source: branches/publications/ORCHIDEE_gmd-2018-57/src_parallel/mod_orchidee_mpi_transfert.F90 @ 6145

Last change on this file since 6145 was 3487, checked in by jan.polcher, 8 years ago

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