Context Navigation

mod_orchidee_mpi_transfert.F90 @ 7852

Last change on this file since 7852 was 6563, checked in by josefine.ghattas, 4 years ago
Correction for compilation without MPI, for sequential use.
Property svn:keywords set to `Date Revision HeadURL`
File size: 105.7 KB

Line
1	! ==============================================================================================================================
2	! MODULE : mod_orchidee_mpi_transfert
3	!
4	! CONTACT : orchidee-help _at_ listes.ipsl.fr
5	!
6	! LICENCE : IPSL (2006)
7	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8	!
9	!>\BRIEF Low level MPI parallel communication encapsulations for ORCHIDEE.
10	!!
11	!!\n DESCRIPTION : This module contains low level interfaces to communicate information to all MPI processes.
12	!! The interfaces in this module are only used by mod_orchidee_transfert_para to create high level interfaces.
13	!! Note that these interfaces are only called by the master OMP thread on each MPI process.
14	!! The interfaces in this module are:
15	!! - bcast_mpi, scatter_mpi, gather_mpi_s, scatter_2D_mpi, gather_2D_mpi, reduced_sum_mpi
16	!!
17	!! RECENT CHANGE(S): None
18	!!
19	!! REFERENCES(S) : None
20	!!
21	!! SVN :
22	!! $HeadURL$
23	!! $Date$
24	!! $Revision$
25	!! \n
26	!_ ================================================================================================================================
27	MODULE mod_orchidee_mpi_transfert
28	!-
29	! USE ioipsl
30	USE mod_orchidee_para_var
31	USE timer
32	!-
33	IMPLICIT NONE
34	!-
35	#include "src_parallel.h"
36	!
37	PUBLIC bcast_mpi, scatter_mpi, gather_mpi_s, gather_mpi, scatter_unindexed_mpi, gather_unindexed_mpi, &
38	gather2D_mpi, reduce_sum_mpi, allreduce_sum_mpi
39	!-
40	!! ==============================================================================================================================
41	!! INTERFACE : bcast_mpi
42	!!
43	!>\BRIEF Send a variable from root process to all MPI processes
44	!!
45	!! DESCRIPTION : Send a variable from root process to all MPI processes. Need to be call under OMP MASTER
46	!!
47	!! \n
48	!_ ================================================================================================================================
49	INTERFACE bcast_mpi
50	MODULE PROCEDURE bcast_mpi_c, bcast_mpi_c1, &
51	bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
52	bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
53	bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
54	END INTERFACE
55
56
57	!! ==============================================================================================================================
58	!! INTERFACE : scatter_mpi
59	!!
60	!>\BRIEF Distribute a global field from the root process to the local domain on each MPI processes (on kjpindex)
61	!!
62	!! DESCRIPTION : Distribute a global field from the root process to the local domain on each MPI processes.
63	!! Need to be call under OMP MASTER
64	!!
65	!! \n
66	!_ ================================================================================================================================
67	INTERFACE scatter_mpi
68	MODULE PROCEDURE scatter_mpi_i,scatter_mpi_i1,scatter_mpi_i2,scatter_mpi_i3,scatter_mpi_i4, &
69	scatter_mpi_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3,scatter_mpi_r4, &
70	scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3,scatter_mpi_l4
71	END INTERFACE
72
73	!! ==============================================================================================================================
74	!! INTERFACE : gather_mpi_s
75	!!
76	!>\BRIEF gather a variable (on kjpindex) on the global grid. (With call of suspend time)
77	!!
78	!! DESCRIPTION : gather a variable on the global grid. (With call of suspend time)
79	!!
80	!! \n
81	!_ ================================================================================================================================
82	INTERFACE gather_mpi_s
83	MODULE PROCEDURE gather_mpi_is, &
84	gather_mpi_rs, &
85	gather_mpi_ls
86	END INTERFACE
87
88	!! ==============================================================================================================================
89	!! INTERFACE : gather_mpi
90	!!
91	!>\BRIEF Each process MPI send their local field (on kjpindex) to the root process which will recieve
92	!! the field on the global domain
93	!!
94	!! DESCRIPTION : Each process MPI send their local field (on kjpindex) to the root process which will recieve
95	!! the field on the global domain.
96	!! Need to be call under OMP MASTER
97	!!
98	!! \n
99	!_ ================================================================================================================================
100	INTERFACE gather_mpi
101	MODULE PROCEDURE gather_mpi_i,gather_mpi_i1,gather_mpi_i2,gather_mpi_i3,gather_mpi_i4, &
102	gather_mpi_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3,gather_mpi_r4, &
103	gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3,gather_mpi_l4
104	END INTERFACE
105
106	INTERFACE scatter_unindexed_mpi
107	MODULE PROCEDURE &
108	scatter_unindexed_mpi_i, scatter_unindexed_mpi_i1, scatter_unindexed_mpi_i2, &
109	scatter_unindexed_mpi_i3, scatter_unindexed_mpi_i4, &
110	scatter_unindexed_mpi_r, scatter_unindexed_mpi_r1, scatter_unindexed_mpi_r2, &
111	scatter_unindexed_mpi_r3, scatter_unindexed_mpi_r4, &
112	scatter_unindexed_mpi_l, scatter_unindexed_mpi_l1, scatter_unindexed_mpi_l2, &
113	scatter_unindexed_mpi_l3, scatter_unindexed_mpi_l4
114	END INTERFACE
115
116	INTERFACE gather_unindexed_mpi
117	MODULE PROCEDURE &
118	gather_unindexed_mpi_i,gather_unindexed_mpi_i1,gather_unindexed_mpi_i2,gather_unindexed_mpi_i3,gather_unindexed_mpi_i4, &
119	gather_unindexed_mpi_r,gather_unindexed_mpi_r1,gather_unindexed_mpi_r2,gather_unindexed_mpi_r3,gather_unindexed_mpi_r4, &
120	gather_unindexed_mpi_l,gather_unindexed_mpi_l1,gather_unindexed_mpi_l2,gather_unindexed_mpi_l3,gather_unindexed_mpi_l4
121	END INTERFACE
122
123	!! ==============================================================================================================================
124	!! INTERFACE : scatter2D_mpi
125	!!
126	!>\BRIEF Distribute a global field (lon,lat) from the root process to the local domain on each processes MPI
127	!!
128	!! DESCRIPTION : Distribute a global field (lon,lat) from the root process to the local domain on each processes MPI
129	!!
130	!! \n
131	!_ ================================================================================================================================
132
133	INTERFACE scatter2D_mpi
134	MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, &
135	scatter2D_mpi_r0,scatter2D_mpi_r,scatter2D_mpi_r1,scatter2D_mpi_r2,scatter2D_mpi_r3, &
136	scatter2D_mpi_l,scatter2D_mpi_l1,scatter2D_mpi_l2,scatter2D_mpi_l3
137	END INTERFACE
138
139	!! ==============================================================================================================================
140	!! INTERFACE : gather2D_mpi
141	!!
142	!>\BRIEF Each process MPI send their local field (on lon,lat) to the root process which will recieve
143	!! the field on the global domain
144	!!
145	!! DESCRIPTION :
146	!!
147	!! \n
148	!_ ================================================================================================================================
149	INTERFACE gather2D_mpi
150	MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, &
151	gather2D_mpi_r0,gather2D_mpi_r,gather2D_mpi_r1,gather2D_mpi_r2,gather2D_mpi_r3, &
152	gather2D_mpi_l,gather2D_mpi_l1,gather2D_mpi_l2,gather2D_mpi_l3
153	END INTERFACE
154
155	!! ==============================================================================================================================
156	!! INTERFACE : reduce_sum_mpi
157	!!
158	!>\BRIEF The root process will recieve the sum of the values from all processe
159	!!
160	!! DESCRIPTION :The root process will recieve the sum of the values from all processe. Need to be call under OMP MASTER
161	!!
162	!! \n
163	!_ ================================================================================================================================
164	INTERFACE reduce_sum_mpi
165	MODULE PROCEDURE reduce_sum_mpi_i,reduce_sum_mpi_i1,reduce_sum_mpi_i2,reduce_sum_mpi_i3,reduce_sum_mpi_i4, &
166	reduce_sum_mpi_r,reduce_sum_mpi_r1,reduce_sum_mpi_r2,reduce_sum_mpi_r3,reduce_sum_mpi_r4
167	END INTERFACE
168
169	!! ==============================================================================================================================
170	!! INTERFACE : all_reduce_sum_mpi
171	!!
172	!>\BRIEF The root process will recieve the sum of the values from all processe
173	!!
174	!! DESCRIPTION :The root process will recieve the sum of the values from all processe. Need to be call under OMP MASTER
175	!!
176	!! \n
177	!_ ================================================================================================================================
178	INTERFACE allreduce_sum_mpi
179	MODULE PROCEDURE allreduce_sum_mpi_r, allreduce_sum_mpi_i
180	END INTERFACE
181	CONTAINS
182
183	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
184	!! Definition of Broadcast 1D --> 4D !!
185	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
186
187	!! -- Character string -- !!
188
189	SUBROUTINE bcast_mpi_c(var)
190	IMPLICIT NONE
191	CHARACTER(LEN=*),INTENT(INOUT) :: Var
192	CHARACTER(LEN=len(Var)),DIMENSION(1) :: Var1
193
194	#ifndef CPP_PARA
195	RETURN
196	#else
197	IF (is_mpi_root) &
198	Var1(1)=Var
199	CALL orch_bcast_mpi_cgen(Var1,1)
200	Var=Var1(1)
201	#endif
202	END SUBROUTINE bcast_mpi_c
203
204	SUBROUTINE bcast_mpi_c1(var)
205	IMPLICIT NONE
206	CHARACTER(LEN=*),INTENT(INOUT) :: Var(:)
207
208	#ifndef CPP_PARA
209	RETURN
210	#else
211	CALL orch_bcast_mpi_cgen(Var,size(Var))
212	#endif
213	END SUBROUTINE bcast_mpi_c1
214
215
216	!! -- Integers -- !!
217
218	SUBROUTINE bcast_mpi_i(var)
219	IMPLICIT NONE
220	INTEGER(i_std),INTENT(INOUT) :: Var
221	INTEGER(i_std),DIMENSION(1) :: Var1
222
223	#ifndef CPP_PARA
224	RETURN
225	#else
226	IF (is_mpi_root) &
227	Var1(1)=Var
228	CALL orch_bcast_mpi_igen(Var1,1)
229	Var=Var1(1)
230	#endif
231	END SUBROUTINE bcast_mpi_i
232
233	SUBROUTINE bcast_mpi_i1(var)
234	IMPLICIT NONE
235	INTEGER(i_std),INTENT(INOUT) :: Var(:)
236
237	#ifndef CPP_PARA
238	RETURN
239	#else
240	CALL orch_bcast_mpi_igen(Var,size(Var))
241	#endif
242	END SUBROUTINE bcast_mpi_i1
243
244	SUBROUTINE bcast_mpi_i2(var)
245	IMPLICIT NONE
246	INTEGER(i_std),INTENT(INOUT) :: Var(:,:)
247
248	#ifndef CPP_PARA
249	RETURN
250	#else
251	CALL orch_bcast_mpi_igen(Var,size(Var))
252	#endif
253	END SUBROUTINE bcast_mpi_i2
254
255	SUBROUTINE bcast_mpi_i3(var)
256	IMPLICIT NONE
257	INTEGER(i_std),INTENT(INOUT) :: Var(:,:,:)
258
259	#ifndef CPP_PARA
260	RETURN
261	#else
262	CALL orch_bcast_mpi_igen(Var,size(Var))
263	#endif
264	END SUBROUTINE bcast_mpi_i3
265
266	SUBROUTINE bcast_mpi_i4(var)
267	IMPLICIT NONE
268	INTEGER(i_std),INTENT(INOUT) :: Var(:,:,:,:)
269
270	#ifndef CPP_PARA
271	RETURN
272	#else
273	CALL orch_bcast_mpi_igen(Var,size(Var))
274	#endif
275	END SUBROUTINE bcast_mpi_i4
276
277
278	!! -- Reals -- !!
279
280	SUBROUTINE bcast_mpi_r(var)
281	IMPLICIT NONE
282	REAL(r_std),INTENT(INOUT) :: Var
283	REAL(r_std),DIMENSION(1) :: Var1
284
285	#ifndef CPP_PARA
286	RETURN
287	#else
288	IF (is_mpi_root) &
289	Var1(1)=Var
290	CALL orch_bcast_mpi_rgen(Var1,1)
291	Var=Var1(1)
292	#endif
293	END SUBROUTINE bcast_mpi_r
294
295	SUBROUTINE bcast_mpi_r1(var)
296	IMPLICIT NONE
297	REAL(r_std),INTENT(INOUT) :: Var(:)
298
299	#ifndef CPP_PARA
300	RETURN
301	#else
302	CALL orch_bcast_mpi_rgen(Var,size(Var))
303	#endif
304	END SUBROUTINE bcast_mpi_r1
305
306	SUBROUTINE bcast_mpi_r2(var)
307	IMPLICIT NONE
308	REAL(r_std),INTENT(INOUT) :: Var(:,:)
309
310	#ifndef CPP_PARA
311	RETURN
312	#else
313	CALL orch_bcast_mpi_rgen(Var,size(Var))
314	#endif
315	END SUBROUTINE bcast_mpi_r2
316
317	SUBROUTINE bcast_mpi_r3(var)
318	IMPLICIT NONE
319	REAL(r_std),INTENT(INOUT) :: Var(:,:,:)
320
321	#ifndef CPP_PARA
322	RETURN
323	#else
324	CALL orch_bcast_mpi_rgen(Var,size(Var))
325	#endif
326	END SUBROUTINE bcast_mpi_r3
327
328	SUBROUTINE bcast_mpi_r4(var)
329	IMPLICIT NONE
330	REAL(r_std),INTENT(INOUT) :: Var(:,:,:,:)
331
332	#ifndef CPP_PARA
333	RETURN
334	#else
335	CALL orch_bcast_mpi_rgen(Var,size(Var))
336	#endif
337	END SUBROUTINE bcast_mpi_r4
338
339	!! -- Logicals -- !!
340
341	SUBROUTINE bcast_mpi_l(var)
342	IMPLICIT NONE
343	LOGICAL,INTENT(INOUT) :: Var
344	LOGICAL,DIMENSION(1) :: Var1
345	#ifndef CPP_PARA
346	RETURN
347	#else
348	IF (is_mpi_root) &
349	Var1(1)=Var
350	CALL orch_bcast_mpi_lgen(Var1,1)
351	Var=Var1(1)
352	#endif
353	END SUBROUTINE bcast_mpi_l
354
355	SUBROUTINE bcast_mpi_l1(var)
356	IMPLICIT NONE
357	LOGICAL,INTENT(INOUT) :: Var(:)
358
359	#ifndef CPP_PARA
360	RETURN
361	#else
362	CALL orch_bcast_mpi_lgen(Var,size(Var))
363	#endif
364	END SUBROUTINE bcast_mpi_l1
365
366	SUBROUTINE bcast_mpi_l2(var)
367	IMPLICIT NONE
368	LOGICAL,INTENT(INOUT) :: Var(:,:)
369
370	#ifndef CPP_PARA
371	RETURN
372	#else
373	CALL orch_bcast_mpi_lgen(Var,size(Var))
374	#endif
375	END SUBROUTINE bcast_mpi_l2
376
377	SUBROUTINE bcast_mpi_l3(var)
378	IMPLICIT NONE
379	LOGICAL,INTENT(INOUT) :: Var(:,:,:)
380
381	#ifndef CPP_PARA
382	RETURN
383	#else
384	CALL orch_bcast_mpi_lgen(Var,size(Var))
385	#endif
386	END SUBROUTINE bcast_mpi_l3
387
388	SUBROUTINE bcast_mpi_l4(var)
389	IMPLICIT NONE
390	LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
391
392	#ifndef CPP_PARA
393	RETURN
394	#else
395	CALL orch_bcast_mpi_lgen(Var,size(Var))
396	#endif
397	END SUBROUTINE bcast_mpi_l4
398
399	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
400	!! Definition of Scatter 1D --> 4D !!
401	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
402
403	SUBROUTINE scatter_mpi_i(VarIn, VarOut)
404
405	IMPLICIT NONE
406
407	INTEGER(i_std),INTENT(IN),DIMENSION(nbp_glo) :: VarIn
408	INTEGER(i_std),INTENT(OUT),DIMENSION(nbp_mpi) :: VarOut
409
410
411	#ifdef CPP_PARA
412	INTEGER(i_std),DIMENSION(1) :: dummy
413	#endif
414
415	#ifndef CPP_PARA
416	VarOut(:)=VarIn(:)
417	RETURN
418	#else
419
420	IF (is_mpi_root) THEN
421	CALL orch_scatter_mix_mpi_igen(VarIn,Varout,SIZE(VarIn,1),1, &
422	nbp_para_info)
423	ELSE
424	CALL orch_scatter_mix_mpi_igen(dummy,Varout,1,1,&
425	nbp_para_info)
426	ENDIF
427
428	#endif
429	END SUBROUTINE scatter_mpi_i
430
431	SUBROUTINE scatter_mpi_i1(VarIn, VarOut)
432
433	IMPLICIT NONE
434
435	INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
436	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
437
438	#ifdef CPP_PARA
439	INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy
440	#endif
441
442	#ifndef CPP_PARA
443	VarOut(:,:)=VarIn(:,:)
444	RETURN
445	#else
446	IF (is_mpi_root) THEN
447	CALL orch_scatter_mix_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2),&
448	nbp_para_info)
449	ELSE
450	CALL orch_scatter_mix_mpi_igen(dummy,Varout,1,SIZE(VarOut,2),&
451	nbp_para_info)
452	ENDIF
453
454	#endif
455	END SUBROUTINE scatter_mpi_i1
456
457	SUBROUTINE scatter_mpi_i2(VarIn, VarOut)
458
459	IMPLICIT NONE
460
461	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
462	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
463
464	#ifdef CPP_PARA
465	INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
466	#endif
467
468	#ifndef CPP_PARA
469	VarOut(:,:,:)=VarIn(:,:,:)
470	RETURN
471	#else
472	IF (is_mpi_root) THEN
473	CALL orch_scatter_mix_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3),&
474	nbp_para_info)
475	ELSE
476	CALL orch_scatter_mix_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3),&
477	nbp_para_info)
478	ENDIF
479	#endif
480	END SUBROUTINE scatter_mpi_i2
481
482	SUBROUTINE scatter_mpi_i3(VarIn, VarOut)
483
484	IMPLICIT NONE
485
486	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
487	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
488
489	#ifdef CPP_PARA
490	INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)) :: dummy
491	#endif
492
493	#ifndef CPP_PARA
494	VarOut(:,:,:,:)=VarIn(:,:,:,:)
495	RETURN
496	#else
497	IF (is_mpi_root) THEN
498	CALL orch_scatter_mix_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4),&
499	nbp_para_info)
500	ELSE
501	CALL orch_scatter_mix_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4),&
502	nbp_para_info)
503	ENDIF
504
505	#endif
506	END SUBROUTINE scatter_mpi_i3
507
508	SUBROUTINE scatter_mpi_i4(VarIn, VarOut)
509
510	IMPLICIT NONE
511
512	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
513	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
514
515	#ifdef CPP_PARA
516	INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
517	#endif
518
519	#ifndef CPP_PARA
520	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
521	RETURN
522	#else
523	IF (is_mpi_root) THEN
524	CALL orch_scatter_mix_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5),&
525	nbp_para_info)
526	ELSE
527	CALL orch_scatter_mix_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5),&
528	nbp_para_info)
529	ENDIF
530
531	#endif
532	END SUBROUTINE scatter_mpi_i4
533
534	SUBROUTINE scatter_mpi_r(VarIn, VarOut)
535
536	IMPLICIT NONE
537
538	REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
539	REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
540
541
542	#ifdef CPP_PARA
543	REAL(r_std),DIMENSION(1) :: dummy
544	#endif
545
546	#ifndef CPP_PARA
547	VarOut(:)=VarIn(:)
548	RETURN
549	#else
550	IF (is_mpi_root) THEN
551	CALL orch_scatter_mix_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),1,&
552	nbp_para_info)
553	ELSE
554	CALL orch_scatter_mix_mpi_rgen(dummy,Varout,1,1,&
555	nbp_para_info)
556	ENDIF
557	#endif
558	END SUBROUTINE scatter_mpi_r
559
560	SUBROUTINE scatter_mpi_r1(VarIn, VarOut)
561
562	IMPLICIT NONE
563
564	REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
565	REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
566
567	#ifdef CPP_PARA
568	REAL(r_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy
569	#endif
570
571	#ifndef CPP_PARA
572	VarOut(:,:)=VarIn(:,:)
573	RETURN
574	#else
575	IF (is_mpi_root) THEN
576	CALL orch_scatter_mix_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2),&
577	nbp_para_info)
578	ELSE
579	CALL orch_scatter_mix_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2),&
580	nbp_para_info)
581	ENDIF
582
583	#endif
584	END SUBROUTINE scatter_mpi_r1
585
586	SUBROUTINE scatter_mpi_r2(VarIn, VarOut)
587
588	IMPLICIT NONE
589
590	REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
591	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
592
593	#ifdef CPP_PARA
594	REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
595	#endif
596
597	#ifndef CPP_PARA
598	VarOut(:,:,:)=VarIn(:,:,:)
599	RETURN
600	#else
601	IF (is_mpi_root) THEN
602	CALL orch_scatter_mix_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3),&
603	nbp_para_info)
604	ELSE
605	CALL orch_scatter_mix_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3),&
606	nbp_para_info)
607	ENDIF
608
609	#endif
610	END SUBROUTINE scatter_mpi_r2
611
612	SUBROUTINE scatter_mpi_r3(VarIn, VarOut)
613
614	IMPLICIT NONE
615
616	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
617	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
618
619	#ifdef CPP_PARA
620	REAL(r_std),DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)) :: dummy
621	#endif
622
623	#ifndef CPP_PARA
624	VarOut(:,:,:,:)=VarIn(:,:,:,:)
625	RETURN
626	#else
627	IF (is_mpi_root) THEN
628	CALL orch_scatter_mix_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4),&
629	nbp_para_info)
630	ELSE
631	CALL orch_scatter_mix_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4),&
632	nbp_para_info)
633	ENDIF
634	#endif
635	END SUBROUTINE scatter_mpi_r3
636
637	SUBROUTINE scatter_mpi_r4(VarIn, VarOut)
638
639	IMPLICIT NONE
640
641	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
642	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
643
644	#ifdef CPP_PARA
645	REAL(r_std),DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
646	#endif
647
648	#ifndef CPP_PARA
649	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
650	RETURN
651	#else
652	IF (is_mpi_root) THEN
653	CALL orch_scatter_mix_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5),&
654	nbp_para_info)
655	ELSE
656	CALL orch_scatter_mix_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5),&
657	nbp_para_info)
658	ENDIF
659	#endif
660	END SUBROUTINE scatter_mpi_r4
661
662
663	SUBROUTINE scatter_mpi_l(VarIn, VarOut)
664
665	IMPLICIT NONE
666
667	LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
668	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
669
670	#ifdef CPP_PARA
671	LOGICAL,DIMENSION(1) :: dummy
672	#endif
673
674	#ifndef CPP_PARA
675	VarOut(:)=VarIn(:)
676	RETURN
677	#else
678	IF (is_mpi_root) THEN
679	CALL orch_scatter_mix_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),1,&
680	nbp_para_info)
681	ELSE
682	CALL orch_scatter_mix_mpi_lgen(dummy,Varout,1,1,&
683	nbp_para_info)
684	ENDIF
685	#endif
686	END SUBROUTINE scatter_mpi_l
687
688	SUBROUTINE scatter_mpi_l1(VarIn, VarOut)
689
690	IMPLICIT NONE
691
692	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
693	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
694
695	#ifdef CPP_PARA
696	LOGICAL,DIMENSION(1,SIZE(VarOut,2)) :: dummy
697	#endif
698
699	#ifndef CPP_PARA
700	VarOut(:,:)=VarIn(:,:)
701	RETURN
702	#else
703	IF (is_mpi_root) THEN
704	CALL orch_scatter_mix_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2),&
705	nbp_para_info)
706	ELSE
707	CALL orch_scatter_mix_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2),&
708	nbp_para_info)
709	ENDIF
710	#endif
711	END SUBROUTINE scatter_mpi_l1
712
713	SUBROUTINE scatter_mpi_l2(VarIn, VarOut)
714
715	IMPLICIT NONE
716
717	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
718	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
719
720	#ifdef CPP_PARA
721	LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
722	#endif
723
724	#ifndef CPP_PARA
725	VarOut(:,:,:)=VarIn(:,:,:)
726	RETURN
727	#else
728	IF (is_mpi_root) THEN
729	CALL orch_scatter_mix_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3),&
730	nbp_para_info)
731	ELSE
732	CALL orch_scatter_mix_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3),&
733	nbp_para_info)
734	ENDIF
735	#endif
736	END SUBROUTINE scatter_mpi_l2
737
738	SUBROUTINE scatter_mpi_l3(VarIn, VarOut)
739
740	IMPLICIT NONE
741
742	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
743	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
744
745	#ifdef CPP_PARA
746	LOGICAL,DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)) :: dummy
747	#endif
748
749	#ifndef CPP_PARA
750	VarOut(:,:,:,:)=VarIn(:,:,:,:)
751	RETURN
752	#else
753	IF (is_mpi_root) THEN
754	CALL orch_scatter_mix_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4), &
755	nbp_para_info)
756	ELSE
757	CALL orch_scatter_mix_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4), &
758	nbp_para_info)
759	ENDIF
760	#endif
761	END SUBROUTINE scatter_mpi_l3
762
763	SUBROUTINE scatter_mpi_l4(VarIn, VarOut)
764
765	IMPLICIT NONE
766
767	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
768	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
769
770	#ifdef CPP_PARA
771	LOGICAL,DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
772	#endif
773
774	#ifndef CPP_PARA
775	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
776	RETURN
777	#else
778	IF (is_mpi_root) THEN
779	CALL orch_scatter_mix_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4),SIZE(VarOut,5), &
780	nbp_para_info)
781	ELSE
782	CALL orch_scatter_mix_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4),SIZE(VarOut,5), &
783	nbp_para_info)
784	ENDIF
785	#endif
786	END SUBROUTINE scatter_mpi_l4
787
788	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
789	!! Definition of Gather 1D --> 4D !!
790	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
791
792	SUBROUTINE gather_mpi_is(VarIn, VarOut)
793
794	IMPLICIT NONE
795
796	#ifdef CPP_PARA
797	INCLUDE 'mpif.h'
798	#endif
799
800	INTEGER(i_std),INTENT(IN) :: VarIn
801	INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
802
803	#ifdef CPP_PARA
804	INTEGER(i_std) :: nb,i,index_para,rank
805	INTEGER(i_std) :: ierr
806	LOGICAL :: flag=.FALSE.
807	LOGICAL, PARAMETER :: check=.FALSE.
808	#endif
809
810	#ifndef CPP_PARA
811	VarOut(:)=VarIn
812	RETURN
813	#else
814
815	IF (timer_state(timer_mpi)==running) THEN
816	flag=.TRUE.
817	ELSE
818	flag=.FALSE.
819	ENDIF
820
821	IF (flag) CALL suspend_timer(timer_mpi)
822
823	IF (check) &
824	WRITE(numout,*) "gather_mpi_is VarIn=",VarIn
825
826	#ifdef CPP_PARA
827	CALL MPI_GATHER(VarIn,1,MPI_INT_ORCH,VarOut,1,MPI_INT_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
828	#endif
829
830	IF (check) &
831	WRITE(numout,*) "gather_mpi_is VarOut=",VarOut
832	IF (flag) CALL resume_timer(timer_mpi)
833	#endif
834	END SUBROUTINE gather_mpi_is
835
836	SUBROUTINE gather_mpi_rs(VarIn, VarOut)
837
838	IMPLICIT NONE
839
840	#ifdef CPP_PARA
841	INCLUDE 'mpif.h'
842	#endif
843
844	REAL(r_std),INTENT(IN) :: VarIn
845	REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
846
847	#ifdef CPP_PARA
848	INTEGER(i_std) :: nb,i,index_para,rank
849	INTEGER(i_std) :: ierr
850	LOGICAL :: flag=.FALSE.
851	LOGICAL, PARAMETER :: check=.FALSE.
852	#endif
853
854	#ifndef CPP_PARA
855	VarOut(:)=VarIn
856	RETURN
857	#else
858
859	IF (timer_state(timer_mpi)==running) THEN
860	flag=.TRUE.
861	ELSE
862	flag=.FALSE.
863	ENDIF
864
865	IF (flag) CALL suspend_timer(timer_mpi)
866
867	IF (check) &
868	WRITE(numout,*) "gather_mpi_rs VarIn=",VarIn
869
870	#ifdef CPP_PARA
871	CALL MPI_GATHER(VarIn,1,MPI_REAL_ORCH,VarOut,1,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
872	#endif
873
874	IF (check) &
875	WRITE(numout,*) "gather_mpi_rs VarOut=",VarOut
876
877	IF (flag) CALL resume_timer(timer_mpi)
878	#endif
879	END SUBROUTINE gather_mpi_rs
880
881	SUBROUTINE gather_mpi_ls(VarIn, VarOut)
882
883	IMPLICIT NONE
884
885	#ifdef CPP_PARA
886	INCLUDE 'mpif.h'
887	#endif
888
889	LOGICAL,INTENT(IN) :: VarIn
890	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
891
892	#ifdef CPP_PARA
893	INTEGER(i_std) :: nb,i,index_para,rank
894	INTEGER(i_std) :: ierr
895	LOGICAL :: flag=.FALSE.
896	LOGICAL, PARAMETER :: check=.FALSE.
897	#endif
898
899	#ifndef CPP_PARA
900	VarOut(:)=VarIn
901	RETURN
902	#else
903
904	IF (timer_state(timer_mpi)==running) THEN
905	flag=.TRUE.
906	ELSE
907	flag=.FALSE.
908	ENDIF
909
910	IF (flag) CALL suspend_timer(timer_mpi)
911
912	IF (check) &
913	WRITE(numout,*) "gather_mpi_ls VarIn=",VarIn
914
915	#ifdef CPP_PARA
916	CALL MPI_GATHER(VarIn,1,MPI_LOGICAL,VarOut,1,MPI_LOGICAL,mpi_rank_root,MPI_COMM_ORCH,ierr)
917	#endif
918
919	IF (check) &
920	WRITE(numout,*) "gather_mpi_ls VarOut=",VarOut
921	IF (flag) CALL resume_timer(timer_mpi)
922	#endif
923	END SUBROUTINE gather_mpi_ls
924
925	!!!!! --> Integers
926
927	SUBROUTINE gather_mpi_i(VarIn, VarOut)
928
929	IMPLICIT NONE
930
931	INTEGER(i_std),INTENT(IN),DIMENSION(:) :: VarIn
932	INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
933
934	#ifdef CPP_PARA
935	INTEGER(i_std),DIMENSION(1) :: dummy
936	#endif
937
938	#ifndef CPP_PARA
939	VarOut(:)=VarIn(:)
940	RETURN
941	#else
942
943	IF (is_mpi_root) THEN
944	CALL orch_gather_mix_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),1, &
945	nbp_para_info)
946	ELSE
947	CALL orch_gather_mix_mpi_igen(VarIn,dummy,1,1, &
948	nbp_para_info)
949	ENDIF
950
951	#endif
952	END SUBROUTINE gather_mpi_i
953
954	!!!!!
955
956	SUBROUTINE gather_mpi_i1(VarIn, VarOut)
957
958	IMPLICIT NONE
959
960	INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
961	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
962
963	#ifdef CPP_PARA
964	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy
965	#endif
966
967	#ifndef CPP_PARA
968	VarOut(:,:)=VarIn(:,:)
969	RETURN
970	#else
971
972	IF (is_mpi_root) THEN
973	CALL orch_gather_mix_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2),&
974	nbp_para_info)
975	ELSE
976	CALL orch_gather_mix_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2),&
977	nbp_para_info)
978	ENDIF
979
980	#endif
981	END SUBROUTINE gather_mpi_i1
982
983	!!!!!
984
985	SUBROUTINE gather_mpi_i2(VarIn, VarOut)
986
987	IMPLICIT NONE
988
989	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
990	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
991
992	#ifdef CPP_PARA
993	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
994	#endif
995
996	#ifndef CPP_PARA
997	VarOut(:,:,:)=VarIn(:,:,:)
998	RETURN
999	#else
1000
1001	IF (is_mpi_root) THEN
1002	CALL orch_gather_mix_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3),&
1003	nbp_para_info)
1004	ELSE
1005	CALL orch_gather_mix_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3),&
1006	nbp_para_info)
1007	ENDIF
1008
1009	#endif
1010	END SUBROUTINE gather_mpi_i2
1011
1012	!!!!!
1013
1014	SUBROUTINE gather_mpi_i3(VarIn, VarOut)
1015
1016	IMPLICIT NONE
1017
1018	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1019	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1020
1021	#ifdef CPP_PARA
1022	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)) :: dummy
1023	#endif
1024
1025	#ifndef CPP_PARA
1026	VarOut(:,:,:,:)=VarIn(:,:,:,:)
1027	RETURN
1028	#else
1029
1030	IF (is_mpi_root) THEN
1031	CALL orch_gather_mix_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4),&
1032	nbp_para_info)
1033	ELSE
1034	CALL orch_gather_mix_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4),&
1035	nbp_para_info)
1036	ENDIF
1037
1038	#endif
1039	END SUBROUTINE gather_mpi_i3
1040
1041
1042	SUBROUTINE gather_mpi_i4(VarIn, VarOut)
1043
1044	IMPLICIT NONE
1045
1046	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1047	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1048
1049	#ifdef CPP_PARA
1050	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
1051	#endif
1052
1053	#ifndef CPP_PARA
1054	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1055	RETURN
1056	#else
1057
1058	IF (is_mpi_root) THEN
1059	CALL orch_gather_mix_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5),&
1060	nbp_para_info)
1061	ELSE
1062	CALL orch_gather_mix_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*Size(VarIn,5),&
1063	nbp_para_info)
1064	ENDIF
1065
1066	#endif
1067	END SUBROUTINE gather_mpi_i4
1068
1069	!!!!! --> Reals
1070
1071	SUBROUTINE gather_mpi_r(VarIn, VarOut)
1072
1073	IMPLICIT NONE
1074
1075	REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
1076	REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
1077
1078	#ifdef CPP_PARA
1079	REAL(r_std),DIMENSION(1) :: dummy
1080	#endif
1081
1082	#ifndef CPP_PARA
1083	VarOut(:)=VarIn(:)
1084	RETURN
1085	#else
1086
1087	IF (is_mpi_root) THEN
1088	CALL orch_gather_mix_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1,&
1089	nbp_para_info)
1090	ELSE
1091	CALL orch_gather_mix_mpi_rgen(VarIn,dummy,1,1,&
1092	nbp_para_info)
1093	ENDIF
1094
1095	#endif
1096	END SUBROUTINE gather_mpi_r
1097
1098	!!!!!
1099
1100	SUBROUTINE gather_mpi_r1(VarIn, VarOut)
1101
1102	IMPLICIT NONE
1103
1104	REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
1105	REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
1106
1107	#ifdef CPP_PARA
1108	REAL(r_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy
1109	#endif
1110
1111	#ifndef CPP_PARA
1112	VarOut(:,:)=VarIn(:,:)
1113	RETURN
1114	#else
1115
1116	IF (is_mpi_root) THEN
1117	CALL orch_gather_mix_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2),&
1118	nbp_para_info)
1119	ELSE
1120	CALL orch_gather_mix_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2),&
1121	nbp_para_info)
1122	ENDIF
1123
1124	#endif
1125	END SUBROUTINE gather_mpi_r1
1126
1127	!!!!!
1128
1129	SUBROUTINE gather_mpi_r2(VarIn, VarOut)
1130
1131	IMPLICIT NONE
1132
1133	REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
1134	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1135
1136	#ifdef CPP_PARA
1137	REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
1138	#endif
1139
1140	#ifndef CPP_PARA
1141	VarOut(:,:,:)=VarIn(:,:,:)
1142	RETURN
1143	#else
1144
1145	IF (is_mpi_root) THEN
1146	CALL orch_gather_mix_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3),&
1147	nbp_para_info)
1148	ELSE
1149	CALL orch_gather_mix_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3),&
1150	nbp_para_info)
1151	ENDIF
1152
1153	#endif
1154	END SUBROUTINE gather_mpi_r2
1155
1156	!!!!!
1157
1158	SUBROUTINE gather_mpi_r3(VarIn, VarOut)
1159
1160	IMPLICIT NONE
1161
1162	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1163	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1164
1165	#ifdef CPP_PARA
1166	REAL(r_std),DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)) :: dummy
1167	#endif
1168
1169	#ifndef CPP_PARA
1170	VarOut(:,:,:,:)=VarIn(:,:,:,:)
1171	RETURN
1172	#else
1173
1174	IF (is_mpi_root) THEN
1175	CALL orch_gather_mix_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4),&
1176	nbp_para_info)
1177	ELSE
1178	CALL orch_gather_mix_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4),&
1179	nbp_para_info)
1180	ENDIF
1181
1182	#endif
1183	END SUBROUTINE gather_mpi_r3
1184
1185	!!!!!
1186
1187	SUBROUTINE gather_mpi_r4(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(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5)) :: 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_gather_mix_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5),&
1205	nbp_para_info)
1206	ELSE
1207	CALL orch_gather_mix_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5),&
1208	nbp_para_info)
1209	ENDIF
1210
1211	#endif
1212	END SUBROUTINE gather_mpi_r4
1213
1214	!!!!! --> Logicals
1215
1216	SUBROUTINE gather_mpi_l(VarIn, VarOut)
1217
1218	IMPLICIT NONE
1219
1220	LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
1221	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
1222
1223	#ifdef CPP_PARA
1224	LOGICAL,DIMENSION(1) :: dummy
1225	#endif
1226
1227	#ifndef CPP_PARA
1228	VarOut(:)=VarIn(:)
1229	RETURN
1230	#else
1231
1232	IF (is_mpi_root) THEN
1233	CALL orch_gather_mix_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),1,&
1234	nbp_para_info)
1235	ELSE
1236	CALL orch_gather_mix_mpi_lgen(VarIn,dummy,1,1,&
1237	nbp_para_info)
1238	ENDIF
1239
1240	#endif
1241	END SUBROUTINE gather_mpi_l
1242
1243	!!!!!
1244
1245	SUBROUTINE gather_mpi_l1(VarIn, VarOut)
1246
1247	IMPLICIT NONE
1248
1249	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1250	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1251
1252	#ifdef CPP_PARA
1253	LOGICAL,DIMENSION(1,SIZE(VarIn,2)) :: dummy
1254	#endif
1255
1256	#ifndef CPP_PARA
1257	VarOut(:,:)=VarIn(:,:)
1258	RETURN
1259	#else
1260
1261	IF (is_mpi_root) THEN
1262	CALL orch_gather_mix_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2),&
1263	nbp_para_info)
1264	ELSE
1265	CALL orch_gather_mix_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2),&
1266	nbp_para_info)
1267	ENDIF
1268
1269	#endif
1270	END SUBROUTINE gather_mpi_l1
1271
1272	!!!!!
1273
1274	SUBROUTINE gather_mpi_l2(VarIn, VarOut)
1275
1276	IMPLICIT NONE
1277
1278	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1279	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1280
1281	#ifdef CPP_PARA
1282	LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
1283	#endif
1284
1285	#ifndef CPP_PARA
1286	VarOut(:,:,:)=VarIn(:,:,:)
1287	RETURN
1288	#else
1289
1290	IF (is_mpi_root) THEN
1291	CALL orch_gather_mix_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3),&
1292	nbp_para_info)
1293	ELSE
1294	CALL orch_gather_mix_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3),&
1295	nbp_para_info)
1296	ENDIF
1297
1298	#endif
1299	END SUBROUTINE gather_mpi_l2
1300
1301	!!!!!
1302
1303	SUBROUTINE gather_mpi_l3(VarIn, VarOut)
1304
1305	IMPLICIT NONE
1306
1307	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1308	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1309
1310	#ifdef CPP_PARA
1311	LOGICAL,DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)) :: dummy
1312	#endif
1313
1314	#ifndef CPP_PARA
1315	VarOut(:,:,:,:)=VarIn(:,:,:,:)
1316	RETURN
1317	#else
1318
1319	IF (is_mpi_root) THEN
1320	CALL orch_gather_mix_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4),&
1321	nbp_para_info)
1322	ELSE
1323	CALL orch_gather_mix_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4),&
1324	nbp_para_info)
1325	ENDIF
1326
1327	#endif
1328	END SUBROUTINE gather_mpi_l3
1329
1330	!!!!!
1331
1332	SUBROUTINE gather_mpi_l4(VarIn, VarOut)
1333
1334	IMPLICIT NONE
1335
1336	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1337	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1338
1339	#ifdef CPP_PARA
1340	LOGICAL,DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
1341	#endif
1342
1343	#ifndef CPP_PARA
1344	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1345	RETURN
1346	#else
1347
1348	IF (is_mpi_root) THEN
1349	CALL orch_gather_mix_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5),&
1350	nbp_para_info)
1351	ELSE
1352	CALL orch_gather_mix_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5),&
1353	nbp_para_info)
1354	ENDIF
1355
1356	#endif
1357	END SUBROUTINE gather_mpi_l4
1358
1359	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1360	!! Definition des Scatter_unindexed --> 4D !!
1361	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1362
1363
1364
1365
1366	SUBROUTINE scatter_unindexed_mpi_i(VarIn, VarOut)
1367
1368	IMPLICIT NONE
1369
1370	INTEGER(i_std),INTENT(IN),DIMENSION(nbp_glo) :: VarIn
1371	INTEGER(i_std),INTENT(OUT),DIMENSION(nbp_mpi) :: VarOut
1372
1373
1374	#ifdef CPP_PARA
1375	INTEGER(i_std),DIMENSION(1) :: dummy
1376	#endif
1377
1378	#ifndef CPP_PARA
1379	VarOut(:)=VarIn(:)
1380	RETURN
1381	#else
1382
1383	IF (is_mpi_root) THEN
1384	CALL orch_scatter_mix_mpi_igen(VarIn,Varout,SIZE(VarIn,1),1,&
1385	ij_para_info)
1386	ELSE
1387	CALL orch_scatter_mix_mpi_igen(dummy,Varout,1,1,&
1388	ij_para_info)
1389	ENDIF
1390
1391	#endif
1392	END SUBROUTINE scatter_unindexed_mpi_i
1393
1394	SUBROUTINE scatter_unindexed_mpi_i1(VarIn, VarOut)
1395
1396	IMPLICIT NONE
1397
1398	INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
1399	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
1400
1401	#ifdef CPP_PARA
1402	INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy
1403	#endif
1404
1405	#ifndef CPP_PARA
1406	VarOut(:,:)=VarIn(:,:)
1407	RETURN
1408	#else
1409	IF (is_mpi_root) THEN
1410	CALL orch_scatter_mix_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2),&
1411	ij_para_info)
1412	ELSE
1413	CALL orch_scatter_mix_mpi_igen(dummy,Varout,1,SIZE(VarOut,2),&
1414	ij_para_info)
1415	ENDIF
1416
1417	#endif
1418	END SUBROUTINE scatter_unindexed_mpi_i1
1419
1420	SUBROUTINE scatter_unindexed_mpi_i2(VarIn, VarOut)
1421
1422	IMPLICIT NONE
1423
1424	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
1425	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1426
1427	#ifdef CPP_PARA
1428	INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
1429	#endif
1430
1431	#ifndef CPP_PARA
1432	VarOut(:,:,:)=VarIn(:,:,:)
1433	RETURN
1434	#else
1435	IF (is_mpi_root) THEN
1436	CALL orch_scatter_mix_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3),&
1437	ij_para_info)
1438	ELSE
1439	CALL orch_scatter_mix_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3),&
1440	ij_para_info)
1441	ENDIF
1442	#endif
1443	END SUBROUTINE scatter_unindexed_mpi_i2
1444
1445	SUBROUTINE scatter_unindexed_mpi_i3(VarIn, VarOut)
1446
1447	IMPLICIT NONE
1448
1449	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1450	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1451
1452	#ifdef CPP_PARA
1453	INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)) :: dummy
1454	#endif
1455
1456	#ifndef CPP_PARA
1457	VarOut(:,:,:,:)=VarIn(:,:,:,:)
1458	RETURN
1459	#else
1460	IF (is_mpi_root) THEN
1461	CALL orch_scatter_mix_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4),&
1462	ij_para_info)
1463	ELSE
1464	CALL orch_scatter_mix_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4),&
1465	ij_para_info)
1466	ENDIF
1467
1468	#endif
1469	END SUBROUTINE scatter_unindexed_mpi_i3
1470
1471	SUBROUTINE scatter_unindexed_mpi_i4(VarIn, VarOut)
1472
1473	IMPLICIT NONE
1474
1475	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1476	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1477
1478	#ifdef CPP_PARA
1479	INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
1480	#endif
1481
1482	#ifndef CPP_PARA
1483	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1484	RETURN
1485	#else
1486	IF (is_mpi_root) THEN
1487	CALL orch_scatter_mix_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5),&
1488	ij_para_info)
1489	ELSE
1490	CALL orch_scatter_mix_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5),&
1491	ij_para_info)
1492	ENDIF
1493
1494	#endif
1495	END SUBROUTINE scatter_unindexed_mpi_i4
1496
1497
1498	SUBROUTINE scatter_unindexed_mpi_r(VarIn, VarOut)
1499
1500	IMPLICIT NONE
1501
1502	REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
1503	REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
1504
1505
1506	#ifdef CPP_PARA
1507	REAL(r_std),DIMENSION(1) :: dummy
1508	#endif
1509
1510	#ifndef CPP_PARA
1511	VarOut(:)=VarIn(:)
1512	RETURN
1513	#else
1514	IF (is_mpi_root) THEN
1515	CALL orch_scatter_mix_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),1,&
1516	ij_para_info)
1517	ELSE
1518	CALL orch_scatter_mix_mpi_rgen(dummy,Varout,1,1,&
1519	ij_para_info)
1520	ENDIF
1521	#endif
1522	END SUBROUTINE scatter_unindexed_mpi_r
1523
1524	SUBROUTINE scatter_unindexed_mpi_r1(VarIn, VarOut)
1525
1526	IMPLICIT NONE
1527
1528	REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
1529	REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
1530
1531	#ifdef CPP_PARA
1532	REAL(r_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy
1533	#endif
1534
1535	#ifndef CPP_PARA
1536	VarOut(:,:)=VarIn(:,:)
1537	RETURN
1538	#else
1539	IF (is_mpi_root) THEN
1540	CALL orch_scatter_mix_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2),&
1541	ij_para_info)
1542	ELSE
1543	CALL orch_scatter_mix_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2), &
1544	ij_para_info)
1545	ENDIF
1546
1547	#endif
1548	END SUBROUTINE scatter_unindexed_mpi_r1
1549
1550	SUBROUTINE scatter_unindexed_mpi_r2(VarIn, VarOut)
1551
1552	IMPLICIT NONE
1553
1554	REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
1555	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1556
1557	#ifdef CPP_PARA
1558	REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
1559	#endif
1560
1561	#ifndef CPP_PARA
1562	VarOut(:,:,:)=VarIn(:,:,:)
1563	RETURN
1564	#else
1565	IF (is_mpi_root) THEN
1566	CALL orch_scatter_mix_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3),&
1567	ij_para_info)
1568	ELSE
1569	CALL orch_scatter_mix_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3),&
1570	ij_para_info)
1571	ENDIF
1572
1573	#endif
1574	END SUBROUTINE scatter_unindexed_mpi_r2
1575
1576	SUBROUTINE scatter_unindexed_mpi_r3(VarIn, VarOut)
1577
1578	IMPLICIT NONE
1579
1580	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1581	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1582
1583	#ifdef CPP_PARA
1584	REAL(r_std),DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)) :: dummy
1585	#endif
1586
1587	#ifndef CPP_PARA
1588	VarOut(:,:,:,:)=VarIn(:,:,:,:)
1589	RETURN
1590	#else
1591	IF (is_mpi_root) THEN
1592	CALL orch_scatter_mix_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4),&
1593	ij_para_info)
1594	ELSE
1595	CALL orch_scatter_mix_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4),&
1596	ij_para_info)
1597	ENDIF
1598	#endif
1599	END SUBROUTINE scatter_unindexed_mpi_r3
1600
1601	SUBROUTINE scatter_unindexed_mpi_r4(VarIn, VarOut)
1602
1603	IMPLICIT NONE
1604
1605	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1606	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1607
1608	#ifdef CPP_PARA
1609	REAL(r_std),DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
1610	#endif
1611
1612	#ifndef CPP_PARA
1613	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1614	RETURN
1615	#else
1616	IF (is_mpi_root) THEN
1617	CALL orch_scatter_mix_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5),&
1618	ij_para_info)
1619	ELSE
1620	CALL orch_scatter_mix_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5),&
1621	ij_para_info)
1622	ENDIF
1623	#endif
1624	END SUBROUTINE scatter_unindexed_mpi_r4
1625
1626
1627	SUBROUTINE scatter_unindexed_mpi_l(VarIn, VarOut)
1628
1629	IMPLICIT NONE
1630
1631	LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
1632	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
1633
1634	#ifdef CPP_PARA
1635	LOGICAL,DIMENSION(1) :: dummy
1636	#endif
1637
1638	#ifndef CPP_PARA
1639	VarOut(:)=VarIn(:)
1640	RETURN
1641	#else
1642	IF (is_mpi_root) THEN
1643	CALL orch_scatter_mix_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),1,&
1644	ij_para_info)
1645	ELSE
1646	CALL orch_scatter_mix_mpi_lgen(dummy,Varout,1,1,&
1647	ij_para_info)
1648	ENDIF
1649	#endif
1650	END SUBROUTINE scatter_unindexed_mpi_l
1651
1652	SUBROUTINE scatter_unindexed_mpi_l1(VarIn, VarOut)
1653
1654	IMPLICIT NONE
1655
1656	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1657	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1658
1659	#ifdef CPP_PARA
1660	LOGICAL,DIMENSION(1,SIZE(VarOut,2)) :: dummy
1661	#endif
1662
1663	#ifndef CPP_PARA
1664	VarOut(:,:)=VarIn(:,:)
1665	RETURN
1666	#else
1667	IF (is_mpi_root) THEN
1668	CALL orch_scatter_mix_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2),&
1669	ij_para_info)
1670	ELSE
1671	CALL orch_scatter_mix_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2),&
1672	ij_para_info)
1673	ENDIF
1674	#endif
1675	END SUBROUTINE scatter_unindexed_mpi_l1
1676
1677	SUBROUTINE scatter_unindexed_mpi_l2(VarIn, VarOut)
1678
1679	IMPLICIT NONE
1680
1681	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1682	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1683
1684	#ifdef CPP_PARA
1685	LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
1686	#endif
1687
1688	#ifndef CPP_PARA
1689	VarOut(:,:,:)=VarIn(:,:,:)
1690	RETURN
1691	#else
1692	IF (is_mpi_root) THEN
1693	CALL orch_scatter_mix_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3),&
1694	ij_para_info)
1695	ELSE
1696	CALL orch_scatter_mix_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3),&
1697	ij_para_info)
1698	ENDIF
1699	#endif
1700	END SUBROUTINE scatter_unindexed_mpi_l2
1701
1702	SUBROUTINE scatter_unindexed_mpi_l3(VarIn, VarOut)
1703
1704	IMPLICIT NONE
1705
1706	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1707	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1708
1709	#ifdef CPP_PARA
1710	LOGICAL,DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)) :: dummy
1711	#endif
1712
1713	#ifndef CPP_PARA
1714	VarOut(:,:,:,:)=VarIn(:,:,:,:)
1715	RETURN
1716	#else
1717	IF (is_mpi_root) THEN
1718	CALL orch_scatter_mix_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4),&
1719	ij_para_info)
1720	ELSE
1721	CALL orch_scatter_mix_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4),&
1722	ij_para_info)
1723	ENDIF
1724	#endif
1725	END SUBROUTINE scatter_unindexed_mpi_l3
1726
1727	SUBROUTINE scatter_unindexed_mpi_l4(VarIn, VarOut)
1728
1729	IMPLICIT NONE
1730
1731	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1732	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1733
1734	#ifdef CPP_PARA
1735	LOGICAL,DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
1736	#endif
1737
1738	#ifndef CPP_PARA
1739	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1740	RETURN
1741	#else
1742	IF (is_mpi_root) THEN
1743	CALL orch_scatter_mix_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5),&
1744	ij_para_info)
1745	ELSE
1746	CALL orch_scatter_mix_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5),&
1747	ij_para_info)
1748	ENDIF
1749	#endif
1750	END SUBROUTINE scatter_unindexed_mpi_l4
1751
1752
1753
1754
1755
1756
1757
1758	!!!!! --> Les entiers
1759
1760	SUBROUTINE gather_unindexed_mpi_i(VarIn, VarOut)
1761
1762	IMPLICIT NONE
1763
1764	INTEGER(i_std),INTENT(IN),DIMENSION(:) :: VarIn
1765	INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
1766
1767	#ifdef CPP_PARA
1768	INTEGER(i_std),DIMENSION(1) :: dummy
1769	#endif
1770
1771	#ifndef CPP_PARA
1772	VarOut(:)=VarIn(:)
1773	RETURN
1774	#else
1775
1776	IF (is_mpi_root) THEN
1777	CALL orch_gather_mix_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),1,&
1778	ij_para_info)
1779	ELSE
1780	CALL orch_gather_mix_mpi_igen(VarIn,dummy,1,1,&
1781	ij_para_info)
1782	ENDIF
1783
1784	#endif
1785	END SUBROUTINE gather_unindexed_mpi_i
1786
1787	!!!!!
1788
1789	SUBROUTINE gather_unindexed_mpi_i1(VarIn, VarOut)
1790
1791	IMPLICIT NONE
1792
1793	INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
1794	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
1795
1796	#ifdef CPP_PARA
1797	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy
1798	#endif
1799
1800	#ifndef CPP_PARA
1801	VarOut(:,:)=VarIn(:,:)
1802	RETURN
1803	#else
1804
1805	IF (is_mpi_root) THEN
1806	CALL orch_gather_mix_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2),&
1807	ij_para_info)
1808	ELSE
1809	CALL orch_gather_mix_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2),ij_para_info,&
1810	ij_para_info)
1811	ENDIF
1812
1813	#endif
1814	END SUBROUTINE gather_unindexed_mpi_i1
1815
1816	!!!!!
1817
1818	SUBROUTINE gather_unindexed_mpi_i2(VarIn, VarOut)
1819
1820	IMPLICIT NONE
1821
1822	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
1823	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1824
1825	#ifdef CPP_PARA
1826	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
1827	#endif
1828
1829	#ifndef CPP_PARA
1830	VarOut(:,:,:)=VarIn(:,:,:)
1831	RETURN
1832	#else
1833
1834	IF (is_mpi_root) THEN
1835	CALL orch_gather_mix_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3),&
1836	ij_para_info)
1837	ELSE
1838	CALL orch_gather_mix_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3),&
1839	ij_para_info)
1840	ENDIF
1841
1842	#endif
1843	END SUBROUTINE gather_unindexed_mpi_i2
1844
1845	!!!!!
1846
1847	SUBROUTINE gather_unindexed_mpi_i3(VarIn, VarOut)
1848
1849	IMPLICIT NONE
1850
1851	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1852	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1853
1854	#ifdef CPP_PARA
1855	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)) :: dummy
1856	#endif
1857
1858	#ifndef CPP_PARA
1859	VarOut(:,:,:,:)=VarIn(:,:,:,:)
1860	RETURN
1861	#else
1862
1863	IF (is_mpi_root) THEN
1864	CALL orch_gather_mix_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4),&
1865	ij_para_info)
1866	ELSE
1867	CALL orch_gather_mix_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4),&
1868	ij_para_info)
1869	ENDIF
1870
1871	#endif
1872	END SUBROUTINE gather_unindexed_mpi_i3
1873
1874	!!!!!
1875
1876	SUBROUTINE gather_unindexed_mpi_i4(VarIn, VarOut)
1877
1878	IMPLICIT NONE
1879
1880	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1881	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1882
1883	#ifdef CPP_PARA
1884	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
1885	#endif
1886
1887	#ifndef CPP_PARA
1888	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1889	RETURN
1890	#else
1891
1892	IF (is_mpi_root) THEN
1893	CALL orch_gather_mix_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5),&
1894	ij_para_info)
1895	ELSE
1896	CALL orch_gather_mix_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5),&
1897	ij_para_info)
1898	ENDIF
1899
1900	#endif
1901	END SUBROUTINE gather_unindexed_mpi_i4
1902
1903	!!!!! --> Les reels
1904
1905	SUBROUTINE gather_unindexed_mpi_r(VarIn, VarOut)
1906
1907	IMPLICIT NONE
1908
1909	REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
1910	REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
1911
1912	#ifdef CPP_PARA
1913	REAL(r_std),DIMENSION(1) :: dummy
1914	#endif
1915
1916	#ifndef CPP_PARA
1917	VarOut(:)=VarIn(:)
1918	RETURN
1919	#else
1920
1921	IF (is_mpi_root) THEN
1922	CALL orch_gather_mix_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1,&
1923	ij_para_info)
1924	ELSE
1925	CALL orch_gather_mix_mpi_rgen(VarIn,dummy,1,1,&
1926	ij_para_info)
1927	ENDIF
1928
1929	#endif
1930	END SUBROUTINE gather_unindexed_mpi_r
1931
1932	!!!!!
1933
1934	SUBROUTINE gather_unindexed_mpi_r1(VarIn, VarOut)
1935
1936	IMPLICIT NONE
1937
1938	REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
1939	REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
1940
1941	#ifdef CPP_PARA
1942	REAL(r_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy
1943	#endif
1944
1945	#ifndef CPP_PARA
1946	VarOut(:,:)=VarIn(:,:)
1947	RETURN
1948	#else
1949
1950	IF (is_mpi_root) THEN
1951	CALL orch_gather_mix_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2),&
1952	ij_para_info)
1953	ELSE
1954	CALL orch_gather_mix_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2),&
1955	ij_para_info)
1956	ENDIF
1957
1958	#endif
1959	END SUBROUTINE gather_unindexed_mpi_r1
1960
1961	!!!!!
1962
1963	SUBROUTINE gather_unindexed_mpi_r2(VarIn, VarOut)
1964
1965	IMPLICIT NONE
1966
1967	REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
1968	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1969
1970	#ifdef CPP_PARA
1971	REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
1972	#endif
1973
1974	#ifndef CPP_PARA
1975	VarOut(:,:,:)=VarIn(:,:,:)
1976	RETURN
1977	#else
1978
1979	IF (is_mpi_root) THEN
1980	CALL orch_gather_mix_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3),&
1981	ij_para_info)
1982	ELSE
1983	CALL orch_gather_mix_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3),&
1984	ij_para_info)
1985	ENDIF
1986
1987	#endif
1988	END SUBROUTINE gather_unindexed_mpi_r2
1989
1990	!!!!!
1991
1992	SUBROUTINE gather_unindexed_mpi_r3(VarIn, VarOut)
1993
1994	IMPLICIT NONE
1995
1996	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1997	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1998
1999	#ifdef CPP_PARA
2000	REAL(r_std),DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)) :: dummy
2001	#endif
2002
2003	#ifndef CPP_PARA
2004	VarOut(:,:,:,:)=VarIn(:,:,:,:)
2005	RETURN
2006	#else
2007
2008	IF (is_mpi_root) THEN
2009	CALL orch_gather_mix_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4),&
2010	ij_para_info)
2011	ELSE
2012	CALL orch_gather_mix_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4),&
2013	ij_para_info)
2014	ENDIF
2015
2016	#endif
2017	END SUBROUTINE gather_unindexed_mpi_r3
2018
2019	!!!!!
2020
2021	SUBROUTINE gather_unindexed_mpi_r4(VarIn, VarOut)
2022
2023	IMPLICIT NONE
2024
2025	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
2026	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
2027
2028	#ifdef CPP_PARA
2029	REAL(r_std),DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
2030	#endif
2031
2032	#ifndef CPP_PARA
2033	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
2034	RETURN
2035	#else
2036
2037	IF (is_mpi_root) THEN
2038	CALL orch_gather_mix_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5),&
2039	ij_para_info)
2040	ELSE
2041	CALL orch_gather_mix_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5),&
2042	ij_para_info)
2043	ENDIF
2044
2045	#endif
2046	END SUBROUTINE gather_unindexed_mpi_r4
2047
2048	!!!!! --> Les booleen
2049
2050	SUBROUTINE gather_unindexed_mpi_l(VarIn, VarOut)
2051
2052	IMPLICIT NONE
2053
2054	LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
2055	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
2056
2057	#ifdef CPP_PARA
2058	LOGICAL,DIMENSION(1) :: dummy
2059	#endif
2060
2061	#ifndef CPP_PARA
2062	VarOut(:)=VarIn(:)
2063	RETURN
2064	#else
2065
2066	IF (is_mpi_root) THEN
2067	CALL orch_gather_mix_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),1,&
2068	ij_para_info)
2069	ELSE
2070	CALL orch_gather_mix_mpi_lgen(VarIn,dummy,1,1,&
2071	ij_para_info)
2072	ENDIF
2073
2074	#endif
2075	END SUBROUTINE gather_unindexed_mpi_l
2076
2077	!!!!!
2078
2079	SUBROUTINE gather_unindexed_mpi_l1(VarIn, VarOut)
2080
2081	IMPLICIT NONE
2082
2083	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
2084	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
2085
2086	#ifdef CPP_PARA
2087	LOGICAL,DIMENSION(1,SIZE(VarIn,2)) :: dummy
2088	#endif
2089
2090	#ifndef CPP_PARA
2091	VarOut(:,:)=VarIn(:,:)
2092	RETURN
2093	#else
2094
2095	IF (is_mpi_root) THEN
2096	CALL orch_gather_mix_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2),&
2097	ij_para_info)
2098	ELSE
2099	CALL orch_gather_mix_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2),&
2100	ij_para_info)
2101	ENDIF
2102
2103	#endif
2104	END SUBROUTINE gather_unindexed_mpi_l1
2105
2106	!!!!!
2107
2108	SUBROUTINE gather_unindexed_mpi_l2(VarIn, VarOut)
2109
2110	IMPLICIT NONE
2111
2112	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
2113	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
2114
2115	#ifdef CPP_PARA
2116	LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
2117	#endif
2118
2119	#ifndef CPP_PARA
2120	VarOut(:,:,:)=VarIn(:,:,:)
2121	RETURN
2122	#else
2123
2124	IF (is_mpi_root) THEN
2125	CALL orch_gather_mix_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3),&
2126	ij_para_info)
2127	ELSE
2128	CALL orch_gather_mix_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3),&
2129	ij_para_info)
2130	ENDIF
2131
2132	#endif
2133	END SUBROUTINE gather_unindexed_mpi_l2
2134
2135	!!!!!
2136
2137	SUBROUTINE gather_unindexed_mpi_l3(VarIn, VarOut)
2138
2139	IMPLICIT NONE
2140
2141	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
2142	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
2143
2144	#ifdef CPP_PARA
2145	LOGICAL,DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)) :: dummy
2146	#endif
2147
2148	#ifndef CPP_PARA
2149	VarOut(:,:,:,:)=VarIn(:,:,:,:)
2150	RETURN
2151	#else
2152
2153	IF (is_mpi_root) THEN
2154	CALL orch_gather_mix_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4),&
2155	ij_para_info)
2156	ELSE
2157	CALL orch_gather_mix_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4),&
2158	ij_para_info)
2159	ENDIF
2160
2161	#endif
2162	END SUBROUTINE gather_unindexed_mpi_l3
2163
2164	!!!!!
2165
2166	SUBROUTINE gather_unindexed_mpi_l4(VarIn, VarOut)
2167
2168	IMPLICIT NONE
2169
2170	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
2171	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
2172
2173	#ifdef CPP_PARA
2174	LOGICAL,DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
2175	#endif
2176
2177	#ifndef CPP_PARA
2178	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
2179	RETURN
2180	#else
2181
2182	IF (is_mpi_root) THEN
2183	CALL orch_gather_mix_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5),&
2184	ij_para_info)
2185	ELSE
2186	CALL orch_gather_mix_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5),&
2187	ij_para_info)
2188	ENDIF
2189
2190	#endif
2191	END SUBROUTINE gather_unindexed_mpi_l4
2192
2193
2194
2195
2196
2197
2198	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2199	!! Definition of Scatter2D --> 4D !!
2200	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2201
2202	SUBROUTINE scatter2D_mpi_i(VarIn, VarOut)
2203
2204	IMPLICIT NONE
2205
2206	INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
2207	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
2208
2209	#ifdef CPP_PARA
2210	INTEGER(i_std),DIMENSION(1,1) :: dummy
2211	#endif
2212
2213	#ifndef CPP_PARA
2214	VarOut(:,:)=VarIn(:,:)
2215	RETURN
2216	#else
2217
2218	IF (is_mpi_root) THEN
2219	CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
2220	ELSE
2221	CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,1)
2222	ENDIF
2223
2224
2225	#endif
2226	END SUBROUTINE scatter2D_mpi_i
2227
2228	SUBROUTINE scatter2D_mpi_i1(VarIn, VarOut)
2229
2230	IMPLICIT NONE
2231
2232	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
2233	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
2234
2235	#ifdef CPP_PARA
2236	INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)) :: dummy
2237	#endif
2238
2239	#ifndef CPP_PARA
2240	VarOut(:,:,:)=VarIn(:,:,:)
2241	RETURN
2242	#else
2243
2244	IF (is_mpi_root) THEN
2245	CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
2246	ELSE
2247	CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3))
2248	ENDIF
2249
2250	#endif
2251	END SUBROUTINE scatter2D_mpi_i1
2252
2253	SUBROUTINE scatter2D_mpi_i2(VarIn, VarOut)
2254
2255	IMPLICIT NONE
2256
2257	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
2258	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
2259
2260	#ifdef CPP_PARA
2261	INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
2262	#endif
2263
2264	#ifndef CPP_PARA
2265	VarOut(:,:,:,:)=VarIn(:,:,:,:)
2266	RETURN
2267	#else
2268
2269	IF (is_mpi_root) THEN
2270	CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)SIZE(VarIn,2),SIZE(VarOut,3)SIZE(VarOut,4))
2271	ELSE
2272	CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
2273	ENDIF
2274
2275
2276	#endif
2277	END SUBROUTINE scatter2D_mpi_i2
2278
2279	SUBROUTINE scatter2D_mpi_i3(VarIn, VarOut)
2280
2281	IMPLICIT NONE
2282
2283	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
2284	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
2285
2286	#ifdef CPP_PARA
2287	INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)SIZE(VarOut,4)SIZE(VarOut,5)) :: dummy
2288	#endif
2289
2290	#ifndef CPP_PARA
2291	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
2292	RETURN
2293	#else
2294
2295	IF (is_mpi_root) THEN
2296	CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)SIZE(VarIn,2),SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5))
2297	ELSE
2298	CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3)SIZE(VarOut,4)SIZE(VarOut,5))
2299	ENDIF
2300
2301	#endif
2302	END SUBROUTINE scatter2D_mpi_i3
2303
2304
2305	SUBROUTINE scatter2D_mpi_r0(VarIn, VarOut)
2306
2307	IMPLICIT NONE
2308
2309	REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
2310	REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
2311
2312	#ifdef CPP_PARA
2313	REAL(r_std),DIMENSION(1) :: dummy
2314	#endif
2315
2316	#ifndef CPP_PARA
2317	VarOut(:)=VarIn(:)
2318	RETURN
2319	#else
2320
2321	IF (is_mpi_root) THEN
2322	CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1),1)
2323	ELSE
2324	CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,1)
2325	ENDIF
2326
2327
2328	#endif
2329	END SUBROUTINE scatter2D_mpi_r0
2330
2331	SUBROUTINE scatter2D_mpi_r(VarIn, VarOut)
2332
2333	IMPLICIT NONE
2334
2335	REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
2336	REAL(r_std),INTENT(INOUT),DIMENSION(:,:) :: VarOut
2337
2338	#ifdef CPP_PARA
2339	REAL(r_std),DIMENSION(1,1) :: dummy
2340	#endif
2341
2342	#ifndef CPP_PARA
2343	VarOut(:,:)=VarIn(:,:)
2344	RETURN
2345	#else
2346
2347	IF (is_mpi_root) THEN
2348	CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
2349	ELSE
2350	CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,1)
2351	ENDIF
2352
2353	#endif
2354	END SUBROUTINE scatter2D_mpi_r
2355
2356	SUBROUTINE scatter2D_mpi_r1(VarIn, VarOut)
2357
2358	IMPLICIT NONE
2359
2360	REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
2361	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
2362
2363	#ifdef CPP_PARA
2364	REAL(r_std),DIMENSION(1,SIZE(VarOut,3)) :: dummy
2365	#endif
2366
2367	#ifndef CPP_PARA
2368	VarOut(:,:,:)=VarIn(:,:,:)
2369	RETURN
2370	#else
2371
2372	IF (is_mpi_root) THEN
2373	CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
2374	ELSE
2375	CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3))
2376	ENDIF
2377
2378	#endif
2379	END SUBROUTINE scatter2D_mpi_r1
2380
2381	SUBROUTINE scatter2D_mpi_r2(VarIn, VarOut)
2382
2383	IMPLICIT NONE
2384
2385	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
2386	REAL(r_std),INTENT(INOUT),DIMENSION(:,:,:,:) :: VarOut
2387
2388	#ifdef CPP_PARA
2389	REAL(r_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
2390	#endif
2391
2392	#ifndef CPP_PARA
2393	VarOut(:,:,:,:)=VarIn(:,:,:,:)
2394	RETURN
2395	#else
2396
2397	IF (is_mpi_root) THEN
2398	CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)SIZE(VarIn,2),SIZE(VarOut,3)SIZE(VarOut,4))
2399	ELSE
2400	CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
2401	ENDIF
2402
2403	#endif
2404	END SUBROUTINE scatter2D_mpi_r2
2405
2406	SUBROUTINE scatter2D_mpi_r3(VarIn, VarOut)
2407
2408	IMPLICIT NONE
2409
2410	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
2411	REAL(r_std),INTENT(INOUT),DIMENSION(:,:,:,:,:) :: VarOut
2412
2413	#ifdef CPP_PARA
2414	REAL(r_std),DIMENSION(1,SIZE(VarOut,3)SIZE(VarOut,4)SIZE(VarOut,5)) :: dummy
2415	#endif
2416
2417	#ifndef CPP_PARA
2418	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
2419	RETURN
2420	#else
2421
2422	IF (is_mpi_root) THEN
2423	CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)SIZE(VarIn,2),SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5))
2424	ELSE
2425	CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3)SIZE(VarOut,4)SIZE(VarOut,5))
2426	ENDIF
2427
2428	#endif
2429	END SUBROUTINE scatter2D_mpi_r3
2430
2431
2432	SUBROUTINE scatter2D_mpi_l(VarIn, VarOut)
2433
2434	IMPLICIT NONE
2435
2436	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
2437	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
2438
2439	#ifdef CPP_PARA
2440	LOGICAL,DIMENSION(1,1) :: dummy
2441	#endif
2442
2443	#ifndef CPP_PARA
2444	VarOut(:,:)=VarIn(:,:)
2445	RETURN
2446	#else
2447
2448	IF (is_mpi_root) THEN
2449	CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
2450	ELSE
2451	CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,1)
2452	ENDIF
2453
2454	#endif
2455	END SUBROUTINE scatter2D_mpi_l
2456
2457	SUBROUTINE scatter2D_mpi_l1(VarIn, VarOut)
2458
2459	IMPLICIT NONE
2460
2461	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
2462	LOGICAL,INTENT(INOUT),DIMENSION(:,:,:) :: VarOut
2463
2464	#ifdef CPP_PARA
2465	LOGICAL,DIMENSION(1,SIZE(VarOut,3)) :: dummy
2466	#endif
2467
2468	#ifndef CPP_PARA
2469	VarOut(:,:,:)=VarIn(:,:,:)
2470	RETURN
2471	#else
2472
2473	IF (is_mpi_root) THEN
2474	CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
2475	ELSE
2476	CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3))
2477	ENDIF
2478
2479	#endif
2480	END SUBROUTINE scatter2D_mpi_l1
2481
2482	SUBROUTINE scatter2D_mpi_l2(VarIn, VarOut)
2483
2484	IMPLICIT NONE
2485
2486	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
2487	LOGICAL,INTENT(INOUT),DIMENSION(:,:,:,:) :: VarOut
2488
2489	#ifdef CPP_PARA
2490	LOGICAL,DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
2491	#endif
2492
2493	#ifndef CPP_PARA
2494	VarOut(:,:,:,:)=VarIn(:,:,:,:)
2495	RETURN
2496	#else
2497
2498	IF (is_mpi_root) THEN
2499	CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)SIZE(VarIn,2),SIZE(VarOut,3)SIZE(VarOut,4))
2500	ELSE
2501	CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
2502	ENDIF
2503
2504	#endif
2505	END SUBROUTINE scatter2D_mpi_l2
2506
2507	SUBROUTINE scatter2D_mpi_l3(VarIn, VarOut)
2508
2509	IMPLICIT NONE
2510
2511	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
2512	LOGICAL,INTENT(INOUT),DIMENSION(:,:,:,:,:) :: VarOut
2513
2514	#ifdef CPP_PARA
2515	LOGICAL,DIMENSION(1,SIZE(VarOut,3)SIZE(VarOut,4)SIZE(VarOut,5)) :: dummy
2516	#endif
2517
2518	#ifndef CPP_PARA
2519	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
2520	RETURN
2521	#else
2522
2523	IF (is_mpi_root) THEN
2524	CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)SIZE(VarIn,2),SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5))
2525	ELSE
2526	CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3)SIZE(VarOut,4)SIZE(VarOut,5))
2527	ENDIF
2528
2529	#endif
2530	END SUBROUTINE scatter2D_mpi_l3
2531
2532	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2533	!! Definition of all_reduce_sum !!
2534	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2535
2536	SUBROUTINE allreduce_sum_mpi_r(VarIn, VarOut)
2537	IMPLICIT NONE
2538
2539	REAL(r_std),INTENT(IN) :: VarIn
2540	REAL(r_std),INTENT(OUT) :: VarOut
2541
2542	#ifdef CPP_PARA
2543	REAL(r_std),DIMENSION(1) :: Var1
2544	REAL(r_std),DIMENSION(1) :: Var2
2545	! REAL(r_std),DIMENSION(1) :: dummy
2546	#endif
2547
2548	#ifndef CPP_PARA
2549	VarOut=VarIn
2550	RETURN
2551	#else
2552
2553	Var1(1)=VarIn
2554	CALL orch_allreduce_sum_mpi_rgen(Var1,Var2,1)
2555	VarOut=Var2(1)
2556
2557	#endif
2558	END SUBROUTINE allreduce_sum_mpi_r
2559
2560	SUBROUTINE allreduce_sum_mpi_i(VarIn, VarOut)
2561	IMPLICIT NONE
2562
2563	INTEGER(i_std),INTENT(IN) :: VarIn
2564	INTEGER(i_std),INTENT(OUT) :: VarOut
2565
2566	#ifdef CPP_PARA
2567	INTEGER(i_std),DIMENSION(1) :: Var1
2568	INTEGER(i_std),DIMENSION(1) :: Var2
2569	#endif
2570
2571	#ifndef CPP_PARA
2572	VarOut=VarIn
2573	RETURN
2574	#else
2575
2576	Var1(1)=VarIn
2577	CALL orch_allreduce_sum_mpi_igen(Var1,Var2,1)
2578	VarOut=Var2(1)
2579
2580	#endif
2581	END SUBROUTINE allreduce_sum_mpi_i
2582
2583
2584	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2585	!! Definition of Gather2D --> 4D !!
2586	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2587
2588	SUBROUTINE gather2D_mpi_i(VarIn, VarOut)
2589
2590	IMPLICIT NONE
2591
2592	INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
2593	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
2594
2595	#ifdef CPP_PARA
2596	INTEGER(i_std),DIMENSION(1,1) :: dummy
2597	#endif
2598
2599	#ifndef CPP_PARA
2600	VarOut(:,:)=VarIn(:,:)
2601	RETURN
2602	#else
2603
2604	IF (is_mpi_root) THEN
2605	CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
2606	ELSE
2607	CALL orch_gather2D_mpi_igen(VarIn,dummy,1,1)
2608	ENDIF
2609
2610	#endif
2611	END SUBROUTINE gather2D_mpi_i
2612
2613	SUBROUTINE gather2D_mpi_i1(VarIn, VarOut)
2614
2615	IMPLICIT NONE
2616
2617	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
2618	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
2619
2620	#ifdef CPP_PARA
2621	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)) :: dummy
2622	#endif
2623
2624	#ifndef CPP_PARA
2625	VarOut(:,:,:)=VarIn(:,:,:)
2626	RETURN
2627	#else
2628
2629	IF (is_mpi_root) THEN
2630	CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
2631	ELSE
2632	CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3))
2633	ENDIF
2634
2635	#endif
2636	END SUBROUTINE gather2D_mpi_i1
2637
2638	SUBROUTINE gather2D_mpi_i2(VarIn, VarOut)
2639
2640	IMPLICIT NONE
2641
2642	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
2643	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
2644
2645	#ifdef CPP_PARA
2646	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
2647	#endif
2648
2649	#ifndef CPP_PARA
2650	VarOut(:,:,:,:)=VarIn(:,:,:,:)
2651	RETURN
2652	#else
2653
2654	IF (is_mpi_root) THEN
2655	CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)SIZE(VarOut,2),SIZE(VarIn,3)SIZE(VarIn,4))
2656	ELSE
2657	CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
2658	ENDIF
2659
2660	#endif
2661	END SUBROUTINE gather2D_mpi_i2
2662
2663	SUBROUTINE gather2D_mpi_i3(VarIn, VarOut)
2664
2665	IMPLICIT NONE
2666
2667	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
2668	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
2669
2670	#ifdef CPP_PARA
2671	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)SIZE(VarIn,4)SIZE(VarIn,5)) :: dummy
2672	#endif
2673
2674	#ifndef CPP_PARA
2675	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
2676	RETURN
2677	#else
2678
2679	IF (is_mpi_root) THEN
2680	CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)SIZE(VarOut,2),SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5))
2681	ELSE
2682	CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3)SIZE(VarIn,4)SIZE(VarIn,5))
2683	ENDIF
2684
2685	#endif
2686	END SUBROUTINE gather2D_mpi_i3
2687
2688
2689	SUBROUTINE gather2D_mpi_r0(VarIn, VarOut)
2690
2691	IMPLICIT NONE
2692
2693	REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
2694	REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
2695
2696	#ifdef CPP_PARA
2697	REAL(r_std),DIMENSION(1) :: dummy
2698	#endif
2699
2700	#ifndef CPP_PARA
2701	VarOut(:)=VarIn(:)
2702	RETURN
2703	#else
2704
2705	IF (is_mpi_root) THEN
2706	CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1)
2707	ELSE
2708	CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,1)
2709	ENDIF
2710
2711	#endif
2712	END SUBROUTINE gather2D_mpi_r0
2713
2714	SUBROUTINE gather2D_mpi_r(VarIn, VarOut)
2715
2716	IMPLICIT NONE
2717
2718	REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
2719	REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
2720
2721	#ifdef CPP_PARA
2722	REAL(r_std),DIMENSION(1,1) :: dummy
2723	#endif
2724
2725	#ifndef CPP_PARA
2726	VarOut(:,:)=VarIn(:,:)
2727	RETURN
2728	#else
2729
2730	IF (is_mpi_root) THEN
2731	CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
2732	ELSE
2733	CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,1)
2734	ENDIF
2735
2736	#endif
2737	END SUBROUTINE gather2D_mpi_r
2738
2739	SUBROUTINE gather2D_mpi_r1(VarIn, VarOut)
2740
2741	IMPLICIT NONE
2742
2743	REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
2744	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
2745
2746	#ifdef CPP_PARA
2747	REAL(r_std),DIMENSION(1,SIZE(VarIn,3)) :: dummy
2748	#endif
2749
2750	#ifndef CPP_PARA
2751	VarOut(:,:,:)=VarIn(:,:,:)
2752	RETURN
2753	#else
2754
2755	IF (is_mpi_root) THEN
2756	CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
2757	ELSE
2758	CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3))
2759	ENDIF
2760
2761	#endif
2762	END SUBROUTINE gather2D_mpi_r1
2763
2764	SUBROUTINE gather2D_mpi_r2(VarIn, VarOut)
2765
2766	IMPLICIT NONE
2767
2768	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
2769	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
2770
2771	#ifdef CPP_PARA
2772	REAL(r_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
2773	#endif
2774
2775	#ifndef CPP_PARA
2776	VarOut(:,:,:,:)=VarIn(:,:,:,:)
2777	RETURN
2778	#else
2779
2780	IF (is_mpi_root) THEN
2781	CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)SIZE(VarOut,2),SIZE(VarIn,3)SIZE(VarIn,4))
2782	ELSE
2783	CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
2784	ENDIF
2785
2786	#endif
2787	END SUBROUTINE gather2D_mpi_r2
2788
2789	SUBROUTINE gather2D_mpi_r3(VarIn, VarOut)
2790
2791	IMPLICIT NONE
2792
2793	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
2794	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
2795
2796	#ifdef CPP_PARA
2797	REAL(r_std),DIMENSION(1,SIZE(VarIn,3)SIZE(VarIn,4)SIZE(VarIn,5)) :: dummy
2798	#endif
2799
2800	#ifndef CPP_PARA
2801	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
2802	RETURN
2803	#else
2804
2805	IF (is_mpi_root) THEN
2806	CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)SIZE(VarOut,2),SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5))
2807	ELSE
2808	CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3)SIZE(VarIn,4)SIZE(VarIn,5))
2809	ENDIF
2810
2811	#endif
2812	END SUBROUTINE gather2D_mpi_r3
2813
2814
2815	SUBROUTINE gather2D_mpi_l(VarIn, VarOut)
2816
2817	IMPLICIT NONE
2818
2819	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
2820	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
2821
2822	#ifdef CPP_PARA
2823	LOGICAL,DIMENSION(1,1) :: dummy
2824	#endif
2825
2826	#ifndef CPP_PARA
2827	VarOut(:,:)=VarIn(:,:)
2828	RETURN
2829	#else
2830
2831	IF (is_mpi_root) THEN
2832	CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
2833	ELSE
2834	CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,1)
2835	ENDIF
2836
2837	#endif
2838	END SUBROUTINE gather2D_mpi_l
2839
2840	SUBROUTINE gather2D_mpi_l1(VarIn, VarOut)
2841
2842	IMPLICIT NONE
2843
2844	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
2845	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
2846
2847	#ifdef CPP_PARA
2848	LOGICAL,DIMENSION(1,SIZE(VarIn,3)) :: dummy
2849	#endif
2850
2851	#ifndef CPP_PARA
2852	VarOut(:,:,:)=VarIn(:,:,:)
2853	RETURN
2854	#else
2855
2856	IF (is_mpi_root) THEN
2857	CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
2858	ELSE
2859	CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3))
2860	ENDIF
2861
2862	#endif
2863	END SUBROUTINE gather2D_mpi_l1
2864
2865	SUBROUTINE gather2D_mpi_l2(VarIn, VarOut)
2866
2867	IMPLICIT NONE
2868
2869	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
2870	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
2871
2872	#ifdef CPP_PARA
2873	LOGICAL,DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
2874	#endif
2875
2876	#ifndef CPP_PARA
2877	VarOut(:,:,:,:)=VarIn(:,:,:,:)
2878	RETURN
2879	#else
2880
2881	IF (is_mpi_root) THEN
2882	CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)SIZE(VarOut,2),SIZE(VarIn,3)SIZE(VarIn,4))
2883	ELSE
2884	CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
2885	ENDIF
2886
2887	#endif
2888	END SUBROUTINE gather2D_mpi_l2
2889
2890	SUBROUTINE gather2D_mpi_l3(VarIn, VarOut)
2891
2892	IMPLICIT NONE
2893
2894	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
2895	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
2896
2897	#ifdef CPP_PARA
2898	LOGICAL,DIMENSION(1,SIZE(VarIn,3)SIZE(VarIn,4)SIZE(VarIn,5)) :: dummy
2899	#endif
2900
2901	#ifndef CPP_PARA
2902	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
2903	RETURN
2904	#else
2905
2906	IF (is_mpi_root) THEN
2907	CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)SIZE(VarOut,2),SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5))
2908	ELSE
2909	CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3)SIZE(VarIn,4)SIZE(VarIn,5))
2910	ENDIF
2911
2912	#endif
2913	END SUBROUTINE gather2D_mpi_l3
2914
2915	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2916	!! Definition of reduce_sum --> 4D !!
2917	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2918
2919	SUBROUTINE reduce_sum_mpi_i(VarIn, VarOut)
2920
2921	IMPLICIT NONE
2922
2923	INTEGER(i_std),INTENT(IN) :: VarIn
2924	INTEGER(i_std),INTENT(OUT) :: VarOut
2925
2926	#ifdef CPP_PARA
2927	INTEGER(i_std),DIMENSION(1) :: Var1
2928	INTEGER(i_std),DIMENSION(1) :: Var2
2929	INTEGER(i_std),DIMENSION(1) :: dummy
2930	#endif
2931
2932	#ifndef CPP_PARA
2933	VarOut=VarIn
2934	RETURN
2935	#else
2936	Var1(1)=VarIn
2937	IF (is_mpi_root) THEN
2938	CALL orch_reduce_sum_mpi_igen(Var1,Var2,1)
2939	VarOut=Var2(1)
2940	ELSE
2941	CALL orch_reduce_sum_mpi_igen(Var1,dummy,1)
2942	VarOut=VarIn
2943	ENDIF
2944	#endif
2945	END SUBROUTINE reduce_sum_mpi_i
2946
2947	SUBROUTINE reduce_sum_mpi_i1(VarIn, VarOut)
2948
2949	IMPLICIT NONE
2950
2951	INTEGER(i_std),INTENT(IN),DIMENSION(:) :: VarIn
2952	INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
2953
2954	#ifdef CPP_PARA
2955	INTEGER(i_std),DIMENSION(1) :: dummy
2956	#endif
2957
2958	#ifndef CPP_PARA
2959	VarOut(:)=VarIn(:)
2960	RETURN
2961	#else
2962
2963	IF (is_mpi_root) THEN
2964	CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
2965	ELSE
2966	CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))
2967	ENDIF
2968
2969	#endif
2970	END SUBROUTINE reduce_sum_mpi_i1
2971
2972	SUBROUTINE reduce_sum_mpi_i2(VarIn, VarOut)
2973	IMPLICIT NONE
2974
2975	INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
2976	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
2977
2978	#ifdef CPP_PARA
2979	INTEGER(i_std),DIMENSION(1) :: dummy
2980	#endif
2981
2982	#ifndef CPP_PARA
2983	VarOut(:,:)=VarIn(:,:)
2984	RETURN
2985	#else
2986
2987	IF (is_mpi_root) THEN
2988	CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
2989	ELSE
2990	CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))
2991	ENDIF
2992
2993	#endif
2994	END SUBROUTINE reduce_sum_mpi_i2
2995
2996	SUBROUTINE reduce_sum_mpi_i3(VarIn, VarOut)
2997	IMPLICIT NONE
2998
2999	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
3000	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
3001
3002	#ifdef CPP_PARA
3003	INTEGER(i_std),DIMENSION(1) :: dummy
3004	#endif
3005
3006	#ifndef CPP_PARA
3007	VarOut(:,:,:)=VarIn(:,:,:)
3008	RETURN
3009	#else
3010
3011	IF (is_mpi_root) THEN
3012	CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
3013	ELSE
3014	CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))
3015	ENDIF
3016
3017	#endif
3018	END SUBROUTINE reduce_sum_mpi_i3
3019
3020	SUBROUTINE reduce_sum_mpi_i4(VarIn, VarOut)
3021	IMPLICIT NONE
3022
3023	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
3024	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
3025
3026	#ifdef CPP_PARA
3027	INTEGER(i_std),DIMENSION(1) :: dummy
3028	#endif
3029
3030	#ifndef CPP_PARA
3031	VarOut(:,:,:,:)=VarIn(:,:,:,:)
3032	RETURN
3033	#else
3034
3035	IF (is_mpi_root) THEN
3036	CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
3037	ELSE
3038	CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))
3039	ENDIF
3040
3041	#endif
3042	END SUBROUTINE reduce_sum_mpi_i4
3043
3044
3045	SUBROUTINE reduce_sum_mpi_r(VarIn, VarOut)
3046	IMPLICIT NONE
3047
3048	REAL(r_std),INTENT(IN) :: VarIn
3049	REAL(r_std),INTENT(OUT) :: VarOut
3050
3051	#ifdef CPP_PARA
3052	REAL(r_std),DIMENSION(1) :: Var1
3053	REAL(r_std),DIMENSION(1) :: Var2
3054	REAL(r_std),DIMENSION(1) :: dummy
3055	#endif
3056
3057	#ifndef CPP_PARA
3058	VarOut=VarIn
3059	RETURN
3060	#else
3061
3062	Var1(1)=VarIn
3063	IF (is_mpi_root) THEN
3064	CALL orch_reduce_sum_mpi_rgen(Var1,Var2,1)
3065	VarOut=Var2(1)
3066	ELSE
3067	CALL orch_reduce_sum_mpi_rgen(Var1,dummy,1)
3068	VarOut=VarIn
3069	ENDIF
3070
3071	#endif
3072	END SUBROUTINE reduce_sum_mpi_r
3073
3074	SUBROUTINE reduce_sum_mpi_r1(VarIn, VarOut)
3075	IMPLICIT NONE
3076
3077	REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
3078	REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
3079
3080	#ifdef CPP_PARA
3081	REAL(r_std),DIMENSION(1) :: dummy
3082	#endif
3083
3084	#ifndef CPP_PARA
3085	VarOut(:)=VarIn(:)
3086	RETURN
3087	#else
3088
3089	IF (is_mpi_root) THEN
3090	CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
3091	ELSE
3092	CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))
3093	ENDIF
3094
3095	#endif
3096	END SUBROUTINE reduce_sum_mpi_r1
3097
3098	SUBROUTINE reduce_sum_mpi_r2(VarIn, VarOut)
3099	IMPLICIT NONE
3100
3101	REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
3102	REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
3103
3104	#ifdef CPP_PARA
3105	REAL(r_std),DIMENSION(1) :: dummy
3106	#endif
3107
3108	#ifndef CPP_PARA
3109	VarOut(:,:)=VarIn(:,:)
3110	RETURN
3111	#else
3112
3113	IF (is_mpi_root) THEN
3114	CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
3115	ELSE
3116	CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))
3117	ENDIF
3118
3119	#endif
3120	END SUBROUTINE reduce_sum_mpi_r2
3121
3122	SUBROUTINE reduce_sum_mpi_r3(VarIn, VarOut)
3123	IMPLICIT NONE
3124
3125	REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
3126	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
3127
3128	#ifdef CPP_PARA
3129	REAL(r_std),DIMENSION(1) :: dummy
3130	#endif
3131
3132	#ifndef CPP_PARA
3133	VarOut(:,:,:)=VarIn(:,:,:)
3134	RETURN
3135	#else
3136
3137	IF (is_mpi_root) THEN
3138	CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
3139	ELSE
3140	CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))
3141	ENDIF
3142
3143	#endif
3144	END SUBROUTINE reduce_sum_mpi_r3
3145
3146	SUBROUTINE reduce_sum_mpi_r4(VarIn, VarOut)
3147	IMPLICIT NONE
3148
3149	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
3150	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
3151
3152	#ifdef CPP_PARA
3153	REAL(r_std),DIMENSION(1) :: dummy
3154	#endif
3155
3156	#ifndef CPP_PARA
3157	VarOut(:,:,:,:)=VarIn(:,:,:,:)
3158	RETURN
3159	#else
3160
3161	IF (is_mpi_root) THEN
3162	CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
3163	ELSE
3164	CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))
3165	ENDIF
3166
3167	#endif
3168	END SUBROUTINE reduce_sum_mpi_r4
3169
3170
3171	END MODULE mod_orchidee_mpi_transfert
3172
3173	#ifdef CPP_PARA
3174
3175	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3176	!! DEFINITION OF GENERIC TRANSFERT SUBROUTINES !!
3177	!! These subroutines are only used localy in this module !!
3178	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3179
3180	SUBROUTINE orch_bcast_mpi_cgen(var,nb)
3181	USE mod_orchidee_para_var
3182	USE timer
3183
3184	IMPLICIT NONE
3185
3186	CHARACTER(LEN=*),DIMENSION(nb),INTENT(INOUT) :: Var
3187	INTEGER(i_std),INTENT(IN) :: nb
3188
3189	INCLUDE 'mpif.h'
3190
3191	INTEGER(i_std) :: ierr
3192	LOGICAL :: flag=.FALSE.
3193	LOGICAL, PARAMETER :: check=.FALSE.
3194
3195	IF (timer_state(timer_mpi)==running) THEN
3196	flag=.TRUE.
3197	ELSE
3198	flag=.FALSE.
3199	ENDIF
3200
3201	IF (check) &
3202	WRITE(numout,*) "orch_bcast_mpi_cgen before bcast Var",Var
3203	IF (flag) CALL suspend_timer(timer_mpi)
3204	CALL MPI_BCAST(Var,nb*LEN(Var(1)),MPI_CHARACTER,mpi_rank_root,MPI_COMM_ORCH,ierr)
3205	IF (flag) CALL resume_timer(timer_mpi)
3206	IF (check) &
3207	WRITE(numout,*) "orch_bcast_mpi_cgen after bcast Var",Var
3208
3209	END SUBROUTINE orch_bcast_mpi_cgen
3210
3211	SUBROUTINE orch_bcast_mpi_igen(var,nb)
3212	USE mod_orchidee_para_var
3213	USE timer
3214	IMPLICIT NONE
3215
3216	INTEGER(i_std),DIMENSION(nb),INTENT(INOUT) :: Var
3217	INTEGER(i_std),INTENT(IN) :: nb
3218
3219	INCLUDE 'mpif.h'
3220
3221	INTEGER(i_std) :: ierr
3222	LOGICAL :: flag=.FALSE.
3223	LOGICAL, PARAMETER :: check=.FALSE.
3224
3225	IF (timer_state(timer_mpi)==running) THEN
3226	flag=.TRUE.
3227	ELSE
3228	flag=.FALSE.
3229	ENDIF
3230
3231	IF (flag) CALL suspend_timer(timer_mpi)
3232
3233	IF (check) &
3234	WRITE(numout,*) "orch_bcast_mpi_igen before bcast Var",Var
3235	CALL MPI_BCAST(Var,nb,MPI_INT_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
3236	IF (flag) CALL resume_timer(timer_mpi)
3237	IF (check) &
3238	WRITE(numout,*) "orch_bcast_mpi_igen after bcast Var",Var
3239
3240	END SUBROUTINE orch_bcast_mpi_igen
3241
3242	SUBROUTINE orch_bcast_mpi_rgen(var,nb)
3243	USE mod_orchidee_para_var
3244	USE timer
3245
3246	IMPLICIT NONE
3247
3248	REAL(r_std),DIMENSION(nb),INTENT(INOUT) :: Var
3249	INTEGER(i_std),INTENT(IN) :: nb
3250
3251	INCLUDE 'mpif.h'
3252
3253	INTEGER(i_std) :: ierr
3254	LOGICAL :: flag=.FALSE.
3255	LOGICAL, PARAMETER :: check=.FALSE.
3256
3257	IF (timer_state(timer_mpi)==running) THEN
3258	flag=.TRUE.
3259	ELSE
3260	flag=.FALSE.
3261	ENDIF
3262
3263	IF (check) &
3264	WRITE(numout,*) "orch_bcast_mpi_rgen before bcast Var",Var
3265	IF (flag) CALL suspend_timer(timer_mpi)
3266	CALL MPI_BCAST(Var,nb,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
3267	IF (flag) CALL resume_timer(timer_mpi)
3268	IF (check) &
3269	WRITE(numout,*) "orch_bcast_mpi_rgen after bcast Var",Var
3270
3271	END SUBROUTINE orch_bcast_mpi_rgen
3272
3273	SUBROUTINE orch_bcast_mpi_lgen(var,nb)
3274	USE mod_orchidee_para_var
3275	USE timer
3276
3277	IMPLICIT NONE
3278
3279	LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
3280	INTEGER(i_std),INTENT(IN) :: nb
3281
3282	INCLUDE 'mpif.h'
3283
3284	INTEGER(i_std) :: ierr
3285	LOGICAL :: flag=.FALSE.
3286	LOGICAL, PARAMETER :: check=.FALSE.
3287
3288
3289	IF (timer_state(timer_mpi)==running) THEN
3290	flag=.TRUE.
3291	ELSE
3292	flag=.FALSE.
3293	ENDIF
3294
3295	IF (check) &
3296	WRITE(numout,*) "orch_bcast_mpi_lgen before bcast Var",Var
3297	IF (flag) CALL suspend_timer(timer_mpi)
3298	CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_rank_root,MPI_COMM_ORCH,ierr)
3299	IF (flag) CALL resume_timer(timer_mpi)
3300	IF (check) &
3301	WRITE(numout,*) "orch_bcast_mpi_lgen after bcast Var",Var
3302
3303	END SUBROUTINE orch_bcast_mpi_lgen
3304
3305
3306	SUBROUTINE orch_scatter_mix_mpi_igen(VarIn, VarOut, nbp, dimsize, &
3307	grid_info)
3308	USE mod_orchidee_para_var
3309	USE timer
3310
3311	IMPLICIT NONE
3312
3313	INTEGER(i_std),INTENT(IN) :: nbp
3314	INTEGER(i_std),INTENT(IN) :: dimsize
3315	TYPE(gridcells_info), INTENT(in) :: grid_info
3316	INTEGER(i_std),INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
3317	INTEGER(i_std),INTENT(OUT),DIMENSION(grid_info%nb_mpi_loc,dimsize) :: VarOut
3318
3319	INCLUDE 'mpif.h'
3320
3321	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
3322	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
3323	INTEGER(i_std),DIMENSION(dimsize*grid_info%nb_mpi_global) :: VarTmp
3324
3325	INTEGER(i_std) :: nb,i,index_para,rank
3326	INTEGER(i_std) :: ierr
3327	LOGICAL :: flag=.FALSE.
3328	LOGICAL, PARAMETER :: check=.FALSE.
3329
3330	IF (timer_state(timer_mpi)==running) THEN
3331	flag=.TRUE.
3332	ELSE
3333	flag=.FALSE.
3334	ENDIF
3335
3336	IF (flag) CALL suspend_timer(timer_mpi)
3337
3338	IF (is_mpi_root) THEN
3339	Index_Para=1
3340	DO rank=0,mpi_size-1
3341	nb=grid_info%nb_mpi_para(rank)
3342	displs(rank)=Index_Para-1
3343	counts(rank)=nb*dimsize
3344	DO i=1,dimsize
3345	VarTmp(Index_para:Index_para+nb-1)=VarIn(grid_info%begin_mpi_para(rank):grid_info%end_mpi_para(rank),i)
3346	Index_para=Index_para+nb
3347	ENDDO
3348	ENDDO
3349	IF (check) THEN
3350	WRITE(numout,*) "orch_scatter_mix_mpi_igen VarIn",VarIn
3351	WRITE(numout,*) "orch_scatter_mix_mpi_igen VarTmp",VarTmp
3352	ENDIF
3353	ENDIF
3354
3355	CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INT_ORCH,VarOut,grid_info%nb_mpi_loc*dimsize, &
3356	MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
3357	IF (flag) CALL resume_timer(timer_mpi)
3358	IF (check) &
3359	WRITE(numout,*) "orch_scatter_mix_mpi_igen VarOut",VarOut
3360
3361	END SUBROUTINE orch_scatter_mix_mpi_igen
3362
3363	SUBROUTINE orch_scatter_mix_mpi_rgen(VarIn, VarOut, nbp, dimsize, &
3364	grid_info)
3365	USE mod_orchidee_para_var
3366	USE timer
3367
3368	IMPLICIT NONE
3369
3370	INTEGER(i_std),INTENT(IN) :: dimsize
3371	INTEGER(i_std),INTENT(IN) :: nbp
3372	TYPE(gridcells_info), INTENT(in) :: grid_info
3373	REAL(r_std),INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
3374	REAL(r_std),INTENT(OUT),DIMENSION(grid_info%nb_mpi_loc,dimsize) :: VarOut
3375
3376	INCLUDE 'mpif.h'
3377
3378	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
3379	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
3380	REAL(r_std),DIMENSION(dimsize*grid_info%nb_mpi_global) :: VarTmp
3381
3382	INTEGER(i_std) :: nb,i,index_para,rank
3383	INTEGER(i_std) :: ierr
3384	LOGICAL :: flag=.FALSE.
3385	LOGICAL, PARAMETER :: check=.FALSE.
3386
3387	IF (timer_state(timer_mpi)==running) THEN
3388	flag=.TRUE.
3389	ELSE
3390	flag=.FALSE.
3391	ENDIF
3392
3393	IF (flag) CALL suspend_timer(timer_mpi)
3394
3395	IF (is_mpi_root) THEN
3396	Index_para=1
3397	DO rank=0,mpi_size-1
3398	nb=grid_info%nb_mpi_para(rank)
3399	displs(rank)=Index_para-1
3400	counts(rank)=nb*dimsize
3401	DO i=1,dimsize
3402	VarTmp(Index_para:Index_para+nb-1)=VarIn(grid_info%begin_mpi_para(rank):grid_info%end_mpi_para(rank),i)
3403	Index_para=Index_para+nb
3404	ENDDO
3405	ENDDO
3406	IF (check) THEN
3407	WRITE(numout,*) "orch_scatter_mix_mpi_rgen VarIn",VarIn
3408	WRITE(numout,*) "orch_scatter_mix_mpi_rgen VarTmp",VarTmp
3409	ENDIF
3410	ENDIF
3411
3412	CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_ORCH,VarOut,grid_info%nb_mpi_loc*dimsize, &
3413	MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
3414
3415	IF (flag) CALL resume_timer(timer_mpi)
3416	IF (check) &
3417	WRITE(numout,*) "orch_scatter_mix_mpi_rgen VarOut",VarOut
3418
3419	END SUBROUTINE orch_scatter_mix_mpi_rgen
3420
3421	SUBROUTINE orch_scatter_mix_mpi_lgen(VarIn, VarOut, nbp, dimsize, &
3422	grid_info)
3423	USE mod_orchidee_para_var
3424	USE timer
3425
3426	IMPLICIT NONE
3427
3428	INTEGER(i_std),INTENT(IN) :: dimsize
3429	INTEGER(i_std),INTENT(IN) :: nbp
3430	TYPE(gridcells_info), INTENT(in) :: grid_info
3431	LOGICAL,INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
3432	LOGICAL,INTENT(OUT),DIMENSION(grid_info%nb_mpi_loc,dimsize) :: VarOut
3433
3434	INCLUDE 'mpif.h'
3435
3436	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
3437	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
3438	LOGICAL,DIMENSION(dimsize*grid_info%nb_mpi_global) :: VarTmp
3439
3440	INTEGER(i_std) :: nb,i,index_para,rank
3441	INTEGER(i_std) :: ierr
3442	LOGICAL :: flag=.FALSE.
3443	LOGICAL, PARAMETER :: check=.FALSE.
3444
3445	IF (timer_state(timer_mpi)==running) THEN
3446	flag=.TRUE.
3447	ELSE
3448	flag=.FALSE.
3449	ENDIF
3450
3451	IF (flag) CALL suspend_timer(timer_mpi)
3452
3453	IF (is_mpi_root) THEN
3454	Index_para=1
3455	DO rank=0,mpi_size-1
3456	nb=grid_info%nb_mpi_para(rank)
3457	displs(rank)=Index_para-1
3458	counts(rank)=nb*dimsize
3459	DO i=1,dimsize
3460	VarTmp(Index_para:Index_para+nb-1)=VarIn(grid_info%begin_mpi_para(rank):grid_info%end_mpi_para(rank),i)
3461	Index_para=Index_para+nb
3462	ENDDO
3463	ENDDO
3464	IF (check) THEN
3465	WRITE(numout,*) "orch_scatter_mix_mpi_lgen VarIn",VarIn
3466	WRITE(numout,*) "orch_scatter_mix_mpi_lgen VarTmp",VarTmp
3467	ENDIF
3468	ENDIF
3469
3470	CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,grid_info%nb_mpi_loc*dimsize, &
3471	MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
3472	IF (flag) CALL resume_timer(timer_mpi)
3473	IF (check) &
3474	WRITE(numout,*) "orch_scatter_mix_mpi_lgen VarOut",VarOut
3475
3476	END SUBROUTINE orch_scatter_mix_mpi_lgen
3477
3478	SUBROUTINE orch_gather_mix_mpi_igen(VarIn, VarOut, nbp, dimsize, &
3479	grid_info)
3480
3481
3482	USE mod_orchidee_para_var
3483	USE timer
3484
3485	IMPLICIT NONE
3486
3487	INTEGER(i_std),INTENT(IN) :: dimsize
3488	INTEGER(i_std),INTENT(IN) :: nbp
3489	TYPE(gridcells_info), INTENT(in) :: grid_info
3490	INTEGER(i_std),INTENT(IN),DIMENSION(grid_info%nb_mpi_loc,dimsize) :: VarIn
3491
3492	INTEGER(i_std),INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
3493
3494	INCLUDE 'mpif.h'
3495
3496	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
3497	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
3498	INTEGER(i_std),DIMENSION(dimsize*grid_info%nb_mpi_global) :: VarTmp
3499
3500	INTEGER(i_std) :: nb,i,index_para,rank
3501	INTEGER(i_std) :: ierr
3502	LOGICAL :: flag=.FALSE.
3503	LOGICAL, PARAMETER :: check=.FALSE.
3504
3505	IF (timer_state(timer_mpi)==running) THEN
3506	flag=.TRUE.
3507	ELSE
3508	flag=.FALSE.
3509	ENDIF
3510
3511	IF (flag) CALL suspend_timer(timer_mpi)
3512
3513	IF (is_mpi_root) THEN
3514	Index_para=1
3515	DO rank=0,mpi_size-1
3516	nb=grid_info%nb_mpi_para(rank)
3517	displs(rank)=Index_para-1
3518	counts(rank)=nb*dimsize
3519	Index_para=Index_para+nb*dimsize
3520	ENDDO
3521	IF (check) &
3522	WRITE(numout,*) "orch_gather_mix_mpi_igen grid_info%nb_mpi_para, displs, counts,Index_Para-1",&
3523	grid_info%nb_mpi_para, displs, counts,Index_Para-1
3524
3525	ENDIF
3526
3527	CALL MPI_GATHERV(VarIn,grid_info%nb_mpi_loc*dimsize,MPI_INT_ORCH,VarTmp,counts,displs, &
3528	MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
3529
3530
3531	IF (is_mpi_root) THEN
3532	Index_para=1
3533	DO rank=0,mpi_size-1
3534	nb=grid_info%nb_mpi_para(rank)
3535	DO i=1,dimsize
3536	VarOut(grid_info%begin_mpi_para(rank):grid_info%end_mpi_para(rank),i)=VarTmp(Index_para:Index_para+nb-1)
3537	Index_para=Index_para+nb
3538	ENDDO
3539	ENDDO
3540	ENDIF
3541	IF (check) &
3542	WRITE(numout,*) "orch_gather_mix_mpi_igen VarOut=",VarOut
3543	IF (flag) CALL resume_timer(timer_mpi)
3544
3545	END SUBROUTINE orch_gather_mix_mpi_igen
3546
3547
3548	SUBROUTINE orch_gather_mix_mpi_rgen(VarIn, VarOut, nbp, dimsize, &
3549	grid_info)
3550	USE mod_orchidee_para_var
3551	USE timer
3552
3553	IMPLICIT NONE
3554
3555	INTEGER(i_std),INTENT(IN) :: dimsize
3556	INTEGER(i_std),INTENT(IN) :: nbp
3557	TYPE(gridcells_info), INTENT(in) :: grid_info
3558	REAL(r_std),INTENT(IN),DIMENSION(grid_info%nb_mpi_loc,dimsize) :: VarIn
3559	REAL(r_std),INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
3560
3561	INCLUDE 'mpif.h'
3562
3563	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
3564	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
3565	REAL(r_std),DIMENSION(dimsize*grid_info%nb_mpi_global) :: VarTmp
3566
3567	INTEGER(i_std) :: nb,i,index_para,rank
3568	INTEGER(i_std) :: ierr
3569	LOGICAL :: flag=.FALSE.
3570	LOGICAL, PARAMETER :: check=.FALSE.
3571
3572	IF (timer_state(timer_mpi)==running) THEN
3573	flag=.TRUE.
3574	ELSE
3575	flag=.FALSE.
3576	ENDIF
3577
3578	IF (flag) CALL suspend_timer(timer_mpi)
3579
3580	IF (is_mpi_root) THEN
3581	Index_para=1
3582	DO rank=0,mpi_size-1
3583	nb=grid_info%nb_mpi_para(rank)
3584	displs(rank)=Index_para-1
3585	counts(rank)=nb*dimsize
3586	Index_para=Index_para+nb*dimsize
3587	ENDDO
3588	IF (check) &
3589	WRITE(numout,*) "orch_gather_mix_mpi_rgen grid_info%nb_mpi_para, displs, counts,Index_Para-1",&
3590	ij_para_nb, displs, counts,Index_Para-1
3591
3592	ENDIF
3593
3594	IF (check) &
3595	WRITE(numout,*) "orch_gather_mix_mpi_rgen VarIn=",VarIn
3596	CALL MPI_GATHERV(VarIn,grid_info%nb_mpi_loc*dimsize,MPI_REAL_ORCH,VarTmp,counts,displs, &
3597	MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
3598	IF (check) &
3599	WRITE(numout,*) "orch_gather_mix_mpi_rgen dimsize,VarTmp=",dimsize,VarTmp
3600
3601	IF (is_mpi_root) THEN
3602	Index_para=1
3603	DO rank=0,mpi_size-1
3604	nb=grid_info%nb_mpi_para(rank)
3605	DO i=1,dimsize
3606	VarOut(grid_info%begin_mpi_para(rank):grid_info%end_mpi_para(rank),i)=VarTmp(Index_para:Index_para+nb-1)
3607	Index_para=Index_para+nb
3608	ENDDO
3609	ENDDO
3610	ENDIF
3611	IF (check) &
3612	WRITE(numout,*) "orch_gather_mix_mpi_rgen VarOut=",VarOut
3613	IF (flag) CALL resume_timer(timer_mpi)
3614
3615	END SUBROUTINE orch_gather_mix_mpi_rgen
3616
3617	SUBROUTINE orch_gather_mix_mpi_lgen(VarIn, VarOut, nbp, dimsize, &
3618	grid_info)
3619	USE mod_orchidee_para_var
3620	USE timer
3621
3622	IMPLICIT NONE
3623
3624	INTEGER(i_std),INTENT(IN) :: dimsize
3625	INTEGER(i_std),INTENT(IN) :: nbp
3626	TYPE(gridcells_info), INTENT(in) :: grid_info
3627	LOGICAL,INTENT(IN),DIMENSION(grid_info%nb_mpi_loc,dimsize) :: VarIn
3628	LOGICAL,INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
3629
3630	INCLUDE 'mpif.h'
3631
3632	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
3633	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
3634	LOGICAL,DIMENSION(dimsize*grid_info%nb_mpi_global) :: VarTmp
3635
3636	INTEGER(i_std) :: nb,i,index_para,rank
3637	INTEGER(i_std) :: ierr
3638	LOGICAL :: flag=.FALSE.
3639	LOGICAL, PARAMETER :: check=.FALSE.
3640
3641
3642	IF (timer_state(timer_mpi)==running) THEN
3643	flag=.TRUE.
3644	ELSE
3645	flag=.FALSE.
3646	ENDIF
3647
3648	IF (flag) CALL suspend_timer(timer_mpi)
3649
3650	IF (is_mpi_root) THEN
3651	Index_para=1
3652	DO rank=0,mpi_size-1
3653	nb=grid_info%nb_mpi_para(rank)
3654	displs(rank)=Index_para-1
3655	counts(rank)=nb*dimsize
3656	Index_para=Index_para+nb*dimsize
3657	ENDDO
3658	IF (check) &
3659	WRITE(numout,*) "orch_gather_mix_mpi_lgen ij_para_nb, displs, counts,Index_Para-1",&
3660	ij_para_nb, displs, counts,Index_Para-1
3661	ENDIF
3662
3663	IF (check) &
3664	WRITE(numout,*) "orch_gather_mix_mpi_lgen VarIn=",VarIn
3665	CALL MPI_GATHERV(VarIn,grid_info%nb_mpi_loc*dimsize,MPI_LOGICAL,VarTmp,counts,displs, &
3666	MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
3667	IF (check) &
3668	WRITE(numout,*) "orch_gather_mix_mpi_lgen dimsize,VarTmp=",dimsize,VarTmp
3669
3670	IF (is_mpi_root) THEN
3671	Index_para=1
3672	DO rank=0,mpi_size-1
3673	nb=grid_info%nb_mpi_para(rank)
3674	DO i=1,dimsize
3675	VarOut(grid_info%begin_mpi_para(rank):grid_info%end_mpi_para(rank),i)=VarTmp(Index_para:Index_para+nb-1)
3676	Index_para=Index_para+nb
3677	ENDDO
3678	ENDDO
3679	ENDIF
3680	IF (check) &
3681	WRITE(numout,*) "orch_gather_mix_mpi_lgen VarOut=",VarOut
3682	IF (flag) CALL resume_timer(timer_mpi)
3683
3684	END SUBROUTINE orch_gather_mix_mpi_lgen
3685
3686
3687
3688
3689
3690
3691	SUBROUTINE orch_scatter2D_mpi_igen(VarIn, VarOut, nbp2D, dimsize)
3692	USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
3693	USE timer
3694
3695	IMPLICIT NONE
3696
3697	INTEGER(i_std),INTENT(IN) :: dimsize
3698	INTEGER(i_std),INTENT(IN) :: nbp2D
3699	INTEGER(i_std),INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
3700	INTEGER(i_std),INTENT(OUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
3701
3702	INCLUDE 'mpif.h'
3703
3704	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
3705	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
3706	INTEGER(i_std),DIMENSION(dimsizeiimjjm) :: VarTmp1
3707	INTEGER(i_std),DIMENSION(ij_nb,dimsize) :: VarTmp2
3708
3709	INTEGER(i_std) :: nb,i,ij,index_para,rank
3710	INTEGER(i_std) :: ierr
3711	LOGICAL :: flag=.FALSE.
3712	LOGICAL, PARAMETER :: check=.FALSE.
3713
3714	IF (timer_state(timer_mpi)==running) THEN
3715	flag=.TRUE.
3716	ELSE
3717	flag=.FALSE.
3718	ENDIF
3719
3720	IF (flag) CALL suspend_timer(timer_mpi)
3721
3722	IF (is_mpi_root) THEN
3723	Index_para=1
3724	DO rank=0,mpi_size-1
3725	nb=ij_para_nb(rank)
3726	displs(rank)=Index_para-1
3727	counts(rank)=nb*dimsize
3728	DO i=1,dimsize
3729	VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
3730	Index_para=Index_para+nb
3731	ENDDO
3732	ENDDO
3733	IF (check) THEN
3734	WRITE(numout,*) "orch_scatter2D_mpi_igen VarIn",VarIn
3735	WRITE(numout,*) "orch_scatter2D_mpi_igen VarTmp1",VarTmp1
3736	ENDIF
3737	ENDIF
3738
3739	CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_INT_ORCH,VarTmp2,ij_nb*dimsize, &
3740	MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
3741	IF (check) &
3742	WRITE(numout,*) "orch_scatter2D_mpi_igen VarTmp2",VarTmp2
3743
3744	DO i=1,dimsize
3745	DO ij=1,ij_nb
3746	VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
3747	ENDDO
3748	ENDDO
3749	IF (flag) CALL resume_timer(timer_mpi)
3750	IF (check) &
3751	WRITE(numout,*) "orch_scatter2D_mpi_igen VarOut",VarOut
3752
3753	END SUBROUTINE orch_scatter2D_mpi_igen
3754
3755	SUBROUTINE orch_scatter2D_mpi_rgen(VarIn, VarOut, nbp2D, dimsize)
3756	USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
3757	USE timer
3758
3759	IMPLICIT NONE
3760
3761	INTEGER(i_std),INTENT(IN) :: dimsize
3762	INTEGER(i_std),INTENT(IN) :: nbp2D
3763	REAL(r_std),INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
3764	REAL(r_std),INTENT(INOUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
3765
3766	INCLUDE 'mpif.h'
3767
3768	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
3769	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
3770	REAL(r_std),DIMENSION(dimsizeiimjjm) :: VarTmp1
3771	REAL(r_std),DIMENSION(ij_nb,dimsize) :: VarTmp2
3772
3773	INTEGER(i_std) :: nb,i,ij,index_para,rank
3774	INTEGER(i_std) :: ierr
3775	LOGICAL :: flag=.FALSE.
3776	LOGICAL, PARAMETER :: check=.FALSE.
3777
3778	IF (timer_state(timer_mpi)==running) THEN
3779	flag=.TRUE.
3780	ELSE
3781	flag=.FALSE.
3782	ENDIF
3783
3784	IF (flag) CALL suspend_timer(timer_mpi)
3785
3786	IF (is_mpi_root) THEN
3787	Index_para=1
3788	DO rank=0,mpi_size-1
3789	nb=ij_para_nb(rank)
3790	displs(rank)=Index_para-1
3791	counts(rank)=nb*dimsize
3792	DO i=1,dimsize
3793	VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
3794	Index_para=Index_para+nb
3795	ENDDO
3796	ENDDO
3797	IF (check) THEN
3798	WRITE(numout,*) "orch_scatter2D_mpi_rgen VarIn",VarIn
3799	WRITE(numout,*) "orch_scatter2D_mpi_rgen VarTmp1",VarTmp1
3800	ENDIF
3801	ENDIF
3802	nb=ij_nb*dimsize
3803	IF (check) &
3804	WRITE(numout,) "ij_nbdimsize",ij_nb*dimsize
3805
3806	CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_REAL_ORCH,VarTmp2,nb, &
3807	MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
3808	IF (check) &
3809	WRITE(numout,*) "orch_scatter2D_mpi_rgen VarTmp2",VarTmp2
3810
3811	DO i=1,dimsize
3812	DO ij=1,ij_nb
3813	VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
3814	ENDDO
3815	ENDDO
3816
3817	IF (flag) CALL resume_timer(timer_mpi)
3818	IF (check) &
3819	WRITE(numout,*) "orch_scatter2D_mpi_rgen VarOut",VarOut
3820
3821	END SUBROUTINE orch_scatter2D_mpi_rgen
3822
3823	SUBROUTINE orch_scatter2D_mpi_lgen(VarIn, VarOut, nbp2D, dimsize)
3824	USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
3825	USE timer
3826
3827	IMPLICIT NONE
3828
3829	INTEGER(i_std),INTENT(IN) :: dimsize
3830	INTEGER(i_std),INTENT(IN) :: nbp2D
3831	LOGICAL,INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
3832	LOGICAL,INTENT(INOUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
3833
3834	INCLUDE 'mpif.h'
3835
3836	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
3837	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
3838	LOGICAL,DIMENSION(dimsizeiimjjm) :: VarTmp1
3839	LOGICAL,DIMENSION(ij_nb,dimsize) :: VarTmp2
3840
3841	INTEGER(i_std) :: nb,i,ij,index_para,rank
3842	INTEGER(i_std) :: ierr
3843	LOGICAL :: flag=.FALSE.
3844	LOGICAL, PARAMETER :: check=.FALSE.
3845
3846	IF (timer_state(timer_mpi)==running) THEN
3847	flag=.TRUE.
3848	ELSE
3849	flag=.FALSE.
3850	ENDIF
3851
3852	IF (flag) CALL suspend_timer(timer_mpi)
3853
3854	IF (is_mpi_root) THEN
3855	Index_para=1
3856	DO rank=0,mpi_size-1
3857	nb=ij_para_nb(rank)
3858	displs(rank)=Index_para-1
3859	counts(rank)=nb*dimsize
3860	DO i=1,dimsize
3861	VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
3862	Index_para=Index_para+nb
3863	ENDDO
3864	ENDDO
3865	IF (check) THEN
3866	WRITE(numout,*) "orch_scatter2D_mpi_lgen VarIn",VarIn
3867	WRITE(numout,*) "orch_scatter2D_mpi_lgen VarTmp1",VarTmp1
3868	ENDIF
3869	ENDIF
3870
3871	CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_LOGICAL,VarTmp2,ij_nb*dimsize, &
3872	MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
3873	IF (check) &
3874	WRITE(numout,*) "orch_scatter2D_mpi_lgen VarTmp2",VarTmp2
3875
3876	DO i=1,dimsize
3877	DO ij=1,ij_nb
3878	VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
3879	ENDDO
3880	ENDDO
3881	IF (flag) CALL resume_timer(timer_mpi)
3882	IF (check) &
3883	WRITE(numout,*) "orch_scatter2D_mpi_lgen VarOut",VarOut
3884
3885	END SUBROUTINE orch_scatter2D_mpi_lgen
3886
3887
3888	SUBROUTINE orch_gather2D_mpi_igen(VarIn, VarOut, nbp2D, dimsize)
3889	USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
3890	USE timer
3891
3892	IMPLICIT NONE
3893
3894	INTEGER(i_std),INTENT(IN) :: dimsize
3895	INTEGER(i_std),INTENT(IN) :: nbp2D
3896	INTEGER(i_std),INTENT(IN),DIMENSION(iim*jj_nb,dimsize) :: VarIn
3897	INTEGER(i_std),INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
3898
3899	INCLUDE 'mpif.h'
3900
3901	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
3902	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
3903	INTEGER(i_std),DIMENSION(ij_nb,dimsize) :: VarTmp1
3904	INTEGER(i_std),DIMENSION(dimsizeiimjjm) :: VarTmp2
3905
3906	INTEGER(i_std) :: nb,i,ij,index_para,rank
3907	INTEGER(i_std) :: ierr
3908	LOGICAL :: flag=.FALSE.
3909	LOGICAL,PARAMETER :: check=.FALSE.
3910
3911	IF (timer_state(timer_mpi)==running) THEN
3912	flag=.TRUE.
3913	ELSE
3914	flag=.FALSE.
3915	ENDIF
3916
3917	IF (flag) CALL suspend_timer(timer_mpi)
3918
3919	IF (is_mpi_root) THEN
3920	Index_para=1
3921
3922	DO rank=0,mpi_size-1
3923	nb=ij_para_nb(rank)
3924	displs(rank)=Index_para-1
3925	counts(rank)=nb*dimsize
3926	Index_para=Index_para+nb*dimsize
3927	ENDDO
3928	IF (check) &
3929	WRITE(numout,*) "orch_gather2D_mpi_igen nbp_mpi_para, displs, counts,Index_Para-1", &
3930	nbp_mpi_para, displs, counts,Index_Para-1
3931	ENDIF
3932	DO i=1,dimsize
3933	DO ij=1,ij_nb
3934	VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
3935	ENDDO
3936	ENDDO
3937
3938	IF (check) THEN
3939	WRITE(numout,*) "orch_gather2D_mpi_igen VarIn=",VarIn
3940	WRITE(numout,*) "orch_gather2D_mpi_igen VarTmp1=",VarTmp1
3941	ENDIF
3942	CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_INT_ORCH,VarTmp2,counts,displs, &
3943	MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
3944	IF (check) &
3945	WRITE(numout,*) "orch_gather2D_mpi_igen VarTmp2=",VarTmp2
3946
3947	IF (is_mpi_root) THEN
3948	Index_para=1
3949	DO rank=0,mpi_size-1
3950	nb=ij_para_nb(rank)
3951	DO i=1,dimsize
3952	VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
3953	Index_para=Index_para+nb
3954	ENDDO
3955	ENDDO
3956	ENDIF
3957
3958	IF (flag) CALL resume_timer(timer_mpi)
3959	IF (check) &
3960	WRITE(numout,*) "orch_gather2D_mpi_igen VarOut=",VarOut
3961
3962	END SUBROUTINE orch_gather2D_mpi_igen
3963
3964	SUBROUTINE orch_gather2D_mpi_rgen(VarIn, VarOut, nbp2D,dimsize)
3965	USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
3966	USE timer
3967
3968	IMPLICIT NONE
3969
3970	INTEGER(i_std),INTENT(IN) :: dimsize
3971	INTEGER(i_std),INTENT(IN) :: nbp2D
3972	REAL(r_std),INTENT(IN),DIMENSION(iim*jj_nb,dimsize) :: VarIn
3973	REAL(r_std),INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
3974
3975	INCLUDE 'mpif.h'
3976
3977	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
3978	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
3979	REAL(r_std),DIMENSION(ij_nb,dimsize) :: VarTmp1
3980	REAL(r_std),DIMENSION(dimsizeiimjjm) :: VarTmp2
3981
3982	INTEGER(i_std) :: nb,i,ij,index_para,rank
3983	INTEGER(i_std) :: ierr
3984	LOGICAL :: flag=.FALSE.
3985	LOGICAL,PARAMETER :: check=.FALSE.
3986
3987	IF (timer_state(timer_mpi)==running) THEN
3988	flag=.TRUE.
3989	ELSE
3990	flag=.FALSE.
3991	ENDIF
3992
3993	IF (flag) CALL suspend_timer(timer_mpi)
3994
3995	IF (is_mpi_root) THEN
3996	Index_para=1
3997
3998	DO rank=0,mpi_size-1
3999	nb=ij_para_nb(rank)
4000	displs(rank)=Index_para-1
4001	counts(rank)=nb*dimsize
4002	Index_para=Index_para+nb*dimsize
4003	ENDDO
4004	IF (check) &
4005	WRITE(numout,*) "orch_gather2D_mpi_rgen nbp_mpi_para, displs, counts,Index_Para-1", &
4006	nbp_mpi_para, displs, counts,Index_Para-1
4007	ENDIF
4008
4009	DO i=1,dimsize
4010	DO ij=1,ij_nb
4011	VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
4012	ENDDO
4013	ENDDO
4014
4015	IF (check) THEN
4016	WRITE(numout,*) "orch_gather2D_mpi_rgen VarIn=",VarIn
4017	WRITE(numout,*) "orch_gather2D_mpi_rgen VarTmp1=",VarTmp1
4018	ENDIF
4019	CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_REAL_ORCH,VarTmp2,counts,displs, &
4020	MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
4021	IF (check) &
4022	WRITE(numout,*) "orch_gather2D_mpi_rgen VarTmp2=",VarTmp2
4023
4024	IF (is_mpi_root) THEN
4025	Index_para=1
4026	DO rank=0,mpi_size-1
4027	nb=ij_para_nb(rank)
4028	DO i=1,dimsize
4029	VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
4030	Index_para=Index_para+nb
4031	ENDDO
4032	ENDDO
4033	ENDIF
4034
4035	IF (flag) CALL resume_timer(timer_mpi)
4036	IF (check) &
4037	WRITE(numout,*) "orch_gather2D_mpi_rgen VarOut=",VarOut
4038
4039	END SUBROUTINE orch_gather2D_mpi_rgen
4040
4041	SUBROUTINE orch_gather2D_mpi_lgen(VarIn, VarOut, nbp2D, dimsize)
4042	USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
4043	USE timer
4044
4045	IMPLICIT NONE
4046
4047	INTEGER(i_std),INTENT(IN) :: dimsize
4048	INTEGER(i_std),INTENT(IN) :: nbp2D
4049	LOGICAL,INTENT(IN),DIMENSION(iim*jj_nb,dimsize) :: VarIn
4050	LOGICAL,INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
4051
4052	INCLUDE 'mpif.h'
4053
4054	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
4055	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
4056	LOGICAL,DIMENSION(ij_nb,dimsize) :: VarTmp1
4057	LOGICAL,DIMENSION(dimsizeiimjjm) :: VarTmp2
4058
4059	INTEGER(i_std) :: nb,i,ij,index_para,rank
4060	INTEGER(i_std) :: ierr
4061	LOGICAL :: flag=.FALSE.
4062	LOGICAL,PARAMETER :: check=.FALSE.
4063
4064	IF (timer_state(timer_mpi)==running) THEN
4065	flag=.TRUE.
4066	ELSE
4067	flag=.FALSE.
4068	ENDIF
4069
4070	IF (flag) CALL suspend_timer(timer_mpi)
4071
4072	IF (is_mpi_root) THEN
4073	Index_para=1
4074
4075	DO rank=0,mpi_size-1
4076	nb=ij_para_nb(rank)
4077	displs(rank)=Index_para-1
4078	counts(rank)=nb*dimsize
4079	Index_para=Index_para+nb*dimsize
4080	ENDDO
4081	IF (check) &
4082	WRITE(numout,*) "orch_gather2D_mpi_lgen nbp_mpi_para, displs, counts,Index_Para-1", &
4083	nbp_mpi_para, displs, counts,Index_Para-1
4084	ENDIF
4085
4086	DO i=1,dimsize
4087	DO ij=1,ij_nb
4088	VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
4089	ENDDO
4090	ENDDO
4091
4092	IF (check) THEN
4093	WRITE(numout,*) "orch_gather2D_mpi_lgen VarIn=",VarIn
4094	WRITE(numout,*) "orch_gather2D_mpi_lgen VarTmp1=",VarTmp1
4095	ENDIF
4096	CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_LOGICAL,VarTmp2,counts,displs, &
4097	MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
4098	IF (check) &
4099	WRITE(numout,*) "orch_gather2D_mpi_lgen VarTmp2=",VarTmp2
4100
4101	IF (is_mpi_root) THEN
4102	Index_para=1
4103	DO rank=0,mpi_size-1
4104	nb=ij_para_nb(rank)
4105	DO i=1,dimsize
4106	VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
4107	Index_para=Index_para+nb
4108	ENDDO
4109	ENDDO
4110	ENDIF
4111
4112	IF (flag) CALL resume_timer(timer_mpi)
4113	IF (check) &
4114	WRITE(numout,*) "orch_gather2D_mpi_lgen VarOut=",VarOut
4115
4116	END SUBROUTINE orch_gather2D_mpi_lgen
4117
4118	SUBROUTINE orch_reduce_sum_mpi_igen(VarIn,VarOut,nb)
4119	USE mod_orchidee_para_var
4120	USE timer
4121
4122	IMPLICIT NONE
4123
4124	INTEGER(i_std),DIMENSION(nb),INTENT(IN) :: VarIn
4125	INTEGER(i_std),DIMENSION(nb),INTENT(OUT) :: VarOut
4126	INTEGER(i_std),INTENT(IN) :: nb
4127
4128	INCLUDE 'mpif.h'
4129
4130	INTEGER(i_std) :: ierr
4131	LOGICAL :: flag=.FALSE.
4132	LOGICAL, PARAMETER :: check=.FALSE.
4133
4134	IF (timer_state(timer_mpi)==running) THEN
4135	flag=.TRUE.
4136	ELSE
4137	flag=.FALSE.
4138	ENDIF
4139
4140	IF (check) &
4141	WRITE(numout,*) "orch_reduce_sum_mpi_igen VarIn",VarIn
4142	IF (flag) CALL suspend_timer(timer_mpi)
4143
4144	CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INT_ORCH,MPI_SUM,mpi_rank_root,MPI_COMM_ORCH,ierr)
4145
4146	IF (flag) CALL resume_timer(timer_mpi)
4147	IF (check) &
4148	WRITE(numout,*) "orch_reduce_sum_mpi_igen VarOut",VarOut
4149
4150	END SUBROUTINE orch_reduce_sum_mpi_igen
4151
4152	SUBROUTINE orch_reduce_sum_mpi_rgen(VarIn,VarOut,nb)
4153	USE mod_orchidee_para_var
4154	USE timer
4155
4156	IMPLICIT NONE
4157
4158	REAL(r_std),DIMENSION(nb),INTENT(IN) :: VarIn
4159	REAL(r_std),DIMENSION(nb),INTENT(OUT) :: VarOut
4160	INTEGER(i_std),INTENT(IN) :: nb
4161
4162	INCLUDE 'mpif.h'
4163
4164	INTEGER(i_std) :: ierr
4165	LOGICAL :: flag=.FALSE.
4166	LOGICAL, PARAMETER :: check=.FALSE.
4167
4168	IF (timer_state(timer_mpi)==running) THEN
4169	flag=.TRUE.
4170	ELSE
4171	flag=.FALSE.
4172	ENDIF
4173
4174	IF (check) &
4175	WRITE(numout,*) "orch_reduce_sum_mpi_rgen VarIn",VarIn
4176	IF (flag) CALL suspend_timer(timer_mpi)
4177
4178	CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_ORCH,MPI_SUM,mpi_rank_root,MPI_COMM_ORCH,ierr)
4179
4180	IF (flag) CALL resume_timer(timer_mpi)
4181	IF (check) &
4182	WRITE(numout,*) "orch_reduce_sum_mpi_rgen VarOut",VarOut
4183
4184	END SUBROUTINE orch_reduce_sum_mpi_rgen
4185
4186
4187	SUBROUTINE orch_allreduce_sum_mpi_rgen(VarIn,VarOut,nb)
4188	USE mod_orchidee_para_var
4189	USE timer
4190	USE mpi
4191
4192	IMPLICIT NONE
4193
4194	REAL(r_std),DIMENSION(nb),INTENT(IN) :: VarIn
4195	REAL(r_std),DIMENSION(nb),INTENT(OUT) :: VarOut
4196	INTEGER(i_std),INTENT(IN) :: nb
4197
4198	INTEGER(i_std) :: ierr
4199	LOGICAL :: flag=.FALSE.
4200	LOGICAL, PARAMETER :: check=.FALSE.
4201
4202	IF (timer_state(timer_mpi)==running) THEN
4203	flag=.TRUE.
4204	ELSE
4205	flag=.FALSE.
4206	ENDIF
4207
4208	IF (check) &
4209	WRITE(numout,*) "orch_allreduce_sum_mpi_rgen VarIn",VarIn
4210	IF (flag) CALL suspend_timer(timer_mpi)
4211
4212	CALL MPI_ALLREDUCE(VarIn,VarOut,nb,MPI_REAL_ORCH,MPI_SUM,MPI_COMM_ORCH,ierr)
4213
4214	IF (flag) CALL resume_timer(timer_mpi)
4215	IF (check) &
4216	WRITE(numout,*) "orch_allreduce_sum_mpi_rgen VarOut",VarOut
4217
4218	END SUBROUTINE orch_allreduce_sum_mpi_rgen
4219
4220
4221	SUBROUTINE orch_allreduce_sum_mpi_igen(VarIn,VarOut,nb)
4222	USE mod_orchidee_para_var
4223	USE timer
4224	USE mpi
4225
4226	IMPLICIT NONE
4227
4228	INTEGER(i_std),DIMENSION(nb),INTENT(IN) :: VarIn
4229	INTEGER(i_std),DIMENSION(nb),INTENT(OUT) :: VarOut
4230	INTEGER(i_std),INTENT(IN) :: nb
4231
4232	INTEGER(i_std) :: ierr
4233	LOGICAL :: flag=.FALSE.
4234	LOGICAL, PARAMETER :: check=.FALSE.
4235
4236	IF (timer_state(timer_mpi)==running) THEN
4237	flag=.TRUE.
4238	ELSE
4239	flag=.FALSE.
4240	ENDIF
4241
4242	IF (check) &
4243	WRITE(numout,*) "orch_allreduce_sum_mpi_igen VarIn",VarIn
4244	IF (flag) CALL suspend_timer(timer_mpi)
4245
4246	CALL MPI_ALLREDUCE(VarIn,VarOut,nb,MPI_INT_ORCH,MPI_SUM,MPI_COMM_ORCH,ierr)
4247
4248	IF (flag) CALL resume_timer(timer_mpi)
4249	IF (check) &
4250	WRITE(numout,*) "orch_allreduce_sum_mpi_igen VarOut",VarOut
4251
4252	END SUBROUTINE orch_allreduce_sum_mpi_igen
4253
4254	#endif

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

Context Navigation

source: tags/ORCHIDEE_4_1/ORCHIDEE/src_parallel/mod_orchidee_mpi_transfert.F90 @ 7852

Download in other formats: