MPI + FORTRAN 非阻塞通信交换数组边界测试程序

我写了个测试程序，，功能如下：

1、每个进程初始化一个数组，全部赋值为进程的IDk号：arr(i) = myid；

2、然后各进程将数组的计算域均分，每个进程的计算域为[dp(myid),dp(myid+1))，左闭右开；

3、相邻进程，交换数组的边界，采用非阻塞通信方式；

4、输出自已计算域内的数组元素；

一维：

program main ! implicit none include 'mpif.h' integer, parameter::imax = 1, jmax = 1, kmax = 20 integer i,j,k, kb, ke real arr(kmax) integer delta, myleft, myright, dp(0:kmax) integer myid,numprocs,ierr,status(mpi_status_size,2) integer REQ(4),tag call MPI_Init(IERR) call MPI_Comm_rank(MPI_COMM_WORLD, myid, IERR) call MPI_Comm_size(MPI_COMM_WORLD, numprocs,IERR) !set initial values for array do k = 1, kmax arr(k) = myid enddo forall(i=1:kmax) dp(i) = 0 endforall !partition the task delta = kmax / numprocs dp(0) = 1 do i = 1, numprocs dp(i) = dp(i-1) + delta enddo dp(numprocs) = kmax myleft = myid - 1 myright = myid + 1 if(myleft.eq.(-1)) then myleft = MPI_PROC_NULL endif if(myright.eq.numprocs) then myright = MPI_PROC_NULL endif !MPI_PROC_NULL = -1 kb = dp(myid) ke = dp(myid+1) - 1 if(myid.eq.numprocs-1) then ke = ke + 1 endif ! if(myid.eq.0) print *,'dp:', dp(0:numprocs) do i = 1, 3 tag = i + 100 call MPI_Isend(arr(kb), imax*jmax, MPI_REAL, & myleft,tag,MPI_COMM_WORLD, REQ(1), IERR) call MPI_Isend(arr(ke), imax*jmax, & MPI_REAL, myright,tag,MPI_COMM_WORLD, REQ(2), IERR) call MPI_Irecv(arr(ke), imax*jmax, & MPI_REAL, myright,tag,MPI_COMM_WORLD, REQ(3), IERR) call MPI_Irecv(arr(kb), imax*jmax, MPI_REAL, & myleft,tag,MPI_COMM_WORLD, REQ(4), IERR) call MPI_Waitall(4,REQ,status, IERR) enddo !output local values print *, arr(kb:ke) call mpi_finalize(ierr) end

result:

[root@c0109 simple]# mpif90 send.F -o send [root@c0109 simple]# mpiexec -n 3 ./send 1.000000 2.000000 2.000000 2.000000 2.000000 2.000000 0.000000 1.000000 1.000000 1.000000 2.000000 0.000000 0.000000 0.000000 0.000000 1.000000 [root@c0109 simple]# vim send2.F [root@c0109 simple]# mpif90 send2.F -o send [root@c0109 simple]# mpiexec -n 3 ./send 1.000000 2.000000 2.000000 2.000000 2.000000 2.000000 2.000000 2.000000 0.000000 1.000000 1.000000 1.000000 1.000000 2.000000 0.000000 0.000000 0.000000 0.000000 0.000000 1.000000 [root@c0109 simple]# mpiexec -n 4 ./send 1.000000 2.000000 2.000000 2.000000 3.000000 0.000000 1.000000 1.000000 1.000000 2.000000 2.000000 3.000000 3.000000 3.000000 3.000000 0.000000 0.000000 0.000000 0.000000 1.000000 [root@c0109 simple]# 

 

 

二维：

program main implicit none include 'mpif.h' integer, parameter::imax = 3, jmax = 12 integer i,j,k, kb, ke integer arr(imax,jmax) integer delta, myleft, myright, dp(0:jmax) integer myid,numprocs,ierr,status(mpi_status_size,2) integer REQ(4),tag call MPI_Init(IERR) call MPI_Comm_rank(MPI_COMM_WORLD, myid, IERR) call MPI_Comm_size(MPI_COMM_WORLD, numprocs,IERR) !set initial values for array do 10 j = 1, jmax do 10 i = 1, imax arr(i,j) = myid 10 continue forall(i=1:jmax) dp(i) = 0 endforall !partition the task delta = jmax / numprocs dp(0) = 1 do i = 1, numprocs dp(i) = dp(i-1) + delta enddo dp(numprocs) = jmax myleft = myid - 1 myright = myid + 1 if(myleft.eq.(-1)) then myleft = MPI_PROC_NULL endif if(myright.eq.numprocs) then myright = MPI_PROC_NULL endif !MPI_PROC_NULL = -1 kb = dp(myid) ke = dp(myid+1) - 1 if(myid.eq.numprocs-1) then ke = ke + 1 endif if(myid.eq.0) print *, dp(0:numprocs) do i = 1, 3 tag = i + 200 call MPI_Isend(arr(1,kb), imax, MPI_INTEGER, & myleft,tag,MPI_COMM_WORLD, REQ(1), IERR) call MPI_Isend(arr(1,ke), imax,MPI_INTEGER, & myright,tag,MPI_COMM_WORLD, REQ(2), IERR) call MPI_Irecv(arr(1,ke), imax,MPI_INTEGER, & myright,tag,MPI_COMM_WORLD, REQ(3), IERR) call MPI_Irecv(arr(1,kb), imax,MPI_INTEGER, & myleft,tag,MPI_COMM_WORLD, REQ(4), IERR) call MPI_Waitall(4,REQ,status, IERR) enddo print *, arr(1:imax,kb:ke) call mpi_finalize(ierr) end  

 

result:

[root@c0108 zlt]# mpiexec -n 5 ./a 1 3 5 7 9 12 0 0 0 1 1 1 2 2 2 4 4 4 0 0 0 2 2 2 1 1 1 3 3 3 3 3 3 4 4 4 4 4 4 4 4 4 [root@c0108 zlt]# mpiexec -n 4 ./a 1 4 7 10 12 0 0 0 0 0 0 1 1 1 0 0 0 1 1 1 2 2 2 2 2 2 3 3 3 3 3 3 1 1 1 2 2 2 3 3 3 [root@c0108 zlt]#