MODULE transfert_mpi_mod
USE genmod
  
  TYPE array
    INTEGER,POINTER :: value(:)
    INTEGER         :: domain
    INTEGER         :: rank
    INTEGER         :: size
    INTEGER,POINTER :: buffer(:)
    REAL,POINTER    :: buffer_r2(:)
    REAL,POINTER    :: buffer_r3(:,:)
    REAL,POINTER    :: buffer_r4(:,:,:)
  END TYPE array
    
  TYPE t_request
    INTEGER :: type_field
    INTEGER :: max_size
    INTEGER :: size
    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 :: nrecv
    TYPE(ARRAY),POINTER :: recv(:)
    INTEGER :: nsend
    TYPE(ARRAY),POINTER :: send(:)
  END TYPE t_request
  
  TYPE(t_request),POINTER :: req_i1(:)
  TYPE(t_request),POINTER :: req_e1(:)
  
  
CONTAINS

  SUBROUTINE init_transfert
  USE domain_mod
  USE dimensions
  USE field_mod
  USE metric
  USE mpipara
  IMPLICIT NONE
  INTEGER :: ind,i,j
 
    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    
    
      DO i=ii_begin,ii_end
        CALL request_add_point(ind,i,jj_begin,req_i1)
      ENDDO

      DO j=jj_begin,jj_end
        CALL request_add_point(ind,ii_end,j,req_i1)
      ENDDO    
    
      DO i=ii_begin,ii_end
        CALL request_add_point(ind,i,jj_end,req_i1)
      ENDDO    

      DO j=jj_begin,jj_end
        CALL request_add_point(ind,ii_begin,j,req_i1)
      ENDDO    
    
    ENDDO
  
    CALL finalize_request(req_i1)
  
    CALL create_request(field_u,req_e1)
    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,rup)
        CALL request_add_point(ind,i+1,jj_begin-1,req_e1,lup)
      ENDDO

      DO j=jj_begin,jj_end
        CALL request_add_point(ind,ii_end+1,j,req_e1,left)
        CALL request_add_point(ind,ii_end+1,j-1,req_e1,lup)
      ENDDO    
    
      DO i=ii_begin,ii_end
        CALL request_add_point(ind,i,jj_end+1,req_e1,ldown)
        CALL request_add_point(ind,i-1,jj_end+1,req_e1,rdown)
      ENDDO    

      DO j=jj_begin,jj_end
        CALL request_add_point(ind,ii_begin-1,j,req_e1,right)
        CALL request_add_point(ind,ii_begin-1,j+1,req_e1,rdown)
      ENDDO   

      DO i=ii_begin+1,ii_end-1
        CALL request_add_point(ind,i,jj_begin,req_e1,right)
        CALL request_add_point(ind,i,jj_end,req_e1,right)
      ENDDO
    
      DO j=jj_begin+1,jj_end-1
        CALL request_add_point(ind,ii_begin,j,req_e1,rup)
        CALL request_add_point(ind,ii_end,j,req_e1,rup)
      ENDDO   

      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e1,left)
      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e1,ldown)
      CALL request_add_point(ind,ii_begin+1,jj_end,req_e1,left)
      CALL request_add_point(ind,ii_end,jj_begin+1,req_e1,ldown)

      CALL finalize_request(req_e1)
     
    ENDDO
  
  END SUBROUTINE init_transfert
  
  SUBROUTINE create_request(type_field,request)
  USE domain_mod
  USE field_mod
  IMPLICIT NONE
    INTEGER :: type_field
    TYPE(t_request),POINTER :: request(:)
    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
      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))
    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(:)

    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
!    req%max_size=req%max_size*2
    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))
    
    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%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)

  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%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=MOD(pos-1+src_delta+6,6)+1
        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%src_domain(req%size)=src_domain
        req%src_ind(req%size)=src_n+domain_glo(src_domain)%u_pos(src_pos)

!        req%target_i(req%size)=i
!        req%target_j(req%size)=j
!        req%src_i(req%size)=domain(ind)%assign_i(i,j)
!        req%src_j(req%size)=domain(ind)%assign_j(i,j)
        
