diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 2d98c693..82db39a9 100644 --- a/.github/workflows/CI.yml +++ b/.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" diff --git a/README.md b/README.md index 1f23e88f..3771c1e4 100644 --- a/README.md +++ b/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 diff --git a/src/sourcery/sourcery_data_partition_m.f90 b/src/sourcery/sourcery_data_partition_m.f90 index 89312d46..8a0be255 100644 --- a/src/sourcery/sourcery_data_partition_m.f90 +++ b/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 diff --git a/src/sourcery/sourcery_data_partition_s.f90 b/src/sourcery/sourcery_data_partition_s.f90 index ed27ef85..34f63029 100644 --- a/src/sourcery/sourcery_data_partition_s.f90 +++ b/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) diff --git a/test/data_partition_test.f90 b/test/data_partition_test.f90 index d2bf594d..c95b8356 100644 --- a/test/data_partition_test.f90 +++ b/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,6 +57,7 @@ function verify_block_partitioning() result(test_passes) end associate end associate end associate + end function function verify_default_image_number() result(test_passes) @@ -70,7 +65,7 @@ function verify_default_image_number() result(test_passes) 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