Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

mod_orchidee_mpi_transfert.F90 @ 7541

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

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

Context Navigation

source: branches/publications/ORCHIDEE_2.2_r7266/ORCHIDEE/src_parallel/mod_orchidee_mpi_transfert.F90 @ 7541

Download in other formats: