From e3a80147912d61ed85f5a565f4796197d910b048 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Wed, 12 Oct 2016 16:35:39 -0600 Subject: [PATCH 01/13] Refactor fates history dimensions into standalone module Move the fates history dimensions class into a standalone module, along with the procedures for initialization and setting threads. Test suite: ERS_D_Ld5.f10_f10.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: 49733e8 Test namelist changes: none Test answer changes: bit for bit Test summary: pass --- .../src/ED/main/FatesHistoryDimensionMod.F90 | 70 +++++++++ components/clm/src/ED/main/HistoryIOMod.F90 | 148 ++++++++++-------- .../clm/src/utils/clmfates_interfaceMod.F90 | 48 ++++-- 3 files changed, 185 insertions(+), 81 deletions(-) create mode 100644 components/clm/src/ED/main/FatesHistoryDimensionMod.F90 diff --git a/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 b/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 new file mode 100644 index 0000000000..6fb3d5c54d --- /dev/null +++ b/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 @@ -0,0 +1,70 @@ +module FatesHistoryDimensionMod + + use FatesConstantsMod, only : fates_short_string_length + + implicit none + + ! FIXME(bja, 2016-10) do these need to be strings, or can they be integer enumerations? + character(*), parameter :: patch_r8 = 'PA_R8' + character(*), parameter :: patch_ground_r8 = 'PA_GRND_R8' + character(*), parameter :: patch_class_pft_r8 = 'PA_SCPF_R8' + character(*), parameter :: site_r8 = 'SI_R8' + character(*), parameter :: site_ground_r8 = 'SI_GRND_R8' + character(*), parameter :: site_class_pft_r8 = 'SI_SCPF_R8' + + ! This structure is not allocated by thread, but the upper and lower boundaries + ! of the dimension for each thread is saved in the clump_ entry + type fates_history_dimension_type + character(len=fates_short_string_length) :: name + integer :: lower_bound + integer :: upper_bound + integer, allocatable :: clump_lower_bound(:) ! lower bound of thread's portion of HIO array + integer, allocatable :: clump_upper_bound(:) ! upper bound of thread's portion of HIO array + contains + procedure, public :: Init => InitHistoryDimensions + procedure, public :: SetThreadBounds => SetHistoryDimensionThreadBounds + end type fates_history_dimension_type + +contains + + ! ===================================================================================== + subroutine InitHistoryDimensions(this, name, num_threads, lower_bound, upper_bound) + + implicit none + + ! arguments + class(fates_history_dimension_type), intent(inout) :: this + character(len=*), intent(in) :: name + integer, intent(in) :: num_threads + integer, intent(in) :: lower_bound + integer, intent(in) :: upper_bound + + this%name = trim(name) + this%lower_bound = lower_bound + this%upper_bound = upper_bound + + allocate(this%clump_lower_bound(num_threads)) + this%clump_lower_bound(:) = -1 + + allocate(this%clump_upper_bound(num_threads)) + this%clump_upper_bound(:) = -1 + + end subroutine InitHistoryDimensions + + ! ===================================================================================== + + subroutine SetHistoryDimensionThreadBounds(this, thread_index, lower_bound, upper_bound) + + implicit none + + class(fates_history_dimension_type), intent(inout) :: this + integer, intent(in) :: thread_index + integer, intent(in) :: lower_bound + integer, intent(in) :: upper_bound + + this%clump_lower_bound(thread_index) = lower_bound + this%clump_upper_bound(thread_index) = upper_bound + + end subroutine SetHistoryDimensionThreadBounds + +end module FatesHistoryDimensionMod diff --git a/components/clm/src/ED/main/HistoryIOMod.F90 b/components/clm/src/ED/main/HistoryIOMod.F90 index b21edabe18..669d86c608 100644 --- a/components/clm/src/ED/main/HistoryIOMod.F90 +++ b/components/clm/src/ED/main/HistoryIOMod.F90 @@ -4,7 +4,12 @@ Module HistoryIOMod use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : fates_avg_flag_length, fates_short_string_length, fates_long_string_length use FatesGlobals , only : fates_log + + use FatesHistoryDimensionMod, only : fates_history_dimension_type + use EDTypesMod , only : cp_hio_ignore_val + + ! FIXME(bja, 2016-10) need to remove CLM dependancy use pftconMod , only : pftcon implicit none @@ -124,17 +129,16 @@ Module HistoryIOMod ! The number of variable dim/kind types we have defined (static) integer, parameter :: n_iovar_dk = 6 - - ! This structure is not allocated by thread, but the upper and lower boundaries - ! of the dimension for each thread is saved in the clump_ entry - type iovar_dim_type - character(fates_short_string_length) :: name ! This should match the name of the dimension - integer :: lb ! lower bound - integer :: ub ! upper bound - integer,allocatable :: clump_lb(:) ! lower bound of thread's portion of HIO array - integer,allocatable :: clump_ub(:) ! upper bound of thread's portion of HIO array - end type iovar_dim_type - + type, public :: fates_bounds_type + integer :: patch_begin + integer :: patch_end + integer :: column_begin + integer :: column_end + integer :: ground_begin + integer :: ground_end + integer :: pft_class_begin + integer :: pft_class_end + end type fates_bounds_type ! This structure is allocated by thread, and must be calculated after the FATES @@ -155,8 +159,8 @@ Module HistoryIOMod integer :: ndims ! number of dimensions in this IO type integer, allocatable :: dimsize(:) ! The size of each dimension logical :: active - type(iovar_dim_type), pointer :: dim1_ptr - type(iovar_dim_type), pointer :: dim2_ptr + type(fates_history_dimension_type), pointer :: dim1_ptr + type(fates_history_dimension_type), pointer :: dim2_ptr end type iovar_dimkind_type @@ -200,26 +204,29 @@ Module HistoryIOMod ! This is a structure that explains where FATES patch boundaries ! on each thread point to in the host IO array, this structure ! is allocated by number of threads - type(iovar_dim_type) :: iopa_dim + type(fates_history_dimension_type) :: iopa_dim ! This is a structure that explains where FATES patch boundaries ! on each thread point to in the host IO array, this structure ! is allocated by number of threads - type(iovar_dim_type) :: iosi_dim + type(fates_history_dimension_type) :: iosi_dim ! This is a structure that contains the boundaries for the ! ground level (includes rock) dimension - type(iovar_dim_type) :: iogrnd_dim + type(fates_history_dimension_type) :: iogrnd_dim ! This is a structure that contains the boundaries for the ! number of size-class x pft dimension - type(iovar_dim_type) :: ioscpf_dim + type(fates_history_dimension_type) :: ioscpf_dim type(iovar_map_type), pointer :: iovar_map(:) contains + procedure, public :: Init => InitFatesHistoryOutput + procedure, public :: SetThreadBounds => SetHistoryThreadBounds + procedure, public :: update_history_dyn procedure, public :: update_history_prod procedure, public :: update_history_cbal @@ -229,8 +236,6 @@ Module HistoryIOMod procedure, public :: iotype_index procedure, public :: set_dim_ptrs procedure, public :: get_hvar_bounds - procedure, public :: dim_init - procedure, public :: set_dim_thread_bounds procedure, private :: flush_hvars end type fates_hio_interface_type @@ -239,9 +244,52 @@ Module HistoryIOMod contains - ! =================================================================================== + ! ====================================================================== + + subroutine InitFatesHistoryOutput(this, num_threads, fates_bounds) + + implicit none + + class(fates_hio_interface_type), intent(inout) :: this + integer, intent(in) :: num_threads + type(fates_bounds_type), intent(in) :: fates_bounds + + call this%iopa_dim%Init('patch', num_threads, fates_bounds%patch_begin, fates_bounds%patch_end) + call this%iosi_dim%Init('column', num_threads, fates_bounds%column_begin, fates_bounds%column_end) + call this%iogrnd_dim%Init('levgrnd', num_threads, fates_bounds%ground_begin, fates_bounds%ground_end) + call this%ioscpf_dim%Init('levscpf', num_threads, fates_bounds%pft_class_begin, fates_bounds%pft_class_end) + + ! Allocate the mapping between FATES indices and the IO indices + allocate(this%iovar_map(num_threads)) + + end subroutine InitFatesHistoryOutput + + ! ====================================================================== + subroutine SetHistoryThreadBounds(this, thread_index, thread_bounds) + + implicit none + + class(fates_hio_interface_type), intent(inout) :: this + + integer, intent(in) :: thread_index + type(fates_bounds_type), intent(in) :: thread_bounds + + call this%iopa_dim%SetThreadBounds(thread_index, & + thread_bounds%patch_begin, thread_bounds%patch_end) + + call this%iosi_dim%SetThreadBounds(thread_index, & + thread_bounds%column_begin, thread_bounds%column_end) + + call this%iogrnd_dim%SetThreadBounds(thread_index, & + thread_bounds%ground_begin, thread_bounds%ground_end) + + call this%ioscpf_dim%SetThreadBounds(thread_index, & + thread_bounds%pft_class_begin, thread_bounds%pft_class_end) + + end subroutine SetHistoryThreadBounds - subroutine update_history_cbal(this,nc,nsites,sites) + ! ======================================================================= + subroutine update_history_cbal(this,nc,nsites,sites) use EDtypesMod , only : ed_site_type @@ -733,7 +781,6 @@ subroutine flush_hvars(this,nc,upfreq_in) type(iovar_def_type),pointer :: hvar integer :: lb1,ub1,lb2,ub2 - do ivar=1,ubound(this%hvars,1) hvar => this%hvars(ivar) if (hvar%upfreq==upfreq_in) then ! Only flush variables with update on dynamics step @@ -1292,18 +1339,18 @@ subroutine get_hvar_bounds(this,hvar,thread,lb1,ub1,lb2,ub2) ! The thread = 0 case is the boundaries for the whole proc/node if (thread==0) then - lb1 = hvar%iovar_dk_ptr%dim1_ptr%lb - ub1 = hvar%iovar_dk_ptr%dim1_ptr%ub + lb1 = hvar%iovar_dk_ptr%dim1_ptr%lower_bound + ub1 = hvar%iovar_dk_ptr%dim1_ptr%upper_bound if(ndims>1)then - lb2 = hvar%iovar_dk_ptr%dim2_ptr%lb - ub2 = hvar%iovar_dk_ptr%dim2_ptr%ub + lb2 = hvar%iovar_dk_ptr%dim2_ptr%lower_bound + ub2 = hvar%iovar_dk_ptr%dim2_ptr%upper_bound end if else - lb1 = hvar%iovar_dk_ptr%dim1_ptr%clump_lb(thread) - ub1 = hvar%iovar_dk_ptr%dim1_ptr%clump_ub(thread) + lb1 = hvar%iovar_dk_ptr%dim1_ptr%clump_lower_bound(thread) + ub1 = hvar%iovar_dk_ptr%dim1_ptr%clump_upper_bound(thread) if(ndims>1)then - lb2 = hvar%iovar_dk_ptr%dim2_ptr%clump_lb(thread) - ub2 = hvar%iovar_dk_ptr%dim2_ptr%clump_ub(thread) + lb2 = hvar%iovar_dk_ptr%dim2_ptr%clump_lower_bound(thread) + ub2 = hvar%iovar_dk_ptr%dim2_ptr%clump_upper_bound(thread) end if end if @@ -1416,7 +1463,7 @@ subroutine set_dim_ptrs(this,dk_name,idim,dim_target) class(fates_hio_interface_type) :: this character(len=*),intent(in) :: dk_name integer,intent(in) :: idim ! dimension index - type(iovar_dim_type),target :: dim_target + type(fates_history_dimension_type),target :: dim_target ! local @@ -1440,7 +1487,7 @@ subroutine set_dim_ptrs(this,dk_name,idim,dim_target) end if ! With the map, we can set the dimension size - this%iovar_dk(ityp)%dimsize(idim) = dim_target%ub - dim_target%lb + 1 + this%iovar_dk(ityp)%dimsize(idim) = dim_target%upper_bound - dim_target%lower_bound + 1 return @@ -1467,43 +1514,6 @@ function iotype_index(this,iotype_name) result(ityp) end function iotype_index - ! ===================================================================================== - - subroutine dim_init(this,iovar_dim,dim_name,nthreads,lb_in,ub_in) - - ! arguments - class(fates_hio_interface_type) :: this - type(iovar_dim_type),target :: iovar_dim - character(len=*),intent(in) :: dim_name - integer,intent(in) :: nthreads - integer,intent(in) :: lb_in - integer,intent(in) :: ub_in - - allocate(iovar_dim%clump_lb(nthreads)) - allocate(iovar_dim%clump_ub(nthreads)) - - iovar_dim%name = trim(dim_name) - iovar_dim%lb = lb_in - iovar_dim%ub = ub_in - - return - end subroutine dim_init - - ! ===================================================================================== - - subroutine set_dim_thread_bounds(this,iovar_dim,nc,lb_in,ub_in) - - class(fates_hio_interface_type) :: this - type(iovar_dim_type),target :: iovar_dim - integer,intent(in) :: nc ! Thread index - integer,intent(in) :: lb_in - integer,intent(in) :: ub_in - - iovar_dim%clump_lb(nc) = lb_in - iovar_dim%clump_ub(nc) = ub_in - - return - end subroutine set_dim_thread_bounds ! ==================================================================================== ! DEPRECATED, TRANSITIONAL OR FUTURE CODE SECTION diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 86fd070b4b..437eaac36a 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -81,7 +81,10 @@ module CLMFatesInterfaceMod set_fates_ctrlparms, & allocate_bcin, & allocate_bcout - + + use FatesHistoryDimensionMod, only : fates_history_dimension_type + use HistoryIOMod, only : fates_bounds_type + use HistoryIOMod , only : fates_hio_interface_type use ChecksBalancesMod , only : SummarizeNetFluxes, FATES_BGC_Carbon_BalanceCheck @@ -1411,8 +1414,6 @@ end subroutine wrap_bgc_summary subroutine init_history_io(this,bounds_proc) use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp - use EDtypesMod , only : nlevsclass_ed - use clm_varpar , only : mxpft, nlevgrnd ! Arguments class(hlm_fates_interface_type), intent(inout) :: this @@ -1429,6 +1430,9 @@ subroutine init_history_io(this,bounds_proc) integer :: c ! ALM/CLM column index character(len=32) :: dim2name + type(fates_bounds_type) :: fates_bounds + type(fates_bounds_type) :: fates_clump + ! This routine initializes the types of output variables ! not the variables themselves, just the types ! --------------------------------------------------------------------------------- @@ -1456,26 +1460,23 @@ subroutine init_history_io(this,bounds_proc) ! "scpf" ! ------------------------------------------------------------------------------------ - call this%fates_hio%dim_init(this%fates_hio%iopa_dim,'patch',nclumps,bounds_proc%begp,bounds_proc%endp) - call this%fates_hio%dim_init(this%fates_hio%iosi_dim,'column',nclumps,bounds_proc%begc,bounds_proc%endc) - call this%fates_hio%dim_init(this%fates_hio%iogrnd_dim,'levgrnd',nclumps,1,nlevgrnd) - call this%fates_hio%dim_init(this%fates_hio%ioscpf_dim,'levscpf',nclumps,1,nlevsclass_ed*mxpft) + call hlm_bounds_to_fates_bounds(bounds_proc, fates_bounds) + + call this%fates_hio%Init(nclumps, fates_bounds) ! Allocate the mapping between FATES indices and the IO indices allocate(this%fates_hio%iovar_map(nclumps)) ! Define the bounds on the first dimension for each thread - !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,s,c) + !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,fates_clump,s,c,num_sites) do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) ! thread bounds for patch - call this%fates_hio%set_dim_thread_bounds(this%fates_hio%iopa_dim,nc,bounds_clump%begp,bounds_clump%endp) - call this%fates_hio%set_dim_thread_bounds(this%fates_hio%iosi_dim,nc,bounds_clump%begc,bounds_clump%endc) - call this%fates_hio%set_dim_thread_bounds(this%fates_hio%iogrnd_dim,nc,1,nlevgrnd) - call this%fates_hio%set_dim_thread_bounds(this%fates_hio%ioscpf_dim,nc,1,nlevsclass_ed*mxpft) + call hlm_bounds_to_fates_bounds(bounds_clump, fates_clump) + call this%fates_hio%SetThreadBounds(nc, fates_clump) ! ------------------------------------------------------------------------------------ ! PART I.5: SET SOME INDEX MAPPINGS SPECIFICALLY FOR SITE<->COLUMN AND PATCH @@ -1605,5 +1606,28 @@ subroutine init_history_io(this,bounds_proc) return end subroutine init_history_io + subroutine hlm_bounds_to_fates_bounds(hlm, fates) + + use EDtypesMod , only : nlevsclass_ed + use clm_varpar , only : mxpft, nlevgrnd + + implicit none + + type(bounds_type), intent(in) :: hlm + type(fates_bounds_type), intent(out) :: fates + + fates%patch_begin = hlm%begp + fates%patch_end = hlm%endp + + fates%column_begin = hlm%begc + fates%column_end = hlm%endc + + fates%ground_begin = 1 + fates%ground_end = nlevgrnd + + fates%pft_class_begin = 1 + fates%pft_class_end = nlevsclass_ed * mxpft + + end subroutine hlm_bounds_to_fates_bounds end module CLMFatesInterfaceMod From 32fab0576a8e19691cf9be2a8dc2106ed8edbdaa Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Fri, 14 Oct 2016 09:46:40 -0600 Subject: [PATCH 02/13] Refactor fates history variable kind Refactor the fates history dimension kind struct, move it into its own module, create init function to remove copy-paste variable initialization. Test suite: ERS_D_Ld5.f10_f10.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: 49733e8 Test namelist changes: none Test answer changes: bit for bit Test summary: pass --- .../clm/src/ED/main/FatesConstantsMod.F90 | 2 + .../src/ED/main/FatesHistoryVarKindMod.F90 | 55 ++++++++++ components/clm/src/ED/main/HistoryIOMod.F90 | 100 +++++------------- 3 files changed, 81 insertions(+), 76 deletions(-) create mode 100644 components/clm/src/ED/main/FatesHistoryVarKindMod.F90 diff --git a/components/clm/src/ED/main/FatesConstantsMod.F90 b/components/clm/src/ED/main/FatesConstantsMod.F90 index be01937c4f..a8b93fa979 100644 --- a/components/clm/src/ED/main/FatesConstantsMod.F90 +++ b/components/clm/src/ED/main/FatesConstantsMod.F90 @@ -14,6 +14,8 @@ module FatesConstantsMod integer, parameter :: fates_short_string_length = 32 integer, parameter :: fates_long_string_length = 199 + integer, parameter :: fates_unset_int = -9999 + ! various magic numbers real(fates_r8), parameter :: fates_special_value = 1.0e36_fates_r8 ! special value for real data, compatible with clm. integer, parameter :: fates_int_special_value = -9999 ! keep this negative to avoid conflicts with possible valid values diff --git a/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 b/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 new file mode 100644 index 0000000000..869f16a186 --- /dev/null +++ b/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 @@ -0,0 +1,55 @@ +module FatesHistoryVariableKindMod + + use FatesConstantsMod, only : fates_long_string_length + use FatesHistoryDimensionMod, only : fates_history_dimension_type + + implicit none + + ! 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 + ! dimensioning specifications from the host, but we currently arent using those + ! passing functions.. + + ! This structure is not multi-threaded + type fates_history_variable_kind_type + character(len=fates_long_string_length) :: name ! String labelling this IO type + integer :: ndims ! number of dimensions in this IO type + integer, allocatable :: dimsize(:) ! The size of each dimension + logical :: active + type(fates_history_dimension_type), pointer :: dim1_ptr + type(fates_history_dimension_type), pointer :: dim2_ptr + + contains + + procedure, public :: Init => InitVariableKind + + end type fates_history_variable_kind_type + + + +contains + + ! =================================================================================== + subroutine InitVariableKind(this, name, num_dims) + + use FatesConstantsMod, only : fates_unset_int + + implicit none + + class(fates_history_variable_kind_type), intent(inout) :: this + character(*), intent(in) :: name + integer, intent(in) :: num_dims + + this%name = trim(name) + this%ndims = num_dims + allocate(this%dimsize(this%ndims)) + this%dimsize(:) = fates_unset_int + this%active = .false. + nullify(this%dim1_ptr) + nullify(this%dim2_ptr) + + end subroutine InitVariableKind + + + +end module FatesHistoryVariableKindMod diff --git a/components/clm/src/ED/main/HistoryIOMod.F90 b/components/clm/src/ED/main/HistoryIOMod.F90 index 669d86c608..7708b26419 100644 --- a/components/clm/src/ED/main/HistoryIOMod.F90 +++ b/components/clm/src/ED/main/HistoryIOMod.F90 @@ -6,6 +6,7 @@ Module HistoryIOMod use FatesGlobals , only : fates_log use FatesHistoryDimensionMod, only : fates_history_dimension_type + use FatesHistoryVariableKindMod, only : fates_history_variable_kind_type use EDTypesMod , only : cp_hio_ignore_val @@ -153,18 +154,6 @@ Module HistoryIOMod - ! This structure is not multi-threaded - type iovar_dimkind_type - character(fates_short_string_length) :: name ! String labelling this IO type - integer :: ndims ! number of dimensions in this IO type - integer, allocatable :: dimsize(:) ! The size of each dimension - logical :: active - type(fates_history_dimension_type), pointer :: dim1_ptr - type(fates_history_dimension_type), pointer :: dim2_ptr - end type iovar_dimkind_type - - - ! This type is instanteated in the HLM-FATES interface (clmfates_interfaceMod.F90) type iovar_def_type character(len=fates_short_string_length) :: vname @@ -180,7 +169,7 @@ Module HistoryIOMod ! 1 = dynamics "dyn" (daily) ! 2 = production "prod" (prob model tstep) real(r8) :: flushval - type(iovar_dimkind_type),pointer :: iovar_dk_ptr + type(fates_history_variable_kind_type),pointer :: iovar_dk_ptr ! Pointers (only one of these is allocated per variable) real(r8), pointer :: r81d(:) real(r8), pointer :: r82d(:,:) @@ -199,7 +188,7 @@ Module HistoryIOMod ! Instanteat one registry of the different dimension/kinds (dk) ! All output variables will have a pointer to one of these dk's - type(iovar_dimkind_type), pointer :: iovar_dk(:) + type(fates_history_variable_kind_type), pointer :: iovar_dk(:) ! This is a structure that explains where FATES patch boundaries ! on each thread point to in the host IO array, this structure @@ -1372,89 +1361,48 @@ subroutine init_iovar_dk_maps(this) ! The allocation on the structures is not dynamic and should only add up to the ! number of entries listed here. ! - ! note (RGK) %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 - ! dimensioning specifications from the host, but we currently arent using those - ! passing functions.. ! ---------------------------------------------------------------------------------- + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & + site_r8, site_ground_r8, site_class_pft_r8 + + implicit none ! Arguments class(fates_hio_interface_type) :: this - ! Locals - integer :: ityp + ! Localsi + integer :: index integer, parameter :: unset_int = -999 - + allocate(this%iovar_dk(n_iovar_dk)) ! 1d Patch - ityp = 1 - this%iovar_dk(ityp)%name = 'PA_R8' - this%iovar_dk(ityp)%ndims = 1 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) + index = 1 + call this%iovar_dk(index)%Init(patch_r8, 1) ! 1d Site - ityp = 2 - this%iovar_dk(ityp)%name = 'SI_R8' - this%iovar_dk(ityp)%ndims = 1 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) + index = index + 1 + call this%iovar_dk(index)%Init(site_r8, 1) ! patch x ground - ityp = 3 - this%iovar_dk(ityp)%name = 'PA_GRND_R8' - this%iovar_dk(ityp)%ndims = 2 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) + index = index + 1 + call this%iovar_dk(index)%Init(patch_ground_r8, 2) ! patch x size-class/pft - ityp = 4 - this%iovar_dk(ityp)%name = 'PA_SCPF_R8' - this%iovar_dk(ityp)%ndims = 2 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) + index = index + 1 + call this%iovar_dk(index)%Init(patch_class_pft_r8, 2) ! site x ground - ityp = 5 - this%iovar_dk(ityp)%name = 'SI_GRND_R8' - this%iovar_dk(ityp)%ndims = 2 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) + index = index + 1 + call this%iovar_dk(index)%Init(site_ground_r8, 2) ! site x size-class/pft - ityp = 6 - this%iovar_dk(ityp)%name = 'SI_SCPF_R8' - this%iovar_dk(ityp)%ndims = 2 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) + index = index + 1 + call this%iovar_dk(index)%Init(site_class_pft_r8, 2) - - - - - - return + ! FIXME(bja, 2016-10) assert(index == n_iovar_dk) end subroutine init_iovar_dk_maps - + ! =================================================================================== subroutine set_dim_ptrs(this,dk_name,idim,dim_target) From 719c030fb67f051742f04ed11a6a3735efc95e64 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Fri, 14 Oct 2016 15:54:39 -0600 Subject: [PATCH 03/13] Refactor fates history to class and module for hist variables. Test: ERS_D_Ld5.f10_f10.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: 44aac42 Test status: pass --- .../src/ED/main/FatesHistoryDimensionMod.F90 | 1 + .../src/ED/main/FatesHistoryVariableType.F90 | 228 ++++++++++++++++++ components/clm/src/ED/main/HistoryIOMod.F90 | 219 +++-------------- 3 files changed, 261 insertions(+), 187 deletions(-) create mode 100644 components/clm/src/ED/main/FatesHistoryVariableType.F90 diff --git a/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 b/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 index 6fb3d5c54d..da1598fd53 100644 --- a/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 @@ -11,6 +11,7 @@ module FatesHistoryDimensionMod character(*), parameter :: site_r8 = 'SI_R8' character(*), parameter :: site_ground_r8 = 'SI_GRND_R8' character(*), parameter :: site_class_pft_r8 = 'SI_SCPF_R8' + character(*), parameter :: patch_int = 'PA_INT' ! This structure is not allocated by thread, but the upper and lower boundaries ! of the dimension for each thread is saved in the clump_ entry diff --git a/components/clm/src/ED/main/FatesHistoryVariableType.F90 b/components/clm/src/ED/main/FatesHistoryVariableType.F90 new file mode 100644 index 0000000000..1e15751f9f --- /dev/null +++ b/components/clm/src/ED/main/FatesHistoryVariableType.F90 @@ -0,0 +1,228 @@ +module FatesHistoryVariableType + + use FatesConstantsMod, only : r8 => fates_r8 + use FatesGlobals, only : fates_log + use FatesHistoryVariableKindMod, only : fates_history_variable_kind_type + + implicit none + + ! This type is instanteated in the HLM-FATES interface (clmfates_interfaceMod.F90) + + type fates_history_variable_type + character(len=32) :: vname + character(len=24) :: units + character(len=128) :: long + character(len=24) :: use_default ! States whether a variable should be turned + ! on the output files by default (active/inactive) + ! It is a good idea to set inactive for very large + ! or infrequently used output datasets + character(len=24) :: vtype + character(len=1) :: avgflag + integer :: upfreq ! Update frequency (this is for checks and flushing) + ! 1 = dynamics "dyn" (daily) + ! 2 = production "prod" (prob model tstep) + real(r8) :: flushval + type(fates_history_variable_kind_type),pointer :: iovar_dk_ptr + ! Pointers (only one of these is allocated per variable) + real(r8), pointer :: r81d(:) + real(r8), pointer :: r82d(:,:) + real(r8), pointer :: r83d(:,:,:) + integer, pointer :: int1d(:) + integer, pointer :: int2d(:,:) + integer, pointer :: int3d(:,:,:) + contains + procedure, public :: Init => InitHistoryVariableType + procedure, public :: Flush => FlushVar + procedure, private :: GetBounds + end type fates_history_variable_type + +contains + + subroutine InitHistoryVariableType(this, vname, units, long, use_default, & + vtype, avgflag, flushval, upfreq, n_iovar_dk, iovar_dk) + + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & + site_r8, site_ground_r8, site_class_pft_r8 + + implicit none + + class(fates_history_variable_type), intent(inout) :: this + character(len=*), intent(in) :: vname + character(len=*), intent(in) :: units + character(len=*), intent(in) :: long + character(len=*), intent(in) :: use_default + character(len=*), intent(in) :: vtype + character(len=*), intent(in) :: avgflag + real(r8), intent(in) :: flushval ! If the type is an int we will round with nint + integer, intent(in) :: upfreq + integer, intent(in) :: n_iovar_dk + type(fates_history_variable_kind_type), intent(in), target :: iovar_dk(:) + + integer :: ityp + integer :: lb1, ub1, lb2, ub2 + + this%vname = vname + this%units = units + this%long = long + this%use_default = use_default + this%vtype = vtype + this%avgflag = avgflag + this%flushval = flushval + this%upfreq = upfreq + + nullify(this%r81d) + nullify(this%r82d) + nullify(this%r83d) + nullify(this%int1d) + nullify(this%int2d) + nullify(this%int3d) + + ityp = iotype_index(trim(vtype), n_iovar_dk, iovar_dk) + this%iovar_dk_ptr => iovar_dk(ityp) + this%iovar_dk_ptr%active = .true. + + call this%GetBounds(0, lb1, ub1, lb2, ub2) + + ! NOTE(rgk, 2016-09) currently, all array spaces are flushed each + ! time the update is called. The flush here on the initialization + ! may be redundant, but will prevent issues in the future if we + ! have host models where not all threads are updating the HHistory + ! array spaces. + + select case(trim(vtype)) + case(patch_r8) + allocate(this%r81d(lb1:ub1)) + this%r81d(:) = flushval + + case(site_r8) + allocate(this%r81d(lb1:ub1)) + this%r81d(:) = flushval + + case(patch_ground_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(patch_class_pft_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(site_ground_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(site_class_pft_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),' ?' + stop + ! end_run + end select + + end subroutine InitHistoryVariableType + + ! ===================================================================================== + + subroutine GetBounds(this, thread, lb1, ub1, lb2, ub2) + + class(fates_history_variable_type), intent(inout) :: this + + integer, intent(in) :: thread + + integer, intent(out) :: lb1 + integer, intent(out) :: ub1 + integer, intent(out) :: lb2 + integer, intent(out) :: ub2 + + ! local + integer :: ndims + + lb1 = 0 + ub1 = 0 + lb2 = 0 + ub2 = 0 + + ndims = this%iovar_dk_ptr%ndims + + ! The thread = 0 case is the boundaries for the whole proc/node + if (thread==0) then + lb1 = this%iovar_dk_ptr%dim1_ptr%lower_bound + ub1 = this%iovar_dk_ptr%dim1_ptr%upper_bound + if(ndims>1)then + lb2 = this%iovar_dk_ptr%dim2_ptr%lower_bound + ub2 = this%iovar_dk_ptr%dim2_ptr%upper_bound + end if + else + lb1 = this%iovar_dk_ptr%dim1_ptr%clump_lower_bound(thread) + ub1 = this%iovar_dk_ptr%dim1_ptr%clump_upper_bound(thread) + if(ndims>1)then + lb2 = this%iovar_dk_ptr%dim2_ptr%clump_lower_bound(thread) + ub2 = this%iovar_dk_ptr%dim2_ptr%clump_upper_bound(thread) + end if + end if + + end subroutine GetBounds + + subroutine FlushVar(this, thread) + + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & + site_r8, site_ground_r8, site_class_pft_r8, patch_int + + implicit none + + class(fates_history_variable_type), intent(inout) :: this + integer, intent(in) :: thread + + integer :: lb1, ub1, lb2, ub2 + + call this%GetBounds(thread, lb1, ub1, lb2, ub2) + + select case(trim(this%iovar_dk_ptr%name)) + case(patch_r8) + this%r81d(lb1:ub1) = this%flushval + case(site_r8) + this%r81d(lb1:ub1) = this%flushval + case(patch_ground_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(patch_class_pft_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_ground_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_class_pft_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(patch_int) + this%int1d(lb1:ub1) = nint(this%flushval) + case default + write(fates_log(),*) 'fates history variable type undefined while flushing history variables' + stop + !end_run + end select + + end subroutine FlushVar + + ! ==================================================================================== + + function iotype_index(iotype_name, n_iovar_dk, iovar_dk) result(ityp) + + ! argument + character(len=*), intent(in) :: iotype_name + integer, intent(in) :: n_iovar_dk + type(fates_history_variable_kind_type), intent(in) :: iovar_dk(:) + + ! local + integer :: ityp + + do ityp=1, n_iovar_dk + if(trim(iotype_name).eq.trim(iovar_dk(ityp)%name))then + return + end if + end do + write(fates_log(),*) 'An IOTYPE THAT DOESNT EXIST WAS SPECIFIED' + !end_run + + end function iotype_index + + +end module FatesHistoryVariableType diff --git a/components/clm/src/ED/main/HistoryIOMod.F90 b/components/clm/src/ED/main/HistoryIOMod.F90 index 7708b26419..cc1547a171 100644 --- a/components/clm/src/ED/main/HistoryIOMod.F90 +++ b/components/clm/src/ED/main/HistoryIOMod.F90 @@ -7,6 +7,7 @@ Module HistoryIOMod use FatesHistoryDimensionMod, only : fates_history_dimension_type use FatesHistoryVariableKindMod, only : fates_history_variable_kind_type + use FatesHistoryVariableType, only : fates_history_variable_type use EDTypesMod , only : cp_hio_ignore_val @@ -153,37 +154,10 @@ Module HistoryIOMod end type iovar_map_type - - ! This type is instanteated in the HLM-FATES interface (clmfates_interfaceMod.F90) - type iovar_def_type - character(len=fates_short_string_length) :: vname - character(len=fates_short_string_length) :: units - character(len=fates_long_string_length) :: long - character(len=fates_short_string_length) :: use_default ! States whether a variable should be turned - ! on the output files by default (active/inactive) - ! It is a good idea to set inactive for very large - ! or infrequently used output datasets - character(len=fates_short_string_length) :: vtype - character(len=fates_avg_flag_length) :: avgflag - integer :: upfreq ! Update frequency (this is for checks and flushing) - ! 1 = dynamics "dyn" (daily) - ! 2 = production "prod" (prob model tstep) - real(r8) :: flushval - type(fates_history_variable_kind_type),pointer :: iovar_dk_ptr - ! Pointers (only one of these is allocated per variable) - real(r8), pointer :: r81d(:) - real(r8), pointer :: r82d(:,:) - real(r8), pointer :: r83d(:,:,:) - integer, pointer :: int1d(:) - integer, pointer :: int2d(:,:) - integer, pointer :: int3d(:,:,:) - end type iovar_def_type - - type, public :: fates_hio_interface_type ! Instance of the list of history output varialbes - type(iovar_def_type), pointer :: hvars(:) + type(fates_history_variable_type), pointer :: hvars(:) integer :: n_hvars ! Instanteat one registry of the different dimension/kinds (dk) @@ -222,9 +196,7 @@ Module HistoryIOMod procedure, public :: define_history_vars procedure, public :: set_history_var procedure, public :: init_iovar_dk_maps - procedure, public :: iotype_index procedure, public :: set_dim_ptrs - procedure, public :: get_hvar_bounds procedure, private :: flush_hvars end type fates_hio_interface_type @@ -374,7 +346,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) real(r8) :: patch_scaling_scalar ! ratio of canopy to patch area for counteracting patch scaling real(r8) :: dbh ! diameter ("at breast height") - type(iovar_def_type),pointer :: hvar + type(fates_history_variable_type),pointer :: hvar type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -686,7 +658,7 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) real(r8) :: n_density ! individual of cohort per m2. real(r8) :: n_perm2 ! individuals per m2 for the whole column - type(iovar_def_type),pointer :: hvar + type(fates_history_variable_type),pointer :: hvar type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -767,33 +739,13 @@ subroutine flush_hvars(this,nc,upfreq_in) integer,intent(in) :: upfreq_in integer :: ivar - type(iovar_def_type),pointer :: hvar + type(fates_history_variable_type),pointer :: hvar integer :: lb1,ub1,lb2,ub2 do ivar=1,ubound(this%hvars,1) hvar => this%hvars(ivar) - if (hvar%upfreq==upfreq_in) then ! Only flush variables with update on dynamics step - call this%get_hvar_bounds(hvar,nc,lb1,ub1,lb2,ub2) - select case(trim(hvar%iovar_dk_ptr%name)) - case('PA_R8') - hvar%r81d(lb1:ub1) = hvar%flushval - case('SI_R8') - hvar%r81d(lb1:ub1) = hvar%flushval - case('PA_GRND_R8') - hvar%r82d(lb1:ub1,lb2:ub2) = hvar%flushval - case('PA_SCPF_R8') - hvar%r82d(lb1:ub1,lb2:ub2) = hvar%flushval - case('SI_GRND_R8') - hvar%r82d(lb1:ub1,lb2:ub2) = hvar%flushval - case('SI_SCPF_R8') - hvar%r82d(lb1:ub1,lb2:ub2) = hvar%flushval - case('PA_INT') - hvar%int1d(lb1:ub1) = nint(hvar%flushval) - case default - write(fates_log(),*) 'iotyp undefined while flushing history variables' - stop - !end_run - end select + if (hvar%upfreq == upfreq_in) then ! Only flush variables with update on dynamics step + call hvar%Flush(nc) end if end do @@ -1218,16 +1170,16 @@ subroutine set_history_var(this,vname,units,long,use_default,avgflag,vtype,hlms, ! arguments class(fates_hio_interface_type) :: this - character(len=*),intent(in) :: vname - character(len=*),intent(in) :: units - character(len=*),intent(in) :: long - character(len=*),intent(in) :: use_default - character(len=*),intent(in) :: avgflag - character(len=*),intent(in) :: vtype - character(len=*),intent(in) :: hlms - real(r8),intent(in) :: flushval ! IF THE TYPE IS AN INT WE WILL round with NINT - integer,intent(in) :: upfreq - character(len=*),intent(in) :: callstep + character(len=*), intent(in) :: vname + character(len=*), intent(in) :: units + character(len=*), intent(in) :: long + character(len=*), intent(in) :: use_default + character(len=*), intent(in) :: avgflag + character(len=*), intent(in) :: vtype + character(len=*), intent(in) :: hlms + real(r8), intent(in) :: flushval ! IF THE TYPE IS AN INT WE WILL round with NINT + integer, intent(in) :: upfreq + character(len=*), intent(in) :: callstep integer, intent(inout) :: ivar integer, intent(inout) :: index ! This is the index for the variable of ! interest that is associated with an @@ -1236,117 +1188,28 @@ subroutine set_history_var(this,vname,units,long,use_default,avgflag,vtype,hlms, ! not used ! locals - type(iovar_def_type),pointer :: hvar - integer :: ub1,lb1,ub2,lb2 ! Bounds for allocating the var + type(fates_history_variable_type), pointer :: hvar + integer :: ub1, lb1, ub2, lb2 ! Bounds for allocating the var integer :: ityp - - if( check_hlm_list(trim(hlms),trim(cp_hlm_name)) ) then - + + logical :: write_var + + write_var = check_hlm_list(trim(hlms), trim(cp_hlm_name)) + if( write_var ) then ivar = ivar+1 index = ivar - if(trim(callstep).eq.'initialize')then - - hvar => this%hvars(ivar) - hvar%vname = vname - hvar%units = units - hvar%long = long - hvar%use_default = use_default - hvar%vtype = vtype - hvar%avgflag = avgflag - hvar%flushval = flushval - hvar%upfreq = upfreq - ityp=this%iotype_index(trim(vtype)) - hvar%iovar_dk_ptr => this%iovar_dk(ityp) - this%iovar_dk(ityp)%active = .true. - - nullify(hvar%r81d) - nullify(hvar%r82d) - nullify(hvar%r83d) - nullify(hvar%int1d) - nullify(hvar%int2d) - nullify(hvar%int3d) - - call this%get_hvar_bounds(hvar,0,lb1,ub1,lb2,ub2) - - ! currently, all array spaces are flushed each time - ! the update is called. The flush here on the initialization - ! may be redundant, but will prevent issues in the future - ! if we have host models where not all threads are updating - ! the HIO array spaces. (RGK:09-2016) - - select case(trim(vtype)) - case('PA_R8') - allocate(hvar%r81d(lb1:ub1));hvar%r81d(:)=flushval - case('SI_R8') - allocate(hvar%r81d(lb1:ub1));hvar%r81d(:)=flushval - case('PA_GRND_R8') - allocate(hvar%r82d(lb1:ub1,lb2:ub2));hvar%r82d(:,:)=flushval - case('PA_SCPF_R8') - allocate(hvar%r82d(lb1:ub1,lb2:ub2));hvar%r82d(:,:)=flushval - case('SI_GRND_R8') - allocate(hvar%r82d(lb1:ub1,lb2:ub2));hvar%r82d(:,:)=flushval - case('SI_SCPF_R8') - allocate(hvar%r82d(lb1:ub1,lb2:ub2));hvar%r82d(:,:)=flushval - case default - write(fates_log(),*) 'Incompatible vtype passed to set_history_var' - write(fates_log(),*) 'vtype = ',trim(vtype),' ?' - stop - ! end_run - end select - + if (trim(callstep) .eq. 'initialize') then + call this%hvars(ivar)%Init(vname, units, long, use_default, & + vtype, avgflag, flushval, upfreq, n_iovar_dk, this%iovar_dk) end if else - index = 0 end if return end subroutine set_history_var - ! ===================================================================================== - - subroutine get_hvar_bounds(this,hvar,thread,lb1,ub1,lb2,ub2) - - class(fates_hio_interface_type) :: this - type(iovar_def_type),target,intent(in) :: hvar - integer,intent(in) :: thread - integer,intent(out) :: lb1 - integer,intent(out) :: ub1 - integer,intent(out) :: lb2 - integer,intent(out) :: ub2 - - ! local - integer :: ndims - - lb1 = 0 - ub1 = 0 - lb2 = 0 - ub2 = 0 - - ndims = hvar%iovar_dk_ptr%ndims - - ! The thread = 0 case is the boundaries for the whole proc/node - if (thread==0) then - lb1 = hvar%iovar_dk_ptr%dim1_ptr%lower_bound - ub1 = hvar%iovar_dk_ptr%dim1_ptr%upper_bound - if(ndims>1)then - lb2 = hvar%iovar_dk_ptr%dim2_ptr%lower_bound - ub2 = hvar%iovar_dk_ptr%dim2_ptr%upper_bound - end if - else - lb1 = hvar%iovar_dk_ptr%dim1_ptr%clump_lower_bound(thread) - ub1 = hvar%iovar_dk_ptr%dim1_ptr%clump_upper_bound(thread) - if(ndims>1)then - lb2 = hvar%iovar_dk_ptr%dim2_ptr%clump_lower_bound(thread) - ub2 = hvar%iovar_dk_ptr%dim2_ptr%clump_upper_bound(thread) - end if - end if - - return - end subroutine get_hvar_bounds - - ! ==================================================================================== subroutine init_iovar_dk_maps(this) @@ -1406,6 +1269,10 @@ end subroutine init_iovar_dk_maps ! =================================================================================== subroutine set_dim_ptrs(this,dk_name,idim,dim_target) + + use FatesHistoryVariableType, only : iotype_index + + implicit none ! arguments class(fates_hio_interface_type) :: this @@ -1417,7 +1284,7 @@ subroutine set_dim_ptrs(this,dk_name,idim,dim_target) ! local integer :: ityp - ityp = this%iotype_index(trim(dk_name)) + ityp = iotype_index(trim(dk_name), n_iovar_dk, this%iovar_dk) ! First check to see if the dimension is allocated if(this%iovar_dk(ityp)%ndims Date: Fri, 14 Oct 2016 17:12:57 -0600 Subject: [PATCH 04/13] clm-fates interface cleanup Replace some hard coded strings with string parameters. Split a thread loop into two parts so allocation and assignment of data can be grouped together. Test: ERS_D_Ld5.f10_f10.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: 44aac42 Test status: pass --- .../clm/src/utils/clmfates_interfaceMod.F90 | 68 +++++++++++-------- 1 file changed, 39 insertions(+), 29 deletions(-) diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 437eaac36a..f60161c802 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -82,10 +82,7 @@ module CLMFatesInterfaceMod allocate_bcin, & allocate_bcout - use FatesHistoryDimensionMod, only : fates_history_dimension_type - use HistoryIOMod, only : fates_bounds_type - - use HistoryIOMod , only : fates_hio_interface_type + use HistoryIOMod, only : fates_hio_interface_type use ChecksBalancesMod , only : SummarizeNetFluxes, FATES_BGC_Carbon_BalanceCheck use EDTypesMod , only : udata @@ -1415,6 +1412,11 @@ subroutine init_history_io(this,bounds_proc) use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp + use HistoryIOMod, only : fates_bounds_type + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & + site_r8, site_ground_r8, site_class_pft_r8 + + ! Arguments class(hlm_fates_interface_type), intent(inout) :: this type(bounds_type),intent(in) :: bounds_proc ! Currently "proc" @@ -1464,10 +1466,6 @@ subroutine init_history_io(this,bounds_proc) call this%fates_hio%Init(nclumps, fates_bounds) - ! Allocate the mapping between FATES indices and the IO indices - allocate(this%fates_hio%iovar_map(nclumps)) - - ! Define the bounds on the first dimension for each thread !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,fates_clump,s,c,num_sites) do nc = 1,nclumps @@ -1477,11 +1475,22 @@ subroutine init_history_io(this,bounds_proc) ! thread bounds for patch call hlm_bounds_to_fates_bounds(bounds_clump, fates_clump) call this%fates_hio%SetThreadBounds(nc, fates_clump) + end do + !$OMP END PARALLEL DO - ! ------------------------------------------------------------------------------------ - ! PART I.5: SET SOME INDEX MAPPINGS SPECIFICALLY FOR SITE<->COLUMN AND PATCH - ! ------------------------------------------------------------------------------------ + ! ------------------------------------------------------------------------------------ + ! PART I.5: SET SOME INDEX MAPPINGS SPECIFICALLY FOR SITE<->COLUMN AND PATCH + ! ------------------------------------------------------------------------------------ + + ! Allocate the mapping between FATES indices and the IO indices + allocate(this%fates_hio%iovar_map(nclumps)) + + !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,fates_clump,s,c,num_sites) + do nc = 1,nclumps + + call get_clump_bounds(nc, bounds_clump) + allocate(this%fates_hio%iovar_map(nc)%site_index(this%fates(nc)%nsites)) allocate(this%fates_hio%iovar_map(nc)%patch1_index(this%fates(nc)%nsites)) @@ -1501,21 +1510,21 @@ subroutine init_history_io(this,bounds_proc) call this%fates_hio%init_iovar_dk_maps() - call this%fates_hio%set_dim_ptrs(dk_name='PA_R8',idim=1,dim_target=this%fates_hio%iopa_dim) + call this%fates_hio%set_dim_ptrs(dk_name=patch_r8,idim=1, dim_target=this%fates_hio%iopa_dim) - call this%fates_hio%set_dim_ptrs(dk_name='SI_R8',idim=1,dim_target=this%fates_hio%iosi_dim) + call this%fates_hio%set_dim_ptrs(dk_name=site_r8, idim=1, dim_target=this%fates_hio%iosi_dim) - call this%fates_hio%set_dim_ptrs(dk_name='PA_GRND_R8',idim=1,dim_target=this%fates_hio%iopa_dim) - call this%fates_hio%set_dim_ptrs(dk_name='PA_GRND_R8',idim=2,dim_target=this%fates_hio%iogrnd_dim) + call this%fates_hio%set_dim_ptrs(dk_name=patch_ground_r8, idim=1, dim_target=this%fates_hio%iopa_dim) + call this%fates_hio%set_dim_ptrs(dk_name=patch_ground_r8, idim=2, dim_target=this%fates_hio%iogrnd_dim) - call this%fates_hio%set_dim_ptrs(dk_name='SI_GRND_R8',idim=1,dim_target=this%fates_hio%iosi_dim) - call this%fates_hio%set_dim_ptrs(dk_name='SI_GRND_R8',idim=2,dim_target=this%fates_hio%iogrnd_dim) + call this%fates_hio%set_dim_ptrs(dk_name=site_ground_r8, idim=1, dim_target=this%fates_hio%iosi_dim) + call this%fates_hio%set_dim_ptrs(dk_name=site_ground_r8, idim=2, dim_target=this%fates_hio%iogrnd_dim) - call this%fates_hio%set_dim_ptrs(dk_name='PA_SCPF_R8',idim=1,dim_target=this%fates_hio%iopa_dim) - call this%fates_hio%set_dim_ptrs(dk_name='PA_SCPF_R8',idim=2,dim_target=this%fates_hio%ioscpf_dim) + call this%fates_hio%set_dim_ptrs(dk_name=patch_class_pft_r8, idim=1, dim_target=this%fates_hio%iopa_dim) + call this%fates_hio%set_dim_ptrs(dk_name=patch_class_pft_r8, idim=2, dim_target=this%fates_hio%ioscpf_dim) - call this%fates_hio%set_dim_ptrs(dk_name='SI_SCPF_R8',idim=1,dim_target=this%fates_hio%iosi_dim) - call this%fates_hio%set_dim_ptrs(dk_name='SI_SCPF_R8',idim=2,dim_target=this%fates_hio%ioscpf_dim) + call this%fates_hio%set_dim_ptrs(dk_name=site_class_pft_r8, idim=1, dim_target=this%fates_hio%iosi_dim) + call this%fates_hio%set_dim_ptrs(dk_name=site_class_pft_r8, idim=2, dim_target=this%fates_hio%ioscpf_dim) ! ------------------------------------------------------------------------------------ @@ -1547,21 +1556,21 @@ subroutine init_history_io(this,bounds_proc) select case(trim(ioname)) - case('PA_R8') + case(patch_r8) call hist_addfld1d(fname=trim(vname),units=trim(vunits), & avgflag=trim(vavgflag),long_name=trim(vlong), & ptr_patch=this%fates_hio%hvars(ivar)%r81d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case('SI_R8') + case(site_r8) call hist_addfld1d(fname=trim(vname),units=trim(vunits), & avgflag=trim(vavgflag),long_name=trim(vlong), & ptr_col=this%fates_hio%hvars(ivar)%r81d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case('PA_GRND_R8') + case(patch_ground_r8) dim2name = this%fates_hio%hvars(ivar)%iovar_dk_ptr%dim2_ptr%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & ! <--- addfld2d type2d=trim(dim2name), & ! <--- type2d @@ -1570,7 +1579,7 @@ subroutine init_history_io(this,bounds_proc) default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case('PA_SCPF_R8') + case(patch_class_pft_r8) dim2name = this%fates_hio%hvars(ivar)%iovar_dk_ptr%dim2_ptr%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & type2d=trim(dim2name), & @@ -1578,7 +1587,7 @@ subroutine init_history_io(this,bounds_proc) ptr_patch=this%fates_hio%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case('SI_GRND_R8') + case(site_ground_r8) dim2name = this%fates_hio%hvars(ivar)%iovar_dk_ptr%dim2_ptr%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & type2d=trim(dim2name), & @@ -1586,7 +1595,7 @@ subroutine init_history_io(this,bounds_proc) ptr_col=this%fates_hio%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case('SI_SCPF_R8') + case(site_class_pft_r8) dim2name = this%fates_hio%hvars(ivar)%iovar_dk_ptr%dim2_ptr%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & type2d=trim(dim2name), & @@ -1608,8 +1617,9 @@ end subroutine init_history_io subroutine hlm_bounds_to_fates_bounds(hlm, fates) - use EDtypesMod , only : nlevsclass_ed - use clm_varpar , only : mxpft, nlevgrnd + use HistoryIOMod, only : fates_bounds_type + use EDtypesMod, only : nlevsclass_ed + use clm_varpar, only : mxpft, nlevgrnd implicit none From d9fa2501db19abbb5a3ce681ccc311c178155c36 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Wed, 19 Oct 2016 17:02:40 -0600 Subject: [PATCH 05/13] Remove the pointers to fates history dims Remove the pointers to the fates_history_dimensions stored in the iovar_dimension kind types. Replace them with integer indicies. indicies point into an array of dimension types. The indices - name mapping and dim array is stored in the top level fates history io object passed into subroutines as read only data as needed. Test: ERS_D_Ld5.f10_f10.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: 44aac42 Test status: pass Test suite: ed - yellowstone gnu, intel, pgi Test baseline: 44aac42 Test status: all tests pass --- .../src/ED/main/FatesHistoryDimensionMod.F90 | 21 + .../src/ED/main/FatesHistoryVarKindMod.F90 | 28 +- .../src/ED/main/FatesHistoryVariableType.F90 | 78 +- components/clm/src/ED/main/HistoryIOMod.F90 | 871 ++++++++++-------- .../clm/src/utils/clmfates_interfaceMod.F90 | 51 +- 5 files changed, 593 insertions(+), 456 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 b/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 index da1598fd53..143048eee0 100644 --- a/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 @@ -13,6 +13,27 @@ module FatesHistoryDimensionMod character(*), parameter :: site_class_pft_r8 = 'SI_SCPF_R8' character(*), parameter :: patch_int = 'PA_INT' + integer, parameter :: fates_num_dimension_types = 4 + character(*), parameter :: patch = 'patch' + character(*), parameter :: column = 'column' + character(*), parameter :: levgrnd = 'levgrnd' + character(*), parameter :: levscpf = 'levscpf' + + ! patch = This is a structure that records where FATES patch boundaries + ! on each thread point to in the host IO array, this structure + ! is allocated by number of threads + + ! column = This is a structure that records where FATES column boundaries + ! on each thread point to in the host IO array, this structure + ! is allocated by number of threads + + ! ground = This is a structure that records the boundaries for the + ! ground level (includes rock) dimension + + ! levscpf = This is a structure that records the boundaries for the + ! number of size-class x pft dimension + + ! This structure is not allocated by thread, but the upper and lower boundaries ! of the dimension for each thread is saved in the clump_ entry type fates_history_dimension_type diff --git a/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 b/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 index 869f16a186..22ed6c283b 100644 --- a/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 @@ -15,13 +15,15 @@ module FatesHistoryVariableKindMod character(len=fates_long_string_length) :: name ! String labelling this IO type integer :: ndims ! number of dimensions in this IO type integer, allocatable :: dimsize(:) ! The size of each dimension - logical :: active - type(fates_history_dimension_type), pointer :: dim1_ptr - type(fates_history_dimension_type), pointer :: dim2_ptr + logical, private :: active_ + integer :: dim1_index + integer :: dim2_index contains procedure, public :: Init => InitVariableKind + procedure, public :: set_active + procedure, public :: is_active end type fates_history_variable_kind_type @@ -44,12 +46,24 @@ subroutine InitVariableKind(this, name, num_dims) this%ndims = num_dims allocate(this%dimsize(this%ndims)) this%dimsize(:) = fates_unset_int - this%active = .false. - nullify(this%dim1_ptr) - nullify(this%dim2_ptr) + this%active_ = .false. + this%dim1_index = fates_unset_int + this%dim2_index = fates_unset_int end subroutine InitVariableKind - + ! ======================================================================= + subroutine set_active(this) + implicit none + class(fates_history_variable_kind_type), intent(inout) :: this + this%active_ = .true. + end subroutine set_active + + logical function is_active(this) + implicit none + class(fates_history_variable_kind_type), intent(in) :: this + is_active = this%active_ + end function is_active + end module FatesHistoryVariableKindMod diff --git a/components/clm/src/ED/main/FatesHistoryVariableType.F90 b/components/clm/src/ED/main/FatesHistoryVariableType.F90 index 1e15751f9f..54558a5420 100644 --- a/components/clm/src/ED/main/FatesHistoryVariableType.F90 +++ b/components/clm/src/ED/main/FatesHistoryVariableType.F90 @@ -22,7 +22,7 @@ module FatesHistoryVariableType ! 1 = dynamics "dyn" (daily) ! 2 = production "prod" (prob model tstep) real(r8) :: flushval - type(fates_history_variable_kind_type),pointer :: iovar_dk_ptr + integer :: dim_kinds_index ! Pointers (only one of these is allocated per variable) real(r8), pointer :: r81d(:) real(r8), pointer :: r82d(:,:) @@ -32,15 +32,16 @@ module FatesHistoryVariableType integer, pointer :: int3d(:,:,:) contains procedure, public :: Init => InitHistoryVariableType - procedure, public :: Flush => FlushVar + procedure, public :: Flush procedure, private :: GetBounds end type fates_history_variable_type contains subroutine InitHistoryVariableType(this, vname, units, long, use_default, & - vtype, avgflag, flushval, upfreq, n_iovar_dk, iovar_dk) + vtype, avgflag, flushval, upfreq, n_dim_kinds, dim_kinds, dim_bounds) + use FatesHistoryDimensionMod, only : fates_history_dimension_type use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & site_r8, site_ground_r8, site_class_pft_r8 @@ -55,10 +56,11 @@ subroutine InitHistoryVariableType(this, vname, units, long, use_default, & character(len=*), intent(in) :: avgflag real(r8), intent(in) :: flushval ! If the type is an int we will round with nint integer, intent(in) :: upfreq - integer, intent(in) :: n_iovar_dk - type(fates_history_variable_kind_type), intent(in), target :: iovar_dk(:) + integer, intent(in) :: n_dim_kinds + type(fates_history_dimension_type), intent(in) :: dim_bounds(:) + type(fates_history_variable_kind_type), intent(inout) :: dim_kinds(:) - integer :: ityp + integer :: dk_index integer :: lb1, ub1, lb2, ub2 this%vname = vname @@ -77,11 +79,11 @@ subroutine InitHistoryVariableType(this, vname, units, long, use_default, & nullify(this%int2d) nullify(this%int3d) - ityp = iotype_index(trim(vtype), n_iovar_dk, iovar_dk) - this%iovar_dk_ptr => iovar_dk(ityp) - this%iovar_dk_ptr%active = .true. + dk_index = iotype_index(trim(vtype), n_dim_kinds, dim_kinds) + this%dim_kinds_index = dk_index + call dim_kinds(dk_index)%set_active() - call this%GetBounds(0, lb1, ub1, lb2, ub2) + call this%GetBounds(0, dim_bounds, dim_kinds, lb1, ub1, lb2, ub2) ! NOTE(rgk, 2016-09) currently, all array spaces are flushed each ! time the update is called. The flush here on the initialization @@ -125,12 +127,16 @@ end subroutine InitHistoryVariableType ! ===================================================================================== - subroutine GetBounds(this, thread, lb1, ub1, lb2, ub2) + subroutine GetBounds(this, thread, dim_bounds, dim_kinds, lb1, ub1, lb2, ub2) - class(fates_history_variable_type), intent(inout) :: this + use FatesHistoryDimensionMod, only : fates_history_dimension_type - integer, intent(in) :: thread + implicit none + class(fates_history_variable_type), intent(inout) :: this + integer, intent(in) :: thread + class(fates_history_dimension_type), intent(in) :: dim_bounds(:) + type(fates_history_variable_kind_type), intent(in) :: dim_kinds(:) integer, intent(out) :: lb1 integer, intent(out) :: ub1 integer, intent(out) :: lb2 @@ -138,35 +144,41 @@ subroutine GetBounds(this, thread, lb1, ub1, lb2, ub2) ! local integer :: ndims + integer :: d_index lb1 = 0 ub1 = 0 lb2 = 0 ub2 = 0 - ndims = this%iovar_dk_ptr%ndims + ndims = dim_kinds(this%dim_kinds_index)%ndims ! The thread = 0 case is the boundaries for the whole proc/node if (thread==0) then - lb1 = this%iovar_dk_ptr%dim1_ptr%lower_bound - ub1 = this%iovar_dk_ptr%dim1_ptr%upper_bound + d_index = dim_kinds(this%dim_kinds_index)%dim1_index + lb1 = dim_bounds(d_index)%lower_bound + ub1 = dim_bounds(d_index)%upper_bound if(ndims>1)then - lb2 = this%iovar_dk_ptr%dim2_ptr%lower_bound - ub2 = this%iovar_dk_ptr%dim2_ptr%upper_bound + d_index = dim_kinds(this%dim_kinds_index)%dim2_index + lb2 = dim_bounds(d_index)%lower_bound + ub2 = dim_bounds(d_index)%upper_bound end if else - lb1 = this%iovar_dk_ptr%dim1_ptr%clump_lower_bound(thread) - ub1 = this%iovar_dk_ptr%dim1_ptr%clump_upper_bound(thread) + d_index = dim_kinds(this%dim_kinds_index)%dim1_index + lb1 = dim_bounds(d_index)%clump_lower_bound(thread) + ub1 = dim_bounds(d_index)%clump_upper_bound(thread) if(ndims>1)then - lb2 = this%iovar_dk_ptr%dim2_ptr%clump_lower_bound(thread) - ub2 = this%iovar_dk_ptr%dim2_ptr%clump_upper_bound(thread) + d_index = dim_kinds(this%dim_kinds_index)%dim2_index + lb2 = dim_bounds(d_index)%clump_lower_bound(thread) + ub2 = dim_bounds(d_index)%clump_upper_bound(thread) end if end if end subroutine GetBounds - subroutine FlushVar(this, thread) + subroutine Flush(this, thread, dim_bounds, dim_kinds) + use FatesHistoryDimensionMod, only : fates_history_dimension_type use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & site_r8, site_ground_r8, site_class_pft_r8, patch_int @@ -174,12 +186,14 @@ subroutine FlushVar(this, thread) class(fates_history_variable_type), intent(inout) :: this integer, intent(in) :: thread + type(fates_history_dimension_type), intent(in) :: dim_bounds(:) + type(fates_history_variable_kind_type), intent(in) :: dim_kinds(:) integer :: lb1, ub1, lb2, ub2 - call this%GetBounds(thread, lb1, ub1, lb2, ub2) + call this%GetBounds(thread, dim_bounds, dim_kinds, lb1, ub1, lb2, ub2) - select case(trim(this%iovar_dk_ptr%name)) + select case(trim(dim_kinds(this%dim_kinds_index)%name)) case(patch_r8) this%r81d(lb1:ub1) = this%flushval case(site_r8) @@ -200,22 +214,22 @@ subroutine FlushVar(this, thread) !end_run end select - end subroutine FlushVar + end subroutine Flush ! ==================================================================================== - function iotype_index(iotype_name, n_iovar_dk, iovar_dk) result(ityp) + function iotype_index(iotype_name, n_dim_kinds, dim_kinds) result(dk_index) ! argument character(len=*), intent(in) :: iotype_name - integer, intent(in) :: n_iovar_dk - type(fates_history_variable_kind_type), intent(in) :: iovar_dk(:) + integer, intent(in) :: n_dim_kinds + type(fates_history_variable_kind_type), intent(in) :: dim_kinds(:) ! local - integer :: ityp + integer :: dk_index - do ityp=1, n_iovar_dk - if(trim(iotype_name).eq.trim(iovar_dk(ityp)%name))then + do dk_index=1, n_dim_kinds + if (trim(iotype_name) .eq. trim(dim_kinds(dk_index)%name)) then return end if end do diff --git a/components/clm/src/ED/main/HistoryIOMod.F90 b/components/clm/src/ED/main/HistoryIOMod.F90 index cc1547a171..aed6e5312b 100644 --- a/components/clm/src/ED/main/HistoryIOMod.F90 +++ b/components/clm/src/ED/main/HistoryIOMod.F90 @@ -5,7 +5,7 @@ Module HistoryIOMod use FatesConstantsMod, only : fates_avg_flag_length, fates_short_string_length, fates_long_string_length use FatesGlobals , only : fates_log - use FatesHistoryDimensionMod, only : fates_history_dimension_type + use FatesHistoryDimensionMod, only : fates_history_dimension_type, fates_num_dimension_types use FatesHistoryVariableKindMod, only : fates_history_variable_kind_type use FatesHistoryVariableType, only : fates_history_variable_type @@ -129,7 +129,7 @@ Module HistoryIOMod ! The number of variable dim/kind types we have defined (static) - integer, parameter :: n_iovar_dk = 6 + integer, parameter :: n_dim_kinds = 6 type, public :: fates_bounds_type integer :: patch_begin @@ -162,29 +162,17 @@ Module HistoryIOMod ! Instanteat one registry of the different dimension/kinds (dk) ! All output variables will have a pointer to one of these dk's - type(fates_history_variable_kind_type), pointer :: iovar_dk(:) + type(fates_history_variable_kind_type) :: dim_kinds(n_dim_kinds) ! This is a structure that explains where FATES patch boundaries - ! on each thread point to in the host IO array, this structure - ! is allocated by number of threads - type(fates_history_dimension_type) :: iopa_dim + ! on each thread point to in the host IO array, this structure is + ! allocated by number of threads. This could be dynamically + ! allocated, but is unlikely to change...? + type(fates_history_dimension_type) :: dim_bounds(fates_num_dimension_types) - ! This is a structure that explains where FATES patch boundaries - ! on each thread point to in the host IO array, this structure - ! is allocated by number of threads - type(fates_history_dimension_type) :: iosi_dim - - ! This is a structure that contains the boundaries for the - ! ground level (includes rock) dimension - type(fates_history_dimension_type) :: iogrnd_dim - - ! This is a structure that contains the boundaries for the - ! number of size-class x pft dimension - type(fates_history_dimension_type) :: ioscpf_dim - - type(iovar_map_type), pointer :: iovar_map(:) - + + integer, private :: patch_index_, column_index_, levgrnd_index_, levscpf_index_ contains procedure, public :: Init => InitFatesHistoryOutput @@ -195,9 +183,17 @@ Module HistoryIOMod procedure, public :: update_history_cbal procedure, public :: define_history_vars procedure, public :: set_history_var - procedure, public :: init_iovar_dk_maps - procedure, public :: set_dim_ptrs + procedure, public :: init_dim_kinds_maps + procedure, public :: set_dim_indicies procedure, private :: flush_hvars + procedure, public :: patch_index + procedure, public :: column_index + procedure, public :: levgrnd_index + procedure, public :: levscpf_index + procedure, private :: set_patch_index + procedure, private :: set_column_index + procedure, private :: set_levgrnd_index + procedure, private :: set_levscpf_index end type fates_hio_interface_type @@ -209,17 +205,37 @@ Module HistoryIOMod subroutine InitFatesHistoryOutput(this, num_threads, fates_bounds) + use FatesHistoryDimensionMod, only : patch, column, levgrnd, levscpf + implicit none class(fates_hio_interface_type), intent(inout) :: this integer, intent(in) :: num_threads type(fates_bounds_type), intent(in) :: fates_bounds - - call this%iopa_dim%Init('patch', num_threads, fates_bounds%patch_begin, fates_bounds%patch_end) - call this%iosi_dim%Init('column', num_threads, fates_bounds%column_begin, fates_bounds%column_end) - call this%iogrnd_dim%Init('levgrnd', num_threads, fates_bounds%ground_begin, fates_bounds%ground_end) - call this%ioscpf_dim%Init('levscpf', num_threads, fates_bounds%pft_class_begin, fates_bounds%pft_class_end) - + + integer :: dim_count = 0 + + dim_count = dim_count + 1 + call this%set_patch_index(dim_count) + call this%dim_bounds(dim_count)%Init(patch, num_threads, & + fates_bounds%patch_begin, fates_bounds%patch_end) + + dim_count = dim_count + 1 + call this%set_column_index(dim_count) + call this%dim_bounds(dim_count)%Init(column, num_threads, & + fates_bounds%column_begin, fates_bounds%column_end) + + dim_count = dim_count + 1 + call this%set_levgrnd_index(dim_count) + call this%dim_bounds(dim_count)%Init(levgrnd, num_threads, & + fates_bounds%ground_begin, fates_bounds%ground_end) + + 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) + ! FIXME(bja, 2016-10) assert(dim_count == FatesHistorydimensionmod::num_dimension_types) + ! Allocate the mapping between FATES indices and the IO indices allocate(this%iovar_map(num_threads)) @@ -234,22 +250,253 @@ subroutine SetHistoryThreadBounds(this, thread_index, thread_bounds) integer, intent(in) :: thread_index type(fates_bounds_type), intent(in) :: thread_bounds + + integer :: index - call this%iopa_dim%SetThreadBounds(thread_index, & + index = this%patch_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%patch_begin, thread_bounds%patch_end) - call this%iosi_dim%SetThreadBounds(thread_index, & + index = this%column_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%column_begin, thread_bounds%column_end) - call this%iogrnd_dim%SetThreadBounds(thread_index, & + index = this%levgrnd_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%ground_begin, thread_bounds%ground_end) - call this%ioscpf_dim%SetThreadBounds(thread_index, & + index = this%levscpf_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%pft_class_begin, thread_bounds%pft_class_end) end subroutine SetHistoryThreadBounds - ! ======================================================================= + ! =================================================================================== + + subroutine set_dim_indicies(this, dk_name, idim, dim_index) + + use FatesHistoryVariableType, only : iotype_index + + implicit none + + ! arguments + class(fates_hio_interface_type), intent(inout) :: this + character(len=*), intent(in) :: dk_name + integer, intent(in) :: idim ! dimension index + integer, intent(in) :: dim_index + + + ! local + integer :: ityp + + ityp = iotype_index(trim(dk_name), n_dim_kinds, this%dim_kinds) + + ! First check to see if the dimension is allocated + if (this%dim_kinds(ityp)%ndims < idim) then + write(fates_log(), *) 'Trying to define dimension size to a dim-type structure' + write(fates_log(), *) 'but the dimension index does not exist' + write(fates_log(), *) 'type: ',dk_name,' ndims: ',this%dim_kinds(ityp)%ndims,' input dim:',idim + stop + !end_run + end if + + if (idim == 1) then + this%dim_kinds(ityp)%dim1_index = dim_index + else if (idim == 2) then + this%dim_kinds(ityp)%dim2_index = dim_index + end if + + ! With the map, we can set the dimension size + this%dim_kinds(ityp)%dimsize(idim) = this%dim_bounds(dim_index)%upper_bound - & + this%dim_bounds(dim_index)%lower_bound + 1 + + end subroutine set_dim_indicies + + ! ======================================================================= + subroutine set_patch_index(this, index) + implicit none + class(fates_hio_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%patch_index_ = index + end subroutine set_patch_index + + integer function patch_index(this) + implicit none + class(fates_hio_interface_type), intent(in) :: this + patch_index = this%patch_index_ + end function patch_index + + ! ======================================================================= + subroutine set_column_index(this, index) + implicit none + class(fates_hio_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%column_index_ = index + end subroutine set_column_index + + integer function column_index(this) + implicit none + class(fates_hio_interface_type), intent(in) :: this + column_index = this%column_index_ + end function column_index + + ! ======================================================================= + subroutine set_levgrnd_index(this, index) + implicit none + class(fates_hio_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levgrnd_index_ = index + end subroutine set_levgrnd_index + + integer function levgrnd_index(this) + implicit none + class(fates_hio_interface_type), intent(in) :: this + levgrnd_index = this%levgrnd_index_ + end function levgrnd_index + + ! ======================================================================= + subroutine set_levscpf_index(this, index) + implicit none + class(fates_hio_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levscpf_index_ = index + end subroutine set_levscpf_index + + integer function levscpf_index(this) + implicit none + class(fates_hio_interface_type), intent(in) :: this + levscpf_index = this%levscpf_index_ + end function levscpf_index + + ! ====================================================================================== + + subroutine flush_hvars(this,nc,upfreq_in) + + class(fates_hio_interface_type) :: this + integer,intent(in) :: nc + integer,intent(in) :: upfreq_in + + integer :: ivar + type(fates_history_variable_type),pointer :: hvar + integer :: lb1,ub1,lb2,ub2 + + do ivar=1,ubound(this%hvars,1) + hvar => this%hvars(ivar) + if (hvar%upfreq == upfreq_in) then ! Only flush variables with update on dynamics step + call hvar%Flush(nc, this%dim_bounds, this%dim_kinds) + end if + end do + + end subroutine flush_hvars + + + ! ===================================================================================== + + subroutine set_history_var(this, vname, units, long, use_default, avgflag, vtype, & + hlms, flushval, upfreq, ivar, callstep, index) + + use FatesUtilsMod, only : check_hlm_list + use EDTypesMod, only : cp_hlm_name + + implicit none + + ! arguments + class(fates_hio_interface_type), intent(inout) :: this + character(len=*), intent(in) :: vname + character(len=*), intent(in) :: units + character(len=*), intent(in) :: long + character(len=*), intent(in) :: use_default + character(len=*), intent(in) :: avgflag + character(len=*), intent(in) :: vtype + character(len=*), intent(in) :: hlms + real(r8), intent(in) :: flushval ! IF THE TYPE IS AN INT WE WILL round with NINT + integer, intent(in) :: upfreq + character(len=*), intent(in) :: callstep + integer, intent(inout) :: ivar + integer, intent(inout) :: index ! This is the index for the variable of + ! interest that is associated with an + ! explict name (for fast reference during update) + ! A zero is passed back when the variable is + ! not used + + ! locals + type(fates_history_variable_type), pointer :: hvar + integer :: ub1, lb1, ub2, lb2 ! Bounds for allocating the var + integer :: ityp + + logical :: write_var + + write_var = check_hlm_list(trim(hlms), trim(cp_hlm_name)) + if( write_var ) then + ivar = ivar+1 + index = ivar + + if (trim(callstep) .eq. 'initialize') then + call this%hvars(ivar)%Init(vname, units, long, use_default, & + vtype, avgflag, flushval, upfreq, n_dim_kinds, this%dim_kinds, & + this%dim_bounds) + end if + else + index = 0 + end if + + return + end subroutine set_history_var + + ! ==================================================================================== + + subroutine init_dim_kinds_maps(this) + + ! ---------------------------------------------------------------------------------- + ! This subroutine simply initializes the structures that define the different + ! array and type formats for different IO variables + ! + ! PA_R8 : 1D patch scale 8-byte reals + ! SI_R8 : 1D site scale 8-byte reals + ! + ! The allocation on the structures is not dynamic and should only add up to the + ! number of entries listed here. + ! + ! ---------------------------------------------------------------------------------- + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & + site_r8, site_ground_r8, site_class_pft_r8 + + implicit none + + ! Arguments + class(fates_hio_interface_type), intent(inout) :: this + + + integer :: index + + ! 1d Patch + index = 1 + call this%dim_kinds(index)%Init(patch_r8, 1) + + ! 1d Site + index = index + 1 + call this%dim_kinds(index)%Init(site_r8, 1) + + ! patch x ground + index = index + 1 + call this%dim_kinds(index)%Init(patch_ground_r8, 2) + + ! patch x size-class/pft + index = index + 1 + call this%dim_kinds(index)%Init(patch_class_pft_r8, 2) + + ! site x ground + index = index + 1 + call this%dim_kinds(index)%Init(site_ground_r8, 2) + + ! site x size-class/pft + index = index + 1 + call this%dim_kinds(index)%Init(site_class_pft_r8, 2) + + ! FIXME(bja, 2016-10) assert(index == n_dim_kinds) + end subroutine init_dim_kinds_maps + + ! ======================================================================= subroutine update_history_cbal(this,nc,nsites,sites) use EDtypesMod , only : ed_site_type @@ -730,28 +977,7 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) end subroutine update_history_prod - ! ====================================================================================== - - subroutine flush_hvars(this,nc,upfreq_in) - - class(fates_hio_interface_type) :: this - integer,intent(in) :: nc - integer,intent(in) :: upfreq_in - - integer :: ivar - type(fates_history_variable_type),pointer :: hvar - integer :: lb1,ub1,lb2,ub2 - - do ivar=1,ubound(this%hvars,1) - hvar => this%hvars(ivar) - if (hvar%upfreq == upfreq_in) then ! Only flush variables with update on dynamics step - call hvar%Flush(nc) - end if - end do - - end subroutine flush_hvars - - ! ==================================================================================== + ! ==================================================================================== subroutine define_history_vars(this,callstep,nvar) @@ -781,11 +1007,15 @@ subroutine define_history_vars(this,callstep,nvar) ! If your HLM makes use of, and you want, INTEGER OUTPUT, pass the flushval as ! a real. The applied flush value will use the NINT() intrinsic function ! --------------------------------------------------------------------------------- + + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & + site_r8, site_ground_r8, site_class_pft_r8 + implicit none - class(fates_hio_interface_type) :: this - character(len=*),intent(in) :: callstep ! are we 'count'ing or 'initializ'ing? - integer,optional,intent(out) :: nvar - integer :: ivar + class(fates_hio_interface_type), intent(inout) :: this + character(len=*), intent(in) :: callstep ! are we 'count'ing or 'initializ'ing? + integer, optional, intent(out) :: nvar + integer :: ivar if(.not. (trim(callstep).eq.'count' .or. trim(callstep).eq.'initialize') ) then write(fates_log(),*) 'defining history variables in FATES requires callstep count or initialize' @@ -795,361 +1025,361 @@ subroutine define_history_vars(this,callstep,nvar) ivar=0 ! Site level counting variables - call this%set_history_var(vname='ED_NPATCHES',units='none', & + call this%set_history_var(vname='ED_NPATCHES', units='none', & long='Total number of ED patches per site', use_default='active', & - avgflag='A',vtype='SI_R8',hlms='CLM:ALM',flushval=1.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_npatches_si) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=1.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_npatches_si) - call this%set_history_var(vname='ED_NCOHORTS',units='none', & + call this%set_history_var(vname='ED_NCOHORTS', units='none', & long='Total number of ED cohorts per site', use_default='active', & - avgflag='A',vtype='SI_R8',hlms='CLM:ALM',flushval=1.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_ncohorts_si) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=1.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_ncohorts_si) ! Patch variables - call this%set_history_var(vname='TRIMMING',units='none', & + call this%set_history_var(vname='TRIMMING', units='none', & long='Degree to which canopy expansion is limited by leaf economics', & use_default='active', & - avgflag='A',vtype='PA_R8',hlms='CLM:ALM',flushval=1.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_trimming_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=1.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_trimming_pa) - call this%set_history_var(vname='AREA_PLANT',units='m2', & + call this%set_history_var(vname='AREA_PLANT', units='m2', & long='area occupied by all plants', use_default='active', & - avgflag='A',vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_area_plant_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_area_plant_pa) - call this%set_history_var(vname='AREA_TREES',units='m2', & + call this%set_history_var(vname='AREA_TREES', units='m2', & long='area occupied by woody plants', use_default='active', & - avgflag='A',vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_area_treespread_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_area_treespread_pa) - call this%set_history_var(vname='CANOPY_SPREAD',units='0-1', & + call this%set_history_var(vname='CANOPY_SPREAD', units='0-1', & long='Scaling factor between tree basal area and canopy area', & use_default='active', & - avgflag='A',vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_canopy_spread_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_canopy_spread_pa) - call this%set_history_var(vname='PFTbiomass',units='gC/m2', & + call this%set_history_var(vname='PFTbiomass', units='gC/m2', & long='total PFT level biomass', use_default='active', & - avgflag='A', vtype='PA_GRND_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & + avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, callstep=callstep, index = ih_biomass_pa_pft ) call this%set_history_var(vname='PFTleafbiomass', units='gC/m2', & long='total PFT level leaf biomass', use_default='active', & - avgflag='A', vtype='PA_GRND_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & + avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, callstep=callstep, index = ih_leafbiomass_pa_pft ) call this%set_history_var(vname='PFTstorebiomass', units='gC/m2', & long='total PFT level stored biomass', use_default='active', & - avgflag='A', vtype='PA_GRND_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & + avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, callstep=callstep, index = ih_storebiomass_pa_pft ) call this%set_history_var(vname='PFTnindivs', units='indiv / m2', & long='total PFT level number of individuals', use_default='active', & - avgflag='A', vtype='PA_GRND_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & + avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, callstep=callstep, index = ih_nindivs_pa_pft ) ! Fire Variables call this%set_history_var(vname='FIRE_NESTEROV_INDEX', units='none', & long='nesterov_fire_danger index', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_nesterov_fire_danger_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_nesterov_fire_danger_pa) call this%set_history_var(vname='FIRE_ROS', units='m/min', & long='fire rate of spread m/min', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_spitfire_ROS_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_spitfire_ROS_pa) call this%set_history_var(vname='EFFECT_WSPEED', units='none', & long ='effective windspeed for fire spread', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_effect_wspeed_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_effect_wspeed_pa ) call this%set_history_var(vname='FIRE_TFC_ROS', units='none', & long ='total fuel consumed', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_TFC_ROS_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_TFC_ROS_pa ) call this%set_history_var(vname='FIRE_INTENSITY', units='kJ/m/s', & long='spitfire fire intensity: kJ/m/s', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_intensity_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_fire_intensity_pa ) call this%set_history_var(vname='FIRE_AREA', units='fraction', & long='spitfire fire area:m2', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_area_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_fire_area_pa ) call this%set_history_var(vname='SCORCH_HEIGHT', units='m', & long='spitfire fire area:m2', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_scorch_height_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_scorch_height_pa ) call this%set_history_var(vname='fire_fuel_mef', units='m', & long='spitfire fuel moisture', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_fuel_mef_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_fire_fuel_mef_pa ) call this%set_history_var(vname='fire_fuel_bulkd', units='m', & long='spitfire fuel bulk density', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_fuel_bulkd_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_fire_fuel_bulkd_pa ) call this%set_history_var(vname='FIRE_FUEL_EFF_MOIST', units='m', & long='spitfire fuel moisture', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_fuel_eff_moist_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_fire_fuel_eff_moist_pa ) call this%set_history_var(vname='fire_fuel_sav', units='m', & long='spitfire fuel surface/volume ', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_fuel_sav_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_fire_fuel_sav_pa ) call this%set_history_var(vname='SUM_FUEL', units='gC m-2', & long='total ground fuel related to ros (omits 1000hr fuels)', & use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_sum_fuel_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_sum_fuel_pa ) ! Litter Variables call this%set_history_var(vname='LITTER_IN', units='gC m-2 s-1', & long='Litter flux in leaves', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_litter_in_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_litter_in_pa ) call this%set_history_var(vname='LITTER_OUT', units='gC m-2 s-1', & long='Litter flux out leaves', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_litter_out_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_litter_out_pa ) call this%set_history_var(vname='SEED_BANK', units='gC m-2', & long='Total Seed Mass of all PFTs', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_seed_bank_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_seed_bank_si ) call this%set_history_var(vname='SEEDS_IN', units='gC m-2 s-1', & long='Seed Production Rate', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_seeds_in_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_seeds_in_pa ) call this%set_history_var(vname='SEED_GERMINATION', units='gC m-2 s-1', & long='Seed mass converted into new cohorts', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_seed_germination_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_seed_germination_pa ) call this%set_history_var(vname='SEED_DECAY', units='gC m-2 s-1', & long='Seed mass decay', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_seed_decay_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_seed_decay_pa ) call this%set_history_var(vname='ED_bstore', units='gC m-2', & long='Storage biomass', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_bstore_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_bstore_pa ) call this%set_history_var(vname='ED_bdead', units='gC m-2', & long='Dead (structural) biomass (live trees, not CWD)', & use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_bdead_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_bdead_pa ) call this%set_history_var(vname='ED_balive', units='gC m-2', & long='Live biomass', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_balive_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_balive_pa ) call this%set_history_var(vname='ED_bleaf', units='gC m-2', & long='Leaf biomass', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_bleaf_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_bleaf_pa ) call this%set_history_var(vname='ED_biomass', units='gC m-2', & long='Total biomass', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_btotal_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, callstep=callstep, index = ih_btotal_pa ) ! Ecosystem Carbon Fluxes (updated rapidly, upfreq=2) call this%set_history_var(vname='NPP_column', units='gC/m^2/s', & long='net primary production on the site', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_npp_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, callstep=callstep, index = ih_npp_si ) call this%set_history_var(vname='GPP', units='gC/m^2/s', & long='gross primary production', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_gpp_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, callstep=callstep, index = ih_gpp_pa ) call this%set_history_var(vname='NPP', units='gC/m^2/s', & long='net primary production', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_npp_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, callstep=callstep, index = ih_npp_pa ) call this%set_history_var(vname='AR', units='gC/m^2/s', & long='autotrophic respiration', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_aresp_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, callstep=callstep, index = ih_aresp_pa ) call this%set_history_var(vname='GROWTH_RESP', units='gC/m^2/s', & long='growth respiration', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_growth_resp_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, callstep=callstep, index = ih_growth_resp_pa ) call this%set_history_var(vname='MAINT_RESP', units='gC/m^2/s', & long='maintenance respiration', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_maint_resp_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, callstep=callstep, index = ih_maint_resp_pa ) ! Carbon Flux (grid dimension x scpf) (THESE ARE DEFAULT INACTIVE!!! ! (BECAUSE THEY TAKE UP SPACE!!! ! =================================================================================== - call this%set_history_var(vname='GPP_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='GPP_SCPF', units='kgC/m2/yr', & long='gross primary production', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_gpp_si_scpf ) + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, index = ih_gpp_si_scpf ) - call this%set_history_var(vname='NPP_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_SCPF', units='kgC/m2/yr', & long='total net primary production', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_totl_si_scpf ) + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, index = ih_npp_totl_si_scpf ) - call this%set_history_var(vname='NPP_LEAF_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_LEAF_SCPF', units='kgC/m2/yr', & long='NPP flux into leaves', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_leaf_si_scpf ) + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, index = ih_npp_leaf_si_scpf ) - call this%set_history_var(vname='NPP_SEED_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_SEED_SCPF', units='kgC/m2/yr', & long='NPP flux into seeds', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_seed_si_scpf ) + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, index = ih_npp_seed_si_scpf ) - call this%set_history_var(vname='NPP_FNRT_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_FNRT_SCPF', units='kgC/m2/yr', & long='NPP flux into fine roots', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_fnrt_si_scpf ) + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, index = ih_npp_fnrt_si_scpf ) - call this%set_history_var(vname='NPP_BGSW_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_BGSW_SCPF', units='kgC/m2/yr', & long='NPP flux into below-ground sapwood', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_bgsw_si_scpf ) + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, 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',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_bgdw_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', & + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, index = ih_npp_bgdw_si_scpf ) - call this%set_history_var(vname='NPP_AGSW_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_AGSW_SCPF', units='kgC/m2/yr', & long='NPP flux into above-ground sapwood', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_agsw_si_scpf ) + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, 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',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_agdw_si_scpf ) + long='NPP flux into above-ground deadwood', use_default='inactive', & + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, 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', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_stor_si_scpf ) + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, 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',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_ddbh_si_scpf ) + long='diameter growth increment and pft/size',use_default='inactive', & + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, index = ih_ddbh_si_scpf ) - call this%set_history_var(vname='BA_SCPF',units = 'm2/ha', & + 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='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_ba_si_scpf ) + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, index = ih_ba_si_scpf ) - call this%set_history_var(vname='NPLANT_SCPF',units = 'N/ha', & + call this%set_history_var(vname='NPLANT_SCPF', units = 'N/ha', & long='stem number density by patch and pft/size', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_nplant_si_scpf ) + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, 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',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_m1_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', & + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, 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',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_m2_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', & + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, 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', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_m3_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', & + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, 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',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_m4_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', & + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, 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',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_m5_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', & + avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, callstep=callstep, index = ih_m5_si_scpf ) ! CARBON BALANCE VARIABLES THAT DEPEND ON HLM BGC INPUTS call this%set_history_var(vname='NEP', units='gC/m^2/s', & long='net ecosystem production', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_nep_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, callstep=callstep, 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='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_fire_c_to_atm_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, callstep=callstep, 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='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_nbp_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, callstep=callstep, 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='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_totecosysc_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, callstep=callstep, 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='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_cbal_err_fates_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, callstep=callstep, 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='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_cbal_err_bgc_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, callstep=callstep, 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='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_cbal_err_tot_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, callstep=callstep, 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='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_biomass_stock_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, callstep=callstep, 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='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_litter_stock_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, callstep=callstep, 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='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_cwd_stock_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, callstep=callstep, index = ih_cwd_stock_si ) ! Must be last thing before return @@ -1158,165 +1388,16 @@ subroutine define_history_vars(this,callstep,nvar) return end subroutine define_history_vars - - ! ===================================================================================== - - subroutine set_history_var(this,vname,units,long,use_default,avgflag,vtype,hlms, & - flushval,upfreq,ivar,callstep,index) - - use FatesUtilsMod, only : check_hlm_list - use EDTypesMod, only : cp_hlm_name - - ! arguments - class(fates_hio_interface_type) :: this - character(len=*), intent(in) :: vname - character(len=*), intent(in) :: units - character(len=*), intent(in) :: long - character(len=*), intent(in) :: use_default - character(len=*), intent(in) :: avgflag - character(len=*), intent(in) :: vtype - character(len=*), intent(in) :: hlms - real(r8), intent(in) :: flushval ! IF THE TYPE IS AN INT WE WILL round with NINT - integer, intent(in) :: upfreq - character(len=*), intent(in) :: callstep - integer, intent(inout) :: ivar - integer, intent(inout) :: index ! This is the index for the variable of - ! interest that is associated with an - ! explict name (for fast reference during update) - ! A zero is passed back when the variable is - ! not used - - ! locals - type(fates_history_variable_type), pointer :: hvar - integer :: ub1, lb1, ub2, lb2 ! Bounds for allocating the var - integer :: ityp - - logical :: write_var - - write_var = check_hlm_list(trim(hlms), trim(cp_hlm_name)) - if( write_var ) then - ivar = ivar+1 - index = ivar - - if (trim(callstep) .eq. 'initialize') then - call this%hvars(ivar)%Init(vname, units, long, use_default, & - vtype, avgflag, flushval, upfreq, n_iovar_dk, this%iovar_dk) - end if - else - index = 0 - end if - - return - end subroutine set_history_var - - ! ==================================================================================== - - subroutine init_iovar_dk_maps(this) - - ! ---------------------------------------------------------------------------------- - ! This subroutine simply initializes the structures that define the different - ! array and type formats for different IO variables - ! - ! PA_R8 : 1D patch scale 8-byte reals - ! SI_R8 : 1D site scale 8-byte reals - ! - ! The allocation on the structures is not dynamic and should only add up to the - ! number of entries listed here. - ! - ! ---------------------------------------------------------------------------------- - use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & - site_r8, site_ground_r8, site_class_pft_r8 - - implicit none - - ! Arguments - class(fates_hio_interface_type) :: this - - ! Localsi - integer :: index - integer, parameter :: unset_int = -999 - - allocate(this%iovar_dk(n_iovar_dk)) - - ! 1d Patch - index = 1 - call this%iovar_dk(index)%Init(patch_r8, 1) - - ! 1d Site - index = index + 1 - call this%iovar_dk(index)%Init(site_r8, 1) - - ! patch x ground - index = index + 1 - call this%iovar_dk(index)%Init(patch_ground_r8, 2) - - ! patch x size-class/pft - index = index + 1 - call this%iovar_dk(index)%Init(patch_class_pft_r8, 2) - - ! site x ground - index = index + 1 - call this%iovar_dk(index)%Init(site_ground_r8, 2) - - ! site x size-class/pft - index = index + 1 - call this%iovar_dk(index)%Init(site_class_pft_r8, 2) - - ! FIXME(bja, 2016-10) assert(index == n_iovar_dk) - end subroutine init_iovar_dk_maps - - ! =================================================================================== - - subroutine set_dim_ptrs(this,dk_name,idim,dim_target) - - use FatesHistoryVariableType, only : iotype_index - - implicit none - - ! arguments - class(fates_hio_interface_type) :: this - character(len=*),intent(in) :: dk_name - integer,intent(in) :: idim ! dimension index - type(fates_history_dimension_type),target :: dim_target - - - ! local - integer :: ityp - - ityp = iotype_index(trim(dk_name), n_iovar_dk, this%iovar_dk) - - ! First check to see if the dimension is allocated - if(this%iovar_dk(ityp)%ndims dim_target - elseif(idim==2) then - this%iovar_dk(ityp)%dim2_ptr => dim_target - end if - - ! With the map, we can set the dimension size - this%iovar_dk(ityp)%dimsize(idim) = dim_target%upper_bound - dim_target%lower_bound + 1 - - - return - end subroutine set_dim_ptrs - ! ==================================================================================== ! DEPRECATED, TRANSITIONAL OR FUTURE CODE SECTION ! ==================================================================================== - !subroutine set_fates_hio_str(tag,iotype_name,iostr_val) + !subroutine set_fates_hio_str(tag,iotype_name, iostr_val) ! ! Arguments -! character(len=*),intent(in) :: tag -! character(len=*), optional,intent(in) :: iotype_name +! character(len=*), intent(in) :: tag +! character(len=*), optional, intent(in) :: iotype_name ! integer, optional, intent(in) :: iostr_val ! ! local variables @@ -1327,32 +1408,32 @@ end subroutine set_dim_ptrs ! select case (trim(tag)) ! case('flush_to_unset') -! write(*,*) '' -! write(*,*) 'Flushing FATES IO types prior to transfer from host' -! do ityp=1,ubound(iovar_str,1) +! write(*, *) '' +! write(*, *) 'Flushing FATES IO types prior to transfer from host' +! do ityp=1,ubound(iovar_str, 1) ! iovar_str(ityp)%dimsize = unset_int ! iovar_str(ityp)%active = .false. ! end do ! case('check_allset') -! do ityp=1,ubound(iovar_str,1) -! write(*,*) 'Checking to see if ',iovar_str(ityp)%name,' IO communicators were sent to FATES' +! do ityp=1,ubound(iovar_str, 1) +! write(*, *) 'Checking to see if ',iovar_str(ityp)%name, ' IO communicators were sent to FATES' ! if(iovar_str(ityp)%active)then ! if(iovar_str(ityp)%offset .eq. unset_int) then -! write(*,*) 'FATES offset information of IO type:',iovar_str(ityp)%name -! write(*,*) 'was never set' +! write(*, *) 'FATES offset information of IO type:', iovar_str(ityp)%name +! write(*, *) 'was never set' ! ! end_run('MESSAGE') ! end if -! do idim=1,iovar_str(ityp)%ndims +! do idim=1, iovar_str(ityp)%ndims ! if(iovar_str(ityp)%dimsize(idim) .eq. unset_int) then -! write(*,*) 'FATES dimension information of IO type:',iovar_str(ityp)%name -! write(*,*) 'was never set' +! write(*, *) 'FATES dimension information of IO type:', iovar_str(ityp)%name +! write(*, *) 'was never set' ! ! end_run('MESSAGE') ! end if ! end do ! end if ! end do -! write(*,*) 'Checked. All history IO specifications properly sent to FATES.' +! write(*, *) 'Checked. All history IO specifications properly sent to FATES.' ! case default ! ! Must have two arguments if this is not a check or flush @@ -1364,39 +1445,39 @@ end subroutine set_dim_ptrs ! case('offset') ! ityp=iotype_index(trim(iotype_name)) ! iovar_str(ityp)%offset = iostr_val -! write(*,*) 'Transfering offset for IOTYPE',iotype_name,' to FATES' +! write(*, *) 'Transfering offset for IOTYPE',iotype_name, ' to FATES' ! case('dimsize1') ! ityp=iotype_index(trim(iotype_name)) ! iovar_str(ityp)%dimsize(1) = iostr_val -! write(*,*) 'Transfering 1st dimension size for IOTYPE',iotype_name,' to FATES' +! write(*, *) 'Transfering 1st dimension size for IOTYPE',iotype_name, ' to FATES' ! case('dimsize2') ! ityp=iotype_index(trim(iotype_name)) -! if(ubound(iovar_str(ityp)%dimsize,1)==1)then -! write(fates_log(),*) 'Transfering second dimensional bound to unallocated space' -! write(fates_log(),*) 'type:',iotype_name +! if(ubound(iovar_str(ityp)%dimsize, 1)==1)then +! write(fates_log(), *) 'Transfering second dimensional bound to unallocated space' +! write(fates_log(), *) 'type:', iotype_name ! ! end_run ! end if ! iovar_str(ityp)%dimsize(2) = iostr_val -! write(*,*) 'Transfering 2nd dimension size for IOTYPE',iotype_name,' to FATES' +! write(*, *) 'Transfering 2nd dimension size for IOTYPE',iotype_name, ' to FATES' ! case('dimsize3') ! ityp=iotype_index(trim(iotype_name)) -! if(ubound(iovar_str(ityp)%dimsize,1)<3)then -! write(fates_log(),*) 'Transfering third dimensional bound to unallocated space' -! write(fates_log(),*) 'type:',iotype_name +! if(ubound(iovar_str(ityp)%dimsize, 1)<3)then +! write(fates_log(), *) 'Transfering third dimensional bound to unallocated space' +! write(fates_log(), *) 'type:', iotype_name ! ! end_run ! end if ! iovar_str(ityp)%dimsize(3) = iostr_val -! write(*,*) 'Transfering 3rd dimension size for IOTYPE',iotype_name,' to FATES' +! write(*, *) 'Transfering 3rd dimension size for IOTYPE',iotype_name, ' to FATES' ! case default -! write(*,*) 'IO parameter not recognized:',trim(tag) +! write(*, *) 'IO parameter not recognized:', trim(tag) ! ! end_run ! end select ! else -! write(*,*) 'no value was provided for the tag' +! write(*, *) 'no value was provided for the tag' ! end if ! ! end select diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index f60161c802..da630cf228 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -1412,6 +1412,7 @@ subroutine init_history_io(this,bounds_proc) use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp + use FatesConstantsMod, only : fates_short_string_length, fates_long_string_length use HistoryIOMod, only : fates_bounds_type use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & site_r8, site_ground_r8, site_class_pft_r8 @@ -1430,7 +1431,9 @@ subroutine init_history_io(this,bounds_proc) integer :: nclumps ! number of threads on this proc integer :: s ! FATES site index integer :: c ! ALM/CLM column index - character(len=32) :: dim2name + character(len=fates_short_string_length) :: dim2name + character(len=fates_long_string_length) :: ioname + integer :: d_index, dk_index type(fates_bounds_type) :: fates_bounds type(fates_bounds_type) :: fates_clump @@ -1453,8 +1456,8 @@ subroutine init_history_io(this,bounds_proc) ! see FATES: HistoryIOMod.F90. Dimension types are defined at the top of the ! module, and a new explicitly named instance of that type should be created. ! With this new dimension, a new output type/kind can contain that dimension. - ! A new type/kind can be added to the iovar_dk structure, which defines its members - ! in created in init_iovar_dk_maps(). Make sure to increase the size of n_iovar_dk. + ! A new type/kind can be added to the dim_kinds structure, which defines its members + ! in created in init_dim_kinds_maps(). Make sure to increase the size of n_dim_kinds. ! A type/kind of output is defined by the data type (ie r8,int,..) ! and the dimensions. Keep in mind that 3D variables (or 4D if you include time) ! are not really supported in CLM/ALM right now. There are ways around this @@ -1508,23 +1511,23 @@ subroutine init_history_io(this,bounds_proc) ! INTERF-TODO: THESE CAN ALL BE EMBEDDED INTO A SUBROUTINE IN HISTORYIOMOD ! ------------------------------------------------------------------------------------ - call this%fates_hio%init_iovar_dk_maps() + call this%fates_hio%init_dim_kinds_maps() - call this%fates_hio%set_dim_ptrs(dk_name=patch_r8,idim=1, dim_target=this%fates_hio%iopa_dim) + call this%fates_hio%set_dim_indicies(patch_r8, 1, this%fates_hio%patch_index()) - call this%fates_hio%set_dim_ptrs(dk_name=site_r8, idim=1, dim_target=this%fates_hio%iosi_dim) + call this%fates_hio%set_dim_indicies(site_r8, 1, this%fates_hio%column_index()) - call this%fates_hio%set_dim_ptrs(dk_name=patch_ground_r8, idim=1, dim_target=this%fates_hio%iopa_dim) - call this%fates_hio%set_dim_ptrs(dk_name=patch_ground_r8, idim=2, dim_target=this%fates_hio%iogrnd_dim) + call this%fates_hio%set_dim_indicies(patch_ground_r8, 1, this%fates_hio%patch_index()) + call this%fates_hio%set_dim_indicies(patch_ground_r8, 2, this%fates_hio%levgrnd_index()) - call this%fates_hio%set_dim_ptrs(dk_name=site_ground_r8, idim=1, dim_target=this%fates_hio%iosi_dim) - call this%fates_hio%set_dim_ptrs(dk_name=site_ground_r8, idim=2, dim_target=this%fates_hio%iogrnd_dim) + call this%fates_hio%set_dim_indicies(site_ground_r8, 1, this%fates_hio%column_index()) + call this%fates_hio%set_dim_indicies(site_ground_r8, 2, this%fates_hio%levgrnd_index()) - call this%fates_hio%set_dim_ptrs(dk_name=patch_class_pft_r8, idim=1, dim_target=this%fates_hio%iopa_dim) - call this%fates_hio%set_dim_ptrs(dk_name=patch_class_pft_r8, idim=2, dim_target=this%fates_hio%ioscpf_dim) + call this%fates_hio%set_dim_indicies(patch_class_pft_r8, 1, this%fates_hio%patch_index()) + call this%fates_hio%set_dim_indicies(patch_class_pft_r8, 2, this%fates_hio%levscpf_index()) - call this%fates_hio%set_dim_ptrs(dk_name=site_class_pft_r8, idim=1, dim_target=this%fates_hio%iosi_dim) - call this%fates_hio%set_dim_ptrs(dk_name=site_class_pft_r8, idim=2, dim_target=this%fates_hio%ioscpf_dim) + call this%fates_hio%set_dim_indicies(site_class_pft_r8, 1, this%fates_hio%column_index()) + call this%fates_hio%set_dim_indicies(site_class_pft_r8, 2, this%fates_hio%levscpf_index()) ! ------------------------------------------------------------------------------------ @@ -1550,10 +1553,10 @@ subroutine init_history_io(this,bounds_proc) vunits => this%fates_hio%hvars(ivar)%units, & vlong => this%fates_hio%hvars(ivar)%long, & vdefault => this%fates_hio%hvars(ivar)%use_default, & - vavgflag => this%fates_hio%hvars(ivar)%avgflag, & - ioname => this%fates_hio%hvars(ivar)%iovar_dk_ptr%name ) - - + vavgflag => this%fates_hio%hvars(ivar)%avgflag) + + dk_index = this%fates_hio%hvars(ivar)%dim_kinds_index + ioname = trim(this%fates_hio%dim_kinds(dk_index)%name) select case(trim(ioname)) case(patch_r8) @@ -1571,7 +1574,8 @@ subroutine init_history_io(this,bounds_proc) set_lake=0._r8,set_urb=0._r8) case(patch_ground_r8) - dim2name = this%fates_hio%hvars(ivar)%iovar_dk_ptr%dim2_ptr%name + d_index = this%fates_hio%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hio%dim_bounds(d_index)%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & ! <--- addfld2d type2d=trim(dim2name), & ! <--- type2d avgflag=trim(vavgflag),long_name=trim(vlong), & @@ -1580,7 +1584,8 @@ subroutine init_history_io(this,bounds_proc) set_lake=0._r8,set_urb=0._r8) case(patch_class_pft_r8) - dim2name = this%fates_hio%hvars(ivar)%iovar_dk_ptr%dim2_ptr%name + d_index = this%fates_hio%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hio%dim_bounds(d_index)%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & type2d=trim(dim2name), & avgflag=trim(vavgflag),long_name=trim(vlong), & @@ -1588,7 +1593,8 @@ subroutine init_history_io(this,bounds_proc) default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) case(site_ground_r8) - dim2name = this%fates_hio%hvars(ivar)%iovar_dk_ptr%dim2_ptr%name + d_index = this%fates_hio%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hio%dim_bounds(d_index)%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & type2d=trim(dim2name), & avgflag=trim(vavgflag),long_name=trim(vlong), & @@ -1596,7 +1602,8 @@ subroutine init_history_io(this,bounds_proc) default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) case(site_class_pft_r8) - dim2name = this%fates_hio%hvars(ivar)%iovar_dk_ptr%dim2_ptr%name + d_index = this%fates_hio%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hio%dim_bounds(d_index)%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & type2d=trim(dim2name), & avgflag=trim(vavgflag),long_name=trim(vlong), & From 7408f380b2e8bd4a24fec25fc808143542d9cfd5 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Thu, 20 Oct 2016 11:13:13 -0600 Subject: [PATCH 06/13] Refactor history output Move some history initialization details out of the clm fates interface and into the history module. Convert another pointer into an allocatable. Test: ERS_D_Ld5.f10_f10.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: 44aac42 Test status: pass --- components/clm/src/ED/main/HistoryIOMod.F90 | 249 +++++++++++------- .../clm/src/utils/clmfates_interfaceMod.F90 | 37 +-- 2 files changed, 160 insertions(+), 126 deletions(-) diff --git a/components/clm/src/ED/main/HistoryIOMod.F90 b/components/clm/src/ED/main/HistoryIOMod.F90 index aed6e5312b..a4df876aa8 100644 --- a/components/clm/src/ED/main/HistoryIOMod.F90 +++ b/components/clm/src/ED/main/HistoryIOMod.F90 @@ -157,8 +157,8 @@ Module HistoryIOMod type, public :: fates_hio_interface_type ! Instance of the list of history output varialbes - type(fates_history_variable_type), pointer :: hvars(:) - integer :: n_hvars + type(fates_history_variable_type), allocatable :: hvars(:) + integer, private :: num_history_vars_ ! Instanteat one registry of the different dimension/kinds (dk) ! All output variables will have a pointer to one of these dk's @@ -177,19 +177,27 @@ Module HistoryIOMod procedure, public :: Init => InitFatesHistoryOutput procedure, public :: SetThreadBounds => SetHistoryThreadBounds - + procedure, public :: initialize_history_vars + procedure, public :: assemble_valid_output_types + procedure, public :: update_history_dyn procedure, public :: update_history_prod procedure, public :: update_history_cbal - procedure, public :: define_history_vars - procedure, public :: set_history_var - procedure, public :: init_dim_kinds_maps - procedure, public :: set_dim_indicies - procedure, private :: flush_hvars + + ! 'get' methods used by external callers to access private read only data + procedure, public :: num_history_vars procedure, public :: patch_index procedure, public :: column_index procedure, public :: levgrnd_index procedure, public :: levscpf_index + + ! private work functions + procedure, private :: define_history_vars + procedure, private :: set_history_var + procedure, private :: init_dim_kinds_maps + procedure, private :: set_dim_indicies + procedure, private :: flush_hvars + procedure, private :: set_patch_index procedure, private :: set_column_index procedure, private :: set_levgrnd_index @@ -271,6 +279,36 @@ subroutine SetHistoryThreadBounds(this, thread_index, thread_bounds) end subroutine SetHistoryThreadBounds + ! =================================================================================== + subroutine assemble_valid_output_types(this) + + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & + site_r8, site_ground_r8, site_class_pft_r8 + + implicit none + + class(fates_hio_interface_type), intent(inout) :: this + + call this%init_dim_kinds_maps() + + call this%set_dim_indicies(patch_r8, 1, this%patch_index()) + + call this%set_dim_indicies(site_r8, 1, this%column_index()) + + call this%set_dim_indicies(patch_ground_r8, 1, this%patch_index()) + call this%set_dim_indicies(patch_ground_r8, 2, this%levgrnd_index()) + + call this%set_dim_indicies(site_ground_r8, 1, this%column_index()) + call this%set_dim_indicies(site_ground_r8, 2, this%levgrnd_index()) + + call this%set_dim_indicies(patch_class_pft_r8, 1, this%patch_index()) + call this%set_dim_indicies(patch_class_pft_r8, 2, this%levscpf_index()) + + call this%set_dim_indicies(site_class_pft_r8, 1, this%column_index()) + call this%set_dim_indicies(site_class_pft_r8, 2, this%levscpf_index()) + + end subroutine assemble_valid_output_types + ! =================================================================================== subroutine set_dim_indicies(this, dk_name, idim, dim_index) @@ -381,10 +419,11 @@ subroutine flush_hvars(this,nc,upfreq_in) integer :: lb1,ub1,lb2,ub2 do ivar=1,ubound(this%hvars,1) - hvar => this%hvars(ivar) - if (hvar%upfreq == upfreq_in) then ! Only flush variables with update on dynamics step - call hvar%Flush(nc, this%dim_bounds, this%dim_kinds) - end if + associate( hvar => this%hvars(ivar) ) + if (hvar%upfreq == upfreq_in) then ! Only flush variables with update on dynamics step + call hvar%Flush(nc, this%dim_bounds, this%dim_kinds) + end if + end associate end do end subroutine flush_hvars @@ -393,7 +432,7 @@ end subroutine flush_hvars ! ===================================================================================== subroutine set_history_var(this, vname, units, long, use_default, avgflag, vtype, & - hlms, flushval, upfreq, ivar, callstep, index) + hlms, flushval, upfreq, ivar, initialize, index) use FatesUtilsMod, only : check_hlm_list use EDTypesMod, only : cp_hlm_name @@ -411,7 +450,7 @@ subroutine set_history_var(this, vname, units, long, use_default, avgflag, vtype character(len=*), intent(in) :: hlms real(r8), intent(in) :: flushval ! IF THE TYPE IS AN INT WE WILL round with NINT integer, intent(in) :: upfreq - character(len=*), intent(in) :: callstep + logical, intent(in) :: initialize integer, intent(inout) :: ivar integer, intent(inout) :: index ! This is the index for the variable of ! interest that is associated with an @@ -431,7 +470,7 @@ subroutine set_history_var(this, vname, units, long, use_default, avgflag, vtype ivar = ivar+1 index = ivar - if (trim(callstep) .eq. 'initialize') then + if (initialize) then call this%hvars(ivar)%Init(vname, units, long, use_default, & vtype, avgflag, flushval, upfreq, n_dim_kinds, this%dim_kinds, & this%dim_bounds) @@ -977,9 +1016,40 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) end subroutine update_history_prod + ! ==================================================================================== + integer function num_history_vars(this) + + implicit none + + class(fates_hio_interface_type), intent(in) :: this + + num_history_vars = this%num_history_vars_ + + end function num_history_vars + + ! ==================================================================================== + + subroutine initialize_history_vars(this) + + implicit none + + class(fates_hio_interface_type), intent(inout) :: this + + ! Determine how many of the history IO variables registered in FATES + ! are going to be allocated + call this%define_history_vars(initialize_variables=.false.) + + ! Allocate the list of history output variable objects + allocate(this%hvars(this%num_history_vars())) + + ! construct the object that defines all of the IO variables + call this%define_history_vars(initialize_variables=.true.) + + end subroutine initialize_history_vars + ! ==================================================================================== - subroutine define_history_vars(this,callstep,nvar) + subroutine define_history_vars(this, initialize_variables) ! --------------------------------------------------------------------------------- ! @@ -1013,191 +1083,186 @@ subroutine define_history_vars(this,callstep,nvar) implicit none class(fates_hio_interface_type), intent(inout) :: this - character(len=*), intent(in) :: callstep ! are we 'count'ing or 'initializ'ing? - integer, optional, intent(out) :: nvar + logical, intent(in) :: initialize_variables ! are we 'count'ing or 'initializ'ing? + integer :: ivar - if(.not. (trim(callstep).eq.'count' .or. trim(callstep).eq.'initialize') ) then - write(fates_log(),*) 'defining history variables in FATES requires callstep count or initialize' - ! end_run('MESSAGE') - end if - ivar=0 ! Site level counting variables call this%set_history_var(vname='ED_NPATCHES', units='none', & long='Total number of ED patches per site', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=1.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_npatches_si) + ivar=ivar, initialize=initialize_variables, index = ih_npatches_si) call this%set_history_var(vname='ED_NCOHORTS', units='none', & long='Total number of ED cohorts per site', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=1.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_ncohorts_si) + ivar=ivar, initialize=initialize_variables, index = ih_ncohorts_si) ! Patch variables call this%set_history_var(vname='TRIMMING', units='none', & long='Degree to which canopy expansion is limited by leaf economics', & use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=1.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_trimming_pa) + ivar=ivar, initialize=initialize_variables, index = ih_trimming_pa) call this%set_history_var(vname='AREA_PLANT', units='m2', & long='area occupied by all plants', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_area_plant_pa) + ivar=ivar, initialize=initialize_variables, index = ih_area_plant_pa) call this%set_history_var(vname='AREA_TREES', units='m2', & long='area occupied by woody plants', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_area_treespread_pa) + ivar=ivar, initialize=initialize_variables, index = ih_area_treespread_pa) call this%set_history_var(vname='CANOPY_SPREAD', units='0-1', & long='Scaling factor between tree basal area and canopy area', & use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_canopy_spread_pa) + ivar=ivar, initialize=initialize_variables, index = ih_canopy_spread_pa) 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, callstep=callstep, index = ih_biomass_pa_pft ) + ivar=ivar, initialize=initialize_variables, index = ih_biomass_pa_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, callstep=callstep, index = ih_leafbiomass_pa_pft ) + ivar=ivar, initialize=initialize_variables, index = ih_leafbiomass_pa_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, callstep=callstep, index = ih_storebiomass_pa_pft ) + ivar=ivar, initialize=initialize_variables, index = ih_storebiomass_pa_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, callstep=callstep, index = ih_nindivs_pa_pft ) + ivar=ivar, initialize=initialize_variables, index = ih_nindivs_pa_pft ) ! Fire Variables call this%set_history_var(vname='FIRE_NESTEROV_INDEX', units='none', & long='nesterov_fire_danger index', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_nesterov_fire_danger_pa) + ivar=ivar, initialize=initialize_variables, index = ih_nesterov_fire_danger_pa) call this%set_history_var(vname='FIRE_ROS', units='m/min', & long='fire rate of spread m/min', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_spitfire_ROS_pa) + ivar=ivar, initialize=initialize_variables, index = ih_spitfire_ROS_pa) call this%set_history_var(vname='EFFECT_WSPEED', units='none', & long ='effective windspeed for fire spread', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_effect_wspeed_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_effect_wspeed_pa ) call this%set_history_var(vname='FIRE_TFC_ROS', units='none', & long ='total fuel consumed', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_TFC_ROS_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_TFC_ROS_pa ) call this%set_history_var(vname='FIRE_INTENSITY', units='kJ/m/s', & long='spitfire fire intensity: kJ/m/s', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_fire_intensity_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_fire_intensity_pa ) call this%set_history_var(vname='FIRE_AREA', units='fraction', & long='spitfire fire area:m2', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_fire_area_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_fire_area_pa ) call this%set_history_var(vname='SCORCH_HEIGHT', units='m', & long='spitfire fire area:m2', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_scorch_height_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_scorch_height_pa ) call this%set_history_var(vname='fire_fuel_mef', units='m', & long='spitfire fuel moisture', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_fire_fuel_mef_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_fire_fuel_mef_pa ) call this%set_history_var(vname='fire_fuel_bulkd', units='m', & long='spitfire fuel bulk density', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_fire_fuel_bulkd_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_fire_fuel_bulkd_pa ) call this%set_history_var(vname='FIRE_FUEL_EFF_MOIST', units='m', & long='spitfire fuel moisture', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_fire_fuel_eff_moist_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_fire_fuel_eff_moist_pa ) call this%set_history_var(vname='fire_fuel_sav', units='m', & long='spitfire fuel surface/volume ', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_fire_fuel_sav_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_fire_fuel_sav_pa ) call this%set_history_var(vname='SUM_FUEL', units='gC m-2', & long='total ground fuel related to ros (omits 1000hr fuels)', & use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_sum_fuel_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_sum_fuel_pa ) ! Litter Variables call this%set_history_var(vname='LITTER_IN', units='gC m-2 s-1', & long='Litter flux in leaves', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_litter_in_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_litter_in_pa ) call this%set_history_var(vname='LITTER_OUT', units='gC m-2 s-1', & long='Litter flux out leaves', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_litter_out_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_litter_out_pa ) call this%set_history_var(vname='SEED_BANK', units='gC m-2', & long='Total Seed Mass of all PFTs', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_seed_bank_si ) + ivar=ivar, initialize=initialize_variables, index = ih_seed_bank_si ) call this%set_history_var(vname='SEEDS_IN', units='gC m-2 s-1', & long='Seed Production Rate', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_seeds_in_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_seeds_in_pa ) call this%set_history_var(vname='SEED_GERMINATION', units='gC m-2 s-1', & long='Seed mass converted into new cohorts', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_seed_germination_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_seed_germination_pa ) call this%set_history_var(vname='SEED_DECAY', units='gC m-2 s-1', & long='Seed mass decay', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_seed_decay_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_seed_decay_pa ) call this%set_history_var(vname='ED_bstore', units='gC m-2', & long='Storage biomass', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_bstore_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_bstore_pa ) call this%set_history_var(vname='ED_bdead', units='gC m-2', & long='Dead (structural) biomass (live trees, not CWD)', & use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_bdead_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_bdead_pa ) call this%set_history_var(vname='ED_balive', units='gC m-2', & long='Live biomass', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_balive_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_balive_pa ) call this%set_history_var(vname='ED_bleaf', units='gC m-2', & long='Leaf biomass', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_bleaf_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_bleaf_pa ) call this%set_history_var(vname='ED_biomass', units='gC m-2', & long='Total biomass', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_btotal_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_btotal_pa ) ! Ecosystem Carbon Fluxes (updated rapidly, upfreq=2) @@ -1205,32 +1270,32 @@ subroutine define_history_vars(this,callstep,nvar) call this%set_history_var(vname='NPP_column', units='gC/m^2/s', & long='net primary production on the site', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & - ivar=ivar, callstep=callstep, index = ih_npp_si ) + ivar=ivar, initialize=initialize_variables, index = ih_npp_si ) call this%set_history_var(vname='GPP', units='gC/m^2/s', & long='gross primary production', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & - ivar=ivar, callstep=callstep, index = ih_gpp_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_gpp_pa ) call this%set_history_var(vname='NPP', units='gC/m^2/s', & long='net primary production', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & - ivar=ivar, callstep=callstep, index = ih_npp_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_npp_pa ) call this%set_history_var(vname='AR', units='gC/m^2/s', & long='autotrophic respiration', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & - ivar=ivar, callstep=callstep, index = ih_aresp_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_aresp_pa ) call this%set_history_var(vname='GROWTH_RESP', units='gC/m^2/s', & long='growth respiration', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & - ivar=ivar, callstep=callstep, index = ih_growth_resp_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_growth_resp_pa ) call this%set_history_var(vname='MAINT_RESP', units='gC/m^2/s', & long='maintenance respiration', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & - ivar=ivar, callstep=callstep, index = ih_maint_resp_pa ) + ivar=ivar, initialize=initialize_variables, index = ih_maint_resp_pa ) ! Carbon Flux (grid dimension x scpf) (THESE ARE DEFAULT INACTIVE!!! @@ -1240,93 +1305,93 @@ subroutine define_history_vars(this,callstep,nvar) call this%set_history_var(vname='GPP_SCPF', units='kgC/m2/yr', & long='gross primary production', use_default='inactive', & avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_gpp_si_scpf ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_gpp_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_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_npp_totl_si_scpf ) + 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', & avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_npp_leaf_si_scpf ) + 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', & avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_npp_seed_si_scpf ) + 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', & avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_npp_fnrt_si_scpf ) + 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', & avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_npp_bgsw_si_scpf ) + 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', & avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_npp_bgdw_si_scpf ) + 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', & avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_npp_agsw_si_scpf ) + 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', & avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_npp_agdw_si_scpf ) + 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', & avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_npp_stor_si_scpf ) + 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', & avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_ddbh_si_scpf ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_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_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_ba_si_scpf ) + 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', & avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_nplant_si_scpf ) + 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', & avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_m1_si_scpf ) + 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', & avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_m2_si_scpf ) + 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', & avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_m3_si_scpf ) + 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', & avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_m4_si_scpf ) + 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', & avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, callstep=callstep, index = ih_m5_si_scpf ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m5_si_scpf ) ! CARBON BALANCE VARIABLES THAT DEPEND ON HLM BGC INPUTS @@ -1334,58 +1399,56 @@ subroutine define_history_vars(this,callstep,nvar) 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, & - upfreq=3, ivar=ivar, callstep=callstep, index = ih_nep_si ) + 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, & - upfreq=3, ivar=ivar, callstep=callstep, index = ih_fire_c_to_atm_si ) + 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, & - upfreq=3, ivar=ivar, callstep=callstep, index = ih_nbp_si ) + 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, & - upfreq=3, ivar=ivar, callstep=callstep, index = ih_totecosysc_si ) + 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, & - upfreq=3, ivar=ivar, callstep=callstep, index = ih_cbal_err_fates_si ) + 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, & - upfreq=3, ivar=ivar, callstep=callstep, index = ih_cbal_err_bgc_si ) + 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, & - upfreq=3, ivar=ivar, callstep=callstep, index = ih_cbal_err_tot_si ) + 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, & - upfreq=3, ivar=ivar, callstep=callstep, index = ih_biomass_stock_si ) + 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, & - upfreq=3, ivar=ivar, callstep=callstep, index = ih_litter_stock_si ) + 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, & - upfreq=3, ivar=ivar, callstep=callstep, index = ih_cwd_stock_si ) + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cwd_stock_si ) ! Must be last thing before return - if(present(nvar)) nvar = ivar - - return + this%num_history_vars_ = ivar end subroutine define_history_vars diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index da630cf228..92186e1e5c 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -1510,44 +1510,16 @@ subroutine init_history_io(this,bounds_proc) ! PART II: USE THE JUST DEFINED DIMENSIONS TO ASSEMBLE THE VALID IO TYPES ! INTERF-TODO: THESE CAN ALL BE EMBEDDED INTO A SUBROUTINE IN HISTORYIOMOD ! ------------------------------------------------------------------------------------ - - call this%fates_hio%init_dim_kinds_maps() - - call this%fates_hio%set_dim_indicies(patch_r8, 1, this%fates_hio%patch_index()) - - call this%fates_hio%set_dim_indicies(site_r8, 1, this%fates_hio%column_index()) - - call this%fates_hio%set_dim_indicies(patch_ground_r8, 1, this%fates_hio%patch_index()) - call this%fates_hio%set_dim_indicies(patch_ground_r8, 2, this%fates_hio%levgrnd_index()) - - call this%fates_hio%set_dim_indicies(site_ground_r8, 1, this%fates_hio%column_index()) - call this%fates_hio%set_dim_indicies(site_ground_r8, 2, this%fates_hio%levgrnd_index()) - - call this%fates_hio%set_dim_indicies(patch_class_pft_r8, 1, this%fates_hio%patch_index()) - call this%fates_hio%set_dim_indicies(patch_class_pft_r8, 2, this%fates_hio%levscpf_index()) - - call this%fates_hio%set_dim_indicies(site_class_pft_r8, 1, this%fates_hio%column_index()) - call this%fates_hio%set_dim_indicies(site_class_pft_r8, 2, this%fates_hio%levscpf_index()) - + call this%fates_hio%assemble_valid_output_types() ! ------------------------------------------------------------------------------------ ! PART III: DEFINE THE LIST OF OUTPUT VARIABLE OBJECTS, AND REGISTER THEM WITH THE ! HLM ACCORDING TO THEIR TYPES ! ------------------------------------------------------------------------------------ + call this%fates_hio%initialize_history_vars() + nvar = this%fates_hio%num_history_vars() - ! Determine how many of the history IO variables registered in FATES - ! are going to be allocated - - call this%fates_hio%define_history_vars('count',nvar) - this%fates_hio%n_hvars = nvar - - ! Allocate the list of history output variable objects - allocate(this%fates_hio%hvars(nvar)) - - ! construct the object that defines all of the IO variables - call this%fates_hio%define_history_vars('initialize') - - do ivar = 1,nvar + do ivar = 1, nvar associate( vname => this%fates_hio%hvars(ivar)%vname, & vunits => this%fates_hio%hvars(ivar)%units, & @@ -1619,7 +1591,6 @@ subroutine init_history_io(this,bounds_proc) end associate end do - return end subroutine init_history_io subroutine hlm_bounds_to_fates_bounds(hlm, fates) From a6f353dd838912f8b4b86b37add82f8d411097e0 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Thu, 20 Oct 2016 12:26:12 -0600 Subject: [PATCH 07/13] NAG bugfix: break line that exceeds 132 characters. Test: ERS_D_Ld5.5x5_amazon.ICLM45ED.hobart_nag.clm-edTest Test baseline: none (master didn't compile and run on nag) Test status: pass lease enter the commit message for your changes. Lines starting --- components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index a0056056c8..4a5801ff17 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -546,7 +546,8 @@ subroutine canopy_structure( currentSite ) enddo if(((checkarea-currentPatch%area)) > 0.0001)then - write(fates_log(),*) 'problem with canopy area', checkarea,currentPatch%area,checkarea-currentPatch%area,i,z,missing_area + write(fates_log(),*) 'problem with canopy area', checkarea, currentPatch%area, checkarea - currentPatch%area, & + i, z, missing_area currentCohort => currentPatch%tallest do while (associated(currentCohort)) if(currentCohort%canopy_layer == i)then From 3a6b65b41a56ac47a231bc4097f8c98a578793af Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Thu, 20 Oct 2016 13:48:30 -0600 Subject: [PATCH 08/13] Add a small test suite for ed on hobart. Create a small hobart specific test suite for testing ed with nag while dealing with some hobart specific limitations that prevent running the full ed test suite. Test suite: ed - hobart nag Test baseline: none, previous version didn't run Test status: all tests pass. --- components/clm/cime_config/testdefs/testlist_clm.xml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/components/clm/cime_config/testdefs/testlist_clm.xml b/components/clm/cime_config/testdefs/testlist_clm.xml index 512908b01b..e56c1f7667 100644 --- a/components/clm/cime_config/testdefs/testlist_clm.xml +++ b/components/clm/cime_config/testdefs/testlist_clm.xml @@ -694,6 +694,7 @@ ed + hobart hobart yellowstone yellowstone @@ -703,10 +704,12 @@ ed + hobart yellowstone ed + hobart hobart yellowstone yellowstone @@ -721,12 +724,14 @@ ed + hobart ed hobart yellowstone ed + hobart hobart yellowstone yellowstone From 31572b4e1f15cd99db3ffe70a3e83dcf1ba0684b Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Fri, 21 Oct 2016 10:58:22 -0600 Subject: [PATCH 09/13] Rename HistoryIOMod.F90 -> FatesHistoryInterfaceMod.F90 Rename the history interface file to have a consistent name other history related files. no source changes. Test: ERS_D_Ld5.f10_f10.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: 44aac42 Test status: pass --- .../ED/main/{HistoryIOMod.F90 => FatesHistoryInterfaceMod.F90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename components/clm/src/ED/main/{HistoryIOMod.F90 => FatesHistoryInterfaceMod.F90} (100%) diff --git a/components/clm/src/ED/main/HistoryIOMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 similarity index 100% rename from components/clm/src/ED/main/HistoryIOMod.F90 rename to components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 From 4698f421fcd156d07b666cfde30b4bf6f452a7c8 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Fri, 21 Oct 2016 11:19:39 -0600 Subject: [PATCH 10/13] Source changes renaming the history interface module. Rename the history interface class and corresponding instance. Note: ammending commit, test was not a clean build, may not compile. Test: ERS_D_Ld5.f10_f10.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: 44aac42 Test status: pass --- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 50 +++++------ .../clm/src/utils/clmfates_interfaceMod.F90 | 86 +++++++++---------- 2 files changed, 68 insertions(+), 68 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index a4df876aa8..fd7e6126ad 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1,4 +1,4 @@ -Module HistoryIOMod +module FatesHistoryInterfaceMod use FatesConstantsMod, only : r8 => fates_r8 @@ -154,7 +154,7 @@ Module HistoryIOMod end type iovar_map_type - type, public :: fates_hio_interface_type + type, public :: fates_history_interface_type ! Instance of the list of history output varialbes type(fates_history_variable_type), allocatable :: hvars(:) @@ -203,7 +203,7 @@ Module HistoryIOMod procedure, private :: set_levgrnd_index procedure, private :: set_levscpf_index - end type fates_hio_interface_type + end type fates_history_interface_type @@ -217,7 +217,7 @@ subroutine InitFatesHistoryOutput(this, num_threads, fates_bounds) implicit none - class(fates_hio_interface_type), intent(inout) :: this + class(fates_history_interface_type), intent(inout) :: this integer, intent(in) :: num_threads type(fates_bounds_type), intent(in) :: fates_bounds @@ -254,7 +254,7 @@ subroutine SetHistoryThreadBounds(this, thread_index, thread_bounds) implicit none - class(fates_hio_interface_type), intent(inout) :: this + class(fates_history_interface_type), intent(inout) :: this integer, intent(in) :: thread_index type(fates_bounds_type), intent(in) :: thread_bounds @@ -287,7 +287,7 @@ subroutine assemble_valid_output_types(this) implicit none - class(fates_hio_interface_type), intent(inout) :: this + class(fates_history_interface_type), intent(inout) :: this call this%init_dim_kinds_maps() @@ -318,7 +318,7 @@ subroutine set_dim_indicies(this, dk_name, idim, dim_index) implicit none ! arguments - class(fates_hio_interface_type), intent(inout) :: this + class(fates_history_interface_type), intent(inout) :: this character(len=*), intent(in) :: dk_name integer, intent(in) :: idim ! dimension index integer, intent(in) :: dim_index @@ -353,56 +353,56 @@ end subroutine set_dim_indicies ! ======================================================================= subroutine set_patch_index(this, index) implicit none - class(fates_hio_interface_type), intent(inout) :: this + class(fates_history_interface_type), intent(inout) :: this integer, intent(in) :: index this%patch_index_ = index end subroutine set_patch_index integer function patch_index(this) implicit none - class(fates_hio_interface_type), intent(in) :: this + class(fates_history_interface_type), intent(in) :: this patch_index = this%patch_index_ end function patch_index ! ======================================================================= subroutine set_column_index(this, index) implicit none - class(fates_hio_interface_type), intent(inout) :: this + class(fates_history_interface_type), intent(inout) :: this integer, intent(in) :: index this%column_index_ = index end subroutine set_column_index integer function column_index(this) implicit none - class(fates_hio_interface_type), intent(in) :: this + class(fates_history_interface_type), intent(in) :: this column_index = this%column_index_ end function column_index ! ======================================================================= subroutine set_levgrnd_index(this, index) implicit none - class(fates_hio_interface_type), intent(inout) :: this + class(fates_history_interface_type), intent(inout) :: this integer, intent(in) :: index this%levgrnd_index_ = index end subroutine set_levgrnd_index integer function levgrnd_index(this) implicit none - class(fates_hio_interface_type), intent(in) :: this + class(fates_history_interface_type), intent(in) :: this levgrnd_index = this%levgrnd_index_ end function levgrnd_index ! ======================================================================= subroutine set_levscpf_index(this, index) implicit none - class(fates_hio_interface_type), intent(inout) :: this + class(fates_history_interface_type), intent(inout) :: this integer, intent(in) :: index this%levscpf_index_ = index end subroutine set_levscpf_index integer function levscpf_index(this) implicit none - class(fates_hio_interface_type), intent(in) :: this + class(fates_history_interface_type), intent(in) :: this levscpf_index = this%levscpf_index_ end function levscpf_index @@ -410,7 +410,7 @@ end function levscpf_index subroutine flush_hvars(this,nc,upfreq_in) - class(fates_hio_interface_type) :: this + class(fates_history_interface_type) :: this integer,intent(in) :: nc integer,intent(in) :: upfreq_in @@ -440,7 +440,7 @@ subroutine set_history_var(this, vname, units, long, use_default, avgflag, vtype implicit none ! arguments - class(fates_hio_interface_type), intent(inout) :: this + class(fates_history_interface_type), intent(inout) :: this character(len=*), intent(in) :: vname character(len=*), intent(in) :: units character(len=*), intent(in) :: long @@ -503,7 +503,7 @@ subroutine init_dim_kinds_maps(this) implicit none ! Arguments - class(fates_hio_interface_type), intent(inout) :: this + class(fates_history_interface_type), intent(inout) :: this integer :: index @@ -541,7 +541,7 @@ subroutine update_history_cbal(this,nc,nsites,sites) use EDtypesMod , only : ed_site_type ! Arguments - class(fates_hio_interface_type) :: this + class(fates_history_interface_type) :: this integer , intent(in) :: nc ! clump index integer , intent(in) :: nsites type(ed_site_type) , intent(inout), target :: sites(nsites) @@ -609,7 +609,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) use EDParamsMod , only : ED_val_ag_biomass ! Arguments - class(fates_hio_interface_type) :: this + class(fates_history_interface_type) :: this integer , intent(in) :: nc ! clump index integer , intent(in) :: nsites type(ed_site_type) , intent(inout), target :: sites(nsites) @@ -925,7 +925,7 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ed_patch_type, & AREA ! Arguments - class(fates_hio_interface_type) :: this + class(fates_history_interface_type) :: this integer , intent(in) :: nc ! clump index integer , intent(in) :: nsites type(ed_site_type) , intent(inout), target :: sites(nsites) @@ -1021,7 +1021,7 @@ integer function num_history_vars(this) implicit none - class(fates_hio_interface_type), intent(in) :: this + class(fates_history_interface_type), intent(in) :: this num_history_vars = this%num_history_vars_ @@ -1033,7 +1033,7 @@ subroutine initialize_history_vars(this) implicit none - class(fates_hio_interface_type), intent(inout) :: this + class(fates_history_interface_type), intent(inout) :: this ! Determine how many of the history IO variables registered in FATES ! are going to be allocated @@ -1082,7 +1082,7 @@ subroutine define_history_vars(this, initialize_variables) site_r8, site_ground_r8, site_class_pft_r8 implicit none - class(fates_hio_interface_type), intent(inout) :: this + class(fates_history_interface_type), intent(inout) :: this logical, intent(in) :: initialize_variables ! are we 'count'ing or 'initializ'ing? integer :: ivar @@ -1549,4 +1549,4 @@ end subroutine define_history_vars -end module HistoryIOMod +end module FatesHistoryInterfaceMod diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 92186e1e5c..d42dbe8a48 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -82,7 +82,7 @@ module CLMFatesInterfaceMod allocate_bcin, & allocate_bcout - use HistoryIOMod, only : fates_hio_interface_type + use FatesHistoryInterfaceMod, only : fates_history_interface_type use ChecksBalancesMod , only : SummarizeNetFluxes, FATES_BGC_Carbon_BalanceCheck use EDTypesMod , only : udata @@ -139,7 +139,7 @@ module CLMFatesInterfaceMod type(f2hmap_type), allocatable :: f2hmap(:) ! fates_hio is the interface class for the history output - type(fates_hio_interface_type) :: fates_hio + type(fates_history_interface_type) :: fates_hist contains @@ -510,7 +510,7 @@ subroutine dynamics_driv(this, nc, bounds_clump, & ! --------------------------------------------------------------------------------- ! Update history IO fields that depend on ecosystem dynamics ! --------------------------------------------------------------------------------- - call this%fates_hio%update_history_dyn( nc, & + call this%fates_hist%update_history_dyn( nc, & this%fates(nc)%nsites, & this%fates(nc)%sites) @@ -681,7 +681,7 @@ subroutine init_restart(this, ncid, flag, waterstate_inst, canopystate_inst ) ! ------------------------------------------------------------------------ ! Update history IO fields that depend on ecosystem dynamics ! ------------------------------------------------------------------------ - call this%fates_hio%update_history_dyn( nc, & + call this%fates_hist%update_history_dyn( nc, & this%fates(nc)%nsites, & this%fates(nc)%sites) @@ -749,7 +749,7 @@ subroutine init_coldstart(this, waterstate_inst, canopystate_inst) ! ------------------------------------------------------------------------ ! Update history IO fields that depend on ecosystem dynamics ! ------------------------------------------------------------------------ - call this%fates_hio%update_history_dyn( nc, & + call this%fates_hist%update_history_dyn( nc, & this%fates(nc)%nsites, & this%fates(nc)%sites) @@ -1210,7 +1210,7 @@ subroutine wrap_accumulatefluxes(this, nc, fn, filterp) dtime) - call this%fates_hio%update_history_prod(nc, & + call this%fates_hist%update_history_prod(nc, & this%fates(nc)%nsites, & this%fates(nc)%sites, & dtime) @@ -1397,7 +1397,7 @@ subroutine wrap_bgc_summary(this, nc, soilbiogeochem_carbonflux_inst, & ! Update history variables that track these variables - call this%fates_hio%update_history_cbal(nc, & + call this%fates_hist%update_history_cbal(nc, & this%fates(nc)%nsites, & this%fates(nc)%sites) @@ -1413,7 +1413,7 @@ subroutine init_history_io(this,bounds_proc) use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp use FatesConstantsMod, only : fates_short_string_length, fates_long_string_length - use HistoryIOMod, only : fates_bounds_type + use FatesHistoryInterfaceMod, only : fates_bounds_type use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & site_r8, site_ground_r8, site_class_pft_r8 @@ -1444,7 +1444,7 @@ subroutine init_history_io(this,bounds_proc) if(.not.use_ed) return - !associate(hio => this%fates_hio) + !associate(hio => this%fates_hist) nclumps = get_proc_clumps() @@ -1453,7 +1453,7 @@ subroutine init_history_io(this,bounds_proc) ! ! ------------------------------------------------------------------------------- ! Those who wish add variables that require new dimensions, please - ! see FATES: HistoryIOMod.F90. Dimension types are defined at the top of the + ! see FATES: FatesHistoryInterfaceMod.F90. Dimension types are defined at the top of the ! module, and a new explicitly named instance of that type should be created. ! With this new dimension, a new output type/kind can contain that dimension. ! A new type/kind can be added to the dim_kinds structure, which defines its members @@ -1467,7 +1467,7 @@ subroutine init_history_io(this,bounds_proc) call hlm_bounds_to_fates_bounds(bounds_proc, fates_bounds) - call this%fates_hio%Init(nclumps, fates_bounds) + call this%fates_hist%Init(nclumps, fates_bounds) ! Define the bounds on the first dimension for each thread !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,fates_clump,s,c,num_sites) @@ -1477,7 +1477,7 @@ subroutine init_history_io(this,bounds_proc) ! thread bounds for patch call hlm_bounds_to_fates_bounds(bounds_clump, fates_clump) - call this%fates_hio%SetThreadBounds(nc, fates_clump) + call this%fates_hist%SetThreadBounds(nc, fates_clump) end do !$OMP END PARALLEL DO @@ -1486,7 +1486,7 @@ subroutine init_history_io(this,bounds_proc) ! ------------------------------------------------------------------------------------ ! Allocate the mapping between FATES indices and the IO indices - allocate(this%fates_hio%iovar_map(nclumps)) + allocate(this%fates_hist%iovar_map(nclumps)) !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,fates_clump,s,c,num_sites) @@ -1494,13 +1494,13 @@ subroutine init_history_io(this,bounds_proc) call get_clump_bounds(nc, bounds_clump) - allocate(this%fates_hio%iovar_map(nc)%site_index(this%fates(nc)%nsites)) - allocate(this%fates_hio%iovar_map(nc)%patch1_index(this%fates(nc)%nsites)) + allocate(this%fates_hist%iovar_map(nc)%site_index(this%fates(nc)%nsites)) + allocate(this%fates_hist%iovar_map(nc)%patch1_index(this%fates(nc)%nsites)) do s=1,this%fates(nc)%nsites c = this%f2hmap(nc)%fcolumn(s) - this%fates_hio%iovar_map(nc)%site_index(s) = c - this%fates_hio%iovar_map(nc)%patch1_index(s) = col%patchi(c)+1 + this%fates_hist%iovar_map(nc)%site_index(s) = c + this%fates_hist%iovar_map(nc)%patch1_index(s) = col%patchi(c)+1 end do end do @@ -1510,76 +1510,76 @@ subroutine init_history_io(this,bounds_proc) ! PART II: USE THE JUST DEFINED DIMENSIONS TO ASSEMBLE THE VALID IO TYPES ! INTERF-TODO: THESE CAN ALL BE EMBEDDED INTO A SUBROUTINE IN HISTORYIOMOD ! ------------------------------------------------------------------------------------ - call this%fates_hio%assemble_valid_output_types() + call this%fates_hist%assemble_valid_output_types() ! ------------------------------------------------------------------------------------ ! PART III: DEFINE THE LIST OF OUTPUT VARIABLE OBJECTS, AND REGISTER THEM WITH THE ! HLM ACCORDING TO THEIR TYPES ! ------------------------------------------------------------------------------------ - call this%fates_hio%initialize_history_vars() - nvar = this%fates_hio%num_history_vars() + call this%fates_hist%initialize_history_vars() + nvar = this%fates_hist%num_history_vars() do ivar = 1, nvar - associate( vname => this%fates_hio%hvars(ivar)%vname, & - vunits => this%fates_hio%hvars(ivar)%units, & - vlong => this%fates_hio%hvars(ivar)%long, & - vdefault => this%fates_hio%hvars(ivar)%use_default, & - vavgflag => this%fates_hio%hvars(ivar)%avgflag) - - dk_index = this%fates_hio%hvars(ivar)%dim_kinds_index - ioname = trim(this%fates_hio%dim_kinds(dk_index)%name) + associate( vname => this%fates_hist%hvars(ivar)%vname, & + vunits => this%fates_hist%hvars(ivar)%units, & + vlong => this%fates_hist%hvars(ivar)%long, & + vdefault => this%fates_hist%hvars(ivar)%use_default, & + vavgflag => this%fates_hist%hvars(ivar)%avgflag) + + dk_index = this%fates_hist%hvars(ivar)%dim_kinds_index + ioname = trim(this%fates_hist%dim_kinds(dk_index)%name) select case(trim(ioname)) case(patch_r8) call hist_addfld1d(fname=trim(vname),units=trim(vunits), & avgflag=trim(vavgflag),long_name=trim(vlong), & - ptr_patch=this%fates_hio%hvars(ivar)%r81d, & + ptr_patch=this%fates_hist%hvars(ivar)%r81d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) case(site_r8) call hist_addfld1d(fname=trim(vname),units=trim(vunits), & avgflag=trim(vavgflag),long_name=trim(vlong), & - ptr_col=this%fates_hio%hvars(ivar)%r81d, & + ptr_col=this%fates_hist%hvars(ivar)%r81d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) case(patch_ground_r8) - d_index = this%fates_hio%dim_kinds(dk_index)%dim2_index - dim2name = this%fates_hio%dim_bounds(d_index)%name + d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hist%dim_bounds(d_index)%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & ! <--- addfld2d type2d=trim(dim2name), & ! <--- type2d avgflag=trim(vavgflag),long_name=trim(vlong), & - ptr_patch=this%fates_hio%hvars(ivar)%r82d, & + ptr_patch=this%fates_hist%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) case(patch_class_pft_r8) - d_index = this%fates_hio%dim_kinds(dk_index)%dim2_index - dim2name = this%fates_hio%dim_bounds(d_index)%name + d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hist%dim_bounds(d_index)%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & type2d=trim(dim2name), & avgflag=trim(vavgflag),long_name=trim(vlong), & - ptr_patch=this%fates_hio%hvars(ivar)%r82d, & + ptr_patch=this%fates_hist%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) case(site_ground_r8) - d_index = this%fates_hio%dim_kinds(dk_index)%dim2_index - dim2name = this%fates_hio%dim_bounds(d_index)%name + d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hist%dim_bounds(d_index)%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & type2d=trim(dim2name), & avgflag=trim(vavgflag),long_name=trim(vlong), & - ptr_col=this%fates_hio%hvars(ivar)%r82d, & + ptr_col=this%fates_hist%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) case(site_class_pft_r8) - d_index = this%fates_hio%dim_kinds(dk_index)%dim2_index - dim2name = this%fates_hio%dim_bounds(d_index)%name + d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hist%dim_bounds(d_index)%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & type2d=trim(dim2name), & avgflag=trim(vavgflag),long_name=trim(vlong), & - ptr_col=this%fates_hio%hvars(ivar)%r82d, & + ptr_col=this%fates_hist%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) @@ -1595,7 +1595,7 @@ end subroutine init_history_io subroutine hlm_bounds_to_fates_bounds(hlm, fates) - use HistoryIOMod, only : fates_bounds_type + use FatesHistoryInterfaceMod, only : fates_bounds_type use EDtypesMod, only : nlevsclass_ed use clm_varpar, only : mxpft, nlevgrnd From 1622c86a3399d5837462488a1129f7db7aa2233b Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Tue, 25 Oct 2016 11:58:10 -0600 Subject: [PATCH 11/13] Code cleanup for history names and whitespace Note: ammend commit, compilation errors with openmp on. Test: ERS_D_Ld5.f10_f10.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: 44aac42 Test status: pass --- .../src/ED/main/FatesHistoryDimensionMod.F90 | 12 ++--- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 28 ++++++------ .../src/ED/main/FatesHistoryVarKindMod.F90 | 28 ++++++++++-- .../src/ED/main/FatesHistoryVariableType.F90 | 45 +++++-------------- .../clm/src/utils/clmfates_interfaceMod.F90 | 26 ++++------- 5 files changed, 65 insertions(+), 74 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 b/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 index 143048eee0..a287c19aa8 100644 --- a/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 @@ -43,14 +43,14 @@ module FatesHistoryDimensionMod integer, allocatable :: clump_lower_bound(:) ! lower bound of thread's portion of HIO array integer, allocatable :: clump_upper_bound(:) ! upper bound of thread's portion of HIO array contains - procedure, public :: Init => InitHistoryDimensions - procedure, public :: SetThreadBounds => SetHistoryDimensionThreadBounds + procedure, public :: Init + procedure, public :: SetThreadBounds end type fates_history_dimension_type contains ! ===================================================================================== - subroutine InitHistoryDimensions(this, name, num_threads, lower_bound, upper_bound) + subroutine Init(this, name, num_threads, lower_bound, upper_bound) implicit none @@ -71,11 +71,11 @@ subroutine InitHistoryDimensions(this, name, num_threads, lower_bound, upper_bou allocate(this%clump_upper_bound(num_threads)) this%clump_upper_bound(:) = -1 - end subroutine InitHistoryDimensions + end subroutine Init ! ===================================================================================== - subroutine SetHistoryDimensionThreadBounds(this, thread_index, lower_bound, upper_bound) + subroutine SetThreadBounds(this, thread_index, lower_bound, upper_bound) implicit none @@ -87,6 +87,6 @@ subroutine SetHistoryDimensionThreadBounds(this, thread_index, lower_bound, uppe this%clump_lower_bound(thread_index) = lower_bound this%clump_upper_bound(thread_index) = upper_bound - end subroutine SetHistoryDimensionThreadBounds + end subroutine SetThreadBounds end module FatesHistoryDimensionMod diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index fd7e6126ad..07125e8acc 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -129,7 +129,7 @@ module FatesHistoryInterfaceMod ! The number of variable dim/kind types we have defined (static) - integer, parameter :: n_dim_kinds = 6 + integer, parameter :: fates_num_dim_kinds = 6 type, public :: fates_bounds_type integer :: patch_begin @@ -162,7 +162,7 @@ module FatesHistoryInterfaceMod ! Instanteat one registry of the different dimension/kinds (dk) ! All output variables will have a pointer to one of these dk's - type(fates_history_variable_kind_type) :: dim_kinds(n_dim_kinds) + type(fates_history_variable_kind_type) :: dim_kinds(fates_num_dim_kinds) ! This is a structure that explains where FATES patch boundaries ! on each thread point to in the host IO array, this structure is @@ -175,8 +175,8 @@ module FatesHistoryInterfaceMod integer, private :: patch_index_, column_index_, levgrnd_index_, levscpf_index_ contains - procedure, public :: Init => InitFatesHistoryOutput - procedure, public :: SetThreadBounds => SetHistoryThreadBounds + procedure, public :: Init + procedure, public :: SetThreadBounds procedure, public :: initialize_history_vars procedure, public :: assemble_valid_output_types @@ -211,7 +211,7 @@ module FatesHistoryInterfaceMod ! ====================================================================== - subroutine InitFatesHistoryOutput(this, num_threads, fates_bounds) + subroutine Init(this, num_threads, fates_bounds) use FatesHistoryDimensionMod, only : patch, column, levgrnd, levscpf @@ -247,10 +247,10 @@ subroutine InitFatesHistoryOutput(this, num_threads, fates_bounds) ! Allocate the mapping between FATES indices and the IO indices allocate(this%iovar_map(num_threads)) - end subroutine InitFatesHistoryOutput + end subroutine Init ! ====================================================================== - subroutine SetHistoryThreadBounds(this, thread_index, thread_bounds) + subroutine SetThreadBounds(this, thread_index, thread_bounds) implicit none @@ -277,13 +277,13 @@ subroutine SetHistoryThreadBounds(this, thread_index, thread_bounds) call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%pft_class_begin, thread_bounds%pft_class_end) - end subroutine SetHistoryThreadBounds + end subroutine SetThreadBounds ! =================================================================================== subroutine assemble_valid_output_types(this) - use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & - site_r8, site_ground_r8, site_class_pft_r8 + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8 + use FatesHistoryDimensionMod, only : site_r8, site_ground_r8, site_class_pft_r8 implicit none @@ -313,7 +313,7 @@ end subroutine assemble_valid_output_types subroutine set_dim_indicies(this, dk_name, idim, dim_index) - use FatesHistoryVariableType, only : iotype_index + use FatesHistoryVariableKindMod , only : iotype_index implicit none @@ -327,7 +327,7 @@ subroutine set_dim_indicies(this, dk_name, idim, dim_index) ! local integer :: ityp - ityp = iotype_index(trim(dk_name), n_dim_kinds, this%dim_kinds) + ityp = iotype_index(trim(dk_name), fates_num_dim_kinds, this%dim_kinds) ! First check to see if the dimension is allocated if (this%dim_kinds(ityp)%ndims < idim) then @@ -472,7 +472,7 @@ subroutine set_history_var(this, vname, units, long, use_default, avgflag, vtype if (initialize) then call this%hvars(ivar)%Init(vname, units, long, use_default, & - vtype, avgflag, flushval, upfreq, n_dim_kinds, this%dim_kinds, & + vtype, avgflag, flushval, upfreq, fates_num_dim_kinds, this%dim_kinds, & this%dim_bounds) end if else @@ -532,7 +532,7 @@ subroutine init_dim_kinds_maps(this) index = index + 1 call this%dim_kinds(index)%Init(site_class_pft_r8, 2) - ! FIXME(bja, 2016-10) assert(index == n_dim_kinds) + ! FIXME(bja, 2016-10) assert(index == fates_num_dim_kinds) end subroutine init_dim_kinds_maps ! ======================================================================= diff --git a/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 b/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 index 22ed6c283b..fd8bd7a871 100644 --- a/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 @@ -1,6 +1,7 @@ module FatesHistoryVariableKindMod use FatesConstantsMod, only : fates_long_string_length + use FatesGlobals, only : fates_log use FatesHistoryDimensionMod, only : fates_history_dimension_type implicit none @@ -21,7 +22,7 @@ module FatesHistoryVariableKindMod contains - procedure, public :: Init => InitVariableKind + procedure, public :: Init procedure, public :: set_active procedure, public :: is_active @@ -32,7 +33,7 @@ module FatesHistoryVariableKindMod contains ! =================================================================================== - subroutine InitVariableKind(this, name, num_dims) + subroutine Init(this, name, num_dims) use FatesConstantsMod, only : fates_unset_int @@ -50,7 +51,7 @@ subroutine InitVariableKind(this, name, num_dims) this%dim1_index = fates_unset_int this%dim2_index = fates_unset_int - end subroutine InitVariableKind + end subroutine Init ! ======================================================================= subroutine set_active(this) @@ -65,5 +66,26 @@ logical function is_active(this) is_active = this%active_ end function is_active + ! ==================================================================================== + + function iotype_index(iotype_name, num_dim_kinds, dim_kinds) result(dk_index) + + ! argument + character(len=*), intent(in) :: iotype_name + integer, intent(in) :: num_dim_kinds + type(fates_history_variable_kind_type), intent(in) :: dim_kinds(:) + + ! local + integer :: dk_index + + do dk_index=1, num_dim_kinds + if (trim(iotype_name) .eq. trim(dim_kinds(dk_index)%name)) then + return + end if + end do + write(fates_log(),*) 'An IOTYPE THAT DOESNT EXIST WAS SPECIFIED' + !end_run + + end function iotype_index end module FatesHistoryVariableKindMod diff --git a/components/clm/src/ED/main/FatesHistoryVariableType.F90 b/components/clm/src/ED/main/FatesHistoryVariableType.F90 index 54558a5420..a2b41f0548 100644 --- a/components/clm/src/ED/main/FatesHistoryVariableType.F90 +++ b/components/clm/src/ED/main/FatesHistoryVariableType.F90 @@ -31,19 +31,21 @@ module FatesHistoryVariableType integer, pointer :: int2d(:,:) integer, pointer :: int3d(:,:,:) contains - procedure, public :: Init => InitHistoryVariableType + procedure, public :: Init procedure, public :: Flush procedure, private :: GetBounds end type fates_history_variable_type contains - subroutine InitHistoryVariableType(this, vname, units, long, use_default, & - vtype, avgflag, flushval, upfreq, n_dim_kinds, dim_kinds, dim_bounds) + subroutine Init(this, vname, units, long, use_default, & + vtype, avgflag, flushval, upfreq, num_dim_kinds, dim_kinds, dim_bounds) use FatesHistoryDimensionMod, only : fates_history_dimension_type - use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & - site_r8, site_ground_r8, site_class_pft_r8 + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8 + use FatesHistoryDimensionMod, only : site_r8, site_ground_r8, site_class_pft_r8 + + use FatesHistoryVariableKindMod, only : iotype_index implicit none @@ -56,7 +58,7 @@ subroutine InitHistoryVariableType(this, vname, units, long, use_default, & character(len=*), intent(in) :: avgflag real(r8), intent(in) :: flushval ! If the type is an int we will round with nint integer, intent(in) :: upfreq - integer, intent(in) :: n_dim_kinds + integer, intent(in) :: num_dim_kinds type(fates_history_dimension_type), intent(in) :: dim_bounds(:) type(fates_history_variable_kind_type), intent(inout) :: dim_kinds(:) @@ -79,7 +81,7 @@ subroutine InitHistoryVariableType(this, vname, units, long, use_default, & nullify(this%int2d) nullify(this%int3d) - dk_index = iotype_index(trim(vtype), n_dim_kinds, dim_kinds) + dk_index = iotype_index(trim(vtype), num_dim_kinds, dim_kinds) this%dim_kinds_index = dk_index call dim_kinds(dk_index)%set_active() @@ -123,7 +125,7 @@ subroutine InitHistoryVariableType(this, vname, units, long, use_default, & ! end_run end select - end subroutine InitHistoryVariableType + end subroutine Init ! ===================================================================================== @@ -179,8 +181,8 @@ end subroutine GetBounds subroutine Flush(this, thread, dim_bounds, dim_kinds) use FatesHistoryDimensionMod, only : fates_history_dimension_type - use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & - site_r8, site_ground_r8, site_class_pft_r8, patch_int + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8 + use FatesHistoryDimensionMod, only : site_r8, site_ground_r8, site_class_pft_r8, patch_int implicit none @@ -216,27 +218,4 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) end subroutine Flush - ! ==================================================================================== - - function iotype_index(iotype_name, n_dim_kinds, dim_kinds) result(dk_index) - - ! argument - character(len=*), intent(in) :: iotype_name - integer, intent(in) :: n_dim_kinds - type(fates_history_variable_kind_type), intent(in) :: dim_kinds(:) - - ! local - integer :: dk_index - - do dk_index=1, n_dim_kinds - if (trim(iotype_name) .eq. trim(dim_kinds(dk_index)%name)) then - return - end if - end do - write(fates_log(),*) 'An IOTYPE THAT DOESNT EXIST WAS SPECIFIED' - !end_run - - end function iotype_index - - end module FatesHistoryVariableType diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index d42dbe8a48..6c538b888f 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -172,7 +172,7 @@ module CLMFatesInterfaceMod ! ==================================================================================== - subroutine init(this,bounds_proc, use_ed) + subroutine init(this, bounds_proc, use_ed) ! --------------------------------------------------------------------------------- ! This initializes the dlm_fates_interface_type @@ -255,8 +255,7 @@ subroutine init(this,bounds_proc, use_ed) write(iulog,*) 'clm_fates%init(): allocating for ',nclumps,' threads' end if - return - end subroutine init + end subroutine init ! ==================================================================================== @@ -414,8 +413,6 @@ subroutine check_hlm_active(this, nc, bounds_clump) end if end do - - end subroutine check_hlm_active ! ------------------------------------------------------------------------------------ @@ -635,7 +632,6 @@ subroutine wrap_update_hlmfates_dyn(this, nc, bounds_clump, & end do end associate - return end subroutine wrap_update_hlmfates_dyn ! ------------------------------------------------------------------------------------ @@ -691,8 +687,7 @@ subroutine init_restart(this, ncid, flag, waterstate_inst, canopystate_inst ) end do !$OMP END PARALLEL DO - - return + end subroutine init_restart ! ==================================================================================== @@ -756,7 +751,7 @@ subroutine init_coldstart(this, waterstate_inst, canopystate_inst) end if end do !$OMP END PARALLEL DO - return + end subroutine init_coldstart ! ====================================================================================== @@ -847,7 +842,7 @@ subroutine wrap_sunfrac(this,nc,atm2lnd_inst,canopystate_inst) end do end associate - return + end subroutine wrap_sunfrac ! =================================================================================== @@ -1044,7 +1039,7 @@ subroutine wrap_btran(this,nc,fn,filterc,soilstate_inst, waterstate_inst, & end do end do end associate - return + end subroutine wrap_btran ! ==================================================================================== @@ -1174,7 +1169,7 @@ subroutine wrap_photosynthesis(this, nc, bounds, fn, filterp, & end associate call t_stopf('edpsn') - return + end subroutine wrap_photosynthesis ! ====================================================================================== @@ -1215,8 +1210,6 @@ subroutine wrap_accumulatefluxes(this, nc, fn, filterp) this%fates(nc)%sites, & dtime) - return - end subroutine wrap_accumulatefluxes ! ====================================================================================== @@ -1303,7 +1296,6 @@ subroutine wrap_canopy_radiation(this, bounds_clump, nc, & end associate - return end subroutine wrap_canopy_radiation ! ====================================================================================== @@ -1344,7 +1336,6 @@ subroutine wrap_litter_fluxout(this, nc, bounds_clump, canopystate_inst, soilbio soilbiogeochem_carbonflux_inst%FATES_c_to_litr_lig_c_col(c,:) = this%fates(nc)%bc_out(s)%FATES_c_to_litr_lig_c_col(:) end do - end subroutine wrap_litter_fluxout ! ====================================================================================== @@ -1403,7 +1394,6 @@ subroutine wrap_bgc_summary(this, nc, soilbiogeochem_carbonflux_inst, & end associate - return end subroutine wrap_bgc_summary ! ====================================================================================== @@ -1457,7 +1447,7 @@ subroutine init_history_io(this,bounds_proc) ! module, and a new explicitly named instance of that type should be created. ! With this new dimension, a new output type/kind can contain that dimension. ! A new type/kind can be added to the dim_kinds structure, which defines its members - ! in created in init_dim_kinds_maps(). Make sure to increase the size of n_dim_kinds. + ! in created in init_dim_kinds_maps(). Make sure to increase the size of fates_num_dim_kinds. ! A type/kind of output is defined by the data type (ie r8,int,..) ! and the dimensions. Keep in mind that 3D variables (or 4D if you include time) ! are not really supported in CLM/ALM right now. There are ways around this From f835a812935ce83c64411b14bce8da04436db2c5 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Tue, 25 Oct 2016 13:21:51 -0600 Subject: [PATCH 12/13] Bugfix: remove old variable from OpenMP pragmas to fix compilation error. Tests: ERP_D_Ld3_P15x2.f10_f10.ICLM45BGC.yellowstone_intel.clm-default ERP_D_Ld3_P15x2.f10_f10.ICLM45BGC.yellowstone_gnu.clm-default Test baseline: 44aac42 Test status: pass Test suite: ed - yellowstone gnu, intel, pgi Test baseline: 44aac42 Test status: all tests pass Test suite: ed - hobart nag Test baseline: none Test status: all tests pass Test suite: clm_short - yellowstone gnu, intel, pgi Test baseline: clm4_5_12_r195 Test status: all tests pass --- components/clm/src/utils/clmfates_interfaceMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 6c538b888f..8dd309ab7d 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -1460,7 +1460,7 @@ subroutine init_history_io(this,bounds_proc) call this%fates_hist%Init(nclumps, fates_bounds) ! Define the bounds on the first dimension for each thread - !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,fates_clump,s,c,num_sites) + !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,fates_clump,s,c) do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) @@ -1479,7 +1479,7 @@ subroutine init_history_io(this,bounds_proc) allocate(this%fates_hist%iovar_map(nclumps)) - !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,fates_clump,s,c,num_sites) + !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,fates_clump,s,c) do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) From 8c9fc5a0c846f658c3d7ff59e8af1899e0b15c2f Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Wed, 2 Nov 2016 15:54:31 -0600 Subject: [PATCH 13/13] Fix typo and naming issue found during code review. Testing: Test: SMS_D_Ld5.f10_f10.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: 53bbb9d Test status: pass Test suite: ed - yellowstone gnu, intel, pgi Test baseline: 53bbb9d Test status: all tests pass Test suite: ed - hobart nag Test baseline: none, previous master did not run under nag. Test status: all tests pass Test suite: clm_shorts - yellowstone gnu, intel, pgi Test baseline: clm4_5_12_r195 Test status: all tests pass --- .../src/ED/main/FatesHistoryDimensionMod.F90 | 4 +- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 92 +++++++++---------- .../src/ED/main/FatesHistoryVariableType.F90 | 16 ++-- .../clm/src/utils/clmfates_interfaceMod.F90 | 8 +- 4 files changed, 60 insertions(+), 60 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 b/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 index a287c19aa8..d980f84093 100644 --- a/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 @@ -7,10 +7,10 @@ module FatesHistoryDimensionMod ! FIXME(bja, 2016-10) do these need to be strings, or can they be integer enumerations? character(*), parameter :: patch_r8 = 'PA_R8' character(*), parameter :: patch_ground_r8 = 'PA_GRND_R8' - character(*), parameter :: patch_class_pft_r8 = 'PA_SCPF_R8' + character(*), parameter :: patch_size_pft_r8 = 'PA_SCPF_R8' character(*), parameter :: site_r8 = 'SI_R8' character(*), parameter :: site_ground_r8 = 'SI_GRND_R8' - character(*), parameter :: site_class_pft_r8 = 'SI_SCPF_R8' + character(*), parameter :: site_size_pft_r8 = 'SI_SCPF_R8' character(*), parameter :: patch_int = 'PA_INT' integer, parameter :: fates_num_dimension_types = 4 diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index b8a9463834..77aace9d47 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -202,7 +202,7 @@ module FatesHistoryInterfaceMod procedure, private :: define_history_vars procedure, private :: set_history_var procedure, private :: init_dim_kinds_maps - procedure, private :: set_dim_indicies + procedure, private :: set_dim_indices procedure, private :: flush_hvars procedure, private :: set_patch_index @@ -289,8 +289,8 @@ end subroutine SetThreadBounds ! =================================================================================== subroutine assemble_valid_output_types(this) - use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8 - use FatesHistoryDimensionMod, only : site_r8, site_ground_r8, site_class_pft_r8 + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 + use FatesHistoryDimensionMod, only : site_r8, site_ground_r8, site_size_pft_r8 implicit none @@ -298,27 +298,27 @@ subroutine assemble_valid_output_types(this) call this%init_dim_kinds_maps() - call this%set_dim_indicies(patch_r8, 1, this%patch_index()) + call this%set_dim_indices(patch_r8, 1, this%patch_index()) - call this%set_dim_indicies(site_r8, 1, this%column_index()) + call this%set_dim_indices(site_r8, 1, this%column_index()) - call this%set_dim_indicies(patch_ground_r8, 1, this%patch_index()) - call this%set_dim_indicies(patch_ground_r8, 2, this%levgrnd_index()) + call this%set_dim_indices(patch_ground_r8, 1, this%patch_index()) + call this%set_dim_indices(patch_ground_r8, 2, this%levgrnd_index()) - call this%set_dim_indicies(site_ground_r8, 1, this%column_index()) - call this%set_dim_indicies(site_ground_r8, 2, this%levgrnd_index()) + call this%set_dim_indices(site_ground_r8, 1, this%column_index()) + call this%set_dim_indices(site_ground_r8, 2, this%levgrnd_index()) - call this%set_dim_indicies(patch_class_pft_r8, 1, this%patch_index()) - call this%set_dim_indicies(patch_class_pft_r8, 2, this%levscpf_index()) + call this%set_dim_indices(patch_size_pft_r8, 1, this%patch_index()) + call this%set_dim_indices(patch_size_pft_r8, 2, this%levscpf_index()) - call this%set_dim_indicies(site_class_pft_r8, 1, this%column_index()) - call this%set_dim_indicies(site_class_pft_r8, 2, this%levscpf_index()) + 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()) end subroutine assemble_valid_output_types ! =================================================================================== - subroutine set_dim_indicies(this, dk_name, idim, dim_index) + subroutine set_dim_indices(this, dk_name, idim, dim_index) use FatesHistoryVariableKindMod , only : iotype_index @@ -355,7 +355,7 @@ subroutine set_dim_indicies(this, dk_name, idim, dim_index) this%dim_kinds(ityp)%dimsize(idim) = this%dim_bounds(dim_index)%upper_bound - & this%dim_bounds(dim_index)%lower_bound + 1 - end subroutine set_dim_indicies + end subroutine set_dim_indices ! ======================================================================= subroutine set_patch_index(this, index) @@ -504,8 +504,8 @@ subroutine init_dim_kinds_maps(this) ! number of entries listed here. ! ! ---------------------------------------------------------------------------------- - use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & - site_r8, site_ground_r8, site_class_pft_r8 + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8, & + site_r8, site_ground_r8, site_size_pft_r8 implicit none @@ -529,7 +529,7 @@ subroutine init_dim_kinds_maps(this) ! patch x size-class/pft index = index + 1 - call this%dim_kinds(index)%Init(patch_class_pft_r8, 2) + call this%dim_kinds(index)%Init(patch_size_pft_r8, 2) ! site x ground index = index + 1 @@ -537,7 +537,7 @@ subroutine init_dim_kinds_maps(this) ! site x size-class/pft index = index + 1 - call this%dim_kinds(index)%Init(site_class_pft_r8, 2) + call this%dim_kinds(index)%Init(site_size_pft_r8, 2) ! FIXME(bja, 2016-10) assert(index == fates_num_dim_kinds) end subroutine init_dim_kinds_maps @@ -1128,8 +1128,8 @@ subroutine define_history_vars(this, initialize_variables) ! a real. The applied flush value will use the NINT() intrinsic function ! --------------------------------------------------------------------------------- - use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & - site_r8, site_ground_r8, site_class_pft_r8 + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8, & + site_r8, site_ground_r8, site_size_pft_r8 implicit none class(fates_history_interface_type), intent(inout) :: this @@ -1354,130 +1354,130 @@ 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', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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='NPP_SCPF', units='kgC/m2/yr', & long='total net primary production', use_default='inactive', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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='BA_SCPF', units = 'm2/ha', & long='basal area by patch and pft/size', use_default='inactive', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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 count by patch and pft/size', use_default='inactive', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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', & - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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 ) ! 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',& - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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',& - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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',& - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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',& - avgflag='A', vtype=site_class_pft_r8,hlms='CLM:ALM', flushval=0.0_r8, & + 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',& - avgflag='A', vtype=site_class_pft_r8,hlms='CLM:ALM', flushval=0.0_r8, & + 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',& - avgflag='A', vtype=site_class_pft_r8,hlms='CLM:ALM', flushval=0.0_r8, & + 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',& - avgflag='A', vtype=site_class_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + 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 ) diff --git a/components/clm/src/ED/main/FatesHistoryVariableType.F90 b/components/clm/src/ED/main/FatesHistoryVariableType.F90 index a2b41f0548..218950432f 100644 --- a/components/clm/src/ED/main/FatesHistoryVariableType.F90 +++ b/components/clm/src/ED/main/FatesHistoryVariableType.F90 @@ -42,8 +42,8 @@ subroutine Init(this, vname, units, long, use_default, & vtype, avgflag, flushval, upfreq, num_dim_kinds, dim_kinds, dim_bounds) use FatesHistoryDimensionMod, only : fates_history_dimension_type - use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8 - use FatesHistoryDimensionMod, only : site_r8, site_ground_r8, site_class_pft_r8 + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 + use FatesHistoryDimensionMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesHistoryVariableKindMod, only : iotype_index @@ -106,7 +106,7 @@ subroutine Init(this, vname, units, long, use_default, & allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval - case(patch_class_pft_r8) + case(patch_size_pft_r8) allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval @@ -114,7 +114,7 @@ subroutine Init(this, vname, units, long, use_default, & allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval - case(site_class_pft_r8) + case(site_size_pft_r8) allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval @@ -181,8 +181,8 @@ end subroutine GetBounds subroutine Flush(this, thread, dim_bounds, dim_kinds) use FatesHistoryDimensionMod, only : fates_history_dimension_type - use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8 - use FatesHistoryDimensionMod, only : site_r8, site_ground_r8, site_class_pft_r8, patch_int + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 + use FatesHistoryDimensionMod, only : site_r8, site_ground_r8, site_size_pft_r8, patch_int implicit none @@ -202,11 +202,11 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) this%r81d(lb1:ub1) = this%flushval case(patch_ground_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval - case(patch_class_pft_r8) + case(patch_size_pft_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_ground_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval - case(site_class_pft_r8) + case(site_size_pft_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(patch_int) this%int1d(lb1:ub1) = nint(this%flushval) diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 852825dbd9..963d013e37 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -1403,8 +1403,8 @@ subroutine init_history_io(this,bounds_proc) use FatesConstantsMod, only : fates_short_string_length, fates_long_string_length use FatesHistoryInterfaceMod, only : fates_bounds_type - use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_class_pft_r8, & - site_r8, site_ground_r8, site_class_pft_r8 + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8, & + site_r8, site_ground_r8, site_size_pft_r8 ! Arguments @@ -1544,7 +1544,7 @@ subroutine init_history_io(this,bounds_proc) default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case(patch_class_pft_r8) + case(patch_size_pft_r8) d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index dim2name = this%fates_hist%dim_bounds(d_index)%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & @@ -1562,7 +1562,7 @@ subroutine init_history_io(this,bounds_proc) ptr_col=this%fates_hist%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case(site_class_pft_r8) + case(site_size_pft_r8) d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index dim2name = this%fates_hist%dim_bounds(d_index)%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), &