DISPATCH
process_mod.f90
1 !===============================================================================
2 !> Data type to keep and maintain information on MPI processes. The process
3 !> data type maintains a list of nbor MPI ranks, which is used to send and recv.
4 !>
5 !> To send a buffer to all nbors, repeatedly do:
6 !>
7 !> call process%send (buffer)
8 !>
9 !> To process incoming buffers (with "call unpack(buffer)"), repeatedly do
10 !>
11 !> call process%recv (buffer, unpack)
12 !>
13 !===============================================================================
15  USE io_mod
16  USE trace_mod
17  USE mpi_mod
18  USE mpi_comm_mod
19  USE link_mod
20  USE task_list_mod
21  implicit none
22  private
23  !-----------------------------------------------------------------------------
24  ! process nbor
25  !-----------------------------------------------------------------------------
26  type, public:: nbor_t
27  type(nbor_t), pointer:: next => null()
28  type(mpi_comm_t):: out, in
29  integer:: rank
30  logical:: present
31  end type
32  !-----------------------------------------------------------------------------
33  ! process nbor list
34  !-----------------------------------------------------------------------------
35  type, public:: nbor_list_t
36  type(nbor_t), pointer:: head => null()
37  type(nbor_t), pointer:: tail => null()
38  contains
39  procedure:: update
40  procedure:: add_by_rank
41  end type
42 CONTAINS
43 
44 !===============================================================================
45 !> Initialize a neighbor list
46 !===============================================================================
47 SUBROUTINE update (self, task_list)
48  class(nbor_list_t):: self
49  type(task_list_t):: task_list
50  !.............................................................................
51  type(link_t), pointer:: link
52  type(nbor_t), pointer:: nbor, next, prev
53  logical, save:: first_time=.true.
54  !-----------------------------------------------------------------------------
55  ! Clear the present flag
56  !-----------------------------------------------------------------------------
57  call trace%begin ('nbor_list_t%update')
58  nbor => self%head
59  do while (associated(nbor))
60  nbor%present = .false.
61  nbor => nbor%next
62  end do
63  !-----------------------------------------------------------------------------
64  ! Add to the nbor_list and set present flags
65  !-----------------------------------------------------------------------------
66  link => task_list%head
67  do while (associated(link))
68  if (link%task%rank /= mpi%rank) &
69  call self%add_by_rank (link%task%rank)
70  link => link%next
71  end do
72  !-----------------------------------------------------------------------------
73  ! Prune the nbor_list = remove ranks that are no longer present
74  !-----------------------------------------------------------------------------
75  nullify (prev)
76  nbor => self%head
77  if (first_time.and.io%master) &
78  print *, 'nbors to rank', mpi%rank, ':'
79  do while (associated(nbor))
80  next => nbor%next
81  if (.not.nbor%present) then
82  if (associated(prev)) then
83  prev%next => next
84  else
85  self%head => next
86  end if
87  deallocate (nbor)
88  end if
89  if (first_time.and.io%master) &
90  print *, 'nbor rank:', nbor%rank
91  nbor => next
92  end do
93  first_time = .false.
94  call trace%end()
95 END SUBROUTINE update
96 
97 !===============================================================================
98 !> Add an nbor to the list, keeping it sorted by rank
99 !===============================================================================
100 SUBROUTINE add_by_rank (self, rank)
101  class(nbor_list_t):: self
102  integer:: rank
103  !.............................................................................
104  type(nbor_t), pointer:: this, nbor
105  !-----------------------------------------------------------------------------
106  call trace%begin ('nbor_list_t%add_by_rank')
107  this => self%head
108  if (associated(this)) then
109  !---------------------------------------------------------------------------
110  ! If nbor%rank is less than self%head%rank, place it at the head
111  !---------------------------------------------------------------------------
112  if (rank < this%rank) then
113  nbor => new_nbor(rank)
114  nbor%next => this
115  self%head => nbor
116  call trace%end()
117  return
118  else
119  do while (associated(this))
120  !-----------------------------------------------------------------------
121  ! If not at the tail, and nbor%rankd is in between this and the next
122  !-----------------------------------------------------------------------
123  if (rank == this%rank) then
124  this%present = .true.
125  return
126  else if (associated(this%next)) then
127  if (rank > this%rank .and. rank < this%next%rank) then
128  nbor => new_nbor(rank)
129  nbor%next => this%next
130  this%next => nbor
131  call trace%end()
132  return
133  end if
134  !-----------------------------------------------------------------------
135  ! At the tail
136  !-----------------------------------------------------------------------
137  else if (rank > this%rank) then
138  nbor => new_nbor(rank)
139  this%next => nbor
140  self%tail => nbor
141  call trace%end()
142  return
143  end if
144  this => this%next
145  call trace%end()
146  return
147  end do
148  end if
149  !-----------------------------------------------------------------------------
150  ! If self%head is not associated, nbor is the first list elemend to be added
151  !-----------------------------------------------------------------------------
152  else
153  nbor => new_nbor(rank)
154  self%head => nbor
155  self%tail => nbor
156  end if
157  call trace%end()
158 contains
159  !-----------------------------------------------------------------------------
160  !-----------------------------------------------------------------------------
161  function new_nbor (rank)
162  integer:: rank
163  type(nbor_t), pointer:: new_nbor
164  !---------------------------------------------------------------------------
165  allocate (new_nbor)
166  new_nbor%rank = rank
167  new_nbor%present = .true.
168  end function
169 END SUBROUTINE add_by_rank
170 
171 END MODULE nbor_list_mod
172 
173 !===============================================================================
174 !> Data type to keep and maintain information on MPI processes
175 !===============================================================================
177  USE io_mod
178  USE trace_mod
179  USE mpi_mod
180  USE link_mod
181  USE task_list_mod
182  USE nbor_list_mod
183  implicit none
184  private
185  !-----------------------------------------------------------------------------
186  ! process
187  !-----------------------------------------------------------------------------
188  type, public:: process_t
189  integer:: rank
190  type(nbor_list_t):: nbor_list
191  contains
192  procedure:: update
193  procedure:: send
194  procedure:: recv
195  end type
196 CONTAINS
197 
198 !===============================================================================
199 !> Initialize a process_t instance
200 !===============================================================================
201 SUBROUTINE update (self, task_list)
202  class(process_t):: self
203  type(task_list_t):: task_list
204  !.............................................................................
205  call self%nbor_list%update (task_list)
206  self%rank = mpi%rank
207 END SUBROUTINE update
208 
209 !===============================================================================
210 !> Send a buffer to all nbors. When a send is complete, renew the buffer, and
211 !> resend.
212 !===============================================================================
213 SUBROUTINE send (self, buffer)
214  class(process_t):: self
215  integer, pointer:: buffer(:)
216  type(nbor_t), pointer:: nbor
217  !.............................................................................
218  nbor => self%nbor_list%head
219  do while (associated(nbor))
220  if (.not.allocated(nbor%out%buffer)) then
221  allocate (nbor%out%buffer(size(buffer)))
222  nbor%out%buffer = buffer
223  call nbor%out%send (nbor%rank, 111)
224  end if
225  if (nbor%out%sent ()) then
226  nbor%out%buffer = buffer
227  call nbor%out%send (nbor%rank, 111)
228  end if
229  nbor => nbor%next
230  end do
231 END SUBROUTINE send
232 
233 !===============================================================================
234 !> Receive and process a buffer from all nbors
235 !===============================================================================
236 SUBROUTINE recv (self, buffer, process)
237  class(process_t):: self
238  integer, pointer:: buffer(:)
239  procedure(template):: process
240  !.............................................................................
241  type(nbor_t), pointer:: nbor
242  !-----------------------------------------------------------------------------
243  ! Loop over process nbors, asking for input packages, and process when recv'd
244  !-----------------------------------------------------------------------------
245  nbor => self%nbor_list%head
246  do while (associated(nbor))
247  if (.not.allocated(nbor%in%buffer)) then
248  allocate (nbor%in%buffer(size(buffer)))
249  end if
250  if (nbor%in%recv (nbor%rank, 111)) then
251  call process (nbor%in%buffer)
252  end if
253  nbor => nbor%next
254  end do
255 END SUBROUTINE recv
256 
257 !===============================================================================
258 !> Template processing procedure
259 !===============================================================================
260 SUBROUTINE template (buffer)
261  integer:: buffer(:)
262 END SUBROUTINE template
263 
264 END MODULE process_mod
Data type to keep and maintain information on MPI processes.
Task list data type, with methods for startup and updates. Message handling is inherited from the tas...
Data type to keep and maintain information on MPI processes. The process data type maintains a list o...
Definition: process_mod.f90:14
Definition: io_mod.f90:4
Simple module for sending / receiving packages to / from other ranks.
Definition: mpi_comm_mod.f90:4