Context Navigation

source: branches/publications/ORCHILEAK-Gommet/src_parallel/mod_orchidee_mpi_transfert.F90 @ 7346

Last change on this file since 7346 was 1925, checked in by josefine.ghattas, 10 years ago
xios : adapted for use with OpenMP (only master thread do call to xios), added coherence check between cpp key XIOS and run time flag mod_orchidee_para : moved declaration part into mod_orchidee_para_var simplifications in the use of modules in src_parallel : only use mod_orchidee_para_var if this is sufficient small corrections for OpenMP
File size: 69.0 KB

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

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

Download in other formats: