source: branches/ORCHIDEE_EXT/ORCHIDEE/src_parallel/transfert_para.f90 @ 64

Last change on this file since 64 was 64, checked in by didier.solyga, 13 years ago

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