Index: codes/icosagcm/trunk/src/parallel/transfert_mpi.f90
===================================================================
--- codes/icosagcm/trunk/src/parallel/transfert_mpi.f90	(revision 998)
+++ codes/icosagcm/trunk/src/parallel/transfert_mpi.f90	(revision 999)
@@ -21,9 +21,14 @@
   ! 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 :: ind_loc, remote_ind_glo, remote_rank ! index of local and remote domain
     integer :: npoints ! Number of cells to transfer (dim12)
     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)
+    integer :: mpi_buffer_displ = -1
+  end type
+  
+  type mpi_buffer_t
+    integer :: n
+    real, allocatable :: buff(:)
   end type
 
@@ -35,4 +40,6 @@
     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
+    type (mpi_buffer_t), pointer :: mpi_buffer_in(:)
+    type (mpi_buffer_t), pointer :: mpi_buffer_out(:)
     integer, pointer :: mpi_requests_in(:) ! MPI requests used for message_in.
     integer, pointer :: mpi_requests_out(:) ! MPI requests used for message_out.
@@ -100,9 +107,8 @@
     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
+    integer :: ind, ind_loc, remote_ind_glo, loc_ind_glo, i, remote_rank
+    integer :: message_in_size, message_out_size, message_local_size, buffer_in_size, buffer_out_size
     type(t_local_submessage), allocatable :: message_local_tmp(:)
     type(t_submessage), allocatable :: message_in_tmp(:), message_out_tmp(:)
-    type(t_submessage), pointer :: submessage
     integer :: field_type
 
@@ -136,29 +142,41 @@
     allocate(message_local_tmp(INITIAL_ALLOC_SIZE))
     message_local_size=0
-    do ind_loc = 1, ndomain
+    do loc_ind_glo = 1, ndomain_glo
       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( field_type, request(ind_loc)%points_HtoB(remote_ind_glo), &
-                                              ind_loc, remote_ind_glo, dim3, dim4, request(1)%vector )
-            submessage_in = make_submessage( field_type, 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%npoints = submessage_out%npoints
-            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( field_type, 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 )
+        if(domglo_rank(loc_ind_glo) == mpi_rank) then 
+          ind_loc = domglo_loc_ind(loc_ind_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( field_type, request(ind_loc)%points_HtoB(remote_ind_glo), &
+                                                ind_loc, remote_ind_glo, dim3, dim4, request(1)%vector )
+              submessage_in = make_submessage( field_type, 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%npoints = submessage_out%npoints
+              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( field_type, 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          
           end if
+        end if
+      end do
+    end do
+    ! Recv and Send submessages are transposed to recieve and send in same order
+    ! We iterate over global domain index to match sends with recieves (local domains are not ordered like global domains)
+    do remote_ind_glo = 1, ndomain_glo
+      do loc_ind_glo = 1, ndomain_glo
+        if( (domglo_rank(loc_ind_glo) == mpi_rank) .and. (domglo_rank(remote_ind_glo) /= mpi_rank) ) then
+          ind_loc = domglo_loc_ind(loc_ind_glo)
           if( request(ind_loc)%points_BtoH(remote_ind_glo)%npoints > 0 ) then
             submessage_in = make_submessage( field_type, request(ind_loc)%points_BtoH(remote_ind_glo), &
@@ -169,4 +187,6 @@
       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)
@@ -174,18 +194,38 @@
     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)) )
+    ! Allocate MPI buffers
+    allocate( message%mpi_buffer_in(0:mpi_size-1) )
+    allocate( message%mpi_buffer_out(0:mpi_size-1) )
+    do i = 0, mpi_size-1
+      buffer_in_size = dim3*dim4*sum( message%message_in(:)%npoints, message%message_in(:)%remote_rank == i )
+      buffer_out_size = dim3*dim4*sum( message%message_out(:)%npoints, message%message_out(:)%remote_rank == i )
+      !TODO : what if size == 0 ?
+      allocate( message%mpi_buffer_in(i)%buff( buffer_in_size ) )
+      allocate( message%mpi_buffer_out(i)%buff( buffer_out_size ) )
+      message%mpi_buffer_in(i)%n=0
+      message%mpi_buffer_out(i)%n=0
+    end do
+    ! Set offsets in submessages
     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 )
+      remote_rank = message%message_out(i)%remote_rank
+      message%message_out(i)%mpi_buffer_displ = message%mpi_buffer_out(remote_rank)%n
+      message%mpi_buffer_out(remote_rank)%n = message%mpi_buffer_out(remote_rank)%n + message%message_out(i)%npoints*dim3*dim4
     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 )
