From 1307cd56cfbea6a6d1d9f676db581ae5475c656b Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 11 Jan 2017 20:48:17 -0800 Subject: [PATCH 01/12] added size class only dimension and a basal area variable on that dimension --- main/FatesHistoryInterfaceMod.F90 | 66 ++++++++++++++++++++++++++++--- main/FatesHistoryVariableType.F90 | 9 ++++- main/FatesIODimensionsMod.F90 | 6 +++ main/FatesIOVariableKindMod.F90 | 2 + 4 files changed, 76 insertions(+), 7 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index b2b090b24a..abf4b0a921 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -134,10 +134,12 @@ module FatesHistoryInterfaceMod integer, private :: ih_ar_crootm_si_scpf integer, private :: ih_ar_frootm_si_scpf + ! indices to (site x scls) variables + integer, private :: ih_ba_si_scls ! The number of variable dim/kind types we have defined (static) - integer, parameter :: fates_history_num_dimensions = 4 - integer, parameter :: fates_history_num_dim_kinds = 6 + integer, parameter :: fates_history_num_dimensions = 5 + integer, parameter :: fates_history_num_dim_kinds = 8 @@ -170,7 +172,7 @@ module FatesHistoryInterfaceMod type(iovar_map_type), pointer :: iovar_map(:) - integer, private :: patch_index_, column_index_, levgrnd_index_, levscpf_index_ + integer, private :: patch_index_, column_index_, levgrnd_index_, levscpf_index_, levscls_index_ contains procedure, public :: Init @@ -188,6 +190,7 @@ module FatesHistoryInterfaceMod procedure, public :: column_index procedure, public :: levgrnd_index procedure, public :: levscpf_index + procedure, public :: levscls_index ! private work functions procedure, private :: define_history_vars @@ -200,6 +203,7 @@ module FatesHistoryInterfaceMod procedure, private :: set_column_index procedure, private :: set_levgrnd_index procedure, private :: set_levscpf_index + procedure, private :: set_levscls_index end type fates_history_interface_type @@ -211,7 +215,7 @@ module FatesHistoryInterfaceMod subroutine Init(this, num_threads, fates_bounds) - use FatesIODimensionsMod, only : patch, column, levgrnd, levscpf + use FatesIODimensionsMod, only : patch, column, levgrnd, levscpf, levscls use FatesIODimensionsMod, only : fates_bounds_type implicit none @@ -241,6 +245,11 @@ subroutine Init(this, num_threads, fates_bounds) call this%set_levscpf_index(dim_count) call this%dim_bounds(dim_count)%Init(levscpf, num_threads, & fates_bounds%pft_class_begin, fates_bounds%pft_class_end) + + dim_count = dim_count + 1 + call this%set_levscls_index(dim_count) + call this%dim_bounds(dim_count)%Init(levscls, num_threads, & + fates_bounds%size_class_begin, fates_bounds%size_class_end) ! FIXME(bja, 2016-10) assert(dim_count == FatesHistorydimensionmod::num_dimension_types) ! Allocate the mapping between FATES indices and the IO indices @@ -277,6 +286,10 @@ subroutine SetThreadBoundsEach(this, thread_index, thread_bounds) index = this%levscpf_index() call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%pft_class_begin, thread_bounds%pft_class_end) + + index = this%levscls_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%size_class_begin, thread_bounds%size_class_end) end subroutine SetThreadBoundsEach @@ -285,6 +298,7 @@ subroutine assemble_history_output_types(this) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 + use FatesIOVariableKindMod, only : patch_size_r8, site_size_r8 implicit none @@ -308,6 +322,12 @@ subroutine assemble_history_output_types(this) call this%set_dim_indices(site_size_pft_r8, 1, this%column_index()) call this%set_dim_indices(site_size_pft_r8, 2, this%levscpf_index()) + call this%set_dim_indices(patch_size_r8, 1, this%patch_index()) + call this%set_dim_indices(patch_size_r8, 2, this%levscls_index()) + + call this%set_dim_indices(site_size_r8, 1, this%column_index()) + call this%set_dim_indices(site_size_r8, 2, this%levscls_index()) + end subroutine assemble_history_output_types ! =================================================================================== @@ -407,6 +427,20 @@ integer function levscpf_index(this) levscpf_index = this%levscpf_index_ end function levscpf_index + ! ======================================================================= + subroutine set_levscls_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levscls_index_ = index + end subroutine set_levscls_index + + integer function levscls_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levscls_index = this%levscls_index_ + end function levscls_index + ! ====================================================================================== subroutine flush_hvars(this,nc,upfreq_in) @@ -500,6 +534,7 @@ subroutine init_dim_kinds_maps(this) ! ---------------------------------------------------------------------------------- use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 + use FatesIOVariableKindMod, only : patch_size_r8, site_size_r8 implicit none @@ -533,6 +568,14 @@ subroutine init_dim_kinds_maps(this) index = index + 1 call this%dim_kinds(index)%Init(site_size_pft_r8, 2) + ! patch x size-class + index = index + 1 + call this%dim_kinds(index)%Init(patch_size_r8, 2) + + ! site x size-class + index = index + 1 + call this%dim_kinds(index)%Init(site_size_r8, 2) + ! FIXME(bja, 2016-10) assert(index == fates_history_num_dim_kinds) end subroutine init_dim_kinds_maps @@ -688,7 +731,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m2_si_scpf => this%hvars(ih_m2_si_scpf)%r82d, & 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_m5_si_scpf => this%hvars(ih_m5_si_scpf)%r82d, & + hio_ba_si_scls => this%hvars(ih_ba_si_scls)%r82d ) ! --------------------------------------------------------------------------------- ! Flush arrays to values defined by %flushval (see registry entry in @@ -789,7 +833,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! have any meaning, otherwise they are just inialization values if( .not.(ccohort%isnew) ) then - associate( scpf => ccohort%size_by_pft_class ) + associate( scpf => ccohort%size_by_pft_class, & + scls => ccohort%size_class ) hio_gpp_si_scpf(io_si,scpf) = hio_gpp_si_scpf(io_si,scpf) + & n_perm2*ccohort%gpp_acc_hold ! [kgC/m2/yr] @@ -840,6 +885,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! 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 + ! 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 ! number density [/ha] hio_nplant_si_scpf(io_si,scpf) = hio_nplant_si_scpf(io_si,scpf) + AREA*n_perm2 @@ -1124,6 +1172,7 @@ subroutine define_history_vars(this, initialize_variables) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 + use FatesIOVariableKindMod, only : patch_size_r8, site_size_r8 implicit none class(fates_history_interface_type), intent(inout) :: this @@ -1474,6 +1523,11 @@ subroutine define_history_vars(this, initialize_variables) 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 ) + ! size-class only variables + 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, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ba_si_scls ) ! CARBON BALANCE VARIABLES THAT DEPEND ON HLM BGC INPUTS diff --git a/main/FatesHistoryVariableType.F90 b/main/FatesHistoryVariableType.F90 index 44d6458668..7829c8030a 100644 --- a/main/FatesHistoryVariableType.F90 +++ b/main/FatesHistoryVariableType.F90 @@ -44,7 +44,7 @@ subroutine Init(this, vname, units, long, use_default, & use FatesIODimensionsMod, only : fates_io_dimension_type use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 - use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 + use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8, site_size_r8 use FatesIOVariableKindMod, only : iotype_index implicit none @@ -118,6 +118,10 @@ subroutine Init(this, vname, units, long, use_default, & allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval + case(site_size_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + case default write(fates_log(),*) 'Incompatible vtype passed to set_history_var' write(fates_log(),*) 'vtype = ',trim(vtype),' ?' @@ -183,6 +187,7 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) use FatesIODimensionsMod, only : fates_io_dimension_type use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8, patch_int + use FatesIOVariableKindMod, only : site_size_r8 implicit none @@ -208,6 +213,8 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_size_pft_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_size_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(patch_int) this%int1d(lb1:ub1) = nint(this%flushval) case default diff --git a/main/FatesIODimensionsMod.F90 b/main/FatesIODimensionsMod.F90 index 84c082e75c..b73755e02a 100644 --- a/main/FatesIODimensionsMod.F90 +++ b/main/FatesIODimensionsMod.F90 @@ -9,6 +9,7 @@ module FatesIODimensionsMod character(*), parameter :: column = 'column' character(*), parameter :: levgrnd = 'levgrnd' character(*), parameter :: levscpf = 'levscpf' + character(*), parameter :: levscls = 'levscls' ! patch = This is a structure that records where FATES patch boundaries ! on each thread point to in the host IO array, this structure @@ -24,6 +25,9 @@ module FatesIODimensionsMod ! levscpf = This is a structure that records the boundaries for the ! number of size-class x pft dimension + ! levscls = This is a structure that records the boundaries for the + ! number of size-class dimension + type, public :: fates_bounds_type integer :: patch_begin @@ -36,6 +40,8 @@ module FatesIODimensionsMod integer :: ground_end integer :: pft_class_begin integer :: pft_class_end + integer :: size_class_begin + integer :: size_class_end end type fates_bounds_type diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90 index 343d3b4364..77371a3a98 100644 --- a/main/FatesIOVariableKindMod.F90 +++ b/main/FatesIOVariableKindMod.F90 @@ -12,10 +12,12 @@ module FatesIOVariableKindMod character(*), parameter :: patch_r8 = 'PA_R8' character(*), parameter :: patch_ground_r8 = 'PA_GRND_R8' character(*), parameter :: patch_size_pft_r8 = 'PA_SCPF_R8' + character(*), parameter :: patch_size_r8 = 'PA_SCLS_R8' character(*), parameter :: site_r8 = 'SI_R8' character(*), parameter :: site_int = 'SI_INT' character(*), parameter :: site_ground_r8 = 'SI_GRND_R8' character(*), parameter :: site_size_pft_r8 = 'SI_SCPF_R8' + character(*), parameter :: site_size_r8 = 'SI_SCLS_R8' character(*), parameter :: patch_int = 'PA_INT' character(*), parameter :: cohort_r8 = 'CO_R8' character(*), parameter :: cohort_int = 'CO_INT' From 03375f4eddc9f8e980f5b6f2baf51b96aec628e1 Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 12 Jan 2017 15:52:35 -0800 Subject: [PATCH 02/12] added age and pft dimensions to history; however it is crashing in subgridAveMod.F90 --- biogeochem/EDPatchDynamicsMod.F90 | 4 + main/EDMainMod.F90 | 4 + main/EDTypesMod.F90 | 19 ++++- main/FatesHistoryInterfaceMod.F90 | 117 ++++++++++++++++++++++++++---- main/FatesHistoryVariableType.F90 | 17 ++++- main/FatesIODimensionsMod.F90 | 16 +++- main/FatesIOVariableKindMod.F90 | 3 + 7 files changed, 161 insertions(+), 19 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 5fae1a783f..b54f781211 100755 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -831,6 +831,7 @@ subroutine create_patch(currentSite, new_patch, age, areap, spread_local,cwd_ag_ new_patch%siteptr => currentSite new_patch%age = age + new_patch%age_class = 1 new_patch%area = areap new_patch%spread = spread_local new_patch%cwd_ag = cwd_ag_local @@ -899,6 +900,7 @@ subroutine zero_patch(cp_p) currentPatch%clm_pno = 999 currentPatch%age = nan + currentPatch%age_class = 1 currentPatch%area = nan currentPatch%canopy_layer_lai(:) = nan currentPatch%total_canopy_area = nan @@ -1150,6 +1152,7 @@ subroutine fuse_2_patches(dp, rp) ! associated with the secnd patch ! ! !USES: + use EDTypesMod, only: pageclass_ed ! ! !ARGUMENTS: type (ed_patch_type) , intent(inout), pointer :: dp ! Donor Patch @@ -1169,6 +1172,7 @@ subroutine fuse_2_patches(dp, rp) !area weighted average of ages & litter rp%age = (dp%age * dp%area + rp%age * rp%area)/(dp%area + rp%area) + rp%age_class = max(1,count(rp%age-pageclass_ed.ge.0.0_r8)) do p = 1,numpft_ed rp%seeds_in(p) = (rp%seeds_in(p)*rp%area + dp%seeds_in(p)*dp%area)/(rp%area + dp%area) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 9499f93d02..f43cbbb570 100755 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -137,6 +137,7 @@ subroutine ed_integrate_state_variables(currentSite, temperature_inst ) ! FIX(SPM,032414) refactor so everything goes through interface ! ! !USES: + use EDTypesMod, only : pageclass_ed ! ! !ARGUMENTS: type(ed_site_type) , intent(inout) :: currentSite @@ -170,6 +171,9 @@ subroutine ed_integrate_state_variables(currentSite, temperature_inst ) currentPatch%patchno,currentPatch%area endif + ! check to see if the patch has moved to the next age class + currentPatch%age_class = count(currentPatch%age-pageclass_ed.ge.0.0_r8) + ! Find the derivatives of the growth and litter processes. call canopy_derivs(currentSite, currentPatch) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 3419386adf..d4731bfc91 100755 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -83,9 +83,12 @@ module EDTypesMod ! real(r8), parameter, dimension(16) :: sclass_ed = (/0.0_r8,1.0_r8,2.0_r8,3.0_r8,4.0_r8,5.0_r8,10.0_r8,20.0_r8,30.0_r8,40.0_r8, & ! 50.0_r8,60.0_r8,70.0_r8,80.0_r8,90.0_r8,100.0_r8/) - real(r8), parameter, dimension(13) :: sclass_ed = (/0.0_r8,5.0_r8,10.0_r8,15.0_r8,20.0_r8,30.0_r8,40.0_r8, & + real(r8), parameter, dimension(nlevsclass_ed) :: sclass_ed = (/0.0_r8,5.0_r8,10.0_r8,15.0_r8,20.0_r8,30.0_r8,40.0_r8, & 50.0_r8,60.0_r8,70.0_r8,80.0_r8,90.0_r8,100.0_r8/) + integer, parameter :: nlevpage_ed = 7 ! Number of patch-age classes for age structured analyses + real(r8), parameter, dimension(nlevpage_ed) :: pageclass_ed = (/0.0_r8,1.0_r8,2._r8,5.0_r8,10.0_r8,20.0_r8,50.0_r8/) + ! integer, parameter :: nlevsclass_ed = 17 ! real(r8), parameter, dimension(17) :: sclass_ed = (/0.1_r8, 5.0_r8,10.0_r8,15.0_r8,20.0_r8,25.0_r8, & @@ -99,13 +102,15 @@ module EDTypesMod character(len = 10), parameter,dimension(5) :: char_list = (/"background","hydraulic ","carbon ","impact ","fire "/) - ! These three vectors are used for history output mapping + ! These vectors are used for history output mapping real(r8) ,allocatable :: levsclass_ed(:) ! The lower bound on size classes for ED trees. This ! is used really for IO into the ! history tapes. It gets copied from ! the parameter array sclass_ed. integer , allocatable :: pft_levscpf_ed(:) integer , allocatable :: scls_levscpf_ed(:) + real(r8), allocatable :: levpage_ed(:) + integer , allocatable :: levpft_ed(:) ! Control Parameters (cp_) @@ -313,6 +318,7 @@ module EDTypesMod ! PATCH INFO real(r8) :: age ! average patch age: years + integer :: age_class ! age class of the patch for history binning purposes real(r8) :: area ! patch area: m2 integer :: countcohorts ! Number of cohorts in patch integer :: ncl_p ! Number of occupied canopy layers @@ -575,11 +581,20 @@ subroutine ed_hist_scpfmaps allocate( levsclass_ed(1:nlevsclass_ed )) allocate( pft_levscpf_ed(1:nlevsclass_ed*mxpft)) allocate(scls_levscpf_ed(1:nlevsclass_ed*mxpft)) + allocate( levpft_ed(1:mxpft )) + allocate( levpage_ed(1:nlevpage_ed )) ! Fill the IO array of plant size classes ! For some reason the history files did not like ! a hard allocation of sclass_ed levsclass_ed(:) = sclass_ed(:) + + levpage_ed(:) = pageclass_ed(:) + + ! make pft array + do ipft=1,mxpft + levpft_ed(ipft) = ipft + end do ! Fill the IO arrays that match pft and size class to their combined array i=0 diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index abf4b0a921..0ef6cc110a 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -64,15 +64,13 @@ module FatesHistoryInterfaceMod integer, private :: ih_growth_resp_pa ! Indices to (patch x pft) variables (using nlevgrnd as surrogate) - + !+++cdk+++ leaving these as-is for now to preserve b4b, but once established, need to move these to actual pft dimension integer, private :: ih_biomass_pa_pft integer, private :: ih_leafbiomass_pa_pft integer, private :: ih_storebiomass_pa_pft integer, private :: ih_nindivs_pa_pft ! Indices to (site) variables - - integer, private :: ih_nep_si integer, private :: ih_nep_timeintegrated_si integer, private :: ih_npp_timeintegrated_si @@ -137,9 +135,15 @@ module FatesHistoryInterfaceMod ! indices to (site x scls) variables integer, private :: ih_ba_si_scls + ! indices to (site x pft) variables + integer, private :: ih_biomass_si_pft + + ! indices to (site x patch-age) variables + integer, private :: ih_area_si_page + ! The number of variable dim/kind types we have defined (static) - integer, parameter :: fates_history_num_dimensions = 5 - integer, parameter :: fates_history_num_dim_kinds = 8 + integer, parameter :: fates_history_num_dimensions = 7 + integer, parameter :: fates_history_num_dim_kinds = 10 @@ -172,7 +176,8 @@ module FatesHistoryInterfaceMod type(iovar_map_type), pointer :: iovar_map(:) - integer, private :: patch_index_, column_index_, levgrnd_index_, levscpf_index_, levscls_index_ + integer, private :: patch_index_, column_index_, levgrnd_index_, levscpf_index_ + integer, private :: levscls_index_, levpft_index_, levpage_index_ contains procedure, public :: Init @@ -191,6 +196,8 @@ module FatesHistoryInterfaceMod procedure, public :: levgrnd_index procedure, public :: levscpf_index procedure, public :: levscls_index + procedure, public :: levpft_index + procedure, public :: levpage_index ! private work functions procedure, private :: define_history_vars @@ -204,6 +211,8 @@ module FatesHistoryInterfaceMod procedure, private :: set_levgrnd_index procedure, private :: set_levscpf_index procedure, private :: set_levscls_index + procedure, private :: set_levpft_index + procedure, private :: set_levpage_index end type fates_history_interface_type @@ -215,7 +224,8 @@ module FatesHistoryInterfaceMod subroutine Init(this, num_threads, fates_bounds) - use FatesIODimensionsMod, only : patch, column, levgrnd, levscpf, levscls + use FatesIODimensionsMod, only : patch, column, levgrnd, levscpf + use FatesIODimensionsMod, only : levscls, levpft, levpage use FatesIODimensionsMod, only : fates_bounds_type implicit none @@ -244,12 +254,22 @@ subroutine Init(this, num_threads, fates_bounds) dim_count = dim_count + 1 call this%set_levscpf_index(dim_count) call this%dim_bounds(dim_count)%Init(levscpf, num_threads, & - fates_bounds%pft_class_begin, fates_bounds%pft_class_end) + fates_bounds%sizepft_class_begin, fates_bounds%sizepft_class_end) dim_count = dim_count + 1 call this%set_levscls_index(dim_count) call this%dim_bounds(dim_count)%Init(levscls, num_threads, & fates_bounds%size_class_begin, fates_bounds%size_class_end) + + dim_count = dim_count + 1 + call this%set_levpft_index(dim_count) + call this%dim_bounds(dim_count)%Init(levpft, num_threads, & + fates_bounds%pft_class_begin, fates_bounds%pft_class_end) + + dim_count = dim_count + 1 + call this%set_levpage_index(dim_count) + call this%dim_bounds(dim_count)%Init(levpage, num_threads, & + fates_bounds%page_class_begin, fates_bounds%page_class_end) ! FIXME(bja, 2016-10) assert(dim_count == FatesHistorydimensionmod::num_dimension_types) ! Allocate the mapping between FATES indices and the IO indices @@ -285,11 +305,15 @@ subroutine SetThreadBoundsEach(this, thread_index, thread_bounds) index = this%levscpf_index() call this%dim_bounds(index)%SetThreadBounds(thread_index, & - thread_bounds%pft_class_begin, thread_bounds%pft_class_end) + thread_bounds%sizepft_class_begin, thread_bounds%sizepft_class_end) - index = this%levscls_index() + index = this%levpft_index() call this%dim_bounds(index)%SetThreadBounds(thread_index, & - thread_bounds%size_class_begin, thread_bounds%size_class_end) + thread_bounds%pft_class_begin, thread_bounds%pft_class_end) + + index = this%levpage_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%page_class_begin, thread_bounds%page_class_end) end subroutine SetThreadBoundsEach @@ -299,6 +323,7 @@ subroutine assemble_history_output_types(this) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : patch_size_r8, site_size_r8 + use FatesIOVariableKindMod, only : site_pft_r8, site_page_r8 implicit none @@ -328,6 +353,12 @@ subroutine assemble_history_output_types(this) call this%set_dim_indices(site_size_r8, 1, this%column_index()) call this%set_dim_indices(site_size_r8, 2, this%levscls_index()) + call this%set_dim_indices(site_pft_r8, 1, this%column_index()) + call this%set_dim_indices(site_pft_r8, 2, this%levpft_index()) + + call this%set_dim_indices(site_page_r8, 1, this%column_index()) + call this%set_dim_indices(site_page_r8, 2, this%levpage_index()) + end subroutine assemble_history_output_types ! =================================================================================== @@ -441,6 +472,34 @@ integer function levscls_index(this) levscls_index = this%levscls_index_ end function levscls_index + ! ======================================================================= + subroutine set_levpft_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levpft_index_ = index + end subroutine set_levpft_index + + integer function levpft_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levpft_index = this%levpft_index_ + end function levpft_index + + ! ======================================================================= + subroutine set_levpage_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levpage_index_ = index + end subroutine set_levpage_index + + integer function levpage_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levpage_index = this%levpage_index_ + end function levpage_index + ! ====================================================================================== subroutine flush_hvars(this,nc,upfreq_in) @@ -535,6 +594,7 @@ subroutine init_dim_kinds_maps(this) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : patch_size_r8, site_size_r8 + use FatesIOVariableKindMod, only : site_pft_r8, site_page_r8 implicit none @@ -576,6 +636,14 @@ subroutine init_dim_kinds_maps(this) index = index + 1 call this%dim_kinds(index)%Init(site_size_r8, 2) + ! site x pft + index = index + 1 + call this%dim_kinds(index)%Init(site_pft_r8, 2) + + ! site x patch-age clase + index = index + 1 + call this%dim_kinds(index)%Init(site_page_r8, 2) + ! FIXME(bja, 2016-10) assert(index == fates_history_num_dim_kinds) end subroutine init_dim_kinds_maps @@ -649,7 +717,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) ed_patch_type, & AREA, & sclass_ed, & - nlevsclass_ed + nlevsclass_ed, & + levpage_ed, & + nlevpage_ed, & + levpft_ed use EDParamsMod , only : ED_val_ag_biomass ! Arguments @@ -732,7 +803,9 @@ 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_ba_si_scls => this%hvars(ih_ba_si_scls)%r82d ) + hio_ba_si_scls => this%hvars(ih_ba_si_scls)%r82d)!, & +! hio_biomass_si_pft => this%hvars(ih_biomass_si_pft)%r82d, & +! hio_area_si_page => this%hvars(ih_area_si_page)%r82d) ! --------------------------------------------------------------------------------- ! Flush arrays to values defined by %flushval (see registry entry in @@ -764,6 +837,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! Increment the number of patches per site hio_npatches_si(io_si) = hio_npatches_si(io_si) + 1._r8 + + ! report the fractional area in each age class bin + ! hio_area_si_page(io_si,cpatch%age_class) = hio_area_si_page(io_si,cpatch%age_class) & + ! + cpatch%area/AREA ccohort => cpatch%shortest do while(associated(ccohort)) @@ -824,6 +901,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_nindivs_pa_pft(io_pa,ft) = hio_nindivs_pa_pft(io_pa,ft) + & ccohort%n + ! hio_biomass_si_pft(io_si, ft) = hio_biomass_si_pft(io_si, ft) + & + ! n_density * ccohort%b * 1.e3_r8 + ! Site by Size-Class x PFT (SCPF) ! ------------------------------------------------------------------------ @@ -1173,6 +1253,7 @@ subroutine define_history_vars(this, initialize_variables) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : patch_size_r8, site_size_r8 + use FatesIOVariableKindMod, only : site_pft_r8, site_page_r8 implicit none class(fates_history_interface_type), intent(inout) :: this @@ -1236,6 +1317,16 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_nindivs_pa_pft ) + ! call this%set_history_var(vname='PFT_biomass', units='gC/m2', & + ! long='total PFT level biomass -- on actual PFT dimension', 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_biomass_si_pft ) + + ! call this%set_history_var(vname='patch_area_by_age', units='m2/m2', & + ! long='patch area by age bin', use_default='active', & + ! avgflag='A', vtype=site_page_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ! ivar=ivar, initialize=initialize_variables, index = ih_area_si_page ) + ! Fire Variables call this%set_history_var(vname='FIRE_NESTEROV_INDEX', units='none', & diff --git a/main/FatesHistoryVariableType.F90 b/main/FatesHistoryVariableType.F90 index 7829c8030a..24f4616e89 100644 --- a/main/FatesHistoryVariableType.F90 +++ b/main/FatesHistoryVariableType.F90 @@ -44,7 +44,8 @@ subroutine Init(this, vname, units, long, use_default, & use FatesIODimensionsMod, only : fates_io_dimension_type use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 - use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8, site_size_r8 + use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 + use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_page_r8 use FatesIOVariableKindMod, only : iotype_index implicit none @@ -122,6 +123,14 @@ subroutine Init(this, vname, units, long, use_default, & allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval + case(site_pft_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(site_page_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + case default write(fates_log(),*) 'Incompatible vtype passed to set_history_var' write(fates_log(),*) 'vtype = ',trim(vtype),' ?' @@ -187,7 +196,7 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) use FatesIODimensionsMod, only : fates_io_dimension_type use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8, patch_int - use FatesIOVariableKindMod, only : site_size_r8 + use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_page_r8 implicit none @@ -215,6 +224,10 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_size_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_pft_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_page_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(patch_int) this%int1d(lb1:ub1) = nint(this%flushval) case default diff --git a/main/FatesIODimensionsMod.F90 b/main/FatesIODimensionsMod.F90 index b73755e02a..80973f2e2b 100644 --- a/main/FatesIODimensionsMod.F90 +++ b/main/FatesIODimensionsMod.F90 @@ -10,6 +10,8 @@ module FatesIODimensionsMod character(*), parameter :: levgrnd = 'levgrnd' character(*), parameter :: levscpf = 'levscpf' character(*), parameter :: levscls = 'levscls' + character(*), parameter :: levpft = 'levpft' + character(*), parameter :: levpage = 'levpage' ! patch = This is a structure that records where FATES patch boundaries ! on each thread point to in the host IO array, this structure @@ -28,6 +30,12 @@ module FatesIODimensionsMod ! levscls = This is a structure that records the boundaries for the ! number of size-class dimension + ! levpft = This is a structure that records the boundaries for the + ! number of pft dimension + + ! levpage = This is a structure that records the boundaries for the + ! number of patch-age-class dimension + type, public :: fates_bounds_type integer :: patch_begin @@ -38,10 +46,14 @@ module FatesIODimensionsMod integer :: column_end ! we call this a "site" (rgk 11-2016) integer :: ground_begin integer :: ground_end - integer :: pft_class_begin - integer :: pft_class_end + integer :: sizepft_class_begin + integer :: sizepft_class_end integer :: size_class_begin integer :: size_class_end + integer :: pft_class_begin + integer :: pft_class_end + integer :: page_class_begin + integer :: page_class_end end type fates_bounds_type diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90 index 77371a3a98..79305f0b87 100644 --- a/main/FatesIOVariableKindMod.F90 +++ b/main/FatesIOVariableKindMod.F90 @@ -21,6 +21,9 @@ module FatesIOVariableKindMod character(*), parameter :: patch_int = 'PA_INT' character(*), parameter :: cohort_r8 = 'CO_R8' character(*), parameter :: cohort_int = 'CO_INT' + character(*), parameter :: site_pft_r8 = 'SI_PFT_R8' + character(*), parameter :: site_page_r8 = 'SI_PAGE_R8' + ! NOTE(RGK, 2016) %active is not used yet. Was intended as a check on the HLM->FATES ! control parameter passing to ensure all active dimension types received all From 8c82daffc08e003a09390d2eac63d76ed1355841 Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 12 Jan 2017 16:10:21 -0800 Subject: [PATCH 03/12] fixed one bug but still crashing --- main/FatesHistoryInterfaceMod.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 0ef6cc110a..069ce30e6f 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -307,6 +307,10 @@ subroutine SetThreadBoundsEach(this, thread_index, thread_bounds) call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%sizepft_class_begin, thread_bounds%sizepft_class_end) + index = this%levscls_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%size_class_begin, thread_bounds%size_class_end) + index = this%levpft_index() call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%pft_class_begin, thread_bounds%pft_class_end) From 6f76add8d91dbeae80d01bb1c77d165a7fef189b Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 12 Jan 2017 17:20:27 -0800 Subject: [PATCH 04/12] actually with debug off it doesn't crash. reinstating new variables. --- main/FatesHistoryInterfaceMod.F90 | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 069ce30e6f..b777f8a852 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -807,9 +807,9 @@ 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_ba_si_scls => this%hvars(ih_ba_si_scls)%r82d)!, & -! hio_biomass_si_pft => this%hvars(ih_biomass_si_pft)%r82d, & -! hio_area_si_page => this%hvars(ih_area_si_page)%r82d) + hio_ba_si_scls => this%hvars(ih_ba_si_scls)%r82d, & + hio_biomass_si_pft => this%hvars(ih_biomass_si_pft)%r82d, & + hio_area_si_page => this%hvars(ih_area_si_page)%r82d) ! --------------------------------------------------------------------------------- ! Flush arrays to values defined by %flushval (see registry entry in @@ -843,8 +843,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npatches_si(io_si) = hio_npatches_si(io_si) + 1._r8 ! report the fractional area in each age class bin - ! hio_area_si_page(io_si,cpatch%age_class) = hio_area_si_page(io_si,cpatch%age_class) & - ! + cpatch%area/AREA + hio_area_si_page(io_si,cpatch%age_class) = hio_area_si_page(io_si,cpatch%age_class) & + + cpatch%area/AREA ccohort => cpatch%shortest do while(associated(ccohort)) @@ -905,8 +905,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_nindivs_pa_pft(io_pa,ft) = hio_nindivs_pa_pft(io_pa,ft) + & ccohort%n - ! hio_biomass_si_pft(io_si, ft) = hio_biomass_si_pft(io_si, ft) + & - ! n_density * ccohort%b * 1.e3_r8 + hio_biomass_si_pft(io_si, ft) = hio_biomass_si_pft(io_si, ft) + & + n_density * ccohort%b * 1.e3_r8 ! Site by Size-Class x PFT (SCPF) ! ------------------------------------------------------------------------ @@ -1321,15 +1321,15 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_nindivs_pa_pft ) - ! call this%set_history_var(vname='PFT_biomass', units='gC/m2', & - ! long='total PFT level biomass -- on actual PFT dimension', 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_biomass_si_pft ) + call this%set_history_var(vname='PFT_biomass', units='gC/m2', & + long='total PFT level biomass -- on actual PFT dimension', 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_biomass_si_pft ) - ! call this%set_history_var(vname='patch_area_by_age', units='m2/m2', & - ! long='patch area by age bin', use_default='active', & - ! avgflag='A', vtype=site_page_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ! ivar=ivar, initialize=initialize_variables, index = ih_area_si_page ) + call this%set_history_var(vname='patch_area_by_age', units='m2/m2', & + long='patch area by age bin', use_default='active', & + avgflag='A', vtype=site_page_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_area_si_page ) ! Fire Variables From d8a81915e2da439a7c6e30e1b15d872b1aaaa37f Mon Sep 17 00:00:00 2001 From: ckoven Date: Fri, 13 Jan 2017 15:39:36 -0800 Subject: [PATCH 05/12] changed page to age throughout to clarify meaning --- biogeochem/EDPatchDynamicsMod.F90 | 4 +-- main/EDMainMod.F90 | 4 +-- main/EDTypesMod.F90 | 10 +++--- main/FatesHistoryInterfaceMod.F90 | 56 +++++++++++++++---------------- main/FatesHistoryVariableType.F90 | 8 ++--- main/FatesIODimensionsMod.F90 | 8 ++--- main/FatesIOVariableKindMod.F90 | 2 +- 7 files changed, 46 insertions(+), 46 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index b54f781211..0cb9434bd7 100755 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1152,7 +1152,7 @@ subroutine fuse_2_patches(dp, rp) ! associated with the secnd patch ! ! !USES: - use EDTypesMod, only: pageclass_ed + use EDTypesMod, only: ageclass_ed ! ! !ARGUMENTS: type (ed_patch_type) , intent(inout), pointer :: dp ! Donor Patch @@ -1172,7 +1172,7 @@ subroutine fuse_2_patches(dp, rp) !area weighted average of ages & litter rp%age = (dp%age * dp%area + rp%age * rp%area)/(dp%area + rp%area) - rp%age_class = max(1,count(rp%age-pageclass_ed.ge.0.0_r8)) + rp%age_class = max(1,count(rp%age-ageclass_ed.ge.0.0_r8)) do p = 1,numpft_ed rp%seeds_in(p) = (rp%seeds_in(p)*rp%area + dp%seeds_in(p)*dp%area)/(rp%area + dp%area) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index f43cbbb570..69889f1b37 100755 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -137,7 +137,7 @@ subroutine ed_integrate_state_variables(currentSite, temperature_inst ) ! FIX(SPM,032414) refactor so everything goes through interface ! ! !USES: - use EDTypesMod, only : pageclass_ed + use EDTypesMod, only : ageclass_ed ! ! !ARGUMENTS: type(ed_site_type) , intent(inout) :: currentSite @@ -172,7 +172,7 @@ subroutine ed_integrate_state_variables(currentSite, temperature_inst ) endif ! check to see if the patch has moved to the next age class - currentPatch%age_class = count(currentPatch%age-pageclass_ed.ge.0.0_r8) + currentPatch%age_class = count(currentPatch%age-ageclass_ed.ge.0.0_r8) ! Find the derivatives of the growth and litter processes. call canopy_derivs(currentSite, currentPatch) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index d4731bfc91..d1d973a856 100755 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -86,8 +86,8 @@ module EDTypesMod real(r8), parameter, dimension(nlevsclass_ed) :: sclass_ed = (/0.0_r8,5.0_r8,10.0_r8,15.0_r8,20.0_r8,30.0_r8,40.0_r8, & 50.0_r8,60.0_r8,70.0_r8,80.0_r8,90.0_r8,100.0_r8/) - integer, parameter :: nlevpage_ed = 7 ! Number of patch-age classes for age structured analyses - real(r8), parameter, dimension(nlevpage_ed) :: pageclass_ed = (/0.0_r8,1.0_r8,2._r8,5.0_r8,10.0_r8,20.0_r8,50.0_r8/) + integer, parameter :: nlevage_ed = 7 ! Number of patch-age classes for age structured analyses + real(r8), parameter, dimension(nlevage_ed) :: ageclass_ed = (/0.0_r8,1.0_r8,2._r8,5.0_r8,10.0_r8,20.0_r8,50.0_r8/) ! integer, parameter :: nlevsclass_ed = 17 @@ -109,7 +109,7 @@ module EDTypesMod ! the parameter array sclass_ed. integer , allocatable :: pft_levscpf_ed(:) integer , allocatable :: scls_levscpf_ed(:) - real(r8), allocatable :: levpage_ed(:) + real(r8), allocatable :: levage_ed(:) integer , allocatable :: levpft_ed(:) @@ -582,14 +582,14 @@ subroutine ed_hist_scpfmaps allocate( pft_levscpf_ed(1:nlevsclass_ed*mxpft)) allocate(scls_levscpf_ed(1:nlevsclass_ed*mxpft)) allocate( levpft_ed(1:mxpft )) - allocate( levpage_ed(1:nlevpage_ed )) + allocate( levage_ed(1:nlevage_ed )) ! Fill the IO array of plant size classes ! For some reason the history files did not like ! a hard allocation of sclass_ed levsclass_ed(:) = sclass_ed(:) - levpage_ed(:) = pageclass_ed(:) + levage_ed(:) = ageclass_ed(:) ! make pft array do ipft=1,mxpft diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index b777f8a852..1495baa63d 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -139,7 +139,7 @@ module FatesHistoryInterfaceMod integer, private :: ih_biomass_si_pft ! indices to (site x patch-age) variables - integer, private :: ih_area_si_page + integer, private :: ih_area_si_age ! The number of variable dim/kind types we have defined (static) integer, parameter :: fates_history_num_dimensions = 7 @@ -177,7 +177,7 @@ module FatesHistoryInterfaceMod type(iovar_map_type), pointer :: iovar_map(:) integer, private :: patch_index_, column_index_, levgrnd_index_, levscpf_index_ - integer, private :: levscls_index_, levpft_index_, levpage_index_ + integer, private :: levscls_index_, levpft_index_, levage_index_ contains procedure, public :: Init @@ -197,7 +197,7 @@ module FatesHistoryInterfaceMod procedure, public :: levscpf_index procedure, public :: levscls_index procedure, public :: levpft_index - procedure, public :: levpage_index + procedure, public :: levage_index ! private work functions procedure, private :: define_history_vars @@ -212,7 +212,7 @@ module FatesHistoryInterfaceMod procedure, private :: set_levscpf_index procedure, private :: set_levscls_index procedure, private :: set_levpft_index - procedure, private :: set_levpage_index + procedure, private :: set_levage_index end type fates_history_interface_type @@ -225,7 +225,7 @@ module FatesHistoryInterfaceMod subroutine Init(this, num_threads, fates_bounds) use FatesIODimensionsMod, only : patch, column, levgrnd, levscpf - use FatesIODimensionsMod, only : levscls, levpft, levpage + use FatesIODimensionsMod, only : levscls, levpft, levage use FatesIODimensionsMod, only : fates_bounds_type implicit none @@ -267,9 +267,9 @@ subroutine Init(this, num_threads, fates_bounds) fates_bounds%pft_class_begin, fates_bounds%pft_class_end) dim_count = dim_count + 1 - call this%set_levpage_index(dim_count) - call this%dim_bounds(dim_count)%Init(levpage, num_threads, & - fates_bounds%page_class_begin, fates_bounds%page_class_end) + call this%set_levage_index(dim_count) + call this%dim_bounds(dim_count)%Init(levage, num_threads, & + fates_bounds%age_class_begin, fates_bounds%age_class_end) ! FIXME(bja, 2016-10) assert(dim_count == FatesHistorydimensionmod::num_dimension_types) ! Allocate the mapping between FATES indices and the IO indices @@ -315,9 +315,9 @@ subroutine SetThreadBoundsEach(this, thread_index, thread_bounds) call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%pft_class_begin, thread_bounds%pft_class_end) - index = this%levpage_index() + index = this%levage_index() call this%dim_bounds(index)%SetThreadBounds(thread_index, & - thread_bounds%page_class_begin, thread_bounds%page_class_end) + thread_bounds%age_class_begin, thread_bounds%age_class_end) end subroutine SetThreadBoundsEach @@ -327,7 +327,7 @@ subroutine assemble_history_output_types(this) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : patch_size_r8, site_size_r8 - use FatesIOVariableKindMod, only : site_pft_r8, site_page_r8 + use FatesIOVariableKindMod, only : site_pft_r8, site_age_r8 implicit none @@ -360,8 +360,8 @@ subroutine assemble_history_output_types(this) call this%set_dim_indices(site_pft_r8, 1, this%column_index()) call this%set_dim_indices(site_pft_r8, 2, this%levpft_index()) - call this%set_dim_indices(site_page_r8, 1, this%column_index()) - call this%set_dim_indices(site_page_r8, 2, this%levpage_index()) + call this%set_dim_indices(site_age_r8, 1, this%column_index()) + call this%set_dim_indices(site_age_r8, 2, this%levage_index()) end subroutine assemble_history_output_types @@ -491,18 +491,18 @@ integer function levpft_index(this) end function levpft_index ! ======================================================================= - subroutine set_levpage_index(this, index) + subroutine set_levage_index(this, index) implicit none class(fates_history_interface_type), intent(inout) :: this integer, intent(in) :: index - this%levpage_index_ = index - end subroutine set_levpage_index + this%levage_index_ = index + end subroutine set_levage_index - integer function levpage_index(this) + integer function levage_index(this) implicit none class(fates_history_interface_type), intent(in) :: this - levpage_index = this%levpage_index_ - end function levpage_index + levage_index = this%levage_index_ + end function levage_index ! ====================================================================================== @@ -598,7 +598,7 @@ subroutine init_dim_kinds_maps(this) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : patch_size_r8, site_size_r8 - use FatesIOVariableKindMod, only : site_pft_r8, site_page_r8 + use FatesIOVariableKindMod, only : site_pft_r8, site_age_r8 implicit none @@ -646,7 +646,7 @@ subroutine init_dim_kinds_maps(this) ! site x patch-age clase index = index + 1 - call this%dim_kinds(index)%Init(site_page_r8, 2) + call this%dim_kinds(index)%Init(site_age_r8, 2) ! FIXME(bja, 2016-10) assert(index == fates_history_num_dim_kinds) end subroutine init_dim_kinds_maps @@ -722,8 +722,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) AREA, & sclass_ed, & nlevsclass_ed, & - levpage_ed, & - nlevpage_ed, & + levage_ed, & + nlevage_ed, & levpft_ed use EDParamsMod , only : ED_val_ag_biomass @@ -809,7 +809,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m5_si_scpf => this%hvars(ih_m5_si_scpf)%r82d, & hio_ba_si_scls => this%hvars(ih_ba_si_scls)%r82d, & hio_biomass_si_pft => this%hvars(ih_biomass_si_pft)%r82d, & - hio_area_si_page => this%hvars(ih_area_si_page)%r82d) + hio_area_si_age => this%hvars(ih_area_si_age)%r82d) ! --------------------------------------------------------------------------------- ! Flush arrays to values defined by %flushval (see registry entry in @@ -843,7 +843,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npatches_si(io_si) = hio_npatches_si(io_si) + 1._r8 ! report the fractional area in each age class bin - hio_area_si_page(io_si,cpatch%age_class) = hio_area_si_page(io_si,cpatch%age_class) & + hio_area_si_age(io_si,cpatch%age_class) = hio_area_si_age(io_si,cpatch%age_class) & + cpatch%area/AREA ccohort => cpatch%shortest @@ -1257,7 +1257,7 @@ subroutine define_history_vars(this, initialize_variables) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : patch_size_r8, site_size_r8 - use FatesIOVariableKindMod, only : site_pft_r8, site_page_r8 + use FatesIOVariableKindMod, only : site_pft_r8, site_age_r8 implicit none class(fates_history_interface_type), intent(inout) :: this @@ -1328,8 +1328,8 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='patch_area_by_age', units='m2/m2', & long='patch area by age bin', use_default='active', & - avgflag='A', vtype=site_page_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_area_si_page ) + avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_area_si_age ) ! Fire Variables diff --git a/main/FatesHistoryVariableType.F90 b/main/FatesHistoryVariableType.F90 index 24f4616e89..20abd41f89 100644 --- a/main/FatesHistoryVariableType.F90 +++ b/main/FatesHistoryVariableType.F90 @@ -45,7 +45,7 @@ subroutine Init(this, vname, units, long, use_default, & use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 - use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_page_r8 + use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 use FatesIOVariableKindMod, only : iotype_index implicit none @@ -127,7 +127,7 @@ subroutine Init(this, vname, units, long, use_default, & allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval - case(site_page_r8) + case(site_age_r8) allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval @@ -196,7 +196,7 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) use FatesIODimensionsMod, only : fates_io_dimension_type use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8, patch_int - use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_page_r8 + use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 implicit none @@ -226,7 +226,7 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_pft_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval - case(site_page_r8) + case(site_age_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(patch_int) this%int1d(lb1:ub1) = nint(this%flushval) diff --git a/main/FatesIODimensionsMod.F90 b/main/FatesIODimensionsMod.F90 index 80973f2e2b..83b2475aad 100644 --- a/main/FatesIODimensionsMod.F90 +++ b/main/FatesIODimensionsMod.F90 @@ -11,7 +11,7 @@ module FatesIODimensionsMod character(*), parameter :: levscpf = 'levscpf' character(*), parameter :: levscls = 'levscls' character(*), parameter :: levpft = 'levpft' - character(*), parameter :: levpage = 'levpage' + character(*), parameter :: levage = 'levage' ! patch = This is a structure that records where FATES patch boundaries ! on each thread point to in the host IO array, this structure @@ -33,7 +33,7 @@ module FatesIODimensionsMod ! levpft = This is a structure that records the boundaries for the ! number of pft dimension - ! levpage = This is a structure that records the boundaries for the + ! levage = This is a structure that records the boundaries for the ! number of patch-age-class dimension @@ -52,8 +52,8 @@ module FatesIODimensionsMod integer :: size_class_end integer :: pft_class_begin integer :: pft_class_end - integer :: page_class_begin - integer :: page_class_end + integer :: age_class_begin + integer :: age_class_end end type fates_bounds_type diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90 index 79305f0b87..54c7707bdb 100644 --- a/main/FatesIOVariableKindMod.F90 +++ b/main/FatesIOVariableKindMod.F90 @@ -22,7 +22,7 @@ module FatesIOVariableKindMod character(*), parameter :: cohort_r8 = 'CO_R8' character(*), parameter :: cohort_int = 'CO_INT' character(*), parameter :: site_pft_r8 = 'SI_PFT_R8' - character(*), parameter :: site_page_r8 = 'SI_PAGE_R8' + character(*), parameter :: site_age_r8 = 'SI_AGE_R8' ! NOTE(RGK, 2016) %active is not used yet. Was intended as a check on the HLM->FATES From 87ea4e78095a7a353983eda444d2517bce3ee025 Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 17 Jan 2017 14:55:09 -0800 Subject: [PATCH 06/12] removed the patch x size shape since it isn't used and could be buggy --- main/FatesHistoryInterfaceMod.F90 | 18 ++++-------------- main/FatesIOVariableKindMod.F90 | 1 - 2 files changed, 4 insertions(+), 15 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 1495baa63d..69ef96cad4 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -143,7 +143,7 @@ module FatesHistoryInterfaceMod ! The number of variable dim/kind types we have defined (static) integer, parameter :: fates_history_num_dimensions = 7 - integer, parameter :: fates_history_num_dim_kinds = 10 + integer, parameter :: fates_history_num_dim_kinds = 9 @@ -326,8 +326,7 @@ subroutine assemble_history_output_types(this) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 - use FatesIOVariableKindMod, only : patch_size_r8, site_size_r8 - use FatesIOVariableKindMod, only : site_pft_r8, site_age_r8 + use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 implicit none @@ -351,9 +350,6 @@ subroutine assemble_history_output_types(this) call this%set_dim_indices(site_size_pft_r8, 1, this%column_index()) call this%set_dim_indices(site_size_pft_r8, 2, this%levscpf_index()) - call this%set_dim_indices(patch_size_r8, 1, this%patch_index()) - call this%set_dim_indices(patch_size_r8, 2, this%levscls_index()) - call this%set_dim_indices(site_size_r8, 1, this%column_index()) call this%set_dim_indices(site_size_r8, 2, this%levscls_index()) @@ -597,8 +593,7 @@ subroutine init_dim_kinds_maps(this) ! ---------------------------------------------------------------------------------- use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 - use FatesIOVariableKindMod, only : patch_size_r8, site_size_r8 - use FatesIOVariableKindMod, only : site_pft_r8, site_age_r8 + use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 implicit none @@ -632,10 +627,6 @@ subroutine init_dim_kinds_maps(this) index = index + 1 call this%dim_kinds(index)%Init(site_size_pft_r8, 2) - ! patch x size-class - index = index + 1 - call this%dim_kinds(index)%Init(patch_size_r8, 2) - ! site x size-class index = index + 1 call this%dim_kinds(index)%Init(site_size_r8, 2) @@ -1256,8 +1247,7 @@ subroutine define_history_vars(this, initialize_variables) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 - use FatesIOVariableKindMod, only : patch_size_r8, site_size_r8 - use FatesIOVariableKindMod, only : site_pft_r8, site_age_r8 + use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 implicit none class(fates_history_interface_type), intent(inout) :: this diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90 index 54c7707bdb..2c8eb98216 100644 --- a/main/FatesIOVariableKindMod.F90 +++ b/main/FatesIOVariableKindMod.F90 @@ -12,7 +12,6 @@ module FatesIOVariableKindMod character(*), parameter :: patch_r8 = 'PA_R8' character(*), parameter :: patch_ground_r8 = 'PA_GRND_R8' character(*), parameter :: patch_size_pft_r8 = 'PA_SCPF_R8' - character(*), parameter :: patch_size_r8 = 'PA_SCLS_R8' character(*), parameter :: site_r8 = 'SI_R8' character(*), parameter :: site_int = 'SI_INT' character(*), parameter :: site_ground_r8 = 'SI_GRND_R8' From 21bb9944ec01bd581212af9a43b5bffb2843cdc3 Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 18 Jan 2017 14:54:00 -0800 Subject: [PATCH 07/12] fixed an error in pft biomass calculation and also a metadata issue on the patch age axis that made ferret display time weirdly --- main/FatesHistoryInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 69ef96cad4..e7bd7979ac 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -897,7 +897,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%n hio_biomass_si_pft(io_si, ft) = hio_biomass_si_pft(io_si, ft) + & - n_density * ccohort%b * 1.e3_r8 + ccohort%n * ccohort%b * 1.e3_r8 / AREA ! Site by Size-Class x PFT (SCPF) ! ------------------------------------------------------------------------ From 146ddd1fbcb6fce46eb1605027ddc020a103544d Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 18 Jan 2017 17:09:47 -0800 Subject: [PATCH 08/12] added a couple new diagnostic variables on age class dimension --- main/FatesHistoryInterfaceMod.F90 | 39 +++++++++++++++++++++++++++---- 1 file changed, 35 insertions(+), 4 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index e7bd7979ac..46e83c9603 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -140,6 +140,8 @@ module FatesHistoryInterfaceMod ! indices to (site x patch-age) variables integer, private :: ih_area_si_age + integer, private :: ih_lai_si_age + integer, private :: ih_canopy_area_si_age ! The number of variable dim/kind types we have defined (static) integer, parameter :: fates_history_num_dimensions = 7 @@ -727,7 +729,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! Locals integer :: s ! The local site index integer :: io_si ! The site index of the IO array - integer :: ipa ! The local "I"ndex of "PA"tches + integer :: ipa, ipa2 ! The local "I"ndex of "PA"tches integer :: io_pa ! The patch index of the IO array integer :: io_pa1 ! The first patch index in the IO array for each site integer :: io_soipa @@ -746,6 +748,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) real(r8), parameter :: daysecs = 86400.0_r8 ! What modeler doesn't recognize 86400? real(r8), parameter :: yeardays = 365.0_r8 ! ALM/CLM do not use leap-years + real(r8), parameter :: tiny = 1.e-5_r8 ! some small number associate( hio_npatches_si => this%hvars(ih_npatches_si)%r81d, & hio_ncohorts_si => this%hvars(ih_ncohorts_si)%r81d, & @@ -800,7 +803,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m5_si_scpf => this%hvars(ih_m5_si_scpf)%r82d, & hio_ba_si_scls => this%hvars(ih_ba_si_scls)%r82d, & hio_biomass_si_pft => this%hvars(ih_biomass_si_pft)%r82d, & - hio_area_si_age => this%hvars(ih_area_si_age)%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) ! --------------------------------------------------------------------------------- ! Flush arrays to values defined by %flushval (see registry entry in @@ -833,9 +838,15 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! Increment the number of patches per site hio_npatches_si(io_si) = hio_npatches_si(io_si) + 1._r8 - ! report the fractional area in each age class bin + ! Increment the fractional area in each age class bin hio_area_si_age(io_si,cpatch%age_class) = hio_area_si_age(io_si,cpatch%age_class) & + cpatch%area/AREA + + ! Increment the leaf and canopy areas in each age class bin + 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 ccohort => cpatch%shortest do while(associated(ccohort)) @@ -1026,6 +1037,15 @@ subroutine update_history_dyn(this,nc,nsites,sites) ipa = ipa + 1 cpatch => cpatch%younger end do !patch loop + + ! divide so-far-just-summed but to-be-averaged patch-age-class variables by patch-age-class area to get mean values + do ipa2 = 1, nlevage_ed + if (hio_area_si_age(io_si, ipa2) .gt. tiny) then + hio_lai_si_age(io_si, ipa2) = hio_lai_si_age(io_si, ipa2) / (hio_area_si_age(io_si, ipa2)*AREA) + else + hio_lai_si_age(io_si, ipa2) = 0._r8 + endif + end do enddo ! site loop @@ -1316,10 +1336,21 @@ 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_biomass_si_pft ) - call this%set_history_var(vname='patch_area_by_age', units='m2/m2', & + ! 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', & avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_area_si_age ) + + call this%set_history_var(vname='LAI_BY_AGE', units='m2/m2', & + long='leaf area index by age bin', use_default='active', & + avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_lai_si_age ) + + call this%set_history_var(vname='CANOPY_AREA_BY_AGE', units='m2/m2', & + long='canopy area by age bin', use_default='active', & + avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_canopy_area_si_age ) ! Fire Variables From aedee0c02d9dd64e8967f060fadd2f2ef781077c Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 19 Jan 2017 11:58:52 -0800 Subject: [PATCH 09/12] added npp and gpp by age class diagnostics --- biogeochem/EDPatchDynamicsMod.F90 | 2 - main/EDTypesMod.F90 | 2 - main/FatesHistoryInterfaceMod.F90 | 67 +++++++++++++++++++++++++++++-- 3 files changed, 64 insertions(+), 7 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 0cb9434bd7..efd1701968 100755 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -937,8 +937,6 @@ subroutine zero_patch(cp_p) currentPatch%lai = nan ! leaf area index of patch currentPatch%spread(:) = nan ! dynamic ratio of dbh to canopy area. currentPatch%pft_agb_profile(:,:) = nan - currentPatch%gpp = 0._r8 - currentPatch%npp = 0._r8 ! DISTURBANCE currentPatch%disturbance_rates = 0._r8 diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index be94ffdd97..d861559ce3 100755 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -392,8 +392,6 @@ module EDTypesMod ! 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) :: gpp ! total patch gpp: KgC/m2/year - real(r8) :: npp ! total patch npp: KgC/m2/year ! ROOTS real(r8), allocatable :: rootfr_ft(:,:) ! root fraction of each PFT in each soil layer:- diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 46e83c9603..d17cf450a3 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -142,6 +142,10 @@ module FatesHistoryInterfaceMod integer, private :: ih_area_si_age integer, private :: ih_lai_si_age integer, private :: ih_canopy_area_si_age + integer, private :: ih_gpp_si_age + integer, private :: ih_npp_si_age + integer, private :: ih_ncl_si_age + integer, private :: ih_npatches_si_age ! The number of variable dim/kind types we have defined (static) integer, parameter :: fates_history_num_dimensions = 7 @@ -805,7 +809,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_biomass_si_pft => this%hvars(ih_biomass_si_pft)%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) + hio_canopy_area_si_age => this%hvars(ih_canopy_area_si_age)%r82d, & + hio_ncl_si_age => this%hvars(ih_ncl_si_age)%r82d, & + hio_npatches_si_age => this%hvars(ih_npatches_si_age)%r82d) + ! --------------------------------------------------------------------------------- ! Flush arrays to values defined by %flushval (see registry entry in @@ -842,11 +849,14 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_area_si_age(io_si,cpatch%age_class) = hio_area_si_age(io_si,cpatch%age_class) & + cpatch%area/AREA - ! Increment the leaf and canopy areas in each age class bin + ! 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 ccohort => cpatch%shortest do while(associated(ccohort)) @@ -1042,8 +1052,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) do ipa2 = 1, nlevage_ed if (hio_area_si_age(io_si, ipa2) .gt. tiny) then hio_lai_si_age(io_si, ipa2) = hio_lai_si_age(io_si, ipa2) / (hio_area_si_age(io_si, ipa2)*AREA) + hio_ncl_si_age(io_si, ipa2) = hio_ncl_si_age(io_si, ipa2) / (hio_area_si_age(io_si, ipa2)*AREA) else hio_lai_si_age(io_si, ipa2) = 0._r8 + hio_ncl_si_age(io_si, ipa2) = 0._r8 endif end do @@ -1067,6 +1079,7 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ed_cohort_type, & ed_patch_type, & AREA, & + nlevage_ed, & sclass_ed, & nlevsclass_ed ! Arguments @@ -1088,6 +1101,9 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) integer :: ft ! functional type index real(r8) :: n_density ! individual of cohort per m2. real(r8) :: n_perm2 ! individuals per m2 for the whole column + real(r8) :: patch_area_by_age(nlevage_ed) ! patch area in each bin for normalizing purposes + real(r8), parameter :: tiny = 1.e-5_r8 ! some small number + integer :: ipa2 ! patch incrementer type(fates_history_variable_type),pointer :: hvar type(ed_patch_type),pointer :: cpatch @@ -1108,7 +1124,10 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) hio_ar_agsapm_si_scpf => this%hvars(ih_ar_agsapm_si_scpf)%r82d, & 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_ar_frootm_si_scpf => this%hvars(ih_ar_frootm_si_scpf)%r82d, & + hio_gpp_si_age => this%hvars(ih_gpp_si_age)%r82d, & + hio_npp_si_age => this%hvars(ih_npp_si_age)%r82d & + ) ! Flush the relevant history variables @@ -1122,10 +1141,15 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ipa = 0 cpatch => sites(s)%oldest_patch + + patch_area_by_age(:) = 0._r8 + do while(associated(cpatch)) io_pa = io_pa1 + ipa + patch_area_by_age(cpatch%age_class) = patch_area_by_age(cpatch%age_class) + cpatch%area + ccohort => cpatch%shortest do while(associated(ccohort)) @@ -1188,6 +1212,11 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) hio_ar_frootm_si_scpf(io_si,scpf) = hio_ar_frootm_si_scpf(io_si,scpf) + & ccohort%froot_mr * n_perm2 * daysecs * yeardays + ! accumulate fluxes per patch age bin + hio_gpp_si_age(io_si,cpatch%age_class) = hio_gpp_si_age(io_si,cpatch%age_class) & + + 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 end associate endif @@ -1196,6 +1225,16 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ipa = ipa + 1 cpatch => cpatch%younger end do !patch loop + + do ipa2 = 1, nlevage_ed + if (patch_area_by_age(ipa2) .gt. tiny) then + hio_gpp_si_age(io_si, ipa2) = hio_gpp_si_age(io_si, ipa2) / (patch_area_by_age(ipa2)) + hio_npp_si_age(io_si, ipa2) = hio_npp_si_age(io_si, ipa2) / (patch_area_by_age(ipa2)) + else + hio_gpp_si_age(io_si, ipa2) = 0._r8 + hio_npp_si_age(io_si, ipa2) = 0._r8 + endif + end do enddo ! site loop @@ -1352,6 +1391,16 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_canopy_area_si_age ) + call this%set_history_var(vname='NCL_BY_AGE', units='--', & + long='number of canopy levels by age bin', use_default='active', & + avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_ncl_si_age ) + + call this%set_history_var(vname='NPATCH_BY_AGE', units='--', & + long='number of patches by age bin', use_default='active', & + avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_npatches_si_age ) + ! Fire Variables call this%set_history_var(vname='FIRE_NESTEROV_INDEX', units='none', & @@ -1506,6 +1555,18 @@ 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_maint_resp_pa ) + ! fast fluxes by age bin + call this%set_history_var(vname='NPP_BY_AGE', units='gC/m^2/s', & + long='net primary productivity by age bin', use_default='active', & + avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_npp_si_age ) + + call this%set_history_var(vname='GPP_BY_AGE', units='gC/m^2/s', & + long='gross primary productivity by age bin', use_default='active', & + 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 ) + + ! Carbon Flux (grid dimension x scpf) (THESE ARE DEFAULT INACTIVE!!! ! (BECAUSE THEY TAKE UP SPACE!!! From 9d70ed6769f5d8ba1d496b24c8ce154d1bdd21df Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 19 Jan 2017 13:40:39 -0800 Subject: [PATCH 10/12] moved the old pft variables to the new pft dimension --- main/FatesHistoryInterfaceMod.F90 | 56 ++++++++++++------------------- 1 file changed, 22 insertions(+), 34 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index d17cf450a3..11ce1b4c82 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -63,13 +63,6 @@ module FatesHistoryInterfaceMod integer, private :: ih_maint_resp_pa integer, private :: ih_growth_resp_pa - ! Indices to (patch x pft) variables (using nlevgrnd as surrogate) - !+++cdk+++ leaving these as-is for now to preserve b4b, but once established, need to move these to actual pft dimension - integer, private :: ih_biomass_pa_pft - integer, private :: ih_leafbiomass_pa_pft - integer, private :: ih_storebiomass_pa_pft - integer, private :: ih_nindivs_pa_pft - ! Indices to (site) variables integer, private :: ih_nep_si integer, private :: ih_nep_timeintegrated_si @@ -137,6 +130,10 @@ module FatesHistoryInterfaceMod ! indices to (site x pft) variables integer, private :: ih_biomass_si_pft + integer, private :: ih_leafbiomass_si_pft + integer, private :: ih_storebiomass_si_pft + integer, private :: ih_nindivs_si_pft + ! indices to (site x patch-age) variables integer, private :: ih_area_si_age @@ -760,10 +757,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_area_plant_pa => this%hvars(ih_area_plant_pa)%r81d, & hio_area_treespread_pa => this%hvars(ih_area_treespread_pa)%r81d, & hio_canopy_spread_pa => this%hvars(ih_canopy_spread_pa)%r81d, & - hio_biomass_pa_pft => this%hvars(ih_biomass_pa_pft)%r82d, & - hio_leafbiomass_pa_pft => this%hvars(ih_leafbiomass_pa_pft)%r82d, & - hio_storebiomass_pa_pft => this%hvars(ih_storebiomass_pa_pft)%r82d, & - hio_nindivs_pa_pft => this%hvars(ih_nindivs_pa_pft)%r82d, & + hio_biomass_si_pft => this%hvars(ih_biomass_si_pft)%r82d, & + hio_leafbiomass_si_pft => this%hvars(ih_leafbiomass_si_pft)%r82d, & + hio_storebiomass_si_pft => this%hvars(ih_storebiomass_si_pft)%r82d, & + hio_nindivs_si_pft => this%hvars(ih_nindivs_si_pft)%r82d, & hio_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, & @@ -806,7 +803,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m4_si_scpf => this%hvars(ih_m4_si_scpf)%r82d, & hio_m5_si_scpf => this%hvars(ih_m5_si_scpf)%r82d, & hio_ba_si_scls => this%hvars(ih_ba_si_scls)%r82d, & - hio_biomass_si_pft => this%hvars(ih_biomass_si_pft)%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, & @@ -905,20 +901,17 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_balive_pa(io_pa) = hio_balive_pa(io_pa) + n_density * ccohort%balive * 1.e3_r8 ! Update PFT partitioned biomass components - hio_biomass_pa_pft(io_pa,ft) = hio_biomass_pa_pft(io_pa,ft) + & - n_density * ccohort%b * 1.e3_r8 - - hio_leafbiomass_pa_pft(io_pa,ft) = hio_leafbiomass_pa_pft(io_pa,ft) + & - n_density * ccohort%bl * 1.e3_r8 + hio_leafbiomass_si_pft(io_si,ft) = hio_leafbiomass_si_pft(io_si,ft) + & + (ccohort%n / AREA) * ccohort%bl * 1.e3_r8 - hio_storebiomass_pa_pft(io_pa,ft) = hio_storebiomass_pa_pft(io_pa,ft) + & - n_density * ccohort%bstore * 1.e3_r8 + hio_storebiomass_si_pft(io_si,ft) = hio_storebiomass_si_pft(io_si,ft) + & + (ccohort%n / AREA) * ccohort%bstore * 1.e3_r8 - hio_nindivs_pa_pft(io_pa,ft) = hio_nindivs_pa_pft(io_pa,ft) + & - ccohort%n + hio_nindivs_si_pft(io_si,ft) = hio_nindivs_si_pft(io_si,ft) + & + ccohort%n / AREA hio_biomass_si_pft(io_si, ft) = hio_biomass_si_pft(io_si, ft) + & - ccohort%n * ccohort%b * 1.e3_r8 / AREA + (ccohort%n / AREA) * ccohort%b * 1.e3_r8 ! Site by Size-Class x PFT (SCPF) ! ------------------------------------------------------------------------ @@ -1352,28 +1345,23 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='PFTbiomass', units='gC/m2', & long='total PFT level biomass', use_default='active', & - avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_biomass_pa_pft ) + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_biomass_si_pft ) call this%set_history_var(vname='PFTleafbiomass', units='gC/m2', & long='total PFT level leaf biomass', use_default='active', & - avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_leafbiomass_pa_pft ) + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_leafbiomass_si_pft ) call this%set_history_var(vname='PFTstorebiomass', units='gC/m2', & long='total PFT level stored biomass', use_default='active', & - avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_storebiomass_pa_pft ) + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_storebiomass_si_pft ) call this%set_history_var(vname='PFTnindivs', units='indiv / m2', & long='total PFT level number of individuals', use_default='active', & - avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_nindivs_pa_pft ) - - call this%set_history_var(vname='PFT_biomass', units='gC/m2', & - long='total PFT level biomass -- on actual PFT dimension', 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_biomass_si_pft ) + ivar=ivar, initialize=initialize_variables, index = ih_nindivs_si_pft ) ! patch age class variables call this%set_history_var(vname='PATCH_AREA_BY_AGE', units='m2/m2', & From a1b9d69420e4334bb6762d1a786e1d47af2d46a9 Mon Sep 17 00:00:00 2001 From: ckoven Date: Fri, 20 Jan 2017 18:14:11 -0800 Subject: [PATCH 11/12] fixed some issues that rgknox pointed out in PR --- biogeochem/EDPatchDynamicsMod.F90 | 2 +- main/FatesHistoryInterfaceMod.F90 | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index efd1701968..7f5ffb942e 100755 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1170,7 +1170,7 @@ subroutine fuse_2_patches(dp, rp) !area weighted average of ages & litter rp%age = (dp%age * dp%area + rp%age * rp%area)/(dp%area + rp%area) - rp%age_class = max(1,count(rp%age-ageclass_ed.ge.0.0_r8)) + rp%age_class = count(rp%age-ageclass_ed.ge.0.0_r8) do p = 1,numpft_ed rp%seeds_in(p) = (rp%seeds_in(p)*rp%area + dp%seeds_in(p)*dp%area)/(rp%area + dp%area) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 11ce1b4c82..3681f1d64a 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1343,22 +1343,22 @@ 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_canopy_spread_pa) - call this%set_history_var(vname='PFTbiomass', units='gC/m2', & + call this%set_history_var(vname='PFT_BIOMASS', units='gC/m2', & long='total PFT level biomass', 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_biomass_si_pft ) - call this%set_history_var(vname='PFTleafbiomass', units='gC/m2', & + call this%set_history_var(vname='PFT_LEAF_BIOMASS', units='gC/m2', & long='total PFT level leaf biomass', 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_leafbiomass_si_pft ) - call this%set_history_var(vname='PFTstorebiomass', units='gC/m2', & + call this%set_history_var(vname='PFT_STORE_BIOMASS', units='gC/m2', & long='total PFT level stored biomass', 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_storebiomass_si_pft ) - call this%set_history_var(vname='PFTnindivs', units='indiv / m2', & + call this%set_history_var(vname='PFT_N_INDIVS', units='indiv / m2', & long='total PFT level number of individuals', 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_nindivs_si_pft ) @@ -1380,7 +1380,7 @@ subroutine define_history_vars(this, initialize_variables) ivar=ivar, initialize=initialize_variables, index = ih_canopy_area_si_age ) call this%set_history_var(vname='NCL_BY_AGE', units='--', & - long='number of canopy levels by age bin', use_default='active', & + long='number of canopy levels by age bin', use_default='inactive', & avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_ncl_si_age ) From 706df0a03f05c9068263b7a1d5272b615d76efb9 Mon Sep 17 00:00:00 2001 From: ckoven Date: Fri, 20 Jan 2017 19:19:53 -0800 Subject: [PATCH 12/12] as it turns out, the testing scripts don't like the changed PFT variable names. reverting. --- main/FatesHistoryInterfaceMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 3681f1d64a..568b9950d4 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1343,22 +1343,22 @@ 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_canopy_spread_pa) - call this%set_history_var(vname='PFT_BIOMASS', units='gC/m2', & + call this%set_history_var(vname='PFTbiomass', units='gC/m2', & long='total PFT level biomass', 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_biomass_si_pft ) - call this%set_history_var(vname='PFT_LEAF_BIOMASS', units='gC/m2', & + call this%set_history_var(vname='PFTleafbiomass', units='gC/m2', & long='total PFT level leaf biomass', 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_leafbiomass_si_pft ) - call this%set_history_var(vname='PFT_STORE_BIOMASS', units='gC/m2', & + call this%set_history_var(vname='PFTstorebiomass', units='gC/m2', & long='total PFT level stored biomass', 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_storebiomass_si_pft ) - call this%set_history_var(vname='PFT_N_INDIVS', units='indiv / m2', & + call this%set_history_var(vname='PFTnindivs', units='indiv / m2', & long='total PFT level number of individuals', 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_nindivs_si_pft )