source: LMDZ5/trunk/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90 @ 2306

Last change on this file since 2306 was 2239, checked in by Ehouarn Millour, 10 years ago

Reorganizing physics/dynamics interface:

  • what is related to dynamics-physics interface is now in a seperate directory: dynlmdz_phy* for physics in phy*
  • 1d model and related dependencies (including a couple from "dynamics", set up as symbolic links) is now in subdirectory "dyn1d" of phy*.
  • "bibio" directory is now "misc" and should only contain autonomous utilities.
  • "cosp" is now a subdirectory of phylmd.

EM

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 47.7 KB
Line 
1!
2!$Header$
3!
4MODULE mod_phys_lmdz_mpi_transfert
5
6
7  INTERFACE bcast_mpi
8    MODULE PROCEDURE bcast_mpi_c,                                                     &
9                     bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
10                     bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
11                     bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
12  END INTERFACE
13
14  INTERFACE scatter_mpi
15    MODULE PROCEDURE scatter_mpi_i,scatter_mpi_i1,scatter_mpi_i2,scatter_mpi_i3, &
16                     scatter_mpi_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3, &
17                     scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3
18  END INTERFACE
19
20 
21  INTERFACE gather_mpi
22    MODULE PROCEDURE gather_mpi_i,gather_mpi_i1,gather_mpi_i2,gather_mpi_i3, &
23                     gather_mpi_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3, &
24                     gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3 
25  END INTERFACE
26 
27  INTERFACE scatter2D_mpi
28    MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, &
29                     scatter2D_mpi_r,scatter2D_mpi_r1,scatter2D_mpi_r2,scatter2D_mpi_r3, &
30                     scatter2D_mpi_l,scatter2D_mpi_l1,scatter2D_mpi_l2,scatter2D_mpi_l3
31  END INTERFACE
32
33  INTERFACE gather2D_mpi
34    MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, &
35                     gather2D_mpi_r,gather2D_mpi_r1,gather2D_mpi_r2,gather2D_mpi_r3, &
36                     gather2D_mpi_l,gather2D_mpi_l1,gather2D_mpi_l2,gather2D_mpi_l3
37  END INTERFACE
38 
39  INTERFACE reduce_sum_mpi
40    MODULE PROCEDURE reduce_sum_mpi_i,reduce_sum_mpi_i1,reduce_sum_mpi_i2,reduce_sum_mpi_i3,reduce_sum_mpi_i4, &
41                     reduce_sum_mpi_r,reduce_sum_mpi_r1,reduce_sum_mpi_r2,reduce_sum_mpi_r3,reduce_sum_mpi_r4
42  END INTERFACE
43
44 INTERFACE grid1dTo2d_mpi
45    MODULE PROCEDURE grid1dTo2d_mpi_i,grid1dTo2d_mpi_i1,grid1dTo2d_mpi_i2,grid1dTo2d_mpi_i3, &
46                     grid1dTo2d_mpi_r,grid1dTo2d_mpi_r1,grid1dTo2d_mpi_r2,grid1dTo2d_mpi_r3, &
47                     grid1dTo2d_mpi_l,grid1dTo2d_mpi_l1,grid1dTo2d_mpi_l2,grid1dTo2d_mpi_l3
48 END INTERFACE
49
50 INTERFACE grid2dTo1d_mpi
51    MODULE PROCEDURE grid2dTo1d_mpi_i,grid2dTo1d_mpi_i1,grid2dTo1d_mpi_i2,grid2dTo1d_mpi_i3, &
52                     grid2dTo1d_mpi_r,grid2dTo1d_mpi_r1,grid2dTo1d_mpi_r2,grid2dTo1d_mpi_r3, &
53                     grid2dTo1d_mpi_l,grid2dTo1d_mpi_l1,grid2dTo1d_mpi_l2,grid2dTo1d_mpi_l3
54 END INTERFACE
55   
56CONTAINS
57
58!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
59!! Definition des Broadcast --> 4D   !!
60!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
61
62!! -- Les chaine de charactère -- !!
63
64  SUBROUTINE bcast_mpi_c(var1)
65  IMPLICIT NONE
66    CHARACTER(LEN=*),INTENT(INOUT) :: Var1
67   
68    CALL bcast_mpi_cgen(Var1,len(Var1))
69
70  END SUBROUTINE bcast_mpi_c
71
72!! -- Les entiers -- !!
73 
74  SUBROUTINE bcast_mpi_i(var)
75  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
76  IMPLICIT NONE
77    INTEGER,INTENT(INOUT) :: Var
78   
79    INTEGER               :: var_tmp(1)
80   
81    IF (is_mpi_root) var_tmp(1)=var
82    CALL bcast_mpi_igen(Var_tmp,1)
83    var=var_tmp(1)
84   
85  END SUBROUTINE bcast_mpi_i
86
87  SUBROUTINE bcast_mpi_i1(var)
88  IMPLICIT NONE
89    INTEGER,INTENT(INOUT) :: Var(:)
90
91    CALL bcast_mpi_igen(Var,size(Var))
92   
93  END SUBROUTINE bcast_mpi_i1
94
95  SUBROUTINE bcast_mpi_i2(var)
96  IMPLICIT NONE
97    INTEGER,INTENT(INOUT) :: Var(:,:)
98   
99    CALL bcast_mpi_igen(Var,size(Var))
100 
101  END SUBROUTINE bcast_mpi_i2
102
103  SUBROUTINE bcast_mpi_i3(var)
104  IMPLICIT NONE
105    INTEGER,INTENT(INOUT) :: Var(:,:,:)
106   
107    CALL bcast_mpi_igen(Var,size(Var))
108
109  END SUBROUTINE bcast_mpi_i3
110
111  SUBROUTINE bcast_mpi_i4(var)
112  IMPLICIT NONE
113    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
114   
115    CALL bcast_mpi_igen(Var,size(Var))
116
117  END SUBROUTINE bcast_mpi_i4
118
119
120!! -- Les reels -- !!
121
122  SUBROUTINE bcast_mpi_r(var)
123  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
124  IMPLICIT NONE
125    REAL,INTENT(INOUT) :: Var
126    REAL               :: var_tmp(1)
127   
128    IF (is_mpi_root) var_tmp(1)=var
129    CALL bcast_mpi_rgen(Var_tmp,1)
130    var=var_tmp(1)   
131
132  END SUBROUTINE bcast_mpi_r
133
134  SUBROUTINE bcast_mpi_r1(var)
135  IMPLICIT NONE
136    REAL,INTENT(INOUT) :: Var(:)
137   
138    CALL bcast_mpi_rgen(Var,size(Var))
139
140  END SUBROUTINE bcast_mpi_r1
141
142  SUBROUTINE bcast_mpi_r2(var)
143  IMPLICIT NONE
144    REAL,INTENT(INOUT) :: Var(:,:)
145   
146    CALL bcast_mpi_rgen(Var,size(Var))
147
148  END SUBROUTINE bcast_mpi_r2
149
150  SUBROUTINE bcast_mpi_r3(var)
151  IMPLICIT NONE
152    REAL,INTENT(INOUT) :: Var(:,:,:)
153   
154    CALL bcast_mpi_rgen(Var,size(Var))
155
156  END SUBROUTINE bcast_mpi_r3
157
158  SUBROUTINE bcast_mpi_r4(var)
159  IMPLICIT NONE
160    REAL,INTENT(INOUT) :: Var(:,:,:,:)
161   
162    CALL bcast_mpi_rgen(Var,size(Var))
163
164  END SUBROUTINE bcast_mpi_r4
165 
166!! -- Les booleans -- !!
167
168  SUBROUTINE bcast_mpi_l(var)
169  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
170  IMPLICIT NONE
171    LOGICAL,INTENT(INOUT) :: Var
172    LOGICAL               :: var_tmp(1)
173   
174    IF (is_mpi_root) var_tmp(1)=var
175    CALL bcast_mpi_lgen(Var_tmp,1)
176    var=var_tmp(1)   
177
178  END SUBROUTINE bcast_mpi_l
179
180  SUBROUTINE bcast_mpi_l1(var)
181  IMPLICIT NONE
182    LOGICAL,INTENT(INOUT) :: Var(:)
183   
184    CALL bcast_mpi_lgen(Var,size(Var))
185
186  END SUBROUTINE bcast_mpi_l1
187
188  SUBROUTINE bcast_mpi_l2(var)
189  IMPLICIT NONE
190    LOGICAL,INTENT(INOUT) :: Var(:,:)
191   
192    CALL bcast_mpi_lgen(Var,size(Var))
193
194  END SUBROUTINE bcast_mpi_l2
195
196  SUBROUTINE bcast_mpi_l3(var)
197  IMPLICIT NONE
198    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
199   
200    CALL bcast_mpi_lgen(Var,size(Var))
201
202  END SUBROUTINE bcast_mpi_l3
203
204  SUBROUTINE bcast_mpi_l4(var)
205  IMPLICIT NONE
206    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
207   
208    CALL bcast_mpi_lgen(Var,size(Var))
209
210  END SUBROUTINE bcast_mpi_l4
211 
212!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
213!! Definition des Scatter   --> 4D   !!
214!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
215
216  SUBROUTINE scatter_mpi_i(VarIn, VarOut)
217    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
218    IMPLICIT NONE
219 
220    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
221    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
222
223    CALL scatter_mpi_igen(VarIn,Varout,1)
224   
225  END SUBROUTINE scatter_mpi_i
226
227  SUBROUTINE scatter_mpi_i1(VarIn, VarOut)
228    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
229    IMPLICIT NONE
230 
231    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
232    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
233   
234    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2))
235   
236  END SUBROUTINE scatter_mpi_i1
237 
238  SUBROUTINE scatter_mpi_i2(VarIn, VarOut)
239    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
240    IMPLICIT NONE
241 
242    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
243    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
244   
245    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
246
247  END SUBROUTINE scatter_mpi_i2
248
249  SUBROUTINE scatter_mpi_i3(VarIn, VarOut)
250    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
251    IMPLICIT NONE
252 
253    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
254    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
255   
256    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
257 
258  END SUBROUTINE scatter_mpi_i3
259
260
261  SUBROUTINE scatter_mpi_r(VarIn, VarOut)
262    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
263    IMPLICIT NONE
264 
265    REAL,INTENT(IN),DIMENSION(:) :: VarIn
266    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
267   
268      CALL scatter_mpi_rgen(VarIn,Varout,1)
269 
270  END SUBROUTINE scatter_mpi_r
271
272  SUBROUTINE scatter_mpi_r1(VarIn, VarOut)
273  USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
274  IMPLICIT NONE
275 
276    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
277    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
278   
279      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2))
280 
281  END SUBROUTINE scatter_mpi_r1
282 
283  SUBROUTINE scatter_mpi_r2(VarIn, VarOut)
284    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
285    IMPLICIT NONE
286 
287    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
288    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
289   
290      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
291 
292  END SUBROUTINE scatter_mpi_r2
293
294  SUBROUTINE scatter_mpi_r3(VarIn, VarOut)
295    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
296    IMPLICIT NONE
297 
298    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
299    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
300   
301      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
302 
303  END SUBROUTINE scatter_mpi_r3
304
305
306  SUBROUTINE scatter_mpi_l(VarIn, VarOut)
307    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
308    IMPLICIT NONE
309 
310    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
311    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
312   
313      CALL scatter_mpi_lgen(VarIn,Varout,1)
314   
315  END SUBROUTINE scatter_mpi_l
316
317  SUBROUTINE scatter_mpi_l1(VarIn, VarOut)
318    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
319    IMPLICIT NONE
320 
321    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
322    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
323   
324      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2))
325 
326  END SUBROUTINE scatter_mpi_l1
327 
328  SUBROUTINE scatter_mpi_l2(VarIn, VarOut)
329    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
330    IMPLICIT NONE
331 
332    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
333    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
334   
335      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
336 
337  END SUBROUTINE scatter_mpi_l2
338
339  SUBROUTINE scatter_mpi_l3(VarIn, VarOut)
340    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
341    IMPLICIT NONE
342 
343    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
344    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
345   
346      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
347 
348  END SUBROUTINE scatter_mpi_l3 
349
350!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
351!! Definition des Gather   --> 4D   !!
352!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
353 
354!!!!! --> Les entiers
355
356  SUBROUTINE gather_mpi_i(VarIn, VarOut)
357    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
358    IMPLICIT NONE
359 
360    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
361    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
362   
363      CALL gather_mpi_igen(VarIn,VarOut,1)
364 
365  END SUBROUTINE gather_mpi_i
366 
367
368!!!!!
369
370  SUBROUTINE gather_mpi_i1(VarIn, VarOut)
371    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
372    IMPLICIT NONE
373 
374    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
375    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
376   
377      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2))
378 
379  END SUBROUTINE gather_mpi_i1
380
381!!!!!
382 
383  SUBROUTINE gather_mpi_i2(VarIn, VarOut)
384    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
385    IMPLICIT NONE
386 
387    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
388    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
389   
390      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
391 
392  END SUBROUTINE gather_mpi_i2
393
394!!!!!
395
396  SUBROUTINE gather_mpi_i3(VarIn, VarOut)
397    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
398    IMPLICIT NONE
399 
400    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
401    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
402   
403      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
404 
405  END SUBROUTINE gather_mpi_i3
406
407!!!!! --> Les reels
408
409  SUBROUTINE gather_mpi_r(VarIn, VarOut)
410    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
411    IMPLICIT NONE
412 
413    REAL,INTENT(IN),DIMENSION(:) :: VarIn
414    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
415   
416      CALL gather_mpi_rgen(VarIn,VarOut,1)
417 
418  END SUBROUTINE gather_mpi_r
419
420!!!!!
421
422  SUBROUTINE gather_mpi_r1(VarIn, VarOut)
423    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
424    IMPLICIT NONE
425 
426    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
427    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
428   
429      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2))
430 
431  END SUBROUTINE gather_mpi_r1
432
433!!!!!
434 
435  SUBROUTINE gather_mpi_r2(VarIn, VarOut)
436    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
437    IMPLICIT NONE
438 
439    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
440    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
441   
442      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
443 
444  END SUBROUTINE gather_mpi_r2
445
446!!!!!
447
448  SUBROUTINE gather_mpi_r3(VarIn, VarOut)
449    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
450    IMPLICIT NONE
451 
452    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
453    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
454   
455      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
456 
457  END SUBROUTINE gather_mpi_r3
458
459!!!!! --> Les booleen
460
461  SUBROUTINE gather_mpi_l(VarIn, VarOut)
462    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
463    IMPLICIT NONE
464 
465    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
466    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
467   
468      CALL gather_mpi_lgen(VarIn,VarOut,1)
469 
470  END SUBROUTINE gather_mpi_l
471
472!!!!!
473
474  SUBROUTINE gather_mpi_l1(VarIn, VarOut)
475    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
476    IMPLICIT NONE
477 
478    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
479    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
480   
481      CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2))
482 
483  END SUBROUTINE gather_mpi_l1
484
485!!!!!
486 
487  SUBROUTINE gather_mpi_l2(VarIn, VarOut)
488    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
489    IMPLICIT NONE
490 
491    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
492    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
493   
494      CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
495 
496  END SUBROUTINE gather_mpi_l2
497
498!!!!!
499
500  SUBROUTINE gather_mpi_l3(VarIn, VarOut)
501    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
502    IMPLICIT NONE
503 
504    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
505    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
506   
507    CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
508 
509  END SUBROUTINE gather_mpi_l3
510
511!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
512!! Definition des Scatter2D   --> 4D   !!
513!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
514
515  SUBROUTINE scatter2D_mpi_i(VarIn, VarOut)
516    USE mod_grid_phy_lmdz
517    IMPLICIT NONE
518 
519    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
520    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
521
522    INTEGER,DIMENSION(klon_glo) :: Var_tmp   
523   
524    CALL grid2dTo1d_glo(VarIn,Var_tmp)
525    CALL scatter_mpi(Var_tmp,VarOut)
526
527  END SUBROUTINE scatter2D_mpi_i
528
529  SUBROUTINE scatter2D_mpi_i1(VarIn, VarOut)
530    USE mod_grid_phy_lmdz
531    IMPLICIT NONE
532 
533    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
534    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
535    INTEGER,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
536
537    CALL grid2dTo1d_glo(VarIn,Var_tmp)
538    CALL scatter_mpi(Var_tmp,VarOut)
539
540  END SUBROUTINE scatter2D_mpi_i1
541
542  SUBROUTINE scatter2D_mpi_i2(VarIn, VarOut)
543    USE mod_grid_phy_lmdz
544    IMPLICIT NONE
545 
546    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
547    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
548
549    INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
550
551    CALL grid2dTo1d_glo(VarIn,Var_tmp)
552    CALL scatter_mpi(Var_tmp,VarOut)
553
554  END SUBROUTINE scatter2D_mpi_i2
555 
556  SUBROUTINE scatter2D_mpi_i3(VarIn, VarOut)
557    USE mod_grid_phy_lmdz
558    IMPLICIT NONE
559 
560    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
561    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
562    INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
563
564    CALL grid2dTo1d_glo(VarIn,Var_tmp)
565    CALL scatter_mpi(Var_tmp,VarOut)
566   
567  END SUBROUTINE scatter2D_mpi_i3
568
569
570
571  SUBROUTINE scatter2D_mpi_r(VarIn, VarOut)
572    USE mod_grid_phy_lmdz
573    IMPLICIT NONE
574 
575    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
576    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
577
578    REAL,DIMENSION(klon_glo) :: Var_tmp   
579   
580    CALL grid2dTo1d_glo(VarIn,Var_tmp)
581    CALL scatter_mpi(Var_tmp,VarOut)
582
583  END SUBROUTINE scatter2D_mpi_R
584
585
586  SUBROUTINE scatter2D_mpi_r1(VarIn, VarOut)
587    USE mod_grid_phy_lmdz
588    IMPLICIT NONE
589    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
590    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
591   
592    REAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
593   
594    CALL grid2dTo1d_glo(VarIn,Var_tmp)
595    CALL scatter_mpi(Var_tmp,VarOut)
596
597  END SUBROUTINE scatter2D_mpi_r1
598
599
600  SUBROUTINE scatter2D_mpi_r2(VarIn, VarOut)
601    USE mod_grid_phy_lmdz
602    IMPLICIT NONE
603 
604    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
605    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
606
607    REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
608   
609    CALL grid2dTo1d_glo(VarIn,Var_tmp)
610    CALL scatter_mpi(Var_tmp,VarOut)
611
612  END SUBROUTINE scatter2D_mpi_r2
613 
614  SUBROUTINE scatter2D_mpi_r3(VarIn, VarOut)
615    USE mod_grid_phy_lmdz
616    IMPLICIT NONE
617 
618    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
619    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
620   
621    REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
622
623    CALL grid2dTo1d_glo(VarIn,Var_tmp)
624    CALL scatter_mpi(Var_tmp,VarOut)
625 
626  END SUBROUTINE scatter2D_mpi_r3
627 
628 
629  SUBROUTINE scatter2D_mpi_l(VarIn, VarOut)
630    USE mod_grid_phy_lmdz
631    IMPLICIT NONE
632 
633    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
634    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
635
636    LOGICAL,DIMENSION(klon_glo) :: Var_tmp   
637   
638    CALL grid2dTo1d_glo(VarIn,Var_tmp)
639    CALL scatter_mpi(Var_tmp,VarOut)
640
641  END SUBROUTINE scatter2D_mpi_l
642
643
644  SUBROUTINE scatter2D_mpi_l1(VarIn, VarOut)
645    USE mod_grid_phy_lmdz
646    IMPLICIT NONE
647 
648    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
649    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
650   
651    LOGICAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
652
653    CALL grid2dTo1d_glo(VarIn,Var_tmp)
654    CALL scatter_mpi(Var_tmp,VarOut)
655 
656  END SUBROUTINE scatter2D_mpi_l1
657
658
659  SUBROUTINE scatter2D_mpi_l2(VarIn, VarOut)
660    USE mod_grid_phy_lmdz
661    IMPLICIT NONE
662 
663    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
664    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
665   
666    LOGICAL, DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
667 
668    CALL grid2dTo1d_glo(VarIn,Var_tmp)
669    CALL scatter_mpi(Var_tmp,VarOut)
670
671  END SUBROUTINE scatter2D_mpi_l2
672 
673  SUBROUTINE scatter2D_mpi_l3(VarIn, VarOut)
674    USE mod_grid_phy_lmdz
675    IMPLICIT NONE
676 
677    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
678    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
679   
680    LOGICAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
681
682    CALL grid2dTo1d_glo(VarIn,Var_tmp)
683    CALL scatter_mpi(Var_tmp,VarOut)
684 
685  END SUBROUTINE scatter2D_mpi_l3
686 
687 
688!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
689!! Definition des Gather2D   --> 4D   !!
690!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
691
692  SUBROUTINE gather2D_mpi_i(VarIn, VarOut)
693    USE mod_grid_phy_lmdz
694    IMPLICIT NONE
695 
696    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
697    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
698   
699    INTEGER,DIMENSION(klon_glo) :: Var_tmp
700   
701    CALL gather_mpi(VarIn,Var_tmp)
702    CALL grid1dTo2d_glo(Var_tmp,VarOut)
703
704  END SUBROUTINE gather2D_mpi_i
705
706  SUBROUTINE gather2D_mpi_i1(VarIn, VarOut)
707    USE mod_grid_phy_lmdz
708    IMPLICIT NONE
709 
710    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
711    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
712
713    INTEGER,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
714
715    CALL gather_mpi(VarIn,Var_tmp)
716    CALL grid1dTo2d_glo(Var_tmp,VarOut)
717
718  END SUBROUTINE gather2D_mpi_i1
719
720  SUBROUTINE gather2D_mpi_i2(VarIn, VarOut)
721    USE mod_grid_phy_lmdz
722    IMPLICIT NONE
723 
724    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
725    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
726
727    INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
728   
729    CALL gather_mpi(VarIn,Var_tmp)
730    CALL grid1dTo2d_glo(Var_tmp,VarOut)
731
732  END SUBROUTINE gather2D_mpi_i2
733 
734  SUBROUTINE gather2D_mpi_i3(VarIn, VarOut)
735    USE mod_grid_phy_lmdz
736    IMPLICIT NONE
737 
738    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
739    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
740 
741    INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
742   
743    CALL gather_mpi(VarIn,Var_tmp)
744    CALL grid1dTo2d_glo(Var_tmp,VarOut)
745
746  END SUBROUTINE gather2D_mpi_i3
747
748
749
750  SUBROUTINE gather2D_mpi_r(VarIn, VarOut)
751    USE mod_grid_phy_lmdz
752    IMPLICIT NONE
753 
754    REAL,INTENT(IN),DIMENSION(:) :: VarIn
755    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
756   
757    REAL,DIMENSION(klon_glo) :: Var_tmp
758   
759    CALL gather_mpi(VarIn,Var_tmp)
760    CALL grid1dTo2d_glo(Var_tmp,VarOut)
761
762  END SUBROUTINE gather2D_mpi_r
763
764  SUBROUTINE gather2D_mpi_r1(VarIn, VarOut)
765    USE mod_grid_phy_lmdz
766    IMPLICIT NONE
767 
768    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
769    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
770   
771    REAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
772
773    CALL gather_mpi(VarIn,Var_tmp)
774    CALL grid1dTo2d_glo(Var_tmp,VarOut)
775
776  END SUBROUTINE gather2D_mpi_r1
777
778  SUBROUTINE gather2D_mpi_r2(VarIn, VarOut)
779    USE mod_grid_phy_lmdz
780    IMPLICIT NONE
781 
782    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
783    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
784   
785    REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
786
787    CALL gather_mpi(VarIn,Var_tmp)
788    CALL grid1dTo2d_glo(Var_tmp,VarOut)
789
790  END SUBROUTINE gather2D_mpi_r2
791 
792  SUBROUTINE gather2D_mpi_r3(VarIn, VarOut)
793    USE mod_grid_phy_lmdz
794    IMPLICIT NONE
795 
796    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
797    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
798   
799    REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
800   
801    CALL gather_mpi(VarIn,Var_tmp)
802    CALL grid1dTo2d_glo(Var_tmp,VarOut)
803
804  END SUBROUTINE gather2D_mpi_r3
805
806 
807 
808  SUBROUTINE gather2D_mpi_l(VarIn, VarOut)
809    USE mod_grid_phy_lmdz
810    IMPLICIT NONE
811 
812    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
813    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
814   
815    LOGICAL,DIMENSION(klon_glo) :: Var_tmp
816   
817    CALL gather_mpi(VarIn,Var_tmp)
818    CALL grid1dTo2d_glo(Var_tmp,VarOut)
819
820  END SUBROUTINE gather2D_mpi_l
821
822  SUBROUTINE gather2D_mpi_l1(VarIn, VarOut)
823    USE mod_grid_phy_lmdz
824    IMPLICIT NONE
825 
826    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
827    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
828   
829    LOGICAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
830
831    CALL gather_mpi(VarIn,Var_tmp)
832    CALL grid1dTo2d_glo(Var_tmp,VarOut)
833
834  END SUBROUTINE gather2D_mpi_l1
835
836  SUBROUTINE gather2D_mpi_l2(VarIn, VarOut)
837    USE mod_grid_phy_lmdz
838    IMPLICIT NONE
839 
840    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
841    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
842   
843    LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
844
845    CALL gather_mpi(VarIn,Var_tmp)
846    CALL grid1dTo2d_glo(Var_tmp,VarOut)
847
848  END SUBROUTINE gather2D_mpi_l2
849 
850  SUBROUTINE gather2D_mpi_l3(VarIn, VarOut)
851    USE mod_grid_phy_lmdz
852    IMPLICIT NONE
853 
854    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
855    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
856   
857    LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
858   
859    CALL gather_mpi(VarIn,Var_tmp)
860    CALL grid1dTo2d_glo(Var_tmp,VarOut)
861
862  END SUBROUTINE gather2D_mpi_l3
863 
864 
865!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
866!! Definition des reduce_sum   --> 4D   !!
867!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
868
869  SUBROUTINE reduce_sum_mpi_i(VarIn, VarOut)
870    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
871    IMPLICIT NONE
872 
873    INTEGER,INTENT(IN)  :: VarIn
874    INTEGER,INTENT(OUT) :: VarOut
875    INTEGER             :: VarIn_tmp(1)
876    INTEGER             :: VarOut_tmp(1)
877   
878    VarIn_tmp(1)=VarIn   
879    CALL reduce_sum_mpi_igen(VarIn_tmp,Varout_tmp,1)
880    VarOut=VarOut_tmp(1)
881   
882  END SUBROUTINE reduce_sum_mpi_i
883
884  SUBROUTINE reduce_sum_mpi_i1(VarIn, VarOut)
885    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
886    IMPLICIT NONE
887 
888    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
889    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
890   
891    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
892 
893  END SUBROUTINE reduce_sum_mpi_i1
894
895  SUBROUTINE reduce_sum_mpi_i2(VarIn, VarOut)
896    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
897    IMPLICIT NONE
898 
899    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
900    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
901   
902    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
903 
904  END SUBROUTINE reduce_sum_mpi_i2
905
906  SUBROUTINE reduce_sum_mpi_i3(VarIn, VarOut)
907    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
908    IMPLICIT NONE
909 
910    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
911    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
912   
913    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
914 
915  END SUBROUTINE reduce_sum_mpi_i3
916
917  SUBROUTINE reduce_sum_mpi_i4(VarIn, VarOut)
918    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
919    IMPLICIT NONE
920 
921    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
922    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
923   
924    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
925 
926  END SUBROUTINE reduce_sum_mpi_i4                 
927 
928 
929  SUBROUTINE reduce_sum_mpi_r(VarIn, VarOut)
930    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
931    IMPLICIT NONE
932 
933    REAL,INTENT(IN)  :: VarIn
934    REAL,INTENT(OUT) :: VarOut
935    REAL             :: VarIn_tmp(1)
936    REAL             :: VarOut_tmp(1)
937   
938    VarIn_tmp(1)=VarIn   
939    CALL reduce_sum_mpi_rgen(VarIn_tmp,Varout_tmp,1)
940    VarOut=VarOut_tmp(1)
941 
942  END SUBROUTINE reduce_sum_mpi_r
943
944  SUBROUTINE reduce_sum_mpi_r1(VarIn, VarOut)
945    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
946    IMPLICIT NONE
947 
948    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
949    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
950   
951    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
952     
953  END SUBROUTINE reduce_sum_mpi_r1
954
955  SUBROUTINE reduce_sum_mpi_r2(VarIn, VarOut)
956    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
957    IMPLICIT NONE
958 
959    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
960    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
961   
962    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
963 
964  END SUBROUTINE reduce_sum_mpi_r2
965
966  SUBROUTINE reduce_sum_mpi_r3(VarIn, VarOut)
967    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
968    IMPLICIT NONE
969 
970    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
971    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
972   
973    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
974 
975  END SUBROUTINE reduce_sum_mpi_r3
976
977  SUBROUTINE reduce_sum_mpi_r4(VarIn, VarOut)
978    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
979    IMPLICIT NONE
980 
981    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
982    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
983   
984    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
985 
986  END SUBROUTINE reduce_sum_mpi_r4
987 
988
989
990!!!!!!!!!!!!!!!!!!!!!!!!!!!!
991!! SUBROUTINE grid1dTo2d  !! 
992!!!!!!!!!!!!!!!!!!!!!!!!!!!!
993
994
995  SUBROUTINE grid1dTo2d_mpi_i(VarIn,VarOut) 
996  IMPLICIT NONE 
997    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
998    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
999   
1000    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,1)
1001 
1002  END SUBROUTINE grid1dTo2d_mpi_i
1003 
1004
1005  SUBROUTINE grid1dTo2d_mpi_i1(VarIn,VarOut) 
1006  IMPLICIT NONE 
1007    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
1008    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
1009   
1010    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2))
1011 
1012  END SUBROUTINE grid1dTo2d_mpi_i1
1013
1014  SUBROUTINE grid1dTo2d_mpi_i2(VarIn,VarOut) 
1015  IMPLICIT NONE 
1016    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
1017    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
1018   
1019    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
1020 
1021  END SUBROUTINE grid1dTo2d_mpi_i2
1022 
1023  SUBROUTINE grid1dTo2d_mpi_i3(VarIn,VarOut) 
1024  IMPLICIT NONE 
1025    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
1026    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
1027   
1028    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
1029 
1030  END SUBROUTINE grid1dTo2d_mpi_i3
1031
1032
1033  SUBROUTINE grid1dTo2d_mpi_r(VarIn,VarOut) 
1034  IMPLICIT NONE 
1035    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
1036    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
1037   
1038    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,1)
1039 
1040  END SUBROUTINE grid1dTo2d_mpi_r
1041 
1042
1043  SUBROUTINE grid1dTo2d_mpi_r1(VarIn,VarOut) 
1044  IMPLICIT NONE 
1045    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
1046    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
1047   
1048    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2))
1049 
1050  END SUBROUTINE grid1dTo2d_mpi_r1
1051
1052  SUBROUTINE grid1dTo2d_mpi_r2(VarIn,VarOut) 
1053  IMPLICIT NONE 
1054    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
1055    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
1056   
1057    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
1058 
1059  END SUBROUTINE grid1dTo2d_mpi_r2
1060 
1061  SUBROUTINE grid1dTo2d_mpi_r3(VarIn,VarOut) 
1062  IMPLICIT NONE 
1063    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
1064    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
1065   
1066    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
1067 
1068  END SUBROUTINE grid1dTo2d_mpi_r3
1069 
1070 
1071 
1072  SUBROUTINE grid1dTo2d_mpi_l(VarIn,VarOut) 
1073  IMPLICIT NONE 
1074    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
1075    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
1076   
1077    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,1)
1078 
1079  END SUBROUTINE grid1dTo2d_mpi_l
1080 
1081
1082  SUBROUTINE grid1dTo2d_mpi_l1(VarIn,VarOut) 
1083  IMPLICIT NONE 
1084    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
1085    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
1086   
1087    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2))
1088 
1089  END SUBROUTINE grid1dTo2d_mpi_l1
1090
1091  SUBROUTINE grid1dTo2d_mpi_l2(VarIn,VarOut) 
1092  IMPLICIT NONE 
1093    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
1094    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
1095   
1096    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
1097 
1098  END SUBROUTINE grid1dTo2d_mpi_l2
1099 
1100  SUBROUTINE grid1dTo2d_mpi_l3(VarIn,VarOut) 
1101  IMPLICIT NONE 
1102    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
1103    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
1104   
1105    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
1106 
1107  END SUBROUTINE grid1dTo2d_mpi_l3
1108
1109
1110  SUBROUTINE grid2dTo1d_mpi_i(VarIn,VarOut) 
1111  IMPLICIT NONE 
1112    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
1113    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
1114   
1115    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,1)
1116 
1117  END SUBROUTINE grid2dTo1d_mpi_i
1118 
1119
1120  SUBROUTINE grid2dTo1d_mpi_i1(VarIn,VarOut) 
1121  IMPLICIT NONE 
1122    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1123    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
1124   
1125    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3))
1126 
1127  END SUBROUTINE grid2dTo1d_mpi_i1
1128
1129  SUBROUTINE grid2dTo1d_mpi_i2(VarIn,VarOut) 
1130  IMPLICIT NONE 
1131    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1132    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
1133   
1134    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
1135 
1136  END SUBROUTINE grid2dTo1d_mpi_i2
1137 
1138  SUBROUTINE grid2dTo1d_mpi_i3(VarIn,VarOut) 
1139  IMPLICIT NONE 
1140    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1141    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
1142   
1143    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
1144 
1145  END SUBROUTINE grid2dTo1d_mpi_i3
1146 
1147
1148
1149
1150  SUBROUTINE grid2dTo1d_mpi_r(VarIn,VarOut) 
1151  IMPLICIT NONE 
1152    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1153    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
1154   
1155    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,1)
1156 
1157  END SUBROUTINE grid2dTo1d_mpi_r
1158 
1159
1160  SUBROUTINE grid2dTo1d_mpi_r1(VarIn,VarOut) 
1161  IMPLICIT NONE 
1162    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1163    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
1164   
1165    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3))
1166 
1167  END SUBROUTINE grid2dTo1d_mpi_r1
1168
1169  SUBROUTINE grid2dTo1d_mpi_r2(VarIn,VarOut) 
1170  IMPLICIT NONE 
1171    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1172    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
1173   
1174    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
1175 
1176  END SUBROUTINE grid2dTo1d_mpi_r2
1177 
1178  SUBROUTINE grid2dTo1d_mpi_r3(VarIn,VarOut) 
1179  IMPLICIT NONE 
1180    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1181    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
1182   
1183    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
1184 
1185  END SUBROUTINE grid2dTo1d_mpi_r3
1186
1187
1188
1189  SUBROUTINE grid2dTo1d_mpi_l(VarIn,VarOut) 
1190  IMPLICIT NONE 
1191    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1192    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
1193   
1194    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,1)
1195 
1196  END SUBROUTINE grid2dTo1d_mpi_l
1197 
1198
1199  SUBROUTINE grid2dTo1d_mpi_l1(VarIn,VarOut) 
1200  IMPLICIT NONE 
1201    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1202    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
1203   
1204    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3))
1205 
1206  END SUBROUTINE grid2dTo1d_mpi_l1
1207
1208
1209
1210  SUBROUTINE grid2dTo1d_mpi_l2(VarIn,VarOut) 
1211  IMPLICIT NONE 
1212    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1213    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
1214   
1215    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
1216 
1217  END SUBROUTINE grid2dTo1d_mpi_l2
1218
1219 
1220  SUBROUTINE grid2dTo1d_mpi_l3(VarIn,VarOut) 
1221  IMPLICIT NONE 
1222    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1223    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
1224   
1225    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
1226 
1227  END SUBROUTINE grid2dTo1d_mpi_l3
1228
1229               
1230
1231
1232
1233!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1234!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
1235!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1236
1237  SUBROUTINE bcast_mpi_cgen(var,nb)
1238    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1239    IMPLICIT NONE
1240   
1241    CHARACTER(LEN=*),INTENT(INOUT) :: Var
1242    INTEGER,INTENT(IN) :: nb
1243   
1244#ifdef CPP_MPI
1245    INCLUDE 'mpif.h'
1246#endif
1247    INTEGER :: ierr
1248
1249    IF (.not.is_using_mpi) RETURN
1250   
1251#ifdef CPP_MPI
1252    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_root_x,COMM_LMDZ_PHY,ierr)
1253#endif
1254       
1255  END SUBROUTINE bcast_mpi_cgen
1256
1257
1258     
1259  SUBROUTINE bcast_mpi_igen(var,nb)
1260    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1261    IMPLICIT NONE
1262   
1263    INTEGER,INTENT(IN) :: nb
1264    INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var
1265   
1266#ifdef CPP_MPI
1267    INCLUDE 'mpif.h'
1268#endif
1269    INTEGER :: ierr
1270
1271    IF (.not.is_using_mpi) RETURN
1272
1273#ifdef CPP_MPI
1274    CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_root_x,COMM_LMDZ_PHY,ierr)
1275#endif
1276       
1277  END SUBROUTINE bcast_mpi_igen
1278
1279
1280
1281 
1282  SUBROUTINE bcast_mpi_rgen(var,nb)
1283    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1284    IMPLICIT NONE
1285   
1286    INTEGER,INTENT(IN) :: nb
1287    REAL,DIMENSION(nb),INTENT(INOUT) :: Var
1288   
1289#ifdef CPP_MPI
1290    INCLUDE 'mpif.h'
1291#endif
1292    INTEGER :: ierr
1293
1294    IF (.not.is_using_mpi) RETURN
1295
1296#ifdef CPP_MPI
1297    CALL MPI_BCAST(Var,nb,MPI_REAL_LMDZ,mpi_root_x,COMM_LMDZ_PHY,ierr)
1298#endif
1299   
1300  END SUBROUTINE bcast_mpi_rgen
1301 
1302
1303
1304
1305  SUBROUTINE bcast_mpi_lgen(var,nb)
1306    USE mod_phys_lmdz_mpi_data ,  mpi_root_x=>mpi_root
1307    IMPLICIT NONE
1308   
1309    INTEGER,INTENT(IN) :: nb
1310    LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
1311   
1312#ifdef CPP_MPI
1313    INCLUDE 'mpif.h'
1314#endif
1315    INTEGER :: ierr
1316
1317    IF (.not.is_using_mpi) RETURN
1318
1319#ifdef CPP_MPI
1320    CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_root_x,COMM_LMDZ_PHY,ierr)
1321#endif
1322
1323  END SUBROUTINE bcast_mpi_lgen
1324
1325 
1326
1327  SUBROUTINE scatter_mpi_igen(VarIn, VarOut, dimsize)
1328    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1329    USE mod_grid_phy_lmdz
1330    IMPLICIT NONE
1331 
1332    INTEGER,INTENT(IN) :: dimsize
1333    INTEGER,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
1334    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
1335 
1336#ifdef CPP_MPI
1337    INCLUDE 'mpif.h'
1338#endif
1339    INTEGER,DIMENSION(0:mpi_size-1) :: displs
1340    INTEGER,DIMENSION(0:mpi_size-1) :: counts
1341    INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp
1342    INTEGER :: nb,i,index,rank
1343    INTEGER :: ierr
1344
1345
1346    IF (.not.is_using_mpi) THEN
1347      VarOut(:,:)=VarIn(:,:)
1348      RETURN
1349    ENDIF
1350
1351   
1352    IF (is_mpi_root) THEN
1353      Index=1
1354      DO rank=0,mpi_size-1
1355        nb=klon_mpi_para_nb(rank)
1356        displs(rank)=Index-1
1357        counts(rank)=nb*dimsize
1358        DO i=1,dimsize
1359          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
1360          Index=Index+nb
1361        ENDDO
1362      ENDDO
1363    ENDIF
1364     
1365#ifdef CPP_MPI
1366    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INTEGER,VarOut,klon_mpi*dimsize,   &
1367                      MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
1368#endif
1369
1370  END SUBROUTINE scatter_mpi_igen
1371
1372  SUBROUTINE scatter_mpi_rgen(VarIn, VarOut, dimsize)
1373    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1374    USE mod_grid_phy_lmdz
1375    IMPLICIT NONE
1376 
1377    INTEGER,INTENT(IN) :: dimsize
1378    REAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
1379    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
1380 
1381#ifdef CPP_MPI
1382    INCLUDE 'mpif.h'
1383#endif
1384
1385    INTEGER,DIMENSION(0:mpi_size-1) :: displs
1386    INTEGER,DIMENSION(0:mpi_size-1) :: counts
1387    REAL,DIMENSION(dimsize*klon_glo) :: VarTmp
1388    INTEGER :: nb,i,index,rank
1389    INTEGER :: ierr
1390
1391    IF (.not.is_using_mpi) THEN
1392      VarOut(:,:)=VarIn(:,:)
1393      RETURN
1394    ENDIF
1395   
1396    IF (is_mpi_root) THEN
1397      Index=1
1398      DO rank=0,mpi_size-1
1399        nb=klon_mpi_para_nb(rank)
1400        displs(rank)=Index-1
1401        counts(rank)=nb*dimsize
1402        DO i=1,dimsize
1403          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
1404          Index=Index+nb
1405        ENDDO
1406      ENDDO
1407    ENDIF
1408     
1409#ifdef CPP_MPI
1410    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_LMDZ,VarOut,klon_mpi*dimsize,   &
1411                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
1412
1413#endif
1414
1415  END SUBROUTINE scatter_mpi_rgen
1416
1417 
1418  SUBROUTINE scatter_mpi_lgen(VarIn, VarOut, dimsize)
1419    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1420    USE mod_grid_phy_lmdz
1421    IMPLICIT NONE
1422 
1423    INTEGER,INTENT(IN) :: dimsize
1424    LOGICAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
1425    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
1426 
1427#ifdef CPP_MPI
1428    INCLUDE 'mpif.h'
1429#endif
1430
1431    INTEGER,DIMENSION(0:mpi_size-1) :: displs
1432    INTEGER,DIMENSION(0:mpi_size-1) :: counts
1433    LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp
1434    INTEGER :: nb,i,index,rank
1435    INTEGER :: ierr
1436
1437    IF (.not.is_using_mpi) THEN
1438      VarOut(:,:)=VarIn(:,:)
1439      RETURN
1440    ENDIF
1441   
1442    IF (is_mpi_root) THEN
1443      Index=1
1444      DO rank=0,mpi_size-1
1445        nb=klon_mpi_para_nb(rank)
1446        displs(rank)=Index-1
1447        counts(rank)=nb*dimsize
1448        DO i=1,dimsize
1449          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
1450          Index=Index+nb
1451        ENDDO
1452      ENDDO
1453    ENDIF
1454     
1455#ifdef CPP_MPI
1456    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,klon_mpi*dimsize,   &
1457                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
1458#endif
1459
1460  END SUBROUTINE scatter_mpi_lgen 
1461
1462
1463
1464
1465  SUBROUTINE gather_mpi_igen(VarIn, VarOut, dimsize)
1466    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1467    USE mod_grid_phy_lmdz
1468    IMPLICIT NONE
1469 
1470#ifdef CPP_MPI
1471    INCLUDE 'mpif.h'
1472#endif
1473   
1474    INTEGER,INTENT(IN) :: dimsize
1475    INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
1476    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
1477 
1478    INTEGER,DIMENSION(0:mpi_size-1) :: displs
1479    INTEGER,DIMENSION(0:mpi_size-1) :: counts
1480    INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp
1481    INTEGER :: nb,i,index,rank
1482    INTEGER :: ierr
1483
1484    IF (.not.is_using_mpi) THEN
1485      VarOut(:,:)=VarIn(:,:)
1486      RETURN
1487    ENDIF
1488
1489    IF (is_mpi_root) THEN
1490      Index=1
1491      DO rank=0,mpi_size-1
1492        nb=klon_mpi_para_nb(rank)
1493        displs(rank)=Index-1
1494        counts(rank)=nb*dimsize
1495        Index=Index+nb*dimsize
1496      ENDDO
1497     
1498    ENDIF
1499   
1500#ifdef CPP_MPI
1501    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_INTEGER,VarTmp,counts,displs,   &
1502                     MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
1503#endif
1504
1505                         
1506    IF (is_mpi_root) THEN
1507      Index=1
1508      DO rank=0,mpi_size-1
1509        nb=klon_mpi_para_nb(rank)
1510        DO i=1,dimsize
1511          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
1512          Index=Index+nb
1513        ENDDO
1514      ENDDO
1515    ENDIF
1516
1517  END SUBROUTINE gather_mpi_igen 
1518
1519  SUBROUTINE gather_mpi_rgen(VarIn, VarOut, dimsize)
1520    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1521    USE mod_grid_phy_lmdz
1522    IMPLICIT NONE
1523 
1524#ifdef CPP_MPI
1525    INCLUDE 'mpif.h'
1526#endif
1527   
1528    INTEGER,INTENT(IN) :: dimsize
1529    REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
1530    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
1531 
1532    INTEGER,DIMENSION(0:mpi_size-1) :: displs
1533    INTEGER,DIMENSION(0:mpi_size-1) :: counts
1534    REAL,DIMENSION(dimsize*klon_glo) :: VarTmp
1535    INTEGER :: nb,i,index,rank
1536    INTEGER :: ierr
1537
1538    IF (is_mpi_root) THEN
1539      Index=1
1540      DO rank=0,mpi_size-1
1541        nb=klon_mpi_para_nb(rank)
1542        displs(rank)=Index-1
1543        counts(rank)=nb*dimsize
1544        Index=Index+nb*dimsize
1545      ENDDO
1546    ENDIF
1547   
1548    IF (.not.is_using_mpi) THEN
1549      VarOut(:,:)=VarIn(:,:)
1550      RETURN
1551    ENDIF
1552
1553#ifdef CPP_MPI
1554    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_REAL_LMDZ,VarTmp,counts,displs,   &
1555                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
1556#endif
1557                         
1558    IF (is_mpi_root) THEN
1559      Index=1
1560      DO rank=0,mpi_size-1
1561        nb=klon_mpi_para_nb(rank)
1562        DO i=1,dimsize
1563          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
1564          Index=Index+nb
1565        ENDDO
1566      ENDDO
1567    ENDIF
1568
1569  END SUBROUTINE gather_mpi_rgen 
1570
1571  SUBROUTINE gather_mpi_lgen(VarIn, VarOut, dimsize)
1572    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1573    USE mod_grid_phy_lmdz
1574    IMPLICIT NONE
1575 
1576    INTEGER,INTENT(IN) :: dimsize
1577    LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
1578    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
1579 
1580#ifdef CPP_MPI
1581    INCLUDE 'mpif.h'
1582#endif
1583
1584    INTEGER,DIMENSION(0:mpi_size-1) :: displs
1585    INTEGER,DIMENSION(0:mpi_size-1) :: counts
1586    LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp
1587    INTEGER :: nb,i,index,rank
1588    INTEGER :: ierr
1589   
1590    IF (.not.is_using_mpi) THEN
1591      VarOut(:,:)=VarIn(:,:)
1592      RETURN
1593    ENDIF
1594
1595    IF (is_mpi_root) THEN
1596      Index=1
1597      DO rank=0,mpi_size-1
1598        nb=klon_mpi_para_nb(rank)
1599        displs(rank)=Index-1
1600        counts(rank)=nb*dimsize
1601        Index=Index+nb*dimsize
1602      ENDDO
1603    ENDIF
1604   
1605
1606#ifdef CPP_MPI
1607    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs,   &
1608                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
1609#endif
1610                         
1611    IF (is_mpi_root) THEN
1612      Index=1
1613      DO rank=0,mpi_size-1
1614        nb=klon_mpi_para_nb(rank)
1615        DO i=1,dimsize
1616          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
1617          Index=Index+nb
1618        ENDDO
1619      ENDDO
1620    ENDIF
1621
1622  END SUBROUTINE gather_mpi_lgen
1623 
1624
1625
1626  SUBROUTINE reduce_sum_mpi_igen(VarIn,VarOut,nb)
1627    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1628    USE mod_grid_phy_lmdz
1629    IMPLICIT NONE
1630   
1631#ifdef CPP_MPI
1632    INCLUDE 'mpif.h'
1633#endif
1634   
1635    INTEGER,INTENT(IN) :: nb
1636    INTEGER,DIMENSION(nb),INTENT(IN) :: VarIn
1637    INTEGER,DIMENSION(nb),INTENT(OUT) :: VarOut   
1638    INTEGER :: ierr
1639   
1640    IF (.not.is_using_mpi) THEN
1641      VarOut(:)=VarIn(:)
1642      RETURN
1643    ENDIF
1644
1645
1646#ifdef CPP_MPI
1647    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
1648#endif
1649           
1650  END SUBROUTINE reduce_sum_mpi_igen
1651 
1652  SUBROUTINE reduce_sum_mpi_rgen(VarIn,VarOut,nb)
1653    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1654    USE mod_grid_phy_lmdz
1655
1656    IMPLICIT NONE
1657
1658#ifdef CPP_MPI
1659    INCLUDE 'mpif.h'
1660#endif
1661   
1662    INTEGER,INTENT(IN) :: nb
1663    REAL,DIMENSION(nb),INTENT(IN) :: VarIn
1664    REAL,DIMENSION(nb),INTENT(OUT) :: VarOut   
1665    INTEGER :: ierr
1666 
1667    IF (.not.is_using_mpi) THEN
1668      VarOut(:)=VarIn(:)
1669      RETURN
1670    ENDIF
1671   
1672#ifdef CPP_MPI
1673    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
1674#endif
1675       
1676  END SUBROUTINE reduce_sum_mpi_rgen
1677
1678
1679
1680  SUBROUTINE grid1dTo2d_mpi_igen(VarIn,VarOut,dimsize)
1681    USE mod_phys_lmdz_mpi_data
1682    USE mod_grid_phy_lmdz
1683    IMPLICIT NONE
1684   
1685    INTEGER,INTENT(IN) :: dimsize
1686    INTEGER,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
1687    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
1688    INTEGER :: i,ij,Offset
1689
1690   
1691    VarOut(1:nbp_lon,:)=0
1692    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0
1693   
1694    offset=ii_begin
1695    IF (is_north_pole) Offset=nbp_lon
1696   
1697   
1698    DO i=1,dimsize
1699      DO ij=1,klon_mpi
1700        VarOut(ij+offset-1,i)=VarIn(ij,i)
1701      ENDDO
1702    ENDDO
1703   
1704   
1705    IF (is_north_pole) THEN
1706      DO i=1,dimsize
1707        DO ij=1,nbp_lon
1708         VarOut(ij,i)=VarIn(1,i)
1709        ENDDO
1710      ENDDO
1711    ENDIF
1712   
1713    IF (is_south_pole) THEN
1714      DO i=1,dimsize
1715        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
1716         VarOut(ij,i)=VarIn(klon_mpi,i)
1717        ENDDO
1718      ENDDO
1719    ENDIF
1720
1721  END SUBROUTINE grid1dTo2d_mpi_igen   
1722
1723
1724  SUBROUTINE grid1dTo2d_mpi_rgen(VarIn,VarOut,dimsize)
1725    USE mod_phys_lmdz_mpi_data
1726    USE mod_grid_phy_lmdz
1727    IMPLICIT NONE
1728   
1729    INTEGER,INTENT(IN) :: dimsize
1730    REAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
1731    REAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
1732    INTEGER :: i,ij,Offset
1733
1734   
1735    VarOut(1:nbp_lon,:)=0
1736    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0
1737   
1738    offset=ii_begin
1739    IF (is_north_pole) Offset=nbp_lon
1740   
1741   
1742    DO i=1,dimsize
1743      DO ij=1,klon_mpi
1744        VarOut(ij+offset-1,i)=VarIn(ij,i)
1745      ENDDO
1746    ENDDO
1747   
1748   
1749    IF (is_north_pole) THEN
1750      DO i=1,dimsize
1751        DO ij=1,nbp_lon
1752         VarOut(ij,i)=VarIn(1,i)
1753        ENDDO
1754      ENDDO
1755    ENDIF
1756   
1757    IF (is_south_pole) THEN
1758      DO i=1,dimsize
1759        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
1760         VarOut(ij,i)=VarIn(klon_mpi,i)
1761        ENDDO
1762      ENDDO
1763    ENDIF
1764
1765   END SUBROUTINE grid1dTo2d_mpi_rgen   
1766
1767
1768
1769  SUBROUTINE grid1dTo2d_mpi_lgen(VarIn,VarOut,dimsize)
1770    USE mod_phys_lmdz_mpi_data
1771    USE mod_grid_phy_lmdz
1772    IMPLICIT NONE
1773   
1774    INTEGER,INTENT(IN) :: dimsize
1775    LOGICAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
1776    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
1777    INTEGER :: i,ij,Offset
1778
1779   
1780    VarOut(1:nbp_lon,:)=.FALSE.
1781    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=.FALSE.
1782   
1783    offset=ii_begin
1784    IF (is_north_pole) Offset=nbp_lon
1785   
1786   
1787    DO i=1,dimsize
1788      DO ij=1,klon_mpi
1789        VarOut(ij+offset-1,i)=VarIn(ij,i)
1790      ENDDO
1791    ENDDO
1792   
1793   
1794    IF (is_north_pole) THEN
1795      DO i=1,dimsize
1796        DO ij=1,nbp_lon
1797         VarOut(ij,i)=VarIn(1,i)
1798        ENDDO
1799      ENDDO
1800    ENDIF
1801   
1802    IF (is_south_pole) THEN
1803      DO i=1,dimsize
1804        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
1805         VarOut(ij,i)=VarIn(klon_mpi,i)
1806        ENDDO
1807      ENDDO
1808    ENDIF
1809
1810   END SUBROUTINE grid1dTo2d_mpi_lgen   
1811
1812 
1813
1814
1815  SUBROUTINE grid2dTo1d_mpi_igen(VarIn,VarOut,dimsize)
1816    USE mod_phys_lmdz_mpi_data
1817    USE mod_grid_phy_lmdz
1818    IMPLICIT NONE
1819   
1820    INTEGER,INTENT(IN) :: dimsize
1821    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
1822    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
1823    INTEGER :: i,ij,offset
1824
1825    offset=ii_begin
1826    IF (is_north_pole) offset=nbp_lon
1827
1828    DO i=1,dimsize
1829      DO ij=1,klon_mpi
1830        VarOut(ij,i)=VarIn(ij+offset-1,i)
1831      ENDDO
1832    ENDDO
1833
1834    IF (is_north_pole) THEN
1835      DO i=1,dimsize
1836        VarOut(1,i)=VarIn(1,i)
1837      ENDDO
1838    ENDIF
1839   
1840   
1841  END SUBROUTINE grid2dTo1d_mpi_igen   
1842
1843
1844
1845  SUBROUTINE grid2dTo1d_mpi_rgen(VarIn,VarOut,dimsize)
1846    USE mod_phys_lmdz_mpi_data
1847    USE mod_grid_phy_lmdz
1848    IMPLICIT NONE
1849   
1850    INTEGER,INTENT(IN) :: dimsize
1851    REAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
1852    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
1853    INTEGER :: i,ij,offset
1854
1855    offset=ii_begin
1856    IF (is_north_pole) offset=nbp_lon
1857
1858    DO i=1,dimsize
1859      DO ij=1,klon_mpi
1860        VarOut(ij,i)=VarIn(ij+offset-1,i)
1861      ENDDO
1862    ENDDO
1863
1864    IF (is_north_pole) THEN
1865      DO i=1,dimsize
1866         VarOut(1,i)=VarIn(1,i)
1867      ENDDO
1868    ENDIF
1869   
1870   
1871  END SUBROUTINE grid2dTo1d_mpi_rgen   
1872 
1873
1874  SUBROUTINE grid2dTo1d_mpi_lgen(VarIn,VarOut,dimsize)
1875    USE mod_phys_lmdz_mpi_data
1876    USE mod_grid_phy_lmdz
1877    IMPLICIT NONE
1878   
1879    INTEGER,INTENT(IN) :: dimsize
1880    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
1881    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
1882    INTEGER :: i,ij,offset
1883
1884    offset=ii_begin
1885    IF (is_north_pole) offset=nbp_lon
1886
1887    DO i=1,dimsize
1888      DO ij=1,klon_mpi
1889        VarOut(ij,i)=VarIn(ij+offset-1,i)
1890      ENDDO
1891    ENDDO
1892
1893    IF (is_north_pole) THEN
1894      DO i=1,dimsize
1895        VarOut(1,i)=VarIn(1,i)
1896      ENDDO
1897    ENDIF
1898   
1899   
1900  END SUBROUTINE grid2dTo1d_mpi_lgen   
1901
1902END MODULE mod_phys_lmdz_mpi_transfert
Note: See TracBrowser for help on using the repository browser.