1! Test that sendget with strides on either side (of the assignment) works
2! as expected.
3!
4! This test needs at least three images, because sendget has the potential
5! to check whether on image used in the communication is the current one.
6! More than three images do not pay, because there is no general code in
7! this test.
8!
9! Written by Andre Vehreschild
10
11program stridedsendgettest
12
13  implicit none
14
15  integer, parameter :: src_image = 2, dst_image = 3, master_image = 1
16  integer, save, dimension(4,6) :: srcmat[*], dstmat[*]
17  integer, save, dimension(6) :: srcvec[*], dstvec[*]
18  integer :: i
19  logical :: test_passed = .true.
20
21  ! Make sure that enough images are available for this test.
22  ! Everything less than dst_image == 3 may make sendget use an
23  ! optimized version saving a part of the communication, which is
24  ! not what the test should test.
25  if (num_images() < dst_image) then
26     print*, "Pretend that the test was run and passed, even though there are too few images to perform test:"
27     print*, "Test passed"
28     error stop "Need at least three images."
29  end if
30
31  ! On the src_image, set some defined values, to be able to distinguish
32  ! strides going wrong.
33  if (this_image() == src_image) then
34    srcvec = [(2 * i, i = 1, 6)]
35    srcmat = reshape([(i * 2, i = 1, 4*6)], [4,6])
36  ! On the dst_image set values that enable to recognize unset values.
37  elseif (this_image() == dst_image) then
38    dstmat = -1
39    dstvec = -2
40  end if
41
42  ! Make sure data is valid on all images.
43  sync all
44
45  ! master_image is the controller in this communication and therefore needs
46  ! to initiate the communication.
47  if (this_image() == master_image) then
48    ! Transfer data from the src-vector to the dst-vector on image
49    ! dst_image.  This is a transfer of a contingous block of data and here for
50    ! completeness only.
51    dstvec(:)[dst_image] = srcvec(:)[src_image]
52    ! This statement uses a stride in the send phase of the communication.
53    dstmat(3,:)[dst_image] = srcvec(:)[src_image]
54  end if
55
56  ! Make sure the communication has completed.
57  sync all
58
59  ! Check the result of communication on the dst_image.
60  if (this_image() == dst_image) then
61    ! Check that transfering to the vector has succeeded.
62    if (any(dstvec /= [2, 4, 6, 8, 10, 12])) error stop "SendGet vec/vec does not match."
63
64    ! Check that transfering a vector into a matrix changes only the
65    ! values desired.
66    if (any(dstmat /= reshape([-1, -1,  2, -1, &
67                               -1, -1,  4, -1, &
68                               -1, -1,  6, -1, &
69                               -1, -1,  8, -1, &
70                               -1, -1, 10, -1, &
71                               -1, -1, 12, -1], [4, 6]))) then
72      error stop "SendGet matrow/vec does not match."
73    end if
74    ! Reset the dst-buffers to enable new test.
75    dstvec = -2
76    dstmat = -1
77  end if
78
79  ! Wait for dst having done its tests.
80  sync all
81  if (this_image() == master_image) then
82    ! Execute strided get in sendget and store in a vector to just
83    ! test the get.
84    dstvec(:)[dst_image] = srcmat(2,:)[src_image]
85    ! Test both strided get and strided send at once.
86    dstmat(3,:)[dst_image] = srcmat(2,:)[src_image]
87  end if
88
89  ! Ensure that the communication is all done.
90  sync all
91  if (this_image() == dst_image) then
92    ! Check, that the strided get has the expected result.
93    if (any(dstvec /= [4, 12, 20, 28, 36, 44])) error stop "SendGet vec/matrow does not match."
94
95    ! And that both communications with stride work as expected.
96    if (any(dstmat /= reshape([-1, -1,  4, -1, &
97                               -1, -1, 12, -1, &
98                               -1, -1, 20, -1, &
99                               -1, -1, 28, -1, &
100                               -1, -1, 36, -1, &
101                               -1, -1, 44, -1], [4, 6]))) then
102      error stop "SendGet matrow/matrow does not match."
103    end if
104
105    ! Above checks would stop with an error on failure, so its save
106    ! to unguardedly print here, when all tests pass.
107    print *, "Test passed"
108  end if
109end program
110