@@ -27,9 +27,19 @@ function results() result(test_results)
2727    type (test_result_t), allocatable  ::  test_results(:)
2828
2929    test_results =  [ &
30-       test_result_t(" partitioning data in nearly even blocks"  , verify_block_partitioning()), &
30+       test_result_t(" partitioning data in nearly even blocks"  , verify_block_partitioning(num_particles)), &
31+       test_result_t(" partitioning data in nearly even blocks when some blocks are singletons"  , &
32+        verify_block_partitioning(num_images()+ 1 )), &
33+       test_result_t(" bins of size 1 when set cardinality == num_images()"  , verify_block_partitioning_with_singletons()), &
3134      test_result_t(" default image_number is this_image()"  , verify_default_image_number()), &
35+       test_result_t(" partitioning data into contiguous bins without overlap"  , &
36+         verify_partitions_are_contiguous_without_overlap(num_particles)), &
37+       test_result_t(" contiguous non overlapping partitions with singletons"  , &
38+         verify_partitions_are_contiguous_without_overlap(num_images())), &
39+       test_result_t(" contiguous non overlapping partitions with some singletons"  , &
40+         verify_partitions_are_contiguous_without_overlap(num_images()+ 1 )), &
3241      test_result_t(" partitioning all data across all images without data loss"  , verify_all_particles_partitioned()), &
42+       test_result_t(" no data is lost when singleton bins are used"  , verify_all_particles_partitioned_on_singletons()), &
3343      test_result_t(" gathering a 1D real array onto all images"  , verify_all_gather_1D_real_array()), &
3444      test_result_t(" gathering dimension 1 of 2D real array onto all images witout dim argument"  , &
3545        verify_all_gather_2D_real_array()), &
@@ -40,26 +50,96 @@ function results() result(test_results)
4050    ]
4151  end  function 
4252
43-   function  verify_block_partitioning () result(test_passes)
53+   function  verify_testing_in_parallel () result(test_passes)
54+     ! ! Verify that the test is being run in parallel
55+     logical  test_passes
56+     test_passes =  num_images() > 1 
57+   end  function 
58+ 
59+   function  verify_block_partitioning (cardinality ) result(test_passes)
4460    ! ! Verify that the data is partitioned across images evenly to
4561    ! ! within a difference of one datum between any two images.
62+     integer , intent (in ) ::  cardinality
4663    type (data_partition_t) partition
4764    logical  test_passes
4865    integer  my_particles
4966
67+     associate( me= >this_image(), partition = > data_partition_t(cardinality= cardinality))
68+       associate( my_first= >partition% first(me), my_last= >partition% last(me) )
69+         my_particles =  my_last -  my_first +  1 
70+         associate( ni= >num_images() )
71+           associate( quotient= >cardinality/ ni, remainder= >mod (cardinality,ni)  )
72+             test_passes =  quotient +  merge (1 , 0 , me<= remainder) == my_particles
73+           end associate
74+         end associate
75+       end associate
76+     end associate
77+ 
78+   end  function 
79+ 
80+   function  verify_block_partitioning_with_singletons () result(test_passes)
81+     ! ! Verify that the data is partitioned so that each image has a bin of
82+     ! ! size 1.
83+     type (data_partition_t) partition, another_partition
84+     logical  test_passes
85+     integer  my_particles
86+     integer  num_particles
87+         
88+     num_particles =  num_images()
89+     another_partition =  data_partition_t(cardinality= num_particles)
90+ 
5091    associate( me= >this_image(), partition = > data_partition_t(cardinality= num_particles))
5192      associate( my_first= >partition% first(me), my_last= >partition% last(me) )
5293        my_particles =  my_last -  my_first +  1 
5394        associate( ni= >num_images() )
5495          associate( quotient= >num_particles/ ni, remainder= >mod (num_particles,ni)  )
55-             test_passes =  quotient +  merge (1 , 0 , me<= remainder) == my_particles
96+             test_passes =  quotient == 1  &
97+               .and.  remainder == 0  &
98+               .and.  my_particles == 1  &
99+               .and.  my_last == my_first &
100+               .and.  my_first == me
56101          end associate
57102        end associate
58103      end associate
59104    end associate
60105
61106  end  function 
62107
108+   function  verify_partitions_are_contiguous_without_overlap (cardinality ) result(test_passes)
109+     ! ! Verify that the data is partitioned across images into contiguous bins without overlap
110+     integer , intent (in ) ::  cardinality
111+     logical  test_passes
112+     type (data_partition_t) partition
113+ 
114+     associate( me= >this_image(), partition = > data_partition_t(cardinality= cardinality))
115+       associate( my_first= >partition% first(me), my_last= >partition% last(me) )
116+         associate(ni = > num_images())
117+           if  (me > 1 ) then 
118+             associate( your_first= >partition% first(me-1 ), your_last= >partition% last(me-1 ) )
119+                 test_passes =  my_first <=  my_last &
120+                 .and.  your_first <=  your_last &
121+                 .and.  my_first >=  1  &
122+                 .and.  my_last <=  cardinality &
123+                 .and.  my_first == your_last +  1 
124+             end associate
125+           else  if  (me == 1  .and.  ni > 1 ) then 
126+             associate( your_first= >partition% first(me+1 ), your_last= >partition% last(me+1 ) )
127+                 test_passes =  my_first <=  my_last &
128+                 .and.  your_first <=  your_last &
129+                 .and.  my_first >=  1  &
130+                 .and.  my_last <=  cardinality &
131+                 .and.  my_last == your_first -  1 
132+             end associate
133+           else  if  (ni == 1 ) then 
134+             test_passes =  my_first <=  my_last &
135+             .and.  my_first >=  1  &
136+             .and.  my_last <=  cardinality
137+           end if 
138+         end associate
139+       end associate
140+     end associate
141+   end  function 
142+ 
63143  function  verify_default_image_number () result(test_passes)
64144    ! ! Verify that the first and last functions assume image_number == this_image() if image_number is not  present
65145    type (data_partition_t) partition
@@ -86,6 +166,26 @@ function verify_all_particles_partitioned() result(test_passes)
86166    end associate
87167  end  function 
88168
169+   function  verify_all_particles_partitioned_on_singletons () result(test_passes)
170+     ! ! Verify that the number of particles on each image sums to the
171+     ! ! total number of particles distributed when the cardinality of the 
172+     ! ! partitioned set is equal to num_images()
173+     type (data_partition_t) partition
174+     logical  test_passes
175+     integer  particles
176+     integer  num_particles
177+     num_particles =  num_images()
178+ 
179+     associate( me= >this_image(), partition = > data_partition_t(cardinality= num_particles))
180+       associate( my_first= >partition% first(me), my_last= >partition% last(me) )
181+         particles =  my_last -  my_first +  1 
182+         test_passes =  particles == 1 
183+         call  co_sum(particles)
184+         test_passes =  test_passes .and.  num_particles == particles
185+       end associate
186+     end associate
187+   end  function 
188+ 
89189 function  verify_all_gather_1D_real_array () result(test_passes)
90190   type (data_partition_t) partition
91191   logical  test_passes
0 commit comments