From cfb940e8fade65015830c06795b8786c49a1aba0 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 19 Jan 2017 17:19:08 -0800 Subject: [PATCH 01/35] Added a FATES wrapper to the CIME shared endrun --- components/clm/src/ED/main/FatesGlobals.F90 | 28 +++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/components/clm/src/ED/main/FatesGlobals.F90 b/components/clm/src/ED/main/FatesGlobals.F90 index 9ae06e207c..0c3575e388 100644 --- a/components/clm/src/ED/main/FatesGlobals.F90 +++ b/components/clm/src/ED/main/FatesGlobals.F90 @@ -35,4 +35,32 @@ logical function fates_global_verbose() fates_global_verbose = fates_global_verbose_ end function fates_global_verbose + + subroutine fates_endrun(msg) + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Abort the model for abnormal termination + ! This subroutine was derived from CLM's + ! endrun_vanilla() in abortutils.F90 + ! + use shr_sys_mod , only: shr_sys_abort + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in), optional :: msg ! string to be printed + !----------------------------------------------------------------------- + + if (present (msg)) then + write(fates_log(),*)'ENDRUN:', msg + else + write(fates_log(),*)'ENDRUN: called without a message string' + end if + + call shr_sys_abort() + + end subroutine fates_endrun + + + end module FatesGlobals From 78c6574464010562f3380927cad66277fbfc9880 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 19 Jan 2017 18:02:04 -0800 Subject: [PATCH 02/35] Converted global calls to abortutilsmods endrun to fates endrun. Also did some light cleaning of some other calls to the cime shares, mostly just for readability. --- .../clm/src/ED/biogeochem/EDCanopyStructureMod.F90 | 7 ++++--- .../clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 | 5 +++-- .../clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 | 12 +++++++----- components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 | 3 ++- .../clm/src/ED/biogeochem/EDSharedParamsMod.F90 | 2 +- .../clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 | 7 ++++--- .../ED/biogeophys/FatesPlantRespPhotosynthMod.F90 | 8 +++++--- components/clm/src/ED/main/EDInitMod.F90 | 2 +- components/clm/src/ED/main/EDPftvarcon.F90 | 2 +- .../clm/src/ED/main/FatesRestartInterfaceMod.F90 | 6 +++--- 10 files changed, 31 insertions(+), 23 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index 00a969a78c..b4a42463cd 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -5,7 +5,7 @@ module EDCanopyStructureMod ! This is obviosuly far too complicated for it's own good and needs re-writing. ! ============================================================================ - use shr_kind_mod , only : r8 => shr_kind_r8; + use FatesConstantsMod , only : r8 => fates_r8 use FatesGlobals , only : fates_log use pftconMod , only : pftcon use EDGrowthFunctionsMod , only : c_area @@ -13,9 +13,10 @@ module EDCanopyStructureMod use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, ncwd use EDtypesMod , only : cp_nclmax,cp_nlevcan use EDtypesMod , only : numpft_ed + use FatesGlobals , only : endrun => fates_endrun + + ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg - use abortutils , only : endrun - use FatesGlobals , only : fates_log implicit none private diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index 199682bdb7..7e59338636 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -4,12 +4,11 @@ module EDCohortDynamicsMod ! Cohort stuctures in ED. ! ! !USES: - use abortutils , only : endrun + use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log use FatesGlobals , only : freq_day use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : fates_unset_int - use shr_log_mod , only : errMsg => shr_log_errMsg use pftconMod , only : pftcon use EDEcophysContype , only : EDecophyscon use EDGrowthFunctionsMod , only : c_area, tree_lai @@ -18,6 +17,8 @@ module EDCohortDynamicsMod use EDtypesMod , only : ncwd, maxcohortsperpatch use EDtypesMod , only : sclass_ed,nlevsclass_ed,AREA use EDtypesMod , only : min_npm2, min_nppatch, min_n_safemath + ! CIME globals + use shr_log_mod , only : errMsg => shr_log_errMsg ! implicit none private diff --git a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 index 6d7c84ebb1..b78ae92f8c 100755 --- a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 @@ -3,9 +3,7 @@ module EDPatchDynamicsMod ! ============================================================================ ! Controls formation, creation, fusing and termination of patch level processes. ! ============================================================================ - - use shr_kind_mod , only : r8 => shr_kind_r8; - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varctl , only : iulog use FatesGlobals , only : freq_day use pftconMod , only : pftcon @@ -13,6 +11,12 @@ module EDPatchDynamicsMod use EDtypesMod , only : ncwd, n_dbh_bins, ntol, numpft_ed, area, dbhmax, maxPatchesPerCol use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : min_patch_area, cp_numlevgrnd, cp_numSWb + use FatesGlobals , only : endrun => fates_endrun + use FatesConstantsMod , only : r8 => fates_r8 + + ! CIME globals + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! implicit none private @@ -878,7 +882,6 @@ subroutine zero_patch(cp_p) ! (this needs to be two seperate routines, one for nan & one for zero ! ! !USES: - use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) ! ! !ARGUMENTS: type(ed_patch_type), intent(inout), target :: cp_p @@ -1475,7 +1478,6 @@ function countPatches( bounds, nsites, sites ) result ( totNumPatches ) ! ! !USES: use decompMod , only : bounds_type - use abortutils , only : endrun use EDTypesMod , only : ed_site_type ! ! !ARGUMENTS: diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index a496767038..d07dc7d5cb 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -1281,7 +1281,8 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) use EDParamsMod, only : ED_val_ag_biomass use FatesInterfaceMod, only : bc_in_type, bc_out_type use clm_varctl, only : use_vertsoilc - use abortutils , only : endrun + use FatesGlobals, only : endrun => fates_endrun + ! INTERF-TODO: remove the control parameters: exponential_rooting_profile, ! pftspecific_rootingprofile, rootprof_exp, surfprof_exp, zisoi, dzsoi_decomp, zsoi diff --git a/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 b/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 index c4111c124f..d6d7d7cb40 100644 --- a/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 @@ -28,7 +28,7 @@ module EDSharedParamsMod subroutine EDParamsReadShared(ncid) ! use ncdio_pio , only : file_desc_t,ncd_io - use abortutils , only : endrun + use FatesGlobals, only : endrun => fates_endrun use shr_log_mod , only : errMsg => shr_log_errMsg ! type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id diff --git a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 index d76695916c..039f64e3c9 100644 --- a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 @@ -13,16 +13,17 @@ module EDSurfaceRadiationMod use EDtypesMod , only : ed_patch_type, ed_site_type use EDtypesMod , only : numpft_ed use EDtypesMod , only : maxPatchesPerCol - use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_log_mod , only : errMsg => shr_log_errMsg + use FatesConstantsMod , only : r8 => fates_r8 use FatesInterfaceMod , only : bc_in_type, & bc_out_type use EDTypesMod , only : cp_numSWb, & ! Actual number of SW radiation bands cp_maxSWb, & ! maximum number of SW bands (for scratch) cp_nclmax ! control parameter, number of SW bands use EDCanopyStructureMod, only: calc_areaindex - + ! CIME globals + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none private diff --git a/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 b/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 index 73f995df4d..25fe730f17 100644 --- a/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -20,12 +20,14 @@ module FATESPlantRespPhotosynthMod ! !USES: - use abortutils, only : endrun + use FatesGlobals, only : endrun => fates_endrun use FatesGlobals, only : fates_log use FatesConstantsMod, only : r8 => fates_r8 - use shr_log_mod , only : errMsg => shr_log_errMsg use EDTypesMod, only : use_fates_plant_hydro - + + ! CIME Globals + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none private diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 index 76bc5ed9b2..f1fec24b2f 100755 --- a/components/clm/src/ED/main/EDInitMod.F90 +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -5,7 +5,7 @@ module EDInitMod ! ============================================================================ use FatesConstantsMod , only : r8 => fates_r8 - use abortutils , only : endrun + use FatesGlobals , only : endrun => fates_endrun use EDTypesMod , only : cp_nclmax use FatesGlobals , only : fates_log use clm_varctl , only : use_ed_spit_fire diff --git a/components/clm/src/ED/main/EDPftvarcon.F90 b/components/clm/src/ED/main/EDPftvarcon.F90 index 475ee7b1bb..0961e71adb 100644 --- a/components/clm/src/ED/main/EDPftvarcon.F90 +++ b/components/clm/src/ED/main/EDPftvarcon.F90 @@ -58,7 +58,7 @@ subroutine EDpftconrd( ncid ) ! ! !USES: use ncdio_pio , only : file_desc_t, ncd_io - use abortutils , only : endrun + use FatesGlobals, only : endrun => fates_endrun ! ! !ARGUMENTS: implicit none diff --git a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 index 18b77bc6cf..0ad8fb6836 100644 --- a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 @@ -6,14 +6,14 @@ module FatesRestartInterfaceMod use FatesConstantsMod , only : fates_short_string_length use FatesConstantsMod , only : fates_long_string_length use FatesGlobals , only : fates_log - + use FatesGlobals , only : endrun => fates_endrun use FatesIODimensionsMod, only : fates_io_dimension_type use FatesIOVariableKindMod, only : fates_io_variable_kind_type use FatesRestartVariableMod, only : fates_restart_variable_type - ! TO BE REMOVED WHEN ERROR HANDLINE IS ADDED (rgk 11-2016) + ! CIME GLOBALS use shr_log_mod , only : errMsg => shr_log_errMsg - use abortutils , only : endrun + implicit none From a3b00104c8a0adce18f78a6db4b340ab292b5759 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 23 Jan 2017 11:34:38 -0800 Subject: [PATCH 03/35] Partial changes to fixing update sequence of cohort and patch dimension globals. --- components/clm/src/ED/main/EDTypesMod.F90 | 15 -------- components/clm/src/ED/main/FatesGlobals.F90 | 38 ++++++++++++++++--- .../clm/src/ED/main/FatesInterfaceMod.F90 | 5 +-- components/clm/src/main/initGridCellsMod.F90 | 12 ++++-- .../clm/src/utils/clmfates_interfaceMod.F90 | 10 +---- 5 files changed, 44 insertions(+), 36 deletions(-) diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 1817de3e66..75eb463109 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -16,21 +16,6 @@ module EDTypesMod real(r8) :: timestep_secs ! subdaily timestep in seconds (e.g. 1800 or 3600) real(r8), parameter :: AREA = 10000.0_r8 ! Notional area of simulated forest m2 - integer doy - - integer, parameter :: invalidValue = -9999 ! invalid value for gcells, - ! cohorts, and patches - - ! for setting number of patches per gridcell and number of cohorts per patch - ! for I/O and converting to a vector - - integer, parameter :: maxPatchesPerCol = 10 ! - integer, parameter :: maxCohortsPerPatch = 160 ! - integer, parameter :: cohorts_per_col = 1600 ! This is the max number of individual items one can store per - - ! each grid cell and effects the striding in the ED restart - ! data as some fields are arrays where each array is - ! associated with one cohort integer, parameter :: numWaterMem = 10 ! watermemory saved as site level var diff --git a/components/clm/src/ED/main/FatesGlobals.F90 b/components/clm/src/ED/main/FatesGlobals.F90 index 517d057b71..1c2986fd8b 100644 --- a/components/clm/src/ED/main/FatesGlobals.F90 +++ b/components/clm/src/ED/main/FatesGlobals.F90 @@ -5,16 +5,34 @@ module FatesGlobals ! immediately obvious home. use FatesConstantsMod , only : r8 => fates_r8 + use EDTypes , only : cp_nclmax, cp_nlevcan, numpft_ed implicit none - - public :: FatesGlobalsInit public :: fates_log public :: fates_global_verbose public :: SetFatesTime + + ! for setting number of patches per gridcell and number of cohorts per patch + ! for I/O and converting to a vector + + integer, parameter :: maxPatchesPerSite = 10 ! maximum number of patches to live on a site + integer, parameter :: CohortsPerPatch = 160 ! maxCohortsPerPatch is the value that is ultimately + ! used to set array sizes. The arrays that it allocates + ! are sometimes used to hold non-cohort entities. As such + ! the size of those arrays must be the maximum of what we + ! expect from cohorts per patch, and those others. + + integer :: maxCohortsPerPatch ! See above for CohortsPerPatch + integer :: maxCohortsPerSite ! This is the max number of individual items one can store per + ! each grid cell and effects the striding in the ED restart + ! data as some fields are arrays where each array is + ! associated with one cohort + + + ! ------------------------------------------------------------------------------------- ! Timing Variables ! It is assumed that all of the sites on a given machine will be synchronous. @@ -33,22 +51,30 @@ module FatesGlobals ! this is a frequency integer, private :: fates_log_ - logical, private :: fates_global_verbose_ + logical, private, parameter :: fates_global_verbose_ = .false. contains - subroutine FatesGlobalsInit(log_unit, global_verbose) + subroutine FatesGlobalsInit(log_unit) implicit none integer, intent(in) :: log_unit - logical, intent(in) :: global_verbose + + + maxCohortsPerPatch = max(CohortsPerPatch, & + numpft_ed * cp_nclmax * cp_nlevcan) + + maxCohortsPerSite = maxPatchesPerCol * maxCohortsPerPatch + fates_log_ = log_unit fates_global_verbose_ = global_verbose end subroutine FatesGlobalsInit + ! ===================================================================================== + integer function fates_log() fates_log = fates_log_ end function fates_log @@ -112,7 +138,7 @@ subroutine SetFatesTime(current_year_in, current_month_in, & model_day = model_day_in day_of_year = day_of_year_in days_per_year = days_per_year_in - freq_day = freq_day_in + freq_day = freq_day_in end subroutine SetFatesTime diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90 index 272bbfbc38..6b9966262d 100644 --- a/components/clm/src/ED/main/FatesInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesInterfaceMod.F90 @@ -324,16 +324,15 @@ module FatesInterfaceMod contains ! ==================================================================================== - subroutine FatesInterfaceInit(log_unit, global_verbose) + subroutine FatesInterfaceInit(log_unit) use FatesGlobals, only : FatesGlobalsInit implicit none integer, intent(in) :: log_unit - logical, intent(in) :: global_verbose - call FatesGlobalsInit(log_unit, global_verbose) + call FatesGlobalsInit(log_unit) end subroutine FatesInterfaceInit diff --git a/components/clm/src/main/initGridCellsMod.F90 b/components/clm/src/main/initGridCellsMod.F90 index 8e54576bb9..7f3e14ef8e 100644 --- a/components/clm/src/main/initGridCellsMod.F90 +++ b/components/clm/src/main/initGridCellsMod.F90 @@ -28,6 +28,7 @@ module initGridCellsMod use initSubgridMod , only : clm_ptrs_compdown, clm_ptrs_check use initSubgridMod , only : add_landunit, add_column, add_patch use glcBehaviorMod , only : glc_behavior_type + use FatesInterfaceMod, only : FatesInterfaceInit ! ! !PUBLIC TYPES: implicit none @@ -191,6 +192,7 @@ subroutine initGridcells(glc_behavior) if ( use_ed ) then ! cohort decomp + call FatesInterfaceInit(iulog) call set_cohort_decomp( bounds_clump=bounds_clump ) end if @@ -227,13 +229,12 @@ subroutine initGridcells(glc_behavior) end subroutine initGridcells - !------------------------------------------------------------------------ subroutine set_cohort_decomp ( bounds_clump ) - ! + ! !DESCRIPTION: ! Set gridcell decomposition for cohorts ! - use EDTypesMod , only : cohorts_per_col + use FatesGlobals, only : maxCohortsPerSite use EDVecCohortType , only : ed_vec_cohort ! ! !ARGUMENTS: @@ -241,10 +242,12 @@ subroutine set_cohort_decomp ( bounds_clump ) ! ! !LOCAL VARIABLES: integer c, ci + integer cohorts_per_col !------------------------------------------------------------------------ - ci = bounds_clump%begc + cohorts_per_col = maxCohortsPerSite + ci = bounds_clump%begc do c = bounds_clump%begCohort, bounds_clump%endCohort ed_vec_cohort%column(c) = ci @@ -252,6 +255,7 @@ subroutine set_cohort_decomp ( bounds_clump ) end do + end subroutine set_cohort_decomp !------------------------------------------------------------------------ diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index f4edad4514..7b5b46d119 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -171,8 +171,8 @@ module CLMFatesInterfaceMod __FILE__ contains - - ! ==================================================================================== + + ! ==================================================================================== subroutine init(this, bounds_proc, use_ed) @@ -222,12 +222,6 @@ subroutine init(this, bounds_proc, use_ed) end if - if(DEBUG)then - write(iulog,*) 'Entering clm_fates%init' - end if - - verbose_output = .false. - call FatesInterfaceInit(iulog, verbose_output) nclumps = get_proc_clumps() allocate(this%fates(nclumps)) From b4c8755842738818cdb70e5e48d179b125c8a0e5 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 23 Jan 2017 17:31:21 -0800 Subject: [PATCH 04/35] First pass of creating maxElements, having it live in FatesGlobals and having it a dependent variable that goes on to set HLM allocations. This pass also simplifies how HLM cohort<->grid,lu and column mappings are calculated. This is done by removing ed_cohort_vector. In this phase we have not removed that memory structure, but we are bypassing it. --- .../ED/biogeochem/EDCanopyStructureMod.F90 | 10 +-- .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 8 +- .../src/ED/biogeochem/EDPatchDynamicsMod.F90 | 8 +- .../src/ED/biogeophys/EDSurfaceAlbedoMod.F90 | 25 +++--- .../FatesPlantRespPhotosynthMod.F90 | 6 +- components/clm/src/ED/main/EDInitMod.F90 | 5 +- components/clm/src/ED/main/EDTypesMod.F90 | 16 ++-- components/clm/src/ED/main/FatesGlobals.F90 | 63 ++++++++++---- .../clm/src/ED/main/FatesInterfaceMod.F90 | 87 ++++++++++--------- .../src/ED/main/FatesRestartInterfaceMod.F90 | 38 ++++---- components/clm/src/main/clm_initializeMod.F90 | 18 ++++ components/clm/src/main/decompInitMod.F90 | 9 +- components/clm/src/main/initGridCellsMod.F90 | 9 +- components/clm/src/main/subgridMod.F90 | 4 +- .../clm/src/utils/clmfates_interfaceMod.F90 | 12 ++- 15 files changed, 179 insertions(+), 139 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index b4a42463cd..315d84766d 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -11,8 +11,9 @@ module EDCanopyStructureMod use EDGrowthFunctionsMod , only : c_area use EDCohortDynamicsMod , only : copy_cohort, terminate_cohorts, fuse_cohorts use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, ncwd - use EDtypesMod , only : cp_nclmax,cp_nlevcan - use EDtypesMod , only : numpft_ed + use FatesGlobals , only : cp_nclmax + use FatesGlobals , only : cp_nlevcan + use FatesGlobals , only : numpft_ed use FatesGlobals , only : endrun => fates_endrun ! CIME Globals @@ -80,7 +81,7 @@ subroutine canopy_structure( currentSite ) use EDParamsMod, only : ED_val_comp_excln, ED_val_ag_biomass use SFParamsMod, only : SF_val_cwd_frac - use EDtypesMod , only : ncwd, min_patch_area, cp_nlevcan + use EDtypesMod , only : ncwd, min_patch_area ! ! !ARGUMENTS type(ed_site_type) , intent(inout), target :: currentSite @@ -593,7 +594,6 @@ subroutine canopy_spread( currentSite ) ! Calculates the spatial spread of tree canopies based on canopy closure. ! ! !USES: - use EDTypesMod , only : cp_nlevcan use EDParamsMod , only : ED_val_maxspread, ED_val_minspread ! ! !ARGUMENTS @@ -773,7 +773,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) ! !USES: use EDGrowthFunctionsMod , only : tree_lai, tree_sai, c_area - use EDtypesMod , only : area, dinc_ed, hitemax, numpft_ed, n_hite_bins + use EDtypesMod , only : area, dinc_ed, hitemax, n_hite_bins use EDEcophysConType , only : EDecophyscon ! diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index 7e59338636..b4b154731b 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -13,8 +13,10 @@ module EDCohortDynamicsMod use EDEcophysContype , only : EDecophyscon use EDGrowthFunctionsMod , only : c_area, tree_lai use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type - use EDTypesMod , only : fusetol, cp_nclmax - use EDtypesMod , only : ncwd, maxcohortsperpatch + use EDTypesMod , only : fusetol + use FatesGlobals , only : cp_nclmax + use EDtypesMod , only : ncwd + use FatesGlobals , only : maxCohortsPerPatch use EDtypesMod , only : sclass_ed,nlevsclass_ed,AREA use EDtypesMod , only : min_npm2, min_nppatch, min_n_safemath ! CIME globals @@ -599,7 +601,7 @@ subroutine fuse_cohorts(patchptr) ! Join similar cohorts to reduce total number ! ! !USES: - use EDTypesMod , only : cp_nlevcan + use FatesGlobals , only : cp_nlevcan ! ! !ARGUMENTS type (ed_patch_type), intent(inout), target :: patchptr diff --git a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 index b78ae92f8c..35bf4c3d61 100755 --- a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 @@ -8,7 +8,9 @@ module EDPatchDynamicsMod use FatesGlobals , only : freq_day use pftconMod , only : pftcon use EDCohortDynamicsMod , only : fuse_cohorts, sort_cohorts, insert_cohort - use EDtypesMod , only : ncwd, n_dbh_bins, ntol, numpft_ed, area, dbhmax, maxPatchesPerCol + use EDtypesMod , only : ncwd, n_dbh_bins, ntol, area, dbhmax + use FatesGlobals , only : numpft_ed + use FatesGlobals , only : maxPatchesPerSite use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : min_patch_area, cp_numlevgrnd, cp_numSWb use FatesGlobals , only : endrun => fates_endrun @@ -172,7 +174,7 @@ subroutine spawn_patches( currentSite ) ! 10) Area checked, and patchno recalculated. ! ! !USES: - use EDTypesMod , only : cp_nclmax + use FatesGlobals , only : cp_nclmax use EDParamsMod , only : ED_val_maxspread, ED_val_understorey_death use EDCohortDynamicsMod , only : zero_cohort, copy_cohort, terminate_cohorts ! @@ -1021,7 +1023,7 @@ subroutine fuse_patches( csite ) !--------------------------------------------------------------------- !maxpatch = 4 - maxpatch = maxPatchesPerCol + maxpatch = maxPatchesPerSite currentSite => csite diff --git a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 index 039f64e3c9..d90fca8810 100644 --- a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 @@ -11,14 +11,15 @@ module EDSurfaceRadiationMod #include "shr_assert.h" use EDtypesMod , only : ed_patch_type, ed_site_type - use EDtypesMod , only : numpft_ed - use EDtypesMod , only : maxPatchesPerCol + use FatesGlobals , only : numpft_ed + use FatesGlobals , only : maxPatchesPerSite use FatesConstantsMod , only : r8 => fates_r8 use FatesInterfaceMod , only : bc_in_type, & bc_out_type use EDTypesMod , only : cp_numSWb, & ! Actual number of SW radiation bands - cp_maxSWb, & ! maximum number of SW bands (for scratch) - cp_nclmax ! control parameter, number of SW bands + cp_maxSWb ! maximum number of SW bands (for scratch) + + use FatesGlobals , only : cp_nclmax use EDCanopyStructureMod, only: calc_areaindex ! CIME globals @@ -48,7 +49,9 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) ! !USES: use clm_varctl , only : iulog use pftconMod , only : pftcon - use EDtypesMod , only : ed_patch_type, numpft_ed, cp_nlevcan + use EDtypesMod , only : ed_patch_type + use FatesGlobals , only : numpft_ed + use FatesGlobals , only : cp_nlevcan use EDTypesMod , only : ed_site_type @@ -75,8 +78,8 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) real(r8) :: k_dir(numpft_ed) ! Direct beam extinction coefficient real(r8) :: tr_dir_z(cp_nclmax,numpft_ed,cp_nlevcan) ! Exponential transmittance of direct beam radiation through a single layer real(r8) :: tr_dif_z(cp_nclmax,numpft_ed,cp_nlevcan) ! Exponential transmittance of diffuse radiation through a single layer - real(r8) :: forc_dir(maxPatchesPerCol,cp_maxSWb) - real(r8) :: forc_dif(maxPatchesPerCol,cp_maxSWb) + real(r8) :: forc_dir(maxPatchesPerSite,cp_maxSWb) + real(r8) :: forc_dif(maxPatchesPerSite,cp_maxSWb) real(r8) :: weighted_dir_tr(cp_nclmax) real(r8) :: weighted_fsun(cp_nclmax) real(r8) :: weighted_dif_ratio(cp_nclmax,cp_maxSWb) @@ -94,8 +97,8 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) real(r8) :: abs_rad(cp_maxSWb) !radiation absorbed by soil real(r8) :: tr_soili ! Radiation transmitted to the soil surface. real(r8) :: tr_soild ! Radiation transmitted to the soil surface. - real(r8) :: phi1b(maxPatchesPerCol,numpft_ed) ! Radiation transmitted to the soil surface. - real(r8) :: phi2b(maxPatchesPerCol,numpft_ed) + real(r8) :: phi1b(maxPatchesPerSite,numpft_ed) ! Radiation transmitted to the soil surface. + real(r8) :: phi2b(maxPatchesPerSite,numpft_ed) real(r8) :: laisum ! cumulative lai+sai for canopy layer (at middle of layer) real(r8) :: angle @@ -108,8 +111,8 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) integer :: fp,iv,s ! array indices integer :: ib ! waveband number real(r8) :: cosz ! 0.001 <= coszen <= 1.000 - real(r8) :: chil(maxPatchesPerCol) ! -0.4 <= xl <= 0.6 - real(r8) :: gdir(maxPatchesPerCol) ! leaf projection in solar direction (0 to 1) + real(r8) :: chil(maxPatchesPerSite) ! -0.4 <= xl <= 0.6 + real(r8) :: gdir(maxPatchesPerSite) ! leaf projection in solar direction (0 to 1) !----------------------------------------------------------------------- diff --git a/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 b/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 index 25fe730f17..b861021355 100644 --- a/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -68,10 +68,10 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) use EDTypesMod , only : ed_patch_type use EDTypesMod , only : ed_cohort_type use EDTypesMod , only : ed_site_type - use EDTypesMod , only : numpft_ed + use FatesGlobals , only : numpft_ed use EDTypesMod , only : cp_numlevsoil - use EDTypesMod , only : cp_nlevcan - use EDTypesMod , only : cp_nclmax + use FatesGlobals , only : cp_nlevcan + use FatesGlobals , only : cp_nclmax use EDEcophysContype , only : EDecophyscon use FatesInterfaceMod , only : bc_in_type use FatesInterfaceMod , only : bc_out_type diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 index f1fec24b2f..aa5850ade8 100755 --- a/components/clm/src/ED/main/EDInitMod.F90 +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -6,7 +6,7 @@ module EDInitMod use FatesConstantsMod , only : r8 => fates_r8 use FatesGlobals , only : endrun => fates_endrun - use EDTypesMod , only : cp_nclmax + use FatesGlobals , only : cp_nclmax use FatesGlobals , only : fates_log use clm_varctl , only : use_ed_spit_fire use clm_time_manager , only : is_restart @@ -16,7 +16,8 @@ module EDInitMod use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts use EDPatchDynamicsMod , only : create_patch use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, area - use EDTypesMod , only : cohorts_per_col, ncwd, numpft_ed + use EDTypesMod , only : ncwd + use FatesGlobals , only : numpft_ed implicit none private diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 75eb463109..ec900b43cd 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -1,10 +1,9 @@ module EDTypesMod use shr_kind_mod , only : r8 => shr_kind_r8; - use decompMod , only : bounds_type - use clm_varpar , only : nlevgrnd, mxpft - use domainMod , only : domain_type - use shr_sys_mod , only : shr_sys_flush + use clm_varpar , only : mxpft + use FatesGlobals , only : cp_nclmax, cp_nlevcan, numpft_ed + implicit none save @@ -25,7 +24,7 @@ module EDTypesMod integer , parameter :: SENES = 10 ! Window of time over which we track temp for cold sensecence (days) real(r8), parameter :: DINC_ED = 1.0_r8 ! size of LAI bins. integer , parameter :: N_DIST_TYPES = 2 ! number of disturbance types (mortality, fire) - integer , parameter :: numpft_ed = 2 ! number of PFTs used in ED. + integer , parameter :: maxPft = 79 ! max number of PFTs potentially used by CLM @@ -96,11 +95,7 @@ module EDTypesMod ! Control Parameters (cp_) ! ------------------------------------------------------------------------------------- - ! These parameters are dictated by FATES internals - - integer, parameter :: cp_nclmax = 2 ! Maximum number of canopy layers - integer, parameter :: cp_nlevcan = 40 ! number of leaf layers in canopy layer integer, parameter :: cp_maxSWb = 2 ! maximum number of broad-bands in the ! shortwave spectrum cp_numSWb <= cp_maxSWb @@ -566,7 +561,7 @@ subroutine ed_hist_scpfmaps integer :: i integer :: isc integer :: ipft - + allocate( levsclass_ed(1:nlevsclass_ed )) allocate( pft_levscpf_ed(1:nlevsclass_ed*mxpft)) allocate(scls_levscpf_ed(1:nlevsclass_ed*mxpft)) @@ -628,7 +623,6 @@ subroutine set_root_fraction( this , depth_gl) ! Calculates the fractions of the root biomass in each layer for each pft. ! ! !USES: - use PatchType , only : clmpatch => patch use pftconMod , only : pftcon ! ! !ARGUMENTS diff --git a/components/clm/src/ED/main/FatesGlobals.F90 b/components/clm/src/ED/main/FatesGlobals.F90 index 1c2986fd8b..47bdf6cd19 100644 --- a/components/clm/src/ED/main/FatesGlobals.F90 +++ b/components/clm/src/ED/main/FatesGlobals.F90 @@ -5,7 +5,7 @@ module FatesGlobals ! immediately obvious home. use FatesConstantsMod , only : r8 => fates_r8 - use EDTypes , only : cp_nclmax, cp_nlevcan, numpft_ed +! use EDTypesMod , only : cp_nclmax, cp_nlevcan, numpft_ed implicit none @@ -13,24 +13,41 @@ module FatesGlobals public :: fates_log public :: fates_global_verbose public :: SetFatesTime + public :: set_fates_global_elements ! for setting number of patches per gridcell and number of cohorts per patch ! for I/O and converting to a vector - integer, parameter :: maxPatchesPerSite = 10 ! maximum number of patches to live on a site - integer, parameter :: CohortsPerPatch = 160 ! maxCohortsPerPatch is the value that is ultimately - ! used to set array sizes. The arrays that it allocates - ! are sometimes used to hold non-cohort entities. As such - ! the size of those arrays must be the maximum of what we - ! expect from cohorts per patch, and those others. + integer, parameter :: maxPatchesPerSite = 10 ! maximum number of patches to live on a site + integer, parameter :: maxCohortsPerPatch = 160 ! maximum number of cohorts to live on a patch - integer :: maxCohortsPerPatch ! See above for CohortsPerPatch - integer :: maxCohortsPerSite ! This is the max number of individual items one can store per - ! each grid cell and effects the striding in the ED restart - ! data as some fields are arrays where each array is - ! associated with one cohort + ! Variables mostly used for dimensioning host land model (HLM) array spaces + + integer, protected :: maxElementsPerPatch ! maxElementsPerPatch is the value that is ultimately + ! used to set the size of the largest arrays necessary + ! in things like restart files (probably hosted by the + ! HLM). The size of these arrays are not a parameter + ! because it is simply the maximum of several different + ! dimensions. It is possible that this would be the + ! maximum number of cohorts per patch, but + ! but it could be other things. + + integer, protected :: maxElementsPerSite ! This is the max number of individual items one can store per + ! each grid cell and effects the striding in the ED restart + ! data as some fields are arrays where each array is + ! associated with one cohort + + integer, protected :: maxCohortsPerSite ! Maximum number of cohorts that can exist in a given + ! site. Its possible this is not used. + + + integer, parameter :: cp_nclmax = 2 ! Maximum number of canopy layers + + integer, parameter :: cp_nlevcan = 40 ! number of leaf layers in canopy layer + + integer , parameter :: numpft_ed = 2 ! number of PFTs used in ED. ! ------------------------------------------------------------------------------------- @@ -51,22 +68,30 @@ module FatesGlobals ! this is a frequency integer, private :: fates_log_ - logical, private, parameter :: fates_global_verbose_ = .false. + logical, private :: fates_global_verbose_ contains - subroutine FatesGlobalsInit(log_unit) + subroutine set_fates_global_elements() + implicit none - implicit none + maxElementsPerPatch = max(maxCohortsPerPatch, & + numpft_ed * cp_nclmax * cp_nlevcan) + + maxCohortsPerSite = maxPatchesPerSite * maxCohortsPerPatch + + maxElementsPerSite = maxPatchesPerSite * maxElementsPerPatch - integer, intent(in) :: log_unit + end subroutine set_fates_global_elements + ! ===================================================================================== - maxCohortsPerPatch = max(CohortsPerPatch, & - numpft_ed * cp_nclmax * cp_nlevcan) + subroutine FatesGlobalsInit(log_unit,global_verbose) - maxCohortsPerSite = maxPatchesPerCol * maxCohortsPerPatch + implicit none + integer, intent(in) :: log_unit + logical, intent(in) :: global_verbose fates_log_ = log_unit fates_global_verbose_ = global_verbose diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90 index 6b9966262d..569af025f0 100644 --- a/components/clm/src/ED/main/FatesInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesInterfaceMod.F90 @@ -10,8 +10,8 @@ module FatesInterfaceMod ! ------------------------------------------------------------------------------------ use EDtypesMod , only : ed_site_type - use EDtypesMod , only : maxPatchesPerCol - use EDtypesMod , only : cp_nclmax + use FatesGlobals , only : maxPatchesPerSite + use FatesGlobals , only : cp_nclmax use EDtypesMod , only : cp_numSWb use EDtypesMod , only : cp_numlevgrnd use EDtypesMod , only : cp_maxSWb @@ -324,15 +324,16 @@ module FatesInterfaceMod contains ! ==================================================================================== - subroutine FatesInterfaceInit(log_unit) + subroutine FatesInterfaceInit(log_unit,global_verbose) use FatesGlobals, only : FatesGlobalsInit implicit none integer, intent(in) :: log_unit + logical, intent(in) :: global_verbose - call FatesGlobalsInit(log_unit) + call FatesGlobalsInit(log_unit,global_verbose) end subroutine FatesInterfaceInit @@ -372,15 +373,15 @@ subroutine allocate_bcin(bc_in) ! Allocate input boundaries ! Vegetation Dynamics - allocate(bc_in%t_veg24_pa(maxPatchesPerCol)) + allocate(bc_in%t_veg24_pa(maxPatchesPerSite)) - allocate(bc_in%wind24_pa(maxPatchesPerCol)) - allocate(bc_in%relhumid24_pa(maxPatchesPerCol)) - allocate(bc_in%precip24_pa(maxPatchesPerCol)) + allocate(bc_in%wind24_pa(maxPatchesPerSite)) + allocate(bc_in%relhumid24_pa(maxPatchesPerSite)) + allocate(bc_in%precip24_pa(maxPatchesPerSite)) ! Radiation - allocate(bc_in%solad_parb(maxPatchesPerCol,cp_numSWb)) - allocate(bc_in%solai_parb(maxPatchesPerCol,cp_numSWb)) + allocate(bc_in%solad_parb(maxPatchesPerSite,cp_numSWb)) + allocate(bc_in%solai_parb(maxPatchesPerSite,cp_numSWb)) ! Hydrology allocate(bc_in%smp_gl(cp_numlevgrnd)) @@ -390,20 +391,20 @@ subroutine allocate_bcin(bc_in) allocate(bc_in%h2o_liqvol_gl(cp_numlevgrnd)) ! Photosynthesis - allocate(bc_in%filter_photo_pa(maxPatchesPerCol)) - allocate(bc_in%dayl_factor_pa(maxPatchesPerCol)) - allocate(bc_in%esat_tv_pa(maxPatchesPerCol)) - allocate(bc_in%eair_pa(maxPatchesPerCol)) - allocate(bc_in%oair_pa(maxPatchesPerCol)) - allocate(bc_in%cair_pa(maxPatchesPerCol)) - allocate(bc_in%rb_pa(maxPatchesPerCol)) - allocate(bc_in%t_veg_pa(maxPatchesPerCol)) - allocate(bc_in%tgcm_pa(maxPatchesPerCol)) + allocate(bc_in%filter_photo_pa(maxPatchesPerSite)) + allocate(bc_in%dayl_factor_pa(maxPatchesPerSite)) + allocate(bc_in%esat_tv_pa(maxPatchesPerSite)) + allocate(bc_in%eair_pa(maxPatchesPerSite)) + allocate(bc_in%oair_pa(maxPatchesPerSite)) + allocate(bc_in%cair_pa(maxPatchesPerSite)) + allocate(bc_in%rb_pa(maxPatchesPerSite)) + allocate(bc_in%t_veg_pa(maxPatchesPerSite)) + allocate(bc_in%tgcm_pa(maxPatchesPerSite)) allocate(bc_in%t_soisno_gl(cp_numlevgrnd)) ! Canopy Radiation - allocate(bc_in%filter_vegzen_pa(maxPatchesPerCol)) - allocate(bc_in%coszen_pa(maxPatchesPerCol)) + allocate(bc_in%filter_vegzen_pa(maxPatchesPerSite)) + allocate(bc_in%coszen_pa(maxPatchesPerSite)) allocate(bc_in%albgr_dir_rb(cp_numSWb)) allocate(bc_in%albgr_dif_rb(cp_numSWb)) @@ -427,28 +428,28 @@ subroutine allocate_bcout(bc_out) ! Radiation - allocate(bc_out%fsun_pa(maxPatchesPerCol)) - allocate(bc_out%laisun_pa(maxPatchesPerCol)) - allocate(bc_out%laisha_pa(maxPatchesPerCol)) + allocate(bc_out%fsun_pa(maxPatchesPerSite)) + allocate(bc_out%laisun_pa(maxPatchesPerSite)) + allocate(bc_out%laisha_pa(maxPatchesPerSite)) ! Hydrology allocate(bc_out%active_suction_gl(cp_numlevgrnd)) - allocate(bc_out%rootr_pagl(maxPatchesPerCol,cp_numlevgrnd)) - allocate(bc_out%btran_pa(maxPatchesPerCol)) + allocate(bc_out%rootr_pagl(maxPatchesPerSite,cp_numlevgrnd)) + allocate(bc_out%btran_pa(maxPatchesPerSite)) ! Photosynthesis - allocate(bc_out%rssun_pa(maxPatchesPerCol)) - allocate(bc_out%rssha_pa(maxPatchesPerCol)) + allocate(bc_out%rssun_pa(maxPatchesPerSite)) + allocate(bc_out%rssha_pa(maxPatchesPerSite)) ! Canopy Radiation - allocate(bc_out%albd_parb(maxPatchesPerCol,cp_numSWb)) - allocate(bc_out%albi_parb(maxPatchesPerCol,cp_numSWb)) - allocate(bc_out%fabd_parb(maxPatchesPerCol,cp_numSWb)) - allocate(bc_out%fabi_parb(maxPatchesPerCol,cp_numSWb)) - allocate(bc_out%ftdd_parb(maxPatchesPerCol,cp_numSWb)) - allocate(bc_out%ftid_parb(maxPatchesPerCol,cp_numSWb)) - allocate(bc_out%ftii_parb(maxPatchesPerCol,cp_numSWb)) + allocate(bc_out%albd_parb(maxPatchesPerSite,cp_numSWb)) + allocate(bc_out%albi_parb(maxPatchesPerSite,cp_numSWb)) + allocate(bc_out%fabd_parb(maxPatchesPerSite,cp_numSWb)) + allocate(bc_out%fabi_parb(maxPatchesPerSite,cp_numSWb)) + allocate(bc_out%ftdd_parb(maxPatchesPerSite,cp_numSWb)) + allocate(bc_out%ftid_parb(maxPatchesPerSite,cp_numSWb)) + allocate(bc_out%ftii_parb(maxPatchesPerSite,cp_numSWb)) ! biogeochemistry allocate(bc_out%FATES_c_to_litr_lab_c_col(cp_numlevdecomp_full)) @@ -456,14 +457,14 @@ subroutine allocate_bcout(bc_out) allocate(bc_out%FATES_c_to_litr_lig_c_col(cp_numlevdecomp_full)) ! Canopy Structure - allocate(bc_out%elai_pa(maxPatchesPerCol)) - allocate(bc_out%esai_pa(maxPatchesPerCol)) - allocate(bc_out%tlai_pa(maxPatchesPerCol)) - allocate(bc_out%tsai_pa(maxPatchesPerCol)) - allocate(bc_out%htop_pa(maxPatchesPerCol)) - allocate(bc_out%hbot_pa(maxPatchesPerCol)) - allocate(bc_out%canopy_fraction_pa(maxPatchesPerCol)) - allocate(bc_out%frac_veg_nosno_alb_pa(maxPatchesPerCol)) + allocate(bc_out%elai_pa(maxPatchesPerSite)) + allocate(bc_out%esai_pa(maxPatchesPerSite)) + allocate(bc_out%tlai_pa(maxPatchesPerSite)) + allocate(bc_out%tsai_pa(maxPatchesPerSite)) + allocate(bc_out%htop_pa(maxPatchesPerSite)) + allocate(bc_out%hbot_pa(maxPatchesPerSite)) + allocate(bc_out%canopy_fraction_pa(maxPatchesPerSite)) + allocate(bc_out%frac_veg_nosno_alb_pa(maxPatchesPerSite)) return diff --git a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 index 0ad8fb6836..41de351bd8 100644 --- a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 @@ -905,14 +905,13 @@ end subroutine set_restart_var subroutine set_restart_vectors(this,nc,nsites,sites) - use EDTypesMod, only : cp_nclmax - use EDTypesMod, only : cp_nlevcan - use EDTypesMod, only : maxCohortsPerPatch - use EDTypesMod, only : numpft_ed + use FatesGlobals, only : cp_nclmax + use FatesGlobals, only : cp_nlevcan + use FatesGlobals, only : maxElementsPerPatch + use FatesGlobals, only : numpft_ed use EDTypesMod, only : ed_site_type use EDTypesMod, only : ed_cohort_type use EDTypesMod, only : ed_patch_type - use EDTypesMod, only : cohorts_per_col use EDTypesMod, only : ncwd use EDTypesMod, only : numWaterMem @@ -1148,7 +1147,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) if ( DEBUG ) then write(fates_log(),*) 'offsetNumCohorts III ' & - ,io_idx_co,cohorts_per_col, cohortsperpatch + ,io_idx_co,cohortsperpatch endif ! ! deal with patch level fields of arrays here @@ -1196,7 +1195,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) ! Set the first cohort index to the start of the next patch, increment ! by the maximum number of cohorts per patch - io_idx_co_1st = io_idx_co_1st + maxCohortsPerPatch + io_idx_co_1st = io_idx_co_1st + maxElementsPerPatch ! reset counters so that they are all advanced evenly. Currently ! the offset is 10, the max of numpft_ed, ncwd, cp_nclmax, @@ -1209,7 +1208,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) if ( DEBUG ) then write(fates_log(),*) 'CLTV io_idx_co_1st ', io_idx_co_1st - write(fates_log(),*) 'CLTV cohorts_per_col ', cohorts_per_col write(fates_log(),*) 'CLTV numCohort ', cohortsperpatch write(fates_log(),*) 'CLTV totalCohorts ', totalCohorts end if @@ -1275,10 +1273,10 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites ) use EDTypesMod, only : ed_cohort_type use EDTypesMod, only : ed_patch_type use EDTypesMod, only : ncwd - use EDTypesMod, only : cp_nlevcan - use EDTypesMod, only : cp_nclmax - use EDTypesMod, only : maxCohortsPerPatch - use EDTypesMod, only : numpft_ed + use FatesGlobals, only : cp_nlevcan + use FatesGlobals, only : cp_nclmax + use FatesGlobals, only : maxElementsPerPatch + use FatesGlobals, only : numpft_ed use EDTypesMod, only : area use EDPatchDynamicsMod, only : zero_patch use EDGrowthFunctionsMod, only : Dbh @@ -1453,7 +1451,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites ) endif - io_idx_co_1st = io_idx_co_1st + maxCohortsPerPatch + io_idx_co_1st = io_idx_co_1st + maxElementsPerPatch enddo ! ends loop over idx_pa @@ -1469,12 +1467,11 @@ subroutine get_restart_vectors(this, nc, nsites, sites) use EDTypesMod, only : ed_site_type use EDTypesMod, only : ed_cohort_type use EDTypesMod, only : ed_patch_type - use EDTypesMod, only : numpft_ed + use FatesGlobals, only : numpft_ed use EDTypesMod, only : ncwd - use EDTypesMod, only : cp_nlevcan - use EDTypesMod, only : cp_nclmax - use EDTypesMod, only : maxCohortsPerPatch - use EDTypesMod, only : cohorts_per_col + use FatesGlobals, only : cp_nlevcan + use FatesGlobals, only : cp_nclmax + use FatesGlobals, only : maxElementsPerPatch use EDTypesMod, only : numWaterMem ! !ARGUMENTS: @@ -1699,7 +1696,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) if ( DEBUG ) then write(fates_log(),*) 'CVTL III ' & - ,io_idx_co,cohorts_per_col, cohortsperpatch + ,io_idx_co,cohortsperpatch endif ! ! deal with patch level fields of arrays here @@ -1746,7 +1743,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ! Now increment the position of the first cohort to that of the next ! patch - io_idx_co_1st = io_idx_co_1st + maxCohortsPerPatch + io_idx_co_1st = io_idx_co_1st + maxElementsPerPatch ! and max the number of allowed cohorts per patch io_idx_pa_pft = io_idx_co_1st @@ -1757,7 +1754,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) if ( DEBUG ) then write(fates_log(),*) 'CVTL io_idx_co_1st ', io_idx_co_1st - write(fates_log(),*) 'CVTL cohorts_per_col ', cohorts_per_col write(fates_log(),*) 'CVTL cohortsperpatch ', cohortsperpatch write(fates_log(),*) 'CVTL totalCohorts ', totalCohorts end if diff --git a/components/clm/src/main/clm_initializeMod.F90 b/components/clm/src/main/clm_initializeMod.F90 index 1c54d2596b..e64a64d282 100644 --- a/components/clm/src/main/clm_initializeMod.F90 +++ b/components/clm/src/main/clm_initializeMod.F90 @@ -23,6 +23,8 @@ module clm_initializeMod use reweightMod , only : reweight_wrapup use filterMod , only : allocFilters, filter use EDVecCohortType , only : ed_vec_cohort ! instance, used for domain decomp + use FatesGlobals , only : set_fates_global_elements + use clm_instMod ! implicit none @@ -177,6 +179,22 @@ subroutine initialize1( ) call surfrd_get_data(begg, endg, ldomain, fsurdat) + ! ------------------------------------------------------------------------ + ! Ask Fates to evaluate its own dimensioning needs. + ! This determines the total amount of space it requires in its largest + ! dimension. We are currently calling that the "cohort" dimension, but + ! it is really a utility dimension that captures the models largest + ! size need. + ! Sets: + ! maxElementsPerPatch + ! maxElementsPerSite (where a site is roughly equivalent to a column) + ! maxCohortsperSite + ! (Note: maxELementsPerSite is the critical variable used by CLM + ! to allocate space) + ! ------------------------------------------------------------------------ + + call set_fates_global_elements() + ! ------------------------------------------------------------------------ ! Determine decomposition of subgrid scale landunits, columns, patches ! ------------------------------------------------------------------------ diff --git a/components/clm/src/main/decompInitMod.F90 b/components/clm/src/main/decompInitMod.F90 index e1ff624243..9c2bf9e42a 100644 --- a/components/clm/src/main/decompInitMod.F90 +++ b/components/clm/src/main/decompInitMod.F90 @@ -21,6 +21,7 @@ module decompInitMod use glcBehaviorMod , only : glc_behavior_type use decompMod use mct_mod + use FatesGlobals , only : maxElementsPerSite ! ! !PUBLIC TYPES: implicit none @@ -726,12 +727,16 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior) call mct_gsMap_init(gsmap_patch_gdc2glo, gindex, mpicom, comp_id, locsize, globsize) deallocate(gindex) + ! FATES gsmap for the cohort/element vector + if ( use_ed ) then - ! ED cohort gsMap allocate(gindex(begCohort:endCohort)) ioff(:) = 0 + ci = begc do coi = begCohort,endCohort - ci = ed_vec_cohort%column(coi) ! function call to get column for this cohort idx +! ci = ed_vec_cohort%column(coi) ! function call to get column for this cohort idx +! ed_vec_cohort%column(coi) = ci + if ( mod(coi, maxElementsPerSite ) == 0 ) ci = ci + 1 gi = col%gridcell(ci) ! convert column into gridcell gindex(coi) = coStart(gi) + ioff(gi) ioff(gi) = ioff(gi) + 1 diff --git a/components/clm/src/main/initGridCellsMod.F90 b/components/clm/src/main/initGridCellsMod.F90 index 7f3e14ef8e..2d8669ee33 100644 --- a/components/clm/src/main/initGridCellsMod.F90 +++ b/components/clm/src/main/initGridCellsMod.F90 @@ -28,7 +28,6 @@ module initGridCellsMod use initSubgridMod , only : clm_ptrs_compdown, clm_ptrs_check use initSubgridMod , only : add_landunit, add_column, add_patch use glcBehaviorMod , only : glc_behavior_type - use FatesInterfaceMod, only : FatesInterfaceInit ! ! !PUBLIC TYPES: implicit none @@ -192,7 +191,6 @@ subroutine initGridcells(glc_behavior) if ( use_ed ) then ! cohort decomp - call FatesInterfaceInit(iulog) call set_cohort_decomp( bounds_clump=bounds_clump ) end if @@ -234,7 +232,7 @@ subroutine set_cohort_decomp ( bounds_clump ) ! !DESCRIPTION: ! Set gridcell decomposition for cohorts ! - use FatesGlobals, only : maxCohortsPerSite + use FatesGlobals, only : maxElementsPerSite use EDVecCohortType , only : ed_vec_cohort ! ! !ARGUMENTS: @@ -242,16 +240,13 @@ subroutine set_cohort_decomp ( bounds_clump ) ! ! !LOCAL VARIABLES: integer c, ci - integer cohorts_per_col !------------------------------------------------------------------------ - cohorts_per_col = maxCohortsPerSite - ci = bounds_clump%begc do c = bounds_clump%begCohort, bounds_clump%endCohort ed_vec_cohort%column(c) = ci - if ( mod(c, cohorts_per_col ) == 0 ) ci = ci + 1 + if ( mod(c, maxElementsPerSite ) == 0 ) ci = ci + 1 end do diff --git a/components/clm/src/main/subgridMod.F90 b/components/clm/src/main/subgridMod.F90 index 1924edaf68..c3cbb97f32 100644 --- a/components/clm/src/main/subgridMod.F90 +++ b/components/clm/src/main/subgridMod.F90 @@ -17,7 +17,7 @@ module subgridMod use clm_varctl , only : iulog use clm_instur , only : wt_lunit, urban_valid, wt_cft use glcBehaviorMod , only : glc_behavior_type - use EDtypesMod, only : cohorts_per_col + use FatesGlobals , only : maxElementsPerSite implicit none private @@ -163,7 +163,7 @@ subroutine subgrid_get_info_natveg(gi, ncohorts, npatches, ncols, nlunits) ! based on all columns. ! ------------------------------------------------------------------------- - ncohorts = ncols*cohorts_per_col + ncohorts = ncols*maxElementsPerSite end subroutine subgrid_get_info_natveg diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 7b5b46d119..63fd277705 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -221,7 +221,9 @@ subroutine init(this, bounds_proc, use_ed) call param_derived%Init(numpft_ed) end if - + + verbose_output = .false. + call FatesInterfaceInit(iulog, verbose_output) nclumps = get_proc_clumps() allocate(this%fates(nclumps)) @@ -728,11 +730,7 @@ subroutine restart( this, bounds_proc, ncid, flag, waterstate_inst, canopystate_ use FatesIODimensionsMod, only: fates_bounds_type use FatesIOVariableKindMod, only : site_r8, site_int, cohort_r8, cohort_int use EDMainMod, only : ed_update_site - use EDTypesMod, only: cohorts_per_col ! EDtypes should be protected - ! this variable should be transferred - ! to a location where we keep - ! variables that are co-dictated by - ! FATES and the HLM + use FatesGlobals, only: maxElementsPerSite implicit none @@ -815,7 +813,7 @@ subroutine restart( this, bounds_proc, ncid, flag, waterstate_inst, canopystate_ c = this%f2hmap(nc)%fcolumn(s) this%fates_restart%restart_map(nc)%site_index(s) = c this%fates_restart%restart_map(nc)%cohort1_index(s) = & - bounds_proc%begCohort + (c-bounds_proc%begc)*cohorts_per_col + 1 + bounds_proc%begCohort + (c-bounds_proc%begc)*maxElementsPerSite + 1 end do end do From cc5b5537a86435906ad122a380555606651ebe36 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 24 Jan 2017 14:04:12 -0800 Subject: [PATCH 05/35] Removed the ed_vec_cohort structure. --- .../clm/src/ED/main/EDVecCohortType.F90 | 42 ------------------- components/clm/src/main/clm_initializeMod.F90 | 6 --- components/clm/src/main/decompInitMod.F90 | 5 +-- components/clm/src/main/initGridCellsMod.F90 | 32 -------------- 4 files changed, 1 insertion(+), 84 deletions(-) delete mode 100644 components/clm/src/ED/main/EDVecCohortType.F90 diff --git a/components/clm/src/ED/main/EDVecCohortType.F90 b/components/clm/src/ED/main/EDVecCohortType.F90 deleted file mode 100644 index feefd13502..0000000000 --- a/components/clm/src/ED/main/EDVecCohortType.F90 +++ /dev/null @@ -1,42 +0,0 @@ -module EDVecCohortType - - !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! cohortype. mimics CLM vector subgrid types. For now this holds ED data that is - ! necessary in the rest of CLM - ! - ! !USES: - - ! !PUBLIC TYPES: - implicit none - public - ! - type, public :: ed_vec_cohort_type - integer :: cohorts_per_column - integer , pointer :: column(:) !index into column level quantities - contains - procedure, public :: Init - end type ed_vec_cohort_type - - type(ed_vec_cohort_type), public :: ed_vec_cohort - !------------------------------------------------------------------------ - -contains - - !------------------------------------------------------------------------ - subroutine Init(this, beg, end) - ! - ! !USES: - ! - ! !ARGUMENTS: - class(ed_vec_cohort_type) :: this - integer, intent(in) :: beg, end - !------------------------------------------------------------------------ - - ! FIX(SPM,032414) pull this out and put in own ED source - - allocate(this%column(beg:end)) - - end subroutine Init - -end module EDVecCohortType diff --git a/components/clm/src/main/clm_initializeMod.F90 b/components/clm/src/main/clm_initializeMod.F90 index e64a64d282..980749925f 100644 --- a/components/clm/src/main/clm_initializeMod.F90 +++ b/components/clm/src/main/clm_initializeMod.F90 @@ -22,7 +22,6 @@ module clm_initializeMod use PatchType , only : patch ! instance use reweightMod , only : reweight_wrapup use filterMod , only : allocFilters, filter - use EDVecCohortType , only : ed_vec_cohort ! instance, used for domain decomp use FatesGlobals , only : set_fates_global_elements use clm_instMod @@ -215,11 +214,6 @@ subroutine initialize1( ) call col%Init (bounds_proc%begc, bounds_proc%endc) call patch%Init(bounds_proc%begp, bounds_proc%endp) - if ( use_ed ) then - ! INTERF-TODO: THIS GUY NEEDS TO BE MOVED TO THE INTERFACE - call ed_vec_cohort%Init(bounds_proc%begCohort,bounds_proc%endCohort) - end if - ! Build hierarchy and topological info for derived types ! This is needed here for the following call to decompInit_glcp diff --git a/components/clm/src/main/decompInitMod.F90 b/components/clm/src/main/decompInitMod.F90 index 9c2bf9e42a..a2f33ec61f 100644 --- a/components/clm/src/main/decompInitMod.F90 +++ b/components/clm/src/main/decompInitMod.F90 @@ -16,8 +16,7 @@ module decompInitMod use GridcellType , only : grc use LandunitType , only : lun use ColumnType , only : col - use PatchType , only : patch - use EDVecCohortType , only : ed_vec_cohort + use PatchType , only : patch use glcBehaviorMod , only : glc_behavior_type use decompMod use mct_mod @@ -734,8 +733,6 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior) ioff(:) = 0 ci = begc do coi = begCohort,endCohort -! ci = ed_vec_cohort%column(coi) ! function call to get column for this cohort idx -! ed_vec_cohort%column(coi) = ci if ( mod(coi, maxElementsPerSite ) == 0 ) ci = ci + 1 gi = col%gridcell(ci) ! convert column into gridcell gindex(coi) = coStart(gi) + ioff(gi) diff --git a/components/clm/src/main/initGridCellsMod.F90 b/components/clm/src/main/initGridCellsMod.F90 index 2d8669ee33..608fd265f0 100644 --- a/components/clm/src/main/initGridCellsMod.F90 +++ b/components/clm/src/main/initGridCellsMod.F90 @@ -37,7 +37,6 @@ module initGridCellsMod public initGridcells ! initialize sub-grid gridcell mapping ! ! !PRIVATE MEMBER FUNCTIONS: - private set_cohort_decomp private set_landunit_veg_compete private set_landunit_wet_ice_lake private set_landunit_ice_mec @@ -189,11 +188,6 @@ subroutine initGridcells(glc_behavior) end do endif - if ( use_ed ) then - ! cohort decomp - call set_cohort_decomp( bounds_clump=bounds_clump ) - end if - ! Ensure that we have set the expected number of patchs, cols and landunits for this clump SHR_ASSERT(li == bounds_clump%endl, errMsg(sourcefile, __LINE__)) SHR_ASSERT(ci == bounds_clump%endc, errMsg(sourcefile, __LINE__)) @@ -227,32 +221,6 @@ subroutine initGridcells(glc_behavior) end subroutine initGridcells - subroutine set_cohort_decomp ( bounds_clump ) - - ! !DESCRIPTION: - ! Set gridcell decomposition for cohorts - ! - use FatesGlobals, only : maxElementsPerSite - use EDVecCohortType , only : ed_vec_cohort - ! - ! !ARGUMENTS: - type(bounds_type), intent(in) :: bounds_clump - ! - ! !LOCAL VARIABLES: - integer c, ci - !------------------------------------------------------------------------ - - ci = bounds_clump%begc - do c = bounds_clump%begCohort, bounds_clump%endCohort - - ed_vec_cohort%column(c) = ci - if ( mod(c, maxElementsPerSite ) == 0 ) ci = ci + 1 - - end do - - - end subroutine set_cohort_decomp - !------------------------------------------------------------------------ subroutine set_landunit_veg_compete (ltype, gi, li, ci, pi) ! From 8bc1c925522f17eda3efe3d2442fd30277c687fd Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 25 Jan 2017 15:05:45 -0800 Subject: [PATCH 06/35] This commit completes the re-shuffling of global variables in fates in this phase. The difference is that scalars dictated by the hlm going into fates are now living in FatesInterface mod where their wrappers are. Likewise, the varialbes that are dictated by fates and are destined for the HLM are also in this module, as are the wrapper call functions. The wrapper call functions to set fates_maxElementsPerPatch and fates_maxElementsPerSite are called during Initialize1(), and fates_maxElementsPerSite is now used during decompInit instead of the ed_vec_cohort structure. --- .../ED/biogeochem/EDCanopyStructureMod.F90 | 52 ++-- .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 29 +- .../ED/biogeochem/EDGrowthFunctionsMod.F90 | 16 +- .../src/ED/biogeochem/EDPatchDynamicsMod.F90 | 112 ++++--- .../clm/src/ED/biogeochem/EDPhysiologyMod.F90 | 130 ++++---- .../ED/biogeophys/EDAccumulateFluxesMod.F90 | 10 +- .../clm/src/ED/biogeophys/EDBtranMod.F90 | 22 +- .../src/ED/biogeophys/EDSurfaceAlbedoMod.F90 | 186 ++++++----- .../FatesPlantRespPhotosynthMod.F90 | 30 +- components/clm/src/ED/fire/SFMainMod.F90 | 76 ++--- components/clm/src/ED/fire/SFParamsMod.F90 | 2 +- components/clm/src/ED/main/EDInitMod.F90 | 11 +- components/clm/src/ED/main/EDMainMod.F90 | 83 ++--- components/clm/src/ED/main/EDTypesMod.F90 | 245 ++++----------- .../clm/src/ED/main/FatesConstantsMod.F90 | 4 + components/clm/src/ED/main/FatesGlobals.F90 | 94 +----- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 28 +- .../clm/src/ED/main/FatesInterfaceMod.F90 | 291 +++++++++++++----- .../src/ED/main/FatesRestartInterfaceMod.F90 | 52 ++-- components/clm/src/main/clm_initializeMod.F90 | 10 +- components/clm/src/main/decompInitMod.F90 | 4 +- components/clm/src/main/subgridMod.F90 | 4 +- .../clm/src/utils/clmfates_interfaceMod.F90 | 20 +- 23 files changed, 748 insertions(+), 763 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index 315d84766d..65069708f7 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -11,9 +11,9 @@ module EDCanopyStructureMod use EDGrowthFunctionsMod , only : c_area use EDCohortDynamicsMod , only : copy_cohort, terminate_cohorts, fuse_cohorts use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, ncwd - use FatesGlobals , only : cp_nclmax - use FatesGlobals , only : cp_nlevcan - use FatesGlobals , only : numpft_ed + use EDTypesMod , only : nclmax + use EDTypesMod , only : nlevcan + use EDTypesMod , only : numpft_ed use FatesGlobals , only : endrun => fates_endrun ! CIME Globals @@ -96,10 +96,10 @@ subroutine canopy_structure( currentSite ) real(r8) :: cc_loss real(r8) :: lossarea real(r8) :: newarea - real(r8) :: arealayer(cp_nlevcan) ! Amount of plant area currently in each canopy layer - real(r8) :: sumdiff(cp_nlevcan) ! The total of the exclusion weights for all cohorts in layer z + real(r8) :: arealayer(nlevcan) ! Amount of plant area currently in each canopy layer + real(r8) :: sumdiff(nlevcan) ! The total of the exclusion weights for all cohorts in layer z real(r8) :: weight ! The amount of the total lost area that comes from this cohort - real(r8) :: sum_weights(cp_nlevcan) + real(r8) :: sum_weights(nlevcan) real(r8) :: new_total_area_check real(r8) :: missing_area, promarea,cc_gain,sumgain integer :: promswitch,lower_cohort_switch @@ -140,7 +140,7 @@ subroutine canopy_structure( currentSite ) z = z + 1 endif - currentPatch%NCL_p = min(cp_nclmax,z) ! Set current canopy layer occupancy indicator. + currentPatch%NCL_p = min(nclmax,z) ! Set current canopy layer occupancy indicator. do i = 1,z ! Loop around the currently occupied canopy layers. @@ -201,7 +201,7 @@ subroutine canopy_structure( currentSite ) currentCohort%dbh = currentCohort%dbh copyc%dbh = copyc%dbh !+ 0.000000000001_r8 !kill the ones which go into canopy layers that are not allowed... (default nclmax=2) - if(i+1 > cp_nclmax)then + if(i+1 > nclmax)then !put the litter from the terminated cohorts into the fragmenting pools ! write(fates_log(),*) '3rd canopy layer' do c=1,ncwd @@ -246,8 +246,8 @@ subroutine canopy_structure( currentSite ) currentCohort%canopy_layer = i + 1 !the whole cohort becomes demoted sumloss = sumloss + currentCohort%c_area - !kill the ones which go into canopy layers that are not allowed... (default cp_nclmax=2) - if(i+1 > cp_nclmax)then + !kill the ones which go into canopy layers that are not allowed... (default nclmax=2) + if(i+1 > nclmax)then !put the litter from the terminated cohorts into the fragmenting pools do c=1,ncwd @@ -294,7 +294,7 @@ subroutine canopy_structure( currentSite ) enddo !arealayer loop if(arealayer(i)-currentPatch%area > 0.00001_r8)then - write(fates_log(),*) 'lossarea problem', lossarea,sumloss,z,currentPatch%patchno,currentPatch%clm_pno + write(fates_log(),*) 'lossarea problem', lossarea,sumloss,z,currentPatch%patchno endif enddo !z @@ -319,7 +319,7 @@ subroutine canopy_structure( currentSite ) excess_area = arealayer(j)-currentPatch%area endif enddo - currentPatch%ncl_p = min(z,cp_nclmax) + currentPatch%ncl_p = min(z,nclmax) enddo !is there still excess area in any layer? @@ -494,7 +494,7 @@ subroutine canopy_structure( currentSite ) if(currentPatch%area-arealayer(i) < 0.000001_r8)then !write(fates_log(),*) 'gainarea problem',sumgain,arealayer(i),currentPatch%area,z, & - !currentPatch%patchno,currentPatch%clm_pno,currentPatch%area - arealayer(i),i,missing_area,count_mi + !currentPatch%patchno,currentPatch%area - arealayer(i),i,missing_area,count_mi endif if(promswitch == 1)then ! write(fates_log(),*) 'z loop',arealayer(1:3),currentPatch%patchno,z @@ -521,7 +521,7 @@ subroutine canopy_structure( currentSite ) endif endif enddo - currentPatch%ncl_p = min(z,cp_nclmax) + currentPatch%ncl_p = min(z,nclmax) if(promswitch == 1)then ! write(fates_log(),*) 'missingarea loop',arealayer(1:3),currentPatch%patchno,missing_area,z endif @@ -532,7 +532,7 @@ subroutine canopy_structure( currentSite ) call terminate_cohorts(currentPatch) if(promswitch == 1)then - !write(fates_log(),*) 'going into cohort check',currentPatch%clm_pno + !write(fates_log(),*) 'going into cohort check' endif ! ----------- Check cohort area ------------------------------! do i = 1,z @@ -602,7 +602,7 @@ subroutine canopy_spread( currentSite ) ! !LOCAL VARIABLES: type (ed_cohort_type), pointer :: currentCohort type (ed_patch_type) , pointer :: currentPatch - real(r8) :: arealayer(cp_nlevcan) ! Amount of canopy in each layer. + real(r8) :: arealayer(nlevcan) ! Amount of canopy in each layer. real(r8) :: inc ! Arbitrary daily incremental change in canopy area integer :: z !---------------------------------------------------------------------- @@ -625,7 +625,7 @@ subroutine canopy_spread( currentSite ) enddo !If the canopy area is approaching closure, squash the tree canopies and make them taller and thinner - do z = 1,cp_nclmax + do z = 1,nclmax if(arealayer(z)/currentPatch%area > 0.9_r8)then currentPatch%spread(z) = currentPatch%spread(z) - inc @@ -660,6 +660,7 @@ subroutine canopy_summarization( nsites, sites, bc_in ) use FatesInterfaceMod , only : bc_in_type use EDPatchDynamicsMod , only : set_patchno + use EDPatchDYnamicsMod , only : set_root_fraction use EDCohortDynamicsMod , only : size_and_type_class_index use EDGrowthFunctionsMod , only : tree_lai, c_area use EDEcophysConType , only : EDecophyscon @@ -699,7 +700,7 @@ subroutine canopy_summarization( nsites, sites, bc_in ) do while(associated(currentPatch)) - call currentPatch%set_root_fraction(bc_in(s)%depth_gl) + call set_root_fraction(currentPatch,bc_in(s)%depth_gl) !zero cohort-summed variables. currentPatch%total_canopy_area = 0.0_r8 @@ -849,7 +850,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) max(currentPatch%ncan(currentCohort%canopy_layer,currentCohort%pft),currentCohort%NV) currentPatch%lai = currentPatch%lai +currentCohort%lai - do L = 1,cp_nclmax-1 + do L = 1,nclmax-1 if(currentCohort%canopy_layer == L)then currentPatch%canopy_layer_lai(L) = currentPatch%canopy_layer_lai(L) + currentCohort%lai + & currentCohort%sai @@ -1102,10 +1103,10 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) /currentPatch%tlai_profile(L,ft,iv) enddo - currentPatch%tlai_profile(L,ft,currentPatch%nrad(L,ft)+1: cp_nlevcan) = 0._r8 - currentPatch%tsai_profile(L,ft,currentPatch%nrad(L,ft)+1: cp_nlevcan) = 0._r8 - currentPatch%elai_profile(L,ft,currentPatch%nrad(L,ft)+1: cp_nlevcan) = 0._r8 - currentPatch%esai_profile(L,ft,currentPatch%nrad(L,ft)+1: cp_nlevcan) = 0._r8 + currentPatch%tlai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan) = 0._r8 + currentPatch%tsai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan) = 0._r8 + currentPatch%elai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan) = 0._r8 + currentPatch%esai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan) = 0._r8 enddo enddo @@ -1163,7 +1164,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) do L = 1,currentPatch%NCL_p do ft = 1,numpft_ed if(currentPatch%present(L,FT) > 1)then - write(fates_log(), *) 'ED: present issue',currentPatch%clm_pno,L,ft,currentPatch%present(L,FT) + write(fates_log(), *) 'ED: present issue',L,ft,currentPatch%present(L,FT) currentPatch%present(L,ft) = 1 endif enddo @@ -1190,7 +1191,6 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) use EDTypesMod , only : ed_patch_type, ed_cohort_type, & ed_site_type, AREA use FatesInterfaceMod , only : bc_out_type - use ColumnType , only : col ! THIS MUST BE REMOVED WITH CLM_PNO ! ! !ARGUMENTS @@ -1214,8 +1214,6 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) do while(associated(currentPatch)) ifp = ifp+1 - currentPatch%clm_pno = ifp + col%patchi(c) ! THIS IS SLOWLY BEING REMOVED - if ( currentPatch%total_canopy_area-currentPatch%area > 0.000001_r8 ) then write(fates_log(),*) 'ED: canopy area bigger than area',currentPatch%total_canopy_area ,currentPatch%area currentPatch%total_canopy_area = currentPatch%area diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index b4b154731b..8a40de4db9 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -6,7 +6,7 @@ module EDCohortDynamicsMod ! !USES: use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log - use FatesGlobals , only : freq_day + use FatesInterfaceMod , only : hlm_freq_day use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : fates_unset_int use pftconMod , only : pftcon @@ -14,11 +14,12 @@ module EDCohortDynamicsMod use EDGrowthFunctionsMod , only : c_area, tree_lai use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : fusetol - use FatesGlobals , only : cp_nclmax - use EDtypesMod , only : ncwd - use FatesGlobals , only : maxCohortsPerPatch - use EDtypesMod , only : sclass_ed,nlevsclass_ed,AREA - use EDtypesMod , only : min_npm2, min_nppatch, min_n_safemath + use EDTypesMod , only : nclmax + use EDTypesMod , only : ncwd + use EDTypesMod , only : maxCohortsPerPatch + use EDTypesMod , only : sclass_ed,nlevsclass_ed,AREA + use EDTypesMod , only : min_npm2, min_nppatch + use EDTypesMod , only : min_n_safemath ! CIME globals use shr_log_mod , only : errMsg => shr_log_errMsg ! @@ -227,7 +228,7 @@ subroutine allocate_live_biomass(cc_p,mode) if(mode==1)then ! it will not be able to put out as many leaves as it had previous timestep currentcohort%npp_leaf = currentcohort%npp_leaf + & - max(0.0_r8,currentcohort%balive*leaf_frac - currentcohort%bl)/freq_day + max(0.0_r8,currentcohort%balive*leaf_frac - currentcohort%bl)/hlm_freq_day end if currentcohort%bl = currentcohort%balive*leaf_frac @@ -238,10 +239,10 @@ subroutine allocate_live_biomass(cc_p,mode) currentcohort%npp_froot = currentcohort%npp_froot + & max(0._r8,pftcon%froot_leaf(ft)*(currentcohort%balive+currentcohort%laimemory)*leaf_frac - currentcohort%br) / & - freq_day + hlm_freq_day currentcohort%npp_bsw = max(0._r8,EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(currentcohort%balive + & - currentcohort%laimemory)*leaf_frac - currentcohort%bsw)/freq_day + currentcohort%laimemory)*leaf_frac - currentcohort%bsw)/hlm_freq_day currentcohort%npp_bdead = currentCohort%dbdeaddt @@ -276,10 +277,10 @@ subroutine allocate_live_biomass(cc_p,mode) currentcohort%npp_froot = currentcohort%npp_froot + & max(0.0_r8,pftcon%froot_leaf(ft)*(ideal_balive + & - currentcohort%laimemory)*leaf_frac*ratio_balive-currentcohort%br)/freq_day + currentcohort%laimemory)*leaf_frac*ratio_balive-currentcohort%br)/hlm_freq_day currentcohort%npp_bsw = max(0.0_r8,EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(ideal_balive + & - currentcohort%laimemory)*leaf_frac*ratio_balive - currentcohort%bsw)/freq_day + currentcohort%laimemory)*leaf_frac*ratio_balive - currentcohort%bsw)/hlm_freq_day currentcohort%npp_bdead = currentCohort%dbdeaddt @@ -529,7 +530,7 @@ subroutine terminate_cohorts( patchptr ) endif ! In the third canopy layer - if (currentCohort%canopy_layer > cp_nclmax ) then + if (currentCohort%canopy_layer > nclmax ) then terminate = 1 if ( DEBUG ) then write(fates_log(),*) 'terminating cohorts 2', currentCohort%canopy_layer @@ -601,7 +602,7 @@ subroutine fuse_cohorts(patchptr) ! Join similar cohorts to reduce total number ! ! !USES: - use FatesGlobals , only : cp_nlevcan + use EDTypesMod , only : nlevcan ! ! !ARGUMENTS type (ed_patch_type), intent(inout), target :: patchptr @@ -753,7 +754,7 @@ subroutine fuse_cohorts(patchptr) currentCohort%npp_bseed = (currentCohort%n*currentCohort%npp_bseed + nextc%n*nextc%npp_bseed)/newn currentCohort%npp_store = (currentCohort%n*currentCohort%npp_store + nextc%n*nextc%npp_store)/newn - do i=1, cp_nlevcan + do i=1, nlevcan if (currentCohort%year_net_uptake(i) == 999._r8 .or. nextc%year_net_uptake(i) == 999._r8) then currentCohort%year_net_uptake(i) = min(nextc%year_net_uptake(i),currentCohort%year_net_uptake(i)) else diff --git a/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 b/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 index 12a46c79b1..cd330f1c8b 100755 --- a/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 @@ -6,11 +6,11 @@ module EDGrowthFunctionsMod ! At present, there is only a single allocation trajectory. ! ============================================================================ - use shr_kind_mod , only : r8 => shr_kind_r8 + use FatesConstantsMod, only : r8 => fates_r8 use FatesGlobals , only : fates_log use pftconMod , only : pftcon use EDEcophysContype , only : EDecophyscon - use EDTypesMod , only : ed_cohort_type, cp_nlevcan, dinc_ed + use EDTypesMod , only : ed_cohort_type, nlevcan, dinc_ed implicit none private @@ -159,10 +159,10 @@ real(r8) function tree_lai( cohort_in ) cohort_in%treelai = tree_lai ! here, if the LAI exceeeds the maximum size of the possible array, then we have no way of accomodating it - ! at the moments cp_nlevcan default is 40, which is very large, so exceeding this would clearly illustrate a + ! at the moments nlevcan default is 40, which is very large, so exceeding this would clearly illustrate a ! huge error - if(cohort_in%treelai > cp_nlevcan*dinc_ed)then - write(fates_log(),*) 'too much lai' , cohort_in%treelai , cohort_in%pft , cp_nlevcan * dinc_ed + if(cohort_in%treelai > nlevcan*dinc_ed)then + write(fates_log(),*) 'too much lai' , cohort_in%treelai , cohort_in%pft , nlevcan * dinc_ed endif return @@ -196,10 +196,10 @@ real(r8) function tree_sai( cohort_in ) cohort_in%treesai = tree_sai ! here, if the LAI exceeeds the maximum size of the possible array, then we have no way of accomodating it - ! at the moments cp_nlevcan default is 40, which is very large, so exceeding this would clearly illustrate a + ! at the moments nlevcan default is 40, which is very large, so exceeding this would clearly illustrate a ! huge error - if(cohort_in%treesai > cp_nlevcan*dinc_ed)then - write(fates_log(),*) 'too much sai' , cohort_in%treesai , cohort_in%pft , cp_nlevcan * dinc_ed + if(cohort_in%treesai > nlevcan*dinc_ed)then + write(fates_log(),*) 'too much sai' , cohort_in%treesai , cohort_in%pft , nlevcan * dinc_ed endif return diff --git a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 index 35bf4c3d61..34d22267ee 100755 --- a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 @@ -4,15 +4,19 @@ module EDPatchDynamicsMod ! Controls formation, creation, fusing and termination of patch level processes. ! ============================================================================ - use clm_varctl , only : iulog - use FatesGlobals , only : freq_day + use FatesGlobals , only : fates_log + use FatesInterfaceMod , only : hlm_freq_day use pftconMod , only : pftcon use EDCohortDynamicsMod , only : fuse_cohorts, sort_cohorts, insert_cohort use EDtypesMod , only : ncwd, n_dbh_bins, ntol, area, dbhmax - use FatesGlobals , only : numpft_ed - use FatesGlobals , only : maxPatchesPerSite + use EDTypesMod , only : numpft_ed + use EDTypesMod , only : maxPatchesPerSite use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type - use EDTypesMod , only : min_patch_area, cp_numlevgrnd, cp_numSWb + use EDTypesMod , only : min_patch_area + use EDTypesMod , only : nclmax + use FatesInterfaceMod , only : hlm_numlevgrnd + use FatesInterfaceMod , only : hlm_numlevsoil + use FatesInterfaceMod , only : hlm_numSWb use FatesGlobals , only : endrun => fates_endrun use FatesConstantsMod , only : r8 => fates_r8 @@ -32,6 +36,7 @@ module EDPatchDynamicsMod public :: disturbance_rates public :: check_patch_area public :: set_patchno + public :: set_root_fraction private:: fuse_2_patches @@ -91,7 +96,7 @@ subroutine disturbance_rates( site_in) if(currentCohort%canopy_layer == 1)then currentPatch%disturbance_rates(1) = currentPatch%disturbance_rates(1) + & - min(1.0_r8,currentCohort%dmort)*freq_day*currentCohort%c_area/currentPatch%area + min(1.0_r8,currentCohort%dmort)*hlm_freq_day*currentCohort%c_area/currentPatch%area endif @@ -105,7 +110,7 @@ subroutine disturbance_rates( site_in) currentPatch%disturbance_rates(2) = min(0.99_r8,currentPatch%disturbance_rates(2) + currentPatch%frac_burnt) if (currentPatch%disturbance_rates(2) > 0.98_r8)then - write(iulog,*) 'very high fire areas',currentPatch%disturbance_rates(2),currentPatch%frac_burnt + write(fates_log(),*) 'very high fire areas',currentPatch%disturbance_rates(2),currentPatch%frac_burnt endif !Only use larger of two natural disturbance modes WHY? @@ -174,7 +179,7 @@ subroutine spawn_patches( currentSite ) ! 10) Area checked, and patchno recalculated. ! ! !USES: - use FatesGlobals , only : cp_nclmax + use EDParamsMod , only : ED_val_maxspread, ED_val_understorey_death use EDCohortDynamicsMod , only : zero_cohort, copy_cohort, terminate_cohorts ! @@ -197,7 +202,7 @@ subroutine spawn_patches( currentSite ) real(r8) :: leaf_litter_local(numpft_ed) ! 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) :: spread_local(cp_nclmax) ! initial value of canopy spread parameter.no units + real(r8) :: spread_local(nclmax) ! initial value of canopy spread parameter.no units !--------------------------------------------------------------------- storesmallcohort => null() ! storage of the smallest cohort for insertion routine @@ -225,7 +230,7 @@ subroutine spawn_patches( currentSite ) cwd_bg_local = 0.0_r8 leaf_litter_local = 0.0_r8 root_litter_local = 0.0_r8 - spread_local(1:cp_nclmax) = ED_val_maxspread + spread_local(1:nclmax) = ED_val_maxspread age = 0.0_r8 allocate(new_patch) @@ -277,7 +282,7 @@ subroutine spawn_patches( currentSite ) ! because this is the part of the original patch where no trees have actually fallen ! The diagnostic cmort,bmort and hmort rates have already been saved - currentCohort%n = currentCohort%n * (1.0_r8 - min(1.0_r8,currentCohort%dmort * freq_day)) + currentCohort%n = currentCohort%n * (1.0_r8 - min(1.0_r8,currentCohort%dmort * hlm_freq_day)) nc%n = 0.0_r8 ! kill all of the trees who caused the disturbance. nc%cmort = nan ! The mortality diagnostics are set to nan because the cohort should dissappear @@ -304,7 +309,7 @@ subroutine spawn_patches( currentSite ) ! so with the number density must come the effective mortality rates. nc%fmort = 0.0_r8 ! Should had also been zero in the donor - nc%imort = ED_val_understorey_death/freq_day ! This was zero in the donor + nc%imort = ED_val_understorey_death/hlm_freq_day ! This was zero in the donor nc%cmort = currentCohort%cmort nc%hmort = currentCohort%hmort nc%bmort = currentCohort%bmort @@ -342,7 +347,7 @@ subroutine spawn_patches( currentSite ) ! loss of individual from fire in new patch. nc%n = nc%n * (1.0_r8 - currentCohort%fire_mort) - nc%fmort = currentCohort%fire_mort/freq_day + nc%fmort = currentCohort%fire_mort/hlm_freq_day nc%imort = 0.0_r8 nc%cmort = currentCohort%cmort nc%hmort = currentCohort%hmort @@ -439,7 +444,7 @@ subroutine check_patch_area( currentSite ) areatot = areatot + currentPatch%area currentPatch => currentPatch%younger if (( areatot - area ) > 0._r8 ) then - write(iulog,*) 'trimming patch area - is too big' , areatot-area + write(fates_log(),*) 'trimming patch area - is too big' , areatot-area currentSite%oldest_patch%area = currentSite%oldest_patch%area - (areatot - area) endif enddo @@ -722,7 +727,7 @@ subroutine mortality_litter_fluxes(cp_target, new_patch_target, patch_site_aread !currentCohort%dmort = mortality_rates(currentCohort) !the disturbance calculations are done with the previous n, c_area and d_mort. So it's probably & !not right to recalcualte dmort here. - canopy_dead = currentCohort%n * min(1.0_r8,currentCohort%dmort * freq_day) + canopy_dead = currentCohort%n * min(1.0_r8,currentCohort%dmort * hlm_freq_day) currentPatch%canopy_mortality_woody_litter = currentPatch%canopy_mortality_woody_litter + & canopy_dead*(currentCohort%bdead+currentCohort%bsw) @@ -814,16 +819,16 @@ subroutine create_patch(currentSite, new_patch, age, areap, spread_local,cwd_ag_ ! !LOCAL VARIABLES: !--------------------------------------------------------------------- - allocate(new_patch%tr_soil_dir(cp_numSWb)) - allocate(new_patch%tr_soil_dif(cp_numSWb)) - allocate(new_patch%tr_soil_dir_dif(cp_numSWb)) - allocate(new_patch%fab(cp_numSWb)) - allocate(new_patch%fabd(cp_numSWb)) - allocate(new_patch%fabi(cp_numSWb)) - allocate(new_patch%sabs_dir(cp_numSWb)) - allocate(new_patch%sabs_dif(cp_numSWb)) - allocate(new_patch%rootfr_ft(numpft_ed,cp_numlevgrnd)) - allocate(new_patch%rootr_ft(numpft_ed,cp_numlevgrnd)) + allocate(new_patch%tr_soil_dir(hlm_numSWb)) + allocate(new_patch%tr_soil_dif(hlm_numSWb)) + allocate(new_patch%tr_soil_dir_dif(hlm_numSWb)) + allocate(new_patch%fab(hlm_numSWb)) + allocate(new_patch%fabd(hlm_numSWb)) + allocate(new_patch%fabi(hlm_numSWb)) + allocate(new_patch%sabs_dir(hlm_numSWb)) + allocate(new_patch%sabs_dif(hlm_numSWb)) + allocate(new_patch%rootfr_ft(numpft_ed,hlm_numlevgrnd)) + allocate(new_patch%rootr_ft(numpft_ed,hlm_numlevgrnd)) call zero_patch(new_patch) !The nan value in here is not working?? @@ -901,7 +906,6 @@ subroutine zero_patch(cp_p) currentPatch%siteptr => null() currentPatch%patchno = 999 - currentPatch%clm_pno = 999 currentPatch%age = nan currentPatch%area = nan @@ -1063,7 +1067,7 @@ subroutine fuse_patches( csite ) do while(associated(tpp)) if(.not.associated(currentPatch))then - write(iulog,*) 'ED: issue with currentPatch' + write(fates_log(),*) 'ED: issue with currentPatch' endif if(associated(tpp).and.associated(currentPatch))then @@ -1105,7 +1109,7 @@ subroutine fuse_patches( csite ) call sort_cohorts(tpp) currentPatch => tmpptr else - ! write(iulog,*) 'patches not fused' + ! write(fates_log(),*) 'patches not fused' endif endif !are both patches associated? endif !are these different patches? @@ -1339,15 +1343,17 @@ subroutine terminate_patches(cs_pnt) ! Do not force the fusion of the youngest patch to its neighbour. ! This is only really meant for very old patches. if(associated(currentPatch%older) )then - write(iulog,*) 'fusing to older patch because this one is too small',currentPatch%area, currentPatch%lai, & + write(fates_log(),*) 'fusing to older patch because this one is too small',& + currentPatch%area, currentPatch%lai, & currentPatch%older%area,currentPatch%older%lai call fuse_2_patches(currentPatch%older, currentPatch) - write(iulog,*) 'after fusion to older patch',currentPatch%area + write(fates_log(),*) 'after fusion to older patch',currentPatch%area else - write(iulog,*) 'fusing to younger patch because oldest one is too small',currentPatch%area, currentPatch%lai + write(fates_log(),*) 'fusing to younger patch because oldest one is too small',& + currentPatch%area, currentPatch%lai tmpptr => currentPatch%younger call fuse_2_patches(currentPatch, currentPatch%younger) - write(iulog,*) 'after fusion to younger patch' + write(fates_log(),*) 'after fusion to younger patch' currentPatch => tmpptr endif endif @@ -1364,7 +1370,7 @@ subroutine terminate_patches(cs_pnt) areatot = areatot + currentPatch%area currentPatch => currentPatch%younger if((areatot-area) > 0.0000001_r8)then - write(iulog,*) 'ED: areatot too large. end terminate', areatot + write(fates_log(),*) 'ED: areatot too large. end terminate', areatot endif enddo @@ -1460,7 +1466,8 @@ subroutine patch_pft_size_profile(cp_pnt) do j = 1,N_DBH_BINS if((currentCohort%dbh > mind(j)) .AND. (currentCohort%dbh <= maxd(j)))then - currentPatch%pft_agb_profile(currentCohort%pft,j) = currentPatch%pft_agb_profile(currentCohort%pft,j) + & + currentPatch%pft_agb_profile(currentCohort%pft,j) = & + currentPatch%pft_agb_profile(currentCohort%pft,j) + & currentCohort%bdead*currentCohort%n/currentPatch%area endif @@ -1472,7 +1479,7 @@ subroutine patch_pft_size_profile(cp_pnt) end subroutine patch_pft_size_profile - ! ============================================================================ + ! ===================================================================================== function countPatches( bounds, nsites, sites ) result ( totNumPatches ) ! ! !DESCRIPTION: @@ -1505,4 +1512,39 @@ function countPatches( bounds, nsites, sites ) result ( totNumPatches ) end function countPatches + ! ==================================================================================== + + subroutine set_root_fraction( cpatch , depth_gl ) + ! + ! !DESCRIPTION: + ! Calculates the fractions of the root biomass in each layer for each pft. + ! + ! !USES: + use pftconMod , only : pftcon + ! + ! !ARGUMENTS + type(ed_patch_type),intent(inout), target :: cpatch + real(r8),intent(in) :: depth_gl(0:hlm_numlevgrnd) + ! + ! !LOCAL VARIABLES: + integer :: lev,p,c,ft + !---------------------------------------------------------------------- + + do ft = 1,numpft_ed + do lev = 1, hlm_numlevgrnd + cpatch%rootfr_ft(ft,lev) = 0._r8 + enddo + + do lev = 1, hlm_numlevsoil-1 + cpatch%rootfr_ft(ft,lev) = .5_r8*( & + exp(-pftcon%roota_par(ft) * depth_gl(lev-1)) & + + exp(-pftcon%rootb_par(ft) * depth_gl(lev-1)) & + - exp(-pftcon%roota_par(ft) * depth_gl(lev)) & + - exp(-pftcon%rootb_par(ft) * depth_gl(lev))) + end do + end do + + end subroutine set_root_fraction + + end module EDPatchDynamicsMod diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index d07dc7d5cb..91ca9fe836 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -7,18 +7,23 @@ module EDPhysiologyMod ! ============================================================================ use FatesGlobals, only : fates_log - use FatesGlobals, only : days_per_year - use FatesGlobals, only : model_day - use FatesGlobals, only : freq_day - use FatesGlobals, only : day_of_year + use FatesInterfaceMod, only : hlm_days_per_year + use FatesInterfaceMod, only : hlm_model_day + use FatesInterfaceMod, only : hlm_freq_day + use FatesInterfaceMod, only : hlm_day_of_year use FatesConstantsMod, only : r8 => fates_r8 - use pftconMod , only : pftcon - use EDEcophysContype , only : EDecophyscon + use pftconMod , only : pftcon + use EDEcophysContype , only : EDecophyscon use FatesInterfaceMod, only : bc_in_type use EDCohortDynamicsMod , only : allocate_live_biomass, zero_cohort use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts - use EDTypesMod , only : dg_sf, dinc_ed, external_recruitment - use EDTypesMod , only : ncwd, cp_nlevcan, numpft_ed, senes + use EDTypesMod , only : numWaterMem + use EDTypesMod , only : dg_sf, dinc_ed + use EDTypesMod , only : external_recruitment + use EDTypesMod , only : ncwd + use EDTypesMod , only : nlevcan + use EDTypesMod , only : numpft_ed + use EDTypesMod , only : senes use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type implicit none @@ -172,13 +177,13 @@ subroutine trim_canopy( currentSite ) trimmed = 0 currentCohort%treelai = tree_lai(currentCohort) currentCohort%nv = ceiling((currentCohort%treelai+currentCohort%treesai)/dinc_ed) - if (currentCohort%nv > cp_nlevcan)then - write(fates_log(),*) 'nv > cp_nlevcan',currentCohort%nv,currentCohort%treelai,currentCohort%treesai, & + if (currentCohort%nv > nlevcan)then + write(fates_log(),*) 'nv > nlevcan',currentCohort%nv,currentCohort%treelai,currentCohort%treesai, & currentCohort%c_area,currentCohort%n,currentCohort%bl endif !Leaf cost vs netuptake for each leaf layer. - do z = 1,cp_nlevcan + do z = 1,nlevcan if (currentCohort%year_net_uptake(z) /= 999._r8)then !there was activity this year in this leaf layer. !Leaf Cost kgC/m2/year-1 !decidous costs. @@ -292,7 +297,7 @@ subroutine phenology( currentSite, bc_in ) ncolddayslim = 5 cold_t = 7.5_r8 ! ed_ph_coldtemp - t = day_of_year + t = hlm_day_of_year temp_in_C = bc_in%t_veg24_si - tfrz !-----------------Cold Phenology--------------------! @@ -342,7 +347,7 @@ subroutine phenology( currentSite, bc_in ) endif - timesinceleafoff = model_day - currentSite%leafoffdate + timesinceleafoff = hlm_model_day - currentSite%leafoffdate !LEAF ON: COLD DECIDUOUS. Needs to !1) have exceeded the growing degree day threshold !2) The leaves should not be on already @@ -358,7 +363,7 @@ subroutine phenology( currentSite, bc_in ) endif !status endif !GDD - timesinceleafon = model_day - currentSite%leafondate + timesinceleafon = hlm_model_day - currentSite%leafondate !LEAF OFF: COLD THRESHOLD @@ -372,7 +377,7 @@ subroutine phenology( currentSite, bc_in ) if (timesinceleafon > mindayson)then if (currentSite%status == 2)then currentSite%status = 1 !alter status of site to 'leaves on' - currentSite%leafoffdate = model_day !record leaf off date + currentSite%leafoffdate = hlm_model_day !record leaf off date if ( DEBUG ) write(fates_log(),*) 'leaves off' endif endif @@ -382,7 +387,7 @@ subroutine phenology( currentSite, bc_in ) if(timesinceleafoff > 400)then !remove leaves after a whole year when there is no 'off' period. if(currentSite%status == 2)then currentSite%status = 1 !alter status of site to 'leaves on' - currentSite%leafoffdate = model_day !record leaf off date + currentSite%leafoffdate = hlm_model_day !record leaf off date if ( DEBUG ) write(fates_log(),*) 'leaves off' endif endif @@ -416,8 +421,8 @@ subroutine phenology( currentSite, bc_in ) !Accumulate surface water memory of last 10 days. currentSite%water_memory(1) = bc_in%h2osoi_vol_si !waterstate_inst%h2osoi_vol_col(coli,1) - do i = 1,9 !shift memory along one - currentSite%water_memory(11-i) = currentSite%water_memory(10-i) + do i = 1,numWaterMem !shift memory along one + currentSite%water_memory(numWaterMem+1-i) = currentSite%water_memory(numWaterMem-i) enddo !In drought phenology, we often need to force the leaves to stay on or off as moisture fluctuates... @@ -446,7 +451,9 @@ subroutine phenology( currentSite, bc_in ) !Here, we used a window of oppurtunity to determine if we are close to the time when then leaves came on last year if ((t >= currentSite%dleafondate - 30.and.t <= currentSite%dleafondate + 30).or.(t > 360 - 15.and. & currentSite%dleafondate < 15))then ! are we in the window? - if (sum(currentSite%water_memory(1:10)/10._r8) >= drought_threshold.and.currentSite%dstatus == 1.and.t >= 10)then + ! TODO: CHANGE THIS MATH, MOVE THE DENOMENATOR OUTSIDE OF THE SUM (rgk 01-2017) + if (sum(currentSite%water_memory(1:numWaterMem)/dble(numWaterMem)) & + >= 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 > off_time)then currentSite%dstatus = 2 !alter status of site to 'leaves on' @@ -638,7 +645,7 @@ subroutine seeds_in( currentSite, cp_pnt ) currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) - if (EXTERNAL_RECRUITMENT == 1) then !external seed rain - needed to prevent extinction + if (external_recruitment == 1) then !external seed rain - needed to prevent extinction do p = 1,numpft_ed currentPatch%seeds_in(p) = currentPatch%seeds_in(p) + & EDecophyscon%seed_rain(p) !KgC/m2/year @@ -767,9 +774,9 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! convert from kgC/indiv/day into kgC/indiv/year ! TODO: CONVERT DAYS_PER_YEAR TO DBLE (HOLDING FOR B4B COMPARISONS, RGK-01-2017) - currentCohort%npp_acc_hold = currentCohort%npp_acc * days_per_year - currentCohort%gpp_acc_hold = currentCohort%gpp_acc * days_per_year - currentCohort%resp_acc_hold = currentCohort%resp_acc * days_per_year + currentCohort%npp_acc_hold = currentCohort%npp_acc * hlm_days_per_year + currentCohort%gpp_acc_hold = currentCohort%gpp_acc * hlm_days_per_year + currentCohort%resp_acc_hold = currentCohort%resp_acc * hlm_days_per_year currentSite%flux_in = currentSite%flux_in + currentCohort%npp_acc * currentCohort%n @@ -936,7 +943,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! prevent negative leaf pool (but not negative store pool). This is also a numerical error prevention, ! but it shouldn't happen actually... - if (-1.0_r8*currentCohort%dbalivedt * freq_day > currentCohort%balive*0.99)then + if (-1.0_r8*currentCohort%dbalivedt * hlm_freq_day > currentCohort%balive*0.99)then write(fates_log(),*) 'using non-neg leaf mass cap',currentCohort%balive , currentCohort%dbalivedt,currentCohort%dbstoredt, & currentCohort%carbon_balance currentCohort%dbstoredt = currentCohort%dbstoredt + currentCohort%dbalivedt @@ -992,7 +999,7 @@ subroutine recruitment( t, currentSite, currentPatch ) + EDecophyscon%sapwood_ratio(ft)*temp_cohort%hite) temp_cohort%bstore = EDecophyscon%cushion(ft)*(temp_cohort%balive/ (1.0_r8 + pftcon%froot_leaf(ft) & + EDecophyscon%sapwood_ratio(ft)*temp_cohort%hite)) - temp_cohort%n = currentPatch%area * currentPatch%seed_germination(ft)*freq_day & + temp_cohort%n = currentPatch%area * currentPatch%seed_germination(ft)*hlm_freq_day & / (temp_cohort%bdead+temp_cohort%balive+temp_cohort%bstore) if (t == 1)then @@ -1069,7 +1076,7 @@ subroutine CWD_Input( currentPatch) currentPatch%root_litter_in(pft) = currentPatch%root_litter_in(pft) + & currentCohort%root_md * currentCohort%n/currentPatch%area !turnover currentPatch%leaf_litter_in(pft) = currentPatch%leaf_litter_in(pft) + & - currentCohort%leaf_litter * currentCohort%n/currentPatch%area/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. @@ -1088,7 +1095,7 @@ subroutine CWD_Input( currentPatch) dead_n = -1.0_r8 * currentCohort%dndt / currentPatch%area currentPatch%leaf_litter_in(pft) = currentPatch%leaf_litter_in(pft) + & - (currentCohort%bl+currentCohort%leaf_litter/freq_day)* dead_n + (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 @@ -1241,13 +1248,13 @@ subroutine cwd_out( currentSite, currentPatch, bc_in ) !add up carbon going into fragmenting pools currentSite%flux_out = currentSite%flux_out + sum(currentPatch%leaf_litter_out) * & - currentPatch%area *freq_day!kgC/site/day + currentPatch%area *hlm_freq_day!kgC/site/day currentSite%flux_out = currentSite%flux_out + sum(currentPatch%root_litter_out) * & - currentPatch%area *freq_day!kgC/site/day + currentPatch%area *hlm_freq_day!kgC/site/day currentSite%flux_out = currentSite%flux_out + sum(currentPatch%cwd_ag_out) * & - currentPatch%area *freq_day!kgC/site/day + currentPatch%area *hlm_freq_day!kgC/site/day currentSite%flux_out = currentSite%flux_out + sum(currentPatch%cwd_bg_out) * & - currentPatch%area *freq_day!kgC/site/day + currentPatch%area *hlm_freq_day!kgC/site/day end subroutine cwd_out @@ -1270,11 +1277,11 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! This means that the state update for the litter pools and for the CWD pools occurs at different timescales. - use EDTypesMod, only : AREA, numpft_ed, cp_numlevdecomp_full, cp_numlevdecomp + use EDTypesMod, only : AREA + use EDTypesMod, only : numpft_ed + use FatesInterfaceMod, only : hlm_numlevdecomp_full + use FatesInterfaceMod, only : hlm_numlevdecomp use SoilBiogeochemVerticalProfileMod, only: surfprof_exp - - !use EDCLMLinkMod, only: cwd_fcel_ed, cwd_flig - use pftconMod, only : pftcon use FatesConstantsMod, only : sec_per_day use clm_varcon, only : zisoi, dzsoi_decomp, zsoi @@ -1305,9 +1312,9 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) integer :: begp,endp integer :: begc,endc !bounds !------------------------------------------------------------------------ - real(r8) :: cinput_rootfr(1:numpft_ed, 1:cp_numlevdecomp_full) ! column by pft root fraction used for calculating inputs - real(r8) :: croot_prof_perpatch(1:cp_numlevdecomp_full) - real(r8) :: surface_prof(1:cp_numlevdecomp_full) + real(r8) :: cinput_rootfr(1:numpft_ed, 1:hlm_numlevdecomp_full) ! column by pft root fraction used for calculating inputs + real(r8) :: croot_prof_perpatch(1:hlm_numlevdecomp_full) + real(r8) :: surface_prof(1:hlm_numlevdecomp_full) integer :: ft real(r8) :: rootfr_tot(1:numpft_ed), biomass_bg_ft(1:numpft_ed) real(r8) :: surface_prof_tot, leaf_prof_sum, stem_prof_sum, froot_prof_sum, biomass_bg_tot @@ -1331,10 +1338,10 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! Doing so will be answer changing though so perhaps easiest to do this in steps. integer, parameter :: rooting_profile_varindex_water = 1 - real(r8) :: leaf_prof(1:nsites, 1:cp_numlevdecomp) - real(r8) :: froot_prof(1:nsites, 1:numpft_ed, 1:cp_numlevdecomp) - real(r8) :: croot_prof(1:nsites, 1:cp_numlevdecomp) - real(r8) :: stem_prof(1:nsites, 1:cp_numlevdecomp) + real(r8) :: leaf_prof(1:nsites, 1:hlm_numlevdecomp) + real(r8) :: froot_prof(1:nsites, 1:numpft_ed, 1:hlm_numlevdecomp) + real(r8) :: croot_prof(1:nsites, 1:hlm_numlevdecomp) + real(r8) :: stem_prof(1:nsites, 1:hlm_numlevdecomp) ! INTERF-TODO: THESE PARAMETERS WERE ORIGINALLY SET BY params_inst% ! THEY NEED THEIR OWN ENTRIES IN THE PARAMETER FILE (RGK) @@ -1364,7 +1371,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! define a single shallow surface profile for surface additions (leaves, stems, and N deposition) surface_prof(:) = 0._r8 - do j = 1, cp_numlevdecomp + do j = 1, hlm_numlevdecomp surface_prof(j) = exp(-surfprof_exp * zsoi(j)) / dzsoi_decomp(j) end do @@ -1381,14 +1388,14 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) if ( .not. pftspecific_rootingprofile ) then ! define rooting profile from exponential parameters do ft = 1, numpft_ed - do j = 1, cp_numlevdecomp + do j = 1, hlm_numlevdecomp cinput_rootfr(ft,j) = exp(-rootprof_exp * zsoi(j)) / dzsoi_decomp(j) end do end do else ! use beta distribution parameter from Jackson et al., 1996 do ft = 1, numpft_ed - do j = 1, cp_numlevdecomp + do j = 1, hlm_numlevdecomp cinput_rootfr(ft,j) = ( pftcon%rootprof_beta(ft, rooting_profile_varindex_water) ** (zisoi(j-1)*100._r8) - & pftcon%rootprof_beta(ft, rooting_profile_varindex_water) ** (zisoi(j)*100._r8) ) & / dzsoi_decomp(j) @@ -1397,7 +1404,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) endif else do ft = 1,numpft_ed - do j = 1, cp_numlevdecomp + do j = 1, hlm_numlevdecomp ! use standard CLM root fraction profiles; cinput_rootfr(ft,j) = ( .5_r8*( & exp(-pftcon%roota_par(ft) * zisoi(j-1)) & @@ -1418,11 +1425,11 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) end do surface_prof_tot = 0._r8 ! - do j = 1, min(max(bc_in(s)%max_rooting_depth_index_col, 1), cp_numlevdecomp) + do j = 1, min(max(bc_in(s)%max_rooting_depth_index_col, 1), hlm_numlevdecomp) surface_prof_tot = surface_prof_tot + surface_prof(j) * dzsoi_decomp(j) end do do ft = 1,numpft_ed - do j = 1, min(max(bc_in(s)%max_rooting_depth_index_col, 1), cp_numlevdecomp) + do j = 1, min(max(bc_in(s)%max_rooting_depth_index_col, 1), hlm_numlevdecomp) rootfr_tot(ft) = rootfr_tot(ft) + cinput_rootfr(ft,j) * dzsoi_decomp(j) end do end do @@ -1432,7 +1439,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) if ( (bc_in(s)%max_rooting_depth_index_col > 0) .and. (rootfr_tot(ft) > 0._r8) ) then ! where there is not permafrost extending to the surface, integrate the profiles over the active layer ! this is equivalent to integrating over all soil layers outside of permafrost regions - do j = 1, min(max(bc_in(s)%max_rooting_depth_index_col, 1), cp_numlevdecomp) + do j = 1, min(max(bc_in(s)%max_rooting_depth_index_col, 1), hlm_numlevdecomp) froot_prof(s,ft,j) = cinput_rootfr(ft,j) / rootfr_tot(ft) end do else @@ -1445,7 +1452,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) if ( (bc_in(s)%max_rooting_depth_index_col > 0) .and. (surface_prof_tot > 0._r8) ) then ! where there is not permafrost extending to the surface, integrate the profiles over the active layer ! this is equivalent to integrating over all soil layers outside of permafrost regions - do j = 1, min(max(bc_in(s)%max_rooting_depth_index_col, 1), cp_numlevdecomp) + do j = 1, min(max(bc_in(s)%max_rooting_depth_index_col, 1), hlm_numlevdecomp) ! set all surface processes to shallower profile leaf_prof(s,j) = surface_prof(j)/ surface_prof_tot stem_prof(s,j) = surface_prof(j)/ surface_prof_tot @@ -1454,7 +1461,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! if fully frozen, or no roots, put everything in the top layer leaf_prof(s,1) = 1._r8/dzsoi_decomp(1) stem_prof(s,1) = 1._r8/dzsoi_decomp(1) - do j = 2, cp_numlevdecomp + do j = 2, hlm_numlevdecomp leaf_prof(s,j) = 0._r8 stem_prof(s,j) = 0._r8 end do @@ -1475,7 +1482,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! check the leaf and stem profiles leaf_prof_sum = 0._r8 stem_prof_sum = 0._r8 - do j = 1, cp_numlevdecomp + do j = 1, hlm_numlevdecomp leaf_prof_sum = leaf_prof_sum + leaf_prof(s,j) * dzsoi_decomp(j) stem_prof_sum = stem_prof_sum + stem_prof(s,j) * dzsoi_decomp(j) end do @@ -1492,7 +1499,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! now check each fine root profile do ft = 1,numpft_ed froot_prof_sum = 0._r8 - do j = 1, cp_numlevdecomp + do j = 1, hlm_numlevdecomp froot_prof_sum = froot_prof_sum + froot_prof(s,ft,j) * dzsoi_decomp(j) end do if ( ( abs(froot_prof_sum - 1._r8) > delta ) ) then @@ -1504,7 +1511,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! zero the site-level C input variables do s = 1, nsites - do j = 1, cp_numlevdecomp + do j = 1, hlm_numlevdecomp bc_out(s)%FATES_c_to_litr_lab_c_col(j) = 0._r8 bc_out(s)%FATES_c_to_litr_cel_c_col(j) = 0._r8 bc_out(s)%FATES_c_to_litr_lig_c_col(j) = 0._r8 @@ -1540,14 +1547,14 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) biomass_bg_tot = biomass_bg_tot + biomass_bg_ft(ft) end do ! - do j = 1, cp_numlevdecomp + do j = 1, hlm_numlevdecomp ! zero this for each patch croot_prof_perpatch(j) = 0._r8 end do ! if ( biomass_bg_tot .gt. 0._r8) then do ft = 1,numpft_ed - do j = 1, cp_numlevdecomp + do j = 1, hlm_numlevdecomp croot_prof_perpatch(j) = croot_prof_perpatch(j) + froot_prof(s,ft,j) * biomass_bg_ft(ft) / biomass_bg_tot end do end do @@ -1557,7 +1564,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! ! add croot_prof as weighted average (weighted by patch area) of croot_prof_perpatch - do j = 1, cp_numlevdecomp + do j = 1, hlm_numlevdecomp croot_prof(s, j) = croot_prof(s, j) + croot_prof_perpatch(j) * currentPatch%area / AREA end do ! @@ -1574,7 +1581,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! ! ! CWD pools fragmenting into decomposing litter pools. do ci = 1, ncwd - do j = 1, cp_numlevdecomp + do j = 1, hlm_numlevdecomp bc_out(s)%FATES_c_to_litr_cel_c_col(j) = bc_out(s)%FATES_c_to_litr_cel_c_col(j) + & currentpatch%CWD_AG_out(ci) * cwd_fcel * currentpatch%area/AREA * stem_prof(s,j) bc_out(s)%FATES_c_to_litr_lig_c_col(j) = bc_out(s)%FATES_c_to_litr_lig_c_col(j) + & @@ -1589,7 +1596,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! leaf and fine root pools. do ft = 1,numpft_ed - do j = 1, cp_numlevdecomp + do j = 1, hlm_numlevdecomp bc_out(s)%FATES_c_to_litr_lab_c_col(j) = bc_out(s)%FATES_c_to_litr_lab_c_col(j) + & currentpatch%leaf_litter_out(ft) * pftcon%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(s,j) bc_out(s)%FATES_c_to_litr_cel_c_col(j) = bc_out(s)%FATES_c_to_litr_cel_c_col(j) + & @@ -1621,19 +1628,18 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) end do ! do sites(s) do s = 1, nsites - do j = 1, cp_numlevdecomp + do j = 1, hlm_numlevdecomp ! time unit conversion bc_out(s)%FATES_c_to_litr_lab_c_col(j)=bc_out(s)%FATES_c_to_litr_lab_c_col(j) * mass_convert / time_convert bc_out(s)%FATES_c_to_litr_cel_c_col(j)=bc_out(s)%FATES_c_to_litr_cel_c_col(j) * mass_convert / time_convert bc_out(s)%FATES_c_to_litr_lig_c_col(j)=bc_out(s)%FATES_c_to_litr_lig_c_col(j) * mass_convert / time_convert - end do end do ! write(fates_log(),*)'cdk FATES_c_to_litr_lab_c: ', FATES_c_to_litr_lab_c ! write_col(fates_log(),*)'cdk FATES_c_to_litr_cel_c: ', FATES_c_to_litr_cel_c ! write_col(fates_log(),*)'cdk FATES_c_to_litr_lig_c: ', FATES_c_to_litr_lig_c - ! write_col(fates_log(),*)'cdk cp_numlevdecomp_full, bounds%begc, bounds%endc: ', cp_numlevdecomp_full, bounds%begc, bounds%endc + ! write_col(fates_log(),*)'cdk hlm_numlevdecomp_full, bounds%begc, bounds%endc: ', hlm_numlevdecomp_full, bounds%begc, bounds%endc ! write(fates_log(),*)'cdk leaf_prof: ', leaf_prof ! write(fates_log(),*)'cdk stem_prof: ', stem_prof ! write(fates_log(),*)'cdk froot_prof: ', froot_prof diff --git a/components/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 b/components/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 index 78563a3a2d..a63608ad82 100644 --- a/components/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 +++ b/components/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 @@ -28,8 +28,8 @@ subroutine AccumulateFluxes_ED(nsites, sites, bc_in, bc_out, dt_time) ! see above ! ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 - use clm_varctl , only : iulog + use FatesConstantsMod , only : r8 => fates_r8 + use FatesGlobals , only : fates_log use EDTypesMod , only : ed_patch_type, ed_cohort_type, & ed_site_type, AREA use FatesInterfaceMod , only : bc_in_type,bc_out_type @@ -67,10 +67,10 @@ subroutine AccumulateFluxes_ED(nsites, sites, bc_in, bc_out, dt_time) ! _tstep fluxes are KgC/indiv/timestep _acc are KgC/indiv/day if ( DEBUG ) then - write(iulog,*) 'EDAccumFlux 64 ',ccohort%npp_acc, & + write(fates_log(),*) 'EDAccumFlux 64 ',ccohort%npp_acc, & ccohort%npp_tstep - write(iulog,*) 'EDAccumFlux 66 ',ccohort%gpp_tstep - write(iulog,*) 'EDAccumFlux 67 ',ccohort%resp_tstep + write(fates_log(),*) 'EDAccumFlux 66 ',ccohort%gpp_tstep + write(fates_log(),*) 'EDAccumFlux 67 ',ccohort%resp_tstep endif ccohort%npp_acc = ccohort%npp_acc + ccohort%npp_tstep diff --git a/components/clm/src/ED/biogeophys/EDBtranMod.F90 b/components/clm/src/ED/biogeophys/EDBtranMod.F90 index 8ac4a51b36..efcd2098bb 100644 --- a/components/clm/src/ED/biogeophys/EDBtranMod.F90 +++ b/components/clm/src/ED/biogeophys/EDBtranMod.F90 @@ -6,16 +6,16 @@ module EDBtranMod ! ------------------------------------------------------------------------------------ use pftconMod , only : pftcon - use clm_varcon , only : tfrz + use FatesConstantsMod , only : tfrz => t_water_freeze_k_1atm use EDTypesMod , only : ed_site_type, & ed_patch_type, & ed_cohort_type, & - numpft_ed, & - cp_numlevgrnd + numpft_ed + use FatesInterfaceMod , only : hlm_numlevgrnd use shr_kind_mod , only : r8 => shr_kind_r8 use FatesInterfaceMod , only : bc_in_type, & bc_out_type - use clm_varctl , only : iulog !INTERF-TODO: THIS SHOULD BE MOVED + use FatesGlobals , only : fates_log ! implicit none @@ -63,7 +63,7 @@ subroutine get_active_suction_layers(nsites, sites, bc_in, bc_out) do s = 1,nsites if (bc_in(s)%filter_btran) then - do j = 1,cp_numlevgrnd + do j = 1,hlm_numlevgrnd bc_out(s)%active_suction_gl(j) = check_layer_water( bc_in(s)%h2o_liqvol_gl(j),bc_in(s)%tempk_gl(j) ) end do else @@ -128,7 +128,7 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) do ft = 1,numpft_ed cpatch%btran_ft(ft) = 0.0_r8 - do j = 1,cp_numlevgrnd + do j = 1,hlm_numlevgrnd ! Calculations are only relevant where liquid water exists ! see clm_fates%wrap_btran for calculation with CLM/ALM @@ -155,7 +155,7 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) end do !j ! Normalize root resistances to get layer contribution to ET - do j = 1,cp_numlevgrnd + do j = 1,hlm_numlevgrnd if (cpatch%btran_ft(ft) > 0.0_r8) then cpatch%rootr_ft(ft,j) = cpatch%rootr_ft(ft,j)/cpatch%btran_ft(ft) else @@ -179,7 +179,7 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) ! pass the host a total transpiration for the patch. This needs rootr to be ! distributed over the soil layers. - do j = 1,cp_numlevgrnd + do j = 1,hlm_numlevgrnd bc_out(s)%rootr_pagl(ifp,j) = 0._r8 do ft = 1,numpft_ed if(sum(pftgs) > 0._r8)then !prevent problem with the first timestep - might fail @@ -206,8 +206,8 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) temprootr = sum(bc_out(s)%rootr_pagl(ifp,:)) if(abs(1.0_r8-temprootr) > 1.0e-10_r8 .and. temprootr > 1.0e-10_r8)then - write(iulog,*) 'error with rootr in canopy fluxes',temprootr,sum(pftgs),sum(cpatch%rootr_ft(1:2,:),dim=2) - do j = 1,cp_numlevgrnd + write(fates_log(),*) 'error with rootr in canopy fluxes',temprootr,sum(pftgs),sum(cpatch%rootr_ft(1:2,:),dim=2) + do j = 1,hlm_numlevgrnd bc_out(s)%rootr_pagl(ifp,j) = bc_out(s)%rootr_pagl(ifp,j)/temprootr enddo end if @@ -300,7 +300,7 @@ end subroutine btran_ed ! weighted_swp = weighted_swp/totestevap ! ! weight SWP for the total evaporation ! else -! write(iulog,*) 'empty soil', totestevap +! write(fates_log(),*) 'empty soil', totestevap ! ! error check ! weighted_swp = minlwp ! end if diff --git a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 index d90fca8810..130b093da0 100644 --- a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 @@ -10,17 +10,19 @@ module EDSurfaceRadiationMod #include "shr_assert.h" - use EDtypesMod , only : ed_patch_type, ed_site_type - use FatesGlobals , only : numpft_ed - use FatesGlobals , only : maxPatchesPerSite + use EDTypesMod , only : ed_patch_type, ed_site_type + use EDTypesMod , only : numpft_ed + use EDTypesMod , only : maxPatchesPerSite use FatesConstantsMod , only : r8 => fates_r8 - use FatesInterfaceMod , only : bc_in_type, & - bc_out_type - use EDTypesMod , only : cp_numSWb, & ! Actual number of SW radiation bands - cp_maxSWb ! maximum number of SW bands (for scratch) - - use FatesGlobals , only : cp_nclmax + use FatesInterfaceMod , only : bc_in_type + use FatesInterfaceMod , only : bc_out_type + use FatesInterfaceMod , only : hlm_numSWb + use EDTypesMod , only : maxSWb + use EDTypesMod , only : nclmax + use EDTypesMod , only : numpft_ed + use EDTypesMod , only : nlevcan use EDCanopyStructureMod, only: calc_areaindex + use FatesGlobals , only : fates_log ! CIME globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -32,8 +34,9 @@ module EDSurfaceRadiationMod public :: ED_SunShadeFracs logical :: DEBUG = .false. ! for debugging this module + - real(r8), public :: albice(cp_maxSWb) = & ! albedo land ice by waveband (1=vis, 2=nir) + real(r8), public :: albice(maxSWb) = & ! albedo land ice by waveband (1=vis, 2=nir) (/ 0.80_r8, 0.55_r8 /) ! INTERF-TODO: THIS NEEDS SOME CONSISTENCY AND SHOULD BE SET IN THE INTERFACE @@ -47,11 +50,8 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) ! ! !USES: - use clm_varctl , only : iulog use pftconMod , only : pftcon use EDtypesMod , only : ed_patch_type - use FatesGlobals , only : numpft_ed - use FatesGlobals , only : cp_nlevcan use EDTypesMod , only : ed_site_type @@ -74,27 +74,27 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) real(r8) :: sb real(r8) :: error ! Error check real(r8) :: down_rad, up_rad ! Iterative solution do Dif_dn and Dif_up - real(r8) :: ftweight(cp_nclmax,numpft_ed,cp_nlevcan) + real(r8) :: ftweight(nclmax,numpft_ed,nlevcan) real(r8) :: k_dir(numpft_ed) ! Direct beam extinction coefficient - real(r8) :: tr_dir_z(cp_nclmax,numpft_ed,cp_nlevcan) ! Exponential transmittance of direct beam radiation through a single layer - real(r8) :: tr_dif_z(cp_nclmax,numpft_ed,cp_nlevcan) ! Exponential transmittance of diffuse radiation through a single layer - real(r8) :: forc_dir(maxPatchesPerSite,cp_maxSWb) - real(r8) :: forc_dif(maxPatchesPerSite,cp_maxSWb) - real(r8) :: weighted_dir_tr(cp_nclmax) - real(r8) :: weighted_fsun(cp_nclmax) - real(r8) :: weighted_dif_ratio(cp_nclmax,cp_maxSWb) - real(r8) :: weighted_dif_down(cp_nclmax) - real(r8) :: weighted_dif_up(cp_nclmax) - real(r8) :: refl_dif(cp_nclmax,numpft_ed,cp_nlevcan,cp_maxSWb) ! Term for diffuse radiation reflected by laye - real(r8) :: tran_dif(cp_nclmax,numpft_ed,cp_nlevcan,cp_maxSWb) ! Term for diffuse radiation transmitted by layer - real(r8) :: dif_ratio(cp_nclmax,numpft_ed,cp_nlevcan,cp_maxSWb) ! Ratio of upward to forward diffuse fluxes - real(r8) :: Dif_dn(cp_nclmax,numpft_ed,cp_nlevcan) ! Forward diffuse flux onto canopy layer J (W/m**2 ground area) - real(r8) :: Dif_up(cp_nclmax,numpft_ed,cp_nlevcan) ! Upward diffuse flux above canopy layer J (W/m**2 ground area) - real(r8) :: lai_change(cp_nclmax,numpft_ed,cp_nlevcan) ! Forward diffuse flux onto canopy layer J (W/m**2 ground area) - real(r8) :: f_not_abs(numpft_ed,cp_maxSWb) ! Fraction reflected + transmitted. 1-absorbtion. - real(r8) :: Abs_dir_z(numpft_ed,cp_nlevcan) - real(r8) :: Abs_dif_z(numpft_ed,cp_nlevcan) - real(r8) :: abs_rad(cp_maxSWb) !radiation absorbed by soil + real(r8) :: tr_dir_z(nclmax,numpft_ed,nlevcan) ! Exponential transmittance of direct beam radiation through a single layer + real(r8) :: tr_dif_z(nclmax,numpft_ed,nlevcan) ! Exponential transmittance of diffuse radiation through a single layer + real(r8) :: forc_dir(maxPatchesPerSite,maxSWb) + real(r8) :: forc_dif(maxPatchesPerSite,maxSWb) + real(r8) :: weighted_dir_tr(nclmax) + real(r8) :: weighted_fsun(nclmax) + real(r8) :: weighted_dif_ratio(nclmax,maxSWb) + real(r8) :: weighted_dif_down(nclmax) + real(r8) :: weighted_dif_up(nclmax) + real(r8) :: refl_dif(nclmax,numpft_ed,nlevcan,maxSWb) ! Term for diffuse radiation reflected by laye + real(r8) :: tran_dif(nclmax,numpft_ed,nlevcan,maxSWb) ! Term for diffuse radiation transmitted by layer + real(r8) :: dif_ratio(nclmax,numpft_ed,nlevcan,maxSWb) ! Ratio of upward to forward diffuse fluxes + real(r8) :: Dif_dn(nclmax,numpft_ed,nlevcan) ! Forward diffuse flux onto canopy layer J (W/m**2 ground area) + real(r8) :: Dif_up(nclmax,numpft_ed,nlevcan) ! Upward diffuse flux above canopy layer J (W/m**2 ground area) + real(r8) :: lai_change(nclmax,numpft_ed,nlevcan) ! Forward diffuse flux onto canopy layer J (W/m**2 ground area) + real(r8) :: f_not_abs(numpft_ed,maxSWb) ! Fraction reflected + transmitted. 1-absorbtion. + real(r8) :: Abs_dir_z(numpft_ed,nlevcan) + real(r8) :: Abs_dif_z(numpft_ed,nlevcan) + real(r8) :: abs_rad(maxSWb) !radiation absorbed by soil real(r8) :: tr_soili ! Radiation transmitted to the soil surface. real(r8) :: tr_soild ! Radiation transmitted to the soil surface. real(r8) :: phi1b(maxPatchesPerSite,numpft_ed) ! Radiation transmitted to the soil surface. @@ -181,7 +181,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) ! no radiation is absorbed bc_out(s)%fabd_parb(ifp,:) = 0.0_r8 bc_out(s)%fabi_parb(ifp,:) = 0.0_r8 - do ib = 1,cp_numSWb + do ib = 1,hlm_numSWb bc_out(s)%albd_parb(ifp,ib) = bc_in(s)%albgr_dir_rb(ib) bc_out(s)%albd_parb(ifp,ib) = bc_in(s)%albgr_dif_rb(ib) bc_out(s)%ftdd_parb(ifp,ib)= 1.0_r8 @@ -191,7 +191,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) else ! Is this pft/canopy layer combination present in this patch? - do L = 1,cp_nclmax + do L = 1,nclmax do ft = 1,numpft_ed currentPatch%present(L,ft) = 0 do iv = 1, currentPatch%nrad(L,ft) @@ -204,7 +204,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) end do !L do radtype = 1,2 !do this once for one unit of diffuse, and once for one unit of direct radiation - do ib = 1,cp_numSWb + do ib = 1,hlm_numSWb if (radtype == 1) then ! Set the hypothetical driving radiation. We do this once for a single unit of direct and ! once for a single unit of diffuse radiation. @@ -227,10 +227,10 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) end do !ft1 end do !L if (sum(ftweight(1,:,1))<0.999_r8)then - write(iulog,*) 'canopy not full',ftweight(1,:,1) + write(fates_log(),*) 'canopy not full',ftweight(1,:,1) endif if (sum(ftweight(1,:,1))>1.0001_r8)then - write(iulog,*) 'canopy too full',ftweight(1,:,1) + write(fates_log(),*) 'canopy too full',ftweight(1,:,1) endif !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! @@ -253,7 +253,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) do L = 1,currentPatch%NCL_p !start at the top canopy layer (1 is the top layer.) weighted_dir_tr(L) = 0.0_r8 weighted_fsun(L) = 0._r8 - weighted_dif_ratio(L,1:cp_numSWb) = 0._r8 + weighted_dif_ratio(L,1:hlm_numSWb) = 0._r8 !Each canopy layer (canopy, understorey) has multiple 'parallel' pft's do ft =1,numpft_ed if (currentPatch%present(L,ft) == 1)then !only do calculation if there are the appropriate leaves. @@ -296,7 +296,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) lai_change(L,ft,iv) = ftweight(L,ft,iv)-ftweight(L,ft,iv+1) endif if (ftweight(L,ft,iv+1) - ftweight(L,ft,iv) > 1.e-10_r8)then - write(iulog,*) 'lower layer has more coverage. This is wrong' , & + write(fates_log(),*) 'lower layer has more coverage. This is wrong' , & ftweight(L,ft,iv),ftweight(L,ft,iv+1),ftweight(L,ft,iv+1)-ftweight(L,ft,iv) endif @@ -393,7 +393,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) ! Iterative solution do scattering !==============================================================================! - do ib = 1,cp_numSWb !vis, nir + do ib = 1,hlm_numSWb !vis, nir !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! ! Leaf scattering coefficient and terms do diffuse radiation reflected ! and transmitted by a layer @@ -435,12 +435,12 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) weighted_dif_ratio(L,ib) = weighted_dif_ratio(L,ib) + & dif_ratio(L,ft,1,ib) * ftweight(L,ft,1) !instance where the first layer ftweight is used a proxy for the whole column. FTWA - end do!cp_numSWb + end do!hlm_numSWb endif ! currentPatch%present end do!ft end do!L - do ib = 1,cp_numSWb + do ib = 1,hlm_numSWb Dif_dn(:,:,:) = 0.00_r8 Dif_up(:,:,:) = 0.00_r8 do L = 1, currentPatch%NCL_p !work down from the top of the canopy. @@ -696,8 +696,8 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) do iv = 1, currentPatch%nrad(L,ft) if (radtype==1) then if ( DEBUG ) then - write(iulog,*) 'EDsurfAlb 730 ',Abs_dif_z(ft,iv),currentPatch%f_sun(L,ft,iv) - write(iulog,*) 'EDsurfAlb 731 ', currentPatch%fabd_sha_z(L,ft,iv), & + write(fates_log(),*) 'EDsurfAlb 730 ',Abs_dif_z(ft,iv),currentPatch%f_sun(L,ft,iv) + write(fates_log(),*) 'EDsurfAlb 731 ', currentPatch%fabd_sha_z(L,ft,iv), & currentPatch%fabd_sun_z(L,ft,iv) endif currentPatch%fabd_sha_z(L,ft,iv) = Abs_dif_z(ft,iv) * & @@ -712,7 +712,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) currentPatch%f_sun(L,ft,iv) endif if ( DEBUG ) then - write(iulog,*) 'EDsurfAlb 740 ', currentPatch%fabd_sha_z(L,ft,iv), & + write(fates_log(),*) 'EDsurfAlb 740 ', currentPatch%fabd_sha_z(L,ft,iv), & currentPatch%fabd_sun_z(L,ft,iv) endif end do @@ -790,22 +790,22 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) (1.0_r8-bc_in(s)%albgr_dir_rb(ib)) + & currentPatch%tr_soil_dir_dif(ib) * (1.0_r8-bc_in(s)%albgr_dif_rb(ib)))) if ( abs(error) > 0.0001)then - write(iulog,*)'dir ground absorption error',ifp,s,error,currentPatch%sabs_dir(ib), & + write(fates_log(),*)'dir ground absorption error',ifp,s,error,currentPatch%sabs_dir(ib), & currentPatch%tr_soil_dir(ib)* & (1.0_r8-bc_in(s)%albgr_dir_rb(ib)),currentPatch%NCL_p,ib,sum(ftweight(1,:,1)) - write(iulog,*) 'albedos',currentPatch%sabs_dir(ib) ,currentPatch%tr_soil_dir(ib), & + write(fates_log(),*) 'albedos',currentPatch%sabs_dir(ib) ,currentPatch%tr_soil_dir(ib), & (1.0_r8-bc_in(s)%albgr_dir_rb(ib)),currentPatch%lai do ft =1,3 iv = currentPatch%nrad(1,ft) + 1 - write(iulog,*) 'abs soil fluxes', Abs_dir_z(ft,iv),Abs_dif_z(ft,iv) + write(fates_log(),*) 'abs soil fluxes', Abs_dir_z(ft,iv),Abs_dif_z(ft,iv) end do end if else if ( abs(currentPatch%sabs_dif(ib)-(currentPatch%tr_soil_dif(ib) * & (1.0_r8-bc_in(s)%albgr_dif_rb(ib)))) > 0.0001)then - write(iulog,*)'dif ground absorption error',ifp,s,currentPatch%sabs_dif(ib) , & + write(fates_log(),*)'dif ground absorption error',ifp,s,currentPatch%sabs_dif(ib) , & (currentPatch%tr_soil_dif(ib)* & (1.0_r8-bc_in(s)%albgr_dif_rb(ib))),currentPatch%NCL_p,ib,sum(ftweight(1,:,1)) endif @@ -831,22 +831,22 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) enddo enddo if (lai_change(1,2,1).gt.0.0.and.lai_change(1,2,2).gt.0.0)then - ! write(iulog,*) 'lai_change(1,2,12)',lai_change(1,2,1:4) + ! write(fates_log(),*) 'lai_change(1,2,12)',lai_change(1,2,1:4) endif if (lai_change(1,2,2).gt.0.0.and.lai_change(1,2,3).gt.0.0)then - ! write(iulog,*) ' lai_change (1,2,23)',lai_change(1,2,1:4) + ! write(fates_log(),*) ' lai_change (1,2,23)',lai_change(1,2,1:4) endif if (lai_change(1,1,3).gt.0.0.and.lai_change(1,1,2).gt.0.0)then ! NO-OP - ! write(iulog,*) 'first layer of lai_change 2 3',lai_change(1,1,1:3) + ! write(fates_log(),*) 'first layer of lai_change 2 3',lai_change(1,1,1:3) endif if (lai_change(1,1,3).gt.0.0.and.lai_change(1,1,4).gt.0.0)then ! NO-OP - ! write(iulog,*) 'first layer of lai_change 3 4',lai_change(1,1,1:4) + ! write(fates_log(),*) 'first layer of lai_change 3 4',lai_change(1,1,1:4) endif if (lai_change(1,1,4).gt.0.0.and.lai_change(1,1,5).gt.0.0)then ! NO-OP - ! write(iulog,*) 'first layer of lai_change 4 5',lai_change(1,1,1:5) + ! write(fates_log(),*) 'first layer of lai_change 4 5',lai_change(1,1,1:5) endif if (radtype == 1)then @@ -862,15 +862,15 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) ! will deal with them for now. end if if (abs(error) > 0.15_r8)then - write(iulog,*) 'Large Dir Radn consvn error',error ,ifp,ib - write(iulog,*) 'diags', bc_out(s)%albd_parb(ifp,ib), bc_out(s)%ftdd_parb(ifp,ib), & + write(fates_log(),*) 'Large Dir Radn consvn error',error ,ifp,ib + write(fates_log(),*) 'diags', bc_out(s)%albd_parb(ifp,ib), bc_out(s)%ftdd_parb(ifp,ib), & bc_out(s)%ftid_parb(ifp,ib), bc_out(s)%fabd_parb(ifp,ib) - write(iulog,*) 'lai_change',lai_change(currentpatch%ncl_p,1:2,1:4) - write(iulog,*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:2,1:4) - write(iulog,*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:2,1:4) - write(iulog,*) 'ftweight',ftweight(1,1:2,1:4) - write(iulog,*) 'cp',currentPatch%area, currentPatch%patchno - write(iulog,*) 'bc_in(s)%albgr_dir_rb(ib)',bc_in(s)%albgr_dir_rb(ib) + write(fates_log(),*) 'lai_change',lai_change(currentpatch%ncl_p,1:2,1:4) + write(fates_log(),*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:2,1:4) + write(fates_log(),*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:2,1:4) + write(fates_log(),*) 'ftweight',ftweight(1,1:2,1:4) + write(fates_log(),*) 'cp',currentPatch%area, currentPatch%patchno + write(fates_log(),*) 'bc_in(s)%albgr_dir_rb(ib)',bc_in(s)%albgr_dir_rb(ib) bc_out(s)%albd_parb(ifp,ib) = bc_out(s)%albd_parb(ifp,ib) + error end if @@ -881,19 +881,19 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) end if if (abs(error) > 0.15_r8)then - write(iulog,*) '>5% Dif Radn consvn error',error ,ifp,ib - write(iulog,*) 'diags', bc_out(s)%albi_parb(ifp,ib), bc_out(s)%ftii_parb(ifp,ib), & + write(fates_log(),*) '>5% Dif Radn consvn error',error ,ifp,ib + write(fates_log(),*) 'diags', bc_out(s)%albi_parb(ifp,ib), bc_out(s)%ftii_parb(ifp,ib), & bc_out(s)%fabi_parb(ifp,ib) - write(iulog,*) 'lai_change',lai_change(currentpatch%ncl_p,1:2,1:4) - write(iulog,*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:2,1:4) - write(iulog,*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:2,1:4) - write(iulog,*) 'ftweight',ftweight(currentpatch%ncl_p,1:2,1:4) - write(iulog,*) 'cp',currentPatch%area, currentPatch%patchno - write(iulog,*) 'bc_in(s)%albgr_dif_rb(ib)',bc_in(s)%albgr_dif_rb(ib) - write(iulog,*) 'rhol',rhol(1:2,:) - write(iulog,*) 'ftw',sum(ftweight(1,:,1)),ftweight(1,1:2,1) - write(iulog,*) 'present',currentPatch%present(1,1:2) - write(iulog,*) 'CAP',currentPatch%canopy_area_profile(1,1:2,1) + write(fates_log(),*) 'lai_change',lai_change(currentpatch%ncl_p,1:2,1:4) + write(fates_log(),*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:2,1:4) + write(fates_log(),*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:2,1:4) + write(fates_log(),*) 'ftweight',ftweight(currentpatch%ncl_p,1:2,1:4) + write(fates_log(),*) 'cp',currentPatch%area, currentPatch%patchno + write(fates_log(),*) 'bc_in(s)%albgr_dif_rb(ib)',bc_in(s)%albgr_dif_rb(ib) + write(fates_log(),*) 'rhol',rhol(1:2,:) + write(fates_log(),*) 'ftw',sum(ftweight(1,:,1)),ftweight(1,1:2,1) + write(fates_log(),*) 'present',currentPatch%present(1,1:2) + write(fates_log(),*) 'CAP',currentPatch%canopy_area_profile(1,1:2,1) bc_out(s)%albi_parb(ifp,ib) = bc_out(s)%albi_parb(ifp,ib) + error end if @@ -907,12 +907,12 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) endif if (abs(error) > 0.00000001_r8)then - write(iulog,*) 'there is still error after correction',error ,ifp,ib + write(fates_log(),*) 'there is still error after correction',error ,ifp,ib end if end if - end do !cp_numSWb + end do !hlm_numSWb enddo ! rad-type endif ! is there vegetation? @@ -930,8 +930,6 @@ end subroutine ED_Norman_Radiation subroutine ED_SunShadeFracs(nsites, sites,bc_in,bc_out) - use clm_varctl , only : iulog - implicit none ! Arguments @@ -962,7 +960,7 @@ subroutine ED_SunShadeFracs(nsites, sites,bc_in,bc_out) ifp=ifp+1 - if( DEBUG ) write(iulog,*) 'edsurfRad_5600',ifp,s,cpatch%NCL_p,numpft_ed + if( DEBUG ) write(fates_log(),*) 'edsurfRad_5600',ifp,s,cpatch%NCL_p,numpft_ed ! zero out various datas cpatch%ed_parsun_z(:,:,:) = 0._r8 @@ -985,7 +983,7 @@ subroutine ED_SunShadeFracs(nsites, sites,bc_in,bc_out) do CL = 1, cpatch%NCL_p do FT = 1,numpft_ed - if( DEBUG ) write(iulog,*) 'edsurfRad_5601',CL,FT,cpatch%nrad(CL,ft) + if( DEBUG ) write(fates_log(),*) 'edsurfRad_5601',CL,FT,cpatch%nrad(CL,ft) do iv = 1, cpatch%nrad(CL,ft) !NORMAL CASE. @@ -995,8 +993,8 @@ subroutine ED_SunShadeFracs(nsites, sites,bc_in,bc_out) cpatch%ed_laisun_z(CL,ft,iv) = cpatch%elai_profile(CL,ft,iv) * & cpatch%f_sun(CL,ft,iv) - if ( DEBUG ) write(iulog,*) 'edsurfRad 570 ',cpatch%elai_profile(CL,ft,iv) - if ( DEBUG ) write(iulog,*) 'edsurfRad 571 ',cpatch%f_sun(CL,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'edsurfRad 570 ',cpatch%elai_profile(CL,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'edsurfRad 571 ',cpatch%f_sun(CL,ft,iv) cpatch%ed_laisha_z(CL,ft,iv) = cpatch%elai_profile(CL,ft,iv) * & (1._r8 - cpatch%f_sun(CL,ft,iv)) @@ -1017,7 +1015,7 @@ subroutine ED_SunShadeFracs(nsites, sites,bc_in,bc_out) endif if(bc_out(s)%fsun_pa(ifp) > 1._r8)then - write(iulog,*) 'too much leaf area in profile', bc_out(s)%fsun_pa(ifp), & + write(fates_log(),*) 'too much leaf area in profile', bc_out(s)%fsun_pa(ifp), & cpatch%lai,sunlai,shalai endif @@ -1030,34 +1028,34 @@ subroutine ED_SunShadeFracs(nsites, sites,bc_in,bc_out) ! If sun/shade big leaf code, nrad=1 and fluxes from SurfaceAlbedo ! are canopy integrated so that layer values equal big leaf values. - if ( DEBUG ) write(iulog,*) 'edsurfRad 645 ',cpatch%NCL_p,numpft_ed + if ( DEBUG ) write(fates_log(),*) 'edsurfRad 645 ',cpatch%NCL_p,numpft_ed do CL = 1, cpatch%NCL_p do FT = 1,numpft_ed - if ( DEBUG ) write(iulog,*) 'edsurfRad 649 ',cpatch%nrad(CL,ft) + if ( DEBUG ) write(fates_log(),*) 'edsurfRad 649 ',cpatch%nrad(CL,ft) do iv = 1, cpatch%nrad(CL,ft) if ( DEBUG ) then - write(iulog,*) 'edsurfRad 653 ', cpatch%ed_parsun_z(CL,ft,iv) - write(iulog,*) 'edsurfRad 654 ', bc_in(s)%solad_parb(ifp,ipar) - write(iulog,*) 'edsurfRad 655 ', bc_in(s)%solai_parb(ifp,ipar) - write(iulog,*) 'edsurfRad 656 ', cpatch%fabd_sun_z(CL,ft,iv) - write(iulog,*) 'edsurfRad 657 ', cpatch%fabi_sun_z(CL,ft,iv) + write(fates_log(),*) 'edsurfRad 653 ', cpatch%ed_parsun_z(CL,ft,iv) + write(fates_log(),*) 'edsurfRad 654 ', bc_in(s)%solad_parb(ifp,ipar) + write(fates_log(),*) 'edsurfRad 655 ', bc_in(s)%solai_parb(ifp,ipar) + write(fates_log(),*) 'edsurfRad 656 ', cpatch%fabd_sun_z(CL,ft,iv) + write(fates_log(),*) 'edsurfRad 657 ', cpatch%fabi_sun_z(CL,ft,iv) endif cpatch%ed_parsun_z(CL,ft,iv) = & bc_in(s)%solad_parb(ifp,ipar)*cpatch%fabd_sun_z(CL,ft,iv) + & bc_in(s)%solai_parb(ifp,ipar)*cpatch%fabi_sun_z(CL,ft,iv) - if ( DEBUG )write(iulog,*) 'edsurfRad 663 ', cpatch%ed_parsun_z(CL,ft,iv) + if ( DEBUG )write(fates_log(),*) 'edsurfRad 663 ', cpatch%ed_parsun_z(CL,ft,iv) cpatch%ed_parsha_z(CL,ft,iv) = & bc_in(s)%solad_parb(ifp,ipar)*cpatch%fabd_sha_z(CL,ft,iv) + & bc_in(s)%solai_parb(ifp,ipar)*cpatch%fabi_sha_z(CL,ft,iv) - if ( DEBUG ) write(iulog,*) 'edsurfRad 669 ', cpatch%ed_parsha_z(CL,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'edsurfRad 669 ', cpatch%ed_parsha_z(CL,ft,iv) end do !iv end do !FT @@ -1096,7 +1094,7 @@ end subroutine ED_SunShadeFracs ! g = gridcell(p) ! errsol = (fsa(p) + fsr(p) - (forc_solad(g,1) + forc_solad(g,2) + forc_solai(g,1) + forc_solai(g,2))) ! if(abs(errsol) > 0.1_r8)then -! write(iulog,*) 'sol error in surf rad',p,g, errsol +! write(fates_log(),*) 'sol error in surf rad',p,g, errsol ! endif ! end do ! return diff --git a/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 b/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 index b861021355..6dd2592c24 100644 --- a/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -24,7 +24,10 @@ module FATESPlantRespPhotosynthMod use FatesGlobals, only : fates_log use FatesConstantsMod, only : r8 => fates_r8 use EDTypesMod, only : use_fates_plant_hydro - + use EDTypesMod, only : numpft_ed + use EDTypesMod, only : nlevcan + use EDTypesMod, only : nclmax + ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -68,10 +71,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) use EDTypesMod , only : ed_patch_type use EDTypesMod , only : ed_cohort_type use EDTypesMod , only : ed_site_type - use FatesGlobals , only : numpft_ed - use EDTypesMod , only : cp_numlevsoil - use FatesGlobals , only : cp_nlevcan - use FatesGlobals , only : cp_nclmax + use FatesInterfaceMod , only : hlm_numlevsoil use EDEcophysContype , only : EDecophyscon use FatesInterfaceMod , only : bc_in_type use FatesInterfaceMod , only : bc_out_type @@ -82,6 +82,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) use FatesConstantsMod, only : rgas => rgas_J_K_kmol use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm use FatesParameterDerivedMod, only : param_derived + use EDPatchDynamicsMod, only: set_root_fraction ! ARGUMENTS: @@ -115,17 +116,17 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! ----------------------------------------------------------------------------------- ! leaf maintenance (dark) respiration (umol CO2/m**2/s) Double check this - real(r8) :: lmr_z(cp_nlevcan,mxpft,cp_nclmax) + real(r8) :: lmr_z(nlevcan,mxpft,nclmax) ! stomatal resistance s/m - real(r8) :: rs_z(cp_nlevcan,mxpft,cp_nclmax) + real(r8) :: rs_z(nlevcan,mxpft,nclmax) ! net leaf photosynthesis averaged over sun and shade leaves. (umol CO2/m**2/s) - real(r8) :: anet_av_z(cp_nlevcan,mxpft,cp_nclmax) + real(r8) :: anet_av_z(nlevcan,mxpft,nclmax) ! Mask used to determine which leaf-layer biophysical rates have been ! used already - logical :: rate_mask_z(cp_nlevcan,mxpft,cp_nclmax) + logical :: rate_mask_z(nlevcan,mxpft,nclmax) real(r8) :: vcmax_z ! leaf layer maximum rate of carboxylation ! (umol co2/m**2/s) @@ -293,7 +294,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) end do !ft - call currentPatch%set_root_fraction(bc_in(s)%depth_gl) + call set_root_fraction(currentPatch,bc_in(s)%depth_gl) ! ------------------------------------------------------------------------ ! Part VI: Loop over all leaf layers. @@ -543,7 +544,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Fine Root MR (kgC/plant/s) ! ------------------------------------------------------------------ currentCohort%froot_mr = 0._r8 - do j = 1,cp_numlevsoil + do j = 1,hlm_numlevsoil tcsoi = q10**((bc_in(s)%t_soisno_gl(j)-tfrz - 20.0_r8)/10.0_r8) currentCohort%froot_mr = currentCohort%froot_mr + & froot_n * base_mr_20 * tcsoi * currentPatch%rootfr_ft(ft,j) @@ -553,7 +554,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! ------------------------------------------------------------------ if (woody(ft) == 1) then currentCohort%livecroot_mr = 0._r8 - do j = 1,cp_numlevsoil + do j = 1,hlm_numlevsoil ! Soil temperature used to adjust base rate of MR tcsoi = q10**((bc_in(s)%t_soisno_gl(j)-tfrz - 20.0_r8)/10.0_r8) currentCohort%livecroot_mr = currentCohort%livecroot_mr + & @@ -1312,8 +1313,7 @@ subroutine UpdateCanopyNCanNRadPresent(currentPatch) ! profile). ! --------------------------------------------------------------------------------- - use EDTypesMod , only : cp_nclmax - use EDTypesMOd , only : numpft_ed + use EDTypesMod , only : ed_patch_type use EDTypesMod , only : ed_cohort_type @@ -1349,7 +1349,7 @@ subroutine UpdateCanopyNCanNRadPresent(currentPatch) currentPatch%nrad = currentPatch%ncan ! Now loop through and identify which layer and pft combo has scattering elements - do cl = 1,cp_nclmax + do cl = 1,nclmax do ft = 1,numpft_ed currentPatch%present(cl,ft) = 0 do iv = 1, currentPatch%nrad(cl,ft); diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90 index b6ff07c79a..7c715deafa 100755 --- a/components/clm/src/ED/fire/SFMainMod.F90 +++ b/components/clm/src/ED/fire/SFMainMod.F90 @@ -7,8 +7,8 @@ module SFMainMod use FatesConstantsMod , only : r8 => fates_r8 -! use spmdMod , only : masterproc - use EDTypesMod , only : cp_masterproc ! 1= master process, 0=not master process + use FatesInterfaceMod , only : hlm_masterproc ! 1= master process, 0=not master process + use EDTypesMod , only : numWaterMem use FatesGlobals , only : fates_log use FatesInterfaceMod , only : bc_in_type @@ -184,15 +184,15 @@ subroutine charecteristics_of_fuel ( currentSite ) currentPatch%fuel_frac = 0.0_r8 if(write_sf == 1)then - if ( cp_masterproc == 1 ) write(fates_log(),*) ' leaf_litter1 ',currentPatch%leaf_litter - if ( cp_masterproc == 1 ) write(fates_log(),*) ' leaf_litter2 ',sum(currentPatch%CWD_AG) - if ( cp_masterproc == 1 ) write(fates_log(),*) ' leaf_litter3 ',currentPatch%livegrass - if ( cp_masterproc == 1 ) write(fates_log(),*) ' sum fuel', currentPatch%sum_fuel + if ( hlm_masterproc == 1 ) write(fates_log(),*) ' leaf_litter1 ',currentPatch%leaf_litter + if ( hlm_masterproc == 1 ) write(fates_log(),*) ' leaf_litter2 ',sum(currentPatch%CWD_AG) + if ( hlm_masterproc == 1 ) write(fates_log(),*) ' leaf_litter3 ',currentPatch%livegrass + if ( hlm_masterproc == 1 ) write(fates_log(),*) ' sum fuel', currentPatch%sum_fuel endif currentPatch%sum_fuel = sum(currentPatch%leaf_litter) + sum(currentPatch%CWD_AG) + currentPatch%livegrass if(write_SF == 1)then - if ( cp_masterproc == 1 ) write(fates_log(),*) 'sum fuel', currentPatch%sum_fuel,currentPatch%area + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'sum fuel', currentPatch%sum_fuel,currentPatch%area endif ! =============================================== ! Average moisture, bulk density, surface area-volume and moisture extinction of fuel @@ -204,9 +204,9 @@ subroutine charecteristics_of_fuel ( currentSite ) currentPatch%fuel_frac(dg_sf+1:tr_sf) = currentPatch%CWD_AG / currentPatch%sum_fuel if(write_sf == 1)then - if ( cp_masterproc == 1 ) write(fates_log(),*) 'ff1 ',currentPatch%fuel_frac - if ( cp_masterproc == 1 ) write(fates_log(),*) 'ff2 ',currentPatch%fuel_frac - if ( cp_masterproc == 1 ) write(fates_log(),*) 'ff2a ',lg_sf,currentPatch%livegrass,currentPatch%sum_fuel + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'ff1 ',currentPatch%fuel_frac + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'ff2 ',currentPatch%fuel_frac + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'ff2a ',lg_sf,currentPatch%livegrass,currentPatch%sum_fuel endif currentPatch%fuel_frac(lg_sf) = currentPatch%livegrass / currentPatch%sum_fuel @@ -215,14 +215,14 @@ subroutine charecteristics_of_fuel ( currentSite ) !Equation 6 in Thonicke et al. 2010. fuel_moisture(dg_sf+1:tr_sf) = exp(-1.0_r8 * SF_val_alpha_FMC(dg_sf+1:tr_sf) * currentSite%acc_NI) if(write_SF == 1)then - if ( cp_masterproc == 1 ) write(fates_log(),*) 'ff3 ',currentPatch%fuel_frac - if ( cp_masterproc == 1 ) write(fates_log(),*) 'fm ',fuel_moisture - if ( cp_masterproc == 1 ) write(fates_log(),*) 'csa ',currentSite%acc_NI - if ( cp_masterproc == 1 ) write(fates_log(),*) 'sfv ',SF_val_alpha_FMC + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'ff3 ',currentPatch%fuel_frac + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'fm ',fuel_moisture + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'csa ',currentSite%acc_NI + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'sfv ',SF_val_alpha_FMC endif ! FIX(RF,032414): needs refactoring. ! average water content !is this the correct metric? - timeav_swc = sum(currentSite%water_memory(1:10)) / 10._r8 + timeav_swc = sum(currentSite%water_memory(1:numWaterMem)) / dble(numWaterMem) ! Equation B2 in Thonicke et al. 2010 fuel_moisture(lg_sf) = max(0.0_r8, 10.0_r8/9._r8 * timeav_swc - 1.0_r8/9.0_r8) @@ -232,7 +232,7 @@ subroutine charecteristics_of_fuel ( currentSite ) currentPatch%fuel_mef = sum(currentPatch%fuel_frac(dg_sf:lb_sf) * MEF(dg_sf:lb_sf)) currentPatch%fuel_eff_moist = sum(currentPatch%fuel_frac(dg_sf:lb_sf) * fuel_moisture(dg_sf:lb_sf)) if(write_sf == 1)then - if ( cp_masterproc == 1 ) write(fates_log(),*) 'ff4 ',currentPatch%fuel_eff_moist + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'ff4 ',currentPatch%fuel_eff_moist endif ! Add on properties of live grass multiplied by grass fraction. (6) currentPatch%fuel_bulkd = currentPatch%fuel_bulkd + currentPatch%fuel_frac(lg_sf) * SF_val_FBD(lg_sf) @@ -259,14 +259,14 @@ subroutine charecteristics_of_fuel ( currentSite ) if(write_SF == 1)then - if ( cp_masterproc == 1 ) write(fates_log(),*) 'no litter fuel at all',currentPatch%patchno, & + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'no litter fuel at all',currentPatch%patchno, & currentPatch%sum_fuel,sum(currentPatch%cwd_ag), & sum(currentPatch%cwd_bg),sum(currentPatch%leaf_litter) endif currentPatch%fuel_sav = sum(SF_val_SAV(1:ncwd+2))/(ncwd+2) ! make average sav to avoid crashing code. - if ( cp_masterproc == 1 ) write(fates_log(),*) 'problem with spitfire fuel averaging' + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'problem with spitfire fuel averaging' ! FIX(SPM,032414) refactor...should not have 0 fuel unless everything is burnt ! off. @@ -282,7 +282,7 @@ subroutine charecteristics_of_fuel ( currentSite ) ! FIX(SPM,032414) refactor... if(write_SF == 1.and.currentPatch%fuel_sav <= 0.0_r8.or.currentPatch%fuel_bulkd <= & 0.0_r8.or.currentPatch%fuel_mef <= 0.0_r8.or.currentPatch%fuel_eff_moist <= 0.0_r8)then - if ( cp_masterproc == 1 ) write(fates_log(),*) 'problem with spitfire fuel averaging' + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'problem with spitfire fuel averaging' endif currentPatch => currentPatch%younger @@ -321,7 +321,7 @@ subroutine wind_effect ( currentSite, bc_in) wind = bc_in%wind24_pa(iofp) * sec_per_min ! Convert to m/min for SPITFIRE units. if(write_SF == 1)then - if ( cp_masterproc == 1 ) write(fates_log(),*) 'wind24', wind + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'wind24', wind endif ! --- influence of wind speed, corrected for surface roughness---- ! --- averaged over the whole grid cell to prevent extreme divergence @@ -360,7 +360,7 @@ subroutine wind_effect ( currentSite, bc_in) grass_fraction = min(grass_fraction,1.0_r8-tree_fraction) bare_fraction = 1.0 - tree_fraction - grass_fraction if(write_sf == 1)then - if ( cp_masterproc == 1 ) write(fates_log(),*) 'grass, trees, bare',grass_fraction, tree_fraction, bare_fraction + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'grass, trees, bare',grass_fraction, tree_fraction, bare_fraction endif currentPatch=>currentSite%oldest_patch; @@ -410,18 +410,18 @@ subroutine rate_of_spread ( currentSite ) currentPatch%sum_fuel = currentPatch%sum_fuel * (1.0_r8 - SF_val_miner_total) !net of minerals ! ----start spreading--- - if ( cp_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - currentPatch%fuel_bulkd ',currentPatch%fuel_bulkd - if ( cp_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - SF_val_part_dens ',SF_val_part_dens + if ( hlm_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - currentPatch%fuel_bulkd ',currentPatch%fuel_bulkd + if ( hlm_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - SF_val_part_dens ',SF_val_part_dens beta = (currentPatch%fuel_bulkd / 0.45_r8) / SF_val_part_dens ! Equation A6 in Thonicke et al. 2010 beta_op = 0.200395_r8 *(currentPatch%fuel_sav**(-0.8189_r8)) - if ( cp_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - beta ',beta - if ( cp_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - beta_op ',beta_op + if ( hlm_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - beta ',beta + if ( hlm_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - beta_op ',beta_op bet = beta/beta_op if(write_sf == 1)then - if ( cp_masterproc == 1 ) write(fates_log(),*) 'esf ',currentPatch%fuel_eff_moist + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'esf ',currentPatch%fuel_eff_moist endif ! ---heat of pre-ignition--- ! Equation A4 in Thonicke et al. 2010 @@ -439,11 +439,11 @@ subroutine rate_of_spread ( currentSite ) ! Equation A5 in Thonicke et al. 2010 if (DEBUG) then - if ( cp_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - c ',c - if ( cp_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - currentPatch%effect_wspeed ',currentPatch%effect_wspeed - if ( cp_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - b ',b - if ( cp_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - bet ',bet - if ( cp_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - e ',e + if ( hlm_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - c ',c + if ( hlm_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - currentPatch%effect_wspeed ',currentPatch%effect_wspeed + if ( hlm_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - b ',b + if ( hlm_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - bet ',bet + if ( hlm_masterproc == 1 .and.DEBUG) write(fates_log(),*) 'SF - e ',e endif ! convert from m/min to ft/min for Rothermel ROS eqn @@ -605,7 +605,7 @@ subroutine fire_intensity ( currentSite ) W = currentPatch%TFC_ROS / 0.45_r8 !kgC/m2 to kgbiomass/m2 currentPatch%FI = SF_val_fuel_energy * W * ROS !kj/m/s, or kW/m if(write_sf == 1)then - if( cp_masterproc == 1 ) write(fates_log(),*) 'fire_intensity',currentPatch%fi,W,currentPatch%ROS_front + if( hlm_masterproc == 1 ) write(fates_log(),*) 'fire_intensity',currentPatch%fi,W,currentPatch%ROS_front endif !'decide_fire' subroutine shortened and put in here... if (currentPatch%FI >= fire_threshold) then ! 50kW/m is the threshold for a self-sustaining fire @@ -616,7 +616,7 @@ subroutine fire_intensity ( currentSite ) ! Equation 14 in Thonicke et al. 2010 currentPatch%FD = SF_val_max_durat / (1.0_r8 + SF_val_max_durat * exp(SF_val_durat_slope*d_FDI)) if(write_SF == 1)then - if ( cp_masterproc == 1 ) write(fates_log(),*) 'fire duration minutes',currentPatch%fd + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'fire duration minutes',currentPatch%fd endif !equation 15 in Arora and Boer CTEM model.Average fire is 1 day long. !currentPatch%FD = 60.0_r8 * 24.0_r8 !no minutes in a day @@ -703,19 +703,19 @@ subroutine area_burnt ( currentSite ) currentPatch%AB = size_of_fire * currentPatch%nf if (currentPatch%AB > gridarea*currentPatch%area/area) then !all of patch burnt. - if ( cp_masterproc == 1 ) write(fates_log(),*) 'burnt all of patch',currentPatch%patchno, & + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'burnt all of patch',currentPatch%patchno, & currentPatch%area/area,currentPatch%ab,currentPatch%area/area*gridarea - if ( cp_masterproc == 1 ) write(fates_log(),*) 'ros',currentPatch%ROS_front,currentPatch%FD, & + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'ros',currentPatch%ROS_front,currentPatch%FD, & currentPatch%NF,currentPatch%FI,size_of_fire - if ( cp_masterproc == 1 ) write(fates_log(),*) 'litter', & + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'litter', & currentPatch%sum_fuel,currentPatch%CWD_AG,currentPatch%leaf_litter ! turn km2 into m2. work out total area burnt. currentPatch%AB = currentPatch%area * gridarea/AREA endif currentPatch%frac_burnt = currentPatch%AB / (gridarea*currentPatch%area/area) if(write_SF == 1)then - if ( cp_masterproc == 1 ) write(fates_log(),*) 'frac_burnt',currentPatch%frac_burnt + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'frac_burnt',currentPatch%frac_burnt endif endif endif! fire @@ -772,7 +772,7 @@ subroutine crown_scorching ( currentSite ) currentCohort%bdead))*currentCohort%n)/tree_ag_biomass !equation 16 in Thonicke et al. 2010 if(write_SF == 1)then - if ( cp_masterproc == 1 ) write(fates_log(),*) 'currentPatch%SH',currentPatch%SH,f_ag_bmass + if ( hlm_masterproc == 1 ) write(fates_log(),*) 'currentPatch%SH',currentPatch%SH,f_ag_bmass endif !2/3 Byram (1959) currentPatch%SH = currentPatch%SH + f_ag_bmass * SF_val_alpha_SH * (currentPatch%FI**0.667_r8) diff --git a/components/clm/src/ED/fire/SFParamsMod.F90 b/components/clm/src/ED/fire/SFParamsMod.F90 index 3caa526a01..978ac5f9a2 100644 --- a/components/clm/src/ED/fire/SFParamsMod.F90 +++ b/components/clm/src/ED/fire/SFParamsMod.F90 @@ -2,7 +2,7 @@ module SFParamsMod ! ! module that deals with reading the SF parameter file ! - use shr_kind_mod , only: r8 => shr_kind_r8 + use FatesConstantsMod , only: r8 => fates_r8 use EDtypesMod , only: NLSC,NFSC,NCWD implicit none diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 index aa5850ade8..952e486333 100755 --- a/components/clm/src/ED/main/EDInitMod.F90 +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -6,7 +6,7 @@ module EDInitMod use FatesConstantsMod , only : r8 => fates_r8 use FatesGlobals , only : endrun => fates_endrun - use FatesGlobals , only : cp_nclmax + use EDTypesMod , only : nclmax use FatesGlobals , only : fates_log use clm_varctl , only : use_ed_spit_fire use clm_time_manager , only : is_restart @@ -17,8 +17,9 @@ module EDInitMod use EDPatchDynamicsMod , only : create_patch use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, area use EDTypesMod , only : ncwd - use FatesGlobals , only : numpft_ed - + use EDTypesMod , only : nuMWaterMem + use EDTypesMod , only : numpft_ed + implicit none private @@ -145,7 +146,7 @@ subroutine set_site_properties( nsites, sites) sites(s)%ED_GDD_site = GDD if ( .not. is_restart() ) then - sites(s)%water_memory(1:10) = watermem + sites(s)%water_memory(1:numWaterMem) = watermem end if sites(s)%status = stat @@ -179,7 +180,7 @@ subroutine init_patches( nsites, sites) integer :: s real(r8) :: cwd_ag_local(ncwd) real(r8) :: cwd_bg_local(ncwd) - real(r8) :: spread_local(cp_nclmax) + real(r8) :: spread_local(nclmax) real(r8) :: leaf_litter_local(numpft_ed) real(r8) :: root_litter_local(numpft_ed) real(r8) :: age !notional age of this patch diff --git a/components/clm/src/ED/main/EDMainMod.F90 b/components/clm/src/ED/main/EDMainMod.F90 index 6882222f1e..749e06ffab 100755 --- a/components/clm/src/ED/main/EDMainMod.F90 +++ b/components/clm/src/ED/main/EDMainMod.F90 @@ -7,23 +7,34 @@ module EDMainMod use shr_kind_mod , only : r8 => shr_kind_r8 use FatesGlobals , only : fates_log - use FatesGlobals , only : freq_day - use FatesGlobals , only : day_of_year - use FatesGlobals , only : days_per_year - use FatesGlobals , only : current_year - use FatesGlobals , only : current_month - use FatesGlobals , only : current_day - use atm2lndType , only : atm2lnd_type - use SoilStateType , only : soilstate_type - use TemperatureType , only : temperature_type - use EDCohortDynamicsMod , only : allocate_live_biomass, terminate_cohorts, fuse_cohorts, sort_cohorts, count_cohorts - use EDPatchDynamicsMod , only : disturbance_rates, fuse_patches, spawn_patches, terminate_patches - use EDPhysiologyMod , only : canopy_derivs, non_canopy_derivs, phenology, recruitment, trim_canopy + use FatesInterfaceMod , only : hlm_freq_day + use FatesInterfaceMod , only : hlm_day_of_year + use FatesInterfaceMod , only : hlm_days_per_year + use FatesInterfaceMod , only : hlm_current_year + use FatesInterfaceMod , only : hlm_current_month + use FatesInterfaceMod , only : hlm_current_day + use EDCohortDynamicsMod , only : allocate_live_biomass + use EDCohortDynamicsMod , only : terminate_cohorts + use EDCohortDynamicsMod , only : fuse_cohorts + use EDCohortDynamicsMod , only : sort_cohorts + use EDCohortDynamicsMod , only : count_cohorts + use EDPatchDynamicsMod , only : disturbance_rates + use EDPatchDynamicsMod , only : fuse_patches + use EDPatchDynamicsMod , only : spawn_patches + use EDPatchDynamicsMod , only : terminate_patches + use EDPhysiologyMod , only : canopy_derivs + use EDPhysiologyMod , only : non_canopy_derivs + use EDPhysiologyMod , only : phenology + use EDPhysiologyMod , only : recruitment + use EDPhysiologyMod , only : trim_canopy use SFMainMod , only : fire_model - use EDtypesMod , only : ncwd, numpft_ed - use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type + use EDtypesMod , only : ncwd + use EDTypesMod , only : numpft_ed + use EDtypesMod , only : ed_site_type + use EDtypesMod , only : ed_patch_type + use EDtypesMod , only : ed_cohort_type use FatesInterfaceMod , only : bc_in_type - use EDTypesMod , only : cp_masterproc + use FatesInterfaceMod , only : hlm_masterproc implicit none @@ -60,8 +71,8 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) type(ed_patch_type), pointer :: currentPatch !----------------------------------------------------------------------- - if ( cp_masterproc==1 ) write(fates_log(),'(A,I4,A,I2.2,A,I2.2)') 'FATES Dynamics: ',& - current_year,'-',current_month,'-',current_day + if ( hlm_masterproc==1 ) write(fates_log(),'(A,I4,A,I2.2,A,I2.2)') 'FATES Dynamics: ',& + hlm_current_year,'-',hlm_current_month,'-',hlm_current_day !************************************************************************** ! Fire, growth, biogeochemistry. @@ -170,7 +181,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) do while(associated(currentPatch)) - currentPatch%age = currentPatch%age + freq_day + currentPatch%age = currentPatch%age + hlm_freq_day ! FIX(SPM,032414) valgrind 'Conditional jump or move depends on uninitialised value' if( currentPatch%age < 0._r8 )then write(fates_log(),*) 'negative patch age?',currentPatch%age, & @@ -185,17 +196,17 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) do while(associated(currentCohort)) cohort_biomass_store = (currentCohort%balive+currentCohort%bdead+currentCohort%bstore) - currentCohort%dbh = max(small_no,currentCohort%dbh + currentCohort%ddbhdt * freq_day ) - currentCohort%balive = currentCohort%balive + currentCohort%dbalivedt * freq_day - currentCohort%bdead = max(small_no,currentCohort%bdead + currentCohort%dbdeaddt * freq_day ) + currentCohort%dbh = max(small_no,currentCohort%dbh + currentCohort%ddbhdt * hlm_freq_day ) + currentCohort%balive = currentCohort%balive + currentCohort%dbalivedt * hlm_freq_day + currentCohort%bdead = max(small_no,currentCohort%bdead + currentCohort%dbdeaddt * hlm_freq_day ) if ( DEBUG ) then write(fates_log(),*) 'EDMainMod dbstoredt I ',currentCohort%bstore, & - currentCohort%dbstoredt,freq_day + currentCohort%dbstoredt,hlm_freq_day end if - currentCohort%bstore = currentCohort%bstore + currentCohort%dbstoredt * freq_day + currentCohort%bstore = currentCohort%bstore + currentCohort%dbstoredt * hlm_freq_day if ( DEBUG ) then write(fates_log(),*) 'EDMainMod dbstoredt II ',currentCohort%bstore, & - currentCohort%dbstoredt,freq_day + currentCohort%dbstoredt,hlm_freq_day end if if( (currentCohort%balive+currentCohort%bdead+currentCohort%bstore)*currentCohort%n<0._r8)then @@ -203,10 +214,10 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) currentCohort%bdead,currentCohort%bstore endif - if(abs((currentCohort%balive+currentCohort%bdead+currentCohort%bstore+freq_day*(currentCohort%md+ & + if(abs((currentCohort%balive+currentCohort%bdead+currentCohort%bstore+hlm_freq_day*(currentCohort%md+ & currentCohort%seed_prod)-cohort_biomass_store)-currentCohort%npp_acc) > 1e-8_r8)then write(fates_log(),*) 'issue with c balance in integration', abs(currentCohort%balive+currentCohort%bdead+ & - currentCohort%bstore+freq_day* & + currentCohort%bstore+hlm_freq_day* & (currentCohort%md+currentCohort%seed_prod)-cohort_biomass_store-currentCohort%npp_acc) endif @@ -221,23 +232,19 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) enddo - if ( DEBUG ) then - write(6,*)'DEBUG18: calling non_canopy_derivs with pno= ',currentPatch%clm_pno - endif - call non_canopy_derivs( currentSite, currentPatch, bc_in) !update state variables simultaneously according to derivatives for this time period. ! first update the litter variables that are tracked at the patch level do c = 1,ncwd - currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + currentPatch%dcwd_ag_dt(c)* freq_day - currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + currentPatch%dcwd_bg_dt(c)* freq_day + currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + currentPatch%dcwd_ag_dt(c)* hlm_freq_day + currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + currentPatch%dcwd_bg_dt(c)* hlm_freq_day enddo do ft = 1,numpft_ed - currentPatch%leaf_litter(ft) = currentPatch%leaf_litter(ft) + currentPatch%dleaf_litter_dt(ft)* freq_day - currentPatch%root_litter(ft) = currentPatch%root_litter(ft) + currentPatch%droot_litter_dt(ft)* freq_day + currentPatch%leaf_litter(ft) = currentPatch%leaf_litter(ft) + currentPatch%dleaf_litter_dt(ft)* hlm_freq_day + currentPatch%root_litter(ft) = currentPatch%root_litter(ft) + currentPatch%droot_litter_dt(ft)* hlm_freq_day enddo do c = 1,ncwd @@ -261,7 +268,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) endif if(currentPatch%root_litter(ft) currentPatch%shortest do while(associated(currentCohort)) - currentCohort%n = max(small_no,currentCohort%n + currentCohort%dndt * freq_day ) + currentCohort%n = max(small_no,currentCohort%n + currentCohort%dndt * hlm_freq_day ) currentCohort => currentCohort%taller enddo @@ -282,7 +289,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) ! at the site level, update the seed bank mass do ft = 1,numpft_ed - currentSite%seed_bank(ft) = currentSite%seed_bank(ft) + currentSite%dseed_dt(ft)*freq_day + currentSite%seed_bank(ft) = currentSite%seed_bank(ft) + currentSite%dseed_dt(ft)*hlm_freq_day enddo ! Check for negative values. Write out warning to show carbon balance. @@ -355,7 +362,7 @@ subroutine ed_update_site( currentSite, bc_in ) ! FIX(RF,032414). This needs to be monthly, not annual ! If this is the second to last day of the year, then perform trimming - if( day_of_year == days_per_year-1) then + if( hlm_day_of_year == hlm_days_per_year-1) then write(fates_log(),*) 'calling trim canopy' call trim_canopy(currentSite) diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index ec900b43cd..f080052279 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -1,32 +1,48 @@ module EDTypesMod - use shr_kind_mod , only : r8 => shr_kind_r8; + use FatesConstantsMod , only : r8 => fates_r8 use clm_varpar , only : mxpft - use FatesGlobals , only : cp_nclmax, cp_nlevcan, numpft_ed implicit none save - !SWITCHES THAT ARE READ IN - integer RESTART ! restart flag, 1= read initial system state 0 = bare ground + integer, parameter :: maxPatchesPerSite = 10 ! maximum number of patches to live on a site + integer, parameter :: maxCohortsPerPatch = 160 ! maximum number of cohorts to live on a patch + integer, parameter :: nclmax = 2 ! Maximum number of canopy layers + integer, parameter :: nlevcan = 40 ! number of leaf layers in canopy layer + integer, parameter :: maxpft = 10 ! maximum number of PFTs allowed + ! the parameter file may determine that fewer + ! are used, but this helps allocate scratch + ! space and output arrays. + + integer, parameter :: numpft_ed = 2 ! number of PFTs used in ED. + + ! TODO: we use this cp_maxSWb only because we have a static array (size=2) of + ! land-ice abledo for vis and nir. This should be a parameter, which would + ! get us on track to start using multi-spectral or hyper-spectral (RGK 02-2017) + integer, parameter :: maxSWb = 2 ! maximum number of broad-bands in the + ! shortwave spectrum cp_numSWb <= cp_maxSWb + ! this is just for scratch-array purposes + ! if cp_numSWb is larger than this value + ! simply bump this number up as needed + + ! Module switches (this will be read in one day) + ! This variable only exists now to serve as a place holder + !!!!!!!!!! THIS SHOULD NOT BE SET TO TRUE !!!!!!!!!!!!!!!!! + logical, parameter :: use_fates_plant_hydro = .false. + ! MODEL PARAMETERS - real(r8) :: timestep_secs ! subdaily timestep in seconds (e.g. 1800 or 3600) - real(r8), parameter :: AREA = 10000.0_r8 ! Notional area of simulated forest m2 - integer, parameter :: numWaterMem = 10 ! watermemory saved as site level var ! BIOLOGY/BIOGEOCHEMISTRY - integer , parameter :: INTERNAL_RECRUITMENT = 1 ! internal recruitment fla 1=yes - integer , parameter :: EXTERNAL_RECRUITMENT = 0 ! external recruitment flag 1=yes + integer , parameter :: external_recruitment = 0 ! external recruitment flag 1=yes integer , parameter :: SENES = 10 ! Window of time over which we track temp for cold sensecence (days) real(r8), parameter :: DINC_ED = 1.0_r8 ! size of LAI bins. integer , parameter :: N_DIST_TYPES = 2 ! number of disturbance types (mortality, fire) - integer , parameter :: maxPft = 79 ! max number of PFTs potentially used by CLM - ! SPITFIRE integer , parameter :: NLSC = 6 ! number carbon compartments in above ground litter array @@ -54,9 +70,11 @@ module EDTypesMod real(r8), parameter :: min_npm2 = 1.0d-5 ! minimum cohort number density per m2 before termination real(r8), parameter :: min_patch_area = 0.001_r8 ! smallest allowable patch area before termination real(r8), parameter :: min_nppatch = 1.0d-8 ! minimum number of cohorts per patch (min_npm2*min_patch_area) - real(r8), parameter :: min_n_safemath = 1.0d-15 ! in some cases, we want to immediately remove super small - ! number densities of cohorts to prevent FPEs, this is usually - ! just relevant in the first day after recruitment + + ! in some cases, we want to immediately remove super small + ! number densities of cohorts to prevent FPEs, this is usually + ! just relevant in the first day after recruitment + real(r8), parameter :: min_n_safemath = 1.0E-15_r8 character*4 yearchar @@ -80,7 +98,8 @@ module EDTypesMod ! Number of ways to die ! (background,hydraulic,carbon,impact,fire) - character(len = 10), parameter,dimension(5) :: char_list = (/"background","hydraulic ","carbon ","impact ","fire "/) + character(len = 10), parameter,dimension(nlevmclass_ed) :: char_list = & + (/"background","hydraulic ","carbon ","impact ","fire "/) ! These three vectors are used for history output mapping @@ -90,56 +109,7 @@ module EDTypesMod ! the parameter array sclass_ed. integer , allocatable :: pft_levscpf_ed(:) integer , allocatable :: scls_levscpf_ed(:) - - - ! Control Parameters (cp_) - ! ------------------------------------------------------------------------------------- - - - - integer, parameter :: cp_maxSWb = 2 ! maximum number of broad-bands in the - ! shortwave spectrum cp_numSWb <= cp_maxSWb - ! this is just for scratch-array purposes - ! if cp_numSWb is larger than this value - ! simply bump this number up as needed - ! These parameters are dictated by the host model or driver - - integer :: cp_numSWb ! Number of broad-bands in the short-wave radiation - ! specturm to track - ! (typically 2 as a default, VIS/NIR, in ED variants <2016) - - integer :: cp_numlevgrnd ! Number of ground layers - integer :: cp_numlevsoil ! Number of soil layers - - ! Number of GROUND layers for the purposes of biogeochemistry; can be either 1 - ! or the total number of soil layers (includes bedrock) - integer :: cp_numlevdecomp_full - - ! Number of SOIL layers for the purposes of biogeochemistry; can be either 1 - ! or the total number of soil layers - integer :: cp_numlevdecomp - - ! This character string passed by the HLM is used during the processing of IO - ! data, so that FATES knows which IO variables it should prepare. For instance - ! ATS, ALM and CLM will only want variables specficially packaged for them. - ! This string will dictate which filter is enacted. - character(len=16) :: cp_hlm_name - - ! This value can be flushed to history diagnostics, such that the - ! HLM will interpret that the value should not be included in the average. - real(r8) :: cp_hio_ignore_val - - - ! Is this the master processor, typically useful for knowing if - ! the current machine should be printing out messages to the logs or terminals - ! 1 = TRUE (is master) 0 = FALSE (is not master) - integer :: cp_masterproc - - - ! Module switches (this will be read in one day) - ! This variable only exists now to serve as a place holder - !!!!!!!!!! THIS SHOULD NOT BE SET TO TRUE !!!!!!!!!!!!!!!!! - logical,parameter :: use_fates_plant_hydro = .false. + !************************************ !** COHORT type structure ** @@ -228,8 +198,8 @@ module EDTypesMod real(r8) :: npp_bseed ! NPP into seeds: KgC/indiv/day real(r8) :: npp_store ! NPP into storage: KgC/indiv/day - real(r8) :: ts_net_uptake(cp_nlevcan) ! Net uptake of leaf layers: kgC/m2/s - real(r8) :: year_net_uptake(cp_nlevcan) ! Net uptake of leaf layers: kgC/m2/year + real(r8) :: ts_net_uptake(nlevcan) ! Net uptake of leaf layers: kgC/m2/s + real(r8) :: year_net_uptake(nlevcan) ! Net uptake of leaf layers: kgC/m2/year ! RESPIRATION COMPONENTS real(r8) :: rdark ! Dark respiration: kgC/indiv/s @@ -300,9 +270,6 @@ module EDTypesMod !INDICES integer :: patchno ! unique number given to each new patch created for tracking - ! INTERF-TODO: THIS VARIABLE SHOULD BE REMOVED - integer :: clm_pno ! clm patch number (index of p vector) - ! PATCH INFO real(r8) :: age ! average patch age: years real(r8) :: area ! patch area: m2 @@ -310,42 +277,42 @@ module EDTypesMod integer :: ncl_p ! Number of occupied canopy layers ! LEAF ORGANIZATION - real(r8) :: spread(cp_nclmax) ! dynamic ratio of dbh to canopy area: cm/m2 + real(r8) :: spread(nclmax) ! dynamic ratio of dbh to canopy area: cm/m2 real(r8) :: pft_agb_profile(numpft_ed,n_dbh_bins) ! binned above ground biomass, for patch fusion: KgC/m2 - real(r8) :: canopy_layer_lai(cp_nclmax) ! lai that is shading this canopy layer: m2/m2 + real(r8) :: canopy_layer_lai(nclmax) ! lai that is shading this canopy layer: m2/m2 real(r8) :: total_canopy_area ! area that is covered by vegetation : m2 real(r8) :: total_tree_area ! area that is covered by woody vegetation : m2 real(r8) :: canopy_area ! area that is covered by vegetation : m2 (is this different to total_canopy_area? real(r8) :: bare_frac_area ! bare soil in this patch expressed as a fraction of the total soil surface. real(r8) :: lai ! leaf area index of patch - real(r8) :: tlai_profile(cp_nclmax,numpft_ed,cp_nlevcan) ! total leaf area in each canopy layer, pft, and leaf layer. m2/m2 - real(r8) :: elai_profile(cp_nclmax,numpft_ed,cp_nlevcan) ! exposed leaf area in each canopy layer, pft, and leaf layer. m2/m2 - real(r8) :: tsai_profile(cp_nclmax,numpft_ed,cp_nlevcan) ! total stem area in each canopy layer, pft, and leaf layer. m2/m2 - real(r8) :: esai_profile(cp_nclmax,numpft_ed,cp_nlevcan) ! exposed stem area in each canopy layer, pft, and leaf layer. m2/m2 - real(r8) :: layer_height_profile(cp_nclmax,numpft_ed,cp_nlevcan) - real(r8) :: canopy_area_profile(cp_nclmax,numpft_ed,cp_nlevcan) ! fraction of canopy in each canopy + real(r8) :: tlai_profile(nclmax,numpft_ed,nlevcan) ! total leaf area in each canopy layer, pft, and leaf layer. m2/m2 + real(r8) :: elai_profile(nclmax,numpft_ed,nlevcan) ! exposed leaf area in each canopy layer, pft, and leaf layer. m2/m2 + real(r8) :: tsai_profile(nclmax,numpft_ed,nlevcan) ! total stem area in each canopy layer, pft, and leaf layer. m2/m2 + real(r8) :: esai_profile(nclmax,numpft_ed,nlevcan) ! exposed stem area in each canopy layer, pft, and leaf layer. m2/m2 + real(r8) :: layer_height_profile(nclmax,numpft_ed,nlevcan) + real(r8) :: canopy_area_profile(nclmax,numpft_ed,nlevcan) ! fraction of canopy in each canopy ! layer, pft, and leaf layer:- - integer :: present(cp_nclmax,numpft_ed) ! is there any of this pft in this canopy layer? - integer :: nrad(cp_nclmax,numpft_ed) ! number of exposed leaf layers for each canopy layer and pft - integer :: ncan(cp_nclmax,numpft_ed) ! number of total leaf layers for each canopy layer and pft + integer :: present(nclmax,numpft_ed) ! is there any of this pft in this canopy layer? + integer :: nrad(nclmax,numpft_ed) ! number of exposed leaf layers for each canopy layer and pft + integer :: ncan(nclmax,numpft_ed) ! number of total leaf layers for each canopy layer and pft !RADIATION FLUXES - real(r8) :: fabd_sun_z(cp_nclmax,numpft_ed,cp_nlevcan) ! sun fraction of direct light absorbed by each canopy + real(r8) :: fabd_sun_z(nclmax,numpft_ed,nlevcan) ! sun fraction of direct light absorbed by each canopy ! layer, pft, and leaf layer:- - real(r8) :: fabd_sha_z(cp_nclmax,numpft_ed,cp_nlevcan) ! shade fraction of direct light absorbed by each canopy + real(r8) :: fabd_sha_z(nclmax,numpft_ed,nlevcan) ! shade fraction of direct light absorbed by each canopy ! layer, pft, and leaf layer:- - real(r8) :: fabi_sun_z(cp_nclmax,numpft_ed,cp_nlevcan) ! sun fraction of indirect light absorbed by each canopy + real(r8) :: fabi_sun_z(nclmax,numpft_ed,nlevcan) ! sun fraction of indirect light absorbed by each canopy ! layer, pft, and leaf layer:- - real(r8) :: fabi_sha_z(cp_nclmax,numpft_ed,cp_nlevcan) ! shade fraction of indirect light absorbed by each canopy + real(r8) :: fabi_sha_z(nclmax,numpft_ed,nlevcan) ! shade fraction of indirect light absorbed by each canopy ! layer, pft, and leaf layer:- - real(r8) :: ed_laisun_z(cp_nclmax,numpft_ed,cp_nlevcan) ! amount of LAI in the sun in each canopy layer, + real(r8) :: ed_laisun_z(nclmax,numpft_ed,nlevcan) ! amount of LAI in the sun in each canopy layer, ! pft, and leaf layer. m2/m2 - real(r8) :: ed_laisha_z(cp_nclmax,numpft_ed,cp_nlevcan) ! amount of LAI in the shade in each canopy layer, - real(r8) :: ed_parsun_z(cp_nclmax,numpft_ed,cp_nlevcan) ! PAR absorbed in the sun in each canopy layer, - real(r8) :: ed_parsha_z(cp_nclmax,numpft_ed,cp_nlevcan) ! PAR absorbed in the shade in each canopy layer, - real(r8) :: f_sun(cp_nclmax,numpft_ed,cp_nlevcan) ! fraction of leaves in the sun in each canopy layer, pft, + real(r8) :: ed_laisha_z(nclmax,numpft_ed,nlevcan) ! amount of LAI in the shade in each canopy layer, + real(r8) :: ed_parsun_z(nclmax,numpft_ed,nlevcan) ! PAR absorbed in the sun in each canopy layer, + real(r8) :: ed_parsha_z(nclmax,numpft_ed,nlevcan) ! PAR absorbed in the shade in each canopy layer, + real(r8) :: f_sun(nclmax,numpft_ed,nlevcan) ! fraction of leaves in the sun in each canopy layer, pft, ! and leaf layer. m2/m2 real(r8),allocatable :: tr_soil_dir(:) ! fraction of incoming direct radiation that (cm_numSWb) @@ -367,7 +334,7 @@ module EDTypesMod real(r8) :: seed_germination(numpft_ed) ! germination rate of seed pool in KgC/m2/year ! PHOTOSYNTHESIS - real(r8) :: psn_z(cp_nclmax,numpft_ed,cp_nlevcan) ! carbon assimilation in each canopy layer, pft, and leaf layer. umolC/m2/s + real(r8) :: psn_z(nclmax,numpft_ed,nlevcan) ! carbon assimilation in each canopy layer, pft, and leaf layer. umolC/m2/s real(r8) :: gpp ! total patch gpp: KgC/m2/year real(r8) :: npp ! total patch npp: KgC/m2/year @@ -417,13 +384,13 @@ module EDTypesMod real(r8) :: fuel_frac(ncwd+2) ! fraction of each litter class in the ros_fuel:-. real(r8) :: livegrass ! total aboveground grass biomass in patch. KgC/m2 real(r8) :: fuel_bulkd ! average fuel bulk density of the ground fuel - ! (incl. live grasses. omits 1000hr fuels). KgC/m3 + ! (incl. live grasses. omits 1000hr fuels). KgC/m3 real(r8) :: fuel_sav ! average surface area to volume ratio of the ground fuel - ! (incl. live grasses. omits 1000hr fuels). + ! (incl. live grasses. omits 1000hr fuels). real(r8) :: fuel_mef ! average moisture of extinction factor - ! of the ground fuel (incl. live grasses. omits 1000hr fuels). + ! of the ground fuel (incl. live grasses. omits 1000hr fuels). real(r8) :: fuel_eff_moist ! effective avearage fuel moisture content of the ground fuel - ! (incl. live grasses. omits 1000hr fuels) + ! (incl. live grasses. omits 1000hr fuels) real(r8) :: litter_moisture(ncwd+2) ! FIRE SPREAD @@ -445,8 +412,6 @@ module EDTypesMod contains - procedure, public :: set_root_fraction - end type ed_patch_type !************************************ @@ -516,7 +481,7 @@ module EDTypesMod integer :: leafoffdate ! doy of leaf off:- integer :: dleafondate ! doy of leaf on drought:- integer :: dleafoffdate ! doy of leaf on drought:- - real(r8) :: water_memory(10) ! last 10 days of soil moisture memory... + real(r8) :: water_memory(numWaterMem) ! last 10 days of soil moisture memory... !SEED BANK real(r8) :: seed_bank(numpft_ed) ! seed pool in KgC/m2/year @@ -533,20 +498,6 @@ module EDTypesMod end type ed_site_type - !************************************ - !** Userdata type structure ** - !************************************ - -! type userdata -! integer :: cohort_number ! Counts up the number of cohorts which have been made. -! integer :: n_sub ! num of substeps in year -! real(r8) :: deltat ! fraction of year used for each timestep (1/N_SUB) -! integer :: time_period ! Within year timestep (1:N_SUB) day of year -! integer :: restart_year ! Which year of simulation are we starting in? -! end type userdata -! type(userdata), public, target :: udata ! THIS WAS NOT THREADSAFE - !-------------------------------------------------------------------------------------! - public :: ed_hist_scpfmaps contains @@ -583,76 +534,6 @@ subroutine ed_hist_scpfmaps end subroutine ed_hist_scpfmaps - !-------------------------------------------------------------------------------------! - function map_clmpatch_to_edpatch(site, clmpatch_number) result(edpatch_pointer) - ! - ! !ARGUMENTS - type(ed_site_type), intent(in), target :: site - integer, intent(in) :: clmpatch_number - ! - ! !LOCAL VARIABLES: - type(ed_patch_type), pointer :: edpatch_pointer - !---------------------------------------------------------------------- - - ! There is a one-to-one mapping between edpatches and clmpatches. To obtain - ! this mapping - the following is computed elsewhere in the code base - ! (1) what is the weight respective to the column of clmpatch? - ! dynEDMod determines this via the following logic - ! if (clm_patch%is_veg(p) .or. clm_patch%is_bareground(p)) then - ! clm_patch%wtcol(p) = clm_patch%wt_ed(p) - ! else - ! clm_patch%wtcol(p) = 0.0_r8 - ! end if - ! (2) is the clmpatch active? - ! subgridWeightsMod uses the following logic (in routine is_active_p) to determine if - ! clmpatch_number is active ( this is a shortened version of the logic to capture - ! only the essential parts relevent here) - ! if (clmpatch%wtcol(p) > 0._r8) is_active_p = .true. - - edpatch_pointer => site%oldest_patch - do while ( clmpatch_number /= edpatch_pointer%clm_pno ) - edpatch_pointer => edpatch_pointer%younger - end do - - end function map_clmpatch_to_edpatch - - !-------------------------------------------------------------------------------------! - subroutine set_root_fraction( this , depth_gl) - ! - ! !DESCRIPTION: - ! Calculates the fractions of the root biomass in each layer for each pft. - ! - ! !USES: - use pftconMod , only : pftcon - ! - ! !ARGUMENTS - class(ed_patch_type) :: this - real(r8),intent(in) :: depth_gl(0:cp_numlevgrnd) - ! - ! !LOCAL VARIABLES: - integer :: lev,p,c,ft - !---------------------------------------------------------------------- - - do ft = 1,numpft_ed - do lev = 1, cp_numlevgrnd - this%rootfr_ft(ft,lev) = 0._r8 - enddo - - do lev = 1, cp_numlevsoil-1 - this%rootfr_ft(ft,lev) = .5_r8*( & - exp(-pftcon%roota_par(ft) * depth_gl(lev-1)) & - + exp(-pftcon%rootb_par(ft) * depth_gl(lev-1)) & - - exp(-pftcon%roota_par(ft) * depth_gl(lev)) & - - exp(-pftcon%rootb_par(ft) * depth_gl(lev))) - end do - end do - - end subroutine set_root_fraction - - - ! ===================================================================================== - - end module EDTypesMod diff --git a/components/clm/src/ED/main/FatesConstantsMod.F90 b/components/clm/src/ED/main/FatesConstantsMod.F90 index b7bf5edb9b..8bbf432f5a 100644 --- a/components/clm/src/ED/main/FatesConstantsMod.F90 +++ b/components/clm/src/ED/main/FatesConstantsMod.F90 @@ -64,4 +64,8 @@ module FatesConstantsMod real(fates_r8), parameter :: pi_const = 3.14159265359_fates_r8 + ! Numerical Constants + + + end module FatesConstantsMod diff --git a/components/clm/src/ED/main/FatesGlobals.F90 b/components/clm/src/ED/main/FatesGlobals.F90 index 47bdf6cd19..3a1912b66a 100644 --- a/components/clm/src/ED/main/FatesGlobals.F90 +++ b/components/clm/src/ED/main/FatesGlobals.F90 @@ -5,84 +5,24 @@ module FatesGlobals ! immediately obvious home. use FatesConstantsMod , only : r8 => fates_r8 -! use EDTypesMod , only : cp_nclmax, cp_nlevcan, numpft_ed implicit none public :: FatesGlobalsInit public :: fates_log public :: fates_global_verbose - public :: SetFatesTime - public :: set_fates_global_elements - ! for setting number of patches per gridcell and number of cohorts per patch - ! for I/O and converting to a vector + - integer, parameter :: maxPatchesPerSite = 10 ! maximum number of patches to live on a site - integer, parameter :: maxCohortsPerPatch = 160 ! maximum number of cohorts to live on a patch - ! Variables mostly used for dimensioning host land model (HLM) array spaces - - integer, protected :: maxElementsPerPatch ! maxElementsPerPatch is the value that is ultimately - ! used to set the size of the largest arrays necessary - ! in things like restart files (probably hosted by the - ! HLM). The size of these arrays are not a parameter - ! because it is simply the maximum of several different - ! dimensions. It is possible that this would be the - ! maximum number of cohorts per patch, but - ! but it could be other things. - - integer, protected :: maxElementsPerSite ! This is the max number of individual items one can store per - ! each grid cell and effects the striding in the ED restart - ! data as some fields are arrays where each array is - ! associated with one cohort - - integer, protected :: maxCohortsPerSite ! Maximum number of cohorts that can exist in a given - ! site. Its possible this is not used. - - - integer, parameter :: cp_nclmax = 2 ! Maximum number of canopy layers - - integer, parameter :: cp_nlevcan = 40 ! number of leaf layers in canopy layer - - integer , parameter :: numpft_ed = 2 ! number of PFTs used in ED. - - - ! ------------------------------------------------------------------------------------- - ! Timing Variables - ! It is assumed that all of the sites on a given machine will be synchronous. - ! It is also assumed that the HLM will control time. - ! ------------------------------------------------------------------------------------- - integer, protected :: current_year ! Current year - integer, protected :: current_month ! month of year - integer, protected :: current_day ! day of month - integer, protected :: current_tod ! time of day (seconds past 0Z) - integer, protected :: current_date ! time of day (seconds past 0Z) - integer, protected :: reference_date ! YYYYMMDD - real(r8), protected :: model_day ! elapsed days between current date and reference - integer, protected :: day_of_year ! The integer day of the year - integer, protected :: days_per_year ! The HLM controls time, some HLMs may include a leap - real(r8), protected :: freq_day ! fraction of year for daily time-step (1/days_per_year) - ! this is a frequency - integer, private :: fates_log_ logical, private :: fates_global_verbose_ contains - subroutine set_fates_global_elements() - implicit none - - maxElementsPerPatch = max(maxCohortsPerPatch, & - numpft_ed * cp_nclmax * cp_nlevcan) - - maxCohortsPerSite = maxPatchesPerSite * maxCohortsPerPatch - - maxElementsPerSite = maxPatchesPerSite * maxElementsPerPatch - end subroutine set_fates_global_elements ! ===================================================================================== @@ -135,36 +75,6 @@ end subroutine fates_endrun ! ===================================================================================== - subroutine SetFatesTime(current_year_in, current_month_in, & - current_day_in, current_tod_in, & - current_date_in, reference_date_in, & - model_day_in, day_of_year_in, & - days_per_year_in, freq_day_in) - - ! This subroutine should be called directly from the HLM - - integer, intent(in) :: current_year_in - integer, intent(in) :: current_month_in - integer, intent(in) :: current_day_in - integer, intent(in) :: current_tod_in - integer, intent(in) :: current_date_in - integer, intent(in) :: reference_date_in - real(r8), intent(in) :: model_day_in - integer, intent(in) :: day_of_year_in - integer, intent(in) :: days_per_year_in - real(r8), intent(in) :: freq_day_in - - current_year = current_year_in - current_month = current_month_in - current_day = current_day_in - current_tod = current_tod_in - current_date = current_date_in - reference_date = reference_date_in - model_day = model_day_in - day_of_year = day_of_year_in - days_per_year = days_per_year_in - freq_day = freq_day_in - - end subroutine SetFatesTime + end module FatesGlobals diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index b2b090b24a..868446623b 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -8,7 +8,7 @@ module FatesHistoryInterfaceMod use FatesIODimensionsMod, only : fates_io_dimension_type use FatesIOVariableKindMod, only : fates_io_variable_kind_type use FatesHistoryVariableType, only : fates_history_variable_type - use EDTypesMod , only : cp_hio_ignore_val + use FatesInterfaceMod, only : hlm_hio_ignore_val ! FIXME(bja, 2016-10) need to remove CLM dependancy use pftconMod , only : pftcon @@ -435,8 +435,8 @@ end subroutine flush_hvars subroutine set_history_var(this, vname, units, long, use_default, avgflag, vtype, & hlms, flushval, upfreq, ivar, initialize, index) - use FatesUtilsMod, only : check_hlm_list - use EDTypesMod, only : cp_hlm_name + use FatesUtilsMod, only : check_hlm_list + use FatesInterfaceMod, only : hlm_name implicit none @@ -466,7 +466,7 @@ subroutine set_history_var(this, vname, units, long, use_default, avgflag, vtype logical :: write_var - write_var = check_hlm_list(trim(hlms), trim(cp_hlm_name)) + write_var = check_hlm_list(trim(hlms), trim(hlm_name)) if( write_var ) then ivar = ivar+1 index = ivar @@ -1479,52 +1479,52 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='NEP', units='gC/m^2/s', & long='net ecosystem production', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_nep_si ) call this%set_history_var(vname='Fire_Closs', units='gC/m^2/s', & long='ED/SPitfire Carbon loss to atmosphere', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_fire_c_to_atm_si ) call this%set_history_var(vname='NBP', units='gC/m^2/s', & long='net biosphere production', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_nbp_si ) call this%set_history_var(vname='TOTECOSYSC', units='gC/m^2', & long='total ecosystem carbon', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_totecosysc_si ) call this%set_history_var(vname='CBALANCE_ERROR_ED', units='gC/m^2/s', & long='total carbon balance error on ED side', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cbal_err_fates_si ) call this%set_history_var(vname='CBALANCE_ERROR_BGC', units='gC/m^2/s', & long='total carbon balance error on HLMs BGC side', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cbal_err_bgc_si ) call this%set_history_var(vname='CBALANCE_ERROR_TOTAL', units='gC/m^2/s', & long='total carbon balance error total', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cbal_err_tot_si ) call this%set_history_var(vname='BIOMASS_STOCK_COL', units='gC/m^2', & long='total ED biomass carbon at the column level', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_biomass_stock_si ) call this%set_history_var(vname='ED_LITTER_STOCK_COL', units='gC/m^2', & long='total ED litter carbon at the column level', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_litter_stock_si ) call this%set_history_var(vname='CWD_STOCK_COL', units='gC/m^2', & long='total CWD carbon at the column level', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cwd_stock_si ) diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90 index 569af025f0..cfa31b091c 100644 --- a/components/clm/src/ED/main/FatesInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesInterfaceMod.F90 @@ -9,24 +9,118 @@ module FatesInterfaceMod ! which is allocated by thread ! ------------------------------------------------------------------------------------ - use EDtypesMod , only : ed_site_type - use FatesGlobals , only : maxPatchesPerSite - use FatesGlobals , only : cp_nclmax - use EDtypesMod , only : cp_numSWb - use EDtypesMod , only : cp_numlevgrnd - use EDtypesMod , only : cp_maxSWb - use EDtypesMod , only : cp_numlevdecomp - use EDtypesMod , only : cp_numlevdecomp_full - use EDtypesMod , only : cp_hlm_name - use EDtypesMod , only : cp_hio_ignore_val - use EDtypesMod , only : cp_numlevsoil - use EDtypesMod , only : cp_masterproc - use FatesConstantsMod , only : r8 => fates_r8 + use EDTypesMod , only : ed_site_type + use EDTypesMod , only : maxPatchesPerSite + use EDTypesMod , only : maxCohortsPerPatch + use EDTypesMod , only : maxSWb + use EDTypesMod , only : nclmax + use EDTypesMod , only : nlevcan + use EDTypesMod , only : numpft_ed + use FatesConstantsMod , only : r8 => fates_r8 + use FatesGlobals , only : fates_global_verbose + use FatesGlobals , only : fates_log + implicit none + public :: FatesInterfaceInit + public :: set_fates_ctrlparms + public :: SetFatesTime + public :: set_fates_global_elements + + ! ------------------------------------------------------------------------------------- + ! Parameters that are dictated by the Host Land Model + ! THESE ARE NOT DYNAMIC. SHOULD BE SET ONCE DURING INTIALIZATION. + ! ------------------------------------------------------------------------------------- + + + integer, protected :: hlm_numSWb ! Number of broad-bands in the short-wave radiation + ! specturm to track + ! (typically 2 as a default, VIS/NIR, in ED variants <2016) + + integer, protected :: hlm_numlevgrnd ! Number of ground layers + integer, protected :: hlm_numlevsoil ! Number of soil layers + + + integer, protected :: hlm_numlevdecomp_full ! Number of GROUND layers for the purposes + ! of biogeochemistry; can be either 1 + ! or the total number of soil layers + ! (includes bedrock) + + + integer, protected :: hlm_numlevdecomp ! Number of SOIL layers for the purposes of + ! biogeochemistry; can be either 1 or the total + ! number of soil layers + + + character(len=16), protected :: hlm_name ! This character string passed by the HLM + ! is used during the processing of IO data, + ! so that FATES knows which IO variables it + ! should prepare. For instance + ! ATS, ALM and CLM will only want variables + ! specficially packaged for them. + ! This string sets which filter is enacted. + + + real(r8), protected :: hlm_hio_ignore_val ! This value can be flushed to history + ! diagnostics, such that the + ! HLM will interpret that the value should not + ! be included in the average. + + integer, protected :: hlm_masterproc ! Is this the master processor, typically useful + ! for knowing if the current machine should be + ! printing out messages to the logs or terminals + ! 1 = TRUE (is master) 0 = FALSE (is not master) + + + ! ------------------------------------------------------------------------------------- + ! Parameters that are dictated by FATES and known to be required knowledge + ! needed by the HLMs + ! ------------------------------------------------------------------------------------- + + ! Variables mostly used for dimensioning host land model (HLM) array spaces + + integer, protected :: fates_maxElementsPerPatch ! maxElementsPerPatch is the value that is ultimately + ! used to set the size of the largest arrays necessary + ! in things like restart files (probably hosted by the + ! HLM). The size of these arrays are not a parameter + ! because it is simply the maximum of several different + ! dimensions. It is possible that this would be the + ! maximum number of cohorts per patch, but + ! but it could be other things. + + integer, protected :: fates_maxElementsPerSite ! This is the max number of individual items one can store per + ! each grid cell and effects the striding in the ED restart + ! data as some fields are arrays where each array is + ! associated with one cohort + + + + ! ------------------------------------------------------------------------------------ + ! DYNAMIC BOUNDARY CONDITIONS ! ------------------------------------------------------------------------------------ - ! Notes on types + + + ! ------------------------------------------------------------------------------------- + ! Scalar Timing Variables + ! It is assumed that all of the sites on a given machine will be synchronous. + ! It is also assumed that the HLM will control time. + ! ------------------------------------------------------------------------------------- + integer, protected :: hlm_current_year ! Current year + integer, protected :: hlm_current_month ! month of year + integer, protected :: hlm_current_day ! day of month + integer, protected :: hlm_current_tod ! time of day (seconds past 0Z) + integer, protected :: hlm_current_date ! time of day (seconds past 0Z) + integer, protected :: hlm_reference_date ! YYYYMMDD + real(r8), protected :: hlm_model_day ! elapsed days between current date and ref + integer, protected :: hlm_day_of_year ! The integer day of the year + integer, protected :: hlm_days_per_year ! The HLM controls time, some HLMs may + ! include a leap + real(r8), protected :: hlm_freq_day ! fraction of year for daily time-step + ! (1/days_per_year_, this is a frequency + + ! ------------------------------------------------------------------------------------- + ! Structured Boundary Conditions (SITE/PATCH SCALE) ! For floating point arrays, it is sometimes the convention to define the arrays as ! POINTER instead of ALLOCATABLE. This usually achieves the same result with subtle ! differences. POINTER arrays can point to scalar values, discontinuous array slices @@ -38,8 +132,9 @@ module FatesInterfaceMod ! _pa means patch dimensions ! _rb means radiation band ! ------------------------------------------------------------------------------------ - - + + + type, public :: bc_in_type @@ -317,8 +412,7 @@ module FatesInterfaceMod end type fates_interface_type - public :: FatesInterfaceInit - public :: set_fates_ctrlparms + contains @@ -380,15 +474,15 @@ subroutine allocate_bcin(bc_in) allocate(bc_in%precip24_pa(maxPatchesPerSite)) ! Radiation - allocate(bc_in%solad_parb(maxPatchesPerSite,cp_numSWb)) - allocate(bc_in%solai_parb(maxPatchesPerSite,cp_numSWb)) + allocate(bc_in%solad_parb(maxPatchesPerSite,hlm_numSWb)) + allocate(bc_in%solai_parb(maxPatchesPerSite,hlm_numSWb)) ! Hydrology - allocate(bc_in%smp_gl(cp_numlevgrnd)) - allocate(bc_in%eff_porosity_gl(cp_numlevgrnd)) - allocate(bc_in%watsat_gl(cp_numlevgrnd)) - allocate(bc_in%tempk_gl(cp_numlevgrnd)) - allocate(bc_in%h2o_liqvol_gl(cp_numlevgrnd)) + allocate(bc_in%smp_gl(hlm_numlevgrnd)) + allocate(bc_in%eff_porosity_gl(hlm_numlevgrnd)) + allocate(bc_in%watsat_gl(hlm_numlevgrnd)) + allocate(bc_in%tempk_gl(hlm_numlevgrnd)) + allocate(bc_in%h2o_liqvol_gl(hlm_numlevgrnd)) ! Photosynthesis allocate(bc_in%filter_photo_pa(maxPatchesPerSite)) @@ -400,19 +494,19 @@ subroutine allocate_bcin(bc_in) allocate(bc_in%rb_pa(maxPatchesPerSite)) allocate(bc_in%t_veg_pa(maxPatchesPerSite)) allocate(bc_in%tgcm_pa(maxPatchesPerSite)) - allocate(bc_in%t_soisno_gl(cp_numlevgrnd)) + allocate(bc_in%t_soisno_gl(hlm_numlevgrnd)) ! Canopy Radiation allocate(bc_in%filter_vegzen_pa(maxPatchesPerSite)) allocate(bc_in%coszen_pa(maxPatchesPerSite)) - allocate(bc_in%albgr_dir_rb(cp_numSWb)) - allocate(bc_in%albgr_dif_rb(cp_numSWb)) + allocate(bc_in%albgr_dir_rb(hlm_numSWb)) + allocate(bc_in%albgr_dif_rb(hlm_numSWb)) ! Carbon Balance Checking ! (snow-depth and snow fraction are site level and not vectors) ! Ground layer structure - allocate(bc_in%depth_gl(0:cp_numlevgrnd)) + allocate(bc_in%depth_gl(0:hlm_numlevgrnd)) return end subroutine allocate_bcin @@ -433,8 +527,8 @@ subroutine allocate_bcout(bc_out) allocate(bc_out%laisha_pa(maxPatchesPerSite)) ! Hydrology - allocate(bc_out%active_suction_gl(cp_numlevgrnd)) - allocate(bc_out%rootr_pagl(maxPatchesPerSite,cp_numlevgrnd)) + allocate(bc_out%active_suction_gl(hlm_numlevgrnd)) + allocate(bc_out%rootr_pagl(maxPatchesPerSite,hlm_numlevgrnd)) allocate(bc_out%btran_pa(maxPatchesPerSite)) ! Photosynthesis @@ -443,18 +537,18 @@ subroutine allocate_bcout(bc_out) allocate(bc_out%rssha_pa(maxPatchesPerSite)) ! Canopy Radiation - allocate(bc_out%albd_parb(maxPatchesPerSite,cp_numSWb)) - allocate(bc_out%albi_parb(maxPatchesPerSite,cp_numSWb)) - allocate(bc_out%fabd_parb(maxPatchesPerSite,cp_numSWb)) - allocate(bc_out%fabi_parb(maxPatchesPerSite,cp_numSWb)) - allocate(bc_out%ftdd_parb(maxPatchesPerSite,cp_numSWb)) - allocate(bc_out%ftid_parb(maxPatchesPerSite,cp_numSWb)) - allocate(bc_out%ftii_parb(maxPatchesPerSite,cp_numSWb)) + allocate(bc_out%albd_parb(maxPatchesPerSite,hlm_numSWb)) + allocate(bc_out%albi_parb(maxPatchesPerSite,hlm_numSWb)) + allocate(bc_out%fabd_parb(maxPatchesPerSite,hlm_numSWb)) + allocate(bc_out%fabi_parb(maxPatchesPerSite,hlm_numSWb)) + allocate(bc_out%ftdd_parb(maxPatchesPerSite,hlm_numSWb)) + allocate(bc_out%ftid_parb(maxPatchesPerSite,hlm_numSWb)) + allocate(bc_out%ftii_parb(maxPatchesPerSite,hlm_numSWb)) ! biogeochemistry - allocate(bc_out%FATES_c_to_litr_lab_c_col(cp_numlevdecomp_full)) - allocate(bc_out%FATES_c_to_litr_cel_c_col(cp_numlevdecomp_full)) - allocate(bc_out%FATES_c_to_litr_lig_c_col(cp_numlevdecomp_full)) + allocate(bc_out%FATES_c_to_litr_lab_c_col(hlm_numlevdecomp_full)) + allocate(bc_out%FATES_c_to_litr_cel_c_col(hlm_numlevdecomp_full)) + allocate(bc_out%FATES_c_to_litr_lig_c_col(hlm_numlevdecomp_full)) ! Canopy Structure allocate(bc_out%elai_pa(maxPatchesPerSite)) @@ -540,13 +634,59 @@ subroutine zero_bcs(this,s) return end subroutine zero_bcs - - ! ==================================================================================== - subroutine set_fates_ctrlparms(tag,ival,rval,cval) + + ! =================================================================================== + + subroutine set_fates_global_elements() + implicit none + + fates_maxElementsPerPatch = max(maxCohortsPerPatch, & + numpft_ed * nclmax * nlevcan) + + fates_maxElementsPerSite = maxPatchesPerSite * fates_maxElementsPerPatch + + end subroutine set_fates_global_elements + + ! =================================================================================== + + subroutine SetFatesTime(current_year_in, current_month_in, & + current_day_in, current_tod_in, & + current_date_in, reference_date_in, & + model_day_in, day_of_year_in, & + days_per_year_in, freq_day_in) + + ! This subroutine should be called directly from the HLM + + integer, intent(in) :: current_year_in + integer, intent(in) :: current_month_in + integer, intent(in) :: current_day_in + integer, intent(in) :: current_tod_in + integer, intent(in) :: current_date_in + integer, intent(in) :: reference_date_in + real(r8), intent(in) :: model_day_in + integer, intent(in) :: day_of_year_in + integer, intent(in) :: days_per_year_in + real(r8), intent(in) :: freq_day_in + + hlm_current_year = current_year_in + hlm_current_month = current_month_in + hlm_current_day = current_day_in + hlm_current_tod = current_tod_in + hlm_current_date = current_date_in + hlm_reference_date = reference_date_in + hlm_model_day = model_day_in + hlm_day_of_year = day_of_year_in + hlm_days_per_year = days_per_year_in + hlm_freq_day = freq_day_in + + end subroutine SetFatesTime + + ! ==================================================================================== + + subroutine set_fates_ctrlparms(tag,ival,rval,cval) ! --------------------------------------------------------------------------------- - ! INTERF-TODO: NEED ALLOWANCES FOR REAL AND CHARACTER ARGS.. ! Certain model control parameters and dimensions used by FATES are dictated by ! the the driver or the host mode. To see which parameters should be filled here ! please also look at the ctrl_parms_type in FATESTYpeMod, in the section listing @@ -568,8 +708,6 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) ! RGK-2016 ! --------------------------------------------------------------------------------- - use FatesGlobals, only : fates_log, fates_global_verbose - ! Arguments integer, optional, intent(in) :: ival real(r8), optional, intent(in) :: rval @@ -587,18 +725,18 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) if (fates_global_verbose()) then write(fates_log(), *) 'Flushing FATES control parameters prior to transfer from host' end if - cp_numSwb = unset_int - cp_numlevgrnd = unset_int - cp_numlevsoil = unset_int - cp_numlevdecomp_full = unset_int - cp_numlevdecomp = unset_int - cp_hlm_name = 'unset' - cp_hio_ignore_val = unset_double - cp_masterproc = unset_int + hlm_numSwb = unset_int + hlm_numlevgrnd = unset_int + hlm_numlevsoil = unset_int + hlm_numlevdecomp_full = unset_int + hlm_numlevdecomp = unset_int + hlm_name = 'unset' + hlm_hio_ignore_val = unset_double + hlm_masterproc = unset_int case('check_allset') - if(cp_numSWb .eq. unset_int) then + if(hlm_numSWb .eq. unset_int) then if (fates_global_verbose()) then write(fates_log(), *) 'FATES dimension/parameter unset: num_sw_rad_bbands' end if @@ -606,28 +744,28 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) ! end_run('MESSAGE') end if - if(cp_masterproc .eq. unset_int) then + if(hlm_masterproc .eq. unset_int) then if (fates_global_verbose()) then - write(fates_log(), *) 'FATES parameter unset: cp_masterproc' + write(fates_log(), *) 'FATES parameter unset: hlm_masterproc' end if ! INTERF-TODO: FATES NEEDS INTERNAL end_run ! end_run('MESSAGE') end if - if(cp_numSWb > cp_maxSWb) then + if(hlm_numSWb > maxSWb) then if (fates_global_verbose()) then write(fates_log(), *) 'FATES sets a maximum number of shortwave bands' - write(fates_log(), *) 'for some scratch-space, cp_maxSWb' + write(fates_log(), *) 'for some scratch-space, maxSWb' write(fates_log(), *) 'it defaults to 2, but can be increased as needed' write(fates_log(), *) 'your driver or host model is intending to drive' - write(fates_log(), *) 'FATES with:',cp_numSWb,' bands.' - write(fates_log(), *) 'please increase cp_maxSWb in EDTypes to match' + write(fates_log(), *) 'FATES with:',hlm_numSWb,' bands.' + write(fates_log(), *) 'please increase maxSWb in EDTypes to match' write(fates_log(), *) 'or exceed this value' end if ! end_run('MESSAGE') end if - if(cp_numlevgrnd .eq. unset_int) then + if(hlm_numlevgrnd .eq. unset_int) then if (fates_global_verbose()) then write(fates_log(), *) 'FATES dimension/parameter unset: numlevground' end if @@ -635,7 +773,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) ! end_run('MESSAGE') end if - if(cp_numlevsoil .eq. unset_int) then + if(hlm_numlevsoil .eq. unset_int) then if (fates_global_verbose()) then write(fates_log(), *) 'FATES dimension/parameter unset: numlevground' end if @@ -643,7 +781,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) ! end_run('MESSAGE') end if - if(cp_numlevdecomp_full .eq. unset_int) then + if(hlm_numlevdecomp_full .eq. unset_int) then if (fates_global_verbose()) then write(fates_log(), *) 'FATES dimension/parameter unset: numlevdecomp_full' end if @@ -651,7 +789,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) ! end_run('MESSAGE') end if - if(cp_numlevdecomp .eq. unset_int) then + if(hlm_numlevdecomp .eq. unset_int) then if (fates_global_verbose()) then write(fates_log(), *) 'FATES dimension/parameter unset: numlevdecomp' end if @@ -659,7 +797,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) ! end_run('MESSAGE') end if - if(trim(cp_hlm_name) .eq. 'unset') then + if(trim(hlm_name) .eq. 'unset') then if (fates_global_verbose()) then write(fates_log(),*) 'FATES dimension/parameter unset: hlm_name' end if @@ -667,7 +805,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) ! end_run('MESSAGE') end if - if( abs(cp_hio_ignore_val-unset_double)<1e-10 ) then + if( abs(hlm_hio_ignore_val-unset_double)<1e-10 ) then if (fates_global_verbose()) then write(fates_log(),*) 'FATES dimension/parameter unset: hio_ignore' end if @@ -686,37 +824,37 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) select case (trim(tag)) case('masterproc') - cp_masterproc = ival + hlm_masterproc = ival if (fates_global_verbose()) then write(fates_log(),*) 'Transfering masterproc = ',ival,' to FATES' end if case('num_sw_bbands') - cp_numSwb = ival + hlm_numSwb = ival if (fates_global_verbose()) then write(fates_log(),*) 'Transfering num_sw_bbands = ',ival,' to FATES' end if case('num_lev_ground') - cp_numlevgrnd = ival + hlm_numlevgrnd = ival if (fates_global_verbose()) then write(fates_log(),*) 'Transfering num_lev_ground = ',ival,' to FATES' end if case('num_lev_soil') - cp_numlevsoil = ival + hlm_numlevsoil = ival if (fates_global_verbose()) then write(fates_log(),*) 'Transfering num_lev_ground = ',ival,' to FATES' end if case('num_levdecomp_full') - cp_numlevdecomp_full = ival + hlm_numlevdecomp_full = ival if (fates_global_verbose()) then write(fates_log(),*) 'Transfering num_levdecomp_full = ',ival,' to FATES' end if case('num_levdecomp') - cp_numlevdecomp = ival + hlm_numlevdecomp = ival if (fates_global_verbose()) then write(fates_log(),*) 'Transfering num_levdecomp = ',ival,' to FATES' end if @@ -733,7 +871,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) if(present(rval))then select case (trim(tag)) case ('hio_ignore_val') - cp_hio_ignore_val = rval + hlm_hio_ignore_val = rval if (fates_global_verbose()) then write(fates_log(),*) 'Transfering hio_ignore_val = ',rval,' to FATES' end if @@ -749,7 +887,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) select case (trim(tag)) case('hlm_name') - cp_hlm_name = trim(cval) + hlm_name = trim(cval) if (fates_global_verbose()) then write(fates_log(),*) 'Transfering the HLM name = ',trim(cval) end if @@ -768,5 +906,4 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) end subroutine set_fates_ctrlparms - end module FatesInterfaceMod diff --git a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 index 41de351bd8..6f903da993 100644 --- a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 @@ -854,7 +854,7 @@ subroutine set_restart_var(this,vname,vtype,long_name,units,flushval, & hlms,initialize,ivar,index) use FatesUtilsMod, only : check_hlm_list - use EDTypesMod, only : cp_hlm_name + use FatesInterfaceMod, only : hlm_name ! arguments class(fates_restart_interface_type) :: this @@ -879,7 +879,7 @@ subroutine set_restart_var(this,vname,vtype,long_name,units,flushval, & logical :: use_var - use_var = check_hlm_list(trim(hlms), trim(cp_hlm_name)) + use_var = check_hlm_list(trim(hlms), trim(hlm_name)) if( use_var ) then @@ -905,10 +905,10 @@ end subroutine set_restart_var subroutine set_restart_vectors(this,nc,nsites,sites) - use FatesGlobals, only : cp_nclmax - use FatesGlobals, only : cp_nlevcan - use FatesGlobals, only : maxElementsPerPatch - use FatesGlobals, only : numpft_ed + use EDTypesMod, only : nclmax + use EDTypesMod, only : nlevcan + use FatesInterfaceMod, only : fates_maxElementsPerPatch + use EDTypesMod, only : numpft_ed use EDTypesMod, only : ed_site_type use EDTypesMod, only : ed_cohort_type use EDTypesMod, only : ed_patch_type @@ -1168,18 +1168,18 @@ subroutine set_restart_vectors(this,nc,nsites,sites) io_idx_pa_cwd = io_idx_pa_cwd + 1 end do - do i = 1,cp_nclmax ! cp_nclmax currently 2 + do i = 1,nclmax ! nclmax currently 2 rio_spread_pacl(io_idx_pa_cl) = cpatch%spread(i) io_idx_pa_cl = io_idx_pa_cl + 1 end do if ( DEBUG ) write(fates_log(),*) 'CLTV io_idx_pa_sunz 1 ',io_idx_pa_sunz - if ( DEBUG ) write(fates_log(),*) 'CLTV 1186 ',cp_nlevcan,numpft_ed,cp_nclmax + if ( DEBUG ) write(fates_log(),*) 'CLTV 1186 ',nlevcan,numpft_ed,nclmax - do k = 1,cp_nlevcan ! cp_nlevcan currently 40 + do k = 1,nlevcan ! nlevcan currently 40 do j = 1,numpft_ed ! numpft_ed currently 2 - do i = 1,cp_nclmax ! cp_nclmax currently 2 + do i = 1,nclmax ! nclmax currently 2 rio_fsun_paclftls(io_idx_pa_sunz) = cpatch%f_sun(i,j,k) rio_fabd_sun_z_paclftls(io_idx_pa_sunz) = cpatch%fabd_sun_z(i,j,k) rio_fabi_sun_z_paclftls(io_idx_pa_sunz) = cpatch%fabi_sun_z(i,j,k) @@ -1195,10 +1195,10 @@ subroutine set_restart_vectors(this,nc,nsites,sites) ! Set the first cohort index to the start of the next patch, increment ! by the maximum number of cohorts per patch - io_idx_co_1st = io_idx_co_1st + maxElementsPerPatch + io_idx_co_1st = io_idx_co_1st + fates_maxElementsPerPatch ! reset counters so that they are all advanced evenly. Currently - ! the offset is 10, the max of numpft_ed, ncwd, cp_nclmax, + ! the offset is 10, the max of numpft_ed, ncwd, nclmax, ! io_idx_si_wmem and the number of allowed cohorts per patch io_idx_pa_pft = io_idx_co_1st io_idx_pa_cwd = io_idx_co_1st @@ -1273,10 +1273,10 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites ) use EDTypesMod, only : ed_cohort_type use EDTypesMod, only : ed_patch_type use EDTypesMod, only : ncwd - use FatesGlobals, only : cp_nlevcan - use FatesGlobals, only : cp_nclmax - use FatesGlobals, only : maxElementsPerPatch - use FatesGlobals, only : numpft_ed + use EDTypesMod, only : nlevcan + use EDTypesMod, only : nclmax + use FatesInterfaceMod, only : fates_maxElementsPerPatch + use EDTypesMod, only : numpft_ed use EDTypesMod, only : area use EDPatchDynamicsMod, only : zero_patch use EDGrowthFunctionsMod, only : Dbh @@ -1298,7 +1298,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites ) type(ed_cohort_type), allocatable :: temp_cohort real(r8) :: cwd_ag_local(ncwd) real(r8) :: cwd_bg_local(ncwd) - real(r8) :: spread_local(cp_nclmax) + real(r8) :: spread_local(nclmax) real(r8) :: leaf_litter_local(numpft_ed) real(r8) :: root_litter_local(numpft_ed) real(r8) :: patch_age @@ -1451,7 +1451,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites ) endif - io_idx_co_1st = io_idx_co_1st + maxElementsPerPatch + io_idx_co_1st = io_idx_co_1st + fates_maxElementsPerPatch enddo ! ends loop over idx_pa @@ -1467,11 +1467,11 @@ subroutine get_restart_vectors(this, nc, nsites, sites) use EDTypesMod, only : ed_site_type use EDTypesMod, only : ed_cohort_type use EDTypesMod, only : ed_patch_type - use FatesGlobals, only : numpft_ed + use EDTypesMod, only : numpft_ed use EDTypesMod, only : ncwd - use FatesGlobals, only : cp_nlevcan - use FatesGlobals, only : cp_nclmax - use FatesGlobals, only : maxElementsPerPatch + use EDTypesMod, only : nlevcan + use EDTypesMod, only : nclmax + use FatesInterfaceMod, only : fates_maxElementsPerPatch use EDTypesMod, only : numWaterMem ! !ARGUMENTS: @@ -1718,16 +1718,16 @@ subroutine get_restart_vectors(this, nc, nsites, sites) io_idx_pa_cwd = io_idx_pa_cwd + 1 enddo - do i = 1,cp_nclmax ! cp_nclmax currently 2 + do i = 1,nclmax ! nclmax currently 2 cpatch%spread(i) = rio_spread_pacl(io_idx_pa_cl) io_idx_pa_cl = io_idx_pa_cl + 1 enddo if ( DEBUG ) write(fates_log(),*) 'CVTL io_idx_pa_sunz 1 ',io_idx_pa_sunz - do k = 1,cp_nlevcan ! cp_nlevcan currently 40 + do k = 1,nlevcan ! nlevcan currently 40 do j = 1,numpft_ed ! numpft_ed currently 2 - do i = 1,cp_nclmax ! cp_nclmax currently 2 + do i = 1,nclmax ! nclmax currently 2 cpatch%f_sun(i,j,k) = rio_fsun_paclftls(io_idx_pa_sunz) cpatch%fabd_sun_z(i,j,k) = rio_fabd_sun_z_paclftls(io_idx_pa_sunz) cpatch%fabi_sun_z(i,j,k) = rio_fabi_sun_z_paclftls(io_idx_pa_sunz) @@ -1743,7 +1743,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ! Now increment the position of the first cohort to that of the next ! patch - io_idx_co_1st = io_idx_co_1st + maxElementsPerPatch + io_idx_co_1st = io_idx_co_1st + fates_maxElementsPerPatch ! and max the number of allowed cohorts per patch io_idx_pa_pft = io_idx_co_1st diff --git a/components/clm/src/main/clm_initializeMod.F90 b/components/clm/src/main/clm_initializeMod.F90 index 980749925f..6149513b79 100644 --- a/components/clm/src/main/clm_initializeMod.F90 +++ b/components/clm/src/main/clm_initializeMod.F90 @@ -22,7 +22,7 @@ module clm_initializeMod use PatchType , only : patch ! instance use reweightMod , only : reweight_wrapup use filterMod , only : allocFilters, filter - use FatesGlobals , only : set_fates_global_elements + use FatesInterfaceMod, only : set_fates_global_elements use clm_instMod ! @@ -185,10 +185,10 @@ subroutine initialize1( ) ! it is really a utility dimension that captures the models largest ! size need. ! Sets: - ! maxElementsPerPatch - ! maxElementsPerSite (where a site is roughly equivalent to a column) - ! maxCohortsperSite - ! (Note: maxELementsPerSite is the critical variable used by CLM + ! fates_maxElementsPerPatch + ! fates_maxElementsPerSite (where a site is roughly equivalent to a column) + ! + ! (Note: fates_maxELementsPerSite is the critical variable used by CLM ! to allocate space) ! ------------------------------------------------------------------------ diff --git a/components/clm/src/main/decompInitMod.F90 b/components/clm/src/main/decompInitMod.F90 index a2f33ec61f..430621d25a 100644 --- a/components/clm/src/main/decompInitMod.F90 +++ b/components/clm/src/main/decompInitMod.F90 @@ -20,7 +20,7 @@ module decompInitMod use glcBehaviorMod , only : glc_behavior_type use decompMod use mct_mod - use FatesGlobals , only : maxElementsPerSite + use FatesInterfaceMod, only : fates_maxElementsPerSite ! ! !PUBLIC TYPES: implicit none @@ -733,7 +733,7 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior) ioff(:) = 0 ci = begc do coi = begCohort,endCohort - if ( mod(coi, maxElementsPerSite ) == 0 ) ci = ci + 1 + if ( mod(coi, fates_maxElementsPerSite ) == 0 ) ci = ci + 1 gi = col%gridcell(ci) ! convert column into gridcell gindex(coi) = coStart(gi) + ioff(gi) ioff(gi) = ioff(gi) + 1 diff --git a/components/clm/src/main/subgridMod.F90 b/components/clm/src/main/subgridMod.F90 index c3cbb97f32..f4f082feed 100644 --- a/components/clm/src/main/subgridMod.F90 +++ b/components/clm/src/main/subgridMod.F90 @@ -17,7 +17,7 @@ module subgridMod use clm_varctl , only : iulog use clm_instur , only : wt_lunit, urban_valid, wt_cft use glcBehaviorMod , only : glc_behavior_type - use FatesGlobals , only : maxElementsPerSite + use FatesInterfaceMod, only : fates_maxElementsPerSite implicit none private @@ -163,7 +163,7 @@ subroutine subgrid_get_info_natveg(gi, ncohorts, npatches, ncols, nlunits) ! based on all columns. ! ------------------------------------------------------------------------- - ncohorts = ncols*maxElementsPerSite + ncohorts = ncols*fates_maxElementsPerSite end subroutine subgrid_get_info_natveg diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 63fd277705..5e8cefef1c 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -77,19 +77,19 @@ module CLMFatesInterfaceMod use shr_log_mod , only : errMsg => shr_log_errMsg ! Used FATES Modules - use FatesInterfaceMod , only : fates_interface_type, & - set_fates_ctrlparms, & - allocate_bcin, & - allocate_bcout + use FatesInterfaceMod , only : fates_interface_type + use FatesInterfaceMod , only : allocate_bcin + use FatesInterfaceMod , only : allocate_bcout - use FatesGlobals , only : SetFatesTime + use FatesInterfaceMod , only : SetFatesTime + use FatesInterfaceMod , only : set_fates_ctrlparms use FatesHistoryInterfaceMod, only : fates_history_interface_type use FatesRestartInterfaceMod, only : fates_restart_interface_type use ChecksBalancesMod , only : SummarizeNetFluxes, FATES_BGC_Carbon_BalanceCheck use EDTypesMod , only : ed_patch_type - use EDtypesMod , only : cp_numlevgrnd + use FatesInterfaceMod , only : hlm_numlevgrnd use EDMainMod , only : ed_ecosystem_dynamics use EDMainMod , only : ed_update_site use EDInitMod , only : zero_site @@ -106,7 +106,7 @@ module CLMFatesInterfaceMod use EDPhysiologyMod , only : flux_into_litter_pools implicit none - + type, public :: f2hmap_type ! This is the associated column index of each FATES site @@ -377,7 +377,7 @@ subroutine init_allocate(this) do s = 1, this%fates(nc)%nsites c = this%f2hmap(nc)%fcolumn(s) - this%fates(nc)%bc_in(s)%depth_gl(0:cp_numlevgrnd) = col%zi(c,0:cp_numlevgrnd) + this%fates(nc)%bc_in(s)%depth_gl(0:hlm_numlevgrnd) = col%zi(c,0:hlm_numlevgrnd) end do if( this%fates(nc)%nsites == 0 ) then @@ -730,7 +730,7 @@ subroutine restart( this, bounds_proc, ncid, flag, waterstate_inst, canopystate_ use FatesIODimensionsMod, only: fates_bounds_type use FatesIOVariableKindMod, only : site_r8, site_int, cohort_r8, cohort_int use EDMainMod, only : ed_update_site - use FatesGlobals, only: maxElementsPerSite + use FatesInterfaceMod, only: fates_maxElementsPerSite implicit none @@ -813,7 +813,7 @@ subroutine restart( this, bounds_proc, ncid, flag, waterstate_inst, canopystate_ c = this%f2hmap(nc)%fcolumn(s) this%fates_restart%restart_map(nc)%site_index(s) = c this%fates_restart%restart_map(nc)%cohort1_index(s) = & - bounds_proc%begCohort + (c-bounds_proc%begc)*maxElementsPerSite + 1 + bounds_proc%begCohort + (c-bounds_proc%begc)*fates_maxElementsPerSite + 1 end do end do From ac46e0fcc70fbad1069d9ca34fb6cdb17024e07a Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 26 Jan 2017 21:45:49 -0800 Subject: [PATCH 07/35] added seed homogenization mode to prevent compettive exclusion --- .../clm/src/ED/biogeochem/EDPhysiologyMod.F90 | 41 ++++++++++++++++++- components/clm/src/ED/main/EDTypesMod.F90 | 3 ++ 2 files changed, 43 insertions(+), 1 deletion(-) diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index fccd8c0843..dbec515c9a 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -641,6 +641,7 @@ subroutine seeds_in( currentSite, cp_pnt ) ! ! !USES: use EDTypesMod, only : AREA + use EDTypesMod, only : homogenize_seed_pfts ! ! !ARGUMENTS type(ed_site_type), intent(inout), target :: currentSite @@ -650,12 +651,48 @@ subroutine seeds_in( currentSite, cp_pnt ) type(ed_patch_type), pointer :: currentPatch type(ed_cohort_type), pointer :: currentCohort integer :: p + logical :: pft_present(numpft_ed) + real(r8) :: npfts_present !---------------------------------------------------------------------- currentPatch => cp_pnt currentPatch%seeds_in(:) = 0.0_r8 - + + if ( homogenize_seed_pfts ) then + ! special mode to remove intergenerational filters on PFT existence: each PFT seeds all PFTs + ! first loop over all patches and cohorts to see what and how many PFTs are present on this site + pft_present(:) = .false. + npfts_present = 0._r8 + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + p = currentCohort%pft + if (.not. pft_present(p)) then + pft_present(p) = .true. + npfts_present = npfts_present + 1._r8 + endif + currentCohort => currentCohort%shorter + enddo !cohort loop + currentPatch => currentPatch%younger + enddo ! patch loop + + ! now calculate the homogenized seed flux into each PFT pool + currentPatch => cp_pnt + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + do p = 1, numpft_ed + if (pft_present(p)) then + currentPatch%seeds_in(p) = currentPatch%seeds_in(p) + currentCohort%seed_prod * currentCohort%n / & + (currentPatch%area * npfts_present) + endif + end do + currentCohort => currentCohort%shorter + enddo !cohort loop + else + + ! normal case: each PFT seeds its own type currentCohort => currentPatch%tallest do while (associated(currentCohort)) p = currentCohort%pft @@ -663,6 +700,8 @@ subroutine seeds_in( currentSite, cp_pnt ) currentCohort => currentCohort%shorter enddo !cohort loop + endif + currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index d861559ce3..ff00f13030 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -76,6 +76,9 @@ module EDTypesMod character*4 yearchar + ! special mode to cause PFTs to create seed mass of all currently-existing PFTs + logical, parameter :: homogenize_seed_pfts = .true. + !the lower limit of the size classes of ED cohorts !0-10,10-20... integer, parameter :: nlevsclass_ed = 13 ! Number of dbh size classes for size structure analysis From b84f6b05771425b3f6cf232599c2ed81736de4ca Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 27 Jan 2017 12:31:32 -0800 Subject: [PATCH 08/35] Removed the necessity of allocating fates sites when fates is not running. Combined clm_fates%init and clm_fates%init_allocate. Created a trivial cohort dimensioning scheme for non-fates runs. --- .../clm/src/ED/main/FatesInterfaceMod.F90 | 25 ++++- components/clm/src/main/clm_initializeMod.F90 | 2 +- components/clm/src/main/clm_instMod.F90 | 15 +-- .../clm/src/utils/clmfates_interfaceMod.F90 | 101 +++++++++--------- 4 files changed, 75 insertions(+), 68 deletions(-) diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90 index cfa31b091c..79279454d7 100644 --- a/components/clm/src/ED/main/FatesInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesInterfaceMod.F90 @@ -638,13 +638,30 @@ end subroutine zero_bcs ! =================================================================================== - subroutine set_fates_global_elements() + subroutine set_fates_global_elements(use_fates) implicit none - fates_maxElementsPerPatch = max(maxCohortsPerPatch, & - numpft_ed * nclmax * nlevcan) + logical,intent(in) :: use_fates ! Is fates turned on? - fates_maxElementsPerSite = maxPatchesPerSite * fates_maxElementsPerPatch + if (use_fates) then + + fates_maxElementsPerPatch = max(maxCohortsPerPatch, & + numpft_ed * nclmax * nlevcan) + + fates_maxElementsPerSite = maxPatchesPerSite * fates_maxElementsPerPatch + + else + ! If we are not using FATES, the cohort dimension is still + ! going to be initialized, lets set it to the smallest value + ! possible so that the dimensioning info takes up little space + + fates_maxElementsPerPatch = 1 + + fates_maxElementsPerSite = 1 + + + end if + end subroutine set_fates_global_elements diff --git a/components/clm/src/main/clm_initializeMod.F90 b/components/clm/src/main/clm_initializeMod.F90 index 6149513b79..7545c2425b 100644 --- a/components/clm/src/main/clm_initializeMod.F90 +++ b/components/clm/src/main/clm_initializeMod.F90 @@ -192,7 +192,7 @@ subroutine initialize1( ) ! to allocate space) ! ------------------------------------------------------------------------ - call set_fates_global_elements() + call set_fates_global_elements(use_ed) ! ------------------------------------------------------------------------ ! Determine decomposition of subgrid scale landunits, columns, patches diff --git a/components/clm/src/main/clm_instMod.F90 b/components/clm/src/main/clm_instMod.F90 index 5c321eec47..309e620e96 100644 --- a/components/clm/src/main/clm_instMod.F90 +++ b/components/clm/src/main/clm_instMod.F90 @@ -395,17 +395,10 @@ subroutine clm_instInit(bounds) call crop_inst%Init(bounds) end if - ! NOTE (MV, 10-24-2014): because ed_allsites is currently passed as arguments to - ! biogeophys routines in the present implementation - it needs to be allocated - - ! if use_ed is not set, then this will not contain any significant memory - ! if use_ed is true, then the actual memory for all of the ED data structures - ! is allocated in the call to EDInitMod - called from clm_initialize - ! NOTE (SPM, 10-27-2015) ... check on deallocation of ed_allsites_inst - ! NOTE (RGK, 04-25-2016) : Updating names, ED is now part of FATES - ! Incrementally changing to ED names to FATES - - call clm_fates%Init(bounds,use_ed) - call clm_fates%init_allocate() + + ! Initialize the Functionaly Assembled Terrestrial Ecosystem Simulator (FATES) + ! + call clm_fates%Init(bounds) deallocate (h2osno_col) deallocate (snow_depth_col) diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 5e8cefef1c..e295cce1e7 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -25,7 +25,7 @@ module CLMFatesInterfaceMod ! ! Conventions: ! keep line widths within 90 spaces - ! DLM acronym = Driving Land Model + ! HLM acronym = Host Land Model ! ! ------------------------------------------------------------------------------------- @@ -147,7 +147,6 @@ module CLMFatesInterfaceMod contains procedure, public :: init - procedure, public :: init_allocate procedure, public :: check_hlm_active procedure, public :: restart procedure, public :: init_coldstart @@ -174,10 +173,10 @@ module CLMFatesInterfaceMod ! ==================================================================================== - subroutine init(this, bounds_proc, use_ed) + subroutine init(this, bounds_proc ) ! --------------------------------------------------------------------------------- - ! This initializes the dlm_fates_interface_type + ! This initializes the hlm_fates_interface_type ! ! sites is the root of the ED state hierarchy (instantaneous info on ! the state of the ecosystem). As such, it governs the connection points between @@ -201,26 +200,29 @@ subroutine init(this, bounds_proc, use_ed) ! Input Arguments class(hlm_fates_interface_type), intent(inout) :: this type(bounds_type),intent(in) :: bounds_proc - logical,intent(in) :: use_ed ! NEEDS TO BE PASSED (FOR NOW) - ! BC THE FATES SITE VECTORS - ! NEED TO BE GENERATED - ! FOR NON-ED AS WELL. SO - ! ONLY PART OF THIS MAY BE OPERATIVE + ! local variables integer :: nclumps ! Number of threads logical :: verbose_output integer :: pass_masterproc + integer :: nc ! thread index + integer :: s ! FATES site index + integer :: c ! HLM column index + integer :: l ! HLM LU index + integer :: g ! HLM grid index + integer, allocatable :: collist (:) + type(bounds_type) :: bounds_clump + integer :: nmaxcol + + if(.not.use_ed) return - if (use_ed) then - - ! Initialize the FATES communicators with the HLM - ! This involves to stages - ! 1) allocate the vectors - ! 2) add the history variables defined in clm_inst to the history machinery - call EDecophysconInit( EDpftvarcon_inst, numpft ) - call param_derived%Init(numpft_ed) - end if + ! Initialize the FATES communicators with the HLM + ! This involves to stages + ! 1) allocate the vectors + ! 2) add the history variables defined in clm_inst to the history machinery + call EDecophysconInit( EDpftvarcon_inst, numpft ) + call param_derived%Init( numpft_ed ) verbose_output = .false. call FatesInterfaceInit(iulog, verbose_output) @@ -256,37 +258,11 @@ subroutine init(this, bounds_proc, use_ed) ! Check through FATES parameters to see if all have been set call set_fates_ctrlparms('check_allset') - if(DEBUG)then write(iulog,*) 'clm_fates%init(): allocating for ',nclumps,' threads' end if - end subroutine init - - ! ==================================================================================== - - subroutine init_allocate(this) - implicit none - - ! Input Arguments - class(hlm_fates_interface_type), intent(inout) :: this - ! local variables - integer :: nclumps ! Number of threads - integer :: nc ! thread index - integer :: s ! FATES site index - integer :: c ! HLM column index - integer :: l ! HLM LU index - integer :: g ! HLM grid index - integer, allocatable :: collist (:) - type(bounds_type) :: bounds_clump - type(bounds_type) :: bounds_proc - integer :: nmaxcol - - if(DEBUG)then - write(iulog,*) 'Entering clm_fates%init_allocate' - end if - nclumps = get_proc_clumps() !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,nmaxcol,s,c,l,g,collist) @@ -389,17 +365,15 @@ subroutine init_allocate(this) end do !$OMP END PARALLEL DO - call get_proc_bounds(bounds_proc) + call this%init_history_io(bounds_proc) - end subroutine init_allocate - - - ! ------------------------------------------------------------------------------------ - - subroutine check_hlm_active(this, nc, bounds_clump) + end subroutine init + ! =================================================================================== + + subroutine check_hlm_active(this, nc, bounds_clump) implicit none class(hlm_fates_interface_type), intent(inout) :: this @@ -408,12 +382,14 @@ subroutine check_hlm_active(this, nc, bounds_clump) ! local variables integer :: c + + + if (.not.use_ed) return do c = bounds_clump%begc,bounds_clump%endc ! FATES ACTIVE BUT HLM IS NOT if(this%f2hmap(nc)%hsites(c)>0 .and. .not.col%active(c)) then - write(iulog,*) 'INACTIVE COLUMN WITH ACTIVE FATES SITE' write(iulog,*) 'c = ',c @@ -472,6 +448,8 @@ subroutine dynamics_driv(this, nc, bounds_clump, & real(r8) :: day_of_year !----------------------------------------------------------------------- + if(.not.use_ed) return + ! --------------------------------------------------------------------------------- ! Part I. ! Prepare input boundary conditions for FATES dynamics @@ -616,6 +594,8 @@ subroutine wrap_update_hlmfates_dyn(this, nc, bounds_clump, & integer :: s ! site index integer :: c ! column index + if (.not.use_ed) return + associate( & tlai => canopystate_inst%tlai_patch , & elai => canopystate_inst%elai_patch , & @@ -759,6 +739,8 @@ subroutine restart( this, bounds_proc, ncid, flag, waterstate_inst, canopystate_ logical, save :: initialized = .false. + if (.not.use_ed) return + nclumps = get_proc_clumps() ! --------------------------------------------------------------------------------- @@ -975,6 +957,7 @@ subroutine init_coldstart(this, waterstate_inst, canopystate_inst) integer :: c integer :: g + if(.not.use_ed) return nclumps = get_proc_clumps() @@ -1053,6 +1036,8 @@ subroutine wrap_sunfrac(this,nc,atm2lnd_inst,canopystate_inst) type(ed_patch_type), pointer :: cpatch ! c"urrent" patch INTERF-TODO: SHOULD ! BE HIDDEN AS A FATES PRIVATE + + if(.not.use_ed) return associate( forc_solad => atm2lnd_inst%forc_solad_grc, & forc_solai => atm2lnd_inst%forc_solai_grc, & @@ -1176,6 +1161,8 @@ subroutine wrap_btran(this,nc,fn,filterc,soilstate_inst, waterstate_inst, & integer :: j integer :: ifp integer :: p + + if (.not.use_ed) return associate(& sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) @@ -1348,6 +1335,8 @@ subroutine wrap_photosynthesis(this, nc, bounds, fn, filterp, & integer :: s,c,p,ifp,j,icp real(r8) :: dtime + if (.not.use_ed) return + call t_startf('edpsn') associate(& t_soisno => temperature_inst%t_soisno_col , & @@ -1448,6 +1437,8 @@ subroutine wrap_accumulatefluxes(this, nc, fn, filterp) integer :: s,c,p,ifp,icp real(r8) :: dtime + if (.not.use_ed) return + ! Run a check on the filter do icp = 1,fn p = filterp(icp) @@ -1495,6 +1486,8 @@ subroutine wrap_canopy_radiation(this, bounds_clump, nc, & ! locals integer :: s,c,p,ifp,icp + if (.not.use_ed) return + associate(& albgrd_col => surfalb_inst%albgrd_col , & !in albgri_col => surfalb_inst%albgri_col , & !in @@ -1580,6 +1573,8 @@ subroutine wrap_bgc_summary(this, nc, soilbiogeochem_carbonflux_inst, & logical :: is_beg_day integer :: s,c + if (.not.use_ed) return + associate(& hr => soilbiogeochem_carbonflux_inst%hr_col, & ! (gC/m2/s) total heterotrophic respiration totsomc => soilbiogeochem_carbonstate_inst%totsomc_col, & ! (gC/m2) total soil organic matter carbon @@ -1811,6 +1806,8 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) type(bounds_type), intent(in) :: hlm type(fates_bounds_type), intent(out) :: fates + if (.not.use_ed) return + fates%cohort_begin = hlm%begcohort fates%cohort_end = hlm%endcohort From f844a9478d450c9618f844873a37588b27c1ded3 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 6 Feb 2017 12:41:57 -0800 Subject: [PATCH 09/35] Changed endrun() to require a message. --- components/clm/src/ED/main/FatesGlobals.F90 | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/components/clm/src/ED/main/FatesGlobals.F90 b/components/clm/src/ED/main/FatesGlobals.F90 index 3a1912b66a..dda07ec64c 100644 --- a/components/clm/src/ED/main/FatesGlobals.F90 +++ b/components/clm/src/ED/main/FatesGlobals.F90 @@ -12,11 +12,6 @@ module FatesGlobals public :: fates_log public :: fates_global_verbose - - - - - integer, private :: fates_log_ logical, private :: fates_global_verbose_ @@ -60,13 +55,11 @@ subroutine fates_endrun(msg) ! ! !ARGUMENTS: implicit none - character(len=*), intent(in), optional :: msg ! string to be printed + character(len=*), intent(in) :: msg ! string to be printed !----------------------------------------------------------------------- if (present (msg)) then write(fates_log(),*)'ENDRUN:', msg - else - write(fates_log(),*)'ENDRUN: called without a message string' end if call shr_sys_abort() From 698b6fb75486b6a50214bd6dc955659659f659bb Mon Sep 17 00:00:00 2001 From: ckoven Date: Mon, 6 Feb 2017 13:58:08 -0800 Subject: [PATCH 10/35] added new diagnostics on canopy/understory plants, carbon storage, and carbon mortality --- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 83 +++++++++++++++++-- 1 file changed, 75 insertions(+), 8 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 568b9950d4..f474ffd7fe 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -100,14 +100,15 @@ module FatesHistoryInterfaceMod integer, private :: ih_npp_agsw_si_scpf integer, private :: ih_npp_agdw_si_scpf integer, private :: ih_npp_stor_si_scpf - integer, private :: ih_litt_leaf_si_scpf - integer, private :: ih_litt_fnrt_si_scpf - integer, private :: ih_litt_sawd_si_scpf - integer, private :: ih_litt_ddwd_si_scpf - integer, private :: ih_r_leaf_si_scpf - integer, private :: ih_r_stem_si_scpf - integer, private :: ih_r_root_si_scpf - integer, private :: ih_r_stor_si_scpf + + integer, private :: ih_bstor_canopy_si_scpf + integer, private :: ih_bstor_understory_si_scpf + integer, private :: ih_bleaf_canopy_si_scpf + integer, private :: ih_bleaf_understory_si_scpf + integer, private :: ih_m3_canopy_si_scpf + integer, private :: ih_m3_understory_si_scpf + integer, private :: ih_nplant_canopy_si_scpf + integer, private :: ih_nplant_understory_si_scpf integer, private :: ih_ddbh_si_scpf integer, private :: ih_ba_si_scpf @@ -794,6 +795,14 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_agsw_si_scpf => this%hvars(ih_npp_agsw_si_scpf)%r82d, & hio_npp_agdw_si_scpf => this%hvars(ih_npp_agdw_si_scpf)%r82d, & hio_npp_stor_si_scpf => this%hvars(ih_npp_stor_si_scpf)%r82d, & + hio_bstor_canopy_si_scpf => this%hvars(ih_bstor_canopy_si_scpf)%r82d, & + hio_bstor_understory_si_scpf => this%hvars(ih_bstor_understory_si_scpf)%r82d, & + hio_bleaf_canopy_si_scpf => this%hvars(ih_bleaf_canopy_si_scpf)%r82d, & + hio_bleaf_understory_si_scpf => this%hvars(ih_bleaf_understory_si_scpf)%r82d, & + hio_m3_canopy_si_scpf => this%hvars(ih_m3_canopy_si_scpf)%r82d, & + hio_m3_understory_si_scpf => this%hvars(ih_m3_understory_si_scpf)%r82d, & + hio_nplant_canopy_si_scpf => this%hvars(ih_nplant_canopy_si_scpf)%r82d, & + hio_nplant_understory_si_scpf => this%hvars(ih_nplant_understory_si_scpf)%r82d, & hio_ddbh_si_scpf => this%hvars(ih_ddbh_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, & @@ -989,6 +998,23 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_ddbh_si_scpf(io_si,scpf) = -999.9 end if end if + + ! update SCPF- and canopy/subcanopy- partitioned quantities + if (ccohort%canopy_layer .eq. 1) then + hio_bstor_canopy_si_scpf(io_si,scpf) = hio_bstor_canopy_si_scpf(io_si,scpf) + & + ccohort%bstore * n_perm2 * AREA + hio_bleaf_canopy_si_scpf(io_si,scpf) = hio_bleaf_canopy_si_scpf(io_si,scpf) + & + ccohort%bl * n_perm2 * AREA + hio_m3_canopy_si_scpf(io_si,scpf) = hio_m3_canopy_si_scpf(io_si,scpf) + ccohort%cmort*n_perm2*AREA + hio_nplant_canopy_si_scpf(io_si,scpf) = hio_nplant_canopy_si_scpf(io_si,scpf) + AREA*n_perm2 + else + hio_bstor_understory_si_scpf(io_si,scpf) = hio_bstor_understory_si_scpf(io_si,scpf) + & + ccohort%bstore * n_perm2 + hio_bleaf_understory_si_scpf(io_si,scpf) = hio_bleaf_understory_si_scpf(io_si,scpf) + & + ccohort%bl * n_perm2 + hio_m3_understory_si_scpf(io_si,scpf) = hio_m3_understory_si_scpf(io_si,scpf) + ccohort%cmort*n_perm2*AREA + hio_nplant_understory_si_scpf(io_si,scpf) = hio_nplant_understory_si_scpf(io_si,scpf) + AREA*n_perm2 + endif end associate end if @@ -1651,6 +1677,47 @@ 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_m5_si_scpf ) + call this%set_history_var(vname='M3_CANOPY_SCPF', units = 'N/ha/yr', & + long='carbon starvation mortality of canopy plants count by patch and pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_canopy_si_scpf ) + + call this%set_history_var(vname='BSTOR_CANOPY_SCPF', units = 'kgC/ha', & + long='biomass carbon in storage pools of canopy plants count by patch and pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_bstor_canopy_si_scpf ) + + call this%set_history_var(vname='BLEAF_CANOPY_SCPF', units = 'kgC/ha', & + long='biomass carbon in leaf of canopy plants count by patch and pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_bleaf_canopy_si_scpf ) + + call this%set_history_var(vname='NPLANT_CANOPY_SCPF', units = 'N/ha', & + long='stem number of canopy plants density by patch and pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_canopy_si_scpf ) + + call this%set_history_var(vname='M3_UNDERSTORY_SCPF', units = 'N/ha/yr', & + long='carbon starvation mortality of understory plants count by patch and pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_understory_si_scpf ) + + call this%set_history_var(vname='BSTOR_UNDERSTORY_SCPF', units = 'kgC/ha', & + long='biomass carbon in storage pools of understory plants count by patch and pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_bstor_understory_si_scpf ) + + call this%set_history_var(vname='BLEAF_UNDERSTORY_SCPF', units = 'kgC/ha', & + long='biomass carbon in leaf of understory plants count by patch and pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_bleaf_understory_si_scpf ) + + call this%set_history_var(vname='NPLANT_UNDERSTORY_SCPF', units = 'N/ha', & + long='stem number of understory plants density by patch and pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_scpf ) + + ! Size structured diagnostics that require rapid updates (upfreq=2) call this%set_history_var(vname='AR_SCPF',units = 'kgC/m2/yr', & From e1b5b9b9d6512bc0b4d71f671754d661d026555a Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 6 Feb 2017 14:17:50 -0800 Subject: [PATCH 11/35] Some calls to fates_endrun() were not passing messages. --- components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 | 4 ++-- components/clm/src/ED/main/FatesGlobals.F90 | 5 +---- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index 90cac68551..2eb77c486e 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -1505,7 +1505,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) write(fates_log(), *) 'stem_prof: ', stem_prof(s,:) write(fates_log(), *) 'max_rooting_depth_index_col: ', bc_in(s)%max_rooting_depth_index_col write(fates_log(), *) 'dzsoi_decomp: ', dzsoi_decomp - call endrun() + call endrun(msg=errMsg(sourcefile, __LINE__)) endif ! now check each fine root profile do ft = 1,numpft_ed @@ -1515,7 +1515,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) end do if ( ( abs(froot_prof_sum - 1._r8) > delta ) ) then write(fates_log(), *) 'profile sums: ', froot_prof_sum - call endrun() + call endrun(msg=errMsg(sourcefile, __LINE__)) endif end do end do diff --git a/components/clm/src/ED/main/FatesGlobals.F90 b/components/clm/src/ED/main/FatesGlobals.F90 index dda07ec64c..3d4d561c7a 100644 --- a/components/clm/src/ED/main/FatesGlobals.F90 +++ b/components/clm/src/ED/main/FatesGlobals.F90 @@ -58,10 +58,7 @@ subroutine fates_endrun(msg) character(len=*), intent(in) :: msg ! string to be printed !----------------------------------------------------------------------- - if (present (msg)) then - write(fates_log(),*)'ENDRUN:', msg - end if - + write(fates_log(),*)'ENDRUN:', msg call shr_sys_abort() end subroutine fates_endrun From 4acda0e41267153c99adab7e650431eb3eef3fbb Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 7 Feb 2017 13:33:32 -0800 Subject: [PATCH 12/35] added more canopy/understory diagnostics on ddbh, gpp, and ar --- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 107 ++++++++++++++++-- 1 file changed, 100 insertions(+), 7 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index f474ffd7fe..84e36859db 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -62,6 +62,10 @@ module FatesHistoryInterfaceMod integer, private :: ih_aresp_pa integer, private :: ih_maint_resp_pa integer, private :: ih_growth_resp_pa + integer, private :: ih_ar_canopy_pa + integer, private :: ih_gpp_canopy_pa + integer, private :: ih_ar_understory_pa + integer, private :: ih_gpp_understory_pa ! Indices to (site) variables integer, private :: ih_nep_si @@ -109,6 +113,12 @@ module FatesHistoryInterfaceMod integer, private :: ih_m3_understory_si_scpf integer, private :: ih_nplant_canopy_si_scpf integer, private :: ih_nplant_understory_si_scpf + integer, private :: ih_ddbh_canopy_si_scpf + integer, private :: ih_ddbh_understory_si_scpf + integer, private :: ih_gpp_canopy_si_scpf + integer, private :: ih_gpp_understory_si_scpf + integer, private :: ih_ar_canopy_si_scpf + integer, private :: ih_ar_understory_si_scpf integer, private :: ih_ddbh_si_scpf integer, private :: ih_ba_si_scpf @@ -803,6 +813,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m3_understory_si_scpf => this%hvars(ih_m3_understory_si_scpf)%r82d, & hio_nplant_canopy_si_scpf => this%hvars(ih_nplant_canopy_si_scpf)%r82d, & hio_nplant_understory_si_scpf => this%hvars(ih_nplant_understory_si_scpf)%r82d, & + hio_ddbh_canopy_si_scpf => this%hvars(ih_ddbh_canopy_si_scpf)%r82d, & + hio_ddbh_understory_si_scpf => this%hvars(ih_ddbh_understory_si_scpf)%r82d, & + hio_gpp_canopy_si_scpf => this%hvars(ih_gpp_canopy_si_scpf)%r82d, & + hio_gpp_understory_si_scpf => this%hvars(ih_gpp_understory_si_scpf)%r82d, & + 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_ba_si_scpf => this%hvars(ih_ba_si_scpf)%r82d, & hio_nplant_si_scpf => this%hvars(ih_nplant_si_scpf)%r82d, & @@ -990,13 +1006,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! number density [/ha] hio_nplant_si_scpf(io_si,scpf) = hio_nplant_si_scpf(io_si,scpf) + AREA*n_perm2 - ! Growth Incrments must have NaN check and woody check - if(ccohort%ddbhdt == ccohort%ddbhdt) then - hio_ddbh_si_scpf(io_si,scpf) = hio_ddbh_si_scpf(io_si,scpf) + & - ccohort%ddbhdt*n_perm2*AREA - else - hio_ddbh_si_scpf(io_si,scpf) = -999.9 - end if + ! growth increment + hio_ddbh_si_scpf(io_si,scpf) = hio_ddbh_si_scpf(io_si,scpf) + & + ccohort%ddbhdt*n_perm2*AREA end if ! update SCPF- and canopy/subcanopy- partitioned quantities @@ -1007,6 +1019,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%bl * n_perm2 * AREA hio_m3_canopy_si_scpf(io_si,scpf) = hio_m3_canopy_si_scpf(io_si,scpf) + ccohort%cmort*n_perm2*AREA hio_nplant_canopy_si_scpf(io_si,scpf) = hio_nplant_canopy_si_scpf(io_si,scpf) + AREA*n_perm2 + hio_gpp_canopy_si_scpf(io_si,scpf) = hio_gpp_canopy_si_scpf(io_si,scpf) + & + n_perm2*ccohort%gpp_acc_hold + hio_ar_canopy_si_scpf(io_si,scpf) = hio_ar_canopy_si_scpf(io_si,scpf) + & + n_perm2*ccohort%resp_acc_hold + ! growth increment + hio_ddbh_canopy_si_scpf(io_si,scpf) = hio_ddbh_canopy_si_scpf(io_si,scpf) + & + ccohort%ddbhdt*n_perm2*AREA else hio_bstor_understory_si_scpf(io_si,scpf) = hio_bstor_understory_si_scpf(io_si,scpf) + & ccohort%bstore * n_perm2 @@ -1014,6 +1033,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%bl * n_perm2 hio_m3_understory_si_scpf(io_si,scpf) = hio_m3_understory_si_scpf(io_si,scpf) + ccohort%cmort*n_perm2*AREA hio_nplant_understory_si_scpf(io_si,scpf) = hio_nplant_understory_si_scpf(io_si,scpf) + AREA*n_perm2 + hio_gpp_understory_si_scpf(io_si,scpf) = hio_gpp_understory_si_scpf(io_si,scpf) + & + n_perm2*ccohort%gpp_acc_hold + hio_ar_understory_si_scpf(io_si,scpf) = hio_ar_understory_si_scpf(io_si,scpf) + & + n_perm2*ccohort%resp_acc_hold + ! growth increment + hio_ddbh_understory_si_scpf(io_si,scpf) = hio_ddbh_understory_si_scpf(io_si,scpf) + & + ccohort%ddbhdt*n_perm2*AREA endif end associate @@ -1144,6 +1170,10 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) hio_ar_darkm_si_scpf => this%hvars(ih_ar_darkm_si_scpf)%r82d, & hio_ar_crootm_si_scpf => this%hvars(ih_ar_crootm_si_scpf)%r82d, & hio_ar_frootm_si_scpf => this%hvars(ih_ar_frootm_si_scpf)%r82d, & + hio_gpp_canopy_pa => this%hvars(ih_gpp_canopy_pa)%r81d, & + hio_ar_canopy_pa => this%hvars(ih_ar_canopy_pa)%r81d, & + hio_gpp_understory_pa => this%hvars(ih_gpp_understory_pa)%r81d, & + hio_ar_understory_pa => this%hvars(ih_ar_understory_pa)%r81d, & hio_gpp_si_age => this%hvars(ih_gpp_si_age)%r82d, & hio_npp_si_age => this%hvars(ih_npp_si_age)%r82d & ) @@ -1236,6 +1266,19 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) + ccohort%gpp_tstep * ccohort%n * 1.e3_r8 / dt_tstep hio_npp_si_age(io_si,cpatch%age_class) = hio_npp_si_age(io_si,cpatch%age_class) & + ccohort%npp_tstep * ccohort%n * 1.e3_r8 / dt_tstep + + ! accumulate fluxes on canopy- and understory- separated fluxes + if (ccohort%canopy_layer .eq. 1) then + hio_gpp_canopy_pa(io_pa) = hio_gpp_canopy_pa(io_pa) + & + ccohort%gpp_tstep * 1.e3_r8 * n_density / dt_tstep + hio_ar_canopy_pa(io_pa) = hio_ar_canopy_pa(io_pa) + & + ccohort%resp_tstep * 1.e3_r8 * n_density / dt_tstep + else + hio_gpp_understory_pa(io_pa) = hio_gpp_understory_pa(io_pa) + & + ccohort%gpp_tstep * 1.e3_r8 * n_density / dt_tstep + hio_ar_understory_pa(io_pa) = hio_ar_understory_pa(io_pa) + & + ccohort%resp_tstep * 1.e3_r8 * n_density / dt_tstep + endif end associate endif @@ -1580,6 +1623,26 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_gpp_si_age ) + ! fast fluxes separated canopy/understory + call this%set_history_var(vname='GPP_CANOPY', units='gC/m^2/s', & + long='gross primary production of canopy plants', use_default='active', & + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_gpp_canopy_pa ) + + call this%set_history_var(vname='AR_CANOPY', units='gC/m^2/s', & + long='autotrophic respiration of canopy plants', use_default='active', & + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_ar_canopy_pa ) + + call this%set_history_var(vname='GPP_UNDERSTORY', units='gC/m^2/s', & + long='gross primary production of understory plants', use_default='active', & + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_gpp_understory_pa ) + + call this%set_history_var(vname='AR_UNDERSTORY', units='gC/m^2/s', & + long='autotrophic respiration of understory plants', use_default='active', & + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_ar_understory_pa ) ! Carbon Flux (grid dimension x scpf) (THESE ARE DEFAULT INACTIVE!!! @@ -1591,6 +1654,26 @@ 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_gpp_si_scpf ) + call this%set_history_var(vname='GPP_CANOPY_SCPF', units='kgC/m2/yr', & + long='gross primary production of canopy plants', 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_gpp_canopy_si_scpf ) + + call this%set_history_var(vname='AR_CANOPY_SCPF', units='kgC/m2/yr', & + long='autotrophic respiration of canopy plants', 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_ar_canopy_si_scpf ) + + call this%set_history_var(vname='GPP_UNDERSTORY_SCPF', units='kgC/m2/yr', & + long='gross primary production of understory plants', 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_gpp_understory_si_scpf ) + + call this%set_history_var(vname='AR_UNDERSTORY_SCPF', units='kgC/m2/yr', & + long='autotrophic respiration of understory plants', 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_ar_understory_si_scpf ) + call this%set_history_var(vname='NPP_SCPF', units='kgC/m2/yr', & long='total net primary production', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -1642,6 +1725,16 @@ 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='DDBH_CANOPY_SCPF', units = 'cm/yr/ha', & + long='diameter growth increment and pft/size',use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_canopy_si_scpf ) + + call this%set_history_var(vname='DDBH_UNDERSTORY_SCPF', units = 'cm/yr/ha', & + long='diameter growth increment and pft/size',use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_understory_si_scpf ) + call this%set_history_var(vname='BA_SCPF', units = 'm2/ha', & long='basal area by patch and pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & From 89035ec931618f3c72582bde94d9951164fe0657 Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 7 Feb 2017 14:34:55 -0800 Subject: [PATCH 13/35] fixed a unit error --- components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 84e36859db..9464e693aa 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1028,9 +1028,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%ddbhdt*n_perm2*AREA else hio_bstor_understory_si_scpf(io_si,scpf) = hio_bstor_understory_si_scpf(io_si,scpf) + & - ccohort%bstore * n_perm2 + ccohort%bstore * n_perm2 * AREA hio_bleaf_understory_si_scpf(io_si,scpf) = hio_bleaf_understory_si_scpf(io_si,scpf) + & - ccohort%bl * n_perm2 + ccohort%bl * n_perm2 * AREA hio_m3_understory_si_scpf(io_si,scpf) = hio_m3_understory_si_scpf(io_si,scpf) + ccohort%cmort*n_perm2*AREA hio_nplant_understory_si_scpf(io_si,scpf) = hio_nplant_understory_si_scpf(io_si,scpf) + AREA*n_perm2 hio_gpp_understory_si_scpf(io_si,scpf) = hio_gpp_understory_si_scpf(io_si,scpf) + & From 3fbe65c218d1cbe4e6ab50374b7deb6a868fdf28 Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 8 Feb 2017 15:20:55 -0800 Subject: [PATCH 14/35] added new mortality term to report terminated cohorts and also redefined the newish canopy_area_by_patch_age variable --- .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 4 ++++ components/clm/src/ED/main/EDInitMod.F90 | 3 +++ components/clm/src/ED/main/EDTypesMod.F90 | 3 +++ .../src/ED/main/FatesHistoryInterfaceMod.F90 | 20 +++++++++++++++++-- 4 files changed, 28 insertions(+), 2 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index 2237553ccd..79da24d337 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -559,6 +559,10 @@ subroutine terminate_cohorts( patchptr ) endif if (terminate == 1) then + ! preserve a record of the to-be-terminated cohort for mortality accounting + currentPatch%siteptr%terminated_nindivs(currentCohort%size_by_pft_class) = & + currentPatch%siteptr%terminated_nindivs(currentCohort%size_by_pft_class) + currentCohort%n + if (.not. associated(currentCohort%taller)) then currentPatch%tallest => currentCohort%shorter else diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 index 76bc5ed9b2..5357622447 100755 --- a/components/clm/src/ED/main/EDInitMod.F90 +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -79,6 +79,9 @@ subroutine zero_site( site_in ) site_in%fates_to_bgc_this_ts = 0.0_r8 site_in%fates_to_bgc_last_ts = 0.0_r8 + ! termination info + site_in%terminated_nindivs(:) = 0._r8 + end subroutine zero_site ! ============================================================================ diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index a92283ebbd..19b2cf63f6 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -558,6 +558,9 @@ module EDTypesMod real(r8) :: cwd_ag_burned(ncwd) real(r8) :: leaf_litter_burned(numpft_ed) + ! TERMINATION + real(r8) :: terminated_nindivs(1:nlevsclass_ed*mxpft) ! number of individuals that were in cohorts which were terminated this timestep on scpf array + end type ed_site_type !************************************ diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 9464e693aa..8735697bee 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -127,6 +127,7 @@ module FatesHistoryInterfaceMod integer, private :: ih_m3_si_scpf integer, private :: ih_m4_si_scpf integer, private :: ih_m5_si_scpf + integer, private :: ih_m6_si_scpf integer, private :: ih_ar_si_scpf integer, private :: ih_ar_grow_si_scpf @@ -729,6 +730,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) nlevsclass_ed, & levage_ed, & nlevage_ed, & + mxpft, & levpft_ed use EDParamsMod , only : ED_val_ag_biomass @@ -748,6 +750,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: lb1,ub1,lb2,ub2 ! IO array bounds for the calling thread integer :: ivar ! index of IO variable object vector integer :: ft ! functional type index + integer :: i_scpf ! iterator for scpf dim real(r8) :: n_density ! individual of cohort per m2. real(r8) :: n_perm2 ! individuals per m2 for the whole column @@ -827,6 +830,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m3_si_scpf => this%hvars(ih_m3_si_scpf)%r82d, & hio_m4_si_scpf => this%hvars(ih_m4_si_scpf)%r82d, & hio_m5_si_scpf => this%hvars(ih_m5_si_scpf)%r82d, & + hio_m6_si_scpf => this%hvars(ih_m6_si_scpf)%r82d, & hio_ba_si_scls => this%hvars(ih_ba_si_scls)%r82d, & hio_area_si_age => this%hvars(ih_area_si_age)%r82d, & hio_lai_si_age => this%hvars(ih_lai_si_age)%r82d, & @@ -873,8 +877,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! Increment some patch-age-resolved diagnostics hio_lai_si_age(io_si,cpatch%age_class) = hio_lai_si_age(io_si,cpatch%age_class) & + cpatch%lai * cpatch%area - hio_canopy_area_si_age(io_si,cpatch%age_class) = hio_canopy_area_si_age(io_si,cpatch%age_class) & - + cpatch%canopy_area/AREA hio_ncl_si_age(io_si,cpatch%age_class) = hio_ncl_si_age(io_si,cpatch%age_class) & + cpatch%ncl_p * cpatch%area hio_npatches_si_age(io_si,cpatch%age_class) = hio_npatches_si_age(io_si,cpatch%age_class) + 1._r8 @@ -918,6 +920,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_area_treespread_pa(io_pa) = 0.0_r8 end if + hio_canopy_area_si_age(io_si,cpatch%age_class) = hio_canopy_area_si_age(io_si,cpatch%age_class) & + + ccohort%c_area/AREA + ! Update biomass components hio_bleaf_pa(io_pa) = hio_bleaf_pa(io_pa) + n_density * ccohort%bl * 1.e3_r8 hio_bstore_pa(io_pa) = hio_bstore_pa(io_pa) + n_density * ccohort%bstore * 1.e3_r8 @@ -1103,6 +1108,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_ncl_si_age(io_si, ipa2) = 0._r8 endif end do + + ! pass the cohort termination mortality as a flux to the history, and then reset the termination mortality buffer + do i_scpf = 1, nlevsclass_ed * mxpft + hio_m6_si_scpf(io_si,i_scpf) = sites(s)%terminated_nindivs(i_scpf) * yeardays + end do + sites(s)%terminated_nindivs(:) = 0._r8 enddo ! site loop @@ -1770,6 +1781,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_m5_si_scpf ) + call this%set_history_var(vname='M6_SCPF', units = 'N/ha/yr', & + long='termination mortality count by patch and pft/size',use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m6_si_scpf ) + call this%set_history_var(vname='M3_CANOPY_SCPF', units = 'N/ha/yr', & long='carbon starvation mortality of canopy plants count by patch and pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & From bdf1219e00d7513e7048f973e5e0f1227dec4a2b Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 9 Feb 2017 13:20:29 -0800 Subject: [PATCH 15/35] added a recruitment rate variable to history so that we can ensure conservation of individuals --- .../clm/src/ED/biogeochem/EDPhysiologyMod.F90 | 3 +++ components/clm/src/ED/main/EDInitMod.F90 | 3 ++- components/clm/src/ED/main/EDTypesMod.F90 | 5 +++-- .../clm/src/ED/main/FatesHistoryInterfaceMod.F90 | 15 ++++++++++++++- 4 files changed, 22 insertions(+), 4 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index c127a0b585..273625b404 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -1072,6 +1072,9 @@ subroutine recruitment( t, currentSite, currentPatch ) call create_cohort(currentPatch, temp_cohort%pft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & temp_cohort%balive, temp_cohort%bdead, temp_cohort%bstore, & temp_cohort%laimemory, cohortstatus, temp_cohort%canopy_trim, currentPatch%NCL_p) + + ! keep track of how many individuals were recruited for passing to history + currentPatch%siteptr%recruitment_rate(ft) = currentPatch%siteptr%recruitment_rate(ft) + temp_cohort%n endif enddo !pft loop diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 index 5357622447..082942fca9 100755 --- a/components/clm/src/ED/main/EDInitMod.F90 +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -79,8 +79,9 @@ subroutine zero_site( site_in ) site_in%fates_to_bgc_this_ts = 0.0_r8 site_in%fates_to_bgc_last_ts = 0.0_r8 - ! termination info + ! termination and recruitment info site_in%terminated_nindivs(:) = 0._r8 + site_in%recruitment_rate(:) = 0._r8 end subroutine zero_site diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 19b2cf63f6..400ae2bb3c 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -67,7 +67,7 @@ module EDTypesMod integer , parameter :: N_DBH_BINS = 5 ! no. of dbh bins used when comparing patches - real(r8), parameter :: min_npm2 = 1.0d-5 ! minimum cohort number density per m2 before termination + real(r8), parameter :: min_npm2 = 1.0d-5 ! minimum cohort number density per m2 before termintion real(r8), parameter :: min_patch_area = 0.001_r8 ! smallest allowable patch area before termination real(r8), parameter :: min_nppatch = 1.0d-8 ! minimum number of cohorts per patch (min_npm2*min_patch_area) real(r8), parameter :: min_n_safemath = 1.0d-15 ! in some cases, we want to immediately remove super small @@ -558,8 +558,9 @@ module EDTypesMod real(r8) :: cwd_ag_burned(ncwd) real(r8) :: leaf_litter_burned(numpft_ed) - ! TERMINATION + ! TERMINATION AND RECRUITMENT real(r8) :: terminated_nindivs(1:nlevsclass_ed*mxpft) ! number of individuals that were in cohorts which were terminated this timestep on scpf array + real(r8) :: recruitment_rate(1:mxpft) ! number of individuals that were recruited into new cohorts end type ed_site_type diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 8735697bee..144178c59f 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -145,6 +145,7 @@ module FatesHistoryInterfaceMod integer, private :: ih_leafbiomass_si_pft integer, private :: ih_storebiomass_si_pft integer, private :: ih_nindivs_si_pft + integer, private :: ih_recruitment_si_pft ! indices to (site x patch-age) variables @@ -750,7 +751,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: lb1,ub1,lb2,ub2 ! IO array bounds for the calling thread integer :: ivar ! index of IO variable object vector integer :: ft ! functional type index - integer :: i_scpf ! iterator for scpf dim + integer :: i_scpf,i_pft ! iterators for scpf and pft dims real(r8) :: n_density ! individual of cohort per m2. real(r8) :: n_perm2 ! individuals per m2 for the whole column @@ -775,6 +776,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_leafbiomass_si_pft => this%hvars(ih_leafbiomass_si_pft)%r82d, & hio_storebiomass_si_pft => this%hvars(ih_storebiomass_si_pft)%r82d, & hio_nindivs_si_pft => this%hvars(ih_nindivs_si_pft)%r82d, & + hio_recruitment_si_pft => this%hvars(ih_recruitment_si_pft)%r82d, & hio_nesterov_fire_danger_pa => this%hvars(ih_nesterov_fire_danger_pa)%r81d, & hio_spitfire_ros_pa => this%hvars(ih_spitfire_ROS_pa)%r81d, & hio_tfc_ros_pa => this%hvars(ih_TFC_ROS_pa)%r81d, & @@ -1114,6 +1116,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m6_si_scpf(io_si,i_scpf) = sites(s)%terminated_nindivs(i_scpf) * yeardays end do sites(s)%terminated_nindivs(:) = 0._r8 + + ! pass the recruitment rate as a flux to the history, and then reset the recruitment buffer + do i_pft = 1, mxpft + hio_recruitment_si_pft(io_si,i_pft) = sites(s)%recruitment_rate(i_pft) * yeardays + end do + sites(s)%recruitment_rate(:) = 0._r8 enddo ! site loop @@ -1443,6 +1451,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_nindivs_si_pft ) + call this%set_history_var(vname='RECRUITMENT', units='indiv/ha/yr', & + long='Rate of recruitment by PFT', use_default='active', & + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_recruitment_si_pft ) + ! patch age class variables call this%set_history_var(vname='PATCH_AREA_BY_AGE', units='m2/m2', & long='patch area by age bin', use_default='active', & From f2d8da8d473cfdcda79192fbd996e4f0c05770ef Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 9 Feb 2017 15:06:25 -0800 Subject: [PATCH 16/35] cleanup, new default-on scls summary vars, and aggregation of canopy/understory scpf mortality rates --- .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 10 +- components/clm/src/ED/main/EDInitMod.F90 | 2 +- components/clm/src/ED/main/EDTypesMod.F90 | 6 +- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 127 ++++++++++++++---- 4 files changed, 112 insertions(+), 33 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index 79da24d337..edbfdd34ea 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -498,6 +498,7 @@ subroutine terminate_cohorts( patchptr ) type (ed_cohort_type) , pointer :: nextc integer :: terminate ! do we terminate (1) or not (0) integer :: c ! counter for litter size class. + integer :: levcan ! canopy level !---------------------------------------------------------------------- currentPatch => patchptr @@ -560,8 +561,13 @@ subroutine terminate_cohorts( patchptr ) if (terminate == 1) then ! preserve a record of the to-be-terminated cohort for mortality accounting - currentPatch%siteptr%terminated_nindivs(currentCohort%size_by_pft_class) = & - currentPatch%siteptr%terminated_nindivs(currentCohort%size_by_pft_class) + currentCohort%n + if (currentCohort%canopy_layer .eq. 1) then + levcan = 1 + else + levcan = 2 + endif + currentPatch%siteptr%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) = & + currentPatch%siteptr%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) + currentCohort%n if (.not. associated(currentCohort%taller)) then currentPatch%tallest => currentCohort%shorter diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 index 082942fca9..a9b9a98736 100755 --- a/components/clm/src/ED/main/EDInitMod.F90 +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -80,7 +80,7 @@ subroutine zero_site( site_in ) site_in%fates_to_bgc_last_ts = 0.0_r8 ! termination and recruitment info - site_in%terminated_nindivs(:) = 0._r8 + site_in%terminated_nindivs(:,:,:) = 0._r8 site_in%recruitment_rate(:) = 0._r8 end subroutine zero_site diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 400ae2bb3c..48eeb96c5a 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -67,7 +67,7 @@ module EDTypesMod integer , parameter :: N_DBH_BINS = 5 ! no. of dbh bins used when comparing patches - real(r8), parameter :: min_npm2 = 1.0d-5 ! minimum cohort number density per m2 before termintion + real(r8), parameter :: min_npm2 = 1.0d-5 ! minimum cohort number density per m2 before termination real(r8), parameter :: min_patch_area = 0.001_r8 ! smallest allowable patch area before termination real(r8), parameter :: min_nppatch = 1.0d-8 ! minimum number of cohorts per patch (min_npm2*min_patch_area) real(r8), parameter :: min_n_safemath = 1.0d-15 ! in some cases, we want to immediately remove super small @@ -558,8 +558,8 @@ module EDTypesMod real(r8) :: cwd_ag_burned(ncwd) real(r8) :: leaf_litter_burned(numpft_ed) - ! TERMINATION AND RECRUITMENT - real(r8) :: terminated_nindivs(1:nlevsclass_ed*mxpft) ! number of individuals that were in cohorts which were terminated this timestep on scpf array + ! TERMINATION AND RECRUITMENT~ + real(r8) :: terminated_nindivs(1:nlevsclass_ed,1:mxpft,2) ! number of individuals that were in cohorts which were terminated this timestep, on size x pft x canopy array. real(r8) :: recruitment_rate(1:mxpft) ! number of individuals that were recruited into new cohorts end type ed_site_type diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 144178c59f..8c8702e746 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -109,8 +109,8 @@ module FatesHistoryInterfaceMod integer, private :: ih_bstor_understory_si_scpf integer, private :: ih_bleaf_canopy_si_scpf integer, private :: ih_bleaf_understory_si_scpf - integer, private :: ih_m3_canopy_si_scpf - integer, private :: ih_m3_understory_si_scpf + integer, private :: ih_mortality_canopy_si_scpf + integer, private :: ih_mortality_understory_si_scpf integer, private :: ih_nplant_canopy_si_scpf integer, private :: ih_nplant_understory_si_scpf integer, private :: ih_ddbh_canopy_si_scpf @@ -139,6 +139,10 @@ module FatesHistoryInterfaceMod ! indices to (site x scls) variables integer, private :: ih_ba_si_scls + integer, private :: ih_nplant_canopy_si_scls + integer, private :: ih_nplant_understory_si_scls + integer, private :: ih_mortality_canopy_si_scls + integer, private :: ih_mortality_understory_si_scls ! indices to (site x pft) variables integer, private :: ih_biomass_si_pft @@ -146,6 +150,7 @@ module FatesHistoryInterfaceMod integer, private :: ih_storebiomass_si_pft integer, private :: ih_nindivs_si_pft integer, private :: ih_recruitment_si_pft + integer, private :: ih_mortality_si_pft ! indices to (site x patch-age) variables @@ -751,7 +756,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: lb1,ub1,lb2,ub2 ! IO array bounds for the calling thread integer :: ivar ! index of IO variable object vector integer :: ft ! functional type index - integer :: i_scpf,i_pft ! iterators for scpf and pft dims + integer :: i_scpf,i_pft,i_scls ! iterators for scpf, pft, and scls dims real(r8) :: n_density ! individual of cohort per m2. real(r8) :: n_perm2 ! individuals per m2 for the whole column @@ -777,6 +782,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_storebiomass_si_pft => this%hvars(ih_storebiomass_si_pft)%r82d, & hio_nindivs_si_pft => this%hvars(ih_nindivs_si_pft)%r82d, & hio_recruitment_si_pft => this%hvars(ih_recruitment_si_pft)%r82d, & + hio_mortality_si_pft => this%hvars(ih_mortality_si_pft)%r82d, & hio_nesterov_fire_danger_pa => this%hvars(ih_nesterov_fire_danger_pa)%r81d, & hio_spitfire_ros_pa => this%hvars(ih_spitfire_ROS_pa)%r81d, & hio_tfc_ros_pa => this%hvars(ih_TFC_ROS_pa)%r81d, & @@ -814,8 +820,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_bstor_understory_si_scpf => this%hvars(ih_bstor_understory_si_scpf)%r82d, & hio_bleaf_canopy_si_scpf => this%hvars(ih_bleaf_canopy_si_scpf)%r82d, & hio_bleaf_understory_si_scpf => this%hvars(ih_bleaf_understory_si_scpf)%r82d, & - hio_m3_canopy_si_scpf => this%hvars(ih_m3_canopy_si_scpf)%r82d, & - hio_m3_understory_si_scpf => this%hvars(ih_m3_understory_si_scpf)%r82d, & + hio_mortality_canopy_si_scpf => this%hvars(ih_mortality_canopy_si_scpf)%r82d, & + hio_mortality_understory_si_scpf => this%hvars(ih_mortality_understory_si_scpf)%r82d, & hio_nplant_canopy_si_scpf => this%hvars(ih_nplant_canopy_si_scpf)%r82d, & hio_nplant_understory_si_scpf => this%hvars(ih_nplant_understory_si_scpf)%r82d, & hio_ddbh_canopy_si_scpf => this%hvars(ih_ddbh_canopy_si_scpf)%r82d, & @@ -834,6 +840,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m5_si_scpf => this%hvars(ih_m5_si_scpf)%r82d, & hio_m6_si_scpf => this%hvars(ih_m6_si_scpf)%r82d, & hio_ba_si_scls => this%hvars(ih_ba_si_scls)%r82d, & + hio_nplant_canopy_si_scls => this%hvars(ih_nplant_canopy_si_scls)%r82d, & + hio_nplant_understory_si_scls => this%hvars(ih_nplant_understory_si_scls)%r82d, & + hio_mortality_canopy_si_scls => this%hvars(ih_mortality_canopy_si_scls)%r82d, & + hio_mortality_understory_si_scls => this%hvars(ih_mortality_understory_si_scls)%r82d, & hio_area_si_age => this%hvars(ih_area_si_age)%r82d, & hio_lai_si_age => this%hvars(ih_lai_si_age)%r82d, & hio_canopy_area_si_age => this%hvars(ih_canopy_area_si_age)%r82d, & @@ -1018,14 +1028,16 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%ddbhdt*n_perm2*AREA end if - ! update SCPF- and canopy/subcanopy- partitioned quantities + ! update SCPF/SCLS- and canopy/subcanopy- partitioned quantities if (ccohort%canopy_layer .eq. 1) then hio_bstor_canopy_si_scpf(io_si,scpf) = hio_bstor_canopy_si_scpf(io_si,scpf) + & ccohort%bstore * n_perm2 * AREA hio_bleaf_canopy_si_scpf(io_si,scpf) = hio_bleaf_canopy_si_scpf(io_si,scpf) + & ccohort%bl * n_perm2 * AREA - hio_m3_canopy_si_scpf(io_si,scpf) = hio_m3_canopy_si_scpf(io_si,scpf) + ccohort%cmort*n_perm2*AREA + hio_mortality_canopy_si_scpf(io_si,scpf) = hio_mortality_canopy_si_scpf(io_si,scpf)+ & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * n_perm2*AREA hio_nplant_canopy_si_scpf(io_si,scpf) = hio_nplant_canopy_si_scpf(io_si,scpf) + AREA*n_perm2 + hio_nplant_canopy_si_scls(io_si,scls) = hio_nplant_canopy_si_scls(io_si,scls) + AREA*n_perm2 hio_gpp_canopy_si_scpf(io_si,scpf) = hio_gpp_canopy_si_scpf(io_si,scpf) + & n_perm2*ccohort%gpp_acc_hold hio_ar_canopy_si_scpf(io_si,scpf) = hio_ar_canopy_si_scpf(io_si,scpf) + & @@ -1033,13 +1045,18 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! growth increment hio_ddbh_canopy_si_scpf(io_si,scpf) = hio_ddbh_canopy_si_scpf(io_si,scpf) + & ccohort%ddbhdt*n_perm2*AREA + ! sum of all mortality + hio_mortality_canopy_si_scls(io_si,scls) = hio_mortality_canopy_si_scls(io_si,scls) + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * n_perm2*AREA else hio_bstor_understory_si_scpf(io_si,scpf) = hio_bstor_understory_si_scpf(io_si,scpf) + & ccohort%bstore * n_perm2 * AREA hio_bleaf_understory_si_scpf(io_si,scpf) = hio_bleaf_understory_si_scpf(io_si,scpf) + & ccohort%bl * n_perm2 * AREA - hio_m3_understory_si_scpf(io_si,scpf) = hio_m3_understory_si_scpf(io_si,scpf) + ccohort%cmort*n_perm2*AREA + hio_mortality_understory_si_scpf(io_si,scpf) = hio_mortality_understory_si_scpf(io_si,scpf)+ & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * n_perm2*AREA hio_nplant_understory_si_scpf(io_si,scpf) = hio_nplant_understory_si_scpf(io_si,scpf) + AREA*n_perm2 + hio_nplant_understory_si_scls(io_si,scls) = hio_nplant_understory_si_scls(io_si,scls) + AREA*n_perm2 hio_gpp_understory_si_scpf(io_si,scpf) = hio_gpp_understory_si_scpf(io_si,scpf) + & n_perm2*ccohort%gpp_acc_hold hio_ar_understory_si_scpf(io_si,scpf) = hio_ar_understory_si_scpf(io_si,scpf) + & @@ -1047,6 +1064,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! growth increment hio_ddbh_understory_si_scpf(io_si,scpf) = hio_ddbh_understory_si_scpf(io_si,scpf) + & ccohort%ddbhdt*n_perm2*AREA + ! sum of all mortality + hio_mortality_understory_si_scls(io_si,scls) = hio_mortality_understory_si_scls(io_si,scls) + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * n_perm2*AREA endif end associate @@ -1112,16 +1132,43 @@ subroutine update_history_dyn(this,nc,nsites,sites) end do ! pass the cohort termination mortality as a flux to the history, and then reset the termination mortality buffer - do i_scpf = 1, nlevsclass_ed * mxpft - hio_m6_si_scpf(io_si,i_scpf) = sites(s)%terminated_nindivs(i_scpf) * yeardays + ! note there are various ways of reporting the total mortality, so pass to these as well + do i_pft = 1, mxpft + do i_scls = 1,nlevsclass_ed + hio_m6_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) = (sites(s)%terminated_nindivs(i_pft,i_scls,1) + & + sites(s)%terminated_nindivs(i_scls,i_pft,2)) * yeardays + hio_mortality_canopy_si_scls(io_si,i_pft) = hio_mortality_canopy_si_scls(io_si,i_pft) + & + sites(s)%terminated_nindivs(i_scls,i_pft,1) * yeardays + hio_mortality_understory_si_scls(io_si,i_pft) = hio_mortality_understory_si_scls(io_si,i_pft) + & + sites(s)%terminated_nindivs(i_scls,i_pft,2) * yeardays + hio_mortality_canopy_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) = & + hio_mortality_canopy_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) + & + sites(s)%terminated_nindivs(i_scls,i_pft,1) * yeardays + hio_mortality_understory_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) = & + hio_mortality_understory_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) + & + sites(s)%terminated_nindivs(i_scls,i_pft,2) * yeardays + end do end do - sites(s)%terminated_nindivs(:) = 0._r8 + sites(s)%terminated_nindivs(:,:,:) = 0._r8 ! pass the recruitment rate as a flux to the history, and then reset the recruitment buffer do i_pft = 1, mxpft hio_recruitment_si_pft(io_si,i_pft) = sites(s)%recruitment_rate(i_pft) * yeardays end do sites(s)%recruitment_rate(:) = 0._r8 + + ! summarize all of the mortality fluxes by PFT + do i_pft = 1, mxpft + do i_scls = 1,nlevsclass_ed + hio_mortality_si_pft(io_si,i_pft) = hio_mortality_si_pft(io_si,i_pft) + & + hio_m1_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) + & + hio_m2_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) + & + hio_m3_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) + & + hio_m4_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) + & + hio_m5_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) + & + hio_m6_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) + end do + end do enddo ! site loop @@ -1456,6 +1503,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_recruitment_si_pft ) + call this%set_history_var(vname='MORTALITY', units='indiv/ha/yr', & + long='Rate of total mortality by PFT', use_default='active', & + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_mortality_si_pft ) + ! patch age class variables call this%set_history_var(vname='PATCH_AREA_BY_AGE', units='m2/m2', & long='patch area by age bin', use_default='active', & @@ -1770,47 +1822,47 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_scpf ) call this%set_history_var(vname='M1_SCPF', units = 'N/ha/yr', & - long='background mortality count by patch and pft/size', use_default='inactive', & + long='background mortality by patch and pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m1_si_scpf ) call this%set_history_var(vname='M2_SCPF', units = 'N/ha/yr', & - long='hydraulic mortality count by patch and pft/size',use_default='inactive', & + long='hydraulic mortality by patch and pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m2_si_scpf ) call this%set_history_var(vname='M3_SCPF', units = 'N/ha/yr', & - long='carbon starvation mortality count by patch and pft/size', use_default='inactive', & + long='carbon starvation mortality by patch and pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_si_scpf ) call this%set_history_var(vname='M4_SCPF', units = 'N/ha/yr', & - long='impact mortality count by patch and pft/size',use_default='inactive', & + long='impact mortality by patch and pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m4_si_scpf ) call this%set_history_var(vname='M5_SCPF', units = 'N/ha/yr', & - long='fire mortality count by patch and pft/size',use_default='inactive', & + long='fire mortality by patch and pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m5_si_scpf ) call this%set_history_var(vname='M6_SCPF', units = 'N/ha/yr', & - long='termination mortality count by patch and pft/size',use_default='inactive', & + long='termination mortality by patch and pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m6_si_scpf ) - call this%set_history_var(vname='M3_CANOPY_SCPF', units = 'N/ha/yr', & - long='carbon starvation mortality of canopy plants count by patch and pft/size', use_default='inactive', & + call this%set_history_var(vname='MORTALITY_CANOPY_SCPF', units = 'N/ha/yr', & + long='total mortality of canopy plants by patch and pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_canopy_si_scpf ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_canopy_si_scpf ) call this%set_history_var(vname='BSTOR_CANOPY_SCPF', units = 'kgC/ha', & - long='biomass carbon in storage pools of canopy plants count by patch and pft/size', use_default='inactive', & + long='biomass carbon in storage pools of canopy plants by patch and pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_bstor_canopy_si_scpf ) call this%set_history_var(vname='BLEAF_CANOPY_SCPF', units = 'kgC/ha', & - long='biomass carbon in leaf of canopy plants count by patch and pft/size', use_default='inactive', & + long='biomass carbon in leaf of canopy plants by patch and pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_bleaf_canopy_si_scpf ) @@ -1819,18 +1871,18 @@ 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_nplant_canopy_si_scpf ) - call this%set_history_var(vname='M3_UNDERSTORY_SCPF', units = 'N/ha/yr', & - long='carbon starvation mortality of understory plants count by patch and pft/size', use_default='inactive', & + call this%set_history_var(vname='MORTALITY_UNDERSTORY_SCPF', units = 'N/ha/yr', & + long='total mortality of understory plants by patch and pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_understory_si_scpf ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_understory_si_scpf ) call this%set_history_var(vname='BSTOR_UNDERSTORY_SCPF', units = 'kgC/ha', & - long='biomass carbon in storage pools of understory plants count by patch and pft/size', use_default='inactive', & + long='biomass carbon in storage pools of understory plants by patch and pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_bstor_understory_si_scpf ) call this%set_history_var(vname='BLEAF_UNDERSTORY_SCPF', units = 'kgC/ha', & - long='biomass carbon in leaf of understory plants count by patch and pft/size', use_default='inactive', & + long='biomass carbon in leaf of understory plants by patch and pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_bleaf_understory_si_scpf ) @@ -1883,6 +1935,27 @@ 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_ba_si_scls ) + call this%set_history_var(vname='NPLANT_CANOPY_SCLS', units = 'indiv/ha', & + long='number of canopy plants by size class', use_default='active', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_canopy_si_scls ) + + call this%set_history_var(vname='MORTALITY_CANOPY_SCLS', units = 'indiv/ha/yr', & + long='total mortality of canopy trees by size class', use_default='active', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_canopy_si_scls ) + + call this%set_history_var(vname='NPLANT_UNDERSTORY_SCLS', units = 'indiv/ha', & + long='number of understory plants by size class', use_default='active', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_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, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_understory_si_scls ) + + ! CARBON BALANCE VARIABLES THAT DEPEND ON HLM BGC INPUTS call this%set_history_var(vname='NEP', units='gC/m^2/s', & From eb9902db4159cccf22e84fea09ec68078830b5e4 Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 9 Feb 2017 16:04:02 -0800 Subject: [PATCH 17/35] turned off seed homogenization --- components/clm/src/ED/main/EDTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 48eeb96c5a..79386f3e8c 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -77,7 +77,7 @@ module EDTypesMod character*4 yearchar ! special mode to cause PFTs to create seed mass of all currently-existing PFTs - logical, parameter :: homogenize_seed_pfts = .true. + logical, parameter :: homogenize_seed_pfts = .false. !the lower limit of the size classes of ED cohorts !0-10,10-20... From f0ef3088cca4ac12ee1f18f94fb00998eaaa2213 Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 9 Feb 2017 19:41:32 -0800 Subject: [PATCH 18/35] indexing bugfix --- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 26 +++++++++---------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 8c8702e746..b2634f1381 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1135,17 +1135,16 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! note there are various ways of reporting the total mortality, so pass to these as well do i_pft = 1, mxpft do i_scls = 1,nlevsclass_ed - hio_m6_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) = (sites(s)%terminated_nindivs(i_pft,i_scls,1) + & + i_scpf = (i_pft-1)*nlevsclass_ed + i_scls + hio_m6_si_scpf(io_si,i_scpf) = (sites(s)%terminated_nindivs(i_pft,i_scls,1) + & sites(s)%terminated_nindivs(i_scls,i_pft,2)) * yeardays - hio_mortality_canopy_si_scls(io_si,i_pft) = hio_mortality_canopy_si_scls(io_si,i_pft) + & + hio_mortality_canopy_si_scls(io_si,i_scls) = hio_mortality_canopy_si_scls(io_si,i_scls) + & sites(s)%terminated_nindivs(i_scls,i_pft,1) * yeardays - hio_mortality_understory_si_scls(io_si,i_pft) = hio_mortality_understory_si_scls(io_si,i_pft) + & + hio_mortality_understory_si_scls(io_si,i_scls) = hio_mortality_understory_si_scls(io_si,i_scls) + & sites(s)%terminated_nindivs(i_scls,i_pft,2) * yeardays - hio_mortality_canopy_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) = & - hio_mortality_canopy_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) + & + hio_mortality_canopy_si_scpf(io_si,i_scpf) = hio_mortality_canopy_si_scpf(io_si,i_scpf) + & sites(s)%terminated_nindivs(i_scls,i_pft,1) * yeardays - hio_mortality_understory_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) = & - hio_mortality_understory_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) + & + hio_mortality_understory_si_scpf(io_si,i_scpf) = hio_mortality_understory_si_scpf(io_si,i_scpf) + & sites(s)%terminated_nindivs(i_scls,i_pft,2) * yeardays end do end do @@ -1160,13 +1159,14 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! summarize all of the mortality fluxes by PFT do i_pft = 1, mxpft do i_scls = 1,nlevsclass_ed + i_scpf = (i_pft-1)*nlevsclass_ed + i_scls hio_mortality_si_pft(io_si,i_pft) = hio_mortality_si_pft(io_si,i_pft) + & - hio_m1_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) + & - hio_m2_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) + & - hio_m3_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) + & - hio_m4_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) + & - hio_m5_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) + & - hio_m6_si_scpf(io_si,(i_pft-1)*nlevsclass_ed + i_scls) + hio_m1_si_scpf(io_si,i_scpf) + & + hio_m2_si_scpf(io_si,i_scpf) + & + hio_m3_si_scpf(io_si,i_scpf) + & + hio_m4_si_scpf(io_si,i_scpf) + & + hio_m5_si_scpf(io_si,i_scpf) + & + hio_m6_si_scpf(io_si,i_scpf) end do end do From a5292d69b367211ef1cf50849787b45813f41545 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 14 Feb 2017 10:41:43 -0800 Subject: [PATCH 19/35] Fixed some long-names in SCPF type history variables. --- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 80 +++++++++---------- 1 file changed, 40 insertions(+), 40 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index b2634f1381..d26cc82ffa 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1726,168 +1726,168 @@ subroutine define_history_vars(this, initialize_variables) ! =================================================================================== call this%set_history_var(vname='GPP_SCPF', units='kgC/m2/yr', & - long='gross primary production', use_default='inactive', & + long='gross primary production by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_gpp_si_scpf ) call this%set_history_var(vname='GPP_CANOPY_SCPF', units='kgC/m2/yr', & - long='gross primary production of canopy plants', use_default='inactive', & + long='gross primary production of canopy plants by pft/size ', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_gpp_canopy_si_scpf ) call this%set_history_var(vname='AR_CANOPY_SCPF', units='kgC/m2/yr', & - long='autotrophic respiration of canopy plants', use_default='inactive', & + long='autotrophic respiration of canopy plants by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ar_canopy_si_scpf ) call this%set_history_var(vname='GPP_UNDERSTORY_SCPF', units='kgC/m2/yr', & - long='gross primary production of understory plants', use_default='inactive', & + long='gross primary production of understory plants by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_gpp_understory_si_scpf ) call this%set_history_var(vname='AR_UNDERSTORY_SCPF', units='kgC/m2/yr', & - long='autotrophic respiration of understory plants', use_default='inactive', & + long='autotrophic respiration of understory plants by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ar_understory_si_scpf ) call this%set_history_var(vname='NPP_SCPF', units='kgC/m2/yr', & - long='total net primary production', use_default='inactive', & + long='total net primary production by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_totl_si_scpf ) call this%set_history_var(vname='NPP_LEAF_SCPF', units='kgC/m2/yr', & - long='NPP flux into leaves', use_default='inactive', & + long='NPP flux into leaves by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_si_scpf ) call this%set_history_var(vname='NPP_SEED_SCPF', units='kgC/m2/yr', & - long='NPP flux into seeds', use_default='inactive', & + long='NPP flux into seeds by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_seed_si_scpf ) call this%set_history_var(vname='NPP_FNRT_SCPF', units='kgC/m2/yr', & - long='NPP flux into fine roots', use_default='inactive', & + long='NPP flux into fine roots by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_fnrt_si_scpf ) call this%set_history_var(vname='NPP_BGSW_SCPF', units='kgC/m2/yr', & - long='NPP flux into below-ground sapwood', use_default='inactive', & + long='NPP flux into below-ground sapwood by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bgsw_si_scpf ) call this%set_history_var(vname='NPP_BGDW_SCPF', units='kgC/m2/yr', & - long='NPP flux into below-ground deadwood', use_default='inactive', & + long='NPP flux into below-ground deadwood by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bgdw_si_scpf ) call this%set_history_var(vname='NPP_AGSW_SCPF', units='kgC/m2/yr', & - long='NPP flux into above-ground sapwood', use_default='inactive', & + long='NPP flux into above-ground sapwood by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_agsw_si_scpf ) call this%set_history_var(vname = 'NPP_AGDW_SCPF', units='kgC/m2/yr', & - long='NPP flux into above-ground deadwood', use_default='inactive', & + long='NPP flux into above-ground deadwood by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_agdw_si_scpf ) call this%set_history_var(vname = 'NPP_STOR_SCPF', units='kgC/m2/yr', & - long='NPP flux into storage', use_default='inactive', & + long='NPP flux into storage by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_stor_si_scpf ) call this%set_history_var(vname='DDBH_SCPF', units = 'cm/yr/ha', & - long='diameter growth increment and pft/size',use_default='inactive', & + long='diameter growth increment by pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_si_scpf ) call this%set_history_var(vname='DDBH_CANOPY_SCPF', units = 'cm/yr/ha', & - long='diameter growth increment and pft/size',use_default='inactive', & + long='diameter growth increment by pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_canopy_si_scpf ) call this%set_history_var(vname='DDBH_UNDERSTORY_SCPF', units = 'cm/yr/ha', & - long='diameter growth increment and pft/size',use_default='inactive', & + long='diameter growth increment by pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_understory_si_scpf ) call this%set_history_var(vname='BA_SCPF', units = 'm2/ha', & - long='basal area by patch and pft/size', use_default='inactive', & + long='basal area by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ba_si_scpf ) call this%set_history_var(vname='NPLANT_SCPF', units = 'N/ha', & - long='stem number density by patch and pft/size', use_default='inactive', & + long='stem number density by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_scpf ) call this%set_history_var(vname='M1_SCPF', units = 'N/ha/yr', & - long='background mortality by patch and pft/size', use_default='inactive', & + long='background mortality by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m1_si_scpf ) call this%set_history_var(vname='M2_SCPF', units = 'N/ha/yr', & - long='hydraulic mortality by patch and pft/size',use_default='inactive', & + long='hydraulic mortality by pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m2_si_scpf ) call this%set_history_var(vname='M3_SCPF', units = 'N/ha/yr', & - long='carbon starvation mortality by patch and pft/size', use_default='inactive', & + long='carbon starvation mortality by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_si_scpf ) call this%set_history_var(vname='M4_SCPF', units = 'N/ha/yr', & - long='impact mortality by patch and pft/size',use_default='inactive', & + long='impact mortality by pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m4_si_scpf ) call this%set_history_var(vname='M5_SCPF', units = 'N/ha/yr', & - long='fire mortality by patch and pft/size',use_default='inactive', & + long='fire mortality by pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m5_si_scpf ) call this%set_history_var(vname='M6_SCPF', units = 'N/ha/yr', & - long='termination mortality by patch and pft/size',use_default='inactive', & + long='termination mortality by pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m6_si_scpf ) call this%set_history_var(vname='MORTALITY_CANOPY_SCPF', units = 'N/ha/yr', & - long='total mortality of canopy plants by patch and pft/size', use_default='inactive', & + long='total mortality of canopy plants by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_canopy_si_scpf ) call this%set_history_var(vname='BSTOR_CANOPY_SCPF', units = 'kgC/ha', & - long='biomass carbon in storage pools of canopy plants by patch and pft/size', use_default='inactive', & + long='biomass carbon in storage pools of canopy plants by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_bstor_canopy_si_scpf ) call this%set_history_var(vname='BLEAF_CANOPY_SCPF', units = 'kgC/ha', & - long='biomass carbon in leaf of canopy plants by patch and pft/size', use_default='inactive', & + long='biomass carbon in leaf of canopy plants by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_bleaf_canopy_si_scpf ) call this%set_history_var(vname='NPLANT_CANOPY_SCPF', units = 'N/ha', & - long='stem number of canopy plants density by patch and pft/size', use_default='inactive', & + long='stem number of canopy plants density by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_canopy_si_scpf ) call this%set_history_var(vname='MORTALITY_UNDERSTORY_SCPF', units = 'N/ha/yr', & - long='total mortality of understory plants by patch and pft/size', use_default='inactive', & + long='total mortality of understory plants by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_understory_si_scpf ) call this%set_history_var(vname='BSTOR_UNDERSTORY_SCPF', units = 'kgC/ha', & - long='biomass carbon in storage pools of understory plants by patch and pft/size', use_default='inactive', & + long='biomass carbon in storage pools of understory plants by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_bstor_understory_si_scpf ) call this%set_history_var(vname='BLEAF_UNDERSTORY_SCPF', units = 'kgC/ha', & - long='biomass carbon in leaf of understory plants by patch and pft/size', use_default='inactive', & + long='biomass carbon in leaf of understory plants by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_bleaf_understory_si_scpf ) call this%set_history_var(vname='NPLANT_UNDERSTORY_SCPF', units = 'N/ha', & - long='stem number of understory plants density by patch and pft/size', use_default='inactive', & + long='stem number of understory plants density by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_scpf ) @@ -1895,37 +1895,37 @@ subroutine define_history_vars(this, initialize_variables) ! Size structured diagnostics that require rapid updates (upfreq=2) call this%set_history_var(vname='AR_SCPF',units = 'kgC/m2/yr', & - long='total autotrophic respiration per m2 per year',use_default='inactive',& + long='total autotrophic respiration per m2 per year by pft/size',use_default='inactive',& avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_si_scpf ) call this%set_history_var(vname='AR_GROW_SCPF',units = 'kgC/m2/yr', & - long='growth autotrophic respiration per m2 per year',use_default='inactive',& + long='growth autotrophic respiration per m2 per year by pft/size',use_default='inactive',& avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_grow_si_scpf ) call this%set_history_var(vname='AR_MAINT_SCPF',units = 'kgC/m2/yr', & - long='maintenance autotrophic respiration per m2 per year',use_default='inactive',& + long='maintenance autotrophic respiration per m2 per year by pft/size',use_default='inactive',& avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_maint_si_scpf ) call this%set_history_var(vname='AR_DARKM_SCPF',units = 'kgC/m2/yr', & - long='dark portion of maintenance autotrophic respiration per m2 per year',use_default='inactive',& + long='dark portion of maintenance autotrophic respiration per m2 per year by pft/size',use_default='inactive',& avgflag='A', vtype=site_size_pft_r8,hlms='CLM:ALM', flushval=0.0_r8, & upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_darkm_si_scpf ) call this%set_history_var(vname='AR_AGSAPM_SCPF',units = 'kgC/m2/yr', & - long='above-ground sapwood maintenance autotrophic respiration per m2 per year',use_default='inactive',& + long='above-ground sapwood maintenance autotrophic respiration per m2 per year by pft/size',use_default='inactive',& avgflag='A', vtype=site_size_pft_r8,hlms='CLM:ALM', flushval=0.0_r8, & upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_agsapm_si_scpf ) call this%set_history_var(vname='AR_CROOTM_SCPF',units = 'kgC/m2/yr', & - long='below-ground sapwood maintenance autotrophic respiration per m2 per year',use_default='inactive',& + long='below-ground sapwood maintenance autotrophic respiration per m2 per year by pft/size',use_default='inactive',& avgflag='A', vtype=site_size_pft_r8,hlms='CLM:ALM', flushval=0.0_r8, & upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_crootm_si_scpf ) call this%set_history_var(vname='AR_FROOTM_SCPF',units = 'kgC/m2/yr', & - long='fine root maintenance autotrophic respiration per m2 per year',use_default='inactive',& + long='fine root maintenance autotrophic respiration per m2 per year by pft/size',use_default='inactive',& avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_frootm_si_scpf ) From e36e1f19a4210ba65a76a289fefdf707ec50ae41 Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 14 Feb 2017 11:23:05 -0800 Subject: [PATCH 20/35] added yet more diagnostics to disaggregate the canopy/understory and size-resolved cohort carbon budgets --- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 370 +++++++++++++++++- 1 file changed, 369 insertions(+), 1 deletion(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index b2634f1381..c01b66417b 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -144,6 +144,49 @@ module FatesHistoryInterfaceMod integer, private :: ih_mortality_canopy_si_scls integer, private :: ih_mortality_understory_si_scls + ! lots of non-default diagnostics for understanding canopy versus understory carbon balances + integer, private :: ih_rdark_canopy_si_scls + integer, private :: ih_livestem_mr_canopy_si_scls + integer, private :: ih_livecroot_mr_canopy_si_scls + integer, private :: ih_froot_mr_canopy_si_scls + integer, private :: ih_resp_g_canopy_si_scls + integer, private :: ih_resp_m_canopy_si_scls + integer, private :: ih_leaf_md_canopy_si_scls + integer, private :: ih_root_md_canopy_si_scls + integer, private :: ih_carbon_balance_canopy_si_scls + integer, private :: ih_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_froot_canopy_si_scls + integer, private :: ih_npp_bsw_canopy_si_scls + integer, private :: ih_npp_bdead_canopy_si_scls + integer, private :: ih_npp_bseed_canopy_si_scls + integer, private :: ih_npp_store_canopy_si_scls + + integer, private :: ih_rdark_understory_si_scls + integer, private :: ih_livestem_mr_understory_si_scls + integer, private :: ih_livecroot_mr_understory_si_scls + integer, private :: ih_froot_mr_understory_si_scls + integer, private :: ih_resp_g_understory_si_scls + integer, private :: ih_resp_m_understory_si_scls + integer, private :: ih_leaf_md_understory_si_scls + integer, private :: ih_root_md_understory_si_scls + integer, private :: ih_carbon_balance_understory_si_scls + integer, private :: ih_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_froot_understory_si_scls + integer, private :: ih_npp_bsw_understory_si_scls + integer, private :: ih_npp_bdead_understory_si_scls + integer, private :: ih_npp_bseed_understory_si_scls + integer, private :: ih_npp_store_understory_si_scls + ! indices to (site x pft) variables integer, private :: ih_biomass_si_pft integer, private :: ih_leafbiomass_si_pft @@ -844,6 +887,34 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_nplant_understory_si_scls => this%hvars(ih_nplant_understory_si_scls)%r82d, & hio_mortality_canopy_si_scls => this%hvars(ih_mortality_canopy_si_scls)%r82d, & hio_mortality_understory_si_scls => this%hvars(ih_mortality_understory_si_scls)%r82d, & + hio_leaf_md_canopy_si_scls => this%hvars(ih_leaf_md_canopy_si_scls)%r82d, & + hio_root_md_canopy_si_scls => this%hvars(ih_root_md_canopy_si_scls)%r82d, & + hio_carbon_balance_canopy_si_scls => this%hvars(ih_carbon_balance_canopy_si_scls)%r82d, & + 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_froot_canopy_si_scls => this%hvars(ih_npp_froot_canopy_si_scls)%r82d, & + hio_npp_bsw_canopy_si_scls => this%hvars(ih_npp_bsw_canopy_si_scls)%r82d, & + hio_npp_bdead_canopy_si_scls => this%hvars(ih_npp_bdead_canopy_si_scls)%r82d, & + hio_npp_bseed_canopy_si_scls => this%hvars(ih_npp_bseed_canopy_si_scls)%r82d, & + hio_npp_store_canopy_si_scls => this%hvars(ih_npp_store_canopy_si_scls)%r82d, & + hio_leaf_md_understory_si_scls => this%hvars(ih_leaf_md_understory_si_scls)%r82d, & + hio_root_md_understory_si_scls => this%hvars(ih_root_md_understory_si_scls)%r82d, & + hio_carbon_balance_understory_si_scls=> this%hvars(ih_carbon_balance_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_froot_understory_si_scls => this%hvars(ih_npp_froot_understory_si_scls)%r82d, & + hio_npp_bsw_understory_si_scls => this%hvars(ih_npp_bsw_understory_si_scls)%r82d, & + hio_npp_bdead_understory_si_scls => this%hvars(ih_npp_bdead_understory_si_scls)%r82d, & + hio_npp_bseed_understory_si_scls => this%hvars(ih_npp_bseed_understory_si_scls)%r82d, & + hio_npp_store_understory_si_scls => this%hvars(ih_npp_store_understory_si_scls)%r82d, & hio_area_si_age => this%hvars(ih_area_si_age)%r82d, & hio_lai_si_age => this%hvars(ih_lai_si_age)%r82d, & hio_canopy_area_si_age => this%hvars(ih_canopy_area_si_age)%r82d, & @@ -1048,6 +1119,35 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! sum of all mortality hio_mortality_canopy_si_scls(io_si,scls) = hio_mortality_canopy_si_scls(io_si,scls) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * n_perm2*AREA + ! + hio_leaf_md_canopy_si_scls(io_si,scls) = hio_leaf_md_canopy_si_scls(io_si,scls) + & + ccohort%leaf_md * n_perm2 * AREA + hio_root_md_canopy_si_scls(io_si,scls) = hio_root_md_canopy_si_scls(io_si,scls) + & + ccohort%root_md * n_perm2 * AREA + hio_carbon_balance_canopy_si_scls(io_si,scls) = hio_carbon_balance_canopy_si_scls(io_si,scls) + & + ccohort%carbon_balance * n_perm2 * AREA + hio_seed_prod_canopy_si_scls(io_si,scls) = hio_seed_prod_canopy_si_scls(io_si,scls) + & + ccohort%seed_prod * n_perm2 * AREA + hio_dbalivedt_canopy_si_scls(io_si,scls) = hio_dbalivedt_canopy_si_scls(io_si,scls) + & + ccohort%dbalivedt * n_perm2 * AREA + hio_dbdeaddt_canopy_si_scls(io_si,scls) = hio_dbdeaddt_canopy_si_scls(io_si,scls) + & + ccohort%dbdeaddt * n_perm2 * AREA + hio_dbstoredt_canopy_si_scls(io_si,scls) = hio_dbstoredt_canopy_si_scls(io_si,scls) + & + ccohort%dbstoredt * n_perm2 * AREA + hio_storage_flux_canopy_si_scls(io_si,scls) = hio_storage_flux_canopy_si_scls(io_si,scls) + & + ccohort%storage_flux * n_perm2 * AREA + hio_npp_leaf_canopy_si_scls(io_si,scls) = hio_npp_leaf_canopy_si_scls(io_si,scls) + & + ccohort%npp_leaf * n_perm2 * AREA * yeardays + hio_npp_froot_canopy_si_scls(io_si,scls) = hio_npp_froot_canopy_si_scls(io_si,scls) + & + ccohort%npp_froot * n_perm2 * AREA * yeardays + hio_npp_bsw_canopy_si_scls(io_si,scls) = hio_npp_bsw_canopy_si_scls(io_si,scls) + & + ccohort%npp_bsw * n_perm2 * AREA * yeardays + hio_npp_bdead_canopy_si_scls(io_si,scls) = hio_npp_bdead_canopy_si_scls(io_si,scls) + & + ccohort%npp_bdead * n_perm2 * AREA * yeardays + hio_npp_bseed_canopy_si_scls(io_si,scls) = hio_npp_bseed_canopy_si_scls(io_si,scls) + & + ccohort%npp_bseed * n_perm2 * AREA * yeardays + hio_npp_store_canopy_si_scls(io_si,scls) = hio_npp_store_canopy_si_scls(io_si,scls) + & + ccohort%npp_store * n_perm2 * AREA * yeardays else hio_bstor_understory_si_scpf(io_si,scpf) = hio_bstor_understory_si_scpf(io_si,scpf) + & ccohort%bstore * n_perm2 * AREA @@ -1067,6 +1167,35 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! sum of all mortality hio_mortality_understory_si_scls(io_si,scls) = hio_mortality_understory_si_scls(io_si,scls) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * n_perm2*AREA + ! + hio_leaf_md_understory_si_scls(io_si,scls) = hio_leaf_md_understory_si_scls(io_si,scls) + & + ccohort%leaf_md * n_perm2 * AREA + hio_root_md_understory_si_scls(io_si,scls) = hio_root_md_understory_si_scls(io_si,scls) + & + ccohort%root_md * n_perm2 * AREA + hio_carbon_balance_understory_si_scls(io_si,scls) = hio_carbon_balance_understory_si_scls(io_si,scls) + & + ccohort%carbon_balance * n_perm2 * AREA + hio_seed_prod_understory_si_scls(io_si,scls) = hio_seed_prod_understory_si_scls(io_si,scls) + & + ccohort%seed_prod * n_perm2 * AREA + hio_dbalivedt_understory_si_scls(io_si,scls) = hio_dbalivedt_understory_si_scls(io_si,scls) + & + ccohort%dbalivedt * n_perm2 * AREA + hio_dbdeaddt_understory_si_scls(io_si,scls) = hio_dbdeaddt_understory_si_scls(io_si,scls) + & + ccohort%dbdeaddt * n_perm2 * AREA + hio_dbstoredt_understory_si_scls(io_si,scls) = hio_dbstoredt_understory_si_scls(io_si,scls) + & + ccohort%dbstoredt * n_perm2 * AREA + hio_storage_flux_understory_si_scls(io_si,scls) = hio_storage_flux_understory_si_scls(io_si,scls) + & + ccohort%storage_flux * n_perm2 * AREA + hio_npp_leaf_understory_si_scls(io_si,scls) = hio_npp_leaf_understory_si_scls(io_si,scls) + & + ccohort%npp_leaf * n_perm2 * AREA * yeardays + hio_npp_froot_understory_si_scls(io_si,scls) = hio_npp_froot_understory_si_scls(io_si,scls) + & + ccohort%npp_froot * n_perm2 * AREA * yeardays + hio_npp_bsw_understory_si_scls(io_si,scls) = hio_npp_bsw_understory_si_scls(io_si,scls) + & + ccohort%npp_bsw * n_perm2 * AREA * yeardays + hio_npp_bdead_understory_si_scls(io_si,scls) = hio_npp_bdead_understory_si_scls(io_si,scls) + & + ccohort%npp_bdead * n_perm2 * AREA * yeardays + hio_npp_bseed_understory_si_scls(io_si,scls) = hio_npp_bseed_understory_si_scls(io_si,scls) + & + ccohort%npp_bseed * n_perm2 * AREA * yeardays + hio_npp_store_understory_si_scls(io_si,scls) = hio_npp_store_understory_si_scls(io_si,scls) + & + ccohort%npp_store * n_perm2 * AREA * yeardays endif end associate @@ -1240,6 +1369,18 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) hio_ar_canopy_pa => this%hvars(ih_ar_canopy_pa)%r81d, & hio_gpp_understory_pa => this%hvars(ih_gpp_understory_pa)%r81d, & hio_ar_understory_pa => this%hvars(ih_ar_understory_pa)%r81d, & + hio_rdark_canopy_si_scls => this%hvars(ih_rdark_canopy_si_scls)%r82d, & + hio_livestem_mr_canopy_si_scls => this%hvars(ih_livestem_mr_canopy_si_scls)%r82d, & + hio_livecroot_mr_canopy_si_scls => this%hvars(ih_livecroot_mr_canopy_si_scls)%r82d, & + hio_froot_mr_canopy_si_scls => this%hvars(ih_froot_mr_canopy_si_scls)%r82d, & + hio_resp_g_canopy_si_scls => this%hvars(ih_resp_g_canopy_si_scls)%r82d, & + hio_resp_m_canopy_si_scls => this%hvars(ih_resp_m_canopy_si_scls)%r82d, & + hio_rdark_understory_si_scls => this%hvars(ih_rdark_understory_si_scls)%r82d, & + hio_livestem_mr_understory_si_scls => this%hvars(ih_livestem_mr_understory_si_scls)%r82d, & + hio_livecroot_mr_understory_si_scls => this%hvars(ih_livecroot_mr_understory_si_scls)%r82d, & + hio_froot_mr_understory_si_scls => this%hvars(ih_froot_mr_understory_si_scls)%r82d, & + hio_resp_g_understory_si_scls => this%hvars(ih_resp_g_understory_si_scls)%r82d, & + hio_resp_m_understory_si_scls => this%hvars(ih_resp_m_understory_si_scls)%r82d, & hio_gpp_si_age => this%hvars(ih_gpp_si_age)%r82d, & hio_npp_si_age => this%hvars(ih_npp_si_age)%r82d & ) @@ -1280,7 +1421,8 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) if ( .not. ccohort%isnew ) then ! Calculate index for the scpf class - associate( scpf => ccohort%size_by_pft_class ) + associate( scpf => ccohort%size_by_pft_class, & + scls => ccohort%size_class ) ! scale up cohort fluxes to their patches hio_npp_pa(io_pa) = hio_npp_pa(io_pa) + & @@ -1339,11 +1481,37 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ccohort%gpp_tstep * 1.e3_r8 * n_density / dt_tstep hio_ar_canopy_pa(io_pa) = hio_ar_canopy_pa(io_pa) + & ccohort%resp_tstep * 1.e3_r8 * n_density / dt_tstep + ! + hio_rdark_canopy_si_scls(io_si,scls) = hio_rdark_canopy_si_scls(io_si,scls) + & + ccohort%rdark * 1.e3_r8 * n_density * daysecs * yeardays + hio_livestem_mr_canopy_si_scls(io_si,scls) = hio_livestem_mr_canopy_si_scls(io_si,scls) + & + ccohort%livestem_mr * 1.e3_r8 * n_density * daysecs * yeardays + hio_livecroot_mr_canopy_si_scls(io_si,scls) = hio_livecroot_mr_canopy_si_scls(io_si,scls) + & + ccohort%livecroot_mr * 1.e3_r8 * n_density * daysecs * yeardays + hio_froot_mr_canopy_si_scls(io_si,scls) = hio_froot_mr_canopy_si_scls(io_si,scls) + & + ccohort%froot_mr * 1.e3_r8 * n_density * daysecs * yeardays + hio_resp_g_canopy_si_scls(io_si,scls) = hio_resp_g_canopy_si_scls(io_si,scls) + & + ccohort%resp_g * 1.e3_r8 * n_density * daysecs * yeardays / dt_tstep + hio_resp_m_canopy_si_scls(io_si,scls) = hio_resp_m_canopy_si_scls(io_si,scls) + & + ccohort%resp_m * 1.e3_r8 * n_density * daysecs * yeardays / dt_tstep else hio_gpp_understory_pa(io_pa) = hio_gpp_understory_pa(io_pa) + & ccohort%gpp_tstep * 1.e3_r8 * n_density / dt_tstep hio_ar_understory_pa(io_pa) = hio_ar_understory_pa(io_pa) + & ccohort%resp_tstep * 1.e3_r8 * n_density / dt_tstep + ! + hio_rdark_understory_si_scls(io_si,scls) = hio_rdark_understory_si_scls(io_si,scls) + & + ccohort%rdark * 1.e3_r8 * n_density * daysecs * yeardays + hio_livestem_mr_understory_si_scls(io_si,scls) = hio_livestem_mr_understory_si_scls(io_si,scls) + & + ccohort%livestem_mr * 1.e3_r8 * n_density * daysecs * yeardays + hio_livecroot_mr_understory_si_scls(io_si,scls) = hio_livecroot_mr_understory_si_scls(io_si,scls) + & + ccohort%livecroot_mr * 1.e3_r8 * n_density * daysecs * yeardays + hio_froot_mr_understory_si_scls(io_si,scls) = hio_froot_mr_understory_si_scls(io_si,scls) + & + ccohort%froot_mr * 1.e3_r8 * n_density * daysecs * yeardays + hio_resp_g_understory_si_scls(io_si,scls) = hio_resp_g_understory_si_scls(io_si,scls) + & + ccohort%resp_g * 1.e3_r8 * n_density * daysecs * yeardays / dt_tstep + hio_resp_m_understory_si_scls(io_si,scls) = hio_resp_m_understory_si_scls(io_si,scls) + & + ccohort%resp_m * 1.e3_r8 * n_density * daysecs * yeardays / dt_tstep endif end associate endif @@ -1955,6 +2123,206 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_understory_si_scls ) + call this%set_history_var(vname='LEAF_MD_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='LEAF_MD 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_leaf_md_canopy_si_scls ) + + call this%set_history_var(vname='ROOT_MD_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='ROOT_MD 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_root_md_canopy_si_scls ) + + call this%set_history_var(vname='CARBON_BALANCE_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='CARBON_BALANCE 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_carbon_balance_canopy_si_scls ) + + call this%set_history_var(vname='SEED_PROD_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='SEED_PROD 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_seed_prod_canopy_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='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=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_canopy_si_scls ) + + call this%set_history_var(vname='NPP_FROOT_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='NPP_FROOT 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_npp_froot_canopy_si_scls ) + + call this%set_history_var(vname='NPP_BSW_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='NPP_BSW 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_npp_bsw_canopy_si_scls ) + + call this%set_history_var(vname='NPP_BDEAD_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='NPP_BDEAD 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_npp_bdead_canopy_si_scls ) + + call this%set_history_var(vname='NPP_BSEED_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='NPP_BSEED 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_npp_bseed_canopy_si_scls ) + + call this%set_history_var(vname='NPP_STORE_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='NPP_STORE 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_npp_store_canopy_si_scls ) + + call this%set_history_var(vname='RDARK_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='RDARK for canopy plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_rdark_canopy_si_scls ) + + call this%set_history_var(vname='LIVESTEM_MR_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='LIVESTEM_MR for canopy plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_livestem_mr_canopy_si_scls ) + + call this%set_history_var(vname='LIVECROOT_MR_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='LIVECROOT_MR for canopy plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_livecroot_mr_canopy_si_scls ) + + call this%set_history_var(vname='FROOT_MR_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='FROOT_MR for canopy plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_froot_mr_canopy_si_scls ) + + call this%set_history_var(vname='RESP_G_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='RESP_G for canopy plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_resp_g_canopy_si_scls ) + + call this%set_history_var(vname='RESP_M_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='RESP_M for canopy plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_resp_m_canopy_si_scls ) + + call this%set_history_var(vname='LEAF_MD_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='LEAF_MD 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_leaf_md_understory_si_scls ) + + call this%set_history_var(vname='ROOT_MD_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='ROOT_MD 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_root_md_understory_si_scls ) + + call this%set_history_var(vname='CARBON_BALANCE_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='CARBON_BALANCE 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_carbon_balance_understory_si_scls ) + + call this%set_history_var(vname='SEED_PROD_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='SEED_PROD 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_seed_prod_understory_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='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, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_understory_si_scls ) + + call this%set_history_var(vname='NPP_FROOT_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='NPP_FROOT 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_npp_froot_understory_si_scls ) + + call this%set_history_var(vname='NPP_BSW_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='NPP_BSW 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_npp_bsw_understory_si_scls ) + + call this%set_history_var(vname='NPP_BDEAD_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='NPP_BDEAD 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_npp_bdead_understory_si_scls ) + + call this%set_history_var(vname='NPP_BSEED_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='NPP_BSEED 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_npp_bseed_understory_si_scls ) + + call this%set_history_var(vname='NPP_STORE_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='NPP_STORE 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_npp_store_understory_si_scls ) + + call this%set_history_var(vname='RDARK_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='RDARK for understory plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_rdark_understory_si_scls ) + + call this%set_history_var(vname='LIVESTEM_MR_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='LIVESTEM_MR for understory plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_livestem_mr_understory_si_scls ) + + call this%set_history_var(vname='LIVECROOT_MR_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='LIVECROOT_MR for understory plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_livecroot_mr_understory_si_scls ) + + call this%set_history_var(vname='FROOT_MR_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='FROOT_MR for understory plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_froot_mr_understory_si_scls ) + + call this%set_history_var(vname='RESP_G_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='RESP_G for understory plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_resp_g_understory_si_scls ) + + call this%set_history_var(vname='RESP_M_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='RESP_M for understory plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_resp_m_understory_si_scls ) + ! CARBON BALANCE VARIABLES THAT DEPEND ON HLM BGC INPUTS From cfe21cb4e0e8b6495d04e6671fbb6eefca653024 Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 14 Feb 2017 16:22:02 -0800 Subject: [PATCH 21/35] fixed 2 bugs: one unit and one restart --- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 24 +++++++-------- .../src/ED/main/FatesRestartInterfaceMod.F90 | 30 +++++++++++++++++++ 2 files changed, 42 insertions(+), 12 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 89c8cfb34c..d38c967997 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1483,17 +1483,17 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ccohort%resp_tstep * 1.e3_r8 * n_density / dt_tstep ! hio_rdark_canopy_si_scls(io_si,scls) = hio_rdark_canopy_si_scls(io_si,scls) + & - ccohort%rdark * 1.e3_r8 * n_density * daysecs * yeardays + ccohort%rdark * 1.e3_r8 * ccohort%n * daysecs * yeardays hio_livestem_mr_canopy_si_scls(io_si,scls) = hio_livestem_mr_canopy_si_scls(io_si,scls) + & - ccohort%livestem_mr * 1.e3_r8 * n_density * daysecs * yeardays + ccohort%livestem_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays hio_livecroot_mr_canopy_si_scls(io_si,scls) = hio_livecroot_mr_canopy_si_scls(io_si,scls) + & - ccohort%livecroot_mr * 1.e3_r8 * n_density * daysecs * yeardays + ccohort%livecroot_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays hio_froot_mr_canopy_si_scls(io_si,scls) = hio_froot_mr_canopy_si_scls(io_si,scls) + & - ccohort%froot_mr * 1.e3_r8 * n_density * daysecs * yeardays + ccohort%froot_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays hio_resp_g_canopy_si_scls(io_si,scls) = hio_resp_g_canopy_si_scls(io_si,scls) + & - ccohort%resp_g * 1.e3_r8 * n_density * daysecs * yeardays / dt_tstep + ccohort%resp_g * 1.e3_r8 * ccohort%n * daysecs * yeardays / dt_tstep hio_resp_m_canopy_si_scls(io_si,scls) = hio_resp_m_canopy_si_scls(io_si,scls) + & - ccohort%resp_m * 1.e3_r8 * n_density * daysecs * yeardays / dt_tstep + ccohort%resp_m * 1.e3_r8 * ccohort%n * daysecs * yeardays / dt_tstep else hio_gpp_understory_pa(io_pa) = hio_gpp_understory_pa(io_pa) + & ccohort%gpp_tstep * 1.e3_r8 * n_density / dt_tstep @@ -1501,17 +1501,17 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ccohort%resp_tstep * 1.e3_r8 * n_density / dt_tstep ! hio_rdark_understory_si_scls(io_si,scls) = hio_rdark_understory_si_scls(io_si,scls) + & - ccohort%rdark * 1.e3_r8 * n_density * daysecs * yeardays + ccohort%rdark * 1.e3_r8 * ccohort%n * daysecs * yeardays hio_livestem_mr_understory_si_scls(io_si,scls) = hio_livestem_mr_understory_si_scls(io_si,scls) + & - ccohort%livestem_mr * 1.e3_r8 * n_density * daysecs * yeardays + ccohort%livestem_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays hio_livecroot_mr_understory_si_scls(io_si,scls) = hio_livecroot_mr_understory_si_scls(io_si,scls) + & - ccohort%livecroot_mr * 1.e3_r8 * n_density * daysecs * yeardays + ccohort%livecroot_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays hio_froot_mr_understory_si_scls(io_si,scls) = hio_froot_mr_understory_si_scls(io_si,scls) + & - ccohort%froot_mr * 1.e3_r8 * n_density * daysecs * yeardays + ccohort%froot_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays hio_resp_g_understory_si_scls(io_si,scls) = hio_resp_g_understory_si_scls(io_si,scls) + & - ccohort%resp_g * 1.e3_r8 * n_density * daysecs * yeardays / dt_tstep + ccohort%resp_g * 1.e3_r8 * ccohort%n * daysecs * yeardays / dt_tstep hio_resp_m_understory_si_scls(io_si,scls) = hio_resp_m_understory_si_scls(io_si,scls) + & - ccohort%resp_m * 1.e3_r8 * n_density * daysecs * yeardays / dt_tstep + ccohort%resp_m * 1.e3_r8 * ccohort%n * daysecs * yeardays / dt_tstep endif end associate endif diff --git a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 index 18b77bc6cf..90b9dd21aa 100644 --- a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 @@ -98,6 +98,9 @@ module FatesRestartInterfaceMod integer, private :: ir_imort_co integer, private :: ir_fmort_co integer, private :: ir_ddbhdt_co + integer, private :: ir_dbalivedt_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 @@ -731,6 +734,21 @@ 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_dbalivedt', 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_dbalivedt_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, & @@ -1008,6 +1026,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_imort_co => this%rvars(ir_imort_co)%r81d, & rio_fmort_co => this%rvars(ir_fmort_co)%r81d, & rio_ddbhdt_co => this%rvars(ir_ddbhdt_co)%r81d, & + rio_dbalivedt_co => this%rvars(ir_dbalivedt_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, & @@ -1116,6 +1137,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_imort_co(io_idx_co) = ccohort%imort rio_fmort_co(io_idx_co) = ccohort%fmort rio_ddbhdt_co(io_idx_co) = ccohort%ddbhdt + rio_dbalivedt_co(io_idx_co) = ccohort%dbalivedt + 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 @@ -1570,6 +1594,9 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_imort_co => this%rvars(ir_imort_co)%r81d, & rio_fmort_co => this%rvars(ir_fmort_co)%r81d, & rio_ddbhdt_co => this%rvars(ir_ddbhdt_co)%r81d, & + rio_dbalivedt_co => this%rvars(ir_dbalivedt_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, & @@ -1663,6 +1690,9 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%imort = rio_imort_co(io_idx_co) ccohort%fmort = rio_fmort_co(io_idx_co) ccohort%ddbhdt = rio_ddbhdt_co(io_idx_co) + ccohort%dbalivedt = rio_dbalivedt_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) From 76f4e362a7974e14baa90b05efa611231a74ceee Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 16 Feb 2017 13:42:15 -0800 Subject: [PATCH 22/35] added a diagnostic to track the relative fraction of understory individuals of a given size class who were demoted on a given timestep --- .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 3 +++ .../src/ED/biogeochem/EDPatchDynamicsMod.F90 | 1 + components/clm/src/ED/main/EDTypesMod.F90 | 1 + .../src/ED/main/FatesHistoryInterfaceMod.F90 | 22 +++++++++++++++++++ .../src/ED/main/FatesRestartInterfaceMod.F90 | 10 +++++++++ 5 files changed, 37 insertions(+) diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index edbfdd34ea..6fbdb3371b 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -94,6 +94,7 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & new_cohort%dbh = dbh new_cohort%canopy_trim = ctrim new_cohort%canopy_layer = clayer + new_cohort%canopy_layer_yesterday = clayer new_cohort%laimemory = laimemory new_cohort%bdead = bdead new_cohort%balive = balive @@ -334,6 +335,7 @@ subroutine nan_cohort(cc_p) currentCohort%pft = fates_unset_int ! pft number currentCohort%indexnumber = fates_unset_int ! unique number for each cohort. (within clump?) currentCohort%canopy_layer = fates_unset_int ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) + currentCohort%canopy_layer_yesterday = fates_unset_int ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) 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 @@ -1041,6 +1043,7 @@ subroutine copy_cohort( currentCohort,copyc ) n%gscan = o%gscan n%leaf_cost = o%leaf_cost n%canopy_layer = o%canopy_layer + n%canopy_layer_yesterday = o%canopy_layer_yesterday n%nv = o%nv n%status_coh = o%status_coh n%canopy_trim = o%canopy_trim diff --git a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 index df283d6c54..049a1e8aa8 100755 --- a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 @@ -262,6 +262,7 @@ subroutine spawn_patches( currentSite ) !this is the case as the new patch probably doesn't have a closed canopy, and ! even if it does, that will be sorted out in canopy_structure. nc%canopy_layer = 1 + nc%canopy_layer_yesterday = 1 !mortality is dominant disturbance if(currentPatch%disturbance_rates(1) > currentPatch%disturbance_rates(2))then diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 79386f3e8c..c83fc0bf46 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -191,6 +191,7 @@ module EDTypesMod 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.) + integer :: canopy_layer_yesterday ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) real(r8) :: b ! total biomass: kGC per indiv real(r8) :: bsw ! sapwood in stem and roots: kGC per indiv real(r8) :: bl ! leaf biomass: kGC per indiv diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index d38c967997..038ec6656d 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -187,6 +187,9 @@ module FatesHistoryInterfaceMod integer, private :: ih_npp_bseed_understory_si_scls integer, private :: ih_npp_store_understory_si_scls + integer, private :: ih_yesterdaycanopylevel_canopy_si_scls + integer, private :: ih_yesterdaycanopylevel_understory_si_scls + ! indices to (site x pft) variables integer, private :: ih_biomass_si_pft integer, private :: ih_leafbiomass_si_pft @@ -915,6 +918,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_bdead_understory_si_scls => this%hvars(ih_npp_bdead_understory_si_scls)%r82d, & hio_npp_bseed_understory_si_scls => this%hvars(ih_npp_bseed_understory_si_scls)%r82d, & hio_npp_store_understory_si_scls => this%hvars(ih_npp_store_understory_si_scls)%r82d, & + hio_yesterdaycanopylevel_canopy_si_scls => this%hvars(ih_yesterdaycanopylevel_canopy_si_scls)%r82d, & + hio_yesterdaycanopylevel_understory_si_scls => this%hvars(ih_yesterdaycanopylevel_understory_si_scls)%r82d, & hio_area_si_age => this%hvars(ih_area_si_age)%r82d, & hio_lai_si_age => this%hvars(ih_lai_si_age)%r82d, & hio_canopy_area_si_age => this%hvars(ih_canopy_area_si_age)%r82d, & @@ -1148,6 +1153,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%npp_bseed * n_perm2 * AREA * yeardays hio_npp_store_canopy_si_scls(io_si,scls) = hio_npp_store_canopy_si_scls(io_si,scls) + & ccohort%npp_store * n_perm2 * AREA * yeardays + hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) = hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) + & + real(ccohort%canopy_layer_yesterday, r8) * n_perm2 * AREA else hio_bstor_understory_si_scpf(io_si,scpf) = hio_bstor_understory_si_scpf(io_si,scpf) + & ccohort%bstore * n_perm2 * AREA @@ -1196,7 +1203,11 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%npp_bseed * n_perm2 * AREA * yeardays hio_npp_store_understory_si_scls(io_si,scls) = hio_npp_store_understory_si_scls(io_si,scls) + & ccohort%npp_store * n_perm2 * AREA * yeardays + hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) = hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) + & + real(ccohort%canopy_layer_yesterday, r8) * n_perm2 * AREA endif + ! + ccohort%canopy_layer_yesterday = ccohort%canopy_layer end associate end if @@ -2098,6 +2109,17 @@ subroutine define_history_vars(this, initialize_variables) upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_frootm_si_scpf ) ! size-class only variables + + call this%set_history_var(vname='YESTERDAYCANLEV_CANOPY_SCLS', units = 'indiv/ha', & + long='Yesterdays canopy level 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_yesterdaycanopylevel_canopy_si_scls ) + + call this%set_history_var(vname='YESTERDAYCANLEV_UNDERSTORY_SCLS', units = 'indiv/ha', & + long='Yesterdays canopy level 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_yesterdaycanopylevel_understory_si_scls ) + call this%set_history_var(vname='BA_SCLS', units = 'm2/ha', & long='basal area by size class', use_default='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & diff --git a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 index 90b9dd21aa..d645992768 100644 --- a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 @@ -75,6 +75,7 @@ module FatesRestartInterfaceMod 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 integer, private :: ir_dbh_co integer, private :: ir_height_co @@ -622,6 +623,10 @@ subroutine define_restart_vars(this, initialize_variables) long_name='ed cohort - canopy_layer', units='unitless', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_canopy_layer_co ) + call this%set_restart_var(vname='fates_canopy_layer_yesterday', vtype=cohort_r8, & + long_name='ed cohort - canopy_layer_yesterday', units='unitless', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_canopy_layer_yesterday_co ) + call this%set_restart_var(vname='fates_canopy_trim', vtype=cohort_r8, & long_name='ed cohort - canopy_trim', units='fraction', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_canopy_trim_co ) @@ -1003,6 +1008,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) 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, & rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & rio_height_co => this%rvars(ir_height_co)%r81d, & @@ -1114,6 +1120,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_broot_co(io_idx_co) = ccohort%br rio_bstore_co(io_idx_co) = ccohort%bstore 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_dbh_co(io_idx_co) = ccohort%dbh rio_height_co(io_idx_co) = ccohort%hite @@ -1410,6 +1417,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites ) temp_cohort%laimemory = 0.0_r8 temp_cohort%canopy_trim = 0.0_r8 temp_cohort%canopy_layer = 1.0_r8 + temp_cohort%canopy_layer_yesterday = 1.0_r8 ! set the pft (only 2 used in ed) based on odd/even cohort ! number @@ -1571,6 +1579,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) 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, & rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & rio_height_co => this%rvars(ir_height_co)%r81d, & @@ -1667,6 +1676,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%br = rio_broot_co(io_idx_co) ccohort%bstore = rio_bstore_co(io_idx_co) 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) From 4082f4cfd631e7bbe7db46af39823237cbc49446 Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 21 Feb 2017 12:19:53 -0800 Subject: [PATCH 23/35] added new vars on demotion rates and updated prior canopy level to allow fusion --- .../ED/biogeochem/EDCanopyStructureMod.F90 | 17 +++++++ .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 7 ++- .../src/ED/biogeochem/EDPatchDynamicsMod.F90 | 2 +- components/clm/src/ED/main/EDInitMod.F90 | 4 ++ components/clm/src/ED/main/EDTypesMod.F90 | 6 ++- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 44 +++++++++++++++++-- 6 files changed, 71 insertions(+), 9 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index 3b8d94e6ed..f0f9511e9f 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -110,6 +110,8 @@ subroutine canopy_structure( currentSite ) ! Section 1: Check total canopy area. new_total_area_check = 0._r8 + currentSite%demotion_rate(:) = 0._r8 + currentSite%demotion_carbonflux = 0._r8 do while (associated(currentPatch)) ! Patch loop if (currentPatch%area .gt. min_patch_area) then ! avoid numerical weirdness that shouldn't be happening anyway @@ -198,6 +200,14 @@ subroutine canopy_structure( currentSite ) ! causing non-linearity issues with c_area. is this really required? currentCohort%dbh = currentCohort%dbh copyc%dbh = copyc%dbh !+ 0.000000000001_r8 + + ! keep track of number and biomass of demoted cohort + currentSite%demotion_rate(currentCohort%size_class) = & + currentSite%demotion_rate(currentCohort%size_class) + currentCohort%n + currentSite%demotion_carbonflux = currentSite%demotion_carbonflux + & + (currentCohort%bdead + currentCohort%bsw + currentCohort%bl + currentCohort%br + & + currentCohort%bstore) * currentCohort%n + !kill the ones which go into canopy layers that are not allowed... (default nclmax=2) if(i+1 > cp_nclmax)then !put the litter from the terminated cohorts into the fragmenting pools @@ -244,6 +254,13 @@ subroutine canopy_structure( currentSite ) currentCohort%canopy_layer = i + 1 !the whole cohort becomes demoted sumloss = sumloss + currentCohort%c_area + ! keep track of number and biomass of demoted cohort + currentSite%demotion_rate(currentCohort%size_class) = & + currentSite%demotion_rate(currentCohort%size_class) + currentCohort%n + currentSite%demotion_carbonflux = currentSite%demotion_carbonflux + & + (currentCohort%bdead + currentCohort%bsw + currentCohort%bl + currentCohort%br + & + currentCohort%bstore) * currentCohort%n + !kill the ones which go into canopy layers that are not allowed... (default cp_nclmax=2) if(i+1 > cp_nclmax)then !put the litter from the terminated cohorts into the fragmenting pools diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index 6fbdb3371b..0cb1f5d73a 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -94,7 +94,7 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & new_cohort%dbh = dbh new_cohort%canopy_trim = ctrim new_cohort%canopy_layer = clayer - new_cohort%canopy_layer_yesterday = clayer + new_cohort%canopy_layer_yesterday = real(clayer, r8) new_cohort%laimemory = laimemory new_cohort%bdead = bdead new_cohort%balive = balive @@ -335,7 +335,7 @@ subroutine nan_cohort(cc_p) currentCohort%pft = fates_unset_int ! pft number currentCohort%indexnumber = fates_unset_int ! unique number for each cohort. (within clump?) currentCohort%canopy_layer = fates_unset_int ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) - currentCohort%canopy_layer_yesterday = fates_unset_int ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) + currentCohort%canopy_layer_yesterday = nan ! recent canopy status of cohort (1 = canopy, 2 = understorey, etc.) 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 @@ -766,6 +766,9 @@ subroutine fuse_cohorts(patchptr) currentCohort%npp_bseed = (currentCohort%n*currentCohort%npp_bseed + nextc%n*nextc%npp_bseed)/newn currentCohort%npp_store = (currentCohort%n*currentCohort%npp_store + nextc%n*nextc%npp_store)/newn + ! recent canopy history + currentCohort%canopy_layer_yesterday = (currentCohort%n*currentCohort%canopy_layer_yesterday + nextc%n*nextc%canopy_layer_yesterday)/newn + do i=1, cp_nlevcan if (currentCohort%year_net_uptake(i) == 999._r8 .or. nextc%year_net_uptake(i) == 999._r8) then currentCohort%year_net_uptake(i) = min(nextc%year_net_uptake(i),currentCohort%year_net_uptake(i)) diff --git a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 index 049a1e8aa8..a0136bb19c 100755 --- a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 @@ -262,7 +262,7 @@ subroutine spawn_patches( currentSite ) !this is the case as the new patch probably doesn't have a closed canopy, and ! even if it does, that will be sorted out in canopy_structure. nc%canopy_layer = 1 - nc%canopy_layer_yesterday = 1 + nc%canopy_layer_yesterday = 1._r8 !mortality is dominant disturbance if(currentPatch%disturbance_rates(1) > currentPatch%disturbance_rates(2))then diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 index a9b9a98736..4bf0ea8ac1 100755 --- a/components/clm/src/ED/main/EDInitMod.F90 +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -83,6 +83,10 @@ subroutine zero_site( site_in ) site_in%terminated_nindivs(:,:,:) = 0._r8 site_in%recruitment_rate(:) = 0._r8 + ! demotion info + site_in%demotion_rate(:) = 0._r8 + site_in%demotion_carbonflux = 0._r8 + end subroutine zero_site ! ============================================================================ diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index c83fc0bf46..74123bace3 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -191,7 +191,7 @@ module EDTypesMod 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.) - integer :: canopy_layer_yesterday ! 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) :: b ! total biomass: kGC per indiv real(r8) :: bsw ! sapwood in stem and roots: kGC per indiv real(r8) :: bl ! leaf biomass: kGC per indiv @@ -559,9 +559,11 @@ module EDTypesMod real(r8) :: cwd_ag_burned(ncwd) real(r8) :: leaf_litter_burned(numpft_ed) - ! TERMINATION AND RECRUITMENT~ + ! TERMINATION, RECRUITMENT, AND DEMOTION real(r8) :: terminated_nindivs(1:nlevsclass_ed,1:mxpft,2) ! number of individuals that were in cohorts which were terminated this timestep, on size x pft x canopy array. real(r8) :: recruitment_rate(1:mxpft) ! number of individuals that were recruited into new cohorts + real(r8) :: demotion_rate(1:nlevsclass_ed) ! rate of individuals demoted from canopy to understory per FATES timestep + real(r8) :: demotion_carbonflux ! biomass of demoted individuals from canopy to understory [gC/m2/s] end type ed_site_type diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 038ec6656d..b6f0d2bdad 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -66,6 +66,8 @@ module FatesHistoryInterfaceMod integer, private :: ih_gpp_canopy_pa integer, private :: ih_ar_understory_pa integer, private :: ih_gpp_understory_pa + integer, private :: ih_canopy_biomass_pa + integer, private :: ih_understory_biomass_pa ! Indices to (site) variables integer, private :: ih_nep_si @@ -91,6 +93,7 @@ module FatesHistoryInterfaceMod integer, private :: ih_cbal_err_tot_si integer, private :: ih_npatches_si integer, private :: ih_ncohorts_si + integer, private :: ih_demotion_carbonflux_si ! Indices to (site x scpf) variables integer, private :: ih_nplant_si_scpf @@ -143,6 +146,7 @@ module FatesHistoryInterfaceMod integer, private :: ih_nplant_understory_si_scls integer, private :: ih_mortality_canopy_si_scls integer, private :: ih_mortality_understory_si_scls + integer, private :: ih_demotion_rate_si_scls ! lots of non-default diagnostics for understanding canopy versus understory carbon balances integer, private :: ih_rdark_canopy_si_scls @@ -852,6 +856,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_balive_pa => this%hvars(ih_balive_pa)%r81d, & hio_bleaf_pa => this%hvars(ih_bleaf_pa)%r81d, & hio_btotal_pa => this%hvars(ih_btotal_pa)%r81d, & + hio_canopy_biomass_pa => this%hvars(ih_canopy_biomass_pa)%r81d, & + hio_understory_biomass_pa => this%hvars(ih_understory_biomass_pa)%r81d, & hio_gpp_si_scpf => this%hvars(ih_gpp_si_scpf)%r82d, & hio_npp_totl_si_scpf => this%hvars(ih_npp_totl_si_scpf)%r82d, & hio_npp_leaf_si_scpf => this%hvars(ih_npp_leaf_si_scpf)%r82d, & @@ -890,6 +896,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_nplant_understory_si_scls => this%hvars(ih_nplant_understory_si_scls)%r82d, & hio_mortality_canopy_si_scls => this%hvars(ih_mortality_canopy_si_scls)%r82d, & hio_mortality_understory_si_scls => this%hvars(ih_mortality_understory_si_scls)%r82d, & + hio_demotion_rate_si_scls => this%hvars(ih_demotion_rate_si_scls)%r82d, & + hio_demotion_carbonflux_si => this%hvars(ih_demotion_carbonflux_si)%r81d, & hio_leaf_md_canopy_si_scls => this%hvars(ih_leaf_md_canopy_si_scls)%r82d, & hio_root_md_canopy_si_scls => this%hvars(ih_root_md_canopy_si_scls)%r82d, & hio_carbon_balance_canopy_si_scls => this%hvars(ih_carbon_balance_canopy_si_scls)%r82d, & @@ -1110,6 +1118,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%bstore * n_perm2 * AREA hio_bleaf_canopy_si_scpf(io_si,scpf) = hio_bleaf_canopy_si_scpf(io_si,scpf) + & ccohort%bl * n_perm2 * AREA + hio_canopy_biomass_pa(io_pa) = hio_canopy_biomass_pa(io_pa) + n_density * ccohort%b * 1.e3_r8 hio_mortality_canopy_si_scpf(io_si,scpf) = hio_mortality_canopy_si_scpf(io_si,scpf)+ & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * n_perm2*AREA hio_nplant_canopy_si_scpf(io_si,scpf) = hio_nplant_canopy_si_scpf(io_si,scpf) + AREA*n_perm2 @@ -1154,12 +1163,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_store_canopy_si_scls(io_si,scls) = hio_npp_store_canopy_si_scls(io_si,scls) + & ccohort%npp_store * n_perm2 * AREA * yeardays hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) = hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) + & - real(ccohort%canopy_layer_yesterday, r8) * n_perm2 * AREA + ccohort%canopy_layer_yesterday * n_perm2 * AREA else hio_bstor_understory_si_scpf(io_si,scpf) = hio_bstor_understory_si_scpf(io_si,scpf) + & ccohort%bstore * n_perm2 * AREA hio_bleaf_understory_si_scpf(io_si,scpf) = hio_bleaf_understory_si_scpf(io_si,scpf) + & ccohort%bl * n_perm2 * AREA + hio_understory_biomass_pa(io_pa) = hio_understory_biomass_pa(io_pa) + n_density * ccohort%b * 1.e3_r8 hio_mortality_understory_si_scpf(io_si,scpf) = hio_mortality_understory_si_scpf(io_si,scpf)+ & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * n_perm2*AREA hio_nplant_understory_si_scpf(io_si,scpf) = hio_nplant_understory_si_scpf(io_si,scpf) + AREA*n_perm2 @@ -1204,10 +1214,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_store_understory_si_scls(io_si,scls) = hio_npp_store_understory_si_scls(io_si,scls) + & ccohort%npp_store * n_perm2 * AREA * yeardays hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) = hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) + & - real(ccohort%canopy_layer_yesterday, r8) * n_perm2 * AREA + ccohort%canopy_layer_yesterday * n_perm2 * AREA endif ! - ccohort%canopy_layer_yesterday = ccohort%canopy_layer + ccohort%canopy_layer_yesterday = real(ccohort%canopy_layer, r8) end associate end if @@ -1309,7 +1319,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m6_si_scpf(io_si,i_scpf) end do end do - + + ! pass demotion rates and associated carbon fluxes to history + do i_scls = 1,nlevsclass_ed + hio_demotion_rate_si_scls(io_si,i_scls) = sites(s)%demotion_rate(i_scls) * yeardays + end do + hio_demotion_carbonflux_si(io_si) = sites(s)%demotion_carbonflux * 1e3 / (1e-4 * daysecs) + enddo ! site loop end associate @@ -1834,6 +1850,16 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_btotal_pa ) + call this%set_history_var(vname='CANOPY_BIOMASS', units='gC m-2', & + long='Biomass of canopy plants', use_default='active', & + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_canopy_biomass_pa ) + + call this%set_history_var(vname='UNDERSTORY_BIOMASS', units='gC m-2', & + long='Biomass of understory plants', use_default='active', & + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_understory_biomass_pa ) + ! Ecosystem Carbon Fluxes (updated rapidly, upfreq=2) @@ -2125,6 +2151,16 @@ 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_ba_si_scls ) + call this%set_history_var(vname='DEMOTION_RATE_SCLS', units = 'indiv/ha/yr', & + long='demotion rate from canopy to understory by size class', use_default='active', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_demotion_rate_si_scls ) + + call this%set_history_var(vname='DEMOTION_CARBONFLUX', units = 'gC/m2/s', & + long='demotion-associated biomass carbon flux from canopy to understory', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_demotion_carbonflux_si ) + call this%set_history_var(vname='NPLANT_CANOPY_SCLS', units = 'indiv/ha', & long='number of canopy plants by size class', use_default='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & From c3e01499e1be578523a150a3fd22b02d00388607 Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 21 Feb 2017 22:01:19 -0800 Subject: [PATCH 24/35] fixed unit error and also added new diagnsotics on carbon fluxes from mortality and promotion --- .../ED/biogeochem/EDCanopyStructureMod.F90 | 40 ++++++++++++++----- .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 4 +- components/clm/src/ED/main/EDInitMod.F90 | 5 ++- components/clm/src/ED/main/EDTypesMod.F90 | 5 ++- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 38 +++++++++++++++++- 5 files changed, 78 insertions(+), 14 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index f0f9511e9f..148e53b1e1 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -105,13 +105,17 @@ subroutine canopy_structure( currentSite ) integer :: count_mi !---------------------------------------------------------------------- - currentPatch => currentSite%oldest_patch - - ! Section 1: Check total canopy area. - - new_total_area_check = 0._r8 + currentPatch => currentSite%oldest_patch + ! + ! zero site-level demotion / promotion tracking info currentSite%demotion_rate(:) = 0._r8 + currentSite%promotion_rate(:) = 0._r8 currentSite%demotion_carbonflux = 0._r8 + currentSite%promotion_carbonflux = 0._r8 + ! + ! Section 1: Check total canopy area. + ! + new_total_area_check = 0._r8 do while (associated(currentPatch)) ! Patch loop if (currentPatch%area .gt. min_patch_area) then ! avoid numerical weirdness that shouldn't be happening anyway @@ -205,8 +209,7 @@ subroutine canopy_structure( currentSite ) currentSite%demotion_rate(currentCohort%size_class) = & currentSite%demotion_rate(currentCohort%size_class) + currentCohort%n currentSite%demotion_carbonflux = currentSite%demotion_carbonflux + & - (currentCohort%bdead + currentCohort%bsw + currentCohort%bl + currentCohort%br + & - currentCohort%bstore) * currentCohort%n + currentCohort%b * currentCohort%n !kill the ones which go into canopy layers that are not allowed... (default nclmax=2) if(i+1 > cp_nclmax)then @@ -258,8 +261,7 @@ subroutine canopy_structure( currentSite ) currentSite%demotion_rate(currentCohort%size_class) = & currentSite%demotion_rate(currentCohort%size_class) + currentCohort%n currentSite%demotion_carbonflux = currentSite%demotion_carbonflux + & - (currentCohort%bdead + currentCohort%bsw + currentCohort%bl + currentCohort%br + & - currentCohort%bstore) * currentCohort%n + currentCohort%b * currentCohort%n !kill the ones which go into canopy layers that are not allowed... (default cp_nclmax=2) if(i+1 > cp_nclmax)then @@ -383,6 +385,12 @@ subroutine canopy_structure( currentSite ) currentCohort%canopy_layer = i currentCohort%c_area = c_area(currentCohort) + ! 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_carbonflux = currentSite%promotion_carbonflux + & + currentCohort%b * currentCohort%n + ! write(fates_log(),*) 'promoting very small cohort', currentCohort%c_area,currentCohort%canopy_layer endif arealayer(currentCohort%canopy_layer) = arealayer(currentCohort%canopy_layer)+currentCohort%c_area @@ -442,12 +450,18 @@ subroutine canopy_structure( currentSite ) newarea = currentCohort%c_area - cc_gain !new area of existing cohort copyc%n = currentCohort%n*cc_gain/currentCohort%c_area !number of individuals in promoted cohort. - ! number of individuals in cohort remianing in understorey + ! number of individuals in cohort remaining in understorey currentCohort%n = currentCohort%n - (currentCohort%n*cc_gain/currentCohort%c_area) currentCohort%canopy_layer = i+1 !keep current cohort in the understory. copyc%canopy_layer = i ! promote copy to the higher canopy layer. + ! keep track of number and biomass of promoted cohort + currentSite%promotion_rate(copyc%size_class) = & + currentSite%promotion_rate(copyc%size_class) + copyc%n + currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + & + copyc%b * copyc%n + ! seperate cohorts. ! needs to be a very small number to avoid causing non-linearity issues with c_area. ! is this really required? @@ -474,6 +488,12 @@ subroutine canopy_structure( currentSite ) ! if the upper canopy spread is smaller. this shold be dealt with by the 'excess area' loop. currentCohort%c_area = c_area(currentCohort) + ! 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_carbonflux = currentSite%promotion_carbonflux + & + currentCohort%b * currentCohort%n + promswitch = 1 ! write(fates_log(),*) 'promoting whole cohort', currentCohort%c_area,cc_gain,currentCohort%canopy_layer, & diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index 0cb1f5d73a..3c3247bd32 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -570,7 +570,9 @@ subroutine terminate_cohorts( patchptr ) endif currentPatch%siteptr%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) = & currentPatch%siteptr%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) + currentCohort%n - + ! + currentPatch%siteptr%termination_carbonflux(levcan) = currentPatch%siteptr%termination_carbonflux(levcan) + & + currentCohort%n * currentCohort%b if (.not. associated(currentCohort%taller)) then currentPatch%tallest => currentCohort%shorter else diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 index 4bf0ea8ac1..4d12e266fa 100755 --- a/components/clm/src/ED/main/EDInitMod.F90 +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -81,11 +81,14 @@ subroutine zero_site( site_in ) ! termination and recruitment info site_in%terminated_nindivs(:,:,:) = 0._r8 + site_in%termination_carbonflux(:) = 0._r8 site_in%recruitment_rate(:) = 0._r8 - ! demotion info + ! demotion/promotion info site_in%demotion_rate(:) = 0._r8 site_in%demotion_carbonflux = 0._r8 + site_in%promotion_rate(:) = 0._r8 + site_in%promotion_carbonflux = 0._r8 end subroutine zero_site diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 74123bace3..6fe9171def 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -561,9 +561,12 @@ module EDTypesMod ! TERMINATION, RECRUITMENT, AND DEMOTION real(r8) :: terminated_nindivs(1:nlevsclass_ed,1:mxpft,2) ! number of individuals that were in cohorts which were terminated this timestep, on size x pft x canopy array. + real(r8) :: termination_carbonflux(2) ! carbon flux from live to dead pools associated with termination mortality, per canopy level real(r8) :: recruitment_rate(1:mxpft) ! number of individuals that were recruited into new cohorts real(r8) :: demotion_rate(1:nlevsclass_ed) ! rate of individuals demoted from canopy to understory per FATES timestep - real(r8) :: demotion_carbonflux ! biomass of demoted individuals from canopy to understory [gC/m2/s] + real(r8) :: demotion_carbonflux ! biomass of demoted individuals from canopy to understory [kgC/ha/day] + real(r8) :: promotion_rate(1:nlevsclass_ed) ! rate of individuals promoted from understory to canopy per FATES timestep + real(r8) :: promotion_carbonflux ! biomass of promoted individuals from understory to canopy [kgC/ha/day] end type ed_site_type diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index b6f0d2bdad..9029eec566 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -94,6 +94,9 @@ module FatesHistoryInterfaceMod integer, private :: ih_npatches_si integer, private :: ih_ncohorts_si integer, private :: ih_demotion_carbonflux_si + integer, private :: ih_promotion_carbonflux_si + integer, private :: ih_canopy_mortality_carbonflux_si + integer, private :: ih_understory_mortality_carbonflux_si ! Indices to (site x scpf) variables integer, private :: ih_nplant_si_scpf @@ -147,6 +150,7 @@ module FatesHistoryInterfaceMod integer, private :: ih_mortality_canopy_si_scls integer, private :: ih_mortality_understory_si_scls integer, private :: ih_demotion_rate_si_scls + integer, private :: ih_promotion_rate_si_scls ! lots of non-default diagnostics for understanding canopy versus understory carbon balances integer, private :: ih_rdark_canopy_si_scls @@ -898,6 +902,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_mortality_understory_si_scls => this%hvars(ih_mortality_understory_si_scls)%r82d, & hio_demotion_rate_si_scls => this%hvars(ih_demotion_rate_si_scls)%r82d, & hio_demotion_carbonflux_si => this%hvars(ih_demotion_carbonflux_si)%r81d, & + hio_promotion_rate_si_scls => this%hvars(ih_promotion_rate_si_scls)%r82d, & + hio_promotion_carbonflux_si => this%hvars(ih_promotion_carbonflux_si)%r81d, & + hio_canopy_mortality_carbonflux_si => this%hvars(ih_canopy_mortality_carbonflux_si)%r81d, & + hio_understory_mortality_carbonflux_si => this%hvars(ih_understory_mortality_carbonflux_si)%r81d, & hio_leaf_md_canopy_si_scls => this%hvars(ih_leaf_md_canopy_si_scls)%r82d, & hio_root_md_canopy_si_scls => this%hvars(ih_root_md_canopy_si_scls)%r82d, & hio_carbon_balance_canopy_si_scls => this%hvars(ih_carbon_balance_canopy_si_scls)%r82d, & @@ -1133,6 +1141,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! sum of all mortality hio_mortality_canopy_si_scls(io_si,scls) = hio_mortality_canopy_si_scls(io_si,scls) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * n_perm2*AREA + hio_canopy_mortality_carbonflux_si(io_si) = hio_canopy_mortality_carbonflux_si(io_si) + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * & + ccohort%b * ccohort%n * 1e3 / (1e4 * daysecs) ! hio_leaf_md_canopy_si_scls(io_si,scls) = hio_leaf_md_canopy_si_scls(io_si,scls) + & ccohort%leaf_md * n_perm2 * AREA @@ -1184,6 +1195,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! sum of all mortality hio_mortality_understory_si_scls(io_si,scls) = hio_mortality_understory_si_scls(io_si,scls) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * n_perm2*AREA + hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * & + ccohort%b * ccohort%n * 1e3 / (1e4 * daysecs) ! hio_leaf_md_understory_si_scls(io_si,scls) = hio_leaf_md_understory_si_scls(io_si,scls) + & ccohort%leaf_md * n_perm2 * AREA @@ -1323,8 +1337,20 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! pass demotion rates and associated carbon fluxes to history do i_scls = 1,nlevsclass_ed hio_demotion_rate_si_scls(io_si,i_scls) = sites(s)%demotion_rate(i_scls) * yeardays + hio_promotion_rate_si_scls(io_si,i_scls) = sites(s)%promotion_rate(i_scls) * yeardays end do - hio_demotion_carbonflux_si(io_si) = sites(s)%demotion_carbonflux * 1e3 / (1e-4 * daysecs) + ! + ! convert kg C / ha / day to gc / m2 / sec + hio_demotion_carbonflux_si(io_si) = sites(s)%demotion_carbonflux * 1e3 / (1e4 * daysecs) + hio_promotion_carbonflux_si(io_si) = sites(s)%promotion_carbonflux * 1e3 / (1e4 * daysecs) + ! + ! mortality-associated carbon fluxes + hio_canopy_mortality_carbonflux_si(io_si) = hio_canopy_mortality_carbonflux_si(io_si) + & + sites(s)%termination_carbonflux(1) * 1e3 / (1e4 * daysecs) + hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & + sites(s)%termination_carbonflux(2) * 1e3 / (1e4 * daysecs) + ! and zero the site-level termination carbon flux variable + sites(s)%termination_carbonflux(:) = 0._r8 enddo ! site loop @@ -2161,6 +2187,16 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_demotion_carbonflux_si ) + call this%set_history_var(vname='PROMOTION_RATE_SCLS', units = 'indiv/ha/yr', & + long='promotion rate from understory to canopy by size class', use_default='active', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_promotion_rate_si_scls ) + + call this%set_history_var(vname='PROMOTION_CARBONFLUX', units = 'gC/m2/s', & + long='promotion-associated biomass carbon flux from understory to canopy', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_promotion_carbonflux_si ) + call this%set_history_var(vname='NPLANT_CANOPY_SCLS', units = 'indiv/ha', & long='number of canopy plants by size class', use_default='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & From dd04f1559e08baac9f7c14f81c2560b563a7b594 Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 22 Feb 2017 09:45:03 -0800 Subject: [PATCH 25/35] bufix and some cleanup --- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 35 ++++++++++++------- 1 file changed, 23 insertions(+), 12 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 9029eec566..25614f5af6 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1876,12 +1876,12 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_btotal_pa ) - call this%set_history_var(vname='CANOPY_BIOMASS', units='gC m-2', & + call this%set_history_var(vname='BIOMASS_CANOPY', units='gC m-2', & long='Biomass of canopy plants', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_canopy_biomass_pa ) - call this%set_history_var(vname='UNDERSTORY_BIOMASS', units='gC m-2', & + call this%set_history_var(vname='BIOMASS_UNDERSTORY', units='gC m-2', & long='Biomass of understory plants', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_understory_biomass_pa ) @@ -1951,6 +1951,27 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_ar_understory_pa ) + ! slow carbon fluxes associated with mortality from or transfer betweeen canopy and understory + call this%set_history_var(vname='DEMOTION_CARBONFLUX', units = 'gC/m2/s', & + long='demotion-associated biomass carbon flux from canopy to understory', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_demotion_carbonflux_si ) + + call this%set_history_var(vname='PROMOTION_CARBONFLUX', units = 'gC/m2/s', & + long='promotion-associated biomass carbon flux from understory to canopy', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_promotion_carbonflux_si ) + + call this%set_history_var(vname='MORTALITY_CARBONFLUX_CANOPY', units = 'gC/m2/s', & + long='flux of biomass carbon from live to dead pools from mortality of canopy plants', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_canopy_mortality_carbonflux_si ) + + call this%set_history_var(vname='MORTALITY_CARBONFLUX_UNDERSTORY', units = 'gC/m2/s', & + long='flux of biomass carbon from live to dead pools from mortality of understory plants', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_understory_mortality_carbonflux_si ) + ! Carbon Flux (grid dimension x scpf) (THESE ARE DEFAULT INACTIVE!!! ! (BECAUSE THEY TAKE UP SPACE!!! @@ -2182,21 +2203,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_demotion_rate_si_scls ) - call this%set_history_var(vname='DEMOTION_CARBONFLUX', units = 'gC/m2/s', & - long='demotion-associated biomass carbon flux from canopy to understory', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_demotion_carbonflux_si ) - call this%set_history_var(vname='PROMOTION_RATE_SCLS', units = 'indiv/ha/yr', & long='promotion rate from understory to canopy by size class', use_default='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_promotion_rate_si_scls ) - call this%set_history_var(vname='PROMOTION_CARBONFLUX', units = 'gC/m2/s', & - long='promotion-associated biomass carbon flux from understory to canopy', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_promotion_carbonflux_si ) - call this%set_history_var(vname='NPLANT_CANOPY_SCLS', units = 'indiv/ha', & long='number of canopy plants by size class', use_default='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & From 3a7b068975ccb001ee5320deaaa3d3fc046f061d Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 22 Feb 2017 10:26:45 -0800 Subject: [PATCH 26/35] reduced thresholds for cohort termination due to small number densities to allow cohorts to demote successfully --- components/clm/src/ED/main/EDTypesMod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 6fe9171def..bef4d13b69 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -67,12 +67,12 @@ module EDTypesMod integer , parameter :: N_DBH_BINS = 5 ! no. of dbh bins used when comparing patches - real(r8), parameter :: min_npm2 = 1.0d-5 ! minimum cohort number density per m2 before termination - real(r8), parameter :: min_patch_area = 0.001_r8 ! smallest allowable patch area before termination - real(r8), parameter :: min_nppatch = 1.0d-8 ! minimum number of cohorts per patch (min_npm2*min_patch_area) - real(r8), parameter :: min_n_safemath = 1.0d-15 ! in some cases, we want to immediately remove super small - ! number densities of cohorts to prevent FPEs, this is usually - ! just relevant in the first day after recruitment + real(r8), parameter :: min_npm2 = 1.0E-8_r8 ! minimum cohort number density per m2 before termination + real(r8), parameter :: min_patch_area = 0.001_r8 ! smallest allowable patch area before termination + real(r8), parameter :: min_nppatch = 1.0E-11_r8 ! minimum number of cohorts per patch (min_npm2*min_patch_area) + real(r8), parameter :: min_n_safemath = 1.0E-15_r8 ! in some cases, we want to immediately remove super small + ! number densities of cohorts to prevent FPEs, this is usually + ! just relevant in the first day after recruitment character*4 yearchar From 4157e60b67d78f5cfd3d11e12926d77d94acd243 Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 22 Feb 2017 11:04:27 -0800 Subject: [PATCH 27/35] removed calls to terminate_cohorts in EDCanopyStructureMod.F90 --- components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index 148e53b1e1..ae65628678 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -295,7 +295,6 @@ subroutine canopy_structure( currentSite ) !currentCohort%canopy_layer,currentCohort%dbh endif - ! call terminate_cohorts(currentPatch) !----------- End of cohort splitting ------------------------------! endif !canopy layer = i @@ -304,7 +303,6 @@ subroutine canopy_structure( currentSite ) enddo !currentCohort - call terminate_cohorts(currentPatch) arealayer(i) = arealayer(i) - sumloss !Update arealayer for diff calculations of layer below. arealayer(i + 1) = arealayer(i + 1) + sumloss @@ -340,7 +338,6 @@ subroutine canopy_structure( currentSite ) enddo !is there still excess area in any layer? - call terminate_cohorts(currentPatch) call fuse_cohorts(currentPatch) call terminate_cohorts(currentPatch) @@ -500,7 +497,6 @@ subroutine canopy_structure( currentSite ) !currentCohort%pft,currentPatch%patchno endif - !call terminate_cohorts(currentPatch) if(promswitch == 1)then ! write(fates_log(),*) 'cohort loop',currentCohort%pft,currentPatch%patchno endif @@ -562,7 +558,6 @@ subroutine canopy_structure( currentSite ) endif enddo !is there still not enough canopy area in any layer? - call terminate_cohorts(currentPatch) call fuse_cohorts(currentPatch) call terminate_cohorts(currentPatch) From cb812d9967bf2b93088c7d64be6e803fb5e1beb8 Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 22 Feb 2017 12:47:33 -0800 Subject: [PATCH 28/35] fixed unit error on mortality_carbonflux_canopy and mortality_carbonflux_understory --- components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 25614f5af6..f65832537c 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1143,7 +1143,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * n_perm2*AREA hio_canopy_mortality_carbonflux_si(io_si) = hio_canopy_mortality_carbonflux_si(io_si) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * & - ccohort%b * ccohort%n * 1e3 / (1e4 * daysecs) + ccohort%b * ccohort%n * 1e3 / (1e4 * daysecs * yeardays) ! hio_leaf_md_canopy_si_scls(io_si,scls) = hio_leaf_md_canopy_si_scls(io_si,scls) + & ccohort%leaf_md * n_perm2 * AREA @@ -1197,7 +1197,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * n_perm2*AREA hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * & - ccohort%b * ccohort%n * 1e3 / (1e4 * daysecs) + ccohort%b * ccohort%n * 1e3 / (1e4 * daysecs * yeardays) ! hio_leaf_md_understory_si_scls(io_si,scls) = hio_leaf_md_understory_si_scls(io_si,scls) + & ccohort%leaf_md * n_perm2 * AREA From b9fd99e64460525aed2b39989955daaa17fe7423 Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 22 Feb 2017 13:49:07 -0800 Subject: [PATCH 29/35] fixed a unit error on the canopy/understory-reoslved tissue npp fluxes, which was traced back to a wrong description in EDTypesMod. Also cleanup. --- components/clm/src/ED/main/EDTypesMod.F90 | 12 +- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 106 +++++++++--------- 2 files changed, 59 insertions(+), 59 deletions(-) diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 6fe9171def..326126a5b3 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -250,12 +250,12 @@ module EDTypesMod ! Net Primary Production Partitions - real(r8) :: npp_leaf ! NPP into leaves (includes replacement of turnover): KgC/indiv/day - real(r8) :: npp_froot ! NPP into fine roots (includes replacement of turnover): KgC/indiv/day - real(r8) :: npp_bsw ! NPP into sapwood: KgC/indiv/day - real(r8) :: npp_bdead ! NPP into deadwood (structure): KgC/indiv/day - real(r8) :: npp_bseed ! NPP into seeds: KgC/indiv/day - real(r8) :: npp_store ! NPP into storage: KgC/indiv/day + real(r8) :: npp_leaf ! NPP into leaves (includes replacement of turnover): KgC/indiv/year + real(r8) :: npp_froot ! NPP into fine roots (includes replacement of turnover): KgC/indiv/year + real(r8) :: npp_bsw ! NPP into sapwood: KgC/indiv/year + real(r8) :: npp_bdead ! NPP into deadwood (structure): KgC/indiv/year + real(r8) :: npp_bseed ! NPP into seeds: KgC/indiv/year + real(r8) :: npp_store ! NPP into storage: KgC/indiv/year real(r8) :: ts_net_uptake(cp_nlevcan) ! Net uptake of leaf layers: kgC/m2/s real(r8) :: year_net_uptake(cp_nlevcan) ! Net uptake of leaf layers: kgC/m2/year diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index f65832537c..774c6308fc 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1099,136 +1099,136 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! Woody State Variables (basal area and number density and mortality) if (pftcon%woody(ft) == 1) then - hio_m1_si_scpf(io_si,scpf) = hio_m1_si_scpf(io_si,scpf) + ccohort%bmort*n_perm2*AREA - hio_m2_si_scpf(io_si,scpf) = hio_m2_si_scpf(io_si,scpf) + ccohort%hmort*n_perm2*AREA - hio_m3_si_scpf(io_si,scpf) = hio_m3_si_scpf(io_si,scpf) + ccohort%cmort*n_perm2*AREA - hio_m4_si_scpf(io_si,scpf) = hio_m4_si_scpf(io_si,scpf) + ccohort%imort*n_perm2*AREA - hio_m5_si_scpf(io_si,scpf) = hio_m5_si_scpf(io_si,scpf) + ccohort%fmort*n_perm2*AREA + hio_m1_si_scpf(io_si,scpf) = hio_m1_si_scpf(io_si,scpf) + ccohort%bmort*ccohort%n + hio_m2_si_scpf(io_si,scpf) = hio_m2_si_scpf(io_si,scpf) + ccohort%hmort*ccohort%n + hio_m3_si_scpf(io_si,scpf) = hio_m3_si_scpf(io_si,scpf) + ccohort%cmort*ccohort%n + hio_m4_si_scpf(io_si,scpf) = hio_m4_si_scpf(io_si,scpf) + ccohort%imort*ccohort%n + hio_m5_si_scpf(io_si,scpf) = hio_m5_si_scpf(io_si,scpf) + ccohort%fmort*ccohort%n ! basal area [m2/ha] hio_ba_si_scpf(io_si,scpf) = hio_ba_si_scpf(io_si,scpf) + & - 0.25_r8*3.14159_r8*((dbh/100.0_r8)**2.0_r8)*n_perm2*AREA + 0.25_r8*3.14159_r8*((dbh/100.0_r8)**2.0_r8)*ccohort%n ! also by size class only hio_ba_si_scls(io_si,scls) = hio_ba_si_scls(io_si,scls) + & - 0.25_r8*3.14159_r8*((dbh/100.0_r8)**2.0_r8)*n_perm2*AREA + 0.25_r8*3.14159_r8*((dbh/100.0_r8)**2.0_r8)*ccohort%n ! number density [/ha] - hio_nplant_si_scpf(io_si,scpf) = hio_nplant_si_scpf(io_si,scpf) + AREA*n_perm2 + hio_nplant_si_scpf(io_si,scpf) = hio_nplant_si_scpf(io_si,scpf) + ccohort%n ! growth increment hio_ddbh_si_scpf(io_si,scpf) = hio_ddbh_si_scpf(io_si,scpf) + & - ccohort%ddbhdt*n_perm2*AREA + ccohort%ddbhdt*ccohort%n end if ! update SCPF/SCLS- and canopy/subcanopy- partitioned quantities if (ccohort%canopy_layer .eq. 1) then hio_bstor_canopy_si_scpf(io_si,scpf) = hio_bstor_canopy_si_scpf(io_si,scpf) + & - ccohort%bstore * n_perm2 * AREA + ccohort%bstore * ccohort%n hio_bleaf_canopy_si_scpf(io_si,scpf) = hio_bleaf_canopy_si_scpf(io_si,scpf) + & - ccohort%bl * n_perm2 * AREA + ccohort%bl * ccohort%n hio_canopy_biomass_pa(io_pa) = hio_canopy_biomass_pa(io_pa) + n_density * ccohort%b * 1.e3_r8 hio_mortality_canopy_si_scpf(io_si,scpf) = hio_mortality_canopy_si_scpf(io_si,scpf)+ & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * n_perm2*AREA - hio_nplant_canopy_si_scpf(io_si,scpf) = hio_nplant_canopy_si_scpf(io_si,scpf) + AREA*n_perm2 - hio_nplant_canopy_si_scls(io_si,scls) = hio_nplant_canopy_si_scls(io_si,scls) + AREA*n_perm2 + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * ccohort%n + hio_nplant_canopy_si_scpf(io_si,scpf) = hio_nplant_canopy_si_scpf(io_si,scpf) + ccohort%n + hio_nplant_canopy_si_scls(io_si,scls) = hio_nplant_canopy_si_scls(io_si,scls) + ccohort%n hio_gpp_canopy_si_scpf(io_si,scpf) = hio_gpp_canopy_si_scpf(io_si,scpf) + & n_perm2*ccohort%gpp_acc_hold hio_ar_canopy_si_scpf(io_si,scpf) = hio_ar_canopy_si_scpf(io_si,scpf) + & n_perm2*ccohort%resp_acc_hold ! growth increment hio_ddbh_canopy_si_scpf(io_si,scpf) = hio_ddbh_canopy_si_scpf(io_si,scpf) + & - ccohort%ddbhdt*n_perm2*AREA + ccohort%ddbhdt*ccohort%n ! sum of all mortality hio_mortality_canopy_si_scls(io_si,scls) = hio_mortality_canopy_si_scls(io_si,scls) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * n_perm2*AREA + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * ccohort%n hio_canopy_mortality_carbonflux_si(io_si) = hio_canopy_mortality_carbonflux_si(io_si) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * & ccohort%b * ccohort%n * 1e3 / (1e4 * daysecs * yeardays) ! hio_leaf_md_canopy_si_scls(io_si,scls) = hio_leaf_md_canopy_si_scls(io_si,scls) + & - ccohort%leaf_md * n_perm2 * AREA + 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 * n_perm2 * AREA + ccohort%root_md * ccohort%n hio_carbon_balance_canopy_si_scls(io_si,scls) = hio_carbon_balance_canopy_si_scls(io_si,scls) + & - ccohort%carbon_balance * n_perm2 * AREA + ccohort%carbon_balance * ccohort%n hio_seed_prod_canopy_si_scls(io_si,scls) = hio_seed_prod_canopy_si_scls(io_si,scls) + & - ccohort%seed_prod * n_perm2 * AREA + ccohort%seed_prod * ccohort%n hio_dbalivedt_canopy_si_scls(io_si,scls) = hio_dbalivedt_canopy_si_scls(io_si,scls) + & - ccohort%dbalivedt * n_perm2 * AREA + ccohort%dbalivedt * ccohort%n hio_dbdeaddt_canopy_si_scls(io_si,scls) = hio_dbdeaddt_canopy_si_scls(io_si,scls) + & - ccohort%dbdeaddt * n_perm2 * AREA + ccohort%dbdeaddt * ccohort%n hio_dbstoredt_canopy_si_scls(io_si,scls) = hio_dbstoredt_canopy_si_scls(io_si,scls) + & - ccohort%dbstoredt * n_perm2 * AREA + ccohort%dbstoredt * ccohort%n hio_storage_flux_canopy_si_scls(io_si,scls) = hio_storage_flux_canopy_si_scls(io_si,scls) + & - ccohort%storage_flux * n_perm2 * AREA + ccohort%storage_flux * ccohort%n hio_npp_leaf_canopy_si_scls(io_si,scls) = hio_npp_leaf_canopy_si_scls(io_si,scls) + & - ccohort%npp_leaf * n_perm2 * AREA * yeardays + ccohort%npp_leaf * ccohort%n hio_npp_froot_canopy_si_scls(io_si,scls) = hio_npp_froot_canopy_si_scls(io_si,scls) + & - ccohort%npp_froot * n_perm2 * AREA * yeardays + ccohort%npp_froot * ccohort%n hio_npp_bsw_canopy_si_scls(io_si,scls) = hio_npp_bsw_canopy_si_scls(io_si,scls) + & - ccohort%npp_bsw * n_perm2 * AREA * yeardays + ccohort%npp_bsw * ccohort%n hio_npp_bdead_canopy_si_scls(io_si,scls) = hio_npp_bdead_canopy_si_scls(io_si,scls) + & - ccohort%npp_bdead * n_perm2 * AREA * yeardays + ccohort%npp_bdead * ccohort%n hio_npp_bseed_canopy_si_scls(io_si,scls) = hio_npp_bseed_canopy_si_scls(io_si,scls) + & - ccohort%npp_bseed * n_perm2 * AREA * yeardays + ccohort%npp_bseed * ccohort%n hio_npp_store_canopy_si_scls(io_si,scls) = hio_npp_store_canopy_si_scls(io_si,scls) + & - ccohort%npp_store * n_perm2 * AREA * yeardays + ccohort%npp_store * ccohort%n hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) = hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) + & - ccohort%canopy_layer_yesterday * n_perm2 * AREA + ccohort%canopy_layer_yesterday * ccohort%n else hio_bstor_understory_si_scpf(io_si,scpf) = hio_bstor_understory_si_scpf(io_si,scpf) + & - ccohort%bstore * n_perm2 * AREA + ccohort%bstore * ccohort%n hio_bleaf_understory_si_scpf(io_si,scpf) = hio_bleaf_understory_si_scpf(io_si,scpf) + & - ccohort%bl * n_perm2 * AREA + ccohort%bl * ccohort%n hio_understory_biomass_pa(io_pa) = hio_understory_biomass_pa(io_pa) + n_density * ccohort%b * 1.e3_r8 hio_mortality_understory_si_scpf(io_si,scpf) = hio_mortality_understory_si_scpf(io_si,scpf)+ & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * n_perm2*AREA - hio_nplant_understory_si_scpf(io_si,scpf) = hio_nplant_understory_si_scpf(io_si,scpf) + AREA*n_perm2 - hio_nplant_understory_si_scls(io_si,scls) = hio_nplant_understory_si_scls(io_si,scls) + AREA*n_perm2 + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * ccohort%n + hio_nplant_understory_si_scpf(io_si,scpf) = hio_nplant_understory_si_scpf(io_si,scpf) + ccohort%n + hio_nplant_understory_si_scls(io_si,scls) = hio_nplant_understory_si_scls(io_si,scls) + ccohort%n hio_gpp_understory_si_scpf(io_si,scpf) = hio_gpp_understory_si_scpf(io_si,scpf) + & n_perm2*ccohort%gpp_acc_hold hio_ar_understory_si_scpf(io_si,scpf) = hio_ar_understory_si_scpf(io_si,scpf) + & n_perm2*ccohort%resp_acc_hold ! growth increment hio_ddbh_understory_si_scpf(io_si,scpf) = hio_ddbh_understory_si_scpf(io_si,scpf) + & - ccohort%ddbhdt*n_perm2*AREA + ccohort%ddbhdt*ccohort%n ! sum of all mortality hio_mortality_understory_si_scls(io_si,scls) = hio_mortality_understory_si_scls(io_si,scls) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * n_perm2*AREA + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * ccohort%n hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * & ccohort%b * ccohort%n * 1e3 / (1e4 * daysecs * yeardays) ! hio_leaf_md_understory_si_scls(io_si,scls) = hio_leaf_md_understory_si_scls(io_si,scls) + & - ccohort%leaf_md * n_perm2 * AREA + ccohort%leaf_md * ccohort%n hio_root_md_understory_si_scls(io_si,scls) = hio_root_md_understory_si_scls(io_si,scls) + & - ccohort%root_md * n_perm2 * AREA + ccohort%root_md * ccohort%n hio_carbon_balance_understory_si_scls(io_si,scls) = hio_carbon_balance_understory_si_scls(io_si,scls) + & - ccohort%carbon_balance * n_perm2 * AREA + ccohort%carbon_balance * ccohort%n hio_seed_prod_understory_si_scls(io_si,scls) = hio_seed_prod_understory_si_scls(io_si,scls) + & - ccohort%seed_prod * n_perm2 * AREA + ccohort%seed_prod * ccohort%n hio_dbalivedt_understory_si_scls(io_si,scls) = hio_dbalivedt_understory_si_scls(io_si,scls) + & - ccohort%dbalivedt * n_perm2 * AREA + ccohort%dbalivedt * ccohort%n hio_dbdeaddt_understory_si_scls(io_si,scls) = hio_dbdeaddt_understory_si_scls(io_si,scls) + & - ccohort%dbdeaddt * n_perm2 * AREA + ccohort%dbdeaddt * ccohort%n hio_dbstoredt_understory_si_scls(io_si,scls) = hio_dbstoredt_understory_si_scls(io_si,scls) + & - ccohort%dbstoredt * n_perm2 * AREA + ccohort%dbstoredt * ccohort%n hio_storage_flux_understory_si_scls(io_si,scls) = hio_storage_flux_understory_si_scls(io_si,scls) + & - ccohort%storage_flux * n_perm2 * AREA + ccohort%storage_flux * ccohort%n hio_npp_leaf_understory_si_scls(io_si,scls) = hio_npp_leaf_understory_si_scls(io_si,scls) + & - ccohort%npp_leaf * n_perm2 * AREA * yeardays + ccohort%npp_leaf * ccohort%n hio_npp_froot_understory_si_scls(io_si,scls) = hio_npp_froot_understory_si_scls(io_si,scls) + & - ccohort%npp_froot * n_perm2 * AREA * yeardays + ccohort%npp_froot * ccohort%n hio_npp_bsw_understory_si_scls(io_si,scls) = hio_npp_bsw_understory_si_scls(io_si,scls) + & - ccohort%npp_bsw * n_perm2 * AREA * yeardays + ccohort%npp_bsw * ccohort%n hio_npp_bdead_understory_si_scls(io_si,scls) = hio_npp_bdead_understory_si_scls(io_si,scls) + & - ccohort%npp_bdead * n_perm2 * AREA * yeardays + ccohort%npp_bdead * ccohort%n hio_npp_bseed_understory_si_scls(io_si,scls) = hio_npp_bseed_understory_si_scls(io_si,scls) + & - ccohort%npp_bseed * n_perm2 * AREA * yeardays + ccohort%npp_bseed * ccohort%n hio_npp_store_understory_si_scls(io_si,scls) = hio_npp_store_understory_si_scls(io_si,scls) + & - ccohort%npp_store * n_perm2 * AREA * yeardays + ccohort%npp_store * ccohort%n hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) = hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) + & - ccohort%canopy_layer_yesterday * n_perm2 * AREA + ccohort%canopy_layer_yesterday * ccohort%n endif ! ccohort%canopy_layer_yesterday = real(ccohort%canopy_layer, r8) From c875214bbf798308f98448e3b7801da59ffb5a04 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 1 Mar 2017 12:06:47 -0800 Subject: [PATCH 30/35] Made a fix to indexing and storage of water-memory. --- components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index 2eb77c486e..0e9b02860b 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -427,10 +427,11 @@ subroutine phenology( currentSite, bc_in ) ! distinction actually matter??).... !Accumulate surface water memory of last 10 days. - currentSite%water_memory(1) = bc_in%h2osoi_vol_si !waterstate_inst%h2osoi_vol_col(coli,1) - do i = 1,numWaterMem !shift memory along one + + do i = 1,numWaterMem-1 !shift memory along one currentSite%water_memory(numWaterMem+1-i) = currentSite%water_memory(numWaterMem-i) enddo + currentSite%water_memory(1) = bc_in%h2osoi_vol_si !waterstate_inst%h2osoi_vol_col(coli,1) !In drought phenology, we often need to force the leaves to stay on or off as moisture fluctuates... timesincedleafoff = 0 From 725e0b539037c9e5b695bee216b32a01d9b507f7 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 2 Mar 2017 13:53:56 -0800 Subject: [PATCH 31/35] Cleaned up endrun use statements in EDAccumulateFluxes, also removed unnecessary call to IEEE arithmetic. --- .../clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/components/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 b/components/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 index f05703528e..f782a21979 100644 --- a/components/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 +++ b/components/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 @@ -9,8 +9,10 @@ module EDAccumulateFluxesMod ! Rosie Fisher. March 2014. ! ! !USES: - use abortutils, only : endrun + use FatesGlobals, only : fates_endrun + use FatesGlobals, only : fates_log use shr_log_mod , only : errMsg => shr_log_errMsg + use FatesConstantsMod , only : r8 => fates_r8 implicit none private ! @@ -32,12 +34,10 @@ subroutine AccumulateFluxes_ED(nsites, sites, bc_in, bc_out, dt_time) ! see above ! ! !USES: - use FatesConstantsMod , only : r8 => fates_r8 - use FatesGlobals , only : fates_log + use EDTypesMod , only : ed_patch_type, ed_cohort_type, & ed_site_type, AREA use FatesInterfaceMod , only : bc_in_type,bc_out_type - use, intrinsic :: IEEE_ARITHMETIC ! ! !ARGUMENTS From d12288affef2db6409b6ad0171c3efd2cccee242 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 2 Mar 2017 14:24:40 -0800 Subject: [PATCH 32/35] Changed endrun in EDPhysiology to point to fates_endrun() in FatesGlobals. --- components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index 0e9b02860b..2d78b27817 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -27,9 +27,8 @@ module EDPhysiologyMod use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use shr_log_mod , only : errMsg => shr_log_errMsg - use abortutils , only : endrun use FatesGlobals , only : fates_log - + use FatesGlobals , only : endrun => fates_endrun implicit none From 416e5901beaf3c165592111d232efb1eeec3bf64 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 3 Mar 2017 11:23:43 -0800 Subject: [PATCH 33/35] Swapped indices on terminated_nindivs array, bugfix. --- components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 774c6308fc..4892de2d6b 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1300,7 +1300,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) do i_pft = 1, mxpft do i_scls = 1,nlevsclass_ed i_scpf = (i_pft-1)*nlevsclass_ed + i_scls - hio_m6_si_scpf(io_si,i_scpf) = (sites(s)%terminated_nindivs(i_pft,i_scls,1) + & + hio_m6_si_scpf(io_si,i_scpf) = (sites(s)%terminated_nindivs(i_scls,i_pft,1) + & sites(s)%terminated_nindivs(i_scls,i_pft,2)) * yeardays hio_mortality_canopy_si_scls(io_si,i_scls) = hio_mortality_canopy_si_scls(io_si,i_scls) + & sites(s)%terminated_nindivs(i_scls,i_pft,1) * yeardays From cb364b9e3d1df2cc0f297c6d0e24711c5069e5ba Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 8 Mar 2017 19:07:35 -0800 Subject: [PATCH 34/35] cleaned up site pointer issues --- .../clm/src/ED/biogeochem/EDCanopyStructureMod.F90 | 10 +++++----- .../clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 | 9 +++++---- .../clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 | 4 ++-- components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 | 2 +- components/clm/src/ED/main/EDMainMod.F90 | 4 ++-- 5 files changed, 15 insertions(+), 14 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index 23368746c9..2516b18dfc 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -307,7 +307,7 @@ subroutine canopy_structure( currentSite ) enddo !currentCohort - call terminate_cohorts(currentPatch) + call terminate_cohorts(currentSite, currentPatch) arealayer(i) = arealayer(i) - sumloss !Update arealayer for diff calculations of layer below. arealayer(i + 1) = arealayer(i + 1) + sumloss @@ -343,9 +343,9 @@ subroutine canopy_structure( currentSite ) enddo !is there still excess area in any layer? - call terminate_cohorts(currentPatch) + call terminate_cohorts(currentSite, currentPatch) call fuse_cohorts(currentPatch) - call terminate_cohorts(currentPatch) + call terminate_cohorts(currentSite, currentPatch) ! ----------- Check cohort area ------------------------------! do i = 1,z @@ -565,9 +565,9 @@ subroutine canopy_structure( currentSite ) endif enddo !is there still not enough canopy area in any layer? - call terminate_cohorts(currentPatch) + call terminate_cohorts(currentSite, currentPatch) call fuse_cohorts(currentPatch) - call terminate_cohorts(currentPatch) + call terminate_cohorts(currentSite, currentPatch) if(promswitch == 1)then !write(fates_log(),*) 'going into cohort check' diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index 1ff9971d82..d02f3c0300 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -485,7 +485,7 @@ subroutine zero_cohort(cc_p) end subroutine zero_cohort !-------------------------------------------------------------------------------------! - subroutine terminate_cohorts( patchptr ) + subroutine terminate_cohorts( siteptr, patchptr ) ! ! !DESCRIPTION: ! terminates cohorts when they get too small @@ -495,6 +495,7 @@ subroutine terminate_cohorts( patchptr ) use SFParamsMod, only : SF_val_CWD_frac ! ! !ARGUMENTS + type (ed_site_type), intent(inout), target :: siteptr type (ed_patch_type), intent(inout), target :: patchptr ! ! !LOCAL VARIABLES: @@ -571,10 +572,10 @@ subroutine terminate_cohorts( patchptr ) else levcan = 2 endif - currentPatch%siteptr%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) = & - currentPatch%siteptr%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) + currentCohort%n + siteptr%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) = & + siteptr%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) + currentCohort%n ! - currentPatch%siteptr%termination_carbonflux(levcan) = currentPatch%siteptr%termination_carbonflux(levcan) + & + siteptr%termination_carbonflux(levcan) = siteptr%termination_carbonflux(levcan) + & currentCohort%n * currentCohort%b if (.not. associated(currentCohort%taller)) then currentPatch%tallest => currentCohort%shorter diff --git a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 index 237c831af5..fd5423eeec 100755 --- a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 @@ -396,7 +396,7 @@ subroutine spawn_patches( currentSite ) !sort out the cohorts, since some of them may be so small as to need removing. call fuse_cohorts(currentPatch) - call terminate_cohorts(currentPatch) + call terminate_cohorts(currentSite, currentPatch) call sort_cohorts(currentPatch) currentPatch => currentPatch%younger @@ -413,7 +413,7 @@ subroutine spawn_patches( currentSite ) currentSite%youngest_patch => new_patch call fuse_cohorts(new_patch) - call terminate_cohorts(new_patch) + call terminate_cohorts(currentSite, new_patch) call sort_cohorts(new_patch) endif !end new_patch area diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index 0cdd239021..f2ffc055e9 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -1081,7 +1081,7 @@ subroutine recruitment( t, currentSite, currentPatch ) temp_cohort%laimemory, cohortstatus, temp_cohort%canopy_trim, currentPatch%NCL_p) ! keep track of how many individuals were recruited for passing to history - currentPatch%siteptr%recruitment_rate(ft) = currentPatch%siteptr%recruitment_rate(ft) + temp_cohort%n + currentSite%recruitment_rate(ft) = currentSite%recruitment_rate(ft) + temp_cohort%n endif enddo !pft loop diff --git a/components/clm/src/ED/main/EDMainMod.F90 b/components/clm/src/ED/main/EDMainMod.F90 index d06ff59218..780787e2df 100755 --- a/components/clm/src/ED/main/EDMainMod.F90 +++ b/components/clm/src/ED/main/EDMainMod.F90 @@ -118,7 +118,7 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) call fuse_cohorts(currentPatch) ! kills cohorts that are too small - call terminate_cohorts(currentPatch) + call terminate_cohorts(currentSite, currentPatch) currentPatch => currentPatch%younger @@ -341,7 +341,7 @@ subroutine ed_update_site( currentSite, bc_in ) currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) - call terminate_cohorts(currentPatch) + call terminate_cohorts(currentSite, currentPatch) ! FIX(SPM,040314) why is this needed for BFB restarts? Look into this at some point cohort_number = count_cohorts(currentPatch) From c40a748c880175533ca7efcc014e8282830ca127 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 8 Mar 2017 21:16:46 -0800 Subject: [PATCH 35/35] Fixed some overly long line lengths. --- components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 | 3 ++- components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index d02f3c0300..f1bbdde262 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -773,7 +773,8 @@ subroutine fuse_cohorts(patchptr) currentCohort%npp_store = (currentCohort%n*currentCohort%npp_store + nextc%n*nextc%npp_store)/newn ! recent canopy history - currentCohort%canopy_layer_yesterday = (currentCohort%n*currentCohort%canopy_layer_yesterday + nextc%n*nextc%canopy_layer_yesterday)/newn + currentCohort%canopy_layer_yesterday = (currentCohort%n*currentCohort%canopy_layer_yesterday + & + nextc%n*nextc%canopy_layer_yesterday)/newn do i=1, nlevcan if (currentCohort%year_net_uptake(i) == 999._r8 .or. nextc%year_net_uptake(i) == 999._r8) then diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index eb95615af3..d7aa01ec11 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1227,7 +1227,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%npp_bseed * ccohort%n hio_npp_store_understory_si_scls(io_si,scls) = hio_npp_store_understory_si_scls(io_si,scls) + & ccohort%npp_store * ccohort%n - hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) = hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) + & + hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) = & + hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) + & ccohort%canopy_layer_yesterday * ccohort%n endif !