source: branches/publications/ORCHIDEE_gmd_mict_peat_ch4/src_parallel/mod_orchidee_mpi_transfert.F90 @ 7346

Last change on this file since 7346 was 3927, checked in by albert.jornet, 8 years ago

New: add gather and scatter for 5 dimensions
File size: 72.9 KB
Line 
1! Low level MPI parallel communication encapsulations for ORCHIDEE.
2
3!-
4!- $Header: $
5!-
6
7MODULE mod_orchidee_mpi_transfert
8  !-
9  USE defprec
10  USE mod_orchidee_para_var
11  USE timer
12  !-
13  IMPLICIT NONE
14  !-
15#include "src_parallel.h"
16  !-
17
18  INTERFACE bcast_mpi
19     MODULE PROCEDURE bcast_mpi_c, bcast_mpi_c1,                           &
20          bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
21          bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
22          bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
23  END INTERFACE
24
25  INTERFACE scatter_mpi
26     MODULE PROCEDURE scatter_mpi_i,scatter_mpi_i1,scatter_mpi_i2,scatter_mpi_i3,scatter_mpi_i4, &
27          scatter_mpi_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3,scatter_mpi_r4, &
28          scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3,scatter_mpi_l4
29  END INTERFACE
30
31  INTERFACE gather_mpi_s
32     MODULE PROCEDURE gather_mpi_is, &
33          gather_mpi_rs, &
34          gather_mpi_ls
35  END INTERFACE
36
37  INTERFACE gather_mpi
38     MODULE PROCEDURE gather_mpi_i,gather_mpi_i1,gather_mpi_i2,gather_mpi_i3,gather_mpi_i4, &
39          gather_mpi_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3,gather_mpi_r4, &
40          gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3,gather_mpi_l4 
41  END INTERFACE
42
43  INTERFACE scatter2D_mpi
44     MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, &
45          scatter2D_mpi_r0,scatter2D_mpi_r,scatter2D_mpi_r1,scatter2D_mpi_r2,scatter2D_mpi_r3, &
46          scatter2D_mpi_l,scatter2D_mpi_l1,scatter2D_mpi_l2,scatter2D_mpi_l3
47  END INTERFACE
48
49  INTERFACE gather2D_mpi
50     MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, &
51          gather2D_mpi_r0,gather2D_mpi_r,gather2D_mpi_r1,gather2D_mpi_r2,gather2D_mpi_r3, &
52          gather2D_mpi_l,gather2D_mpi_l1,gather2D_mpi_l2,gather2D_mpi_l3
53  END INTERFACE
54
55  INTERFACE reduce_sum_mpi
56     MODULE PROCEDURE reduce_sum_mpi_i,reduce_sum_mpi_i1,reduce_sum_mpi_i2,reduce_sum_mpi_i3,reduce_sum_mpi_i4, &
57          reduce_sum_mpi_r,reduce_sum_mpi_r1,reduce_sum_mpi_r2,reduce_sum_mpi_r3,reduce_sum_mpi_r4
58  END INTERFACE
59
60CONTAINS
61
62!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
63!! Definition des Broadcast --> 4D   !!
64!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
65
66  !! -- Les chaine de charactère -- !!
67
68  SUBROUTINE bcast_mpi_c(var)
69    IMPLICIT NONE
70    CHARACTER(LEN=*),INTENT(INOUT) :: Var
71    CHARACTER(LEN=len(Var)),DIMENSION(1) :: Var1
72
73#ifndef CPP_PARA
74    RETURN
75#else
76    IF (is_mpi_root) &
77         Var1(1)=Var
78    CALL orch_bcast_mpi_cgen(Var1,1)
79    Var=Var1(1)
80#endif
81  END SUBROUTINE bcast_mpi_c
82
83  SUBROUTINE bcast_mpi_c1(var)
84  IMPLICIT NONE
85    CHARACTER(LEN=*),INTENT(INOUT) :: Var(:)
86   
87#ifndef CPP_PARA
88    RETURN
89#else
90    CALL orch_bcast_mpi_cgen(Var,size(Var))
91#endif
92  END SUBROUTINE bcast_mpi_c1
93
94
95  !! -- Les entiers -- !!
96
97  SUBROUTINE bcast_mpi_i(var)
98    IMPLICIT NONE
99    INTEGER(i_std),INTENT(INOUT) :: Var
100    INTEGER(i_std),DIMENSION(1) :: Var1
101
102#ifndef CPP_PARA
103    RETURN
104#else
105    IF (is_mpi_root) &
106         Var1(1)=Var
107    CALL orch_bcast_mpi_igen(Var1,1)
108    Var=Var1(1)
109#endif
110  END SUBROUTINE bcast_mpi_i
111
112  SUBROUTINE bcast_mpi_i1(var)
113    IMPLICIT NONE
114    INTEGER(i_std),INTENT(INOUT) :: Var(:)
115
116#ifndef CPP_PARA
117    RETURN
118#else
119    CALL orch_bcast_mpi_igen(Var,size(Var))
120#endif
121  END SUBROUTINE bcast_mpi_i1
122
123  SUBROUTINE bcast_mpi_i2(var)
124    IMPLICIT NONE
125    INTEGER(i_std),INTENT(INOUT) :: Var(:,:)
126
127#ifndef CPP_PARA
128    RETURN
129#else
130    CALL orch_bcast_mpi_igen(Var,size(Var))
131#endif
132  END SUBROUTINE bcast_mpi_i2
133
134  SUBROUTINE bcast_mpi_i3(var)
135    IMPLICIT NONE
136    INTEGER(i_std),INTENT(INOUT) :: Var(:,:,:)
137
138#ifndef CPP_PARA
139    RETURN
140#else
141    CALL orch_bcast_mpi_igen(Var,size(Var))
142#endif
143  END SUBROUTINE bcast_mpi_i3
144
145  SUBROUTINE bcast_mpi_i4(var)
146    IMPLICIT NONE
147    INTEGER(i_std),INTENT(INOUT) :: Var(:,:,:,:)
148
149#ifndef CPP_PARA
150    RETURN
151#else
152    CALL orch_bcast_mpi_igen(Var,size(Var))
153#endif
154  END SUBROUTINE bcast_mpi_i4
155
156
157  !! -- Les reels -- !!
158
159  SUBROUTINE bcast_mpi_r(var)
160    IMPLICIT NONE
161    REAL(r_std),INTENT(INOUT) :: Var
162    REAL(r_std),DIMENSION(1) :: Var1
163
164#ifndef CPP_PARA
165    RETURN
166#else
167    IF (is_mpi_root) &
168         Var1(1)=Var
169    CALL orch_bcast_mpi_rgen(Var1,1)
170    Var=Var1(1)
171#endif
172  END SUBROUTINE bcast_mpi_r
173
174  SUBROUTINE bcast_mpi_r1(var)
175    IMPLICIT NONE
176    REAL(r_std),INTENT(INOUT) :: Var(:)
177
178#ifndef CPP_PARA
179    RETURN
180#else
181    CALL orch_bcast_mpi_rgen(Var,size(Var))
182#endif
183  END SUBROUTINE bcast_mpi_r1
184
185  SUBROUTINE bcast_mpi_r2(var)
186    IMPLICIT NONE
187    REAL(r_std),INTENT(INOUT) :: Var(:,:)
188
189#ifndef CPP_PARA
190    RETURN
191#else
192    CALL orch_bcast_mpi_rgen(Var,size(Var))
193#endif
194  END SUBROUTINE bcast_mpi_r2
195
196  SUBROUTINE bcast_mpi_r3(var)
197    IMPLICIT NONE
198    REAL(r_std),INTENT(INOUT) :: Var(:,:,:)
199
200#ifndef CPP_PARA
201    RETURN
202#else
203    CALL orch_bcast_mpi_rgen(Var,size(Var))
204#endif
205  END SUBROUTINE bcast_mpi_r3
206
207  SUBROUTINE bcast_mpi_r4(var)
208    IMPLICIT NONE
209    REAL(r_std),INTENT(INOUT) :: Var(:,:,:,:)
210
211#ifndef CPP_PARA
212    RETURN
213#else
214    CALL orch_bcast_mpi_rgen(Var,size(Var))
215#endif
216  END SUBROUTINE bcast_mpi_r4
217
218  !! -- Les booleans -- !!
219
220  SUBROUTINE bcast_mpi_l(var)
221    IMPLICIT NONE
222    LOGICAL,INTENT(INOUT) :: Var
223    LOGICAL,DIMENSION(1) :: Var1
224#ifndef CPP_PARA
225    RETURN
226#else
227    IF (is_mpi_root) &
228         Var1(1)=Var
229    CALL orch_bcast_mpi_lgen(Var1,1)
230    Var=Var1(1)
231#endif
232  END SUBROUTINE bcast_mpi_l
233
234  SUBROUTINE bcast_mpi_l1(var)
235    IMPLICIT NONE
236    LOGICAL,INTENT(INOUT) :: Var(:)
237
238#ifndef CPP_PARA
239    RETURN
240#else
241    CALL orch_bcast_mpi_lgen(Var,size(Var))
242#endif
243  END SUBROUTINE bcast_mpi_l1
244
245  SUBROUTINE bcast_mpi_l2(var)
246    IMPLICIT NONE
247    LOGICAL,INTENT(INOUT) :: Var(:,:)
248
249#ifndef CPP_PARA
250    RETURN
251#else
252    CALL orch_bcast_mpi_lgen(Var,size(Var))
253#endif
254  END SUBROUTINE bcast_mpi_l2
255
256  SUBROUTINE bcast_mpi_l3(var)
257    IMPLICIT NONE
258    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
259
260#ifndef CPP_PARA
261    RETURN
262#else
263    CALL orch_bcast_mpi_lgen(Var,size(Var))
264#endif
265  END SUBROUTINE bcast_mpi_l3
266
267  SUBROUTINE bcast_mpi_l4(var)
268    IMPLICIT NONE
269    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
270
271#ifndef CPP_PARA
272    RETURN
273#else
274    CALL orch_bcast_mpi_lgen(Var,size(Var))
275#endif
276  END SUBROUTINE bcast_mpi_l4
277
278!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
279!! Definition des Scatter   --> 4D   !!
280!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
281
282  SUBROUTINE scatter_mpi_i(VarIn, VarOut)
283
284    IMPLICIT NONE
285
286    INTEGER(i_std),INTENT(IN),DIMENSION(nbp_glo) :: VarIn
287    INTEGER(i_std),INTENT(OUT),DIMENSION(nbp_mpi) :: VarOut
288
289
290#ifdef CPP_PARA
291    INTEGER(i_std),DIMENSION(1) :: dummy
292#endif
293
294#ifndef CPP_PARA
295    VarOut(:)=VarIn(:)
296    RETURN
297#else
298
299    IF (is_mpi_root) THEN
300       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),1)
301    ELSE
302       CALL orch_scatter_mpi_igen(dummy,Varout,1,1)
303    ENDIF
304
305#endif
306  END SUBROUTINE scatter_mpi_i
307
308  SUBROUTINE scatter_mpi_i1(VarIn, VarOut)
309
310    IMPLICIT NONE
311
312    INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
313    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
314
315#ifdef CPP_PARA
316    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy
317#endif
318
319#ifndef CPP_PARA
320    VarOut(:,:)=VarIn(:,:)
321    RETURN
322#else
323    IF (is_mpi_root) THEN
324       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
325    ELSE
326       CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2))
327    ENDIF
328
329#endif
330  END SUBROUTINE scatter_mpi_i1
331
332  SUBROUTINE scatter_mpi_i2(VarIn, VarOut)
333
334    IMPLICIT NONE
335
336    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
337    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
338
339#ifdef CPP_PARA
340    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
341#endif
342
343#ifndef CPP_PARA
344    VarOut(:,:,:)=VarIn(:,:,:)
345    RETURN
346#else   
347    IF (is_mpi_root) THEN
348       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
349    ELSE
350       CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
351    ENDIF
352#endif
353  END SUBROUTINE scatter_mpi_i2
354
355  SUBROUTINE scatter_mpi_i3(VarIn, VarOut)
356
357    IMPLICIT NONE
358
359    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
360    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
361
362#ifdef CPP_PARA
363    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
364#endif
365
366#ifndef CPP_PARA
367    VarOut(:,:,:,:)=VarIn(:,:,:,:)
368    RETURN
369#else   
370    IF (is_mpi_root) THEN
371       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
372    ELSE
373       CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
374    ENDIF
375
376#endif
377  END SUBROUTINE scatter_mpi_i3
378
379  SUBROUTINE scatter_mpi_i4(VarIn, VarOut)
380
381    IMPLICIT NONE
382
383    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
384    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
385
386#ifdef CPP_PARA
387    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
388#endif
389
390#ifndef CPP_PARA
391    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
392    RETURN
393#else   
394    IF (is_mpi_root) THEN
395       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
396    ELSE
397       CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
398    ENDIF
399
400#endif
401  END SUBROUTINE scatter_mpi_i4
402
403  SUBROUTINE scatter_mpi_r(VarIn, VarOut)
404
405    IMPLICIT NONE
406
407    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
408    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
409
410
411#ifdef CPP_PARA
412    REAL(r_std),DIMENSION(1) :: dummy
413#endif
414
415#ifndef CPP_PARA
416    VarOut(:)=VarIn(:)
417    RETURN
418#else
419    IF (is_mpi_root) THEN
420       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),1)
421    ELSE
422       CALL orch_scatter_mpi_rgen(dummy,Varout,1,1)
423    ENDIF
424#endif
425  END SUBROUTINE scatter_mpi_r
426
427  SUBROUTINE scatter_mpi_r1(VarIn, VarOut)
428
429    IMPLICIT NONE
430
431    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
432    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
433
434#ifdef CPP_PARA
435    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy
436#endif
437
438#ifndef CPP_PARA
439    VarOut(:,:)=VarIn(:,:)
440    RETURN
441#else
442    IF (is_mpi_root) THEN
443       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
444    ELSE
445       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2))
446    ENDIF
447
448#endif
449  END SUBROUTINE scatter_mpi_r1
450
451  SUBROUTINE scatter_mpi_r2(VarIn, VarOut)
452
453    IMPLICIT NONE
454
455    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
456    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
457
458#ifdef CPP_PARA
459    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
460#endif
461
462#ifndef CPP_PARA
463    VarOut(:,:,:)=VarIn(:,:,:)
464    RETURN
465#else
466    IF (is_mpi_root) THEN
467       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
468    ELSE
469       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
470    ENDIF
471
472#endif
473  END SUBROUTINE scatter_mpi_r2
474
475  SUBROUTINE scatter_mpi_r3(VarIn, VarOut)
476
477    IMPLICIT NONE
478
479    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
480    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
481
482#ifdef CPP_PARA
483    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
484#endif
485
486#ifndef CPP_PARA
487    VarOut(:,:,:,:)=VarIn(:,:,:,:)
488    RETURN
489#else
490    IF (is_mpi_root) THEN
491       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
492    ELSE
493       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
494    ENDIF
495#endif
496  END SUBROUTINE scatter_mpi_r3
497
498  SUBROUTINE scatter_mpi_r4(VarIn, VarOut)
499
500    IMPLICIT NONE
501
502    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
503    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
504
505#ifdef CPP_PARA
506    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
507#endif
508
509#ifndef CPP_PARA
510    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
511    RETURN
512#else
513    IF (is_mpi_root) THEN
514       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
515    ELSE
516       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
517    ENDIF
518#endif
519  END SUBROUTINE scatter_mpi_r4
520
521
522  SUBROUTINE scatter_mpi_l(VarIn, VarOut)
523
524    IMPLICIT NONE
525
526    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
527    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
528
529#ifdef CPP_PARA   
530    LOGICAL,DIMENSION(1) :: dummy
531#endif
532
533#ifndef CPP_PARA
534    VarOut(:)=VarIn(:)
535    RETURN
536#else
537    IF (is_mpi_root) THEN
538       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),1)
539    ELSE
540       CALL orch_scatter_mpi_lgen(dummy,Varout,1,1)
541    ENDIF
542#endif
543  END SUBROUTINE scatter_mpi_l
544
545  SUBROUTINE scatter_mpi_l1(VarIn, VarOut)
546
547    IMPLICIT NONE
548
549    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
550    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
551
552#ifdef CPP_PARA
553    LOGICAL,DIMENSION(1,SIZE(VarOut,2)) :: dummy
554#endif
555
556#ifndef CPP_PARA
557    VarOut(:,:)=VarIn(:,:)
558    RETURN
559#else
560    IF (is_mpi_root) THEN
561       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
562    ELSE
563       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2))
564    ENDIF
565#endif
566  END SUBROUTINE scatter_mpi_l1
567
568  SUBROUTINE scatter_mpi_l2(VarIn, VarOut)
569
570    IMPLICIT NONE
571
572    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
573    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
574
575#ifdef CPP_PARA
576    LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
577#endif
578
579#ifndef CPP_PARA
580    VarOut(:,:,:)=VarIn(:,:,:)
581    RETURN
582#else
583    IF (is_mpi_root) THEN
584       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
585    ELSE
586       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
587    ENDIF
588#endif
589  END SUBROUTINE scatter_mpi_l2
590
591  SUBROUTINE scatter_mpi_l3(VarIn, VarOut)
592
593    IMPLICIT NONE
594
595    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
596    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
597
598#ifdef CPP_PARA
599    LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
600#endif
601
602#ifndef CPP_PARA
603    VarOut(:,:,:,:)=VarIn(:,:,:,:)
604    RETURN
605#else
606    IF (is_mpi_root) THEN
607       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
608    ELSE
609       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
610    ENDIF
611#endif
612  END SUBROUTINE scatter_mpi_l3
613
614  SUBROUTINE scatter_mpi_l4(VarIn, VarOut)
615
616    IMPLICIT NONE
617
618    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
619    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
620
621#ifdef CPP_PARA
622    LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
623#endif
624
625#ifndef CPP_PARA
626    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
627    RETURN
628#else
629    IF (is_mpi_root) THEN
630       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
631    ELSE
632       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
633    ENDIF
634#endif
635  END SUBROUTINE scatter_mpi_l4
636
637!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
638!! Definition des Gather   --> 4D   !!
639!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
640
641  SUBROUTINE gather_mpi_is(VarIn, VarOut)
642
643#ifdef CPP_PARA
644    USE mpi
645#endif
646
647    IMPLICIT NONE
648
649    INTEGER(i_std),INTENT(IN) :: VarIn
650    INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
651
652#ifdef CPP_PARA
653    INTEGER(i_std) :: nb,i,index_para,rank
654    INTEGER(i_std) :: ierr
655    LOGICAL :: flag=.FALSE.
656    LOGICAL, PARAMETER :: check=.FALSE.
657#endif
658
659#ifndef CPP_PARA
660    VarOut(:)=VarIn
661    RETURN
662#else
663
664    IF (timer_state(timer_mpi)==running) THEN
665      flag=.TRUE.
666    ELSE
667      flag=.FALSE.
668    ENDIF
669   
670    IF (flag) CALL suspend_timer(timer_mpi)
671
672    IF (check) &
673         WRITE(numout,*) "gather_mpi_is VarIn=",VarIn   
674
675#ifdef CPP_PARA
676    CALL MPI_GATHER(VarIn,1,MPI_INT_ORCH,VarOut,1,MPI_INT_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
677#endif
678
679    IF (check) &
680         WRITE(numout,*) "gather_mpi_is VarOut=",VarOut
681    IF (flag) CALL resume_timer(timer_mpi)
682#endif
683  END SUBROUTINE gather_mpi_is
684
685  SUBROUTINE gather_mpi_rs(VarIn, VarOut)
686
687#ifdef CPP_PARA
688    USE mpi
689#endif
690
691    IMPLICIT NONE
692
693    REAL(r_std),INTENT(IN) :: VarIn
694    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
695
696#ifdef CPP_PARA
697    INTEGER(i_std) :: nb,i,index_para,rank
698    INTEGER(i_std) :: ierr
699    LOGICAL :: flag=.FALSE.
700    LOGICAL, PARAMETER :: check=.FALSE.
701#endif
702
703#ifndef CPP_PARA
704    VarOut(:)=VarIn
705    RETURN
706#else
707
708    IF (timer_state(timer_mpi)==running) THEN
709      flag=.TRUE.
710    ELSE
711      flag=.FALSE.
712    ENDIF
713   
714    IF (flag) CALL suspend_timer(timer_mpi)
715
716    IF (check) &
717         WRITE(numout,*) "gather_mpi_rs VarIn=",VarIn   
718
719#ifdef CPP_PARA
720    CALL MPI_GATHER(VarIn,1,MPI_REAL_ORCH,VarOut,1,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
721#endif
722
723    IF (check) &
724         WRITE(numout,*) "gather_mpi_rs VarOut=",VarOut
725
726    IF (flag) CALL resume_timer(timer_mpi)
727#endif
728  END SUBROUTINE gather_mpi_rs
729
730  SUBROUTINE gather_mpi_ls(VarIn, VarOut)
731
732#ifdef CPP_PARA
733    USE mpi
734#endif
735
736    IMPLICIT NONE
737
738    LOGICAL,INTENT(IN) :: VarIn
739    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
740
741#ifdef CPP_PARA
742    INTEGER(i_std) :: nb,i,index_para,rank
743    INTEGER(i_std) :: ierr
744    LOGICAL :: flag=.FALSE.
745    LOGICAL, PARAMETER :: check=.FALSE.
746#endif
747
748#ifndef CPP_PARA
749    VarOut(:)=VarIn
750    RETURN
751#else
752
753    IF (timer_state(timer_mpi)==running) THEN
754      flag=.TRUE.
755    ELSE
756      flag=.FALSE.
757    ENDIF
758   
759    IF (flag) CALL suspend_timer(timer_mpi)
760
761    IF (check) &
762         WRITE(numout,*) "gather_mpi_ls VarIn=",VarIn   
763
764#ifdef CPP_PARA
765    CALL MPI_GATHER(VarIn,1,MPI_LOGICAL,VarOut,1,MPI_LOGICAL,mpi_rank_root,MPI_COMM_ORCH,ierr)
766#endif
767
768    IF (check) &
769         WRITE(numout,*) "gather_mpi_ls VarOut=",VarOut
770    IF (flag) CALL resume_timer(timer_mpi)
771#endif
772  END SUBROUTINE gather_mpi_ls
773
774!!!!! --> Les entiers
775
776  SUBROUTINE gather_mpi_i(VarIn, VarOut)
777
778    IMPLICIT NONE
779
780    INTEGER(i_std),INTENT(IN),DIMENSION(:) :: VarIn
781    INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
782
783#ifdef CPP_PARA
784    INTEGER(i_std),DIMENSION(1) :: dummy
785#endif
786
787#ifndef CPP_PARA
788    VarOut(:)=VarIn(:)
789    RETURN
790#else
791
792    IF (is_mpi_root) THEN
793       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),1)
794    ELSE
795       CALL orch_gather_mpi_igen(VarIn,dummy,1,1)
796    ENDIF
797
798#endif
799  END SUBROUTINE gather_mpi_i
800
801!!!!!
802
803  SUBROUTINE gather_mpi_i1(VarIn, VarOut)
804
805    IMPLICIT NONE
806
807    INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
808    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
809
810#ifdef CPP_PARA
811    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy
812#endif
813
814#ifndef CPP_PARA
815    VarOut(:,:)=VarIn(:,:)
816    RETURN
817#else
818
819    IF (is_mpi_root) THEN
820       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
821    ELSE
822       CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2))
823    ENDIF
824
825#endif
826  END SUBROUTINE gather_mpi_i1
827
828!!!!!
829
830  SUBROUTINE gather_mpi_i2(VarIn, VarOut)
831
832    IMPLICIT NONE
833
834    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
835    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
836
837#ifdef CPP_PARA
838    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
839#endif
840
841#ifndef CPP_PARA
842    VarOut(:,:,:)=VarIn(:,:,:)
843    RETURN
844#else
845
846    IF (is_mpi_root) THEN
847       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
848    ELSE
849       CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
850    ENDIF
851
852#endif
853  END SUBROUTINE gather_mpi_i2
854
855!!!!!
856
857  SUBROUTINE gather_mpi_i3(VarIn, VarOut)
858
859    IMPLICIT NONE
860
861    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
862    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
863
864#ifdef CPP_PARA
865    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
866#endif
867
868#ifndef CPP_PARA
869    VarOut(:,:,:,:)=VarIn(:,:,:,:)
870    RETURN
871#else
872
873    IF (is_mpi_root) THEN
874       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
875    ELSE
876       CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
877    ENDIF
878
879#endif
880  END SUBROUTINE gather_mpi_i3
881
882!!!!!
883
884  SUBROUTINE gather_mpi_i4(VarIn, VarOut)
885
886    IMPLICIT NONE
887
888    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
889    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
890
891#ifdef CPP_PARA
892    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
893#endif
894
895#ifndef CPP_PARA
896    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
897    RETURN
898#else
899
900    IF (is_mpi_root) THEN
901       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
902    ELSE
903       CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
904    ENDIF
905
906#endif
907  END SUBROUTINE gather_mpi_i4
908
909!!!!! --> Les reels
910
911  SUBROUTINE gather_mpi_r(VarIn, VarOut)
912
913    IMPLICIT NONE
914
915    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
916    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
917
918#ifdef CPP_PARA
919    REAL(r_std),DIMENSION(1) :: dummy
920#endif
921
922#ifndef CPP_PARA
923    VarOut(:)=VarIn(:)
924    RETURN
925#else
926
927    IF (is_mpi_root) THEN
928       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1)
929    ELSE
930       CALL orch_gather_mpi_rgen(VarIn,dummy,1,1)
931    ENDIF
932
933#endif
934  END SUBROUTINE gather_mpi_r
935
936!!!!!
937
938  SUBROUTINE gather_mpi_r1(VarIn, VarOut)
939
940    IMPLICIT NONE
941
942    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
943    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
944
945#ifdef CPP_PARA
946    REAL(r_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy
947#endif
948
949#ifndef CPP_PARA
950    VarOut(:,:)=VarIn(:,:)
951    RETURN
952#else
953
954    IF (is_mpi_root) THEN
955       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
956    ELSE
957       CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2))
958    ENDIF
959
960#endif
961  END SUBROUTINE gather_mpi_r1
962
963!!!!!
964
965  SUBROUTINE gather_mpi_r2(VarIn, VarOut)
966
967    IMPLICIT NONE
968
969    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
970    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
971
972#ifdef CPP_PARA
973    REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
974#endif
975
976#ifndef CPP_PARA
977    VarOut(:,:,:)=VarIn(:,:,:)
978    RETURN
979#else
980
981    IF (is_mpi_root) THEN
982       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
983    ELSE
984       CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
985    ENDIF
986
987#endif
988  END SUBROUTINE gather_mpi_r2
989
990!!!!!
991
992  SUBROUTINE gather_mpi_r3(VarIn, VarOut)
993
994    IMPLICIT NONE
995
996    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
997    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
998
999#ifdef CPP_PARA
1000    REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
1001#endif
1002
1003#ifndef CPP_PARA
1004    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1005    RETURN
1006#else
1007
1008    IF (is_mpi_root) THEN
1009       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
1010    ELSE
1011       CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
1012    ENDIF
1013
1014#endif
1015  END SUBROUTINE gather_mpi_r3
1016
1017!!!!!
1018
1019  SUBROUTINE gather_mpi_r4(VarIn, VarOut)
1020
1021    IMPLICIT NONE
1022
1023    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1024    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1025
1026#ifdef CPP_PARA
1027    REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
1028#endif
1029
1030#ifndef CPP_PARA
1031    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1032    RETURN
1033#else
1034
1035    IF (is_mpi_root) THEN
1036       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
1037    ELSE
1038       CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
1039    ENDIF
1040
1041#endif
1042  END SUBROUTINE gather_mpi_r4
1043
1044!!!!! --> Les booleen
1045
1046  SUBROUTINE gather_mpi_l(VarIn, VarOut)
1047
1048    IMPLICIT NONE
1049
1050    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
1051    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
1052
1053#ifdef CPP_PARA
1054    LOGICAL,DIMENSION(1) :: dummy
1055#endif
1056
1057#ifndef CPP_PARA
1058    VarOut(:)=VarIn(:)
1059    RETURN
1060#else
1061
1062    IF (is_mpi_root) THEN
1063       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),1)
1064    ELSE
1065       CALL orch_gather_mpi_lgen(VarIn,dummy,1,1)     
1066    ENDIF
1067
1068#endif
1069  END SUBROUTINE gather_mpi_l
1070
1071!!!!!
1072
1073  SUBROUTINE gather_mpi_l1(VarIn, VarOut)
1074
1075    IMPLICIT NONE
1076
1077    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1078    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1079
1080#ifdef CPP_PARA
1081    LOGICAL,DIMENSION(1,SIZE(VarIn,2)) :: dummy
1082#endif
1083
1084#ifndef CPP_PARA
1085    VarOut(:,:)=VarIn(:,:)
1086    RETURN
1087#else
1088
1089    IF (is_mpi_root) THEN
1090       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
1091    ELSE
1092       CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2))
1093    ENDIF
1094
1095#endif
1096  END SUBROUTINE gather_mpi_l1
1097
1098!!!!!
1099
1100  SUBROUTINE gather_mpi_l2(VarIn, VarOut)
1101
1102    IMPLICIT NONE
1103
1104    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1105    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1106
1107#ifdef CPP_PARA
1108    LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
1109#endif
1110
1111#ifndef CPP_PARA
1112    VarOut(:,:,:)=VarIn(:,:,:)
1113    RETURN
1114#else
1115
1116    IF (is_mpi_root) THEN
1117       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
1118    ELSE
1119       CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
1120    ENDIF
1121
1122#endif
1123  END SUBROUTINE gather_mpi_l2
1124
1125!!!!!
1126
1127  SUBROUTINE gather_mpi_l3(VarIn, VarOut)
1128
1129    IMPLICIT NONE
1130
1131    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1132    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1133
1134#ifdef CPP_PARA
1135    LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
1136#endif
1137
1138#ifndef CPP_PARA
1139    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1140    RETURN
1141#else
1142
1143    IF (is_mpi_root) THEN
1144       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
1145    ELSE
1146       CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
1147    ENDIF
1148
1149#endif
1150  END SUBROUTINE gather_mpi_l3
1151
1152!!!!!
1153
1154  SUBROUTINE gather_mpi_l4(VarIn, VarOut)
1155
1156    IMPLICIT NONE
1157
1158    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1159    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1160
1161#ifdef CPP_PARA
1162    LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
1163#endif
1164
1165#ifndef CPP_PARA
1166    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1167    RETURN
1168#else
1169
1170    IF (is_mpi_root) THEN
1171       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
1172    ELSE
1173       CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
1174    ENDIF
1175
1176#endif
1177  END SUBROUTINE gather_mpi_l4
1178!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1179!! Definition des Scatter2D   --> 4D   !!
1180!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1181
1182  SUBROUTINE scatter2D_mpi_i(VarIn, VarOut)
1183
1184    IMPLICIT NONE
1185
1186    INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
1187    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
1188
1189#ifdef CPP_PARA
1190    INTEGER(i_std),DIMENSION(1,1) :: dummy
1191#endif
1192
1193#ifndef CPP_PARA
1194    VarOut(:,:)=VarIn(:,:)
1195    RETURN
1196#else
1197
1198    IF (is_mpi_root) THEN
1199       CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
1200    ELSE
1201       CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,1)
1202    ENDIF
1203
1204
1205#endif
1206  END SUBROUTINE scatter2D_mpi_i
1207
1208  SUBROUTINE scatter2D_mpi_i1(VarIn, VarOut)
1209
1210    IMPLICIT NONE
1211
1212    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
1213    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1214
1215#ifdef CPP_PARA
1216    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)) :: dummy
1217#endif
1218
1219#ifndef CPP_PARA
1220    VarOut(:,:,:)=VarIn(:,:,:)
1221    RETURN
1222#else
1223
1224    IF (is_mpi_root) THEN
1225       CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
1226    ELSE
1227       CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3))
1228    ENDIF
1229
1230#endif
1231  END SUBROUTINE scatter2D_mpi_i1
1232
1233  SUBROUTINE scatter2D_mpi_i2(VarIn, VarOut)
1234
1235    IMPLICIT NONE
1236
1237    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1238    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1239
1240#ifdef CPP_PARA
1241    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
1242#endif
1243
1244#ifndef CPP_PARA
1245    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1246    RETURN
1247#else
1248
1249    IF (is_mpi_root) THEN
1250       CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4))
1251    ELSE
1252       CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
1253    ENDIF
1254
1255
1256#endif
1257  END SUBROUTINE scatter2D_mpi_i2
1258
1259  SUBROUTINE scatter2D_mpi_i3(VarIn, VarOut)
1260
1261    IMPLICIT NONE
1262
1263    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:)  :: VarIn
1264    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1265
1266#ifdef CPP_PARA
1267    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
1268#endif
1269
1270#ifndef CPP_PARA
1271    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1272    RETURN
1273#else
1274
1275    IF (is_mpi_root) THEN
1276       CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
1277    ELSE
1278       CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
1279    ENDIF
1280
1281#endif
1282  END SUBROUTINE scatter2D_mpi_i3
1283
1284
1285  SUBROUTINE scatter2D_mpi_r0(VarIn, VarOut)
1286
1287    IMPLICIT NONE
1288
1289    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
1290    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
1291
1292#ifdef CPP_PARA
1293    REAL(r_std),DIMENSION(1) :: dummy
1294#endif
1295
1296#ifndef CPP_PARA
1297    VarOut(:)=VarIn(:)
1298    RETURN
1299#else
1300
1301    IF (is_mpi_root) THEN
1302       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1),1)
1303    ELSE
1304       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,1)     
1305    ENDIF
1306
1307
1308#endif
1309  END SUBROUTINE scatter2D_mpi_r0
1310
1311  SUBROUTINE scatter2D_mpi_r(VarIn, VarOut)
1312
1313    IMPLICIT NONE
1314
1315    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
1316    REAL(r_std),INTENT(INOUT),DIMENSION(:,:) :: VarOut
1317
1318#ifdef CPP_PARA
1319    REAL(r_std),DIMENSION(1,1) :: dummy
1320#endif
1321
1322#ifndef CPP_PARA
1323    VarOut(:,:)=VarIn(:,:)
1324    RETURN
1325#else
1326
1327    IF (is_mpi_root) THEN
1328       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
1329    ELSE
1330       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,1)
1331    ENDIF
1332
1333#endif
1334  END SUBROUTINE scatter2D_mpi_r
1335
1336  SUBROUTINE scatter2D_mpi_r1(VarIn, VarOut)
1337
1338    IMPLICIT NONE
1339
1340    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
1341    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1342
1343#ifdef CPP_PARA
1344    REAL(r_std),DIMENSION(1,SIZE(VarOut,3)) :: dummy
1345#endif
1346
1347#ifndef CPP_PARA
1348    VarOut(:,:,:)=VarIn(:,:,:)
1349    RETURN
1350#else
1351
1352    IF (is_mpi_root) THEN
1353       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
1354    ELSE
1355       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3))
1356    ENDIF
1357
1358#endif
1359  END SUBROUTINE scatter2D_mpi_r1
1360
1361  SUBROUTINE scatter2D_mpi_r2(VarIn, VarOut)
1362
1363    IMPLICIT NONE
1364
1365    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1366    REAL(r_std),INTENT(INOUT),DIMENSION(:,:,:,:) :: VarOut
1367
1368#ifdef CPP_PARA
1369    REAL(r_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
1370#endif
1371
1372#ifndef CPP_PARA
1373    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1374    RETURN
1375#else
1376
1377    IF (is_mpi_root) THEN
1378       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4))
1379    ELSE
1380       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
1381    ENDIF
1382
1383#endif
1384  END SUBROUTINE scatter2D_mpi_r2
1385
1386  SUBROUTINE scatter2D_mpi_r3(VarIn, VarOut)
1387
1388    IMPLICIT NONE
1389
1390    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:)  :: VarIn
1391    REAL(r_std),INTENT(INOUT),DIMENSION(:,:,:,:,:) :: VarOut
1392
1393#ifdef CPP_PARA
1394    REAL(r_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
1395#endif
1396
1397#ifndef CPP_PARA
1398    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1399    RETURN
1400#else
1401
1402    IF (is_mpi_root) THEN
1403       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
1404    ELSE
1405       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
1406    ENDIF
1407
1408#endif
1409  END SUBROUTINE scatter2D_mpi_r3
1410
1411
1412  SUBROUTINE scatter2D_mpi_l(VarIn, VarOut)
1413
1414    IMPLICIT NONE
1415
1416    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1417    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1418
1419#ifdef CPP_PARA
1420    LOGICAL,DIMENSION(1,1) :: dummy
1421#endif
1422
1423#ifndef CPP_PARA
1424    VarOut(:,:)=VarIn(:,:)
1425    RETURN
1426#else
1427
1428    IF (is_mpi_root) THEN
1429       CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
1430    ELSE
1431       CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,1)
1432    ENDIF
1433
1434#endif
1435  END SUBROUTINE scatter2D_mpi_l
1436
1437  SUBROUTINE scatter2D_mpi_l1(VarIn, VarOut)
1438
1439    IMPLICIT NONE
1440
1441    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1442    LOGICAL,INTENT(INOUT),DIMENSION(:,:,:) :: VarOut
1443
1444#ifdef CPP_PARA   
1445    LOGICAL,DIMENSION(1,SIZE(VarOut,3)) :: dummy
1446#endif
1447
1448#ifndef CPP_PARA
1449    VarOut(:,:,:)=VarIn(:,:,:)
1450    RETURN
1451#else
1452
1453    IF (is_mpi_root) THEN
1454       CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
1455    ELSE
1456       CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3))
1457    ENDIF
1458
1459#endif
1460  END SUBROUTINE scatter2D_mpi_l1
1461
1462  SUBROUTINE scatter2D_mpi_l2(VarIn, VarOut)
1463
1464    IMPLICIT NONE
1465
1466    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1467    LOGICAL,INTENT(INOUT),DIMENSION(:,:,:,:) :: VarOut
1468
1469#ifdef CPP_PARA
1470    LOGICAL,DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
1471#endif
1472
1473#ifndef CPP_PARA
1474    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1475    RETURN
1476#else
1477
1478    IF (is_mpi_root) THEN
1479       CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4))
1480    ELSE
1481       CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
1482    ENDIF
1483
1484#endif
1485  END SUBROUTINE scatter2D_mpi_l2
1486
1487  SUBROUTINE scatter2D_mpi_l3(VarIn, VarOut)
1488
1489    IMPLICIT NONE
1490
1491    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:)  :: VarIn
1492    LOGICAL,INTENT(INOUT),DIMENSION(:,:,:,:,:) :: VarOut
1493
1494#ifdef CPP_PARA
1495    LOGICAL,DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
1496#endif
1497
1498#ifndef CPP_PARA
1499    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1500    RETURN
1501#else
1502
1503    IF (is_mpi_root) THEN
1504       CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
1505    ELSE
1506       CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
1507    ENDIF
1508
1509#endif
1510  END SUBROUTINE scatter2D_mpi_l3
1511
1512
1513!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1514!! Definition des Gather2D   --> 4D   !!
1515!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1516
1517  SUBROUTINE gather2D_mpi_i(VarIn, VarOut)
1518
1519    IMPLICIT NONE
1520
1521    INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
1522    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
1523
1524#ifdef CPP_PARA
1525    INTEGER(i_std),DIMENSION(1,1) :: dummy
1526#endif
1527
1528#ifndef CPP_PARA
1529    VarOut(:,:)=VarIn(:,:)
1530    RETURN
1531#else
1532
1533    IF (is_mpi_root) THEN
1534       CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
1535    ELSE
1536       CALL orch_gather2D_mpi_igen(VarIn,dummy,1,1)
1537    ENDIF
1538
1539#endif
1540  END SUBROUTINE gather2D_mpi_i
1541
1542  SUBROUTINE gather2D_mpi_i1(VarIn, VarOut)
1543
1544    IMPLICIT NONE
1545
1546    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
1547    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1548
1549#ifdef CPP_PARA
1550    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)) :: dummy
1551#endif
1552
1553#ifndef CPP_PARA
1554    VarOut(:,:,:)=VarIn(:,:,:)
1555    RETURN
1556#else
1557
1558    IF (is_mpi_root) THEN
1559       CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
1560    ELSE
1561       CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3))
1562    ENDIF
1563
1564#endif
1565  END SUBROUTINE gather2D_mpi_i1
1566
1567  SUBROUTINE gather2D_mpi_i2(VarIn, VarOut)
1568
1569    IMPLICIT NONE
1570
1571    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1572    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1573
1574#ifdef CPP_PARA
1575    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
1576#endif
1577
1578#ifndef CPP_PARA
1579    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1580    RETURN
1581#else
1582
1583    IF (is_mpi_root) THEN
1584       CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4))
1585    ELSE
1586       CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
1587    ENDIF
1588
1589#endif
1590  END SUBROUTINE gather2D_mpi_i2
1591
1592  SUBROUTINE gather2D_mpi_i3(VarIn, VarOut)
1593
1594    IMPLICIT NONE
1595
1596    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1597    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1598
1599#ifdef CPP_PARA
1600    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
1601#endif
1602
1603#ifndef CPP_PARA
1604    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1605    RETURN
1606#else
1607
1608    IF (is_mpi_root) THEN
1609       CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
1610    ELSE
1611       CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
1612    ENDIF
1613
1614#endif
1615  END SUBROUTINE gather2D_mpi_i3
1616
1617
1618  SUBROUTINE gather2D_mpi_r0(VarIn, VarOut)
1619
1620    IMPLICIT NONE
1621
1622    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
1623    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
1624
1625#ifdef CPP_PARA
1626    REAL(r_std),DIMENSION(1) :: dummy
1627#endif
1628
1629#ifndef CPP_PARA
1630    VarOut(:)=VarIn(:)
1631    RETURN
1632#else
1633
1634    IF (is_mpi_root) THEN
1635       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1)
1636    ELSE
1637       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,1)
1638    ENDIF
1639
1640#endif
1641  END SUBROUTINE gather2D_mpi_r0
1642
1643  SUBROUTINE gather2D_mpi_r(VarIn, VarOut)
1644
1645    IMPLICIT NONE
1646
1647    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
1648    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
1649
1650#ifdef CPP_PARA
1651    REAL(r_std),DIMENSION(1,1) :: dummy
1652#endif
1653
1654#ifndef CPP_PARA
1655    VarOut(:,:)=VarIn(:,:)
1656    RETURN
1657#else
1658
1659    IF (is_mpi_root) THEN
1660       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
1661    ELSE
1662       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,1)
1663    ENDIF
1664
1665#endif
1666  END SUBROUTINE gather2D_mpi_r
1667
1668  SUBROUTINE gather2D_mpi_r1(VarIn, VarOut)
1669
1670    IMPLICIT NONE
1671
1672    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
1673    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1674
1675#ifdef CPP_PARA
1676    REAL(r_std),DIMENSION(1,SIZE(VarIn,3)) :: dummy
1677#endif
1678
1679#ifndef CPP_PARA
1680    VarOut(:,:,:)=VarIn(:,:,:)
1681    RETURN
1682#else
1683
1684    IF (is_mpi_root) THEN
1685       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
1686    ELSE
1687       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3))
1688    ENDIF
1689
1690#endif
1691  END SUBROUTINE gather2D_mpi_r1
1692
1693  SUBROUTINE gather2D_mpi_r2(VarIn, VarOut)
1694
1695    IMPLICIT NONE
1696
1697    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1698    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1699
1700#ifdef CPP_PARA
1701    REAL(r_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
1702#endif
1703
1704#ifndef CPP_PARA
1705    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1706    RETURN
1707#else
1708
1709    IF (is_mpi_root) THEN
1710       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4))
1711    ELSE
1712       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
1713    ENDIF
1714
1715#endif
1716  END SUBROUTINE gather2D_mpi_r2
1717
1718  SUBROUTINE gather2D_mpi_r3(VarIn, VarOut)
1719
1720    IMPLICIT NONE
1721
1722    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1723    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1724
1725#ifdef CPP_PARA
1726    REAL(r_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
1727#endif
1728
1729#ifndef CPP_PARA
1730    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1731    RETURN
1732#else
1733
1734    IF (is_mpi_root) THEN
1735       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
1736    ELSE
1737       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
1738    ENDIF
1739
1740#endif
1741  END SUBROUTINE gather2D_mpi_r3
1742
1743
1744  SUBROUTINE gather2D_mpi_l(VarIn, VarOut)
1745
1746    IMPLICIT NONE
1747
1748    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1749    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1750
1751#ifdef CPP_PARA   
1752    LOGICAL,DIMENSION(1,1) :: dummy
1753#endif
1754
1755#ifndef CPP_PARA
1756    VarOut(:,:)=VarIn(:,:)
1757    RETURN
1758#else
1759
1760    IF (is_mpi_root) THEN
1761       CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
1762    ELSE
1763       CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,1)
1764    ENDIF
1765
1766#endif
1767  END SUBROUTINE gather2D_mpi_l
1768
1769  SUBROUTINE gather2D_mpi_l1(VarIn, VarOut)
1770
1771    IMPLICIT NONE
1772
1773    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1774    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1775
1776#ifdef CPP_PARA   
1777    LOGICAL,DIMENSION(1,SIZE(VarIn,3)) :: dummy
1778#endif
1779
1780#ifndef CPP_PARA
1781    VarOut(:,:,:)=VarIn(:,:,:)
1782    RETURN
1783#else
1784
1785    IF (is_mpi_root) THEN
1786       CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
1787    ELSE
1788       CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3))
1789    ENDIF
1790
1791#endif
1792  END SUBROUTINE gather2D_mpi_l1
1793
1794  SUBROUTINE gather2D_mpi_l2(VarIn, VarOut)
1795
1796    IMPLICIT NONE
1797
1798    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1799    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1800
1801#ifdef CPP_PARA   
1802    LOGICAL,DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
1803#endif
1804
1805#ifndef CPP_PARA
1806    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1807    RETURN
1808#else
1809
1810    IF (is_mpi_root) THEN
1811       CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4))
1812    ELSE
1813       CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
1814    ENDIF
1815
1816#endif
1817  END SUBROUTINE gather2D_mpi_l2
1818
1819  SUBROUTINE gather2D_mpi_l3(VarIn, VarOut)
1820
1821    IMPLICIT NONE
1822
1823    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1824    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1825
1826#ifdef CPP_PARA   
1827    LOGICAL,DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
1828#endif
1829
1830#ifndef CPP_PARA
1831    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1832    RETURN
1833#else
1834
1835    IF (is_mpi_root) THEN
1836       CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
1837    ELSE
1838       CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
1839    ENDIF
1840
1841#endif
1842  END SUBROUTINE gather2D_mpi_l3
1843
1844!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1845!! Definition des reduce_sum   --> 4D   !!
1846!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1847
1848  SUBROUTINE reduce_sum_mpi_i(VarIn, VarOut)
1849
1850    IMPLICIT NONE
1851
1852    INTEGER(i_std),INTENT(IN)  :: VarIn
1853    INTEGER(i_std),INTENT(OUT) :: VarOut
1854
1855#ifdef CPP_PARA
1856    INTEGER(i_std),DIMENSION(1) :: Var1
1857    INTEGER(i_std),DIMENSION(1) :: Var2
1858    INTEGER(i_std),DIMENSION(1) :: dummy
1859#endif
1860
1861#ifndef CPP_PARA
1862    VarOut=VarIn
1863    RETURN
1864#else
1865    Var1(1)=VarIn
1866    IF (is_mpi_root) THEN
1867       CALL orch_reduce_sum_mpi_igen(Var1,Var2,1)
1868       VarOut=Var2(1)
1869    ELSE
1870       CALL orch_reduce_sum_mpi_igen(Var1,dummy,1)
1871       VarOut=VarIn
1872    ENDIF
1873#endif
1874  END SUBROUTINE reduce_sum_mpi_i
1875
1876  SUBROUTINE reduce_sum_mpi_i1(VarIn, VarOut)
1877
1878    IMPLICIT NONE
1879
1880    INTEGER(i_std),INTENT(IN),DIMENSION(:)  :: VarIn
1881    INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
1882
1883#ifdef CPP_PARA
1884    INTEGER(i_std),DIMENSION(1) :: dummy
1885#endif
1886
1887#ifndef CPP_PARA
1888    VarOut(:)=VarIn(:)
1889    RETURN
1890#else
1891
1892    IF (is_mpi_root) THEN
1893       CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
1894    ELSE
1895       CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))     
1896    ENDIF
1897
1898#endif
1899  END SUBROUTINE reduce_sum_mpi_i1
1900
1901  SUBROUTINE reduce_sum_mpi_i2(VarIn, VarOut)
1902    IMPLICIT NONE
1903
1904    INTEGER(i_std),INTENT(IN),DIMENSION(:,:)  :: VarIn
1905    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
1906
1907#ifdef CPP_PARA
1908    INTEGER(i_std),DIMENSION(1) :: dummy
1909#endif
1910
1911#ifndef CPP_PARA
1912    VarOut(:,:)=VarIn(:,:)
1913    RETURN
1914#else
1915
1916    IF (is_mpi_root) THEN
1917       CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
1918    ELSE
1919       CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))     
1920    ENDIF
1921
1922#endif
1923  END SUBROUTINE reduce_sum_mpi_i2
1924
1925  SUBROUTINE reduce_sum_mpi_i3(VarIn, VarOut)
1926    IMPLICIT NONE
1927
1928    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:)  :: VarIn
1929    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1930
1931#ifdef CPP_PARA
1932    INTEGER(i_std),DIMENSION(1) :: dummy
1933#endif
1934
1935#ifndef CPP_PARA
1936    VarOut(:,:,:)=VarIn(:,:,:)
1937    RETURN
1938#else
1939
1940    IF (is_mpi_root) THEN
1941       CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
1942    ELSE
1943       CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))     
1944    ENDIF
1945
1946#endif
1947  END SUBROUTINE reduce_sum_mpi_i3
1948
1949  SUBROUTINE reduce_sum_mpi_i4(VarIn, VarOut)
1950    IMPLICIT NONE
1951
1952    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
1953    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1954
1955#ifdef CPP_PARA
1956    INTEGER(i_std),DIMENSION(1) :: dummy
1957#endif
1958
1959#ifndef CPP_PARA
1960    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1961    RETURN
1962#else
1963
1964    IF (is_mpi_root) THEN
1965       CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
1966    ELSE
1967       CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))     
1968    ENDIF
1969
1970#endif
1971  END SUBROUTINE reduce_sum_mpi_i4
1972
1973
1974  SUBROUTINE reduce_sum_mpi_r(VarIn, VarOut)
1975    IMPLICIT NONE
1976
1977    REAL(r_std),INTENT(IN)  :: VarIn
1978    REAL(r_std),INTENT(OUT) :: VarOut
1979
1980#ifdef CPP_PARA
1981    REAL(r_std),DIMENSION(1) :: Var1
1982    REAL(r_std),DIMENSION(1) :: Var2
1983    REAL(r_std),DIMENSION(1) :: dummy
1984#endif
1985
1986#ifndef CPP_PARA
1987    VarOut=VarIn
1988    RETURN
1989#else
1990
1991    Var1(1)=VarIn
1992    IF (is_mpi_root) THEN
1993       CALL orch_reduce_sum_mpi_rgen(Var1,Var2,1)
1994       VarOut=Var2(1)
1995    ELSE
1996       CALL orch_reduce_sum_mpi_rgen(Var1,dummy,1)
1997       VarOut=VarIn
1998    ENDIF
1999
2000#endif
2001  END SUBROUTINE reduce_sum_mpi_r
2002
2003  SUBROUTINE reduce_sum_mpi_r1(VarIn, VarOut)
2004    IMPLICIT NONE
2005
2006    REAL(r_std),INTENT(IN),DIMENSION(:)  :: VarIn
2007    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
2008
2009#ifdef CPP_PARA
2010    REAL(r_std),DIMENSION(1) :: dummy
2011#endif
2012
2013#ifndef CPP_PARA
2014    VarOut(:)=VarIn(:)
2015    RETURN
2016#else
2017
2018    IF (is_mpi_root) THEN
2019       CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
2020    ELSE
2021       CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))     
2022    ENDIF
2023
2024#endif
2025  END SUBROUTINE reduce_sum_mpi_r1
2026
2027  SUBROUTINE reduce_sum_mpi_r2(VarIn, VarOut)
2028    IMPLICIT NONE
2029
2030    REAL(r_std),INTENT(IN),DIMENSION(:,:)  :: VarIn
2031    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
2032
2033#ifdef CPP_PARA
2034    REAL(r_std),DIMENSION(1) :: dummy
2035#endif
2036
2037#ifndef CPP_PARA
2038    VarOut(:,:)=VarIn(:,:)
2039    RETURN
2040#else
2041
2042    IF (is_mpi_root) THEN
2043       CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
2044    ELSE
2045       CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))     
2046    ENDIF
2047
2048#endif
2049  END SUBROUTINE reduce_sum_mpi_r2
2050
2051  SUBROUTINE reduce_sum_mpi_r3(VarIn, VarOut)
2052    IMPLICIT NONE
2053
2054    REAL(r_std),INTENT(IN),DIMENSION(:,:,:)  :: VarIn
2055    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
2056
2057#ifdef CPP_PARA
2058    REAL(r_std),DIMENSION(1) :: dummy
2059#endif
2060
2061#ifndef CPP_PARA
2062    VarOut(:,:,:)=VarIn(:,:,:)
2063    RETURN
2064#else
2065
2066    IF (is_mpi_root) THEN
2067       CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
2068    ELSE
2069       CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))     
2070    ENDIF
2071
2072#endif
2073  END SUBROUTINE reduce_sum_mpi_r3
2074
2075  SUBROUTINE reduce_sum_mpi_r4(VarIn, VarOut)
2076    IMPLICIT NONE
2077
2078    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
2079    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
2080
2081#ifdef CPP_PARA
2082    REAL(r_std),DIMENSION(1) :: dummy
2083#endif
2084
2085#ifndef CPP_PARA
2086    VarOut(:,:,:,:)=VarIn(:,:,:,:)
2087    RETURN
2088#else
2089
2090    IF (is_mpi_root) THEN
2091       CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
2092    ELSE
2093       CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))     
2094    ENDIF
2095
2096#endif
2097  END SUBROUTINE reduce_sum_mpi_r4
2098
2099
2100END MODULE mod_orchidee_mpi_transfert
2101
2102#ifdef CPP_PARA
2103
2104!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2105!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
2106!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2107
2108SUBROUTINE orch_bcast_mpi_cgen(var,nb)
2109  USE mod_orchidee_para_var
2110  USE timer
2111  USE mpi
2112
2113  IMPLICIT NONE
2114
2115  CHARACTER(LEN=*),DIMENSION(nb),INTENT(INOUT) :: Var
2116  INTEGER(i_std),INTENT(IN) :: nb
2117
2118  INTEGER(i_std) :: ierr
2119  LOGICAL :: flag=.FALSE.
2120  LOGICAL, PARAMETER :: check=.FALSE.
2121 
2122  IF (timer_state(timer_mpi)==running) THEN
2123     flag=.TRUE.
2124  ELSE
2125     flag=.FALSE.
2126  ENDIF
2127 
2128  IF (check) &
2129       WRITE(numout,*) "orch_bcast_mpi_cgen before bcast Var",Var   
2130  IF (flag) CALL suspend_timer(timer_mpi)
2131  CALL MPI_BCAST(Var,nb*LEN(Var(1)),MPI_CHARACTER,mpi_rank_root,MPI_COMM_ORCH,ierr)
2132  IF (flag) CALL resume_timer(timer_mpi)
2133  IF (check) &
2134       WRITE(numout,*) "orch_bcast_mpi_cgen after bcast Var",Var
2135
2136END SUBROUTINE orch_bcast_mpi_cgen
2137
2138SUBROUTINE orch_bcast_mpi_igen(var,nb)
2139  USE mod_orchidee_para_var
2140  USE timer
2141  USE mpi
2142  IMPLICIT NONE
2143
2144  INTEGER(i_std),DIMENSION(nb),INTENT(INOUT) :: Var
2145  INTEGER(i_std),INTENT(IN) :: nb
2146
2147
2148  INTEGER(i_std) :: ierr
2149  LOGICAL :: flag=.FALSE.
2150  LOGICAL, PARAMETER :: check=.FALSE.
2151
2152  IF (timer_state(timer_mpi)==running) THEN
2153     flag=.TRUE.
2154  ELSE
2155     flag=.FALSE.
2156  ENDIF
2157
2158  IF (flag) CALL suspend_timer(timer_mpi)
2159
2160  IF (check) &
2161       WRITE(numout,*) "orch_bcast_mpi_igen before bcast Var",Var
2162  CALL MPI_BCAST(Var,nb,MPI_INT_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
2163  IF (flag) CALL resume_timer(timer_mpi)
2164  IF (check) &
2165       WRITE(numout,*) "orch_bcast_mpi_igen after bcast Var",Var   
2166
2167END SUBROUTINE orch_bcast_mpi_igen
2168
2169SUBROUTINE orch_bcast_mpi_rgen(var,nb)
2170  USE mod_orchidee_para_var
2171  USE timer
2172  USE mpi
2173
2174  IMPLICIT NONE
2175
2176  REAL(r_std),DIMENSION(nb),INTENT(INOUT) :: Var
2177  INTEGER(i_std),INTENT(IN) :: nb
2178
2179  INTEGER(i_std) :: ierr
2180  LOGICAL :: flag=.FALSE.
2181  LOGICAL, PARAMETER :: check=.FALSE.
2182
2183  IF (timer_state(timer_mpi)==running) THEN
2184     flag=.TRUE.
2185  ELSE
2186     flag=.FALSE.
2187  ENDIF
2188
2189  IF (check) &
2190       WRITE(numout,*) "orch_bcast_mpi_rgen before bcast Var",Var
2191  IF (flag) CALL suspend_timer(timer_mpi)
2192  CALL MPI_BCAST(Var,nb,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
2193  IF (flag) CALL resume_timer(timer_mpi)
2194  IF (check) &
2195       WRITE(numout,*) "orch_bcast_mpi_rgen after bcast Var",Var
2196
2197END SUBROUTINE orch_bcast_mpi_rgen
2198
2199SUBROUTINE orch_bcast_mpi_lgen(var,nb)
2200  USE mod_orchidee_para_var
2201  USE timer
2202  USE mpi
2203
2204  IMPLICIT NONE
2205
2206  LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
2207  INTEGER(i_std),INTENT(IN) :: nb
2208
2209  INTEGER(i_std) :: ierr
2210  LOGICAL :: flag=.FALSE.
2211  LOGICAL, PARAMETER :: check=.FALSE.
2212
2213
2214  IF (timer_state(timer_mpi)==running) THEN
2215     flag=.TRUE.
2216  ELSE
2217     flag=.FALSE.
2218  ENDIF
2219
2220  IF (check) &
2221       WRITE(numout,*) "orch_bcast_mpi_lgen before bcast Var",Var
2222  IF (flag) CALL suspend_timer(timer_mpi)
2223  CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_rank_root,MPI_COMM_ORCH,ierr)
2224  IF (flag) CALL resume_timer(timer_mpi)
2225  IF (check) &
2226       WRITE(numout,*) "orch_bcast_mpi_lgen after bcast Var",Var
2227
2228END SUBROUTINE orch_bcast_mpi_lgen
2229
2230
2231SUBROUTINE orch_scatter_mpi_igen(VarIn, VarOut, nbp, dimsize)
2232  USE mod_orchidee_para_var
2233  USE timer
2234  USE mpi
2235
2236  IMPLICIT NONE
2237
2238  INTEGER(i_std),INTENT(IN) :: nbp
2239  INTEGER(i_std),INTENT(IN) :: dimsize
2240  INTEGER(i_std),INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
2241  INTEGER(i_std),INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
2242
2243  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2244  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2245  INTEGER(i_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
2246
2247  INTEGER(i_std) :: nb,i,index_para,rank
2248  INTEGER(i_std) :: ierr
2249  LOGICAL :: flag=.FALSE.
2250  LOGICAL, PARAMETER :: check=.FALSE.
2251
2252  IF (timer_state(timer_mpi)==running) THEN
2253     flag=.TRUE.
2254  ELSE
2255     flag=.FALSE.
2256  ENDIF
2257
2258  IF (flag) CALL suspend_timer(timer_mpi)
2259
2260  IF (is_mpi_root) THEN
2261     Index_Para=1
2262     DO rank=0,mpi_size-1
2263        nb=nbp_mpi_para(rank)
2264        displs(rank)=Index_Para-1
2265        counts(rank)=nb*dimsize
2266        DO i=1,dimsize
2267           VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)
2268           Index_para=Index_para+nb
2269        ENDDO
2270     ENDDO
2271     IF (check) THEN
2272        WRITE(numout,*) "orch_scatter_mpi_igen VarIn",VarIn
2273        WRITE(numout,*) "orch_scatter_mpi_igen VarTmp",VarTmp
2274     ENDIF
2275  ENDIF
2276
2277  CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INT_ORCH,VarOut,nbp_mpi*dimsize,   &
2278       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
2279  IF (flag) CALL resume_timer(timer_mpi)
2280  IF (check) &
2281       WRITE(numout,*) "orch_scatter_mpi_igen VarOut",VarOut
2282
2283END SUBROUTINE orch_scatter_mpi_igen
2284
2285SUBROUTINE orch_scatter_mpi_rgen(VarIn, VarOut, nbp, dimsize)
2286  USE mod_orchidee_para_var
2287  USE timer
2288  USE mpi
2289
2290  IMPLICIT NONE
2291
2292  INTEGER(i_std),INTENT(IN) :: dimsize
2293  INTEGER(i_std),INTENT(IN) :: nbp
2294  REAL(r_std),INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
2295  REAL(r_std),INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
2296
2297  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2298  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2299  REAL(r_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
2300
2301  INTEGER(i_std) :: nb,i,index_para,rank
2302  INTEGER(i_std) :: ierr
2303  LOGICAL :: flag=.FALSE.
2304  LOGICAL, PARAMETER :: check=.FALSE.
2305
2306  IF (timer_state(timer_mpi)==running) THEN
2307     flag=.TRUE.
2308  ELSE
2309     flag=.FALSE.
2310  ENDIF
2311
2312  IF (flag) CALL suspend_timer(timer_mpi)
2313
2314  IF (is_mpi_root) THEN
2315     Index_para=1
2316     DO rank=0,mpi_size-1
2317        nb=nbp_mpi_para(rank)
2318        displs(rank)=Index_para-1
2319        counts(rank)=nb*dimsize
2320        DO i=1,dimsize
2321           VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)
2322           Index_para=Index_para+nb
2323        ENDDO
2324     ENDDO
2325     IF (check) THEN
2326        WRITE(numout,*) "orch_scatter_mpi_rgen VarIn",VarIn
2327        WRITE(numout,*) "orch_scatter_mpi_rgen VarTmp",VarTmp
2328     ENDIF
2329  ENDIF
2330
2331  CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_ORCH,VarOut,nbp_mpi*dimsize,   &
2332       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
2333
2334  IF (flag) CALL resume_timer(timer_mpi)
2335  IF (check) &
2336       WRITE(numout,*) "orch_scatter_mpi_rgen VarOut",VarOut
2337
2338END SUBROUTINE orch_scatter_mpi_rgen
2339
2340SUBROUTINE orch_scatter_mpi_lgen(VarIn, VarOut, nbp, dimsize)
2341  USE mod_orchidee_para_var
2342  USE timer
2343  USE mpi
2344
2345  IMPLICIT NONE
2346
2347  INTEGER(i_std),INTENT(IN) :: dimsize
2348  INTEGER(i_std),INTENT(IN) :: nbp
2349  LOGICAL,INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
2350  LOGICAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
2351
2352  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2353  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2354  LOGICAL,DIMENSION(dimsize*nbp_glo) :: VarTmp
2355
2356  INTEGER(i_std) :: nb,i,index_para,rank
2357  INTEGER(i_std) :: ierr
2358  LOGICAL :: flag=.FALSE.
2359  LOGICAL, PARAMETER :: check=.FALSE.
2360
2361  IF (timer_state(timer_mpi)==running) THEN
2362     flag=.TRUE.
2363  ELSE
2364     flag=.FALSE.
2365  ENDIF
2366
2367  IF (flag) CALL suspend_timer(timer_mpi)
2368
2369  IF (is_mpi_root) THEN
2370     Index_para=1
2371     DO rank=0,mpi_size-1
2372        nb=nbp_mpi_para(rank)
2373        displs(rank)=Index_para-1
2374        counts(rank)=nb*dimsize
2375        DO i=1,dimsize
2376           VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)
2377           Index_para=Index_para+nb
2378        ENDDO
2379     ENDDO
2380     IF (check) THEN
2381        WRITE(numout,*) "orch_scatter_mpi_lgen VarIn",VarIn
2382        WRITE(numout,*) "orch_scatter_mpi_lgen VarTmp",VarTmp
2383     ENDIF
2384  ENDIF
2385
2386  CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,nbp_mpi*dimsize,   &
2387       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
2388  IF (flag) CALL resume_timer(timer_mpi)
2389  IF (check) &
2390       WRITE(numout,*) "orch_scatter_mpi_lgen VarOut",VarOut
2391
2392END SUBROUTINE orch_scatter_mpi_lgen
2393
2394SUBROUTINE orch_gather_mpi_igen(VarIn, VarOut, nbp, dimsize)
2395  USE mod_orchidee_para_var
2396  USE timer
2397  USE mpi
2398
2399  IMPLICIT NONE
2400
2401  INTEGER(i_std),INTENT(IN) :: dimsize
2402  INTEGER(i_std),INTENT(IN) :: nbp
2403  INTEGER(i_std),INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
2404  INTEGER(i_std),INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
2405
2406  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2407  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2408  INTEGER(i_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
2409
2410  INTEGER(i_std) :: nb,i,index_para,rank
2411  INTEGER(i_std) :: ierr
2412  LOGICAL :: flag=.FALSE.
2413  LOGICAL, PARAMETER :: check=.FALSE.
2414
2415  IF (timer_state(timer_mpi)==running) THEN
2416     flag=.TRUE.
2417  ELSE
2418     flag=.FALSE.
2419  ENDIF
2420
2421  IF (flag) CALL suspend_timer(timer_mpi)
2422
2423  IF (is_mpi_root) THEN
2424     Index_para=1
2425     DO rank=0,mpi_size-1
2426        nb=nbp_mpi_para(rank)
2427        displs(rank)=Index_para-1
2428        counts(rank)=nb*dimsize
2429        Index_para=Index_para+nb*dimsize
2430     ENDDO
2431     IF (check) &
2432          WRITE(numout,*) "orch_gather_mpi_igen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
2433
2434  ENDIF
2435
2436  CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_INT_ORCH,VarTmp,counts,displs,   &
2437       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
2438
2439
2440  IF (is_mpi_root) THEN
2441     Index_para=1
2442     DO rank=0,mpi_size-1
2443        nb=nbp_mpi_para(rank)
2444        DO i=1,dimsize
2445           VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1)
2446           Index_para=Index_para+nb
2447        ENDDO
2448     ENDDO
2449  ENDIF
2450  IF (check) &
2451       WRITE(numout,*) "orch_gather_mpi_igen VarOut=",VarOut
2452  IF (flag) CALL resume_timer(timer_mpi)
2453
2454END SUBROUTINE orch_gather_mpi_igen
2455
2456SUBROUTINE orch_gather_mpi_rgen(VarIn, VarOut, nbp, dimsize)
2457  USE mod_orchidee_para_var
2458  USE timer
2459  USE mpi
2460
2461  IMPLICIT NONE
2462
2463  INTEGER(i_std),INTENT(IN) :: dimsize
2464  INTEGER(i_std),INTENT(IN) :: nbp
2465  REAL(r_std),INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
2466  REAL(r_std),INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
2467
2468  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2469  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2470  REAL(r_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
2471
2472  INTEGER(i_std) :: nb,i,index_para,rank
2473  INTEGER(i_std) :: ierr
2474  LOGICAL :: flag=.FALSE.
2475  LOGICAL, PARAMETER :: check=.FALSE.
2476
2477  IF (timer_state(timer_mpi)==running) THEN
2478     flag=.TRUE.
2479  ELSE
2480     flag=.FALSE.
2481  ENDIF
2482
2483  IF (flag) CALL suspend_timer(timer_mpi)
2484
2485  IF (is_mpi_root) THEN
2486     Index_para=1
2487     DO rank=0,mpi_size-1
2488        nb=nbp_mpi_para(rank)
2489        displs(rank)=Index_para-1
2490        counts(rank)=nb*dimsize
2491        Index_para=Index_para+nb*dimsize
2492     ENDDO
2493     IF (check) &
2494          WRITE(numout,*) "orch_gather_mpi_rgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
2495
2496  ENDIF
2497
2498  IF (check) &
2499       WRITE(numout,*) "orch_gather_mpi_rgen VarIn=",VarIn   
2500  CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_REAL_ORCH,VarTmp,counts,displs,   &
2501       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
2502  IF (check) &
2503       WRITE(numout,*) "orch_gather_mpi_rgen dimsize,VarTmp=",dimsize,VarTmp
2504
2505  IF (is_mpi_root) THEN
2506     Index_para=1
2507     DO rank=0,mpi_size-1
2508        nb=nbp_mpi_para(rank)
2509        DO i=1,dimsize
2510           VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1)
2511           Index_para=Index_para+nb
2512        ENDDO
2513     ENDDO
2514  ENDIF
2515  IF (check) &
2516       WRITE(numout,*) "orch_gather_mpi_rgen VarOut=",VarOut
2517  IF (flag) CALL resume_timer(timer_mpi)
2518
2519END SUBROUTINE orch_gather_mpi_rgen
2520
2521SUBROUTINE orch_gather_mpi_lgen(VarIn, VarOut, nbp, dimsize)
2522  USE mod_orchidee_para_var
2523  USE timer
2524  USE mpi
2525
2526  IMPLICIT NONE
2527
2528  INTEGER(i_std),INTENT(IN) :: dimsize
2529  INTEGER(i_std),INTENT(IN) :: nbp
2530  LOGICAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
2531  LOGICAL,INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
2532
2533  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2534  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2535  LOGICAL,DIMENSION(dimsize*nbp_glo) :: VarTmp
2536
2537  INTEGER(i_std) :: nb,i,index_para,rank
2538  INTEGER(i_std) :: ierr
2539  LOGICAL :: flag=.FALSE.
2540  LOGICAL, PARAMETER :: check=.FALSE.
2541
2542
2543  IF (timer_state(timer_mpi)==running) THEN
2544     flag=.TRUE.
2545  ELSE
2546     flag=.FALSE.
2547  ENDIF
2548
2549  IF (flag) CALL suspend_timer(timer_mpi)
2550
2551  IF (is_mpi_root) THEN
2552     Index_para=1
2553     DO rank=0,mpi_size-1
2554        nb=nbp_mpi_para(rank)
2555        displs(rank)=Index_para-1
2556        counts(rank)=nb*dimsize
2557        Index_para=Index_para+nb*dimsize
2558     ENDDO
2559     IF (check) &
2560          WRITE(numout,*) "orch_gather_mpi_lgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
2561  ENDIF
2562
2563  IF (check) &
2564       WRITE(numout,*) "orch_gather_mpi_lgen VarIn=",VarIn   
2565  CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs,   &
2566       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
2567  IF (check) &
2568       WRITE(numout,*) "orch_gather_mpi_lgen dimsize,VarTmp=",dimsize,VarTmp
2569
2570  IF (is_mpi_root) THEN
2571     Index_para=1
2572     DO rank=0,mpi_size-1
2573        nb=nbp_mpi_para(rank)
2574        DO i=1,dimsize
2575           VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1)
2576           Index_para=Index_para+nb
2577        ENDDO
2578     ENDDO
2579  ENDIF
2580  IF (check) &
2581       WRITE(numout,*) "orch_gather_mpi_lgen VarOut=",VarOut
2582  IF (flag) CALL resume_timer(timer_mpi)
2583
2584END SUBROUTINE orch_gather_mpi_lgen
2585
2586
2587SUBROUTINE orch_scatter2D_mpi_igen(VarIn, VarOut, nbp2D, dimsize)
2588  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
2589  USE timer
2590  USE mpi
2591
2592  IMPLICIT NONE
2593
2594  INTEGER(i_std),INTENT(IN) :: dimsize
2595  INTEGER(i_std),INTENT(IN) :: nbp2D
2596  INTEGER(i_std),INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
2597  INTEGER(i_std),INTENT(OUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
2598
2599  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: displs
2600  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: counts
2601  INTEGER(i_std),DIMENSION(dimsize*iim*jjm)   :: VarTmp1
2602  INTEGER(i_std),DIMENSION(ij_nb,dimsize)     :: VarTmp2
2603
2604  INTEGER(i_std) :: nb,i,ij,index_para,rank
2605  INTEGER(i_std) :: ierr
2606  LOGICAL :: flag=.FALSE.
2607  LOGICAL, PARAMETER :: check=.FALSE.
2608
2609  IF (timer_state(timer_mpi)==running) THEN
2610     flag=.TRUE.
2611  ELSE
2612     flag=.FALSE.
2613  ENDIF
2614
2615  IF (flag) CALL suspend_timer(timer_mpi)
2616
2617  IF (is_mpi_root) THEN
2618     Index_para=1
2619     DO rank=0,mpi_size-1
2620        nb=ij_para_nb(rank)
2621        displs(rank)=Index_para-1
2622        counts(rank)=nb*dimsize
2623        DO i=1,dimsize
2624           VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
2625           Index_para=Index_para+nb
2626        ENDDO
2627     ENDDO
2628     IF (check) THEN
2629        WRITE(numout,*) "orch_scatter2D_mpi_igen VarIn",VarIn
2630        WRITE(numout,*) "orch_scatter2D_mpi_igen VarTmp1",VarTmp1
2631     ENDIF
2632  ENDIF
2633
2634  CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_INT_ORCH,VarTmp2,ij_nb*dimsize,   &
2635       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
2636  IF (check) &
2637       WRITE(numout,*) "orch_scatter2D_mpi_igen VarTmp2",VarTmp2
2638
2639  DO i=1,dimsize
2640     DO ij=1,ij_nb
2641        VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
2642     ENDDO
2643  ENDDO
2644  IF (flag) CALL resume_timer(timer_mpi)
2645  IF (check) &
2646       WRITE(numout,*) "orch_scatter2D_mpi_igen VarOut",VarOut
2647
2648END SUBROUTINE orch_scatter2D_mpi_igen
2649
2650SUBROUTINE orch_scatter2D_mpi_rgen(VarIn, VarOut, nbp2D, dimsize)
2651  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
2652  USE timer
2653  USE mpi
2654
2655  IMPLICIT NONE
2656
2657  INTEGER(i_std),INTENT(IN) :: dimsize
2658  INTEGER(i_std),INTENT(IN) :: nbp2D
2659  REAL(r_std),INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
2660  REAL(r_std),INTENT(INOUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
2661
2662  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: displs
2663  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: counts
2664  REAL(r_std),DIMENSION(dimsize*iim*jjm)   :: VarTmp1
2665  REAL(r_std),DIMENSION(ij_nb,dimsize)     :: VarTmp2
2666
2667  INTEGER(i_std) :: nb,i,ij,index_para,rank
2668  INTEGER(i_std) :: ierr
2669  LOGICAL :: flag=.FALSE.
2670  LOGICAL, PARAMETER :: check=.FALSE.
2671
2672  IF (timer_state(timer_mpi)==running) THEN
2673     flag=.TRUE.
2674  ELSE
2675     flag=.FALSE.
2676  ENDIF
2677
2678  IF (flag) CALL suspend_timer(timer_mpi)
2679
2680  IF (is_mpi_root) THEN
2681     Index_para=1
2682     DO rank=0,mpi_size-1
2683        nb=ij_para_nb(rank)
2684        displs(rank)=Index_para-1
2685        counts(rank)=nb*dimsize
2686        DO i=1,dimsize
2687           VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
2688           Index_para=Index_para+nb
2689        ENDDO
2690     ENDDO
2691     IF (check) THEN
2692        WRITE(numout,*) "orch_scatter2D_mpi_rgen VarIn",VarIn
2693        WRITE(numout,*) "orch_scatter2D_mpi_rgen VarTmp1",VarTmp1
2694     ENDIF
2695  ENDIF
2696  nb=ij_nb*dimsize
2697  IF (check) &
2698       WRITE(numout,*) "ij_nb*dimsize",ij_nb*dimsize
2699
2700  CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_REAL_ORCH,VarTmp2,nb,   &
2701       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
2702  IF (check) &
2703       WRITE(numout,*) "orch_scatter2D_mpi_rgen VarTmp2",VarTmp2
2704
2705  DO i=1,dimsize
2706     DO ij=1,ij_nb
2707        VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
2708     ENDDO
2709  ENDDO
2710
2711  IF (flag) CALL resume_timer(timer_mpi)
2712  IF (check) &
2713       WRITE(numout,*) "orch_scatter2D_mpi_rgen VarOut",VarOut
2714
2715END SUBROUTINE orch_scatter2D_mpi_rgen
2716
2717SUBROUTINE orch_scatter2D_mpi_lgen(VarIn, VarOut, nbp2D, dimsize)
2718  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
2719  USE timer
2720  USE mpi
2721
2722  IMPLICIT NONE
2723
2724  INTEGER(i_std),INTENT(IN) :: dimsize
2725  INTEGER(i_std),INTENT(IN) :: nbp2D
2726  LOGICAL,INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
2727  LOGICAL,INTENT(INOUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
2728
2729  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: displs
2730  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: counts
2731  LOGICAL,DIMENSION(dimsize*iim*jjm)   :: VarTmp1
2732  LOGICAL,DIMENSION(ij_nb,dimsize)     :: VarTmp2
2733
2734  INTEGER(i_std) :: nb,i,ij,index_para,rank
2735  INTEGER(i_std) :: ierr
2736  LOGICAL :: flag=.FALSE.
2737  LOGICAL, PARAMETER :: check=.FALSE.
2738
2739  IF (timer_state(timer_mpi)==running) THEN
2740     flag=.TRUE.
2741  ELSE
2742     flag=.FALSE.
2743  ENDIF
2744
2745  IF (flag) CALL suspend_timer(timer_mpi)
2746
2747  IF (is_mpi_root) THEN
2748     Index_para=1
2749     DO rank=0,mpi_size-1
2750        nb=ij_para_nb(rank)
2751        displs(rank)=Index_para-1
2752        counts(rank)=nb*dimsize
2753        DO i=1,dimsize
2754           VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
2755           Index_para=Index_para+nb
2756        ENDDO
2757     ENDDO
2758     IF (check) THEN
2759        WRITE(numout,*) "orch_scatter2D_mpi_lgen VarIn",VarIn
2760        WRITE(numout,*) "orch_scatter2D_mpi_lgen VarTmp1",VarTmp1
2761     ENDIF
2762  ENDIF
2763
2764  CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_LOGICAL,VarTmp2,ij_nb*dimsize,   &
2765       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
2766  IF (check) &
2767       WRITE(numout,*) "orch_scatter2D_mpi_lgen VarTmp2",VarTmp2
2768
2769  DO i=1,dimsize
2770     DO ij=1,ij_nb
2771        VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
2772     ENDDO
2773  ENDDO
2774  IF (flag) CALL resume_timer(timer_mpi)
2775  IF (check) &
2776       WRITE(numout,*) "orch_scatter2D_mpi_lgen VarOut",VarOut
2777
2778END SUBROUTINE orch_scatter2D_mpi_lgen
2779
2780
2781SUBROUTINE orch_gather2D_mpi_igen(VarIn, VarOut, nbp2D, dimsize)
2782  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
2783  USE timer
2784  USE mpi
2785
2786  IMPLICIT NONE
2787
2788  INTEGER(i_std),INTENT(IN) :: dimsize
2789  INTEGER(i_std),INTENT(IN) :: nbp2D
2790  INTEGER(i_std),INTENT(IN),DIMENSION(iim*jj_nb,dimsize)  :: VarIn
2791  INTEGER(i_std),INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
2792
2793  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: displs
2794  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: counts
2795  INTEGER(i_std),DIMENSION(ij_nb,dimsize)   :: VarTmp1
2796  INTEGER(i_std),DIMENSION(dimsize*iim*jjm) :: VarTmp2
2797
2798  INTEGER(i_std) :: nb,i,ij,index_para,rank
2799  INTEGER(i_std) :: ierr
2800  LOGICAL :: flag=.FALSE.
2801  LOGICAL,PARAMETER :: check=.FALSE.
2802
2803  IF (timer_state(timer_mpi)==running) THEN
2804     flag=.TRUE.
2805  ELSE
2806     flag=.FALSE.
2807  ENDIF
2808
2809  IF (flag) CALL suspend_timer(timer_mpi)
2810
2811  IF (is_mpi_root) THEN
2812     Index_para=1
2813
2814     DO rank=0,mpi_size-1
2815        nb=ij_para_nb(rank)
2816        displs(rank)=Index_para-1
2817        counts(rank)=nb*dimsize
2818        Index_para=Index_para+nb*dimsize
2819     ENDDO
2820     IF (check) &
2821          WRITE(numout,*) "orch_gather2D_mpi_igen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
2822  ENDIF
2823  DO i=1,dimsize
2824     DO ij=1,ij_nb
2825        VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
2826     ENDDO
2827  ENDDO
2828
2829  IF (check) THEN
2830     WRITE(numout,*) "orch_gather2D_mpi_igen VarIn=",VarIn   
2831     WRITE(numout,*) "orch_gather2D_mpi_igen VarTmp1=",VarTmp1
2832  ENDIF
2833  CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_INT_ORCH,VarTmp2,counts,displs,   &
2834       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
2835  IF (check) &
2836       WRITE(numout,*) "orch_gather2D_mpi_igen VarTmp2=",VarTmp2
2837
2838  IF (is_mpi_root) THEN
2839     Index_para=1
2840     DO rank=0,mpi_size-1
2841        nb=ij_para_nb(rank)
2842        DO i=1,dimsize
2843           VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
2844           Index_para=Index_para+nb
2845        ENDDO
2846     ENDDO
2847  ENDIF
2848
2849  IF (flag) CALL resume_timer(timer_mpi)
2850  IF (check) &
2851       WRITE(numout,*) "orch_gather2D_mpi_igen VarOut=",VarOut
2852
2853END SUBROUTINE orch_gather2D_mpi_igen
2854
2855SUBROUTINE orch_gather2D_mpi_rgen(VarIn, VarOut, nbp2D,dimsize)
2856  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
2857  USE timer
2858  USE mpi
2859
2860  IMPLICIT NONE
2861
2862  INTEGER(i_std),INTENT(IN) :: dimsize
2863  INTEGER(i_std),INTENT(IN) :: nbp2D
2864  REAL(r_std),INTENT(IN),DIMENSION(iim*jj_nb,dimsize)  :: VarIn
2865  REAL(r_std),INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
2866
2867  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: displs
2868  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: counts
2869  REAL(r_std),DIMENSION(ij_nb,dimsize)   :: VarTmp1
2870  REAL(r_std),DIMENSION(dimsize*iim*jjm) :: VarTmp2
2871
2872  INTEGER(i_std) :: nb,i,ij,index_para,rank
2873  INTEGER(i_std) :: ierr
2874  LOGICAL :: flag=.FALSE.
2875  LOGICAL,PARAMETER :: check=.FALSE.
2876
2877  IF (timer_state(timer_mpi)==running) THEN
2878     flag=.TRUE.
2879  ELSE
2880     flag=.FALSE.
2881  ENDIF
2882
2883  IF (flag) CALL suspend_timer(timer_mpi)
2884
2885  IF (is_mpi_root) THEN
2886     Index_para=1
2887
2888     DO rank=0,mpi_size-1
2889        nb=ij_para_nb(rank)
2890        displs(rank)=Index_para-1
2891        counts(rank)=nb*dimsize
2892        Index_para=Index_para+nb*dimsize
2893     ENDDO
2894     IF (check) &
2895          WRITE(numout,*) "orch_gather2D_mpi_rgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
2896  ENDIF
2897
2898  DO i=1,dimsize
2899     DO ij=1,ij_nb
2900        VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
2901     ENDDO
2902  ENDDO
2903
2904  IF (check) THEN
2905     WRITE(numout,*) "orch_gather2D_mpi_rgen VarIn=",VarIn   
2906     WRITE(numout,*) "orch_gather2D_mpi_rgen VarTmp1=",VarTmp1
2907  ENDIF
2908  CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_REAL_ORCH,VarTmp2,counts,displs,   &
2909       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
2910  IF (check) &
2911       WRITE(numout,*) "orch_gather2D_mpi_rgen VarTmp2=",VarTmp2
2912
2913  IF (is_mpi_root) THEN
2914     Index_para=1
2915     DO rank=0,mpi_size-1
2916        nb=ij_para_nb(rank)
2917        DO i=1,dimsize
2918           VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
2919           Index_para=Index_para+nb
2920        ENDDO
2921     ENDDO
2922  ENDIF
2923
2924  IF (flag) CALL resume_timer(timer_mpi)
2925  IF (check) &
2926       WRITE(numout,*) "orch_gather2D_mpi_rgen VarOut=",VarOut
2927
2928END SUBROUTINE orch_gather2D_mpi_rgen
2929
2930SUBROUTINE orch_gather2D_mpi_lgen(VarIn, VarOut, nbp2D, dimsize)
2931  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
2932  USE timer
2933  USE mpi
2934
2935  IMPLICIT NONE
2936
2937  INTEGER(i_std),INTENT(IN) :: dimsize
2938  INTEGER(i_std),INTENT(IN) :: nbp2D
2939  LOGICAL,INTENT(IN),DIMENSION(iim*jj_nb,dimsize)  :: VarIn
2940  LOGICAL,INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
2941
2942  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: displs
2943  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: counts
2944  LOGICAL,DIMENSION(ij_nb,dimsize)   :: VarTmp1
2945  LOGICAL,DIMENSION(dimsize*iim*jjm) :: VarTmp2
2946
2947  INTEGER(i_std) :: nb,i,ij,index_para,rank
2948  INTEGER(i_std) :: ierr
2949  LOGICAL :: flag=.FALSE.
2950  LOGICAL,PARAMETER :: check=.FALSE.
2951
2952  IF (timer_state(timer_mpi)==running) THEN
2953     flag=.TRUE.
2954  ELSE
2955     flag=.FALSE.
2956  ENDIF
2957
2958  IF (flag) CALL suspend_timer(timer_mpi)
2959
2960  IF (is_mpi_root) THEN
2961     Index_para=1
2962
2963     DO rank=0,mpi_size-1
2964        nb=ij_para_nb(rank)
2965        displs(rank)=Index_para-1
2966        counts(rank)=nb*dimsize
2967        Index_para=Index_para+nb*dimsize
2968     ENDDO
2969     IF (check) &
2970          WRITE(numout,*) "orch_gather2D_mpi_lgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
2971  ENDIF
2972
2973  DO i=1,dimsize
2974     DO ij=1,ij_nb
2975        VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
2976     ENDDO
2977  ENDDO
2978
2979  IF (check) THEN
2980     WRITE(numout,*) "orch_gather2D_mpi_lgen VarIn=",VarIn   
2981     WRITE(numout,*) "orch_gather2D_mpi_lgen VarTmp1=",VarTmp1
2982  ENDIF
2983  CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_LOGICAL,VarTmp2,counts,displs,   &
2984       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
2985  IF (check) &
2986       WRITE(numout,*) "orch_gather2D_mpi_lgen VarTmp2=",VarTmp2
2987
2988  IF (is_mpi_root) THEN
2989     Index_para=1
2990     DO rank=0,mpi_size-1
2991        nb=ij_para_nb(rank)
2992        DO i=1,dimsize
2993           VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
2994           Index_para=Index_para+nb
2995        ENDDO
2996     ENDDO
2997  ENDIF
2998
2999  IF (flag) CALL resume_timer(timer_mpi)
3000  IF (check) &
3001       WRITE(numout,*) "orch_gather2D_mpi_lgen VarOut=",VarOut
3002
3003END SUBROUTINE orch_gather2D_mpi_lgen
3004
3005SUBROUTINE orch_reduce_sum_mpi_igen(VarIn,VarOut,nb)
3006  USE mod_orchidee_para_var
3007  USE timer
3008  USE mpi
3009
3010  IMPLICIT NONE
3011
3012  INTEGER(i_std),DIMENSION(nb),INTENT(IN) :: VarIn
3013  INTEGER(i_std),DIMENSION(nb),INTENT(OUT) :: VarOut   
3014  INTEGER(i_std),INTENT(IN) :: nb
3015
3016  INTEGER(i_std) :: ierr
3017  LOGICAL :: flag=.FALSE.
3018  LOGICAL, PARAMETER :: check=.FALSE.
3019
3020  IF (timer_state(timer_mpi)==running) THEN
3021     flag=.TRUE.
3022  ELSE
3023     flag=.FALSE.
3024  ENDIF
3025
3026  IF (check) &
3027       WRITE(numout,*) "orch_reduce_sum_mpi_igen VarIn",VarIn
3028  IF (flag) CALL suspend_timer(timer_mpi)
3029
3030  CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INT_ORCH,MPI_SUM,mpi_rank_root,MPI_COMM_ORCH,ierr)
3031
3032  IF (flag) CALL resume_timer(timer_mpi)
3033  IF (check) &
3034       WRITE(numout,*) "orch_reduce_sum_mpi_igen VarOut",VarOut
3035
3036END SUBROUTINE orch_reduce_sum_mpi_igen
3037
3038SUBROUTINE orch_reduce_sum_mpi_rgen(VarIn,VarOut,nb)
3039  USE mod_orchidee_para_var
3040  USE timer
3041  USE mpi
3042
3043  IMPLICIT NONE
3044
3045  REAL(r_std),DIMENSION(nb),INTENT(IN) :: VarIn
3046  REAL(r_std),DIMENSION(nb),INTENT(OUT) :: VarOut   
3047  INTEGER(i_std),INTENT(IN) :: nb
3048
3049  INTEGER(i_std) :: ierr
3050  LOGICAL :: flag=.FALSE.
3051  LOGICAL, PARAMETER :: check=.FALSE.
3052
3053  IF (timer_state(timer_mpi)==running) THEN
3054     flag=.TRUE.
3055  ELSE
3056     flag=.FALSE.
3057  ENDIF
3058
3059  IF (check) &
3060       WRITE(numout,*) "orch_reduce_sum_mpi_rgen VarIn",VarIn
3061  IF (flag) CALL suspend_timer(timer_mpi)
3062
3063  CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_ORCH,MPI_SUM,mpi_rank_root,MPI_COMM_ORCH,ierr)
3064
3065  IF (flag) CALL resume_timer(timer_mpi)
3066  IF (check) &
3067       WRITE(numout,*) "orch_reduce_sum_mpi_rgen VarOut",VarOut
3068
3069END SUBROUTINE orch_reduce_sum_mpi_rgen
3070
3071#endif
Note: See TracBrowser for help on using the repository browser.