在fortran中使用MPI_PUT，并且使用c_loc的不同等级具有不同的位移

Question

我将MPI等级划分为一个数组，以计算不同部分，然后将这些切片放置/发送到不参与计算的不同等级。该等级是新通信器的主人，该通信器被设置为对阵列执行其他操作（平均，IO等）。我将其与MPI_isend和MPI_irecv一起使用，现在我想尝试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)

我有! if (.not.allocated(diag_comm)) then被注释掉了，因为我试图对所有计算r的秩进行此操作，但是得到了相同的结果。我正在使用mpiifort -O0 -fpe0 -init=snan,arrays -no-wrap-margin -traceback -stand f18进行编译，并在我的Makefile中使用mpirun -n 12 ./[email protected] : -n 6 ./[email protected]运行。我使用的mpiifort版本是

> 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

输出（write (6,*) loc_base, grk）很奇怪。

  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

等级12-17是不参与“计算r”的等级，但是我不确定c_loc(r(1,1))为什么这些等级不同。另外，等级0也不同。

我的实际问题是

1）如何计算displacement变量？我做得对吗？因为在这种情况下，等级之间是否应该有所不同？

2）为什么c_loc(r(1,1))在第12-17位排名不同？这与SPMD程序有关吗？为什么等级0有所不同？

3）我可以与所有职等进行单向交流吗？我每个等级都调用mpi_isend，然后我以另一种方式在所有等级发送中循环调用mpi_irecv。我可以对MPI_Put做类似的事情吗？我应该使用MPI_Get吗？还有别的吗？

4）如何使它工作？这只是我自己的一个教育示例，而我实际上需要做的事情要复杂得多。

Answer 1

我至少可以回答项目2。您有：

call c_f_pointer(c_loc(r(1,1)),fptr)
 loc_base = fptr

其中loc_base被声明为整数。您似乎以为loc_base是某种地址，但事实并非如此。在Fortran中，来自指针的固有分配将分配目标的值，而不是目标的位置。因此，您实际上对loc_base做的是TRANSFER的REAL值的r-可能不是您想要的。