Merge pull request #286 from rgknox/rgknox-threadfix

bug fixes to multi-threading

main/FatesHistoryInterfaceMod.F90

@@ -870,20 +870,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
 
 
   ! =====================================================================================
@@ -916,7 +913,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
 
@@ -1111,7 +1107,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)
@@ -1136,7 +1132,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
 
@@ -1895,7 +1890,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)
@@ -2253,7 +2247,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

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

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