Skip to content

Commit 322b14e

Browse files
rousonrouson
committed
chore: work around Cray compiler bugs
1 parent 95f35c1 commit 322b14e

File tree

5 files changed

+254
-18
lines changed

5 files changed

+254
-18
lines changed

‎src/sourcery/sourcery_formats_m.f90‎ renamed to ‎src/sourcery/sourcery_formats_m.F90‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,8 @@ module sourcery_formats_m
55
character(len=*), parameter :: csv = "(*(G0,:,','))" !! comma-separated values
66
character(len=*), parameter :: cscv = "(*('(',G0,',',G0,')',:,',')))" !! comma-separated complex values
77

8+
9+
#ifndef _CRAYFTN
810
interface
911

1012
pure module function separated_values(separator, mold) result(format_string)
@@ -14,5 +16,16 @@ pure module function separated_values(separator, mold) result(format_string)
1416
end function
1517

1618
end interface
19+
#else
20+
interface separated_values
21+
22+
pure module function separated_values_1D(separator, mold) result(format_string)
23+
character(len=*), intent(in) :: separator
24+
class(*), intent(in) :: mold(:)
25+
character(len=:), allocatable :: format_string
26+
end function
27+
28+
end interface
29+
#endif
1730

1831
end module

‎src/sourcery/sourcery_formats_s.f90‎ renamed to ‎src/sourcery/sourcery_formats_s.F90‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,8 @@
44

55
contains
66

7+
#ifndef _CRAYFTN
8+
79
module procedure separated_values
810
character(len=*), parameter :: prefix = "(*(G0,:,'"
911
character(len=*), parameter :: suffix = "'))"
@@ -28,4 +30,28 @@
2830
end select
2931
end procedure
3032

33+
#else
34+
35+
module procedure separated_values_1D
36+
character(len=*), parameter :: prefix = "(*(G0,:,'"
37+
character(len=*), parameter :: suffix = "'))"
38+
character(len=*), parameter :: complex_prefix = "(*('(',G0,',',G0,')',:,'"
39+
40+
select type(mold)
41+
type is(complex)
42+
format_string = complex_prefix // separator // suffix
43+
type is(real)
44+
format_string = prefix // separator // suffix
45+
type is(integer)
46+
format_string = prefix // separator // suffix
47+
type is(character(len=*))
48+
format_string = prefix // separator // suffix
49+
class default
50+
error stop "format_s separated_values_1D: unsupported type"
51+
end select
52+
end procedure
53+
54+
55+
#endif
56+
3157
end submodule sourcery_formats_s

‎src/sourcery/sourcery_test_s.f90‎ renamed to ‎src/sourcery/sourcery_test_s.F90‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,8 @@
88

99
associate(me => this_image())
1010
if (me==1) print *, new_line('a'), test%subject()
11+
12+
#ifndef _CRAYFTN
1113
associate(test_results => test%results())
1214
associate(num_tests => size(test_results))
1315
tests = tests + num_tests
@@ -30,6 +32,30 @@
3032
end block
3133
end associate
3234
end associate
35+
#else
36+
block
37+
logical, allocatable :: passing_tests(:)
38+
type(test_result_t), allocatable :: test_results(:)
39+
integer i
40+
41+
test_results = test%results()
42+
associate(num_tests => size(test_results))
43+
tests = tests + num_tests
44+
if (me==1) then
45+
do i=1,num_tests
46+
if (me==1) print *," ",test_results(i)%characterize()
47+
end do
48+
end if
49+
passing_tests = test_results%passed()
50+
call co_all(passing_tests)
51+
associate(num_passes => count(passing_tests))
52+
if (me==1) print '(a,2(i0,a))'," ",num_passes," of ", num_tests," tests pass."
53+
passes = passes + num_passes
54+
end associate
55+
end associate
56+
end block
57+
#endif
58+
3359
end associate
3460

3561
end procedure

‎test/data_partition_test.f90‎ renamed to ‎test/data_partition_test.F90‎

Lines changed: 109 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -43,55 +43,87 @@ function results() result(test_results)
4343
function verify_block_partitioning() result(test_passes)
4444
!! Verify that the data is partitioned across images evenly to
4545
!! within a difference of one datum between any two images.
46-
type(data_partition_t) partition
4746
logical test_passes
48-
integer my_particles
4947

48+
#ifndef _CRAYFTN
5049
associate( me=>this_image(), partition => data_partition_t(cardinality=num_particles))
5150
associate( my_first=>partition%first(me), my_last=>partition%last(me) )
52-
my_particles = my_last - my_first + 1
53-
associate( ni=>num_images() )
51+
associate( ni=>num_images(), my_particles => my_last - my_first + 1)
52+
associate( quotient=>num_particles/ni, remainder=>mod(num_particles,ni) )
53+
test_passes = quotient + merge(1, 0, me<=remainder) == my_particles
54+
end associate
55+
end associate
56+
end associate
57+
end associate
58+
#else
59+
type(data_partition_t) partition
60+
61+
associate(me=>this_image())
62+
partition = data_partition_t(cardinality=num_particles)
63+
associate( my_first=>partition%first(me), my_last=>partition%last(me) )
64+
associate( ni=>num_images(), my_particles => my_last - my_first + 1)
5465
associate( quotient=>num_particles/ni, remainder=>mod(num_particles,ni) )
5566
test_passes = quotient + merge(1, 0, me<=remainder) == my_particles
5667
end associate
5768
end associate
5869
end associate
5970
end associate
71+
#endif
6072

6173
end function
6274

6375
function verify_default_image_number() result(test_passes)
6476
!! Verify that the first and last functions assume image_number == this_image() if image_number is not present
65-
type(data_partition_t) partition
6677
logical test_passes
6778

79+
#ifndef _CRAYFTN
6880
associate( me=>this_image(), partition => data_partition_t(cardinality=num_particles))
6981
test_passes = partition%first() == partition%first(me) .and.partition%last() == partition%last(me)
7082
end associate
83+
#else
84+
type(data_partition_t) partition
85+
86+
partition = data_partition_t(cardinality=num_particles)
87+
associate( me=>this_image())
88+
test_passes = partition%first() == partition%first(me) .and. partition%last() == partition%last(me)
89+
end associate
90+
#endif
7191
end function
7292

7393
function verify_all_particles_partitioned() result(test_passes)
7494
!! Verify that the number of particles on each image sums to the
7595
!! total number of particles distributed.
76-
type(data_partition_t) partition
7796
logical test_passes
7897
integer particles
7998

80-
associate( me=>this_image(), partition => data_partition_t(cardinality=num_particles))
81-
associate( my_first=>partition%first(me), my_last=>partition%last(me) )
99+
#ifndef _CRAYFTN
100+
associate(me => this_image(), partition => data_partition_t(cardinality=num_particles))
101+
associate(my_first=>partition%first(me), my_last=>partition%last(me))
102+
particles = my_last - my_first + 1
103+
call co_sum(particles)
104+
test_passes = num_particles == particles
105+
end associate
106+
end associate
107+
#else
108+
type(data_partition_t) partition
109+
110+
partition = data_partition_t(cardinality=num_particles)
111+
associate(me=>this_image())
112+
associate(my_first=>partition%first(me), my_last=>partition%last(me))
82113
particles = my_last - my_first + 1
83114
call co_sum(particles)
84115
test_passes = num_particles == particles
85116
end associate
86117
end associate
118+
#endif
87119
end function
88120

89121
function verify_all_gather_1D_real_array() result(test_passes)
90-
type(data_partition_t) partition
91122
logical test_passes
92123
real(real64) :: particle_scalar(num_particles)
93124
real(real64), parameter :: junk=-12345._real64, expected=1._real64
94125

126+
#ifndef _CRAYFTN
95127
associate( me=>this_image(), partition => data_partition_t(cardinality=num_particles))
96128
associate( first=>partition%first(me), last=>partition%last(me) )
97129
particle_scalar(first:last) = expected !! values to be gathered
@@ -101,56 +133,93 @@ function verify_all_gather_1D_real_array() result(test_passes)
101133
test_passes = all(particle_scalar==expected)
102134
end associate
103135
end associate
136+
#else
137+
type(data_partition_t) partition
138+
139+
associate( me=>this_image())
140+
partition = data_partition_t(cardinality=num_particles)
141+
associate( first=>partition%first(me), last=>partition%last(me) )
142+
particle_scalar(first:last) = expected !! values to be gathered
143+
particle_scalar(1:first-1) = junk !! values to be overwritten by the gather
144+
particle_scalar(last+1:) = junk !! values to be overwritten by the gather
145+
call partition%gather(particle_scalar)
146+
test_passes = all(particle_scalar==expected)
147+
end associate
148+
end associate
149+
#endif
104150
end function
105151

106152
function verify_all_gather_2D_real_array() result(test_passes)
107-
type(data_partition_t) partition
108153
logical test_passes
109154
integer, parameter :: vec_space_dim=3
110155
real(real64) particle_vector(vec_space_dim, num_particles)
111156
real(real64), parameter :: junk=-12345._real64, expected=1._real64
112157

158+
#ifndef _CRAYFTN
113159
associate( me=>this_image(), partition => data_partition_t(cardinality=num_particles))
114160
associate( first=>partition%first(me), last=>partition%last(me) )
161+
particle_vector(:, first:last) = expected !! values to be gathered
162+
particle_vector(:, 1:first-1) = junk !! values to be overwritten by the gather
163+
particle_vector(:, last+1:) = junk !! values to be overwritten by the gather
164+
call partition%gather(particle_vector)
165+
test_passes = all(particle_vector==expected)
166+
end associate
167+
end associate
168+
#else
169+
type(data_partition_t) partition
115170

171+
associate( me=>this_image())
172+
partition = data_partition_t(cardinality=num_particles)
173+
associate( first=>partition%first(me), last=>partition%last(me) )
116174
particle_vector(:, first:last) = expected !! values to be gathered
117175
particle_vector(:, 1:first-1) = junk !! values to be overwritten by the gather
118176
particle_vector(:, last+1:) = junk !! values to be overwritten by the gather
119177
call partition%gather(particle_vector)
120178
test_passes = all(particle_vector==expected)
121179
end associate
122180
end associate
181+
#endif
123182
end function
124183

125184
function verify_all_gather_2D_real_array_dim1() result(test_passes)
126-
type(data_partition_t) partition
127185
logical test_passes
128186
integer, parameter :: vec_space_dim=3
129187
real(real64) :: vector_transpose(num_particles, vec_space_dim)
130188
real(real64), parameter :: junk=-12345._real64, expected=1._real64
131189

190+
#ifndef _CRAYFTN
132191
associate( me=>this_image(), partition => data_partition_t(cardinality=num_particles))
133192
associate( first=>partition%first(me), last=>partition%last(me) )
134-
135193
vector_transpose(first:last, :) = expected !! values to be gathered
136194
vector_transpose(1:first-1, :) = junk !! values to be overwritten by the gather
137195
vector_transpose(last+1:, :) = junk !! values to be overwritten by the gather
138-
139196
call partition%gather( vector_transpose, dim=1)
140-
141197
test_passes= all(vector_transpose==expected)
198+
end associate
199+
end associate
200+
#else
201+
type(data_partition_t) partition
142202

203+
associate(me=>this_image())
204+
partition = data_partition_t(cardinality=num_particles)
205+
associate( first=>partition%first(me), last=>partition%last(me) )
206+
vector_transpose(first:last, :) = expected !! values to be gathered
207+
vector_transpose(1:first-1, :) = junk !! values to be overwritten by the gather
208+
vector_transpose(last+1:, :) = junk !! values to be overwritten by the gather
209+
call partition%gather( vector_transpose, dim=1)
210+
test_passes= all(vector_transpose==expected)
143211
end associate
144212
end associate
213+
#endif
145214
end function
146215

147216
function verify_gather_2D_real_array_dim1() result(test_passes)
148-
type(data_partition_t) partition
149217
logical test_passes
150218
integer, parameter :: vec_space_dim=3
151219
real(real64) :: vector_transpose(num_particles, vec_space_dim)
152220
real(real64), parameter :: junk=-12345._real64, expected=1._real64
153221

222+
#ifndef _CRAYFTN
154223
associate( me=>this_image(), partition => data_partition_t(cardinality=num_particles))
155224
associate( first=>partition%first(me), last=>partition%last(me) )
156225

@@ -171,6 +240,31 @@ function verify_gather_2D_real_array_dim1() result(test_passes)
171240

172241
end associate
173242
end associate
243+
#else
244+
type(data_partition_t) partition
245+
246+
associate(me=>this_image())
247+
partition = data_partition_t(cardinality=num_particles)
248+
associate( first=>partition%first(me), last=>partition%last(me) )
249+
250+
vector_transpose(first:last, :) = expected !! values to be gathered
251+
vector_transpose(1:first-1, :) = junk !! values to be overwritten by the gather
252+
vector_transpose(last+1:, :) = junk !! values to be overwritten by the gather
253+
254+
call partition%gather( vector_transpose, result_image=gatherer, dim=1)
255+
256+
if (me==gatherer) then
257+
test_passes = all(vector_transpose==expected)
258+
else
259+
test_passes = &
260+
all(vector_transpose(1:first-1,:)==junk) .and. &
261+
all(vector_transpose(first:last,:)==expected) .and. &
262+
all(vector_transpose(last+1:,:)==junk)
263+
end if
264+
265+
end associate
266+
end associate
267+
#endif
174268
end function
175269

176270
end module data_partition_test_m

0 commit comments

Comments
 (0)