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