Context Navigation

source: tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_parallel/transfert_para.f90

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

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

Download in other formats: