source: branches/publications/ORCHIDEE_GLUC_r6545/src_parallel/mod_orchidee_omp_transfert.F90 @ 6737

Last change on this file since 6737 was 6538, checked in by chao.yue, 4 years ago

Rollback to r5301; previous commit does not achieve the right purpose
  • Property svn:keywords set to Date Revision HeadURL
File size: 61.6 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,scatter_omp_i4, &
79          scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3,scatter_omp_r4, &
80          scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3,scatter_omp_l4
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  SUBROUTINE scatter_omp_i4(VarIn, VarOut)
786
787    IMPLICIT NONE
788
789    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
790    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
791
792    IF ( check_all_transfert ) THEN
793      omp_previous=omp_function(omp_rank)
794      omp_function(omp_rank)=23
795      CALL print_omp_function()
796    ENDIF
797#ifndef CPP_OMP
798    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
799    RETURN
800#else   
801    CALL check_buffer_i(size(VarIn))   
802    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5),omp_ibuffer)
803#endif 
804    IF ( check_all_transfert ) &
805        omp_function(omp_rank)=omp_previous
806  END SUBROUTINE scatter_omp_i4
807
808
809  SUBROUTINE scatter_omp_r(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)=24
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,1,omp_rbuffer)
827#endif   
828    IF ( check_all_transfert ) &
829        omp_function(omp_rank)=omp_previous
830  END SUBROUTINE scatter_omp_r
831
832  SUBROUTINE scatter_omp_r1(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)=25
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),omp_rbuffer)
850#endif   
851    IF ( check_all_transfert ) &
852        omp_function(omp_rank)=omp_previous
853  END SUBROUTINE scatter_omp_r1
854
855  SUBROUTINE scatter_omp_r2(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)=26
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),omp_rbuffer)
873#endif
874    IF ( check_all_transfert ) &
875        omp_function(omp_rank)=omp_previous
876  END SUBROUTINE scatter_omp_r2
877
878  SUBROUTINE scatter_omp_r3(VarIn, VarOut)
879
880    IMPLICIT NONE
881
882    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
883    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
884
885    IF ( check_all_transfert ) THEN
886      omp_previous=omp_function(omp_rank)
887      omp_function(omp_rank)=27
888      CALL print_omp_function()
889    ENDIF
890#ifndef CPP_OMP
891    VarOut(:,:,:,:)=VarIn(:,:,:,:)
892    RETURN
893#else
894    CALL check_buffer_r(size(VarIn))   
895    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_rbuffer)
896#endif 
897    IF ( check_all_transfert ) &
898        omp_function(omp_rank)=omp_previous
899  END SUBROUTINE scatter_omp_r3
900
901  SUBROUTINE scatter_omp_r4(VarIn, VarOut)
902
903    IMPLICIT NONE
904
905    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
906    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
907
908    IF ( check_all_transfert ) THEN
909      omp_previous=omp_function(omp_rank)
910      omp_function(omp_rank)=27
911      CALL print_omp_function()
912    ENDIF
913#ifndef CPP_OMP
914    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
915    RETURN
916#else
917    CALL check_buffer_r(size(VarIn))   
918    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5),omp_rbuffer)
919#endif 
920    IF ( check_all_transfert ) &
921        omp_function(omp_rank)=omp_previous
922  END SUBROUTINE scatter_omp_r4
923
924
925  SUBROUTINE scatter_omp_l(VarIn, VarOut)
926
927    IMPLICIT NONE
928    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
929    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
930
931    IF ( check_all_transfert ) THEN
932      omp_previous=omp_function(omp_rank)
933      omp_function(omp_rank)=28
934      CALL print_omp_function()
935    ENDIF
936#ifndef CPP_OMP
937    VarOut(:)=VarIn(:)
938    RETURN
939#else
940    CALL check_buffer_l(size(VarIn))   
941    CALL orch_scatter_omp_lgen(VarIn,Varout,1,omp_lbuffer)
942#endif   
943    IF ( check_all_transfert ) &
944        omp_function(omp_rank)=omp_previous
945  END SUBROUTINE scatter_omp_l
946
947  SUBROUTINE scatter_omp_l1(VarIn, VarOut)
948
949    IMPLICIT NONE
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)=29
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),omp_lbuffer)
964#endif   
965    IF ( check_all_transfert ) &
966        omp_function(omp_rank)=omp_previous
967  END SUBROUTINE scatter_omp_l1
968
969  SUBROUTINE scatter_omp_l2(VarIn, VarOut)
970
971    IMPLICIT NONE
972
973    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
974    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
975
976    IF ( check_all_transfert ) THEN
977      omp_previous=omp_function(omp_rank)
978      omp_function(omp_rank)=30
979      CALL print_omp_function()
980    ENDIF
981#ifndef CPP_OMP
982    VarOut(:,:,:)=VarIn(:,:,:)
983    RETURN
984#else
985    CALL check_buffer_l(size(VarIn))   
986    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3),omp_lbuffer)
987#endif
988    IF ( check_all_transfert ) &
989        omp_function(omp_rank)=omp_previous
990  END SUBROUTINE scatter_omp_l2
991
992  SUBROUTINE scatter_omp_l3(VarIn, VarOut)
993
994    IMPLICIT NONE
995
996    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
997    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
998
999    IF ( check_all_transfert ) THEN
1000      omp_previous=omp_function(omp_rank)
1001      omp_function(omp_rank)=31
1002      CALL print_omp_function()
1003    ENDIF
1004#ifndef CPP_OMP
1005    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1006    RETURN
1007#else
1008    CALL check_buffer_l(size(VarIn))   
1009    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_lbuffer)
1010#endif 
1011    IF ( check_all_transfert ) &
1012        omp_function(omp_rank)=omp_previous
1013  END SUBROUTINE scatter_omp_l3
1014
1015  SUBROUTINE scatter_omp_l4(VarIn, VarOut)
1016
1017    IMPLICIT NONE
1018
1019    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1020    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1021
1022    IF ( check_all_transfert ) THEN
1023      omp_previous=omp_function(omp_rank)
1024      omp_function(omp_rank)=31
1025      CALL print_omp_function()
1026    ENDIF
1027#ifndef CPP_OMP
1028    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1029    RETURN
1030#else
1031    CALL check_buffer_l(size(VarIn))   
1032    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5),omp_lbuffer)
1033#endif 
1034    IF ( check_all_transfert ) &
1035        omp_function(omp_rank)=omp_previous
1036  END SUBROUTINE scatter_omp_l4
1037
1038!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1039!! Definition des Gather   --> 4D   !!
1040!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1041
1042  SUBROUTINE gather_omp_i0(VarIn, VarOut)
1043
1044    IMPLICIT NONE
1045
1046    INTEGER,INTENT(IN)               :: VarIn
1047    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
1048
1049    IF ( check_all_transfert ) THEN
1050      omp_previous=omp_function(omp_rank)
1051      omp_function(omp_rank)=32
1052      CALL print_omp_function()
1053    ENDIF
1054#ifndef CPP_OMP
1055    VarOut(:)=VarIn
1056    RETURN
1057#else
1058    CALL check_buffer_i(size(VarOut))   
1059    CALL orch_gather_omp_simple_igen(VarIn,Varout,omp_ibuffer)
1060#endif
1061    IF ( check_all_transfert ) &
1062        omp_function(omp_rank)=omp_previous
1063  END SUBROUTINE gather_omp_i0
1064
1065!!!!! --> Les entiers
1066
1067  SUBROUTINE gather_omp_i(VarIn, VarOut)
1068
1069    IMPLICIT NONE
1070
1071    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
1072    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
1073
1074    IF ( check_all_transfert ) THEN
1075      omp_previous=omp_function(omp_rank)
1076      omp_function(omp_rank)=33
1077      CALL print_omp_function()
1078    ENDIF
1079#ifndef CPP_OMP
1080    VarOut(:)=VarIn(:)
1081    RETURN
1082#else
1083    CALL check_buffer_i(size(VarOut))   
1084    CALL orch_gather_omp_igen(VarIn,Varout,1,omp_ibuffer)
1085#endif
1086    IF ( check_all_transfert ) &
1087        omp_function(omp_rank)=omp_previous
1088  END SUBROUTINE gather_omp_i
1089
1090
1091  SUBROUTINE gather_omp_i1(VarIn, VarOut)
1092
1093    IMPLICIT NONE
1094
1095    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
1096    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
1097
1098    IF ( check_all_transfert ) THEN
1099      omp_previous=omp_function(omp_rank)
1100      omp_function(omp_rank)=34
1101      CALL print_omp_function()
1102    ENDIF
1103#ifndef CPP_OMP
1104    VarOut(:,:)=VarIn(:,:)
1105    RETURN
1106#else
1107    CALL check_buffer_i(size(VarOut))   
1108    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2),omp_ibuffer)
1109#endif   
1110    IF ( check_all_transfert ) &
1111        omp_function(omp_rank)=omp_previous
1112  END SUBROUTINE gather_omp_i1
1113
1114
1115  SUBROUTINE gather_omp_i2(VarIn, VarOut)
1116
1117    IMPLICIT NONE
1118
1119    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1120    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1121
1122    IF ( check_all_transfert ) THEN
1123      omp_previous=omp_function(omp_rank)
1124      omp_function(omp_rank)=35
1125      CALL print_omp_function()
1126    ENDIF
1127#ifndef CPP_OMP
1128    VarOut(:,:,:)=VarIn(:,:,:)
1129    RETURN
1130#else
1131    CALL check_buffer_i(size(VarOut))   
1132    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_ibuffer)
1133#endif   
1134    IF ( check_all_transfert ) &
1135        omp_function(omp_rank)=omp_previous
1136  END SUBROUTINE gather_omp_i2
1137
1138
1139  SUBROUTINE gather_omp_i3(VarIn, VarOut)
1140
1141    IMPLICIT NONE
1142
1143    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1144    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1145
1146    IF ( check_all_transfert ) THEN
1147      omp_previous=omp_function(omp_rank)
1148      omp_function(omp_rank)=36
1149      CALL print_omp_function()
1150    ENDIF
1151#ifndef CPP_OMP
1152    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1153    RETURN
1154#else
1155    CALL check_buffer_i(size(VarOut))   
1156    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_ibuffer)
1157#endif   
1158    IF ( check_all_transfert ) &
1159        omp_function(omp_rank)=omp_previous
1160  END SUBROUTINE gather_omp_i3
1161
1162  SUBROUTINE gather_omp_i4(VarIn, VarOut)
1163
1164    IMPLICIT NONE
1165
1166    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1167    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1168
1169    IF ( check_all_transfert ) THEN
1170      omp_previous=omp_function(omp_rank)
1171      omp_function(omp_rank)=36
1172      CALL print_omp_function()
1173    ENDIF
1174#ifndef CPP_OMP
1175    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1176    RETURN
1177#else
1178    CALL check_buffer_i(size(VarOut))   
1179    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5),omp_ibuffer)
1180#endif   
1181    IF ( check_all_transfert ) &
1182        omp_function(omp_rank)=omp_previous
1183  END SUBROUTINE gather_omp_i4
1184
1185  SUBROUTINE gather_omp_i5(VarIn, VarOut)
1186
1187    IMPLICIT NONE
1188
1189    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:,:) :: VarIn
1190    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:,:) :: VarOut
1191
1192    IF ( check_all_transfert ) THEN
1193      omp_previous=omp_function(omp_rank)
1194      omp_function(omp_rank)=36
1195      CALL print_omp_function()
1196    ENDIF
1197#ifndef CPP_OMP
1198    VarOut(:,:,:,:,:,:)=VarIn(:,:,:,:,:,:)
1199    RETURN
1200#else
1201    CALL check_buffer_i(size(VarOut))   
1202    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)*SIZE(VarIn,6),omp_ibuffer)
1203#endif   
1204    IF ( check_all_transfert ) &
1205        omp_function(omp_rank)=omp_previous
1206  END SUBROUTINE gather_omp_i5
1207
1208!!!!! --> Les reels
1209
1210  SUBROUTINE gather_omp_r0(VarIn, VarOut)
1211
1212    IMPLICIT NONE
1213
1214    REAL,INTENT(IN)               :: VarIn
1215    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
1216
1217    IF ( check_all_transfert ) THEN
1218      omp_previous=omp_function(omp_rank)
1219      omp_function(omp_rank)=37
1220      CALL print_omp_function()
1221    ENDIF
1222#ifndef CPP_OMP
1223    VarOut(:)=VarIn
1224    RETURN
1225#else
1226    CALL check_buffer_r(size(VarOut))   
1227    CALL orch_gather_omp_simple_rgen(VarIn,Varout,omp_rbuffer)
1228#endif
1229    IF ( check_all_transfert ) &
1230        omp_function(omp_rank)=omp_previous
1231  END SUBROUTINE gather_omp_r0
1232
1233  SUBROUTINE gather_omp_r(VarIn, VarOut)
1234
1235    IMPLICIT NONE
1236
1237    REAL,INTENT(IN),DIMENSION(:) :: VarIn
1238    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
1239
1240    IF ( check_all_transfert ) THEN
1241      omp_previous=omp_function(omp_rank)
1242      omp_function(omp_rank)=38
1243      CALL print_omp_function()
1244    ENDIF
1245#ifndef CPP_OMP
1246    VarOut(:)=VarIn(:)
1247    RETURN
1248#else
1249    CALL check_buffer_r(size(VarOut))   
1250    CALL orch_gather_omp_rgen(VarIn,Varout,1,omp_rbuffer)
1251#endif   
1252    IF ( check_all_transfert ) &
1253        omp_function(omp_rank)=omp_previous
1254  END SUBROUTINE gather_omp_r
1255
1256
1257  SUBROUTINE gather_omp_r1(VarIn, VarOut)
1258
1259    IMPLICIT NONE
1260
1261    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1262    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1263
1264    IF ( check_all_transfert ) THEN
1265      omp_previous=omp_function(omp_rank)
1266      omp_function(omp_rank)=39
1267      CALL print_omp_function()
1268    ENDIF
1269#ifndef CPP_OMP
1270    VarOut(:,:)=VarIn(:,:)
1271    RETURN
1272#else
1273    CALL check_buffer_r(size(VarOut))   
1274    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2),omp_rbuffer)
1275#endif   
1276    IF ( check_all_transfert ) &
1277        omp_function(omp_rank)=omp_previous
1278  END SUBROUTINE gather_omp_r1
1279
1280
1281  SUBROUTINE gather_omp_r2(VarIn, VarOut)
1282
1283    IMPLICIT NONE
1284
1285    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1286    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1287
1288    IF ( check_all_transfert ) THEN
1289      omp_previous=omp_function(omp_rank)
1290      omp_function(omp_rank)=40
1291      CALL print_omp_function()
1292    ENDIF
1293#ifndef CPP_OMP
1294    VarOut(:,:,:)=VarIn(:,:,:)
1295    RETURN
1296#else
1297    CALL check_buffer_r(size(VarOut))   
1298    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_rbuffer)
1299#endif   
1300    IF ( check_all_transfert ) &
1301        omp_function(omp_rank)=omp_previous
1302  END SUBROUTINE gather_omp_r2
1303
1304
1305  SUBROUTINE gather_omp_r3(VarIn, VarOut)
1306
1307    IMPLICIT NONE
1308
1309    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1310    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1311
1312    IF ( check_all_transfert ) THEN
1313      omp_previous=omp_function(omp_rank)
1314      omp_function(omp_rank)=41
1315      CALL print_omp_function()
1316    ENDIF
1317#ifndef CPP_OMP
1318    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1319    RETURN
1320#else
1321    CALL check_buffer_r(size(VarOut))   
1322    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_rbuffer)
1323#endif   
1324    IF ( check_all_transfert ) &
1325        omp_function(omp_rank)=omp_previous
1326  END SUBROUTINE gather_omp_r3
1327
1328
1329  SUBROUTINE gather_omp_r4(VarIn, VarOut)
1330
1331    IMPLICIT NONE
1332
1333    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1334    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1335
1336    IF ( check_all_transfert ) THEN
1337      omp_previous=omp_function(omp_rank)
1338      omp_function(omp_rank)=41
1339      CALL print_omp_function()
1340    ENDIF
1341#ifndef CPP_OMP
1342    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1343    RETURN
1344#else
1345    CALL check_buffer_r(size(VarOut))   
1346    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5),omp_rbuffer)
1347#endif   
1348    IF ( check_all_transfert ) &
1349        omp_function(omp_rank)=omp_previous
1350  END SUBROUTINE gather_omp_r4
1351
1352
1353  SUBROUTINE gather_omp_r5(VarIn, VarOut)
1354
1355    IMPLICIT NONE
1356
1357    REAL,INTENT(IN),DIMENSION(:,:,:,:,:,:) :: VarIn
1358    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:,:) :: VarOut
1359
1360    IF ( check_all_transfert ) THEN
1361      omp_previous=omp_function(omp_rank)
1362      omp_function(omp_rank)=41
1363      CALL print_omp_function()
1364    ENDIF
1365#ifndef CPP_OMP
1366    VarOut(:,:,:,:,:,:)=VarIn(:,:,:,:,:,:)
1367    RETURN
1368#else
1369    CALL check_buffer_r(size(VarOut))   
1370    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)*SIZE(VarIn,6),omp_rbuffer)
1371#endif   
1372    IF ( check_all_transfert ) &
1373        omp_function(omp_rank)=omp_previous
1374  END SUBROUTINE gather_omp_r5
1375
1376!!!!! --> Les booleen
1377
1378  SUBROUTINE gather_omp_l0(VarIn, VarOut)
1379
1380    IMPLICIT NONE
1381
1382    LOGICAL,INTENT(IN)               :: VarIn
1383    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
1384
1385    IF ( check_all_transfert ) THEN
1386      omp_previous=omp_function(omp_rank)
1387      omp_function(omp_rank)=42
1388      CALL print_omp_function()
1389    ENDIF
1390#ifndef CPP_OMP
1391    VarOut(:)=VarIn
1392    RETURN
1393#else
1394    CALL check_buffer_l(size(VarOut))   
1395    CALL orch_gather_omp_simple_lgen(VarIn,Varout,omp_lbuffer)
1396#endif
1397    IF ( check_all_transfert ) &
1398        omp_function(omp_rank)=omp_previous
1399  END SUBROUTINE gather_omp_l0
1400
1401  SUBROUTINE gather_omp_l(VarIn, VarOut)
1402
1403    IMPLICIT NONE
1404
1405    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
1406    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
1407
1408    IF ( check_all_transfert ) THEN
1409      omp_previous=omp_function(omp_rank)
1410      omp_function(omp_rank)=43
1411      CALL print_omp_function()
1412    ENDIF
1413#ifndef CPP_OMP
1414    VarOut(:)=VarIn(:)
1415    RETURN
1416#else
1417    CALL check_buffer_l(size(VarOut))   
1418    CALL orch_gather_omp_lgen(VarIn,Varout,1,omp_lbuffer)
1419#endif   
1420    IF ( check_all_transfert ) &
1421        omp_function(omp_rank)=omp_previous
1422  END SUBROUTINE gather_omp_l
1423
1424
1425  SUBROUTINE gather_omp_l1(VarIn, VarOut)
1426
1427    IMPLICIT NONE
1428
1429    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
1430    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1431
1432    IF ( check_all_transfert ) THEN
1433      omp_previous=omp_function(omp_rank)
1434      omp_function(omp_rank)=44
1435      CALL print_omp_function()
1436    ENDIF
1437#ifndef CPP_OMP
1438    VarOut(:,:)=VarIn(:,:)
1439    RETURN
1440#else
1441    CALL check_buffer_l(size(VarOut))   
1442    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2),omp_lbuffer)
1443#endif   
1444    IF ( check_all_transfert ) &
1445        omp_function(omp_rank)=omp_previous
1446  END SUBROUTINE gather_omp_l1
1447
1448
1449  SUBROUTINE gather_omp_l2(VarIn, VarOut)
1450
1451    IMPLICIT NONE
1452
1453    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
1454    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1455
1456    IF ( check_all_transfert ) THEN
1457      omp_previous=omp_function(omp_rank)
1458      omp_function(omp_rank)=45
1459      CALL print_omp_function()
1460    ENDIF
1461#ifndef CPP_OMP
1462    VarOut(:,:,:)=VarIn(:,:,:)
1463    RETURN
1464#else
1465    CALL check_buffer_l(size(VarOut))   
1466    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_lbuffer)
1467#endif   
1468    IF ( check_all_transfert ) &
1469        omp_function(omp_rank)=omp_previous
1470  END SUBROUTINE gather_omp_l2
1471
1472
1473  SUBROUTINE gather_omp_l3(VarIn, VarOut)
1474
1475    IMPLICIT NONE
1476
1477    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
1478    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1479
1480    IF ( check_all_transfert ) THEN
1481      omp_previous=omp_function(omp_rank)
1482      omp_function(omp_rank)=46
1483      CALL print_omp_function()
1484    ENDIF
1485#ifndef CPP_OMP
1486    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1487    RETURN
1488#else
1489    CALL check_buffer_l(size(VarOut))   
1490    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_lbuffer)
1491#endif   
1492    IF ( check_all_transfert ) &
1493        omp_function(omp_rank)=omp_previous
1494  END SUBROUTINE gather_omp_l3
1495
1496
1497  SUBROUTINE gather_omp_l4(VarIn, VarOut)
1498
1499    IMPLICIT NONE
1500
1501    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
1502    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
1503
1504    IF ( check_all_transfert ) THEN
1505      omp_previous=omp_function(omp_rank)
1506      omp_function(omp_rank)=46
1507      CALL print_omp_function()
1508    ENDIF
1509#ifndef CPP_OMP
1510    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
1511    RETURN
1512#else
1513    CALL check_buffer_l(size(VarOut))   
1514    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5),omp_lbuffer)
1515#endif   
1516    IF ( check_all_transfert ) &
1517        omp_function(omp_rank)=omp_previous
1518  END SUBROUTINE gather_omp_l4
1519
1520
1521  SUBROUTINE gather_omp_l5(VarIn, VarOut)
1522
1523    IMPLICIT NONE
1524
1525    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:,:) :: VarIn
1526    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:,:) :: VarOut
1527
1528    IF ( check_all_transfert ) THEN
1529      omp_previous=omp_function(omp_rank)
1530      omp_function(omp_rank)=46
1531      CALL print_omp_function()
1532    ENDIF
1533#ifndef CPP_OMP
1534    VarOut(:,:,:,:,:,:)=VarIn(:,:,:,:,:,:)
1535    RETURN
1536#else
1537    CALL check_buffer_l(size(VarOut))   
1538    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)*SIZE(VarIn,6),omp_lbuffer)
1539#endif   
1540    IF ( check_all_transfert ) &
1541        omp_function(omp_rank)=omp_previous
1542  END SUBROUTINE gather_omp_l5
1543
1544
1545!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1546!! Definition des reduce_sum   --> 4D   !!
1547!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1548
1549  SUBROUTINE reduce_sum_omp_i(VarIn, VarOut)
1550
1551    IMPLICIT NONE
1552
1553    INTEGER,INTENT(IN)  :: VarIn
1554    INTEGER,INTENT(OUT) :: VarOut
1555
1556    IF ( check_all_transfert ) THEN
1557      omp_previous=omp_function(omp_rank)
1558      omp_function(omp_rank)=47
1559      CALL print_omp_function()
1560    ENDIF
1561#ifndef CPP_OMP
1562    VarOut=VarIn
1563    RETURN
1564#else
1565    CALL check_buffer_i(1)   
1566    CALL orch_reduce_sum_omp_igen_scal(VarIn,Varout,omp_ibuffer(1))
1567#endif 
1568    IF ( check_all_transfert ) &
1569        omp_function(omp_rank)=omp_previous
1570  END SUBROUTINE reduce_sum_omp_i
1571
1572  SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut)
1573
1574    IMPLICIT NONE
1575
1576    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
1577    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
1578
1579    IF ( check_all_transfert ) THEN
1580      omp_previous=omp_function(omp_rank)
1581      omp_function(omp_rank)=48
1582      CALL print_omp_function()
1583    ENDIF
1584#ifndef CPP_OMP
1585    VarOut(:)=VarIn(:)
1586    RETURN
1587#else
1588    CALL check_buffer_i(size(VarIn))   
1589    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
1590#endif   
1591    IF ( check_all_transfert ) &
1592        omp_function(omp_rank)=omp_previous
1593  END SUBROUTINE reduce_sum_omp_i1
1594
1595  SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut)
1596    IMPLICIT NONE
1597
1598    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
1599    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
1600
1601    IF ( check_all_transfert ) THEN
1602      omp_previous=omp_function(omp_rank)
1603      omp_function(omp_rank)=49
1604      CALL print_omp_function()
1605    ENDIF
1606#ifndef CPP_OMP
1607    VarOut(:,:)=VarIn(:,:)
1608    RETURN
1609#else
1610    CALL check_buffer_i(size(VarIn))   
1611    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
1612#endif 
1613    IF ( check_all_transfert ) &
1614        omp_function(omp_rank)=omp_previous
1615  END SUBROUTINE reduce_sum_omp_i2
1616
1617  SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut)
1618    IMPLICIT NONE
1619
1620    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
1621    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1622
1623    IF ( check_all_transfert ) THEN
1624      omp_previous=omp_function(omp_rank)
1625      omp_function(omp_rank)=50
1626      CALL print_omp_function()
1627    ENDIF
1628#ifndef CPP_OMP
1629    VarOut(:,:,:)=VarIn(:,:,:)
1630    RETURN
1631#else
1632    CALL check_buffer_i(size(VarIn))   
1633    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
1634#endif 
1635    IF ( check_all_transfert ) &
1636        omp_function(omp_rank)=omp_previous
1637  END SUBROUTINE reduce_sum_omp_i3
1638
1639  SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut)
1640    IMPLICIT NONE
1641
1642    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
1643    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1644
1645    IF ( check_all_transfert ) THEN
1646      omp_previous=omp_function(omp_rank)
1647      omp_function(omp_rank)=51
1648      CALL print_omp_function()
1649    ENDIF
1650#ifndef CPP_OMP
1651    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1652    RETURN
1653#else
1654    CALL check_buffer_i(size(VarIn))   
1655    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
1656#endif 
1657    IF ( check_all_transfert ) &
1658        omp_function(omp_rank)=omp_previous
1659  END SUBROUTINE reduce_sum_omp_i4
1660
1661
1662  SUBROUTINE reduce_sum_omp_r(VarIn, VarOut)
1663    IMPLICIT NONE
1664
1665    REAL,INTENT(IN)  :: VarIn
1666    REAL,INTENT(OUT) :: VarOut
1667
1668    IF ( check_all_transfert ) THEN
1669      omp_previous=omp_function(omp_rank)
1670      omp_function(omp_rank)=52
1671      CALL print_omp_function()
1672    ENDIF
1673#ifndef CPP_OMP
1674    VarOut=VarIn
1675    RETURN
1676#else
1677    CALL check_buffer_r(1)   
1678    CALL orch_reduce_sum_omp_rgen_scal(VarIn,Varout,omp_rbuffer(1))
1679#endif 
1680    IF ( check_all_transfert ) &
1681        omp_function(omp_rank)=omp_previous
1682  END SUBROUTINE reduce_sum_omp_r
1683
1684  SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut)
1685    IMPLICIT NONE
1686
1687    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
1688    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
1689
1690    IF ( check_all_transfert ) THEN
1691      omp_previous=omp_function(omp_rank)
1692      omp_function(omp_rank)=53
1693      CALL print_omp_function()
1694    ENDIF
1695#ifndef CPP_OMP
1696    VarOut(:)=VarIn(:)
1697    RETURN
1698#else
1699    CALL check_buffer_r(size(VarIn))   
1700    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
1701#endif   
1702    IF ( check_all_transfert ) &
1703        omp_function(omp_rank)=omp_previous
1704  END SUBROUTINE reduce_sum_omp_r1
1705
1706  SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut)
1707    IMPLICIT NONE
1708
1709    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
1710    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
1711
1712    IF ( check_all_transfert ) THEN
1713      omp_previous=omp_function(omp_rank)
1714      omp_function(omp_rank)=54
1715      CALL print_omp_function()
1716    ENDIF
1717#ifndef CPP_OMP
1718    VarOut(:,:)=VarIn(:,:)
1719    RETURN
1720#else
1721    CALL check_buffer_r(size(VarIn))   
1722    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
1723#endif 
1724    IF ( check_all_transfert ) &
1725        omp_function(omp_rank)=omp_previous
1726  END SUBROUTINE reduce_sum_omp_r2
1727
1728  SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut)
1729    IMPLICIT NONE
1730
1731    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
1732    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
1733
1734    IF ( check_all_transfert ) THEN
1735      omp_previous=omp_function(omp_rank)
1736      omp_function(omp_rank)=55
1737      CALL print_omp_function()
1738    ENDIF
1739#ifndef CPP_OMP
1740    VarOut(:,:,:)=VarIn(:,:,:)
1741    RETURN
1742#else
1743    CALL check_buffer_r(size(VarIn))   
1744    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
1745#endif 
1746    IF ( check_all_transfert ) &
1747        omp_function(omp_rank)=omp_previous
1748  END SUBROUTINE reduce_sum_omp_r3
1749
1750  SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut)
1751    IMPLICIT NONE
1752
1753    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
1754    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
1755
1756    IF ( check_all_transfert ) THEN
1757      omp_previous=omp_function(omp_rank)
1758      omp_function(omp_rank)=56
1759      CALL print_omp_function()
1760    ENDIF
1761#ifndef CPP_OMP
1762    VarOut(:,:,:,:)=VarIn(:,:,:,:)
1763    RETURN
1764#else
1765    CALL check_buffer_r(size(VarIn))   
1766    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
1767#endif 
1768    IF ( check_all_transfert ) &
1769        omp_function(omp_rank)=omp_previous
1770  END SUBROUTINE reduce_sum_omp_r4
1771
1772END MODULE mod_orchidee_omp_transfert
1773
1774!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1775
1776#ifdef CPP_OMP
1777
1778!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1779!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
1780!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1781
1782SUBROUTINE orch_bcast_omp_cgen(Var,Nb,Buff)
1783  USE mod_orchidee_omp_data
1784  USE mod_orchidee_omp_transfert, ONLY : size_min
1785
1786  IMPLICIT NONE
1787  INTEGER,INTENT(IN)              :: Nb 
1788  CHARACTER(LEN=*),DIMENSION(Nb),INTENT(INOUT) :: Var
1789  CHARACTER(LEN=*),DIMENSION(Nb),INTENT(INOUT) :: Buff
1790  INTEGER :: i
1791  LOGICAL, PARAMETER :: check=.FALSE.
1792
1793  IF ( check_all_transfert ) THEN
1794    omp_previous=omp_function(omp_rank)
1795    omp_function(omp_rank)=57
1796    CALL print_omp_function()
1797  ENDIF
1798
1799  IF (check) THEN
1800     IF (numout_omp > 0) THEN
1801        WRITE(numout_omp,*) "orch_bcast_omp_cgen before bcast Var",Var
1802     ELSE
1803        WRITE(*,*) "orch_bcast_omp_cgen before bcast Var",Var
1804     ENDIF
1805  ENDIF
1806
1807  IF (is_omp_root) THEN
1808     IF ( len(Var) > size_min ) &
1809          CALL ipslerr (3,'orch_bcast_omp_cgen', &
1810          &          'Error with omp_cbuffer.', 'len(Var) > size_min', &
1811          &          '(Increase size_min in mod_orchidee_omp_transfert.)')
1812     DO i=1,Nb
1813        Buff(i)=TRIM(Var(i))
1814     ENDDO
1815  ENDIF
1816
1817  CALL barrier2_omp()
1818
1819  DO i=1,Nb
1820     Var(i)=Buff(i)
1821  ENDDO
1822  CALL barrier2_omp()
1823     
1824  IF (check) THEN
1825     IF (numout_omp > 0) THEN
1826        WRITE(numout_omp,*) "orch_bcast_omp_cgen after bcast Var",Var
1827     ELSE
1828        WRITE(*,*) "orch_bcast_omp_cgen after bcast Var",Var
1829     ENDIF
1830  ENDIF
1831
1832  IF ( check_all_transfert ) &
1833      omp_function(omp_rank)=omp_previous
1834END SUBROUTINE orch_bcast_omp_cgen
1835
1836
1837
1838SUBROUTINE orch_bcast_omp_igen(Var,Nb,Buff)
1839  USE mod_orchidee_omp_data
1840
1841  IMPLICIT NONE
1842
1843  INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
1844  INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
1845  INTEGER,INTENT(IN) :: Nb 
1846
1847  INTEGER :: i
1848
1849  IF ( check_all_transfert ) THEN
1850    omp_previous=omp_function(omp_rank)
1851    omp_function(omp_rank)=58
1852    CALL print_omp_function()
1853  ENDIF
1854
1855  IF (is_omp_root) THEN
1856     DO i=1,Nb
1857        Buff(i)=Var(i)
1858     ENDDO
1859  ENDIF
1860
1861  CALL barrier2_omp()
1862
1863
1864  DO i=1,Nb
1865     Var(i)=Buff(i)
1866  ENDDO
1867
1868  CALL barrier2_omp()
1869
1870  IF ( check_all_transfert ) &
1871      omp_function(omp_rank)=omp_previous
1872END SUBROUTINE orch_bcast_omp_igen
1873
1874
1875
1876SUBROUTINE orch_bcast_omp_rgen(Var,Nb,Buff)
1877  USE mod_orchidee_omp_data
1878
1879  IMPLICIT NONE
1880
1881  REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
1882  REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
1883  INTEGER,INTENT(IN) :: Nb
1884
1885  INTEGER :: i
1886
1887  IF ( check_all_transfert ) THEN
1888    omp_previous=omp_function(omp_rank)
1889    omp_function(omp_rank)=59
1890    CALL print_omp_function()
1891  ENDIF
1892
1893  IF (is_omp_root) THEN
1894     DO i=1,Nb
1895        Buff(i)=Var(i)
1896     ENDDO
1897  ENDIF
1898
1899  CALL barrier2_omp()
1900
1901  DO i=1,Nb
1902     Var(i)=Buff(i)
1903  ENDDO
1904
1905  CALL barrier2_omp()
1906
1907  IF ( check_all_transfert ) &
1908      omp_function(omp_rank)=omp_previous
1909END SUBROUTINE orch_bcast_omp_rgen
1910
1911
1912
1913SUBROUTINE orch_bcast_omp_lgen(Var,Nb,Buff)
1914  USE mod_orchidee_omp_data
1915
1916  IMPLICIT NONE
1917
1918  LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
1919  LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
1920  INTEGER,INTENT(IN) :: Nb
1921
1922  INTEGER :: i
1923
1924  IF ( check_all_transfert ) THEN
1925    omp_previous=omp_function(omp_rank)
1926    omp_function(omp_rank)=60
1927    CALL print_omp_function()
1928  ENDIF
1929
1930  IF (is_omp_root) THEN
1931     DO i=1,Nb
1932        Buff(i)=Var(i)
1933     ENDDO
1934  ENDIF
1935
1936  CALL barrier2_omp()
1937
1938  DO i=1,Nb
1939     Var(i)=Buff(i)
1940  ENDDO
1941
1942  CALL barrier2_omp()
1943
1944  IF ( check_all_transfert ) &
1945      omp_function(omp_rank)=omp_previous
1946END SUBROUTINE orch_bcast_omp_lgen
1947
1948
1949
1950SUBROUTINE orch_scatter_omp_igen(VarIn,VarOut,dimsize,Buff)
1951  USE mod_orchidee_omp_data
1952  USE mod_orchidee_para_var, ONLY : nbp_mpi 
1953  IMPLICIT NONE
1954
1955  INTEGER,INTENT(IN) :: dimsize
1956  INTEGER,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
1957  INTEGER,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
1958  INTEGER,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
1959
1960  INTEGER :: i,ij
1961
1962  IF ( check_all_transfert ) THEN
1963    omp_previous=omp_function(omp_rank)
1964    omp_function(omp_rank)=61
1965    CALL print_omp_function()
1966  ENDIF
1967
1968  IF (is_omp_root) THEN
1969     DO i=1,dimsize
1970        DO ij=1,nbp_mpi
1971           Buff(ij,i)=VarIn(ij,i)
1972        ENDDO
1973     ENDDO
1974  ENDIF
1975
1976  CALL barrier2_omp()
1977
1978  DO i=1,dimsize
1979     DO ij=1,nbp_omp
1980        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
1981     ENDDO
1982  ENDDO
1983
1984  CALL barrier2_omp()
1985
1986  IF ( check_all_transfert ) &
1987      omp_function(omp_rank)=omp_previous
1988END SUBROUTINE orch_scatter_omp_igen
1989
1990
1991SUBROUTINE orch_scatter_omp_rgen(VarIn,VarOut,dimsize,Buff)
1992  USE mod_orchidee_omp_data
1993
1994  USE mod_orchidee_para_var, ONLY : nbp_mpi 
1995  IMPLICIT NONE
1996
1997  INTEGER,INTENT(IN) :: dimsize
1998  REAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
1999  REAL,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
2000  REAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
2001
2002  INTEGER :: i,ij
2003
2004  IF ( check_all_transfert ) THEN
2005    omp_previous=omp_function(omp_rank)
2006    omp_function(omp_rank)=62
2007    CALL print_omp_function()
2008  ENDIF
2009
2010  IF (is_omp_root) THEN
2011     DO i=1,dimsize
2012        DO ij=1,nbp_mpi
2013           Buff(ij,i)=VarIn(ij,i)
2014        ENDDO
2015     ENDDO
2016  ENDIF
2017
2018  CALL barrier2_omp()
2019
2020  DO i=1,dimsize
2021     DO ij=1,nbp_omp
2022        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
2023     ENDDO
2024  ENDDO
2025
2026  CALL barrier2_omp()
2027
2028  IF ( check_all_transfert ) &
2029      omp_function(omp_rank)=omp_previous
2030END SUBROUTINE orch_scatter_omp_rgen
2031
2032
2033SUBROUTINE orch_scatter_omp_lgen(VarIn,VarOut,dimsize,Buff)
2034  USE mod_orchidee_omp_data
2035
2036  USE mod_orchidee_para_var, ONLY : nbp_mpi 
2037  IMPLICIT NONE
2038
2039  INTEGER,INTENT(IN) :: dimsize
2040  LOGICAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
2041  LOGICAL,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
2042  LOGICAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
2043
2044  INTEGER :: i,ij
2045
2046  IF ( check_all_transfert ) THEN
2047    omp_previous=omp_function(omp_rank)
2048    omp_function(omp_rank)=63
2049    CALL print_omp_function()
2050  ENDIF
2051
2052  IF (is_omp_root) THEN
2053     DO i=1,dimsize
2054        DO ij=1,nbp_mpi
2055           Buff(ij,i)=VarIn(ij,i)
2056        ENDDO
2057     ENDDO
2058  ENDIF
2059
2060  CALL barrier2_omp()
2061
2062  DO i=1,dimsize
2063     DO ij=1,nbp_omp
2064        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
2065     ENDDO
2066  ENDDO
2067
2068  CALL barrier2_omp()
2069
2070  IF ( check_all_transfert ) &
2071      omp_function(omp_rank)=omp_previous
2072END SUBROUTINE orch_scatter_omp_lgen
2073
2074
2075
2076SUBROUTINE orch_gather_omp_simple_igen(VarIn,VarOut,Buff)
2077  USE mod_orchidee_omp_data
2078
2079  IMPLICIT NONE
2080
2081  INTEGER,INTENT(IN)                            :: VarIn
2082  INTEGER,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
2083  INTEGER,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
2084
2085  Buff(omp_rank)=VarIn
2086
2087  IF ( check_all_transfert ) THEN
2088    omp_previous=omp_function(omp_rank)
2089    omp_function(omp_rank)=64
2090    CALL print_omp_function()
2091  ENDIF
2092
2093  CALL barrier2_omp()
2094
2095  IF (is_omp_root) THEN
2096     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
2097  ENDIF
2098
2099  CALL barrier2_omp()
2100
2101  IF ( check_all_transfert ) &
2102      omp_function(omp_rank)=omp_previous
2103END SUBROUTINE orch_gather_omp_simple_igen
2104
2105SUBROUTINE orch_gather_omp_igen(VarIn,VarOut,dimsize,Buff)
2106  USE mod_orchidee_omp_data
2107
2108  USE mod_orchidee_para_var, ONLY : nbp_mpi 
2109  IMPLICIT NONE
2110
2111  INTEGER,INTENT(IN) :: dimsize
2112  INTEGER,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
2113  INTEGER,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
2114  INTEGER,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
2115
2116  INTEGER :: i,ij
2117
2118  IF ( check_all_transfert ) THEN
2119    omp_previous=omp_function(omp_rank)
2120    omp_function(omp_rank)=65
2121    CALL print_omp_function()
2122  ENDIF
2123
2124  DO i=1,dimsize
2125     DO ij=1,nbp_omp
2126        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
2127     ENDDO
2128  ENDDO
2129
2130  CALL barrier2_omp()
2131
2132  IF (is_omp_root) THEN
2133     DO i=1,dimsize
2134        DO ij=1,nbp_mpi
2135           VarOut(ij,i)=Buff(ij,i)
2136        ENDDO
2137     ENDDO
2138  ENDIF
2139
2140  CALL barrier2_omp()
2141
2142  IF ( check_all_transfert ) &
2143      omp_function(omp_rank)=omp_previous
2144END SUBROUTINE orch_gather_omp_igen
2145
2146
2147SUBROUTINE orch_gather_omp_simple_rgen(VarIn,VarOut,Buff)
2148  USE mod_orchidee_omp_data
2149
2150  IMPLICIT NONE
2151
2152  REAL,INTENT(IN)                            :: VarIn
2153  REAL,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
2154  REAL,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
2155
2156  IF ( check_all_transfert ) THEN
2157    omp_previous=omp_function(omp_rank)
2158    omp_function(omp_rank)=66
2159    CALL print_omp_function()
2160  ENDIF
2161
2162  Buff(omp_rank)=VarIn
2163
2164  CALL barrier2_omp()
2165
2166  IF (is_omp_root) THEN
2167     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
2168  ENDIF
2169
2170  CALL barrier2_omp()
2171
2172  IF ( check_all_transfert ) &
2173      omp_function(omp_rank)=omp_previous
2174END SUBROUTINE orch_gather_omp_simple_rgen
2175
2176
2177SUBROUTINE orch_gather_omp_rgen(VarIn,VarOut,dimsize,Buff)
2178  USE mod_orchidee_omp_data
2179
2180  USE mod_orchidee_para_var, ONLY : nbp_mpi 
2181  IMPLICIT NONE
2182
2183  INTEGER,INTENT(IN) :: dimsize
2184  REAL,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
2185  REAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
2186  REAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
2187
2188  INTEGER :: i,ij
2189
2190  IF ( check_all_transfert ) THEN
2191    omp_previous=omp_function(omp_rank)
2192    omp_function(omp_rank)=67
2193    CALL print_omp_function()
2194  ENDIF
2195
2196  DO i=1,dimsize
2197     DO ij=1,nbp_omp
2198        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
2199     ENDDO
2200  ENDDO
2201
2202  CALL barrier2_omp()
2203
2204  IF (is_omp_root) THEN
2205     DO i=1,dimsize
2206        DO ij=1,nbp_mpi
2207           VarOut(ij,i)=Buff(ij,i)
2208        ENDDO
2209     ENDDO
2210  ENDIF
2211
2212  CALL barrier2_omp()
2213
2214  IF ( check_all_transfert ) &
2215      omp_function(omp_rank)=omp_previous
2216END SUBROUTINE orch_gather_omp_rgen
2217
2218
2219SUBROUTINE orch_gather_omp_simple_lgen(VarIn,VarOut,Buff)
2220  USE mod_orchidee_omp_data
2221
2222  IMPLICIT NONE
2223
2224  LOGICAL,INTENT(IN)                            :: VarIn
2225  LOGICAL,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
2226  LOGICAL,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
2227
2228  IF ( check_all_transfert ) THEN
2229    omp_previous=omp_function(omp_rank)
2230    omp_function(omp_rank)=68
2231    CALL print_omp_function()
2232  ENDIF
2233
2234  Buff(omp_rank)=VarIn
2235
2236  CALL barrier2_omp()
2237
2238  IF (is_omp_root) THEN
2239     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
2240  ENDIF
2241
2242  CALL barrier2_omp()
2243
2244  IF ( check_all_transfert ) &
2245      omp_function(omp_rank)=omp_previous
2246END SUBROUTINE orch_gather_omp_simple_lgen
2247
2248
2249SUBROUTINE orch_gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
2250  USE mod_orchidee_omp_data
2251
2252  USE mod_orchidee_para_var, ONLY : nbp_mpi 
2253  IMPLICIT NONE
2254
2255  INTEGER,INTENT(IN) :: dimsize
2256  LOGICAL,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
2257  LOGICAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
2258  LOGICAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
2259
2260  INTEGER :: i,ij
2261
2262  IF ( check_all_transfert ) THEN
2263    omp_previous=omp_function(omp_rank)
2264    omp_function(omp_rank)=69
2265    CALL print_omp_function()
2266  ENDIF
2267
2268  DO i=1,dimsize
2269     DO ij=1,nbp_omp
2270        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
2271     ENDDO
2272  ENDDO
2273
2274  CALL barrier2_omp()
2275
2276  IF (is_omp_root) THEN
2277     DO i=1,dimsize
2278        DO ij=1,nbp_mpi
2279           VarOut(ij,i)=Buff(ij,i)
2280        ENDDO
2281     ENDDO
2282  ENDIF
2283
2284  CALL barrier2_omp()
2285
2286  IF ( check_all_transfert ) &
2287      omp_function(omp_rank)=omp_previous
2288END SUBROUTINE orch_gather_omp_lgen
2289
2290SUBROUTINE orch_reduce_sum_omp_igen_scal(VarIn,VarOut,Buff)
2291  USE mod_orchidee_omp_data
2292
2293  IMPLICIT NONE
2294
2295  INTEGER,INTENT(IN)  :: VarIn
2296  INTEGER,INTENT(OUT) :: VarOut
2297  INTEGER,INTENT(INOUT) :: Buff
2298
2299  INTEGER :: i
2300
2301  IF ( check_all_transfert ) THEN
2302    omp_previous=omp_function(omp_rank)
2303    omp_function(omp_rank)=70
2304    CALL print_omp_function()
2305  ENDIF
2306
2307  IF (is_omp_root) Buff=0
2308
2309  CALL barrier2_omp()
2310
2311!$OMP CRITICAL     
2312  Buff=Buff+VarIn
2313!$OMP END CRITICAL
2314
2315  CALL barrier2_omp()
2316
2317  IF (is_omp_root) THEN
2318     VarOut=Buff
2319  ENDIF
2320
2321  CALL barrier2_omp()
2322
2323  IF ( check_all_transfert ) &
2324      omp_function(omp_rank)=omp_previous
2325END SUBROUTINE orch_reduce_sum_omp_igen_scal
2326
2327
2328SUBROUTINE orch_reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
2329  USE mod_orchidee_omp_data
2330
2331  IMPLICIT NONE
2332
2333  INTEGER,INTENT(IN) :: dimsize
2334  INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
2335  INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
2336  INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
2337
2338  INTEGER :: i
2339
2340  IF ( check_all_transfert ) THEN
2341    omp_previous=omp_function(omp_rank)
2342    omp_function(omp_rank)=70
2343    CALL print_omp_function()
2344  ENDIF
2345
2346  IF (is_omp_root) Buff(:)=0
2347
2348  CALL barrier2_omp()
2349
2350!$OMP CRITICAL     
2351  DO i=1,dimsize
2352     Buff(i)=Buff(i)+VarIn(i)
2353  ENDDO
2354!$OMP END CRITICAL
2355
2356  CALL barrier2_omp()
2357
2358  IF (is_omp_root) THEN
2359     DO i=1,dimsize
2360        VarOut(i)=Buff(i)
2361     ENDDO
2362  ENDIF
2363
2364  CALL barrier2_omp()
2365
2366  IF ( check_all_transfert ) &
2367      omp_function(omp_rank)=omp_previous
2368END SUBROUTINE orch_reduce_sum_omp_igen
2369
2370SUBROUTINE orch_reduce_sum_omp_rgen_scal(VarIn,VarOut,Buff)
2371  USE mod_orchidee_omp_data
2372
2373  IMPLICIT NONE
2374
2375  REAL,INTENT(IN)  :: VarIn
2376  REAL,INTENT(OUT) :: VarOut
2377  REAL,INTENT(INOUT) :: Buff
2378
2379  INTEGER :: i
2380
2381  IF ( check_all_transfert ) THEN
2382    omp_previous=omp_function(omp_rank)
2383    omp_function(omp_rank)=71
2384    CALL print_omp_function()
2385  ENDIF
2386
2387  IF (is_omp_root) Buff=0
2388
2389  CALL barrier2_omp()
2390
2391!$OMP CRITICAL     
2392  Buff=Buff+VarIn
2393!$OMP END CRITICAL
2394
2395  CALL barrier2_omp()
2396
2397  IF (is_omp_root) THEN
2398     VarOut=Buff
2399  ENDIF
2400
2401  CALL barrier2_omp()
2402
2403  IF ( check_all_transfert ) &
2404      omp_function(omp_rank)=omp_previous
2405END SUBROUTINE orch_reduce_sum_omp_rgen_scal
2406
2407SUBROUTINE orch_reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
2408  USE mod_orchidee_omp_data
2409
2410  IMPLICIT NONE
2411
2412  INTEGER,INTENT(IN) :: dimsize
2413  REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
2414  REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
2415  REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
2416
2417  INTEGER :: i
2418
2419  IF ( check_all_transfert ) THEN
2420    omp_previous=omp_function(omp_rank)
2421    omp_function(omp_rank)=71
2422    CALL print_omp_function()
2423  ENDIF
2424
2425  IF (is_omp_root) Buff(:)=0
2426
2427  CALL barrier2_omp()
2428
2429!$OMP CRITICAL     
2430  DO i=1,dimsize
2431     Buff(i)=Buff(i)+VarIn(i)
2432  ENDDO
2433!$OMP END CRITICAL
2434
2435  CALL barrier2_omp()
2436
2437  IF (is_omp_root) THEN
2438     DO i=1,dimsize
2439        VarOut(i)=Buff(i)
2440     ENDDO
2441  ENDIF
2442
2443  CALL barrier2_omp()
2444
2445  IF ( check_all_transfert ) &
2446      omp_function(omp_rank)=omp_previous
2447END SUBROUTINE orch_reduce_sum_omp_rgen
2448
2449#endif
Note: See TracBrowser for help on using the repository browser.