source: LMDZ4/branches/LMDZ4-dev/libf/phylmd/mod_phys_lmdz_omp_transfert.F90 @ 1142

Last change on this file since 1142 was 1001, checked in by Laurent Fairhead, 16 years ago
  • Modifs sur le parallelisme: masquage dans la physique
  • Inclusion strato
  • mise en coherence etat0
  • le mode offline fonctionne maintenant en parallele,
  • les fichiers de la dynamiques sont correctement sortis et peuvent etre reconstruit avec rebuild
  • la version parallele de la dynamique peut s'executer sans MPI (sur 1 proc)
  • L'OPENMP fonctionne maintenant sans la parallelisation MPI.

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