!        PRINT *,"1--->",ind,i,j,pos
!        PRINT *,"2--->",src_domain,src_i,src_j,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)%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)
        src_n=(src_j-1)*src_iim+src_i
        src_delta=domain(ind)%delta(i,j)
        
        src_pos=MOD(pos-1+src_delta+6,6)+1
        
        req%target_ind(req%size)=(j-1)*d%iim+i+d%z_pos(pos)
        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
    INTEGER :: nb_domain_recv(0:mpi_size-1)
    INTEGER :: nb_domain_send(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
    INTEGER :: size,ind_glo,ind_loc
    INTEGER :: isend, irecv, ireq, nreq
    INTEGER, ALLOCATABLE :: mpi_req(:)
    INTEGER, ALLOCATABLE :: status(:,:)
    
    IF (.NOT. using_mpi) RETURN
    
    DO ind_loc=1,ndomain
      req=>request(ind_loc)
      
      nb_data_domain_recv(:) = 0
      nb_domain_recv(:) = 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)%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)
      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)
      ENDDO
    ENDDO
    
    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)
      ENDDO
    ENDDO
    
    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
   
   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)
     ENDDO
     
     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)
     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
     
     DO isend=1,req%nsend
       ireq=ireq+1
       CALL MPI_IRECV(req%send(isend)%size,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)

   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)%domain,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,ind_loc,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(:)
       DEALLOCATE(req%recv(irecv)%buffer)
     ENDDO
   ENDDO  
   
    
!   nb_domain_recv(:)=0
!   nb_data_domain_recv(:)=0
!   
!   DO ind_loc=1,ndomain
!   
!     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
!       
!     CALL MPI_Alltoall(nb_domain_recv,1,MPI_INTEGER,nb_domain_send,1,MPI_INTEGER,comm_icosa,ierr)
!   ENDDO
!   
!   DO 
!   recv=sum(nb_domain_recv(:))
!   send=sum(nb_domain_send(:))

!   ALLOCATE(req%recv(recv))
!   ALLOCATE(req%send(send))

!   ALLOCATE(mpi_req(2*(send+recv)))
!   ALLOCATE(status(MPI_STATUS_SIZE,2*(send+recv)))
!   
!   recv=0
!   ireq=0
!   DO ind_glo=1,ndomain_glo
!     IF (nb_data_domain_recv(ind_glo)>0) THEN
!       recv=recv+1
!       list_domain_recv(ind_glo)=recv
!       req%recv(recv)%rank=domglo_rank(ind_glo)
!       req%recv(recv)%size=nb_data_domain_recv(ind_glo)
!       req%recv(recv)%domain=domglo_loc_ind(ind_glo)
!       ALLOCATE(req%recv(recv)%value(req%recv(recv)%size))
!       ireq=ireq+1
!       CALL MPI_ISEND(req%recv(recv)%domain,1,MPI_INTEGER,req%recv(recv)%rank,0,comm_icosa, mpi_req(ireq),ierr)
!       ireq=ireq+1
!       CALL MPI_ISEND(req%recv(recv)%size,1,MPI_INTEGER,req%recv(recv)%rank,0,comm_icosa, mpi_req(ireq),ierr)
!     ENDIF
!   ENDDO
!   
!    
!   send=0
!   DO rank=0,mpi_size-1
!     DO j=1,nb_domain_send(rank)
!       send=send+1
!       req%send(send)%rank=rank
!       ireq=ireq+1
!       CALL MPI_IRECV(req%send(send)%domain,1,MPI_INTEGER,rank,0,comm_icosa, mpi_req(ireq),ierr)
!       ireq=ireq+1
!       CALL MPI_IRECV(req%send(send)%size,1,MPI_INTEGER,rank,0,comm_icosa, mpi_req(ireq),ierr)
!     ENDDO
!   ENDDO
!   
!   CALL MPI_WAITALL(2*(send+recv),mpi_req,status,ierr) 

!   req%recv(:)%size=0
!   
!   DO i=1,req%size
!     j=list_domain_recv(req%src_domain(i))
!     req%recv(j)%size=req%recv(j)%size+1
!     size=req%recv(j)%size
!     req%recv(j)%value(size)=req%src_ind(i)
!   ENDDO
!       
!   ireq=0
!   DO i=1,recv
!     ireq=ireq+1
!     CALL MPI_ISEND(req%recv(i)%value,req%recv(i)%size,MPI_INTEGER,req%recv(i)%rank,req%recv(i)%domain,comm_icosa, mpi_req(ireq),ierr)   
!   ENDDO

!   DO i=1,send
!     ireq=ireq+1
!     ALLOCATE(req%send(i)%value(req%send(i)%size))
!     CALL MPI_IRECV(req%send(i)%value,req%send(i)%size,MPI_INTEGER,req%send(i)%rank,req%send(i)%domain,comm_icosa, mpi_req(ireq),ierr)   
!   ENDDO
!   
!   CALL MPI_WAITALL(send+recv,mpi_req,status,ierr) 
    

   END SUBROUTINE Finalize_request 


  SUBROUTINE transfert_request_mpi(field,request)
  USE field_mod
  USE domain_mod
  USE mpi_mod
  USE mpipara
  IMPLICIT NONE
    TYPE(t_field),POINTER :: field(:)
    TYPE(t_request),POINTER :: request(:)
    REAL(rstd),POINTER :: rval2d(:) 
    REAL(rstd),POINTER :: rval3d(:,:) 
    REAL(rstd),POINTER :: rval4d(:,:,:) 
    REAL(rstd),POINTER :: buffer_r2(:) 
    REAL(rstd),POINTER :: buffer_r3(:,:) 
    REAL(rstd),POINTER :: buffer_r4(:,:,:) 
    INTEGER,POINTER :: value(:) 
    TYPE(ARRAY),POINTER :: recv,send 
    TYPE(t_request),POINTER :: req
    INTEGER, ALLOCATABLE :: mpi_req(:)
    INTEGER, ALLOCATABLE :: status(:,:)
    INTEGER :: irecv,isend
    INTEGER :: ireq,nreq
    INTEGER :: ind,n
    INTEGER :: dim3,dim4

    IF (field(1)%data_type==type_real) THEN
      IF (field(1)%ndim==2) THEN
      
        nreq=sum(request(:)%nsend)+sum(request(:)%nrecv)
        ALLOCATE(mpi_req(nreq))
        ALLOCATE(status(MPI_STATUS_SIZE,nreq))
    
        ireq=0
        DO ind=1,ndomain
          rval2d=>field(ind)%rval2d
        
          req=>request(ind)
          DO isend=1,req%nsend
            send=>req%send(isend)

            ALLOCATE(send%buffer_r2(send%size))
            buffer_r2=>send%buffer_r2
            value=>send%value
            DO n=1,send%size
              buffer_r2(n)=rval2d(value(n))
            ENDDO

            ireq=ireq+1
            CALL MPI_ISEND(buffer_r2,send%size,MPI_REAL8,send%rank,ind,comm_icosa, mpi_req(ireq),ierr)
          ENDDO
        
          DO irecv=1,req%nrecv
            recv=>req%recv(irecv)
            ALLOCATE(recv%buffer_r2(recv%size))
           
            ireq=ireq+1
            CALL MPI_IRECV(recv%buffer_r2,recv%size,MPI_REAL8,recv%rank,recv%domain,comm_icosa, mpi_req(ireq),ierr)
          ENDDO
        
        ENDDO
        
        CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
!        DO ind=1,ndomain
!          field(ind)%rval2d(:)=0.
!        ENDDO
        
        DO ind=1,ndomain
          rval2d=>field(ind)%rval2d
        
          req=>request(ind)
          DO isend=1,req%nsend
            send=>req%send(isend)
            DEALLOCATE(send%buffer_r2)
          ENDDO
        
          DO irecv=1,req%nrecv
            recv=>req%recv(irecv)
            buffer_r2=>recv%buffer_r2
            value=>recv%value
            DO n=1,recv%size
              rval2d(value(n))=buffer_r2(n)  
            ENDDO        
            DEALLOCATE(recv%buffer_r2)
          ENDDO
        
        ENDDO
      
      
      ELSE  IF (field(1)%ndim==3) THEN
      
        nreq=sum(request(:)%nsend)+sum(request(:)%nrecv)
        ALLOCATE(mpi_req(nreq))
        ALLOCATE(status(MPI_STATUS_SIZE,nreq))
    
        ireq=0
        DO ind=1,ndomain
          dim3=size(field(ind)%rval3d,2)
          rval3d=>field(ind)%rval3d
        
          req=>request(ind)
          DO isend=1,req%nsend
            send=>req%send(isend)

            ALLOCATE(send%buffer_r3(send%size,dim3))
            buffer_r3=>send%buffer_r3
            value=>send%value
            DO n=1,send%size
              buffer_r3(n,:)=rval3d(value(n),:)
            ENDDO

            ireq=ireq+1
            CALL MPI_ISEND(buffer_r3,send%size*dim3,MPI_REAL8,send%rank,ind,comm_icosa, mpi_req(ireq),ierr)
          ENDDO
        
          DO irecv=1,req%nrecv
            recv=>req%recv(irecv)
            ALLOCATE(recv%buffer_r3(recv%size,dim3))
           
            ireq=ireq+1
            CALL MPI_IRECV(recv%buffer_r3,recv%size*dim3,MPI_REAL8,recv%rank,recv%domain,comm_icosa, mpi_req(ireq),ierr)
          ENDDO
        
        ENDDO
        
        CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
