Using MPI_PUT in fortran and different ranks have different displacements using c_loc

Question

I have MPI ranks split up to calculate different parts an an array, then I want to put/send those slices onto a different rank that doesn't participate in the calculation. That rank is the master of a new communicator set up to do other things with the array (averaging, IO, etc). I got it to work with MPI_isend and MPI_irecv, and now I want to try MPI_Put.

use mpi_f08
use iso_c_binding
implicit none

integer, parameter :: n=10, gps = 18, pes=12, dpes = 6 
integer :: main=pes, d=dpes
integer :: diag_master
integer :: global_size, global_rank, diag_size, diag_rank
type(MPI_comm),allocatable :: diag_comm
integer :: pelist_diag
TYPE(MPI_Win) :: win
integer :: ierr, i, j
type(MPI_COMM) :: comm, mycomm
integer :: gsz, grk
integer :: lsz, lrk
integer(KIND=MPI_ADDRESS_KIND) :: local_group
logical :: local_flag
integer :: color,key
!!! THIS IS THE ARRAY
real, dimension(n,pes) :: r
!!! 
logical :: on_dpes = .false.
logical,allocatable,dimension(:) :: dpes_list ! true if on dpes list
integer :: comm_manager
integer :: dmg
integer(KIND=MPI_ADDRESS_KIND) :: buff_size !< the size of a variable type
integer(kind=MPI_ADDRESS_KIND) :: displacement 
integer :: disp_size
integer :: loc_base
integer, pointer :: fptr
!!!!!!!! THIS ALL WORKS BEGIN !!!!!!!!
comm=MPI_COMM_WORLD

   call MPI_INIT(ierr)
 call MPI_COMM_SIZE(COMM, gsz, ierr) 
 call MPI_COMM_RANK(COMM, grk, ierr)

 allocate(dpes_list(gsz))
!     write (6,*) "I am ",grk," of ",gsz
     !> Find the group
 call MPI_COMM_GET_ATTR(COMM,MPI_APPNUM,local_group,local_flag,ierr)
!> Split a new communicator as mycom
 color = int(local_group)
 key = 0
 call MPI_COMM_SPLIT(COMM, color, key, mycomm, ierr)
!> Get information about the split communicators
 call mpi_comm_size(mycomm,lsz,ierr)
 call mpi_comm_rank(mycomm,lrk,ierr)
!> Create data on the main communicator
 if (lsz == pes) then
  comm_manager = main
  on_dpes = .false.
     r = 0.0
     if (mod(lrk,2) == 0) then
          c_loop: do concurrent (i=1:n)
               r(i,lrk+1) = sin(real(i))+real(i)
          enddo c_loop
     else
         r(:,lrk+1) = 10.0-dble(lrk)
     endif
 if (lsz == dpes) then
  diag_size = lsz
  diag_rank = lrk
  comm_manager = d
  on_dpes = .true.
  diag_comm = mycomm
     if (lrk==0) then
          dmg = grk
     endif
 endif
  call MPI_ALLGATHER(on_dpes,1,MPI_LOGICAL, &
               dpes_list,gsz,MPI_LOGICAL, MPI_COMM_WORLD, ierr)
!> Get the master of dpes
 do i=1,gsz
     if (dpes_list(i)) then
          dmg = i-1
          exit
     endif
 enddo
 diag_master = dmg
 diag_global_master = dmg
!!!!!!!! THIS ALL WORKS END !!!!!!!!
!! At this point, the ranks that participate in the calculation 
!! have values in r(i,lrk+1) where lrk is their rank
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!! THIS IS WHERE THINGS GO WRONG? !!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 disp_size = storage_size(r)
 buff_size = disp_size*size(r)
 call c_f_pointer(c_loc(r(1,1)),fptr)
 loc_base = fptr
 nullify(fptr)
 write (6,*) loc_base, grk 
 call MPI_Win_create(loc_base,buff_size,disp_size,MPI_INFO_NULL,&
                     mpi_comm_world,win,ierr)
 call MPI_Win_Fence(0,win,ierr)

displacement = loc_base + disp_size *buff_size

! if (.not.allocated(diag_comm)) then
 if (grk == 11) then
     call MPI_Put(r(:,global_rank+1),size(r,1),MPI_FLOAT,&
          diag_master,displacement,size(r,1), MPI_FLOAT, win ,ierr)
 endif

   call MPI_Win_Fence(0,win,ierr)
   CALL MPI_WIN_FREE(win, ierr)
   call MPI_FINALIZE(ierr)

I have ! if (.not.allocated(diag_comm)) then commented out because I tried to do this with all of the ranks that calculate r, but I got the same result. I am compiling with mpiifort -O0 -fpe0 -init=snan,arrays -no-wrap-margin -traceback -stand f18 and run with mpirun -n 12 ./$@.x : -n 6 ./$@.x in my Makefile. The version of mpiifort I am using is

> mpiifort -v
mpiifort for the Intel(R) MPI Library 2019 Update 2 for Linux*
Copyright 2003-2019, Intel Corporation.
ifort version 19.0.2.187

The output (write (6,*) loc_base, grk)is strange.

  1072411986           0
           0           1
           0           2
           0           3
           0           4
           0           5
           0           6
           0           7
           0           8
           0           9
           0          10
           0          11
  2142952877          12
  2142952877          13
  2142952877          14
  2142952877          15
  2142952877          16
  2142952877          17

Rank 12-17 are the ranks that don't participate in "calculating r", but I'm not sure why c_loc(r(1,1)) is different for these ranks. Also, it is different for rank 0.

My actual questions are

1) How do I calculate the displacement variable? Am I doing it correctly? Is it supposed to be different between ranks because it will be in this case?

2) Why is c_loc(r(1,1)) different for the ranks 12-17? Does it have anything to do with the fact that this is a SPMD program? Why is it different for rank 0?

3) Can I do the one way communication with all of the ranks instead of just one? I had each rank call mpi_isend, and then i just called mpi_irecv in a loop through all of the ranks sending when I did this the other way. Can I do something similar with MPI_Put? Should I be using MPI_Get? Something else?

4) How do I get this to work? This is just an educational example for myself, and what I actually need to do is much more complicated.

Using MPI_PUT in fortran and different ranks have different displacements using c_loc

Answers (1)

Related Questions