Skip to content

Commit 23d983a

Browse files
author
Damian Rouson
authored
Merge pull request #9 from sourceryinstitute/data-partitioning-abstraction
Add and test data_partition type
2 parents 5232cd6 + 38f33d4 commit 23d983a

File tree

6 files changed

+443
-10
lines changed

6 files changed

+443
-10
lines changed

‎README.md‎

Lines changed: 13 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -35,11 +35,14 @@ Utility functions
3535

3636
* Array functions
3737
* Assertions
38-
* Emulated intrinsic functions
38+
* Emulated intrinsic functions: `findloc`
39+
* Emulated collective subroutines: `co_sum`, `co_broadcast`
40+
* User-defined collective subroutines: `co_all`
3941
* String functions
4042

4143
Classes
4244
-------
45+
* Parallel data partitioning and gathering
4346
* (Co-)Object pattern abstract parent
4447

4548
Prerequisites
@@ -65,13 +68,19 @@ fpm test \
6568
--flag "-Wall" \
6669
--flag "-std=f2018" \
6770
--flag "-DCOMPILER_LACKS_COLLECTIVE_SUBROUTINES" \
68-
--flag "-DCOMPILER_LACKS_FINDLOC"
71+
--flag "-DCOMPILER_LACKS_FINDLOC"
6972
```
70-
where the `COMPILER_LACKS_*` flags exercise the Sourcery Library's
71-
emulated instrinsic procedures, which are intended for use with
73+
where the `COMPILER_LACKS_*` flags exercise the Sourcery Library's
74+
emulated instrinsic procedures, which are intended for use with
7275
compiler versions that lack support for the named features. Delete
7376
those flags with compilers that support these features.
7477

78+
Build documentation
79+
-------------------
80+
```zsh
81+
ford doc/ford-documentation.md
82+
```
83+
7584
[GNU Fortran]: https://gcc.gnu.org
7685
[OpenCoarrays]: https://github.com/sourceryinstitute/opencoarrays
7786
[fpm]: https://github.com/fortran-lang/fpm

‎src/data-partition-implementation.F90‎

Lines changed: 148 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,148 @@
1+
submodule(data_partition_interface) data_partition_implementation
2+
use assertions_interface, only : assert, assertions
3+
implicit none
4+
5+
contains
6+
7+
module procedure define_partitions
8+
9+
if (allocated(first_datum)) deallocate(first_datum)
10+
if (allocated(last_datum)) deallocate(last_datum)
11+
12+
associate( ni => num_images() )
13+
14+
call assert( ni<=cardinality, "sufficient data for distribution across images")
15+
16+
allocate(first_datum(ni), last_datum(ni))
17+
18+
block
19+
integer i, image
20+
do image=1,ni
21+
associate( remainder => mod(cardinality, ni), quotient => cardinality/ni )
22+
first_datum(image) = sum([(quotient+overflow(i, remainder), i=1, image-1)]) + 1
23+
last_datum(image) = first_datum(image) + quotient + overflow(image, remainder) - 1
24+
end associate
25+
end do
26+
end block
27+
end associate
28+
29+
#ifdef FORD
30+
end procedure
31+
#else
32+
contains
33+
#endif
34+
35+
pure function overflow(im, excess) result(extra_datum)
36+
integer, intent(in) :: im, excess
37+
integer extra_datum
38+
extra_datum= merge(1,0,im<=excess)
39+
end function
40+
41+
#ifndef FORD
42+
end procedure
43+
#endif
44+
45+
module procedure first
46+
if (assertions) call assert( allocated(first_datum), "allocated(first_datum)")
47+
first_index= first_datum( image_number )
48+
end procedure
49+
50+
module procedure last
51+
if (assertions) call assert( allocated(last_datum), "allocated(last_datum)")
52+
last_index = last_datum( image_number )
53+
end procedure
54+
55+
module procedure gather_real_1D_array
56+
57+
if (present(dim)) call assert (dim==1, "dimensioned partitioned == 1")
58+
59+
associate( me => this_image() )
60+
write(6,*) 'gather_real_1D_array(): executing on image', me
61+
flush(6)
62+
associate( first=>first(me), last=>last(me) )
63+
if (.not. present(result_image)) then
64+
a(1:first-1) = 0.
65+
a(last+1:) = 0.
66+
call co_sum(a)
67+
else
68+
block
69+
real(real64), allocatable, dimension(:) :: a_lower, a_upper
70+
a_lower = a(1:first-1)
71+
a_upper = a(last+1:)
72+
a(1:first-1) = 0.
73+
a(last+1:) = 0.
74+
call co_sum(a, result_image=result_image)
75+
if (result_image /= me) then
76+
a(1:first-1) = a_lower
77+
a(last+1:) = a_upper
78+
end if
79+
end block
80+
end if
81+
end associate
82+
end associate
83+
end procedure
84+
85+
module procedure gather_real_2D_array
86+
87+
integer dim_
88+
if (present(dim)) then
89+
dim_ = dim
90+
else
91+
dim_ = 2
92+
end if
93+
94+
associate( me => this_image() )
95+
write(6,*) 'gather_real_2D_array(): executing on image', me
96+
flush(6)
97+
associate( first => first(me), last => last(me) )
98+
if (.not. present(result_image)) then
99+
select case(dim_)
100+
case(1)
101+
a(1:first-1, :) = 0.
102+
a(last+1:, :) = 0.
103+
case(2)
104+
a(:, 1:first-1) = 0.
105+
a(:, last+1:) = 0.
106+
case default
107+
error stop "gather_real_2D_array: invalid dim argument"
108+
end select
109+
call co_sum(a)
110+
else
111+
block
112+
real(real64), allocatable, dimension(:,:) :: a_lower, a_upper
113+
select case(dim_)
114+
case(1)
115+
a_lower = a(1:first-1, :)
116+
a_upper = a(last+1:, :)
117+
a(1:first-1, :) = 0.
118+
a(last+1:, :) = 0.
119+
case(2)
120+
a_lower = a(:, 1:first-1)
121+
a_upper = a(:, last+1:)
122+
a(:, 1:first-1) = 0.
123+
a(:, last+1:) = 0.
124+
case default
125+
error stop "gather_real_2D_array: invalid dim argument"
126+
end select
127+
128+
call co_sum(a, result_image=result_image)
129+
130+
if (result_image /= me) then
131+
select case(dim_)
132+
case(1)
133+
a(1:first-1, :) = a_lower
134+
a(last+1:, :) = a_upper
135+
case(2)
136+
a(:, 1:first-1) = a_lower
137+
a(:, last+1:) = a_upper
138+
case default
139+
error stop "gather_real_2D_array: invalid dim argument"
140+
end select
141+
end if
142+
end block
143+
end if
144+
end associate
145+
end associate
146+
end procedure
147+
148+
end submodule data_partition_implementation

‎src/data-partition-interface.f90‎

Lines changed: 64 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,64 @@
1+
module data_partition_interface
2+
!! distribute data identification numbers across images such that the number of
3+
!! items differs by at most 1 between any two images.
4+
use iso_fortran_env, only : real64
5+
implicit none
6+
7+
private
8+
public :: data_partition
9+
10+
type data_partition
11+
!! encapsulate a description of the data subset the executing image owns
12+
private
13+
contains
14+
procedure, nopass :: define_partitions
15+
procedure, nopass :: first
16+
procedure, nopass :: last
17+
procedure, nopass, private :: gather_real_2D_array, gather_real_1D_array
18+
generic :: gather => gather_real_2D_array, gather_real_1D_array
19+
end type
20+
21+
integer, allocatable :: first_datum(:), last_datum(:)
22+
23+
interface
24+
25+
module subroutine define_partitions(cardinality)
26+
!! define the range of data identification numbers owned by the executing image
27+
integer, intent(in) :: cardinality
28+
end subroutine
29+
30+
pure module function first(image_number) result(first_index)
31+
!! the result is the first identification number owned by the executing image
32+
implicit none
33+
integer, intent(in) :: image_number
34+
integer first_index
35+
end function
36+
37+
pure module function last(image_number) result(last_index)
38+
!! the result is the last identification number owned by the executing image
39+
implicit none
40+
integer, intent(in) :: image_number
41+
integer last_index
42+
end function
43+
44+
!! Gathers are inherently expensive and are best used either
45+
!! 1. Near the beginning/end of execution to amortize costs across an entire run or
46+
!! 2. Temporarily while developing/debugging code.
47+
48+
module subroutine gather_real_1D_array( a, result_image, dim )
49+
!! Gather the elements of an 1D array distributed along dimension dim onto result_image
50+
real(real64), intent(inout) :: a(:)
51+
integer, intent(in), optional :: result_image
52+
integer, intent(in), optional :: dim
53+
end subroutine
54+
55+
module subroutine gather_real_2D_array( a, result_image, dim )
56+
!! Gather the elements of an 2D array distributed along dimension dim onto result_image
57+
real(real64), intent(inout) :: a(:,:)
58+
integer, intent(in), optional :: result_image
59+
integer, intent(in), optional :: dim
60+
end subroutine
61+
62+
end interface
63+
64+
end module data_partition_interface

‎src/emulated_intrinsics_implementation.F90‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,13 +12,19 @@
1212

1313
module procedure co_all
1414
call co_reduce(boolean, both)
15+
#ifdef FORD
16+
end procedure
17+
#else
1518
contains
19+
#endif
1620
pure function both(lhs,rhs) result(lhs_and_rhs)
1721
logical, intent(in) :: lhs,rhs
1822
logical lhs_and_rhs
1923
lhs_and_rhs = lhs .and. rhs
2024
end function
25+
#ifndef FORD
2126
end procedure
27+
#endif
2228

2329
#ifdef COMPILER_LACKS_COLLECTIVE_SUBROUTINES
2430
module procedure co_sum_integer

0 commit comments

Comments
 (0)