source: LMDZ4/branches/LMDZ4-dev/libf/phytherm/mod_phys_lmdz_omp_transfert.F90 @ 1085

Last change on this file since 1085 was 814, checked in by Laurent Fairhead, 17 years ago

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