Index: /codes/icosagcm/trunk/src/transfert_mpi.f90
===================================================================
--- /codes/icosagcm/trunk/src/transfert_mpi.f90	(revision 175)
+++ /codes/icosagcm/trunk/src/transfert_mpi.f90	(revision 176)
@@ -13,4 +13,5 @@
     REAL,POINTER    :: buffer_r3(:,:)
     REAL,POINTER    :: buffer_r4(:,:,:)
+    INTEGER,POINTER :: src_value(:)
   END TYPE array
   
@@ -37,4 +38,5 @@
     TYPE(ARRAY),POINTER :: recv(:)
     INTEGER :: nsend
+    INTEGER :: nreq_mpi
     TYPE(ARRAY),POINTER :: send(:)
   END TYPE t_request
@@ -57,5 +59,8 @@
     LOGICAL :: completed
     LOGICAL :: pending
+    INTEGER :: number
   END TYPE t_message
+  
+  INTEGER,SAVE :: message_number=0 ;
   
 CONTAINS
@@ -402,5 +407,5 @@
   IMPLICIT NONE
     TYPE(t_request),POINTER :: request(:)
-    TYPE(t_request),POINTER :: req
+    TYPE(t_request),POINTER :: req, req_src
     INTEGER :: nb_domain_recv(0:mpi_size-1)
     INTEGER :: nb_domain_send(0:mpi_size-1)
@@ -411,5 +416,5 @@
 
     INTEGER :: rank,i,j
-    INTEGER :: size,ind_glo,ind_loc
+    INTEGER :: size_,ind_glo,ind_loc, ind_src
     INTEGER :: isend, irecv, ireq, nreq
     INTEGER, ALLOCATABLE :: mpi_req(:)
@@ -455,8 +460,8 @@
         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)
+        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
@@ -537,4 +542,22 @@
      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)
+     ENDDO
+     
+     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)
+     ENDDO
+   ENDDO
+   
+   CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
+   CALL MPI_BARRIER(comm_icosa,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)%size,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr)
      ENDDO
@@ -577,6 +600,42 @@
      ENDDO
    ENDDO  
+
+! domain is on the same mpi process
    
-    
+   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)%domain==ind_loc) THEN
+               req%recv(irecv)%src_value => req_src%send(isend)%value
+               IF ( size(req%recv(irecv)%value) /= size(req_src%send(isend)%value)) THEN
+                 STOP "size(req%recv(irecv)%value) /= size(req_src%send(isend)%value"
+               ENDIF
+             ENDIF
+           ENDDO
+       ENDIF
+     
+     ENDDO
+   ENDDO
+   
+! true number of mpi request
+   DO ind_loc=1,ndomain
+     req=>request(ind_loc)
+     req%nreq_mpi=0
+
+     DO isend=1,req%nsend
+      IF (req%send(isend)%rank/=mpi_rank .OR. .TRUE.) req%nreq_mpi=req%nreq_mpi+1  
+     ENDDO
+     
+     DO irecv=1,req%nrecv
+      IF (req%recv(irecv)%rank/=mpi_rank .OR. .TRUE.) req%nreq_mpi=req%nreq_mpi+1  
+     ENDDO
+  
+   ENDDO 
+       
   END SUBROUTINE Finalize_request 
 
@@ -663,7 +722,12 @@
 
 !$OMP MASTER
+    message%number=message_number
+    message_number=message_number+1
+    IF (message_number==100) message_number=0
+    
     message%request=>request
     nreq=sum(request(:)%nsend)+sum(request(:)%nrecv)
-    message%nreq=nreq
+!    message%nreq=nreq
+    message%nreq=sum(message%request(:)%nreq_mpi)
     ALLOCATE(message%mpi_req(nreq))
     ALLOCATE(message%buffers(nreq))
@@ -778,7 +842,7 @@
     TYPE(t_field),POINTER :: field(:)
     TYPE(t_message) :: message
