第二个例子:介绍MPI_BARRIER,同步
MPI_BARRIER,同步
MPI_BARRIER(COMM, IERROR)
!!!说明!!!
COMM -- 通信域
IERROR -- 返回的错误代码
说明:MPI_BARRIER阻塞所有的调用者直到所有的组成员都调用了它,各个进程中这个调用才可以返回。就是说,有些进程执行得快,有些进程执行得慢,要等待所有的进程都执行到这里,才开时同时执行之后的命令,即“同步”。
例:
1 program main 2 3 use mpi 4 implicit none 5 6 character(len=20) :: message1,message2,message3 7 integer :: myid, ierr, status(mpi_status_size), rc, numprocs 8 9 call MPI_INIT(ierr) 10 call MPI_COMM_RANK( MPI_COMM_WORLD, myid, ierr ) 11 call MPI_COMM_SIZE(MPI_COMM_WORLD,numprocs,ierr) 12 write(*,*) ' process ', myid, ' of ', numprocs, ' is alive' 13 14 call MPI_BARRIER( MPI_COMM_WORLD, ierr ) 15 16 if ( myid .eq. 0) then 17 message1 = 'Hello, process 1' 18 call MPI_SEND(message1,20,MPI_CHAR,1,99,MPI_COMM_WORLD,ierr) 19 message2 = 'Hello, process 2' 20 call MPI_SEND(message2,20,MPI_CHAR,2,99,MPI_COMM_WORLD,ierr) 21 message3 = 'Hello, process 3' 22 call MPI_SEND(message3,20,MPI_CHAR,3,99,MPI_COMM_WORLD,ierr) 23 else if ( myid .eq. 1 ) then 24 call MPI_RECV(message1,20,MPI_CHAR,0,99,MPI_COMM_WORLD,status,ierr) 25 write(*,*) message1 26 else if ( myid .eq. 2 ) then 27 call MPI_RECV(message2,20,MPI_CHAR,0,99,MPI_COMM_WORLD,status,ierr) 28 write(*,*) message2 29 else if ( myid .eq. 3 ) then 30 call MPI_RECV(message3,20,MPI_CHAR,0,99,MPI_COMM_WORLD,status,ierr) 31 write(*,*) message3 32 end if 33 34 call MPI_FINALIZE(rc) 35 36 end
没有14行MPI_BARRIER的时候,程序执行结果可能是这样的:
1 process 0 of 4 is alive 2 process 1 of 4 is alive 3 Hello, process 1 4 process 2 of 4 is alive 5 Hello, process 2 6 process 3 of 4 is alive 7 Hello, process 3
可以看到,12行write写命令并没有连续输出,中间被其他的写命令抢先了,因为23行if做了个判断,当process=1时,写出message1,之后的执行同样如此。
当加入14行MPI_BARRIER的时候,程序强制让执行快的进程等一下执行慢的,或者不考虑之后的命令,所有的进程全部都执行完12行的write写命令,之后才开始执行之后的命令。程序执行结果为:
1 process 1 of 4 is alive 2 process 2 of 4 is alive 3 process 3 of 4 is alive 4 process 0 of 4 is alive 5 Hello, process 1 6 Hello, process 2 7 Hello, process 3
可以看到,4个12行的write写命令都执行完之后,程序才执行之后的命令。