Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

mod_orchidee_transfert_para.F90 @ 7346

Last change on this file since 7346 was 4977, checked in by simon.bowring, 6 years ago
Currently running (13/02/2018) version includes all necessarily changes to include DOC in MICT code... further parametrisation necessary to equate soil pools with those of normal forcesoil restarts
Property svn:keywords set to `Date Revision HeadURL`
File size: 23.7 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
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_i4(VarIn, VarOut)
391	IMPLICIT NONE
392
393	INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
394	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
395
396	INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4),SIZE(Varout,5)) :: 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_i4
403
404	SUBROUTINE scatter_r(VarIn, VarOut)
405	IMPLICIT NONE
406
407	REAL,INTENT(IN),DIMENSION(:) :: VarIn
408	REAL,INTENT(OUT),DIMENSION(:) :: VarOut
409
410	REAL,DIMENSION(nbp_mpi) :: Var_tmp
411
412
413	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
414	CALL scatter_omp(Var_tmp,Varout)
415
416	END SUBROUTINE scatter_r
417
418
419	SUBROUTINE scatter_r1(VarIn, VarOut)
420	IMPLICIT NONE
421
422	REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
423	REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
424
425	REAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
426
427
428	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
429	CALL scatter_omp(Var_tmp,Varout)
430
431	END SUBROUTINE scatter_r1
432
433
434	SUBROUTINE scatter_r2(VarIn, VarOut)
435	IMPLICIT NONE
436
437	REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
438	REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
439
440	REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
441
442
443	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
444	CALL scatter_omp(Var_tmp,Varout)
445
446	END SUBROUTINE scatter_r2
447
448
449	SUBROUTINE scatter_r3(VarIn, VarOut)
450	IMPLICIT NONE
451
452	REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
453	REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
454
455	REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
456
457
458	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
459	CALL scatter_omp(Var_tmp,VarOut)
460
461	END SUBROUTINE scatter_r3
462
463
464	SUBROUTINE scatter_r4(VarIn, VarOut)
465	IMPLICIT NONE
466
467	REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
468	REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
469
470	REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4),SIZE(Varout,5)) :: Var_tmp
471
472
473	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
474	CALL scatter_omp(Var_tmp,VarOut)
475
476	END SUBROUTINE scatter_r4
477
478
479	SUBROUTINE scatter_l(VarIn, VarOut)
480	IMPLICIT NONE
481
482	LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
483	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
484
485	LOGICAL,DIMENSION(nbp_mpi) :: Var_tmp
486
487
488	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
489	CALL scatter_omp(Var_tmp,Varout)
490
491	END SUBROUTINE scatter_l
492
493
494	SUBROUTINE scatter_l1(VarIn, VarOut)
495	IMPLICIT NONE
496
497	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
498	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
499
500	LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
501
502
503	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
504	CALL scatter_omp(Var_tmp,Varout)
505
506	END SUBROUTINE scatter_l1
507
508
509	SUBROUTINE scatter_l2(VarIn, VarOut)
510	IMPLICIT NONE
511
512	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
513	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
514
515	LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
516
517
518	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
519	CALL scatter_omp(Var_tmp,Varout)
520
521	END SUBROUTINE scatter_l2
522
523
524	SUBROUTINE scatter_l3(VarIn, VarOut)
525	IMPLICIT NONE
526
527	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
528	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
529
530	LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
531
532
533	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
534	CALL scatter_omp(Var_tmp,VarOut)
535
536	END SUBROUTINE scatter_l3
537
538	SUBROUTINE scatter_l4(VarIn, VarOut)
539	IMPLICIT NONE
540
541	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
542	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
543
544	LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4),SIZE(Varout,5)) :: Var_tmp
545
546
547	IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
548	CALL scatter_omp(Var_tmp,VarOut)
549
550	END SUBROUTINE scatter_l4
551
552
553	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
554	!! Definition of Gather 1D --> 4D !!
555	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
556
557	!!!!! --> Integers
558
559	SUBROUTINE gather_i(VarIn, VarOut)
560	IMPLICIT NONE
561
562	INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
563	INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
564
565	INTEGER, DIMENSION(nbp_mpi) :: Var_tmp
566
567	CALL gather_omp(VarIn,Var_tmp)
568
569	IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
570
571	END SUBROUTINE gather_i
572
573
574	SUBROUTINE gather_i1(VarIn, VarOut)
575	IMPLICIT NONE
576
577	INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
578	INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
579
580	INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
581
582	CALL gather_omp(VarIn,Var_tmp)
583
584	IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
585
586
587	END SUBROUTINE gather_i1
588
589
590	SUBROUTINE gather_i2(VarIn, VarOut)
591	IMPLICIT NONE
592
593	INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
594	INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
595
596	INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
597
598	CALL gather_omp(VarIn,Var_tmp)
599
600	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
601
602	END SUBROUTINE gather_i2
603
604
605	SUBROUTINE gather_i3(VarIn, VarOut)
606	IMPLICIT NONE
607
608	INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
609	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
610
611	INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
612
613	CALL gather_omp(VarIn,Var_tmp)
614
615	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
616
617
618	END SUBROUTINE gather_i3
619
620	SUBROUTINE gather_i4(VarIn, VarOut)
621	IMPLICIT NONE
622
623	INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
624	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
625
626	INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4),SIZE(VarIn,5)) :: Var_tmp
627
628	CALL gather_omp(VarIn,Var_tmp)
629
630	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
631
632
633	END SUBROUTINE gather_i4
634
635	!!!!! --> Reals
636
637
638	SUBROUTINE gather_r(VarIn, VarOut)
639	IMPLICIT NONE
640
641	REAL,INTENT(IN),DIMENSION(:) :: VarIn
642	REAL,INTENT(OUT),DIMENSION(:) :: VarOut
643
644	REAL, DIMENSION(nbp_mpi) :: Var_tmp
645
646	CALL gather_omp(VarIn,Var_tmp)
647
648	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
649
650	END SUBROUTINE gather_r
651
652
653	SUBROUTINE gather_r1(VarIn, VarOut)
654	IMPLICIT NONE
655
656	REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
657	REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
658
659	REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: 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_r1
667
668
669	SUBROUTINE gather_r2(VarIn, VarOut)
670	IMPLICIT NONE
671
672	REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
673	REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
674
675	REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
676
677	CALL gather_omp(VarIn,Var_tmp)
678
679	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
680
681	END SUBROUTINE gather_r2
682
683
684	SUBROUTINE gather_r3(VarIn, VarOut)
685	IMPLICIT NONE
686
687	REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
688	REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
689
690	REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
691
692	CALL gather_omp(VarIn,Var_tmp)
693
694	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
695
696	END SUBROUTINE gather_r3
697
698	SUBROUTINE gather_r4(VarIn, VarOut)
699	IMPLICIT NONE
700
701	REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
702	REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
703
704	REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4),SIZE(VarIn,5)) :: Var_tmp
705
706	CALL gather_omp(VarIn,Var_tmp)
707
708	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
709
710	END SUBROUTINE gather_r4
711
712	!!!!! --> Logiclas
713
714	SUBROUTINE gather_l(VarIn, VarOut)
715	IMPLICIT NONE
716
717	LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
718	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
719
720	LOGICAL, DIMENSION(nbp_mpi) :: Var_tmp
721
722	CALL gather_omp(VarIn,Var_tmp)
723
724	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
725
726	END SUBROUTINE gather_l
727
728
729	SUBROUTINE gather_l1(VarIn, VarOut)
730	IMPLICIT NONE
731
732	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
733	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
734
735	LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
736
737	CALL gather_omp(VarIn,Var_tmp)
738
739	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
740
741	END SUBROUTINE gather_l1
742
743
744	SUBROUTINE gather_l2(VarIn, VarOut)
745	IMPLICIT NONE
746
747	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
748	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
749
750	LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
751
752	CALL gather_omp(VarIn,Var_tmp)
753	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
754
755	END SUBROUTINE gather_l2
756
757
758	SUBROUTINE gather_l3(VarIn, VarOut)
759	IMPLICIT NONE
760
761	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
762	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
763
764	LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
765
766	CALL gather_omp(VarIn,Var_tmp)
767
768	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
769
770	END SUBROUTINE gather_l3
771
772	SUBROUTINE gather_l4(VarIn, VarOut)
773	IMPLICIT NONE
774
775	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
776	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
777
778	LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4),SIZE(VarIn,5)) :: Var_tmp
779
780	CALL gather_omp(VarIn,Var_tmp)
781
782	IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
783
784	END SUBROUTINE gather_l4
785
786	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
787	!! Definition of reduce_sum for integers and reals 1D --> 4D !!
788	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
789
790	! Reduced sum subroutines for integers
791
792	SUBROUTINE reduce_sum_i(VarIn, VarOut)
793	IMPLICIT NONE
794
795	INTEGER,INTENT(IN) :: VarIn
796	INTEGER,INTENT(OUT) :: VarOut
797
798	INTEGER :: Var_tmp
799
800	CALL reduce_sum_omp(VarIn,Var_tmp)
801
802	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
803
804	END SUBROUTINE reduce_sum_i
805
806
807	SUBROUTINE reduce_sum_i1(VarIn, VarOut)
808	IMPLICIT NONE
809
810	INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
811	INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
812
813	INTEGER,DIMENSION(SIZE(VarIn)) :: Var_tmp
814
815	CALL reduce_sum_omp(VarIn,Var_tmp)
816
817	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
818
819	END SUBROUTINE reduce_sum_i1
820
821
822	SUBROUTINE reduce_sum_i2(VarIn, VarOut)
823	IMPLICIT NONE
824
825	INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
826	INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
827
828	INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
829
830	CALL reduce_sum_omp(VarIn,Var_tmp)
831
832	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
833
834	END SUBROUTINE reduce_sum_i2
835
836
837	SUBROUTINE reduce_sum_i3(VarIn, VarOut)
838	IMPLICIT NONE
839
840	INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
841	INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
842
843	INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
844
845	CALL reduce_sum_omp(VarIn,Var_tmp)
846
847	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
848
849	END SUBROUTINE reduce_sum_i3
850
851
852	SUBROUTINE reduce_sum_i4(VarIn, VarOut)
853	IMPLICIT NONE
854
855	INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
856	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
857
858	INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
859
860	CALL reduce_sum_omp(VarIn,Var_tmp)
861
862	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
863
864	END SUBROUTINE reduce_sum_i4
865
866
867	! Reduce sum subroutines for reals
868
869	SUBROUTINE reduce_sum_r(VarIn, VarOut)
870	IMPLICIT NONE
871
872	REAL,INTENT(IN) :: VarIn
873	REAL,INTENT(OUT) :: VarOut
874
875	REAL :: Var_tmp
876
877	CALL reduce_sum_omp(VarIn,Var_tmp)
878
879	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
880
881	END SUBROUTINE reduce_sum_r
882
883
884	SUBROUTINE reduce_sum_r1(VarIn, VarOut)
885	IMPLICIT NONE
886
887	REAL,INTENT(IN),DIMENSION(:) :: VarIn
888	REAL,INTENT(OUT),DIMENSION(:) :: VarOut
889
890	REAL,DIMENSION(SIZE(VarIn)) :: Var_tmp
891
892	CALL reduce_sum_omp(VarIn,Var_tmp)
893
894	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
895
896	END SUBROUTINE reduce_sum_r1
897
898
899	SUBROUTINE reduce_sum_r2(VarIn, VarOut)
900	IMPLICIT NONE
901
902	REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
903	REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
904
905	REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
906
907	CALL reduce_sum_omp(VarIn,Var_tmp)
908
909	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
910
911	END SUBROUTINE reduce_sum_r2
912
913
914	SUBROUTINE reduce_sum_r3(VarIn, VarOut)
915	IMPLICIT NONE
916
917	REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
918	REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
919
920	REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
921
922	CALL reduce_sum_omp(VarIn,Var_tmp)
923
924	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
925
926	END SUBROUTINE reduce_sum_r3
927
928
929	SUBROUTINE reduce_sum_r4(VarIn, VarOut)
930	IMPLICIT NONE
931
932	REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
933	REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
934
935	REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
936
937	CALL reduce_sum_omp(VarIn,Var_tmp)
938
939	IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
940
941	END SUBROUTINE reduce_sum_r4
942
943
944	END MODULE mod_orchidee_transfert_para
945

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

Context Navigation

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

Download in other formats: