source: CONFIG/publications/ICOLMDZORINCA_CO2_Transport_GMD_2023/INCA/build/ppsrc/INCA_PARA/mod_inca_omp_transfert.f90 @ 6610

Last change on this file since 6610 was 6610, checked in by acosce, 9 months ago

INCA used for ICOLMDZORINCA_CO2_Transport_GMD_2023

File size: 26.0 KB
Line 
1
2
3
4
5
6
7
8
9
10
11
12MODULE mod_inca_omp_transfert
13
14  INTEGER,PARAMETER :: omp_buffer_size = 1024*1024*64
15  INTEGER,SAVE,DIMENSION(omp_buffer_size) :: omp_buffer
16 
17  INTERFACE bcast_omp
18    MODULE PROCEDURE bcast_omp_c,bcast_omp_c1,                                         &
19                     bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4, &
20                     bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4,bcast_omp_r5, &
21                     bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4
22  END INTERFACE
23
24  INTERFACE scatter_omp
25    MODULE PROCEDURE scatter_omp_i,scatter_omp_i1,scatter_omp_i2,scatter_omp_i3, &
26                     scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3, &
27                     scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3
28  END INTERFACE
29
30 
31  INTERFACE gather_omp
32    MODULE PROCEDURE gather_omp_i,gather_omp_i1,gather_omp_i2,gather_omp_i3, &
33                     gather_omp_r,gather_omp_r1,gather_omp_r2,gather_omp_r3, &
34                     gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3 
35  END INTERFACE
36 
37 
38  INTERFACE reduce_sum_omp
39    MODULE PROCEDURE reduce_sum_omp_i,reduce_sum_omp_i1,reduce_sum_omp_i2,reduce_sum_omp_i3,reduce_sum_omp_i4, &
40                     reduce_sum_omp_r,reduce_sum_omp_r1,reduce_sum_omp_r2,reduce_sum_omp_r3,reduce_sum_omp_r4
41  END INTERFACE
42
43CONTAINS
44
45  SUBROUTINE OMP_BARRIER
46    USE MOD_INCA_OMP_DATA
47    IMPLICIT NONE
48    LOGICAL :: FLAG_TEST
49    INTEGER :: i
50    REAL :: temps
51    INTEGER :: t1, t2, ir
52
53    flag_omp(omp_rank)=.TRUE.
54!$OMP FLUSH(flag_omp)
55   
56    flag_test = .TRUE.
57    DO WHILE(flag_test)
58       flag_test = .TRUE.
59       
60       DO i=0,omp_size-1
61          IF(.NOT.flag_omp(i) .AND. flag_test) THEN
62             flag_test = .FALSE.
63             EXIT
64          ENDIF
65       ENDDO
66       IF(.NOT.flag_test) THEN
67          call system_clock(count=t1, count_rate=ir)
68          temps = 0.d0
69          DO WHILE(temps.LT.1.D0)
70             call system_clock(count=t2, count_rate=ir)
71             temps=real(t2-t1)/real(ir)
72          ENDDO
73       ENDIF
74       
75    ENDDO
76   
77!$OMP MASTER
78    flag_omp=.FALSE.
79!$OMP END MASTER
80!$OMP BARRIER
81
82  END SUBROUTINE OMP_BARRIER
83
84
85!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
86!! Definition des Broadcast --> 4D   !!
87!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
88
89!! -- Les chaine de charactère -- !!
90
91  SUBROUTINE bcast_omp_c(var)
92  IMPLICIT NONE
93    CHARACTER(LEN=*),INTENT(INOUT) :: Var
94
95    CALL bcast_omp_cgen_inca(Var,1,omp_buffer)
96   
97  END SUBROUTINE bcast_omp_c
98
99  SUBROUTINE bcast_omp_c1(var)
100  IMPLICIT NONE
101    CHARACTER(LEN=*),INTENT(INOUT) :: Var(:)
102
103    CALL bcast_omp_cgen_inca(Var,size(Var),omp_buffer)
104   
105  END SUBROUTINE bcast_omp_c1
106
107!! -- Les entiers -- !!
108 
109  SUBROUTINE bcast_omp_i(var)
110  IMPLICIT NONE
111    INTEGER,INTENT(INOUT) :: Var
112
113    CALL bcast_omp_igen_inca(Var,1,omp_buffer)
114
115  END SUBROUTINE bcast_omp_i
116
117  SUBROUTINE bcast_omp_i1(var)
118  IMPLICIT NONE
119    INTEGER,INTENT(INOUT) :: Var(:)
120   
121    CALL bcast_omp_igen_inca(Var,size(Var),omp_buffer)
122
123  END SUBROUTINE bcast_omp_i1
124
125
126  SUBROUTINE bcast_omp_i2(var)
127  IMPLICIT NONE
128    INTEGER,INTENT(INOUT) :: Var(:,:)
129   
130    CALL bcast_omp_igen_inca(Var,size(Var),omp_buffer)
131
132  END SUBROUTINE bcast_omp_i2
133
134
135  SUBROUTINE bcast_omp_i3(var)
136  IMPLICIT NONE
137    INTEGER,INTENT(INOUT) :: Var(:,:,:)
138
139    CALL bcast_omp_igen_inca(Var,size(Var),omp_buffer)
140
141  END SUBROUTINE bcast_omp_i3
142
143
144  SUBROUTINE bcast_omp_i4(var)
145  IMPLICIT NONE
146    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
147   
148    CALL bcast_omp_igen_inca(Var,size(Var),omp_buffer)
149
150  END SUBROUTINE bcast_omp_i4
151
152
153!! -- Les reels -- !!
154
155  SUBROUTINE bcast_omp_r(var)
156  IMPLICIT NONE
157    REAL,INTENT(INOUT) :: Var
158    REAL,DIMENSION(1)  :: Var2
159
160    Var2(1)=Var
161    CALL bcast_omp_rgen_inca(Var2,1,omp_buffer)
162    Var=Var2(1)
163
164  END SUBROUTINE bcast_omp_r
165
166  SUBROUTINE bcast_omp_r1(var)
167  IMPLICIT NONE
168    REAL,INTENT(INOUT) :: Var(:)
169   
170    CALL bcast_omp_rgen_inca(Var,size(Var),omp_buffer)
171
172  END SUBROUTINE bcast_omp_r1
173
174
175  SUBROUTINE bcast_omp_r2(var)
176  IMPLICIT NONE
177    REAL,INTENT(INOUT) :: Var(:,:)
178   
179    CALL bcast_omp_rgen_inca(Var,size(Var),omp_buffer)
180
181  END SUBROUTINE bcast_omp_r2
182
183
184  SUBROUTINE bcast_omp_r3(var)
185  IMPLICIT NONE
186    REAL,INTENT(INOUT) :: Var(:,:,:)
187
188    CALL bcast_omp_igen_inca(Var,size(Var),omp_buffer)
189
190  END SUBROUTINE bcast_omp_r3
191
192
193  SUBROUTINE bcast_omp_r4(var)
194  IMPLICIT NONE
195    REAL,INTENT(INOUT) :: Var(:,:,:,:)
196   
197    CALL bcast_omp_rgen_inca(Var,size(Var),omp_buffer)
198
199  END SUBROUTINE bcast_omp_r4
200
201  SUBROUTINE bcast_omp_r5(var)
202  IMPLICIT NONE
203    REAL,INTENT(INOUT) :: Var(:,:,:,:,:)
204   
205    CALL bcast_omp_rgen_inca(Var,size(Var),omp_buffer)
206
207  END SUBROUTINE bcast_omp_r5
208 
209!! -- Les booleans -- !!
210
211  SUBROUTINE bcast_omp_l(var)
212  IMPLICIT NONE
213    LOGICAL,INTENT(INOUT) :: Var
214    LOGICAL,DIMENSION(1)  :: Var2
215
216    Var2(1)=Var
217    CALL bcast_omp_lgen_inca(Var2,1,omp_buffer)
218    Var=Var2(1)
219
220  END SUBROUTINE bcast_omp_l
221
222  SUBROUTINE bcast_omp_l1(var)
223  IMPLICIT NONE
224    LOGICAL,INTENT(INOUT) :: Var(:)
225   
226    CALL bcast_omp_lgen_inca(Var,size(Var),omp_buffer)
227
228  END SUBROUTINE bcast_omp_l1
229
230
231  SUBROUTINE bcast_omp_l2(var)
232  IMPLICIT NONE
233    LOGICAL,INTENT(INOUT) :: Var(:,:)
234   
235    CALL bcast_omp_lgen_inca(Var,size(Var),omp_buffer)
236
237  END SUBROUTINE bcast_omp_l2
238
239
240  SUBROUTINE bcast_omp_l3(var)
241  IMPLICIT NONE
242    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
243
244    CALL bcast_omp_lgen_inca(Var,size(Var),omp_buffer)
245
246  END SUBROUTINE bcast_omp_l3
247
248
249  SUBROUTINE bcast_omp_l4(var)
250  IMPLICIT NONE
251    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
252   
253    CALL bcast_omp_lgen_inca(Var,size(Var),omp_buffer)
254
255  END SUBROUTINE bcast_omp_l4
256
257
258
259!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
260!! Definition des Scatter   --> 4D   !!
261!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
262
263  SUBROUTINE scatter_omp_i(VarIn, VarOut)
264    USE mod_inca_omp_data, ONLY : is_omp_root
265    IMPLICIT NONE
266 
267    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
268    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
269
270    INTEGER :: dummy
271
272
273     IF (is_omp_root) THEN
274      CALL scatter_omp_igen_inca(VarIn,Varout,1,omp_buffer)
275     ELSE
276      CALL scatter_omp_igen_inca(dummy,Varout,1,omp_buffer)
277    ENDIF
278   
279  END SUBROUTINE scatter_omp_i
280
281
282  SUBROUTINE scatter_omp_i1(VarIn, VarOut)
283    USE mod_inca_omp_data, ONLY : is_omp_root
284    IMPLICIT NONE
285 
286    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
287    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
288   
289    INTEGER :: dummy
290
291    IF (is_omp_root) THEN
292      CALL scatter_omp_igen_inca(VarIn,Varout,Size(VarOut,2),omp_buffer)
293    ELSE
294      CALL scatter_omp_igen_inca(dummy,Varout,Size(VarOut,2),omp_buffer)
295    ENDIF
296   
297  END SUBROUTINE scatter_omp_i1
298 
299 
300  SUBROUTINE scatter_omp_i2(VarIn, VarOut)
301    USE mod_inca_omp_data, ONLY : is_omp_root
302    IMPLICIT NONE
303 
304    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
305    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
306   
307    INTEGER :: dummy
308   
309    IF (is_omp_root) THEN
310      CALL scatter_omp_igen_inca(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),omp_buffer)
311    ELSE
312      CALL scatter_omp_igen_inca(dummy,Varout,Size(VarOut,2)*Size(VarOut,3),omp_buffer)
313    ENDIF
314
315  END SUBROUTINE scatter_omp_i2
316
317
318  SUBROUTINE scatter_omp_i3(VarIn, VarOut)
319    USE mod_inca_omp_data, ONLY : is_omp_root
320    IMPLICIT NONE
321 
322    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
323    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
324   
325    INTEGER :: dummy
326   
327    IF (is_omp_root) THEN
328      CALL scatter_omp_igen_inca(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),omp_buffer)
329    ELSE
330      CALL scatter_omp_igen_inca(dummy,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),omp_buffer)
331    ENDIF
332 
333  END SUBROUTINE scatter_omp_i3
334
335  SUBROUTINE scatter_omp_r(VarIn, VarOut)
336    USE mod_inca_omp_data, ONLY : is_omp_root
337    IMPLICIT NONE
338 
339    REAL,INTENT(IN),DIMENSION(:) :: VarIn
340    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
341
342    REAL :: dummy
343
344
345     IF (is_omp_root) THEN
346      CALL scatter_omp_rgen_inca(VarIn,Varout,1,omp_buffer)
347     ELSE
348      CALL scatter_omp_rgen_inca(dummy,Varout,1,omp_buffer)
349    ENDIF
350   
351  END SUBROUTINE scatter_omp_r
352
353
354  SUBROUTINE scatter_omp_r1(VarIn, VarOut)
355    USE mod_inca_omp_data, ONLY : is_omp_root
356    IMPLICIT NONE
357 
358    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
359    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
360   
361    REAL :: dummy
362
363    IF (is_omp_root) THEN
364      CALL scatter_omp_rgen_inca(VarIn,Varout,Size(VarOut,2),omp_buffer)
365    ELSE
366      CALL scatter_omp_rgen_inca(dummy,Varout,Size(VarOut,2),omp_buffer)
367    ENDIF
368   
369  END SUBROUTINE scatter_omp_r1
370 
371 
372  SUBROUTINE scatter_omp_r2(VarIn, VarOut)
373    USE mod_inca_omp_data, ONLY : is_omp_root
374    IMPLICIT NONE
375 
376    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
377    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
378   
379    REAL :: dummy
380   
381    IF (is_omp_root) THEN
382      CALL scatter_omp_rgen_inca(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),omp_buffer)
383    ELSE
384      CALL scatter_omp_rgen_inca(dummy,Varout,Size(VarOut,2)*Size(VarOut,3),omp_buffer)
385    ENDIF
386
387  END SUBROUTINE scatter_omp_r2
388
389
390  SUBROUTINE scatter_omp_r3(VarIn, VarOut)
391    USE mod_inca_omp_data, ONLY : is_omp_root
392    IMPLICIT NONE
393 
394    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
395    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
396   
397    REAL :: dummy
398   
399    IF (is_omp_root) THEN
400      CALL scatter_omp_rgen_inca(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),omp_buffer)
401    ELSE
402      CALL scatter_omp_rgen_inca(dummy,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),omp_buffer)
403    ENDIF
404 
405  END SUBROUTINE scatter_omp_r3
406 
407
408
409  SUBROUTINE scatter_omp_l(VarIn, VarOut)
410    USE mod_inca_omp_data, ONLY : is_omp_root
411    IMPLICIT NONE
412 
413    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
414    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
415
416    LOGICAL :: dummy
417
418
419     IF (is_omp_root) THEN
420      CALL scatter_omp_lgen_inca(VarIn,Varout,1,omp_buffer)
421     ELSE
422      CALL scatter_omp_lgen_inca(dummy,Varout,1,omp_buffer)
423    ENDIF
424   
425  END SUBROUTINE scatter_omp_l
426
427
428  SUBROUTINE scatter_omp_l1(VarIn, VarOut)
429    USE mod_inca_omp_data, ONLY : is_omp_root
430    IMPLICIT NONE
431 
432    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
433    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
434   
435    LOGICAL :: dummy
436
437    IF (is_omp_root) THEN
438      CALL scatter_omp_lgen_inca(VarIn,Varout,Size(VarOut,2),omp_buffer)
439    ELSE
440      CALL scatter_omp_lgen_inca(dummy,Varout,Size(VarOut,2),omp_buffer)
441    ENDIF
442   
443  END SUBROUTINE scatter_omp_l1
444 
445 
446  SUBROUTINE scatter_omp_l2(VarIn, VarOut)
447    USE mod_inca_omp_data, ONLY : is_omp_root
448    IMPLICIT NONE
449 
450    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
451    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
452   
453    LOGICAL :: dummy
454   
455    IF (is_omp_root) THEN
456      CALL scatter_omp_lgen_inca(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),omp_buffer)
457    ELSE
458      CALL scatter_omp_lgen_inca(dummy,Varout,Size(VarOut,2)*Size(VarOut,3),omp_buffer)
459    ENDIF
460
461  END SUBROUTINE scatter_omp_l2
462
463
464  SUBROUTINE scatter_omp_l3(VarIn, VarOut)
465    USE mod_inca_omp_data, ONLY : is_omp_root
466    IMPLICIT NONE
467 
468    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
469    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
470   
471    LOGICAL :: dummy
472   
473    IF (is_omp_root) THEN
474      CALL scatter_omp_lgen_inca(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),omp_buffer)
475    ELSE
476      CALL scatter_omp_lgen_inca(dummy,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),omp_buffer)
477    ENDIF
478 
479  END SUBROUTINE scatter_omp_l3 
480 
481
482  SUBROUTINE gather_omp_i(VarIn, VarOut)
483    USE mod_inca_omp_data, ONLY : is_omp_root
484    IMPLICIT NONE
485 
486    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
487    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
488
489    INTEGER :: dummy
490
491
492     IF (is_omp_root) THEN
493      CALL gather_omp_igen_inca(VarIn,Varout,1,omp_buffer)
494     ELSE
495      CALL gather_omp_igen_inca(VarIn,dummy,1,omp_buffer)
496    ENDIF
497   
498  END SUBROUTINE gather_omp_i
499
500
501  SUBROUTINE gather_omp_i1(VarIn, VarOut)
502    USE mod_inca_omp_data, ONLY : is_omp_root
503    IMPLICIT NONE
504 
505    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
506    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
507   
508    INTEGER :: dummy
509
510    IF (is_omp_root) THEN
511      CALL gather_omp_igen_inca(VarIn,Varout,Size(VarIn,2),omp_buffer)
512    ELSE
513      CALL gather_omp_igen_inca(VarIn,dummy,Size(VarIn,2),omp_buffer)
514    ENDIF
515   
516  END SUBROUTINE gather_omp_i1
517
518
519  SUBROUTINE gather_omp_i2(VarIn, VarOut)
520    USE mod_inca_omp_data, ONLY : is_omp_root
521    IMPLICIT NONE
522 
523    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
524    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
525   
526    INTEGER :: dummy
527
528    IF (is_omp_root) THEN
529      CALL gather_omp_igen_inca(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),omp_buffer)
530    ELSE
531      CALL gather_omp_igen_inca(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3),omp_buffer)
532    ENDIF
533   
534  END SUBROUTINE gather_omp_i2
535 
536
537  SUBROUTINE gather_omp_i3(VarIn, VarOut)
538    USE mod_inca_omp_data, ONLY : is_omp_root
539    IMPLICIT NONE
540 
541    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
542    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
543   
544    INTEGER :: dummy
545
546    IF (is_omp_root) THEN
547      CALL gather_omp_igen_inca(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),omp_buffer)
548    ELSE
549      CALL gather_omp_igen_inca(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),omp_buffer)
550    ENDIF
551   
552  END SUBROUTINE gather_omp_i3
553
554
555
556  SUBROUTINE gather_omp_r(VarIn, VarOut)
557    USE mod_inca_omp_data, ONLY : is_omp_root
558    IMPLICIT NONE
559 
560    REAL,INTENT(IN),DIMENSION(:) :: VarIn
561    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
562
563    REAL :: dummy
564
565
566     IF (is_omp_root) THEN
567      CALL gather_omp_rgen_inca(VarIn,Varout,1,omp_buffer)
568     ELSE
569      CALL gather_omp_rgen_inca(VarIn,dummy,1,omp_buffer)
570    ENDIF
571   
572  END SUBROUTINE gather_omp_r
573
574
575  SUBROUTINE gather_omp_r1(VarIn, VarOut)
576    USE mod_inca_omp_data, ONLY : is_omp_root
577    IMPLICIT NONE
578 
579    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
580    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
581   
582    REAL :: dummy
583
584    IF (is_omp_root) THEN
585      CALL gather_omp_rgen_inca(VarIn,Varout,Size(VarIn,2),omp_buffer)
586    ELSE
587      CALL gather_omp_rgen_inca(VarIn,dummy,Size(VarIn,2),omp_buffer)
588    ENDIF
589   
590  END SUBROUTINE gather_omp_r1
591
592
593  SUBROUTINE gather_omp_r2(VarIn, VarOut)
594    USE mod_inca_omp_data, ONLY : is_omp_root
595    IMPLICIT NONE
596 
597    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
598    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
599   
600    REAL :: dummy
601
602    IF (is_omp_root) THEN
603      CALL gather_omp_rgen_inca(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),omp_buffer)
604    ELSE
605      CALL gather_omp_rgen_inca(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3),omp_buffer)
606    ENDIF
607   
608  END SUBROUTINE gather_omp_r2
609 
610
611  SUBROUTINE gather_omp_r3(VarIn, VarOut)
612    USE mod_inca_omp_data, ONLY : is_omp_root
613    IMPLICIT NONE
614 
615    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
616    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
617   
618    REAL :: dummy
619
620    IF (is_omp_root) THEN
621      CALL gather_omp_rgen_inca(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),omp_buffer)
622    ELSE
623      CALL gather_omp_rgen_inca(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),omp_buffer)
624    ENDIF
625   
626  END SUBROUTINE gather_omp_r3
627
628
629  SUBROUTINE gather_omp_l(VarIn, VarOut)
630    USE mod_inca_omp_data, ONLY : is_omp_root
631    IMPLICIT NONE
632 
633    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
634    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
635
636    LOGICAL :: dummy
637
638
639     IF (is_omp_root) THEN
640      CALL gather_omp_lgen_inca(VarIn,Varout,1,omp_buffer)
641     ELSE
642      CALL gather_omp_lgen_inca(VarIn,dummy,1,omp_buffer)
643    ENDIF
644   
645  END SUBROUTINE gather_omp_l
646
647
648  SUBROUTINE gather_omp_l1(VarIn, VarOut)
649    USE mod_inca_omp_data, ONLY : is_omp_root
650    IMPLICIT NONE
651 
652    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
653    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
654   
655    LOGICAL :: dummy
656
657    IF (is_omp_root) THEN
658      CALL gather_omp_lgen_inca(VarIn,Varout,Size(VarIn,2),omp_buffer)
659    ELSE
660      CALL gather_omp_lgen_inca(VarIn,dummy,Size(VarIn,2),omp_buffer)
661    ENDIF
662   
663  END SUBROUTINE gather_omp_l1
664
665
666  SUBROUTINE gather_omp_l2(VarIn, VarOut)
667    USE mod_inca_omp_data, ONLY : is_omp_root
668    IMPLICIT NONE
669 
670    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
671    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
672   
673    LOGICAL :: dummy
674
675    IF (is_omp_root) THEN
676      CALL gather_omp_lgen_inca(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),omp_buffer)
677    ELSE
678      CALL gather_omp_lgen_inca(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3),omp_buffer)
679    ENDIF
680   
681  END SUBROUTINE gather_omp_l2
682 
683
684  SUBROUTINE gather_omp_l3(VarIn, VarOut)
685    USE mod_inca_omp_data, ONLY : is_omp_root
686    IMPLICIT NONE
687 
688    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
689    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
690   
691    LOGICAL :: dummy
692
693    IF (is_omp_root) THEN
694      CALL gather_omp_lgen_inca(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),omp_buffer)
695    ELSE
696      CALL gather_omp_lgen_inca(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),omp_buffer)
697    ENDIF
698   
699  END SUBROUTINE gather_omp_l3
700
701
702
703
704  SUBROUTINE reduce_sum_omp_i(VarIn, VarOut)
705    IMPLICIT NONE
706 
707    INTEGER,INTENT(IN)  :: VarIn
708    INTEGER,INTENT(OUT) :: VarOut
709   
710    CALL reduce_sum_omp_igen_inca(VarIn,Varout,1,omp_buffer)
711 
712  END SUBROUTINE reduce_sum_omp_i
713
714  SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut)
715    IMPLICIT NONE
716 
717    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
718    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
719   
720    CALL reduce_sum_omp_igen_inca(VarIn,Varout,Size(VarIn),omp_buffer)
721   
722  END SUBROUTINE reduce_sum_omp_i1
723 
724 
725  SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut)
726    IMPLICIT NONE
727 
728    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
729    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
730   
731    CALL reduce_sum_omp_igen_inca(VarIn,Varout,Size(VarIn),omp_buffer)
732 
733  END SUBROUTINE reduce_sum_omp_i2
734
735
736  SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut)
737    IMPLICIT NONE
738 
739    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
740    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
741   
742    CALL reduce_sum_omp_igen_inca(VarIn,Varout,Size(VarIn),omp_buffer)
743 
744  END SUBROUTINE reduce_sum_omp_i3
745
746
747  SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut)
748    IMPLICIT NONE
749
750    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
751    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
752 
753    CALL reduce_sum_omp_igen_inca(VarIn,Varout,Size(VarIn),omp_buffer)
754 
755  END SUBROUTINE reduce_sum_omp_i4
756
757
758  SUBROUTINE reduce_sum_omp_r(VarIn, VarOut)
759    IMPLICIT NONE
760 
761    REAL,INTENT(IN)  :: VarIn
762    REAL,INTENT(OUT) :: VarOut
763   
764    CALL reduce_sum_omp_rgen_inca(VarIn,Varout,1,omp_buffer)
765 
766  END SUBROUTINE reduce_sum_omp_r
767
768  SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut)
769    IMPLICIT NONE
770 
771    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
772    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
773   
774    CALL reduce_sum_omp_rgen_inca(VarIn,Varout,Size(VarIn),omp_buffer)
775   
776  END SUBROUTINE reduce_sum_omp_r1
777 
778 
779  SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut)
780    IMPLICIT NONE
781 
782    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
783    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
784   
785    CALL reduce_sum_omp_rgen_inca(VarIn,Varout,Size(VarIn),omp_buffer)
786 
787  END SUBROUTINE reduce_sum_omp_r2
788
789
790  SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut)
791    IMPLICIT NONE
792 
793    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
794    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
795   
796    CALL reduce_sum_omp_rgen_inca(VarIn,Varout,Size(VarIn),omp_buffer)
797 
798  END SUBROUTINE reduce_sum_omp_r3
799
800
801  SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut)
802    IMPLICIT NONE
803
804    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
805    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
806 
807    CALL reduce_sum_omp_rgen_inca(VarIn,Varout,Size(VarIn),omp_buffer)
808 
809  END SUBROUTINE reduce_sum_omp_r4
810
811
812END MODULE mod_inca_omp_transfert
813
814
815SUBROUTINE bcast_omp_cgen_inca(Var,Nb,Buff)
816  IMPLICIT NONE
817   
818  CHARACTER(LEN=*),DIMENSION(Nb),INTENT(INOUT) :: Var
819  CHARACTER(LEN=len(Var)),DIMENSION(Nb) :: Buff
820  INTEGER,INTENT(IN) :: Nb
821
822   
823  INTEGER :: i
824 
825!$OMP MASTER
826  Buff=Var
827!$OMP END MASTER
828!$OMP BARRIER
829
830  Var=Buff
831
832!$OMP BARRIER     
833 
834END SUBROUTINE bcast_omp_cgen_inca
835
836     
837SUBROUTINE bcast_omp_igen_inca(Var,Nb,Buff)
838  IMPLICIT NONE
839   
840  INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
841  INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
842  INTEGER,INTENT(IN) :: Nb
843
844  INTEGER :: i
845   
846!$OMP MASTER
847  DO i=1,Nb
848    Buff(i)=Var(i)
849  ENDDO
850!$OMP END MASTER
851!$OMP BARRIER
852
853  DO i=1,Nb
854    Var(i)=Buff(i)
855  ENDDO
856!$OMP BARRIER       
857
858END SUBROUTINE bcast_omp_igen_inca
859
860
861SUBROUTINE bcast_omp_rgen_inca(Var,Nb,Buff)
862  IMPLICIT NONE
863   
864  REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
865  REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
866  INTEGER,INTENT(IN) :: Nb
867
868  INTEGER :: i
869   
870!$OMP MASTER
871  DO i=1,Nb
872    Buff(i)=Var(i)
873  ENDDO
874!$OMP END MASTER
875!$OMP BARRIER
876
877  DO i=1,Nb
878    Var(i)=Buff(i)
879  ENDDO
880!$OMP BARRIER       
881
882END SUBROUTINE bcast_omp_rgen_inca
883
884SUBROUTINE bcast_omp_lgen_inca(Var,Nb,Buff)
885  IMPLICIT NONE
886   
887  LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
888  LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
889  INTEGER,INTENT(IN) :: Nb
890
891  INTEGER :: i
892   
893!$OMP MASTER
894  DO i=1,Nb
895    Buff(i)=Var(i)
896  ENDDO
897!$OMP END MASTER
898!$OMP BARRIER
899
900  DO i=1,Nb
901    Var(i)=Buff(i)
902  ENDDO
903!$OMP BARRIER       
904
905END SUBROUTINE bcast_omp_lgen_inca
906
907SUBROUTINE scatter_omp_igen_inca(VarIn,VarOut,dimsize,Buff)
908  USE mod_inca_omp_data
909  USE mod_inca_mpi_data, ONLY : plon_mpi 
910  IMPLICIT NONE
911
912  INTEGER,INTENT(IN) :: dimsize
913  INTEGER,INTENT(IN),DIMENSION(plon_mpi,dimsize) :: VarIn
914  INTEGER,INTENT(OUT),DIMENSION(plon_omp,dimsize) :: VarOut
915  INTEGER,INTENT(INOUT),DIMENSION(plon_mpi,dimsize) :: Buff
916
917  INTEGER :: i,ij
918   
919!$OMP MASTER
920  DO i=1,dimsize
921    DO ij=1,plon_mpi
922      Buff(ij,i)=VarIn(ij,i)
923    ENDDO
924  ENDDO 
925!$OMP END MASTER
926!$OMP BARRIER
927
928  DO i=1,dimsize
929    DO ij=1,plon_omp
930      VarOut(ij,i)=Buff(plon_omp_begin-1+ij,i)
931    ENDDO
932  ENDDO
933!$OMP BARRIER 
934
935END SUBROUTINE scatter_omp_igen_inca
936
937SUBROUTINE scatter_omp_rgen_inca(VarIn,VarOut,dimsize,Buff)
938  USE mod_inca_omp_data
939  USE mod_inca_mpi_data, ONLY : plon_mpi 
940  IMPLICIT NONE
941
942  INTEGER,INTENT(IN) :: dimsize
943  REAL,INTENT(IN),DIMENSION(plon_mpi,dimsize) :: VarIn
944  REAL,INTENT(OUT),DIMENSION(plon_omp,dimsize) :: VarOut
945  REAL,INTENT(INOUT),DIMENSION(plon_mpi,dimsize) :: Buff
946
947  INTEGER :: i,ij
948   
949!$OMP MASTER
950  DO i=1,dimsize
951    DO ij=1,plon_mpi
952      Buff(ij,i)=VarIn(ij,i)
953    ENDDO
954  ENDDO 
955!$OMP END MASTER
956!$OMP BARRIER
957
958  DO i=1,dimsize
959    DO ij=1,plon_omp
960      VarOut(ij,i)=Buff(plon_omp_begin-1+ij,i)
961    ENDDO
962  ENDDO
963!$OMP BARRIER 
964
965END SUBROUTINE scatter_omp_rgen_inca
966
967SUBROUTINE scatter_omp_lgen_inca(VarIn,VarOut,dimsize,Buff)
968  USE mod_inca_omp_data
969  USE mod_inca_mpi_data, ONLY : plon_mpi 
970  IMPLICIT NONE
971
972  INTEGER,INTENT(IN) :: dimsize
973  LOGICAL,INTENT(IN),DIMENSION(plon_mpi,dimsize) :: VarIn
974  LOGICAL,INTENT(OUT),DIMENSION(plon_omp,dimsize) :: VarOut
975  LOGICAL,INTENT(INOUT),DIMENSION(plon_mpi,dimsize) :: Buff
976
977  INTEGER :: i,ij
978   
979!$OMP MASTER
980  DO i=1,dimsize
981    DO ij=1,plon_mpi
982      Buff(ij,i)=VarIn(ij,i)
983    ENDDO
984  ENDDO 
985!$OMP END MASTER
986!$OMP BARRIER
987
988  DO i=1,dimsize
989    DO ij=1,plon_omp
990      VarOut(ij,i)=Buff(plon_omp_begin-1+ij,i)
991    ENDDO
992  ENDDO
993!$OMP BARRIER 
994
995END SUBROUTINE scatter_omp_lgen_inca
996
997SUBROUTINE gather_omp_igen_inca(VarIn,VarOut,dimsize,Buff)
998  USE mod_inca_omp_data
999  USE mod_inca_mpi_data, ONLY : plon_mpi 
1000  IMPLICIT NONE
1001
1002  INTEGER,INTENT(IN) :: dimsize
1003  INTEGER,INTENT(IN),DIMENSION(plon_omp,dimsize) :: VarIn
1004  INTEGER,INTENT(OUT),DIMENSION(plon_mpi,dimsize) :: VarOut
1005  INTEGER,INTENT(INOUT),DIMENSION(plon_mpi,dimsize) :: Buff
1006
1007  INTEGER :: i,ij
1008   
1009  DO i=1,dimsize
1010    DO ij=1,plon_omp
1011      Buff(plon_omp_begin-1+ij,i)=VarIn(ij,i)
1012    ENDDO
1013  ENDDO
1014!$OMP BARRIER 
1015
1016
1017!$OMP MASTER
1018  DO i=1,dimsize
1019    DO ij=1,plon_mpi
1020      VarOut(ij,i)=Buff(ij,i)
1021    ENDDO
1022  ENDDO 
1023!$OMP END MASTER
1024!$OMP BARRIER
1025
1026END SUBROUTINE gather_omp_igen_inca
1027
1028SUBROUTINE gather_omp_rgen_inca(VarIn,VarOut,dimsize,Buff)
1029  USE mod_inca_omp_data
1030  USE mod_inca_mpi_data, ONLY : plon_mpi 
1031  IMPLICIT NONE
1032
1033  INTEGER,INTENT(IN) :: dimsize
1034  REAL,INTENT(IN),DIMENSION(plon_omp,dimsize) :: VarIn
1035  REAL,INTENT(OUT),DIMENSION(plon_mpi,dimsize) :: VarOut
1036  REAL,INTENT(INOUT),DIMENSION(plon_mpi,dimsize) :: Buff
1037
1038  INTEGER :: i,ij
1039   
1040  DO i=1,dimsize
1041    DO ij=1,plon_omp
1042      Buff(plon_omp_begin-1+ij,i)=VarIn(ij,i)
1043    ENDDO
1044  ENDDO
1045!$OMP BARRIER 
1046
1047
1048!$OMP MASTER
1049  DO i=1,dimsize
1050    DO ij=1,plon_mpi
1051      VarOut(ij,i)=Buff(ij,i)
1052    ENDDO
1053  ENDDO 
1054!$OMP END MASTER
1055!$OMP BARRIER
1056
1057END SUBROUTINE gather_omp_rgen_inca
1058
1059SUBROUTINE gather_omp_lgen_inca(VarIn,VarOut,dimsize,Buff)
1060  USE mod_inca_omp_data
1061  USE mod_inca_mpi_data, ONLY : plon_mpi 
1062  IMPLICIT NONE
1063
1064  INTEGER,INTENT(IN) :: dimsize
1065  LOGICAL,INTENT(IN),DIMENSION(plon_omp,dimsize) :: VarIn
1066  LOGICAL,INTENT(OUT),DIMENSION(plon_mpi,dimsize) :: VarOut
1067  LOGICAL,INTENT(INOUT),DIMENSION(plon_mpi,dimsize) :: Buff
1068
1069  INTEGER :: i,ij
1070   
1071  DO i=1,dimsize
1072    DO ij=1,plon_omp
1073      Buff(plon_omp_begin-1+ij,i)=VarIn(ij,i)
1074    ENDDO
1075  ENDDO
1076!$OMP BARRIER 
1077
1078
1079!$OMP MASTER
1080  DO i=1,dimsize
1081    DO ij=1,plon_mpi
1082      VarOut(ij,i)=Buff(ij,i)
1083    ENDDO
1084  ENDDO 
1085!$OMP END MASTER
1086!$OMP BARRIER
1087
1088END SUBROUTINE gather_omp_lgen_inca
1089
1090SUBROUTINE reduce_sum_omp_igen_inca(VarIn,VarOut,dimsize,Buff)
1091  IMPLICIT NONE
1092
1093  INTEGER,INTENT(IN) :: dimsize
1094  INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
1095  INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
1096  INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
1097
1098  INTEGER :: i
1099
1100!$OMP MASTER
1101  Buff(:)=0
1102!$OMP END MASTER
1103!$OMP BARRIER
1104
1105!$OMP CRITICAL     
1106  DO i=1,dimsize
1107    Buff(i)=Buff(i)+VarIn(i)
1108  ENDDO
1109!$OMP END CRITICAL
1110!$OMP BARRIER 
1111
1112!$OMP MASTER
1113  DO i=1,dimsize
1114    VarOut(i)=Buff(i)
1115  ENDDO
1116!$OMP END MASTER
1117!$OMP BARRIER
1118
1119END SUBROUTINE reduce_sum_omp_igen_inca
1120
1121SUBROUTINE reduce_sum_omp_rgen_inca(VarIn,VarOut,dimsize,Buff)
1122  IMPLICIT NONE
1123
1124  INTEGER,INTENT(IN) :: dimsize
1125  REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
1126  REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
1127  REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
1128
1129  INTEGER :: i
1130
1131!$OMP MASTER
1132  Buff(:)=0
1133!$OMP END MASTER
1134!$OMP BARRIER
1135
1136!$OMP CRITICAL     
1137  DO i=1,dimsize
1138    Buff(i)=Buff(i)+VarIn(i)
1139  ENDDO
1140!$OMP END CRITICAL
1141!$OMP BARRIER 
1142
1143!$OMP MASTER
1144  DO i=1,dimsize
1145    VarOut(i)=Buff(i)
1146  ENDDO
1147!$OMP END MASTER
1148!$OMP BARRIER
1149
1150END SUBROUTINE reduce_sum_omp_rgen_inca
1151
Note: See TracBrowser for help on using the repository browser.