-    REAL(rstd),POINTER :: rval2d(:) 
-    REAL(rstd),POINTER :: rval3d(:,:) 
-    REAL(rstd),POINTER :: rval4d(:,:,:) 
+    REAL(rstd),POINTER :: rval2d(:), src_rval2d(:) 
+    REAL(rstd),POINTER :: rval3d(:,:), src_rval3d(:,:) 
+    REAL(rstd),POINTER :: rval4d(:,:,:), src_rval4d(:,:,:) 
     REAL(rstd),POINTER :: buffer_r2(:) 
     REAL(rstd),POINTER :: buffer_r3(:,:) 
@@ -791,7 +855,9 @@
     INTEGER, ALLOCATABLE :: status(:,:)
     INTEGER :: irecv,isend
-    INTEGER :: ireq,nreq
+    INTEGER :: ireq,ireq_mpi,nreq
     INTEGER :: ind,n,l,m
     INTEGER :: dim3,dim4
+    INTEGER,POINTER :: src_value(:)
+    INTEGER,POINTER :: sign(:)
 
 !$OMP BARRIER
@@ -799,10 +865,16 @@
     CALL trace_start("transfert_mpi")
 
-    nreq=message%nreq
+!    nreq=message%nreq
     message%field=>field
 
 !$OMP MASTER
-    message%completed=.FALSE.
-    message%pending=.TRUE.
+    IF (message%nreq>0) THEN
+      message%completed=.FALSE.
+      message%pending=.TRUE.
+    ELSE
+      message%completed=.TRUE.
+      message%pending=.FALSE.
+    ENDIF
+    
 !$OMP END MASTER
     
@@ -811,4 +883,5 @@
 
         ireq=0
+        ireq_mpi=0
         DO ind=1,ndomain
           rval2d=>field(ind)%rval2d
@@ -818,19 +891,24 @@
             ireq=ireq+1
             send=>req%send(isend)
-            buffer_r2=>message%buffers(ireq)%r2
             value=>send%value
 
-            CALL trace_in
-
-!$OMP DO SCHEDULE(STATIC)
-            DO n=1,send%size
-              buffer_r2(n)=rval2d(value(n))
-            ENDDO
             
-            CALL trace_out
-
-!$OMP MASTER
-            CALL MPI_ISSEND(buffer_r2,send%size,MPI_REAL8,send%rank,ind,comm_icosa, message%mpi_req(ireq),ierr)
-!$OMP END MASTER
+            IF (send%rank/=mpi_rank .OR. .TRUE.) THEN
+              ireq_mpi=ireq_mpi+1
+              buffer_r2=>message%buffers(ireq)%r2
+              CALL trace_in
+
+              !$OMP DO SCHEDULE(STATIC)
+              DO n=1,send%size
+                buffer_r2(n)=rval2d(value(n))
+              ENDDO
+            
+              CALL trace_out
+
+              !$OMP MASTER
+              CALL MPI_ISSEND(buffer_r2,send%size,MPI_REAL8,send%rank,ind+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr)
+              !$OMP END MASTER
+             
+             ENDIF
           ENDDO
         
@@ -838,8 +916,22 @@
             ireq=ireq+1
             recv=>req%recv(irecv)
-            buffer_r2=>message%buffers(ireq)%r2
-!$OMP MASTER
-            CALL MPI_IRECV(buffer_r2,recv%size,MPI_REAL8,recv%rank,recv%domain,comm_icosa, message%mpi_req(ireq),ierr)
-!$OMP END MASTER
+
+            IF (recv%rank==mpi_rank .AND. .FALSE.) THEN
+              value=>recv%value
+              src_value => recv%src_value
+              src_rval2d=>field(recv%domain)%rval2d
+              sgn=>recv%sign
+              !$OMP DO SCHEDULE(STATIC)
+              DO n=1,recv%size
+                rval2d(value(n))=src_rval2d(src_value(n))*sgn(n)
+              ENDDO
+            
+            ELSE
+               ireq_mpi=ireq_mpi+1
+               buffer_r2=>message%buffers(ireq)%r2
+              !$OMP MASTER
+              CALL MPI_IRECV(buffer_r2,recv%size,MPI_REAL8,recv%rank,recv%domain+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr)
+              !$OMP END MASTER
+            ENDIF
           ENDDO
         
@@ -849,4 +941,5 @@
       
         ireq=0
