From 4f6a3429b2d316b3a7b2ab854931af9f1055df6c Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 5 Oct 2017 15:57:04 -0700 Subject: [PATCH] bug fixes: dimension structure incorrectly defined as a class instead of type, unused hvar pointers and weird association statement. --- main/FatesHistoryInterfaceMod.F90 | 19 ++++++------------- main/FatesHistoryVariableType.F90 | 9 ++++++--- main/FatesRestartVariableType.F90 | 2 +- 3 files changed, 13 insertions(+), 17 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 5afa5cff..08828774 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -869,20 +869,17 @@ subroutine flush_hvars(this,nc,upfreq_in) class(fates_history_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) - 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 + if (this%hvars(ivar)%upfreq == upfreq_in) then ! Only flush variables with update on dynamics step + call this%hvars(ivar)%flush(nc, this%dim_bounds, this%dim_kinds) + + end if end do - end subroutine flush_hvars +end subroutine flush_hvars ! ===================================================================================== @@ -915,7 +912,6 @@ subroutine set_history_var(this, vname, units, long, use_default, avgflag, vtype ! not used ! locals - type(fates_history_variable_type), pointer :: hvar integer :: ub1, lb1, ub2, lb2 ! Bounds for allocating the var integer :: ityp @@ -1110,7 +1106,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) use EDTypesMod , only : nlevleaf ! Arguments - class(fates_history_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) @@ -1135,7 +1131,6 @@ 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(fates_history_variable_type),pointer :: hvar type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -1888,7 +1883,6 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) real(r8), parameter :: tiny = 1.e-5_r8 ! some small number integer :: ipa2 ! patch incrementer integer :: cnlfpft_indx, cnlf_indx, ipft, ican, ileaf ! more iterators and indices - type(fates_history_variable_type),pointer :: hvar type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort real(r8) :: per_dt_tstep ! Time step in frequency units (/s) @@ -2246,7 +2240,6 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,dt_tstep) integer :: ipa2 ! patch incrementer integer :: iscpf ! index of the scpf group - type(fates_history_variable_type),pointer :: hvar type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort type(ed_cohort_hydr_type), pointer :: ccohort_hydr diff --git a/main/FatesHistoryVariableType.F90 b/main/FatesHistoryVariableType.F90 index e7653106..86b9a4f8 100644 --- a/main/FatesHistoryVariableType.F90 +++ b/main/FatesHistoryVariableType.F90 @@ -89,7 +89,7 @@ subroutine Init(this, vname, units, long, use_default, & call dim_kinds(dk_index)%set_active() 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 ! may be redundant, but will prevent issues in the future if we @@ -167,7 +167,7 @@ subroutine Init(this, vname, units, long, use_default, & end subroutine Init ! ===================================================================================== - + subroutine GetBounds(this, thread, dim_bounds, dim_kinds, lb1, ub1, lb2, ub2) use FatesIODimensionsMod, only : fates_io_dimension_type @@ -176,7 +176,7 @@ subroutine GetBounds(this, thread, dim_bounds, dim_kinds, lb1, ub1, lb2, ub2) class(fates_history_variable_type), intent(inout) :: this integer, intent(in) :: thread - class(fates_io_dimension_type), intent(in) :: dim_bounds(:) + type(fates_io_dimension_type), intent(in) :: dim_bounds(:) type(fates_io_variable_kind_type), intent(in) :: dim_kinds(:) integer, intent(out) :: lb1 integer, intent(out) :: ub1 @@ -205,14 +205,17 @@ subroutine GetBounds(this, thread, dim_bounds, dim_kinds, lb1, ub1, lb2, ub2) ub2 = dim_bounds(d_index)%upper_bound end if else + 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 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 diff --git a/main/FatesRestartVariableType.F90 b/main/FatesRestartVariableType.F90 index 40648fb4..48152adf 100644 --- a/main/FatesRestartVariableType.F90 +++ b/main/FatesRestartVariableType.F90 @@ -118,7 +118,7 @@ subroutine GetBounds(this, thread, dim_bounds, dim_kinds, lb1, ub1, lb2, ub2) class(fates_restart_variable_type), intent(inout) :: this integer, intent(in) :: thread - class(fates_io_dimension_type), intent(in) :: dim_bounds(:) + type(fates_io_dimension_type), intent(in) :: dim_bounds(:) type(fates_io_variable_kind_type), intent(in) :: dim_kinds(:) integer, intent(out) :: lb1 integer, intent(out) :: ub1