Context Navigation

source: tags/ORCHIDEE_1_9_6/ORCHIDEE/src_parallel/transfert_para.f90 @ 880

Last change on this file since 880 was 720, checked in by didier.solyga, 12 years ago
Add svn headers for all modules. Improve documentation of the parameters. Replace two values by the corresponding parameters.
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 64.2 KB

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

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

Download in other formats: