source: perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/transfert_para.f90 @ 938

Last change on this file since 938 was 643, checked in by martial.mancip, 12 years ago

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