Context Navigation

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

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: