source: trunk/LMDZ.GENERIC/libf/phy_common/mod_phys_lmdz_omp_transfert.F90 @ 1529

Last change on this file since 1529 was 1521, checked in by emillour, 9 years ago

All GCMs: Updates to make planetary codes (+Earth) setups converge.

  • Made a "phy_common" directory in libf, to contain routines common (wrt structural nature of underlying code/grid) to all LMDZ-related physics packages.
  • moved all "mod_phys_*" and "mod_grid_phy_lmdz" files from dynlonlat_phylonlat to "phy_common"
  • moved "ioipsl_getincom_p.F90 from "misc" to "phy_common" and modified it to match Earth GCM version and renamed it ioipsl_getin_p_mod.F90
  • added an "abort_physics" (as in Earth GCM) in "phy_common"
  • added a "print_control_mod.F90 (as in Earth GCM) in phy_common
  • made similar changes in LMDZ.GENERIC and LMDZ.MARS

EM
File size: 24.3 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=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, &
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!$OMP BARRIER
59!$OMP MASTER
60    IF (buff_size>size_i) THEN
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    ENDIF
65!$OMP END MASTER
66!$OMP BARRIER
67 
68  END SUBROUTINE check_buffer_i
69 
70  SUBROUTINE check_buffer_r(buff_size)
71  IMPLICIT NONE
72  INTEGER :: buff_size
73
74!$OMP BARRIER
75!$OMP MASTER
76    IF (buff_size>size_r) THEN
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    ENDIF
81!$OMP END MASTER
82!$OMP BARRIER
83 
84  END SUBROUTINE check_buffer_r
85 
86  SUBROUTINE check_buffer_l(buff_size)
87  IMPLICIT NONE
88  INTEGER :: buff_size
89
90!$OMP BARRIER
91!$OMP MASTER
92    IF (buff_size>size_l) THEN
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    ENDIF
97!$OMP END MASTER
98!$OMP BARRIER
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 Check_buffer_r(size(VarOut))       
525    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_r)
526   
527  END SUBROUTINE gather_omp_r3
528
529
530  SUBROUTINE gather_omp_l(VarIn, VarOut)
531    IMPLICIT NONE
532 
533    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
534    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
535
536    CALL Check_buffer_l(size(VarOut))   
537    CALL gather_omp_lgen(VarIn,Varout,1,buffer_l)
538   
539  END SUBROUTINE gather_omp_l
540
541
542  SUBROUTINE gather_omp_l1(VarIn, VarOut)
543    IMPLICIT NONE
544 
545    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
546    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
547   
548    CALL Check_buffer_l(size(VarOut))   
549    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2),buffer_l)
550   
551  END SUBROUTINE gather_omp_l1
552
553
554  SUBROUTINE gather_omp_l2(VarIn, VarOut)
555    IMPLICIT NONE
556 
557    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
558    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
559   
560    CALL Check_buffer_l(size(VarOut))   
561    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_l)
562   
563  END SUBROUTINE gather_omp_l2
564 
565
566  SUBROUTINE gather_omp_l3(VarIn, VarOut)
567    IMPLICIT NONE
568 
569    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
570    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
571   
572    CALL Check_buffer_l(size(VarOut))   
573    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_l)
574   
575  END SUBROUTINE gather_omp_l3
576
577
578
579
580  SUBROUTINE reduce_sum_omp_i(VarIn, VarOut)
581    IMPLICIT NONE
582 
583    INTEGER,INTENT(IN)  :: VarIn
584    INTEGER,INTENT(OUT) :: VarOut
585    INTEGER             :: VarIn_tmp(1)
586    INTEGER             :: VarOut_tmp(1)
587   
588    VarIn_tmp(1)=VarIn
589    CALL Check_buffer_i(1)   
590    CALL reduce_sum_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i)
591    VarOut=VarOut_tmp(1)
592   
593  END SUBROUTINE reduce_sum_omp_i
594
595  SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut)
596    IMPLICIT NONE
597 
598    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
599    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
600   
601    CALL Check_buffer_i(size(VarIn))   
602    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
603   
604  END SUBROUTINE reduce_sum_omp_i1
605 
606 
607  SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut)
608    IMPLICIT NONE
609 
610    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
611    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
612
613    CALL Check_buffer_i(size(VarIn))   
614    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
615 
616  END SUBROUTINE reduce_sum_omp_i2
617
618
619  SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut)
620    IMPLICIT NONE
621 
622    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
623    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
624   
625    CALL Check_buffer_i(size(VarIn))   
626    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
627 
628  END SUBROUTINE reduce_sum_omp_i3
629
630
631  SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut)
632    IMPLICIT NONE
633
634    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
635    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
636 
637    CALL Check_buffer_i(size(VarIn))   
638    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
639 
640  END SUBROUTINE reduce_sum_omp_i4
641
642
643  SUBROUTINE reduce_sum_omp_r(VarIn, VarOut)
644    IMPLICIT NONE
645 
646    REAL,INTENT(IN)  :: VarIn
647    REAL,INTENT(OUT) :: VarOut
648    REAL             :: VarIn_tmp(1)
649    REAL             :: VarOut_tmp(1)
650   
651    VarIn_tmp(1)=VarIn
652    CALL Check_buffer_r(1)   
653    CALL reduce_sum_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r)
654    VarOut=VarOut_tmp(1)
655 
656  END SUBROUTINE reduce_sum_omp_r
657
658  SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut)
659    IMPLICIT NONE
660 
661    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
662    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
663   
664    CALL Check_buffer_r(size(VarIn))   
665    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
666   
667  END SUBROUTINE reduce_sum_omp_r1
668 
669 
670  SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut)
671    IMPLICIT NONE
672 
673    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
674    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
675   
676    CALL Check_buffer_r(size(VarIn))   
677    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
678 
679  END SUBROUTINE reduce_sum_omp_r2
680
681
682  SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut)
683    IMPLICIT NONE
684 
685    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
686    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
687   
688    CALL Check_buffer_r(size(VarIn))   
689    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
690 
691  END SUBROUTINE reduce_sum_omp_r3
692
693
694  SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut)
695    IMPLICIT NONE
696
697    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
698    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
699 
700    CALL Check_buffer_r(size(VarIn))   
701    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
702 
703  END SUBROUTINE reduce_sum_omp_r4
704
705!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
706!    LES ROUTINES GENERIQUES    !
707!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
708
709  SUBROUTINE bcast_omp_cgen(Var,Nb,Buff)
710  IMPLICIT NONE
711   
712    CHARACTER(LEN=*),INTENT(INOUT) :: Var
713    CHARACTER(LEN=*),INTENT(INOUT) :: Buff
714    INTEGER,INTENT(IN) :: Nb
715   
716    INTEGER :: i
717 
718  !$OMP MASTER
719      Buff=Var
720  !$OMP END MASTER
721  !$OMP BARRIER
722
723    DO i=1,Nb
724      Var=Buff
725    ENDDO
726  !$OMP BARRIER     
727 
728  END SUBROUTINE bcast_omp_cgen
729
730
731     
732  SUBROUTINE bcast_omp_igen(Var,Nb,Buff)
733  IMPLICIT NONE
734   
735    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
736    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
737    INTEGER,INTENT(IN) :: Nb
738
739    INTEGER :: i
740   
741  !$OMP MASTER
742    DO i=1,Nb
743      Buff(i)=Var(i)
744    ENDDO
745  !$OMP END MASTER
746  !$OMP BARRIER
747
748    DO i=1,Nb
749      Var(i)=Buff(i)
750    ENDDO
751  !$OMP BARRIER       
752
753  END SUBROUTINE bcast_omp_igen
754
755
756  SUBROUTINE bcast_omp_rgen(Var,Nb,Buff)
757  IMPLICIT NONE
758   
759    REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
760    REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
761    INTEGER,INTENT(IN) :: Nb
762
763    INTEGER :: i
764   
765  !$OMP MASTER
766    DO i=1,Nb
767      Buff(i)=Var(i)
768    ENDDO
769  !$OMP END MASTER
770  !$OMP BARRIER
771
772    DO i=1,Nb
773      Var(i)=Buff(i)
774    ENDDO
775  !$OMP BARRIER       
776
777  END SUBROUTINE bcast_omp_rgen
778
779  SUBROUTINE bcast_omp_lgen(Var,Nb,Buff)
780  IMPLICIT NONE
781   
782    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
783    LOGICAL,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
800  END SUBROUTINE bcast_omp_lgen
801
802
803  SUBROUTINE scatter_omp_igen(VarIn,VarOut,dimsize,Buff)
804    USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
805    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
806    IMPLICIT NONE
807
808    INTEGER,INTENT(IN) :: dimsize
809    INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
810    INTEGER,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
811    INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
812
813    INTEGER :: i,ij
814   
815  !$OMP MASTER
816    DO i=1,dimsize
817      DO ij=1,klon_mpi
818        Buff(ij,i)=VarIn(ij,i)
819      ENDDO
820    ENDDO 
821  !$OMP END MASTER
822  !$OMP BARRIER
823 
824    DO i=1,dimsize
825      DO ij=1,klon_omp
826        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
827      ENDDO
828    ENDDO
829  !$OMP BARRIER 
830 
831  END SUBROUTINE scatter_omp_igen
832
833
834  SUBROUTINE scatter_omp_rgen(VarIn,VarOut,dimsize,Buff)
835  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
836  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
837  IMPLICIT NONE
838
839    INTEGER,INTENT(IN) :: dimsize
840    REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
841    REAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
842    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
843
844    INTEGER :: i,ij
845   
846  !$OMP MASTER
847    DO i=1,dimsize
848      DO ij=1,klon_mpi
849        Buff(ij,i)=VarIn(ij,i)
850      ENDDO
851    ENDDO 
852  !$OMP END MASTER
853  !$OMP BARRIER
854
855    DO i=1,dimsize
856      DO ij=1,klon_omp
857        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
858      ENDDO
859    ENDDO
860  !$OMP BARRIER 
861
862  END SUBROUTINE scatter_omp_rgen
863
864
865  SUBROUTINE scatter_omp_lgen(VarIn,VarOut,dimsize,Buff)
866  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
867  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
868  IMPLICIT NONE
869
870    INTEGER,INTENT(IN) :: dimsize
871    LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
872    LOGICAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
873    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
874
875    INTEGER :: i,ij
876   
877 !$OMP MASTER
878    DO i=1,dimsize
879      DO ij=1,klon_mpi
880        Buff(ij,i)=VarIn(ij,i)
881      ENDDO
882    ENDDO 
883  !$OMP END MASTER
884  !$OMP BARRIER
885
886    DO i=1,dimsize
887      DO ij=1,klon_omp
888        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
889      ENDDO
890    ENDDO
891  !$OMP BARRIER 
892
893  END SUBROUTINE scatter_omp_lgen
894
895
896
897
898
899  SUBROUTINE gather_omp_igen(VarIn,VarOut,dimsize,Buff)
900  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
901  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
902  IMPLICIT NONE
903
904    INTEGER,INTENT(IN) :: dimsize
905    INTEGER,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
906    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
907    INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
908
909    INTEGER :: i,ij
910   
911    DO i=1,dimsize
912      DO ij=1,klon_omp
913        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
914      ENDDO
915    ENDDO
916  !$OMP BARRIER 
917 
918 
919  !$OMP MASTER
920    DO i=1,dimsize
921      DO ij=1,klon_mpi
922        VarOut(ij,i)=Buff(ij,i)
923      ENDDO
924    ENDDO 
925  !$OMP END MASTER
926  !$OMP BARRIER
927
928  END SUBROUTINE gather_omp_igen
929
930
931  SUBROUTINE gather_omp_rgen(VarIn,VarOut,dimsize,Buff)
932  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
933  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
934  IMPLICIT NONE
935
936    INTEGER,INTENT(IN) :: dimsize
937    REAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
938    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
939    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
940
941    INTEGER :: i,ij
942   
943    DO i=1,dimsize
944      DO ij=1,klon_omp
945        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
946      ENDDO
947    ENDDO
948  !$OMP BARRIER 
949
950
951  !$OMP MASTER
952    DO i=1,dimsize
953      DO ij=1,klon_mpi
954        VarOut(ij,i)=Buff(ij,i)
955      ENDDO
956    ENDDO 
957  !$OMP END MASTER
958  !$OMP BARRIER
959
960  END SUBROUTINE gather_omp_rgen
961
962
963  SUBROUTINE gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
964  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
965  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
966  IMPLICIT NONE
967
968    INTEGER,INTENT(IN) :: dimsize
969    LOGICAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
970    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
971    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
972
973    INTEGER :: i,ij
974   
975    DO i=1,dimsize
976      DO ij=1,klon_omp
977        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
978      ENDDO
979    ENDDO
980  !$OMP BARRIER 
981
982
983  !$OMP MASTER
984    DO i=1,dimsize
985      DO ij=1,klon_mpi
986        VarOut(ij,i)=Buff(ij,i)
987      ENDDO
988    ENDDO 
989  !$OMP END MASTER
990  !$OMP BARRIER
991
992  END SUBROUTINE gather_omp_lgen
993
994
995  SUBROUTINE reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
996  IMPLICIT NONE
997
998    INTEGER,INTENT(IN) :: dimsize
999    INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
1000    INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
1001    INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
1002
1003    INTEGER :: i
1004
1005  !$OMP MASTER
1006    Buff(:)=0
1007  !$OMP END MASTER
1008  !$OMP BARRIER
1009 
1010  !$OMP CRITICAL     
1011    DO i=1,dimsize
1012      Buff(i)=Buff(i)+VarIn(i)
1013    ENDDO
1014  !$OMP END CRITICAL
1015  !$OMP BARRIER 
1016 
1017  !$OMP MASTER
1018    DO i=1,dimsize
1019      VarOut(i)=Buff(i)
1020    ENDDO
1021  !$OMP END MASTER
1022  !$OMP BARRIER
1023 
1024  END SUBROUTINE reduce_sum_omp_igen
1025
1026  SUBROUTINE reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
1027  IMPLICIT NONE
1028
1029    INTEGER,INTENT(IN) :: dimsize
1030    REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
1031    REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
1032    REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
1033
1034    INTEGER :: i
1035
1036  !$OMP MASTER
1037    Buff(:)=0
1038  !$OMP END MASTER
1039  !$OMP BARRIER
1040 
1041  !$OMP CRITICAL     
1042    DO i=1,dimsize
1043      Buff(i)=Buff(i)+VarIn(i)
1044    ENDDO
1045  !$OMP END CRITICAL
1046  !$OMP BARRIER 
1047 
1048  !$OMP MASTER
1049    DO i=1,dimsize
1050      VarOut(i)=Buff(i)
1051    ENDDO
1052  !$OMP END MASTER
1053  !$OMP BARRIER
1054 
1055  END SUBROUTINE reduce_sum_omp_rgen
1056
1057END MODULE mod_phys_lmdz_omp_transfert
Note: See TracBrowser for help on using the repository browser.