Context Navigation

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

Last change on this file was 4470, checked in by josefine.ghattas, 7 years ago
Change adresse for orchidee-help in the comments.
Property svn:keywords set to `Date Revision HeadURL`
File size: 21.3 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, &
82	scatter_r,scatter_r1,scatter_r2,scatter_r3, &
83	scatter_l,scatter_l1,scatter_l2,scatter_l3
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, &
107	gather_r,gather_r1,gather_r2,gather_r3, &
108	gather_l,gather_l1,gather_l2,gather_l3
109	END INTERFACE
110
111
112	! ===============================================================================================================================
113	!! INTERFACE : reduce_sum
114	!!
115	!>\BRIEF The root process will recieve the sum of the values from all processes
116	!!
117	!! \n DESCRIPTION : The root process will recieve the sum of the values from all processes
118	!! Note that all processes must make the call.
119	!!
120	!! Usage: CALL reduce_sum(VarIn, VarOut)
121	!! VarIn is the value on each process. VarOut is the sum of these values on the root process.
122	!!
123	!! RECENT CHANGE(S): None
124	!!
125	!! REFERENCES(S) : None
126	!!x
127	!! \n
128	!_ ================================================================================================================================
129	INTERFACE reduce_sum
130	MODULE PROCEDURE reduce_sum_i,reduce_sum_i1,reduce_sum_i2,reduce_sum_i3,reduce_sum_i4, &
131	reduce_sum_r,reduce_sum_r1,reduce_sum_r2,reduce_sum_r3,reduce_sum_r4
132	END INTERFACE
133
134
135	CONTAINS
136
137	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
138	!! Definition of Broadcast 1D --> 4D !!
139	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
140
141	!! -- Character string -- !!
142
143	SUBROUTINE bcast_c(var)
144	IMPLICIT NONE
145	CHARACTER(LEN=*),INTENT(INOUT) :: Var
146
147
148	IF (is_omp_root) CALL bcast_mpi(Var)
149	CALL bcast_omp(Var)
150
151	END SUBROUTINE bcast_c
152
153	SUBROUTINE bcast_c1(var)
154	IMPLICIT NONE
155	CHARACTER(LEN=*),INTENT(INOUT) :: Var(:)
156
157
158	IF (is_omp_root) CALL bcast_mpi(Var)
159	CALL bcast_omp(Var)
160
161	END SUBROUTINE bcast_c1
162
163	!! -- Integers -- !!
164
165	SUBROUTINE bcast_i(var)
166	IMPLICIT NONE
167	INTEGER,INTENT(INOUT) :: Var
168
169	IF (is_omp_root) CALL bcast_mpi(Var)
170	CALL bcast_omp(Var)
171
172	END SUBROUTINE bcast_i
173
174	SUBROUTINE bcast_i1(var)
175	IMPLICIT NONE
176	INTEGER,INTENT(INOUT) :: Var(:)
177
178
179	IF (is_omp_root) CALL bcast_mpi(Var)
180	CALL bcast_omp(Var)
181
182	END SUBROUTINE bcast_i1
183
184
185	SUBROUTINE bcast_i2(var)
186	IMPLICIT NONE
187	INTEGER,INTENT(INOUT) :: Var(:,:)
188
189
190	IF (is_omp_root) CALL bcast_mpi(Var)
191	CALL bcast_omp(Var)
192
193	END SUBROUTINE bcast_i2
194
195
196	SUBROUTINE bcast_i3(var)
197	IMPLICIT NONE
198	INTEGER,INTENT(INOUT) :: Var(:,:,:)
199
200
201	IF (is_omp_root) CALL bcast_mpi(Var)
202	CALL bcast_omp(Var)
203
204	END SUBROUTINE bcast_i3
205
206
207	SUBROUTINE bcast_i4(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_i4
216
217
218	!! -- Reals -- !!
219
220	SUBROUTINE bcast_r(var)
221	IMPLICIT NONE
222	REAL,INTENT(INOUT) :: Var
223
224
225	IF (is_omp_root) CALL bcast_mpi(Var)
226	CALL bcast_omp(Var)
227
228	END SUBROUTINE bcast_r
229
230	SUBROUTINE bcast_r1(var)
231	IMPLICIT NONE
232	REAL,INTENT(INOUT) :: Var(:)
233
234
235	IF (is_omp_root) CALL bcast_mpi(Var)
236	CALL bcast_omp(Var)
237
238	END SUBROUTINE bcast_r1
239
240
241	SUBROUTINE bcast_r2(var)
242	IMPLICIT NONE
243	REAL,INTENT(INOUT) :: Var(:,:)
244
245
246	IF (is_omp_root) CALL bcast_mpi(Var)
247	CALL bcast_omp(Var)
248
249	END SUBROUTINE bcast_r2
250
251
252	SUBROUTINE bcast_r3(var)
253	IMPLICIT NONE
254	REAL,INTENT(INOUT) :: Var(:,:,:)
255
256
257	IF (is_omp_root) CALL bcast_mpi(Var)
258	CALL bcast_omp(Var)
259
260	END SUBROUTINE bcast_r3
261
262
263	SUBROUTINE bcast_r4(var)
264	IMPLICIT NONE
265	REAL,INTENT(INOUT) :: Var(:,:,:,:)
266
267	IF (is_omp_root) CALL bcast_mpi(Var)
268	CALL bcast_omp(Var)
269
270	END SUBROUTINE bcast_r4
271
272
273	!! -- Logicals -- !!
274
275	SUBROUTINE bcast_l(var)
276	IMPLICIT NONE
277	LOGICAL,INTENT(INOUT) :: Var
278
279	IF (is_omp_root) CALL bcast_mpi(Var)
280	CALL bcast_omp(Var)
281
282	END SUBROUTINE bcast_l
283
284	SUBROUTINE bcast_l1(var)
285	IMPLICIT NONE
286	LOGICAL,INTENT(INOUT) :: Var(:)
287
288	IF (is_omp_root) CALL bcast_mpi(Var)
289	CALL bcast_omp(Var)
290
291	END SUBROUTINE bcast_l1
292
293
294	SUBROUTINE bcast_l2(var)
295	IMPLICIT NONE
296	LOGICAL,INTENT(INOUT) :: Var(:,:)
297
298
299	IF (is_omp_root) CALL bcast_mpi(Var)
300	CALL bcast_omp(Var)
301
302	END SUBROUTINE bcast_l2
303
304
305	SUBROUTINE bcast_l3(var)
306	IMPLICIT NONE
307	LOGICAL,INTENT(INOUT) :: Var(:,:,:)
308
309	IF (is_omp_root) CALL bcast_mpi(Var)
310	CALL bcast_omp(Var)
311
312	END SUBROUTINE bcast_l3
313
314
315	SUBROUTINE bcast_l4(var)
316	IMPLICIT NONE
317	LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
318
319	IF (is_omp_root) CALL bcast_mpi(Var)
320
321	CALL bcast_omp(Var)
322
323	END SUBROUTINE bcast_l4
324
325
326	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
327	!! Definition of Scatter 1D --> 4D !!
328	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
329
330	SUBROUTINE scatter_i(VarIn, VarOut)
331	IMPLICIT NONE
332
333	INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
334	INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
335
336	INTEGER,DIMENSION(nbp_mpi) :: Var_tmp
337
338
339	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
340	CALL scatter_omp(Var_tmp,Varout)
341
342	END SUBROUTINE scatter_i
343
344
345	SUBROUTINE scatter_i1(VarIn, VarOut)
346	IMPLICIT NONE
347
348	INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
349	INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
350
351	INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
352
353
354	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
355	CALL scatter_omp(Var_tmp,Varout)
356
357	END SUBROUTINE scatter_i1
358
359
360	SUBROUTINE scatter_i2(VarIn, VarOut)
361	IMPLICIT NONE
362
363	INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
364	INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
365
366	INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
367
368
369	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
370	CALL scatter_omp(Var_tmp,Varout)
371
372	END SUBROUTINE scatter_i2
373
374
375	SUBROUTINE scatter_i3(VarIn, VarOut)
376	IMPLICIT NONE
377
378	INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
379	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
380
381	INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
382
383
384	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
385	CALL scatter_omp(Var_tmp,VarOut)
386
387	END SUBROUTINE scatter_i3
388
389
390	SUBROUTINE scatter_r(VarIn, VarOut)
391	IMPLICIT NONE
392
393	REAL,INTENT(IN),DIMENSION(:) :: VarIn
394	REAL,INTENT(OUT),DIMENSION(:) :: VarOut
395
396	REAL,DIMENSION(nbp_mpi) :: Var_tmp
397
398
399	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
400	CALL scatter_omp(Var_tmp,Varout)
401
402	END SUBROUTINE scatter_r
403
404
405	SUBROUTINE scatter_r1(VarIn, VarOut)
406	IMPLICIT NONE
407
408	REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
409	REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
410
411	REAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
412
413
414	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
415	CALL scatter_omp(Var_tmp,Varout)
416
417	END SUBROUTINE scatter_r1
418
419
420	SUBROUTINE scatter_r2(VarIn, VarOut)
421	IMPLICIT NONE
422
423	REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
424	REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
425
426	REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
427
428
429	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
430	CALL scatter_omp(Var_tmp,Varout)
431
432	END SUBROUTINE scatter_r2
433
434
435	SUBROUTINE scatter_r3(VarIn, VarOut)
436	IMPLICIT NONE
437
438	REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
439	REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
440
441	REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
442
443
444	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
445	CALL scatter_omp(Var_tmp,VarOut)
446
447	END SUBROUTINE scatter_r3
448
449
450
451	SUBROUTINE scatter_l(VarIn, VarOut)
452	IMPLICIT NONE
453
454	LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
455	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
456
457	LOGICAL,DIMENSION(nbp_mpi) :: Var_tmp
458
459
460	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
461	CALL scatter_omp(Var_tmp,Varout)
462
463	END SUBROUTINE scatter_l
464
465
466	SUBROUTINE scatter_l1(VarIn, VarOut)
467	IMPLICIT NONE
468
469	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
470	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
471
472	LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
473
474
475	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
476	CALL scatter_omp(Var_tmp,Varout)
477
478	END SUBROUTINE scatter_l1
479
480
481	SUBROUTINE scatter_l2(VarIn, VarOut)
482	IMPLICIT NONE
483
484	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
485	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
486
487	LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
488
489
490	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
491	CALL scatter_omp(Var_tmp,Varout)
492
493	END SUBROUTINE scatter_l2
494
495
496	SUBROUTINE scatter_l3(VarIn, VarOut)
497	IMPLICIT NONE
498
499	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
500	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
501
502	LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
503
504
505	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
506	CALL scatter_omp(Var_tmp,VarOut)
507
508	END SUBROUTINE scatter_l3
509
510
511
512	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
513	!! Definition of Gather 1D --> 4D !!
514	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
515
516	!!!!! --> Integers
517
518	SUBROUTINE gather_i(VarIn, VarOut)
519	IMPLICIT NONE
520
521	INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
522	INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
523
524	INTEGER, DIMENSION(nbp_mpi) :: Var_tmp
525
526	CALL gather_omp(VarIn,Var_tmp)
527
528	IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
529
530	END SUBROUTINE gather_i
531
532
533	SUBROUTINE gather_i1(VarIn, VarOut)
534	IMPLICIT NONE
535
536	INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
537	INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
538
539	INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
540
541	CALL gather_omp(VarIn,Var_tmp)
542
543	IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
544
545
546	END SUBROUTINE gather_i1
547
548
549	SUBROUTINE gather_i2(VarIn, VarOut)
550	IMPLICIT NONE
551
552	INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
553	INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
554
555	INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
556
557	CALL gather_omp(VarIn,Var_tmp)
558
559	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
560
561	END SUBROUTINE gather_i2
562
563
564	SUBROUTINE gather_i3(VarIn, VarOut)
565	IMPLICIT NONE
566
567	INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
568	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
569
570	INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
571
572	CALL gather_omp(VarIn,Var_tmp)
573
574	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
575
576
577	END SUBROUTINE gather_i3
578
579
580	!!!!! --> Reals
581
582	SUBROUTINE gather_r(VarIn, VarOut)
583	IMPLICIT NONE
584
585	REAL,INTENT(IN),DIMENSION(:) :: VarIn
586	REAL,INTENT(OUT),DIMENSION(:) :: VarOut
587
588	REAL, DIMENSION(nbp_mpi) :: Var_tmp
589
590	CALL gather_omp(VarIn,Var_tmp)
591
592	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
593
594	END SUBROUTINE gather_r
595
596
597	SUBROUTINE gather_r1(VarIn, VarOut)
598	IMPLICIT NONE
599
600	REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
601	REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
602
603	REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
604
605	CALL gather_omp(VarIn,Var_tmp)
606
607	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
608
609
610	END SUBROUTINE gather_r1
611
612
613	SUBROUTINE gather_r2(VarIn, VarOut)
614	IMPLICIT NONE
615
616	REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
617	REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
618
619	REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
620
621	CALL gather_omp(VarIn,Var_tmp)
622
623	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
624
625	END SUBROUTINE gather_r2
626
627
628	SUBROUTINE gather_r3(VarIn, VarOut)
629	IMPLICIT NONE
630
631	REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
632	REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
633
634	REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
635
636	CALL gather_omp(VarIn,Var_tmp)
637
638	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
639
640	END SUBROUTINE gather_r3
641
642
643	!!!!! --> Logiclas
644
645	SUBROUTINE gather_l(VarIn, VarOut)
646	IMPLICIT NONE
647
648	LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
649	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
650
651	LOGICAL, DIMENSION(nbp_mpi) :: Var_tmp
652
653	CALL gather_omp(VarIn,Var_tmp)
654
655	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
656
657	END SUBROUTINE gather_l
658
659
660	SUBROUTINE gather_l1(VarIn, VarOut)
661	IMPLICIT NONE
662
663	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
664	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
665
666	LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
667
668	CALL gather_omp(VarIn,Var_tmp)
669
670	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
671
672	END SUBROUTINE gather_l1
673
674
675	SUBROUTINE gather_l2(VarIn, VarOut)
676	IMPLICIT NONE
677
678	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
679	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
680
681	LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
682
683	CALL gather_omp(VarIn,Var_tmp)
684	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
685
686	END SUBROUTINE gather_l2
687
688
689	SUBROUTINE gather_l3(VarIn, VarOut)
690	IMPLICIT NONE
691
692	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
693	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
694
695	LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
696
697	CALL gather_omp(VarIn,Var_tmp)
698
699	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
700
701	END SUBROUTINE gather_l3
702
703
704	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
705	!! Definition of reduce_sum for integers and reals 1D --> 4D !!
706	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
707
708	! Reduced sum subroutines for integers
709
710	SUBROUTINE reduce_sum_i(VarIn, VarOut)
711	IMPLICIT NONE
712
713	INTEGER,INTENT(IN) :: VarIn
714	INTEGER,INTENT(OUT) :: VarOut
715
716	INTEGER :: Var_tmp
717
718	CALL reduce_sum_omp(VarIn,Var_tmp)
719
720	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
721
722	END SUBROUTINE reduce_sum_i
723
724
725	SUBROUTINE reduce_sum_i1(VarIn, VarOut)
726	IMPLICIT NONE
727
728	INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
729	INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
730
731	INTEGER,DIMENSION(SIZE(VarIn)) :: Var_tmp
732
733	CALL reduce_sum_omp(VarIn,Var_tmp)
734
735	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
736
737	END SUBROUTINE reduce_sum_i1
738
739
740	SUBROUTINE reduce_sum_i2(VarIn, VarOut)
741	IMPLICIT NONE
742
743	INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
744	INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
745
746	INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
747
748	CALL reduce_sum_omp(VarIn,Var_tmp)
749
750	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
751
752	END SUBROUTINE reduce_sum_i2
753
754
755	SUBROUTINE reduce_sum_i3(VarIn, VarOut)
756	IMPLICIT NONE
757
758	INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
759	INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
760
761	INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
762
763	CALL reduce_sum_omp(VarIn,Var_tmp)
764
765	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
766
767	END SUBROUTINE reduce_sum_i3
768
769
770	SUBROUTINE reduce_sum_i4(VarIn, VarOut)
771	IMPLICIT NONE
772
773	INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
774	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
775
776	INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
777
778	CALL reduce_sum_omp(VarIn,Var_tmp)
779
780	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
781
782	END SUBROUTINE reduce_sum_i4
783
784
785	! Reduce sum subroutines for reals
786
787	SUBROUTINE reduce_sum_r(VarIn, VarOut)
788	IMPLICIT NONE
789
790	REAL,INTENT(IN) :: VarIn
791	REAL,INTENT(OUT) :: VarOut
792
793	REAL :: Var_tmp
794
795	CALL reduce_sum_omp(VarIn,Var_tmp)
796
797	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
798
799	END SUBROUTINE reduce_sum_r
800
801
802	SUBROUTINE reduce_sum_r1(VarIn, VarOut)
803	IMPLICIT NONE
804
805	REAL,INTENT(IN),DIMENSION(:) :: VarIn
806	REAL,INTENT(OUT),DIMENSION(:) :: VarOut
807
808	REAL,DIMENSION(SIZE(VarIn)) :: Var_tmp
809
810	CALL reduce_sum_omp(VarIn,Var_tmp)
811
812	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
813
814	END SUBROUTINE reduce_sum_r1
815
816
817	SUBROUTINE reduce_sum_r2(VarIn, VarOut)
818	IMPLICIT NONE
819
820	REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
821	REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
822
823	REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
824
825	CALL reduce_sum_omp(VarIn,Var_tmp)
826
827	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
828
829	END SUBROUTINE reduce_sum_r2
830
831
832	SUBROUTINE reduce_sum_r3(VarIn, VarOut)
833	IMPLICIT NONE
834
835	REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
836	REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
837
838	REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
839
840	CALL reduce_sum_omp(VarIn,Var_tmp)
841
842	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
843
844	END SUBROUTINE reduce_sum_r3
845
846
847	SUBROUTINE reduce_sum_r4(VarIn, VarOut)
848	IMPLICIT NONE
849
850	REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
851	REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
852
853	REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
854
855	CALL reduce_sum_omp(VarIn,Var_tmp)
856
857	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
858
859	END SUBROUTINE reduce_sum_r4
860
861
862	END MODULE mod_orchidee_transfert_para
863

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

Download in other formats: