source: trunk/LMDZ.COMMON/libf/phy_common/mod_phys_lmdz_omp_transfert.F90 @ 3832

Last change on this file since 3832 was 3832, checked in by emillour, 4 days ago

Common physics routines:
Somewhat related to r3829 about improving OpenMP:
Introduce a "fix" in buffer allocation for logicals in OpenMP
Tests in debug show that if the task is done by the MASTER
sometimes the buffer is not allocated (yet) but used by threads
whereas things go more smoothly if the task is done via SINGLE.
Maybe just a compiler (or debugger) bug?
EM

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