Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

mod_orchidee_mpi_transfert.F90 @ 7346

Last change on this file since 7346 was 4977, checked in by simon.bowring, 6 years ago
Currently running (13/02/2018) version includes all necessarily changes to include DOC in MICT code... further parametrisation necessary to equate soil pools with those of normal forcesoil restarts
File size: 78.1 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/perso/albert.jornet/MICT_LEAK/src_parallel/mod_orchidee_mpi_transfert.F90 $
23	!! $Date: 2017-07-27 14:10:15 +0200 (jeu. 27 juil. 2017) $
24	!! $Revision: 4537 $
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,scatter_mpi_i4, &
66	scatter_mpi_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3,scatter_mpi_r4, &
67	scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3,scatter_mpi_l4
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,gather_mpi_i4, &
99	gather_mpi_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3,gather_mpi_r4, &
100	gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3,gather_mpi_l4
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	SUBROUTINE scatter_mpi_i4(VarIn, VarOut)
468
469	IMPLICIT NONE
470
471	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
472	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
473
474	#ifdef CPP_PARA
475	INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
476	#endif
477
478	#ifndef CPP_PARA
479	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
480	RETURN
481	#else
482	IF (is_mpi_root) THEN
483	CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5))
484	ELSE
485	CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5))
486	ENDIF
487
488	#endif
489	END SUBROUTINE scatter_mpi_i4
490
491	SUBROUTINE scatter_mpi_r(VarIn, VarOut)
492
493	IMPLICIT NONE
494
495	REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
496	REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
497
498
499	#ifdef CPP_PARA
500	REAL(r_std),DIMENSION(1) :: 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),1)
509	ELSE
510	CALL orch_scatter_mpi_rgen(dummy,Varout,1,1)
511	ENDIF
512	#endif
513	END SUBROUTINE scatter_mpi_r
514
515	SUBROUTINE scatter_mpi_r1(VarIn, VarOut)
516
517	IMPLICIT NONE
518
519	REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
520	REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
521
522	#ifdef CPP_PARA
523	REAL(r_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy
524	#endif
525
526	#ifndef CPP_PARA
527	VarOut(:,:)=VarIn(:,:)
528	RETURN
529	#else
530	IF (is_mpi_root) THEN
531	CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
532	ELSE
533	CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2))
534	ENDIF
535
536	#endif
537	END SUBROUTINE scatter_mpi_r1
538
539	SUBROUTINE scatter_mpi_r2(VarIn, VarOut)
540
541	IMPLICIT NONE
542
543	REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
544	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
545
546	#ifdef CPP_PARA
547	REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
548	#endif
549
550	#ifndef CPP_PARA
551	VarOut(:,:,:)=VarIn(:,:,:)
552	RETURN
553	#else
554	IF (is_mpi_root) THEN
555	CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
556	ELSE
557	CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
558	ENDIF
559
560	#endif
561	END SUBROUTINE scatter_mpi_r2
562
563	SUBROUTINE scatter_mpi_r3(VarIn, VarOut)
564
565	IMPLICIT NONE
566
567	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
568	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
569
570	#ifdef CPP_PARA
571	REAL(r_std),DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)) :: dummy
572	#endif
573
574	#ifndef CPP_PARA
575	VarOut(:,:,:,:)=VarIn(:,:,:,:)
576	RETURN
577	#else
578	IF (is_mpi_root) THEN
579	CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4))
580	ELSE
581	CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4))
582	ENDIF
583	#endif
584	END SUBROUTINE scatter_mpi_r3
585
586	SUBROUTINE scatter_mpi_r4(VarIn, VarOut)
587
588	IMPLICIT NONE
589
590	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
591	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
592
593	#ifdef CPP_PARA
594	REAL(r_std),DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
595	#endif
596
597	#ifndef CPP_PARA
598	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
599	RETURN
600	#else
601	IF (is_mpi_root) THEN
602	CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5))
603	ELSE
604	CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5))
605	ENDIF
606	#endif
607	END SUBROUTINE scatter_mpi_r4
608
609
610	SUBROUTINE scatter_mpi_l(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) :: 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),1)
627	ELSE
628	CALL orch_scatter_mpi_lgen(dummy,Varout,1,1)
629	ENDIF
630	#endif
631	END SUBROUTINE scatter_mpi_l
632
633	SUBROUTINE scatter_mpi_l1(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)) :: 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))
650	ELSE
651	CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2))
652	ENDIF
653	#endif
654	END SUBROUTINE scatter_mpi_l1
655
656	SUBROUTINE scatter_mpi_l2(VarIn, VarOut)
657
658	IMPLICIT NONE
659
660	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
661	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
662
663	#ifdef CPP_PARA
664	LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
665	#endif
666
667	#ifndef CPP_PARA
668	VarOut(:,:,:)=VarIn(:,:,:)
669	RETURN
670	#else
671	IF (is_mpi_root) THEN
672	CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
673	ELSE
674	CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
675	ENDIF
676	#endif
677	END SUBROUTINE scatter_mpi_l2
678
679	SUBROUTINE scatter_mpi_l3(VarIn, VarOut)
680
681	IMPLICIT NONE
682
683	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
684	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
685
686	#ifdef CPP_PARA
687	LOGICAL,DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)) :: dummy
688	#endif
689
690	#ifndef CPP_PARA
691	VarOut(:,:,:,:)=VarIn(:,:,:,:)
692	RETURN
693	#else
694	IF (is_mpi_root) THEN
695	CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4))
696	ELSE
697	CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4))
698	ENDIF
699	#endif
700	END SUBROUTINE scatter_mpi_l3
701
702	SUBROUTINE scatter_mpi_l4(VarIn, VarOut)
703
704	IMPLICIT NONE
705
706	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
707	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
708
709	#ifdef CPP_PARA
710	LOGICAL,DIMENSION(1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
711	#endif
712
713	#ifndef CPP_PARA
714	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
715	RETURN
716	#else
717	IF (is_mpi_root) THEN
718	CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5))
719	ELSE
720	CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5))
721	ENDIF
722	#endif
723	END SUBROUTINE scatter_mpi_l4
724
725	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
726	!! Definition of Gather 1D --> 4D !!
727	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
728
729	SUBROUTINE gather_mpi_is(VarIn, VarOut)
730
731	#ifdef CPP_PARA
732	USE mpi
733	#endif
734
735	IMPLICIT NONE
736
737	INTEGER(i_std),INTENT(IN) :: VarIn
738	INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
739
740	#ifdef CPP_PARA
741	INTEGER(i_std) :: nb,i,index_para,rank
742	INTEGER(i_std) :: ierr
743	LOGICAL :: flag=.FALSE.
744	LOGICAL, PARAMETER :: check=.FALSE.
745	#endif
746
747	#ifndef CPP_PARA
748	VarOut(:)=VarIn
749	RETURN
750	#else
751
752	IF (timer_state(timer_mpi)==running) THEN
753	flag=.TRUE.
754	ELSE
755	flag=.FALSE.
756	ENDIF
757
758	IF (flag) CALL suspend_timer(timer_mpi)
759
760	IF (check) &
761	WRITE(numout,*) "gather_mpi_is VarIn=",VarIn
762
763	#ifdef CPP_PARA
764	CALL MPI_GATHER(VarIn,1,MPI_INT_ORCH,VarOut,1,MPI_INT_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
765	#endif
766
767	IF (check) &
768	WRITE(numout,*) "gather_mpi_is VarOut=",VarOut
769	IF (flag) CALL resume_timer(timer_mpi)
770	#endif
771	END SUBROUTINE gather_mpi_is
772
773	SUBROUTINE gather_mpi_rs(VarIn, VarOut)
774
775	#ifdef CPP_PARA
776	USE mpi
777	#endif
778
779	IMPLICIT NONE
780
781	REAL(r_std),INTENT(IN) :: VarIn
782	REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
783
784	#ifdef CPP_PARA
785	INTEGER(i_std) :: nb,i,index_para,rank
786	INTEGER(i_std) :: ierr
787	LOGICAL :: flag=.FALSE.
788	LOGICAL, PARAMETER :: check=.FALSE.
789	#endif
790
791	#ifndef CPP_PARA
792	VarOut(:)=VarIn
793	RETURN
794	#else
795
796	IF (timer_state(timer_mpi)==running) THEN
797	flag=.TRUE.
798	ELSE
799	flag=.FALSE.
800	ENDIF
801
802	IF (flag) CALL suspend_timer(timer_mpi)
803
804	IF (check) &
805	WRITE(numout,*) "gather_mpi_rs VarIn=",VarIn
806
807	#ifdef CPP_PARA
808	CALL MPI_GATHER(VarIn,1,MPI_REAL_ORCH,VarOut,1,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
809	#endif
810
811	IF (check) &
812	WRITE(numout,*) "gather_mpi_rs VarOut=",VarOut
813
814	IF (flag) CALL resume_timer(timer_mpi)
815	#endif
816	END SUBROUTINE gather_mpi_rs
817
818	SUBROUTINE gather_mpi_ls(VarIn, VarOut)
819
820	#ifdef CPP_PARA
821	USE mpi
822	#endif
823
824	IMPLICIT NONE
825
826	LOGICAL,INTENT(IN) :: VarIn
827	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
828
829	#ifdef CPP_PARA
830	INTEGER(i_std) :: nb,i,index_para,rank
831	INTEGER(i_std) :: ierr
832	LOGICAL :: flag=.FALSE.
833	LOGICAL, PARAMETER :: check=.FALSE.
834	#endif
835
836	#ifndef CPP_PARA
837	VarOut(:)=VarIn
838	RETURN
839	#else
840
841	IF (timer_state(timer_mpi)==running) THEN
842	flag=.TRUE.
843	ELSE
844	flag=.FALSE.
845	ENDIF
846
847	IF (flag) CALL suspend_timer(timer_mpi)
848
849	IF (check) &
850	WRITE(numout,*) "gather_mpi_ls VarIn=",VarIn
851
852	#ifdef CPP_PARA
853	CALL MPI_GATHER(VarIn,1,MPI_LOGICAL,VarOut,1,MPI_LOGICAL,mpi_rank_root,MPI_COMM_ORCH,ierr)
854	#endif
855
856	IF (check) &
857	WRITE(numout,*) "gather_mpi_ls VarOut=",VarOut
858	IF (flag) CALL resume_timer(timer_mpi)
859	#endif
860	END SUBROUTINE gather_mpi_ls
861
862	!!!!! --> Integers
863
864	SUBROUTINE gather_mpi_i(VarIn, VarOut)
865
866	IMPLICIT NONE
867
868	INTEGER(i_std),INTENT(IN),DIMENSION(:) :: VarIn
869	INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
870
871	#ifdef CPP_PARA
872	INTEGER(i_std),DIMENSION(1) :: dummy
873	#endif
874
875	#ifndef CPP_PARA
876	VarOut(:)=VarIn(:)
877	RETURN
878	#else
879
880	IF (is_mpi_root) THEN
881	CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),1)
882	ELSE
883	CALL orch_gather_mpi_igen(VarIn,dummy,1,1)
884	ENDIF
885
886	#endif
887	END SUBROUTINE gather_mpi_i
888
889	!!!!!
890
891	SUBROUTINE gather_mpi_i1(VarIn, VarOut)
892
893	IMPLICIT NONE
894
895	INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
896	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
897
898	#ifdef CPP_PARA
899	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy
900	#endif
901
902	#ifndef CPP_PARA
903	VarOut(:,:)=VarIn(:,:)
904	RETURN
905	#else
906
907	IF (is_mpi_root) THEN
908	CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
909	ELSE
910	CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2))
911	ENDIF
912
913	#endif
914	END SUBROUTINE gather_mpi_i1
915
916	!!!!!
917
918	SUBROUTINE gather_mpi_i2(VarIn, VarOut)
919
920	IMPLICIT NONE
921
922	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
923	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
924
925	#ifdef CPP_PARA
926	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
927	#endif
928
929	#ifndef CPP_PARA
930	VarOut(:,:,:)=VarIn(:,:,:)
931	RETURN
932	#else
933
934	IF (is_mpi_root) THEN
935	CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
936	ELSE
937	CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
938	ENDIF
939
940	#endif
941	END SUBROUTINE gather_mpi_i2
942
943	!!!!!
944
945	SUBROUTINE gather_mpi_i3(VarIn, VarOut)
946
947	IMPLICIT NONE
948
949	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
950	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
951
952	#ifdef CPP_PARA
953	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)) :: dummy
954	#endif
955
956	#ifndef CPP_PARA
957	VarOut(:,:,:,:)=VarIn(:,:,:,:)
958	RETURN
959	#else
960
961	IF (is_mpi_root) THEN
962	CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4))
963	ELSE
964	CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4))
965	ENDIF
966
967	#endif
968	END SUBROUTINE gather_mpi_i3
969
970	!!!!!
971
972	SUBROUTINE gather_mpi_i4(VarIn, VarOut)
973
974	IMPLICIT NONE
975
976	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
977	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
978
979	#ifdef CPP_PARA
980	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
981	#endif
982
983	#ifndef CPP_PARA
984	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
985	RETURN
986	#else
987
988	IF (is_mpi_root) THEN
989	CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5))
990	ELSE
991	CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5))
992	ENDIF
993
994	#endif
995	END SUBROUTINE gather_mpi_i4
996
997	!!!!! --> Reals
998
999	SUBROUTINE gather_mpi_r(VarIn, VarOut)
1000
1001	IMPLICIT NONE
1002
1003	REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
1004	REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
1005
1006	#ifdef CPP_PARA
1007	REAL(r_std),DIMENSION(1) :: dummy
1008	#endif
1009
1010	#ifndef CPP_PARA
1011	VarOut(:)=VarIn(:)
1012	RETURN
1013	#else
1014
1015	IF (is_mpi_root) THEN
1016	CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1)
1017	ELSE
1018	CALL orch_gather_mpi_rgen(VarIn,dummy,1,1)
1019	ENDIF
1020
1021	#endif
1022	END SUBROUTINE gather_mpi_r
1023
1024	!!!!!
1025
1026	SUBROUTINE gather_mpi_r1(VarIn, VarOut)
1027
1028	IMPLICIT NONE
1029
1030	REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
1031	REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
1032
1033	#ifdef CPP_PARA
1034	REAL(r_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy
1035	#endif
1036
1037	#ifndef CPP_PARA
1038	VarOut(:,:)=VarIn(:,:)
1039	RETURN
1040	#else
1041
1042	IF (is_mpi_root) THEN
1043	CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
1044	ELSE
1045	CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2))
1046	ENDIF
1047
1048	#endif
1049	END SUBROUTINE gather_mpi_r1
1050
1051	!!!!!
1052
1053	SUBROUTINE gather_mpi_r2(VarIn, VarOut)
1054
1055	IMPLICIT NONE
1056
1057	REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
1058	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1059
1060	#ifdef CPP_PARA
1061	REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
1062	#endif
1063
1064	#ifndef CPP_PARA
1065	VarOut(:,:,:)=VarIn(:,:,:)
1066	RETURN
1067	#else
1068
1069	IF (is_mpi_root) THEN
1070	CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
1071	ELSE
1072	CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
1073	ENDIF
1074
1075	#endif
1076	END SUBROUTINE gather_mpi_r2
1077
1078	!!!!!
1079
1080	SUBROUTINE gather_mpi_r3(VarIn, VarOut)
1081
1082	IMPLICIT NONE
1083
1084	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1085	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1086
1087	#ifdef CPP_PARA
1088	REAL(r_std),DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)) :: dummy
1089	#endif
1090
1091	#ifndef CPP_PARA
1092	VarOut(:,:,:,:)=VarIn(:,:,:,:)
1093	RETURN
1094	#else
1095
1096	IF (is_mpi_root) THEN
1097	CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4))
1098	ELSE
1099	CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4))
1100	ENDIF
1101
1102	#endif
1103	END SUBROUTINE gather_mpi_r3
1104
1105	!!!!!
1106
1107	SUBROUTINE gather_mpi_r4(VarIn, VarOut)
1108
1109	IMPLICIT NONE
1110
1111	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1112	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1113
1114	#ifdef CPP_PARA
1115	REAL(r_std),DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
1116	#endif
1117
1118	#ifndef CPP_PARA
1119	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1120	RETURN
1121	#else
1122
1123	IF (is_mpi_root) THEN
1124	CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5))
1125	ELSE
1126	CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5))
1127	ENDIF
1128
1129	#endif
1130	END SUBROUTINE gather_mpi_r4
1131
1132	!!!!! --> Logicals
1133
1134	SUBROUTINE gather_mpi_l(VarIn, VarOut)
1135
1136	IMPLICIT NONE
1137
1138	LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
1139	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
1140
1141	#ifdef CPP_PARA
1142	LOGICAL,DIMENSION(1) :: dummy
1143	#endif
1144
1145	#ifndef CPP_PARA
1146	VarOut(:)=VarIn(:)
1147	RETURN
1148	#else
1149
1150	IF (is_mpi_root) THEN
1151	CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),1)
1152	ELSE
1153	CALL orch_gather_mpi_lgen(VarIn,dummy,1,1)
1154	ENDIF
1155
1156	#endif
1157	END SUBROUTINE gather_mpi_l
1158
1159	!!!!!
1160
1161	SUBROUTINE gather_mpi_l1(VarIn, VarOut)
1162
1163	IMPLICIT NONE
1164
1165	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1166	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1167
1168	#ifdef CPP_PARA
1169	LOGICAL,DIMENSION(1,SIZE(VarIn,2)) :: dummy
1170	#endif
1171
1172	#ifndef CPP_PARA
1173	VarOut(:,:)=VarIn(:,:)
1174	RETURN
1175	#else
1176
1177	IF (is_mpi_root) THEN
1178	CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
1179	ELSE
1180	CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2))
1181	ENDIF
1182
1183	#endif
1184	END SUBROUTINE gather_mpi_l1
1185
1186	!!!!!
1187
1188	SUBROUTINE gather_mpi_l2(VarIn, VarOut)
1189
1190	IMPLICIT NONE
1191
1192	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1193	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1194
1195	#ifdef CPP_PARA
1196	LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
1197	#endif
1198
1199	#ifndef CPP_PARA
1200	VarOut(:,:,:)=VarIn(:,:,:)
1201	RETURN
1202	#else
1203
1204	IF (is_mpi_root) THEN
1205	CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
1206	ELSE
1207	CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
1208	ENDIF
1209
1210	#endif
1211	END SUBROUTINE gather_mpi_l2
1212
1213	!!!!!
1214
1215	SUBROUTINE gather_mpi_l3(VarIn, VarOut)
1216
1217	IMPLICIT NONE
1218
1219	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1220	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1221
1222	#ifdef CPP_PARA
1223	LOGICAL,DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)) :: dummy
1224	#endif
1225
1226	#ifndef CPP_PARA
1227	VarOut(:,:,:,:)=VarIn(:,:,:,:)
1228	RETURN
1229	#else
1230
1231	IF (is_mpi_root) THEN
1232	CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4))
1233	ELSE
1234	CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4))
1235	ENDIF
1236
1237	#endif
1238	END SUBROUTINE gather_mpi_l3
1239
1240	!!!!!
1241
1242	SUBROUTINE gather_mpi_l4(VarIn, VarOut)
1243
1244	IMPLICIT NONE
1245
1246	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1247	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1248
1249	#ifdef CPP_PARA
1250	LOGICAL,DIMENSION(1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
1251	#endif
1252
1253	#ifndef CPP_PARA
1254	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1255	RETURN
1256	#else
1257
1258	IF (is_mpi_root) THEN
1259	CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5))
1260	ELSE
1261	CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5))
1262	ENDIF
1263
1264	#endif
1265	END SUBROUTINE gather_mpi_l4
1266	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1267	!! Definition of Scatter2D --> 4D !!
1268	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1269
1270	SUBROUTINE scatter2D_mpi_i(VarIn, VarOut)
1271
1272	IMPLICIT NONE
1273
1274	INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
1275	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
1276
1277	#ifdef CPP_PARA
1278	INTEGER(i_std),DIMENSION(1,1) :: dummy
1279	#endif
1280
1281	#ifndef CPP_PARA
1282	VarOut(:,:)=VarIn(:,:)
1283	RETURN
1284	#else
1285
1286	IF (is_mpi_root) THEN
1287	CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
1288	ELSE
1289	CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,1)
1290	ENDIF
1291
1292
1293	#endif
1294	END SUBROUTINE scatter2D_mpi_i
1295
1296	SUBROUTINE scatter2D_mpi_i1(VarIn, VarOut)
1297
1298	IMPLICIT NONE
1299
1300	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
1301	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1302
1303	#ifdef CPP_PARA
1304	INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)) :: dummy
1305	#endif
1306
1307	#ifndef CPP_PARA
1308	VarOut(:,:,:)=VarIn(:,:,:)
1309	RETURN
1310	#else
1311
1312	IF (is_mpi_root) THEN
1313	CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
1314	ELSE
1315	CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3))
1316	ENDIF
1317
1318	#endif
1319	END SUBROUTINE scatter2D_mpi_i1
1320
1321	SUBROUTINE scatter2D_mpi_i2(VarIn, VarOut)
1322
1323	IMPLICIT NONE
1324
1325	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1326	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1327
1328	#ifdef CPP_PARA
1329	INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
1330	#endif
1331
1332	#ifndef CPP_PARA
1333	VarOut(:,:,:,:)=VarIn(:,:,:,:)
1334	RETURN
1335	#else
1336
1337	IF (is_mpi_root) THEN
1338	CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)SIZE(VarIn,2),SIZE(VarOut,3)SIZE(VarOut,4))
1339	ELSE
1340	CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
1341	ENDIF
1342
1343
1344	#endif
1345	END SUBROUTINE scatter2D_mpi_i2
1346
1347	SUBROUTINE scatter2D_mpi_i3(VarIn, VarOut)
1348
1349	IMPLICIT NONE
1350
1351	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1352	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1353
1354	#ifdef CPP_PARA
1355	INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)SIZE(VarOut,4)SIZE(VarOut,5)) :: dummy
1356	#endif
1357
1358	#ifndef CPP_PARA
1359	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1360	RETURN
1361	#else
1362
1363	IF (is_mpi_root) THEN
1364	CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)SIZE(VarIn,2),SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5))
1365	ELSE
1366	CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3)SIZE(VarOut,4)SIZE(VarOut,5))
1367	ENDIF
1368
1369	#endif
1370	END SUBROUTINE scatter2D_mpi_i3
1371
1372
1373	SUBROUTINE scatter2D_mpi_r0(VarIn, VarOut)
1374
1375	IMPLICIT NONE
1376
1377	REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
1378	REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
1379
1380	#ifdef CPP_PARA
1381	REAL(r_std),DIMENSION(1) :: dummy
1382	#endif
1383
1384	#ifndef CPP_PARA
1385	VarOut(:)=VarIn(:)
1386	RETURN
1387	#else
1388
1389	IF (is_mpi_root) THEN
1390	CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1),1)
1391	ELSE
1392	CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,1)
1393	ENDIF
1394
1395
1396	#endif
1397	END SUBROUTINE scatter2D_mpi_r0
1398
1399	SUBROUTINE scatter2D_mpi_r(VarIn, VarOut)
1400
1401	IMPLICIT NONE
1402
1403	REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
1404	REAL(r_std),INTENT(INOUT),DIMENSION(:,:) :: VarOut
1405
1406	#ifdef CPP_PARA
1407	REAL(r_std),DIMENSION(1,1) :: dummy
1408	#endif
1409
1410	#ifndef CPP_PARA
1411	VarOut(:,:)=VarIn(:,:)
1412	RETURN
1413	#else
1414
1415	IF (is_mpi_root) THEN
1416	CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
1417	ELSE
1418	CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,1)
1419	ENDIF
1420
1421	#endif
1422	END SUBROUTINE scatter2D_mpi_r
1423
1424	SUBROUTINE scatter2D_mpi_r1(VarIn, VarOut)
1425
1426	IMPLICIT NONE
1427
1428	REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
1429	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1430
1431	#ifdef CPP_PARA
1432	REAL(r_std),DIMENSION(1,SIZE(VarOut,3)) :: dummy
1433	#endif
1434
1435	#ifndef CPP_PARA
1436	VarOut(:,:,:)=VarIn(:,:,:)
1437	RETURN
1438	#else
1439
1440	IF (is_mpi_root) THEN
1441	CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
1442	ELSE
1443	CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3))
1444	ENDIF
1445
1446	#endif
1447	END SUBROUTINE scatter2D_mpi_r1
1448
1449	SUBROUTINE scatter2D_mpi_r2(VarIn, VarOut)
1450
1451	IMPLICIT NONE
1452
1453	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1454	REAL(r_std),INTENT(INOUT),DIMENSION(:,:,:,:) :: VarOut
1455
1456	#ifdef CPP_PARA
1457	REAL(r_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
1458	#endif
1459
1460	#ifndef CPP_PARA
1461	VarOut(:,:,:,:)=VarIn(:,:,:,:)
1462	RETURN
1463	#else
1464
1465	IF (is_mpi_root) THEN
1466	CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)SIZE(VarIn,2),SIZE(VarOut,3)SIZE(VarOut,4))
1467	ELSE
1468	CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
1469	ENDIF
1470
1471	#endif
1472	END SUBROUTINE scatter2D_mpi_r2
1473
1474	SUBROUTINE scatter2D_mpi_r3(VarIn, VarOut)
1475
1476	IMPLICIT NONE
1477
1478	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1479	REAL(r_std),INTENT(INOUT),DIMENSION(:,:,:,:,:) :: VarOut
1480
1481	#ifdef CPP_PARA
1482	REAL(r_std),DIMENSION(1,SIZE(VarOut,3)SIZE(VarOut,4)SIZE(VarOut,5)) :: dummy
1483	#endif
1484
1485	#ifndef CPP_PARA
1486	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1487	RETURN
1488	#else
1489
1490	IF (is_mpi_root) THEN
1491	CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)SIZE(VarIn,2),SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5))
1492	ELSE
1493	CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3)SIZE(VarOut,4)SIZE(VarOut,5))
1494	ENDIF
1495
1496	#endif
1497	END SUBROUTINE scatter2D_mpi_r3
1498
1499
1500	SUBROUTINE scatter2D_mpi_l(VarIn, VarOut)
1501
1502	IMPLICIT NONE
1503
1504	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1505	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1506
1507	#ifdef CPP_PARA
1508	LOGICAL,DIMENSION(1,1) :: dummy
1509	#endif
1510
1511	#ifndef CPP_PARA
1512	VarOut(:,:)=VarIn(:,:)
1513	RETURN
1514	#else
1515
1516	IF (is_mpi_root) THEN
1517	CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
1518	ELSE
1519	CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,1)
1520	ENDIF
1521
1522	#endif
1523	END SUBROUTINE scatter2D_mpi_l
1524
1525	SUBROUTINE scatter2D_mpi_l1(VarIn, VarOut)
1526
1527	IMPLICIT NONE
1528
1529	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1530	LOGICAL,INTENT(INOUT),DIMENSION(:,:,:) :: VarOut
1531
1532	#ifdef CPP_PARA
1533	LOGICAL,DIMENSION(1,SIZE(VarOut,3)) :: dummy
1534	#endif
1535
1536	#ifndef CPP_PARA
1537	VarOut(:,:,:)=VarIn(:,:,:)
1538	RETURN
1539	#else
1540
1541	IF (is_mpi_root) THEN
1542	CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
1543	ELSE
1544	CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3))
1545	ENDIF
1546
1547	#endif
1548	END SUBROUTINE scatter2D_mpi_l1
1549
1550	SUBROUTINE scatter2D_mpi_l2(VarIn, VarOut)
1551
1552	IMPLICIT NONE
1553
1554	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1555	LOGICAL,INTENT(INOUT),DIMENSION(:,:,:,:) :: VarOut
1556
1557	#ifdef CPP_PARA
1558	LOGICAL,DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
1559	#endif
1560
1561	#ifndef CPP_PARA
1562	VarOut(:,:,:,:)=VarIn(:,:,:,:)
1563	RETURN
1564	#else
1565
1566	IF (is_mpi_root) THEN
1567	CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)SIZE(VarIn,2),SIZE(VarOut,3)SIZE(VarOut,4))
1568	ELSE
1569	CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
1570	ENDIF
1571
1572	#endif
1573	END SUBROUTINE scatter2D_mpi_l2
1574
1575	SUBROUTINE scatter2D_mpi_l3(VarIn, VarOut)
1576
1577	IMPLICIT NONE
1578
1579	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1580	LOGICAL,INTENT(INOUT),DIMENSION(:,:,:,:,:) :: VarOut
1581
1582	#ifdef CPP_PARA
1583	LOGICAL,DIMENSION(1,SIZE(VarOut,3)SIZE(VarOut,4)SIZE(VarOut,5)) :: dummy
1584	#endif
1585
1586	#ifndef CPP_PARA
1587	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1588	RETURN
1589	#else
1590
1591	IF (is_mpi_root) THEN
1592	CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)SIZE(VarIn,2),SIZE(VarOut,3)SIZE(VarOut,4)*SIZE(VarOut,5))
1593	ELSE
1594	CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3)SIZE(VarOut,4)SIZE(VarOut,5))
1595	ENDIF
1596
1597	#endif
1598	END SUBROUTINE scatter2D_mpi_l3
1599
1600
1601	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1602	!! Definition of Gather2D --> 4D !!
1603	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1604
1605	SUBROUTINE gather2D_mpi_i(VarIn, VarOut)
1606
1607	IMPLICIT NONE
1608
1609	INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
1610	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
1611
1612	#ifdef CPP_PARA
1613	INTEGER(i_std),DIMENSION(1,1) :: dummy
1614	#endif
1615
1616	#ifndef CPP_PARA
1617	VarOut(:,:)=VarIn(:,:)
1618	RETURN
1619	#else
1620
1621	IF (is_mpi_root) THEN
1622	CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
1623	ELSE
1624	CALL orch_gather2D_mpi_igen(VarIn,dummy,1,1)
1625	ENDIF
1626
1627	#endif
1628	END SUBROUTINE gather2D_mpi_i
1629
1630	SUBROUTINE gather2D_mpi_i1(VarIn, VarOut)
1631
1632	IMPLICIT NONE
1633
1634	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
1635	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1636
1637	#ifdef CPP_PARA
1638	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)) :: dummy
1639	#endif
1640
1641	#ifndef CPP_PARA
1642	VarOut(:,:,:)=VarIn(:,:,:)
1643	RETURN
1644	#else
1645
1646	IF (is_mpi_root) THEN
1647	CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
1648	ELSE
1649	CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3))
1650	ENDIF
1651
1652	#endif
1653	END SUBROUTINE gather2D_mpi_i1
1654
1655	SUBROUTINE gather2D_mpi_i2(VarIn, VarOut)
1656
1657	IMPLICIT NONE
1658
1659	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1660	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1661
1662	#ifdef CPP_PARA
1663	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
1664	#endif
1665
1666	#ifndef CPP_PARA
1667	VarOut(:,:,:,:)=VarIn(:,:,:,:)
1668	RETURN
1669	#else
1670
1671	IF (is_mpi_root) THEN
1672	CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)SIZE(VarOut,2),SIZE(VarIn,3)SIZE(VarIn,4))
1673	ELSE
1674	CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
1675	ENDIF
1676
1677	#endif
1678	END SUBROUTINE gather2D_mpi_i2
1679
1680	SUBROUTINE gather2D_mpi_i3(VarIn, VarOut)
1681
1682	IMPLICIT NONE
1683
1684	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1685	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1686
1687	#ifdef CPP_PARA
1688	INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)SIZE(VarIn,4)SIZE(VarIn,5)) :: dummy
1689	#endif
1690
1691	#ifndef CPP_PARA
1692	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1693	RETURN
1694	#else
1695
1696	IF (is_mpi_root) THEN
1697	CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)SIZE(VarOut,2),SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5))
1698	ELSE
1699	CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3)SIZE(VarIn,4)SIZE(VarIn,5))
1700	ENDIF
1701
1702	#endif
1703	END SUBROUTINE gather2D_mpi_i3
1704
1705
1706	SUBROUTINE gather2D_mpi_r0(VarIn, VarOut)
1707
1708	IMPLICIT NONE
1709
1710	REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
1711	REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
1712
1713	#ifdef CPP_PARA
1714	REAL(r_std),DIMENSION(1) :: dummy
1715	#endif
1716
1717	#ifndef CPP_PARA
1718	VarOut(:)=VarIn(:)
1719	RETURN
1720	#else
1721
1722	IF (is_mpi_root) THEN
1723	CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1)
1724	ELSE
1725	CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,1)
1726	ENDIF
1727
1728	#endif
1729	END SUBROUTINE gather2D_mpi_r0
1730
1731	SUBROUTINE gather2D_mpi_r(VarIn, VarOut)
1732
1733	IMPLICIT NONE
1734
1735	REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
1736	REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
1737
1738	#ifdef CPP_PARA
1739	REAL(r_std),DIMENSION(1,1) :: dummy
1740	#endif
1741
1742	#ifndef CPP_PARA
1743	VarOut(:,:)=VarIn(:,:)
1744	RETURN
1745	#else
1746
1747	IF (is_mpi_root) THEN
1748	CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
1749	ELSE
1750	CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,1)
1751	ENDIF
1752
1753	#endif
1754	END SUBROUTINE gather2D_mpi_r
1755
1756	SUBROUTINE gather2D_mpi_r1(VarIn, VarOut)
1757
1758	IMPLICIT NONE
1759
1760	REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
1761	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1762
1763	#ifdef CPP_PARA
1764	REAL(r_std),DIMENSION(1,SIZE(VarIn,3)) :: dummy
1765	#endif
1766
1767	#ifndef CPP_PARA
1768	VarOut(:,:,:)=VarIn(:,:,:)
1769	RETURN
1770	#else
1771
1772	IF (is_mpi_root) THEN
1773	CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
1774	ELSE
1775	CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3))
1776	ENDIF
1777
1778	#endif
1779	END SUBROUTINE gather2D_mpi_r1
1780
1781	SUBROUTINE gather2D_mpi_r2(VarIn, VarOut)
1782
1783	IMPLICIT NONE
1784
1785	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1786	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1787
1788	#ifdef CPP_PARA
1789	REAL(r_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
1790	#endif
1791
1792	#ifndef CPP_PARA
1793	VarOut(:,:,:,:)=VarIn(:,:,:,:)
1794	RETURN
1795	#else
1796
1797	IF (is_mpi_root) THEN
1798	CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)SIZE(VarOut,2),SIZE(VarIn,3)SIZE(VarIn,4))
1799	ELSE
1800	CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
1801	ENDIF
1802
1803	#endif
1804	END SUBROUTINE gather2D_mpi_r2
1805
1806	SUBROUTINE gather2D_mpi_r3(VarIn, VarOut)
1807
1808	IMPLICIT NONE
1809
1810	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1811	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1812
1813	#ifdef CPP_PARA
1814	REAL(r_std),DIMENSION(1,SIZE(VarIn,3)SIZE(VarIn,4)SIZE(VarIn,5)) :: dummy
1815	#endif
1816
1817	#ifndef CPP_PARA
1818	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1819	RETURN
1820	#else
1821
1822	IF (is_mpi_root) THEN
1823	CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)SIZE(VarOut,2),SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5))
1824	ELSE
1825	CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3)SIZE(VarIn,4)SIZE(VarIn,5))
1826	ENDIF
1827
1828	#endif
1829	END SUBROUTINE gather2D_mpi_r3
1830
1831
1832	SUBROUTINE gather2D_mpi_l(VarIn, VarOut)
1833
1834	IMPLICIT NONE
1835
1836	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1837	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1838
1839	#ifdef CPP_PARA
1840	LOGICAL,DIMENSION(1,1) :: dummy
1841	#endif
1842
1843	#ifndef CPP_PARA
1844	VarOut(:,:)=VarIn(:,:)
1845	RETURN
1846	#else
1847
1848	IF (is_mpi_root) THEN
1849	CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
1850	ELSE
1851	CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,1)
1852	ENDIF
1853
1854	#endif
1855	END SUBROUTINE gather2D_mpi_l
1856
1857	SUBROUTINE gather2D_mpi_l1(VarIn, VarOut)
1858
1859	IMPLICIT NONE
1860
1861	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1862	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1863
1864	#ifdef CPP_PARA
1865	LOGICAL,DIMENSION(1,SIZE(VarIn,3)) :: dummy
1866	#endif
1867
1868	#ifndef CPP_PARA
1869	VarOut(:,:,:)=VarIn(:,:,:)
1870	RETURN
1871	#else
1872
1873	IF (is_mpi_root) THEN
1874	CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
1875	ELSE
1876	CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3))
1877	ENDIF
1878
1879	#endif
1880	END SUBROUTINE gather2D_mpi_l1
1881
1882	SUBROUTINE gather2D_mpi_l2(VarIn, VarOut)
1883
1884	IMPLICIT NONE
1885
1886	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1887	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1888
1889	#ifdef CPP_PARA
1890	LOGICAL,DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
1891	#endif
1892
1893	#ifndef CPP_PARA
1894	VarOut(:,:,:,:)=VarIn(:,:,:,:)
1895	RETURN
1896	#else
1897
1898	IF (is_mpi_root) THEN
1899	CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)SIZE(VarOut,2),SIZE(VarIn,3)SIZE(VarIn,4))
1900	ELSE
1901	CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
1902	ENDIF
1903
1904	#endif
1905	END SUBROUTINE gather2D_mpi_l2
1906
1907	SUBROUTINE gather2D_mpi_l3(VarIn, VarOut)
1908
1909	IMPLICIT NONE
1910
1911	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1912	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1913
1914	#ifdef CPP_PARA
1915	LOGICAL,DIMENSION(1,SIZE(VarIn,3)SIZE(VarIn,4)SIZE(VarIn,5)) :: dummy
1916	#endif
1917
1918	#ifndef CPP_PARA
1919	VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1920	RETURN
1921	#else
1922
1923	IF (is_mpi_root) THEN
1924	CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)SIZE(VarOut,2),SIZE(VarIn,3)SIZE(VarIn,4)*SIZE(VarIn,5))
1925	ELSE
1926	CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3)SIZE(VarIn,4)SIZE(VarIn,5))
1927	ENDIF
1928
1929	#endif
1930	END SUBROUTINE gather2D_mpi_l3
1931
1932	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1933	!! Definition of reduce_sum --> 4D !!
1934	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1935
1936	SUBROUTINE reduce_sum_mpi_i(VarIn, VarOut)
1937
1938	IMPLICIT NONE
1939
1940	INTEGER(i_std),INTENT(IN) :: VarIn
1941	INTEGER(i_std),INTENT(OUT) :: VarOut
1942
1943	#ifdef CPP_PARA
1944	INTEGER(i_std),DIMENSION(1) :: Var1
1945	INTEGER(i_std),DIMENSION(1) :: Var2
1946	INTEGER(i_std),DIMENSION(1) :: dummy
1947	#endif
1948
1949	#ifndef CPP_PARA
1950	VarOut=VarIn
1951	RETURN
1952	#else
1953	Var1(1)=VarIn
1954	IF (is_mpi_root) THEN
1955	CALL orch_reduce_sum_mpi_igen(Var1,Var2,1)
1956	VarOut=Var2(1)
1957	ELSE
1958	CALL orch_reduce_sum_mpi_igen(Var1,dummy,1)
1959	VarOut=VarIn
1960	ENDIF
1961	#endif
1962	END SUBROUTINE reduce_sum_mpi_i
1963
1964	SUBROUTINE reduce_sum_mpi_i1(VarIn, VarOut)
1965
1966	IMPLICIT NONE
1967
1968	INTEGER(i_std),INTENT(IN),DIMENSION(:) :: VarIn
1969	INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
1970
1971	#ifdef CPP_PARA
1972	INTEGER(i_std),DIMENSION(1) :: dummy
1973	#endif
1974
1975	#ifndef CPP_PARA
1976	VarOut(:)=VarIn(:)
1977	RETURN
1978	#else
1979
1980	IF (is_mpi_root) THEN
1981	CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
1982	ELSE
1983	CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))
1984	ENDIF
1985
1986	#endif
1987	END SUBROUTINE reduce_sum_mpi_i1
1988
1989	SUBROUTINE reduce_sum_mpi_i2(VarIn, VarOut)
1990	IMPLICIT NONE
1991
1992	INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
1993	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
1994
1995	#ifdef CPP_PARA
1996	INTEGER(i_std),DIMENSION(1) :: dummy
1997	#endif
1998
1999	#ifndef CPP_PARA
2000	VarOut(:,:)=VarIn(:,:)
2001	RETURN
2002	#else
2003
2004	IF (is_mpi_root) THEN
2005	CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
2006	ELSE
2007	CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))
2008	ENDIF
2009
2010	#endif
2011	END SUBROUTINE reduce_sum_mpi_i2
2012
2013	SUBROUTINE reduce_sum_mpi_i3(VarIn, VarOut)
2014	IMPLICIT NONE
2015
2016	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
2017	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
2018
2019	#ifdef CPP_PARA
2020	INTEGER(i_std),DIMENSION(1) :: dummy
2021	#endif
2022
2023	#ifndef CPP_PARA
2024	VarOut(:,:,:)=VarIn(:,:,:)
2025	RETURN
2026	#else
2027
2028	IF (is_mpi_root) THEN
2029	CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
2030	ELSE
2031	CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))
2032	ENDIF
2033
2034	#endif
2035	END SUBROUTINE reduce_sum_mpi_i3
2036
2037	SUBROUTINE reduce_sum_mpi_i4(VarIn, VarOut)
2038	IMPLICIT NONE
2039
2040	INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
2041	INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
2042
2043	#ifdef CPP_PARA
2044	INTEGER(i_std),DIMENSION(1) :: dummy
2045	#endif
2046
2047	#ifndef CPP_PARA
2048	VarOut(:,:,:,:)=VarIn(:,:,:,:)
2049	RETURN
2050	#else
2051
2052	IF (is_mpi_root) THEN
2053	CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
2054	ELSE
2055	CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))
2056	ENDIF
2057
2058	#endif
2059	END SUBROUTINE reduce_sum_mpi_i4
2060
2061
2062	SUBROUTINE reduce_sum_mpi_r(VarIn, VarOut)
2063	IMPLICIT NONE
2064
2065	REAL(r_std),INTENT(IN) :: VarIn
2066	REAL(r_std),INTENT(OUT) :: VarOut
2067
2068	#ifdef CPP_PARA
2069	REAL(r_std),DIMENSION(1) :: Var1
2070	REAL(r_std),DIMENSION(1) :: Var2
2071	REAL(r_std),DIMENSION(1) :: dummy
2072	#endif
2073
2074	#ifndef CPP_PARA
2075	VarOut=VarIn
2076	RETURN
2077	#else
2078
2079	Var1(1)=VarIn
2080	IF (is_mpi_root) THEN
2081	CALL orch_reduce_sum_mpi_rgen(Var1,Var2,1)
2082	VarOut=Var2(1)
2083	ELSE
2084	CALL orch_reduce_sum_mpi_rgen(Var1,dummy,1)
2085	VarOut=VarIn
2086	ENDIF
2087
2088	#endif
2089	END SUBROUTINE reduce_sum_mpi_r
2090
2091	SUBROUTINE reduce_sum_mpi_r1(VarIn, VarOut)
2092	IMPLICIT NONE
2093
2094	REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
2095	REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
2096
2097	#ifdef CPP_PARA
2098	REAL(r_std),DIMENSION(1) :: dummy
2099	#endif
2100
2101	#ifndef CPP_PARA
2102	VarOut(:)=VarIn(:)
2103	RETURN
2104	#else
2105
2106	IF (is_mpi_root) THEN
2107	CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
2108	ELSE
2109	CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))
2110	ENDIF
2111
2112	#endif
2113	END SUBROUTINE reduce_sum_mpi_r1
2114
2115	SUBROUTINE reduce_sum_mpi_r2(VarIn, VarOut)
2116	IMPLICIT NONE
2117
2118	REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
2119	REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
2120
2121	#ifdef CPP_PARA
2122	REAL(r_std),DIMENSION(1) :: dummy
2123	#endif
2124
2125	#ifndef CPP_PARA
2126	VarOut(:,:)=VarIn(:,:)
2127	RETURN
2128	#else
2129
2130	IF (is_mpi_root) THEN
2131	CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
2132	ELSE
2133	CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))
2134	ENDIF
2135
2136	#endif
2137	END SUBROUTINE reduce_sum_mpi_r2
2138
2139	SUBROUTINE reduce_sum_mpi_r3(VarIn, VarOut)
2140	IMPLICIT NONE
2141
2142	REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
2143	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
2144
2145	#ifdef CPP_PARA
2146	REAL(r_std),DIMENSION(1) :: dummy
2147	#endif
2148
2149	#ifndef CPP_PARA
2150	VarOut(:,:,:)=VarIn(:,:,:)
2151	RETURN
2152	#else
2153
2154	IF (is_mpi_root) THEN
2155	CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
2156	ELSE
2157	CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))
2158	ENDIF
2159
2160	#endif
2161	END SUBROUTINE reduce_sum_mpi_r3
2162
2163	SUBROUTINE reduce_sum_mpi_r4(VarIn, VarOut)
2164	IMPLICIT NONE
2165
2166	REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
2167	REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
2168
2169	#ifdef CPP_PARA
2170	REAL(r_std),DIMENSION(1) :: dummy
2171	#endif
2172
2173	#ifndef CPP_PARA
2174	VarOut(:,:,:,:)=VarIn(:,:,:,:)
2175	RETURN
2176	#else
2177
2178	IF (is_mpi_root) THEN
2179	CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
2180	ELSE
2181	CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))
2182	ENDIF
2183
2184	#endif
2185	END SUBROUTINE reduce_sum_mpi_r4
2186
2187
2188	END MODULE mod_orchidee_mpi_transfert
2189
2190	#ifdef CPP_PARA
2191
2192	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2193	!! DEFINITION OF GENERIC TRANSFERT SUBROUTINES !!
2194	!! These subroutines are only used localy in this module !!
2195	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2196
2197	SUBROUTINE orch_bcast_mpi_cgen(var,nb)
2198	USE mod_orchidee_para_var
2199	USE timer
2200	USE mpi
2201
2202	IMPLICIT NONE
2203
2204	CHARACTER(LEN=*),DIMENSION(nb),INTENT(INOUT) :: Var
2205	INTEGER(i_std),INTENT(IN) :: nb
2206
2207	INTEGER(i_std) :: ierr
2208	LOGICAL :: flag=.FALSE.
2209	LOGICAL, PARAMETER :: check=.FALSE.
2210
2211	IF (timer_state(timer_mpi)==running) THEN
2212	flag=.TRUE.
2213	ELSE
2214	flag=.FALSE.
2215	ENDIF
2216
2217	IF (check) &
2218	WRITE(numout,*) "orch_bcast_mpi_cgen before bcast Var",Var
2219	IF (flag) CALL suspend_timer(timer_mpi)
2220	CALL MPI_BCAST(Var,nb*LEN(Var(1)),MPI_CHARACTER,mpi_rank_root,MPI_COMM_ORCH,ierr)
2221	IF (flag) CALL resume_timer(timer_mpi)
2222	IF (check) &
2223	WRITE(numout,*) "orch_bcast_mpi_cgen after bcast Var",Var
2224
2225	END SUBROUTINE orch_bcast_mpi_cgen
2226
2227	SUBROUTINE orch_bcast_mpi_igen(var,nb)
2228	USE mod_orchidee_para_var
2229	USE timer
2230	USE mpi
2231	IMPLICIT NONE
2232
2233	INTEGER(i_std),DIMENSION(nb),INTENT(INOUT) :: Var
2234	INTEGER(i_std),INTENT(IN) :: nb
2235
2236
2237	INTEGER(i_std) :: ierr
2238	LOGICAL :: flag=.FALSE.
2239	LOGICAL, PARAMETER :: check=.FALSE.
2240
2241	IF (timer_state(timer_mpi)==running) THEN
2242	flag=.TRUE.
2243	ELSE
2244	flag=.FALSE.
2245	ENDIF
2246
2247	IF (flag) CALL suspend_timer(timer_mpi)
2248
2249	IF (check) &
2250	WRITE(numout,*) "orch_bcast_mpi_igen before bcast Var",Var
2251	CALL MPI_BCAST(Var,nb,MPI_INT_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
2252	IF (flag) CALL resume_timer(timer_mpi)
2253	IF (check) &
2254	WRITE(numout,*) "orch_bcast_mpi_igen after bcast Var",Var
2255
2256	END SUBROUTINE orch_bcast_mpi_igen
2257
2258	SUBROUTINE orch_bcast_mpi_rgen(var,nb)
2259	USE mod_orchidee_para_var
2260	USE timer
2261	USE mpi
2262
2263	IMPLICIT NONE
2264
2265	REAL(r_std),DIMENSION(nb),INTENT(INOUT) :: Var
2266	INTEGER(i_std),INTENT(IN) :: nb
2267
2268	INTEGER(i_std) :: ierr
2269	LOGICAL :: flag=.FALSE.
2270	LOGICAL, PARAMETER :: check=.FALSE.
2271
2272	IF (timer_state(timer_mpi)==running) THEN
2273	flag=.TRUE.
2274	ELSE
2275	flag=.FALSE.
2276	ENDIF
2277
2278	IF (check) &
2279	WRITE(numout,*) "orch_bcast_mpi_rgen before bcast Var",Var
2280	IF (flag) CALL suspend_timer(timer_mpi)
2281	CALL MPI_BCAST(Var,nb,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
2282	IF (flag) CALL resume_timer(timer_mpi)
2283	IF (check) &
2284	WRITE(numout,*) "orch_bcast_mpi_rgen after bcast Var",Var
2285
2286	END SUBROUTINE orch_bcast_mpi_rgen
2287
2288	SUBROUTINE orch_bcast_mpi_lgen(var,nb)
2289	USE mod_orchidee_para_var
2290	USE timer
2291	USE mpi
2292
2293	IMPLICIT NONE
2294
2295	LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
2296	INTEGER(i_std),INTENT(IN) :: nb
2297
2298	INTEGER(i_std) :: ierr
2299	LOGICAL :: flag=.FALSE.
2300	LOGICAL, PARAMETER :: check=.FALSE.
2301
2302
2303	IF (timer_state(timer_mpi)==running) THEN
2304	flag=.TRUE.
2305	ELSE
2306	flag=.FALSE.
2307	ENDIF
2308
2309	IF (check) &
2310	WRITE(numout,*) "orch_bcast_mpi_lgen before bcast Var",Var
2311	IF (flag) CALL suspend_timer(timer_mpi)
2312	CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_rank_root,MPI_COMM_ORCH,ierr)
2313	IF (flag) CALL resume_timer(timer_mpi)
2314	IF (check) &
2315	WRITE(numout,*) "orch_bcast_mpi_lgen after bcast Var",Var
2316
2317	END SUBROUTINE orch_bcast_mpi_lgen
2318
2319
2320	SUBROUTINE orch_scatter_mpi_igen(VarIn, VarOut, nbp, dimsize)
2321	USE mod_orchidee_para_var
2322	USE timer
2323	USE mpi
2324
2325	IMPLICIT NONE
2326
2327	INTEGER(i_std),INTENT(IN) :: nbp
2328	INTEGER(i_std),INTENT(IN) :: dimsize
2329	INTEGER(i_std),INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
2330	INTEGER(i_std),INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
2331
2332	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2333	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2334	INTEGER(i_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
2335
2336	INTEGER(i_std) :: nb,i,index_para,rank
2337	INTEGER(i_std) :: ierr
2338	LOGICAL :: flag=.FALSE.
2339	LOGICAL, PARAMETER :: check=.FALSE.
2340
2341	IF (timer_state(timer_mpi)==running) THEN
2342	flag=.TRUE.
2343	ELSE
2344	flag=.FALSE.
2345	ENDIF
2346
2347	IF (flag) CALL suspend_timer(timer_mpi)
2348
2349	IF (is_mpi_root) THEN
2350	Index_Para=1
2351	DO rank=0,mpi_size-1
2352	nb=nbp_mpi_para(rank)
2353	displs(rank)=Index_Para-1
2354	counts(rank)=nb*dimsize
2355	DO i=1,dimsize
2356	VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)
2357	Index_para=Index_para+nb
2358	ENDDO
2359	ENDDO
2360	IF (check) THEN
2361	WRITE(numout,*) "orch_scatter_mpi_igen VarIn",VarIn
2362	WRITE(numout,*) "orch_scatter_mpi_igen VarTmp",VarTmp
2363	ENDIF
2364	ENDIF
2365
2366	CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INT_ORCH,VarOut,nbp_mpi*dimsize, &
2367	MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
2368	IF (flag) CALL resume_timer(timer_mpi)
2369	IF (check) &
2370	WRITE(numout,*) "orch_scatter_mpi_igen VarOut",VarOut
2371
2372	END SUBROUTINE orch_scatter_mpi_igen
2373
2374	SUBROUTINE orch_scatter_mpi_rgen(VarIn, VarOut, nbp, dimsize)
2375	USE mod_orchidee_para_var
2376	USE timer
2377	USE mpi
2378
2379	IMPLICIT NONE
2380
2381	INTEGER(i_std),INTENT(IN) :: dimsize
2382	INTEGER(i_std),INTENT(IN) :: nbp
2383	REAL(r_std),INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
2384	REAL(r_std),INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
2385
2386	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2387	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2388	REAL(r_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
2389
2390	INTEGER(i_std) :: nb,i,index_para,rank
2391	INTEGER(i_std) :: ierr
2392	LOGICAL :: flag=.FALSE.
2393	LOGICAL, PARAMETER :: check=.FALSE.
2394
2395	IF (timer_state(timer_mpi)==running) THEN
2396	flag=.TRUE.
2397	ELSE
2398	flag=.FALSE.
2399	ENDIF
2400
2401	IF (flag) CALL suspend_timer(timer_mpi)
2402
2403	IF (is_mpi_root) THEN
2404	Index_para=1
2405	DO rank=0,mpi_size-1
2406	nb=nbp_mpi_para(rank)
2407	displs(rank)=Index_para-1
2408	counts(rank)=nb*dimsize
2409	DO i=1,dimsize
2410	VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)
2411	Index_para=Index_para+nb
2412	ENDDO
2413	ENDDO
2414	IF (check) THEN
2415	WRITE(numout,*) "orch_scatter_mpi_rgen VarIn",VarIn
2416	WRITE(numout,*) "orch_scatter_mpi_rgen VarTmp",VarTmp
2417	ENDIF
2418	ENDIF
2419
2420	CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_ORCH,VarOut,nbp_mpi*dimsize, &
2421	MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
2422
2423	IF (flag) CALL resume_timer(timer_mpi)
2424	IF (check) &
2425	WRITE(numout,*) "orch_scatter_mpi_rgen VarOut",VarOut
2426
2427	END SUBROUTINE orch_scatter_mpi_rgen
2428
2429	SUBROUTINE orch_scatter_mpi_lgen(VarIn, VarOut, nbp, dimsize)
2430	USE mod_orchidee_para_var
2431	USE timer
2432	USE mpi
2433
2434	IMPLICIT NONE
2435
2436	INTEGER(i_std),INTENT(IN) :: dimsize
2437	INTEGER(i_std),INTENT(IN) :: nbp
2438	LOGICAL,INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
2439	LOGICAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
2440
2441	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2442	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2443	LOGICAL,DIMENSION(dimsize*nbp_glo) :: VarTmp
2444
2445	INTEGER(i_std) :: nb,i,index_para,rank
2446	INTEGER(i_std) :: ierr
2447	LOGICAL :: flag=.FALSE.
2448	LOGICAL, PARAMETER :: check=.FALSE.
2449
2450	IF (timer_state(timer_mpi)==running) THEN
2451	flag=.TRUE.
2452	ELSE
2453	flag=.FALSE.
2454	ENDIF
2455
2456	IF (flag) CALL suspend_timer(timer_mpi)
2457
2458	IF (is_mpi_root) THEN
2459	Index_para=1
2460	DO rank=0,mpi_size-1
2461	nb=nbp_mpi_para(rank)
2462	displs(rank)=Index_para-1
2463	counts(rank)=nb*dimsize
2464	DO i=1,dimsize
2465	VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)
2466	Index_para=Index_para+nb
2467	ENDDO
2468	ENDDO
2469	IF (check) THEN
2470	WRITE(numout,*) "orch_scatter_mpi_lgen VarIn",VarIn
2471	WRITE(numout,*) "orch_scatter_mpi_lgen VarTmp",VarTmp
2472	ENDIF
2473	ENDIF
2474
2475	CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,nbp_mpi*dimsize, &
2476	MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
2477	IF (flag) CALL resume_timer(timer_mpi)
2478	IF (check) &
2479	WRITE(numout,*) "orch_scatter_mpi_lgen VarOut",VarOut
2480
2481	END SUBROUTINE orch_scatter_mpi_lgen
2482
2483	SUBROUTINE orch_gather_mpi_igen(VarIn, VarOut, nbp, dimsize)
2484	USE mod_orchidee_para_var
2485	USE timer
2486	USE mpi
2487
2488	IMPLICIT NONE
2489
2490	INTEGER(i_std),INTENT(IN) :: dimsize
2491	INTEGER(i_std),INTENT(IN) :: nbp
2492	INTEGER(i_std),INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
2493	INTEGER(i_std),INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
2494
2495	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2496	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2497	INTEGER(i_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
2498
2499	INTEGER(i_std) :: nb,i,index_para,rank
2500	INTEGER(i_std) :: ierr
2501	LOGICAL :: flag=.FALSE.
2502	LOGICAL, PARAMETER :: check=.FALSE.
2503
2504	IF (timer_state(timer_mpi)==running) THEN
2505	flag=.TRUE.
2506	ELSE
2507	flag=.FALSE.
2508	ENDIF
2509
2510	IF (flag) CALL suspend_timer(timer_mpi)
2511
2512	IF (is_mpi_root) THEN
2513	Index_para=1
2514	DO rank=0,mpi_size-1
2515	nb=nbp_mpi_para(rank)
2516	displs(rank)=Index_para-1
2517	counts(rank)=nb*dimsize
2518	Index_para=Index_para+nb*dimsize
2519	ENDDO
2520	IF (check) &
2521	WRITE(numout,*) "orch_gather_mpi_igen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
2522
2523	ENDIF
2524
2525	CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_INT_ORCH,VarTmp,counts,displs, &
2526	MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
2527
2528
2529	IF (is_mpi_root) THEN
2530	Index_para=1
2531	DO rank=0,mpi_size-1
2532	nb=nbp_mpi_para(rank)
2533	DO i=1,dimsize
2534	VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1)
2535	Index_para=Index_para+nb
2536	ENDDO
2537	ENDDO
2538	ENDIF
2539	IF (check) &
2540	WRITE(numout,*) "orch_gather_mpi_igen VarOut=",VarOut
2541	IF (flag) CALL resume_timer(timer_mpi)
2542
2543	END SUBROUTINE orch_gather_mpi_igen
2544
2545	SUBROUTINE orch_gather_mpi_rgen(VarIn, VarOut, nbp, dimsize)
2546	USE mod_orchidee_para_var
2547	USE timer
2548	USE mpi
2549
2550	IMPLICIT NONE
2551
2552	INTEGER(i_std),INTENT(IN) :: dimsize
2553	INTEGER(i_std),INTENT(IN) :: nbp
2554	REAL(r_std),INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
2555	REAL(r_std),INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
2556
2557	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2558	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2559	REAL(r_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
2560
2561	INTEGER(i_std) :: nb,i,index_para,rank
2562	INTEGER(i_std) :: ierr
2563	LOGICAL :: flag=.FALSE.
2564	LOGICAL, PARAMETER :: check=.FALSE.
2565
2566	IF (timer_state(timer_mpi)==running) THEN
2567	flag=.TRUE.
2568	ELSE
2569	flag=.FALSE.
2570	ENDIF
2571
2572	IF (flag) CALL suspend_timer(timer_mpi)
2573
2574	IF (is_mpi_root) THEN
2575	Index_para=1
2576	DO rank=0,mpi_size-1
2577	nb=nbp_mpi_para(rank)
2578	displs(rank)=Index_para-1
2579	counts(rank)=nb*dimsize
2580	Index_para=Index_para+nb*dimsize
2581	ENDDO
2582	IF (check) &
2583	WRITE(numout,*) "orch_gather_mpi_rgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
2584
2585	ENDIF
2586
2587	IF (check) &
2588	WRITE(numout,*) "orch_gather_mpi_rgen VarIn=",VarIn
2589	CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_REAL_ORCH,VarTmp,counts,displs, &
2590	MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
2591	IF (check) &
2592	WRITE(numout,*) "orch_gather_mpi_rgen dimsize,VarTmp=",dimsize,VarTmp
2593
2594	IF (is_mpi_root) THEN
2595	Index_para=1
2596	DO rank=0,mpi_size-1
2597	nb=nbp_mpi_para(rank)
2598	DO i=1,dimsize
2599	VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1)
2600	Index_para=Index_para+nb
2601	ENDDO
2602	ENDDO
2603	ENDIF
2604	IF (check) &
2605	WRITE(numout,*) "orch_gather_mpi_rgen VarOut=",VarOut
2606	IF (flag) CALL resume_timer(timer_mpi)
2607
2608	END SUBROUTINE orch_gather_mpi_rgen
2609
2610	SUBROUTINE orch_gather_mpi_lgen(VarIn, VarOut, nbp, dimsize)
2611	USE mod_orchidee_para_var
2612	USE timer
2613	USE mpi
2614
2615	IMPLICIT NONE
2616
2617	INTEGER(i_std),INTENT(IN) :: dimsize
2618	INTEGER(i_std),INTENT(IN) :: nbp
2619	LOGICAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
2620	LOGICAL,INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
2621
2622	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2623	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2624	LOGICAL,DIMENSION(dimsize*nbp_glo) :: VarTmp
2625
2626	INTEGER(i_std) :: nb,i,index_para,rank
2627	INTEGER(i_std) :: ierr
2628	LOGICAL :: flag=.FALSE.
2629	LOGICAL, PARAMETER :: check=.FALSE.
2630
2631
2632	IF (timer_state(timer_mpi)==running) THEN
2633	flag=.TRUE.
2634	ELSE
2635	flag=.FALSE.
2636	ENDIF
2637
2638	IF (flag) CALL suspend_timer(timer_mpi)
2639
2640	IF (is_mpi_root) THEN
2641	Index_para=1
2642	DO rank=0,mpi_size-1
2643	nb=nbp_mpi_para(rank)
2644	displs(rank)=Index_para-1
2645	counts(rank)=nb*dimsize
2646	Index_para=Index_para+nb*dimsize
2647	ENDDO
2648	IF (check) &
2649	WRITE(numout,*) "orch_gather_mpi_lgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
2650	ENDIF
2651
2652	IF (check) &
2653	WRITE(numout,*) "orch_gather_mpi_lgen VarIn=",VarIn
2654	CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs, &
2655	MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
2656	IF (check) &
2657	WRITE(numout,*) "orch_gather_mpi_lgen dimsize,VarTmp=",dimsize,VarTmp
2658
2659	IF (is_mpi_root) THEN
2660	Index_para=1
2661	DO rank=0,mpi_size-1
2662	nb=nbp_mpi_para(rank)
2663	DO i=1,dimsize
2664	VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1)
2665	Index_para=Index_para+nb
2666	ENDDO
2667	ENDDO
2668	ENDIF
2669	IF (check) &
2670	WRITE(numout,*) "orch_gather_mpi_lgen VarOut=",VarOut
2671	IF (flag) CALL resume_timer(timer_mpi)
2672
2673	END SUBROUTINE orch_gather_mpi_lgen
2674
2675
2676	SUBROUTINE orch_scatter2D_mpi_igen(VarIn, VarOut, nbp2D, dimsize)
2677	USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
2678	USE timer
2679	USE mpi
2680
2681	IMPLICIT NONE
2682
2683	INTEGER(i_std),INTENT(IN) :: dimsize
2684	INTEGER(i_std),INTENT(IN) :: nbp2D
2685	INTEGER(i_std),INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
2686	INTEGER(i_std),INTENT(OUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
2687
2688	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2689	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2690	INTEGER(i_std),DIMENSION(dimsizeiimjjm) :: VarTmp1
2691	INTEGER(i_std),DIMENSION(ij_nb,dimsize) :: VarTmp2
2692
2693	INTEGER(i_std) :: nb,i,ij,index_para,rank
2694	INTEGER(i_std) :: ierr
2695	LOGICAL :: flag=.FALSE.
2696	LOGICAL, PARAMETER :: check=.FALSE.
2697
2698	IF (timer_state(timer_mpi)==running) THEN
2699	flag=.TRUE.
2700	ELSE
2701	flag=.FALSE.
2702	ENDIF
2703
2704	IF (flag) CALL suspend_timer(timer_mpi)
2705
2706	IF (is_mpi_root) THEN
2707	Index_para=1
2708	DO rank=0,mpi_size-1
2709	nb=ij_para_nb(rank)
2710	displs(rank)=Index_para-1
2711	counts(rank)=nb*dimsize
2712	DO i=1,dimsize
2713	VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
2714	Index_para=Index_para+nb
2715	ENDDO
2716	ENDDO
2717	IF (check) THEN
2718	WRITE(numout,*) "orch_scatter2D_mpi_igen VarIn",VarIn
2719	WRITE(numout,*) "orch_scatter2D_mpi_igen VarTmp1",VarTmp1
2720	ENDIF
2721	ENDIF
2722
2723	CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_INT_ORCH,VarTmp2,ij_nb*dimsize, &
2724	MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
2725	IF (check) &
2726	WRITE(numout,*) "orch_scatter2D_mpi_igen VarTmp2",VarTmp2
2727
2728	DO i=1,dimsize
2729	DO ij=1,ij_nb
2730	VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
2731	ENDDO
2732	ENDDO
2733	IF (flag) CALL resume_timer(timer_mpi)
2734	IF (check) &
2735	WRITE(numout,*) "orch_scatter2D_mpi_igen VarOut",VarOut
2736
2737	END SUBROUTINE orch_scatter2D_mpi_igen
2738
2739	SUBROUTINE orch_scatter2D_mpi_rgen(VarIn, VarOut, nbp2D, dimsize)
2740	USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
2741	USE timer
2742	USE mpi
2743
2744	IMPLICIT NONE
2745
2746	INTEGER(i_std),INTENT(IN) :: dimsize
2747	INTEGER(i_std),INTENT(IN) :: nbp2D
2748	REAL(r_std),INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
2749	REAL(r_std),INTENT(INOUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
2750
2751	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2752	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2753	REAL(r_std),DIMENSION(dimsizeiimjjm) :: VarTmp1
2754	REAL(r_std),DIMENSION(ij_nb,dimsize) :: VarTmp2
2755
2756	INTEGER(i_std) :: nb,i,ij,index_para,rank
2757	INTEGER(i_std) :: ierr
2758	LOGICAL :: flag=.FALSE.
2759	LOGICAL, PARAMETER :: check=.FALSE.
2760
2761	IF (timer_state(timer_mpi)==running) THEN
2762	flag=.TRUE.
2763	ELSE
2764	flag=.FALSE.
2765	ENDIF
2766
2767	IF (flag) CALL suspend_timer(timer_mpi)
2768
2769	IF (is_mpi_root) THEN
2770	Index_para=1
2771	DO rank=0,mpi_size-1
2772	nb=ij_para_nb(rank)
2773	displs(rank)=Index_para-1
2774	counts(rank)=nb*dimsize
2775	DO i=1,dimsize
2776	VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
2777	Index_para=Index_para+nb
2778	ENDDO
2779	ENDDO
2780	IF (check) THEN
2781	WRITE(numout,*) "orch_scatter2D_mpi_rgen VarIn",VarIn
2782	WRITE(numout,*) "orch_scatter2D_mpi_rgen VarTmp1",VarTmp1
2783	ENDIF
2784	ENDIF
2785	nb=ij_nb*dimsize
2786	IF (check) &
2787	WRITE(numout,) "ij_nbdimsize",ij_nb*dimsize
2788
2789	CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_REAL_ORCH,VarTmp2,nb, &
2790	MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
2791	IF (check) &
2792	WRITE(numout,*) "orch_scatter2D_mpi_rgen VarTmp2",VarTmp2
2793
2794	DO i=1,dimsize
2795	DO ij=1,ij_nb
2796	VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
2797	ENDDO
2798	ENDDO
2799
2800	IF (flag) CALL resume_timer(timer_mpi)
2801	IF (check) &
2802	WRITE(numout,*) "orch_scatter2D_mpi_rgen VarOut",VarOut
2803
2804	END SUBROUTINE orch_scatter2D_mpi_rgen
2805
2806	SUBROUTINE orch_scatter2D_mpi_lgen(VarIn, VarOut, nbp2D, dimsize)
2807	USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
2808	USE timer
2809	USE mpi
2810
2811	IMPLICIT NONE
2812
2813	INTEGER(i_std),INTENT(IN) :: dimsize
2814	INTEGER(i_std),INTENT(IN) :: nbp2D
2815	LOGICAL,INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
2816	LOGICAL,INTENT(INOUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
2817
2818	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2819	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2820	LOGICAL,DIMENSION(dimsizeiimjjm) :: VarTmp1
2821	LOGICAL,DIMENSION(ij_nb,dimsize) :: VarTmp2
2822
2823	INTEGER(i_std) :: nb,i,ij,index_para,rank
2824	INTEGER(i_std) :: ierr
2825	LOGICAL :: flag=.FALSE.
2826	LOGICAL, PARAMETER :: check=.FALSE.
2827
2828	IF (timer_state(timer_mpi)==running) THEN
2829	flag=.TRUE.
2830	ELSE
2831	flag=.FALSE.
2832	ENDIF
2833
2834	IF (flag) CALL suspend_timer(timer_mpi)
2835
2836	IF (is_mpi_root) THEN
2837	Index_para=1
2838	DO rank=0,mpi_size-1
2839	nb=ij_para_nb(rank)
2840	displs(rank)=Index_para-1
2841	counts(rank)=nb*dimsize
2842	DO i=1,dimsize
2843	VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
2844	Index_para=Index_para+nb
2845	ENDDO
2846	ENDDO
2847	IF (check) THEN
2848	WRITE(numout,*) "orch_scatter2D_mpi_lgen VarIn",VarIn
2849	WRITE(numout,*) "orch_scatter2D_mpi_lgen VarTmp1",VarTmp1
2850	ENDIF
2851	ENDIF
2852
2853	CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_LOGICAL,VarTmp2,ij_nb*dimsize, &
2854	MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
2855	IF (check) &
2856	WRITE(numout,*) "orch_scatter2D_mpi_lgen VarTmp2",VarTmp2
2857
2858	DO i=1,dimsize
2859	DO ij=1,ij_nb
2860	VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
2861	ENDDO
2862	ENDDO
2863	IF (flag) CALL resume_timer(timer_mpi)
2864	IF (check) &
2865	WRITE(numout,*) "orch_scatter2D_mpi_lgen VarOut",VarOut
2866
2867	END SUBROUTINE orch_scatter2D_mpi_lgen
2868
2869
2870	SUBROUTINE orch_gather2D_mpi_igen(VarIn, VarOut, nbp2D, dimsize)
2871	USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
2872	USE timer
2873	USE mpi
2874
2875	IMPLICIT NONE
2876
2877	INTEGER(i_std),INTENT(IN) :: dimsize
2878	INTEGER(i_std),INTENT(IN) :: nbp2D
2879	INTEGER(i_std),INTENT(IN),DIMENSION(iim*jj_nb,dimsize) :: VarIn
2880	INTEGER(i_std),INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
2881
2882	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2883	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2884	INTEGER(i_std),DIMENSION(ij_nb,dimsize) :: VarTmp1
2885	INTEGER(i_std),DIMENSION(dimsizeiimjjm) :: VarTmp2
2886
2887	INTEGER(i_std) :: nb,i,ij,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
2903	DO rank=0,mpi_size-1
2904	nb=ij_para_nb(rank)
2905	displs(rank)=Index_para-1
2906	counts(rank)=nb*dimsize
2907	Index_para=Index_para+nb*dimsize
2908	ENDDO
2909	IF (check) &
2910	WRITE(numout,*) "orch_gather2D_mpi_igen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
2911	ENDIF
2912	DO i=1,dimsize
2913	DO ij=1,ij_nb
2914	VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
2915	ENDDO
2916	ENDDO
2917
2918	IF (check) THEN
2919	WRITE(numout,*) "orch_gather2D_mpi_igen VarIn=",VarIn
2920	WRITE(numout,*) "orch_gather2D_mpi_igen VarTmp1=",VarTmp1
2921	ENDIF
2922	CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_INT_ORCH,VarTmp2,counts,displs, &
2923	MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
2924	IF (check) &
2925	WRITE(numout,*) "orch_gather2D_mpi_igen VarTmp2=",VarTmp2
2926
2927	IF (is_mpi_root) THEN
2928	Index_para=1
2929	DO rank=0,mpi_size-1
2930	nb=ij_para_nb(rank)
2931	DO i=1,dimsize
2932	VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
2933	Index_para=Index_para+nb
2934	ENDDO
2935	ENDDO
2936	ENDIF
2937
2938	IF (flag) CALL resume_timer(timer_mpi)
2939	IF (check) &
2940	WRITE(numout,*) "orch_gather2D_mpi_igen VarOut=",VarOut
2941
2942	END SUBROUTINE orch_gather2D_mpi_igen
2943
2944	SUBROUTINE orch_gather2D_mpi_rgen(VarIn, VarOut, nbp2D,dimsize)
2945	USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
2946	USE timer
2947	USE mpi
2948
2949	IMPLICIT NONE
2950
2951	INTEGER(i_std),INTENT(IN) :: dimsize
2952	INTEGER(i_std),INTENT(IN) :: nbp2D
2953	REAL(r_std),INTENT(IN),DIMENSION(iim*jj_nb,dimsize) :: VarIn
2954	REAL(r_std),INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
2955
2956	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
2957	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
2958	REAL(r_std),DIMENSION(ij_nb,dimsize) :: VarTmp1
2959	REAL(r_std),DIMENSION(dimsizeiimjjm) :: VarTmp2
2960
2961	INTEGER(i_std) :: nb,i,ij,index_para,rank
2962	INTEGER(i_std) :: ierr
2963	LOGICAL :: flag=.FALSE.
2964	LOGICAL,PARAMETER :: check=.FALSE.
2965
2966	IF (timer_state(timer_mpi)==running) THEN
2967	flag=.TRUE.
2968	ELSE
2969	flag=.FALSE.
2970	ENDIF
2971
2972	IF (flag) CALL suspend_timer(timer_mpi)
2973
2974	IF (is_mpi_root) THEN
2975	Index_para=1
2976
2977	DO rank=0,mpi_size-1
2978	nb=ij_para_nb(rank)
2979	displs(rank)=Index_para-1
2980	counts(rank)=nb*dimsize
2981	Index_para=Index_para+nb*dimsize
2982	ENDDO
2983	IF (check) &
2984	WRITE(numout,*) "orch_gather2D_mpi_rgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
2985	ENDIF
2986
2987	DO i=1,dimsize
2988	DO ij=1,ij_nb
2989	VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
2990	ENDDO
2991	ENDDO
2992
2993	IF (check) THEN
2994	WRITE(numout,*) "orch_gather2D_mpi_rgen VarIn=",VarIn
2995	WRITE(numout,*) "orch_gather2D_mpi_rgen VarTmp1=",VarTmp1
2996	ENDIF
2997	CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_REAL_ORCH,VarTmp2,counts,displs, &
2998	MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
2999	IF (check) &
3000	WRITE(numout,*) "orch_gather2D_mpi_rgen VarTmp2=",VarTmp2
3001
3002	IF (is_mpi_root) THEN
3003	Index_para=1
3004	DO rank=0,mpi_size-1
3005	nb=ij_para_nb(rank)
3006	DO i=1,dimsize
3007	VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
3008	Index_para=Index_para+nb
3009	ENDDO
3010	ENDDO
3011	ENDIF
3012
3013	IF (flag) CALL resume_timer(timer_mpi)
3014	IF (check) &
3015	WRITE(numout,*) "orch_gather2D_mpi_rgen VarOut=",VarOut
3016
3017	END SUBROUTINE orch_gather2D_mpi_rgen
3018
3019	SUBROUTINE orch_gather2D_mpi_lgen(VarIn, VarOut, nbp2D, dimsize)
3020	USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
3021	USE timer
3022	USE mpi
3023
3024	IMPLICIT NONE
3025
3026	INTEGER(i_std),INTENT(IN) :: dimsize
3027	INTEGER(i_std),INTENT(IN) :: nbp2D
3028	LOGICAL,INTENT(IN),DIMENSION(iim*jj_nb,dimsize) :: VarIn
3029	LOGICAL,INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
3030
3031	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
3032	INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
3033	LOGICAL,DIMENSION(ij_nb,dimsize) :: VarTmp1
3034	LOGICAL,DIMENSION(dimsizeiimjjm) :: VarTmp2
3035
3036	INTEGER(i_std) :: nb,i,ij,index_para,rank
3037	INTEGER(i_std) :: ierr
3038	LOGICAL :: flag=.FALSE.
3039	LOGICAL,PARAMETER :: check=.FALSE.
3040
3041	IF (timer_state(timer_mpi)==running) THEN
3042	flag=.TRUE.
3043	ELSE
3044	flag=.FALSE.
3045	ENDIF
3046
3047	IF (flag) CALL suspend_timer(timer_mpi)
3048
3049	IF (is_mpi_root) THEN
3050	Index_para=1
3051
3052	DO rank=0,mpi_size-1
3053	nb=ij_para_nb(rank)
3054	displs(rank)=Index_para-1
3055	counts(rank)=nb*dimsize
3056	Index_para=Index_para+nb*dimsize
3057	ENDDO
3058	IF (check) &
3059	WRITE(numout,*) "orch_gather2D_mpi_lgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
3060	ENDIF
3061
3062	DO i=1,dimsize
3063	DO ij=1,ij_nb
3064	VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
3065	ENDDO
3066	ENDDO
3067
3068	IF (check) THEN
3069	WRITE(numout,*) "orch_gather2D_mpi_lgen VarIn=",VarIn
3070	WRITE(numout,*) "orch_gather2D_mpi_lgen VarTmp1=",VarTmp1
3071	ENDIF
3072	CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_LOGICAL,VarTmp2,counts,displs, &
3073	MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
3074	IF (check) &
3075	WRITE(numout,*) "orch_gather2D_mpi_lgen VarTmp2=",VarTmp2
3076
3077	IF (is_mpi_root) THEN
3078	Index_para=1
3079	DO rank=0,mpi_size-1
3080	nb=ij_para_nb(rank)
3081	DO i=1,dimsize
3082	VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
3083	Index_para=Index_para+nb
3084	ENDDO
3085	ENDDO
3086	ENDIF
3087
3088	IF (flag) CALL resume_timer(timer_mpi)
3089	IF (check) &
3090	WRITE(numout,*) "orch_gather2D_mpi_lgen VarOut=",VarOut
3091
3092	END SUBROUTINE orch_gather2D_mpi_lgen
3093
3094	SUBROUTINE orch_reduce_sum_mpi_igen(VarIn,VarOut,nb)
3095	USE mod_orchidee_para_var
3096	USE timer
3097	USE mpi
3098
3099	IMPLICIT NONE
3100
3101	INTEGER(i_std),DIMENSION(nb),INTENT(IN) :: VarIn
3102	INTEGER(i_std),DIMENSION(nb),INTENT(OUT) :: VarOut
3103	INTEGER(i_std),INTENT(IN) :: nb
3104
3105	INTEGER(i_std) :: ierr
3106	LOGICAL :: flag=.FALSE.
3107	LOGICAL, PARAMETER :: check=.FALSE.
3108
3109	IF (timer_state(timer_mpi)==running) THEN
3110	flag=.TRUE.
3111	ELSE
3112	flag=.FALSE.
3113	ENDIF
3114
3115	IF (check) &
3116	WRITE(numout,*) "orch_reduce_sum_mpi_igen VarIn",VarIn
3117	IF (flag) CALL suspend_timer(timer_mpi)
3118
3119	CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INT_ORCH,MPI_SUM,mpi_rank_root,MPI_COMM_ORCH,ierr)
3120
3121	IF (flag) CALL resume_timer(timer_mpi)
3122	IF (check) &
3123	WRITE(numout,*) "orch_reduce_sum_mpi_igen VarOut",VarOut
3124
3125	END SUBROUTINE orch_reduce_sum_mpi_igen
3126
3127	SUBROUTINE orch_reduce_sum_mpi_rgen(VarIn,VarOut,nb)
3128	USE mod_orchidee_para_var
3129	USE timer
3130	USE mpi
3131
3132	IMPLICIT NONE
3133
3134	REAL(r_std),DIMENSION(nb),INTENT(IN) :: VarIn
3135	REAL(r_std),DIMENSION(nb),INTENT(OUT) :: VarOut
3136	INTEGER(i_std),INTENT(IN) :: nb
3137
3138	INTEGER(i_std) :: ierr
3139	LOGICAL :: flag=.FALSE.
3140	LOGICAL, PARAMETER :: check=.FALSE.
3141
3142	IF (timer_state(timer_mpi)==running) THEN
3143	flag=.TRUE.
3144	ELSE
3145	flag=.FALSE.
3146	ENDIF
3147
3148	IF (check) &
3149	WRITE(numout,*) "orch_reduce_sum_mpi_rgen VarIn",VarIn
3150	IF (flag) CALL suspend_timer(timer_mpi)
3151
3152	CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_ORCH,MPI_SUM,mpi_rank_root,MPI_COMM_ORCH,ierr)
3153
3154	IF (flag) CALL resume_timer(timer_mpi)
3155	IF (check) &
3156	WRITE(numout,*) "orch_reduce_sum_mpi_rgen VarOut",VarOut
3157
3158	END SUBROUTINE orch_reduce_sum_mpi_rgen
3159
3160	#endif

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

Context Navigation

source: branches/publications/ORCHIDEE_gmd_2018_MICT-LEAK/src_parallel/mod_orchidee_mpi_transfert.F90 @ 7346

Download in other formats: