Merge pull request #54 from sourceryinstitute/encapsulate-bin-array

Encapsulate bin array

Author: rouson

.github/workflows/CI.yml

@@ -8,7 +8,7 @@ jobs:
 
     env:
       FC: gfortran
-      GCC_V: 12
+      GCC_V: 13
 
     steps:
     - name: Checkout code
@@ -29,7 +29,7 @@ jobs:
       id: cache-opencoarrays
       uses: actions/cache@v3
       with:
-        path: "OpenCoarrays-2.10.0/"
+        path: "OpenCoarrays-2.10.1/"
         key: ${{ steps.time.outputs.time }}
 
     - name: Install GFortran, OpenCoarrays
@@ -39,9 +39,9 @@ jobs:
         sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-${GCC_V} 100 \
           --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${GCC_V} \
           --slave /usr/bin/g++ g++ /usr/bin/g++-${GCC_V}
-        if [ ! -d OpenCoarrays-2.10.0 ] ; then wget -P . https://github.com/sourceryinstitute/OpenCoarrays/releases/download/2.10.0/OpenCoarrays-2.10.0.tar.gz && tar -xf OpenCoarrays-2.10.0.tar.gz && cd OpenCoarrays-2.10.0 && TERM=xterm ./install.sh -y; fi
+        if [ ! -d OpenCoarrays-2.10.1 ] ; then wget -P . https://github.com/sourceryinstitute/OpenCoarrays/releases/download/2.10.1/OpenCoarrays-2.10.1.tar.gz && tar -xf OpenCoarrays-2.10.1.tar.gz && cd OpenCoarrays-2.10.1 && TERM=xterm ./install.sh -y; fi
 
     - name: Build, run, and test
       run: |
-        source OpenCoarrays-2.10.0/prerequisites/installations/opencoarrays/2.10.0/setup.sh
+        source OpenCoarrays-2.10.1/prerequisites/installations/opencoarrays/2.10.1/setup.sh
         fpm test --compiler caf --runner "cafrun -n 2" 

README.md

@@ -64,12 +64,15 @@ See the [Sourcery GitHub Pages site] for HTML documentation generated with [`for
 
 Prerequisites
 -------------
-[FORD] 6.1.0 or later is required for producing HTML documentation (see
-"[Building the documentation]" below for instructions).  The Fortran Package
-Manager ([fpm]) is required to build Sourcery from source.  See the
-[fpm manifest](./fpm.toml) for the dependencies and developer dependencies,
-all of which [fpm] automatically downloads and builds via the `fpm` command
-provided in the "[Downloding, Building, and Testing]" section below.
+* [FORD] 6.1.0 or later is required for producing HTML documentation (see
+"[Building the documentation]" below for instructions).  
+* The Fortran Package Manager ([fpm]) is required to build Sourcery from source.
+* GCC (`gfortran`) 13.1.0
+* OpenCoarrays 2.10.1 for parallel execution
+
+See [fpm manifest](./fpm.toml) for the dependencies and developer dependencies,
+that [fpm] automatically downloads and builds via the `fpm` command provided in
+the "[Downloding, Building, and Testing]" section below.
 
 
 Downloding, Building, and Testing

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,46 @@ 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 data_partition_t
+
+    pure module function construct(cardinality) result(data_partition)
+      implicit none
+      type(data_partition_t) data_partition
+      integer, intent(in) :: cardinality
+    end function
+
+  end interface
+
   interface
 
-    module subroutine define_partitions(cardinality)
+    pure 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(inout) :: 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 +59,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,46 @@
 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() )]
+    associate(ni => num_images())
+      self%bin = [( bin_t(num_items=cardinality, num_bins=ni, bin_number=image), image=1,ni )]
+    end associate
+  end procedure
+
+  module procedure construct
+    call data_partition%define_partitions(cardinality)
   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 +52,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 +84,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 +121,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 +186,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,7 +47,7 @@ function verify_block_partitioning() result(test_passes)
     logical test_passes
     integer my_particles
 
-    associate( me=>this_image() )
+    associate( me=>this_image(), partition => data_partition_t(cardinality=num_particles))
       associate( my_first=>partition%first(me), my_last=>partition%last(me) )
         my_particles = my_last - my_first + 1
         associate( ni=>num_images() )
@@ -63,14 +57,15 @@ 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
 
-    associate( me=>this_image() )
+    associate( me=>this_image(), partition => data_partition_t(cardinality=num_particles))
       test_passes = partition%first() == partition%first(me) .and.partition%last() == partition%last(me)
     end associate
   end function
@@ -82,7 +77,7 @@ function verify_all_particles_partitioned() result(test_passes)
     logical test_passes
     integer particles
 
-    associate(me => this_image())
+    associate( me=>this_image(), partition => data_partition_t(cardinality=num_particles))
       associate( my_first=>partition%first(me), my_last=>partition%last(me) )
         particles = my_last - my_first + 1
         call co_sum(particles)
@@ -97,7 +92,7 @@ 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
 
-   associate(me => this_image())
+   associate( me=>this_image(), partition => data_partition_t(cardinality=num_particles))
      associate( first=>partition%first(me), last=>partition%last(me) )
        particle_scalar(first:last) = expected !! values to be gathered
        particle_scalar(1:first-1)  = junk !! values to be overwritten by the gather
@@ -115,7 +110,7 @@ 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
 
-   associate(me => this_image())
+   associate( me=>this_image(), partition => data_partition_t(cardinality=num_particles))
      associate( first=>partition%first(me), last=>partition%last(me) )
 
        particle_vector(:, first:last) = expected !! values to be gathered
@@ -134,7 +129,7 @@ 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
 
-   associate(me => this_image())
+   associate( me=>this_image(), partition => data_partition_t(cardinality=num_particles))
      associate( first=>partition%first(me), last=>partition%last(me) )
 
        vector_transpose(first:last, :) = expected !! values to be gathered
@@ -156,7 +151,7 @@ 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
 
-   associate(me => this_image())
+   associate( me=>this_image(), partition => data_partition_t(cardinality=num_particles))
      associate( first=>partition%first(me), last=>partition%last(me) )
 
        vector_transpose(first:last, :) = expected !! values to be gathered