Fix sourceryinstitute#632

Translate image-selector image indices to be w.r.t. the current team.

Untested for sendget_by_ref due to possible issue described in sourceryinstitute#632.

CMakeLists.txt

@@ -735,6 +735,11 @@ if(opencoarrays_aware_compiler)
       add_caf_test(team_number 8 team_number)
       add_caf_test(teams_subset 3 teams_subset)
       add_caf_test(get_communicator 3  get_communicator)
+      add_caf_test(teams_coarray_get 5 teams_coarray_get)
+      add_caf_test(teams_coarray_get_by_ref 5 teams_coarray_get_by_ref)
+      add_caf_test(teams_coarray_send 5 teams_coarray_send)
+      add_caf_test(teams_coarray_send_by_ref 5 teams_coarray_send_by_ref)
+      add_caf_test(teams_coarray_sendget 5 teams_coarray_sendget)
       add_caf_test(alloc_comp_multidim_shape 2 alloc_comp_multidim_shape)
     endif()
   endif()

src/tests/unit/teams/CMakeLists.txt

@@ -1,3 +1,8 @@
 caf_compile_executable(team_number team-number.f90)
 caf_compile_executable(teams_subset teams_subset.f90)
 caf_compile_executable(get_communicator get-communicator.f90)
+caf_compile_executable(teams_coarray_get teams_coarray_get.f90)
+caf_compile_executable(teams_coarray_get_by_ref teams_coarray_get.f90)
+caf_compile_executable(teams_coarray_send teams_coarray_send.f90)
+caf_compile_executable(teams_coarray_send_by_ref teams_coarray_send.f90)
+caf_compile_executable(teams_coarray_sendget teams_coarray_sendget.f90)

src/tests/unit/teams/teams_coarray_get.f90

@@ -0,0 +1,27 @@
+program teams_coarray_get
+  use, intrinsic :: iso_fortran_env, only: team_type
+  implicit none
+  type(team_type) :: team
+  integer, allocatable :: L(:)
+  integer :: i, my_team, R[*]
+
+  ! handle odd or even number of images
+  allocate(L(num_images()/2+mod(num_images(),2)*mod(this_image(),2)))
+
+  R = this_image()
+  my_team = mod(this_image()-1,2)+1
+
+  form team (my_team, team)
+
+  change team (team)
+    do i = 1, num_images()
+      L(i) = R[i]
+    end do
+  end team
+
+  if (any(L /= [(i, i=my_team, num_images(), 2)])) error stop 'Test failed.'
+
+  sync all
+
+  if (this_image() == 1) write(*,*) 'Test passed.'
+end program teams_coarray_get

src/tests/unit/teams/teams_coarray_get_by_ref.f90

@@ -0,0 +1,35 @@
+program teams_coarray_get_by_ref
+  use, intrinsic :: iso_fortran_env, only: team_type
+  implicit none
+  type(team_type) :: team
+  type :: allocatable_array_t
+    integer, allocatable :: A(:)
+  end type
+  type(allocatable_array_t) :: R[*]
+  integer, allocatable :: L(:)
+  integer :: i, my_team
+
+  ! handle odd or even number of images
+  allocate(L(num_images()/2+mod(num_images(),2)*mod(this_image(),2)))
+
+  my_team = mod(this_image()-1,2)+1
+
+  form team (my_team, team)
+
+  ! size(R%A) == this_image(team)
+  allocate(R%A((this_image()+1)/2), source=0)
+
+  R%A(ubound(R%A,1)) = this_image()
+
+  change team (team)
+    do i = 1, num_images()
+      L(i) = R[i]%A(i)
+    end do
+  end team
+
+  if (any(L /= [(i, i=my_team, num_images(), 2)])) error stop 'Test failed.'
+
+  sync all
+
+  if (this_image() == 1) write(*,*) 'Test passed.'
+end program teams_coarray_get_by_ref

src/tests/unit/teams/teams_coarray_send.f90

@@ -0,0 +1,28 @@
+program teams_coarray_send
+  use, intrinsic :: iso_fortran_env, only: team_type
+  implicit none
+  type(team_type) :: team
+  integer, allocatable :: R(:)[:]
+  integer :: extent, i, my_team, initial_team_this_image, odd
+
+  ! if odd number of images, even images have R(extent) == 0
+  extent = num_images()/2+mod(num_images(),2)
+  allocate(R(extent)[*], source=0) 
+
+  initial_team_this_image = this_image()
+  my_team = mod(this_image()-1,2)+1
+
+  form team (my_team, team)
+
+  change team (team)
+    do i = 1, num_images()
+      R(this_image())[i] = initial_team_this_image
+    end do
+  end team
+
+  if (any(R /= [(mod(i, num_images()+1), i=my_team, 2*extent, 2)])) error stop 'Test failed.'
+
+  sync all
+
+  if (this_image() == 1) write(*,*) 'Test passed.'
+end program teams_coarray_send

src/tests/unit/teams/teams_coarray_send_by_ref.f90

@@ -0,0 +1,30 @@
+program teams_coarray_get_by_ref
+  use, intrinsic :: iso_fortran_env, only: team_type
+  implicit none
+  type(team_type) :: team
+  type :: allocatable_array_t
+    integer, allocatable :: A(:)
+  end type
+  type(allocatable_array_t) :: R[*]
+  integer :: i, my_team, initial_team_this_image
+
+  ! handle odd or even number of images
+  allocate(R%A(num_images()/2+mod(num_images(),2)*mod(this_image(),2)), source=0)
+
+  initial_team_this_image = this_image()
+  my_team = mod(this_image()-1,2)+1
+
+  form team (my_team, team)
+
+  change team (team)
+    do i = 1, num_images()
+       R[i]%A(this_image()) = initial_team_this_image
+    end do
+  end team
+
+  if (any(R%A /= [(i, i=my_team, num_images(), 2)])) error stop 'Test failed.'
+
+  sync all
+
+  if (this_image() == 1) write(*,*) 'Test passed.'
+end program teams_coarray_get_by_ref

src/tests/unit/teams/teams_coarray_sendget.f90

@@ -0,0 +1,32 @@
+program teams_coarray_sendget
+  use, intrinsic :: iso_fortran_env, only: team_type
+  implicit none
+  type(team_type) :: team
+  integer, allocatable :: R_send(:,:)[:]
+  integer :: extent, i, j, my_team, team_num_images, R_get[*]
+
+  ! if there are an odd number of images, then even images have R(:,extent) == 0
+  extent = num_images()/2+mod(num_images(),2)
+  allocate(R_send(extent, extent)[*], source=0)
+
+  my_team = mod(this_image()-1,2)+1
+
+  form team (my_team, team)
+
+  R_get = this_image()
+
+  change team (team)
+    team_num_images = num_images()
+    do concurrent (i = 1:num_images(), j = 1:num_images())
+      R_send(this_image(),j)[i] = R_get[j]
+    end do
+  end team
+
+  if (any(R_send /= reshape([((merge(i,0,i<=num_images() .and. j <= team_num_images), &
+                              i=my_team,2*extent,2),j=1,extent)], &
+                            shape=[extent,extent], order=[2,1]))) error stop 'Test failed.'
+
+  sync all
+
+  if (this_image() == 1) write(*,*) 'Test passed.'
+end program teams_coarray_sendget