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

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

trunk : Fixed compilation with --std=f2008 with gfortran

Added dynamico_abort() to replace non standard ABORT() intrinsic
Other modifications to respect the fortran standard
File size: 26.2 KB
Line 
1MODULE transfert_omp_mod
2  PRIVATE
3 
4  REAL,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   
807    CHARACTER(LEN=*),INTENT(INOUT) :: Var
808    CHARACTER(LEN=*),INTENT(INOUT) :: Buff
809    INTEGER,INTENT(IN) :: Nb
810   
811    INTEGER :: i
812 
813  !$OMP MASTER
814      Buff=Var
815  !$OMP END MASTER
816  !$OMP BARRIER
817
818    DO i=1,Nb
819      Var=Buff
820    ENDDO
821  !$OMP BARRIER     
822 
823  END SUBROUTINE bcast_omp_cgen
824
825
826     
827  SUBROUTINE bcast_omp_igen(Var,Nb,Buff)
828  IMPLICIT NONE
829    INTEGER,INTENT(IN) :: Nb
830    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
831    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff 
832
833    INTEGER :: i
834   
835  !$OMP MASTER
836    DO i=1,Nb
837      Buff(i)=Var(i)
838    ENDDO
839  !$OMP END MASTER
840  !$OMP BARRIER
841
842    DO i=1,Nb
843      Var(i)=Buff(i)
844    ENDDO
845  !$OMP BARRIER       
846
847  END SUBROUTINE bcast_omp_igen
848
849
850  SUBROUTINE bcast_omp_rgen(Var,Nb,Buff)
851  IMPLICIT NONE
852    INTEGER,INTENT(IN) :: Nb
853    REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
854    REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff 
855
856    INTEGER :: i
857   
858  !$OMP MASTER
859    DO i=1,Nb
860      Buff(i)=Var(i)
861    ENDDO
862  !$OMP END MASTER
863  !$OMP BARRIER
864
865    DO i=1,Nb
866      Var(i)=Buff(i)
867    ENDDO
868  !$OMP BARRIER       
869
870  END SUBROUTINE bcast_omp_rgen
871
872  SUBROUTINE bcast_omp_lgen(Var,Nb,Buff)
873  IMPLICIT NONE
874    INTEGER,INTENT(IN) :: Nb
875    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
876    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
877
878    INTEGER :: i
879   
880  !$OMP MASTER
881    DO i=1,Nb
882      Buff(i)=Var(i)
883    ENDDO
884  !$OMP END MASTER
885  !$OMP BARRIER
886
887    DO i=1,Nb
888      Var(i)=Buff(i)
889    ENDDO
890  !$OMP BARRIER       
891
892  END SUBROUTINE bcast_omp_lgen
893 
894
895  SUBROUTINE reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
896  IMPLICIT NONE
897
898    INTEGER,INTENT(IN) :: dimsize
899    INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
900    INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
901    INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
902
903    INTEGER :: i
904
905  !$OMP MASTER
906    Buff(:)=0
907  !$OMP END MASTER
908  !$OMP BARRIER
909 
910  !$OMP CRITICAL     
911    DO i=1,dimsize
912      Buff(i)=Buff(i)+VarIn(i)
913    ENDDO
914  !$OMP END CRITICAL
915  !$OMP BARRIER 
916 
917  !$OMP MASTER
918    DO i=1,dimsize
919      VarOut(i)=Buff(i)
920    ENDDO
921  !$OMP END MASTER
922  !$OMP BARRIER
923 
924  END SUBROUTINE reduce_sum_omp_igen
925
926  SUBROUTINE reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
927  IMPLICIT NONE
928
929    INTEGER,INTENT(IN) :: dimsize
930    REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
931    REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
932    REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
933
934    INTEGER :: i
935
936  !$OMP MASTER
937    Buff(:)=0
938  !$OMP END MASTER
939  !$OMP BARRIER
940 
941  !$OMP CRITICAL     
942    DO i=1,dimsize
943      Buff(i)=Buff(i)+VarIn(i)
944    ENDDO
945  !$OMP END CRITICAL
946  !$OMP BARRIER 
947 
948    DO i=1,dimsize
949      VarOut(i)=Buff(i)
950    ENDDO
951  !$OMP BARRIER
952 
953  END SUBROUTINE reduce_sum_omp_rgen
954
955
956
957  SUBROUTINE allreduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
958  IMPLICIT NONE
959
960    INTEGER,INTENT(IN) :: dimsize
961    INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
962    INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
963    INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
964
965    INTEGER :: i
966
967  !$OMP MASTER
968    Buff(:)=0
969  !$OMP END MASTER
970  !$OMP BARRIER
971 
972  !$OMP CRITICAL     
973    DO i=1,dimsize
974      Buff(i)=Buff(i)+VarIn(i)
975    ENDDO
976  !$OMP END CRITICAL
977  !$OMP BARRIER 
978 
979    DO i=1,dimsize
980      VarOut(i)=Buff(i)
981    ENDDO
982  !$OMP BARRIER
983 
984  END SUBROUTINE allreduce_sum_omp_igen
985
986  SUBROUTINE allreduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
987  IMPLICIT NONE
988
989    INTEGER,INTENT(IN) :: dimsize
990    REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
991    REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
992    REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
993
994    INTEGER :: i
995
996  !$OMP MASTER
997    Buff(:)=0
998  !$OMP END MASTER
999  !$OMP BARRIER
1000 
1001  !$OMP CRITICAL     
1002    DO i=1,dimsize
1003      Buff(i)=Buff(i)+VarIn(i)
1004    ENDDO
1005  !$OMP END CRITICAL
1006  !$OMP BARRIER 
1007 
1008    DO i=1,dimsize
1009      VarOut(i)=Buff(i)
1010    ENDDO
1011
1012  !$OMP BARRIER
1013 
1014  END SUBROUTINE allreduce_sum_omp_rgen
1015
1016
1017
1018
1019
1020
1021  SUBROUTINE reduce_max_omp_igen(VarIn,VarOut,dimsize,Buff)
1022  IMPLICIT NONE
1023
1024    INTEGER,INTENT(IN) :: dimsize
1025    INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
1026    INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
1027    INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
1028
1029    INTEGER :: i
1030
1031  !$OMP MASTER
1032    Buff(:)=VarIn(1)
1033  !$OMP END MASTER
1034  !$OMP BARRIER
1035 
1036  !$OMP CRITICAL     
1037    DO i=1,dimsize
1038      Buff(i)=MAX(Buff(i),VarIn(i))
1039    ENDDO
1040  !$OMP END CRITICAL
1041  !$OMP BARRIER 
1042 
1043  !$OMP MASTER
1044    DO i=1,dimsize
1045      VarOut(i)=Buff(i)
1046    ENDDO
1047  !$OMP END MASTER
1048  !$OMP BARRIER
1049 
1050  END SUBROUTINE reduce_max_omp_igen
1051
1052  SUBROUTINE reduce_max_omp_rgen(VarIn,VarOut,dimsize,Buff)
1053  IMPLICIT NONE
1054
1055    INTEGER,INTENT(IN) :: dimsize
1056    REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
1057    REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
1058    REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
1059
1060    INTEGER :: i
1061
1062  !$OMP MASTER
1063    Buff(:)=VarIn(1)
1064  !$OMP END MASTER
1065  !$OMP BARRIER
1066 
1067  !$OMP CRITICAL     
1068    DO i=1,dimsize
1069      Buff(i)=MAX(Buff(i),VarIn(i))
1070    ENDDO
1071  !$OMP END CRITICAL
1072  !$OMP BARRIER 
1073 
1074    DO i=1,dimsize
1075      VarOut(i)=Buff(i)
1076    ENDDO
1077  !$OMP BARRIER
1078 
1079  END SUBROUTINE reduce_max_omp_rgen
1080
1081
1082
1083  SUBROUTINE allreduce_max_omp_igen(VarIn,VarOut,dimsize,Buff)
1084  IMPLICIT NONE
1085
1086    INTEGER,INTENT(IN) :: dimsize
1087    INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
1088    INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
1089    INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
1090
1091    INTEGER :: i
1092
1093  !$OMP MASTER
1094    Buff(:)=VarIn(1)
1095  !$OMP END MASTER
1096  !$OMP BARRIER
1097 
1098  !$OMP CRITICAL     
1099    DO i=1,dimsize
1100      Buff(i)=MAX(Buff(i),VarIn(i))
1101    ENDDO
1102  !$OMP END CRITICAL
1103  !$OMP BARRIER 
1104 
1105    DO i=1,dimsize
1106      VarOut(i)=Buff(i)
1107    ENDDO
1108  !$OMP BARRIER
1109 
1110  END SUBROUTINE allreduce_max_omp_igen
1111
1112  SUBROUTINE allreduce_max_omp_rgen(VarIn,VarOut,dimsize,Buff)
1113  IMPLICIT NONE
1114
1115    INTEGER,INTENT(IN) :: dimsize
1116    REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
1117    REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
1118    REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
1119
1120    INTEGER :: i
1121
1122  !$OMP MASTER
1123    Buff(:)=VarIn(1)
1124  !$OMP END MASTER
1125  !$OMP BARRIER
1126 
1127  !$OMP CRITICAL     
1128    DO i=1,dimsize
1129      Buff(i)=MAX(Buff(i),VarIn(i))
1130    ENDDO
1131  !$OMP END CRITICAL
1132  !$OMP BARRIER 
1133 
1134    DO i=1,dimsize
1135      VarOut(i)=Buff(i)
1136    ENDDO
1137
1138  !$OMP BARRIER
1139 
1140  END SUBROUTINE allreduce_max_omp_rgen
1141   
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152   
1153END MODULE transfert_omp_mod
Note: See TracBrowser for help on using the repository browser.