Fortran90 MPI程序中如何从指定rank获取3D数组的单个元素值

你遇到的问题核心是常规点对点通信需要收发两端主动调用通信接口，但无计算任务的进程不会进入通信逻辑，因此最优方案是使用MPI单边通信（RMA，远程内存访问），该方案不需要远端进程主动参与通信操作，仅需初始化阶段全局注册共享内存即可。

原方案报错原因 #

• MPI_Sendrecv需要通信两端同时调用该接口，你仅在需要拉取数据的进程中调用，远端发送进程未执行对应通信调用，因此会出现消息截断、超时等错误。
• 广播、集合通信要求通信域内所有进程同时调用，也不符合你的场景。

具体实现步骤 #

1. 全局初始化阶段（所有进程都执行，不需要放到if判断内） #

所有进程分配完u数组后，创建MPI RMA窗口，将u数组的内存暴露给通信域内所有进程：

! 分配u数组后新增代码
INTEGER :: win
CALL MPI_Win_create(u, (ie-is+1)*(je-js+1)*(ke-ks+1)*8, 8, MPI_INFO_NULL, MPI_COMM_WORLD, win, ierr)

2. 在perform_some_action子程中拉取远端数据 #

需要获取其他rank的u数组值时，使用MPI_Get接口直接读取远端窗口内存即可：

subroutine perform_some_action(sendingRank, i_target, j_target, k_target, saveValueHere)
    implicit none
    include 'mpif.h'
    integer, intent(in) :: sendingRank, i_target, j_target, k_target
    real(8), intent(out) :: saveValueHere
    integer :: ierr, disp
    ! 提前保存各进程u数组的起始/结束索引，可作为全局变量或入参传递
    integer, save :: is_s, ie_s, js_s, je_s, ks_s, ke_s 
    ! 计算目标元素在远端进程u数组中的偏移量（适配Fortran列优先存储顺序）
    disp = (k_target - ks_s) * (ie_s - is_s + 1) * (je_s - js_s + 1) + (j_target - js_s) * (ie_s - is_s + 1) + (i_target - is_s)
    disp = disp * 8 ! 乘以双精度浮点数的字节数
    
    ! RMA同步
    CALL MPI_Win_fence(0, win, ierr)
    ! 拉取远端数据
    CALL MPI_Get(saveValueHere, 1, MPI_DOUBLE_PRECISION, sendingRank, disp, 1, MPI_DOUBLE_PRECISION, win, ierr)
    ! 同步确保数据拉取完成
    CALL MPI_Win_fence(0, win, ierr)
end subroutine

3. 程序结束前全局释放窗口 #

所有进程在MPI_Finalize前调用窗口释放接口：

CALL MPI_Win_free(win, ierr)

修改后的可运行示例代码 #

PROGRAM mpitest
USE mpi
IMPLICIT NONE

INTEGER :: ierr, npe, rank, win
INTEGER :: is,ie,js,je,ks,ke
REAL(8), dimension(:,:,:), allocatable :: u
REAL(8) :: saveValueHere
INTEGER :: disp ! 内存偏移量

CALL MPI_INIT( ierr )
CALL MPI_COMM_RANK( MPI_COMM_WORLD, rank, ierr )
CALL MPI_COMM_SIZE( MPI_COMM_WORLD, npe, ierr )

if(rank.eq.0) then
    is=1
    ie=2
    js=1
    je=2
    ks=1
    ke=2
else if(rank.eq.1) then
    is=3
    ie=4
    js=3
    je=4
    ks=3
    ke=4
endif

allocate(u(is:ie,js:je,ks:ke))
u=0.d0
if(rank.eq.0) then
    u(is,js,ks)=1.d0
    u(is,js,ke)=2.d0
    u(is,je,ks)=3.d0
    u(is,je,ke)=4.d0
    u(ie,js,ks)=5.d0
    u(ie,js,ke)=6.d0
    u(ie,je,ks)=7.d0
    u(ie,je,ke)=8.d0
else if(rank.eq.1) then
    u(is,js,ks)=11.d0
    u(is,js,ke)=12.d0
    u(is,je,ks)=13.d0
    u(is,je,ke)=14.d0
    u(ie,js,ks)=15.d0
    u(ie,js,ke)=16.d0
    u(ie,je,ks)=17.d0
    u(ie,je,ke)=18.d0
endif

! 所有进程创建RMA窗口
CALL MPI_Win_create(u, (ie-is+1)*(je-js+1)*(ke-ks+1)*8, 8, MPI_INFO_NULL, MPI_COMM_WORLD, win, ierr)

if(rank.eq.0) then
    write(*,*) 'get u(3,4,3)=13.d0 from rank 1 and save in saveValueHere'
    ! 计算rank1上u(3,4,3)的偏移量：rank1的ks=3, js=3, is=3
    disp = (3 - 3) * (4-3+1)*(4-3+1) + (4 - 3)*(4-3+1) + (3-3)
    disp = disp * 8
    ! 拉取数据
    CALL MPI_Win_fence(0, win, ierr)
    CALL MPI_Get(saveValueHere, 1, MPI_DOUBLE_PRECISION, 1, disp, 1, MPI_DOUBLE_PRECISION, win, ierr)
    CALL MPI_Win_fence(0, win, ierr)
    write(*,*) '拉取结果：saveValueHere = ', saveValueHere
endif

! 释放窗口
CALL MPI_Win_free(win, ierr)
deallocate(u)

CALL MPI_FINALIZE(ierr)

END PROGRAM mpitest

额外说明 #

• 偏移量计算需要严格对应Fortran数组列优先的存储顺序，不要和C语言的行优先混淆。
• 如果你的计算场景中多个进程同时拉取数据，MPI_Win_fence同步可以保证数据一致性，不需要额外处理。
• 该方案完全不需要无计算任务的进程参与任何通信逻辑，仅需初始化和释放阶段执行两次全局调用即可，适配你的代码结构。

内容的提问来源于stack exchange，提问作者tre95