Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

mod_orchidee_mpi_transfert.F90 @ 7337

Last change on this file since 7337 was 7297, checked in by wei.li, 3 years ago
updated code for publication, 2021,9,25
File size: 85.6 KB

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

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

Context Navigation

source: branches/publications/ORCHIDEE-MICT-BIOENERGY_r7298/src_parallel/mod_orchidee_mpi_transfert.F90 @ 7337

Download in other formats: