source: codes/icosagcm/devel/src/parallel/transfert_omp.f90

Last change on this file was 1026, checked in by dubos, 4 years ago

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