Context Navigation

mod_orchidee_transfert_para.F90 @ 7852

Last change on this file since 7852 was 6190, checked in by josefine.ghattas, 5 years ago

Added more subroutines included in the interfaces for restget/restput/histwrite_p to be able to handle more dimensions.
For more information, see ticket #596

Done by A. Jornet

Property svn:keywords set to Date Revision HeadURL

File size: 38.1 KB

Line
1	! ===============================================================================================================================
2	! MODULE : mod_orchidee_transfert_para
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 Contains the interfaces bcast, scatter, gather and reduce_sum
10	!!
11	!! \n DESCRIPTION : High level MPI/OpenMP parallel communication encapsulations for ORCHIDEE.
12	!! These interfaces should be called by all procesess (all MPI processes and all OMP threads)
13	!! bcast : send a variable from the root process to all processes
14	!! scatter : distribute a global field known on the root process to the local domain for each processes
15	!! gather : each process sends their local field to the root process which will recieve the field on the global domain
16	!! reduce_sum : the root process will recieve the sum of the values from all processes
17	!!
18	!! RECENT CHANGE(S): None
19	!!
20	!! REFERENCES(S) : None
21	!!
22	!! SVN :
23	!! $HeadURL$
24	!! $Date$
25	!! $Revision$
26	!! \n
27	!_ ================================================================================================================================
28
29	MODULE mod_orchidee_transfert_para
30
31	USE mod_orchidee_para_var
32	USE mod_orchidee_mpi_transfert
33	USE mod_orchidee_omp_transfert
34
35
36	! ===============================================================================================================================
37	!! INTERFACE : bcast
38	!!
39	!>\BRIEF Send a variable from root process to all processes
40	!!
41	!! \n DESCRIPTION : Send a variable from root process to all processes. Note that all processes must make the call.
42	!!
43	!! Usage : CALL bcast(Var)
44	!! The variable Var must be known before the call on the root process. After the call, all processes know the variable.
45	!! The variable has the same dimension on all processes. The variable can be a character string, integer, real or logical.
46	!! It can have rank 1 to 4.
47	!!
48	!! RECENT CHANGE(S): None
49	!!
50	!! REFERENCES(S) : None
51	!!
52	!! \n
53	!_ ================================================================================================================================
54
55	INTERFACE bcast
56	MODULE PROCEDURE bcast_c, bcast_c1, &
57	bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, &
58	bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, &
59	bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4
60	END INTERFACE
61
62	! ===============================================================================================================================
63	!! INTERFACE : scatter
64	!!
65	!>\BRIEF Distribute a global field from the root process to the local domain on each processes
66	!!
67	!! \n DESCRIPTION : Distribute the global field known on the root process to the local domain for each processes.
68	!! Note that all processes must make the call.
69	!!
70	!! Usage: CALL scatter(VarIn, VarOut)
71	!! VarIn must be known on the root process before the call is done.
72	!! After the call, VarOut contains the variable on the local domain on each process.
73	!!
74	!! RECENT CHANGE(S): None
75	!!
76	!! REFERENCES(S) : None
77	!!
78	!! \n
79	!_ ================================================================================================================================
80	INTERFACE scatter
81	MODULE PROCEDURE scatter_i,scatter_i1,scatter_i2,scatter_i3,scatter_i4, &
82	scatter_r,scatter_r1,scatter_r2,scatter_r3,scatter_r4, &
83	scatter_l,scatter_l1,scatter_l2,scatter_l3,scatter_l4
84	END INTERFACE
85
86
87	! ===============================================================================================================================
88	!! INTERFACE : gather
89	!!
90	!>\BRIEF Each process send their local field to the root process which will recieve the field on the global domain
91	!!
92	!! \n DESCRIPTION : Each process send their local field to the root process which will recieve the field on the global domain.
93	!! Note that all processes must make the call.
94	!!
95	!! Usage: CALL gather(VarIn, VarOut)
96	!! VarIn is the variable on the local domain on each process, known before the call. After the call, VarOut is recieved on the
97	!! root process containing the variable on the global domain.
98	!!
99	!! RECENT CHANGE(S): None
100	!!
101	!! REFERENCES(S) : None
102	!!
103	!! \n
104	!_ ================================================================================================================================
105	INTERFACE gather
106	MODULE PROCEDURE gather_i,gather_i1,gather_i2,gather_i3,gather_i4, &
107	gather_r,gather_r1,gather_r2,gather_r3,gather_r4, &
108	gather_l,gather_l1,gather_l2,gather_l3,gather_l4
109	END INTERFACE
110
111	INTERFACE scatter_unindexed
112	MODULE PROCEDURE scatter_unindexed_i,scatter_unindexed_i1,scatter_unindexed_i2,scatter_unindexed_i3, scatter_unindexed_i4, &
113	scatter_unindexed_r,scatter_unindexed_r1,scatter_unindexed_r2,scatter_unindexed_r3, scatter_unindexed_r4, &
114	scatter_unindexed_l,scatter_unindexed_l1,scatter_unindexed_l2,scatter_unindexed_l3, scatter_unindexed_l4
115	END INTERFACE
116
117
118	INTERFACE gather_unindexed
119	MODULE PROCEDURE gather_unindexed_i,gather_unindexed_i1,gather_unindexed_i2,gather_unindexed_i3, gather_unindexed_i4, &
120	gather_unindexed_r,gather_unindexed_r1,gather_unindexed_r2,gather_unindexed_r3, gather_unindexed_r4, &
121	gather_unindexed_l,gather_unindexed_l1,gather_unindexed_l2,gather_unindexed_l3, gather_unindexed_l4
122	END INTERFACE
123
124	! ===============================================================================================================================
125	!! INTERFACE : reduce_sum
126	!!
127	!>\BRIEF The root process will recieve the sum of the values from all processes
128	!!
129	!! \n DESCRIPTION : The root process will recieve the sum of the values from all processes
130	!! Note that all processes must make the call.
131	!!
132	!! Usage: CALL reduce_sum(VarIn, VarOut)
133	!! VarIn is the value on each process. VarOut is the sum of these values on the root process.
134	!!
135	!! RECENT CHANGE(S): None
136	!!
137	!! REFERENCES(S) : None
138	!!x
139	!! \n
140	!_ ================================================================================================================================
141	INTERFACE reduce_sum
142	MODULE PROCEDURE reduce_sum_i,reduce_sum_i1,reduce_sum_i2,reduce_sum_i3,reduce_sum_i4, &
143	reduce_sum_r,reduce_sum_r1,reduce_sum_r2,reduce_sum_r3,reduce_sum_r4
144	END INTERFACE
145
146
147	! ===============================================================================================================================
148	!! INTERFACE : all_reduce_sum
149	!!
150	!>\BRIEF All processes will recieve the sum of the values from all processes
151	!!
152	!! \n DESCRIPTION : All processes will recieve the sum of the values from all processes
153	!! Note that all processes must make the call.
154	!!
155	!! Usage: CALL all_reduce_sum(VarIn, VarOut)
156	!! VarIn is the value on each process. VarOut is the sum of all these values on the all processes.
157	!!
158	!! RECENT CHANGE(S): None
159	!!
160	!! REFERENCES(S) : None
161	!!x
162	!! \n
163	!_ ================================================================================================================================
164	INTERFACE allreduce_sum
165	MODULE PROCEDURE allreduce_sum_r, allreduce_sum_i
166	END INTERFACE
167
168	CONTAINS
169
170	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
171	!! Definition of Broadcast 1D --> 4D !!
172	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
173
174	!! -- Character string -- !!
175
176	SUBROUTINE bcast_c(var)
177	IMPLICIT NONE
178	CHARACTER(LEN=*),INTENT(INOUT) :: Var
179
180
181	IF (is_omp_root) CALL bcast_mpi(Var)
182	CALL bcast_omp(Var)
183
184	END SUBROUTINE bcast_c
185
186	SUBROUTINE bcast_c1(var)
187	IMPLICIT NONE
188	CHARACTER(LEN=*),INTENT(INOUT) :: Var(:)
189
190
191	IF (is_omp_root) CALL bcast_mpi(Var)
192	CALL bcast_omp(Var)
193
194	END SUBROUTINE bcast_c1
195
196	!! -- Integers -- !!
197
198	SUBROUTINE bcast_i(var)
199	IMPLICIT NONE
200	INTEGER,INTENT(INOUT) :: Var
201
202	IF (is_omp_root) CALL bcast_mpi(Var)
203	CALL bcast_omp(Var)
204
205	END SUBROUTINE bcast_i
206
207	SUBROUTINE bcast_i1(var)
208	IMPLICIT NONE
209	INTEGER,INTENT(INOUT) :: Var(:)
210
211
212	IF (is_omp_root) CALL bcast_mpi(Var)
213	CALL bcast_omp(Var)
214
215	END SUBROUTINE bcast_i1
216
217
218	SUBROUTINE bcast_i2(var)
219	IMPLICIT NONE
220	INTEGER,INTENT(INOUT) :: Var(:,:)
221
222
223	IF (is_omp_root) CALL bcast_mpi(Var)
224	CALL bcast_omp(Var)
225
226	END SUBROUTINE bcast_i2
227
228
229	SUBROUTINE bcast_i3(var)
230	IMPLICIT NONE
231	INTEGER,INTENT(INOUT) :: Var(:,:,:)
232
233
234	IF (is_omp_root) CALL bcast_mpi(Var)
235	CALL bcast_omp(Var)
236
237	END SUBROUTINE bcast_i3
238
239
240	SUBROUTINE bcast_i4(var)
241	IMPLICIT NONE
242	INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
243
244
245	IF (is_omp_root) CALL bcast_mpi(Var)
246	CALL bcast_omp(Var)
247
248	END SUBROUTINE bcast_i4
249
250
251	!! -- Reals -- !!
252
253	SUBROUTINE bcast_r(var)
254	IMPLICIT NONE
255	REAL,INTENT(INOUT) :: Var
256
257
258	IF (is_omp_root) CALL bcast_mpi(Var)
259	CALL bcast_omp(Var)
260
261	END SUBROUTINE bcast_r
262
263	SUBROUTINE bcast_r1(var)
264	IMPLICIT NONE
265	REAL,INTENT(INOUT) :: Var(:)
266
267
268	IF (is_omp_root) CALL bcast_mpi(Var)
269	CALL bcast_omp(Var)
270
271	END SUBROUTINE bcast_r1
272
273
274	SUBROUTINE bcast_r2(var)
275	IMPLICIT NONE
276	REAL,INTENT(INOUT) :: Var(:,:)
277
278
279	IF (is_omp_root) CALL bcast_mpi(Var)
280	CALL bcast_omp(Var)
281
282	END SUBROUTINE bcast_r2
283
284
285	SUBROUTINE bcast_r3(var)
286	IMPLICIT NONE
287	REAL,INTENT(INOUT) :: Var(:,:,:)
288
289
290	IF (is_omp_root) CALL bcast_mpi(Var)
291	CALL bcast_omp(Var)
292
293	END SUBROUTINE bcast_r3
294
295
296	SUBROUTINE bcast_r4(var)
297	IMPLICIT NONE
298	REAL,INTENT(INOUT) :: Var(:,:,:,:)
299
300	IF (is_omp_root) CALL bcast_mpi(Var)
301	CALL bcast_omp(Var)
302
303	END SUBROUTINE bcast_r4
304
305
306	!! -- Logicals -- !!
307
308	SUBROUTINE bcast_l(var)
309	IMPLICIT NONE
310	LOGICAL,INTENT(INOUT) :: Var
311
312	IF (is_omp_root) CALL bcast_mpi(Var)
313	CALL bcast_omp(Var)
314
315	END SUBROUTINE bcast_l
316
317	SUBROUTINE bcast_l1(var)
318	IMPLICIT NONE
319	LOGICAL,INTENT(INOUT) :: Var(:)
320
321	IF (is_omp_root) CALL bcast_mpi(Var)
322	CALL bcast_omp(Var)
323
324	END SUBROUTINE bcast_l1
325
326
327	SUBROUTINE bcast_l2(var)
328	IMPLICIT NONE
329	LOGICAL,INTENT(INOUT) :: Var(:,:)
330
331
332	IF (is_omp_root) CALL bcast_mpi(Var)
333	CALL bcast_omp(Var)
334
335	END SUBROUTINE bcast_l2
336
337
338	SUBROUTINE bcast_l3(var)
339	IMPLICIT NONE
340	LOGICAL,INTENT(INOUT) :: Var(:,:,:)
341
342	IF (is_omp_root) CALL bcast_mpi(Var)
343	CALL bcast_omp(Var)
344
345	END SUBROUTINE bcast_l3
346
347
348	SUBROUTINE bcast_l4(var)
349	IMPLICIT NONE
350	LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
351
352	IF (is_omp_root) CALL bcast_mpi(Var)
353
354	CALL bcast_omp(Var)
355
356	END SUBROUTINE bcast_l4
357
358
359	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
360	!! Definition of Scatter 1D --> 4D !!
361	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
362
363	SUBROUTINE scatter_i(VarIn, VarOut)
364	IMPLICIT NONE
365
366	INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
367	INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
368
369	INTEGER,DIMENSION(nbp_mpi) :: Var_tmp
370
371
372	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
373	CALL scatter_omp(Var_tmp,Varout)
374
375	END SUBROUTINE scatter_i
376
377
378	SUBROUTINE scatter_i1(VarIn, VarOut)
379	IMPLICIT NONE
380
381	INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
382	INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
383
384	INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
385
386
387	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
388	CALL scatter_omp(Var_tmp,Varout)
389
390	END SUBROUTINE scatter_i1
391
392
393	SUBROUTINE scatter_i2(VarIn, VarOut)
394	IMPLICIT NONE
395
396	INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
397	INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
398
399	INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
400
401
402	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
403	CALL scatter_omp(Var_tmp,Varout)
404
405	END SUBROUTINE scatter_i2
406
407
408	SUBROUTINE scatter_i3(VarIn, VarOut)
409	IMPLICIT NONE
410
411	INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
412	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
413
414	INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
415
416
417	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
418	CALL scatter_omp(Var_tmp,VarOut)
419
420	END SUBROUTINE scatter_i3
421
422
423	SUBROUTINE scatter_i4(VarIn, VarOut)
424	IMPLICIT NONE
425
426	INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
427	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
428
429	INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4),SIZE(Varout,5)) :: Var_tmp
430
431
432	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
433	CALL scatter_omp(Var_tmp,VarOut)
434
435	END SUBROUTINE scatter_i4
436
437	SUBROUTINE scatter_r(VarIn, VarOut)
438	IMPLICIT NONE
439
440	REAL,INTENT(IN),DIMENSION(:) :: VarIn
441	REAL,INTENT(OUT),DIMENSION(:) :: VarOut
442
443	REAL,DIMENSION(nbp_mpi) :: Var_tmp
444
445
446	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
447	CALL scatter_omp(Var_tmp,Varout)
448
449	END SUBROUTINE scatter_r
450
451
452	SUBROUTINE scatter_r1(VarIn, VarOut)
453	IMPLICIT NONE
454
455	REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
456	REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
457
458	REAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
459
460
461	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
462	CALL scatter_omp(Var_tmp,Varout)
463
464	END SUBROUTINE scatter_r1
465
466
467	SUBROUTINE scatter_r2(VarIn, VarOut)
468	IMPLICIT NONE
469
470	REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
471	REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
472
473	REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
474
475
476	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
477	CALL scatter_omp(Var_tmp,Varout)
478
479	END SUBROUTINE scatter_r2
480
481
482	SUBROUTINE scatter_r3(VarIn, VarOut)
483	IMPLICIT NONE
484
485	REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
486	REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
487
488	REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
489
490
491	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
492	CALL scatter_omp(Var_tmp,VarOut)
493
494	END SUBROUTINE scatter_r3
495
496
497	SUBROUTINE scatter_r4(VarIn, VarOut)
498	IMPLICIT NONE
499
500	REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
501	REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
502
503	REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4),SIZE(Varout,5)) :: Var_tmp
504
505
506	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
507	CALL scatter_omp(Var_tmp,VarOut)
508
509	END SUBROUTINE scatter_r4
510
511
512	SUBROUTINE scatter_l(VarIn, VarOut)
513	IMPLICIT NONE
514
515	LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
516	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
517
518	LOGICAL,DIMENSION(nbp_mpi) :: Var_tmp
519
520
521	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
522	CALL scatter_omp(Var_tmp,Varout)
523
524	END SUBROUTINE scatter_l
525
526
527	SUBROUTINE scatter_l1(VarIn, VarOut)
528	IMPLICIT NONE
529
530	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
531	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
532
533	LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
534
535
536	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
537	CALL scatter_omp(Var_tmp,Varout)
538
539	END SUBROUTINE scatter_l1
540
541
542	SUBROUTINE scatter_l2(VarIn, VarOut)
543	IMPLICIT NONE
544
545	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
546	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
547
548	LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
549
550
551	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
552	CALL scatter_omp(Var_tmp,Varout)
553
554	END SUBROUTINE scatter_l2
555
556
557	SUBROUTINE scatter_l3(VarIn, VarOut)
558	IMPLICIT NONE
559
560	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
561	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
562
563	LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
564
565
566	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
567	CALL scatter_omp(Var_tmp,VarOut)
568
569	END SUBROUTINE scatter_l3
570
571	SUBROUTINE scatter_l4(VarIn, VarOut)
572	IMPLICIT NONE
573
574	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
575	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
576
577	LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4),SIZE(Varout,5)) :: Var_tmp
578
579
580	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
581	CALL scatter_omp(Var_tmp,VarOut)
582
583	END SUBROUTINE scatter_l4
584
585
586	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
587	!! Definition of Gather 1D --> 4D !!
588	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
589
590	!!!!! --> Integers
591
592	SUBROUTINE gather_i(VarIn, VarOut)
593	IMPLICIT NONE
594
595	INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
596	INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
597
598	INTEGER, DIMENSION(nbp_mpi) :: Var_tmp
599
600	CALL gather_omp(VarIn,Var_tmp)
601
602	IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
603
604	END SUBROUTINE gather_i
605
606
607	SUBROUTINE gather_i1(VarIn, VarOut)
608	IMPLICIT NONE
609
610	INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
611	INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
612
613	INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
614
615	CALL gather_omp(VarIn,Var_tmp)
616
617	IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
618
619
620	END SUBROUTINE gather_i1
621
622
623	SUBROUTINE gather_i2(VarIn, VarOut)
624	IMPLICIT NONE
625
626	INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
627	INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
628
629	INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
630
631	CALL gather_omp(VarIn,Var_tmp)
632
633	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
634
635	END SUBROUTINE gather_i2
636
637
638	SUBROUTINE gather_i3(VarIn, VarOut)
639	IMPLICIT NONE
640
641	INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
642	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
643
644	INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
645
646	CALL gather_omp(VarIn,Var_tmp)
647
648	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
649
650
651	END SUBROUTINE gather_i3
652
653	SUBROUTINE gather_i4(VarIn, VarOut)
654	IMPLICIT NONE
655
656	INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
657	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
658
659	INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4),SIZE(VarIn,5)) :: Var_tmp
660
661	CALL gather_omp(VarIn,Var_tmp)
662
663	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
664
665
666	END SUBROUTINE gather_i4
667
668	!!!!! --> Reals
669
670	SUBROUTINE gather_r(VarIn, VarOut)
671	IMPLICIT NONE
672
673	REAL,INTENT(IN),DIMENSION(:) :: VarIn
674	REAL,INTENT(OUT),DIMENSION(:) :: VarOut
675
676	REAL, DIMENSION(nbp_mpi) :: Var_tmp
677
678	CALL gather_omp(VarIn,Var_tmp)
679
680	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
681
682	END SUBROUTINE gather_r
683
684
685	SUBROUTINE gather_r1(VarIn, VarOut)
686	IMPLICIT NONE
687
688	REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
689	REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
690
691	REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
692
693	CALL gather_omp(VarIn,Var_tmp)
694
695	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
696
697
698	END SUBROUTINE gather_r1
699
700
701	SUBROUTINE gather_r2(VarIn, VarOut)
702	IMPLICIT NONE
703
704	REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
705	REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
706
707	REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
708
709	CALL gather_omp(VarIn,Var_tmp)
710
711	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
712
713	END SUBROUTINE gather_r2
714
715
716	SUBROUTINE gather_r3(VarIn, VarOut)
717	IMPLICIT NONE
718
719	REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
720	REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
721
722	REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
723
724	CALL gather_omp(VarIn,Var_tmp)
725
726	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
727
728	END SUBROUTINE gather_r3
729
730	SUBROUTINE gather_r4(VarIn, VarOut)
731	IMPLICIT NONE
732
733	REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
734	REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
735
736	REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4),SIZE(VarIn,5)) :: Var_tmp
737
738	CALL gather_omp(VarIn,Var_tmp)
739
740	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
741
742	END SUBROUTINE gather_r4
743
744	!!!!! --> Logiclas
745
746	SUBROUTINE gather_l(VarIn, VarOut)
747	IMPLICIT NONE
748
749	LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
750	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
751
752	LOGICAL, DIMENSION(nbp_mpi) :: Var_tmp
753
754	CALL gather_omp(VarIn,Var_tmp)
755
756	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
757
758	END SUBROUTINE gather_l
759
760
761	SUBROUTINE gather_l1(VarIn, VarOut)
762	IMPLICIT NONE
763
764	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
765	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
766
767	LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
768
769	CALL gather_omp(VarIn,Var_tmp)
770
771	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
772
773	END SUBROUTINE gather_l1
774
775
776	SUBROUTINE gather_l2(VarIn, VarOut)
777	IMPLICIT NONE
778
779	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
780	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
781
782	LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
783
784	CALL gather_omp(VarIn,Var_tmp)
785	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
786
787	END SUBROUTINE gather_l2
788
789
790	SUBROUTINE gather_l3(VarIn, VarOut)
791	IMPLICIT NONE
792
793	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
794	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
795
796	LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
797
798	CALL gather_omp(VarIn,Var_tmp)
799
800	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
801
802	END SUBROUTINE gather_l3
803
804	SUBROUTINE gather_l4(VarIn, VarOut)
805	IMPLICIT NONE
806
807	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
808	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
809
810	LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4),SIZE(VarIn,5)) :: Var_tmp
811
812	CALL gather_omp(VarIn,Var_tmp)
813
814	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
815
816	END SUBROUTINE gather_l4
817
818	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
819	!! Definition des scatter_unindexed --> 4D !!
820	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
821
822
823	SUBROUTINE scatter_unindexed_i(VarIn, VarOut)
824	IMPLICIT NONE
825
826	INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
827	INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
828
829	INTEGER,DIMENSION(ij_nb) :: Var_tmp
830
831
832	IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
833	CALL scatter_unindexed_omp(Var_tmp,Varout)
834
835	END SUBROUTINE scatter_unindexed_i
836
837
838	SUBROUTINE scatter_unindexed_i1(VarIn, VarOut)
839	IMPLICIT NONE
840
841	INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
842	INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
843
844	INTEGER,DIMENSION(ij_nb,SIZE(Varout,2)) :: Var_tmp
845
846
847	IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
848	CALL scatter_unindexed_omp(Var_tmp,Varout)
849
850	END SUBROUTINE scatter_unindexed_i1
851
852
853	SUBROUTINE scatter_unindexed_i2(VarIn, VarOut)
854	IMPLICIT NONE
855
856	INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
857	INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
858
859	INTEGER,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
860
861
862	IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
863	CALL scatter_unindexed_omp(Var_tmp,Varout)
864
865	END SUBROUTINE scatter_unindexed_i2
866
867
868	SUBROUTINE scatter_unindexed_i3(VarIn, VarOut)
869	IMPLICIT NONE
870
871	INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
872	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
873
874	INTEGER,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
875
876
877	IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
878	CALL scatter_unindexed_omp(Var_tmp,VarOut)
879
880	END SUBROUTINE scatter_unindexed_i3
881
882
883	SUBROUTINE scatter_unindexed_i4(VarIn, VarOut)
884	IMPLICIT NONE
885
886	INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
887	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
888
889	INTEGER,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4), SIZE(Varout,5)) :: Var_tmp
890
891
892	IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
893	CALL scatter_unindexed_omp(Var_tmp,VarOut)
894
895	END SUBROUTINE scatter_unindexed_i4
896
897
898	SUBROUTINE scatter_unindexed_r(VarIn, VarOut)
899	IMPLICIT NONE
900
901	REAL,INTENT(IN),DIMENSION(:) :: VarIn
902	REAL,INTENT(OUT),DIMENSION(:) :: VarOut
903
904	REAL,DIMENSION(ij_nb) :: Var_tmp
905
906
907	IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
908	CALL scatter_unindexed_omp(Var_tmp,Varout)
909
910	END SUBROUTINE scatter_unindexed_r
911
912
913	SUBROUTINE scatter_unindexed_r1(VarIn, VarOut)
914	IMPLICIT NONE
915
916	REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
917	REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
918
919	REAL,DIMENSION(ij_nb,SIZE(Varout,2)) :: Var_tmp
920
921
922	IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
923	CALL scatter_unindexed_omp(Var_tmp,Varout)
924
925	END SUBROUTINE scatter_unindexed_r1
926
927
928	SUBROUTINE scatter_unindexed_r2(VarIn, VarOut)
929	IMPLICIT NONE
930
931	REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
932	REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
933
934	REAL,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
935
936
937	IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
938	CALL scatter_unindexed_omp(Var_tmp,Varout)
939
940	END SUBROUTINE scatter_unindexed_r2
941
942
943	SUBROUTINE scatter_unindexed_r3(VarIn, VarOut)
944	IMPLICIT NONE
945
946	REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
947	REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
948
949	REAL,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
950
951
952	IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
953	CALL scatter_unindexed_omp(Var_tmp,VarOut)
954
955	END SUBROUTINE scatter_unindexed_r3
956
957
958	SUBROUTINE scatter_unindexed_r4(VarIn, VarOut)
959	IMPLICIT NONE
960
961	REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
962	REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
963
964	REAL,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4),SIZE(Varout,5)) :: Var_tmp
965
966
967	IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
968	CALL scatter_unindexed_omp(Var_tmp,VarOut)
969
970	END SUBROUTINE scatter_unindexed_r4
971
972
973
974	SUBROUTINE scatter_unindexed_l(VarIn, VarOut)
975	IMPLICIT NONE
976
977	LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
978	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
979
980	LOGICAL,DIMENSION(ij_nb) :: Var_tmp
981
982
983	IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
984	CALL scatter_unindexed_omp(Var_tmp,Varout)
985
986	END SUBROUTINE scatter_unindexed_l
987
988
989	SUBROUTINE scatter_unindexed_l1(VarIn, VarOut)
990	IMPLICIT NONE
991
992	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
993	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
994
995	LOGICAL,DIMENSION(ij_nb,SIZE(Varout,2)) :: Var_tmp
996
997
998	IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
999	CALL scatter_unindexed_omp(Var_tmp,Varout)
1000
1001	END SUBROUTINE scatter_unindexed_l1
1002
1003
1004	SUBROUTINE scatter_unindexed_l2(VarIn, VarOut)
1005	IMPLICIT NONE
1006
1007	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1008	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1009
1010	LOGICAL,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
1011
1012
1013	IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
1014	CALL scatter_unindexed_omp(Var_tmp,Varout)
1015
1016	END SUBROUTINE scatter_unindexed_l2
1017
1018
1019	SUBROUTINE scatter_unindexed_l3(VarIn, VarOut)
1020	IMPLICIT NONE
1021
1022	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1023	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1024
1025	LOGICAL,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
1026
1027
1028	IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
1029	CALL scatter_unindexed_omp(Var_tmp,VarOut)
1030
1031	END SUBROUTINE scatter_unindexed_l3
1032
1033
1034	SUBROUTINE scatter_unindexed_l4(VarIn, VarOut)
1035	IMPLICIT NONE
1036
1037	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1038	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1039
1040	LOGICAL,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4),SIZE(Varout,5)) :: Var_tmp
1041
1042
1043	IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
1044	CALL scatter_unindexed_omp(Var_tmp,VarOut)
1045
1046	END SUBROUTINE scatter_unindexed_l4
1047
1048
1049
1050	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1051	!! Definition des gather_unindexed --> 4D !!
1052	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1053
1054	!!!!! --> Les entiers
1055
1056	SUBROUTINE gather_unindexed_i(VarIn, VarOut)
1057	IMPLICIT NONE
1058
1059	INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
1060	INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
1061
1062	INTEGER, DIMENSION(ij_nb) :: Var_tmp
1063
1064	CALL gather_unindexed_omp(VarIn,Var_tmp)
1065
1066	IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,Varout)
1067
1068	END SUBROUTINE gather_unindexed_i
1069
1070
1071	SUBROUTINE gather_unindexed_i1(VarIn, VarOut)
1072	IMPLICIT NONE
1073
1074	INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
1075	INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
1076
1077	INTEGER, DIMENSION(ij_nb,SIZE(VarIn,2)) :: Var_tmp
1078
1079	CALL gather_unindexed_omp(VarIn,Var_tmp)
1080
1081	IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,Varout)
1082
1083
1084	END SUBROUTINE gather_unindexed_i1
1085
1086
1087	SUBROUTINE gather_unindexed_i2(VarIn, VarOut)
1088	IMPLICIT NONE
1089
1090	INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1091	INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1092
1093	INTEGER, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
1094
1095	CALL gather_unindexed_omp(VarIn,Var_tmp)
1096
1097	IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1098
1099	END SUBROUTINE gather_unindexed_i2
1100
1101
1102	SUBROUTINE gather_unindexed_i3(VarIn, VarOut)
1103	IMPLICIT NONE
1104
1105	INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1106	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1107
1108	INTEGER, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
1109
1110	CALL gather_unindexed_omp(VarIn,Var_tmp)
1111
1112	IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1113
1114
1115	END SUBROUTINE gather_unindexed_i3
1116
1117
1118	SUBROUTINE gather_unindexed_i4(VarIn, VarOut)
1119	IMPLICIT NONE
1120
1121	INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1122	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1123
1124	INTEGER, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4),SIZE(VarIn,5)) :: Var_tmp
1125
1126	CALL gather_unindexed_omp(VarIn,Var_tmp)
1127
1128	IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1129
1130
1131	END SUBROUTINE gather_unindexed_i4
1132
1133
1134	!!!!! --> Les reels
1135
1136	SUBROUTINE gather_unindexed_r(VarIn, VarOut)
1137	IMPLICIT NONE
1138
1139	REAL,INTENT(IN),DIMENSION(:) :: VarIn
1140	REAL,INTENT(OUT),DIMENSION(:) :: VarOut
1141
1142	REAL, DIMENSION(ij_nb) :: Var_tmp
1143
1144	CALL gather_unindexed_omp(VarIn,Var_tmp)
1145
1146	IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1147
1148	END SUBROUTINE gather_unindexed_r
1149
1150
1151	SUBROUTINE gather_unindexed_r1(VarIn, VarOut)
1152	IMPLICIT NONE
1153
1154	REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1155	REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1156
1157	REAL, DIMENSION(ij_nb,SIZE(VarIn,2)) :: Var_tmp
1158
1159	CALL gather_unindexed_omp(VarIn,Var_tmp)
1160
1161	IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1162
1163
1164	END SUBROUTINE gather_unindexed_r1
1165
1166
1167	SUBROUTINE gather_unindexed_r2(VarIn, VarOut)
1168	IMPLICIT NONE
1169
1170	REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1171	REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1172
1173	REAL, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
1174
1175	CALL gather_unindexed_omp(VarIn,Var_tmp)
1176
1177	IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1178
1179	END SUBROUTINE gather_unindexed_r2
1180
1181
1182	SUBROUTINE gather_unindexed_r3(VarIn, VarOut)
1183	IMPLICIT NONE
1184
1185	REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1186	REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1187
1188	REAL, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
1189
1190	CALL gather_unindexed_omp(VarIn,Var_tmp)
1191
1192	IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1193
1194	END SUBROUTINE gather_unindexed_r3
1195
1196
1197	SUBROUTINE gather_unindexed_r4(VarIn, VarOut)
1198	IMPLICIT NONE
1199
1200	REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1201	REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1202
1203	REAL, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4),SIZE(VarIn,5)) :: Var_tmp
1204
1205	CALL gather_unindexed_omp(VarIn,Var_tmp)
1206
1207	IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1208
1209	END SUBROUTINE gather_unindexed_r4
1210
1211
1212	!!!!! --> Les booleens
1213
1214	SUBROUTINE gather_unindexed_l(VarIn, VarOut)
1215	IMPLICIT NONE
1216
1217	LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
1218	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
1219
1220	LOGICAL, DIMENSION(ij_nb) :: Var_tmp
1221
1222	CALL gather_unindexed_omp(VarIn,Var_tmp)
1223
1224	IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1225
1226	END SUBROUTINE gather_unindexed_l
1227
1228
1229	SUBROUTINE gather_unindexed_l1(VarIn, VarOut)
1230	IMPLICIT NONE
1231
1232	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1233	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1234
1235	LOGICAL, DIMENSION(ij_nb,SIZE(VarIn,2)) :: Var_tmp
1236
1237	CALL gather_unindexed_omp(VarIn,Var_tmp)
1238
1239	IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1240
1241	END SUBROUTINE gather_unindexed_l1
1242
1243
1244	SUBROUTINE gather_unindexed_l2(VarIn, VarOut)
1245	IMPLICIT NONE
1246
1247	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1248	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1249
1250	LOGICAL, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
1251
1252	CALL gather_unindexed_omp(VarIn,Var_tmp)
1253	IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1254
1255	END SUBROUTINE gather_unindexed_l2
1256
1257
1258	SUBROUTINE gather_unindexed_l3(VarIn, VarOut)
1259	IMPLICIT NONE
1260
1261	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1262	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1263
1264	LOGICAL, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
1265
1266	CALL gather_unindexed_omp(VarIn,Var_tmp)
1267
1268	IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1269
1270	END SUBROUTINE gather_unindexed_l3
1271
1272
1273	SUBROUTINE gather_unindexed_l4(VarIn, VarOut)
1274	IMPLICIT NONE
1275
1276	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1277	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1278
1279	LOGICAL, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4),SIZE(VarIn,5)) :: Var_tmp
1280
1281	CALL gather_unindexed_omp(VarIn,Var_tmp)
1282
1283	IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1284
1285	END SUBROUTINE gather_unindexed_l4
1286
1287	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1288	!! Definition of reduce_sum for integers and reals 1D --> 4D !!
1289	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1290
1291	! Reduced sum subroutines for integers
1292
1293	SUBROUTINE reduce_sum_i(VarIn, VarOut)
1294	IMPLICIT NONE
1295
1296	INTEGER,INTENT(IN) :: VarIn
1297	INTEGER,INTENT(OUT) :: VarOut
1298
1299	INTEGER :: Var_tmp
1300
1301	CALL reduce_sum_omp(VarIn,Var_tmp)
1302
1303	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1304
1305	END SUBROUTINE reduce_sum_i
1306
1307
1308	SUBROUTINE reduce_sum_i1(VarIn, VarOut)
1309	IMPLICIT NONE
1310
1311	INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
1312	INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
1313
1314	INTEGER,DIMENSION(SIZE(VarIn)) :: Var_tmp
1315
1316	CALL reduce_sum_omp(VarIn,Var_tmp)
1317
1318	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1319
1320	END SUBROUTINE reduce_sum_i1
1321
1322
1323	SUBROUTINE reduce_sum_i2(VarIn, VarOut)
1324	IMPLICIT NONE
1325
1326	INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
1327	INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
1328
1329	INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
1330
1331	CALL reduce_sum_omp(VarIn,Var_tmp)
1332
1333	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1334
1335	END SUBROUTINE reduce_sum_i2
1336
1337
1338	SUBROUTINE reduce_sum_i3(VarIn, VarOut)
1339	IMPLICIT NONE
1340
1341	INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1342	INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1343
1344	INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
1345
1346	CALL reduce_sum_omp(VarIn,Var_tmp)
1347
1348	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1349
1350	END SUBROUTINE reduce_sum_i3
1351
1352
1353	SUBROUTINE reduce_sum_i4(VarIn, VarOut)
1354	IMPLICIT NONE
1355
1356	INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1357	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1358
1359	INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
1360
1361	CALL reduce_sum_omp(VarIn,Var_tmp)
1362
1363	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1364
1365	END SUBROUTINE reduce_sum_i4
1366
1367
1368	! Reduce sum subroutines for reals
1369
1370	SUBROUTINE reduce_sum_r(VarIn, VarOut)
1371	IMPLICIT NONE
1372
1373	REAL,INTENT(IN) :: VarIn
1374	REAL,INTENT(OUT) :: VarOut
1375
1376	REAL :: Var_tmp
1377
1378	CALL reduce_sum_omp(VarIn,Var_tmp)
1379
1380	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1381
1382	END SUBROUTINE reduce_sum_r
1383
1384
1385	SUBROUTINE reduce_sum_r1(VarIn, VarOut)
1386	IMPLICIT NONE
1387
1388	REAL,INTENT(IN),DIMENSION(:) :: VarIn
1389	REAL,INTENT(OUT),DIMENSION(:) :: VarOut
1390
1391	REAL,DIMENSION(SIZE(VarIn)) :: Var_tmp
1392
1393	CALL reduce_sum_omp(VarIn,Var_tmp)
1394
1395	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1396
1397	END SUBROUTINE reduce_sum_r1
1398
1399
1400	SUBROUTINE reduce_sum_r2(VarIn, VarOut)
1401	IMPLICIT NONE
1402
1403	REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1404	REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1405
1406	REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
1407
1408	CALL reduce_sum_omp(VarIn,Var_tmp)
1409
1410	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1411
1412	END SUBROUTINE reduce_sum_r2
1413
1414
1415	SUBROUTINE reduce_sum_r3(VarIn, VarOut)
1416	IMPLICIT NONE
1417
1418	REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1419	REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1420
1421	REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
1422
1423	CALL reduce_sum_omp(VarIn,Var_tmp)
1424
1425	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1426
1427	END SUBROUTINE reduce_sum_r3
1428
1429
1430	SUBROUTINE reduce_sum_r4(VarIn, VarOut)
1431	IMPLICIT NONE
1432
1433	REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1434	REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1435
1436	REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
1437
1438	CALL reduce_sum_omp(VarIn,Var_tmp)
1439
1440	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1441
1442	END SUBROUTINE reduce_sum_r4
1443
1444	! AllReduce sum subroutines for reals
1445
1446	SUBROUTINE allreduce_sum_r(VarIn, VarOut)
1447	IMPLICIT NONE
1448
1449	REAL,INTENT(IN) :: VarIn
1450	REAL,INTENT(OUT) :: VarOut
1451
1452	REAL :: Var_tmp
1453
1454	CALL reduce_sum_omp(VarIn,Var_tmp)
1455
1456	IF (is_omp_root) CALL allreduce_sum_mpi(Var_tmp,VarOut)
1457
1458	END SUBROUTINE allreduce_sum_r
1459
1460	! AllReduce sum subroutines for integers
1461
1462	SUBROUTINE allreduce_sum_i(VarIn, VarOut)
1463	IMPLICIT NONE
1464
1465	INTEGER,INTENT(IN) :: VarIn
1466	INTEGER,INTENT(OUT) :: VarOut
1467
1468	INTEGER :: Var_tmp
1469
1470	CALL reduce_sum_omp(VarIn,Var_tmp)
1471
1472	IF (is_omp_root) CALL allreduce_sum_mpi(Var_tmp,VarOut)
1473
1474	END SUBROUTINE allreduce_sum_i
1475
1476
1477	END MODULE mod_orchidee_transfert_para
1478

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

Context Navigation

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

Download in other formats: