refac(data_partition_t):make bin array a component

Author: rouson

src/sourcery/sourcery_data_partition_m.f90

@@ -2,6 +2,7 @@ module sourcery_data_partition_m
   !! distribute data identification numbers across images such that the number of
   !! items differs by at most 1 between any two images.
   use iso_fortran_env, only : real32, real64
+  use sourcery_bin_m, only : bin_t
   implicit none
 
   private
@@ -10,31 +11,36 @@ module sourcery_data_partition_m
   type data_partition_t
     !! encapsulate a description of the data subset the executing image owns
     private
+    type(bin_t), allocatable :: bin(:)
   contains
-    procedure, nopass :: define_partitions
-    procedure, nopass :: first
-    procedure, nopass :: last
-    procedure, nopass, private :: gather_real32_2D_array, gather_real64_2D_array,  gather_real32_1D_array, gather_real64_1D_array
+    procedure :: define_partitions
+    procedure :: first
+    procedure :: last
+    procedure, private :: gather_real32_2D_array, gather_real64_2D_array,  gather_real32_1D_array, gather_real64_1D_array
     generic :: gather => gather_real32_2D_array, gather_real64_2D_array,  gather_real32_1D_array, gather_real64_1D_array
   end type
 
   interface
 
-    module subroutine define_partitions(cardinality)
+    module subroutine define_partitions(self, cardinality)
       !! define the range of data identification numbers owned by the executing image
+      implicit none
+      class(data_partition_t), intent(out) :: self
       integer, intent(in) :: cardinality
     end subroutine
 
-    pure module function first(image_number) result(first_index)
+    pure module function first(self, image_number) result(first_index)
       !! the result is the first identification number owned by the executing image
       implicit none
+      class(data_partition_t), intent(in) :: self
       integer, intent(in), optional :: image_number
       integer first_index
     end function
 
-    pure module function last(image_number) result(last_index)
+    pure module function last(self, image_number) result(last_index)
       !! the result is the last identification number owned by the executing image
       implicit none
+      class(data_partition_t), intent(in) :: self
       integer, intent(in), optional :: image_number
       integer last_index
     end function
@@ -43,29 +49,37 @@ pure module function last(image_number) result(last_index)
     !! 1. Near the beginning/end of execution to amortize costs across an entire run or
     !! 2. Temporarily while developing/debugging code.
 
-    module subroutine gather_real32_1D_array( a, result_image, dim )
+    module subroutine gather_real32_1D_array(self, a, result_image, dim )
       !! Gather the elements of an 1D array distributed along dimension dim onto result_image
+      implicit none
+      class(data_partition_t), intent(in) :: self
       real(real32), intent(inout) :: a(:)
       integer, intent(in), optional :: result_image
       integer, intent(in), optional :: dim
     end subroutine
 
-    module subroutine gather_real64_1D_array( a, result_image, dim )
+    module subroutine gather_real64_1D_array(self, a, result_image, dim )
       !! Gather the elements of an 1D array distributed along dimension dim onto result_image
+      implicit none
+      class(data_partition_t), intent(in) :: self
       real(real64), intent(inout) :: a(:)
       integer, intent(in), optional :: result_image
       integer, intent(in), optional :: dim
     end subroutine
 
-    module subroutine gather_real32_2D_array( a, result_image, dim )
+    module subroutine gather_real32_2D_array(self, a, result_image, dim )
       !! Gather the elements of an 2D array distributed along dimension dim onto result_image
+      implicit none
+      class(data_partition_t), intent(in) :: self
       real(real32), intent(inout) :: a(:,:)
       integer, intent(in), optional :: result_image
       integer, intent(in), optional :: dim
     end subroutine
 
-    module subroutine gather_real64_2D_array( a, result_image, dim )
+    module subroutine gather_real64_2D_array(self, a, result_image, dim )
       !! Gather the elements of an 2D array distributed along dimension dim onto result_image
+      implicit none
+      class(data_partition_t), intent(in) :: self
       real(real64), intent(inout) :: a(:,:)
       integer, intent(in), optional :: result_image
       integer, intent(in), optional :: dim

src/sourcery/sourcery_data_partition_s.f90

@@ -1,42 +1,40 @@
 submodule(sourcery_data_partition_m) sourcery_data_partition_s
   use assert_m, only : assert
-  use sourcery_bin_m, only : bin_t
   implicit none
 
   logical, parameter :: verbose=.false.
-  type(bin_t), allocatable :: bin(:)
 
 contains
 
   module procedure define_partitions
     integer image
-    bin = [( bin_t(num_items=cardinality, num_bins=num_images(), bin_number=image), image=1,num_images() )]
+    self%bin = [( bin_t(num_items=cardinality, num_bins=num_images(), bin_number=image), image=1,num_images() )]
   end procedure
 
   module procedure first
     integer image
 
-    call assert( allocated(bin), "data_partition_s(first): allocated(bin)")
+    call assert( allocated(self%bin), "data_partition_s(first): allocated(self%bin)")
 
     if (present(image_number)) then
       image = image_number
     else
       image = this_image()
     end if
-    first_index = bin(image)%first()
+    first_index = self%bin(image)%first()
   end procedure
 
   module procedure last
     integer image
 
-    call assert( allocated(bin), "data_partition_s(last): allocated(bin)")
+    call assert( allocated(self%bin), "data_partition_s(last): allocated(self%in)")
 
     if (present(image_number)) then
       image = image_number
     else
       image = this_image()
     end if
-    last_index = bin(image)%last()
+    last_index = self%bin(image)%last()
   end procedure
 
   module procedure gather_real32_1D_array
@@ -48,7 +46,7 @@
         write(6,*) 'gather_real_1D_array(): executing on image', me
         flush(6)
       end if
-      associate( first=>first(me), last=>last(me) )
+      associate(first=>self%first(me), last=>self%last(me))
         if (.not. present(result_image)) then
           a(1:first-1)  = 0.
           a(last+1:)  = 0.
@@ -80,7 +78,7 @@
         write(6,*) 'gather_real_1D_array(): executing on image', me
         flush(6)
       end if
-      associate( first=>first(me), last=>last(me) )
+      associate(first=>self%first(me), last=>self%last(me))
         if (.not. present(result_image)) then
           a(1:first-1)  = 0.
           a(last+1:)  = 0.
@@ -117,7 +115,7 @@
         write(6,*) 'gather_real32_2D_array(): executing on image', me
         flush(6)
       end if
-      associate( first => first(me), last => last(me) )
+      associate(first=>self%first(me), last=>self%last(me))
         if (.not. present(result_image)) then
           select case(dim_)
             case(1)
@@ -182,7 +180,7 @@
         write(6,*) 'gather_real64_2D_array(): executing on image', me
         flush(6)
       end if
-      associate( first => first(me), last => last(me) )
+      associate(first => self%first(me), last => self%last(me))
         if (.not. present(result_image)) then
           select case(dim_)
             case(1)

test/data_partition_test.f90

@@ -26,24 +26,18 @@ pure function subject() result(specimen)
   function results() result(test_results)
     type(test_result_t), allocatable :: test_results(:)
 
-    call partition%define_partitions(cardinality=num_particles)
-
-    associate( me=>this_image() )
-      associate( my_first=>partition%first(me), my_last=>partition%last(me) )
-        test_results = [ &
-          test_result_t("partitioning data in nearly even blocks", verify_block_partitioning()), &
-          test_result_t("default image_number is this_image()", verify_default_image_number()), &
-          test_result_t("partitioning all data across all images without data loss", verify_all_particles_partitioned()), &
-          test_result_t("gathering a 1D real array onto all images", verify_all_gather_1D_real_array()), &
-          test_result_t("gathering dimension 1 of 2D real array onto all images witout dim argument", &
-            verify_all_gather_2D_real_array()), &
-          test_result_t("gathering dimension 1 of 2D real array onton all images with dim argument", &
-            verify_all_gather_2D_real_array_dim1()), &
-          test_result_t("gathering dimension 1 of 2D real array onto result_image with dim argument", &
-            verify_gather_2D_real_array_dim1()) &
-        ]
-      end associate
-    end associate
+    test_results = [ &
+      test_result_t("partitioning data in nearly even blocks", verify_block_partitioning()), &
+      test_result_t("default image_number is this_image()", verify_default_image_number()), &
+      test_result_t("partitioning all data across all images without data loss", verify_all_particles_partitioned()), &
+      test_result_t("gathering a 1D real array onto all images", verify_all_gather_1D_real_array()), &
+      test_result_t("gathering dimension 1 of 2D real array onto all images witout dim argument", &
+        verify_all_gather_2D_real_array()), &
+      test_result_t("gathering dimension 1 of 2D real array onton all images with dim argument", &
+        verify_all_gather_2D_real_array_dim1()), &
+      test_result_t("gathering dimension 1 of 2D real array onto result_image with dim argument", &
+        verify_gather_2D_real_array_dim1()) &
+    ]
   end function
 
   function verify_block_partitioning() result(test_passes)
@@ -53,6 +47,8 @@ function verify_block_partitioning() result(test_passes)
     logical test_passes
     integer my_particles
 
+    call partition%define_partitions(cardinality=num_particles)
+
     associate( me=>this_image() )
       associate( my_first=>partition%first(me), my_last=>partition%last(me) )
         my_particles = my_last - my_first + 1
@@ -63,13 +59,16 @@ function verify_block_partitioning() result(test_passes)
         end associate
       end associate
     end associate
+
   end function
 
   function verify_default_image_number() result(test_passes)
     !! Verify that the first and last functions assume image_number == this_image() if image_number is not  present
     type(data_partition_t) partition
     logical test_passes
 
+    call partition%define_partitions(cardinality=num_particles)
+
     associate( me=>this_image() )
       test_passes = partition%first() == partition%first(me) .and.partition%last() == partition%last(me)
     end associate
@@ -82,6 +81,8 @@ function verify_all_particles_partitioned() result(test_passes)
     logical test_passes
     integer particles
 
+    call partition%define_partitions(cardinality=num_particles)
+
     associate(me => this_image())
       associate( my_first=>partition%first(me), my_last=>partition%last(me) )
         particles = my_last - my_first + 1
@@ -97,6 +98,8 @@ function verify_all_gather_1D_real_array() result(test_passes)
    real(real64) :: particle_scalar(num_particles)
    real(real64), parameter :: junk=-12345._real64, expected=1._real64
 
+   call partition%define_partitions(cardinality=num_particles)
+
    associate(me => this_image())
      associate( first=>partition%first(me), last=>partition%last(me) )
        particle_scalar(first:last) = expected !! values to be gathered
@@ -115,6 +118,8 @@ function verify_all_gather_2D_real_array() result(test_passes)
    real(real64) particle_vector(vec_space_dim, num_particles)
    real(real64), parameter :: junk=-12345._real64, expected=1._real64
 
+   call partition%define_partitions(cardinality=num_particles)
+
    associate(me => this_image())
      associate( first=>partition%first(me), last=>partition%last(me) )
 
@@ -134,6 +139,8 @@ function verify_all_gather_2D_real_array_dim1() result(test_passes)
    real(real64) :: vector_transpose(num_particles, vec_space_dim)
    real(real64), parameter :: junk=-12345._real64, expected=1._real64
 
+   call partition%define_partitions(cardinality=num_particles)
+
    associate(me => this_image())
      associate( first=>partition%first(me), last=>partition%last(me) )
 
@@ -156,6 +163,8 @@ function verify_gather_2D_real_array_dim1() result(test_passes)
    real(real64) :: vector_transpose(num_particles, vec_space_dim)
    real(real64), parameter :: junk=-12345._real64, expected=1._real64
 
+   call partition%define_partitions(cardinality=num_particles)
+
    associate(me => this_image())
      associate( first=>partition%first(me), last=>partition%last(me) )