source: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_transfert.F90 @ 1242

Last change on this file since 1242 was 1130, checked in by emillour, 11 years ago

Mars GCM:
Series of changes to enable running in parallel (using LMDZ.COMMON dynamics);
Current LMDZ.MARS can still notheless be compiled and run in serial mode
"as previously".
Summary of main changes:

  • Main programs (newstart, start2archive, xvik) that used to be in dyn3d have been moved to phymars.
  • dyn3d/control.h is now module control_mod.F90
  • rearanged input/outputs routines everywhere to handle serial/MPI cases. physdem.F => phyredem.F90 , phyetat0.F => phyetat0.F90 ; all read/write routines for startfi files are gathered in module iostart.F90
  • added parallelism related routines init_phys_lmdz.F90, comgeomphy.F90, dimphy.F90, iniphysiq.F90, mod_grid_phy_lmdz.F90, mod_phys_lmdz_mpi_data.F90, mod_phys_lmdz_mpi_transfert.F90, mod_phys_lmdz_omp_data.F90, mod_phys_lmdz_omp_transfert.F90, mod_phys_lmdz_para.F90, mod_phys_lmdz_transfert_para.F90 in phymars and mod_const_mpi.F90 in dyn3d (for compliance with parallel case)
  • created generic routines 'planetwide_maxval' and 'planetwide_minval', in module "planetwide_mod", that enable obtaining the min and max of a field over the whole planet.

