source: tags/ORCHIDEE_2_0/ORCHIDEE/src_parallel/mod_orchidee_omp_transfert.F90 @ 6368

Last change on this file since 6368 was 4470, checked in by josefine.ghattas, 7 years ago

Change adresse for orchidee-help in the comments.
  • Property svn:keywords set to Date Revision HeadURL
File size: 58.3 KB
Line 
1! ==============================================================================================================================
2! MODULE   : mod_orchidee_omp_transfert
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     Low level OpenMP parallel communication encapsulations for ORCHIDEE.
10!!
11!!\n DESCRIPTION  : Low level OpenMP parallel communication encapsulations for ORCHIDEE.
12!!                  The interfaces in this module are only used by mod_orchidee_transfert_para to create high level interfaces.
13!!
14!! RECENT CHANGE(S): None
15!!
16!! REFERENCES(S)    : None
17!!
18!! SVN              :
19!! $HeadURL$
20!! $Date$
21!! $Revision$
22!! \n
23!_ ================================================================================================================================
24MODULE mod_orchidee_omp_transfert
25  !-
26  USE mod_orchidee_omp_data
27  USE ioipsl
28  !-
29  IMPLICIT NONE
30
31  PRIVATE
32 
33#ifdef CPP_OMP
34  ! Check OpenMP buffer sizes increase.
35  LOGICAL, PARAMETER :: check_size = .FALSE.
36
37  INTEGER,PARAMETER :: grow_factor=1.5
38  INTEGER,PARAMETER :: size_min=1024
39  PUBLIC size_min
40
41  INTEGER(i_std),SAVE,ALLOCATABLE,DIMENSION(:) :: omp_ibuffer
42  INTEGER,SAVE                            :: size_i=0
43  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: omp_lbuffer
44  INTEGER,SAVE                            :: size_l=0
45  REAL(r_std),SAVE,ALLOCATABLE,DIMENSION(:) :: omp_rbuffer
46  INTEGER,SAVE                            :: size_r=0
47  CHARACTER(len=size_min), SAVE,ALLOCATABLE,DIMENSION(:) :: omp_cbuffer
48  INTEGER,SAVE                            :: size_c=0
49
50#endif
51
52  !! ==============================================================================================================================
53  !! INTERFACE   :  bcast_omp
54  !!
55  !>\BRIEF         Send a variable from master thread to all threads OMP 
56  !!
57  !! DESCRIPTION  : NONE
58  !!
59  !! \n
60  !_ ================================================================================================================================
61  INTERFACE bcast_omp
62     MODULE PROCEDURE bcast_omp_c, bcast_omp_c1,                                       &
63          bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4, &
64          bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4, &
65          bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4
66  END INTERFACE
67
68  !! ==============================================================================================================================
69  !! INTERFACE   : scatter_omp
70  !!
71  !>\BRIEF        Distribute a  field on the process MPI grid from the master thread to the local domain on each threads omp
72  !!
73  !! DESCRIPTION  :   NONE
74  !!
75  !! \n
76  !_ ================================================================================================================================
77  INTERFACE scatter_omp
78     MODULE PROCEDURE scatter_omp_i,scatter_omp_i1,scatter_omp_i2,scatter_omp_i3, &
79          scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3, &
80          scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3
81  END INTERFACE
82
83  !! ==============================================================================================================================
84  !! INTERFACE   : gather_omp
85  !!
86  !>\BRIEF          Each thread OMP  send their local field to the master thread which will recieve
87  !!                the field on the MPI domain
88  !!
89  !! DESCRIPTION  : NONE
90  !!
91  !! \n
92  !_ ================================================================================================================================
93  INTERFACE gather_omp
94     MODULE PROCEDURE gather_omp_i0,gather_omp_i,gather_omp_i1,gather_omp_i2,gather_omp_i3,gather_omp_i4,gather_omp_i5, &
95          gather_omp_r0,gather_omp_r,gather_omp_r1,gather_omp_r2,gather_omp_r3,gather_omp_r4,gather_omp_r5, &
96          gather_omp_l0,gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3,gather_omp_l4,gather_omp_l5
97  END INTERFACE
98
99
100  !! ==============================================================================================================================
101  !! INTERFACE   : reduce_sum_omp
102  !!
103  !>\BRIEF       The master thread will recieve the sum of the values from all threads
104  !!
105  !! DESCRIPTION  : NONE
106  !!
107  !! \n
108  !_ ================================================================================================================================
109  INTERFACE reduce_sum_omp
110     MODULE PROCEDURE reduce_sum_omp_i,reduce_sum_omp_i1,reduce_sum_omp_i2,reduce_sum_omp_i3,reduce_sum_omp_i4, &
111          reduce_sum_omp_r,reduce_sum_omp_r1,reduce_sum_omp_r2,reduce_sum_omp_r3,reduce_sum_omp_r4
112  END INTERFACE
113
114  PUBLIC  bcast_omp,scatter_omp,gather_omp,reduce_sum_omp
115
116CONTAINS
117
118  SUBROUTINE check_buffer_c(buff_size)
119    IMPLICIT NONE
120    INTEGER :: buff_size
121
122    IF ( check_all_transfert ) THEN
123      omp_previous=omp_function(omp_rank)
124      omp_function(omp_rank)= 72 
125      CALL print_omp_function()
126    ENDIF
127#ifdef CPP_OMP
128    CALL barrier2_omp()
129    IF (is_omp_root) THEN
130       IF (buff_size>size_c) THEN
131          IF ( check_size ) THEN
132             IF (numout_omp > 0) THEN
133               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for strings : old_size, new_size"
134             ELSE
135               WRITE(*,*) "ORCHIDEE OMP; buffer for strings : old_size, new_size"
136             ENDIF
137             IF (ALLOCATED(omp_cbuffer)) THEN
138                IF (numout_omp > 0) THEN
139                  WRITE(numout_omp,*) SIZE(omp_cbuffer)
140                ELSE
141                  WRITE(*,*) SIZE(omp_cbuffer)
142                ENDIF
143             ELSE
144                IF (numout_omp > 0) THEN
145                  WRITE(numout_omp,*) 0
146                ELSE
147                  WRITE(*,*) 0
148                ENDIF
149             ENDIF
150          ENDIF
151          IF (ALLOCATED(omp_cbuffer)) DEALLOCATE(omp_cbuffer)
152          size_c=MAX(size_min,INT(grow_factor*buff_size))
153          IF ( check_size ) THEN
154             IF (numout_omp > 0) THEN
155               WRITE(numout_omp,*) size_c
156             ELSE
157               WRITE(*,*) size_c
158             ENDIF
159          ENDIF
160          ALLOCATE(omp_cbuffer(size_c))
161       ENDIF
162    ENDIF
163    CALL barrier2_omp()
164
165#endif
166
167    IF ( check_all_transfert ) &
168        omp_function(omp_rank)=omp_previous
169  END SUBROUTINE check_buffer_c
170
171  SUBROUTINE check_buffer_i(buff_size)
172    IMPLICIT NONE
173    INTEGER :: buff_size
174
175    IF ( check_all_transfert ) THEN
176      omp_previous=omp_function(omp_rank)
177      omp_function(omp_rank)= 1 
178      CALL print_omp_function()
179    ENDIF
180#ifdef CPP_OMP
181    CALL barrier2_omp()
182
183    IF (is_omp_root) THEN
184       IF (buff_size>size_i) THEN
185          IF ( check_size ) THEN
186             IF (numout_omp > 0) THEN
187               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for integers : old_size, new_size"
188             ELSE
189               WRITE(*,*) "ORCHIDEE OMP; buffer for integers : old_size, new_size"
190             ENDIF
191             IF (ALLOCATED(omp_ibuffer)) THEN
192                IF (numout_omp > 0) THEN
193                  WRITE(numout_omp,*) SIZE(omp_ibuffer)
194                ELSE
195                  WRITE(*,*) SIZE(omp_ibuffer)
196                ENDIF
197             ELSE
198                IF (numout_omp > 0) THEN
199                  WRITE(numout_omp,*) 0
200                ELSE
201                  WRITE(*,*) 0
202                ENDIF
203             ENDIF
204          ENDIF
205          IF (ALLOCATED(omp_ibuffer)) DEALLOCATE(omp_ibuffer)
206          size_i=MAX(size_min,INT(grow_factor*buff_size))
207          IF ( check_size ) THEN
208             IF (numout_omp > 0) THEN
209               WRITE(numout_omp,*) size_i
210             ELSE
211               WRITE(*,*) size_i
212             ENDIF
213          ENDIF
214          ALLOCATE(omp_ibuffer(size_i))
215       ENDIF
216    ENDIF
217    CALL barrier2_omp()
218
219#endif
220
221    IF ( check_all_transfert ) &
222        omp_function(omp_rank)=omp_previous
223  END SUBROUTINE check_buffer_i
224 
225  SUBROUTINE check_buffer_r(buff_size)
226    IMPLICIT NONE
227    INTEGER :: buff_size
228
229    IF ( check_all_transfert ) THEN
230      omp_previous=omp_function(omp_rank)
231      omp_function(omp_rank)= 2
232      CALL print_omp_function()
233    ENDIF
234#ifdef CPP_OMP
235    CALL barrier2_omp()
236
237    IF (is_omp_root) THEN
238       IF (buff_size>size_r) THEN
239          IF ( check_size ) THEN
240             IF (numout_omp > 0) THEN
241               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for reals : old_size, new_size"
242             ELSE
243               WRITE(*,*) "ORCHIDEE OMP; buffer for reals : old_size, new_size"
244             ENDIF
245             IF (ALLOCATED(omp_rbuffer)) THEN
246                IF (numout_omp > 0) THEN
247                  WRITE(numout_omp,*) SIZE(omp_rbuffer)
248                ELSE
249                  WRITE(*,*) SIZE(omp_rbuffer)
250                ENDIF
251             ELSE
252                IF (numout_omp > 0) THEN
253                  WRITE(numout_omp,*) 0
254                ELSE
255                  WRITE(*,*) 0
256                ENDIF
257             ENDIF
258          ENDIF
259          IF (ALLOCATED(omp_rbuffer)) DEALLOCATE(omp_rbuffer)
260          size_r=MAX(size_min,INT(grow_factor*buff_size))
261          IF ( check_size ) THEN
262             IF (numout_omp > 0) THEN
263               WRITE(numout_omp,*) size_r
264             ELSE
265               WRITE(*,*) size_r
266             ENDIF
267          ENDIF
268          ALLOCATE(omp_rbuffer(size_r))
269       ENDIF
270    ENDIF
271    CALL barrier2_omp()
272
273#endif
274
275    IF ( check_all_transfert ) &
276        omp_function(omp_rank)=omp_previous
277  END SUBROUTINE check_buffer_r
278 
279  SUBROUTINE check_buffer_l(buff_size)
280    IMPLICIT NONE
281    INTEGER :: buff_size
282
283    IF ( check_all_transfert ) THEN
284      omp_previous=omp_function(omp_rank)
285      omp_function(omp_rank)= 3
286      CALL print_omp_function()
287    ENDIF
288#ifdef CPP_OMP
289    CALL barrier2_omp()
290
291    IF (is_omp_root) THEN
292       IF (buff_size>size_l) THEN
293          IF ( check_size ) THEN
294             IF (numout_omp > 0) THEN
295               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for logicals : old_size, new_size"
296             ELSE
297               WRITE(*,*) "ORCHIDEE OMP; buffer for logicals : old_size, new_size"
298             ENDIF
299             IF (ALLOCATED(omp_lbuffer)) THEN
300                IF (numout_omp > 0) THEN
301                  WRITE(numout_omp,*) SIZE(omp_lbuffer)
302                ELSE
303                  WRITE(*,*) SIZE(omp_lbuffer)
304                ENDIF
305             ELSE
306                IF (numout_omp > 0) THEN
307                  WRITE(numout_omp,*) 0
308                ELSE
309                  WRITE(*,*) 0
310                ENDIF
311             ENDIF
312          ENDIF
313          IF (ALLOCATED(omp_lbuffer)) DEALLOCATE(omp_lbuffer)
314          size_l=MAX(size_min,INT(grow_factor*buff_size))
315          IF ( check_size ) THEN
316             IF (numout_omp > 0) THEN
317               WRITE(numout_omp,*) size_l
318             ELSE
319               WRITE(*,*) size_l
320             ENDIF
321          ENDIF
322          ALLOCATE(omp_lbuffer(size_l))
323       ENDIF
324    ENDIF
325    CALL barrier2_omp()
326
327#endif
328
329    IF ( check_all_transfert ) &
330        omp_function(omp_rank)=omp_previous
331  END SUBROUTINE check_buffer_l
332   
333
334!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
335!! Definition des Broadcast --> 4D   !!
336!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
337
338  !! -- Les chaine de charactère -- !!
339
340  SUBROUTINE bcast_omp_c(Var)
341    IMPLICIT NONE
342    CHARACTER(LEN=*),INTENT(INOUT) :: Var
343    CHARACTER(LEN=80),DIMENSION(1) :: Var1
344
345    IF ( check_all_transfert ) THEN
346      omp_previous=omp_function(omp_rank)
347      omp_function(omp_rank)= 4
348      CALL print_omp_function()
349    ENDIF
350#ifndef CPP_OMP
351    RETURN
352#else
353    IF (is_omp_root) &
354         Var1(1)=Var
355    CALL check_buffer_c(1)
356    CALL orch_bcast_omp_cgen(Var1,1,omp_cbuffer)
357    Var=Var1(1)
358#endif
359    IF ( check_all_transfert ) &
360        omp_function(omp_rank)=omp_previous
361  END SUBROUTINE bcast_omp_c
362
363  SUBROUTINE bcast_omp_c1(Var)
364    IMPLICIT NONE
365    CHARACTER(LEN=*),DIMENSION(:),INTENT(INOUT) :: Var
366
367    IF ( check_all_transfert ) THEN
368      omp_previous=omp_function(omp_rank)
369      omp_function(omp_rank)= 4
370      CALL print_omp_function()
371    ENDIF
372#ifndef CPP_OMP
373    RETURN
374#else
375    CALL check_buffer_c(size(Var))
376    CALL orch_bcast_omp_cgen(Var,size(Var),omp_cbuffer)
377#endif
378    IF ( check_all_transfert ) &
379        omp_function(omp_rank)=omp_previous
380  END SUBROUTINE bcast_omp_c1
381
382  !! -- Les entiers -- !!
383
384  SUBROUTINE bcast_omp_i(var1)
385    IMPLICIT NONE
386    INTEGER,INTENT(INOUT) :: Var1
387
388    INTEGER,DIMENSION(1) :: Var
389
390    IF ( check_all_transfert ) THEN
391      omp_previous=omp_function(omp_rank)
392      omp_function(omp_rank)= 5
393      CALL print_omp_function()
394    ENDIF
395#ifndef CPP_OMP
396    RETURN
397#else
398    IF (is_omp_root) &
399         Var(1)=Var1
400    CALL check_buffer_i(1)
401    CALL orch_bcast_omp_igen(Var,1,omp_ibuffer)
402    Var1=Var(1)
403#endif
404    IF ( check_all_transfert ) &
405        omp_function(omp_rank)=omp_previous
406  END SUBROUTINE bcast_omp_i
407
408  SUBROUTINE bcast_omp_i1(var)
409    IMPLICIT NONE
410    INTEGER,INTENT(INOUT) :: Var(:)
411
412    IF ( check_all_transfert ) THEN
413      omp_previous=omp_function(omp_rank)
414      omp_function(omp_rank)= 6
415      CALL print_omp_function()
416    ENDIF
417#ifndef CPP_OMP
418    RETURN
419#else
420    CALL check_buffer_i(size(Var))
421    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
422#endif
423    IF ( check_all_transfert ) &
424        omp_function(omp_rank)=omp_previous
425  END SUBROUTINE bcast_omp_i1
426
427  SUBROUTINE bcast_omp_i2(var)
428    IMPLICIT NONE
429    INTEGER,INTENT(INOUT) :: Var(:,:)
430
431    IF ( check_all_transfert ) THEN
432      omp_previous=omp_function(omp_rank)
433      omp_function(omp_rank)= 7
434      CALL print_omp_function()
435    ENDIF
436#ifndef CPP_OMP
437    RETURN
438#else
439    CALL check_buffer_i(size(Var))
440    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
441#endif
442    IF ( check_all_transfert ) &
443        omp_function(omp_rank)=omp_previous
444  END SUBROUTINE bcast_omp_i2
445
446  SUBROUTINE bcast_omp_i3(var)
447    IMPLICIT NONE
448    INTEGER,INTENT(INOUT) :: Var(:,:,:)
449
450    IF ( check_all_transfert ) THEN
451      omp_previous=omp_function(omp_rank)
452      omp_function(omp_rank)= 8
453      CALL print_omp_function()
454    ENDIF
455#ifndef CPP_OMP
456    RETURN
457#else
458    CALL check_buffer_i(size(Var))
459    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
460#endif
461    IF ( check_all_transfert ) &
462        omp_function(omp_rank)=omp_previous
463  END SUBROUTINE bcast_omp_i3
464
465  SUBROUTINE bcast_omp_i4(var)
466    IMPLICIT NONE
467    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
468
469    IF ( check_all_transfert ) THEN
470      omp_previous=omp_function(omp_rank)
471      omp_function(omp_rank)= 9
472      CALL print_omp_function()
473    ENDIF
474#ifndef CPP_OMP
475    RETURN
476#else
477    CALL check_buffer_i(size(Var))
478    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
479#endif
480    IF ( check_all_transfert ) &
481        omp_function(omp_rank)=omp_previous
482  END SUBROUTINE bcast_omp_i4
483
484
485  !! -- Les reels -- !!
486
487  SUBROUTINE bcast_omp_r(var)
488    IMPLICIT NONE
489    REAL,INTENT(INOUT) :: Var
490
491    REAL,DIMENSION(1) :: Var1
492
493    IF ( check_all_transfert ) THEN
494      omp_previous=omp_function(omp_rank)
495      omp_function(omp_rank)=10
496      CALL print_omp_function()
497    ENDIF
498#ifndef CPP_OMP
499    RETURN
500#else
501    IF (is_omp_root) &
502         Var1(1)=Var
503    CALL check_buffer_r(1)
504    CALL orch_bcast_omp_rgen(Var1,1,omp_rbuffer)
505    Var=Var1(1)
506#endif
507    IF ( check_all_transfert ) &
508        omp_function(omp_rank)=omp_previous
509  END SUBROUTINE bcast_omp_r
510
511  SUBROUTINE bcast_omp_r1(var)
512    IMPLICIT NONE
513    REAL,INTENT(INOUT) :: Var(:)
514
515    IF ( check_all_transfert ) THEN
516      omp_previous=omp_function(omp_rank)
517      omp_function(omp_rank)=11
518      CALL print_omp_function()
519    ENDIF
520#ifndef CPP_OMP
521    RETURN
522#else
523    CALL check_buffer_r(size(Var))
524    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
525#endif
526    IF ( check_all_transfert ) &
527        omp_function(omp_rank)=omp_previous
528  END SUBROUTINE bcast_omp_r1
529
530  SUBROUTINE bcast_omp_r2(var)
531    IMPLICIT NONE
532    REAL,INTENT(INOUT) :: Var(:,:)
533
534    IF ( check_all_transfert ) THEN
535      omp_previous=omp_function(omp_rank)
536      omp_function(omp_rank)=12
537      CALL print_omp_function()
538    ENDIF
539#ifndef CPP_OMP
540    RETURN
541#else
542    CALL check_buffer_r(size(Var))
543    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
544#endif
545    IF ( check_all_transfert ) &
546        omp_function(omp_rank)=omp_previous
547  END SUBROUTINE bcast_omp_r2
548
549  SUBROUTINE bcast_omp_r3(var)
550    IMPLICIT NONE
551    REAL,INTENT(INOUT) :: Var(:,:,:)
552
553    IF ( check_all_transfert ) THEN
554      omp_previous=omp_function(omp_rank)
555      omp_function(omp_rank)=13
556      CALL print_omp_function()
557    ENDIF
558#ifndef CPP_OMP
559    RETURN
560#else
561    CALL check_buffer_r(size(Var))
562    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
563#endif
564    IF ( check_all_transfert ) &
565        omp_function(omp_rank)=omp_previous
566  END SUBROUTINE bcast_omp_r3
567
568  SUBROUTINE bcast_omp_r4(var)
569    IMPLICIT NONE
570    REAL,INTENT(INOUT) :: Var(:,:,:,:)
571
572    IF ( check_all_transfert ) THEN
573      omp_previous=omp_function(omp_rank)
574      omp_function(omp_rank)=14
575      CALL print_omp_function()
576    ENDIF
577#ifndef CPP_OMP
578    RETURN
579#else
580    CALL check_buffer_r(size(Var))
581    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
582#endif
583    IF ( check_all_transfert ) &
584        omp_function(omp_rank)=omp_previous
585  END SUBROUTINE bcast_omp_r4
586
587  !! -- Les booleans -- !!
588
589  SUBROUTINE bcast_omp_l(var)
590    IMPLICIT NONE
591    LOGICAL,INTENT(INOUT) :: Var
592
593    LOGICAL,DIMENSION(1) :: Var1
594
595    IF ( check_all_transfert ) THEN
596      omp_previous=omp_function(omp_rank)
597      omp_function(omp_rank)=15
598      CALL print_omp_function()
599    ENDIF
600#ifndef CPP_OMP
601    RETURN
602#else
603    IF (is_omp_root) &
604         Var1(1)=Var
605    CALL check_buffer_l(1)
606    CALL orch_bcast_omp_lgen(Var1,1,omp_lbuffer)
607    Var=Var1(1)
608#endif
609    IF ( check_all_transfert ) &
610        omp_function(omp_rank)=omp_previous
611  END SUBROUTINE bcast_omp_l
612
613  SUBROUTINE bcast_omp_l1(var)
614    IMPLICIT NONE
615    LOGICAL,INTENT(INOUT) :: Var(:)
616
617    IF ( check_all_transfert ) THEN
618      omp_previous=omp_function(omp_rank)
619      omp_function(omp_rank)=16
620      CALL print_omp_function()
621    ENDIF
622#ifndef CPP_OMP
623    RETURN
624#else
625    CALL check_buffer_l(size(Var))
626    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
627#endif
628    IF ( check_all_transfert ) &
629        omp_function(omp_rank)=omp_previous
630  END SUBROUTINE bcast_omp_l1
631
632  SUBROUTINE bcast_omp_l2(var)
633    IMPLICIT NONE
634    LOGICAL,INTENT(INOUT) :: Var(:,:)
635
636    IF ( check_all_transfert ) THEN
637      omp_previous=omp_function(omp_rank)
638      omp_function(omp_rank)=17
639      CALL print_omp_function()
640    ENDIF
641#ifndef CPP_OMP
642    RETURN
643#else
644    CALL check_buffer_l(size(Var))
645    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
646#endif
647    IF ( check_all_transfert ) &
648        omp_function(omp_rank)=omp_previous
649  END SUBROUTINE bcast_omp_l2
650
651  SUBROUTINE bcast_omp_l3(var)
652    IMPLICIT NONE
653    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
654
655    IF ( check_all_transfert ) THEN
656      omp_previous=omp_function(omp_rank)
657      omp_function(omp_rank)=18
658      CALL print_omp_function()
659    ENDIF
660#ifndef CPP_OMP
661    RETURN
662#else
663    CALL check_buffer_l(size(Var))
664    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
665#endif
666    IF ( check_all_transfert ) &
667        omp_function(omp_rank)=omp_previous
668  END SUBROUTINE bcast_omp_l3
669
670  SUBROUTINE bcast_omp_l4(var)
671    IMPLICIT NONE
672    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
673
674    IF ( check_all_transfert ) THEN
675      omp_previous=omp_function(omp_rank)
676      omp_function(omp_rank)=19
677      CALL print_omp_function()
678    ENDIF
679#ifndef CPP_OMP
680    RETURN
681#else
682    CALL check_buffer_l(size(Var))
683    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
684#endif
685    IF ( check_all_transfert ) &
686        omp_function(omp_rank)=omp_previous
687  END SUBROUTINE bcast_omp_l4
688
689!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
690!! Definition des Scatter   --> 4D   !!
691!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
692
693  SUBROUTINE scatter_omp_i(VarIn, VarOut)
694
695    IMPLICIT NONE
696
697    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
698    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
699
700    IF ( check_all_transfert ) THEN
701      omp_previous=omp_function(omp_rank)
702      omp_function(omp_rank)=20
703      CALL print_omp_function()
704    ENDIF
705#ifndef CPP_OMP
706    VarOut(:)=VarIn(:)
707    RETURN
708#else
709    CALL check_buffer_i(size(VarIn))   
710    CALL orch_scatter_omp_igen(VarIn,Varout,1,omp_ibuffer)
711#endif   
712    IF ( check_all_transfert ) &
713        omp_function(omp_rank)=omp_previous
714  END SUBROUTINE scatter_omp_i
715
716  SUBROUTINE scatter_omp_i1(VarIn, VarOut)
717
718    IMPLICIT NONE
719
720    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
721    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
722
723    IF ( check_all_transfert ) THEN
724      omp_previous=omp_function(omp_rank)
725      omp_function(omp_rank)=21
726      CALL print_omp_function()
727    ENDIF
728#ifndef CPP_OMP
729    VarOut(:,:)=VarIn(:,:)
730    RETURN
731#else
732    CALL check_buffer_i(size(VarIn))   
733    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2),omp_ibuffer)
734#endif   
735    IF ( check_all_transfert ) &
736        omp_function(omp_rank)=omp_previous
737  END SUBROUTINE scatter_omp_i1
738
739  SUBROUTINE scatter_omp_i2(VarIn, VarOut)
740
741    IMPLICIT NONE
742
743    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
744    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
745
746    IF ( check_all_transfert ) THEN
747      omp_previous=omp_function(omp_rank)
748      omp_function(omp_rank)=22
749      CALL print_omp_function()
750    ENDIF
751#ifndef CPP_OMP
752    VarOut(:,:,:)=VarIn(:,:,:)
753    RETURN
754#else   
755    CALL check_buffer_i(size(VarIn))   
756    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3),omp_ibuffer)
757#endif
758    IF ( check_all_transfert ) &
759        omp_function(omp_rank)=omp_previous
760  END SUBROUTINE scatter_omp_i2
761
762  SUBROUTINE scatter_omp_i3(VarIn, VarOut)
763
764    IMPLICIT NONE
765
766    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
767    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
768
769    IF ( check_all_transfert ) THEN
770      omp_previous=omp_function(omp_rank)
771      omp_function(omp_rank)=23
772      CALL print_omp_function()
773    ENDIF
774#ifndef CPP_OMP
775    VarOut(:,:,:,:)=VarIn(:,:,:,:)
776    RETURN
777#else   
778    CALL check_buffer_i(size(VarIn))   
779    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_ibuffer)
780#endif 
781    IF ( check_all_transfert ) &
782        omp_function(omp_rank)=omp_previous
783  END SUBROUTINE scatter_omp_i3
784
785
786  SUBROUTINE scatter_omp_r(VarIn, VarOut)
787
788    IMPLICIT NONE
789
790    REAL,INTENT(IN),DIMENSION(:) :: VarIn
791    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
792
793    IF ( check_all_transfert ) THEN
794      omp_previous=omp_function(omp_rank)
795      omp_function(omp_rank)=24
796      CALL print_omp_function()
797    ENDIF
798#ifndef CPP_OMP
799    VarOut(:)=VarIn(:)
800    RETURN
801#else
802    CALL check_buffer_r(size(VarIn))   
803    CALL orch_scatter_omp_rgen(VarIn,Varout,1,omp_rbuffer)
804#endif   
805    IF ( check_all_transfert ) &
806        omp_function(omp_rank)=omp_previous
807  END SUBROUTINE scatter_omp_r
808
809  SUBROUTINE scatter_omp_r1(VarIn, VarOut)
810
811    IMPLICIT NONE
812
813    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
814    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
815
816    IF ( check_all_transfert ) THEN
817      omp_previous=omp_function(omp_rank)
818      omp_function(omp_rank)=25
819      CALL print_omp_function()
820    ENDIF
821#ifndef CPP_OMP
822    VarOut(:,:)=VarIn(:,:)
823    RETURN
824#else
825    CALL check_buffer_r(size(VarIn))   
826    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2),omp_rbuffer)
827#endif   
828    IF ( check_all_transfert ) &
829        omp_function(omp_rank)=omp_previous
830  END SUBROUTINE scatter_omp_r1
831
832  SUBROUTINE scatter_omp_r2(VarIn, VarOut)
833
834    IMPLICIT NONE
835
836    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
837    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
838
839    IF ( check_all_transfert ) THEN
840      omp_previous=omp_function(omp_rank)
841      omp_function(omp_rank)=26
842      CALL print_omp_function()
843    ENDIF
844#ifndef CPP_OMP
845    VarOut(:,:,:)=VarIn(:,:,:)
846    RETURN
847#else
848    CALL check_buffer_r(size(VarIn))   
849    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3),omp_rbuffer)
850#endif
851    IF ( check_all_transfert ) &
852        omp_function(omp_rank)=omp_previous
853  END SUBROUTINE scatter_omp_r2
854
855  SUBROUTINE scatter_omp_r3(VarIn, VarOut)
856
857    IMPLICIT NONE
858
859    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
860    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
861
862    IF ( check_all_transfert ) THEN
863      omp_previous=omp_function(omp_rank)
864      omp_function(omp_rank)=27
865      CALL print_omp_function()
866    ENDIF
867#ifndef CPP_OMP
868    VarOut(:,:,:,:)=VarIn(:,:,:,:)
869    RETURN
870#else
871    CALL check_buffer_r(size(VarIn))   
872    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_rbuffer)
873#endif 
874    IF ( check_all_transfert ) &
875        omp_function(omp_rank)=omp_previous
876  END SUBROUTINE scatter_omp_r3
877
878
879  SUBROUTINE scatter_omp_l(VarIn, VarOut)
880
881    IMPLICIT NONE
882    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
883    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
884
885    IF ( check_all_transfert ) THEN
886      omp_previous=omp_function(omp_rank)
887      omp_function(omp_rank)=28
888      CALL print_omp_function()
889    ENDIF
890#ifndef CPP_OMP
891    VarOut(:)=VarIn(:)
892    RETURN
893#else
894    CALL check_buffer_l(size(VarIn))   
895    CALL orch_scatter_omp_lgen(VarIn,Varout,1,omp_lbuffer)
896#endif   
897    IF ( check_all_transfert ) &
898        omp_function(omp_rank)=omp_previous
899  END SUBROUTINE scatter_omp_l
900
901  SUBROUTINE scatter_omp_l1(VarIn, VarOut)
902
903    IMPLICIT NONE
904    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
905    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
906
907    IF ( check_all_transfert ) THEN
908      omp_previous=omp_function(omp_rank)
909      omp_function(omp_rank)=29
910      CALL print_omp_function()
911    ENDIF
912#ifndef CPP_OMP
913    VarOut(:,:)=VarIn(:,:)
914    RETURN
915#else
916    CALL check_buffer_l(size(VarIn))   
917    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2),omp_lbuffer)
918#endif   
919    IF ( check_all_transfert ) &
920        omp_function(omp_rank)=omp_previous
921  END SUBROUTINE scatter_omp_l1
922
923  SUBROUTINE scatter_omp_l2(VarIn, VarOut)
924
925    IMPLICIT NONE
926
927    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
928    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
929
930    IF ( check_all_transfert ) THEN
931      omp_previous=omp_function(omp_rank)
932      omp_function(omp_rank)=30
933      CALL print_omp_function()
934    ENDIF
935#ifndef CPP_OMP
936    VarOut(:,:,:)=VarIn(:,:,:)
937    RETURN
938#else
939    CALL check_buffer_l(size(VarIn))   
940    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3),omp_lbuffer)
941#endif
942    IF ( check_all_transfert ) &
943        omp_function(omp_rank)=omp_previous
944  END SUBROUTINE scatter_omp_l2
945
946  SUBROUTINE scatter_omp_l3(VarIn, VarOut)
947
948    IMPLICIT NONE
949
950    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
951    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
952
953    IF ( check_all_transfert ) THEN
954      omp_previous=omp_function(omp_rank)
955      omp_function(omp_rank)=31
956      CALL print_omp_function()
957    ENDIF
958#ifndef CPP_OMP
959    VarOut(:,:,:,:)=VarIn(:,:,:,:)
960    RETURN
961#else
962    CALL check_buffer_l(size(VarIn))   
963    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_lbuffer)
964#endif 
965    IF ( check_all_transfert ) &
966        omp_function(omp_rank)=omp_previous
967  END SUBROUTINE scatter_omp_l3
968
969!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
970!! Definition des Gather   --> 4D   !!
971!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
972
973  SUBROUTINE gather_omp_i0(VarIn, VarOut)
974
975    IMPLICIT NONE
976
977    INTEGER,INTENT(IN)               :: VarIn
978    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
979
980    IF ( check_all_transfert ) THEN
981      omp_previous=omp_function(omp_rank)
982      omp_function(omp_rank)=32
983      CALL print_omp_function()
984    ENDIF
985#ifndef CPP_OMP
986    VarOut(:)=VarIn
987    RETURN
988#else
989    CALL check_buffer_i(size(VarOut))   
990    CALL orch_gather_omp_simple_igen(VarIn,Varout,omp_ibuffer)
991#endif
992    IF ( check_all_transfert ) &
993        omp_function(omp_rank)=omp_previous
994  END SUBROUTINE gather_omp_i0
995
996!!!!! --> Les entiers
997
998  SUBROUTINE gather_omp_i(VarIn, VarOut)
999
1000    IMPLICIT NONE
1001
1002    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
1003    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
1004
1005    IF ( check_all_transfert ) THEN
1006      omp_previous=omp_function(omp_rank)
1007      omp_function(omp_rank)=33
1008      CALL print_omp_function()
1009    ENDIF
1010#ifndef CPP_OMP
1011    VarOut(:)=VarIn(:)
1012    RETURN
1013#else
1014    CALL check_buffer_i(size(VarOut))   
1015    CALL orch_gather_omp_igen(VarIn,Varout,1,omp_ibuffer)
1016#endif
1017    IF ( check_all_transfert ) &
1018        omp_function(omp_rank)=omp_previous
1019  END SUBROUTINE gather_omp_i
1020
1021
1022  SUBROUTINE gather_omp_i1(VarIn, VarOut)
1023
1024    IMPLICIT NONE
1025
1026    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
1027    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
1028
1029    IF ( check_all_transfert ) THEN
1030      omp_previous=omp_function(omp_rank)
1031      omp_function(omp_rank)=34
1032      CALL print_omp_function()
1033    ENDIF
1034#ifndef CPP_OMP
1035    VarOut(:,:)=VarIn(:,:)
1036    RETURN
1037#else
1038    CALL check_buffer_i(size(VarOut))   
1039    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2),omp_ibuffer)
1040#endif   
1041    IF ( check_all_transfert ) &
1042        omp_function(omp_rank)=omp_previous
1043  END SUBROUTINE gather_omp_i1
1044
1045
1046  SUBROUTINE gather_omp_i2(VarIn, VarOut)
1047
1048    IMPLICIT NONE
1049
1050    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1051    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1052
1053    IF ( check_all_transfert ) THEN
1054      omp_previous=omp_function(omp_rank)
1055      omp_function(omp_rank)=35
1056      CALL print_omp_function()
1057    ENDIF
1058#ifndef CPP_OMP
1059    VarOut(:,:,:)=VarIn(:,:,:)
1060    RETURN
1061#else
1062    CALL check_buffer_i(size(VarOut))   
1063    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_ibuffer)
1064#endif   
1065    IF ( check_all_transfert ) &
1066        omp_function(omp_rank)=omp_previous
1067  END SUBROUTINE gather_omp_i2
1068
1069
1070  SUBROUTINE gather_omp_i3(VarIn, VarOut)
1071
1072    IMPLICIT NONE
1073
1074    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1075    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1076
1077    IF ( check_all_transfert ) THEN
1078      omp_previous=omp_function(omp_rank)
1079      omp_function(omp_rank)=36
1080      CALL print_omp_function()
1081    ENDIF
1082#ifndef CPP_OMP
1083    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1084    RETURN
1085#else
1086    CALL check_buffer_i(size(VarOut))   
1087    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_ibuffer)
1088#endif   
1089    IF ( check_all_transfert ) &
1090        omp_function(omp_rank)=omp_previous
1091  END SUBROUTINE gather_omp_i3
1092
1093  SUBROUTINE gather_omp_i4(VarIn, VarOut)
1094
1095    IMPLICIT NONE
1096
1097    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1098    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1099
1100    IF ( check_all_transfert ) THEN
1101      omp_previous=omp_function(omp_rank)
1102      omp_function(omp_rank)=36
1103      CALL print_omp_function()
1104    ENDIF
1105#ifndef CPP_OMP
1106    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1107    RETURN
1108#else
1109    CALL check_buffer_i(size(VarOut))   
1110    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5),omp_ibuffer)
1111#endif   
1112    IF ( check_all_transfert ) &
1113        omp_function(omp_rank)=omp_previous
1114  END SUBROUTINE gather_omp_i4
1115
1116  SUBROUTINE gather_omp_i5(VarIn, VarOut)
1117
1118    IMPLICIT NONE
1119
1120    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:,:) :: VarIn
1121    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:,:) :: VarOut
1122
1123    IF ( check_all_transfert ) THEN
1124      omp_previous=omp_function(omp_rank)
1125      omp_function(omp_rank)=36
1126      CALL print_omp_function()
1127    ENDIF
1128#ifndef CPP_OMP
1129    VarOut(:,:,:,:,:,:)=VarIn(:,:,:,:,:,:)
1130    RETURN
1131#else
1132    CALL check_buffer_i(size(VarOut))   
1133    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)*SIZE(VarIn,6),omp_ibuffer)
1134#endif   
1135    IF ( check_all_transfert ) &
1136        omp_function(omp_rank)=omp_previous
1137  END SUBROUTINE gather_omp_i5
1138
1139!!!!! --> Les reels
1140
1141  SUBROUTINE gather_omp_r0(VarIn, VarOut)
1142
1143    IMPLICIT NONE
1144
1145    REAL,INTENT(IN)               :: VarIn
1146    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
1147
1148    IF ( check_all_transfert ) THEN
1149      omp_previous=omp_function(omp_rank)
1150      omp_function(omp_rank)=37
1151      CALL print_omp_function()
1152    ENDIF
1153#ifndef CPP_OMP
1154    VarOut(:)=VarIn
1155    RETURN
1156#else
1157    CALL check_buffer_r(size(VarOut))   
1158    CALL orch_gather_omp_simple_rgen(VarIn,Varout,omp_rbuffer)
1159#endif
1160    IF ( check_all_transfert ) &
1161        omp_function(omp_rank)=omp_previous
1162  END SUBROUTINE gather_omp_r0
1163
1164  SUBROUTINE gather_omp_r(VarIn, VarOut)
1165
1166    IMPLICIT NONE
1167
1168    REAL,INTENT(IN),DIMENSION(:) :: VarIn
1169    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
1170
1171    IF ( check_all_transfert ) THEN
1172      omp_previous=omp_function(omp_rank)
1173      omp_function(omp_rank)=38
1174      CALL print_omp_function()
1175    ENDIF
1176#ifndef CPP_OMP
1177    VarOut(:)=VarIn(:)
1178    RETURN
1179#else
1180    CALL check_buffer_r(size(VarOut))   
1181    CALL orch_gather_omp_rgen(VarIn,Varout,1,omp_rbuffer)
1182#endif   
1183    IF ( check_all_transfert ) &
1184        omp_function(omp_rank)=omp_previous
1185  END SUBROUTINE gather_omp_r
1186
1187
1188  SUBROUTINE gather_omp_r1(VarIn, VarOut)
1189
1190    IMPLICIT NONE
1191
1192    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1193    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1194
1195    IF ( check_all_transfert ) THEN
1196      omp_previous=omp_function(omp_rank)
1197      omp_function(omp_rank)=39
1198      CALL print_omp_function()
1199    ENDIF
1200#ifndef CPP_OMP
1201    VarOut(:,:)=VarIn(:,:)
1202    RETURN
1203#else
1204    CALL check_buffer_r(size(VarOut))   
1205    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2),omp_rbuffer)
1206#endif   
1207    IF ( check_all_transfert ) &
1208        omp_function(omp_rank)=omp_previous
1209  END SUBROUTINE gather_omp_r1
1210
1211
1212  SUBROUTINE gather_omp_r2(VarIn, VarOut)
1213
1214    IMPLICIT NONE
1215
1216    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1217    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1218
1219    IF ( check_all_transfert ) THEN
1220      omp_previous=omp_function(omp_rank)
1221      omp_function(omp_rank)=40
1222      CALL print_omp_function()
1223    ENDIF
1224#ifndef CPP_OMP
1225    VarOut(:,:,:)=VarIn(:,:,:)
1226    RETURN
1227#else
1228    CALL check_buffer_r(size(VarOut))   
1229    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_rbuffer)
1230#endif   
1231    IF ( check_all_transfert ) &
1232        omp_function(omp_rank)=omp_previous
1233  END SUBROUTINE gather_omp_r2
1234
1235
1236  SUBROUTINE gather_omp_r3(VarIn, VarOut)
1237
1238    IMPLICIT NONE
1239
1240    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1241    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1242
1243    IF ( check_all_transfert ) THEN
1244      omp_previous=omp_function(omp_rank)
1245      omp_function(omp_rank)=41
1246      CALL print_omp_function()
1247    ENDIF
1248#ifndef CPP_OMP
1249    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1250    RETURN
1251#else
1252    CALL check_buffer_r(size(VarOut))   
1253    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_rbuffer)
1254#endif   
1255    IF ( check_all_transfert ) &
1256        omp_function(omp_rank)=omp_previous
1257  END SUBROUTINE gather_omp_r3
1258
1259
1260  SUBROUTINE gather_omp_r4(VarIn, VarOut)
1261
1262    IMPLICIT NONE
1263
1264    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1265    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1266
1267    IF ( check_all_transfert ) THEN
1268      omp_previous=omp_function(omp_rank)
1269      omp_function(omp_rank)=41
1270      CALL print_omp_function()
1271    ENDIF
1272#ifndef CPP_OMP
1273    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1274    RETURN
1275#else
1276    CALL check_buffer_r(size(VarOut))   
1277    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5),omp_rbuffer)
1278#endif   
1279    IF ( check_all_transfert ) &
1280        omp_function(omp_rank)=omp_previous
1281  END SUBROUTINE gather_omp_r4
1282
1283
1284  SUBROUTINE gather_omp_r5(VarIn, VarOut)
1285
1286    IMPLICIT NONE
1287
1288    REAL,INTENT(IN),DIMENSION(:,:,:,:,:,:) :: VarIn
1289    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:,:) :: VarOut
1290
1291    IF ( check_all_transfert ) THEN
1292      omp_previous=omp_function(omp_rank)
1293      omp_function(omp_rank)=41
1294      CALL print_omp_function()
1295    ENDIF
1296#ifndef CPP_OMP
1297    VarOut(:,:,:,:,:,:)=VarIn(:,:,:,:,:,:)
1298    RETURN
1299#else
1300    CALL check_buffer_r(size(VarOut))   
1301    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)*SIZE(VarIn,6),omp_rbuffer)
1302#endif   
1303    IF ( check_all_transfert ) &
1304        omp_function(omp_rank)=omp_previous
1305  END SUBROUTINE gather_omp_r5
1306
1307!!!!! --> Les booleen
1308
1309  SUBROUTINE gather_omp_l0(VarIn, VarOut)
1310
1311    IMPLICIT NONE
1312
1313    LOGICAL,INTENT(IN)               :: VarIn
1314    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
1315
1316    IF ( check_all_transfert ) THEN
1317      omp_previous=omp_function(omp_rank)
1318      omp_function(omp_rank)=42
1319      CALL print_omp_function()
1320    ENDIF
1321#ifndef CPP_OMP
1322    VarOut(:)=VarIn
1323    RETURN
1324#else
1325    CALL check_buffer_l(size(VarOut))   
1326    CALL orch_gather_omp_simple_lgen(VarIn,Varout,omp_lbuffer)
1327#endif
1328    IF ( check_all_transfert ) &
1329        omp_function(omp_rank)=omp_previous
1330  END SUBROUTINE gather_omp_l0
1331
1332  SUBROUTINE gather_omp_l(VarIn, VarOut)
1333
1334    IMPLICIT NONE
1335
1336    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
1337    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
1338
1339    IF ( check_all_transfert ) THEN
1340      omp_previous=omp_function(omp_rank)
1341      omp_function(omp_rank)=43
1342      CALL print_omp_function()
1343    ENDIF
1344#ifndef CPP_OMP
1345    VarOut(:)=VarIn(:)
1346    RETURN
1347#else
1348    CALL check_buffer_l(size(VarOut))   
1349    CALL orch_gather_omp_lgen(VarIn,Varout,1,omp_lbuffer)
1350#endif   
1351    IF ( check_all_transfert ) &
1352        omp_function(omp_rank)=omp_previous
1353  END SUBROUTINE gather_omp_l
1354
1355
1356  SUBROUTINE gather_omp_l1(VarIn, VarOut)
1357
1358    IMPLICIT NONE
1359
1360    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1361    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1362
1363    IF ( check_all_transfert ) THEN
1364      omp_previous=omp_function(omp_rank)
1365      omp_function(omp_rank)=44
1366      CALL print_omp_function()
1367    ENDIF
1368#ifndef CPP_OMP
1369    VarOut(:,:)=VarIn(:,:)
1370    RETURN
1371#else
1372    CALL check_buffer_l(size(VarOut))   
1373    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2),omp_lbuffer)
1374#endif   
1375    IF ( check_all_transfert ) &
1376        omp_function(omp_rank)=omp_previous
1377  END SUBROUTINE gather_omp_l1
1378
1379
1380  SUBROUTINE gather_omp_l2(VarIn, VarOut)
1381
1382    IMPLICIT NONE
1383
1384    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1385    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1386
1387    IF ( check_all_transfert ) THEN
1388      omp_previous=omp_function(omp_rank)
1389      omp_function(omp_rank)=45
1390      CALL print_omp_function()
1391    ENDIF
1392#ifndef CPP_OMP
1393    VarOut(:,:,:)=VarIn(:,:,:)
1394    RETURN
1395#else
1396    CALL check_buffer_l(size(VarOut))   
1397    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_lbuffer)
1398#endif   
1399    IF ( check_all_transfert ) &
1400        omp_function(omp_rank)=omp_previous
1401  END SUBROUTINE gather_omp_l2
1402
1403
1404  SUBROUTINE gather_omp_l3(VarIn, VarOut)
1405
1406    IMPLICIT NONE
1407
1408    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1409    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1410
1411    IF ( check_all_transfert ) THEN
1412      omp_previous=omp_function(omp_rank)
1413      omp_function(omp_rank)=46
1414      CALL print_omp_function()
1415    ENDIF
1416#ifndef CPP_OMP
1417    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1418    RETURN
1419#else
1420    CALL check_buffer_l(size(VarOut))   
1421    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_lbuffer)
1422#endif   
1423    IF ( check_all_transfert ) &
1424        omp_function(omp_rank)=omp_previous
1425  END SUBROUTINE gather_omp_l3
1426
1427
1428  SUBROUTINE gather_omp_l4(VarIn, VarOut)
1429
1430    IMPLICIT NONE
1431
1432    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1433    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1434
1435    IF ( check_all_transfert ) THEN
1436      omp_previous=omp_function(omp_rank)
1437      omp_function(omp_rank)=46
1438      CALL print_omp_function()
1439    ENDIF
1440#ifndef CPP_OMP
1441    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1442    RETURN
1443#else
1444    CALL check_buffer_l(size(VarOut))   
1445    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5),omp_lbuffer)
1446#endif   
1447    IF ( check_all_transfert ) &
1448        omp_function(omp_rank)=omp_previous
1449  END SUBROUTINE gather_omp_l4
1450
1451
1452  SUBROUTINE gather_omp_l5(VarIn, VarOut)
1453
1454    IMPLICIT NONE
1455
1456    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:,:) :: VarIn
1457    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:,:) :: VarOut
1458
1459    IF ( check_all_transfert ) THEN
1460      omp_previous=omp_function(omp_rank)
1461      omp_function(omp_rank)=46
1462      CALL print_omp_function()
1463    ENDIF
1464#ifndef CPP_OMP
1465    VarOut(:,:,:,:,:,:)=VarIn(:,:,:,:,:,:)
1466    RETURN
1467#else
1468    CALL check_buffer_l(size(VarOut))   
1469    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)*SIZE(VarIn,6),omp_lbuffer)
1470#endif   
1471    IF ( check_all_transfert ) &
1472        omp_function(omp_rank)=omp_previous
1473  END SUBROUTINE gather_omp_l5
1474
1475
1476!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1477!! Definition des reduce_sum   --> 4D   !!
1478!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1479
1480  SUBROUTINE reduce_sum_omp_i(VarIn, VarOut)
1481
1482    IMPLICIT NONE
1483
1484    INTEGER,INTENT(IN)  :: VarIn
1485    INTEGER,INTENT(OUT) :: VarOut
1486
1487    IF ( check_all_transfert ) THEN
1488      omp_previous=omp_function(omp_rank)
1489      omp_function(omp_rank)=47
1490      CALL print_omp_function()
1491    ENDIF
1492#ifndef CPP_OMP
1493    VarOut=VarIn
1494    RETURN
1495#else
1496    CALL check_buffer_i(1)   
1497    CALL orch_reduce_sum_omp_igen(VarIn,Varout,1,omp_ibuffer)
1498#endif 
1499    IF ( check_all_transfert ) &
1500        omp_function(omp_rank)=omp_previous
1501  END SUBROUTINE reduce_sum_omp_i
1502
1503  SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut)
1504
1505    IMPLICIT NONE
1506
1507    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
1508    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
1509
1510    IF ( check_all_transfert ) THEN
1511      omp_previous=omp_function(omp_rank)
1512      omp_function(omp_rank)=48
1513      CALL print_omp_function()
1514    ENDIF
1515#ifndef CPP_OMP
1516    VarOut(:)=VarIn(:)
1517    RETURN
1518#else
1519    CALL check_buffer_i(size(VarIn))   
1520    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
1521#endif   
1522    IF ( check_all_transfert ) &
1523        omp_function(omp_rank)=omp_previous
1524  END SUBROUTINE reduce_sum_omp_i1
1525
1526  SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut)
1527    IMPLICIT NONE
1528
1529    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
1530    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
1531
1532    IF ( check_all_transfert ) THEN
1533      omp_previous=omp_function(omp_rank)
1534      omp_function(omp_rank)=49
1535      CALL print_omp_function()
1536    ENDIF
1537#ifndef CPP_OMP
1538    VarOut(:,:)=VarIn(:,:)
1539    RETURN
1540#else
1541    CALL check_buffer_i(size(VarIn))   
1542    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
1543#endif 
1544    IF ( check_all_transfert ) &
1545        omp_function(omp_rank)=omp_previous
1546  END SUBROUTINE reduce_sum_omp_i2
1547
1548  SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut)
1549    IMPLICIT NONE
1550
1551    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
1552    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1553
1554    IF ( check_all_transfert ) THEN
1555      omp_previous=omp_function(omp_rank)
1556      omp_function(omp_rank)=50
1557      CALL print_omp_function()
1558    ENDIF
1559#ifndef CPP_OMP
1560    VarOut(:,:,:)=VarIn(:,:,:)
1561    RETURN
1562#else
1563    CALL check_buffer_i(size(VarIn))   
1564    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
1565#endif 
1566    IF ( check_all_transfert ) &
1567        omp_function(omp_rank)=omp_previous
1568  END SUBROUTINE reduce_sum_omp_i3
1569
1570  SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut)
1571    IMPLICIT NONE
1572
1573    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
1574    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1575
1576    IF ( check_all_transfert ) THEN
1577      omp_previous=omp_function(omp_rank)
1578      omp_function(omp_rank)=51
1579      CALL print_omp_function()
1580    ENDIF
1581#ifndef CPP_OMP
1582    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1583    RETURN
1584#else
1585    CALL check_buffer_i(size(VarIn))   
1586    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
1587#endif 
1588    IF ( check_all_transfert ) &
1589        omp_function(omp_rank)=omp_previous
1590  END SUBROUTINE reduce_sum_omp_i4
1591
1592
1593  SUBROUTINE reduce_sum_omp_r(VarIn, VarOut)
1594    IMPLICIT NONE
1595
1596    REAL,INTENT(IN)  :: VarIn
1597    REAL,INTENT(OUT) :: VarOut
1598
1599    IF ( check_all_transfert ) THEN
1600      omp_previous=omp_function(omp_rank)
1601      omp_function(omp_rank)=52
1602      CALL print_omp_function()
1603    ENDIF
1604#ifndef CPP_OMP
1605    VarOut=VarIn
1606    RETURN
1607#else
1608    CALL check_buffer_r(1)   
1609    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,1,omp_rbuffer)
1610#endif 
1611    IF ( check_all_transfert ) &
1612        omp_function(omp_rank)=omp_previous
1613  END SUBROUTINE reduce_sum_omp_r
1614
1615  SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut)
1616    IMPLICIT NONE
1617
1618    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
1619    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
1620
1621    IF ( check_all_transfert ) THEN
1622      omp_previous=omp_function(omp_rank)
1623      omp_function(omp_rank)=53
1624      CALL print_omp_function()
1625    ENDIF
1626#ifndef CPP_OMP
1627    VarOut(:)=VarIn(:)
1628    RETURN
1629#else
1630    CALL check_buffer_r(size(VarIn))   
1631    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
1632#endif   
1633    IF ( check_all_transfert ) &
1634        omp_function(omp_rank)=omp_previous
1635  END SUBROUTINE reduce_sum_omp_r1
1636
1637  SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut)
1638    IMPLICIT NONE
1639
1640    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
1641    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1642
1643    IF ( check_all_transfert ) THEN
1644      omp_previous=omp_function(omp_rank)
1645      omp_function(omp_rank)=54
1646      CALL print_omp_function()
1647    ENDIF
1648#ifndef CPP_OMP
1649    VarOut(:,:)=VarIn(:,:)
1650    RETURN
1651#else
1652    CALL check_buffer_r(size(VarIn))   
1653    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
1654#endif 
1655    IF ( check_all_transfert ) &
1656        omp_function(omp_rank)=omp_previous
1657  END SUBROUTINE reduce_sum_omp_r2
1658
1659  SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut)
1660    IMPLICIT NONE
1661
1662    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
1663    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1664
1665    IF ( check_all_transfert ) THEN
1666      omp_previous=omp_function(omp_rank)
1667      omp_function(omp_rank)=55
1668      CALL print_omp_function()
1669    ENDIF
1670#ifndef CPP_OMP
1671    VarOut(:,:,:)=VarIn(:,:,:)
1672    RETURN
1673#else
1674    CALL check_buffer_r(size(VarIn))   
1675    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
1676#endif 
1677    IF ( check_all_transfert ) &
1678        omp_function(omp_rank)=omp_previous
1679  END SUBROUTINE reduce_sum_omp_r3
1680
1681  SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut)
1682    IMPLICIT NONE
1683
1684    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
1685    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1686
1687    IF ( check_all_transfert ) THEN
1688      omp_previous=omp_function(omp_rank)
1689      omp_function(omp_rank)=56
1690      CALL print_omp_function()
1691    ENDIF
1692#ifndef CPP_OMP
1693    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1694    RETURN
1695#else
1696    CALL check_buffer_r(size(VarIn))   
1697    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
1698#endif 
1699    IF ( check_all_transfert ) &
1700        omp_function(omp_rank)=omp_previous
1701  END SUBROUTINE reduce_sum_omp_r4
1702
1703END MODULE mod_orchidee_omp_transfert
1704
1705!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1706
1707#ifdef CPP_OMP
1708
1709!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1710!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
1711!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1712
1713SUBROUTINE orch_bcast_omp_cgen(Var,Nb,Buff)
1714  USE mod_orchidee_omp_data
1715  USE mod_orchidee_omp_transfert, ONLY : size_min
1716
1717  IMPLICIT NONE
1718  INTEGER,INTENT(IN)              :: Nb 
1719  CHARACTER(LEN=*),DIMENSION(Nb),INTENT(INOUT) :: Var
1720  CHARACTER(LEN=*),DIMENSION(Nb),INTENT(INOUT) :: Buff
1721  INTEGER :: i
1722  LOGICAL, PARAMETER :: check=.FALSE.
1723
1724  IF ( check_all_transfert ) THEN
1725    omp_previous=omp_function(omp_rank)
1726    omp_function(omp_rank)=57
1727    CALL print_omp_function()
1728  ENDIF
1729
1730  IF (check) THEN
1731     IF (numout_omp > 0) THEN
1732        WRITE(numout_omp,*) "orch_bcast_omp_cgen before bcast Var",Var
1733     ELSE
1734        WRITE(*,*) "orch_bcast_omp_cgen before bcast Var",Var
1735     ENDIF
1736  ENDIF
1737
1738  IF (is_omp_root) THEN
1739     IF ( len(Var) > size_min ) &
1740          CALL ipslerr (3,'orch_bcast_omp_cgen', &
1741          &          'Error with omp_cbuffer.', 'len(Var) > size_min', &
1742          &          '(Increase size_min in mod_orchidee_omp_transfert.)')
1743     DO i=1,Nb
1744        Buff(i)=TRIM(Var(i))
1745     ENDDO
1746  ENDIF
1747
1748  CALL barrier2_omp()
1749
1750  DO i=1,Nb
1751     Var(i)=Buff(i)
1752  ENDDO
1753  CALL barrier2_omp()
1754     
1755  IF (check) THEN
1756     IF (numout_omp > 0) THEN
1757        WRITE(numout_omp,*) "orch_bcast_omp_cgen after bcast Var",Var
1758     ELSE
1759        WRITE(*,*) "orch_bcast_omp_cgen after bcast Var",Var
1760     ENDIF
1761  ENDIF
1762
1763  IF ( check_all_transfert ) &
1764      omp_function(omp_rank)=omp_previous
1765END SUBROUTINE orch_bcast_omp_cgen
1766
1767
1768
1769SUBROUTINE orch_bcast_omp_igen(Var,Nb,Buff)
1770  USE mod_orchidee_omp_data
1771
1772  IMPLICIT NONE
1773
1774  INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
1775  INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
1776  INTEGER,INTENT(IN) :: Nb 
1777
1778  INTEGER :: i
1779
1780  IF ( check_all_transfert ) THEN
1781    omp_previous=omp_function(omp_rank)
1782    omp_function(omp_rank)=58
1783    CALL print_omp_function()
1784  ENDIF
1785
1786  IF (is_omp_root) THEN
1787     DO i=1,Nb
1788        Buff(i)=Var(i)
1789     ENDDO
1790  ENDIF
1791
1792  CALL barrier2_omp()
1793
1794
1795  DO i=1,Nb
1796     Var(i)=Buff(i)
1797  ENDDO
1798
1799  CALL barrier2_omp()
1800
1801  IF ( check_all_transfert ) &
1802      omp_function(omp_rank)=omp_previous
1803END SUBROUTINE orch_bcast_omp_igen
1804
1805
1806
1807SUBROUTINE orch_bcast_omp_rgen(Var,Nb,Buff)
1808  USE mod_orchidee_omp_data
1809
1810  IMPLICIT NONE
1811
1812  REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
1813  REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
1814  INTEGER,INTENT(IN) :: Nb
1815
1816  INTEGER :: i
1817
1818  IF ( check_all_transfert ) THEN
1819    omp_previous=omp_function(omp_rank)
1820    omp_function(omp_rank)=59
1821    CALL print_omp_function()
1822  ENDIF
1823
1824  IF (is_omp_root) THEN
1825     DO i=1,Nb
1826        Buff(i)=Var(i)
1827     ENDDO
1828  ENDIF
1829
1830  CALL barrier2_omp()
1831
1832  DO i=1,Nb
1833     Var(i)=Buff(i)
1834  ENDDO
1835
1836  CALL barrier2_omp()
1837
1838  IF ( check_all_transfert ) &
1839      omp_function(omp_rank)=omp_previous
1840END SUBROUTINE orch_bcast_omp_rgen
1841
1842
1843
1844SUBROUTINE orch_bcast_omp_lgen(Var,Nb,Buff)
1845  USE mod_orchidee_omp_data
1846
1847  IMPLICIT NONE
1848
1849  LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
1850  LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
1851  INTEGER,INTENT(IN) :: Nb
1852
1853  INTEGER :: i
1854
1855  IF ( check_all_transfert ) THEN
1856    omp_previous=omp_function(omp_rank)
1857    omp_function(omp_rank)=60
1858    CALL print_omp_function()
1859  ENDIF
1860
1861  IF (is_omp_root) THEN
1862     DO i=1,Nb
1863        Buff(i)=Var(i)
1864     ENDDO
1865  ENDIF
1866
1867  CALL barrier2_omp()
1868
1869  DO i=1,Nb
1870     Var(i)=Buff(i)
1871  ENDDO
1872
1873  CALL barrier2_omp()
1874
1875  IF ( check_all_transfert ) &
1876      omp_function(omp_rank)=omp_previous
1877END SUBROUTINE orch_bcast_omp_lgen
1878
1879
1880
1881SUBROUTINE orch_scatter_omp_igen(VarIn,VarOut,dimsize,Buff)
1882  USE mod_orchidee_omp_data
1883  USE mod_orchidee_para_var, ONLY : nbp_mpi 
1884  IMPLICIT NONE
1885
1886  INTEGER,INTENT(IN) :: dimsize
1887  INTEGER,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
1888  INTEGER,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
1889  INTEGER,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
1890
1891  INTEGER :: i,ij
1892
1893  IF ( check_all_transfert ) THEN
1894    omp_previous=omp_function(omp_rank)
1895    omp_function(omp_rank)=61
1896    CALL print_omp_function()
1897  ENDIF
1898
1899  IF (is_omp_root) THEN
1900     DO i=1,dimsize
1901        DO ij=1,nbp_mpi
1902           Buff(ij,i)=VarIn(ij,i)
1903        ENDDO
1904     ENDDO
1905  ENDIF
1906
1907  CALL barrier2_omp()
1908
1909  DO i=1,dimsize
1910     DO ij=1,nbp_omp
1911        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
1912     ENDDO
1913  ENDDO
1914
1915  CALL barrier2_omp()
1916
1917  IF ( check_all_transfert ) &
1918      omp_function(omp_rank)=omp_previous
1919END SUBROUTINE orch_scatter_omp_igen
1920
1921
1922SUBROUTINE orch_scatter_omp_rgen(VarIn,VarOut,dimsize,Buff)
1923  USE mod_orchidee_omp_data
1924
1925  USE mod_orchidee_para_var, ONLY : nbp_mpi 
1926  IMPLICIT NONE
1927
1928  INTEGER,INTENT(IN) :: dimsize
1929  REAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
1930  REAL,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
1931  REAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
1932
1933  INTEGER :: i,ij
1934
1935  IF ( check_all_transfert ) THEN
1936    omp_previous=omp_function(omp_rank)
1937    omp_function(omp_rank)=62
1938    CALL print_omp_function()
1939  ENDIF
1940
1941  IF (is_omp_root) THEN
1942     DO i=1,dimsize
1943        DO ij=1,nbp_mpi
1944           Buff(ij,i)=VarIn(ij,i)
1945        ENDDO
1946     ENDDO
1947  ENDIF
1948
1949  CALL barrier2_omp()
1950
1951  DO i=1,dimsize
1952     DO ij=1,nbp_omp
1953        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
1954     ENDDO
1955  ENDDO
1956
1957  CALL barrier2_omp()
1958
1959  IF ( check_all_transfert ) &
1960      omp_function(omp_rank)=omp_previous
1961END SUBROUTINE orch_scatter_omp_rgen
1962
1963
1964SUBROUTINE orch_scatter_omp_lgen(VarIn,VarOut,dimsize,Buff)
1965  USE mod_orchidee_omp_data
1966
1967  USE mod_orchidee_para_var, ONLY : nbp_mpi 
1968  IMPLICIT NONE
1969
1970  INTEGER,INTENT(IN) :: dimsize
1971  LOGICAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
1972  LOGICAL,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
1973  LOGICAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
1974
1975  INTEGER :: i,ij
1976
1977  IF ( check_all_transfert ) THEN
1978    omp_previous=omp_function(omp_rank)
1979    omp_function(omp_rank)=63
1980    CALL print_omp_function()
1981  ENDIF
1982
1983  IF (is_omp_root) THEN
1984     DO i=1,dimsize
1985        DO ij=1,nbp_mpi
1986           Buff(ij,i)=VarIn(ij,i)
1987        ENDDO
1988     ENDDO
1989  ENDIF
1990
1991  CALL barrier2_omp()
1992
1993  DO i=1,dimsize
1994     DO ij=1,nbp_omp
1995        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
1996     ENDDO
1997  ENDDO
1998
1999  CALL barrier2_omp()
2000
2001  IF ( check_all_transfert ) &
2002      omp_function(omp_rank)=omp_previous
2003END SUBROUTINE orch_scatter_omp_lgen
2004
2005
2006
2007SUBROUTINE orch_gather_omp_simple_igen(VarIn,VarOut,Buff)
2008  USE mod_orchidee_omp_data
2009
2010  IMPLICIT NONE
2011
2012  INTEGER,INTENT(IN)                            :: VarIn
2013  INTEGER,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
2014  INTEGER,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
2015
2016  Buff(omp_rank)=VarIn
2017
2018  IF ( check_all_transfert ) THEN
2019    omp_previous=omp_function(omp_rank)
2020    omp_function(omp_rank)=64
2021    CALL print_omp_function()
2022  ENDIF
2023
2024  CALL barrier2_omp()
2025
2026  IF (is_omp_root) THEN
2027     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
2028  ENDIF
2029
2030  CALL barrier2_omp()
2031
2032  IF ( check_all_transfert ) &
2033      omp_function(omp_rank)=omp_previous
2034END SUBROUTINE orch_gather_omp_simple_igen
2035
2036SUBROUTINE orch_gather_omp_igen(VarIn,VarOut,dimsize,Buff)
2037  USE mod_orchidee_omp_data
2038
2039  USE mod_orchidee_para_var, ONLY : nbp_mpi 
2040  IMPLICIT NONE
2041
2042  INTEGER,INTENT(IN) :: dimsize
2043  INTEGER,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
2044  INTEGER,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
2045  INTEGER,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
2046
2047  INTEGER :: i,ij
2048
2049  IF ( check_all_transfert ) THEN
2050    omp_previous=omp_function(omp_rank)
2051    omp_function(omp_rank)=65
2052    CALL print_omp_function()
2053  ENDIF
2054
2055  DO i=1,dimsize
2056     DO ij=1,nbp_omp
2057        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
2058     ENDDO
2059  ENDDO
2060
2061  CALL barrier2_omp()
2062
2063  IF (is_omp_root) THEN
2064     DO i=1,dimsize
2065        DO ij=1,nbp_mpi
2066           VarOut(ij,i)=Buff(ij,i)
2067        ENDDO
2068     ENDDO
2069  ENDIF
2070
2071  CALL barrier2_omp()
2072
2073  IF ( check_all_transfert ) &
2074      omp_function(omp_rank)=omp_previous
2075END SUBROUTINE orch_gather_omp_igen
2076
2077
2078SUBROUTINE orch_gather_omp_simple_rgen(VarIn,VarOut,Buff)
2079  USE mod_orchidee_omp_data
2080
2081  IMPLICIT NONE
2082
2083  REAL,INTENT(IN)                            :: VarIn
2084  REAL,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
2085  REAL,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
2086
2087  IF ( check_all_transfert ) THEN
2088    omp_previous=omp_function(omp_rank)
2089    omp_function(omp_rank)=66
2090    CALL print_omp_function()
2091  ENDIF
2092
2093  Buff(omp_rank)=VarIn
2094
2095  CALL barrier2_omp()
2096
2097  IF (is_omp_root) THEN
2098     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
2099  ENDIF
2100
2101  CALL barrier2_omp()
2102
2103  IF ( check_all_transfert ) &
2104      omp_function(omp_rank)=omp_previous
2105END SUBROUTINE orch_gather_omp_simple_rgen
2106
2107
2108SUBROUTINE orch_gather_omp_rgen(VarIn,VarOut,dimsize,Buff)
2109  USE mod_orchidee_omp_data
2110
2111  USE mod_orchidee_para_var, ONLY : nbp_mpi 
2112  IMPLICIT NONE
2113
2114  INTEGER,INTENT(IN) :: dimsize
2115  REAL,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
2116  REAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
2117  REAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
2118
2119  INTEGER :: i,ij
2120
2121  IF ( check_all_transfert ) THEN
2122    omp_previous=omp_function(omp_rank)
2123    omp_function(omp_rank)=67
2124    CALL print_omp_function()
2125  ENDIF
2126
2127  DO i=1,dimsize
2128     DO ij=1,nbp_omp
2129        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
2130     ENDDO
2131  ENDDO
2132
2133  CALL barrier2_omp()
2134
2135  IF (is_omp_root) THEN
2136     DO i=1,dimsize
2137        DO ij=1,nbp_mpi
2138           VarOut(ij,i)=Buff(ij,i)
2139        ENDDO
2140     ENDDO
2141  ENDIF
2142
2143  CALL barrier2_omp()
2144
2145  IF ( check_all_transfert ) &
2146      omp_function(omp_rank)=omp_previous
2147END SUBROUTINE orch_gather_omp_rgen
2148
2149
2150SUBROUTINE orch_gather_omp_simple_lgen(VarIn,VarOut,Buff)
2151  USE mod_orchidee_omp_data
2152
2153  IMPLICIT NONE
2154
2155  LOGICAL,INTENT(IN)                            :: VarIn
2156  LOGICAL,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
2157  LOGICAL,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
2158
2159  IF ( check_all_transfert ) THEN
2160    omp_previous=omp_function(omp_rank)
2161    omp_function(omp_rank)=68
2162    CALL print_omp_function()
2163  ENDIF
2164
2165  Buff(omp_rank)=VarIn
2166
2167  CALL barrier2_omp()
2168
2169  IF (is_omp_root) THEN
2170     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
2171  ENDIF
2172
2173  CALL barrier2_omp()
2174
2175  IF ( check_all_transfert ) &
2176      omp_function(omp_rank)=omp_previous
2177END SUBROUTINE orch_gather_omp_simple_lgen
2178
2179
2180SUBROUTINE orch_gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
2181  USE mod_orchidee_omp_data
2182
2183  USE mod_orchidee_para_var, ONLY : nbp_mpi 
2184  IMPLICIT NONE
2185
2186  INTEGER,INTENT(IN) :: dimsize
2187  LOGICAL,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
2188  LOGICAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
2189  LOGICAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
2190
2191  INTEGER :: i,ij
2192
2193  IF ( check_all_transfert ) THEN
2194    omp_previous=omp_function(omp_rank)
2195    omp_function(omp_rank)=69
2196    CALL print_omp_function()
2197  ENDIF
2198
2199  DO i=1,dimsize
2200     DO ij=1,nbp_omp
2201        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
2202     ENDDO
2203  ENDDO
2204
2205  CALL barrier2_omp()
2206
2207  IF (is_omp_root) THEN
2208     DO i=1,dimsize
2209        DO ij=1,nbp_mpi
2210           VarOut(ij,i)=Buff(ij,i)
2211        ENDDO
2212     ENDDO
2213  ENDIF
2214
2215  CALL barrier2_omp()
2216
2217  IF ( check_all_transfert ) &
2218      omp_function(omp_rank)=omp_previous
2219END SUBROUTINE orch_gather_omp_lgen
2220
2221
2222
2223SUBROUTINE orch_reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
2224  USE mod_orchidee_omp_data
2225
2226  IMPLICIT NONE
2227
2228  INTEGER,INTENT(IN) :: dimsize
2229  INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
2230  INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
2231  INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
2232
2233  INTEGER :: i
2234
2235  IF ( check_all_transfert ) THEN
2236    omp_previous=omp_function(omp_rank)
2237    omp_function(omp_rank)=70
2238    CALL print_omp_function()
2239  ENDIF
2240
2241  IF (is_omp_root) Buff(:)=0
2242
2243  CALL barrier2_omp()
2244
2245!$OMP CRITICAL     
2246  DO i=1,dimsize
2247     Buff(i)=Buff(i)+VarIn(i)
2248  ENDDO
2249!$OMP END CRITICAL
2250
2251  CALL barrier2_omp()
2252
2253  IF (is_omp_root) THEN
2254     DO i=1,dimsize
2255        VarOut(i)=Buff(i)
2256     ENDDO
2257  ENDIF
2258
2259  CALL barrier2_omp()
2260
2261  IF ( check_all_transfert ) &
2262      omp_function(omp_rank)=omp_previous
2263END SUBROUTINE orch_reduce_sum_omp_igen
2264
2265
2266SUBROUTINE orch_reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
2267  USE mod_orchidee_omp_data
2268
2269  IMPLICIT NONE
2270
2271  INTEGER,INTENT(IN) :: dimsize
2272  REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
2273  REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
2274  REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
2275
2276  INTEGER :: i
2277
2278  IF ( check_all_transfert ) THEN
2279    omp_previous=omp_function(omp_rank)
2280    omp_function(omp_rank)=71
2281    CALL print_omp_function()
2282  ENDIF
2283
2284  IF (is_omp_root) Buff(:)=0
2285
2286  CALL barrier2_omp()
2287
2288!$OMP CRITICAL     
2289  DO i=1,dimsize
2290     Buff(i)=Buff(i)+VarIn(i)
2291  ENDDO
2292!$OMP END CRITICAL
2293
2294  CALL barrier2_omp()
2295
2296  IF (is_omp_root) THEN
2297     DO i=1,dimsize
2298        VarOut(i)=Buff(i)
2299     ENDDO
2300  ENDIF
2301
2302  CALL barrier2_omp()
2303
2304  IF ( check_all_transfert ) &
2305      omp_function(omp_rank)=omp_previous
2306END SUBROUTINE orch_reduce_sum_omp_rgen
2307
2308#endif
Note: See TracBrowser for help on using the repository browser.