+      remote_rank = message%message_in(i)%remote_rank
+      message%message_in(i)%mpi_buffer_displ = message%mpi_buffer_in(remote_rank)%n
+      message%mpi_buffer_in(remote_rank)%n = message%mpi_buffer_in(remote_rank)%n + message%message_in(i)%npoints*dim3*dim4
+    end do
+    ! Create persistant MPI requests
+    allocate( message%mpi_requests_in(0:mpi_size-1) )
+    allocate( message%mpi_requests_out(0:mpi_size-1) )
+    do i = 0, mpi_size-1
+      if(  size(message%mpi_buffer_in(i)%buff) /= message%mpi_buffer_in(i)%n &
+      .or. size(message%mpi_buffer_out(i)%buff) /= message%mpi_buffer_out(i)%n)&
+        call dynamico_abort("Internal error in transfert_mpi : mpi buffer size different than expected")
+      call MPI_Send_Init( message%mpi_buffer_out(i)%buff, message%mpi_buffer_out(i)%n, MPI_REAL8, i,&
+                          100, comm_icosa, message%mpi_requests_out(i), ierr )
+      call MPI_Recv_Init( message%mpi_buffer_in(i)%buff, message%mpi_buffer_in(i)%n, MPI_REAL8, i,&
+                          100, comm_icosa, message%mpi_requests_in(i), ierr )
     end do
     !$omp end master
@@ -205,6 +245,7 @@
       submessage%ind_loc = ind_loc
       submessage%remote_ind_glo = remote_ind_glo
+      submessage%remote_rank = domglo_rank(remote_ind_glo)
       submessage%npoints = points%npoints
-      allocate( submessage%buff( points%npoints, dim3, dim4 ) )
+      submessage%mpi_buffer_displ = -1 ! Buffers not allocated yet
       allocate( submessage%displs( points%npoints ) )
       submessage%displs(:) = points%i + (points%j-1)*iim
@@ -256,7 +297,6 @@
   subroutine message_create_ondevice(message)
     use mpi_mod
-    use mpipara, only : comm_icosa
+    use mpipara, only : mpi_size, comm_icosa
     type(t_message), intent(inout) :: message
-    type(t_submessage), pointer :: submessage
     integer :: i, ierr
 
@@ -264,7 +304,12 @@
 
     !$acc enter data copyin(message) async
+    !$acc enter data copyin(message%mpi_buffer_in(:)) async
+    !$acc enter data copyin(message%mpi_buffer_out(:)) async
+    do i = 0, mpi_size-1
+      !$acc enter data copyin(message%mpi_buffer_in(i)%buff(:)) async
+      !$acc enter data copyin(message%mpi_buffer_out(i)%buff(:)) async
+    end do
     !$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
@@ -272,5 +317,4 @@
     !$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
@@ -287,20 +331,15 @@
     end do
 
-    do i=1, size(message%message_out)
-      submessage => message%message_out(i)
+    !$acc wait
+    do i = 0, mpi_size-1
       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 )
+      call MPI_Request_free(message%mpi_requests_in(i), ierr)
+      !$acc host_data use_device(message%mpi_buffer_out(i)%buff)
+      call MPI_Send_Init( message%mpi_buffer_out(i)%buff, message%mpi_buffer_out(i)%n, MPI_REAL8, i,&
+                          0, 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 host_data use_device(message%mpi_buffer_in(i)%buff)
+      call MPI_Recv_Init( message%mpi_buffer_in(i)%buff, message%mpi_buffer_in(i)%n, MPI_REAL8, i,&
+                          0, comm_icosa, message%mpi_requests_in(i), ierr )
       !$acc end host_data
     end do
@@ -311,4 +350,5 @@
 
   subroutine message_delete_ondevice(message)
+    use mpipara, only : mpi_size
     type(t_message), intent(inout) :: message
     integer :: i
@@ -317,5 +357,4 @@
 
     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
@@ -323,5 +362,4 @@
     !$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
@@ -334,5 +372,10 @@
     end do
     !$acc exit data delete(message%message_local(:)) async
-
+    do i = 0, mpi_size-1
+      !$acc exit data delete(message%mpi_buffer_in(i)%buff(:)) async
+      !$acc exit data delete(message%mpi_buffer_out(i)%buff(:)) async
+    end do
+    !$acc exit data delete(message%mpi_buffer_in(:)) async
+    !$acc exit data delete(message%mpi_buffer_out(:)) async
     do i = 1, ndomain
       !$acc exit data delete(message%field(i)%rval4d(:,:,:)) async
@@ -344,4 +387,5 @@
 
   subroutine finalize_message(message)
+    use mpipara, only : mpi_size
     type(t_message), intent(inout) :: message
     integer :: i, ierr
@@ -355,11 +399,13 @@
     deallocate(message%message_out)
     deallocate(message%message_local)
-    do i=1, size(message%mpi_requests_in)
+    do i=0, mpi_size-1
       call MPI_Request_free(message%mpi_requests_in(i), ierr)
-    end do
+      call MPI_Request_free(message%mpi_requests_out(i), ierr)
+      deallocate(message%mpi_buffer_in(i)%buff)
+      deallocate(message%mpi_buffer_out(i)%buff)
+    end do
+    deallocate(message%mpi_buffer_in)
+    deallocate(message%mpi_buffer_out)
     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
@@ -373,6 +419,6 @@
     type(t_field),pointer :: field(:)
     type(t_message), target :: message
-    integer :: i, k, d3, d4
-    integer :: ierr, d3_begin, d3_end, dim4
+    integer :: i, k, d3, d4, local_displ
+    integer :: ierr, d3_begin, d3_end, dim4, dim3
 
     call enter_profile(profile_mpi)
@@ -397,5 +443,6 @@
 
     dim4 = size(message%field(1)%rval4d, 3)
-    CALL distrib_level( 1, size(message%field(1)%rval4d, 2), d3_begin, d3_end )
+    dim3 = size(message%field(1)%rval4d, 2)
+    CALL distrib_level( 1, dim3, d3_begin, d3_end )
 
     call enter_profile(profile_mpi_copies)
@@ -409,7 +456,9 @@
         do d4 = 1, dim4
           do d3 = d3_begin, d3_end
+            local_displ = message%message_out(i)%mpi_buffer_displ + message%message_out(i)%npoints*( (d3-1) + dim3*(d4-1) )
             !$acc loop
              do k = 1, message%message_out(i)%npoints
-              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)
+              !print *, "buff", message%message_out(i)%remote_rank, k+local_displ, "<- field", message%message_out(i)%ind_loc, message%message_out(i)%displs(k), d3, d4, message%field(message%message_out(i)%ind_loc)%rval4d(message%message_out(i)%displs(k),d3, d4)
+              message%mpi_buffer_out(message%message_out(i)%remote_rank)%buff(k+local_displ) = message%field(message%message_out(i)%ind_loc)%rval4d(message%message_out(i)%displs(k),d3, d4)
             end do
           end do
@@ -470,6 +519,6 @@
     use omp_para, only : distrib_level
     type(t_message), target :: message
-    integer :: d3_begin, d3_end, dim4
-    integer :: i, ierr, k, d3, d4
+    integer :: d3_begin, d3_end, dim4, dim3, dim12
+    integer :: i, ierr, k, d3, d4, local_displ
 
     ! Check if message has been sent and not recieved yet
@@ -483,5 +532,8 @@
     call enter_profile(profile_mpi)
 
-    CALL distrib_level( 1, size(message%field(1)%rval4d, 2), d3_begin, d3_end )
+    dim4 = size(message%field(1)%rval4d, 3)
+    dim3 = size(message%field(1)%rval4d, 2)
+    dim12 = size(message%field(1)%rval4d, 1)
+    CALL distrib_level( 1, dim3, d3_begin, d3_end )
 
     call enter_profile(profile_mpi_waitall)
@@ -507,7 +559,10 @@
         do d4 = 1, dim4
           do d3 = d3_begin, d3_end
+            local_displ = message%message_in(i)%mpi_buffer_displ + message%message_in(i)%npoints*( (d3-1) + dim3*(d4-1) )
             !$acc loop
-            do k = 1, message%message_in(i)%npoints
-              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)
+            do k = 1, message%message_in(i)%npoints 
+              !print *, "field", message%message_in(i)%ind_loc, message%message_in(i)%displs(k), d3, d4, "-> buff", message%message_in(i)%remote_rank, k+local_displ, message%mpi_buffer_in(message%message_in(i)%remote_rank)%buff(k+local_displ)
+              message%field(message%message_in(i)%ind_loc)%rval4d(message%message_in(i)%displs(k),d3,d4) &
+                  = message%mpi_buffer_in(message%message_in(i)%remote_rank)%buff(k+local_displ)
             end do
           end do
Index: codes/icosagcm/trunk/src/parallel/transfert_requests.F90
===================================================================
--- codes/icosagcm/trunk/src/parallel/transfert_requests.F90	(revision 998)
+++ codes/icosagcm/trunk/src/parallel/transfert_requests.F90	(revision 999)
@@ -218,6 +218,6 @@
       integer :: k, i, last, i_min, tmp
 
-      displs = (points%i-1) + (points%j-1)*iim
-      if(allocated(points%elt)) displs = displs + (points%elt-1)*iim*jjm
+      displs = (points%i(1:points%npoints)-1) + (points%j(1:points%npoints)-1)*iim
+      if(allocated(points%elt)) displs = displs + (points%elt(1:points%npoints)-1)*iim*jjm
 
       last=0
@@ -226,5 +226,9 @@
         tmp = displs(i_min)
         displs(i_min) = displs(i)
-        if(last==0 .or. displs(i_min) /= displs(last)) last=last+1
+        if( last==0 ) then
+          last=last+1
+        else if( displs(i_min) /= displs(last) ) then 
+          last=last+1
+        endif
         displs(last) = tmp
       end do
