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

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

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