source: branches/publications/ORCHIDEE_gmd-2018-57/src_parallel/mod_orchidee_omp_transfert.F90 @ 6145

Last change on this file since 6145 was 3965, checked in by jan.polcher, 8 years ago

Merge with trunk at revision3959.
This includes all the developments made for CMIP6 and passage to XIOS2.
All conflicts are resolved and the code compiles.

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