source: branches/publications/ORCHIDEE-MUSLE-r6129/src_parallel/mod_orchidee_transfert_para.F90 @ 7346

Last change on this file since 7346 was 4381, checked in by bertrand.guenet, 7 years ago

Improve the restart file writing
File size: 23.4 KB
Line 
1! ===============================================================================================================================
2! MODULE       : mod_orchidee_transfert_para
3!
4! CONTACT      : orchidee-help _at_ ipsl.jussieu.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!!          bcast      : send a variable from the root process to all processes
13!!          scatter    : distribute a global field known on the root process to the local domain for each processes
14!!          gather     : each process sends their local field to the root process which will recieve the field on the global domain
15!!          reduce_sum : the root process will recieve the sum of the values from all processes
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/tags/ORCHIDEE_MICT_8.4.2/src_parallel/mod_orchidee_transfert_para.F90 $
23!! $Date: 2017-01-10 15:22:30 +0100 (Tue, 10 Jan 2017) $
24!! $Revision: 3990 $
25!! \n
26!_ ================================================================================================================================
27
28MODULE mod_orchidee_transfert_para
29
30  USE mod_orchidee_para_var
31  USE mod_orchidee_mpi_transfert
32  USE mod_orchidee_omp_transfert 
33 
34
35! ===============================================================================================================================
36!! INTERFACE    : gather
37!!
38!>\BRIEF        Send a variable from root process to all processes
39!!
40!! \n DESCRIPTION : Send a variable from root process to all processes
41!!
42!!  Usage : CALL gather(Var)
43!!  The variable Var must be known before the call on the root process. After the call, all processes know the variable.
44!!  The variable has the same dimension on all processes. The variable can be integer, real or logical. It can have rank 1 to 4.
45!!
46!! RECENT CHANGE(S): None
47!!
48!! REFERENCES(S)    : None
49!!
50!! \n
51!_ ================================================================================================================================
52
53  INTERFACE bcast
54    MODULE PROCEDURE bcast_c, bcast_c1,                           &
55                     bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, &
56                     bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, &
57                     bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4
58  END INTERFACE
59
60! ===============================================================================================================================
61!! INTERFACE    : scatter
62!!
63!>\BRIEF        Distribute a global field from the root process to the local domain on each processes
64!!
65!! \n DESCRIPTION : Distribute the global field known on the root process to the local domain for each processes
66!!
67!! Usage: CALL scatter(VarIn, VarOut)
68!! VarIn must be known on the root process before the call is done.
69!! After the call, VarOut contains the variable on the local domain on each process.
70!!
71!! RECENT CHANGE(S): None
72!!
73!! REFERENCES(S)    : None
74!!
75!! \n
76!_ ================================================================================================================================
77  INTERFACE scatter
78    MODULE PROCEDURE scatter_i,scatter_i1,scatter_i2,scatter_i3,scatter_i4, &
79                     scatter_r,scatter_r1,scatter_r2,scatter_r3,scatter_r4, &
80                     scatter_l,scatter_l1,scatter_l2,scatter_l3,scatter_l4
81  END INTERFACE
82
83 
84! ===============================================================================================================================
85!! INTERFACE    : gather
86!!
87!>\BRIEF        Each process send their local field to the root process which will recieve the field on the global domain
88!!
89!! \n DESCRIPTION : Each process send their local field to the root process which will recieve the field on the global domain
90!!
91!! Usage: CALL gather(VarIn, VarOut)
92!! VarIn is the variable on the local domain on each process, known before the call. After the call, VarOut is recieved on the
93!! root process containing the variable on the globale domain.
94!!
95!! RECENT CHANGE(S): None
96!!
97!! REFERENCES(S)    : None
98!!
99!! \n
100!_ ================================================================================================================================
101  INTERFACE gather
102    MODULE PROCEDURE gather_i,gather_i1,gather_i2,gather_i3,gather_i4, &
103                     gather_r,gather_r1,gather_r2,gather_r3,gather_r4, &
104                     gather_l,gather_l1,gather_l2,gather_l3,gather_l4 
105  END INTERFACE
106 
107
108! ===============================================================================================================================
109!! INTERFACE    : reduce_sum
110!!
111!>\BRIEF        The root process will recieve the sum of the values from all processes
112!!
113!! \n DESCRIPTION : The root process will recieve the sum of the values from all processes
114!!
115!! Usage: CALL reduce_sum(VarIn, VarOut)
116!! VarIn is the value on each process. VarOut is the sum of these values on the root process.
117!!
118!! RECENT CHANGE(S): None
119!!
120!! REFERENCES(S)    : None
121!!x
122!! \n
123!_ ================================================================================================================================
124  INTERFACE reduce_sum
125    MODULE PROCEDURE reduce_sum_i,reduce_sum_i1,reduce_sum_i2,reduce_sum_i3,reduce_sum_i4, &
126                     reduce_sum_r,reduce_sum_r1,reduce_sum_r2,reduce_sum_r3,reduce_sum_r4
127  END INTERFACE
128
129   
130CONTAINS
131
132!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
133!! Definition des Broadcast --> 4D   !!
134!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
135
136!! -- Les chaine de charactère -- !!
137
138  SUBROUTINE bcast_c(var)
139  IMPLICIT NONE
140    CHARACTER(LEN=*),INTENT(INOUT) :: Var
141   
142   
143    IF (is_omp_root) CALL bcast_mpi(Var)
144    CALL bcast_omp(Var)
145   
146  END SUBROUTINE bcast_c
147
148  SUBROUTINE bcast_c1(var)
149  IMPLICIT NONE
150    CHARACTER(LEN=*),INTENT(INOUT) :: Var(:)
151   
152   
153    IF (is_omp_root) CALL bcast_mpi(Var)
154    CALL bcast_omp(Var)
155   
156  END SUBROUTINE bcast_c1
157
158!! -- Les entiers -- !!
159 
160  SUBROUTINE bcast_i(var)
161  IMPLICIT NONE
162    INTEGER,INTENT(INOUT) :: Var
163   
164    IF (is_omp_root) CALL bcast_mpi(Var)
165    CALL bcast_omp(Var)
166   
167  END SUBROUTINE bcast_i
168
169  SUBROUTINE bcast_i1(var)
170  IMPLICIT NONE
171    INTEGER,INTENT(INOUT) :: Var(:)
172   
173   
174    IF (is_omp_root) CALL bcast_mpi(Var)
175    CALL bcast_omp(Var)
176   
177  END SUBROUTINE bcast_i1
178
179
180  SUBROUTINE bcast_i2(var)
181  IMPLICIT NONE
182    INTEGER,INTENT(INOUT) :: Var(:,:)
183   
184   
185    IF (is_omp_root) CALL bcast_mpi(Var)
186    CALL bcast_omp(Var)
187   
188  END SUBROUTINE bcast_i2
189
190
191  SUBROUTINE bcast_i3(var)
192  IMPLICIT NONE
193    INTEGER,INTENT(INOUT) :: Var(:,:,:)
194   
195   
196    IF (is_omp_root) CALL bcast_mpi(Var)
197    CALL bcast_omp(Var)
198   
199  END SUBROUTINE bcast_i3
200
201
202  SUBROUTINE bcast_i4(var)
203  IMPLICIT NONE
204    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
205   
206   
207    IF (is_omp_root) CALL bcast_mpi(Var)
208    CALL bcast_omp(Var)
209   
210  END SUBROUTINE bcast_i4
211
212 
213!! -- Les reels -- !!
214 
215  SUBROUTINE bcast_r(var)
216  IMPLICIT NONE
217    REAL,INTENT(INOUT) :: Var
218
219   
220    IF (is_omp_root) CALL bcast_mpi(Var)
221    CALL bcast_omp(Var)
222   
223  END SUBROUTINE bcast_r
224
225  SUBROUTINE bcast_r1(var)
226  IMPLICIT NONE
227    REAL,INTENT(INOUT) :: Var(:)
228   
229   
230    IF (is_omp_root) CALL bcast_mpi(Var)
231    CALL bcast_omp(Var)
232   
233  END SUBROUTINE bcast_r1
234
235
236  SUBROUTINE bcast_r2(var)
237  IMPLICIT NONE
238    REAL,INTENT(INOUT) :: Var(:,:)
239   
240   
241    IF (is_omp_root) CALL bcast_mpi(Var)
242    CALL bcast_omp(Var)
243   
244  END SUBROUTINE bcast_r2
245
246
247  SUBROUTINE bcast_r3(var)
248  IMPLICIT NONE
249    REAL,INTENT(INOUT) :: Var(:,:,:)
250   
251   
252    IF (is_omp_root) CALL bcast_mpi(Var)
253    CALL bcast_omp(Var)
254   
255  END SUBROUTINE bcast_r3
256
257
258  SUBROUTINE bcast_r4(var)
259  IMPLICIT NONE
260    REAL,INTENT(INOUT) :: Var(:,:,:,:)
261   
262    IF (is_omp_root) CALL bcast_mpi(Var)
263    CALL bcast_omp(Var)
264   
265  END SUBROUTINE bcast_r4 
266
267
268!! -- Les booleens -- !!
269 
270  SUBROUTINE bcast_l(var)
271  IMPLICIT NONE
272    LOGICAL,INTENT(INOUT) :: Var
273   
274    IF (is_omp_root) CALL bcast_mpi(Var)
275    CALL bcast_omp(Var)
276   
277  END SUBROUTINE bcast_l
278
279  SUBROUTINE bcast_l1(var)
280  IMPLICIT NONE
281    LOGICAL,INTENT(INOUT) :: Var(:)
282   
283    IF (is_omp_root) CALL bcast_mpi(Var)
284    CALL bcast_omp(Var)
285   
286  END SUBROUTINE bcast_l1
287
288
289  SUBROUTINE bcast_l2(var)
290  IMPLICIT NONE
291    LOGICAL,INTENT(INOUT) :: Var(:,:)
292   
293   
294    IF (is_omp_root) CALL bcast_mpi(Var)
295    CALL bcast_omp(Var)
296   
297  END SUBROUTINE bcast_l2
298
299
300  SUBROUTINE bcast_l3(var)
301  IMPLICIT NONE
302    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
303   
304    IF (is_omp_root) CALL bcast_mpi(Var)
305    CALL bcast_omp(Var)
306   
307  END SUBROUTINE bcast_l3
308
309
310  SUBROUTINE bcast_l4(var)
311  IMPLICIT NONE
312    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
313     
314    IF (is_omp_root) CALL bcast_mpi(Var)
315
316    CALL bcast_omp(Var)
317   
318  END SUBROUTINE bcast_l4
319
320
321!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
322!! Definition des Scatter   --> 4D   !!
323!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
324
325  SUBROUTINE scatter_i(VarIn, VarOut)
326  IMPLICIT NONE
327 
328    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
329    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
330
331    INTEGER,DIMENSION(nbp_mpi) :: Var_tmp
332   
333   
334    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
335    CALL scatter_omp(Var_tmp,Varout)
336   
337  END SUBROUTINE scatter_i
338
339
340  SUBROUTINE scatter_i1(VarIn, VarOut)
341  IMPLICIT NONE
342 
343    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
344    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
345
346    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
347
348   
349    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
350    CALL scatter_omp(Var_tmp,Varout)
351   
352  END SUBROUTINE scatter_i1
353
354
355  SUBROUTINE scatter_i2(VarIn, VarOut)
356  IMPLICIT NONE
357 
358    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
359    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
360   
361    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
362
363   
364    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
365    CALL scatter_omp(Var_tmp,Varout)
366   
367  END SUBROUTINE scatter_i2
368
369
370  SUBROUTINE scatter_i3(VarIn, VarOut)
371  IMPLICIT NONE
372 
373    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
374    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
375
376    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
377
378   
379    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
380    CALL scatter_omp(Var_tmp,VarOut)
381   
382  END SUBROUTINE scatter_i3
383
384
385  SUBROUTINE scatter_i4(VarIn, VarOut)
386  IMPLICIT NONE
387 
388    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
389    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
390
391    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4),SIZE(Varout,5)) :: Var_tmp
392
393   
394    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
395    CALL scatter_omp(Var_tmp,VarOut)
396   
397  END SUBROUTINE scatter_i4
398
399  SUBROUTINE scatter_r(VarIn, VarOut)
400  IMPLICIT NONE
401 
402    REAL,INTENT(IN),DIMENSION(:) :: VarIn
403    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
404
405    REAL,DIMENSION(nbp_mpi) :: Var_tmp
406   
407   
408    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
409    CALL scatter_omp(Var_tmp,Varout)
410   
411  END SUBROUTINE scatter_r
412
413
414  SUBROUTINE scatter_r1(VarIn, VarOut)
415  IMPLICIT NONE
416 
417    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
418    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
419
420    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
421
422   
423    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
424    CALL scatter_omp(Var_tmp,Varout)
425   
426  END SUBROUTINE scatter_r1
427
428
429  SUBROUTINE scatter_r2(VarIn, VarOut)
430  IMPLICIT NONE
431 
432    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
433    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
434   
435    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
436
437   
438    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
439    CALL scatter_omp(Var_tmp,Varout)
440   
441  END SUBROUTINE scatter_r2
442
443
444  SUBROUTINE scatter_r3(VarIn, VarOut)
445  IMPLICIT NONE
446 
447    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
448    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
449
450    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
451
452   
453    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
454    CALL scatter_omp(Var_tmp,VarOut)
455   
456  END SUBROUTINE scatter_r3
457 
458
459  SUBROUTINE scatter_r4(VarIn, VarOut)
460  IMPLICIT NONE
461 
462    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
463    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
464
465    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4),SIZE(Varout,5)) :: Var_tmp
466
467   
468    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
469    CALL scatter_omp(Var_tmp,VarOut)
470   
471  END SUBROUTINE scatter_r4
472 
473
474  SUBROUTINE scatter_l(VarIn, VarOut)
475  IMPLICIT NONE
476 
477    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
478    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
479
480    LOGICAL,DIMENSION(nbp_mpi) :: Var_tmp
481   
482   
483    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
484    CALL scatter_omp(Var_tmp,Varout)
485   
486  END SUBROUTINE scatter_l
487
488
489  SUBROUTINE scatter_l1(VarIn, VarOut)
490  IMPLICIT NONE
491 
492    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
493    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
494
495    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
496
497   
498    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
499    CALL scatter_omp(Var_tmp,Varout)
500   
501  END SUBROUTINE scatter_l1
502
503
504  SUBROUTINE scatter_l2(VarIn, VarOut)
505  IMPLICIT NONE
506 
507    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
508    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
509   
510    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
511
512   
513    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
514    CALL scatter_omp(Var_tmp,Varout)
515   
516  END SUBROUTINE scatter_l2
517
518
519  SUBROUTINE scatter_l3(VarIn, VarOut)
520  IMPLICIT NONE
521 
522    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
523    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
524
525    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
526
527   
528    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
529    CALL scatter_omp(Var_tmp,VarOut)
530   
531  END SUBROUTINE scatter_l3
532
533  SUBROUTINE scatter_l4(VarIn, VarOut)
534  IMPLICIT NONE
535 
536    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
537    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
538
539    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4),SIZE(Varout,5)) :: Var_tmp
540
541   
542    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
543    CALL scatter_omp(Var_tmp,VarOut)
544   
545  END SUBROUTINE scatter_l4
546
547
548!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
549!! Definition des Gather   --> 4D   !!
550!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
551 
552!!!!! --> Les entiers
553
554  SUBROUTINE gather_i(VarIn, VarOut)
555  IMPLICIT NONE
556 
557    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
558    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
559   
560    INTEGER, DIMENSION(nbp_mpi) :: Var_tmp
561   
562    CALL gather_omp(VarIn,Var_tmp)
563   
564    IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
565 
566  END SUBROUTINE gather_i
567
568
569  SUBROUTINE gather_i1(VarIn, VarOut)
570  IMPLICIT NONE
571 
572    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
573    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
574   
575    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
576   
577    CALL gather_omp(VarIn,Var_tmp)
578   
579    IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
580
581 
582  END SUBROUTINE gather_i1
583
584
585  SUBROUTINE gather_i2(VarIn, VarOut)
586  IMPLICIT NONE
587 
588    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
589    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
590   
591    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
592   
593    CALL gather_omp(VarIn,Var_tmp)
594   
595    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
596 
597  END SUBROUTINE gather_i2
598
599
600  SUBROUTINE gather_i3(VarIn, VarOut)
601  IMPLICIT NONE
602 
603    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
604    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
605   
606    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
607   
608    CALL gather_omp(VarIn,Var_tmp)
609   
610    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
611
612 
613  END SUBROUTINE gather_i3
614
615  SUBROUTINE gather_i4(VarIn, VarOut)
616  IMPLICIT NONE
617 
618    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
619    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
620   
621    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4),SIZE(VarIn,5)) :: Var_tmp
622   
623    CALL gather_omp(VarIn,Var_tmp)
624   
625    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
626
627 
628  END SUBROUTINE gather_i4
629
630!!!!! --> Les reels
631
632  SUBROUTINE gather_r(VarIn, VarOut)
633  IMPLICIT NONE
634 
635    REAL,INTENT(IN),DIMENSION(:) :: VarIn
636    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
637   
638    REAL, DIMENSION(nbp_mpi) :: Var_tmp
639   
640    CALL gather_omp(VarIn,Var_tmp)
641   
642    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
643 
644  END SUBROUTINE gather_r
645
646
647  SUBROUTINE gather_r1(VarIn, VarOut)
648  IMPLICIT NONE
649 
650    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
651    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
652   
653    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
654   
655    CALL gather_omp(VarIn,Var_tmp)
656   
657    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
658
659 
660  END SUBROUTINE gather_r1
661
662
663  SUBROUTINE gather_r2(VarIn, VarOut)
664  IMPLICIT NONE
665 
666    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
667    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
668   
669    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
670   
671    CALL gather_omp(VarIn,Var_tmp)
672   
673    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
674 
675  END SUBROUTINE gather_r2
676
677
678  SUBROUTINE gather_r3(VarIn, VarOut)
679  IMPLICIT NONE
680 
681    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
682    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
683   
684    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
685   
686    CALL gather_omp(VarIn,Var_tmp)
687   
688    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
689 
690  END SUBROUTINE gather_r3
691
692  SUBROUTINE gather_r4(VarIn, VarOut)
693  IMPLICIT NONE
694 
695    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
696    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
697   
698    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4),SIZE(VarIn,5)) :: Var_tmp
699   
700    CALL gather_omp(VarIn,Var_tmp)
701   
702    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
703 
704  END SUBROUTINE gather_r4
705
706!!!!! --> Les booleens
707
708  SUBROUTINE gather_l(VarIn, VarOut)
709  IMPLICIT NONE
710 
711    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
712    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
713   
714    LOGICAL, DIMENSION(nbp_mpi) :: Var_tmp
715   
716    CALL gather_omp(VarIn,Var_tmp)
717   
718    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
719 
720  END SUBROUTINE gather_l
721
722
723  SUBROUTINE gather_l1(VarIn, VarOut)
724  IMPLICIT NONE
725 
726    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
727    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
728   
729    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
730   
731    CALL gather_omp(VarIn,Var_tmp)
732   
733    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
734 
735  END SUBROUTINE gather_l1
736
737
738  SUBROUTINE gather_l2(VarIn, VarOut)
739  IMPLICIT NONE
740 
741    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
742    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
743   
744    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
745   
746    CALL gather_omp(VarIn,Var_tmp)
747    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
748 
749  END SUBROUTINE gather_l2
750
751
752  SUBROUTINE gather_l3(VarIn, VarOut)
753  IMPLICIT NONE
754 
755    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
756    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
757   
758    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
759   
760    CALL gather_omp(VarIn,Var_tmp)
761   
762    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
763 
764  END SUBROUTINE gather_l3
765
766  SUBROUTINE gather_l4(VarIn, VarOut)
767  IMPLICIT NONE
768 
769    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
770    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
771   
772    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4),SIZE(VarIn,5)) :: Var_tmp
773   
774    CALL gather_omp(VarIn,Var_tmp)
775   
776    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
777 
778  END SUBROUTINE gather_l4
779
780!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
781!! Definition des reduce_sum   --> 4D   !!
782!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
783
784! Les entiers
785
786  SUBROUTINE reduce_sum_i(VarIn, VarOut)
787  IMPLICIT NONE
788 
789    INTEGER,INTENT(IN)  :: VarIn
790    INTEGER,INTENT(OUT) :: VarOut
791   
792    INTEGER             :: Var_tmp
793           
794    CALL reduce_sum_omp(VarIn,Var_tmp)
795   
796    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
797 
798  END SUBROUTINE reduce_sum_i 
799
800
801  SUBROUTINE reduce_sum_i1(VarIn, VarOut)
802  IMPLICIT NONE
803 
804    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
805    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
806   
807    INTEGER,DIMENSION(SIZE(VarIn))   :: Var_tmp
808           
809    CALL reduce_sum_omp(VarIn,Var_tmp)
810   
811    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
812 
813  END SUBROUTINE reduce_sum_i1 
814
815
816  SUBROUTINE reduce_sum_i2(VarIn, VarOut)
817  IMPLICIT NONE
818 
819    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
820    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
821   
822    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
823           
824    CALL reduce_sum_omp(VarIn,Var_tmp)
825   
826    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
827
828  END SUBROUTINE reduce_sum_i2 
829 
830
831  SUBROUTINE reduce_sum_i3(VarIn, VarOut)
832  IMPLICIT NONE
833 
834    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
835    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
836   
837    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
838           
839    CALL reduce_sum_omp(VarIn,Var_tmp)
840   
841    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
842 
843  END SUBROUTINE reduce_sum_i3 
844
845
846  SUBROUTINE reduce_sum_i4(VarIn, VarOut)
847  IMPLICIT NONE
848 
849    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
850    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
851   
852    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
853           
854    CALL reduce_sum_omp(VarIn,Var_tmp)
855   
856    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
857 
858  END SUBROUTINE reduce_sum_i4 
859
860
861! Les reels
862
863  SUBROUTINE reduce_sum_r(VarIn, VarOut)
864  IMPLICIT NONE
865 
866    REAL,INTENT(IN)  :: VarIn
867    REAL,INTENT(OUT) :: VarOut
868   
869    REAL             :: Var_tmp
870           
871    CALL reduce_sum_omp(VarIn,Var_tmp)
872   
873    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
874 
875  END SUBROUTINE reduce_sum_r 
876
877
878  SUBROUTINE reduce_sum_r1(VarIn, VarOut)
879  IMPLICIT NONE
880 
881    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
882    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
883   
884    REAL,DIMENSION(SIZE(VarIn))   :: Var_tmp
885           
886    CALL reduce_sum_omp(VarIn,Var_tmp)
887   
888    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
889 
890  END SUBROUTINE reduce_sum_r1 
891
892
893  SUBROUTINE reduce_sum_r2(VarIn, VarOut)
894  IMPLICIT NONE
895 
896    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
897    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
898   
899    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
900           
901    CALL reduce_sum_omp(VarIn,Var_tmp)
902   
903    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
904 
905  END SUBROUTINE reduce_sum_r2 
906 
907
908  SUBROUTINE reduce_sum_r3(VarIn, VarOut)
909  IMPLICIT NONE
910 
911    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
912    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
913   
914    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
915           
916    CALL reduce_sum_omp(VarIn,Var_tmp)
917   
918    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
919 
920  END SUBROUTINE reduce_sum_r3 
921
922
923  SUBROUTINE reduce_sum_r4(VarIn, VarOut)
924  IMPLICIT NONE
925 
926    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
927    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
928   
929    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
930           
931    CALL reduce_sum_omp(VarIn,Var_tmp)
932   
933    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
934 
935  END SUBROUTINE reduce_sum_r4 
936
937   
938END MODULE mod_orchidee_transfert_para
939
Note: See TracBrowser for help on using the repository browser.