Context Navigation

source: tags/ORCHIDEE_2_0/ORCHIDEE/src_parallel/mod_orchidee_mpi_transfert.F90

Last change on this file was 4862, checked in by josefine.ghattas, 7 years ago
Cut lines too long for gfortran
Property svn:keywords set to `Date Revision HeadURL`
File size: 74.0 KB

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

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

Download in other formats: