Index: codes/icosagcm/trunk/src/base/field.f90
===================================================================
--- codes/icosagcm/trunk/src/base/field.f90	(revision 962)
+++ codes/icosagcm/trunk/src/base/field.f90	(revision 963)
@@ -13,7 +13,7 @@
   TYPE t_field
     CHARACTER(30)      :: name
-    REAL(rstd),POINTER :: rval2d(:) => null()
-    REAL(rstd),POINTER :: rval3d(:,:) => null()
-    REAL(rstd),POINTER :: rval4d(:,:,:) => null()
+    REAL(rstd),POINTER, CONTIGUOUS :: rval2d(:) => null()
+    REAL(rstd),POINTER, CONTIGUOUS :: rval3d(:,:) => null()
+    REAL(rstd),POINTER, CONTIGUOUS :: rval4d(:,:,:) => null()
 
     INTEGER,POINTER :: ival2d(:)
@@ -274,79 +274,78 @@
        IF (field(ind)%ndim==4) THEN
           IF (data_type==type_integer) THEN
+             IF (field(ind)%ondevice) THEN
+                !$acc exit data delete(field(ind)%ival4d(:,:,:))
+                CONTINUE
+             END IF
              DEALLOCATE(field(ind)%ival4d)
-             IF (field(ind)%ondevice) THEN
-                !$acc exit data delete(field(ind)%ival4d)
-                CONTINUE
-             END IF
           END IF
 
           IF (data_type==type_real) THEN
+             IF (field(ind)%ondevice) THEN
+                !$acc exit data delete(field(ind)%rval4d(:,:,:))
+                CONTINUE
+             END IF
              DEALLOCATE(field(ind)%rval4d)
-             IF (field(ind)%ondevice) THEN
-                !$acc exit data delete(field(ind)%rval4d)
-                CONTINUE
-             END IF
           END IF
 
           IF (data_type==type_logical) THEN
+             IF (field(ind)%ondevice) THEN
+                !$acc exit data delete(field(ind)%lval4d(:,:,:))
+                CONTINUE
+             END IF
              DEALLOCATE(field(ind)%lval4d)
-             IF (field(ind)%ondevice) THEN
-                !$acc exit data delete(field(ind)%lval4d)
-                CONTINUE
-             END IF
           END IF
 
        ELSE IF (field(ind)%ndim==3) THEN
           IF (data_type==type_integer) THEN
+             IF (field(ind)%ondevice) THEN
+                !$acc exit data delete(field(ind)%ival3d(:,:))
+                CONTINUE
+             END IF
              DEALLOCATE(field(ind)%ival3d)
-             IF (field(ind)%ondevice) THEN
-                !$acc exit data delete(field(ind)%ival3d)
-                CONTINUE
-             END IF
           END IF
 
           IF (data_type==type_real) THEN
+             IF (field(ind)%ondevice) THEN
+                !$acc exit data delete(field(ind)%rval3d(:,:))
+                CONTINUE
+             END IF
              DEALLOCATE(field(ind)%rval3d)
-             IF (field(ind)%ondevice) THEN
-                !$acc exit data delete(field(ind)%rval3d)
-                CONTINUE
-             END IF
           END IF
 
           IF (data_type==type_logical) THEN
+             IF (field(ind)%ondevice) THEN
+                !$acc exit data delete(field(ind)%lval3d(:,:))
+                CONTINUE
+             END IF
              DEALLOCATE(field(ind)%lval3d)
-             IF (field(ind)%ondevice) THEN
-                !$acc exit data delete(field(ind)%lval3d)
-                CONTINUE
-             END IF
           END IF
 
        ELSE IF (field(ind)%ndim==2) THEN
           IF (data_type==type_integer) THEN
+             IF (field(ind)%ondevice) THEN
+                !$acc exit data delete(field(ind)%ival2d(:))
+                CONTINUE
+             END IF
              DEALLOCATE(field(ind)%ival2d)
-             IF (field(ind)%ondevice) THEN
-                !$acc exit data delete(field(ind)%ival2d)
-                CONTINUE
-             END IF
           END IF
 
           IF (data_type==type_real) THEN
+             IF (field(ind)%ondevice) THEN
+                !$acc exit data delete(field(ind)%rval2d(:))
+                CONTINUE
+             END IF
              DEALLOCATE(field(ind)%rval2d)
-             IF (field(ind)%ondevice) THEN
-                !$acc exit data delete(field(ind)%rval2d)
-                CONTINUE
-             END IF
           END IF
 
           IF (data_type==type_logical) THEN
+             IF (field(ind)%ondevice) THEN
+                !$acc exit data delete(field(ind)%lval2d(:))
+                CONTINUE
+             END IF
              DEALLOCATE(field(ind)%lval2d)
-             IF (field(ind)%ondevice) THEN
-                !$acc exit data delete(field(ind)%lval2d)
-                CONTINUE
-             END IF
           END IF
 
        ENDIF
-
     ENDDO
   END SUBROUTINE deallocate_field_
@@ -555,15 +554,15 @@
       IF (field(ind)%ndim==4) THEN
          IF (field(ind)%data_type==type_integer) THEN
-            !$acc update device(field(ind)%ival4d(:,:,:))
+            !$acc update device(field(ind)%ival4d(:,:,:)) async
             CONTINUE
          END IF
 
          IF (field(ind)%data_type==type_real) THEN
-            !$acc update device(field(ind)%rval4d(:,:,:))
+            !$acc update device(field(ind)%rval4d(:,:,:)) async
             CONTINUE
          END IF
 
          IF (field(ind)%data_type==type_logical) THEN
-            !$acc update device(field(ind)%lval4d(:,:,:))
+            !$acc update device(field(ind)%lval4d(:,:,:)) async
             CONTINUE
          END IF
@@ -571,15 +570,15 @@
       ELSE IF (field(ind)%ndim==3) THEN
          IF (field(ind)%data_type==type_integer) THEN
-            !$acc update device(field(ind)%ival3d(:,:))
+            !$acc update device(field(ind)%ival3d(:,:)) async
             CONTINUE
          END IF
 
          IF (field(ind)%data_type==type_real) THEN
-            !$acc update device(field(ind)%rval3d(:,:))
+            !$acc update device(field(ind)%rval3d(:,:)) async
             CONTINUE
          END IF
 
          IF (field(ind)%data_type==type_logical) THEN
-            !$acc update device(field(ind)%lval3d(:,:))
+            !$acc update device(field(ind)%lval3d(:,:)) async
             CONTINUE
          END IF
@@ -587,15 +586,15 @@
       ELSE IF (field(ind)%ndim==2) THEN
          IF (field(ind)%data_type==type_integer) THEN
-            !$acc update device(field(ind)%ival2d(:))
+            !$acc update device(field(ind)%ival2d(:)) async
             CONTINUE
          END IF
 
          IF (field(ind)%data_type==type_real) THEN
-            !$acc update device(field(ind)%rval2d(:))
+            !$acc update device(field(ind)%rval2d(:)) async
             CONTINUE
          END IF
 
          IF (field(ind)%data_type==type_logical) THEN
-            !$acc update device(field(ind)%lval2d(:))
+            !$acc update device(field(ind)%lval2d(:)) async
             CONTINUE
          END IF
@@ -616,34 +615,34 @@
 
       IF (field(ind)%ondevice) THEN
-        
+
          IF (field(ind)%ndim==4) THEN
             IF (field(ind)%data_type==type_integer) THEN
-               !$acc update host(field(ind)%ival4d(:,:,:)) wait
+               !$acc update host(field(ind)%ival4d(:,:,:)) async
                CONTINUE
             END IF
 
             IF (field(ind)%data_type==type_real) THEN
-               !$acc update host(field(ind)%rval4d(:,:,:)) wait
+               !$acc update host(field(ind)%rval4d(:,:,:)) async
                CONTINUE
             END IF
 
             IF (field(ind)%data_type==type_logical) THEN
-               !$acc update host(field(ind)%lval4d(:,:,:)) wait
-               CONTINUE
-            END IF
-         
+               !$acc update host(field(ind)%lval4d(:,:,:)) async
+               CONTINUE
+            END IF
+
          ELSE IF (field(ind)%ndim==3) THEN
             IF (field(ind)%data_type==type_integer) THEN
-               !$acc update host(field(ind)%ival3d(:,:)) wait
+               !$acc update host(field(ind)%ival3d(:,:)) async
                CONTINUE
             END IF
 
             IF (field(ind)%data_type==type_real) THEN
-               !$acc update host(field(ind)%rval3d(:,:)) wait
+               !$acc update host(field(ind)%rval3d(:,:)) async
                CONTINUE
             END IF
 
             IF (field(ind)%data_type==type_logical) THEN
-               !$acc update host(field(ind)%lval3d(:,:)) wait
+               !$acc update host(field(ind)%lval3d(:,:)) async
                CONTINUE
             END IF
@@ -651,15 +650,15 @@
          ELSE IF (field(ind)%ndim==2) THEN
             IF (field(ind)%data_type==type_integer) THEN
-               !$acc update host(field(ind)%ival2d(:)) wait
+               !$acc update host(field(ind)%ival2d(:)) async
                CONTINUE
             END IF
 
             IF (field(ind)%data_type==type_real) THEN
-               !$acc update host(field(ind)%rval2d(:)) wait
+               !$acc update host(field(ind)%rval2d(:)) async
                CONTINUE
             END IF
 
             IF (field(ind)%data_type==type_logical) THEN
-               !$acc update host(field(ind)%lval2d(:)) wait
+               !$acc update host(field(ind)%lval2d(:)) async
                CONTINUE
             END IF
@@ -667,4 +666,5 @@
       END IF
    ENDDO
+   !$acc wait
    !$OMP BARRIER
  END SUBROUTINE update_host_field
@@ -679,39 +679,39 @@
     IF (field%ndim==4) THEN
        IF (field%data_type==type_integer) THEN
-          !$acc enter data create(field%ival4d(:,:,:))
+          !$acc enter data create(field%ival4d(:,:,:)) async
        END IF
 
        IF (field%data_type==type_real) THEN
-          !$acc enter data create(field%rval4d(:,:,:))
+          !$acc enter data create(field%rval4d(:,:,:)) async
        END IF
 
        IF (field%data_type==type_logical) THEN
-          !$acc enter data create(field%lval4d(:,:,:))
+          !$acc enter data create(field%lval4d(:,:,:)) async
        END IF
 
     ELSE IF (field%ndim==3) THEN
        IF (field%data_type==type_integer) THEN
-          !$acc enter data create(field%ival3d(:,:))
+          !$acc enter data create(field%ival3d(:,:)) async
        END IF
 
        IF (field%data_type==type_real) THEN
-          !$acc enter data create(field%rval3d(:,:))
+          !$acc enter data create(field%rval3d(:,:)) async
        END IF
 
        IF (field%data_type==type_logical) THEN
-          !$acc enter data create(field%lval3d(:,:))
+          !$acc enter data create(field%lval3d(:,:)) async
        END IF
 
     ELSE IF (field%ndim==2) THEN
        IF (field%data_type==type_integer) THEN
-          !$acc enter data create(field%ival2d(:))
+          !$acc enter data create(field%ival2d(:)) async
        END IF
 
        IF (field%data_type==type_real) THEN
-          !$acc enter data create(field%rval2d(:))
+          !$acc enter data create(field%rval2d(:)) async
        END IF
 
        IF (field%data_type==type_logical) THEN
-          !$acc enter data create(field%lval2d(:))
+          !$acc enter data create(field%lval2d(:)) async
        END IF
     ENDIF
Index: codes/icosagcm/trunk/src/dissip/dissip_gcm.F90
===================================================================
--- codes/icosagcm/trunk/src/dissip/dissip_gcm.F90	(revision 962)
+++ codes/icosagcm/trunk/src/dissip/dissip_gcm.F90	(revision 963)
@@ -4,10 +4,10 @@
   PRIVATE
 
-  TYPE(t_field),POINTER,SAVE :: f_due_diss1(:)
-  TYPE(t_field),POINTER,SAVE :: f_due_diss2(:)
+  TYPE(t_field),POINTER,SAVE :: f_due_diss_gradiv(:)
+  TYPE(t_field),POINTER,SAVE :: f_due_diss_gradrot(:)
 
   TYPE(t_field),POINTER,SAVE :: f_dtheta_diss(:)
   TYPE(t_field),POINTER,SAVE :: f_dtheta_rhodz_diss(:)
-  TYPE(t_message),SAVE :: req_due, req_dtheta 
+  TYPE(t_message),SAVE :: req_due_gradiv, req_due_gradrot, req_dtheta 
  
   INTEGER,SAVE :: nitergdiv=1
@@ -47,7 +47,7 @@
   SUBROUTINE allocate_dissip
   USE icosa
-  IMPLICIT NONE  
-    CALL allocate_field(f_due_diss1,field_u,type_real,llm,ondevice=.TRUE.)
-    CALL allocate_field(f_due_diss2,field_u,type_real,llm,ondevice=.TRUE.)
+  IMPLICIT NONE
+    CALL allocate_field(f_due_diss_gradiv,field_u,type_real,llm,ondevice=.TRUE.)
+    CALL allocate_field(f_due_diss_gradrot,field_u,type_real,llm,ondevice=.TRUE.)
     CALL allocate_field(f_dtheta_diss,field_t,type_real,llm)
     CALL allocate_field(f_dtheta_rhodz_diss,field_t,type_real,llm,ondevice=.TRUE.)
@@ -140,6 +140,7 @@
     CALL allocate_field(f_dtheta,field_t,type_real,ondevice=.TRUE.)
     
-    CALL init_message(f_due_diss1,req_e1_vect,req_due)
-    CALL init_message(f_dtheta_diss,req_i1,req_dtheta)
+    CALL init_message(f_due_diss_gradiv,req_e1_vect,req_due_gradiv)
+    CALL init_message(f_due_diss_gradrot,req_e1_vect,req_due_gradrot)
+    CALL init_message(f_dtheta_rhodz_diss,req_i1,req_dtheta)
 
     tau_graddiv(:)=5000
@@ -548,6 +549,6 @@
     
     CALL trace_start("dissip")
-    CALL gradiv(f_ue,f_due_diss1)
-    CALL gradrot(f_ue,f_due_diss2)
+    CALL gradiv(f_ue,f_due_diss_gradiv)
+    CALL gradrot(f_ue,f_due_diss_gradrot)
 
     CALL divgrad_theta_rhodz(f_mass,f_theta_rhodz,f_dtheta_rhodz_diss)
@@ -558,6 +559,6 @@
       CALL swap_geometry(ind)
       due=f_due(ind) 
-      due_diss1=f_due_diss1(ind)
-      due_diss2=f_due_diss2(ind)
+      due_diss1=f_due_diss_gradiv(ind)
+      due_diss2=f_due_diss_gradrot(ind)
       dtheta_rhodz=f_dtheta_rhodz(ind)
       dtheta_rhodz_diss=f_dtheta_rhodz_diss(ind)
@@ -653,11 +654,11 @@
          USE output_field_mod
 
-         CALL transfert_request(f_due_diss1,req_e1_vect)
-         CALL un2ulonlat(f_due_diss1, f_buf_ulon, f_buf_ulat, (1./(tau_graddiv(1))))
+         CALL transfert_request(f_due_diss_gradiv,req_e1_vect)
+         CALL un2ulonlat(f_due_diss_gradiv, f_buf_ulon, f_buf_ulat, (1./(tau_graddiv(1))))
          CALL output_field("dulon_diss1",f_buf_ulon)
          CALL output_field("dulat_diss1",f_buf_ulat)
 !
-         CALL transfert_request(f_due_diss2,req_e1_vect)
-         CALL un2ulonlat(f_due_diss2, f_buf_ulon, f_buf_ulat, (1./(tau_graddiv(1))))
+         CALL transfert_request(f_due_diss_gradrot,req_e1_vect)
+         CALL un2ulonlat(f_due_diss_gradrot, f_buf_ulon, f_buf_ulat, (1./(tau_graddiv(1))))
          CALL output_field("dulon_diss2",f_buf_ulon)
          CALL output_field("dulat_diss2",f_buf_ulat)
@@ -699,7 +700,6 @@
 
     DO it=1,nitergdiv
-      CALL send_message(f_due,req_due)
-      CALL wait_message(req_due)
-
+      CALL send_message(f_due,req_due_gradiv)
+      CALL wait_message(req_due_gradiv)
       DO ind=1,ndomain
         IF (.NOT. assigned_domain(ind)) CYCLE
@@ -749,6 +749,6 @@
 
     DO it=1,nitergrot
-      CALL send_message(f_due,req_due)
-      CALL wait_message(req_due)
+      CALL send_message(f_due,req_due_gradrot)
+      CALL wait_message(req_due_gradrot)
         
       DO ind=1,ndomain
Index: codes/icosagcm/trunk/src/output/write_field.f90
===================================================================
--- codes/icosagcm/trunk/src/output/write_field.f90	(revision 962)
+++ codes/icosagcm/trunk/src/output/write_field.f90	(revision 963)
@@ -66,5 +66,5 @@
     USE domain_mod
     USE field_mod
-    USE transfert_mpi_mod
+    USE transfert_mod
     USE dimensions
     USE mpipara
Index: codes/icosagcm/trunk/src/parallel/domain.f90
===================================================================
--- codes/icosagcm/trunk/src/parallel/domain.f90	(revision 962)
+++ codes/icosagcm/trunk/src/parallel/domain.f90	(revision 963)
@@ -694,4 +694,6 @@
     
     ENDDO
+
+    !$acc enter data copyin(assigned_domain(:))
     
   END SUBROUTINE assign_domain_omp
Index: codes/icosagcm/trunk/src/parallel/transfert.F90
===================================================================
--- codes/icosagcm/trunk/src/parallel/transfert.F90	(revision 962)
+++ codes/icosagcm/trunk/src/parallel/transfert.F90	(revision 963)
@@ -1,38 +1,89 @@
-MODULE transfert_mod
-
+module transfert_mod
 #ifdef CPP_USING_MPI
-  USE transfert_mpi_mod, ONLY : init_transfert, transfert_request=>transfert_request_mpi, req_i1,req_e1_vect, &
-                                req_e1_scal, req_z1_scal, req_i0, req_e0_vect, req_e0_scal, request_add_point,             &
-                                create_request, gather_field, scatter_field,         &
-                                t_message, init_message=>init_message_mpi,           &
-                                transfert_message=>transfert_message_mpi,            &
-                                send_message=>send_message_mpi,                      &
-                                test_message=>test_message_mpi,                      &
-                                wait_message=>wait_message_mpi,barrier,bcast_mpi
-#else 
-  USE transfert_mpi_mod, ONLY : init_transfert, transfert_request=>transfert_request_seq, req_i1,req_e1_vect, &
-                                req_e1_scal, req_z1_scal, req_i0, req_e0_vect, req_e0_scal,        &
-                                request_add_point, create_request, gather_field,     &
-                                scatter_field, t_message,                            &
-                                init_message=>init_message_seq,                      &
-                                transfert_message=>transfert_message_seq,            &
-                                send_message=>send_message_seq,                      &
-                                test_message=>test_message_seq,                      &
-                                wait_message=>wait_message_seq,barrier, bcast_mpi
+
+#if defined(CPP_USING_MPI_LEGACY)
+#warning("Using legacy transfert_mpi (not default)")
+  use transfert_mpi_legacy_mod, only :  t_message, t_request, &
+                                        req_i1, req_e1_scal, req_e1_vect, &
+                                        req_i0, req_e0_scal, req_e0_vect, &
+                                        req_z1_scal, &
+                                        init_transfert, &
+                                        init_message => init_message_mpi, &
+                                        finalize_message => finalize_message_mpi, &
+                                        send_message => send_message_mpi, &
+                                        wait_message => wait_message_mpi, &
+                                        test_message => test_message_mpi
+#else
+  ! transfert_mpi using manual pack/unpack (default)
+  use transfert_mpi_mod, only : t_message, t_request, &
+                                req_i1, req_e1_scal, req_e1_vect, &
+                                req_i0, req_e0_scal, req_e0_vect, &
+                                req_z1_scal, &
+                                init_transfert, &
+                                init_message, &
+                                finalize_message, &
+                                send_message, &
+                                wait_message, &
+                                test_message
 #endif
-
-  USE transfert_omp_mod
-  
-  INTERFACE bcast
-    MODULE PROCEDURE bcast_c,                                     &
-                     bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, &
-                     bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, &
-		     bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4
-
-  END INTERFACE
-
-
-CONTAINS
-
+#else
+#warning("Using transfert_seq (unmaintained)")
+  use transfert_mpi_legacy_mod, only :  t_message, t_request, &
+                                        req_i1, req_e1_scal, req_e1_vect, &
+                                        req_i0, req_e0_scal, req_e0_vect, &
+                                        req_z1_scal, &
+                                        init_transfert, &
+                                        init_message=>init_message_seq, &
+                                        finalize_message => finalize_message_seq, &
+                                        send_message => send_message_seq, &
+                                        wait_message => wait_message_seq, &
+                                        test_message => test_message_seq
+#endif
+  use transfert_mpi_collectives_mod, only : gather_field, scatter_field, bcast_field, bcast_mpi
+  use transfert_omp_mod, only : bcast_omp
+
+  implicit none
+  private
+  public :: t_message, t_request, &
+          req_i1, req_e1_scal, req_e1_vect, &
+          req_i0, req_e0_scal, req_e0_vect, &
+          !req_z1_scal, &
+          init_transfert, &
+          init_message, &
+          finalize_message, &
+          send_message, &
+          wait_message, &
+          test_message, &
+          transfert_request, &
+          transfert_message, &
+          gather_field, scatter_field, bcast_field, bcast, bcast_omp
+
+  interface bcast
+    module procedure  bcast_c,                                     &
+                      bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, &
+                      bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, &
+                      bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4
+  end interface
+
+contains
+  subroutine transfert_message(field, message)
+    use field_mod, only : t_field
+    type(t_field), pointer :: field(:)
+    type(t_message) :: message
+
+    call send_message(field, message)
+    call wait_message(message)
+  end subroutine
+
+  subroutine transfert_request(field, request)
+    use field_mod, only : t_field
+    type(t_field),pointer :: field(:)
+    type(t_request),pointer :: request(:)
+    type(t_message), save :: message ! Save because shared between threads
+
+    call init_message(field, request, message)
+    call transfert_message(field, message)
+    call finalize_message(message)
+  end subroutine
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -40,5 +91,5 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-!! -- Les chaine de charactère -- !!
+!! -- Les chaine de charactï¿œre -- !!
 
   SUBROUTINE bcast_c(var)
Index: codes/icosagcm/trunk/src/parallel/transfert_mpi.f90
===================================================================
--- codes/icosagcm/trunk/src/parallel/transfert_mpi.f90	(revision 962)
+++ codes/icosagcm/trunk/src/parallel/transfert_mpi.f90	(revision 963)
@@ -1,2326 +1,519 @@
-MODULE transfert_mpi_mod
-USE genmod
-USE field_mod
-IMPLICIT NONE
-  
-  TYPE array
-    INTEGER,POINTER :: value(:)=>null()
-    INTEGER,POINTER :: sign(:)=>null()
-    INTEGER         :: domain
-    INTEGER         :: rank
-    INTEGER         :: tag
-    INTEGER         :: size
-    INTEGER         :: offset
-    INTEGER         :: ireq
-    INTEGER,POINTER :: buffer(:)=>null()
-    REAL,POINTER    :: buffer_r(:)=>null()
-    INTEGER,POINTER :: src_value(:)=>null()
-  END TYPE array
-  
-  TYPE t_buffer
-    REAL,POINTER    :: r(:)
-    INTEGER         :: size
-    INTEGER         :: rank
-  END TYPE t_buffer    
-    
-  TYPE t_request
-    INTEGER :: type_field
-    INTEGER :: max_size
-    INTEGER :: size
-    LOGICAL :: vector
-    INTEGER,POINTER :: src_domain(:)
-    INTEGER,POINTER :: src_i(:)
-    INTEGER,POINTER :: src_j(:)
-    INTEGER,POINTER :: src_ind(:)
-    INTEGER,POINTER :: target_ind(:)
-    INTEGER,POINTER :: target_i(:)
-    INTEGER,POINTER :: target_j(:)
-    INTEGER,POINTER :: target_sign(:)
-    INTEGER :: nrecv
-    TYPE(ARRAY),POINTER :: recv(:)
-    INTEGER :: nsend
-    INTEGER :: nreq_mpi
-    INTEGER :: nreq_send
-    INTEGER :: nreq_recv
-    TYPE(ARRAY),POINTER :: send(:)
-  END TYPE t_request
-  
-  TYPE(t_request),SAVE,POINTER :: req_i1(:)
-  TYPE(t_request),SAVE,POINTER :: req_e1_scal(:)
-  TYPE(t_request),SAVE,POINTER :: req_e1_vect(:)
-  TYPE(t_request),SAVE,POINTER :: req_z1_scal(:)
-  
-  TYPE(t_request),SAVE,POINTER :: req_i0(:)
-  TYPE(t_request),SAVE,POINTER :: req_e0_scal(:)
-  TYPE(t_request),SAVE,POINTER :: req_e0_vect(:)
-
-  TYPE t_reorder
-    INTEGER :: ind
-    INTEGER :: rank
-    INTEGER :: tag
-    INTEGER :: isend
-  END TYPE t_reorder  
-  
-  TYPE t_message
-    CHARACTER(LEN=100) :: name ! for debug
-    TYPE(t_request), POINTER :: request(:)
-    INTEGER :: nreq
-    INTEGER :: nreq_send
-    INTEGER :: nreq_recv
-    TYPE(t_reorder), POINTER :: reorder(:)
-    INTEGER, POINTER :: mpi_req(:)
-    INTEGER, POINTER :: status(:,:)
-    TYPE(t_buffer),POINTER :: buffers(:) 
-    TYPE(t_field),POINTER :: field(:)
-    LOGICAL :: completed
-    LOGICAL :: pending
-    LOGICAL :: open      ! for debug
-    INTEGER :: number
-    LOGICAL :: ondevice=.false. !<Ready to transfer ondevice field
-  END TYPE t_message
-
-
-  INTERFACE bcast_mpi
-    MODULE PROCEDURE bcast_mpi_c,                                                     &
-                     bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
-                     bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
-		     bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
-  END INTERFACE
-
-  integer :: profile_mpi_copies, profile_mpi_waitall, profile_mpi_omp_barrier
-
-CONTAINS
-       
-      
-  SUBROUTINE init_transfert
-  USE profiling_mod
-  USE domain_mod
-  USE dimensions
-  USE field_mod
-  USE metric
-  USE mpipara
-  USE mpi_mod
-  IMPLICIT NONE
-  INTEGER :: ind,i,j
-
-    CALL register_id('MPI', id_mpi)
-    CALL register_id('MPI_copies', profile_mpi_copies)
-    CALL register_id('MPI_waitall', profile_mpi_waitall)
-    CALL register_id('MPI_omp_barrier', profile_mpi_omp_barrier)
-
-    CALL create_request(field_t,req_i1)
-
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      DO i=ii_begin,ii_end+1
-        CALL request_add_point(ind,i,jj_begin-1,req_i1)
-      ENDDO
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_end+1,j,req_i1)
-      ENDDO    
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_end+1,req_i1)
-      ENDDO    
-
-      DO j=jj_begin,jj_end+1
-        CALL request_add_point(ind,ii_begin-1,j,req_i1)
-      ENDDO    
-    
-    ENDDO
-  
-    CALL finalize_request(req_i1)
-
-
-    CALL create_request(field_t,req_i0)
-
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-    
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_begin,req_i0)
-      ENDDO
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_end,j,req_i0)
-      ENDDO    
-    
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_end,req_i0)
-      ENDDO    
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_begin,j,req_i0)
-      ENDDO    
-    
-    ENDDO
- 
-    CALL finalize_request(req_i0)  
-
-
-    CALL create_request(field_u,req_e1_scal)
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_begin-1,req_e1_scal,rup)
-        CALL request_add_point(ind,i+1,jj_begin-1,req_e1_scal,lup)
-      ENDDO
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_end+1,j,req_e1_scal,left)
-      ENDDO    
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_end+1,j-1,req_e1_scal,lup)
-      ENDDO    
-    
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_end+1,req_e1_scal,ldown)
-        CALL request_add_point(ind,i-1,jj_end+1,req_e1_scal,rdown)
-      ENDDO    
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_begin-1,j,req_e1_scal,right)
-      ENDDO   
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_begin-1,j+1,req_e1_scal,rdown)
-      ENDDO   
-
-    ENDDO
-
-    CALL finalize_request(req_e1_scal)
-
-
-    CALL create_request(field_u,req_e0_scal)
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-
-
-      DO i=ii_begin+1,ii_end-1
-        CALL request_add_point(ind,i,jj_begin,req_e0_scal,right)
-        CALL request_add_point(ind,i,jj_end,req_e0_scal,right)
-      ENDDO
-    
-      DO j=jj_begin+1,jj_end-1
-        CALL request_add_point(ind,ii_begin,j,req_e0_scal,rup)
-        CALL request_add_point(ind,ii_end,j,req_e0_scal,rup)
-      ENDDO   
-
-      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e0_scal,left)
-      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e0_scal,ldown)
-      CALL request_add_point(ind,ii_begin+1,jj_end,req_e0_scal,left)
-      CALL request_add_point(ind,ii_end,jj_begin+1,req_e0_scal,ldown)
-
-    ENDDO
-
-    CALL finalize_request(req_e0_scal)
-
-
-    
-    CALL create_request(field_u,req_e1_vect,.TRUE.)
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_begin-1,req_e1_vect,rup)
-        CALL request_add_point(ind,i+1,jj_begin-1,req_e1_vect,lup)
-      ENDDO
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_end+1,j,req_e1_vect,left)
-      ENDDO    
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_end+1,j-1,req_e1_vect,lup)
-      ENDDO    
-    
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_end+1,req_e1_vect,ldown)
-        CALL request_add_point(ind,i-1,jj_end+1,req_e1_vect,rdown)
-      ENDDO    
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_begin-1,j,req_e1_vect,right)
-      ENDDO   
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_begin-1,j+1,req_e1_vect,rdown)
-      ENDDO   
-
-  
-    ENDDO  
-
-    CALL finalize_request(req_e1_vect)
-    
-    
-    CALL create_request(field_u,req_e0_vect,.TRUE.)
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
- 
-      DO i=ii_begin+1,ii_end-1
-        CALL request_add_point(ind,i,jj_begin,req_e0_vect,right)
-        CALL request_add_point(ind,i,jj_end,req_e0_vect,right)
-      ENDDO
-    
-      DO j=jj_begin+1,jj_end-1
-        CALL request_add_point(ind,ii_begin,j,req_e0_vect,rup)
-        CALL request_add_point(ind,ii_end,j,req_e0_vect,rup)
-      ENDDO   
-
-      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e0_vect,left)
-      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e0_vect,ldown)
-      CALL request_add_point(ind,ii_begin+1,jj_end,req_e0_vect,left)
-      CALL request_add_point(ind,ii_end,jj_begin+1,req_e0_vect,ldown)
-  
-    ENDDO  
-
-    CALL finalize_request(req_e0_vect)
-
-    CALL create_request(field_z,req_z1_scal)
-    DO ind=1,ndomain
-      CALL swap_dimensions(ind)
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_begin-1,req_z1_scal,vrup)
-        CALL request_add_point(ind,i+1,jj_begin-1,req_z1_scal,vup)
-      ENDDO
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_end+1,j,req_z1_scal,vlup)
-      ENDDO    
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_end+1,j-1,req_z1_scal,vup)
-      ENDDO    
-    
-      DO i=ii_begin,ii_end
-        CALL request_add_point(ind,i,jj_end+1,req_z1_scal,vdown)
-        CALL request_add_point(ind,i-1,jj_end+1,req_z1_scal,vrdown)
-      ENDDO    
-
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_begin-1,j,req_z1_scal,vrup)
-      ENDDO   
-      DO j=jj_begin,jj_end
-        CALL request_add_point(ind,ii_begin-1,j,req_z1_scal,vrdown)
-      ENDDO   
-
-    ENDDO
-
-    CALL finalize_request(req_z1_scal)
-
-  END SUBROUTINE init_transfert
-  
-  SUBROUTINE create_request(type_field,request,vector)
-  USE domain_mod
-  USE field_mod
-  IMPLICIT NONE
-    INTEGER :: type_field
-    TYPE(t_request),POINTER :: request(:)
-    LOGICAL,OPTIONAL :: vector
-    
-    TYPE(t_request),POINTER :: req
-    TYPE(t_domain),POINTER :: d
-    INTEGER :: ind
-    INTEGER :: max_size
-       
-    ALLOCATE(request(ndomain))
-
-    DO ind=1,ndomain
-      req=>request(ind)
-      d=>domain(ind)
-      IF (type_field==field_t) THEN
-        Max_size=2*(d%iim+2)+2*(d%jjm+2)
-      ELSE IF (type_field==field_u) THEN
-        Max_size=3*(2*(d%iim+2)+2*(d%jjm+2))
-      ELSE IF (type_field==field_z) THEN
-        Max_size=2*(2*(d%iim+2)+2*(d%jjm+2))
-      ENDIF
-
-      req%type_field=type_field
-      req%max_size=max_size*2
-      req%size=0
-      req%vector=.FALSE.
-      IF (PRESENT(vector)) req%vector=vector
-      ALLOCATE(req%src_domain(req%max_size))
-      ALLOCATE(req%src_ind(req%max_size))
-      ALLOCATE(req%target_ind(req%max_size))
-      ALLOCATE(req%src_i(req%max_size))
-      ALLOCATE(req%src_j(req%max_size))
-      ALLOCATE(req%target_i(req%max_size))
-      ALLOCATE(req%target_j(req%max_size))
-      ALLOCATE(req%target_sign(req%max_size))
-    ENDDO
-  
-  END SUBROUTINE create_request
-
-  SUBROUTINE reallocate_request(req)
-  IMPLICIT NONE
-    TYPE(t_request),POINTER :: req
-      
-    INTEGER,POINTER :: src_domain(:)
-    INTEGER,POINTER :: src_ind(:)
-    INTEGER,POINTER :: target_ind(:)
-    INTEGER,POINTER :: src_i(:)
-    INTEGER,POINTER :: src_j(:)
-    INTEGER,POINTER :: target_i(:)
-    INTEGER,POINTER :: target_j(:)
-    INTEGER,POINTER :: target_sign(:)
-
-    PRINT *,"REALLOCATE_REQUEST"
-    src_domain=>req%src_domain
-    src_ind=>req%src_ind
-    target_ind=>req%target_ind
-    src_i=>req%src_i
-    src_j=>req%src_j
-    target_i=>req%target_i
-    target_j=>req%target_j
-    target_sign=>req%target_sign
-
-    ALLOCATE(req%src_domain(req%max_size*2))
-    ALLOCATE(req%src_ind(req%max_size*2))
-    ALLOCATE(req%target_ind(req%max_size*2))
-    ALLOCATE(req%src_i(req%max_size*2))
-    ALLOCATE(req%src_j(req%max_size*2))
-    ALLOCATE(req%target_i(req%max_size*2))
-    ALLOCATE(req%target_j(req%max_size*2))
-    ALLOCATE(req%target_sign(req%max_size*2))
-    
-    req%src_domain(1:req%max_size)=src_domain(:)
-    req%src_ind(1:req%max_size)=src_ind(:)
-    req%target_ind(1:req%max_size)=target_ind(:)
-    req%src_i(1:req%max_size)=src_i(:)
-    req%src_j(1:req%max_size)=src_j(:)
-    req%target_i(1:req%max_size)=target_i(:)
-    req%target_j(1:req%max_size)=target_j(:)
-    req%target_sign(1:req%max_size)=target_sign(:)
-    
-    req%max_size=req%max_size*2
-         
-    DEALLOCATE(src_domain)
-    DEALLOCATE(src_ind)
-    DEALLOCATE(target_ind)
-    DEALLOCATE(src_i)
-    DEALLOCATE(src_j)
-    DEALLOCATE(target_i)
-    DEALLOCATE(target_j)
-    DEALLOCATE(target_sign)
-
-  END SUBROUTINE reallocate_request
-
-      
-    SUBROUTINE request_add_point(ind,i,j,request,pos)
-    USE domain_mod
-    USE field_mod
-    IMPLICIT NONE
-      INTEGER,INTENT(IN)            ::  ind
-      INTEGER,INTENT(IN)            :: i
-      INTEGER,INTENT(IN)            :: j
-      TYPE(t_request),POINTER :: request(:)
-      INTEGER,INTENT(IN),OPTIONAL  :: pos
-      
-      INTEGER :: src_domain
-      INTEGER :: src_iim,src_i,src_j,src_n,src_pos,src_delta
-      TYPE(t_request),POINTER :: req
-      TYPE(t_domain),POINTER :: d
-      
-      req=>request(ind)
-      d=>domain(ind)
-      
-      IF (req%max_size==req%size) CALL reallocate_request(req)
-      req%size=req%size+1
-      IF (req%type_field==field_t) THEN
-        src_domain=domain(ind)%assign_domain(i,j)
-        src_iim=domain_glo(src_domain)%iim
-        src_i=domain(ind)%assign_i(i,j)
-        src_j=domain(ind)%assign_j(i,j)
-
-        req%target_ind(req%size)=(j-1)*d%iim+i
-        req%target_sign(req%size)=1
-        req%src_domain(req%size)=src_domain
-        req%src_ind(req%size)=(src_j-1)*src_iim+src_i
-      ELSE IF (req%type_field==field_u) THEN
-        IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme'
-
-        src_domain=domain(ind)%edge_assign_domain(pos-1,i,j)
-        src_iim=domain_glo(src_domain)%iim
-        src_i=domain(ind)%edge_assign_i(pos-1,i,j)
-        src_j=domain(ind)%edge_assign_j(pos-1,i,j)
-        src_n=(src_j-1)*src_iim+src_i
-        src_delta=domain(ind)%delta(i,j)
-        src_pos=domain(ind)%edge_assign_pos(pos-1,i,j)+1
-                
-        req%target_ind(req%size)=(j-1)*d%iim+i+d%u_pos(pos)
-
-        req%target_sign(req%size)= 1
-        IF (req%vector) req%target_sign(req%size)= domain(ind)%edge_assign_sign(pos-1,i,j)
-
-        req%src_domain(req%size)=src_domain
-        req%src_ind(req%size)=src_n+domain_glo(src_domain)%u_pos(src_pos)
-
-      ELSE IF (req%type_field==field_z) THEN
-        IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme'
-
-        src_domain=domain(ind)%vertex_assign_domain(pos-1,i,j)
-        src_iim=domain_glo(src_domain)%iim
-        src_i=domain(ind)%vertex_assign_i(pos-1,i,j)
-        src_j=domain(ind)%vertex_assign_j(pos-1,i,j)
-        src_n=(src_j-1)*src_iim+src_i
-        src_delta=domain(ind)%delta(i,j)
-        src_pos=domain(ind)%vertex_assign_pos(pos-1,i,j)+1
-
-        
-        req%target_ind(req%size)=(j-1)*d%iim+i+d%z_pos(pos)
-        req%target_sign(req%size)=1
-        req%src_domain(req%size)=src_domain
-        req%src_ind(req%size)=src_n+domain_glo(src_domain)%z_pos(src_pos)
-      ENDIF
-  END SUBROUTINE request_add_point
-  
-  
-  SUBROUTINE Finalize_request(request)
-  USE mpipara
-  USE domain_mod
-  USE mpi_mod
-  IMPLICIT NONE
-    TYPE(t_request),POINTER :: request(:)
-    TYPE(t_request),POINTER :: req, req_src
-    INTEGER :: nb_domain_recv(0:mpi_size-1)
-    INTEGER :: nb_domain_send(0:mpi_size-1)
-    INTEGER :: tag_rank(0:mpi_size-1)
-    INTEGER :: nb_data_domain_recv(ndomain_glo)
-    INTEGER :: list_domain_recv(ndomain_glo)
-    INTEGER,ALLOCATABLE :: list_domain_send(:)
-    INTEGER             :: list_domain(ndomain)
-
-    INTEGER :: rank,i,j,pos
-    INTEGER :: size_,ind_glo,ind_loc
-    INTEGER :: isend, irecv, ireq, nreq, nsend, nrecv
-    INTEGER, ALLOCATABLE :: mpi_req(:)
-    INTEGER, ALLOCATABLE :: status(:,:)
-    INTEGER, ALLOCATABLE :: rank_list(:)
-    INTEGER, ALLOCATABLE :: offset(:)
-    LOGICAL,PARAMETER :: debug = .FALSE.
-
- 
-    IF (.NOT. using_mpi) RETURN
-    
-    DO ind_loc=1,ndomain
-      req=>request(ind_loc)
-      
-      nb_data_domain_recv(:) = 0
-      nb_domain_recv(:) = 0
-      tag_rank(:)=0
-      
-      DO i=1,req%size
-        ind_glo=req%src_domain(i)
-        nb_data_domain_recv(ind_glo)=nb_data_domain_recv(ind_glo)+1
-      ENDDO
- 
-      DO ind_glo=1,ndomain_glo
-        IF ( nb_data_domain_recv(ind_glo) > 0 )  nb_domain_recv(domglo_rank(ind_glo))=nb_domain_recv(domglo_rank(ind_glo))+1
-      ENDDO
-
-      req%nrecv=sum(nb_domain_recv(:))
-      ALLOCATE(req%recv(req%nrecv))
-
-      irecv=0
-      DO ind_glo=1,ndomain_glo
-        IF (nb_data_domain_recv(ind_glo)>0) THEN
-          irecv=irecv+1
-          list_domain_recv(ind_glo)=irecv
-          req%recv(irecv)%rank=domglo_rank(ind_glo)
-          req%recv(irecv)%size=nb_data_domain_recv(ind_glo)
-          req%recv(irecv)%domain=domglo_loc_ind(ind_glo)
-          ALLOCATE(req%recv(irecv)%value(req%recv(irecv)%size))
-          ALLOCATE(req%recv(irecv)%sign(req%recv(irecv)%size))
-          ALLOCATE(req%recv(irecv)%buffer(req%recv(irecv)%size))
-        ENDIF
-      ENDDO
-      
-      req%recv(:)%size=0
-      irecv=0
-      DO i=1,req%size
-        irecv=list_domain_recv(req%src_domain(i))
-        req%recv(irecv)%size=req%recv(irecv)%size+1
-        size_=req%recv(irecv)%size
-        req%recv(irecv)%value(size_)=req%src_ind(i)
-        req%recv(irecv)%buffer(size_)=req%target_ind(i)
-        req%recv(irecv)%sign(size_)=req%target_sign(i)
-      ENDDO
-    ENDDO
-
-    nb_domain_recv(:) = 0    
-    DO ind_loc=1,ndomain
-      req=>request(ind_loc)
-      
-      DO irecv=1,req%nrecv
-        rank=req%recv(irecv)%rank
-        nb_domain_recv(rank)=nb_domain_recv(rank)+1
-      ENDDO
-    ENDDO
-    
-    CALL MPI_Alltoall(nb_domain_recv,1,MPI_INTEGER,nb_domain_send,1,MPI_INTEGER,comm_icosa,ierr)     
-    
-
-    ALLOCATE(list_domain_send(sum(nb_domain_send)))
-    
-    nreq=sum(nb_domain_recv(:))+sum(nb_domain_send(:))
-    ALLOCATE(mpi_req(nreq))
-    ALLOCATE(status(MPI_STATUS_SIZE,nreq))
-    
-
-    ireq=0
-    DO ind_loc=1,ndomain
-      req=>request(ind_loc)
-      DO irecv=1,req%nrecv
-        ireq=ireq+1
-        CALL MPI_ISEND(req%recv(irecv)%domain,1,MPI_INTEGER,req%recv(irecv)%rank,0,comm_icosa, mpi_req(ireq),ierr)
-        IF (debug) PRINT *,"Isend ",req%recv(irecv)%domain, "from ", mpi_rank, "to ",req%recv(irecv)%rank, "tag ",0
-      ENDDO
-    ENDDO
-
-    IF (debug) PRINT *,"------------"    
-    j=0
-    DO rank=0,mpi_size-1
-      DO i=1,nb_domain_send(rank)
-        j=j+1
-        ireq=ireq+1
-        CALL MPI_IRECV(list_domain_send(j),1,MPI_INTEGER,rank,0,comm_icosa, mpi_req(ireq),ierr)
-        IF (debug) PRINT *,"IRecv ",list_domain_send(j), "from ", rank, "to ",mpi_rank, "tag ",0
-      ENDDO
-    ENDDO
-    IF (debug) PRINT *,"------------"    
-    
-    CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
-    
-    list_domain(:)=0
-    DO i=1,sum(nb_domain_send)
-      ind_loc=list_domain_send(i)
-      list_domain(ind_loc)=list_domain(ind_loc)+1
-    ENDDO
-    
-    DO ind_loc=1,ndomain
-      req=>request(ind_loc)
-      req%nsend=list_domain(ind_loc)
-      ALLOCATE(req%send(req%nsend))
-    ENDDO
-
-    IF (debug) PRINT *,"------------"    
-   
-   ireq=0 
-   DO ind_loc=1,ndomain
-     req=>request(ind_loc)
-     
-     DO irecv=1,req%nrecv
-       ireq=ireq+1
-       CALL MPI_ISEND(mpi_rank,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
-       IF (debug) PRINT *,"Isend ",mpi_rank, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
-     ENDDO
-    IF (debug) PRINT *,"------------"    
-     
-     DO isend=1,req%nsend
-       ireq=ireq+1
-       CALL MPI_IRECV(req%send(isend)%rank,1,MPI_INTEGER,MPI_ANY_SOURCE,ind_loc,comm_icosa, mpi_req(ireq),ierr)
-       IF (debug) PRINT *,"IRecv ",req%send(isend)%rank, "from ", "xxx", "to ",mpi_rank, "tag ",ind_loc
-     ENDDO
-   ENDDO
-
-   IF (debug) PRINT *,"------------"    
-
-   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
-   CALL MPI_BARRIER(comm_icosa,ierr)
-
-   IF (debug) PRINT *,"------------"    
-
-   ireq=0 
-   DO ind_loc=1,ndomain
-     req=>request(ind_loc)
-     
-     DO irecv=1,req%nrecv
-       ireq=ireq+1
-       CALL MPI_ISEND(ind_loc,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
-       IF (debug) PRINT *,"Isend ",ind_loc, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
-     ENDDO
-
-     IF (debug) PRINT *,"------------"    
-     
-     DO isend=1,req%nsend
-       ireq=ireq+1
-       CALL MPI_IRECV(req%send(isend)%domain,1,MPI_INTEGER,req%send(isend)%rank,ind_loc,comm_icosa, mpi_req(ireq),ierr)
-       IF (debug) PRINT *,"IRecv ",req%send(isend)%domain, "from ", req%send(isend)%rank, "to ",mpi_rank, "tag ",ind_loc
-     ENDDO
-   ENDDO
-   IF (debug) PRINT *,"------------"    
-   
-   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
-   CALL MPI_BARRIER(comm_icosa,ierr)
-   IF (debug) PRINT *,"------------"    
-
-   ireq=0
-   DO ind_loc=1,ndomain
-     req=>request(ind_loc)
-     
-     DO irecv=1,req%nrecv
-       ireq=ireq+1
-       req%recv(irecv)%tag=tag_rank(req%recv(irecv)%rank)
-       tag_rank(req%recv(irecv)%rank)=tag_rank(req%recv(irecv)%rank)+1
-       CALL MPI_ISEND(req%recv(irecv)%tag,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
-       IF (debug) PRINT *,"Isend ",req%recv(irecv)%tag, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
-     ENDDO
-   IF (debug) PRINT *,"------------"    
-     
-     DO isend=1,req%nsend
-       ireq=ireq+1
-       CALL MPI_IRECV(req%send(isend)%tag,1,MPI_INTEGER,req%send(isend)%rank,ind_loc,comm_icosa, mpi_req(ireq),ierr)
-       IF (debug) PRINT *,"IRecv ",req%send(isend)%tag, "from ", req%send(isend)%rank, "to ",mpi_rank, "tag ",ind_loc
-     ENDDO
-   ENDDO
-   IF (debug) PRINT *,"------------"    
-   
-   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
-   CALL MPI_BARRIER(comm_icosa,ierr)
-
-
-   IF (debug) PRINT *,"------------"    
-
-   ireq=0 
-   DO ind_loc=1,ndomain
-     req=>request(ind_loc)
-     
-     DO irecv=1,req%nrecv
-       ireq=ireq+1
-       CALL MPI_ISEND(req%recv(irecv)%size,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%tag,comm_icosa, mpi_req(ireq),ierr)
-       IF (debug) PRINT *,"Isend ",req%recv(irecv)%size, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
-     ENDDO
-     IF (debug) PRINT *,"------------"    
-     
-     DO isend=1,req%nsend
-       ireq=ireq+1
-       CALL MPI_IRECV(req%send(isend)%size,1,MPI_INTEGER,req%send(isend)%rank,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
-       IF (debug) PRINT *,"IRecv ",req%send(isend)%size, "from ", req%send(isend)%rank, "to ",mpi_rank, "tag ",ind_loc
-     ENDDO
-   ENDDO
-
-   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
-
-   ireq=0 
-   DO ind_loc=1,ndomain
-     req=>request(ind_loc)
-     
-     DO irecv=1,req%nrecv
-       ireq=ireq+1
-       CALL MPI_ISEND(req%recv(irecv)%value,req%recv(irecv)%size,MPI_INTEGER,&
-            req%recv(irecv)%rank,req%recv(irecv)%tag,comm_icosa, mpi_req(ireq),ierr)
-     ENDDO
-     
-     DO isend=1,req%nsend
-       ireq=ireq+1
-       ALLOCATE(req%send(isend)%value(req%send(isend)%size))
-       CALL MPI_IRECV(req%send(isend)%value,req%send(isend)%size,MPI_INTEGER,&
-            req%send(isend)%rank,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
-     ENDDO
-   ENDDO
-
-   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
-
-   DO ind_loc=1,ndomain
-     req=>request(ind_loc)
-     
-     DO irecv=1,req%nrecv
-       req%recv(irecv)%value(:)=req%recv(irecv)%buffer(:)
-       req%recv(irecv)%sign(:) =req%recv(irecv)%sign(:)
-       DEALLOCATE(req%recv(irecv)%buffer)
-     ENDDO
-   ENDDO  
-   
-
-! domain is on the same mpi process => copie memory to memory
-   
-   DO ind_loc=1,ndomain
-     req=>request(ind_loc)
-     
-     DO irecv=1,req%nrecv
-   
-       IF (req%recv(irecv)%rank==mpi_rank) THEN
-           req_src=>request(req%recv(irecv)%domain)
-           DO isend=1,req_src%nsend
-             IF (req_src%send(isend)%rank==mpi_rank .AND. req_src%send(isend)%tag==req%recv(irecv)%tag) THEN
-               req%recv(irecv)%src_value => req_src%send(isend)%value
-               IF ( size(req%recv(irecv)%value) /= size(req_src%send(isend)%value)) THEN
-                 PRINT *,ind_loc, irecv, isend, size(req%recv(irecv)%value), size(req_src%send(isend)%value)
-                 STOP "size(req%recv(irecv)%value) /= size(req_src%send(isend)%value"
-               ENDIF
-             ENDIF
-           ENDDO
-       ENDIF
-     
-     ENDDO
-   ENDDO
-   
-! true number of mpi request
-
-   request(:)%nreq_mpi=0
-   request(:)%nreq_send=0
-   request(:)%nreq_recv=0
-   ALLOCATE(rank_list(sum(request(:)%nsend)))
-   ALLOCATE(offset(sum(request(:)%nsend)))
-   offset(:)=0
-   
-   nsend=0
-   DO ind_loc=1,ndomain
-     req=>request(ind_loc)
-
-     DO isend=1,req%nsend
-       IF (req%send(isend)%rank/=mpi_rank) THEN
-         pos=0
-         DO i=1,nsend
-           IF (req%send(isend)%rank==rank_list(i)) EXIT
-           pos=pos+1
-         ENDDO
-        
-         IF (pos==nsend) THEN
-           nsend=nsend+1
-           req%nreq_mpi=req%nreq_mpi+1
-           req%nreq_send=req%nreq_send+1
-           IF (mpi_threading_mode==MPI_THREAD_FUNNELED .OR. mpi_threading_mode==MPI_THREAD_SINGLE) THEN
-             rank_list(nsend)=req%send(isend)%rank
-           ELSE
-             rank_list(nsend)=-1
-           ENDIF
-         ENDIF
-         
-         pos=pos+1
-         req%send(isend)%ireq=pos
-         req%send(isend)%offset=offset(pos)
-         offset(pos)=offset(pos)+req%send(isend)%size
-       ENDIF
-     ENDDO
-   ENDDO
-
-   DEALLOCATE(rank_list)
-   DEALLOCATE(offset)
-     
-   ALLOCATE(rank_list(sum(request(:)%nrecv)))
-   ALLOCATE(offset(sum(request(:)%nrecv)))
-   offset(:)=0
-   
-   nrecv=0
-   DO ind_loc=1,ndomain
-     req=>request(ind_loc)
-
-     DO irecv=1,req%nrecv
-       IF (req%recv(irecv)%rank/=mpi_rank) THEN
-         pos=0
-         DO i=1,nrecv
-           IF (req%recv(irecv)%rank==rank_list(i)) EXIT
-           pos=pos+1
-         ENDDO
-        
-         IF (pos==nrecv) THEN
-           nrecv=nrecv+1
-           req%nreq_mpi=req%nreq_mpi+1
-           req%nreq_recv=req%nreq_recv+1
-           IF (mpi_threading_mode==MPI_THREAD_FUNNELED .OR. mpi_threading_mode==MPI_THREAD_SINGLE) THEN
-             rank_list(nrecv)=req%recv(irecv)%rank
-           ELSE
-             rank_list(nrecv)=-1
-           ENDIF
-         ENDIF
-        
-         pos=pos+1
-         req%recv(irecv)%ireq=nsend+pos
-         req%recv(irecv)%offset=offset(pos)
-         offset(pos)=offset(pos)+req%recv(irecv)%size
-       ENDIF
-     ENDDO
-   ENDDO 
-
-! get the offsets   
-
-   ireq=0 
-   DO ind_loc=1,ndomain
-     req=>request(ind_loc)
-     
-     DO irecv=1,req%nrecv
-       ireq=ireq+1
-       CALL MPI_ISEND(req%recv(irecv)%offset,1,MPI_INTEGER,&
-            req%recv(irecv)%rank,req%recv(irecv)%tag,comm_icosa, mpi_req(ireq),ierr)
-     ENDDO
-     
-     DO isend=1,req%nsend
-       ireq=ireq+1
-       CALL MPI_IRECV(req%send(isend)%offset,1,MPI_INTEGER,&
-            req%send(isend)%rank,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
-     ENDDO
-   ENDDO
-
-   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
-      
-       
-  END SUBROUTINE Finalize_request 
-
-
-  SUBROUTINE init_message_seq(field, request, message, name)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  USE mpi_mod
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    TYPE(t_request),POINTER :: request(:)
-    TYPE(t_message) :: message
-    CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
-!$OMP MASTER    
-    message%request=>request
-    IF(PRESENT(name)) THEN
-       message%name = TRIM(name)
-    ELSE
-       message%name = 'unknown'
-    END IF
-!$OMP END MASTER    
-!$OMP BARRIER    
-
-  END SUBROUTINE init_message_seq
-
-  SUBROUTINE send_message_seq(field,message)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  USE omp_para
-  USE trace
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    TYPE(t_message) :: message
-
-    CALL transfert_request_seq(field,message%request)
-    
-  END SUBROUTINE send_message_seq
-  
-  SUBROUTINE test_message_seq(message)
-  IMPLICIT NONE
-    TYPE(t_message) :: message
-  END SUBROUTINE  test_message_seq
-  
-   
-  SUBROUTINE wait_message_seq(message)
-  IMPLICIT NONE
-    TYPE(t_message) :: message
-    
-  END SUBROUTINE wait_message_seq    
-
-  SUBROUTINE transfert_message_seq(field,message)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  USE omp_para
-  USE trace
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    TYPE(t_message) :: message
-
-   CALL send_message_seq(field,message)
-    
-  END SUBROUTINE transfert_message_seq    
-    
-
-
-    
-  SUBROUTINE init_message_mpi(field,request, message, name)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  USE mpi_mod
-  IMPLICIT NONE
-  
-    TYPE(t_field),POINTER :: field(:)
-    TYPE(t_request),POINTER :: request(:)
-    TYPE(t_message) :: message
-    CHARACTER(LEN=*), INTENT(IN),OPTIONAL :: name
-
-    TYPE(t_request),POINTER :: req
-    INTEGER :: irecv,isend
-    INTEGER :: ireq,nreq
-    INTEGER :: ind
-    INTEGER :: dim3,dim4
-    INTEGER,SAVE :: message_number=0
-!    TYPE(t_reorder),POINTER :: reorder(:)
-!    TYPE(t_reorder) :: reorder_swap
-
-!$OMP BARRIER
-!$OMP MASTER
+! Module for MPI communication of field halos
+! This module uses Fortran 2003 features : move_alloc intrinsic, pointer bounds remapping, allocatable type fields
+module transfert_mpi_mod
+  use abort_mod, only : dynamico_abort, abort_acc
+  use profiling_mod, only : enter_profile, exit_profile, register_id
+  use domain_mod, only : ndomain, ndomain_glo, domain, domain_glo, domloc_glo_ind, domglo_rank, domglo_loc_ind
+  use field_mod, only : t_field, field_T, field_U
+  use transfert_request_mod
+  implicit none
+  private
+
+  ! Describes how to pack/unpack a message from a local domain to another
+  type t_local_submessage
+    integer :: src_ind_loc, dest_ind_loc ! index of local and remote domain
+    integer, allocatable :: displ_src(:) ! List of indexes to copy from domain src_ind_loc
+    integer, allocatable :: displ_dest(:) ! List of indexes to copy to domain dest_ind_loc
+    integer, allocatable :: sign(:) ! Sign change to be applied for vector requests
+  end type
+
+  ! Describes how to pack/unpack a message from a domain to another, and contains MPI buffer
+  type t_submessage
+    integer :: ind_loc, remote_ind_glo ! index of local and remote domain
+    integer, allocatable :: displs(:) ! List of indexes to copy from field to buffer for each level
+    integer, allocatable :: sign(:) ! Sign change to be applied for vector requests
+    real, allocatable :: buff(:,:,:) ! MPI buffer buff(iim*jjm[*3],dim3,dim4)
+  end type
+
+  ! Describes how to exchange data for a field.
+  type t_message
+    type (t_field), pointer :: field(:) => null() ! Field to exchange
+    type (t_request), pointer :: request(:) => null() ! Type of message to send
+    type (t_local_submessage), pointer :: message_local(:) ! Local halo copies
+    type (t_submessage), pointer :: message_in(:) ! Messages to recieve from remote ranks and to copy back to the field
+    type (t_submessage), pointer :: message_out(:) ! Halos to copy to MPI buffer and to send to remote ranks
+    integer, pointer :: mpi_requests_in(:) ! MPI requests used for message_in.
+    integer, pointer :: mpi_requests_out(:) ! MPI requests used for message_out.
+    ! NOTE : requests are persistant requests initialized in init_message. MPI_Start and MPI_Wait are then used to initiate and complete communications.
+    ! ex : Give mpi_requests_in(i) to MPI_Start to send the buffer contained in message_in(i)
+    integer :: send_seq ! Sequence number : send_seq is incremented each time send_message is called
+    integer :: wait_seq ! Sequence number : wait_seq is incremented each time wait_message is called
+    logical :: ondevice ! Ready to transfer ondevice field
+  end type t_message
+
+  public :: t_message, t_request, &
+    req_i1, req_e1_scal, req_e1_vect, &
+    req_i0, req_e0_scal, req_e0_vect, &
+    req_z1_scal, &
+    init_transfert, &
+    init_message, &
+    finalize_message, &
+    send_message, &
+    wait_message, &
+    test_message
+
+  ! ---- Private variables ----
+  ! Profiling id for mpi
+  integer :: profile_mpi, profile_mpi_copies, profile_mpi_waitall, profile_mpi_barrier
+contains
+  ! Initialize transfert : must be called before any other transfert_mpi routines
+  subroutine init_transfert
+    use mpi_mod, only : MPI_THREAD_SINGLE, MPI_THREAD_FUNNELED
+    use mpipara, only : mpi_threading_mode
+    use profiling_mod, only : register_id
+    logical, parameter :: profile_mpi_detail = .true.
+
+    !$omp master
+    ! Check requested threads support
+    if( mpi_threading_mode /= MPI_THREAD_SINGLE .and. mpi_threading_mode /= MPI_THREAD_FUNNELED ) call dynamico_abort("Only single and funneled threading mode are supported.")
+
+    ! Register profiling ids
+    call register_id("MPI", profile_mpi)
+    if( profile_mpi_detail ) then
+      call register_id("MPI_copies", profile_mpi_copies)
+      call register_id("MPI_waitall", profile_mpi_waitall)
+      call register_id("MPI_omp_barrier", profile_mpi_barrier)
+    else
+      profile_mpi_copies = profile_mpi
+      profile_mpi_waitall = profile_mpi
+      profile_mpi_barrier = profile_mpi
+    endif
+
+    ! Initialize requests
+    call init_all_requests()
+    !$omp end master
+    !$omp barrier
+  end subroutine
+
+  subroutine init_message(field, request, message, name)
+    use mpi_mod
+    use mpipara
+    type(t_field), pointer, intent(in) :: field(:)
+    type(t_request),pointer, intent(in) :: request(:)
+    type(t_message), target, intent(out) :: message ! Needs intent out for call to finalize_message
+    character(len=*), intent(in),optional :: name
+    integer, parameter :: INITIAL_ALLOC_SIZE = 10, GROW_FACTOR = 2
+
+    type(t_submessage) :: submessage_in, submessage_out
+    type(t_local_submessage) :: submessage_local
+    integer :: dim3, dim4
+    integer :: ind, ind_loc, remote_ind_glo, i
+    integer :: message_in_size, message_out_size, message_local_size
+    type(t_local_submessage), allocatable :: message_local_tmp(:)
+    type(t_submessage), allocatable :: message_in_tmp(:), message_out_tmp(:)
+    type(t_submessage), pointer :: submessage
+
+    !$omp barrier
+    !$omp master
     !init off-device
     message%ondevice=.false.
-
-    IF(PRESENT(name)) THEN
-       message%name = TRIM(name)
-    ELSE
-       message%name = 'unknown'
-    END IF
-    message%number=message_number
-    message_number=message_number+1
-    IF (message_number==100) message_number=0
-
-  
-    message%request=>request
-    message%nreq=sum(message%request(:)%nreq_mpi)
-    message%nreq_send=sum(message%request(:)%nreq_send)
-    message%nreq_recv=sum(message%request(:)%nreq_recv)
-    nreq=message%nreq
-
-    ALLOCATE(message%mpi_req(nreq))
-    ALLOCATE(message%buffers(nreq))
-    ALLOCATE(message%status(MPI_STATUS_SIZE,nreq))
-    message%buffers(:)%size=0
-    message%pending=.FALSE.
-    message%completed=.FALSE.
-    message%open=.FALSE.
-
-    DO ind=1,ndomain
-      req=>request(ind)
-      DO isend=1,req%nsend
-        IF (req%send(isend)%rank/=mpi_rank) THEN
-          ireq=req%send(isend)%ireq 
-          message%buffers(ireq)%size=message%buffers(ireq)%size+req%send(isend)%size
-          message%buffers(ireq)%rank=req%send(isend)%rank
-        ENDIF
-      ENDDO
-      DO irecv=1,req%nrecv
-        IF (req%recv(irecv)%rank/=mpi_rank) THEN
-          ireq=req%recv(irecv)%ireq 
-          message%buffers(ireq)%size=message%buffers(ireq)%size+req%recv(irecv)%size
-          message%buffers(ireq)%rank=req%recv(irecv)%rank
-        ENDIF
-      ENDDO
-    ENDDO
-
-
-    IF (field(1)%data_type==type_real) THEN
-
-      IF (field(1)%ndim==2) THEN
-     
-        DO ireq=1,message%nreq
-          CALL allocate_mpi_buffer(message%buffers(ireq)%r,message%buffers(ireq)%size)
-        ENDDO
-      
-      ELSE  IF (field(1)%ndim==3) THEN
-      
-        dim3=size(field(1)%rval3d,2)
-        DO ireq=1,message%nreq
-          message%buffers(ireq)%size=message%buffers(ireq)%size*dim3
-          CALL allocate_mpi_buffer(message%buffers(ireq)%r,message%buffers(ireq)%size)
-        ENDDO
-      
-      ELSE  IF (field(1)%ndim==4) THEN
-        dim3=size(field(1)%rval4d,2)
-        dim4=size(field(1)%rval4d,3)
-        DO ireq=1,message%nreq
-          message%buffers(ireq)%size=message%buffers(ireq)%size*dim3*dim4
-          CALL allocate_mpi_buffer(message%buffers(ireq)%r,message%buffers(ireq)%size)
-        ENDDO
-      ENDIF      
-    ENDIF
-      
-         
+    message%send_seq = 0
+    message%wait_seq = 0
+    ! Set field%rval4d pointer to always use 4d array
+    do ind = 1, ndomain
+      if( field(ind)%ndim == 2 ) field(ind)%rval4d(1:size(field(ind)%rval2d,1),1:1,1:1) => field(ind)%rval2d
+      ! This is Fortran 2008 : can be avoided by using a subroutine with rval3d as a 1D dummy argument
+      ! (/!\ : using a subroutine might generate a temporary contiguous array)
+      if( field(ind)%ndim == 3 ) field(ind)%rval4d(1:size(field(ind)%rval3d,1), &
+        1:size(field(ind)%rval3d,2), 1:1) => field(ind)%rval3d
+    end do
+    dim3 = size(field(1)%rval4d,2)
+    dim4 = size(field(1)%rval4d,3)
+    message%field => field
+    message%request => request
+    ! Create list of inbound/outbound/local messages
+    allocate(message_in_tmp(INITIAL_ALLOC_SIZE))
+    message_in_size=0
+    allocate(message_out_tmp(INITIAL_ALLOC_SIZE))
+    message_out_size=0
+    allocate(message_local_tmp(INITIAL_ALLOC_SIZE))
+    message_local_size=0
+    do ind_loc = 1, ndomain
+      do remote_ind_glo = 1, ndomain_glo
+        if( domglo_rank(remote_ind_glo) == mpi_rank ) then ! If sending to local domain
+          if(request(ind_loc)%points_HtoB(remote_ind_glo)%npoints > 0 ) then ! Add only non-empty messages
+            ! Add local message ind_loc -> remote_ind_glo, aggregarting submessage_in and submessage_out into submessage_local
+            submessage_out = make_submessage( request(ind_loc)%points_HtoB(remote_ind_glo), &
+                                              ind_loc, remote_ind_glo, dim3, dim4, request(1)%vector )
+            submessage_in = make_submessage(request(domglo_loc_ind(remote_ind_glo))%points_BtoH(domloc_glo_ind(ind_loc)), &
+                                            domglo_loc_ind(remote_ind_glo), domloc_glo_ind(ind_loc), dim3, dim4, request(1)%vector)
+            submessage_local%src_ind_loc = ind_loc
+            submessage_local%dest_ind_loc = domglo_loc_ind(remote_ind_glo)
+            submessage_local%displ_src = submessage_out%displs
+            submessage_local%displ_dest = submessage_in%displs
+            submessage_local%sign = submessage_in%sign
+            ! Add to local message list
+            call array_append_local_submessage( message_local_tmp, message_local_size, submessage_local)
+          endif
+        else ! If remote domain
+          ! When data to send to remote_domain, add submessage in message%message_out
+          if( request(ind_loc)%points_HtoB(remote_ind_glo)%npoints > 0 ) then
+            submessage_out = make_submessage( request(ind_loc)%points_HtoB(remote_ind_glo), &
+                                              ind_loc, remote_ind_glo, dim3, dim4, request(1)%vector )
+            call array_append_submessage( message_out_tmp, message_out_size, submessage_out )
+          end if
+          if( request(ind_loc)%points_BtoH(remote_ind_glo)%npoints > 0 ) then
+            submessage_in = make_submessage( request(ind_loc)%points_BtoH(remote_ind_glo), &
+                                             ind_loc, remote_ind_glo, dim3, dim4, request(1)%vector )
+            call array_append_submessage( message_in_tmp, message_in_size, submessage_in )
+          end if
+        end if
+      end do
+    end do
+    ! Trim message_xx_tmp and put it in message%message_xx
+    allocate(message%message_in(message_in_size)); message%message_in(:) = message_in_tmp(:message_in_size)
+    allocate(message%message_out(message_out_size)); message%message_out(:) = message_out_tmp(:message_out_size)
+    allocate(message%message_local(message_local_size)); message%message_local(:) = message_local_tmp(:message_local_size)
+
+    ! Create MPI Persistant Send/Recv requests
+    allocate( message%mpi_requests_in(size(message%message_in)) )
+    allocate( message%mpi_requests_out(size(message%message_out)) )
+    do i=1, size(message%message_out)
+      submessage => message%message_out(i)
+      call MPI_Send_init( submessage%buff, size(submessage%buff), MPI_DOUBLE, domglo_rank(submessage%remote_ind_glo), &
+        submessage%remote_ind_glo+ndomain_glo*domloc_glo_ind(submessage%ind_loc), &
+        comm_icosa, message%mpi_requests_out(i), ierr )
+    end do
+    do i=1, size(message%message_in)
+      submessage => message%message_in(i)
+      call MPI_Recv_init( submessage%buff, size(submessage%buff), MPI_DOUBLE, domglo_rank(submessage%remote_ind_glo), &
+        domloc_glo_ind(submessage%ind_loc)+ndomain_glo*submessage%remote_ind_glo, &
+        comm_icosa,  message%mpi_requests_in(i), ierr )
+    end do
+    !$omp end master
+    !$omp barrier
+  contains
+    ! Generate submessage from points
+    function make_submessage(points, ind_loc, remote_ind_glo, dim3, dim4, vector) result(submessage)
+      use dimensions, only : swap_dimensions, iim, u_pos
+      type(t_points), intent(in) :: points
+      integer, intent(in) :: ind_loc, remote_ind_glo, dim3, dim4
+      logical, intent(in) :: vector
+      integer :: k
+      type(t_submessage) :: submessage
+
+      call swap_dimensions(ind_loc)
+      submessage%ind_loc = ind_loc
+      submessage%remote_ind_glo = remote_ind_glo
+      allocate( submessage%buff( points%npoints, dim3, dim4 ) )
+      allocate( submessage%displs( points%npoints ) )
+      submessage%displs(:) = points%i + (points%j-1)*iim
+      if(allocated(points%edge)) submessage%displs = submessage%displs + u_pos( points%edge )
+      allocate(submessage%sign( points%npoints ))
+      if( vector ) then
+        submessage%sign(:) = (/( domain(ind_loc)%edge_assign_sign(points%edge(k)-1, points%i(k), points%j(k)) ,k=1,points%npoints)/)
+      else
+        submessage%sign(:) = 1
+      endif
+    end function
+
+    ! Add element to array, and reallocate if necessary
+    subroutine array_append_submessage( a, a_size, elt )
+      type(t_submessage), allocatable, intent(inout) :: a(:)
+      integer, intent(inout) :: a_size
+      type(t_submessage), intent(in) :: elt
+      type(t_submessage), allocatable :: a_tmp(:)
+      integer, parameter :: GROW_FACTOR = 2
+
+      if( size( a ) <= a_size ) then
+        allocate( a_tmp ( a_size * GROW_FACTOR ) )
+        a_tmp(1:a_size) = a(1:a_size)
+        call move_alloc(a_tmp, a)
+      end if
+      a_size = a_size + 1
+      a(a_size) = elt;
+    end subroutine
+    ! Add element to array, and reallocate if necessary
+    subroutine array_append_local_submessage( a, a_size, elt )
+      type(t_local_submessage), allocatable, intent(inout) :: a(:)
+      integer, intent(inout) :: a_size
+      type(t_local_submessage), intent(in) :: elt
+      type(t_local_submessage), allocatable :: a_tmp(:)
+      integer, parameter :: GROW_FACTOR = 2
+
+      if( size( a ) <= a_size ) then
+        allocate( a_tmp ( a_size * GROW_FACTOR ) )
+        a_tmp(1:a_size) = a(1:a_size)
+        call move_alloc(a_tmp, a)
+      end if
+      a_size = a_size + 1
+      a(a_size) = elt;
+    end subroutine
+    ! Je demande pardon au dieu du copier-coller car j'ai pÃ©chÃ©
+  end subroutine
+
+  subroutine message_create_ondevice(message)
+    use mpi_mod
+    use mpipara, only : comm_icosa
+    type(t_message), intent(inout) :: message
+    type(t_submessage), pointer :: submessage
+    integer :: i, ierr
+
+    if( message%ondevice ) call dynamico_abort("Message already on device")
+
+    !$acc enter data copyin(message) async
+    !$acc enter data copyin(message%message_in(:)) async
+    do i = 1, size( message%message_in )
+      !$acc enter data copyin(message%message_in(i)%buff(:,:,:)) async
+      !$acc enter data copyin(message%message_in(i)%displs(:)) async
+      !$acc enter data copyin(message%message_in(i)%sign(:)) async
+    end do
+    !$acc enter data copyin(message%message_out(:)) async
+    do i = 1, size( message%message_out )
+      !$acc enter data copyin(message%message_out(i)%buff(:,:,:)) async
+      !$acc enter data copyin(message%message_out(i)%displs(:)) async
+      !!$acc enter data copyin(message%message_out(i)%sign(:)) async
+    end do
+    !$acc enter data copyin(message%message_local(:)) async
+    do i = 1, size( message%message_local )
+      !$acc enter data copyin(message%message_local(i)%displ_src(:)) async
+      !$acc enter data copyin(message%message_local(i)%displ_dest(:)) async
+      !$acc enter data copyin(message%message_local(i)%sign(:)) async
+    end do
+    !$acc enter data copyin(message%field(:)) async
+    do i = 1, ndomain
+      !$acc enter data copyin(message%field(i)%rval4d(:,:,:)) async
+    end do
+
+    do i=1, size(message%message_out)
+      submessage => message%message_out(i)
+      call MPI_Request_free(message%mpi_requests_out(i), ierr)
+      !$acc host_data use_device(submessage%buff)
+      call MPI_Send_init( submessage%buff, size(submessage%buff), MPI_DOUBLE, domglo_rank(submessage%remote_ind_glo), &
+        submessage%remote_ind_glo+ndomain_glo*domloc_glo_ind(submessage%ind_loc), &
+        comm_icosa, message%mpi_requests_out(i), ierr )
+      !$acc end host_data
+    end do
+    do i=1, size(message%message_in)
+      submessage => message%message_in(i)
+      call MPI_Request_free(message%mpi_requests_in(i), ierr)
+      !$acc host_data use_device(submessage%buff)
+      call MPI_Recv_init( submessage%buff, size(submessage%buff), MPI_DOUBLE, domglo_rank(submessage%remote_ind_glo), &
+        domloc_glo_ind(submessage%ind_loc)+ndomain_glo*submessage%remote_ind_glo, &
+        comm_icosa,  message%mpi_requests_in(i), ierr )
+      !$acc end host_data
+    end do
+
+    message%ondevice=.true.
+    !!$acc update device(message%ondevice)
+  end subroutine
+
+  subroutine message_delete_ondevice(message)
+    type(t_message), intent(inout) :: message
+    integer :: i
+
+    if( .not. message%ondevice ) call dynamico_abort("Message not on device")
+
+    do i = 1, size( message%message_in )
+      !$acc exit data delete(message%message_in(i)%buff(:,:,:)) async
+      !$acc exit data delete(message%message_in(i)%displs(:)) async
+      !$acc exit data delete(message%message_in(i)%sign(:)) async
+    end do
+    !$acc exit data delete(message%message_in(:)) async
+    do i = 1, size( message%message_out )
+      !$acc exit data delete(message%message_out(i)%buff(:,:,:)) async
+      !$acc exit data delete(message%message_out(i)%displs(:)) async
+      !!$acc exit data delete(message%message_out(i)%sign(:)) async
+    end do
+    !$acc exit data delete(message%message_out(:)) async
+    do i = 1, size( message%message_local )
+      !$acc exit data delete(message%message_local(i)%displ_src(:)) async
+      !$acc exit data delete(message%message_local(i)%displ_dest(:)) async
+      !$acc exit data delete(message%message_local(i)%sign(:)) async
+    end do
+    !$acc exit data delete(message%message_local(:)) async
+
+    do i = 1, ndomain
+      !$acc exit data delete(message%field(i)%rval4d(:,:,:)) async
+    end do
+    !$acc exit data delete(message%field(:)) async
+    !$acc exit data delete(message) async
+    message%ondevice=.false.
+  end subroutine
+
+  subroutine finalize_message(message)
+    type(t_message), intent(inout) :: message
+    integer :: i, ierr
+
+    !$omp barrier
+    !$omp master
+    if(message%send_seq /= message%wait_seq) call dynamico_abort("No matching wait_message before finalization")
+
+    if(message%ondevice) call message_delete_ondevice(message)
+    deallocate(message%message_in)
+    deallocate(message%message_out)
+    deallocate(message%message_local)
+    do i=1, size(message%mpi_requests_in)
+      call MPI_Request_free(message%mpi_requests_in(i), ierr)
+    end do
+    deallocate(message%mpi_requests_in)
+    do i=1, size(message%mpi_requests_out)
+      call MPI_Request_free(message%mpi_requests_out(i), ierr)
+    end do
+    deallocate(message%mpi_requests_out)
+    !$omp end master
+    !$omp barrier
+  end subroutine
+
+  subroutine send_message(field, message)
+    use mpi_mod
+    use domain_mod, only : assigned_domain
+    use omp_para, only : distrib_level
+    type(t_field),pointer :: field(:)
+    type(t_message), target :: message
+    integer :: i, k, d3, d4
+    integer :: ierr, d3_begin, d3_end, dim4
+
+    call enter_profile(profile_mpi)
+
+    ! Needed because rval4d is set in init_message
+    if( .not. associated( message%field, field ) ) &
+      call dynamico_abort("send_message must be called with the same field used in init_message")
+
+    !Prepare 'message' for on-device copies if field is on device
+    !$omp master
+    if( field(1)%ondevice .and. .not. message%ondevice ) call message_create_ondevice(message)
+    if( field(1)%ondevice .neqv. message%ondevice ) call dynamico_abort("send_message : internal device/host memory synchronization error")
+    ! Check if previous message has been waited
+    if(message%send_seq /= message%wait_seq) &
+      call dynamico_abort("No matching wait_message before new send_message")
+    message%send_seq = message%send_seq + 1
+    !$omp end master
     
-! ! Reorder the request, so recv request are done in the same order than send request
-
-!    nreq_send=sum(request(:)%nsend)  
-!    message%nreq_send=nreq_send
-!    ALLOCATE(message%reorder(nreq_send))
-!    reorder=>message%reorder
-!    ireq=0
-!    DO ind=1,ndomain
-!      req=>request(ind)
-!      DO isend=1,req%nsend
-!        ireq=ireq+1
-!        reorder(ireq)%ind=ind
-!        reorder(ireq)%isend=isend
-!        reorder(ireq)%tag=req%send(isend)%tag
-!      ENDDO
-!    ENDDO
-
-! ! do a very very bad sort
-!    DO i=1,nreq_send-1
-!      DO j=i+1,nreq_send
-!        IF (reorder(i)%tag > reorder(j)%tag) THEN
-!          reorder_swap=reorder(i)
-!          reorder(i)=reorder(j)
-!          reorder(j)=reorder_swap
-!        ENDIF
-!      ENDDO
-!    ENDDO
-!    PRINT *,"reorder ",reorder(:)%tag
-    
- 
-!$OMP END MASTER
-!$OMP BARRIER    
-
-  END SUBROUTINE init_message_mpi
-  
-  SUBROUTINE Finalize_message_mpi(field,message)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  USE mpi_mod
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    TYPE(t_message) :: message
-
-    INTEGER :: ireq, ibuff
-
-!$OMP BARRIER
-!$OMP MASTER
-
-
-    IF (message%field(1)%data_type==type_real) THEN
-      DO ireq=1,message%nreq
-        CALL free_mpi_buffer(message%buffers(ireq)%r)
-      ENDDO    
-    ENDIF
-
-    !deallocate device data if ondevice
-    if(message%ondevice) then
-      do ireq=1, ndomain
-        do ibuff=1,message%request(ireq)%nsend
-          !$acc exit data delete(message%request(ireq)%send(ibuff)%buffer(:))
-          !$acc exit data delete(message%request(ireq)%send(ibuff)%buffer_r(:))
-          !$acc exit data delete(message%request(ireq)%send(ibuff)%sign(:))
-          !$acc exit data delete(message%request(ireq)%send(ibuff)%src_value(:))
-          !$acc exit data delete(message%request(ireq)%send(ibuff)%value(:))
+    call enter_profile(profile_mpi_barrier)
+    !$omp barrier
+    call exit_profile(profile_mpi_barrier)
+
+    dim4 = size(message%field(1)%rval4d, 3)
+    CALL distrib_level( 1, size(message%field(1)%rval4d, 2), d3_begin, d3_end )
+
+    call enter_profile(profile_mpi_copies)
+    !$acc data present(message) async if(message%ondevice)
+
+    ! Halo to Buffer : copy outbound message to MPI buffers
+    !$acc parallel loop default(none) present(message, assigned_domain) async if(message%ondevice)
+    do i = 1, size( message%message_out )
+      if( assigned_domain( message%message_out(i)%ind_loc ) ) then
+        !$acc loop collapse(2)
+        do d4 = 1, dim4
+          do d3 = d3_begin, d3_end
+            !$acc loop
+             do k = 1, size(message%message_out(i)%displs)
+              message%message_out(i)%buff(k,d3,d4) = message%field(message%message_out(i)%ind_loc)%rval4d(message%message_out(i)%displs(k),d3, d4)
+            end do
+          end do
         end do
-        do ibuff=1,message%request(ireq)%nrecv
-          !$acc exit data delete(message%request(ireq)%recv(ibuff)%buffer(:))
-          !$acc exit data delete(message%request(ireq)%recv(ibuff)%buffer_r(:))
-          !$acc exit data delete(message%request(ireq)%recv(ibuff)%sign(:))
-          !$acc exit data delete(message%request(ireq)%recv(ibuff)%src_value(:))
-          !$acc exit data delete(message%request(ireq)%recv(ibuff)%value(:))
+      endif
+    end do
+
+    ! Halo to Halo : copy local messages from source field to destination field
+    !$acc parallel loop default(none) present(message, assigned_domain) async if(message%ondevice)
+    do i = 1, size( message%message_local )
+      if( assigned_domain( message%message_local(i)%dest_ind_loc ) ) then
+        !$acc loop collapse(2) 
+        do d4 = 1, dim4
+          do d3 = d3_begin, d3_end
+            ! Cannot collapse because size(displ_dest) varies with i
+            !$acc loop vector
+            do k = 1, size(message%message_local(i)%displ_dest)
+              message%field(message%message_local(i)%dest_ind_loc)%rval4d(message%message_local(i)%displ_dest(k),d3,d4) = &
+                message%message_local(i)%sign(k)*message%field(message%message_local(i)%src_ind_loc)%rval4d(message%message_local(i)%displ_src(k),d3,d4)
+            end do
+          end do
         end do
-      end do
-      DO ireq=1,message%nreq
-        !$acc exit data delete(message%buffers(ireq)%r)
-      ENDDO
-      message%ondevice=.false.
+      endif
+    end do
+
+    !$acc end data
+    call exit_profile(profile_mpi_copies)
+
+
+    call enter_profile(profile_mpi_barrier)
+    !$acc wait
+    !$omp barrier
+    call exit_profile(profile_mpi_barrier)
+
+    !$omp master
+    call MPI_Startall( size(message%mpi_requests_out), message%mpi_requests_out, ierr )
+    call MPI_Startall( size(message%mpi_requests_in), message%mpi_requests_in, ierr )
+    !$omp end master
+
+    call exit_profile(profile_mpi)
+  end subroutine
+
+  subroutine test_message(message)
+    use mpi_mod
+    type(t_message) :: message
+    integer :: ierr
+    logical :: completed
+
+    !$omp master
+    call MPI_Testall( size(message%mpi_requests_out), message%mpi_requests_out, completed, MPI_STATUSES_IGNORE, ierr )
+    call MPI_Testall( size(message%mpi_requests_in), message%mpi_requests_in, completed, MPI_STATUSES_IGNORE, ierr )
+    !$omp end master
+  end subroutine
+
+  subroutine wait_message(message)
+    use mpi_mod
+    use domain_mod, only : assigned_domain
+    use omp_para, only : distrib_level
+    type(t_message), target :: message
+    integer :: d3_begin, d3_end, dim4
+    integer :: i, ierr, k, d3, d4
+
+    ! Check if message has been sent and not recieved yet
+    ! note : barrier needed between this and send_seq increment, and this and wait_seq increment
+    ! note : watch out for integer overflow a = b+1 doesn't imply a>b
+    if(message%send_seq /= message%wait_seq+1) then
+      print*, "WARNING : wait_message called multiple times for one send_message, skipping"
+      return ! Don't recieve message if already recieved
     end if
 
-    DEALLOCATE(message%mpi_req)
-    DEALLOCATE(message%buffers)
-    DEALLOCATE(message%status)
-
-!$OMP END MASTER
-!$OMP BARRIER
-
-      
-  END SUBROUTINE Finalize_message_mpi
-
-
-  
-  SUBROUTINE barrier
-  USE mpi_mod
-  USE mpipara
-  IMPLICIT NONE
-    
-    CALL MPI_BARRIER(comm_icosa,ierr)
-    
-  END SUBROUTINE barrier  
-    
-  SUBROUTINE transfert_message_mpi(field,message)
-  USE field_mod
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    TYPE(t_message) :: message
-    
-    CALL send_message_mpi(field,message)
-    CALL wait_message_mpi(message)
-    
-  END SUBROUTINE transfert_message_mpi
-
-
-  !!!Update buffers on device for 'message'
-  !!! does create_device_message when not already ondevice
-  SUBROUTINE update_device_message_mpi(message)
-    USE domain_mod
-    IMPLICIT NONE
-    TYPE(t_message), intent(inout) :: message
-    INTEGER :: ireq, ibuff
-
-    !if(.not. message%ondevice) call create_device_message_mpi(message)
-
-    do ireq=1, ndomain
-      do ibuff=1,message%request(ireq)%nsend
-        !device buffers updated even if pointers not attached :
-        !non allocated buffers in 'message' must be set to NULL()
-        !$acc enter data copyin(message%request(ireq)%send(ibuff)%buffer(:)) async
-        !$acc enter data copyin(message%request(ireq)%send(ibuff)%buffer_r(:)) async
-        !$acc enter data copyin(message%request(ireq)%send(ibuff)%sign(:)) async
-        !$acc enter data copyin(message%request(ireq)%send(ibuff)%src_value(:)) async
-        !$acc enter data copyin(message%request(ireq)%send(ibuff)%value(:)) async
-      end do
-      do ibuff=1,message%request(ireq)%nrecv
-        !$acc enter data copyin(message%request(ireq)%recv(ibuff)%buffer(:)) async
-        !$acc enter data copyin(message%request(ireq)%recv(ibuff)%buffer_r(:)) async
-        !$acc enter data copyin(message%request(ireq)%recv(ibuff)%sign(:)) async
-        !$acc enter data copyin(message%request(ireq)%recv(ibuff)%src_value(:)) async
-        !$acc enter data copyin(message%request(ireq)%recv(ibuff)%value(:)) async
-      end do
-    end do
-    DO ireq=1,message%nreq
-      !$acc enter data copyin(message%buffers(ireq)%r) async
-    ENDDO
-    message%ondevice=.true.
-  END SUBROUTINE
-
-  !TODO : add openacc with multiple process
-  SUBROUTINE send_message_mpi(field,message)
-  USE abort_mod
-  USE profiling_mod
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  USE omp_para
-  USE trace
-  USE abort_mod
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    TYPE(t_message) :: message
-    REAL(rstd),POINTER :: rval2d(:), src_rval2d(:) 
-    REAL(rstd),POINTER :: rval3d(:,:), src_rval3d(:,:) 
-    REAL(rstd),POINTER :: rval4d(:,:,:), src_rval4d(:,:,:) 
-    REAL(rstd),POINTER :: buffer_r(:) 
-    INTEGER,POINTER :: value(:) 
-    INTEGER,POINTER :: sgn(:) 
-    TYPE(ARRAY),POINTER :: recv,send 
-    TYPE(t_request),POINTER :: req
-    INTEGER :: irecv,isend
-    INTEGER :: ireq
-    INTEGER :: ind,n
-    INTEGER :: dim3,dim4,d3,d4
-    INTEGER,POINTER :: src_value(:)
-    INTEGER :: offset,msize,moffset,rank
-    INTEGER :: lbegin, lend
-    INTEGER :: max_req
-
-!    CALL trace_start("send_message_mpi")
-
-    CALL enter_profile(id_mpi)
-
-    !Prepare 'message' for on-device copies if field is on device
-    if( field(1)%ondevice .AND. .NOT. message%ondevice ) call update_device_message_mpi(message)
-
-CALL enter_profile(profile_mpi_omp_barrier)
-!$OMP BARRIER
-CALL exit_profile(profile_mpi_omp_barrier)
-
-
-!$OMP MASTER
-    IF(message%open) THEN
-       PRINT *, 'send_message_mpi : message ' // TRIM(message%name) // &
-            ' is still open, no call to wait_message_mpi after last send_message_mpi'
-       CALL dynamico_abort( "send_message_mpi : message still open" )
-    END IF
-    message%open=.TRUE. ! will be set to .FALSE. by wait_message_mpi
-
-    message%field=>field
-
-    IF (message%nreq>0) THEN
-      message%completed=.FALSE.
-      message%pending=.TRUE.
-    ELSE
-      message%completed=.TRUE.
-      message%pending=.FALSE.
-    ENDIF
-!$OMP END MASTER
-CALL enter_profile(profile_mpi_omp_barrier)
-!$OMP BARRIER
-CALL exit_profile(profile_mpi_omp_barrier)
-     
-    IF (field(1)%data_type==type_real) THEN
-      IF (field(1)%ndim==2) THEN
-
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-          
-          rval2d=>field(ind)%rval2d
-        
-          req=>message%request(ind)
-          DO isend=1,req%nsend
-            send=>req%send(isend)
-            value=>send%value
-
-            
-            IF (send%rank/=mpi_rank) THEN
-              ireq=send%ireq
-
-              buffer_r=>message%buffers(ireq)%r
-              offset=send%offset
-              msize=send%size
-              call enter_profile(profile_mpi_copies)
-              !$acc parallel loop default(present) async if (field(ind)%ondevice)
-              DO n=1,msize
-                buffer_r(offset+n)=rval2d(value(n))
-              ENDDO
-              call exit_profile(profile_mpi_copies)
-
-              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
-                CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
-                !$OMP CRITICAL            
-                CALL MPI_ISEND(buffer_r,send%size,MPI_REAL8,send%rank,               &
-                  send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
-                !$OMP END CRITICAL
-              ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
-                CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
-                CALL MPI_ISEND(buffer_r,send%size,MPI_REAL8,send%rank,               &
-                  send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
-              ENDIF
-             
-            ENDIF
-          ENDDO
-        ENDDO
-        
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-          rval2d=>field(ind)%rval2d
-          req=>message%request(ind)        
-
-          DO irecv=1,req%nrecv
-            recv=>req%recv(irecv)
-
-            IF (recv%rank==mpi_rank) THEN
-
-              value=>recv%value
-              src_value => recv%src_value
-              src_rval2d=>field(recv%domain)%rval2d
-              sgn=>recv%sign
-              msize=recv%size
-              call enter_profile(profile_mpi_copies)
-              !$acc parallel loop default(present) async if (field(ind)%ondevice)
-              DO n=1,msize
-                rval2d(value(n))=src_rval2d(src_value(n))*sgn(n)
-              ENDDO
-              call exit_profile(profile_mpi_copies)
-                    
-            ELSE
-            
-              ireq=recv%ireq
-              buffer_r=>message%buffers(ireq)%r
-              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
-                CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
-               !$OMP CRITICAL            
-                CALL MPI_IRECV(buffer_r,recv%size,MPI_REAL8,recv%rank,               &
-                  recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
-               !$OMP END CRITICAL
-              ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
-                 CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
-                 CALL MPI_IRECV(buffer_r,recv%size,MPI_REAL8,recv%rank,              &
-                   recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
-              ENDIF
-            
-            ENDIF
-          ENDDO
-        
-        ENDDO
-        
-      
-      ELSE  IF (field(1)%ndim==3) THEN
-        max_req=0
-        DO ind=1,ndomain
-          req=>message%request(ind)
-          IF (req%nsend>max_req) max_req=req%nsend
-        ENDDO
-              
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) ) CYCLE
-
-          dim3=size(field(ind)%rval3d,2)
-          CALL distrib_level(1,dim3, lbegin,lend)
-
-          rval3d=>field(ind)%rval3d
-          req=>message%request(ind)
- 
-          DO isend=1,req%nsend
-            send=>req%send(isend)
-            value=>send%value
-
-            IF (send%rank/=mpi_rank) THEN
-              ireq=send%ireq
-              buffer_r=>message%buffers(ireq)%r
-
-              msize=send%size
-              moffset=send%offset
-              call enter_profile(profile_mpi_copies)
-
-              !$acc parallel loop default(present) async if (field(ind)%ondevice)
-              DO d3=lbegin,lend
-                offset=moffset*dim3 + (d3-1)*msize
-                !$acc loop
-                DO n=1,msize
-                  buffer_r(n+offset)=rval3d(value(n),d3)
-                ENDDO
-              ENDDO
-              call exit_profile(profile_mpi_copies)
-
-              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
-CALL enter_profile(profile_mpi_omp_barrier)
-!$OMP BARRIER
-CALL exit_profile(profile_mpi_omp_barrier)
-
-              ENDIF
-              
-              IF (is_omp_level_master) THEN
-                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
-                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
-                  !$OMP CRITICAL   
-                  CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank,        &
-                    send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
-                  !$OMP END CRITICAL
-                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
-                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
-                  CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank,        &
-                    send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
-                ENDIF
-              ENDIF
-            ELSE
-              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
-CALL enter_profile(profile_mpi_omp_barrier)
-!$OMP BARRIER
-CALL exit_profile(profile_mpi_omp_barrier)
-
-              ENDIF
-            ENDIF
-          ENDDO
-
-          IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
-            DO isend=req%nsend+1,max_req
-CALL enter_profile(profile_mpi_omp_barrier)
-!$OMP BARRIER
-CALL exit_profile(profile_mpi_omp_barrier)
-
-            ENDDO
-          ENDIF
-
-        ENDDO
-         
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) ) CYCLE
-          dim3=size(field(ind)%rval3d,2)
-          CALL distrib_level(1,dim3, lbegin,lend)
-          rval3d=>field(ind)%rval3d
-          req=>message%request(ind)
-
-          DO irecv=1,req%nrecv
-            recv=>req%recv(irecv)
-
-            IF (recv%rank==mpi_rank) THEN
-              value=>recv%value
-              src_value => recv%src_value
-              src_rval3d=>field(recv%domain)%rval3d
-              sgn=>recv%sign
-              msize=recv%size
-
-              call enter_profile(profile_mpi_copies)
-              CALL trace_start("copy_data")
-              !$acc parallel loop collapse(2) default(present) async if (field(ind)%ondevice)
-              DO d3=lbegin,lend
-                DO n=1,msize
-                  rval3d(value(n),d3)=src_rval3d(src_value(n),d3)*sgn(n)
-                ENDDO
-              ENDDO
-              call exit_profile(profile_mpi_copies)
-              CALL trace_end("copy_data")
-
-            ELSE
-              ireq=recv%ireq
-              buffer_r=>message%buffers(ireq)%r
- 
-              IF (is_omp_level_master) THEN
-                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
-                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
-                  !$OMP CRITICAL
-                  CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank,        &
-                    recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
-                  !$OMP END CRITICAL
-                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
-                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
-                  CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank,        &
-                    recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
-                ENDIF
-              ENDIF
-            ENDIF  
-          ENDDO
-        
-        ENDDO
-
-      ELSE  IF (field(1)%ndim==4) THEN
-
-        max_req=0
-        DO ind=1,ndomain
-          req=>message%request(ind)
-          IF (req%nsend>max_req) max_req=req%nsend
-        ENDDO
-    
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) ) CYCLE
-
-          dim3=size(field(ind)%rval4d,2)
-          CALL distrib_level(1,dim3, lbegin,lend)
-          dim4=size(field(ind)%rval4d,3)
-          rval4d=>field(ind)%rval4d
-          req=>message%request(ind)
-
-          DO isend=1,req%nsend
-            send=>req%send(isend)
-            value=>send%value
-
-            IF (send%rank/=mpi_rank) THEN
-
-              ireq=send%ireq
-              buffer_r=>message%buffers(ireq)%r
-              msize=send%size
-              moffset=send%offset
-
-              call enter_profile(profile_mpi_copies)
-              CALL trace_start("copy_to_buffer")
-              !$acc parallel loop default(present) collapse(2) async if (field(ind)%ondevice)
-              DO d4=1,dim4
-                DO d3=lbegin,lend
-                  offset=moffset*dim3*dim4 + dim3*msize*(d4-1) +               &
-                    (d3-1)*msize
-                  !$acc loop
-                  DO n=1,msize
-                    buffer_r(n+offset)=rval4d(value(n),d3,d4)
-                  ENDDO
-                ENDDO
-              ENDDO
-              CALL trace_end("copy_to_buffer")
-              call exit_profile(profile_mpi_copies)
-
-              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
-CALL enter_profile(profile_mpi_omp_barrier)
-!$OMP BARRIER
-CALL exit_profile(profile_mpi_omp_barrier)
-
-              ENDIF
-
-              IF (is_omp_level_master) THEN
-                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
-                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
-                  !$OMP CRITICAL
-                  CALL MPI_ISEND(buffer_r,send%size*dim3*dim4,MPI_REAL8,send%rank,   &
-                    send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
-                  !$OMP END CRITICAL
-                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
-                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
-                  CALL MPI_ISEND(buffer_r,send%size*dim3*dim4,MPI_REAL8,send%rank,   &
-                    send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
-                ENDIF
-              ENDIF
-            ELSE
-              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
-CALL enter_profile(profile_mpi_omp_barrier)
-!$OMP BARRIER
-CALL exit_profile(profile_mpi_omp_barrier)
-
-              ENDIF
-            ENDIF
-          ENDDO
-          
-          IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
-            DO isend=req%nsend+1,max_req
-CALL enter_profile(profile_mpi_omp_barrier)
-!$OMP BARRIER
-CALL exit_profile(profile_mpi_omp_barrier)
-
-            ENDDO
-          ENDIF
-
-        ENDDO
-        
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) ) CYCLE
-          
-          dim3=size(field(ind)%rval4d,2)
-          CALL distrib_level(1,dim3, lbegin,lend)
-          dim4=size(field(ind)%rval4d,3)
-          rval4d=>field(ind)%rval4d
-          req=>message%request(ind)
-          
-          DO irecv=1,req%nrecv
-            recv=>req%recv(irecv)
-            IF (recv%rank==mpi_rank) THEN
-              value=>recv%value
-              src_value => recv%src_value
-              src_rval4d=>field(recv%domain)%rval4d
-              sgn=>recv%sign
-              msize=recv%size
-              call enter_profile(profile_mpi_copies)
-              CALL trace_start("copy_data")
-              !$acc parallel loop collapse(3) default(present) async if (field(ind)%ondevice)
-              DO d4=1,dim4
-                DO d3=lbegin,lend
-                  DO n=1,msize
-                    rval4d(value(n),d3,d4)=src_rval4d(src_value(n),d3,d4)*sgn(n)
-                  ENDDO
-                ENDDO
-              ENDDO
-              call exit_profile(profile_mpi_copies)
-              CALL trace_end("copy_data")
-                   
-            ELSE
-
-              ireq=recv%ireq
-              buffer_r=>message%buffers(ireq)%r
-              IF (is_omp_level_master) THEN
-                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
-                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
-                 !$OMP CRITICAL           
-                  CALL MPI_IRECV(buffer_r,recv%size*dim3*dim4,MPI_REAL8,recv%rank,   &
-                    recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
-                  !$OMP END CRITICAL
-                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
-                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
-                  CALL MPI_IRECV(buffer_r,recv%size*dim3*dim4,MPI_REAL8,recv%rank,   &
-                    recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
-                ENDIF
-              ENDIF
-            ENDIF
-          ENDDO
-        ENDDO
-
-      ENDIF      
-
-      IF (mpi_threading_mode==MPI_THREAD_FUNNELED .OR. mpi_threading_mode==MPI_THREAD_SINGLE) THEN
-CALL enter_profile(profile_mpi_omp_barrier)
-!$acc wait
-!$OMP BARRIER
-CALL exit_profile(profile_mpi_omp_barrier)
-!$OMP MASTER        
-
-        DO ireq=1,message%nreq_send
-          buffer_r=>message%buffers(ireq)%r
-          msize=message%buffers(ireq)%size
-          rank=message%buffers(ireq)%rank
-          ! Using the "if" clause on the "host_data" directive seems to cause a crash at compilation
-          IF (message%ondevice) THEN
-            !$acc host_data use_device(buffer_r) ! if (message%ondevice)
-            CALL MPI_ISEND(buffer_r,msize,MPI_REAL8,rank,1000*message%number,          &
-              comm_icosa, message%mpi_req(ireq),ierr)
-            !$acc end host_data
-          ELSE
-            CALL MPI_ISEND(buffer_r,msize,MPI_REAL8,rank,1000*message%number,          &
-              comm_icosa, message%mpi_req(ireq),ierr)
-          ENDIF
-        ENDDO
-
-        DO ireq=message%nreq_send+1,message%nreq_send+message%nreq_recv
-          buffer_r=>message%buffers(ireq)%r
-          msize=message%buffers(ireq)%size
-          rank=message%buffers(ireq)%rank
-          ! Using the "if" clause on the "host_data" directive seems to cause a crash at compilation
-          IF (message%ondevice) THEN
-            !$acc host_data use_device(buffer_r) ! if (message%ondevice)
-            CALL MPI_IRECV(buffer_r,msize,MPI_REAL8,rank,1000*message%number,          &
-              comm_icosa, message%mpi_req(ireq),ierr)
-            !$acc end host_data
-          ELSE
-            CALL MPI_IRECV(buffer_r,msize,MPI_REAL8,rank,1000*message%number,          &
-              comm_icosa, message%mpi_req(ireq),ierr)
-          ENDIF
-        ENDDO
-
-!$OMP END MASTER
-      ENDIF              
-    ENDIF
-CALL enter_profile(profile_mpi_omp_barrier)
-!$OMP BARRIER
-CALL exit_profile(profile_mpi_omp_barrier)
- 
-!    CALL trace_end("send_message_mpi")
-
-    CALL exit_profile(id_mpi)
-    
-  END SUBROUTINE send_message_mpi
-  
-  SUBROUTINE test_message_mpi(message)
-  IMPLICIT NONE
-    TYPE(t_message) :: message
-    
-    INTEGER :: ierr
-
-!$OMP MASTER
-    IF (message%pending .AND. .NOT. message%completed) CALL MPI_TESTALL(message%nreq,&
-      message%mpi_req,message%completed,message%status,ierr)
-!$OMP END MASTER
-  END SUBROUTINE  test_message_mpi
-  
-   
-  SUBROUTINE wait_message_mpi(message)
-  USE profiling_mod
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  USE omp_para
-  USE trace
-  IMPLICIT NONE
-    TYPE(t_message) :: message
-
-    TYPE(t_field),POINTER :: field(:)
-    REAL(rstd),POINTER :: rval2d(:) 
-    REAL(rstd),POINTER :: rval3d(:,:) 
-    REAL(rstd),POINTER :: rval4d(:,:,:) 
-    REAL(rstd),POINTER :: buffer_r(:) 
-    INTEGER,POINTER :: value(:) 
-    INTEGER,POINTER :: sgn(:) 
-    TYPE(ARRAY),POINTER :: recv 
-    TYPE(t_request),POINTER :: req
-    INTEGER :: irecv
-    INTEGER :: ireq,nreq
-    INTEGER :: ind,n
-    INTEGER :: dim3,dim4,d3,d4,lbegin,lend
-    INTEGER :: offset, msize, moffset
-
-    message%open=.FALSE.
-    IF (.NOT. message%pending) RETURN
-
-    CALL enter_profile(id_mpi)
-
-!    CALL trace_start("wait_message_mpi")
-
-    field=>message%field
-    nreq=message%nreq
-    
-    IF (field(1)%data_type==type_real) THEN
-      IF (field(1)%ndim==2) THEN
-
-call enter_profile(profile_mpi_waitall)
-!$OMP MASTER         
-         IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req,          &
-          message%status,ierr)
-!$OMP END MASTER
-!$OMP BARRIER
-call exit_profile(profile_mpi_waitall)
-        call enter_profile(profile_mpi_copies)
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
-          
-          rval2d=>field(ind)%rval2d
-          req=>message%request(ind)
-          DO irecv=1,req%nrecv
-            recv=>req%recv(irecv)
-            IF (recv%rank/=mpi_rank) THEN
-              ireq=recv%ireq
-              buffer_r=>message%buffers(ireq)%r
-              value=>recv%value
-              sgn=>recv%sign
-              offset=recv%offset
-              msize=recv%size
-              !$acc parallel loop default(present) async if (field(ind)%ondevice)
-              DO n=1,msize
-                rval2d(value(n))=buffer_r(n+offset)*sgn(n)  
-              ENDDO
-
-            ENDIF
-          ENDDO
-        
-        ENDDO
-        call exit_profile(profile_mpi_copies)
-      
-      
-      ELSE  IF (field(1)%ndim==3) THEN
-         call enter_profile(profile_mpi_waitall)
-!$OMP MASTER
-         IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req,          &
-              message%status,ierr)
-!$OMP END MASTER
-!$OMP BARRIER
-        call exit_profile(profile_mpi_waitall)
-
-        
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) ) CYCLE
-
-          rval3d=>field(ind)%rval3d
-          req=>message%request(ind)
-          DO irecv=1,req%nrecv
-            recv=>req%recv(irecv)
-            IF (recv%rank/=mpi_rank) THEN
-              ireq=recv%ireq
-              buffer_r=>message%buffers(ireq)%r
-              value=>recv%value
-              sgn=>recv%sign
-              
-              dim3=size(rval3d,2)
-    
-              CALL distrib_level(1,dim3, lbegin,lend)
-              msize=recv%size
-              moffset=recv%offset
-              call enter_profile(profile_mpi_copies)
-              CALL trace_start("copy_from_buffer")
-              
-              IF (req%vector) THEN
-                !$acc parallel loop default(present) async if (field(ind)%ondevice)
-                DO d3=lbegin,lend
-                  offset=moffset*dim3 + (d3-1)*msize
-                  !$acc loop
-                  DO n=1,msize
-                    rval3d(value(n),d3)=buffer_r(n+offset)*sgn(n)  
-                  ENDDO
-                ENDDO
-              ELSE
-                !$acc parallel loop default(present) async if (field(ind)%ondevice)
-                DO d3=lbegin,lend
-                  offset=moffset*dim3 + (d3-1)*msize
-                  !$acc loop
-                  DO n=1,msize
-                    rval3d(value(n),d3)=buffer_r(n+offset)  
-                  ENDDO
-                ENDDO
-              ENDIF
-                
-              CALL trace_end("copy_from_buffer")
-              call exit_profile(profile_mpi_copies)
-            ENDIF
-          ENDDO
-        
-        ENDDO
-
-      ELSE  IF (field(1)%ndim==4) THEN
-call enter_profile(profile_mpi_waitall)
-!$OMP MASTER
-        IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req,          &
-          message%status,ierr)
-!$OMP END MASTER
-!$OMP BARRIER
-        call exit_profile(profile_mpi_waitall)
-
-                
-        DO ind=1,ndomain
-          IF (.NOT. assigned_domain(ind) ) CYCLE
-
-          rval4d=>field(ind)%rval4d
-          req=>message%request(ind)
-          DO irecv=1,req%nrecv
-            recv=>req%recv(irecv)
-            IF (recv%rank/=mpi_rank) THEN
-              ireq=recv%ireq
-              buffer_r=>message%buffers(ireq)%r
-              value=>recv%value
-              sgn=>recv%sign
-
-              dim3=size(rval4d,2)
-              CALL distrib_level(1,dim3, lbegin,lend)
-              dim4=size(rval4d,3)
-              msize=recv%size
-              moffset=recv%offset
-              call enter_profile(profile_mpi_copies)
-              CALL trace_start("copy_from_buffer")
-              !$acc parallel loop default(present) collapse(2) async if (field(ind)%ondevice)
-              DO d4=1,dim4
-                DO d3=lbegin,lend
-                  offset=moffset*dim3*dim4 + dim3*msize*(d4-1) +               &
-                    (d3-1)*msize
-                  !$acc loop
-                  DO n=1,msize
-                    rval4d(value(n),d3,d4)=buffer_r(n+offset)*sgn(n) 
-                  ENDDO
-                ENDDO
-              ENDDO
-              CALL trace_end("copy_from_buffer")
-              call exit_profile(profile_mpi_copies)
-            ENDIF
-          ENDDO
-        
-        ENDDO
-      
-      ENDIF      
-      
-    ENDIF
-
-!$OMP MASTER
-    message%pending=.FALSE.
-!$OMP END MASTER
-
-!    CALL trace_end("wait_message_mpi")
-!$OMP BARRIER
-  
-    CALL exit_profile(id_mpi)
-
-  END SUBROUTINE wait_message_mpi
-
-  SUBROUTINE transfert_request_mpi(field,request)
-  USE field_mod
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    TYPE(t_request),POINTER :: request(:)
-
-    TYPE(t_message),SAVE :: message
-   
-   
-    CALL init_message_mpi(field,request, message)
-    CALL transfert_message_mpi(field,message)
-    CALL finalize_message_mpi(field,message)
-   
-  END SUBROUTINE transfert_request_mpi
- 
-   
-   
-  SUBROUTINE transfert_request_seq(field,request)
-  USE field_mod
-  USE domain_mod
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    TYPE(t_request),POINTER :: request(:)
-    REAL(rstd),POINTER :: rval2d(:) 
-    REAL(rstd),POINTER :: rval3d(:,:) 
-    REAL(rstd),POINTER :: rval4d(:,:,:) 
-    INTEGER :: ind
-    TYPE(t_request),POINTER :: req
-    INTEGER :: n
-    
-    DO ind=1,ndomain
-      req=>request(ind)
-      rval2d=>field(ind)%rval2d
-      rval3d=>field(ind)%rval3d
-      rval4d=>field(ind)%rval4d
-      
-      IF (field(ind)%data_type==type_real) THEN
-        IF (field(ind)%ndim==2) THEN
-          DO n=1,req%size
-            rval2d(req%target_ind(n))=field(req%src_domain(n))%rval2d(req%src_ind(n))*&
-              req%target_sign(n)
-          ENDDO
-        ELSE IF (field(ind)%ndim==3) THEN
-          DO n=1,req%size
-            rval3d(req%target_ind(n),:)=field(req%src_domain(n))%rval3d(req%src_ind(n),:)*&
-              req%target_sign(n)
-          ENDDO
-        ELSE IF (field(ind)%ndim==4) THEN
-          DO n=1,req%size
-            rval4d(req%target_ind(n),:,:)=field(req%src_domain(n))%rval4d(req%src_ind(n),:,:)*&
-              req%target_sign(n)
-          ENDDO
-        ENDIF
-      ENDIF        
-
-    ENDDO
-    
-  END SUBROUTINE transfert_request_seq
-  
-  
-  SUBROUTINE gather_field(field_loc,field_glo)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field_loc(:)
-    TYPE(t_field),POINTER :: field_glo(:)
-    INTEGER, ALLOCATABLE :: mpi_req(:)
-    INTEGER, ALLOCATABLE :: status(:,:)
-    INTEGER :: ireq,nreq
-    INTEGER :: ind_glo,ind_loc    
-  
-    IF (.NOT. using_mpi) THEN
-    
-      DO ind_loc=1,ndomain
-        IF (field_loc(ind_loc)%ndim==2) field_glo(ind_loc)%rval2d=field_loc(ind_loc)%rval2d
-        IF (field_loc(ind_loc)%ndim==3) field_glo(ind_loc)%rval3d=field_loc(ind_loc)%rval3d
-        IF (field_loc(ind_loc)%ndim==4) field_glo(ind_loc)%rval4d=field_loc(ind_loc)%rval4d
-      ENDDO
-    
-    ELSE
-          
-      nreq=ndomain
-      IF (mpi_rank==0) nreq=nreq+ndomain_glo 
-      ALLOCATE(mpi_req(nreq))
-      ALLOCATE(status(MPI_STATUS_SIZE,nreq))
-    
-    
-      ireq=0
-      IF (mpi_rank==0) THEN
-        DO ind_glo=1,ndomain_glo
-          ireq=ireq+1
-
-          IF (field_glo(ind_glo)%ndim==2) THEN
-            CALL MPI_IRECV(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 ,   &
-                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
-   
-          ELSE IF (field_glo(ind_glo)%ndim==3) THEN
-            CALL MPI_IRECV(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 ,   &
-                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
-
-          ELSE IF (field_glo(ind_glo)%ndim==4) THEN
-            CALL MPI_IRECV(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   &
-                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
-          ENDIF
-         
-        ENDDO
-      ENDIF
-  
-      DO ind_loc=1,ndomain
-        ireq=ireq+1
-
-        IF (field_loc(ind_loc)%ndim==2) THEN
-          CALL MPI_ISEND(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   &
-                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
-        ELSE IF (field_loc(ind_loc)%ndim==3) THEN
-          CALL MPI_ISEND(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   &
-                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
-        ELSE IF (field_loc(ind_loc)%ndim==4) THEN
-          CALL MPI_ISEND(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   &
-                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
-        ENDIF
-      
-      ENDDO
-   
-      CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
-
-    ENDIF
-        
-  END SUBROUTINE gather_field
-
-  SUBROUTINE bcast_field(field_glo)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field_glo(:)
-    INTEGER :: ind_glo    
-  
-    IF (.NOT. using_mpi) THEN
-    
-! nothing to do
-    
-    ELSE
-          
-      DO ind_glo=1,ndomain_glo
-
-          IF (field_glo(ind_glo)%ndim==2) THEN
-            CALL MPI_BCAST(field_glo(ind_glo)%rval2d, size(field_glo(ind_glo)%rval2d) , MPI_REAL8, 0, comm_icosa, ierr)
-          ELSE IF (field_glo(ind_glo)%ndim==3) THEN
-            CALL MPI_BCAST(field_glo(ind_glo)%rval3d, size(field_glo(ind_glo)%rval3d) , MPI_REAL8, 0, comm_icosa, ierr)
-          ELSE IF (field_glo(ind_glo)%ndim==4) THEN
-            CALL MPI_BCAST(field_glo(ind_glo)%rval4d, size(field_glo(ind_glo)%rval4d) , MPI_REAL8, 0, comm_icosa, ierr)
-          ENDIF
-         
-        ENDDO
-      ENDIF
-        
-  END SUBROUTINE bcast_field
-
-  SUBROUTINE scatter_field(field_glo,field_loc)
-  USE field_mod
-  USE domain_mod
-  USE mpi_mod
-  USE mpipara
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field_glo(:)
-    TYPE(t_field),POINTER :: field_loc(:)
-    INTEGER, ALLOCATABLE :: mpi_req(:)
-    INTEGER, ALLOCATABLE :: status(:,:)
-    INTEGER :: ireq,nreq
-    INTEGER :: ind_glo,ind_loc    
-  
-    IF (.NOT. using_mpi) THEN
-    
-      DO ind_loc=1,ndomain
-        IF (field_loc(ind_loc)%ndim==2) field_loc(ind_loc)%rval2d=field_glo(ind_loc)%rval2d
-        IF (field_loc(ind_loc)%ndim==3) field_loc(ind_loc)%rval3d=field_glo(ind_loc)%rval3d
-        IF (field_loc(ind_loc)%ndim==4) field_loc(ind_loc)%rval4d=field_glo(ind_loc)%rval4d
-      ENDDO
-    
-    ELSE
-          
-      nreq=ndomain
-      IF (mpi_rank==0) nreq=nreq+ndomain_glo 
-      ALLOCATE(mpi_req(nreq))
-      ALLOCATE(status(MPI_STATUS_SIZE,nreq))
-    
-    
-      ireq=0
-      IF (mpi_rank==0) THEN
-        DO ind_glo=1,ndomain_glo
-          ireq=ireq+1
-
-          IF (field_glo(ind_glo)%ndim==2) THEN
-            CALL MPI_ISEND(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 ,   &
-                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
-   
-          ELSE IF (field_glo(ind_glo)%ndim==3) THEN
-            CALL MPI_ISEND(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 ,   &
-                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
-
-          ELSE IF (field_glo(ind_glo)%ndim==4) THEN
-            CALL MPI_ISEND(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   &
-                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
-          ENDIF
-         
-        ENDDO
-      ENDIF
-  
-      DO ind_loc=1,ndomain
-        ireq=ireq+1
-
-        IF (field_loc(ind_loc)%ndim==2) THEN
-          CALL MPI_IRECV(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   &
-                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
-        ELSE IF (field_loc(ind_loc)%ndim==3) THEN
-          CALL MPI_IRECV(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   &
-                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
-        ELSE IF (field_loc(ind_loc)%ndim==4) THEN
-          CALL MPI_IRECV(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   &
-                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
-        ENDIF
-      
-      ENDDO
-   
-      CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
-
-    ENDIF
-        
-  END SUBROUTINE scatter_field
-  
-  SUBROUTINE trace_in
-  USE trace
-  IMPLICIT NONE
-  
-    CALL trace_start("transfert_buffer")
-  END SUBROUTINE trace_in              
-
-  SUBROUTINE trace_out
-  USE trace
-  IMPLICIT NONE
-  
-    CALL trace_end("transfert_buffer")
-  END SUBROUTINE trace_out              
-
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Broadcast --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!! -- Les chaine de charactï¿œre -- !!
-
-  SUBROUTINE bcast_mpi_c(var1)
-  IMPLICIT NONE
-    CHARACTER(LEN=*),INTENT(INOUT) :: Var1
-   
-    CALL bcast_mpi_cgen(Var1,len(Var1))
-
-  END SUBROUTINE bcast_mpi_c
-
-!! -- Les entiers -- !!
-  
-  SUBROUTINE bcast_mpi_i(var)
-  USE mpipara
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var
-    
-    INTEGER               :: var_tmp(1)
-    
-    IF (is_mpi_master) var_tmp(1)=var
-    CALL bcast_mpi_igen(Var_tmp,1)
-    var=var_tmp(1)
-    
-  END SUBROUTINE bcast_mpi_i
-
-  SUBROUTINE bcast_mpi_i1(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:)
-
-    CALL bcast_mpi_igen(Var,size(Var))
-    
-  END SUBROUTINE bcast_mpi_i1
-
-  SUBROUTINE bcast_mpi_i2(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:)
-   
-    CALL bcast_mpi_igen(Var,size(Var))
-  
-  END SUBROUTINE bcast_mpi_i2
-
-  SUBROUTINE bcast_mpi_i3(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:,:)
-   
-    CALL bcast_mpi_igen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_i3
-
-  SUBROUTINE bcast_mpi_i4(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
-   
-    CALL bcast_mpi_igen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_i4
-
-
-!! -- Les reels -- !!
-
-  SUBROUTINE bcast_mpi_r(var)
-  USE mpipara
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var
-    REAL               :: var_tmp(1)
-    
-    IF (is_mpi_master) var_tmp(1)=var
-    CALL bcast_mpi_rgen(Var_tmp,1)
-    var=var_tmp(1)   
-
-  END SUBROUTINE bcast_mpi_r
-
-  SUBROUTINE bcast_mpi_r1(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:)
-   
-    CALL bcast_mpi_rgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_r1
-
-  SUBROUTINE bcast_mpi_r2(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:)
-   
-    CALL bcast_mpi_rgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_r2
-
-  SUBROUTINE bcast_mpi_r3(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:,:)
-   
-    CALL bcast_mpi_rgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_r3
-
-  SUBROUTINE bcast_mpi_r4(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:,:,:)
-   
-    CALL bcast_mpi_rgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_r4
-  
-!! -- Les booleans -- !!
-
-  SUBROUTINE bcast_mpi_l(var)
-  USE mpipara
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var
-    LOGICAL               :: var_tmp(1)
-    
-    IF (is_mpi_master) var_tmp(1)=var
-    CALL bcast_mpi_lgen(Var_tmp,1)
-    var=var_tmp(1)   
-
-  END SUBROUTINE bcast_mpi_l
-
-  SUBROUTINE bcast_mpi_l1(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:)
-   
-    CALL bcast_mpi_lgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_l1
-
-  SUBROUTINE bcast_mpi_l2(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:)
-   
-    CALL bcast_mpi_lgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_l2
-
-  SUBROUTINE bcast_mpi_l3(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
-   
-    CALL bcast_mpi_lgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_l3
-
-  SUBROUTINE bcast_mpi_l4(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
-   
-    CALL bcast_mpi_lgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_l4
-  
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-  SUBROUTINE bcast_mpi_cgen(var,nb)
-    USE mpi_mod
-    USE mpipara
-    IMPLICIT NONE
-    
-    CHARACTER(LEN=*),INTENT(INOUT) :: Var
-    INTEGER,INTENT(IN) :: nb
-
-    IF (.NOT. using_mpi) RETURN
-    
-    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_master,comm_icosa,ierr)
-        
-  END SUBROUTINE bcast_mpi_cgen
-
-
-      
-  SUBROUTINE bcast_mpi_igen(var,nb)
-    USE mpi_mod
-    USE mpipara
-    IMPLICIT NONE
-    INTEGER,INTENT(IN) :: nb
-    INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var
-    
-    IF (.NOT. using_mpi) RETURN
-
-    CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_master,comm_icosa,ierr)
-        
-  END SUBROUTINE bcast_mpi_igen
-
-
-
-  
-  SUBROUTINE bcast_mpi_rgen(var,nb)
-    USE mpi_mod
-    USE mpipara
-    IMPLICIT NONE
-    INTEGER,INTENT(IN) :: nb
-    REAL,DIMENSION(nb),INTENT(INOUT) :: Var
-
-    IF (.NOT. using_mpi) RETURN
-
-    CALL MPI_BCAST(Var,nb,MPI_REAL8,mpi_master,comm_icosa,ierr)
-    
-  END SUBROUTINE bcast_mpi_rgen
-  
-
-
-
-  SUBROUTINE bcast_mpi_lgen(var,nb)
-    USE mpi_mod
-    USE mpipara
-    IMPLICIT NONE
-    INTEGER,INTENT(IN) :: nb
-    LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
-
-    IF (.NOT. using_mpi) RETURN
-
-    CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_master,comm_icosa,ierr)
-
-  END SUBROUTINE bcast_mpi_lgen
-  
-   
-END MODULE transfert_mpi_mod
-      
-        
-        
-        
-      
+    call enter_profile(profile_mpi)
+
+    CALL distrib_level( 1, size(message%field(1)%rval4d, 2), d3_begin, d3_end )
+
+    call enter_profile(profile_mpi_waitall)
+    !$omp master
+    call MPI_Waitall( size(message%mpi_requests_out), message%mpi_requests_out, MPI_STATUSES_IGNORE, ierr )
+    call MPI_Waitall( size(message%mpi_requests_in), message%mpi_requests_in, MPI_STATUSES_IGNORE, ierr )
+    !$omp end master
+    call exit_profile(profile_mpi_waitall)
+
+    call enter_profile(profile_mpi_barrier)
+    !$omp barrier
+    call exit_profile(profile_mpi_barrier)
+
+    call enter_profile(profile_mpi_copies)
+    !$acc data present(message) async if(message%ondevice)
+
+    dim4 = size(message%field(1)%rval4d, 3)
+    ! Buffer to Halo : copy inbound message to field
+    !$acc parallel loop default(none) present(message, assigned_domain) async if(message%ondevice)
+    do i = 1, size( message%message_in )
+      if( assigned_domain( message%message_in(i)%ind_loc ) ) then
+        !$acc loop collapse(2)
+        do d4 = 1, dim4
+          do d3 = d3_begin, d3_end
+            !$acc loop
+            do k = 1, size(message%message_in(i)%displs)
+              message%field(message%message_in(i)%ind_loc)%rval4d(message%message_in(i)%displs(k),d3,d4) = message%message_in(i)%sign(k)*message%message_in(i)%buff(k,d3,d4)
+            end do
+          end do
+        end do
+      endif
+    end do
+
+    !$acc end data
+    call exit_profile(profile_mpi_copies)
+
+    !$omp master
+    message%wait_seq = message%wait_seq + 1
+    !$omp end master
+
+    call enter_profile(profile_mpi_barrier)
+    !$omp barrier
+    call exit_profile(profile_mpi_barrier)
+    call exit_profile(profile_mpi)
+  end subroutine
+end module
Index: codes/icosagcm/trunk/src/parallel/transfert_mpi_collectives.f90
===================================================================
--- codes/icosagcm/trunk/src/parallel/transfert_mpi_collectives.f90	(revision 963)
+++ codes/icosagcm/trunk/src/parallel/transfert_mpi_collectives.f90	(revision 963)
@@ -0,0 +1,412 @@
+MODULE transfert_mpi_collectives_mod
+IMPLICIT NONE
+
+  INTERFACE bcast_mpi
+    MODULE PROCEDURE bcast_mpi_c,                                                     &
+                     bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
+                     bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
+		     bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
+  END INTERFACE
+
+CONTAINS
+
+  SUBROUTINE gather_field(field_loc,field_glo)
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field_loc(:)
+    TYPE(t_field),POINTER :: field_glo(:)
+    INTEGER, ALLOCATABLE :: mpi_req(:)
+    INTEGER, ALLOCATABLE :: status(:,:)
+    INTEGER :: ireq,nreq
+    INTEGER :: ind_glo,ind_loc
+
+    IF (.NOT. using_mpi) THEN
+
+      DO ind_loc=1,ndomain
+        IF (field_loc(ind_loc)%ndim==2) field_glo(ind_loc)%rval2d=field_loc(ind_loc)%rval2d
+        IF (field_loc(ind_loc)%ndim==3) field_glo(ind_loc)%rval3d=field_loc(ind_loc)%rval3d
+        IF (field_loc(ind_loc)%ndim==4) field_glo(ind_loc)%rval4d=field_loc(ind_loc)%rval4d
+      ENDDO
+
+    ELSE
+
+      nreq=ndomain
+      IF (mpi_rank==0) nreq=nreq+ndomain_glo
+      ALLOCATE(mpi_req(nreq))
+      ALLOCATE(status(MPI_STATUS_SIZE,nreq))
+
+
+      ireq=0
+      IF (mpi_rank==0) THEN
+        DO ind_glo=1,ndomain_glo
+          ireq=ireq+1
+
+          IF (field_glo(ind_glo)%ndim==2) THEN
+            CALL MPI_IRECV(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 ,   &
+                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
+
+          ELSE IF (field_glo(ind_glo)%ndim==3) THEN
+            CALL MPI_IRECV(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 ,   &
+                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
+
+          ELSE IF (field_glo(ind_glo)%ndim==4) THEN
+            CALL MPI_IRECV(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   &
+                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
+          ENDIF
+
+        ENDDO
+      ENDIF
+
+      DO ind_loc=1,ndomain
+        ireq=ireq+1
+
+        IF (field_loc(ind_loc)%ndim==2) THEN
+          CALL MPI_ISEND(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   &
+                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
+        ELSE IF (field_loc(ind_loc)%ndim==3) THEN
+          CALL MPI_ISEND(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   &
+                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
+        ELSE IF (field_loc(ind_loc)%ndim==4) THEN
+          CALL MPI_ISEND(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   &
+                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
+        ENDIF
+
+      ENDDO
+
+      CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+
+    ENDIF
+
+  END SUBROUTINE gather_field
+
+  SUBROUTINE bcast_field(field_glo)
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field_glo(:)
+    INTEGER :: ind_glo
+
+    IF (.NOT. using_mpi) THEN
+
+! nothing to do
+
+    ELSE
+
+      DO ind_glo=1,ndomain_glo
+
+          IF (field_glo(ind_glo)%ndim==2) THEN
+            CALL MPI_BCAST(field_glo(ind_glo)%rval2d, size(field_glo(ind_glo)%rval2d) , MPI_REAL8, 0, comm_icosa, ierr)
+          ELSE IF (field_glo(ind_glo)%ndim==3) THEN
+            CALL MPI_BCAST(field_glo(ind_glo)%rval3d, size(field_glo(ind_glo)%rval3d) , MPI_REAL8, 0, comm_icosa, ierr)
+          ELSE IF (field_glo(ind_glo)%ndim==4) THEN
+            CALL MPI_BCAST(field_glo(ind_glo)%rval4d, size(field_glo(ind_glo)%rval4d) , MPI_REAL8, 0, comm_icosa, ierr)
+          ENDIF
+
+        ENDDO
+      ENDIF
+
+  END SUBROUTINE bcast_field
+
+  SUBROUTINE scatter_field(field_glo,field_loc)
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field_glo(:)
+    TYPE(t_field),POINTER :: field_loc(:)
+    INTEGER, ALLOCATABLE :: mpi_req(:)
+    INTEGER, ALLOCATABLE :: status(:,:)
+    INTEGER :: ireq,nreq
+    INTEGER :: ind_glo,ind_loc
+
+    IF (.NOT. using_mpi) THEN
+
+      DO ind_loc=1,ndomain
+        IF (field_loc(ind_loc)%ndim==2) field_loc(ind_loc)%rval2d=field_glo(ind_loc)%rval2d
+        IF (field_loc(ind_loc)%ndim==3) field_loc(ind_loc)%rval3d=field_glo(ind_loc)%rval3d
+        IF (field_loc(ind_loc)%ndim==4) field_loc(ind_loc)%rval4d=field_glo(ind_loc)%rval4d
+      ENDDO
+
+    ELSE
+
+      nreq=ndomain
+      IF (mpi_rank==0) nreq=nreq+ndomain_glo
+      ALLOCATE(mpi_req(nreq))
+      ALLOCATE(status(MPI_STATUS_SIZE,nreq))
+
+
+      ireq=0
+      IF (mpi_rank==0) THEN
+        DO ind_glo=1,ndomain_glo
+          ireq=ireq+1
+
+          IF (field_glo(ind_glo)%ndim==2) THEN
+            CALL MPI_ISEND(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 ,   &
+                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
+
+          ELSE IF (field_glo(ind_glo)%ndim==3) THEN
+            CALL MPI_ISEND(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 ,   &
+                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
+
+          ELSE IF (field_glo(ind_glo)%ndim==4) THEN
+            CALL MPI_ISEND(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   &
+                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr)
+          ENDIF
+
+        ENDDO
+      ENDIF
+
+      DO ind_loc=1,ndomain
+        ireq=ireq+1
+
+        IF (field_loc(ind_loc)%ndim==2) THEN
+          CALL MPI_IRECV(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   &
+                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
+        ELSE IF (field_loc(ind_loc)%ndim==3) THEN
+          CALL MPI_IRECV(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   &
+                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
+        ELSE IF (field_loc(ind_loc)%ndim==4) THEN
+          CALL MPI_IRECV(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   &
+                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr)
+        ENDIF
+
+      ENDDO
+
+      CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+
+    ENDIF
+
+  END SUBROUTINE scatter_field
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactï¿œre -- !!
+
+  SUBROUTINE bcast_mpi_c(var1)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var1
+
+    CALL bcast_mpi_cgen(Var1,len(Var1))
+
+  END SUBROUTINE bcast_mpi_c
+
+!! -- Les entiers -- !!
+
+  SUBROUTINE bcast_mpi_i(var)
+  USE mpipara
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+
+    INTEGER               :: var_tmp(1)
+
+    IF (is_mpi_master) var_tmp(1)=var
+    CALL bcast_mpi_igen(Var_tmp,1)
+    var=var_tmp(1)
+
+  END SUBROUTINE bcast_mpi_i
+
+  SUBROUTINE bcast_mpi_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+
+    CALL bcast_mpi_igen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_i1
+
+  SUBROUTINE bcast_mpi_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+
+    CALL bcast_mpi_igen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_i2
+
+  SUBROUTINE bcast_mpi_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL bcast_mpi_igen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_i3
+
+  SUBROUTINE bcast_mpi_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+
+    CALL bcast_mpi_igen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_i4
+
+
+!! -- Les reels -- !!
+
+  SUBROUTINE bcast_mpi_r(var)
+  USE mpipara
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+    REAL               :: var_tmp(1)
+
+    IF (is_mpi_master) var_tmp(1)=var
+    CALL bcast_mpi_rgen(Var_tmp,1)
+    var=var_tmp(1)
+
+  END SUBROUTINE bcast_mpi_r
+
+  SUBROUTINE bcast_mpi_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r1
+
+  SUBROUTINE bcast_mpi_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r2
+
+  SUBROUTINE bcast_mpi_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r3
+
+  SUBROUTINE bcast_mpi_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r4
+
+!! -- Les booleans -- !!
+
+  SUBROUTINE bcast_mpi_l(var)
+  USE mpipara
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL               :: var_tmp(1)
+
+    IF (is_mpi_master) var_tmp(1)=var
+    CALL bcast_mpi_lgen(Var_tmp,1)
+    var=var_tmp(1)
+
+  END SUBROUTINE bcast_mpi_l
+
+  SUBROUTINE bcast_mpi_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l1
+
+  SUBROUTINE bcast_mpi_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l2
+
+  SUBROUTINE bcast_mpi_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l3
+
+  SUBROUTINE bcast_mpi_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE bcast_mpi_cgen(var,nb)
+    USE mpi_mod
+    USE mpipara
+    IMPLICIT NONE
+
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+
+    IF (.NOT. using_mpi) RETURN
+
+    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_master,comm_icosa,ierr)
+
+  END SUBROUTINE bcast_mpi_cgen
+
+
+
+  SUBROUTINE bcast_mpi_igen(var,nb)
+    USE mpi_mod
+    USE mpipara
+    IMPLICIT NONE
+    INTEGER,INTENT(IN) :: nb
+    INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var
+
+    IF (.NOT. using_mpi) RETURN
+
+    CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_master,comm_icosa,ierr)
+
+  END SUBROUTINE bcast_mpi_igen
+
+
+
+
+  SUBROUTINE bcast_mpi_rgen(var,nb)
+    USE mpi_mod
+    USE mpipara
+    IMPLICIT NONE
+    INTEGER,INTENT(IN) :: nb
+    REAL,DIMENSION(nb),INTENT(INOUT) :: Var
+
+    IF (.NOT. using_mpi) RETURN
+
+    CALL MPI_BCAST(Var,nb,MPI_REAL8,mpi_master,comm_icosa,ierr)
+
+  END SUBROUTINE bcast_mpi_rgen
+
+
+
+
+  SUBROUTINE bcast_mpi_lgen(var,nb)
+    USE mpi_mod
+    USE mpipara
+    IMPLICIT NONE
+    INTEGER,INTENT(IN) :: nb
+    LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
+
+    IF (.NOT. using_mpi) RETURN
+
+    CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_master,comm_icosa,ierr)
+
+  END SUBROUTINE bcast_mpi_lgen
+
+
+END MODULE transfert_mpi_collectives_mod
+
+
+
+
+
Index: codes/icosagcm/trunk/src/parallel/transfert_mpi_legacy.f90
===================================================================
--- codes/icosagcm/trunk/src/parallel/transfert_mpi_legacy.f90	(revision 963)
+++ codes/icosagcm/trunk/src/parallel/transfert_mpi_legacy.f90	(revision 963)
@@ -0,0 +1,1850 @@
+MODULE transfert_mpi_legacy_mod
+USE genmod
+USE field_mod
+IMPLICIT NONE
+
+  TYPE array
+    INTEGER,POINTER :: value(:)=>null()
+    INTEGER,POINTER :: sign(:)=>null()
+    INTEGER         :: domain
+    INTEGER         :: rank
+    INTEGER         :: tag
+    INTEGER         :: size
+    INTEGER         :: offset
+    INTEGER         :: ireq
+    INTEGER,POINTER :: buffer(:)=>null()
+    REAL,POINTER    :: buffer_r(:)=>null()
+    INTEGER,POINTER :: src_value(:)=>null()
+  END TYPE array
+
+  TYPE t_buffer
+    REAL,POINTER    :: r(:)
+    INTEGER         :: size
+    INTEGER         :: rank
+  END TYPE t_buffer
+
+  TYPE t_request
+    INTEGER :: type_field
+    INTEGER :: max_size
+    INTEGER :: size
+    LOGICAL :: vector
+    INTEGER,POINTER :: src_domain(:)
+    INTEGER,POINTER :: src_i(:)
+    INTEGER,POINTER :: src_j(:)
+    INTEGER,POINTER :: src_ind(:)
+    INTEGER,POINTER :: target_ind(:)
+    INTEGER,POINTER :: target_i(:)
+    INTEGER,POINTER :: target_j(:)
+    INTEGER,POINTER :: target_sign(:)
+    INTEGER :: nrecv
+    TYPE(ARRAY),POINTER :: recv(:)
+    INTEGER :: nsend
+    INTEGER :: nreq_mpi
+    INTEGER :: nreq_send
+    INTEGER :: nreq_recv
+    TYPE(ARRAY),POINTER :: send(:)
+  END TYPE t_request
+
+  TYPE(t_request),SAVE,POINTER :: req_i1(:)
+  TYPE(t_request),SAVE,POINTER :: req_e1_scal(:)
+  TYPE(t_request),SAVE,POINTER :: req_e1_vect(:)
+  TYPE(t_request),SAVE,POINTER :: req_z1_scal(:)
+
+  TYPE(t_request),SAVE,POINTER :: req_i0(:)
+  TYPE(t_request),SAVE,POINTER :: req_e0_scal(:)
+  TYPE(t_request),SAVE,POINTER :: req_e0_vect(:)
+
+  TYPE t_reorder
+    INTEGER :: ind
+    INTEGER :: rank
+    INTEGER :: tag
+    INTEGER :: isend
+  END TYPE t_reorder
+
+  TYPE t_message
+    CHARACTER(LEN=100) :: name ! for debug
+    TYPE(t_request), POINTER :: request(:)
+    INTEGER :: nreq
+    INTEGER :: nreq_send
+    INTEGER :: nreq_recv
+    TYPE(t_reorder), POINTER :: reorder(:)
+    INTEGER, POINTER :: mpi_req(:)
+    INTEGER, POINTER :: status(:,:)
+    TYPE(t_buffer),POINTER :: buffers(:)
+    TYPE(t_field),POINTER :: field(:)
+    LOGICAL :: completed
+    LOGICAL :: pending
+    LOGICAL :: open      ! for debug
+    INTEGER :: number
+    LOGICAL :: ondevice=.false. !<Ready to transfer ondevice field
+  END TYPE t_message
+
+  integer :: profile_mpi_copies, profile_mpi_waitall, profile_mpi_omp_barrier
+
+CONTAINS
+
+
+  SUBROUTINE init_transfert
+  USE profiling_mod
+  USE domain_mod
+  USE dimensions
+  USE field_mod
+  USE metric
+  USE mpipara
+  USE mpi_mod
+  IMPLICIT NONE
+  INTEGER :: ind,i,j
+
+    CALL register_id('MPI', id_mpi)
+    CALL register_id('MPI_copies', profile_mpi_copies)
+    CALL register_id('MPI_waitall', profile_mpi_waitall)
+    CALL register_id('MPI_omp_barrier', profile_mpi_omp_barrier)
+
+    CALL create_request(field_t,req_i1)
+
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      DO i=ii_begin,ii_end+1
+        CALL request_add_point(ind,i,jj_begin-1,req_i1)
+      ENDDO
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_end+1,j,req_i1)
+      ENDDO
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_end+1,req_i1)
+      ENDDO
+
+      DO j=jj_begin,jj_end+1
+        CALL request_add_point(ind,ii_begin-1,j,req_i1)
+      ENDDO
+
+    ENDDO
+
+    CALL finalize_request(req_i1)
+
+
+    CALL create_request(field_t,req_i0)
+
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_begin,req_i0)
+      ENDDO
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_end,j,req_i0)
+      ENDDO
+
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_end,req_i0)
+      ENDDO
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_begin,j,req_i0)
+      ENDDO
+
+    ENDDO
+
+    CALL finalize_request(req_i0)
+
+
+    CALL create_request(field_u,req_e1_scal)
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_begin-1,req_e1_scal,rup)
+        CALL request_add_point(ind,i+1,jj_begin-1,req_e1_scal,lup)
+      ENDDO
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_end+1,j,req_e1_scal,left)
+      ENDDO
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_end+1,j-1,req_e1_scal,lup)
+      ENDDO
+
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_end+1,req_e1_scal,ldown)
+        CALL request_add_point(ind,i-1,jj_end+1,req_e1_scal,rdown)
+      ENDDO
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_begin-1,j,req_e1_scal,right)
+      ENDDO
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_begin-1,j+1,req_e1_scal,rdown)
+      ENDDO
+
+    ENDDO
+
+    CALL finalize_request(req_e1_scal)
+
+
+    CALL create_request(field_u,req_e0_scal)
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+
+
+      DO i=ii_begin+1,ii_end-1
+        CALL request_add_point(ind,i,jj_begin,req_e0_scal,right)
+        CALL request_add_point(ind,i,jj_end,req_e0_scal,right)
+      ENDDO
+
+      DO j=jj_begin+1,jj_end-1
+        CALL request_add_point(ind,ii_begin,j,req_e0_scal,rup)
+        CALL request_add_point(ind,ii_end,j,req_e0_scal,rup)
+      ENDDO
+
+      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e0_scal,left)
+      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e0_scal,ldown)
+      CALL request_add_point(ind,ii_begin+1,jj_end,req_e0_scal,left)
+      CALL request_add_point(ind,ii_end,jj_begin+1,req_e0_scal,ldown)
+
+    ENDDO
+
+    CALL finalize_request(req_e0_scal)
+
+
+
+    CALL create_request(field_u,req_e1_vect,.TRUE.)
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_begin-1,req_e1_vect,rup)
+        CALL request_add_point(ind,i+1,jj_begin-1,req_e1_vect,lup)
+      ENDDO
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_end+1,j,req_e1_vect,left)
+      ENDDO
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_end+1,j-1,req_e1_vect,lup)
+      ENDDO
+
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_end+1,req_e1_vect,ldown)
+        CALL request_add_point(ind,i-1,jj_end+1,req_e1_vect,rdown)
+      ENDDO
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_begin-1,j,req_e1_vect,right)
+      ENDDO
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_begin-1,j+1,req_e1_vect,rdown)
+      ENDDO
+
+
+    ENDDO
+
+    CALL finalize_request(req_e1_vect)
+
+
+    CALL create_request(field_u,req_e0_vect,.TRUE.)
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+
+      DO i=ii_begin+1,ii_end-1
+        CALL request_add_point(ind,i,jj_begin,req_e0_vect,right)
+        CALL request_add_point(ind,i,jj_end,req_e0_vect,right)
+      ENDDO
+
+      DO j=jj_begin+1,jj_end-1
+        CALL request_add_point(ind,ii_begin,j,req_e0_vect,rup)
+        CALL request_add_point(ind,ii_end,j,req_e0_vect,rup)
+      ENDDO
+
+      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e0_vect,left)
+      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e0_vect,ldown)
+      CALL request_add_point(ind,ii_begin+1,jj_end,req_e0_vect,left)
+      CALL request_add_point(ind,ii_end,jj_begin+1,req_e0_vect,ldown)
+
+    ENDDO
+
+    CALL finalize_request(req_e0_vect)
+
+    CALL create_request(field_z,req_z1_scal)
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_begin-1,req_z1_scal,vrup)
+        CALL request_add_point(ind,i+1,jj_begin-1,req_z1_scal,vup)
+      ENDDO
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_end+1,j,req_z1_scal,vlup)
+      ENDDO
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_end+1,j-1,req_z1_scal,vup)
+      ENDDO
+
+      DO i=ii_begin,ii_end
+        CALL request_add_point(ind,i,jj_end+1,req_z1_scal,vdown)
+        CALL request_add_point(ind,i-1,jj_end+1,req_z1_scal,vrdown)
+      ENDDO
+
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_begin-1,j,req_z1_scal,vrup)
+      ENDDO
+      DO j=jj_begin,jj_end
+        CALL request_add_point(ind,ii_begin-1,j,req_z1_scal,vrdown)
+      ENDDO
+
+    ENDDO
+
+    CALL finalize_request(req_z1_scal)
+
+  END SUBROUTINE init_transfert
+
+  SUBROUTINE create_request(type_field,request,vector)
+  USE domain_mod
+  USE field_mod
+  IMPLICIT NONE
+    INTEGER :: type_field
+    TYPE(t_request),POINTER :: request(:)
+    LOGICAL,OPTIONAL :: vector
+
+    TYPE(t_request),POINTER :: req
+    TYPE(t_domain),POINTER :: d
+    INTEGER :: ind
+    INTEGER :: max_size
+
+    ALLOCATE(request(ndomain))
+
+    DO ind=1,ndomain
+      req=>request(ind)
+      d=>domain(ind)
+      IF (type_field==field_t) THEN
+        Max_size=2*(d%iim+2)+2*(d%jjm+2)
+      ELSE IF (type_field==field_u) THEN
+        Max_size=3*(2*(d%iim+2)+2*(d%jjm+2))
+      ELSE IF (type_field==field_z) THEN
+        Max_size=2*(2*(d%iim+2)+2*(d%jjm+2))
+      ENDIF
+
+      req%type_field=type_field
+      req%max_size=max_size*2
+      req%size=0
+      req%vector=.FALSE.
+      IF (PRESENT(vector)) req%vector=vector
+      ALLOCATE(req%src_domain(req%max_size))
+      ALLOCATE(req%src_ind(req%max_size))
+      ALLOCATE(req%target_ind(req%max_size))
+      ALLOCATE(req%src_i(req%max_size))
+      ALLOCATE(req%src_j(req%max_size))
+      ALLOCATE(req%target_i(req%max_size))
+      ALLOCATE(req%target_j(req%max_size))
+      ALLOCATE(req%target_sign(req%max_size))
+    ENDDO
+
+  END SUBROUTINE create_request
+
+  SUBROUTINE reallocate_request(req)
+  IMPLICIT NONE
+    TYPE(t_request),POINTER :: req
+
+    INTEGER,POINTER :: src_domain(:)
+    INTEGER,POINTER :: src_ind(:)
+    INTEGER,POINTER :: target_ind(:)
+    INTEGER,POINTER :: src_i(:)
+    INTEGER,POINTER :: src_j(:)
+    INTEGER,POINTER :: target_i(:)
+    INTEGER,POINTER :: target_j(:)
+    INTEGER,POINTER :: target_sign(:)
+
+    PRINT *,"REALLOCATE_REQUEST"
+    src_domain=>req%src_domain
+    src_ind=>req%src_ind
+    target_ind=>req%target_ind
+    src_i=>req%src_i
+    src_j=>req%src_j
+    target_i=>req%target_i
+    target_j=>req%target_j
+    target_sign=>req%target_sign
+
+    ALLOCATE(req%src_domain(req%max_size*2))
+    ALLOCATE(req%src_ind(req%max_size*2))
+    ALLOCATE(req%target_ind(req%max_size*2))
+    ALLOCATE(req%src_i(req%max_size*2))
+    ALLOCATE(req%src_j(req%max_size*2))
+    ALLOCATE(req%target_i(req%max_size*2))
+    ALLOCATE(req%target_j(req%max_size*2))
+    ALLOCATE(req%target_sign(req%max_size*2))
+
+    req%src_domain(1:req%max_size)=src_domain(:)
+    req%src_ind(1:req%max_size)=src_ind(:)
+    req%target_ind(1:req%max_size)=target_ind(:)
+    req%src_i(1:req%max_size)=src_i(:)
+    req%src_j(1:req%max_size)=src_j(:)
+    req%target_i(1:req%max_size)=target_i(:)
+    req%target_j(1:req%max_size)=target_j(:)
+    req%target_sign(1:req%max_size)=target_sign(:)
+
+    req%max_size=req%max_size*2
+
+    DEALLOCATE(src_domain)
+    DEALLOCATE(src_ind)
+    DEALLOCATE(target_ind)
+    DEALLOCATE(src_i)
+    DEALLOCATE(src_j)
+    DEALLOCATE(target_i)
+    DEALLOCATE(target_j)
+    DEALLOCATE(target_sign)
+
+  END SUBROUTINE reallocate_request
+
+
+    SUBROUTINE request_add_point(ind,i,j,request,pos)
+    USE domain_mod
+    USE field_mod
+    IMPLICIT NONE
+      INTEGER,INTENT(IN)            ::  ind
+      INTEGER,INTENT(IN)            :: i
+      INTEGER,INTENT(IN)            :: j
+      TYPE(t_request),POINTER :: request(:)
+      INTEGER,INTENT(IN),OPTIONAL  :: pos
+
+      INTEGER :: src_domain
+      INTEGER :: src_iim,src_i,src_j,src_n,src_pos,src_delta
+      TYPE(t_request),POINTER :: req
+      TYPE(t_domain),POINTER :: d
+
+      req=>request(ind)
+      d=>domain(ind)
+
+      IF (req%max_size==req%size) CALL reallocate_request(req)
+      req%size=req%size+1
+      IF (req%type_field==field_t) THEN
+        src_domain=domain(ind)%assign_domain(i,j)
+        src_iim=domain_glo(src_domain)%iim
+        src_i=domain(ind)%assign_i(i,j)
+        src_j=domain(ind)%assign_j(i,j)
+
+        req%target_ind(req%size)=(j-1)*d%iim+i
+        req%target_sign(req%size)=1
+        req%src_domain(req%size)=src_domain
+        req%src_ind(req%size)=(src_j-1)*src_iim+src_i
+      ELSE IF (req%type_field==field_u) THEN
+        IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme'
+
+        src_domain=domain(ind)%edge_assign_domain(pos-1,i,j)
+        src_iim=domain_glo(src_domain)%iim
+        src_i=domain(ind)%edge_assign_i(pos-1,i,j)
+        src_j=domain(ind)%edge_assign_j(pos-1,i,j)
+        src_n=(src_j-1)*src_iim+src_i
+        src_delta=domain(ind)%delta(i,j)
+        src_pos=domain(ind)%edge_assign_pos(pos-1,i,j)+1
+
+        req%target_ind(req%size)=(j-1)*d%iim+i+d%u_pos(pos)
+
+        req%target_sign(req%size)= 1
+        IF (req%vector) req%target_sign(req%size)= domain(ind)%edge_assign_sign(pos-1,i,j)
+
+        req%src_domain(req%size)=src_domain
+        req%src_ind(req%size)=src_n+domain_glo(src_domain)%u_pos(src_pos)
+
+      ELSE IF (req%type_field==field_z) THEN
+        IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme'
+
+        src_domain=domain(ind)%vertex_assign_domain(pos-1,i,j)
+        src_iim=domain_glo(src_domain)%iim
+        src_i=domain(ind)%vertex_assign_i(pos-1,i,j)
+        src_j=domain(ind)%vertex_assign_j(pos-1,i,j)
+        src_n=(src_j-1)*src_iim+src_i
+        src_delta=domain(ind)%delta(i,j)
+        src_pos=domain(ind)%vertex_assign_pos(pos-1,i,j)+1
+
+
+        req%target_ind(req%size)=(j-1)*d%iim+i+d%z_pos(pos)
+        req%target_sign(req%size)=1
+        req%src_domain(req%size)=src_domain
+        req%src_ind(req%size)=src_n+domain_glo(src_domain)%z_pos(src_pos)
+      ENDIF
+  END SUBROUTINE request_add_point
+
+
+  SUBROUTINE Finalize_request(request)
+  USE mpipara
+  USE domain_mod
+  USE mpi_mod
+  IMPLICIT NONE
+    TYPE(t_request),POINTER :: request(:)
+    TYPE(t_request),POINTER :: req, req_src
+    INTEGER :: nb_domain_recv(0:mpi_size-1)
+    INTEGER :: nb_domain_send(0:mpi_size-1)
+    INTEGER :: tag_rank(0:mpi_size-1)
+    INTEGER :: nb_data_domain_recv(ndomain_glo)
+    INTEGER :: list_domain_recv(ndomain_glo)
+    INTEGER,ALLOCATABLE :: list_domain_send(:)
+    INTEGER             :: list_domain(ndomain)
+
+    INTEGER :: rank,i,j,pos
+    INTEGER :: size_,ind_glo,ind_loc
+    INTEGER :: isend, irecv, ireq, nreq, nsend, nrecv
+    INTEGER, ALLOCATABLE :: mpi_req(:)
+    INTEGER, ALLOCATABLE :: status(:,:)
+    INTEGER, ALLOCATABLE :: rank_list(:)
+    INTEGER, ALLOCATABLE :: offset(:)
+    LOGICAL,PARAMETER :: debug = .FALSE.
+
+
+    IF (.NOT. using_mpi) RETURN
+
+    DO ind_loc=1,ndomain
+      req=>request(ind_loc)
+
+      nb_data_domain_recv(:) = 0
+      nb_domain_recv(:) = 0
+      tag_rank(:)=0
+
+      DO i=1,req%size
+        ind_glo=req%src_domain(i)
+        nb_data_domain_recv(ind_glo)=nb_data_domain_recv(ind_glo)+1
+      ENDDO
+
+      DO ind_glo=1,ndomain_glo
+        IF ( nb_data_domain_recv(ind_glo) > 0 )  nb_domain_recv(domglo_rank(ind_glo))=nb_domain_recv(domglo_rank(ind_glo))+1
+      ENDDO
+
+      req%nrecv=sum(nb_domain_recv(:))
+      ALLOCATE(req%recv(req%nrecv))
+
+      irecv=0
+      DO ind_glo=1,ndomain_glo
+        IF (nb_data_domain_recv(ind_glo)>0) THEN
+          irecv=irecv+1
+          list_domain_recv(ind_glo)=irecv
+          req%recv(irecv)%rank=domglo_rank(ind_glo)
+          req%recv(irecv)%size=nb_data_domain_recv(ind_glo)
+          req%recv(irecv)%domain=domglo_loc_ind(ind_glo)
+          ALLOCATE(req%recv(irecv)%value(req%recv(irecv)%size))
+          ALLOCATE(req%recv(irecv)%sign(req%recv(irecv)%size))
+          ALLOCATE(req%recv(irecv)%buffer(req%recv(irecv)%size))
+        ENDIF
+      ENDDO
+
+      req%recv(:)%size=0
+      irecv=0
+      DO i=1,req%size
+        irecv=list_domain_recv(req%src_domain(i))
+        req%recv(irecv)%size=req%recv(irecv)%size+1
+        size_=req%recv(irecv)%size
+        req%recv(irecv)%value(size_)=req%src_ind(i)
+        req%recv(irecv)%buffer(size_)=req%target_ind(i)
+        req%recv(irecv)%sign(size_)=req%target_sign(i)
+      ENDDO
+    ENDDO
+
+    nb_domain_recv(:) = 0
+    DO ind_loc=1,ndomain
+      req=>request(ind_loc)
+
+      DO irecv=1,req%nrecv
+        rank=req%recv(irecv)%rank
+        nb_domain_recv(rank)=nb_domain_recv(rank)+1
+      ENDDO
+    ENDDO
+
+    CALL MPI_Alltoall(nb_domain_recv,1,MPI_INTEGER,nb_domain_send,1,MPI_INTEGER,comm_icosa,ierr)
+
+
+    ALLOCATE(list_domain_send(sum(nb_domain_send)))
+
+    nreq=sum(nb_domain_recv(:))+sum(nb_domain_send(:))
+    ALLOCATE(mpi_req(nreq))
+    ALLOCATE(status(MPI_STATUS_SIZE,nreq))
+
+
+    ireq=0
+    DO ind_loc=1,ndomain
+      req=>request(ind_loc)
+      DO irecv=1,req%nrecv
+        ireq=ireq+1
+        CALL MPI_ISEND(req%recv(irecv)%domain,1,MPI_INTEGER,req%recv(irecv)%rank,0,comm_icosa, mpi_req(ireq),ierr)
+        IF (debug) PRINT *,"Isend ",req%recv(irecv)%domain, "from ", mpi_rank, "to ",req%recv(irecv)%rank, "tag ",0
+      ENDDO
+    ENDDO
+
+    IF (debug) PRINT *,"------------"
+    j=0
+    DO rank=0,mpi_size-1
+      DO i=1,nb_domain_send(rank)
+        j=j+1
+        ireq=ireq+1
+        CALL MPI_IRECV(list_domain_send(j),1,MPI_INTEGER,rank,0,comm_icosa, mpi_req(ireq),ierr)
+        IF (debug) PRINT *,"IRecv ",list_domain_send(j), "from ", rank, "to ",mpi_rank, "tag ",0
+      ENDDO
+    ENDDO
+    IF (debug) PRINT *,"------------"
+
+    CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+
+    list_domain(:)=0
+    DO i=1,sum(nb_domain_send)
+      ind_loc=list_domain_send(i)
+      list_domain(ind_loc)=list_domain(ind_loc)+1
+    ENDDO
+
+    DO ind_loc=1,ndomain
+      req=>request(ind_loc)
+      req%nsend=list_domain(ind_loc)
+      ALLOCATE(req%send(req%nsend))
+    ENDDO
+
+    IF (debug) PRINT *,"------------"
+
+   ireq=0
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+
+     DO irecv=1,req%nrecv
+       ireq=ireq+1
+       CALL MPI_ISEND(mpi_rank,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
+       IF (debug) PRINT *,"Isend ",mpi_rank, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
+     ENDDO
+    IF (debug) PRINT *,"------------"
+
+     DO isend=1,req%nsend
+       ireq=ireq+1
+       CALL MPI_IRECV(req%send(isend)%rank,1,MPI_INTEGER,MPI_ANY_SOURCE,ind_loc,comm_icosa, mpi_req(ireq),ierr)
+       IF (debug) PRINT *,"IRecv ",req%send(isend)%rank, "from ", "xxx", "to ",mpi_rank, "tag ",ind_loc
+     ENDDO
+   ENDDO
+
+   IF (debug) PRINT *,"------------"
+
+   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+   CALL MPI_BARRIER(comm_icosa,ierr)
+
+   IF (debug) PRINT *,"------------"
+
+   ireq=0
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+
+     DO irecv=1,req%nrecv
+       ireq=ireq+1
+       CALL MPI_ISEND(ind_loc,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
+       IF (debug) PRINT *,"Isend ",ind_loc, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
+     ENDDO
+
+     IF (debug) PRINT *,"------------"
+
+     DO isend=1,req%nsend
+       ireq=ireq+1
+       CALL MPI_IRECV(req%send(isend)%domain,1,MPI_INTEGER,req%send(isend)%rank,ind_loc,comm_icosa, mpi_req(ireq),ierr)
+       IF (debug) PRINT *,"IRecv ",req%send(isend)%domain, "from ", req%send(isend)%rank, "to ",mpi_rank, "tag ",ind_loc
+     ENDDO
+   ENDDO
+   IF (debug) PRINT *,"------------"
+
+   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+   CALL MPI_BARRIER(comm_icosa,ierr)
+   IF (debug) PRINT *,"------------"
+
+   ireq=0
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+
+     DO irecv=1,req%nrecv
+       ireq=ireq+1
+       req%recv(irecv)%tag=tag_rank(req%recv(irecv)%rank)
+       tag_rank(req%recv(irecv)%rank)=tag_rank(req%recv(irecv)%rank)+1
+       CALL MPI_ISEND(req%recv(irecv)%tag,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
+       IF (debug) PRINT *,"Isend ",req%recv(irecv)%tag, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
+     ENDDO
+   IF (debug) PRINT *,"------------"
+
+     DO isend=1,req%nsend
+       ireq=ireq+1
+       CALL MPI_IRECV(req%send(isend)%tag,1,MPI_INTEGER,req%send(isend)%rank,ind_loc,comm_icosa, mpi_req(ireq),ierr)
+       IF (debug) PRINT *,"IRecv ",req%send(isend)%tag, "from ", req%send(isend)%rank, "to ",mpi_rank, "tag ",ind_loc
+     ENDDO
+   ENDDO
+   IF (debug) PRINT *,"------------"
+
+   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+   CALL MPI_BARRIER(comm_icosa,ierr)
+
+
+   IF (debug) PRINT *,"------------"
+
+   ireq=0
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+
+     DO irecv=1,req%nrecv
+       ireq=ireq+1
+       CALL MPI_ISEND(req%recv(irecv)%size,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%tag,comm_icosa, mpi_req(ireq),ierr)
+       IF (debug) PRINT *,"Isend ",req%recv(irecv)%size, "from ", mpi_rank, "to ",req%recv(irecv)%rank,"tag ",req%recv(irecv)%domain
+     ENDDO
+     IF (debug) PRINT *,"------------"
+
+     DO isend=1,req%nsend
+       ireq=ireq+1
+       CALL MPI_IRECV(req%send(isend)%size,1,MPI_INTEGER,req%send(isend)%rank,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
+       IF (debug) PRINT *,"IRecv ",req%send(isend)%size, "from ", req%send(isend)%rank, "to ",mpi_rank, "tag ",ind_loc
+     ENDDO
+   ENDDO
+
+   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+
+   ireq=0
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+
+     DO irecv=1,req%nrecv
+       ireq=ireq+1
+       CALL MPI_ISEND(req%recv(irecv)%value,req%recv(irecv)%size,MPI_INTEGER,&
+            req%recv(irecv)%rank,req%recv(irecv)%tag,comm_icosa, mpi_req(ireq),ierr)
+     ENDDO
+
+     DO isend=1,req%nsend
+       ireq=ireq+1
+       ALLOCATE(req%send(isend)%value(req%send(isend)%size))
+       CALL MPI_IRECV(req%send(isend)%value,req%send(isend)%size,MPI_INTEGER,&
+            req%send(isend)%rank,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
+     ENDDO
+   ENDDO
+
+   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+
+     DO irecv=1,req%nrecv
+       req%recv(irecv)%value(:)=req%recv(irecv)%buffer(:)
+       req%recv(irecv)%sign(:) =req%recv(irecv)%sign(:)
+       DEALLOCATE(req%recv(irecv)%buffer)
+     ENDDO
+   ENDDO
+
+
+! domain is on the same mpi process => copie memory to memory
+
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+
+     DO irecv=1,req%nrecv
+
+       IF (req%recv(irecv)%rank==mpi_rank) THEN
+           req_src=>request(req%recv(irecv)%domain)
+           DO isend=1,req_src%nsend
+             IF (req_src%send(isend)%rank==mpi_rank .AND. req_src%send(isend)%tag==req%recv(irecv)%tag) THEN
+               req%recv(irecv)%src_value => req_src%send(isend)%value
+               IF ( size(req%recv(irecv)%value) /= size(req_src%send(isend)%value)) THEN
+                 PRINT *,ind_loc, irecv, isend, size(req%recv(irecv)%value), size(req_src%send(isend)%value)
+                 STOP "size(req%recv(irecv)%value) /= size(req_src%send(isend)%value"
+               ENDIF
+             ENDIF
+           ENDDO
+       ENDIF
+
+     ENDDO
+   ENDDO
+
+! true number of mpi request
+
+   request(:)%nreq_mpi=0
+   request(:)%nreq_send=0
+   request(:)%nreq_recv=0
+   ALLOCATE(rank_list(sum(request(:)%nsend)))
+   ALLOCATE(offset(sum(request(:)%nsend)))
+   offset(:)=0
+
+   nsend=0
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+
+     DO isend=1,req%nsend
+       IF (req%send(isend)%rank/=mpi_rank) THEN
+         pos=0
+         DO i=1,nsend
+           IF (req%send(isend)%rank==rank_list(i)) EXIT
+           pos=pos+1
+         ENDDO
+
+         IF (pos==nsend) THEN
+           nsend=nsend+1
+           req%nreq_mpi=req%nreq_mpi+1
+           req%nreq_send=req%nreq_send+1
+           IF (mpi_threading_mode==MPI_THREAD_FUNNELED .OR. mpi_threading_mode==MPI_THREAD_SINGLE) THEN
+             rank_list(nsend)=req%send(isend)%rank
+           ELSE
+             rank_list(nsend)=-1
+           ENDIF
+         ENDIF
+
+         pos=pos+1
+         req%send(isend)%ireq=pos
+         req%send(isend)%offset=offset(pos)
+         offset(pos)=offset(pos)+req%send(isend)%size
+       ENDIF
+     ENDDO
+   ENDDO
+
+   DEALLOCATE(rank_list)
+   DEALLOCATE(offset)
+
+   ALLOCATE(rank_list(sum(request(:)%nrecv)))
+   ALLOCATE(offset(sum(request(:)%nrecv)))
+   offset(:)=0
+
+   nrecv=0
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+
+     DO irecv=1,req%nrecv
+       IF (req%recv(irecv)%rank/=mpi_rank) THEN
+         pos=0
+         DO i=1,nrecv
+           IF (req%recv(irecv)%rank==rank_list(i)) EXIT
+           pos=pos+1
+         ENDDO
+
+         IF (pos==nrecv) THEN
+           nrecv=nrecv+1
+           req%nreq_mpi=req%nreq_mpi+1
+           req%nreq_recv=req%nreq_recv+1
+           IF (mpi_threading_mode==MPI_THREAD_FUNNELED .OR. mpi_threading_mode==MPI_THREAD_SINGLE) THEN
+             rank_list(nrecv)=req%recv(irecv)%rank
+           ELSE
+             rank_list(nrecv)=-1
+           ENDIF
+         ENDIF
+
+         pos=pos+1
+         req%recv(irecv)%ireq=nsend+pos
+         req%recv(irecv)%offset=offset(pos)
+         offset(pos)=offset(pos)+req%recv(irecv)%size
+       ENDIF
+     ENDDO
+   ENDDO
+
+! get the offsets
+
+   ireq=0
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+
+     DO irecv=1,req%nrecv
+       ireq=ireq+1
+       CALL MPI_ISEND(req%recv(irecv)%offset,1,MPI_INTEGER,&
+            req%recv(irecv)%rank,req%recv(irecv)%tag,comm_icosa, mpi_req(ireq),ierr)
+     ENDDO
+
+     DO isend=1,req%nsend
+       ireq=ireq+1
+       CALL MPI_IRECV(req%send(isend)%offset,1,MPI_INTEGER,&
+            req%send(isend)%rank,req%send(isend)%tag,comm_icosa, mpi_req(ireq),ierr)
+     ENDDO
+   ENDDO
+
+   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+
+
+  END SUBROUTINE Finalize_request
+
+
+  SUBROUTINE init_message_seq(field, request, message, name)
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  USE mpi_mod
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    TYPE(t_request),POINTER :: request(:)
+    TYPE(t_message) :: message
+    CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
+!$OMP MASTER
+    message%request=>request
+    IF(PRESENT(name)) THEN
+       message%name = TRIM(name)
+    ELSE
+       message%name = 'unknown'
+    END IF
+!$OMP END MASTER
+!$OMP BARRIER
+
+  END SUBROUTINE init_message_seq
+
+  SUBROUTINE send_message_seq(field,message)
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  USE omp_para
+  USE trace
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    TYPE(t_message) :: message
+
+    CALL transfert_request_seq(field,message%request)
+
+  END SUBROUTINE send_message_seq
+
+  SUBROUTINE test_message_seq(message)
+  IMPLICIT NONE
+    TYPE(t_message) :: message
+  END SUBROUTINE  test_message_seq
+
+
+  SUBROUTINE wait_message_seq(message)
+  IMPLICIT NONE
+    TYPE(t_message) :: message
+
+  END SUBROUTINE wait_message_seq
+
+  SUBROUTINE init_message_mpi(field,request, message, name)
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  USE mpi_mod
+  IMPLICIT NONE
+
+    TYPE(t_field),POINTER :: field(:)
+    TYPE(t_request),POINTER :: request(:)
+    TYPE(t_message) :: message
+    CHARACTER(LEN=*), INTENT(IN),OPTIONAL :: name
+
+    TYPE(t_request),POINTER :: req
+    INTEGER :: irecv,isend
+    INTEGER :: ireq,nreq
+    INTEGER :: ind
+    INTEGER :: dim3,dim4
+    INTEGER,SAVE :: message_number=0
+!    TYPE(t_reorder),POINTER :: reorder(:)
+!    TYPE(t_reorder) :: reorder_swap
+
+!$OMP BARRIER
+!$OMP MASTER
+    !init off-device
+    message%ondevice=.false.
+
+    IF(PRESENT(name)) THEN
+       message%name = TRIM(name)
+    ELSE
+       message%name = 'unknown'
+    END IF
+    message%number=message_number
+    message_number=message_number+1
+    IF (message_number==100) message_number=0
+
+
+    message%request=>request
+    message%nreq=sum(message%request(:)%nreq_mpi)
+    message%nreq_send=sum(message%request(:)%nreq_send)
+    message%nreq_recv=sum(message%request(:)%nreq_recv)
+    nreq=message%nreq
+
+    ALLOCATE(message%mpi_req(nreq))
+    ALLOCATE(message%buffers(nreq))
+    ALLOCATE(message%status(MPI_STATUS_SIZE,nreq))
+    message%buffers(:)%size=0
+    message%pending=.FALSE.
+    message%completed=.FALSE.
+    message%open=.FALSE.
+
+    DO ind=1,ndomain
+      req=>request(ind)
+      DO isend=1,req%nsend
+        IF (req%send(isend)%rank/=mpi_rank) THEN
+          ireq=req%send(isend)%ireq
+          message%buffers(ireq)%size=message%buffers(ireq)%size+req%send(isend)%size
+          message%buffers(ireq)%rank=req%send(isend)%rank
+        ENDIF
+      ENDDO
+      DO irecv=1,req%nrecv
+        IF (req%recv(irecv)%rank/=mpi_rank) THEN
+          ireq=req%recv(irecv)%ireq
+          message%buffers(ireq)%size=message%buffers(ireq)%size+req%recv(irecv)%size
+          message%buffers(ireq)%rank=req%recv(irecv)%rank
+        ENDIF
+      ENDDO
+    ENDDO
+
+
+    IF (field(1)%data_type==type_real) THEN
+
+      IF (field(1)%ndim==2) THEN
+
+        DO ireq=1,message%nreq
+          CALL allocate_mpi_buffer(message%buffers(ireq)%r,message%buffers(ireq)%size)
+        ENDDO
+
+      ELSE  IF (field(1)%ndim==3) THEN
+
+        dim3=size(field(1)%rval3d,2)
+        DO ireq=1,message%nreq
+          message%buffers(ireq)%size=message%buffers(ireq)%size*dim3
+          CALL allocate_mpi_buffer(message%buffers(ireq)%r,message%buffers(ireq)%size)
+        ENDDO
+
+      ELSE  IF (field(1)%ndim==4) THEN
+        dim3=size(field(1)%rval4d,2)
+        dim4=size(field(1)%rval4d,3)
+        DO ireq=1,message%nreq
+          message%buffers(ireq)%size=message%buffers(ireq)%size*dim3*dim4
+          CALL allocate_mpi_buffer(message%buffers(ireq)%r,message%buffers(ireq)%size)
+        ENDDO
+      ENDIF
+    ENDIF
+
+
+
+! ! Reorder the request, so recv request are done in the same order than send request
+
+!    nreq_send=sum(request(:)%nsend)
+!    message%nreq_send=nreq_send
+!    ALLOCATE(message%reorder(nreq_send))
+!    reorder=>message%reorder
+!    ireq=0
+!    DO ind=1,ndomain
+!      req=>request(ind)
+!      DO isend=1,req%nsend
+!        ireq=ireq+1
+!        reorder(ireq)%ind=ind
+!        reorder(ireq)%isend=isend
+!        reorder(ireq)%tag=req%send(isend)%tag
+!      ENDDO
+!    ENDDO
+
+! ! do a very very bad sort
+!    DO i=1,nreq_send-1
+!      DO j=i+1,nreq_send
+!        IF (reorder(i)%tag > reorder(j)%tag) THEN
+!          reorder_swap=reorder(i)
+!          reorder(i)=reorder(j)
+!          reorder(j)=reorder_swap
+!        ENDIF
+!      ENDDO
+!    ENDDO
+!    PRINT *,"reorder ",reorder(:)%tag
+
+
+!$OMP END MASTER
+!$OMP BARRIER
+
+  END SUBROUTINE init_message_mpi
+
+  SUBROUTINE Finalize_message_mpi(message)
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  USE mpi_mod
+  IMPLICIT NONE
+    TYPE(t_message) :: message
+
+    INTEGER :: ireq, ibuff
+
+!$OMP BARRIER
+!$OMP MASTER
+
+
+    IF (message%field(1)%data_type==type_real) THEN
+      DO ireq=1,message%nreq
+        CALL free_mpi_buffer(message%buffers(ireq)%r)
+      ENDDO
+    ENDIF
+
+    !deallocate device data if ondevice
+    if(message%ondevice) then
+      do ireq=1, ndomain
+        do ibuff=1,message%request(ireq)%nsend
+          !$acc exit data delete(message%request(ireq)%send(ibuff)%buffer(:))
+          !$acc exit data delete(message%request(ireq)%send(ibuff)%buffer_r(:))
+          !$acc exit data delete(message%request(ireq)%send(ibuff)%sign(:))
+          !$acc exit data delete(message%request(ireq)%send(ibuff)%src_value(:))
+          !$acc exit data delete(message%request(ireq)%send(ibuff)%value(:))
+        end do
+        do ibuff=1,message%request(ireq)%nrecv
+          !$acc exit data delete(message%request(ireq)%recv(ibuff)%buffer(:))
+          !$acc exit data delete(message%request(ireq)%recv(ibuff)%buffer_r(:))
+          !$acc exit data delete(message%request(ireq)%recv(ibuff)%sign(:))
+          !$acc exit data delete(message%request(ireq)%recv(ibuff)%src_value(:))
+          !$acc exit data delete(message%request(ireq)%recv(ibuff)%value(:))
+        end do
+      end do
+      DO ireq=1,message%nreq
+        !$acc exit data delete(message%buffers(ireq)%r)
+      ENDDO
+      message%ondevice=.false.
+    end if
+
+    DEALLOCATE(message%mpi_req)
+    DEALLOCATE(message%buffers)
+    DEALLOCATE(message%status)
+
+!$OMP END MASTER
+!$OMP BARRIER
+
+
+  END SUBROUTINE Finalize_message_mpi
+
+
+  !!!Update buffers on device for 'message'
+  !!! does create_device_message when not already ondevice
+  SUBROUTINE update_device_message_mpi(message)
+    USE domain_mod
+    IMPLICIT NONE
+    TYPE(t_message), intent(inout) :: message
+    INTEGER :: ireq, ibuff
+
+    !if(.not. message%ondevice) call create_device_message_mpi(message)
+
+    do ireq=1, ndomain
+      do ibuff=1,message%request(ireq)%nsend
+        !device buffers updated even if pointers not attached :
+        !non allocated buffers in 'message' must be set to NULL()
+        !$acc enter data copyin(message%request(ireq)%send(ibuff)%buffer(:)) async
+        !$acc enter data copyin(message%request(ireq)%send(ibuff)%buffer_r(:)) async
+        !$acc enter data copyin(message%request(ireq)%send(ibuff)%sign(:)) async
+        !$acc enter data copyin(message%request(ireq)%send(ibuff)%src_value(:)) async
+        !$acc enter data copyin(message%request(ireq)%send(ibuff)%value(:)) async
+      end do
+      do ibuff=1,message%request(ireq)%nrecv
+        !$acc enter data copyin(message%request(ireq)%recv(ibuff)%buffer(:)) async
+        !$acc enter data copyin(message%request(ireq)%recv(ibuff)%buffer_r(:)) async
+        !$acc enter data copyin(message%request(ireq)%recv(ibuff)%sign(:)) async
+        !$acc enter data copyin(message%request(ireq)%recv(ibuff)%src_value(:)) async
+        !$acc enter data copyin(message%request(ireq)%recv(ibuff)%value(:)) async
+      end do
+    end do
+    DO ireq=1,message%nreq
+      !$acc enter data copyin(message%buffers(ireq)%r) async
+    ENDDO
+    message%ondevice=.true.
+  END SUBROUTINE
+
+  !TODO : add openacc with multiple process
+  SUBROUTINE send_message_mpi(field,message)
+  USE abort_mod
+  USE profiling_mod
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  USE omp_para
+  USE trace
+  USE abort_mod
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    TYPE(t_message) :: message
+    REAL(rstd),POINTER :: rval2d(:), src_rval2d(:)
+    REAL(rstd),POINTER :: rval3d(:,:), src_rval3d(:,:)
+    REAL(rstd),POINTER :: rval4d(:,:,:), src_rval4d(:,:,:)
+    REAL(rstd),POINTER :: buffer_r(:)
+    INTEGER,POINTER :: value(:)
+    INTEGER,POINTER :: sgn(:)
+    TYPE(ARRAY),POINTER :: recv,send
+    TYPE(t_request),POINTER :: req
+    INTEGER :: irecv,isend
+    INTEGER :: ireq
+    INTEGER :: ind,n
+    INTEGER :: dim3,dim4,d3,d4
+    INTEGER,POINTER :: src_value(:)
+    INTEGER :: offset,msize,moffset,rank
+    INTEGER :: lbegin, lend
+    INTEGER :: max_req
+
+!    CALL trace_start("send_message_mpi")
+
+    CALL enter_profile(id_mpi)
+
+    !Prepare 'message' for on-device copies if field is on device
+    if( field(1)%ondevice .AND. .NOT. message%ondevice ) call update_device_message_mpi(message)
+
+CALL enter_profile(profile_mpi_omp_barrier)
+!$OMP BARRIER
+CALL exit_profile(profile_mpi_omp_barrier)
+
+
+!$OMP MASTER
+    IF(message%open) THEN
+       PRINT *, 'send_message_mpi : message ' // TRIM(message%name) // &
+            ' is still open, no call to wait_message_mpi after last send_message_mpi'
+       CALL dynamico_abort( "send_message_mpi : message still open" )
+    END IF
+    message%open=.TRUE. ! will be set to .FALSE. by wait_message_mpi
+
+    message%field=>field
+
+    IF (message%nreq>0) THEN
+      message%completed=.FALSE.
+      message%pending=.TRUE.
+    ELSE
+      message%completed=.TRUE.
+      message%pending=.FALSE.
+    ENDIF
+!$OMP END MASTER
+CALL enter_profile(profile_mpi_omp_barrier)
+!$OMP BARRIER
+CALL exit_profile(profile_mpi_omp_barrier)
+     
+    IF (field(1)%data_type==type_real) THEN
+      IF (field(1)%ndim==2) THEN
+
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+
+          rval2d=>field(ind)%rval2d
+
+          req=>message%request(ind)
+          DO isend=1,req%nsend
+            send=>req%send(isend)
+            value=>send%value
+
+
+            IF (send%rank/=mpi_rank) THEN
+              ireq=send%ireq
+
+              buffer_r=>message%buffers(ireq)%r
+              offset=send%offset
+              msize=send%size
+              call enter_profile(profile_mpi_copies)
+              !$acc parallel loop default(present) async if (field(ind)%ondevice)
+              DO n=1,msize
+                buffer_r(offset+n)=rval2d(value(n))
+              ENDDO
+              call exit_profile(profile_mpi_copies)
+
+              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
+                CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
+                !$OMP CRITICAL
+                CALL MPI_ISEND(buffer_r,send%size,MPI_REAL8,send%rank,               &
+                  send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+                !$OMP END CRITICAL
+              ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
+                CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
+                CALL MPI_ISEND(buffer_r,send%size,MPI_REAL8,send%rank,               &
+                  send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+              ENDIF
+
+            ENDIF
+          ENDDO
+        ENDDO
+
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+          rval2d=>field(ind)%rval2d
+          req=>message%request(ind)
+
+          DO irecv=1,req%nrecv
+            recv=>req%recv(irecv)
+
+            IF (recv%rank==mpi_rank) THEN
+
+              value=>recv%value
+              src_value => recv%src_value
+              src_rval2d=>field(recv%domain)%rval2d
+              sgn=>recv%sign
+              msize=recv%size
+              call enter_profile(profile_mpi_copies)
+              !$acc parallel loop default(present) async if (field(ind)%ondevice)
+              DO n=1,msize
+                rval2d(value(n))=src_rval2d(src_value(n))*sgn(n)
+              ENDDO
+              call exit_profile(profile_mpi_copies)
+                    
+            ELSE
+
+              ireq=recv%ireq
+              buffer_r=>message%buffers(ireq)%r
+              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
+                CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
+               !$OMP CRITICAL
+                CALL MPI_IRECV(buffer_r,recv%size,MPI_REAL8,recv%rank,               &
+                  recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+               !$OMP END CRITICAL
+              ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
+                 CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
+                 CALL MPI_IRECV(buffer_r,recv%size,MPI_REAL8,recv%rank,              &
+                   recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+              ENDIF
+
+            ENDIF
+          ENDDO
+
+        ENDDO
+
+
+      ELSE  IF (field(1)%ndim==3) THEN
+        max_req=0
+        DO ind=1,ndomain
+          req=>message%request(ind)
+          IF (req%nsend>max_req) max_req=req%nsend
+        ENDDO
+
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) ) CYCLE
+
+          dim3=size(field(ind)%rval3d,2)
+          CALL distrib_level(1,dim3, lbegin,lend)
+
+          rval3d=>field(ind)%rval3d
+          req=>message%request(ind)
+
+          DO isend=1,req%nsend
+            send=>req%send(isend)
+            value=>send%value
+
+            IF (send%rank/=mpi_rank) THEN
+              ireq=send%ireq
+              buffer_r=>message%buffers(ireq)%r
+
+              msize=send%size
+              moffset=send%offset
+              call enter_profile(profile_mpi_copies)
+
+              !$acc parallel loop default(present) async if (field(ind)%ondevice)
+              DO d3=lbegin,lend
+                offset=moffset*dim3 + (d3-1)*msize
+                !$acc loop
+                DO n=1,msize
+                  buffer_r(n+offset)=rval3d(value(n),d3)
+                ENDDO
+              ENDDO
+              call exit_profile(profile_mpi_copies)
+
+              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
+CALL enter_profile(profile_mpi_omp_barrier)
+!$OMP BARRIER
+CALL exit_profile(profile_mpi_omp_barrier)
+
+              ENDIF
+
+              IF (is_omp_level_master) THEN
+                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
+                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
+                  !$OMP CRITICAL
+                  CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank,        &
+                    send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+                  !$OMP END CRITICAL
+                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
+                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
+                  CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank,        &
+                    send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+                ENDIF
+              ENDIF
+            ELSE
+              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
+CALL enter_profile(profile_mpi_omp_barrier)
+!$OMP BARRIER
+CALL exit_profile(profile_mpi_omp_barrier)
+
+              ENDIF
+            ENDIF
+          ENDDO
+
+          IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
+            DO isend=req%nsend+1,max_req
+CALL enter_profile(profile_mpi_omp_barrier)
+!$OMP BARRIER
+CALL exit_profile(profile_mpi_omp_barrier)
+
+            ENDDO
+          ENDIF
+
+        ENDDO
+
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) ) CYCLE
+          dim3=size(field(ind)%rval3d,2)
+          CALL distrib_level(1,dim3, lbegin,lend)
+          rval3d=>field(ind)%rval3d
+          req=>message%request(ind)
+
+          DO irecv=1,req%nrecv
+            recv=>req%recv(irecv)
+
+            IF (recv%rank==mpi_rank) THEN
+              value=>recv%value
+              src_value => recv%src_value
+              src_rval3d=>field(recv%domain)%rval3d
+              sgn=>recv%sign
+              msize=recv%size
+
+              call enter_profile(profile_mpi_copies)
+              CALL trace_start("copy_data")
+              !$acc parallel loop collapse(2) default(present) async if (field(ind)%ondevice)
+              DO d3=lbegin,lend
+                DO n=1,msize
+                  rval3d(value(n),d3)=src_rval3d(src_value(n),d3)*sgn(n)
+                ENDDO
+              ENDDO
+              call exit_profile(profile_mpi_copies)
+              CALL trace_end("copy_data")
+
+            ELSE
+              ireq=recv%ireq
+              buffer_r=>message%buffers(ireq)%r
+
+              IF (is_omp_level_master) THEN
+                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
+                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
+                  !$OMP CRITICAL
+                  CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank,        &
+                    recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+                  !$OMP END CRITICAL
+                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
+                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
+                  CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank,        &
+                    recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+                ENDIF
+              ENDIF
+            ENDIF
+          ENDDO
+
+        ENDDO
+
+      ELSE  IF (field(1)%ndim==4) THEN
+
+        max_req=0
+        DO ind=1,ndomain
+          req=>message%request(ind)
+          IF (req%nsend>max_req) max_req=req%nsend
+        ENDDO
+
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) ) CYCLE
+
+          dim3=size(field(ind)%rval4d,2)
+          CALL distrib_level(1,dim3, lbegin,lend)
+          dim4=size(field(ind)%rval4d,3)
+          rval4d=>field(ind)%rval4d
+          req=>message%request(ind)
+
+          DO isend=1,req%nsend
+            send=>req%send(isend)
+            value=>send%value
+
+            IF (send%rank/=mpi_rank) THEN
+
+              ireq=send%ireq
+              buffer_r=>message%buffers(ireq)%r
+              msize=send%size
+              moffset=send%offset
+
+              call enter_profile(profile_mpi_copies)
+              CALL trace_start("copy_to_buffer")
+              !$acc parallel loop default(present) collapse(2) async if (field(ind)%ondevice)
+              DO d4=1,dim4
+                DO d3=lbegin,lend
+                  offset=moffset*dim3*dim4 + dim3*msize*(d4-1) +               &
+                    (d3-1)*msize
+                  !$acc loop
+                  DO n=1,msize
+                    buffer_r(n+offset)=rval4d(value(n),d3,d4)
+                  ENDDO
+                ENDDO
+              ENDDO
+              CALL trace_end("copy_to_buffer")
+              call exit_profile(profile_mpi_copies)
+
+              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
+CALL enter_profile(profile_mpi_omp_barrier)
+!$OMP BARRIER
+CALL exit_profile(profile_mpi_omp_barrier)
+
+              ENDIF
+
+              IF (is_omp_level_master) THEN
+                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
+                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
+                  !$OMP CRITICAL
+                  CALL MPI_ISEND(buffer_r,send%size*dim3*dim4,MPI_REAL8,send%rank,   &
+                    send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+                  !$OMP END CRITICAL
+                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
+                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
+                  CALL MPI_ISEND(buffer_r,send%size*dim3*dim4,MPI_REAL8,send%rank,   &
+                    send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+                ENDIF
+              ENDIF
+            ELSE
+              IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
+CALL enter_profile(profile_mpi_omp_barrier)
+!$OMP BARRIER
+CALL exit_profile(profile_mpi_omp_barrier)
+
+              ENDIF
+            ENDIF
+          ENDDO
+
+          IF (mpi_threading_mode==MPI_THREAD_SERIALIZED.OR.mpi_threading_mode==MPI_THREAD_MULTIPLE .AND. omp_level_size>1) THEN
+            DO isend=req%nsend+1,max_req
+CALL enter_profile(profile_mpi_omp_barrier)
+!$OMP BARRIER
+CALL exit_profile(profile_mpi_omp_barrier)
+
+            ENDDO
+          ENDIF
+
+        ENDDO
+
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) ) CYCLE
+
+          dim3=size(field(ind)%rval4d,2)
+          CALL distrib_level(1,dim3, lbegin,lend)
+          dim4=size(field(ind)%rval4d,3)
+          rval4d=>field(ind)%rval4d
+          req=>message%request(ind)
+          
+          DO irecv=1,req%nrecv
+            recv=>req%recv(irecv)
+            IF (recv%rank==mpi_rank) THEN
+              value=>recv%value
+              src_value => recv%src_value
+              src_rval4d=>field(recv%domain)%rval4d
+              sgn=>recv%sign
+              msize=recv%size
+              call enter_profile(profile_mpi_copies)
+              CALL trace_start("copy_data")
+              !$acc parallel loop collapse(3) default(present) async if (field(ind)%ondevice)
+              DO d4=1,dim4
+                DO d3=lbegin,lend
+                  DO n=1,msize
+                    rval4d(value(n),d3,d4)=src_rval4d(src_value(n),d3,d4)*sgn(n)
+                  ENDDO
+                ENDDO
+              ENDDO
+              call exit_profile(profile_mpi_copies)
+              CALL trace_end("copy_data")
+
+            ELSE
+
+              ireq=recv%ireq
+              buffer_r=>message%buffers(ireq)%r
+              IF (is_omp_level_master) THEN
+                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN
+                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_SERIALIZED")
+                 !$OMP CRITICAL
+                  CALL MPI_IRECV(buffer_r,recv%size*dim3*dim4,MPI_REAL8,recv%rank,   &
+                    recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+                  !$OMP END CRITICAL
+                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN
+                  CALL abort_acc("mpi_threading_mode==MPI_THREAD_MULTIPLE")
+                  CALL MPI_IRECV(buffer_r,recv%size*dim3*dim4,MPI_REAL8,recv%rank,   &
+                    recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)
+                ENDIF
+              ENDIF
+            ENDIF
+          ENDDO
+        ENDDO
+
+      ENDIF
+
+      IF (mpi_threading_mode==MPI_THREAD_FUNNELED .OR. mpi_threading_mode==MPI_THREAD_SINGLE) THEN
+CALL enter_profile(profile_mpi_omp_barrier)
+!$acc wait
+!$OMP BARRIER
+CALL exit_profile(profile_mpi_omp_barrier)
+!$OMP MASTER        
+
+        DO ireq=1,message%nreq_send
+          buffer_r=>message%buffers(ireq)%r
+          msize=message%buffers(ireq)%size
+          rank=message%buffers(ireq)%rank
+          ! Using the "if" clause on the "host_data" directive seems to cause a crash at compilation
+          IF (message%ondevice) THEN
+            !$acc host_data use_device(buffer_r) ! if (message%ondevice)
+            CALL MPI_ISEND(buffer_r,msize,MPI_REAL8,rank,1000*message%number,          &
+              comm_icosa, message%mpi_req(ireq),ierr)
+            !$acc end host_data
+          ELSE
+            CALL MPI_ISEND(buffer_r,msize,MPI_REAL8,rank,1000*message%number,          &
+              comm_icosa, message%mpi_req(ireq),ierr)
+          ENDIF
+        ENDDO
+
+        DO ireq=message%nreq_send+1,message%nreq_send+message%nreq_recv
+          buffer_r=>message%buffers(ireq)%r
+          msize=message%buffers(ireq)%size
+          rank=message%buffers(ireq)%rank
+          ! Using the "if" clause on the "host_data" directive seems to cause a crash at compilation
+          IF (message%ondevice) THEN
+            !$acc host_data use_device(buffer_r) ! if (message%ondevice)
+            CALL MPI_IRECV(buffer_r,msize,MPI_REAL8,rank,1000*message%number,          &
+              comm_icosa, message%mpi_req(ireq),ierr)
+            !$acc end host_data
+          ELSE
+            CALL MPI_IRECV(buffer_r,msize,MPI_REAL8,rank,1000*message%number,          &
+              comm_icosa, message%mpi_req(ireq),ierr)
+          ENDIF
+        ENDDO
+
+!$OMP END MASTER
+      ENDIF
+    ENDIF
+CALL enter_profile(profile_mpi_omp_barrier)
+!$OMP BARRIER
+CALL exit_profile(profile_mpi_omp_barrier)
+ 
+!    CALL trace_end("send_message_mpi")
+
+    CALL exit_profile(id_mpi)
+
+  END SUBROUTINE send_message_mpi
+
+  SUBROUTINE test_message_mpi(message)
+  IMPLICIT NONE
+    TYPE(t_message) :: message
+
+    INTEGER :: ierr
+
+!$OMP MASTER
+    IF (message%pending .AND. .NOT. message%completed) CALL MPI_TESTALL(message%nreq,&
+      message%mpi_req,message%completed,message%status,ierr)
+!$OMP END MASTER
+  END SUBROUTINE  test_message_mpi
+
+
+  SUBROUTINE wait_message_mpi(message)
+  USE profiling_mod
+  USE field_mod
+  USE domain_mod
+  USE mpi_mod
+  USE mpipara
+  USE omp_para
+  USE trace
+  IMPLICIT NONE
+    TYPE(t_message) :: message
+
+    TYPE(t_field),POINTER :: field(:)
+    REAL(rstd),POINTER :: rval2d(:)
+    REAL(rstd),POINTER :: rval3d(:,:)
+    REAL(rstd),POINTER :: rval4d(:,:,:)
+    REAL(rstd),POINTER :: buffer_r(:)
+    INTEGER,POINTER :: value(:)
+    INTEGER,POINTER :: sgn(:)
+    TYPE(ARRAY),POINTER :: recv
+    TYPE(t_request),POINTER :: req
+    INTEGER :: irecv
+    INTEGER :: ireq,nreq
+    INTEGER :: ind,n
+    INTEGER :: dim3,dim4,d3,d4,lbegin,lend
+    INTEGER :: offset, msize, moffset
+
+    message%open=.FALSE.
+    IF (.NOT. message%pending) RETURN
+
+    CALL enter_profile(id_mpi)
+
+!    CALL trace_start("wait_message_mpi")
+
+    field=>message%field
+    nreq=message%nreq
+
+    IF (field(1)%data_type==type_real) THEN
+      IF (field(1)%ndim==2) THEN
+
+call enter_profile(profile_mpi_waitall)
+!$OMP MASTER         
+         IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req,          &
+          message%status,ierr)
+!$OMP END MASTER
+!$OMP BARRIER
+call exit_profile(profile_mpi_waitall)
+        call enter_profile(profile_mpi_copies)
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+
+          rval2d=>field(ind)%rval2d
+          req=>message%request(ind)
+          DO irecv=1,req%nrecv
+            recv=>req%recv(irecv)
+            IF (recv%rank/=mpi_rank) THEN
+              ireq=recv%ireq
+              buffer_r=>message%buffers(ireq)%r
+              value=>recv%value
+              sgn=>recv%sign
+              offset=recv%offset
+              msize=recv%size
+              !$acc parallel loop default(present) async if (field(ind)%ondevice)
+              DO n=1,msize
+                rval2d(value(n))=buffer_r(n+offset)*sgn(n)
+              ENDDO
+
+            ENDIF
+          ENDDO
+
+        ENDDO
+        call exit_profile(profile_mpi_copies)
+      
+      
+      ELSE  IF (field(1)%ndim==3) THEN
+         call enter_profile(profile_mpi_waitall)
+!$OMP MASTER
+         IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req,          &
+              message%status,ierr)
+!$OMP END MASTER
+!$OMP BARRIER
+        call exit_profile(profile_mpi_waitall)
+
+
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) ) CYCLE
+
+          rval3d=>field(ind)%rval3d
+          req=>message%request(ind)
+          DO irecv=1,req%nrecv
+            recv=>req%recv(irecv)
+            IF (recv%rank/=mpi_rank) THEN
+              ireq=recv%ireq
+              buffer_r=>message%buffers(ireq)%r
+              value=>recv%value
+              sgn=>recv%sign
+
+              dim3=size(rval3d,2)
+
+              CALL distrib_level(1,dim3, lbegin,lend)
+              msize=recv%size
+              moffset=recv%offset
+              call enter_profile(profile_mpi_copies)
+              CALL trace_start("copy_from_buffer")
+
+              IF (req%vector) THEN
+                !$acc parallel loop default(present) async if (field(ind)%ondevice)
+                DO d3=lbegin,lend
+                  offset=moffset*dim3 + (d3-1)*msize
+                  !$acc loop
+                  DO n=1,msize
+                    rval3d(value(n),d3)=buffer_r(n+offset)*sgn(n)
+                  ENDDO
+                ENDDO
+              ELSE
+                !$acc parallel loop default(present) async if (field(ind)%ondevice)
+                DO d3=lbegin,lend
+                  offset=moffset*dim3 + (d3-1)*msize
+                  !$acc loop
+                  DO n=1,msize
+                    rval3d(value(n),d3)=buffer_r(n+offset)
+                  ENDDO
+                ENDDO
+              ENDIF
+
+              CALL trace_end("copy_from_buffer")
+              call exit_profile(profile_mpi_copies)
+            ENDIF
+          ENDDO
+
+        ENDDO
+
+      ELSE  IF (field(1)%ndim==4) THEN
+call enter_profile(profile_mpi_waitall)
+!$OMP MASTER
+        IF (.NOT. message%completed) CALL MPI_WAITALL(nreq,message%mpi_req,          &
+          message%status,ierr)
+!$OMP END MASTER
+!$OMP BARRIER
+        call exit_profile(profile_mpi_waitall)
+
+
+        DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind) ) CYCLE
+
+          rval4d=>field(ind)%rval4d
+          req=>message%request(ind)
+          DO irecv=1,req%nrecv
+            recv=>req%recv(irecv)
+            IF (recv%rank/=mpi_rank) THEN
+              ireq=recv%ireq
+              buffer_r=>message%buffers(ireq)%r
+              value=>recv%value
+              sgn=>recv%sign
+
+              dim3=size(rval4d,2)
+              CALL distrib_level(1,dim3, lbegin,lend)
+              dim4=size(rval4d,3)
+              msize=recv%size
+              moffset=recv%offset
+              call enter_profile(profile_mpi_copies)
+              CALL trace_start("copy_from_buffer")
+              !$acc parallel loop default(present) collapse(2) async if (field(ind)%ondevice)
+              DO d4=1,dim4
+                DO d3=lbegin,lend
+                  offset=moffset*dim3*dim4 + dim3*msize*(d4-1) +               &
+                    (d3-1)*msize
+                  !$acc loop
+                  DO n=1,msize
+                    rval4d(value(n),d3,d4)=buffer_r(n+offset)*sgn(n)
+                  ENDDO
+                ENDDO
+              ENDDO
+              CALL trace_end("copy_from_buffer")
+              call exit_profile(profile_mpi_copies)
+            ENDIF
+          ENDDO
+
+        ENDDO
+
+      ENDIF
+
+    ENDIF
+
+!$OMP MASTER
+    message%pending=.FALSE.
+!$OMP END MASTER
+
+!    CALL trace_end("wait_message_mpi")
+!$OMP BARRIER
+
+    CALL exit_profile(id_mpi)
+
+  END SUBROUTINE wait_message_mpi
+
+
+  SUBROUTINE transfert_request_seq(field,request)
+  USE field_mod
+  USE domain_mod
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    TYPE(t_request),POINTER :: request(:)
+    REAL(rstd),POINTER :: rval2d(:)
+    REAL(rstd),POINTER :: rval3d(:,:)
+    REAL(rstd),POINTER :: rval4d(:,:,:)
+    INTEGER :: ind
+    TYPE(t_request),POINTER :: req
+    INTEGER :: n
+
+    DO ind=1,ndomain
+      req=>request(ind)
+      rval2d=>field(ind)%rval2d
+      rval3d=>field(ind)%rval3d
+      rval4d=>field(ind)%rval4d
+
+      IF (field(ind)%data_type==type_real) THEN
+        IF (field(ind)%ndim==2) THEN
+          DO n=1,req%size
+            rval2d(req%target_ind(n))=field(req%src_domain(n))%rval2d(req%src_ind(n))*&
+              req%target_sign(n)
+          ENDDO
+        ELSE IF (field(ind)%ndim==3) THEN
+          DO n=1,req%size
+            rval3d(req%target_ind(n),:)=field(req%src_domain(n))%rval3d(req%src_ind(n),:)*&
+              req%target_sign(n)
+          ENDDO
+        ELSE IF (field(ind)%ndim==4) THEN
+          DO n=1,req%size
+            rval4d(req%target_ind(n),:,:)=field(req%src_domain(n))%rval4d(req%src_ind(n),:,:)*&
+              req%target_sign(n)
+          ENDDO
+        ENDIF
+      ENDIF
+
+    ENDDO
+
+  END SUBROUTINE transfert_request_seq
+
+
+END MODULE transfert_mpi_legacy_mod
+
+
+
+
+
Index: codes/icosagcm/trunk/src/parallel/transfert_requests.F90
===================================================================
--- codes/icosagcm/trunk/src/parallel/transfert_requests.F90	(revision 963)
+++ codes/icosagcm/trunk/src/parallel/transfert_requests.F90	(revision 963)
@@ -0,0 +1,342 @@
+! This module contains the requests for transfert_mpi
+module transfert_request_mod
+  use abort_mod
+  use field_mod, only : t_field, field_T, field_U
+  use domain_mod, only : ndomain, ndomain_glo, domain, domain_glo, domloc_glo_ind, domglo_rank, domglo_loc_ind
+  implicit none
+  private
+
+  ! Points for t_request : list of points coordinates in a domain
+  type t_points
+    integer, allocatable :: i(:), j(:), edge(:)
+    integer :: npoints
+  end type
+
+  ! Describes how to exchange data from/to one domain to/from other domains
+  type t_request
+    integer :: field_type
+    type(t_points), allocatable :: points_BtoH(:) ! req(local_ind)%points_BtoH(remote_ind) are the points of
+                                                  ! domain local_ind to unpack from mpi buffer recieved from remote_ind
+    type(t_points), allocatable :: points_HtoB(:) ! req(local_ind)%points_HtoB(remote_ind) are the points of
+                                                  ! domain local_ind to pack to mpi buffer to send to remote_ind
+    logical :: vector = .false. ! Is a vector request (true if sign change needed)
+  end type t_request
+
+  type(t_request),save,pointer :: req_i1(:) ! Halos for T fields
+  type(t_request),save,pointer :: req_e1_scal(:) ! Halos for U fields
+  type(t_request),save,pointer :: req_e1_vect(:) ! Halos for U fields (with sign change)
+  type(t_request),save,pointer :: req_z1_scal(:) => null() ! DO NOT USE : not initialized
+
+  type(t_request),save,pointer :: req_i0(:) ! Duplicated cells for T fields
+  type(t_request),save,pointer :: req_e0_scal(:)
+  type(t_request),save,pointer :: req_e0_vect(:)
+
+  public :: t_points, t_request, &
+            req_i1, req_e1_scal, req_e1_vect, &
+            req_i0, req_e0_scal, req_e0_vect, &
+            req_z1_scal, &
+            init_all_requests
+contains
+
+  ! Initialize requests
+  subroutine init_all_requests
+    use dimensions, only : swap_dimensions, ii_begin, ii_end, jj_begin, jj_end
+    use metric, only : right, rdown, ldown, left, lup, rup
+    integer :: ind, i, j
+
+    ! Create requests req_* see corresponding module variables for description
+    call request_init(req_i0, field_T)
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      DO i=ii_begin,ii_end
+        CALL request_add_point(req_i0,ind,i,jj_begin)
+      ENDDO
+      DO j=jj_begin,jj_end
+        CALL request_add_point(req_i0,ind,ii_begin,j)
+        CALL request_add_point(req_i0,ind,ii_end,j)
+      ENDDO
+      DO i=ii_begin,ii_end
+        CALL request_add_point(req_i0,ind,i,jj_end)
+      ENDDO
+    ENDDO
+    call request_exchange(req_i0)
+
+    call request_init(req_i1, field_T)
+    do ind=1,ndomain
+      call swap_dimensions(ind)
+      do i=ii_begin,ii_end+1
+        call request_add_point(req_i1,ind,i,jj_begin-1)
+      enddo
+      do j=jj_begin,jj_end
+        call request_add_point(req_i1,ind,ii_begin-1,j)
+        call request_add_point(req_i1,ind,ii_end+1,j)
+      enddo
+      call request_add_point(req_i1,ind,ii_begin-1,jj_end+1)
+      do i=ii_begin,ii_end
+        call request_add_point(req_i1,ind,i,jj_end+1)
+      enddo
+    enddo
+    call request_exchange(req_i1)
+
+    call request_init(req_e0_scal, field_U)
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      DO i=ii_begin+1,ii_end-1
+        CALL request_add_point(req_e0_scal,ind,i,jj_begin,right)
+        CALL request_add_point(req_e0_scal,ind,i,jj_end,right)
+      ENDDO
+      DO j=jj_begin+1,jj_end-1
+        CALL request_add_point(req_e0_scal,ind,ii_begin,j,rup)
+        CALL request_add_point(req_e0_scal,ind,ii_end,j,rup)
+      ENDDO
+      CALL request_add_point(req_e0_scal,ind,ii_begin+1,jj_begin,left)
+      CALL request_add_point(req_e0_scal,ind,ii_begin,jj_begin+1,ldown)
+      CALL request_add_point(req_e0_scal,ind,ii_begin+1,jj_end,left)
+      CALL request_add_point(req_e0_scal,ind,ii_end,jj_begin+1,ldown)
+    ENDDO
+    call request_exchange(req_e0_scal)
+
+    ! req_e0_vect is the same request than req_e0_scal but with the vector flag to true
+    allocate( req_e0_vect(ndomain) )
+    req_e0_vect = req_e0_scal
+    req_e0_vect%vector = .true.
+
+    call request_init(req_e1_scal, field_U)
+    DO ind=1,ndomain
+      CALL swap_dimensions(ind)
+      DO i=ii_begin,ii_end
+        CALL request_add_point(req_e1_scal,ind,i,jj_begin-1,rup)
+        CALL request_add_point(req_e1_scal,ind,i+1,jj_begin-1,lup)
+      ENDDO
+      DO j=jj_begin,jj_end
+        CALL request_add_point(req_e1_scal,ind,ii_end+1,j,left)
+      ENDDO
+      DO j=jj_begin,jj_end
+        CALL request_add_point(req_e1_scal,ind,ii_end+1,j-1,lup)
+      ENDDO
+      DO i=ii_begin,ii_end
+        CALL request_add_point(req_e1_scal,ind,i,jj_end+1,ldown)
+        CALL request_add_point(req_e1_scal,ind,i-1,jj_end+1,rdown)
+      ENDDO
+      DO j=jj_begin,jj_end
+        CALL request_add_point(req_e1_scal,ind,ii_begin-1,j,right)
+      ENDDO
+      DO j=jj_begin,jj_end
+        CALL request_add_point(req_e1_scal,ind,ii_begin-1,j+1,rdown)
+      ENDDO
+    ENDDO
+    call request_exchange(req_e1_scal)
+
+    allocate( req_e1_vect(ndomain) )
+    req_e1_vect = req_e1_scal
+    req_e1_vect%vector = .true.
+  contains
+
+    ! ---- Points ----
+    ! Initialize (allocate) points
+    subroutine points_init(points, has_edges)
+      type(t_points):: points
+      logical :: has_edges
+      integer, parameter :: INITIAL_ALLOC_SIZE = 10
+
+      allocate(points%i(INITIAL_ALLOC_SIZE))
+      allocate(points%j(INITIAL_ALLOC_SIZE))
+      if(has_edges) allocate(points%edge(INITIAL_ALLOC_SIZE))
+      points%npoints = 0
+    end subroutine
+
+    ! Append point (i, j [,edge]) to point list
+    subroutine points_append(points, i, j, edge)
+      type(t_points), intent(inout):: points
+      integer, intent(in) :: i, j
+      integer, intent(in), optional :: edge
+      integer :: begin_size
+
+      begin_size=points%npoints
+      call array_append( points%i, begin_size, i )
+      begin_size=points%npoints
+      call array_append( points%j, begin_size, j )
+      if(present(edge)) then
+        begin_size=points%npoints
+        call array_append( points%edge, begin_size, edge )
+      end if
+
+      points%npoints = points%npoints + 1
+    end subroutine
+    
+    ! Add element to array, and reallocate if necessary
+    subroutine array_append( a, a_size, elt )
+      integer, allocatable, intent(inout) :: a(:)
+      integer, intent(inout) :: a_size
+      integer, intent(in) :: elt
+      integer, allocatable :: a_tmp(:)
+      integer, parameter :: GROW_FACTOR = 2
+      
+      if( size( a ) <= a_size ) then
+        allocate( a_tmp ( a_size * GROW_FACTOR ) )
+        a_tmp(1:a_size) = a(1:a_size)
+        call move_alloc(a_tmp, a)
+      end if
+      a_size = a_size + 1
+      a(a_size) = elt;
+    end subroutine
+
+    ! Sort and remove duplicates in points
+    ! dimensions%iim must be set to the right value with swap_dimensions before
+    ! After this call, size(points%i) == points%npoints
+    subroutine points_sort( points )
+      use dimensions, only : iim, jjm
+      type(t_points):: points
+      integer :: displs(points%npoints)
+      integer :: k, i, last, i_min, tmp
+
+      displs = (points%i-1) + (points%j-1)*iim
+      if(allocated(points%edge)) displs = displs + (points%edge-1)*iim*jjm
+
+      last=0
+      do i=1, points%npoints
+        i_min = minloc(displs(i:),1)+i-1
+        tmp = displs(i_min)
+        displs(i_min) = displs(i)
+        if(last==0 .or. displs(i_min) /= displs(last)) last=last+1
+        displs(last) = tmp
+      end do
+
+      points%npoints = last
+      deallocate(points%i); allocate(points%i(last))
+      deallocate(points%j); allocate(points%j(last))
+      do k=1, last
+        points%i(k) = mod(displs(k), iim)+1
+        points%j(k) = mod((displs(k)-(points%i(k)-1))/iim, jjm)+1
+      end do
+      if(allocated(points%edge)) then
+        deallocate(points%edge); allocate(points%edge(last))
+        points%edge(:) = displs(1:last)/(iim*jjm) + 1
+      end if
+
+      if( size(points%i) /= points%npoints ) call dynamico_abort( "Storage too big for points" )
+    end subroutine
+
+    ! ---- Requests ----
+    ! Initialize request
+    subroutine request_init( request, field_type )
+      type(t_request), pointer, intent(out) :: request(:)
+      integer, intent(in) :: field_type
+      integer :: ind, remote_ind_glo
+
+      allocate( request(ndomain) )
+      do ind=1, ndomain
+        request(ind)%field_type = field_type
+        allocate(request(ind)%points_BtoH(ndomain_glo))
+        allocate(request(ind)%points_HtoB(ndomain_glo))
+        do remote_ind_glo = 1, ndomain_glo
+          call points_init(request(ind)%points_BtoH(remote_ind_glo), field_type == field_U)
+          !call points_init(request(ind)%points_HtoB(remote_ind_glo)) ! Initialized before MPI communication in request_exchange
+        end do
+      end do
+    end subroutine
+
+    ! Append local point (ind_glo,i,j) to the point list of domain ind, where ind_glo is the domain owning the point
+    subroutine request_add_point(req, ind, i, j, edge)
+      type(t_request), intent(inout) :: req(:)
+      integer :: ind, i, j
+      integer, optional :: edge
+
+      if( present(edge) ) then ! U field
+        if(domain(ind)%edge_assign_domain(edge-1,i,j) /= domloc_glo_ind(ind) ) & ! Add only if remote domain != local domain
+        call points_append(req(ind)%points_BtoH(domain(ind)%edge_assign_domain(edge-1,i,j)), i, j, edge )
+      else ! T field
+        if(domain(ind)%assign_domain(i,j) /= domloc_glo_ind(ind) ) &
+          call points_append(req(ind)%points_BtoH(domain(ind)%assign_domain(i,j)), i, j )
+      endif
+    end subroutine
+
+    ! Each domain send the cell index it needs from other domains
+    subroutine request_exchange(req)
+      use mpi_mod
+      use dimensions, only : swap_dimensions
+      use mpipara, only : comm_icosa
+      type(t_request), target, intent(in) :: req(:)
+      type(t_points) :: points_send(ndomain,ndomain_glo)
+      type(t_points), pointer :: points
+
+      integer :: ind_loc, remote_ind_glo, k
+      integer :: i, j, edge
+      integer :: reqs(ndomain, ndomain_glo, 2), reqs2(ndomain, ndomain_glo, 2), reqs3(ndomain, ndomain_glo, 3), ierr
+
+      ! Transform position in local domain to position in remote domain pos : (i,j) -> pos_send : (assign_i(i,j), assign_j(i,j))
+      do ind_loc = 1, ndomain
+        call swap_dimensions(ind_loc)
+        do remote_ind_glo = 1, ndomain_glo
+          points => req(ind_loc)%points_BtoH(remote_ind_glo)
+          call points_sort(points)
+          call points_init( points_send(ind_loc,remote_ind_glo), req(ind_loc)%field_type == field_U )
+          do k = 1, points%npoints
+            i = points%i(k)
+            j = points%j(k)
+            if(req(ind_loc)%field_type == field_T) then
+              call points_append(points_send(ind_loc,remote_ind_glo), domain(ind_loc)%assign_i(i,j), &
+                domain(ind_loc)%assign_j(i,j))
+            else
+              edge = points%edge(k) - 1 ! WARNING : domain%edge_assign_* use index in 0:5 instead of 1:6 everywhere else
+              call points_append(points_send(ind_loc,remote_ind_glo), domain(ind_loc)%edge_assign_i(edge,i,j), &
+                domain(ind_loc)%edge_assign_j(edge,i,j), &
+                domain(ind_loc)%edge_assign_pos(edge,i,j)+1)
+            end if
+          end do
+        end do
+      end do
+
+      ! Exchange sizes
+      do ind_loc = 1, ndomain
+        do remote_ind_glo = 1, ndomain_glo
+          call MPI_Isend( points_send(ind_loc,remote_ind_glo)%npoints, 1, MPI_INT, domglo_rank(remote_ind_glo), &
+            remote_ind_glo+ndomain_glo*domloc_glo_ind(ind_loc), comm_icosa, reqs(ind_loc,remote_ind_glo,1), ierr )
+          call MPI_Irecv( req(ind_loc)%points_HtoB(remote_ind_glo)%npoints, 1, MPI_INT, domglo_rank(remote_ind_glo), &
+            domloc_glo_ind(ind_loc)+ndomain_glo*remote_ind_glo, comm_icosa, reqs(ind_loc,remote_ind_glo,2), ierr )
+        end do
+      end do
+      call waitall(reqs,ndomain*ndomain_glo*2)
+
+      ! Exchange points_send -> points_recv
+      do ind_loc = 1, ndomain
+        do remote_ind_glo = 1, ndomain_glo
+          call MPI_Isend( points_send(ind_loc,remote_ind_glo)%i, points_send(ind_loc,remote_ind_glo)%npoints, MPI_INT, &
+            domglo_rank(remote_ind_glo), remote_ind_glo+ndomain_glo*domloc_glo_ind(ind_loc), &
+            comm_icosa, reqs(ind_loc,remote_ind_glo,1), ierr  )
+          call MPI_Isend( points_send(ind_loc,remote_ind_glo)%j, points_send(ind_loc,remote_ind_glo)%npoints, MPI_INT, &
+            domglo_rank(remote_ind_glo), remote_ind_glo+ndomain_glo*domloc_glo_ind(ind_loc), &
+            comm_icosa, reqs2(ind_loc,remote_ind_glo,1), ierr  )
+
+          points => req(ind_loc)%points_HtoB(remote_ind_glo) ! Points to recieve (HtoB)
+          allocate( points%i( points%npoints ) )
+          allocate( points%j( points%npoints ) )
+          call MPI_Irecv( points%i, points%npoints, MPI_INT, domglo_rank(remote_ind_glo), &
+            domloc_glo_ind(ind_loc)+ndomain_glo*remote_ind_glo, comm_icosa, reqs(ind_loc,remote_ind_glo,2), ierr)
+          call MPI_Irecv( points%j, points%npoints, MPI_INT, domglo_rank(remote_ind_glo), &
+            domloc_glo_ind(ind_loc)+ndomain_glo*remote_ind_glo, comm_icosa, reqs2(ind_loc,remote_ind_glo,2), ierr)
+
+          if(req(1)%field_type == field_U) then
+            call MPI_Isend( points_send(ind_loc,remote_ind_glo)%edge, points_send(ind_loc,remote_ind_glo)%npoints, MPI_INT, &
+              domglo_rank(remote_ind_glo), remote_ind_glo+ndomain_glo*domloc_glo_ind(ind_loc), &
+              comm_icosa, reqs3(ind_loc,remote_ind_glo,1), ierr  )
+            allocate( points%edge( points%npoints ) )
+            call MPI_Irecv( points%edge, points%npoints, MPI_INT, &
+              domglo_rank(remote_ind_glo), domloc_glo_ind(ind_loc)+ndomain_glo*remote_ind_glo, &
+              comm_icosa, reqs3(ind_loc,remote_ind_glo,2), ierr )
+          endif
+        end do
+      end do
+      call waitall(reqs,ndomain*ndomain_glo*2)
+      call waitall(reqs2,ndomain*ndomain_glo*2)
+      if(req(1)%field_type == field_U) call waitall(reqs3,ndomain*ndomain_glo*2)
+    end subroutine
+
+    ! MPI_Waitall, but with a N-Dim array of requests
+    subroutine waitall(reqs, size)
+      use mpi_mod
+      integer :: size, reqs(size), ierr
+      call MPI_Waitall( size, reqs, MPI_STATUSES_IGNORE, ierr)
+    end subroutine
+  end subroutine
+end module
Index: codes/icosagcm/trunk/src/sphere/geometry.f90
===================================================================
--- codes/icosagcm/trunk/src/sphere/geometry.f90	(revision 962)
+++ codes/icosagcm/trunk/src/sphere/geometry.f90	(revision 963)
@@ -360,5 +360,5 @@
     USE dimensions
     USE domain_mod 
-    USE transfert_mpi_mod
+    USE transfert_mod
 
     INTEGER :: ind,i,j,k,n
@@ -384,4 +384,5 @@
     CALL allocate_field_glo(xyz_glo, field_t, type_real, 3)
     CALL allocate_field_glo(vertex_glo, field_z, type_real, 3)
+
 
     CALL gather_field(xyz_loc, xyz_glo)
Index: codes/icosagcm/trunk/src/transport/advect_tracer.F90
===================================================================
--- codes/icosagcm/trunk/src/transport/advect_tracer.F90	(revision 962)
+++ codes/icosagcm/trunk/src/transport/advect_tracer.F90	(revision 963)
@@ -148,4 +148,5 @@
 
     CALL send_message(f_cc,req_cc)
+    CALL wait_message(req_cc)
 
     ! horizontal transport - split in two to place transfer of gradq3d
@@ -164,5 +165,4 @@
 
         CALL send_message(f_gradq3d,req_gradq3d)
-        CALL wait_message(req_cc)
         CALL wait_message(req_gradq3d)
 
