DISPATCH
mpi_comm_mod.f90
1 !===============================================================================
2 !> Simple module for sending / receiving packages to / from other ranks
3 !===============================================================================
5 #ifdef MPI
6  USE mpi
7 #endif MPI
8  USE mpi_mod, mp => mpi
9  implicit none
10  private
11  type, public:: mpi_comm_t
12  integer:: req=0
13  integer:: ierr
14  logical:: flag
15  integer, dimension(:), allocatable:: buffer
16  contains
17  procedure:: send
18  procedure:: sent
19  procedure:: recv
20  end type
21 CONTAINS
22 
23 !===============================================================================
24 !> Send a buffer to a rank, with a given tag, and ignore the request
25 !===============================================================================
26 SUBROUTINE send (self, rank, tag)
27  class(mpi_comm_t):: self
28  integer:: rank, tag
29  !-----------------------------------------------------------------------------
30 #ifdef MPI
31  if (mp%mode == mpi_thread_multiple) then
32  call mpi_isend (self%buffer, size(self%buffer), mpi_integer, rank, tag, &
33  mp%comm, self%req, self%ierr)
34  else
35  !$omp critical (mpi_cr)
36  call mpi_isend (self%buffer, size(self%buffer), mpi_integer, rank, tag, &
37  mp%comm, self%req, self%ierr)
38  !$omp end critical (mpi_cr)
39  end if
40 #endif MPI
41 END SUBROUTINE send
42 
43 !===============================================================================
44 !> If not send request is active, start a send. When finished, clear request.
45 !===============================================================================
46 FUNCTION sent (self)
47  logical:: sent
48  class(mpi_comm_t):: self
49 #ifdef MPI
50  !............................................................................
51  integer:: stat(mpi_status_size)
52  !-----------------------------------------------------------------------------
53  if (mp%mode == mpi_thread_multiple) then
54  call mpi_test (self%req, sent, stat, self%ierr)
55  else
56  !$omp critical (mpi_cr)
57  call mpi_test (self%req, sent, stat, self%ierr)
58  !$omp end critical (mpi_cr)
59  end if
60 #else
61  sent = .false.
62 #endif
63  if (sent) self%req = 0
64 END FUNCTION sent
65 
66 !===============================================================================
67 !> If no request is active, issue an MPI_Irecv. If a request is active, clear
68 !> the request if it has finished. In this way, we can receive a stream of
69 !> messages that we know are being sent from a specific rank. The buffer is
70 !> assumed to be permanent, but we are only allowed to access the content when
71 !> a recv call results in a cleared request.
72 !===============================================================================
73 FUNCTION recv (self, rank, tag)
74  logical:: recv
75  class(mpi_comm_t):: self
76  integer:: rank, tag
77 #ifdef MPI
78  !............................................................................
79  integer:: stat(mpi_status_size)
80  !-----------------------------------------------------------------------------
81  if (mp%mode == mpi_thread_multiple) then
82  if (self%req==0) then
83  call mpi_irecv (self%buffer, size(self%buffer), mpi_integer, rank, tag, &
84  mp%comm, self%req, self%ierr)
85  call mpi_test (self%req, recv, stat, self%ierr)
86  end if
87  else
88  !$omp critical (mpi_cr)
89  if (self%req==0) then
90  call mpi_irecv (self%buffer, size(self%buffer), mpi_integer, rank, tag, &
91  mp%comm, self%req, self%ierr)
92  call mpi_test (self%req, recv, stat, self%ierr)
93  end if
94  !$omp end critical (mpi_cr)
95  end if
96 #else
97  recv = .false.
98 #endif
99  if (recv) self%req = 0
100 END FUNCTION recv
101 
102 END MODULE mpi_comm_mod
Simple module for sending / receiving packages to / from other ranks.
Definition: mpi_comm_mod.f90:4