如何使用 MPI PUT 将信息传递给主进程？

Question

我想使用 MPI PUT 将信息传递给主进程，但是我收到一个错误，即进程在没有完成的情况下退出。

例如，两个进程的错误如下所示：

作业中止：

[ranks] message
[0] terminated
[1] process exited without calling finalize

我怎样才能把我的价值's'放到主进程中？我可以用函数 MPI ACCUULATE 来做吗？ 我想在主进程中获取修改后的 s 变量。如果我想计算从所有进程接收到的所有变量的总和，代码会是什么样子？

integer :: process_Rank, size_Of_Cluster, ierror = 0, win, s = 1

call MPI_INIT(ierror)
call MPI_COMM_SIZE(MPI_COMM_WORLD, size_Of_Cluster, ierror)
call MPI_COMM_RANK(MPI_COMM_WORLD, process_Rank, ierror)

!create windows
if(process_Rank == 0) then
   call MPI_WIN_CREATE(s, sizeof(s), 1, MPI_INFO_NULL, MPI_COMM_WORLD, win, ierror)
else
    call MPI_WIN_CREATE(0, 0, 1, MPI_INFO_NULL, MPI_COMM_WORLD, win, ierror)
end if

print *, process_Rank, ' create window'
CALL MPI_Win_fence(0,win,ierror)

!get s from main process (rank = 0)
if(process_Rank <> 0) then
   CALL MPI_Get(s, sizeof(s) , MPI_INT, 0, 0, 20, MPI_INT, win, ierror)
   print *, process_Rank, ' get data and s = ', s
end if

CALL MPI_Win_fence(0,win,ierror)

if(process_Rank <> 0) then
    s = s + process_Rank
    print *, process_Rank, ' s = ', s
    CALL MPI_PUT(s, sizeof(s), MPI_INT, 0 , 1 , 1, MPI_INT, win, ierror)
end if
 
print *, 'result s = ', s
CALL MPI_Win_fence(0, win,ierror)
 
CALL MPI_WIN_FREE(win, ierror)
call MPI_FINALIZE(ierror)

Answer 1

很抱歉，您的代码有很多错误，我现在没有时间解释这一切，但下面是一个我认为可行的非常快速的破解版本 - 主要错误是不正确的类型用于 MPI 例程的实际参数，以及使用非标准功能（sizeof、 [这真的有效吗？]、MPI_INT，也许还有其他）。请研究它并尝试找出它为什么有效而你的无效，我将尝试回来并在某个时候进行更长的解释。但是，如果您什么都没学到，请停止使用 Include 'mpif.h' 并像我一样开始使用该模块 - 这会立即发现您的一个更严重的错误，即多次调用中位移参数的整数类型错误。

如果您正在学习，我还建议您不要使用 Portland Group 编译器。这些年来我的经历并不好。尝试使用最新版本的 gfortran 或 Intel 或 NAG 编译器。

Program onesided

  Use mpi
  
  Implicit None

  integer :: process_Rank, size_Of_Cluster, ierror = 0, win, s = 1, size_s

  Call mpi_sizeof( s, size_s, ierror )

  call MPI_INIT(ierror)
  call MPI_COMM_SIZE(MPI_COMM_WORLD, size_Of_Cluster, ierror)
  call MPI_COMM_RANK(MPI_COMM_WORLD, process_Rank, ierror)

  !create windows
  if(process_Rank == 0) then
     call MPI_WIN_CREATE(s, Int( size_s, mpi_address_kind ), 1, MPI_INFO_NULL, MPI_COMM_WORLD, win, ierror)
  else
     call MPI_WIN_CREATE(0, 0_mpi_address_kind, 1, MPI_INFO_NULL, MPI_COMM_WORLD, win, ierror)
  end if

  print *, process_Rank, ' create window'
  CALL MPI_Win_fence(0,win,ierror)

  !get s from main process (rank = 0)
  if(process_Rank /= 0) then
     CALL MPI_Get(s, 1, MPI_INTEGER, &
          0, 0_mpi_address_kind, 1, MPI_INTEGER, win, ierror)
     print *, process_Rank, ' get data and s = ', s
  end if

  CALL MPI_Win_fence(0,win,ierror)

  if(process_Rank /= 0) then
     s = s + process_Rank
     print *, process_Rank, ' s = ', s
     CALL MPI_PUT(s, 1, MPI_INTEGER, 0 , 0_mpi_address_kind, 1, MPI_INTEGER, win, ierror)
  end if

  print *, 'result s = ', s
  CALL MPI_Win_fence(0, win,ierror)

  CALL MPI_WIN_FREE(win, ierror)
  call MPI_FINALIZE(ierror)

End Program onesided
ijb@ijb-Latitude-5410:~/work/stack$ mpif90 --version
GNU Fortran (Ubuntu 9.3.0-17ubuntu1~20.04) 9.3.0
Copyright (C) 2019 Free Software Foundation, Inc.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

ijb@ijb-Latitude-5410:~/work/stack$ mpif90 -Wall -Wextra -fcheck=all -O -g -std=f2018 one_side.f90
ijb@ijb-Latitude-5410:~/work/stack$ mpirun -np 2 ./a.out 
           0  create window
 result s =            1
           1  create window
           1  get data and s =            1
           1  s =            2
 result s =            2