source: branches/publications/ORCHIDEE_2.2_r7266/ORCHIDEE/src_parallel/mod_orchidee_transfert_para.F90 @ 7541

Last change on this file since 7541 was 7541, checked in by fabienne.maignan, 2 years ago
  1. Zhang publication on coupling factor
File size: 31.6 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: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE_2_2/ORCHIDEE/src_parallel/mod_orchidee_transfert_para.F90 $
24!! $Date: 2018-08-02 09:06:40 +0200 (Thu, 02 Aug 2018) $
25!! $Revision: 5364 $
26!! \n
27!_ ================================================================================================================================
28
29MODULE 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  INTERFACE scatter_unindexed
112    MODULE PROCEDURE scatter_unindexed_i,scatter_unindexed_i1,scatter_unindexed_i2,scatter_unindexed_i3, &
113                     scatter_unindexed_r,scatter_unindexed_r1,scatter_unindexed_r2,scatter_unindexed_r3, &
114                     scatter_unindexed_l,scatter_unindexed_l1,scatter_unindexed_l2,scatter_unindexed_l3
115  END INTERFACE
116
117 
118  INTERFACE gather_unindexed
119    MODULE PROCEDURE gather_unindexed_i,gather_unindexed_i1,gather_unindexed_i2,gather_unindexed_i3, &
120                     gather_unindexed_r,gather_unindexed_r1,gather_unindexed_r2,gather_unindexed_r3, &
121                     gather_unindexed_l,gather_unindexed_l1,gather_unindexed_l2,gather_unindexed_l3 
122  END INTERFACE
123
124! ===============================================================================================================================
125!! INTERFACE    : reduce_sum
126!!
127!>\BRIEF        The root process will recieve the sum of the values from all processes
128!!
129!! \n DESCRIPTION : The root process will recieve the sum of the values from all processes
130!!                  Note that all processes must make the call.
131!!
132!! Usage: CALL reduce_sum(VarIn, VarOut)
133!! VarIn is the value on each process. VarOut is the sum of these values on the root process.
134!!
135!! RECENT CHANGE(S): None
136!!
137!! REFERENCES(S)    : None
138!!x
139!! \n
140!_ ================================================================================================================================
141  INTERFACE reduce_sum
142    MODULE PROCEDURE reduce_sum_i,reduce_sum_i1,reduce_sum_i2,reduce_sum_i3,reduce_sum_i4, &
143                     reduce_sum_r,reduce_sum_r1,reduce_sum_r2,reduce_sum_r3,reduce_sum_r4
144  END INTERFACE
145
146   
147CONTAINS
148
149!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
150!! Definition of Broadcast 1D --> 4D !!
151!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
152
153!! -- Character string -- !!
154
155  SUBROUTINE bcast_c(var)
156  IMPLICIT NONE
157    CHARACTER(LEN=*),INTENT(INOUT) :: Var
158   
159   
160    IF (is_omp_root) CALL bcast_mpi(Var)
161    CALL bcast_omp(Var)
162   
163  END SUBROUTINE bcast_c
164
165  SUBROUTINE bcast_c1(var)
166  IMPLICIT NONE
167    CHARACTER(LEN=*),INTENT(INOUT) :: Var(:)
168   
169   
170    IF (is_omp_root) CALL bcast_mpi(Var)
171    CALL bcast_omp(Var)
172   
173  END SUBROUTINE bcast_c1
174
175!! -- Integers -- !!
176 
177  SUBROUTINE bcast_i(var)
178  IMPLICIT NONE
179    INTEGER,INTENT(INOUT) :: Var
180   
181    IF (is_omp_root) CALL bcast_mpi(Var)
182    CALL bcast_omp(Var)
183   
184  END SUBROUTINE bcast_i
185
186  SUBROUTINE bcast_i1(var)
187  IMPLICIT NONE
188    INTEGER,INTENT(INOUT) :: Var(:)
189   
190   
191    IF (is_omp_root) CALL bcast_mpi(Var)
192    CALL bcast_omp(Var)
193   
194  END SUBROUTINE bcast_i1
195
196
197  SUBROUTINE bcast_i2(var)
198  IMPLICIT NONE
199    INTEGER,INTENT(INOUT) :: Var(:,:)
200   
201   
202    IF (is_omp_root) CALL bcast_mpi(Var)
203    CALL bcast_omp(Var)
204   
205  END SUBROUTINE bcast_i2
206
207
208  SUBROUTINE bcast_i3(var)
209  IMPLICIT NONE
210    INTEGER,INTENT(INOUT) :: Var(:,:,:)
211   
212   
213    IF (is_omp_root) CALL bcast_mpi(Var)
214    CALL bcast_omp(Var)
215   
216  END SUBROUTINE bcast_i3
217
218
219  SUBROUTINE bcast_i4(var)
220  IMPLICIT NONE
221    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
222   
223   
224    IF (is_omp_root) CALL bcast_mpi(Var)
225    CALL bcast_omp(Var)
226   
227  END SUBROUTINE bcast_i4
228
229 
230!! -- Reals -- !!
231 
232  SUBROUTINE bcast_r(var)
233  IMPLICIT NONE
234    REAL,INTENT(INOUT) :: Var
235
236   
237    IF (is_omp_root) CALL bcast_mpi(Var)
238    CALL bcast_omp(Var)
239   
240  END SUBROUTINE bcast_r
241
242  SUBROUTINE bcast_r1(var)
243  IMPLICIT NONE
244    REAL,INTENT(INOUT) :: Var(:)
245   
246   
247    IF (is_omp_root) CALL bcast_mpi(Var)
248    CALL bcast_omp(Var)
249   
250  END SUBROUTINE bcast_r1
251
252
253  SUBROUTINE bcast_r2(var)
254  IMPLICIT NONE
255    REAL,INTENT(INOUT) :: Var(:,:)
256   
257   
258    IF (is_omp_root) CALL bcast_mpi(Var)
259    CALL bcast_omp(Var)
260   
261  END SUBROUTINE bcast_r2
262
263
264  SUBROUTINE bcast_r3(var)
265  IMPLICIT NONE
266    REAL,INTENT(INOUT) :: Var(:,:,:)
267   
268   
269    IF (is_omp_root) CALL bcast_mpi(Var)
270    CALL bcast_omp(Var)
271   
272  END SUBROUTINE bcast_r3
273
274
275  SUBROUTINE bcast_r4(var)
276  IMPLICIT NONE
277    REAL,INTENT(INOUT) :: Var(:,:,:,:)
278   
279    IF (is_omp_root) CALL bcast_mpi(Var)
280    CALL bcast_omp(Var)
281   
282  END SUBROUTINE bcast_r4 
283
284
285!! -- Logicals -- !!
286 
287  SUBROUTINE bcast_l(var)
288  IMPLICIT NONE
289    LOGICAL,INTENT(INOUT) :: Var
290   
291    IF (is_omp_root) CALL bcast_mpi(Var)
292    CALL bcast_omp(Var)
293   
294  END SUBROUTINE bcast_l
295
296  SUBROUTINE bcast_l1(var)
297  IMPLICIT NONE
298    LOGICAL,INTENT(INOUT) :: Var(:)
299   
300    IF (is_omp_root) CALL bcast_mpi(Var)
301    CALL bcast_omp(Var)
302   
303  END SUBROUTINE bcast_l1
304
305
306  SUBROUTINE bcast_l2(var)
307  IMPLICIT NONE
308    LOGICAL,INTENT(INOUT) :: Var(:,:)
309   
310   
311    IF (is_omp_root) CALL bcast_mpi(Var)
312    CALL bcast_omp(Var)
313   
314  END SUBROUTINE bcast_l2
315
316
317  SUBROUTINE bcast_l3(var)
318  IMPLICIT NONE
319    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
320   
321    IF (is_omp_root) CALL bcast_mpi(Var)
322    CALL bcast_omp(Var)
323   
324  END SUBROUTINE bcast_l3
325
326
327  SUBROUTINE bcast_l4(var)
328  IMPLICIT NONE
329    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
330     
331    IF (is_omp_root) CALL bcast_mpi(Var)
332
333    CALL bcast_omp(Var)
334   
335  END SUBROUTINE bcast_l4
336
337
338!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
339!! Definition of Scatter  1D --> 4D  !!
340!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
341
342  SUBROUTINE scatter_i(VarIn, VarOut)
343  IMPLICIT NONE
344 
345    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
346    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
347
348    INTEGER,DIMENSION(nbp_mpi) :: Var_tmp
349   
350   
351    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
352    CALL scatter_omp(Var_tmp,Varout)
353   
354  END SUBROUTINE scatter_i
355
356
357  SUBROUTINE scatter_i1(VarIn, VarOut)
358  IMPLICIT NONE
359 
360    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
361    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
362
363    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
364
365   
366    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
367    CALL scatter_omp(Var_tmp,Varout)
368   
369  END SUBROUTINE scatter_i1
370
371
372  SUBROUTINE scatter_i2(VarIn, VarOut)
373  IMPLICIT NONE
374 
375    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
376    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
377   
378    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
379
380   
381    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
382    CALL scatter_omp(Var_tmp,Varout)
383   
384  END SUBROUTINE scatter_i2
385
386
387  SUBROUTINE scatter_i3(VarIn, VarOut)
388  IMPLICIT NONE
389 
390    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
391    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
392
393    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
394
395   
396    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
397    CALL scatter_omp(Var_tmp,VarOut)
398   
399  END SUBROUTINE scatter_i3
400
401
402  SUBROUTINE scatter_r(VarIn, VarOut)
403  IMPLICIT NONE
404 
405    REAL,INTENT(IN),DIMENSION(:) :: VarIn
406    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
407
408    REAL,DIMENSION(nbp_mpi) :: Var_tmp
409   
410   
411    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
412    CALL scatter_omp(Var_tmp,Varout)
413   
414  END SUBROUTINE scatter_r
415
416
417  SUBROUTINE scatter_r1(VarIn, VarOut)
418  IMPLICIT NONE
419 
420    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
421    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
422
423    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
424
425   
426    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
427    CALL scatter_omp(Var_tmp,Varout)
428   
429  END SUBROUTINE scatter_r1
430
431
432  SUBROUTINE scatter_r2(VarIn, VarOut)
433  IMPLICIT NONE
434 
435    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
436    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
437   
438    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
439
440   
441    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
442    CALL scatter_omp(Var_tmp,Varout)
443   
444  END SUBROUTINE scatter_r2
445
446
447  SUBROUTINE scatter_r3(VarIn, VarOut)
448  IMPLICIT NONE
449 
450    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
451    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
452
453    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
454
455   
456    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
457    CALL scatter_omp(Var_tmp,VarOut)
458   
459  END SUBROUTINE scatter_r3
460 
461 
462
463  SUBROUTINE scatter_l(VarIn, VarOut)
464  IMPLICIT NONE
465 
466    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
467    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
468
469    LOGICAL,DIMENSION(nbp_mpi) :: Var_tmp
470   
471   
472    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
473    CALL scatter_omp(Var_tmp,Varout)
474   
475  END SUBROUTINE scatter_l
476
477
478  SUBROUTINE scatter_l1(VarIn, VarOut)
479  IMPLICIT NONE
480 
481    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
482    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
483
484    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
485
486   
487    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
488    CALL scatter_omp(Var_tmp,Varout)
489   
490  END SUBROUTINE scatter_l1
491
492
493  SUBROUTINE scatter_l2(VarIn, VarOut)
494  IMPLICIT NONE
495 
496    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
497    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
498   
499    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
500
501   
502    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
503    CALL scatter_omp(Var_tmp,Varout)
504   
505  END SUBROUTINE scatter_l2
506
507
508  SUBROUTINE scatter_l3(VarIn, VarOut)
509  IMPLICIT NONE
510 
511    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
512    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
513
514    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
515
516   
517    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
518    CALL scatter_omp(Var_tmp,VarOut)
519   
520  END SUBROUTINE scatter_l3
521
522
523
524!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
525!! Definition of Gather  1D --> 4D   !!
526!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
527 
528!!!!! --> Integers
529
530  SUBROUTINE gather_i(VarIn, VarOut)
531  IMPLICIT NONE
532 
533    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
534    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
535   
536    INTEGER, DIMENSION(nbp_mpi) :: Var_tmp
537   
538    CALL gather_omp(VarIn,Var_tmp)
539   
540    IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
541 
542  END SUBROUTINE gather_i
543
544
545  SUBROUTINE gather_i1(VarIn, VarOut)
546  IMPLICIT NONE
547 
548    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
549    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
550   
551    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
552   
553    CALL gather_omp(VarIn,Var_tmp)
554   
555    IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
556
557 
558  END SUBROUTINE gather_i1
559
560
561  SUBROUTINE gather_i2(VarIn, VarOut)
562  IMPLICIT NONE
563 
564    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
565    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
566   
567    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
568   
569    CALL gather_omp(VarIn,Var_tmp)
570   
571    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
572 
573  END SUBROUTINE gather_i2
574
575
576  SUBROUTINE gather_i3(VarIn, VarOut)
577  IMPLICIT NONE
578 
579    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
580    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
581   
582    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
583   
584    CALL gather_omp(VarIn,Var_tmp)
585   
586    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
587
588 
589  END SUBROUTINE gather_i3
590
591
592!!!!! --> Reals
593
594  SUBROUTINE gather_r(VarIn, VarOut)
595  IMPLICIT NONE
596 
597    REAL,INTENT(IN),DIMENSION(:) :: VarIn
598    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
599   
600    REAL, DIMENSION(nbp_mpi) :: Var_tmp
601   
602    CALL gather_omp(VarIn,Var_tmp)
603   
604    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
605 
606  END SUBROUTINE gather_r
607
608
609  SUBROUTINE gather_r1(VarIn, VarOut)
610  IMPLICIT NONE
611 
612    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
613    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
614   
615    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
616   
617    CALL gather_omp(VarIn,Var_tmp)
618   
619    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
620
621 
622  END SUBROUTINE gather_r1
623
624
625  SUBROUTINE gather_r2(VarIn, VarOut)
626  IMPLICIT NONE
627 
628    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
629    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
630   
631    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
632   
633    CALL gather_omp(VarIn,Var_tmp)
634   
635    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
636 
637  END SUBROUTINE gather_r2
638
639
640  SUBROUTINE gather_r3(VarIn, VarOut)
641  IMPLICIT NONE
642 
643    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
644    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
645   
646    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: 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_r3
653
654
655!!!!! --> Logiclas
656
657  SUBROUTINE gather_l(VarIn, VarOut)
658  IMPLICIT NONE
659 
660    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
661    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
662   
663    LOGICAL, DIMENSION(nbp_mpi) :: Var_tmp
664   
665    CALL gather_omp(VarIn,Var_tmp)
666   
667    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
668 
669  END SUBROUTINE gather_l
670
671
672  SUBROUTINE gather_l1(VarIn, VarOut)
673  IMPLICIT NONE
674 
675    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
676    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
677   
678    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
679   
680    CALL gather_omp(VarIn,Var_tmp)
681   
682    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
683 
684  END SUBROUTINE gather_l1
685
686
687  SUBROUTINE gather_l2(VarIn, VarOut)
688  IMPLICIT NONE
689 
690    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
691    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
692   
693    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
694   
695    CALL gather_omp(VarIn,Var_tmp)
696    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
697 
698  END SUBROUTINE gather_l2
699
700
701  SUBROUTINE gather_l3(VarIn, VarOut)
702  IMPLICIT NONE
703 
704    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
705    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
706   
707    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
708   
709    CALL gather_omp(VarIn,Var_tmp)
710   
711    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
712 
713  END SUBROUTINE gather_l3
714
715!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
716!! Definition des scatter_unindexed   --> 4D   !!
717!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
718
719
720 SUBROUTINE scatter_unindexed_i(VarIn, VarOut)
721  IMPLICIT NONE
722 
723    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
724    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
725
726    INTEGER,DIMENSION(ij_nb) :: Var_tmp
727   
728   
729    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
730    CALL scatter_unindexed_omp(Var_tmp,Varout)
731   
732  END SUBROUTINE scatter_unindexed_i
733
734
735  SUBROUTINE scatter_unindexed_i1(VarIn, VarOut)
736  IMPLICIT NONE
737 
738    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
739    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
740
741    INTEGER,DIMENSION(ij_nb,SIZE(Varout,2)) :: Var_tmp
742
743   
744    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
745    CALL scatter_unindexed_omp(Var_tmp,Varout)
746   
747  END SUBROUTINE scatter_unindexed_i1
748
749
750  SUBROUTINE scatter_unindexed_i2(VarIn, VarOut)
751  IMPLICIT NONE
752 
753    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
754    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
755   
756    INTEGER,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
757
758   
759    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
760    CALL scatter_unindexed_omp(Var_tmp,Varout)
761   
762  END SUBROUTINE scatter_unindexed_i2
763
764
765  SUBROUTINE scatter_unindexed_i3(VarIn, VarOut)
766  IMPLICIT NONE
767 
768    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
769    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
770
771    INTEGER,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
772
773   
774    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
775    CALL scatter_unindexed_omp(Var_tmp,VarOut)
776   
777  END SUBROUTINE scatter_unindexed_i3
778
779
780  SUBROUTINE scatter_unindexed_r(VarIn, VarOut)
781  IMPLICIT NONE
782 
783    REAL,INTENT(IN),DIMENSION(:) :: VarIn
784    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
785
786    REAL,DIMENSION(ij_nb) :: Var_tmp
787   
788   
789    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
790    CALL scatter_unindexed_omp(Var_tmp,Varout)
791   
792  END SUBROUTINE scatter_unindexed_r
793
794
795  SUBROUTINE scatter_unindexed_r1(VarIn, VarOut)
796  IMPLICIT NONE
797 
798    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
799    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
800
801    REAL,DIMENSION(ij_nb,SIZE(Varout,2)) :: Var_tmp
802
803   
804    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
805    CALL scatter_unindexed_omp(Var_tmp,Varout)
806   
807  END SUBROUTINE scatter_unindexed_r1
808
809
810  SUBROUTINE scatter_unindexed_r2(VarIn, VarOut)
811  IMPLICIT NONE
812 
813    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
814    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
815   
816    REAL,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
817
818   
819    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
820    CALL scatter_unindexed_omp(Var_tmp,Varout)
821   
822  END SUBROUTINE scatter_unindexed_r2
823
824
825  SUBROUTINE scatter_unindexed_r3(VarIn, VarOut)
826  IMPLICIT NONE
827 
828    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
829    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
830
831    REAL,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
832
833   
834    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
835    CALL scatter_unindexed_omp(Var_tmp,VarOut)
836   
837  END SUBROUTINE scatter_unindexed_r3
838 
839 
840
841  SUBROUTINE scatter_unindexed_l(VarIn, VarOut)
842  IMPLICIT NONE
843 
844    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
845    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
846
847    LOGICAL,DIMENSION(ij_nb) :: Var_tmp
848   
849   
850    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
851    CALL scatter_unindexed_omp(Var_tmp,Varout)
852   
853  END SUBROUTINE scatter_unindexed_l
854
855
856  SUBROUTINE scatter_unindexed_l1(VarIn, VarOut)
857  IMPLICIT NONE
858 
859    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
860    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
861
862    LOGICAL,DIMENSION(ij_nb,SIZE(Varout,2)) :: Var_tmp
863
864   
865    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
866    CALL scatter_unindexed_omp(Var_tmp,Varout)
867   
868  END SUBROUTINE scatter_unindexed_l1
869
870
871  SUBROUTINE scatter_unindexed_l2(VarIn, VarOut)
872  IMPLICIT NONE
873 
874    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
875    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
876   
877    LOGICAL,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
878
879   
880    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
881    CALL scatter_unindexed_omp(Var_tmp,Varout)
882   
883  END SUBROUTINE scatter_unindexed_l2
884
885
886  SUBROUTINE scatter_unindexed_l3(VarIn, VarOut)
887  IMPLICIT NONE
888 
889    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
890    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
891
892    LOGICAL,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
893
894   
895    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
896    CALL scatter_unindexed_omp(Var_tmp,VarOut)
897   
898  END SUBROUTINE scatter_unindexed_l3
899
900
901
902!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
903!! Definition des gather_unindexed   --> 4D   !!
904!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
905 
906!!!!! --> Les entiers
907
908  SUBROUTINE gather_unindexed_i(VarIn, VarOut)
909  IMPLICIT NONE
910 
911    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
912    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
913   
914    INTEGER, DIMENSION(ij_nb) :: Var_tmp
915   
916    CALL gather_unindexed_omp(VarIn,Var_tmp)
917   
918    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,Varout)
919 
920  END SUBROUTINE gather_unindexed_i
921
922
923  SUBROUTINE gather_unindexed_i1(VarIn, VarOut)
924  IMPLICIT NONE
925 
926    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
927    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
928   
929    INTEGER, DIMENSION(ij_nb,SIZE(VarIn,2)) :: Var_tmp
930   
931    CALL gather_unindexed_omp(VarIn,Var_tmp)
932   
933    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,Varout)
934
935 
936  END SUBROUTINE gather_unindexed_i1
937
938
939  SUBROUTINE gather_unindexed_i2(VarIn, VarOut)
940  IMPLICIT NONE
941 
942    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
943    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
944   
945    INTEGER, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
946   
947    CALL gather_unindexed_omp(VarIn,Var_tmp)
948   
949    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
950 
951  END SUBROUTINE gather_unindexed_i2
952
953
954  SUBROUTINE gather_unindexed_i3(VarIn, VarOut)
955  IMPLICIT NONE
956 
957    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
958    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
959   
960    INTEGER, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
961   
962    CALL gather_unindexed_omp(VarIn,Var_tmp)
963   
964    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
965
966 
967  END SUBROUTINE gather_unindexed_i3
968
969
970!!!!! --> Les reels
971
972  SUBROUTINE gather_unindexed_r(VarIn, VarOut)
973  IMPLICIT NONE
974 
975    REAL,INTENT(IN),DIMENSION(:) :: VarIn
976    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
977   
978    REAL, DIMENSION(ij_nb) :: Var_tmp
979   
980    CALL gather_unindexed_omp(VarIn,Var_tmp)
981   
982    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
983 
984  END SUBROUTINE gather_unindexed_r
985
986
987  SUBROUTINE gather_unindexed_r1(VarIn, VarOut)
988  IMPLICIT NONE
989 
990    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
991    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
992   
993    REAL, DIMENSION(ij_nb,SIZE(VarIn,2)) :: Var_tmp
994   
995    CALL gather_unindexed_omp(VarIn,Var_tmp)
996   
997    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
998
999 
1000  END SUBROUTINE gather_unindexed_r1
1001
1002
1003  SUBROUTINE gather_unindexed_r2(VarIn, VarOut)
1004  IMPLICIT NONE
1005 
1006    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1007    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1008   
1009    REAL, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
1010   
1011    CALL gather_unindexed_omp(VarIn,Var_tmp)
1012   
1013    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1014 
1015  END SUBROUTINE gather_unindexed_r2
1016
1017
1018  SUBROUTINE gather_unindexed_r3(VarIn, VarOut)
1019  IMPLICIT NONE
1020 
1021    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1022    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1023   
1024    REAL, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
1025   
1026    CALL gather_unindexed_omp(VarIn,Var_tmp)
1027   
1028    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1029 
1030  END SUBROUTINE gather_unindexed_r3
1031
1032
1033!!!!! --> Les booleens
1034
1035  SUBROUTINE gather_unindexed_l(VarIn, VarOut)
1036  IMPLICIT NONE
1037 
1038    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
1039    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
1040   
1041    LOGICAL, DIMENSION(ij_nb) :: Var_tmp
1042   
1043    CALL gather_unindexed_omp(VarIn,Var_tmp)
1044   
1045    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1046 
1047  END SUBROUTINE gather_unindexed_l
1048
1049
1050  SUBROUTINE gather_unindexed_l1(VarIn, VarOut)
1051  IMPLICIT NONE
1052 
1053    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1054    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1055   
1056    LOGICAL, DIMENSION(ij_nb,SIZE(VarIn,2)) :: Var_tmp
1057   
1058    CALL gather_unindexed_omp(VarIn,Var_tmp)
1059   
1060    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1061 
1062  END SUBROUTINE gather_unindexed_l1
1063
1064
1065  SUBROUTINE gather_unindexed_l2(VarIn, VarOut)
1066  IMPLICIT NONE
1067 
1068    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1069    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1070   
1071    LOGICAL, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
1072   
1073    CALL gather_unindexed_omp(VarIn,Var_tmp)
1074    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1075 
1076  END SUBROUTINE gather_unindexed_l2
1077
1078
1079  SUBROUTINE gather_unindexed_l3(VarIn, VarOut)
1080  IMPLICIT NONE
1081 
1082    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1083    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1084   
1085    LOGICAL, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
1086   
1087    CALL gather_unindexed_omp(VarIn,Var_tmp)
1088   
1089    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
1090 
1091  END SUBROUTINE gather_unindexed_l3
1092
1093!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1094!! Definition of reduce_sum for integers and reals   1D --> 4D   !!
1095!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1096
1097! Reduced sum subroutines for integers
1098
1099  SUBROUTINE reduce_sum_i(VarIn, VarOut)
1100  IMPLICIT NONE
1101 
1102    INTEGER,INTENT(IN)  :: VarIn
1103    INTEGER,INTENT(OUT) :: VarOut
1104   
1105    INTEGER             :: Var_tmp
1106           
1107    CALL reduce_sum_omp(VarIn,Var_tmp)
1108   
1109    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1110 
1111  END SUBROUTINE reduce_sum_i 
1112
1113
1114  SUBROUTINE reduce_sum_i1(VarIn, VarOut)
1115  IMPLICIT NONE
1116 
1117    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
1118    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
1119   
1120    INTEGER,DIMENSION(SIZE(VarIn))   :: Var_tmp
1121           
1122    CALL reduce_sum_omp(VarIn,Var_tmp)
1123   
1124    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1125 
1126  END SUBROUTINE reduce_sum_i1 
1127
1128
1129  SUBROUTINE reduce_sum_i2(VarIn, VarOut)
1130  IMPLICIT NONE
1131 
1132    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
1133    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
1134   
1135    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
1136           
1137    CALL reduce_sum_omp(VarIn,Var_tmp)
1138   
1139    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1140
1141  END SUBROUTINE reduce_sum_i2 
1142 
1143
1144  SUBROUTINE reduce_sum_i3(VarIn, VarOut)
1145  IMPLICIT NONE
1146 
1147    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
1148    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1149   
1150    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
1151           
1152    CALL reduce_sum_omp(VarIn,Var_tmp)
1153   
1154    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1155 
1156  END SUBROUTINE reduce_sum_i3 
1157
1158
1159  SUBROUTINE reduce_sum_i4(VarIn, VarOut)
1160  IMPLICIT NONE
1161 
1162    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
1163    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1164   
1165    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
1166           
1167    CALL reduce_sum_omp(VarIn,Var_tmp)
1168   
1169    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1170 
1171  END SUBROUTINE reduce_sum_i4 
1172
1173
1174! Reduce sum subroutines for reals
1175
1176  SUBROUTINE reduce_sum_r(VarIn, VarOut)
1177  IMPLICIT NONE
1178 
1179    REAL,INTENT(IN)  :: VarIn
1180    REAL,INTENT(OUT) :: VarOut
1181   
1182    REAL             :: Var_tmp
1183           
1184    CALL reduce_sum_omp(VarIn,Var_tmp)
1185   
1186    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1187 
1188  END SUBROUTINE reduce_sum_r 
1189
1190
1191  SUBROUTINE reduce_sum_r1(VarIn, VarOut)
1192  IMPLICIT NONE
1193 
1194    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
1195    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
1196   
1197    REAL,DIMENSION(SIZE(VarIn))   :: Var_tmp
1198           
1199    CALL reduce_sum_omp(VarIn,Var_tmp)
1200   
1201    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1202 
1203  END SUBROUTINE reduce_sum_r1 
1204
1205
1206  SUBROUTINE reduce_sum_r2(VarIn, VarOut)
1207  IMPLICIT NONE
1208 
1209    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
1210    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1211   
1212    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
1213           
1214    CALL reduce_sum_omp(VarIn,Var_tmp)
1215   
1216    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1217 
1218  END SUBROUTINE reduce_sum_r2 
1219 
1220
1221  SUBROUTINE reduce_sum_r3(VarIn, VarOut)
1222  IMPLICIT NONE
1223 
1224    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
1225    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1226   
1227    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
1228           
1229    CALL reduce_sum_omp(VarIn,Var_tmp)
1230   
1231    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1232 
1233  END SUBROUTINE reduce_sum_r3 
1234
1235
1236  SUBROUTINE reduce_sum_r4(VarIn, VarOut)
1237  IMPLICIT NONE
1238 
1239    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
1240    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1241   
1242    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
1243           
1244    CALL reduce_sum_omp(VarIn,Var_tmp)
1245   
1246    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
1247 
1248  END SUBROUTINE reduce_sum_r4 
1249
1250   
1251END MODULE mod_orchidee_transfert_para
1252
Note: See TracBrowser for help on using the repository browser.