44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60 USE intbufdef_mod
64 use spmd_mod
65
66
67
68 USE spmd_comm_world_mod, ONLY : spmd_comm_world
69#include "implicit_f.inc"
70
71
72
73#include "spmd.inc"
74
75
76
77#include "com01_c.inc"
78#include "com04_c.inc"
79#include "param_c.inc"
80#include "task_c.inc"
81#include "tabsiz_c.inc"
82
83
84
85 INTEGER, INTENT(in) :: NIN
86 INTEGER, INTENT(in) :: MODE
87 INTEGER, INTENT(in) :: NODNX_SMS_SIZ
88 INTEGER, INTENT(in) ::
89 INTEGER, DIMENSION(NINTER+1,NSPMD+1), INTENT(in) :: ISENDTO,IRCVFROM
90 INTEGER, DIMENSION(NPARI,NINTER), INTENT(in) :: IPARI
91 INTEGER, DIMENSION(NUMNOD), INTENT(inout) :: WEIGHT
92 INTEGER, DIMENSION(2,NSPMD+1), INTENT(in) ::
93 INTEGER, DIMENSION(SFR_ELEM), INTENT(in) :: FR_ELEM
94 my_real,
DIMENSION(3,NUMNOD),
INTENT(in) :: x,v
95 my_real,
DIMENSION(NUMNOD),
INTENT(in) :: ms
96 my_real,
DIMENSION(TEMP_SIZE),
INTENT(in) :: temp
97 INTEGER, DIMENSION(NUMNOD), INTENT(in) :: ITAB
98 INTEGER, DIMENSION(NUMNOD), INTENT(in) :: KINET
99 INTEGER, DIMENSION(NODNX_SMS_SIZ), INTENT(in) :: NODNX_SMS
100 TYPE(INTBUF_STRUCT_), DIMENSION(NINTER), INTENT(in) :: INTBUF_TAB
101 TYPE(inter_struct_type), DIMENSION(NINTER), INTENT(inout) :: INTER_STRUCT
102 TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM
103 INTEGER, INTENT(IN) :: GOT_PREVIEW
104 type(component_), dimension(ninter), intent(inout) :: component
105
106
107
108#ifdef MPI
109 LOGICAL :: IS_EXCHANGE_NEEDED
110 INTEGER :: KK,I,J,ijk
111 INTEGER :: P,P_LOC,LOCAL_RANK,REMOTE_PROC
112 INTEGER :: SIZE_,OLD_POINTER
113 INTEGER :: ADRESS,SHIFT_
114 INTEGER :: INDEX_S,INDEX_R
115 INTEGER :: ITIED
116
117 INTEGER ,STATUS(MPI_STATUS_SIZE),IERROR
118 INTEGER :: TOTAL_RCV_SIZE,TOTAL_SEND_SIZE
119 INTEGER :: LOC_PROC,ID_PROC
120 INTEGER :: COUNT_COMM_SIZE_CELL,ID_COMM
121 INTEGER :: DIPLS_
122 INTEGER, DIMENSION(:), ALLOCATABLE :: ARRAY_REQUEST
123 LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: ALREADY_SEND
124 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX_ALREADY_SEND
125
126 INTEGER :: MSGTYP,
127 INTEGER :: MSGOFF
128 DATA msgoff/13000/
129 integer, parameter :: my_tag = 13001
130 logical :: my_condition
131! --------------------------------------------------------------------
132 loc_proc = ispmd + 1
133
134
135
136
137
138 IF(mode==1) THEN
139 IF(ircvfrom(nin,loc_proc)==0.AND.isendto(nin,loc_proc)==0) RETURN
140 IF(.NOT.ALLOCATED(sort_comm(nin)%NB_CELL_PROC)) THEN
141 size_ = sort_comm(nin)%PROC_NUMBER
142 ALLOCATE(sort_comm(nin)%NB_CELL_PROC(size_))
143 ENDIF
144
145 IF(.NOT.ALLOCATED(sort_comm(nin)%SEND_NB_CELL)) THEN
146 size_ = sort_comm(nin)%PROC_NUMBER
147 ALLOCATE(sort_comm(nin)%SEND_NB_CELL(size_))
148 ENDIF
149
150 IF(.NOT.ALLOCATED(sort_comm(nin)%RCV_NB_CELL)) THEN
151 size_ = sort_comm(nin)%PROC_NUMBER
152 ALLOCATE(sort_comm(nin)%RCV_NB_CELL(size_))
153 ENDIF
154
155 IF(.NOT.ALLOCATED(sort_comm(nin)%SEND_DISPLS_NB_CELL)) THEN
156 size_ = sort_comm(nin)%PROC_NUMBER
157 ALLOCATE(sort_comm(nin)%SEND_DISPLS_NB_CELL(size_))
158 ENDIF
159
160 IF(.NOT.ALLOCATED(sort_comm(nin)%RCV_DISPLS_NB_CELL)) THEN
161 size_ = sort_comm(nin)%PROC_NUMBER
162 ALLOCATE(sort_comm(nin)%RCV_DISPLS_NB_CELL(size_))
163 ENDIF
164 my_size = 0
165 total_rcv_size = 0
166 DO i=1,sort_comm(nin)%PROC_NUMBER
167 id_proc = sort_comm(nin)%PROC_LIST(i)
168 sort_comm(nin)%SEND_NB_CELL(i) = 0
169 IF(isendto(nin,id_proc)>0) THEN
170 sort_comm(nin)%SEND_NB_CELL(i) = 1
171 ENDIF
172 sort_comm(nin)%SEND_DISPLS_NB_CELL(i) = 0
173
174 sort_comm(nin)%RCV_NB_CELL(i) = 0
175 IF(isendto(nin,loc_proc)>0) THEN
176 sort_comm(nin)%RCV_NB_CELL(i) = 1
177 ENDIF
178 sort_comm(nin)%RCV_DISPLS_NB_CELL(i) = total_rcv_size
179 IF(isendto(nin,loc_proc)>0) THEN
180 total_rcv_size = total_rcv_size + 1
181 ENDIF
182 ENDDO
183
184 total_send_size = 2
185
186 if(.not.allocated(sort_comm(nin)%request_s)) then
187 allocate(sort_comm(nin)%request_s(sort_comm(nin)%proc_number))
188 endif
189 if(.not.allocated(sort_comm(nin)%request_r)) then
190 allocate(sort_comm(nin)%request_r(sort_comm(nin)%proc_number))
191 endif
192 if(.not.allocated(sort_comm(nin)%index_r)) then
193 allocate(sort_comm(nin)%index_r(sort_comm(nin)%proc_number))
194 endif
195 IF(.NOT.ALLOCATED(sort_comm(nin)%SEND_SIZE_CELL)) THEN
196 size_ = sort_comm(nin)%PROC_NUMBER
197 ALLOCATE(sort_comm(nin)%SEND_SIZE_CELL(size_))
198 ENDIF
199
200 sort_comm(nin)%request_s_nb = 0
201 sort_comm(nin)%request_r_nb = 0
202 my_size = 0
203 itied = ipari(85,nin)
204 do i=1,sort_comm(nin)%proc_number
205 id_proc = sort_comm(nin)%proc_list(i)
206 sort_comm(nin)%nb_cell_proc(i) = 0
207 sort_comm(nin)%send_size_cell(i) = 0
208 my_condition = (itied/=0.and.id_proc-1/=ispmd).or.component(nin)%proc_comp(id_proc)%need_comm_r
209 my_condition = my_condition.and.(isendto(nin,ispmd+1)>0)
210 my_condition = my_condition.and.id_proc/=loc_proc
211 if(my_condition) then
212 sort_comm(nin)%request_r_nb = sort_comm(nin)%request_r_nb + 1
213 sort_comm(nin)%index_r(sort_comm(nin)%request_r_nb) = i
214 call spmd_irecv(sort_comm(nin)%nb_cell_proc(i),1,id_proc-1,my_tag,
215 . sort_comm(nin)%request_r(sort_comm(nin)%request_r_nb),spmd_comm_world)
216 endif
217 my_condition = (itied/=0.and.id_proc-1/=ispmd).or.component(nin)%proc_comp(id_proc)%need_comm_s
218 my_condition = my_condition.and.(isendto(nin,id_proc)>0)
219 my_condition = my_condition.and.id_proc/=loc_proc
220 if(my_condition) then
221 sort_comm(nin)%request_s_nb = sort_comm(nin)%request_s_nb + 1
222 call spmd_isend(sort_comm(nin)%size_cell_list(1),1,id_proc-1,my_tag,
223 . sort_comm(nin)%request_s(sort_comm(nin)%request_s_nb),spmd_comm_world)
224 my_size = my_size + 1
225 sort_comm(nin)%send_size_cell(i) = sort_comm(nin)%size_cell_list(1)
226 endif
227 enddo
228
229 IF(.NOT.ALLOCATED(sort_comm(nin)%SEND_DISPLS_CELL)) THEN
230 size_ = sort_comm(nin)%PROC_NUMBER
231 ALLOCATE(sort_comm(nin)%SEND_DISPLS_CELL(size_))
232 ENDIF
233
234 IF(.NOT.ALLOCATED(sort_comm(nin)%RCV_DISPLS_CELL)) THEN
235 size_ = sort_comm(nin)%PROC_NUMBER
236 ALLOCATE(sort_comm(nin)%RCV_DISPLS_CELL(size_))
237 ENDIF
238 ENDIF
239
240
241
242
243
244
245
246 IF(mode==2) THEN
247
248
249 sort_comm(nin)%NB_REQUEST_CELL_SEND = 0
250 sort_comm(nin)%NB_REQUEST_CELL_RCV = 0
251 IF(.NOT.ALLOCATED(sort_comm(nin)%RCV_SIZE_CELL)) THEN
252 size_ = sort_comm(nin)%PROC_NUMBER
253 ALLOCATE(sort_comm(nin)%RCV_SIZE_CELL(size_))
254 ENDIF
255 sort_comm(nin)%RCV_SIZE_CELL(:) = 0
256
257 IF(ircvfrom(nin,loc_proc)==0.AND.isendto(nin,loc_proc)==0) RETURN
258
259 IF(.NOT.ALLOCATED(sort_comm(nin)%REQUEST_CELL_SEND)) THEN
260 ALLOCATE(sort_comm(nin)%REQUEST_CELL_SEND(sort_comm(nin)%PROC_NUMBER))
261 sort_comm(nin)%REQUEST_CELL_SEND(1:sort_comm(nin)%PROC_NUMBER) = 0
262 ENDIF
263 IF(.NOT.ALLOCATED(sort_comm(nin)%REQUEST_CELL_RCV)) THEN
264 ALLOCATE(sort_comm(nin)%REQUEST_CELL_RCV(sort_comm(nin)%PROC_NUMBER))
265 sort_comm(nin)%REQUEST_CELL_RCV(1:sort_comm(nin)%PROC_NUMBER) = 0
266 ENDIF
267 IF(.NOT.ALLOCATED(sort_comm(nin)%INDEX_RCV)) THEN
268 ALLOCATE(sort_comm(nin)%INDEX_RCV(sort_comm(nin)%PROC_NUMBER))
269 sort_comm(nin)%INDEX_RCV(1:sort_comm(nin)%PROC_NUMBER) = 0
270 ENDIF
271 total_rcv_size = 0
272 do ijk=1,sort_comm(nin)%request_r_nb
273 call spmd_waitany(sort_comm(nin)%request_r_nb,sort_comm(nin)%request_r,index_r,status)
274 i = sort_comm(nin)%index_r(index_r)
275 enddo
276 do i=1,sort_comm(nin)%proc_number
277 id_proc = sort_comm(nin)%proc_list(i)
278
279 sort_comm(nin)%SEND_DISPLS_CELL(i) = 0
280
281 sort_comm(nin)%RCV_SIZE_CELL(i) = 0
282 IF(isendto(nin,loc_proc)>0) THEN
283 sort_comm(nin)%RCV_SIZE_CELL(i) = sort_comm(nin)%NB_CELL_PROC(i)
284 ENDIF
285 sort_comm(nin)%RCV_DISPLS_CELL(i) = total_rcv_size
286 IF(isendto(nin,loc_proc)>0) THEN
287 total_rcv_size = total_rcv_size + sort_comm(nin)%NB_CELL_PROC(i)
288 ENDIF
289 ENDDO
290
291 do ijk=1,sort_comm(nin)%request_s_nb
292 call spmd_waitany(sort_comm(nin)%request_s_nb,sort_comm(nin)%request_s,index_r,status)
293 enddo
294
295 total_send_size = sort_comm(nin)%SIZE_CELL_LIST(1)
296
297 IF(ALLOCATED(sort_comm(nin)%CELL) ) DEALLOCATE(sort_comm(nin)%CELL)
298 ALLOCATE( sort_comm(nin)%CELL(total_rcv_size) )
299
300 itied = ipari(85,nin)
301
302
303
304 DO i=1,sort_comm(nin)%PROC_NUMBER
305 id_proc = sort_comm(nin)%PROC_LIST(i)
306 my_condition = (itied/=0.or.sort_comm(nin)%RCV_SIZE_CELL(i)>0)
307 my_condition = my_condition.and.(isendto(nin,ispmd+1)>0)
308 my_condition = my_condition.and.id_proc/=loc_proc
309 IF(my_condition) THEN
310 msgtyp = msgoff
311 sort_comm(nin)%NB_REQUEST_CELL_RCV = sort_comm(nin)%NB_REQUEST_CELL_RCV
312 sort_comm(nin)%INDEX_RCV(sort_comm(nin)%NB_REQUEST_CELL_RCV) = i
313 CALL mpi_irecv(sort_comm(nin)%CELL(sort_comm(nin)%RCV_DISPLS_CELL(i) + 1),
314 . sort_comm(nin)%RCV_SIZE_CELL(i),mpi_integer,it_spmd(id_proc),
315 . msgtyp,spmd_comm_world,sort_comm(nin)%REQUEST_CELL_RCV
316 ENDIF
317 ENDDO
318
319
320
321
322 DO i=1,sort_comm(nin)%PROC_NUMBER
323 id_proc = sort_comm(nin)%PROC_LIST(i)
324 my_condition = (itied/=0.or.sort_comm(nin)%SEND_SIZE_CELL(i)>0)
325 my_condition = my_condition.and.(isendto(nin,id_proc)>0)
326 my_condition = my_condition.and.id_proc/=loc_proc
327 IF(my_condition) THEN
328 msgtyp = msgoff
329 sort_comm(nin)%NB_REQUEST_CELL_SEND =
330 . sort_comm(nin)%NB_REQUEST_CELL_SEND + 1
332 . sort_comm(nin)%SEND_SIZE_CELL(i),mpi_integer,it_spmd(id_proc),
333 . msgtyp,spmd_comm_world,sort_comm(nin)%REQUEST_CELL_SEND(sort_comm(nin)%NB_REQUEST_CELL_SEND),ierror)
334 ENDIF
335 ENDDO
336
337 ENDIF
338
339
340
341
342
343
344
345 IF(mode==3) THEN
346
347
349 nsnfi(nin)%P(1:nspmd) = 0
350 IF(ircvfrom(nin,loc_proc)==0.AND.isendto(nin,loc_proc)==0) RETURN
351
352 itied = ipari(85,nin)
353 IF(sort_comm(nin)%SIZE_CELL_LIST(1)>0.OR.itied/=0) THEN
355 ENDIF
359
360 if(got_preview == 1) THEN
361 CALL mpi_waitall( sort_comm(nin)%NB_REQUEST_CELL_RCV, sort_comm(nin)%REQUEST_CELL_RCV,mpi_statuses_ignore,ierror )
362 ENDIF
363
364 DO kk=1,sort_comm(nin)%NB_REQUEST_CELL_RCV
365 index_r = kk
366
367
368 if(got_preview == 0 ) then
369 CALL mpi_waitany( sort_comm(nin)%NB_REQUEST_CELL_RCV,
370 . sort_comm(nin)%REQUEST_CELL_RCV,index_r,status,ierror )
371 endif
372
373 remote_proc = sort_comm(nin)%INDEX_RCV(index_r)
374 is_exchange_needed = .true.
375
376 IF(sort_comm(nin)%PROC_LIST(remote_proc)==ispmd+1) is_exchange_needed = .false.
377 IF(is_exchange_needed.AND.sort_comm(nin)%NB_CELL_PROC(remote_proc)==0) is_exchange_needed = .false.
378 IF(itied/=0.AND.ircvfrom(nin,remote_proc)/=0) is_exchange_needed = .true.
379
380 IF(is_exchange_needed) THEN
381
382
384 . iad_elem,fr_elem,x,v,ms,temp,kinet,nodnx_sms,itab,intbuf_tab,ipari,nin,remote_proc,
385 . already_send,index_already_send,sort_comm,nodnx_sms_siz,temp_size)
386 ENDIF
387
388 ENDDO
389
390 DEALLOCATE( already_send )
391 DEALLOCATE( index_already_send )
392 ENDIF
393
394
395
396
397
398
399 IF(mode==4) THEN
400 IF(ircvfrom(nin,loc_proc)==0.AND.isendto(nin,loc_proc)==0) RETURN
401 CALL mpi_waitall( sort_comm(nin)%NB_REQUEST_CELL_SEND,
402 . sort_comm(nin)%REQUEST_CELL_SEND,mpi_statuses_ignore,ierror )
403
404 IF(ALLOCATED(sort_comm(nin)%SEND_SIZE_CELL)) DEALLOCATE(sort_comm(nin)%SEND_SIZE_CELL)
405 IF(ALLOCATED(sort_comm(nin)%SEND_DISPLS_CELL)) DEALLOCATE(sort_comm(nin)%SEND_DISPLS_CELL)
406 IF(ALLOCATED(sort_comm(nin)%RCV_SIZE_CELL)) DEALLOCATE(sort_comm(nin)%RCV_SIZE_CELL)
407 IF(ALLOCATED(sort_comm(nin)%RCV_DISPLS_CELL)) DEALLOCATE(sort_comm(nin)%RCV_DISPLS_CELL)
408 IF(ALLOCATED(sort_comm(nin)%CELL)) DEALLOCATE(sort_comm(nin)%CELL)
409 ENDIF
410
411
412! --------------------------------------------------------------------
413#endif
414 RETURN
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
subroutine mpi_waitall(cnt, array_of_requests, status, ierr)
subroutine mpi_waitany(cnt, array_of_requests, index, status, ierr)
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
type(int_pointer), dimension(:), allocatable nsnfi
subroutine spmd_cell_size_exchange(ircvfrom, isendto, weight, iad_elem, fr_elem, x, v, ms, temp, kinet, nodnx_sms, itab, intbuf_tab, ipari, nin, remote_proc_id, already_send, index_already_send, sort_comm, nodnx_sms_siz, temp_size)
subroutine spmd_cell_size_exchange_init(ircvfrom, isendto, ipari, nin, inter_struct, sort_comm)
subroutine spmd_cell_size_post_rcv(ircvfrom, isendto, nin, sort_comm, itied, component)