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

Last change on this file since 3442 was 3288, checked in by emillour, 20 months ago

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