MPI_Gather及MPI_Gatherv的Fortran测试代码

1.函数说明

MPI_Gather：收集相同长度的数据块。
MPI_Gatherv：收集不同长度的数据块。与MPI_Gather类似，但允许每个进程发送的数据块长度不同，并且根进程可以任意排放数据块在recvbuf中的位置。

MPI_Gather

MPI_Gather(
    void* sendbuf,
    int sendcnt,
    MPI_Datatype sendtype,
    void* recvbuf,
    int recvcnts,
    MPI_Datatype recvtype,
    int root,
    MPI_Comm comm)

收集相同长度的数据块。以root为根进程，所有进程（包括根进程自己）将sendbuf中的数据块发送给根进程，根进程将这些数据块按进程号的顺序依次放到recvbuf中。发送和接收的数据类型与长度必须匹配，即发送和接收使用的数据类型必须具有相同的类型序列。参数recvbuf，recvcnt和recvtype仅对根进程有意义。
需要注意的是，在根进程中，参数recvcnt指分别从每个进程接收的数据长度，而不是从所有进程接收的数据长度之和。因此，当sendtype等于recvtype时，sendcnt应该等于recvcnt。

MPI_Gatherv

MPI_Gatherv(
    void* sendbuf,
    int sendcnt,
    MPI_Datatype sendtype,
    void* recvbuf,
    int recvcnts,
    int* displs,
    MPI_Datatype recvtype,
    int root,
    MPI_Comm comm)

收集不同长度的数据块。与MPI_Gather类似，但允许每个进程发送的数据块长度不同，并且根据进程可以任意排放数据块在recvbuf中的位置。recvbuf，recvtype，recvcnts和displs仅对根进程有意义。数组recvcnts和displs的元素个数等于进程数，用于指定从每个进程接收的数据块长度和他们在recvbuf中的位移，均以recvtype为单位。

MPI参考手册

2.测试代码

mpi_gatherv_test.f90

PROGRAM Main
! -------------------------------------------
! MPI_Gather和MPI_Gatherv的Fortran测试代码
! Yuan @2020.05.19
! -------------------------------------------
  IMPLICIT NONE
  include 'mpif.h'
  INTEGER  :: prcnumb   ! Total number of processes;
  INTEGER  :: myprcid   ! Current process id,from 0 to prcnumb-1;
  LOGICAL  :: OnMonitor ! Whether it is a master node,0=True;

  INTEGER  :: num
  INTEGER  :: num_total
  INTEGER  :: i,ierr,count,root
  INTEGER,DIMENSION(:),ALLOCATABLE :: num_n,lev,lev_n,displs

! ----------------------------
!  1.0 MPI初始化
! ----------------------------
  CALL MPI_Init(ierr)  !MPI环境初始化
  CALL MPI_COMM_RANK(MPI_COMM_WORLD,myprcid,ierr)  !获取当前进程id，从0开始编号
  CALL MPI_COMM_SIZE(MPI_COMM_WORLD,prcnumb,ierr)  !获取总进程数
  OnMonitor=.false.
  IF(myprcid==0) OnMonitor=.true.

! ----------------------------
!  2.0 MPI_Gather的测试例子
! ----------------------------
  num=myprcid+1
  PRINT*,'myprcid=',myprcid,'num=',num
  ALLOCATE(num_n(1:prcnumb))
  count=1
  root=0 !主进程为0号进程
  !Gather：收集相同长度的数据块
  CALL MPI_Gather(num,count,mpi_integer4,num_n,count,mpi_integer4,root,MPI_COMM_WORLD,ierr)
  IF(OnMonitor) PRINT*,'Gather num result=',num_n


! ----------------------------
!  3.0 MPI_Gatherv的测试例子
! ----------------------------
  ALLOCATE(lev(1:num))
  lev=myprcid+1
  PRINT*,'myprcid=',myprcid,'lev=',lev
  
  IF(OnMonitor) THEN
    num_total=sum(num_n)
    PRINT*,'num_total=',num_total
    ALLOCATE(lev_n(1:num_total))

    ALLOCATE(displs(1:prcnumb))
    DO i=1,prcnumb
      displs(i)=sum(num_n(1:i-1)) !displs是相对位置，从0开始
    ENDDO
    PRINT*,'displs=',displs
  ENDIF

  !Gatherv：收集不同长度的数据块，num_n,displs,lev_n由root进程给出
  CALL MPI_Gatherv(lev,num,mpi_integer4,lev_n,num_n,displs,mpi_integer4,root,MPI_COMM_WORLD,ierr)
  IF(OnMonitor) PRINT*,'Gatherv lev result=',lev_n


! ----------------------------
!  4.0 释放空间及结束MPI并行环境
! ----------------------------  
  DEALLOCATE(lev)
  IF(OnMonitor) DEALLOCATE(num_n,lev_n,displs)
  
  CALL MPI_Finalize(ierr)

END PROGRAM Main

3.编译及运行结果：

编译：

mpif90 -o test.exe mpi_gatherv_test.f90
mpirun -np 4 ./test.exe

结果：

测试代码运行结果

最后编辑于：2020.08.19 11:52:19

禁止转载，如需转载请通过简信或评论联系作者。