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

How to pass information to the main process using MPI PUT?

我想使用 MPI PUT 将信息传递给主进程,但我收到一个错误,该进程未完成就退出了。

例如,两个进程的错误如下所示:

作业中止:

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

如何将我的值 's' 放入主进程?我可以用函数 MPI ACCUMULATE 来做吗? 我想在主进程中获取修改后的 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)

抱歉,您的代码有很多错误,我现在没有时间解释,但下面是一个我认为可行的快速破解版本 - 主要错误是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