source: branches/publications/ORCHIDEE_gmd-2018-261/src_parallel/mod_orchidee_transfert_para.F90 @ 7442

Last change on this file since 7442 was 3714, checked in by nicolas.vuichard, 8 years ago

update with trunk changes from r2740 to r3623
  • Property svn:keywords set to Date Revision HeadURL
File size: 20.9 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$
23!! $Date$
24!! $Revision$
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, &
79                     scatter_r,scatter_r1,scatter_r2,scatter_r3, &
80                     scatter_l,scatter_l1,scatter_l2,scatter_l3
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, &
103                     gather_r,gather_r1,gather_r2,gather_r3, &
104                     gather_l,gather_l1,gather_l2,gather_l3 
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_r(VarIn, VarOut)
386  IMPLICIT NONE
387 
388    REAL,INTENT(IN),DIMENSION(:) :: VarIn
389    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
390
391    REAL,DIMENSION(nbp_mpi) :: 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_r
398
399
400  SUBROUTINE scatter_r1(VarIn, VarOut)
401  IMPLICIT NONE
402 
403    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
404    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
405
406    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
407
408   
409    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
410    CALL scatter_omp(Var_tmp,Varout)
411   
412  END SUBROUTINE scatter_r1
413
414
415  SUBROUTINE scatter_r2(VarIn, VarOut)
416  IMPLICIT NONE
417 
418    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
419    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
420   
421    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
422
423   
424    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
425    CALL scatter_omp(Var_tmp,Varout)
426   
427  END SUBROUTINE scatter_r2
428
429
430  SUBROUTINE scatter_r3(VarIn, VarOut)
431  IMPLICIT NONE
432 
433    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
434    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
435
436    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
437
438   
439    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
440    CALL scatter_omp(Var_tmp,VarOut)
441   
442  END SUBROUTINE scatter_r3
443 
444 
445
446  SUBROUTINE scatter_l(VarIn, VarOut)
447  IMPLICIT NONE
448 
449    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
450    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
451
452    LOGICAL,DIMENSION(nbp_mpi) :: Var_tmp
453   
454   
455    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
456    CALL scatter_omp(Var_tmp,Varout)
457   
458  END SUBROUTINE scatter_l
459
460
461  SUBROUTINE scatter_l1(VarIn, VarOut)
462  IMPLICIT NONE
463 
464    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
465    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
466
467    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
468
469   
470    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
471    CALL scatter_omp(Var_tmp,Varout)
472   
473  END SUBROUTINE scatter_l1
474
475
476  SUBROUTINE scatter_l2(VarIn, VarOut)
477  IMPLICIT NONE
478 
479    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
480    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
481   
482    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
483
484   
485    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
486    CALL scatter_omp(Var_tmp,Varout)
487   
488  END SUBROUTINE scatter_l2
489
490
491  SUBROUTINE scatter_l3(VarIn, VarOut)
492  IMPLICIT NONE
493 
494    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
495    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
496
497    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
498
499   
500    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
501    CALL scatter_omp(Var_tmp,VarOut)
502   
503  END SUBROUTINE scatter_l3
504
505
506
507!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
508!! Definition des Gather   --> 4D   !!
509!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
510 
511!!!!! --> Les entiers
512
513  SUBROUTINE gather_i(VarIn, VarOut)
514  IMPLICIT NONE
515 
516    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
517    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
518   
519    INTEGER, DIMENSION(nbp_mpi) :: Var_tmp
520   
521    CALL gather_omp(VarIn,Var_tmp)
522   
523    IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
524 
525  END SUBROUTINE gather_i
526
527
528  SUBROUTINE gather_i1(VarIn, VarOut)
529  IMPLICIT NONE
530 
531    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
532    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
533   
534    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
535   
536    CALL gather_omp(VarIn,Var_tmp)
537   
538    IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
539
540 
541  END SUBROUTINE gather_i1
542
543
544  SUBROUTINE gather_i2(VarIn, VarOut)
545  IMPLICIT NONE
546 
547    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
548    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
549   
550    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
551   
552    CALL gather_omp(VarIn,Var_tmp)
553   
554    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
555 
556  END SUBROUTINE gather_i2
557
558
559  SUBROUTINE gather_i3(VarIn, VarOut)
560  IMPLICIT NONE
561 
562    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
563    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
564   
565    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
566   
567    CALL gather_omp(VarIn,Var_tmp)
568   
569    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
570
571 
572  END SUBROUTINE gather_i3
573
574
575!!!!! --> Les reels
576
577  SUBROUTINE gather_r(VarIn, VarOut)
578  IMPLICIT NONE
579 
580    REAL,INTENT(IN),DIMENSION(:) :: VarIn
581    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
582   
583    REAL, DIMENSION(nbp_mpi) :: Var_tmp
584   
585    CALL gather_omp(VarIn,Var_tmp)
586   
587    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
588 
589  END SUBROUTINE gather_r
590
591
592  SUBROUTINE gather_r1(VarIn, VarOut)
593  IMPLICIT NONE
594 
595    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
596    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
597   
598    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
599   
600    CALL gather_omp(VarIn,Var_tmp)
601   
602    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
603
604 
605  END SUBROUTINE gather_r1
606
607
608  SUBROUTINE gather_r2(VarIn, VarOut)
609  IMPLICIT NONE
610 
611    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
612    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
613   
614    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
615   
616    CALL gather_omp(VarIn,Var_tmp)
617   
618    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
619 
620  END SUBROUTINE gather_r2
621
622
623  SUBROUTINE gather_r3(VarIn, VarOut)
624  IMPLICIT NONE
625 
626    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
627    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
628   
629    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: 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_r3
636
637
638!!!!! --> Les booleens
639
640  SUBROUTINE gather_l(VarIn, VarOut)
641  IMPLICIT NONE
642 
643    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
644    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
645   
646    LOGICAL, DIMENSION(nbp_mpi) :: Var_tmp
647   
648    CALL gather_omp(VarIn,Var_tmp)
649   
650    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
651 
652  END SUBROUTINE gather_l
653
654
655  SUBROUTINE gather_l1(VarIn, VarOut)
656  IMPLICIT NONE
657 
658    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
659    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
660   
661    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
662   
663    CALL gather_omp(VarIn,Var_tmp)
664   
665    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
666 
667  END SUBROUTINE gather_l1
668
669
670  SUBROUTINE gather_l2(VarIn, VarOut)
671  IMPLICIT NONE
672 
673    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
674    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
675   
676    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
677   
678    CALL gather_omp(VarIn,Var_tmp)
679    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
680 
681  END SUBROUTINE gather_l2
682
683
684  SUBROUTINE gather_l3(VarIn, VarOut)
685  IMPLICIT NONE
686 
687    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
688    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
689   
690    LOGICAL, 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_l3
697
698
699!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
700!! Definition des reduce_sum   --> 4D   !!
701!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
702
703! Les entiers
704
705  SUBROUTINE reduce_sum_i(VarIn, VarOut)
706  IMPLICIT NONE
707 
708    INTEGER,INTENT(IN)  :: VarIn
709    INTEGER,INTENT(OUT) :: VarOut
710   
711    INTEGER             :: Var_tmp
712           
713    CALL reduce_sum_omp(VarIn,Var_tmp)
714   
715    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
716 
717  END SUBROUTINE reduce_sum_i 
718
719
720  SUBROUTINE reduce_sum_i1(VarIn, VarOut)
721  IMPLICIT NONE
722 
723    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
724    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
725   
726    INTEGER,DIMENSION(SIZE(VarIn))   :: Var_tmp
727           
728    CALL reduce_sum_omp(VarIn,Var_tmp)
729   
730    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
731 
732  END SUBROUTINE reduce_sum_i1 
733
734
735  SUBROUTINE reduce_sum_i2(VarIn, VarOut)
736  IMPLICIT NONE
737 
738    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
739    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
740   
741    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
742           
743    CALL reduce_sum_omp(VarIn,Var_tmp)
744   
745    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
746
747  END SUBROUTINE reduce_sum_i2 
748 
749
750  SUBROUTINE reduce_sum_i3(VarIn, VarOut)
751  IMPLICIT NONE
752 
753    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
754    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
755   
756    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
757           
758    CALL reduce_sum_omp(VarIn,Var_tmp)
759   
760    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
761 
762  END SUBROUTINE reduce_sum_i3 
763
764
765  SUBROUTINE reduce_sum_i4(VarIn, VarOut)
766  IMPLICIT NONE
767 
768    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
769    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
770   
771    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
772           
773    CALL reduce_sum_omp(VarIn,Var_tmp)
774   
775    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
776 
777  END SUBROUTINE reduce_sum_i4 
778
779
780! Les reels
781
782  SUBROUTINE reduce_sum_r(VarIn, VarOut)
783  IMPLICIT NONE
784 
785    REAL,INTENT(IN)  :: VarIn
786    REAL,INTENT(OUT) :: VarOut
787   
788    REAL             :: Var_tmp
789           
790    CALL reduce_sum_omp(VarIn,Var_tmp)
791   
792    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
793 
794  END SUBROUTINE reduce_sum_r 
795
796
797  SUBROUTINE reduce_sum_r1(VarIn, VarOut)
798  IMPLICIT NONE
799 
800    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
801    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
802   
803    REAL,DIMENSION(SIZE(VarIn))   :: Var_tmp
804           
805    CALL reduce_sum_omp(VarIn,Var_tmp)
806   
807    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
808 
809  END SUBROUTINE reduce_sum_r1 
810
811
812  SUBROUTINE reduce_sum_r2(VarIn, VarOut)
813  IMPLICIT NONE
814 
815    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
816    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
817   
818    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
819           
820    CALL reduce_sum_omp(VarIn,Var_tmp)
821   
822    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
823 
824  END SUBROUTINE reduce_sum_r2 
825 
826
827  SUBROUTINE reduce_sum_r3(VarIn, VarOut)
828  IMPLICIT NONE
829 
830    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
831    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
832   
833    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
834           
835    CALL reduce_sum_omp(VarIn,Var_tmp)
836   
837    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
838 
839  END SUBROUTINE reduce_sum_r3 
840
841
842  SUBROUTINE reduce_sum_r4(VarIn, VarOut)
843  IMPLICIT NONE
844 
845    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
846    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
847   
848    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
849           
850    CALL reduce_sum_omp(VarIn,Var_tmp)
851   
852    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
853 
854  END SUBROUTINE reduce_sum_r4 
855
856   
857END MODULE mod_orchidee_transfert_para
858
Note: See TracBrowser for help on using the repository browser.