1
- ! SYNC IMAGES([this_image - 1, this_image + 1]) with the STAT=STAT_STOPPED_IMAGE
2
- ! specifier and wrap around of image numbers. The test is intended to check
3
- ! that syncing in a ring with a stopped image still terminates all images.
1
+ program sync_image_ring_abort_on_stopped_image
2
+ ! ! `SYNC IMAGES([this_image - 1, this_image + 1])` with
3
+ ! ! `STAT=STAT_STOPPED_IMAGE` specifier on a periodic ring. The test
4
+ ! ! checks that syncing in a ring with a stopped image still
5
+ ! ! terminates all images. All images other than image 1 participate
6
+ ! ! in the `sync images()` call
4
7
5
- program sync_images_ring
6
8
use , intrinsic :: iso_fortran_env
7
9
implicit none
8
10
@@ -11,15 +13,21 @@ program sync_images_ring
11
13
if (num_images() .lt. 2 ) error stop " Need at least two images to test."
12
14
13
15
associate (me = > this_image())
14
- if (me /= 1 ) then
15
- associate (lhs = > merge (me - 1 , num_images(), me /= 1 ), &
16
- rhs = > merge (me + 1 , 1 , me /= num_images()))
17
- sync images([lhs, rhs], STAT= stat_var)
18
- ! Only on image 2 and num_images() testing whether a stopped image is
19
- ! present can be done reliably. All other images could be up ahead.
20
- if (stat_var /= STAT_STOPPED_IMAGE .and. me == 2 ) error stop " Error: stat_var /= STAT_STOPPED_IMAGE: "
21
- if (me == 2 ) print * , ' Test passed.'
22
- end associate
23
- end if
16
+ if (me == 1 ) then
17
+ continue ! ! image 1 does not participate and exits, creating a stopped image
18
+ else
19
+ associate (lhs = > merge (me - 1 , num_images(), me /= 1 ), &
20
+ rhs = > merge (me + 1 , 1 , me /= num_images()))
21
+ sync images([lhs, rhs], STAT= stat_var)
22
+ ! ! Only images bordering image 1 (i.e., 2 and `num_images()`) can
23
+ ! ! accurately test whether a stopped image is present. All other
24
+ ! ! images could be up ahead.
25
+ if (stat_var /= STAT_STOPPED_IMAGE .and. me == 2 ) &
26
+ error stop " Error: stat_var /= STAT_STOPPED_IMAGE: "
27
+ if (stat_var /= STAT_STOPPED_IMAGE .and. me == num_images()) &
28
+ error stop " Error: stat_var /= STAT_STOPPED_IMAGE: "
29
+ if (me == 2 ) print * , ' Test passed.'
30
+ end associate
31
+ end if
24
32
end associate
25
- end program sync_images_ring
33
+ end program
0 commit comments