EM
File size: 48.3 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, only: klon_glo, grid2dTo1d_glo
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, only: klon_glo, grid2dTo1d_glo
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, only: klon_glo, grid2dTo1d_glo
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, only: klon_glo, grid2dTo1d_glo
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, only: klon_glo, grid2dTo1d_glo
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, only: klon_glo, grid2dTo1d_glo
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, only: klon_glo, grid2dTo1d_glo
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, only: klon_glo, grid2dTo1d_glo
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, only: klon_glo, grid2dTo1d_glo
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, only: klon_glo, grid2dTo1d_glo
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, only: klon_glo, grid2dTo1d_glo
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, only: klon_glo, grid2dTo1d_glo
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, only: klon_glo, grid1dTo2d_glo
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, only: klon_glo, grid1dTo2d_glo
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, only: klon_glo, grid1dTo2d_glo
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, only: klon_glo, grid1dTo2d_glo
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, only: klon_glo, grid1dTo2d_glo
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, only: klon_glo, grid1dTo2d_glo
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, only: klon_glo, grid1dTo2d_glo
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, only: klon_glo, grid1dTo2d_glo
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, only: klon_glo, grid1dTo2d_glo
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, only: klon_glo, grid1dTo2d_glo
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, only: klon_glo, grid1dTo2d_glo
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, only: klon_glo, grid1dTo2d_glo
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,DIMENSION(nb),INTENT(INOUT) :: Var
1264    INTEGER,INTENT(IN) :: nb
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    REAL,DIMENSION(nb),INTENT(INOUT) :: Var
1287    INTEGER,INTENT(IN) :: nb
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    LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
1310    INTEGER,INTENT(IN) :: nb
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    if (ierr.ne.MPI_SUCCESS) then
1322      write(*,*) "bcast_mpi error: ierr=",ierr
1323      stop
1324    endif
1325#endif
1326
1327  END SUBROUTINE bcast_mpi_lgen
1328
1329 
1330
1331  SUBROUTINE scatter_mpi_igen(VarIn, VarOut, dimsize)
1332    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1333    USE mod_grid_phy_lmdz
1334    IMPLICIT NONE
1335 
1336    INTEGER,INTENT(IN) :: dimsize
1337    INTEGER,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
1338    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
1339 
1340#ifdef CPP_MPI
1341    INCLUDE 'mpif.h'
1342#endif
1343    INTEGER,DIMENSION(0:mpi_size-1) :: displs
1344    INTEGER,DIMENSION(0:mpi_size-1) :: counts
1345    INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp
1346    INTEGER :: nb,i,index,rank
1347    INTEGER :: ierr
1348
1349
1350    IF (.not.is_using_mpi) THEN
1351      VarOut(:,:)=VarIn(:,:)
1352      RETURN
1353    ENDIF
1354
1355   
1356    IF (is_mpi_root) THEN
1357      Index=1
1358      DO rank=0,mpi_size-1
1359        nb=klon_mpi_para_nb(rank)
1360        displs(rank)=Index-1
1361        counts(rank)=nb*dimsize
1362        DO i=1,dimsize
1363          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
1364          Index=Index+nb
1365        ENDDO
1366      ENDDO
1367    ENDIF
1368     
1369#ifdef CPP_MPI
1370    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INTEGER,VarOut,klon_mpi*dimsize,   &
1371                      MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
1372#endif
1373
1374  END SUBROUTINE scatter_mpi_igen
1375
1376  SUBROUTINE scatter_mpi_rgen(VarIn, VarOut, dimsize)
1377    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1378    USE mod_grid_phy_lmdz
1379    IMPLICIT NONE
1380 
1381    INTEGER,INTENT(IN) :: dimsize
1382    REAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
1383    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
1384 
1385#ifdef CPP_MPI
1386    INCLUDE 'mpif.h'
1387#endif
1388
1389    INTEGER,DIMENSION(0:mpi_size-1) :: displs
1390    INTEGER,DIMENSION(0:mpi_size-1) :: counts
1391    REAL,DIMENSION(dimsize*klon_glo) :: VarTmp
1392    INTEGER :: nb,i,index,rank
1393    INTEGER :: ierr
1394
1395    IF (.not.is_using_mpi) THEN
1396      VarOut(:,:)=VarIn(:,:)
1397      RETURN
1398    ENDIF
1399   
1400    IF (is_mpi_root) THEN
1401      Index=1
1402      DO rank=0,mpi_size-1
1403        nb=klon_mpi_para_nb(rank)
1404        displs(rank)=Index-1
1405        counts(rank)=nb*dimsize
1406        DO i=1,dimsize
1407          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
1408          Index=Index+nb
1409        ENDDO
1410      ENDDO
1411    ENDIF
1412     
1413#ifdef CPP_MPI
1414    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_LMDZ,VarOut,klon_mpi*dimsize,   &
1415                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
1416
1417#endif
1418
1419  END SUBROUTINE scatter_mpi_rgen
1420
1421 
1422  SUBROUTINE scatter_mpi_lgen(VarIn, VarOut, dimsize)
1423    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1424    USE mod_grid_phy_lmdz
1425    IMPLICIT NONE
1426 
1427    INTEGER,INTENT(IN) :: dimsize
1428    LOGICAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
1429    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
1430 
1431#ifdef CPP_MPI
1432    INCLUDE 'mpif.h'
1433#endif
1434
1435    INTEGER,DIMENSION(0:mpi_size-1) :: displs
1436    INTEGER,DIMENSION(0:mpi_size-1) :: counts
1437    LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp
1438    INTEGER :: nb,i,index,rank
1439    INTEGER :: ierr
1440
1441    IF (.not.is_using_mpi) THEN
1442      VarOut(:,:)=VarIn(:,:)
1443      RETURN
1444    ENDIF
1445   
1446    IF (is_mpi_root) THEN
1447      Index=1
1448      DO rank=0,mpi_size-1
1449        nb=klon_mpi_para_nb(rank)
1450        displs(rank)=Index-1
1451        counts(rank)=nb*dimsize
1452        DO i=1,dimsize
1453          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
1454          Index=Index+nb
1455        ENDDO
1456      ENDDO
1457    ENDIF
1458     
1459#ifdef CPP_MPI
1460    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,klon_mpi*dimsize,   &
1461                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
1462#endif
1463
1464  END SUBROUTINE scatter_mpi_lgen 
1465
1466
1467
1468
1469  SUBROUTINE gather_mpi_igen(VarIn, VarOut, dimsize)
1470    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1471    USE mod_grid_phy_lmdz
1472    IMPLICIT NONE
1473 
1474#ifdef CPP_MPI
1475    INCLUDE 'mpif.h'
1476#endif
1477   
1478    INTEGER,INTENT(IN) :: dimsize
1479    INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
1480    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
1481 
1482    INTEGER,DIMENSION(0:mpi_size-1) :: displs
1483    INTEGER,DIMENSION(0:mpi_size-1) :: counts
1484    INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp
1485    INTEGER :: nb,i,index,rank
1486    INTEGER :: ierr
1487
1488    IF (.not.is_using_mpi) THEN
1489      VarOut(:,:)=VarIn(:,:)
1490      RETURN
1491    ENDIF
1492
1493    IF (is_mpi_root) THEN
1494      Index=1
1495      DO rank=0,mpi_size-1
1496        nb=klon_mpi_para_nb(rank)
1497        displs(rank)=Index-1
1498        counts(rank)=nb*dimsize
1499        Index=Index+nb*dimsize
1500      ENDDO
1501     
1502    ENDIF
1503   
1504#ifdef CPP_MPI
1505    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_INTEGER,VarTmp,counts,displs,   &
1506                     MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
1507#endif
1508
1509                         
1510    IF (is_mpi_root) THEN
1511      Index=1
1512      DO rank=0,mpi_size-1
1513        nb=klon_mpi_para_nb(rank)
1514        DO i=1,dimsize
1515          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
1516          Index=Index+nb
1517        ENDDO
1518      ENDDO
1519    ENDIF
1520
1521  END SUBROUTINE gather_mpi_igen 
1522
1523  SUBROUTINE gather_mpi_rgen(VarIn, VarOut, dimsize)
1524    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1525    USE mod_grid_phy_lmdz
1526    IMPLICIT NONE
1527 
1528#ifdef CPP_MPI
1529    INCLUDE 'mpif.h'
1530#endif
1531   
1532    INTEGER,INTENT(IN) :: dimsize
1533    REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
1534    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
1535 
1536    INTEGER,DIMENSION(0:mpi_size-1) :: displs
1537    INTEGER,DIMENSION(0:mpi_size-1) :: counts
1538    REAL,DIMENSION(dimsize*klon_glo) :: VarTmp
1539    INTEGER :: nb,i,index,rank
1540    INTEGER :: ierr
1541
1542    IF (is_mpi_root) THEN
1543      Index=1
1544      DO rank=0,mpi_size-1
1545        nb=klon_mpi_para_nb(rank)
1546        displs(rank)=Index-1
1547        counts(rank)=nb*dimsize
1548        Index=Index+nb*dimsize
1549      ENDDO
1550    ENDIF
1551   
1552    IF (.not.is_using_mpi) THEN
1553      VarOut(:,:)=VarIn(:,:)
1554      RETURN
1555    ENDIF
1556
1557#ifdef CPP_MPI
1558    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_REAL_LMDZ,VarTmp,counts,displs,   &
1559                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
1560#endif
1561                         
1562    IF (is_mpi_root) THEN
1563      Index=1
1564      DO rank=0,mpi_size-1
1565        nb=klon_mpi_para_nb(rank)
1566        DO i=1,dimsize
1567          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
1568          Index=Index+nb
1569        ENDDO
1570      ENDDO
1571    ENDIF
1572
1573  END SUBROUTINE gather_mpi_rgen 
1574
1575  SUBROUTINE gather_mpi_lgen(VarIn, VarOut, dimsize)
1576    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1577    USE mod_grid_phy_lmdz
1578    IMPLICIT NONE
1579 
1580    INTEGER,INTENT(IN) :: dimsize
1581    LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
1582    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
1583 
1584#ifdef CPP_MPI
1585    INCLUDE 'mpif.h'
1586#endif
1587
1588    INTEGER,DIMENSION(0:mpi_size-1) :: displs
1589    INTEGER,DIMENSION(0:mpi_size-1) :: counts
1590    LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp
1591    INTEGER :: nb,i,index,rank
1592    INTEGER :: ierr
1593   
1594    IF (.not.is_using_mpi) THEN
1595      VarOut(:,:)=VarIn(:,:)
1596      RETURN
1597    ENDIF
1598
1599    IF (is_mpi_root) THEN
1600      Index=1
1601      DO rank=0,mpi_size-1
1602        nb=klon_mpi_para_nb(rank)
1603        displs(rank)=Index-1
1604        counts(rank)=nb*dimsize
1605        Index=Index+nb*dimsize
1606      ENDDO
1607    ENDIF
1608   
1609
1610#ifdef CPP_MPI
1611    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs,   &
1612                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
1613#endif
1614                         
1615    IF (is_mpi_root) THEN
1616      Index=1
1617      DO rank=0,mpi_size-1
1618        nb=klon_mpi_para_nb(rank)
1619        DO i=1,dimsize
1620          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
1621          Index=Index+nb
1622        ENDDO
1623      ENDDO
1624    ENDIF
1625
1626  END SUBROUTINE gather_mpi_lgen
1627 
1628
1629
1630  SUBROUTINE reduce_sum_mpi_igen(VarIn,VarOut,nb)
1631    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1632    USE mod_grid_phy_lmdz
1633    IMPLICIT NONE
1634   
1635#ifdef CPP_MPI
1636    INCLUDE 'mpif.h'
1637#endif
1638   
1639    INTEGER,DIMENSION(nb),INTENT(IN) :: VarIn
1640    INTEGER,DIMENSION(nb),INTENT(OUT) :: VarOut   
1641    INTEGER,INTENT(IN) :: nb
1642    INTEGER :: ierr
1643   
1644    IF (.not.is_using_mpi) THEN
1645      VarOut(:)=VarIn(:)
1646      RETURN
1647    ENDIF
1648
1649
1650#ifdef CPP_MPI
1651    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
1652#endif
1653           
1654  END SUBROUTINE reduce_sum_mpi_igen
1655 
1656  SUBROUTINE reduce_sum_mpi_rgen(VarIn,VarOut,nb)
1657    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
1658    USE mod_grid_phy_lmdz
1659
1660    IMPLICIT NONE
1661
1662#ifdef CPP_MPI
1663    INCLUDE 'mpif.h'
1664#endif
1665   
1666    REAL,DIMENSION(nb),INTENT(IN) :: VarIn
1667    REAL,DIMENSION(nb),INTENT(OUT) :: VarOut   
1668    INTEGER,INTENT(IN) :: nb
1669    INTEGER :: ierr
1670 
1671    IF (.not.is_using_mpi) THEN
1672      VarOut(:)=VarIn(:)
1673      RETURN
1674    ENDIF
1675   
1676#ifdef CPP_MPI
1677    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
1678#endif
1679       
1680  END SUBROUTINE reduce_sum_mpi_rgen
1681
1682
1683
1684  SUBROUTINE grid1dTo2d_mpi_igen(VarIn,VarOut,dimsize)
1685    USE mod_phys_lmdz_mpi_data
1686    USE mod_grid_phy_lmdz
1687    IMPLICIT NONE
1688   
1689    INTEGER,INTENT(IN) :: dimsize
1690    INTEGER,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
1691    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
1692    INTEGER :: i,ij,Offset
1693
1694   
1695    VarOut(1:nbp_lon,:)=0
1696    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0
1697   
1698    offset=ii_begin
1699    IF (is_north_pole) Offset=nbp_lon
1700   
1701   
1702    DO i=1,dimsize
1703      DO ij=1,klon_mpi
1704        VarOut(ij+offset-1,i)=VarIn(ij,i)
1705      ENDDO
1706    ENDDO
1707   
1708   
1709    IF (is_north_pole) THEN
1710      DO i=1,dimsize
1711        DO ij=1,nbp_lon
1712         VarOut(ij,i)=VarIn(1,i)
1713        ENDDO
1714      ENDDO
1715    ENDIF
1716   
1717    IF (is_south_pole) THEN
1718      DO i=1,dimsize
1719        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
1720         VarOut(ij,i)=VarIn(klon_mpi,i)
1721        ENDDO
1722      ENDDO
1723    ENDIF
1724
1725  END SUBROUTINE grid1dTo2d_mpi_igen   
1726
1727
1728  SUBROUTINE grid1dTo2d_mpi_rgen(VarIn,VarOut,dimsize)
1729    USE mod_phys_lmdz_mpi_data
1730    USE mod_grid_phy_lmdz
1731    IMPLICIT NONE
1732   
1733    INTEGER,INTENT(IN) :: dimsize
1734    REAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
1735    REAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
1736    INTEGER :: i,ij,Offset
1737
1738   
1739    VarOut(1:nbp_lon,:)=0
1740    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0
1741   
1742    offset=ii_begin
1743    IF (is_north_pole) Offset=nbp_lon
1744   
1745   
1746    DO i=1,dimsize
1747      DO ij=1,klon_mpi
1748        VarOut(ij+offset-1,i)=VarIn(ij,i)
1749      ENDDO
1750    ENDDO
1751   
1752   
1753    IF (is_north_pole) THEN
1754      DO i=1,dimsize
1755        DO ij=1,nbp_lon
1756         VarOut(ij,i)=VarIn(1,i)
1757        ENDDO
1758      ENDDO
1759    ENDIF
1760   
1761    IF (is_south_pole) THEN
1762      DO i=1,dimsize
1763        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
1764         VarOut(ij,i)=VarIn(klon_mpi,i)
1765        ENDDO
1766      ENDDO
1767    ENDIF
1768
1769   END SUBROUTINE grid1dTo2d_mpi_rgen   
1770
1771
1772
1773  SUBROUTINE grid1dTo2d_mpi_lgen(VarIn,VarOut,dimsize)
1774    USE mod_phys_lmdz_mpi_data
1775    USE mod_grid_phy_lmdz
1776    IMPLICIT NONE
1777   
1778    INTEGER,INTENT(IN) :: dimsize
1779    LOGICAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
1780    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
1781    INTEGER :: i,ij,Offset
1782
1783   
1784    VarOut(1:nbp_lon,:)=.FALSE.
1785    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=.FALSE.
1786   
1787    offset=ii_begin
1788    IF (is_north_pole) Offset=nbp_lon
1789   
1790   
1791    DO i=1,dimsize
1792      DO ij=1,klon_mpi
1793        VarOut(ij+offset-1,i)=VarIn(ij,i)
1794      ENDDO
1795    ENDDO
1796   
1797   
1798    IF (is_north_pole) THEN
1799      DO i=1,dimsize
1800        DO ij=1,nbp_lon
1801         VarOut(ij,i)=VarIn(1,i)
1802        ENDDO
1803      ENDDO
1804    ENDIF
1805   
1806    IF (is_south_pole) THEN
1807      DO i=1,dimsize
1808        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
1809         VarOut(ij,i)=VarIn(klon_mpi,i)
1810        ENDDO
1811      ENDDO
1812    ENDIF
1813
1814   END SUBROUTINE grid1dTo2d_mpi_lgen   
1815
1816 
1817
1818
1819  SUBROUTINE grid2dTo1d_mpi_igen(VarIn,VarOut,dimsize)
1820    USE mod_phys_lmdz_mpi_data
1821    USE mod_grid_phy_lmdz
1822    IMPLICIT NONE
1823   
1824    INTEGER,INTENT(IN) :: dimsize
1825    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
1826    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
1827    INTEGER :: i,ij,offset
1828
1829    offset=ii_begin
1830    IF (is_north_pole) offset=nbp_lon
1831
1832    DO i=1,dimsize
1833      DO ij=1,klon_mpi
1834        VarOut(ij,i)=VarIn(ij+offset-1,i)
1835      ENDDO
1836    ENDDO
1837
1838    IF (is_north_pole) THEN
1839      DO i=1,dimsize
1840        VarOut(1,i)=VarIn(1,i)
1841      ENDDO
1842    ENDIF
1843   
1844   
1845  END SUBROUTINE grid2dTo1d_mpi_igen   
1846
1847
1848
1849  SUBROUTINE grid2dTo1d_mpi_rgen(VarIn,VarOut,dimsize)
1850    USE mod_phys_lmdz_mpi_data
1851    USE mod_grid_phy_lmdz
1852    IMPLICIT NONE
1853   
1854    INTEGER,INTENT(IN) :: dimsize
1855    REAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
1856    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
1857    INTEGER :: i,ij,offset
1858
1859    offset=ii_begin
1860    IF (is_north_pole) offset=nbp_lon
1861
1862    DO i=1,dimsize
1863      DO ij=1,klon_mpi
1864        VarOut(ij,i)=VarIn(ij+offset-1,i)
1865      ENDDO
1866    ENDDO
1867
1868    IF (is_north_pole) THEN
1869      DO i=1,dimsize
1870         VarOut(1,i)=VarIn(1,i)
1871      ENDDO
1872    ENDIF
1873   
1874   
1875  END SUBROUTINE grid2dTo1d_mpi_rgen   
1876 
1877
1878  SUBROUTINE grid2dTo1d_mpi_lgen(VarIn,VarOut,dimsize)
1879    USE mod_phys_lmdz_mpi_data
1880    USE mod_grid_phy_lmdz
1881    IMPLICIT NONE
1882   
1883    INTEGER,INTENT(IN) :: dimsize
1884    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
1885    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
1886    INTEGER :: i,ij,offset
1887
1888    offset=ii_begin
1889    IF (is_north_pole) offset=nbp_lon
1890
1891    DO i=1,dimsize
1892      DO ij=1,klon_mpi
1893        VarOut(ij,i)=VarIn(ij+offset-1,i)
1894      ENDDO
1895    ENDDO
1896
1897    IF (is_north_pole) THEN
1898      DO i=1,dimsize
1899        VarOut(1,i)=VarIn(1,i)
1900      ENDDO
1901    ENDIF
1902   
1903   
1904  END SUBROUTINE grid2dTo1d_mpi_lgen   
1905
1906END MODULE mod_phys_lmdz_mpi_transfert
Note: See TracBrowser for help on using the repository browser.