!        DO ind=1,ndomain
!          field(ind)%rval2d(:)=0.
!        ENDDO
        
        DO ind=1,ndomain
          rval3d=>field(ind)%rval3d
        
          req=>request(ind)
          DO isend=1,req%nsend
            send=>req%send(isend)
            DEALLOCATE(send%buffer_r3)
          ENDDO
        
          DO irecv=1,req%nrecv
            recv=>req%recv(irecv)
            buffer_r3=>recv%buffer_r3
            value=>recv%value
            DO n=1,recv%size
              rval3d(value(n),:)=buffer_r3(n,:)  
            ENDDO        
            DEALLOCATE(recv%buffer_r3)
          ENDDO
        
        ENDDO

      ELSE  IF (field(1)%ndim==4) THEN
      
        nreq=sum(request(:)%nsend)+sum(request(:)%nrecv)
        ALLOCATE(mpi_req(nreq))
        ALLOCATE(status(MPI_STATUS_SIZE,nreq))
    
        ireq=0
        DO ind=1,ndomain
          dim3=size(field(ind)%rval4d,2)
          dim4=size(field(ind)%rval4d,3)
          rval4d=>field(ind)%rval4d
        
          req=>request(ind)
          DO isend=1,req%nsend
            send=>req%send(isend)

            ALLOCATE(send%buffer_r4(send%size,dim3,dim4))
            buffer_r4=>send%buffer_r4
            value=>send%value
            DO n=1,send%size
              buffer_r4(n,:,:)=rval4d(value(n),:,:)
            ENDDO

            ireq=ireq+1
            CALL MPI_ISEND(buffer_r4,send%size*dim3*dim4,MPI_REAL8,send%rank,ind,comm_icosa, mpi_req(ireq),ierr)
          ENDDO
        
          DO irecv=1,req%nrecv
            recv=>req%recv(irecv)
            ALLOCATE(recv%buffer_r4(recv%size,dim3,dim4))
           
            ireq=ireq+1
            CALL MPI_IRECV(recv%buffer_r4,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%domain,comm_icosa, mpi_req(ireq),ierr)
          ENDDO
        
        ENDDO
        
        CALL MPI_WAITALL(nreq,mpi_req,status,ierr)
!        DO ind=1,ndomain
!          field(ind)%rval2d(:)=0.
!        ENDDO
        
        DO ind=1,ndomain
          rval4d=>field(ind)%rval4d
        
          req=>request(ind)
          DO isend=1,req%nsend
            send=>req%send(isend)
            DEALLOCATE(send%buffer_r4)
          ENDDO
        
          DO irecv=1,req%nrecv
            recv=>req%recv(irecv)
            buffer_r4=>recv%buffer_r4
            value=>recv%value
            DO n=1,recv%size
              rval4d(value(n),:,:)=buffer_r4(n,:,:)  
            ENDDO        
            DEALLOCATE(recv%buffer_r4)
          ENDDO
        
        ENDDO
      
      ENDIF      
      
    ENDIF
    
  END SUBROUTINE transfert_request_mpi
   
  SUBROUTINE transfert_request(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
    REAL(rstd) :: var1,var2
    
    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))
          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),:)
          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),:,:)
          ENDDO
        ENDIF
      ENDIF        

    ENDDO
    
  END SUBROUTINE transfert_request
  
  
  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
  

END MODULE transfert_mpi_mod