+        ireq_mpi=0
         DO ind=1,ndomain
           dim3=size(field(ind)%rval3d,2)
@@ -857,29 +950,46 @@
             ireq=ireq+1
             send=>req%send(isend)
-            buffer_r3=>message%buffers(ireq)%r3
             value=>send%value
 
-            CALL trace_in
+            IF (send%rank/=mpi_rank .OR. .TRUE.) THEN
+              ireq_mpi=ireq_mpi+1
+              buffer_r3=>message%buffers(ireq)%r3
+ 
+              CALL trace_in
             
 !$OMP DO SCHEDULE(STATIC)
-              DO n=1,send%size
-                buffer_r3(n,:)=rval3d(value(n),:)
+                DO n=1,send%size
+                  buffer_r3(n,:)=rval3d(value(n),:)
+                ENDDO
+
+               CALL trace_out
+
+  !$OMP MASTER
+              CALL MPI_ISSEND(buffer_r3,send%size*dim3,MPI_REAL8,send%rank,ind+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr)
+  !$OMP END MASTER
+            ENDIF
+         ENDDO
+        
+          DO irecv=1,req%nrecv
+            ireq=ireq+1
+            recv=>req%recv(irecv)
+
+            IF (recv%rank==mpi_rank .AND. .FALSE.) THEN
+              value=>recv%value
+              src_value => recv%src_value
+              src_rval3d=>field(recv%domain)%rval3d
+              sgn=>recv%sign
+              !$OMP DO SCHEDULE(STATIC)
+              DO n=1,recv%size
+                rval3d(value(n),:)=src_rval3d(src_value(n),:)*sgn(n)
               ENDDO
-
-             CALL trace_out
-
-!$OMP MASTER
-            CALL MPI_ISSEND(buffer_r3,send%size*dim3,MPI_REAL8,send%rank,ind,comm_icosa, message%mpi_req(ireq),ierr)
+            
+            ELSE
+              ireq_mpi=ireq_mpi+1
+              buffer_r3=>message%buffers(ireq)%r3
+!$OMP MASTER           
+              CALL MPI_IRECV(buffer_r3,recv%size*dim3,MPI_REAL8,recv%rank,recv%domain+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr)
 !$OMP END MASTER
-          ENDDO
-        
-          DO irecv=1,req%nrecv
-            ireq=ireq+1
-            recv=>req%recv(irecv)
-            buffer_r3=>message%buffers(ireq)%r3
-!$OMP MASTER           
-            CALL MPI_IRECV(buffer_r3,recv%size*dim3,MPI_REAL8,recv%rank,recv%domain,comm_icosa, message%mpi_req(ireq),ierr)
-!$OMP END MASTER
-
+            ENDIF
           ENDDO
         
@@ -889,4 +999,5 @@
     
         ireq=0
+        ireq_mpi=0
         DO ind=1,ndomain
           dim3=size(field(ind)%rval4d,2)
@@ -898,19 +1009,22 @@
             ireq=ireq+1
             send=>req%send(isend)
-            buffer_r4=>message%buffers(ireq)%r4
             value=>send%value
 
-            CALL trace_in
+            IF (send%rank/=mpi_rank .OR. .TRUE.) THEN
+              ireq_mpi=ireq_mpi+1
+              buffer_r4=>message%buffers(ireq)%r4
+              CALL trace_in
 
 !$OMP DO SCHEDULE(STATIC)
-            DO n=1,send%size
-               buffer_r4(n,:,:)=rval4d(value(n),:,:)
-            ENDDO
-
-           CALL trace_out
+              DO n=1,send%size
+                 buffer_r4(n,:,:)=rval4d(value(n),:,:)
+              ENDDO
+
+             CALL trace_out
 
 !$OMP MASTER
-            CALL MPI_ISSEND(buffer_r4,send%size*dim3*dim4,MPI_REAL8,send%rank,ind,comm_icosa, message%mpi_req(ireq),ierr)
+              CALL MPI_ISSEND(buffer_r4,send%size*dim3*dim4,MPI_REAL8,send%rank,ind+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr)
 !$OMP END MASTER
+            ENDIF
           ENDDO
         
@@ -918,8 +1032,22 @@
             ireq=ireq+1
             recv=>req%recv(irecv)
-            buffer_r4=>message%buffers(ireq)%r4
+            IF (recv%rank==mpi_rank .AND. .FALSE.) THEN
+              value=>recv%value
+              src_value => recv%src_value
+              src_rval4d=>field(recv%domain)%rval4d
+              sgn=>recv%sign
+
+              !$OMP DO SCHEDULE(STATIC)
+              DO n=1,recv%size
+                rval4d(value(n),:,:)=src_rval4d(src_value(n),:,:)*sgn(n)
+              ENDDO
+            
+            ELSE
+              ireq_mpi=ireq_mpi+1
+              buffer_r4=>message%buffers(ireq)%r4
 !$OMP MASTER           
-            CALL MPI_IRECV(buffer_r4,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%domain,comm_icosa, message%mpi_req(ireq),ierr)
+              CALL MPI_IRECV(buffer_r4,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%domain+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr)
 !$OMP END MASTER
+            ENDIF
           ENDDO
         
@@ -929,5 +1057,8 @@
       
     ENDIF
-
+    IF (ireq_mpi /= message%nreq ) THEN
+      STOP "ireq_mpi /= message%nreq"
+    ENDIF
+    
     CALL trace_end("transfert_mpi")
 !$OMP BARRIER
@@ -1007,17 +1138,18 @@
             ireq=ireq+1
             recv=>req%recv(irecv)
-            buffer_r2=>message%buffers(ireq)%r2
-            value=>recv%value
-            sgn=>recv%sign
-
-            CALL trace_in
+            IF (recv%rank/=mpi_rank .OR. .TRUE.) THEN
+              buffer_r2=>message%buffers(ireq)%r2
+              value=>recv%value
+              sgn=>recv%sign
+
+              CALL trace_in
             
 !$OMP DO SCHEDULE(STATIC)
-            DO n=1,recv%size
-              rval2d(value(n))=buffer_r2(n)*sgn(n)  
-            ENDDO        
-
-            CALL trace_out
-
+              DO n=1,recv%size
+                rval2d(value(n))=buffer_r2(n)*sgn(n)  
+              ENDDO        
+
+              CALL trace_out
+            ENDIF
           ENDDO
         
@@ -1044,17 +1176,18 @@
             ireq=ireq+1
             recv=>req%recv(irecv)
-            buffer_r3=>message%buffers(ireq)%r3
-            value=>recv%value
-            sgn=>recv%sign
-
-            CALL trace_in
+            IF (recv%rank/=mpi_rank .OR. .TRUE.) THEN
+              buffer_r3=>message%buffers(ireq)%r3
+              value=>recv%value
+              sgn=>recv%sign
+
+              CALL trace_in
             
 !$OMP DO SCHEDULE(STATIC)
-            DO n=1,recv%size
-              rval3d(value(n),:)=buffer_r3(n,:)*sgn(n)  
-            ENDDO  
-
-            CALL trace_out
-
+              DO n=1,recv%size
+                rval3d(value(n),:)=buffer_r3(n,:)*sgn(n)  
+              ENDDO  
+
+              CALL trace_out
+            ENDIF
           ENDDO
         
@@ -1079,17 +1212,18 @@
             ireq=ireq+1
             recv=>req%recv(irecv)
-            buffer_r4=>message%buffers(ireq)%r4
-            value=>recv%value
-            sgn=>recv%sign
-
-            CALL trace_in
+            IF (recv%rank/=mpi_rank .OR. .TRUE.) THEN
+              buffer_r4=>message%buffers(ireq)%r4
+              value=>recv%value
+              sgn=>recv%sign
+
+              CALL trace_in
 
 !$OMP DO SCHEDULE(STATIC)
-            DO n=1,recv%size
-              rval4d(value(n),:,:)=buffer_r4(n,:,:)*sgn(n) 
-            ENDDO
-
-            CALL trace_out
-
+              DO n=1,recv%size
+                rval4d(value(n),:,:)=buffer_r4(n,:,:)*sgn(n) 
+              ENDDO
+
+              CALL trace_out
+            ENDIF
           ENDDO
         
