source: codes/icosagcm/trunk/src/parallel/transfert_mpi.f90 @ 962

Last change on this file since 962 was 962, checked in by adurocher, 5 years ago

Merge 'profiling' to trunk
File size: 69.5 KB
Line 
1MODULE transfert_mpi_mod
2USE genmod
3USE field_mod
4IMPLICIT NONE
5 
6  TYPE array
7    INTEGER,POINTER :: value(:)=>null()
8    INTEGER,POINTER :: sign(:)=>null()
9    INTEGER         :: domain
10    INTEGER         :: rank
11    INTEGER         :: tag
12    INTEGER         :: size
13    INTEGER         :: offset
14    INTEGER         :: ireq
15    INTEGER,POINTER :: buffer(:)=>null()
16    REAL,POINTER    :: buffer_r(:)=>null()
17    INTEGER,POINTER :: src_value(:)=>null()
18  END TYPE array
19 
20  TYPE t_buffer
21    REAL,POINTER    :: r(:)
22    INTEGER         :: size
23    INTEGER         :: rank
24  END TYPE t_buffer   
25   
26  TYPE t_request
27    INTEGER :: type_field
28    INTEGER :: max_size
29    INTEGER :: size
30    LOGICAL :: vector
31    INTEGER,POINTER :: src_domain(:)
32    INTEGER,POINTER :: src_i(:)
33    INTEGER,POINTER :: src_j(:)
34    INTEGER,POINTER :: src_ind(:)
35    INTEGER,POINTER :: target_ind(:)
36    INTEGER,POINTER :: target_i(:)
37    INTEGER,POINTER :: target_j(:)
38    INTEGER,POINTER :: target_sign(:)
39    INTEGER :: nrecv
40    TYPE(ARRAY),POINTER :: recv(:)
41    INTEGER :: nsend
42    INTEGER :: nreq_mpi
43    INTEGER :: nreq_send
44    INTEGER :: nreq_recv
45    TYPE(ARRAY),POINTER :: send(:)
46  END TYPE t_request
47 
48  TYPE(t_request),SAVE,POINTER :: req_i1(:)
49  TYPE(t_request),SAVE,POINTER :: req_e1_scal(:)
50  TYPE(t_request),SAVE,POINTER :: req_e1_vect(:)
51  TYPE(t_request),SAVE,POINTER :: req_z1_scal(:)
52 
53  TYPE(t_request),SAVE,POINTER :: req_i0(:)
54  TYPE(t_request),SAVE,POINTER :: req_e0_scal(:)
55  TYPE(t_request),SAVE,POINTER :: req_e0_vect(:)
56
57  TYPE t_reorder
58    INTEGER :: ind
59    INTEGER :: rank
60    INTEGER :: tag
61    INTEGER :: isend
62  END TYPE t_reorder 
63 
64  TYPE t_message
65    CHARACTER(LEN=100) :: name ! for debug
66    TYPE(t_request), POINTER :: request(:)
67    INTEGER :: nreq
68    INTEGER :: nreq_send
69    INTEGER :: nreq_recv
70    TYPE(t_reorder), POINTER :: reorder(:)
71    INTEGER, POINTER :: mpi_req(:)
72    INTEGER, POINTER :: status(:,:)
73    TYPE(t_buffer),POINTER :: buffers(:) 
74    TYPE(t_field),POINTER :: field(:)
75    LOGICAL :: completed
76    LOGICAL :: pending
77    LOGICAL :: open      ! for debug
78    INTEGER :: number
79    LOGICAL :: ondevice=.false. !<Ready to transfer ondevice field
80  END TYPE t_message
81
82
83  INTERFACE bcast_mpi
84    MODULE PROCEDURE bcast_mpi_c,                                                     &
85                     bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
86                     bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
87                     bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
88  END INTERFACE
89
90  integer :: profile_mpi_copies, profile_mpi_waitall, profile_mpi_omp_barrier
91
92CONTAINS
93       
94     
95  SUBROUTINE init_transfert
96  USE profiling_mod
97  USE domain_mod
98  USE dimensions
99  USE field_mod
100  USE metric
101  USE mpipara
102  USE mpi_mod
103  IMPLICIT NONE
104  INTEGER :: ind,i,j
105
106    CALL register_id('MPI', id_mpi)
107    CALL register_id('MPI_copies', profile_mpi_copies)
108    CALL register_id('MPI_waitall', profile_mpi_waitall)
109    CALL register_id('MPI_omp_barrier', profile_mpi_omp_barrier)
110
111    CALL create_request(field_t,req_i1)
112
113    DO ind=1,ndomain
114      CALL swap_dimensions(ind)
115      DO i=ii_begin,ii_end+1
116        CALL request_add_point(ind,i,jj_begin-1,req_i1)
117      ENDDO
118
119      DO j=jj_begin,jj_end
120        CALL request_add_point(ind,ii_end+1,j,req_i1)
121      ENDDO   
122      DO i=ii_begin,ii_end
123        CALL request_add_point(ind,i,jj_end+1,req_i1)
124      ENDDO   
125
126      DO j=jj_begin,jj_end+1
127        CALL request_add_point(ind,ii_begin-1,j,req_i1)
128      ENDDO   
129   
130    ENDDO
131 
132    CALL finalize_request(req_i1)
133
134
135    CALL create_request(field_t,req_i0)
136
137    DO ind=1,ndomain
138      CALL swap_dimensions(ind)
139   
140      DO i=ii_begin,ii_end
141        CALL request_add_point(ind,i,jj_begin,req_i0)
142      ENDDO
143
144      DO j=jj_begin,jj_end
145        CALL request_add_point(ind,ii_end,j,req_i0)
146      ENDDO   
147   
148      DO i=ii_begin,ii_end
149        CALL request_add_point(ind,i,jj_end,req_i0)
150      ENDDO   
151
152      DO j=jj_begin,jj_end
153        CALL request_add_point(ind,ii_begin,j,req_i0)
154      ENDDO   
155   
156    ENDDO
157 
158    CALL finalize_request(req_i0) 
159
160
161    CALL create_request(field_u,req_e1_scal)
162    DO ind=1,ndomain
163      CALL swap_dimensions(ind)
164      DO i=ii_begin,ii_end
165        CALL request_add_point(ind,i,jj_begin-1,req_e1_scal,rup)
166        CALL request_add_point(ind,i+1,jj_begin-1,req_e1_scal,lup)
167      ENDDO
168
169      DO j=jj_begin,jj_end
170        CALL request_add_point(ind,ii_end+1,j,req_e1_scal,left)
171      ENDDO   
172      DO j=jj_begin,jj_end
173        CALL request_add_point(ind,ii_end+1,j-1,req_e1_scal,lup)
174      ENDDO   
175   
176      DO i=ii_begin,ii_end
177        CALL request_add_point(ind,i,jj_end+1,req_e1_scal,ldown)
178        CALL request_add_point(ind,i-1,jj_end+1,req_e1_scal,rdown)
179      ENDDO   
180
181      DO j=jj_begin,jj_end
182        CALL request_add_point(ind,ii_begin-1,j,req_e1_scal,right)
183      ENDDO   
184      DO j=jj_begin,jj_end
185        CALL request_add_point(ind,ii_begin-1,j+1,req_e1_scal,rdown)
186      ENDDO   
187
188    ENDDO
189
190    CALL finalize_request(req_e1_scal)
191
192
193    CALL create_request(field_u,req_e0_scal)
194    DO ind=1,ndomain
195      CALL swap_dimensions(ind)
196
197
198      DO i=ii_begin+1,ii_end-1
199        CALL request_add_point(ind,i,jj_begin,req_e0_scal,right)
200        CALL request_add_point(ind,i,jj_end,req_e0_scal,right)
201      ENDDO
202   
203      DO j=jj_begin+1,jj_end-1
204        CALL request_add_point(ind,ii_begin,j,req_e0_scal,rup)
205        CALL request_add_point(ind,ii_end,j,req_e0_scal,rup)
206      ENDDO   
207
208      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e0_scal,left)
209      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e0_scal,ldown)
210      CALL request_add_point(ind,ii_begin+1,jj_end,req_e0_scal,left)
211      CALL request_add_point(ind,ii_end,jj_begin+1,req_e0_scal,ldown)
212
213    ENDDO
214
215    CALL finalize_request(req_e0_scal)
216
217
218   
219    CALL create_request(field_u,req_e1_vect,.TRUE.)
220    DO ind=1,ndomain
221      CALL swap_dimensions(ind)
222      DO i=ii_begin,ii_end
223        CALL request_add_point(ind,i,jj_begin-1,req_e1_vect,rup)
224        CALL request_add_point(ind,i+1,jj_begin-1,req_e1_vect,lup)
225      ENDDO
226
227      DO j=jj_begin,jj_end
228        CALL request_add_point(ind,ii_end+1,j,req_e1_vect,left)
229      ENDDO   
230      DO j=jj_begin,jj_end
231        CALL request_add_point(ind,ii_end+1,j-1,req_e1_vect,lup)
232      ENDDO   
233   
234      DO i=ii_begin,ii_end
235        CALL request_add_point(ind,i,jj_end+1,req_e1_vect,ldown)
236        CALL request_add_point(ind,i-1,jj_end+1,req_e1_vect,rdown)
237      ENDDO   
238
239      DO j=jj_begin,jj_end
240        CALL request_add_point(ind,ii_begin-1,j,req_e1_vect,right)
241      ENDDO   
242      DO j=jj_begin,jj_end
243        CALL request_add_point(ind,ii_begin-1,j+1,req_e1_vect,rdown)
244      ENDDO   
245
246 
247    ENDDO 
248
249    CALL finalize_request(req_e1_vect)
250   
251   
252    CALL create_request(field_u,req_e0_vect,.TRUE.)
253    DO ind=1,ndomain
254      CALL swap_dimensions(ind)
255 
256      DO i=ii_begin+1,ii_end-1
257        CALL request_add_point(ind,i,jj_begin,req_e0_vect,right)
258        CALL request_add_point(ind,i,jj_end,req_e0_vect,right)
259      ENDDO
260   
261      DO j=jj_begin+1,jj_end-1
262        CALL request_add_point(ind,ii_begin,j,req_e0_vect,rup)
263        CALL request_add_point(ind,ii_end,j,req_e0_vect,rup)
264      ENDDO   
265
266      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e0_vect,left)
267      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e0_vect,ldown)
268      CALL request_add_point(ind,ii_begin+1,jj_end,req_e0_vect,left)
269      CALL request_add_point(ind,ii_end,jj_begin+1,req_e0_vect,ldown)
270 
271    ENDDO 
272
273    CALL finalize_request(req_e0_vect)
274
275    CALL create_request(field_z,req_z1_scal)
276    DO ind=1,ndomain
277      CALL swap_dimensions(ind)
278      DO i=ii_begin,ii_end
279        CALL request_add_point(ind,i,jj_begin-1,req_z1_scal,vrup)
280        CALL request_add_point(ind,i+1,jj_begin-1,req_z1_scal,vup)
281      ENDDO
282
283      DO j=jj_begin,jj_end
284        CALL request_add_point(ind,ii_end+1,j,req_z1_scal,vlup)
285      ENDDO   
286      DO j=jj_begin,jj_end
287        CALL request_add_point(ind,ii_end+1,j-1,req_z1_scal,vup)
288      ENDDO   
289   
290      DO i=ii_begin,ii_end
291        CALL request_add_point(ind,i,jj_end+1,req_z1_scal,vdown)
292        CALL request_add_point(ind,i-1,jj_end+1,req_z1_scal,vrdown)
293      ENDDO   
294
295      DO j=jj_begin,jj_end
296        CALL request_add_point(ind,ii_begin-1,j,req_z1_scal,vrup)
297      ENDDO   
298      DO j=jj_begin,jj_end
299        CALL request_add_point(ind,ii_begin-1,j,req_z1_scal,vrdown)
300      ENDDO   
301
302    ENDDO
303
304    CALL finalize_request(req_z1_scal)
305
306  END SUBROUTINE init_transfert
307 
308  SUBROUTINE create_request(type_field,request,vector)
309  USE domain_mod
310  USE field_mod
311  IMPLICIT NONE
312    INTEGER :: type_field
313    TYPE(t_request),POINTER :: request(:)
314    LOGICAL,OPTIONAL :: vector
315   
316    TYPE(t_request),POINTER :: req
317    TYPE(t_domain),POINTER :: d
318    INTEGER :: ind
319    INTEGER :: max_size
320       
321    ALLOCATE(request(ndomain))
322
323    DO ind=1,ndomain
324      req=>request(ind)
325      d=>domain(ind)
326      IF (type_field==field_t) THEN
327        Max_size=2*(d%iim+2)+2*(d%jjm+2)
328      ELSE IF (type_field==field_u) THEN
329        Max_size=3*(2*(d%iim+2)+2*(d%jjm+2))
330      ELSE IF (type_field==field_z) THEN
331        Max_size=2*(2*(d%iim+2)+2*(d%jjm+2))
332      ENDIF
333
334      req%type_field=type_field
335      req%max_size=max_size*2
336      req%size=0
337      req%vector=.FALSE.
338      IF (PRESENT(vector)) req%vector=vector
339      ALLOCATE(req%src_domain(req%max_size))
340      ALLOCATE(req%src_ind(req%max_size))
341      ALLOCATE(req%target_ind(req%max_size))
342      ALLOCATE(req%src_i(req%max_size))
343      ALLOCATE(req%src_j(req%max_size))
344      ALLOCATE(req%target_i(req%max_size))
345      ALLOCATE(req%target_j(req%max_size))
346      ALLOCATE(req%target_sign(req%max_size))
347    ENDDO
348 
349  END SUBROUTINE create_request
350
351  SUBROUTINE reallocate_request(req)
352  IMPLICIT NONE
353    TYPE(t_request),POINTER :: req
354     
355    INTEGER,POINTER :: src_domain(:)
356    INTEGER,POINTER :: src_ind(:)
357    INTEGER,POINTER :: target_ind(:)
358    INTEGER,POINTER :: src_i(:)
359    INTEGER,POINTER :: src_j(:)
360    INTEGER,POINTER :: target_i(:)
361    INTEGER,POINTER :: target_j(:)
362    INTEGER,POINTER :: target_sign(:)
363
364    PRINT *,"REALLOCATE_REQUEST"
365    src_domain=>req%src_domain
366    src_ind=>req%src_ind
367    target_ind=>req%target_ind
368    src_i=>req%src_i
369    src_j=>req%src_j
370    target_i=>req%target_i
371    target_j=>req%target_j
372    target_sign=>req%target_sign
373
374    ALLOCATE(req%src_domain(req%max_size*2))
375    ALLOCATE(req%src_ind(req%max_size*2))
376    ALLOCATE(req%target_ind(req%max_size*2))
377    ALLOCATE(req%src_i(req%max_size*2))
378    ALLOCATE(req%src_j(req%max_size*2))
379    ALLOCATE(req%target_i(req%max_size*2))
380    ALLOCATE(req%target_j(req%max_size*2))
381    ALLOCATE(req%target_sign(req%max_size*2))
382   
383    req%src_domain(1:req%max_size)=src_domain(:)
384    req%src_ind(1:req%max_size)=src_ind(:)
385    req%target_ind(1:req%max_size)=target_ind(:)
386    req%src_i(1:req%max_size)=src_i(:)
387    req%src_j(1:req%max_size)=src_j(:)
388    req%target_i(1:req%max_size)=target_i(:)
389    req%target_j(1:req%max_size)=target_j(:)
390    req%target_sign(1:req%max_size)=target_sign(:)
391   
392    req%max_size=req%max_size*2
393         
394    DEALLOCATE(src_domain)
395    DEALLOCATE(src_ind)
396    DEALLOCATE(target_ind)
397    DEALLOCATE(src_i)
398    DEALLOCATE(src_j)
399    DEALLOCATE(target_i)
400    DEALLOCATE(target_j)
401    DEALLOCATE(target_sign)
402
403  END SUBROUTINE reallocate_request
404
405     
406    SUBROUTINE request_add_point(ind,i,j,request,pos)
407    USE domain_mod
408    USE field_mod
409    IMPLICIT NONE
410      INTEGER,INTENT(IN)            ::  ind
411      INTEGER,INTENT(IN)            :: i
412      INTEGER,INTENT(IN)            :: j
413      TYPE(t_request),POINTER :: request(:)
414      INTEGER,INTENT(IN),OPTIONAL  :: pos
415     
416      INTEGER :: src_domain
417      INTEGER :: src_iim,src_i,src_j,src_n,src_pos,src_delta
418      TYPE(t_request),POINTER :: req
419      TYPE(t_domain),POINTER :: d
420     
421      req=>request(ind)
422      d=>domain(ind)
423     
424      IF (req%max_size==req%size) CALL reallocate_request(req)
425      req%size=req%size+1
426      IF (req%type_field==field_t) THEN
427        src_domain=domain(ind)%assign_domain(i,j)
428        src_iim=domain_glo(src_domain)%iim
429        src_i=domain(ind)%assign_i(i,j)
430        src_j=domain(ind)%assign_j(i,j)
431
432        req%target_ind(req%size)=(j-1)*d%iim+i
433        req%target_sign(req%size)=1
434        req%src_domain(req%size)=src_domain
435        req%src_ind(req%size)=(src_j-1)*src_iim+src_i
436      ELSE IF (req%type_field==field_u) THEN
437        IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme'
438
439        src_domain=domain(ind)%edge_assign_domain(pos-1,i,j)
440        src_iim=domain_glo(src_domain)%iim
441        src_i=domain(ind)%edge_assign_i(pos-1,i,j)
442        src_j=domain(ind)%edge_assign_j(pos-1,i,j)
443        src_n=(src_j-1)*src_iim+src_i
444        src_delta=domain(ind)%delta(i,j)
445        src_pos=domain(ind)%edge_assign_pos(pos-1,i,j)+1
446               
447        req%target_ind(req%size)=(j-1)*d%iim+i+d%u_pos(pos)
448
449        req%target_sign(req%size)= 1
450        IF (req%vector) req%target_sign(req%size)= domain(ind)%edge_assign_sign(pos-1,i,j)
451
452        req%src_domain(req%size)=src_domain
453        req%src_ind(req%size)=src_n+domain_glo(src_domain)%u_pos(src_pos)
454
455      ELSE IF (req%type_field==field_z) THEN
456        IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme'
457
458        src_domain=domain(ind)%vertex_assign_domain(pos-1,i,j)
459        src_iim=domain_glo(src_domain)%iim
460        src_i=domain(ind)%vertex_assign_i(pos-1,i,j)
461        src_j=domain(ind)%vertex_assign_j(pos-1,i,j)
462        src_n=(src_j-1)*src_iim+src_i
463        src_delta=domain(ind)%delta(i,j)
464        src_pos=domain(ind)%vertex_assign_pos(pos-1,i,j)+1
465
466       
467        req%target_ind(req%size)=(j-1)*d%iim+i+d%z_pos(pos)
468        req%target_sign(req%size)=1
469        req%src_domain(req%size)=src_domain
470        req%src_ind(req%size)=src_n+domain_glo(src_domain)%z_pos(src_pos)
471      ENDIF
472  END SUBROUTINE request_add_point
473 
474 
475  SUBROUTINE Finalize_request(request)
476  USE mpipara
477  USE domain_mod
478  USE mpi_mod
479  IMPLICIT NONE
480    TYPE(t_request),POINTER :: request(:)
481    TYPE(t_request),POINTER :: req, req_src
482    INTEGER :: nb_domain_recv(0:mpi_size-1)
483    INTEGER :: nb_domain_send(0:mpi_size-1)
484    INTEGER :: tag_rank(0:mpi_size-1)
485    INTEGER :: nb_data_domain_recv(ndomain_glo)
486    INTEGER :: list_domain_recv(ndomain_glo)
487    INTEGER,ALLOCATABLE :: list_domain_send(:)
488    INTEGER             :: list_domain(ndomain)
489
490    INTEGER :: rank,i,j,pos
491    INTEGER :: size_,ind_glo,ind_loc
492    INTEGER :: isend, irecv, ireq, nreq, nsend, nrecv
493    INTEGER, ALLOCATABLE :: mpi_req(:)
494    INTEGER, ALLOCATABLE :: status(:,:)
495    INTEGER, ALLOCATABLE :: rank_list(:)
496    INTEGER, ALLOCATABLE :: offset(:)
497    LOGICAL,PARAMETER :: debug = .FALSE.
498
499 
500    IF (.NOT. using_mpi) RETURN
501   
502    DO ind_loc=1,ndomain
503      req=>request(ind_loc)
504     
505      nb_data_domain_recv(:) = 0
506      nb_domain_recv(:) = 0
507      tag_rank(:)=0
508     
509      DO i=1,req%size
510        ind_glo=req%src_domain(i)
511        nb_data_domain_recv(ind_glo)=nb_data_domain_recv(ind_glo)+1
512      ENDDO
513 
514      DO ind_glo=1,ndomain_glo
515        IF ( nb_data_domain_recv(ind_glo) > 0 )  nb_domain_recv(domglo_rank(ind_glo))=nb_domain_recv(domglo_rank(ind_glo))+1
516      ENDDO
517
518      req%nrecv=sum(nb_domain_recv(:))
519      ALLOCATE(req%recv(req%nrecv))
520
521      irecv=0
522      DO ind_glo=1,ndomain_glo
523        IF (nb_data_domain_recv(ind_glo)>0) THEN
524          irecv=irecv+1
525          list_domain_recv(ind_glo)=irecv
526          req%recv(irecv)%rank=domglo_rank(ind_glo)
527          req%recv(irecv)%size=nb_data_domain_recv(ind_glo)
528          req%recv(irecv)%domain=domglo_loc_ind(ind_glo)
529          ALLOCATE(req%recv(irecv)%value(req%recv(irecv)%size))
530          ALLOCATE(req%recv(irecv)%sign(req%recv(irecv)%size))
531          ALLOCATE(req%recv(irecv)%buffer(req%recv(irecv)%size))
532        ENDIF
533      ENDDO
534     
535      req%recv(:)%size=0
536      irecv=0
537      DO i=1,req%size
538        irecv=list_domain_recv(req%src_domain(i))
539        req%recv(irecv)%size=req%recv(irecv)%size+1
540        size_=req%recv(irecv)%size
541        req%recv(irecv)%value(size_)=req%src_ind(i)
542        req%recv(irecv)%buffer(size_)=req%target_ind(i)
543        req%recv(irecv)%sign(size_)=req%target_sign(i)
544      ENDDO
545    ENDDO
546
547    nb_domain_recv(:) = 0   
548    DO ind_loc=1,ndomain
549      req=>request(ind_loc)
550     
551      DO irecv=1,req%nrecv
552        rank=req%recv(irecv)%rank
553        nb_domain_recv(rank)=nb_domain_recv(rank)+1
554      ENDDO
555    ENDDO
556   
557    CALL MPI_Alltoall(nb_domain_recv,1,MPI_INTEGER,nb_domain_send,1,MPI_INTEGER,comm_icosa,ierr)     
558   
559
560    ALLOCATE(list_domain_send(sum(nb_domain_send)))
561   
562    nreq=sum(nb_domain_recv(:))+sum(nb_domain_send(:))
563    ALLOCATE(mpi_req(nreq))
564    ALLOCATE(status(MPI_STATUS_SIZE,nreq))
565   
566
567    ireq=0
568    DO ind_loc=1,ndomain
569      req=>request(ind_loc)
570      DO irecv=1,req%nrecv
571        ireq=ireq+1
572        CALL MPI_ISEND(req%recv(irecv)%domain,1,MPI_INTEGER,req%recv(irecv)%rank,0,comm_icosa, mpi_req(ireq),ierr)
573        IF (debug) PRINT *,"Isend ",req%recv(irecv)%domain, "from ", mpi_rank, "to ",req%recv(irecv)%rank, "tag ",0
574      ENDDO
575    ENDDO
576
577    IF (debug) PRINT *,"------------"   
578    j=0
579    DO rank=0,mpi_size-1
580      DO i=1,nb_domain_send(rank)
581        j=j+1
582        ireq=ireq+1
583        CALL MPI_IRECV(list_domain_send(j),1,MPI_INTEGER,rank,0,comm_icosa, mpi_req(ireq),ierr)
584        IF (debug) PRINT *,"IRecv ",list_domain_send(j), "from ", rank, "to ",mpi_rank, "tag ",0
585      ENDDO
586    ENDDO
587    IF (debug) PRINT *,"------------"   
588   
589    CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
590   
591    list_domain(:)=0
592    DO i=1,sum(nb_domain_send)
593      ind_loc=list_domain_send(i)
594      list_domain(ind_loc)=list_domain(ind_loc)+1
595    ENDDO
596   
597    DO ind_loc=1,ndomain
598      req=>request(ind_loc)
599      req%nsend=list_domain(ind_loc)
600      ALLOCATE(req%send(req%nsend))
601    ENDDO
602
603    IF (debug) PRINT *,"------------"   
604   
605   ireq=0 
606   DO ind_loc=1,ndomain
607     req=>request(ind_loc)
608     
609     DO irecv=1,req%nrecv
610       ireq=ireq+1
611       CALL MPI_ISEND(mpi_rank,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
612       IF (debug) PRINT *,"Isend ",mpi_rank, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
613     ENDDO
614    IF (debug) PRINT *,"------------"   
615     
616     DO isend=1,req%nsend
617       ireq=ireq+1
618       CALL MPI_IRECV(req%send(isend)%rank,1,MPI_INTEGER,MPI_ANY_SOURCE,ind_loc,comm_icosa, mpi_req(ireq),ierr)
619       IF (debug) PRINT *,"IRecv ",req%send(isend)%rank, "from ", "xxx", "to ",mpi_rank, "tag ",ind_loc
620     ENDDO
621   ENDDO
622
623   IF (debug) PRINT *,"------------"   
624
625   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
626   CALL MPI_BARRIER(comm_icosa,ierr)
627
628   IF (debug) PRINT *,"------------"   
629
630   ireq=0 
631   DO ind_loc=1,ndomain
632     req=>request(ind_loc)
633     
634     DO irecv=1,req%nrecv
635       ireq=ireq+1
636       CALL MPI_ISEND(ind_loc,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
637       IF (debug) PRINT *,"Isend ",ind_loc, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
638     ENDDO
639
640     IF (debug) PRINT *,"------------"   
641     
642     DO isend=1,req%nsend
643       ireq=ireq+1
644       CALL MPI_IRECV(req%send(isend)%domain,1,MPI_INTEGER,req%send(isend)%rank,ind_loc,comm_icosa, mpi_req(ireq),ierr)
645       IF (debug) PRINT *,"IRecv ",req%send(isend)%domain, "from ", req%send(isend)%rank, "to ",mpi_rank, "tag ",ind_loc
646     ENDDO
647   ENDDO
648   IF (debug) PRINT *,"------------"   
649   
650   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
651   CALL MPI_BARRIER(comm_icosa,ierr)
652   IF (debug) PRINT *,"------------"   
653
654   ireq=0
655   DO ind_loc=1,ndomain
656     req=>request(ind_loc)
657     
658     DO irecv=1,req%nrecv
659       ireq=ireq+1
660       req%recv(irecv)%tag=tag_rank(req%recv(irecv)%rank)
661       tag_rank(req%recv(irecv)%rank)=tag_rank(req%recv(irecv)%rank)+1
662       CALL MPI_ISEND(req%recv(irecv)%tag,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
663       IF (debug) PRINT *,"Isend ",req%recv(irecv)%tag, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
664     ENDDO
665   IF (debug) PRINT *,"------------"   
666     
667     DO isend=1,req%nsend
668       ireq=ireq+1
669       CALL MPI_IRECV(req%send(isend)%tag,1,MPI_INTEGER,req%send(isend)%rank,ind_loc,comm_icosa, mpi_req(ireq),ierr)
670       IF (debug) PRINT *,"IRecv ",req%send(isend)%tag, "from ", req%send(isend)%rank, "to ",mpi_rank, "tag ",ind_loc
671     ENDDO
672   ENDDO
673   IF (debug) PRINT *,"------------"   
674   
675   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
676   CALL MPI_BARRIER(comm_icosa,ierr)
677
678
679   IF (debug) PRINT *,"------------"   
680
681   ireq=0 
682   DO ind_loc=1,ndomain
683     req=>request(ind_loc)
684     
685     DO irecv=1,req%nrecv
686       ireq=ireq+1
687       CALL MPI_ISEND(req%recv(irecv)%size,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%tag,comm_icosa, mpi_req(ireq),ierr)
688       IF (debug) PRINT *,"Isend ",req%recv(irecv)%size, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
689     ENDDO
690     IF (debug) PRINT *,"------------"   
691     
692     DO isend=1,req%nsend
693       ireq=ireq+1
694       CALL MPI_IRECV(req%send(isend)%size,1,MPI_INTEGER,req%send(isend)%rank,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
695       IF (debug) PRINT *,"IRecv ",req%send(isend)%size, "from ", req%send(isend)%rank, "to ",mpi_rank, "tag ",ind_loc
696     ENDDO
697   ENDDO
698
699   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
700
701   ireq=0 
702   DO ind_loc=1,ndomain
703     req=>request(ind_loc)
704     
705     DO irecv=1,req%nrecv
706       ireq=ireq+1
707       CALL MPI_ISEND(req%recv(irecv)%value,req%recv(irecv)%size,MPI_INTEGER,&
708            req%recv(irecv)%rank,req%recv(irecv)%tag,comm_icosa, mpi_req(ireq),ierr)
709     ENDDO
710     
711     DO isend=1,req%nsend
712       ireq=ireq+1
713       ALLOCATE(req%send(isend)%value(req%send(isend)%size))
714       CALL MPI_IRECV(req%send(isend)%value,req%send(isend)%size,MPI_INTEGER,&
715            req%send(isend)%rank,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
716     ENDDO
717   ENDDO
718
719   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
720
721   DO ind_loc=1,ndomain
722     req=>request(ind_loc)
723     
724     DO irecv=1,req%nrecv
725       req%recv(irecv)%value(:)=req%recv(irecv)%buffer(:)
726       req%recv(irecv)%sign(:) =req%recv(irecv)%sign(:)
727       DEALLOCATE(req%recv(irecv)%buffer)
728     ENDDO
729   ENDDO 
730   
731
732! domain is on the same mpi process => copie memory to memory
733   
734   DO ind_loc=1,ndomain
735     req=>request(ind_loc)
736     
737     DO irecv=1,req%nrecv
738   
739       IF (req%recv(irecv)%rank==mpi_rank) THEN
740           req_src=>request(req%recv(irecv)%domain)
741           DO isend=1,req_src%nsend
742             IF (req_src%send(isend)%rank==mpi_rank .AND. req_src%send(isend)%tag==req%recv(irecv)%tag) THEN
743               req%recv(irecv)%src_value => req_src%send(isend)%value
744               IF ( size(req%recv(irecv)%value) /= size(req_src%send(isend)%value)) THEN
745                 PRINT *,ind_loc, irecv, isend, size(req%recv(irecv)%value), size(req_src%send(isend)%value)
746                 STOP "size(req%recv(irecv)%value) /= size(req_src%send(isend)%value"
747               ENDIF
748             ENDIF
749           ENDDO
750       ENDIF
751     
752     ENDDO
753   ENDDO
754   
755! true number of mpi request
756
757   request(:)%nreq_mpi=0
758   request(:)%nreq_send=0
759   request(:)%nreq_recv=0
760   ALLOCATE(rank_list(sum(request(:)%nsend)))
761   ALLOCATE(offset(sum(request(:)%nsend)))
762   offset(:)=0
763   
764   nsend=0
765   DO ind_loc=1,ndomain
766     req=>request(ind_loc)
767
768     DO isend=1,req%nsend
769       IF (req%send(isend)%rank/=mpi_rank) THEN
770         pos=0
771         DO i=1,nsend
772           IF (req%send(isend)%rank==rank_list(i)) EXIT
773           pos=pos+1
774         ENDDO
775       
776         IF (pos==nsend) THEN
777           nsend=nsend+1
778           req%nreq_mpi=req%nreq_mpi+1
779           req%nreq_send=req%nreq_send+1
780           IF (mpi_threading_mode==MPI_THREAD_FUNNELED .OR. mpi_threading_mode==MPI_THREAD_SINGLE) THEN
781             rank_list(nsend)=req%send(isend)%rank
782           ELSE
783             rank_list(nsend)=-1
784           ENDIF
785         ENDIF
786         
787         pos=pos+1
788         req%send(isend)%ireq=pos
789         req%send(isend)%offset=offset(pos)
790         offset(pos)=offset(pos)+req%send(isend)%size
791       ENDIF
792     ENDDO
793   ENDDO
794
795   DEALLOCATE(rank_list)
796   DEALLOCATE(offset)
797     
798   ALLOCATE(rank_list(sum(request(:)%nrecv)))
799   ALLOCATE(offset(sum(request(:)%nrecv)))
800   offset(:)=0
801   
802   nrecv=0
803   DO ind_loc=1,ndomain
804     req=>request(ind_loc)
805
806     DO irecv=1,req%nrecv
807       IF (req%recv(irecv)%rank/=mpi_rank) THEN
808         pos=0
809         DO i=1,nrecv
810           IF (req%recv(irecv)%rank==rank_list(i)) EXIT
811           pos=pos+1
812         ENDDO
813       
814         IF (pos==nrecv) THEN
815           nrecv=nrecv+1
816           req%nreq_mpi=req%nreq_mpi+1
817           req%nreq_recv=req%nreq_recv+1
818           IF (mpi_threading_mode==MPI_THREAD_FUNNELED .OR. mpi_threading_mode==MPI_THREAD_SINGLE) THEN
819             rank_list(nrecv)=req%recv(irecv)%rank
820           ELSE
821             rank_list(nrecv)=-1
822           ENDIF
823         ENDIF
824       
825         pos=pos+1
826         req%recv(irecv)%ireq=nsend+pos
827         req%recv(irecv)%offset=offset(pos)
828         offset(pos)=offset(pos)+req%recv(irecv)%size
829       ENDIF
830     ENDDO
831   ENDDO 
832
833! get the offsets   
834
835   ireq=0 
836   DO ind_loc=1,ndomain
837     req=>request(ind_loc)
838     
839     DO irecv=1,req%nrecv
840       ireq=ireq+1
841       CALL MPI_ISEND(req%recv(irecv)%offset,1,MPI_INTEGER,&
842            req%recv(irecv)%rank,req%recv(irecv)%tag,comm_icosa, mpi_req(ireq),ierr)
843     ENDDO
844     
845     DO isend=1,req%nsend
846       ireq=ireq+1
847       CALL MPI_IRECV(req%send(isend)%offset,1,MPI_INTEGER,&
848            req%send(isend)%rank,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
849     ENDDO
850   ENDDO
851
852   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
853     
854       
855  END SUBROUTINE Finalize_request 
856
857
858  SUBROUTINE init_message_seq(field, request, message, name)
859  USE field_mod
860  USE domain_mod
861  USE mpi_mod
862  USE mpipara
863  USE mpi_mod
864  IMPLICIT NONE
865    TYPE(t_field),POINTER :: field(:)
866    TYPE(t_request),POINTER :: request(:)
867    TYPE(t_message) :: message
868    CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
869!$OMP MASTER   
870    message%request=>request
871    IF(PRESENT(name)) THEN
872       message%name = TRIM(name)
873    ELSE
874       message%name = 'unknown'
875    END IF
876!$OMP END MASTER   
877!$OMP BARRIER   
878
879  END SUBROUTINE init_message_seq
880
881  SUBROUTINE send_message_seq(field,message)
882  USE field_mod
883  USE domain_mod
884  USE mpi_mod
885  USE mpipara
886  USE omp_para
887  USE trace
888  IMPLICIT NONE
889    TYPE(t_field),POINTER :: field(:)
890    TYPE(t_message) :: message
891
892    CALL transfert_request_seq(field,message%request)
893   
894  END SUBROUTINE send_message_seq
895 
896  SUBROUTINE test_message_seq(message)
897  IMPLICIT NONE
898    TYPE(t_message) :: message
899  END SUBROUTINE  test_message_seq
900 
901   
902  SUBROUTINE wait_message_seq(message)
903  IMPLICIT NONE
904    TYPE(t_message) :: message
905   
906  END SUBROUTINE wait_message_seq   
907
908  SUBROUTINE transfert_message_seq(field,message)
909  USE field_mod
910  USE domain_mod
911  USE mpi_mod
912  USE mpipara
913  USE omp_para
914  USE trace
915  IMPLICIT NONE
916    TYPE(t_field),POINTER :: field(:)
917    TYPE(t_message) :: message
918
919   CALL send_message_seq(field,message)
920   
921  END SUBROUTINE transfert_message_seq   
922   
923
924
925   
926  SUBROUTINE init_message_mpi(field,request, message, name)
927  USE field_mod
928  USE domain_mod
929  USE mpi_mod
930  USE mpipara
931  USE mpi_mod
932  IMPLICIT NONE
933 
934    TYPE(t_field),POINTER :: field(:)
935    TYPE(t_request),POINTER :: request(:)
936    TYPE(t_message) :: message
937    CHARACTER(LEN=*), INTENT(IN),OPTIONAL :: name
938
939    TYPE(t_request),POINTER :: req
940    INTEGER :: irecv,isend
941    INTEGER :: ireq,nreq
942    INTEGER :: ind
943    INTEGER :: dim3,dim4
944    INTEGER,SAVE :: message_number=0
945!    TYPE(t_reorder),POINTER :: reorder(:)
946!    TYPE(t_reorder) :: reorder_swap
947
948!$OMP BARRIER
949!$OMP MASTER
950    !init off-device
951    message%ondevice=.false.
952
953    IF(PRESENT(name)) THEN
954       message%name = TRIM(name)
955    ELSE
956       message%name = 'unknown'
957    END IF
958    message%number=message_number
959    message_number=message_number+1
960    IF (message_number==100) message_number=0
961
962 
963    message%request=>request
964    message%nreq=sum(message%request(:)%nreq_mpi)
965    message%nreq_send=sum(message%request(:)%nreq_send)
966    message%nreq_recv=sum(message%request(:)%nreq_recv)
967    nreq=message%nreq
968
969    ALLOCATE(message%mpi_req(nreq))
970    ALLOCATE(message%buffers(nreq))
971    ALLOCATE(message%status(MPI_STATUS_SIZE,nreq))
972    message%buffers(:)%size=0
973    message%pending=.FALSE.
974    message%completed=.FALSE.
975    message%open=.FALSE.
976
977    DO ind=1,ndomain
978      req=>request(ind)
979      DO isend=1,req%nsend
980        IF (req%send(isend)%rank/=mpi_rank) THEN
981          ireq=req%send(isend)%ireq 
982          message%buffers(ireq)%size=message%buffers(ireq)%size+req%send(isend)%size
983          message%buffers(ireq)%rank=req%send(isend)%rank
984        ENDIF
985      ENDDO
986      DO irecv=1,req%nrecv
987        IF (req%recv(irecv)%rank/=mpi_rank) THEN
988          ireq=req%recv(irecv)%ireq 
989          message%buffers(ireq)%size=message%buffers(ireq)%size+req%recv(irecv)%size
990          message%buffers(ireq)%rank=req%recv(irecv)%rank
991        ENDIF
992      ENDDO
993    ENDDO
994
995
996    IF (field(1)%data_type==type_real) THEN
997
998      IF (field(1)%ndim==2) THEN
999     
1000        DO ireq=1,message%nreq
1001          CALL allocate_mpi_buffer(message%buffers(ireq)%r,message%buffers(ireq)%size)
1002        ENDDO
1003     
1004      ELSE  IF (field(1)%ndim==3) THEN
1005     
1006        dim3=size(field(1)%rval3d,2)
1007        DO ireq=1,message%nreq
1008          message%buffers(ireq)%size=message%buffers(ireq)%size*dim3
1009          CALL allocate_mpi_buffer(message%buffers(ireq)%r,message%buffers(ireq)%size)
1010        ENDDO
1011     
1012      ELSE  IF (field(1)%ndim==4) THEN
1013        dim3=size(field(1)%rval4d,2)
1014        dim4=size(field(1)%rval4d,3)
1015        DO ireq=1,message%nreq
1016          message%buffers(ireq)%size=message%buffers(ireq)%size*dim3*dim4
1017          CALL allocate_mpi_buffer(message%buffers(ireq)%r,message%buffers(ireq)%size)
1018        ENDDO
1019      ENDIF     
1020    ENDIF
1021     
1022         
1023   
1024! ! Reorder the request, so recv request are done in the same order than send request
1025
1026!    nreq_send=sum(request(:)%nsend) 
1027!    message%nreq_send=nreq_send
1028!    ALLOCATE(message%reorder(nreq_send))
1029!    reorder=>message%reorder
1030!    ireq=0
1031!    DO ind=1,ndomain
1032!      req=>request(ind)
1033!      DO isend=1,req%nsend
1034!        ireq=ireq+1
1035!        reorder(ireq)%ind=ind
1036!        reorder(ireq)%isend=isend
1037!        reorder(ireq)%tag=req%send(isend)%tag
1038!      ENDDO
1039!    ENDDO
1040
1041! ! do a very very bad sort
1042!    DO i=1,nreq_send-1
1043!      DO j=i+1,nreq_send
1044!        IF (reorder(i)%tag > reorder(j)%tag) THEN
1045!          reorder_swap=reorder(i)
1046!          reorder(i)=reorder(j)
1047!          reorder(j)=reorder_swap
1048!        ENDIF
1049!      ENDDO
1050!    ENDDO
1051!    PRINT *,"reorder ",reorder(:)%tag
1052   
1053 
1054!$OMP END MASTER
1055!$OMP BARRIER   
1056
1057  END SUBROUTINE init_message_mpi
1058 
1059  SUBROUTINE Finalize_message_mpi(field,message)
1060  USE field_mod
1061  USE domain_mod
1062  USE mpi_mod
1063  USE mpipara
1064  USE mpi_mod
1065  IMPLICIT NONE
1066    TYPE(t_field),POINTER :: field(:)
1067    TYPE(t_message) :: message
1068
1069    INTEGER :: ireq, ibuff
1070
1071!$OMP BARRIER
1072!$OMP MASTER
1073
1074
1075    IF (message%field(1)%data_type==type_real) THEN
1076      DO ireq=1,message%nreq
1077        CALL free_mpi_buffer(message%buffers(ireq)%r)
1078      ENDDO   
1079    ENDIF
1080
1081    !deallocate device data if ondevice
1082    if(message%ondevice) then
1083      do ireq=1, ndomain
1084        do ibuff=1,message%request(ireq)%nsend
1085          !$acc exit data delete(message%request(ireq)%send(ibuff)%buffer(:))
1086          !$acc exit data delete(message%request(ireq)%send(ibuff)%buffer_r(:))
1087          !$acc exit data delete(message%request(ireq)%send(ibuff)%sign(:))
1088          !$acc exit data delete(message%request(ireq)%send(ibuff)%src_value(:))
1089          !$acc exit data delete(message%request(ireq)%send(ibuff)%value(:))
1090        end do
1091        do ibuff=1,message%request(ireq)%nrecv
1092          !$acc exit data delete(message%request(ireq)%recv(ibuff)%buffer(:))
1093          !$acc exit data delete(message%request(ireq)%recv(ibuff)%buffer_r(:))
1094          !$acc exit data delete(message%request(ireq)%recv(ibuff)%sign(:))
1095          !$acc exit data delete(message%request(ireq)%recv(ibuff)%src_value(:))
1096          !$acc exit data delete(message%request(ireq)%recv(ibuff)%value(:))
1097        end do
1098      end do
1099      DO ireq=1,message%nreq
1100        !$acc exit data delete(message%buffers(ireq)%r)
1101      ENDDO
1102      message%ondevice=.false.
1103    end if
1104
1105    DEALLOCATE(message%mpi_req)
1106    DEALLOCATE(message%buffers)
1107    DEALLOCATE(message%status)
1108
1109!$OMP END MASTER
1110!$OMP BARRIER
1111
1112     
1113  END SUBROUTINE Finalize_message_mpi
1114
1115
1116 
1117  SUBROUTINE barrier
1118  USE mpi_mod
1119  USE mpipara
1120  IMPLICIT NONE
1121   
1122    CALL MPI_BARRIER(comm_icosa,ierr)
1123   
1124  END SUBROUTINE barrier 
1125   
1126  SUBROUTINE transfert_message_mpi(field,message)
1127  USE field_mod
1128  IMPLICIT NONE
1129    TYPE(t_field),POINTER :: field(:)
1130    TYPE(t_message) :: message
1131   
1132    CALL send_message_mpi(field,message)
1133    CALL wait_message_mpi(message)
1134   
1135  END SUBROUTINE transfert_message_mpi
1136
1137
1138  !!!Update buffers on device for 'message'
1139  !!! does create_device_message when not already ondevice
1140  SUBROUTINE update_device_message_mpi(message)
1141    USE domain_mod
1142    IMPLICIT NONE
1143    TYPE(t_message), intent(inout) :: message
1144    INTEGER :: ireq, ibuff
1145
1146    !if(.not. message%ondevice) call create_device_message_mpi(message)
1147
1148    do ireq=1, ndomain
1149      do ibuff=1,message%request(ireq)%nsend
1150        !device buffers updated even if pointers not attached :
1151        !non allocated buffers in 'message' must be set to NULL()
1152        !$acc enter data copyin(message%request(ireq)%send(ibuff)%buffer(:)) async
1153        !$acc enter data copyin(message%request(ireq)%send(ibuff)%buffer_r(:)) async
1154        !$acc enter data copyin(message%request(ireq)%send(ibuff)%sign(:)) async
1155        !$acc enter data copyin(message%request(ireq)%send(ibuff)%src_value(:)) async
1156        !$acc enter data copyin(message%request(ireq)%send(ibuff)%value(:)) async
1157      end do
1158      do ibuff=1,message%request(ireq)%nrecv
1159        !$acc enter data copyin(message%request(ireq)%recv(ibuff)%buffer(:)) async
1160        !$acc enter data copyin(message%request(ireq)%recv(ibuff)%buffer_r(:)) async
1161        !$acc enter data copyin(message%request(ireq)%recv(ibuff)%sign(:)) async
1162        !$acc enter data copyin(message%request(ireq)%recv(ibuff)%src_value(:)) async
1163        !$acc enter data copyin(message%request(ireq)%recv(ibuff)%value(:)) async
1164      end do
1165    end do
1166    DO ireq=1,message%nreq
1167      !$acc enter data copyin(message%buffers(ireq)%r) async
1168    ENDDO
1169    message%ondevice=.true.
1170  END SUBROUTINE
1171
1172  !TODO : add openacc with multiple process
1173  SUBROUTINE send_message_mpi(field,message)
1174  USE abort_mod
1175  USE profiling_mod
1176  USE field_mod
1177  USE domain_mod
1178  USE mpi_mod
1179  USE mpipara
1180  USE omp_para
1181  USE trace
1182  USE abort_mod
1183  IMPLICIT NONE
1184    TYPE(t_field),POINTER :: field(:)
1185    TYPE(t_message) :: message
1186    REAL(rstd),POINTER :: rval2d(:), src_rval2d(:) 
1187    REAL(rstd),POINTER :: rval3d(:,:), src_rval3d(:,:) 
1188    REAL(rstd),POINTER :: rval4d(:,:,:), src_rval4d(:,:,:) 
1189    REAL(rstd),POINTER :: buffer_r(:) 
1190    INTEGER,POINTER :: value(:) 
1191    INTEGER,POINTER :: sgn(:) 
1192    TYPE(ARRAY),POINTER :: recv,send 
1193    TYPE(t_request),POINTER :: req
1194    INTEGER :: irecv,isend
1195    INTEGER :: ireq
1196    INTEGER :: ind,n
1197    INTEGER :: dim3,dim4,d3,d4
1198    INTEGER,POINTER :: src_value(:)
1199    INTEGER :: offset,msize,moffset,rank
1200    INTEGER :: lbegin, lend
1201    INTEGER :: max_req
1202
1203!    CALL trace_start("send_message_mpi")
1204
1205    CALL enter_profile(id_mpi)
1206
1207    !Prepare 'message' for on-device copies if field is on device
1208    if( field(1)%ondevice .AND. .NOT. message%ondevice ) call update_device_message_mpi(message)
1209
1210CALL enter_profile(profile_mpi_omp_barrier)
1211!$OMP BARRIER
1212CALL exit_profile(profile_mpi_omp_barrier)
1213
1214
1215!$OMP MASTER
1216    IF(message%open) THEN
1217       PRINT *, 'send_message_mpi : message ' // TRIM(message%name) // &
1218            ' is still open, no call to wait_message_mpi after last send_message_mpi'
1219       CALL dynamico_abort( "send_message_mpi : message still open" )
1220    END IF
1221    message%open=.TRUE. ! will be set to .FALSE. by wait_message_mpi
1222
1223    message%field=>field
1224
1225    IF (message%nreq>0) THEN
1226      message%completed=.FALSE.
1227      message%pending=.TRUE.
1228    ELSE
1229      message%completed=.TRUE.
1230      message%pending=.FALSE.
1231    ENDIF
1232!$OMP END MASTER
1233CALL enter_profile(profile_mpi_omp_barrier)
1234!$OMP BARRIER
1235CALL exit_profile(profile_mpi_omp_barrier)
1236     
1237    IF (field(1)%data_type==type_real) THEN
1238      IF (field(1)%ndim==2) THEN
1239
1240        DO ind=1,ndomain
1241          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
1242         
1243          rval2d=>field(ind)%rval2d
1244       
1245          req=>message%request(ind)
1246          DO isend=1,req%nsend
1247            send=>req%send(isend)
1248            value=>send%value
1249
1250           
1251            IF (send%rank/=mpi_rank) THEN
1252              ireq=send%ireq
1253
1254              buffer_r=>message%buffers(ireq)%r
1255              offset=send%offset
1256              msize=send%size
1257              call enter_profile(profile_mpi_copies)
1258              !$acc parallel loop default(present) async if (field(ind)%ondevice)
1259              DO n=1,msize
1260                buffer_r(offset+n)=rval2d(value(n))
1261              ENDDO
1262              call exit_profile(profile_mpi_copies)
1263
1264              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
1265                CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
1266                !$OMP CRITICAL           
1267                CALL MPI_ISEND(buffer_r,send%size,MPI_REAL8,send%rank,               &
1268                  send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
1269                !$OMP END CRITICAL
1270              ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
1271                CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
1272                CALL MPI_ISEND(buffer_r,send%size,MPI_REAL8,send%rank,               &
1273                  send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
1274              ENDIF
1275             
1276            ENDIF
1277          ENDDO
1278        ENDDO
1279       
1280        DO ind=1,ndomain
1281          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
1282          rval2d=>field(ind)%rval2d
1283          req=>message%request(ind)       
1284
1285          DO irecv=1,req%nrecv
1286            recv=>req%recv(irecv)
1287
1288            IF (recv%rank==mpi_rank) THEN
1289
1290              value=>recv%value
1291              src_value => recv%src_value
1292              src_rval2d=>field(recv%domain)%rval2d
1293              sgn=>recv%sign
1294              msize=recv%size
1295              call enter_profile(profile_mpi_copies)
1296              !$acc parallel loop default(present) async if (field(ind)%ondevice)
1297              DO n=1,msize
1298                rval2d(value(n))=src_rval2d(src_value(n))*sgn(n)
1299              ENDDO
1300              call exit_profile(profile_mpi_copies)
1301                   
1302            ELSE
1303           
1304              ireq=recv%ireq
1305              buffer_r=>message%buffers(ireq)%r
1306              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
1307                CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
1308               !$OMP CRITICAL           
1309                CALL MPI_IRECV(buffer_r,recv%size,MPI_REAL8,recv%rank,               &
1310                  recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
1311               !$OMP END CRITICAL
1312              ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
1313                 CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
1314                 CALL MPI_IRECV(buffer_r,recv%size,MPI_REAL8,recv%rank,              &
1315                   recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
1316              ENDIF
1317           
1318            ENDIF
1319          ENDDO
1320       
1321        ENDDO
1322       
1323     
1324      ELSE  IF (field(1)%ndim==3) THEN
1325        max_req=0
1326        DO ind=1,ndomain
1327          req=>message%request(ind)
1328          IF (req%nsend>max_req) max_req=req%nsend
1329        ENDDO
1330             
1331        DO ind=1,ndomain
1332          IF (.NOT. assigned_domain(ind) ) CYCLE
1333
1334          dim3=size(field(ind)%rval3d,2)
1335          CALL distrib_level(1,dim3, lbegin,lend)
1336
1337          rval3d=>field(ind)%rval3d
1338          req=>message%request(ind)
1339 
1340          DO isend=1,req%nsend
1341            send=>req%send(isend)
1342            value=>send%value
1343
1344            IF (send%rank/=mpi_rank) THEN
1345              ireq=send%ireq
1346              buffer_r=>message%buffers(ireq)%r
1347
1348              msize=send%size
1349              moffset=send%offset
1350              call enter_profile(profile_mpi_copies)
1351
1352              !$acc parallel loop default(present) async if (field(ind)%ondevice)
1353              DO d3=lbegin,lend
1354                offset=moffset*dim3 + (d3-1)*msize
1355                !$acc loop
1356                DO n=1,msize
1357                  buffer_r(n+offset)=rval3d(value(n),d3)
1358                ENDDO
1359              ENDDO
1360              call exit_profile(profile_mpi_copies)
1361
1362              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
1363CALL enter_profile(profile_mpi_omp_barrier)
1364!$OMP BARRIER
1365CALL exit_profile(profile_mpi_omp_barrier)
1366
1367              ENDIF
1368             
1369              IF (is_omp_level_master) THEN
1370                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
1371                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
1372                  !$OMP CRITICAL   
1373                  CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank,        &
1374                    send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
1375                  !$OMP END CRITICAL
1376                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
1377                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
1378                  CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank,        &
1379                    send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
1380                ENDIF
1381              ENDIF
1382            ELSE
1383              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
1384CALL enter_profile(profile_mpi_omp_barrier)
1385!$OMP BARRIER
1386CALL exit_profile(profile_mpi_omp_barrier)
1387
1388              ENDIF
1389            ENDIF
1390          ENDDO
1391
1392          IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
1393            DO isend=req%nsend+1,max_req
1394CALL enter_profile(profile_mpi_omp_barrier)
1395!$OMP BARRIER
1396CALL exit_profile(profile_mpi_omp_barrier)
1397
1398            ENDDO
1399          ENDIF
1400
1401        ENDDO
1402         
1403        DO ind=1,ndomain
1404          IF (.NOT. assigned_domain(ind) ) CYCLE
1405          dim3=size(field(ind)%rval3d,2)
1406          CALL distrib_level(1,dim3, lbegin,lend)
1407          rval3d=>field(ind)%rval3d
1408          req=>message%request(ind)
1409
1410          DO irecv=1,req%nrecv
1411            recv=>req%recv(irecv)
1412
1413            IF (recv%rank==mpi_rank) THEN
1414              value=>recv%value
1415              src_value => recv%src_value
1416              src_rval3d=>field(recv%domain)%rval3d
1417              sgn=>recv%sign
1418              msize=recv%size
1419
1420              call enter_profile(profile_mpi_copies)
1421              CALL trace_start("copy_data")
1422              !$acc parallel loop collapse(2) default(present) async if (field(ind)%ondevice)
1423              DO d3=lbegin,lend
1424                DO n=1,msize
1425                  rval3d(value(n),d3)=src_rval3d(src_value(n),d3)*sgn(n)
1426                ENDDO
1427              ENDDO
1428              call exit_profile(profile_mpi_copies)
1429              CALL trace_end("copy_data")
1430
1431            ELSE
1432              ireq=recv%ireq
1433              buffer_r=>message%buffers(ireq)%r
1434 
1435              IF (is_omp_level_master) THEN
1436                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
1437                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
1438                  !$OMP CRITICAL
1439                  CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank,        &
1440                    recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
1441                  !$OMP END CRITICAL
1442                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
1443                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
1444                  CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank,        &
1445                    recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
1446                ENDIF
1447              ENDIF
1448            ENDIF 
1449          ENDDO
1450       
1451        ENDDO
1452
1453      ELSE  IF (field(1)%ndim==4) THEN
1454
1455        max_req=0
1456        DO ind=1,ndomain
1457          req=>message%request(ind)
1458          IF (req%nsend>max_req) max_req=req%nsend
1459        ENDDO
1460   
1461        DO ind=1,ndomain
1462          IF (.NOT. assigned_domain(ind) ) CYCLE
1463
1464          dim3=size(field(ind)%rval4d,2)
1465          CALL distrib_level(1,dim3, lbegin,lend)
1466          dim4=size(field(ind)%rval4d,3)
1467          rval4d=>field(ind)%rval4d
1468          req=>message%request(ind)
1469
1470          DO isend=1,req%nsend
1471            send=>req%send(isend)
1472            value=>send%value
1473
1474            IF (send%rank/=mpi_rank) THEN
1475
1476              ireq=send%ireq
1477              buffer_r=>message%buffers(ireq)%r
1478              msize=send%size
1479              moffset=send%offset
1480
1481              call enter_profile(profile_mpi_copies)
1482              CALL trace_start("copy_to_buffer")
1483              !$acc parallel loop default(present) collapse(2) async if (field(ind)%ondevice)
1484              DO d4=1,dim4
1485                DO d3=lbegin,lend
1486                  offset=moffset*dim3*dim4 + dim3*msize*(d4-1) +               &
1487                    (d3-1)*msize
1488                  !$acc loop
1489                  DO n=1,msize
1490                    buffer_r(n+offset)=rval4d(value(n),d3,d4)
1491                  ENDDO
1492                ENDDO
1493              ENDDO
1494              CALL trace_end("copy_to_buffer")
1495              call exit_profile(profile_mpi_copies)
1496
1497              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
1498CALL enter_profile(profile_mpi_omp_barrier)
1499!$OMP BARRIER
1500CALL exit_profile(profile_mpi_omp_barrier)
1501
1502              ENDIF
1503
1504              IF (is_omp_level_master) THEN
1505                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
1506                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
1507                  !$OMP CRITICAL
1508                  CALL MPI_ISEND(buffer_r,send%size*dim3*dim4,MPI_REAL8,send%rank,   &
1509                    send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
1510                  !$OMP END CRITICAL
1511                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
1512                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
1513                  CALL MPI_ISEND(buffer_r,send%size*dim3*dim4,MPI_REAL8,send%rank,   &
1514                    send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
1515                ENDIF
1516              ENDIF
1517            ELSE
1518              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
1519CALL enter_profile(profile_mpi_omp_barrier)
1520!$OMP BARRIER
1521CALL exit_profile(profile_mpi_omp_barrier)
1522
1523              ENDIF
1524            ENDIF
1525          ENDDO
1526         
1527          IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
1528            DO isend=req%nsend+1,max_req
1529CALL enter_profile(profile_mpi_omp_barrier)
1530!$OMP BARRIER
1531CALL exit_profile(profile_mpi_omp_barrier)
1532
1533            ENDDO
1534          ENDIF
1535
1536        ENDDO
1537       
1538        DO ind=1,ndomain
1539          IF (.NOT. assigned_domain(ind) ) CYCLE
1540         
1541          dim3=size(field(ind)%rval4d,2)
1542          CALL distrib_level(1,dim3, lbegin,lend)
1543          dim4=size(field(ind)%rval4d,3)
1544          rval4d=>field(ind)%rval4d
1545          req=>message%request(ind)
1546         
1547          DO irecv=1,req%nrecv
1548            recv=>req%recv(irecv)
1549            IF (recv%rank==mpi_rank) THEN
1550              value=>recv%value
1551              src_value => recv%src_value
1552              src_rval4d=>field(recv%domain)%rval4d
1553              sgn=>recv%sign
1554              msize=recv%size
1555              call enter_profile(profile_mpi_copies)
1556              CALL trace_start("copy_data")
1557              !$acc parallel loop collapse(3) default(present) async if (field(ind)%ondevice)
1558              DO d4=1,dim4
1559                DO d3=lbegin,lend
1560                  DO n=1,msize
1561                    rval4d(value(n),d3,d4)=src_rval4d(src_value(n),d3,d4)*sgn(n)
1562                  ENDDO
1563                ENDDO
1564              ENDDO
1565              call exit_profile(profile_mpi_copies)
1566              CALL trace_end("copy_data")
1567                   
1568            ELSE
1569
1570              ireq=recv%ireq
1571              buffer_r=>message%buffers(ireq)%r
1572              IF (is_omp_level_master) THEN
1573                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
1574                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
1575                 !$OMP CRITICAL           
1576                  CALL MPI_IRECV(buffer_r,recv%size*dim3*dim4,MPI_REAL8,recv%rank,   &
1577                    recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
1578                  !$OMP END CRITICAL
1579                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
1580                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
1581                  CALL MPI_IRECV(buffer_r,recv%size*dim3*dim4,MPI_REAL8,recv%rank,   &
1582                    recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
1583                ENDIF
1584              ENDIF
1585            ENDIF
1586          ENDDO
1587        ENDDO
1588
1589      ENDIF     
1590
1591      IF (mpi_threading_mode==MPI_THREAD_FUNNELED .OR. mpi_threading_mode==MPI_THREAD_SINGLE) THEN
1592CALL enter_profile(profile_mpi_omp_barrier)
1593!$acc wait
1594!$OMP BARRIER
1595CALL exit_profile(profile_mpi_omp_barrier)
1596!$OMP MASTER       
1597
1598        DO ireq=1,message%nreq_send
1599          buffer_r=>message%buffers(ireq)%r
1600          msize=message%buffers(ireq)%size
1601          rank=message%buffers(ireq)%rank
1602          ! Using the "if" clause on the "host_data" directive seems to cause a crash at compilation
1603          IF (message%ondevice) THEN
1604            !$acc host_data use_device(buffer_r) ! if (message%ondevice)
1605            CALL MPI_ISEND(buffer_r,msize,MPI_REAL8,rank,1000*message%number,          &
1606              comm_icosa, message%mpi_req(ireq),ierr)
1607            !$acc end host_data
1608          ELSE
1609            CALL MPI_ISEND(buffer_r,msize,MPI_REAL8,rank,1000*message%number,          &
1610              comm_icosa, message%mpi_req(ireq),ierr)
1611          ENDIF
1612        ENDDO
1613
1614        DO ireq=message%nreq_send+1,message%nreq_send+message%nreq_recv
1615          buffer_r=>message%buffers(ireq)%r
1616          msize=message%buffers(ireq)%size
1617          rank=message%buffers(ireq)%rank
1618          ! Using the "if" clause on the "host_data" directive seems to cause a crash at compilation
1619          IF (message%ondevice) THEN
1620            !$acc host_data use_device(buffer_r) ! if (message%ondevice)
1621            CALL MPI_IRECV(buffer_r,msize,MPI_REAL8,rank,1000*message%number,          &
1622              comm_icosa, message%mpi_req(ireq),ierr)
1623            !$acc end host_data
1624          ELSE
1625            CALL MPI_IRECV(buffer_r,msize,MPI_REAL8,rank,1000*message%number,          &
1626              comm_icosa, message%mpi_req(ireq),ierr)
1627          ENDIF
1628        ENDDO
1629
1630!$OMP END MASTER
1631      ENDIF             
1632    ENDIF
1633CALL enter_profile(profile_mpi_omp_barrier)
1634!$OMP BARRIER
1635CALL exit_profile(profile_mpi_omp_barrier)
1636 
1637!    CALL trace_end("send_message_mpi")
1638
1639    CALL exit_profile(id_mpi)
1640   
1641  END SUBROUTINE send_message_mpi
1642 
1643  SUBROUTINE test_message_mpi(message)
1644  IMPLICIT NONE
1645    TYPE(t_message) :: message
1646   
1647    INTEGER :: ierr
1648
1649!$OMP MASTER
1650    IF (message%pending .AND. .NOT. message%completed) CALL MPI_TESTALL(message%nreq,&
1651      message%mpi_req,message%completed,message%status,ierr)
1652!$OMP END MASTER
1653  END SUBROUTINE  test_message_mpi
1654 
1655   
1656  SUBROUTINE wait_message_mpi(message)
1657  USE profiling_mod
1658  USE field_mod
1659  USE domain_mod
1660  USE mpi_mod
1661  USE mpipara
1662  USE omp_para
1663  USE trace
1664  IMPLICIT NONE
1665    TYPE(t_message) :: message
1666
1667    TYPE(t_field),POINTER :: field(:)
1668    REAL(rstd),POINTER :: rval2d(:) 
1669    REAL(rstd),POINTER :: rval3d(:,:) 
1670    REAL(rstd),POINTER :: rval4d(:,:,:) 
1671    REAL(rstd),POINTER :: buffer_r(:) 
1672    INTEGER,POINTER :: value(:) 
1673    INTEGER,POINTER :: sgn(:) 
1674    TYPE(ARRAY),POINTER :: recv 
1675    TYPE(t_request),POINTER :: req
1676    INTEGER :: irecv
1677    INTEGER :: ireq,nreq
1678    INTEGER :: ind,n
1679    INTEGER :: dim3,dim4,d3,d4,lbegin,lend
1680    INTEGER :: offset, msize, moffset
1681
1682    message%open=.FALSE.
1683    IF (.NOT. message%pending) RETURN
1684
1685    CALL enter_profile(id_mpi)
1686
1687!    CALL trace_start("wait_message_mpi")
1688
1689    field=>message%field
1690    nreq=message%nreq
1691   
1692    IF (field(1)%data_type==type_real) THEN
1693      IF (field(1)%ndim==2) THEN
1694
1695call enter_profile(profile_mpi_waitall)
1696!$OMP MASTER         
1697         IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req,          &
1698          message%status,ierr)
1699!$OMP END MASTER
1700!$OMP BARRIER
1701call exit_profile(profile_mpi_waitall)
1702        call enter_profile(profile_mpi_copies)
1703        DO ind=1,ndomain
1704          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
1705         
1706          rval2d=>field(ind)%rval2d
1707          req=>message%request(ind)
1708          DO irecv=1,req%nrecv
1709            recv=>req%recv(irecv)
1710            IF (recv%rank/=mpi_rank) THEN
1711              ireq=recv%ireq
1712              buffer_r=>message%buffers(ireq)%r
1713              value=>recv%value
1714              sgn=>recv%sign
1715              offset=recv%offset
1716              msize=recv%size
1717              !$acc parallel loop default(present) async if (field(ind)%ondevice)
1718              DO n=1,msize
1719                rval2d(value(n))=buffer_r(n+offset)*sgn(n) 
1720              ENDDO
1721
1722            ENDIF
1723          ENDDO
1724       
1725        ENDDO
1726        call exit_profile(profile_mpi_copies)
1727     
1728     
1729      ELSE  IF (field(1)%ndim==3) THEN
1730         call enter_profile(profile_mpi_waitall)
1731!$OMP MASTER
1732         IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req,          &
1733              message%status,ierr)
1734!$OMP END MASTER
1735!$OMP BARRIER
1736        call exit_profile(profile_mpi_waitall)
1737
1738       
1739        DO ind=1,ndomain
1740          IF (.NOT. assigned_domain(ind) ) CYCLE
1741
1742          rval3d=>field(ind)%rval3d
1743          req=>message%request(ind)
1744          DO irecv=1,req%nrecv
1745            recv=>req%recv(irecv)
1746            IF (recv%rank/=mpi_rank) THEN
1747              ireq=recv%ireq
1748              buffer_r=>message%buffers(ireq)%r
1749              value=>recv%value
1750              sgn=>recv%sign
1751             
1752              dim3=size(rval3d,2)
1753   
1754              CALL distrib_level(1,dim3, lbegin,lend)
1755              msize=recv%size
1756              moffset=recv%offset
1757              call enter_profile(profile_mpi_copies)
1758              CALL trace_start("copy_from_buffer")
1759             
1760              IF (req%vector) THEN
1761                !$acc parallel loop default(present) async if (field(ind)%ondevice)
1762                DO d3=lbegin,lend
1763                  offset=moffset*dim3 + (d3-1)*msize
1764                  !$acc loop
1765                  DO n=1,msize
1766                    rval3d(value(n),d3)=buffer_r(n+offset)*sgn(n) 
1767                  ENDDO
1768                ENDDO
1769              ELSE
1770                !$acc parallel loop default(present) async if (field(ind)%ondevice)
1771                DO d3=lbegin,lend
1772                  offset=moffset*dim3 + (d3-1)*msize
1773                  !$acc loop
1774                  DO n=1,msize
1775                    rval3d(value(n),d3)=buffer_r(n+offset) 
1776                  ENDDO
1777                ENDDO
1778              ENDIF
1779               
1780              CALL trace_end("copy_from_buffer")
1781              call exit_profile(profile_mpi_copies)
1782            ENDIF
1783          ENDDO
1784       
1785        ENDDO
1786
1787      ELSE  IF (field(1)%ndim==4) THEN
1788call enter_profile(profile_mpi_waitall)
1789!$OMP MASTER
1790        IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req,          &
1791          message%status,ierr)
1792!$OMP END MASTER
1793!$OMP BARRIER
1794        call exit_profile(profile_mpi_waitall)
1795
1796               
1797        DO ind=1,ndomain
1798          IF (.NOT. assigned_domain(ind) ) CYCLE
1799
1800          rval4d=>field(ind)%rval4d
1801          req=>message%request(ind)
1802          DO irecv=1,req%nrecv
1803            recv=>req%recv(irecv)
1804            IF (recv%rank/=mpi_rank) THEN
1805              ireq=recv%ireq
1806              buffer_r=>message%buffers(ireq)%r
1807              value=>recv%value
1808              sgn=>recv%sign
1809
1810              dim3=size(rval4d,2)
1811              CALL distrib_level(1,dim3, lbegin,lend)
1812              dim4=size(rval4d,3)
1813              msize=recv%size
1814              moffset=recv%offset
1815              call enter_profile(profile_mpi_copies)
1816              CALL trace_start("copy_from_buffer")
1817              !$acc parallel loop default(present) collapse(2) async if (field(ind)%ondevice)
1818              DO d4=1,dim4
1819                DO d3=lbegin,lend
1820                  offset=moffset*dim3*dim4 + dim3*msize*(d4-1) +               &
1821                    (d3-1)*msize
1822                  !$acc loop
1823                  DO n=1,msize
1824                    rval4d(value(n),d3,d4)=buffer_r(n+offset)*sgn(n) 
1825                  ENDDO
1826                ENDDO
1827              ENDDO
1828              CALL trace_end("copy_from_buffer")
1829              call exit_profile(profile_mpi_copies)
1830            ENDIF
1831          ENDDO
1832       
1833        ENDDO
1834     
1835      ENDIF     
1836     
1837    ENDIF
1838
1839!$OMP MASTER
1840    message%pending=.FALSE.
1841!$OMP END MASTER
1842
1843!    CALL trace_end("wait_message_mpi")
1844!$OMP BARRIER
1845 
1846    CALL exit_profile(id_mpi)
1847
1848  END SUBROUTINE wait_message_mpi
1849
1850  SUBROUTINE transfert_request_mpi(field,request)
1851  USE field_mod
1852  IMPLICIT NONE
1853    TYPE(t_field),POINTER :: field(:)
1854    TYPE(t_request),POINTER :: request(:)
1855
1856    TYPE(t_message),SAVE :: message
1857   
1858   
1859    CALL init_message_mpi(field,request, message)
1860    CALL transfert_message_mpi(field,message)
1861    CALL finalize_message_mpi(field,message)
1862   
1863  END SUBROUTINE transfert_request_mpi
1864 
1865   
1866   
1867  SUBROUTINE transfert_request_seq(field,request)
1868  USE field_mod
1869  USE domain_mod
1870  IMPLICIT NONE
1871    TYPE(t_field),POINTER :: field(:)
1872    TYPE(t_request),POINTER :: request(:)
1873    REAL(rstd),POINTER :: rval2d(:) 
1874    REAL(rstd),POINTER :: rval3d(:,:) 
1875    REAL(rstd),POINTER :: rval4d(:,:,:) 
1876    INTEGER :: ind
1877    TYPE(t_request),POINTER :: req
1878    INTEGER :: n
1879   
1880    DO ind=1,ndomain
1881      req=>request(ind)
1882      rval2d=>field(ind)%rval2d
1883      rval3d=>field(ind)%rval3d
1884      rval4d=>field(ind)%rval4d
1885     
1886      IF (field(ind)%data_type==type_real) THEN
1887        IF (field(ind)%ndim==2) THEN
1888          DO n=1,req%size
1889            rval2d(req%target_ind(n))=field(req%src_domain(n))%rval2d(req%src_ind(n))*&
1890              req%target_sign(n)
1891          ENDDO
1892        ELSE IF (field(ind)%ndim==3) THEN
1893          DO n=1,req%size
1894            rval3d(req%target_ind(n),:)=field(req%src_domain(n))%rval3d(req%src_ind(n),:)*&
1895              req%target_sign(n)
1896          ENDDO
1897        ELSE IF (field(ind)%ndim==4) THEN
1898          DO n=1,req%size
1899            rval4d(req%target_ind(n),:,:)=field(req%src_domain(n))%rval4d(req%src_ind(n),:,:)*&
1900              req%target_sign(n)
1901          ENDDO
1902        ENDIF
1903      ENDIF       
1904
1905    ENDDO
1906   
1907  END SUBROUTINE transfert_request_seq
1908 
1909 
1910  SUBROUTINE gather_field(field_loc,field_glo)
1911  USE field_mod
1912  USE domain_mod
1913  USE mpi_mod
1914  USE mpipara
1915  IMPLICIT NONE
1916    TYPE(t_field),POINTER :: field_loc(:)
1917    TYPE(t_field),POINTER :: field_glo(:)
1918    INTEGER, ALLOCATABLE :: mpi_req(:)
1919    INTEGER, ALLOCATABLE :: status(:,:)
1920    INTEGER :: ireq,nreq
1921    INTEGER :: ind_glo,ind_loc   
1922 
1923    IF (.NOT. using_mpi) THEN
1924   
1925      DO ind_loc=1,ndomain
1926        IF (field_loc(ind_loc)%ndim==2) field_glo(ind_loc)%rval2d=field_loc(ind_loc)%rval2d
1927        IF (field_loc(ind_loc)%ndim==3) field_glo(ind_loc)%rval3d=field_loc(ind_loc)%rval3d
1928        IF (field_loc(ind_loc)%ndim==4) field_glo(ind_loc)%rval4d=field_loc(ind_loc)%rval4d
1929      ENDDO
1930   
1931    ELSE
1932         
1933      nreq=ndomain
1934      IF (mpi_rank==0) nreq=nreq+ndomain_glo 
1935      ALLOCATE(mpi_req(nreq))
1936      ALLOCATE(status(MPI_STATUS_SIZE,nreq))
1937   
1938   
1939      ireq=0
1940      IF (mpi_rank==0) THEN
1941        DO ind_glo=1,ndomain_glo
1942          ireq=ireq+1
1943
1944          IF (field_glo(ind_glo)%ndim==2) THEN
1945            CALL MPI_IRECV(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 ,   &
1946                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
1947   
1948          ELSE IF (field_glo(ind_glo)%ndim==3) THEN
1949            CALL MPI_IRECV(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 ,   &
1950                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
1951
1952          ELSE IF (field_glo(ind_glo)%ndim==4) THEN
1953            CALL MPI_IRECV(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   &
1954                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
1955          ENDIF
1956         
1957        ENDDO
1958      ENDIF
1959 
1960      DO ind_loc=1,ndomain
1961        ireq=ireq+1
1962
1963        IF (field_loc(ind_loc)%ndim==2) THEN
1964          CALL MPI_ISEND(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   &
1965                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
1966        ELSE IF (field_loc(ind_loc)%ndim==3) THEN
1967          CALL MPI_ISEND(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   &
1968                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
1969        ELSE IF (field_loc(ind_loc)%ndim==4) THEN
1970          CALL MPI_ISEND(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   &
1971                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
1972        ENDIF
1973     
1974      ENDDO
1975   
1976      CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
1977
1978    ENDIF
1979       
1980  END SUBROUTINE gather_field
1981
1982  SUBROUTINE bcast_field(field_glo)
1983  USE field_mod
1984  USE domain_mod
1985  USE mpi_mod
1986  USE mpipara
1987  IMPLICIT NONE
1988    TYPE(t_field),POINTER :: field_glo(:)
1989    INTEGER :: ind_glo   
1990 
1991    IF (.NOT. using_mpi) THEN
1992   
1993! nothing to do
1994   
1995    ELSE
1996         
1997      DO ind_glo=1,ndomain_glo
1998
1999          IF (field_glo(ind_glo)%ndim==2) THEN
2000            CALL MPI_BCAST(field_glo(ind_glo)%rval2d, size(field_glo(ind_glo)%rval2d) , MPI_REAL8, 0, comm_icosa, ierr)
2001          ELSE IF (field_glo(ind_glo)%ndim==3) THEN
2002            CALL MPI_BCAST(field_glo(ind_glo)%rval3d, size(field_glo(ind_glo)%rval3d) , MPI_REAL8, 0, comm_icosa, ierr)
2003          ELSE IF (field_glo(ind_glo)%ndim==4) THEN
2004            CALL MPI_BCAST(field_glo(ind_glo)%rval4d, size(field_glo(ind_glo)%rval4d) , MPI_REAL8, 0, comm_icosa, ierr)
2005          ENDIF
2006         
2007        ENDDO
2008      ENDIF
2009       
2010  END SUBROUTINE bcast_field
2011
2012  SUBROUTINE scatter_field(field_glo,field_loc)
2013  USE field_mod
2014  USE domain_mod
2015  USE mpi_mod
2016  USE mpipara
2017  IMPLICIT NONE
2018    TYPE(t_field),POINTER :: field_glo(:)
2019    TYPE(t_field),POINTER :: field_loc(:)
2020    INTEGER, ALLOCATABLE :: mpi_req(:)
2021    INTEGER, ALLOCATABLE :: status(:,:)
2022    INTEGER :: ireq,nreq
2023    INTEGER :: ind_glo,ind_loc   
2024 
2025    IF (.NOT. using_mpi) THEN
2026   
2027      DO ind_loc=1,ndomain
2028        IF (field_loc(ind_loc)%ndim==2) field_loc(ind_loc)%rval2d=field_glo(ind_loc)%rval2d
2029        IF (field_loc(ind_loc)%ndim==3) field_loc(ind_loc)%rval3d=field_glo(ind_loc)%rval3d
2030        IF (field_loc(ind_loc)%ndim==4) field_loc(ind_loc)%rval4d=field_glo(ind_loc)%rval4d
2031      ENDDO
2032   
2033    ELSE
2034         
2035      nreq=ndomain
2036      IF (mpi_rank==0) nreq=nreq+ndomain_glo 
2037      ALLOCATE(mpi_req(nreq))
2038      ALLOCATE(status(MPI_STATUS_SIZE,nreq))
2039   
2040   
2041      ireq=0
2042      IF (mpi_rank==0) THEN
2043        DO ind_glo=1,ndomain_glo
2044          ireq=ireq+1
2045
2046          IF (field_glo(ind_glo)%ndim==2) THEN
2047            CALL MPI_ISEND(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 ,   &
2048                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
2049   
2050          ELSE IF (field_glo(ind_glo)%ndim==3) THEN
2051            CALL MPI_ISEND(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 ,   &
2052                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
2053
2054          ELSE IF (field_glo(ind_glo)%ndim==4) THEN
2055            CALL MPI_ISEND(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   &
2056                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
2057          ENDIF
2058         
2059        ENDDO
2060      ENDIF
2061 
2062      DO ind_loc=1,ndomain
2063        ireq=ireq+1
2064
2065        IF (field_loc(ind_loc)%ndim==2) THEN
2066          CALL MPI_IRECV(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   &
2067                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
2068        ELSE IF (field_loc(ind_loc)%ndim==3) THEN
2069          CALL MPI_IRECV(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   &
2070                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
2071        ELSE IF (field_loc(ind_loc)%ndim==4) THEN
2072          CALL MPI_IRECV(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   &
2073                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
2074        ENDIF
2075     
2076      ENDDO
2077   
2078      CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
2079
2080    ENDIF
2081       
2082  END SUBROUTINE scatter_field
2083 
2084  SUBROUTINE trace_in
2085  USE trace
2086  IMPLICIT NONE
2087 
2088    CALL trace_start("transfert_buffer")
2089  END SUBROUTINE trace_in             
2090
2091  SUBROUTINE trace_out
2092  USE trace
2093  IMPLICIT NONE
2094 
2095    CALL trace_end("transfert_buffer")
2096  END SUBROUTINE trace_out             
2097
2098
2099
2100
2101!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2102!! Definition des Broadcast --> 4D   !!
2103!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2104
2105!! -- Les chaine de charactï¿œre -- !!
2106
2107  SUBROUTINE bcast_mpi_c(var1)
2108  IMPLICIT NONE
2109    CHARACTER(LEN=*),INTENT(INOUT) :: Var1
2110   
2111    CALL bcast_mpi_cgen(Var1,len(Var1))
2112
2113  END SUBROUTINE bcast_mpi_c
2114
2115!! -- Les entiers -- !!
2116 
2117  SUBROUTINE bcast_mpi_i(var)
2118  USE mpipara
2119  IMPLICIT NONE
2120    INTEGER,INTENT(INOUT) :: Var
2121   
2122    INTEGER               :: var_tmp(1)
2123   
2124    IF (is_mpi_master) var_tmp(1)=var
2125    CALL bcast_mpi_igen(Var_tmp,1)
2126    var=var_tmp(1)
2127   
2128  END SUBROUTINE bcast_mpi_i
2129
2130  SUBROUTINE bcast_mpi_i1(var)
2131  IMPLICIT NONE
2132    INTEGER,INTENT(INOUT) :: Var(:)
2133
2134    CALL bcast_mpi_igen(Var,size(Var))
2135   
2136  END SUBROUTINE bcast_mpi_i1
2137
2138  SUBROUTINE bcast_mpi_i2(var)
2139  IMPLICIT NONE
2140    INTEGER,INTENT(INOUT) :: Var(:,:)
2141   
2142    CALL bcast_mpi_igen(Var,size(Var))
2143 
2144  END SUBROUTINE bcast_mpi_i2
2145
2146  SUBROUTINE bcast_mpi_i3(var)
2147  IMPLICIT NONE
2148    INTEGER,INTENT(INOUT) :: Var(:,:,:)
2149   
2150    CALL bcast_mpi_igen(Var,size(Var))
2151
2152  END SUBROUTINE bcast_mpi_i3
2153
2154  SUBROUTINE bcast_mpi_i4(var)
2155  IMPLICIT NONE
2156    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
2157   
2158    CALL bcast_mpi_igen(Var,size(Var))
2159
2160  END SUBROUTINE bcast_mpi_i4
2161
2162
2163!! -- Les reels -- !!
2164
2165  SUBROUTINE bcast_mpi_r(var)
2166  USE mpipara
2167  IMPLICIT NONE
2168    REAL,INTENT(INOUT) :: Var
2169    REAL               :: var_tmp(1)
2170   
2171    IF (is_mpi_master) var_tmp(1)=var
2172    CALL bcast_mpi_rgen(Var_tmp,1)
2173    var=var_tmp(1)   
2174
2175  END SUBROUTINE bcast_mpi_r
2176
2177  SUBROUTINE bcast_mpi_r1(var)
2178  IMPLICIT NONE
2179    REAL,INTENT(INOUT) :: Var(:)
2180   
2181    CALL bcast_mpi_rgen(Var,size(Var))
2182
2183  END SUBROUTINE bcast_mpi_r1
2184
2185  SUBROUTINE bcast_mpi_r2(var)
2186  IMPLICIT NONE
2187    REAL,INTENT(INOUT) :: Var(:,:)
2188   
2189    CALL bcast_mpi_rgen(Var,size(Var))
2190
2191  END SUBROUTINE bcast_mpi_r2
2192
2193  SUBROUTINE bcast_mpi_r3(var)
2194  IMPLICIT NONE
2195    REAL,INTENT(INOUT) :: Var(:,:,:)
2196   
2197    CALL bcast_mpi_rgen(Var,size(Var))
2198
2199  END SUBROUTINE bcast_mpi_r3
2200
2201  SUBROUTINE bcast_mpi_r4(var)
2202  IMPLICIT NONE
2203    REAL,INTENT(INOUT) :: Var(:,:,:,:)
2204   
2205    CALL bcast_mpi_rgen(Var,size(Var))
2206
2207  END SUBROUTINE bcast_mpi_r4
2208 
2209!! -- Les booleans -- !!
2210
2211  SUBROUTINE bcast_mpi_l(var)
2212  USE mpipara
2213  IMPLICIT NONE
2214    LOGICAL,INTENT(INOUT) :: Var
2215    LOGICAL               :: var_tmp(1)
2216   
2217    IF (is_mpi_master) var_tmp(1)=var
2218    CALL bcast_mpi_lgen(Var_tmp,1)
2219    var=var_tmp(1)   
2220
2221  END SUBROUTINE bcast_mpi_l
2222
2223  SUBROUTINE bcast_mpi_l1(var)
2224  IMPLICIT NONE
2225    LOGICAL,INTENT(INOUT) :: Var(:)
2226   
2227    CALL bcast_mpi_lgen(Var,size(Var))
2228
2229  END SUBROUTINE bcast_mpi_l1
2230
2231  SUBROUTINE bcast_mpi_l2(var)
2232  IMPLICIT NONE
2233    LOGICAL,INTENT(INOUT) :: Var(:,:)
2234   
2235    CALL bcast_mpi_lgen(Var,size(Var))
2236
2237  END SUBROUTINE bcast_mpi_l2
2238
2239  SUBROUTINE bcast_mpi_l3(var)
2240  IMPLICIT NONE
2241    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
2242   
2243    CALL bcast_mpi_lgen(Var,size(Var))
2244
2245  END SUBROUTINE bcast_mpi_l3
2246
2247  SUBROUTINE bcast_mpi_l4(var)
2248  IMPLICIT NONE
2249    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
2250   
2251    CALL bcast_mpi_lgen(Var,size(Var))
2252
2253  END SUBROUTINE bcast_mpi_l4
2254 
2255!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2256!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
2257!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2258
2259  SUBROUTINE bcast_mpi_cgen(var,nb)
2260    USE mpi_mod
2261    USE mpipara
2262    IMPLICIT NONE
2263   
2264    CHARACTER(LEN=*),INTENT(INOUT) :: Var
2265    INTEGER,INTENT(IN) :: nb
2266
2267    IF (.NOT. using_mpi) RETURN
2268   
2269    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_master,comm_icosa,ierr)
2270       
2271  END SUBROUTINE bcast_mpi_cgen
2272
2273
2274     
2275  SUBROUTINE bcast_mpi_igen(var,nb)
2276    USE mpi_mod
2277    USE mpipara
2278    IMPLICIT NONE
2279    INTEGER,INTENT(IN) :: nb
2280    INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var
2281   
2282    IF (.NOT. using_mpi) RETURN
2283
2284    CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_master,comm_icosa,ierr)
2285       
2286  END SUBROUTINE bcast_mpi_igen
2287
2288
2289
2290 
2291  SUBROUTINE bcast_mpi_rgen(var,nb)
2292    USE mpi_mod
2293    USE mpipara
2294    IMPLICIT NONE
2295    INTEGER,INTENT(IN) :: nb
2296    REAL,DIMENSION(nb),INTENT(INOUT) :: Var
2297
2298    IF (.NOT. using_mpi) RETURN
2299
2300    CALL MPI_BCAST(Var,nb,MPI_REAL8,mpi_master,comm_icosa,ierr)
2301   
2302  END SUBROUTINE bcast_mpi_rgen
2303 
2304
2305
2306
2307  SUBROUTINE bcast_mpi_lgen(var,nb)
2308    USE mpi_mod
2309    USE mpipara
2310    IMPLICIT NONE
2311    INTEGER,INTENT(IN) :: nb
2312    LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
2313
2314    IF (.NOT. using_mpi) RETURN
2315
2316    CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_master,comm_icosa,ierr)
2317
2318  END SUBROUTINE bcast_mpi_lgen
2319 
2320   
2321END MODULE transfert_mpi_mod
2322     
2323       
2324       
2325       
2326     
Note: See TracBrowser for help on using the repository browser.