mod_hallo.F90

Go to the documentation of this file.

module mod_hallo
USE parallel_lmdz
implicit none
  logical,save :: use_mpi_alloc
  integer, parameter :: maxproc=512
  integer, parameter :: defaultmaxbuffersize=1024*1024*100
  integer, SAVE :: maxbuffersize=0
  integer, parameter :: listsize=1000
  
  integer,save       :: maxbuffersize_used
!$OMP THREADPRIVATE( MaxBufferSize_Used)

   real,save,pointer,dimension(:) :: buffer
!$OMP THREADPRIVATE(Buffer)

   integer,save,dimension(Listsize) :: buffer_pos
   integer,save :: index_pos
!$OMP THREADPRIVATE(Buffer_Pos,Index_pos)
   
  type hallo
    real, dimension(:,:),pointer :: field
    integer :: offset
    integer :: size
    integer :: nblevel
    integer :: stride
  end type hallo
  
  type request_sr
    integer :: nbrequest=0
    integer :: nbrequestmax=0
    integer :: buffersize
    integer :: pos
    integer :: index 
    type(hallo), POINTER :: hallo(:)
    integer :: msg_request
  end type request_sr

  type request
    type(request_sr),dimension(0:MaxProc-1) :: requestsend
    type(request_sr),dimension(0:MaxProc-1) :: requestrecv
    integer :: tag=1
  end type request
  
   TYPE(distrib),SAVE :: distrib_gather


  INTERFACE register_swapfield_u
    MODULE PROCEDURE register_swapfield1d_u,register_swapfield2d_u1d,register_swapfield3d_u
  END INTERFACE register_swapfield_u

  INTERFACE register_swapfield_v
    MODULE PROCEDURE register_swapfield1d_v,register_swapfield2d_v1d,register_swapfield3d_v
  END INTERFACE register_swapfield_v

  INTERFACE register_swapfield2d_u
    MODULE PROCEDURE register_swapfield1d_u2d,register_swapfield2d_u2d,register_swapfield3d_u2d
  END INTERFACE register_swapfield2d_u

  INTERFACE register_swapfield2d_v
    MODULE PROCEDURE register_swapfield1d_v2d,register_swapfield2d_v2d,register_swapfield3d_v2d
  END INTERFACE register_swapfield2d_v

  contains

  subroutine init_mod_hallo
  USE dimensions_mod
  USE ioipsl
    implicit none
    integer :: jj_nb_gather(0:mpi_size-1)
    
    index_pos=1
    buffer_pos(index_pos)=1
    maxbuffersize_used=0
!$OMP MASTER     
    maxbuffersize=defaultmaxbuffersize
    CALL getin("mpi_buffer_size",maxbuffersize)
!$OMP END MASTER
!$OMP BARRIER
    
    IF (use_mpi_alloc .AND. using_mpi) THEN
      CALL create_global_mpi_buffer
    ELSE 
      CALL create_standard_mpi_buffer
    ENDIF
     
!$OMP MASTER     
     jj_nb_gather(:)=0
     jj_nb_gather(0)=jjp1
     
     CALL create_distrib(jj_nb_gather,distrib_gather) 
!$OMP END MASTER
!$OMP BARRIER

  end subroutine init_mod_hallo

  SUBROUTINE create_standard_mpi_buffer
  IMPLICIT NONE
    
    ALLOCATE(buffer(maxbuffersize))
    
  END SUBROUTINE create_standard_mpi_buffer
  
  SUBROUTINE create_global_mpi_buffer
  IMPLICIT NONE
#ifdef CPP_MPI
  include 'mpif.h'
#endif  
    pointer(pbuffer,mpi_buffer(maxbuffersize))
    REAL :: MPI_Buffer
#ifdef CPP_MPI
    INTEGER(KIND=MPI_ADDRESS_KIND) :: BS 
#else
    INTEGER(KIND=8) :: BS
#endif
    INTEGER :: i,ierr

!  Allocation du buffer MPI
      bs=8*maxbuffersize
!$OMP CRITICAL (MPI)
#ifdef CPP_MPI
      CALL mpi_alloc_mem(bs,mpi_info_null,pbuffer,ierr)
#endif
!$OMP END CRITICAL (MPI)
      DO i=1,maxbuffersize
                mpi_buffer(i)=i
      ENDDO
     
      CALL  associate_buffer(mpi_buffer)
      
  CONTAINS
     
     SUBROUTINE associate_buffer(MPI_Buffer)
     IMPLICIT NONE
       REAL,DIMENSION(:),target :: MPI_Buffer  

         buffer=>mpi_buffer
 
      END SUBROUTINE  associate_buffer
                                      
  END SUBROUTINE create_global_mpi_buffer
 
      
  subroutine allocate_buffer(Size,Index,Pos)
  implicit none
    integer :: Size
    integer :: Index
    integer :: Pos

    if (buffer_pos(index_pos)+size>maxbuffersize_used) maxbuffersize_used=buffer_pos(index_pos)+Size  
    if (buffer_pos(index_pos)+size>maxbuffersize) then
      print *,'STOP :: La taille de MaxBufferSize dans mod_hallo.F90 est trop petite !!!!'
      stop
    endif
    
    if (index_pos>=listsize) then
      print *,'STOP :: La taille de ListSize dans mod_hallo.F90 est trop petite !!!!'
      stop
    endif
     
    pos=buffer_pos(index_pos)
    buffer_pos(index_pos+1)=buffer_pos(index_pos)+Size
    index_pos=index_pos+1
    index=index_pos
    
  end subroutine allocate_buffer
     
  subroutine deallocate_buffer(Index)
  implicit none
    integer :: Index
    
    buffer_pos(index)=-1
    
    do while (buffer_pos(index_pos)==-1 .and. index_pos>1)
      index_pos=index_pos-1
    end do

  end subroutine deallocate_buffer  
  
  subroutine settag(a_request,tag)
  implicit none
    type(request):: a_request
    integer :: tag
    
    a_request%tag=tag
  end subroutine settag
  
  
  subroutine new_hallo(Field,Stride,NbLevel,offset,size,Ptr_request)
    integer :: Stride
    integer :: NbLevel
    integer :: size
    integer :: offset
    real, dimension(Stride,NbLevel),target :: Field
    type(request_sr),pointer :: Ptr_request
    type(hallo),POINTER :: NewHallos(:),HalloSwitch(:), NewHallo
    
    ptr_request%NbRequest=ptr_request%NbRequest+1
    IF(ptr_request%NbRequestMax==0) THEN
       ptr_request%NbRequestMax=10
       ALLOCATE(ptr_request%Hallo(ptr_request%NbRequestMax))
    ELSE IF ( ptr_request%NbRequest > ptr_request%NbRequestMax) THEN
      ptr_request%NbRequestMax=int(ptr_request%NbRequestMax*1.2)
      ALLOCATE(newhallos(ptr_request%NbRequestMax))
      newhallos(1:ptr_request%NbRequest-1)=ptr_request%hallo(1:ptr_request%NbRequest-1)
      halloswitch=>ptr_request%hallo
      ptr_request%hallo=>newhallos
      DEALLOCATE(halloswitch)
    ENDIF
    
    newhallo=>ptr_request%hallo(ptr_request%NbRequest)
          
    newhallo%Field=>field
    newhallo%Stride=stride
    newhallo%NbLevel=nblevel
    newhallo%size=size
    newhallo%offset=offset
    
  end subroutine new_hallo
  
  subroutine register_sendfield(Field,ij,ll,offset,size,target,a_request)
  USE dimensions_mod
  implicit none

    
      INTEGER :: ij,ll,offset,size,target
      REAL, dimension(ij,ll) :: Field
      type(request),target :: a_request
      type(request_sr),pointer :: Ptr_request

      ptr_request=>a_request%RequestSend(target)

      call new_hallo(field,ij,ll,offset,size,ptr_request)
      
   end subroutine register_sendfield      
      
  subroutine register_recvfield(Field,ij,ll,offset,size,target,a_request)
  USE dimensions_mod
  implicit none

   
      INTEGER :: ij,ll,offset,size,target
      REAL, dimension(ij,ll) :: Field
      type(request),target :: a_request
      type(request_sr),pointer :: Ptr_request

      ptr_request=>a_request%RequestRecv(target)
            
      call new_hallo(field,ij,ll,offset,size,ptr_request)

      
   end subroutine register_recvfield      
  
  subroutine register_swapfield(FieldS,FieldR,ij,ll,jj_Nb_New,a_request)
  USE dimensions_mod
      implicit none

    
    INTEGER :: ij,ll
    REAL, dimension(ij,ll) :: FieldS
    REAL, dimension(ij,ll) :: FieldR
    type(request) :: a_request
    integer,dimension(0:MPI_Size-1) :: jj_Nb_New   
    integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
    
    integer ::i,jje,jjb
    
    jj_begin_new(0)=1
    jj_end_new(0)=jj_nb_new(0)
    do i=1,mpi_size-1
      jj_begin_new(i)=jj_end_new(i-1)+1
      jj_end_new(i)=jj_begin_new(i)+jj_nb_new(i)-1
    enddo
    
    do i=0,mpi_size-1
      if (i /= mpi_rank) then
        jjb=max(jj_begin_new(i),jj_begin)
        jje=min(jj_end_new(i),jj_end)
        
        if (ij==ip1jm .and. jje==jjp1) jje=jjm
        
        if (jje >= jjb) then
          call register_sendfield(fields,ij,ll,jjb,jje-jjb+1,i,a_request) 
        endif
        
        jjb=max(jj_begin_new(mpi_rank),jj_begin_para(i))
        jje=min(jj_end_new(mpi_rank),jj_end_para(i))
        
        if (ij==ip1jm .and. jje==jjp1) jje=jjm
        
        if (jje >= jjb) then
          call register_recvfield(fieldr,ij,ll,jjb,jje-jjb+1,i,a_request) 
        endif
        
      endif
    enddo
    
  end subroutine register_swapfield    
  

  
  subroutine register_swapfieldhallo(FieldS,FieldR,ij,ll,jj_Nb_New,Up,Down,a_request)
  USE dimensions_mod
  
      implicit none
    
    INTEGER :: ij,ll,Up,Down
    REAL, dimension(ij,ll) :: FieldS
    REAL, dimension(ij,ll) :: FieldR
    type(request) :: a_request
    integer,dimension(0:MPI_Size-1) :: jj_Nb_New   
    integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
    
    integer ::i,jje,jjb
    
    jj_begin_new(0)=1
    jj_end_new(0)=jj_nb_new(0)
    do i=1,mpi_size-1
      jj_begin_new(i)=jj_end_new(i-1)+1
      jj_end_new(i)=jj_begin_new(i)+jj_nb_new(i)-1
    enddo
    
    do i=0,mpi_size-1
      jj_begin_new(i)=max(1,jj_begin_new(i)-up)
      jj_end_new(i)=min(jjp1,jj_end_new(i)+down)
    enddo
   
    do i=0,mpi_size-1
      if (i /= mpi_rank) then
        jjb=max(jj_begin_new(i),jj_begin)
        jje=min(jj_end_new(i),jj_end)
        
        if (ij==ip1jm .and. jje==jjp1) jje=jjm
        
        if (jje >= jjb) then
          call register_sendfield(fields,ij,ll,jjb,jje-jjb+1,i,a_request) 
        endif
        
        jjb=max(jj_begin_new(mpi_rank),jj_begin_para(i))
        jje=min(jj_end_new(mpi_rank),jj_end_para(i))
        
        if (ij==ip1jm .and. jje==jjp1) jje=jjm
        
        if (jje >= jjb) then
          call register_recvfield(fieldr,ij,ll,jjb,jje-jjb+1,i,a_request) 
        endif
        
      endif
    enddo
    
  end subroutine register_swapfieldhallo



  SUBROUTINE register_swapfield1d_u(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
  USE parallel_lmdz
  USE dimensions_mod
      IMPLICIT NONE
    
    REAL, DIMENSION(:),INTENT(IN)     :: FieldS
    REAL, DIMENSION(:),INTENT(OUT)    :: FieldR
    TYPE(distrib),OPTIONAL,INTENT(IN) :: old_dist
    TYPE(distrib),INTENT(IN)          :: new_dist
    INTEGER,OPTIONAL,INTENT(IN)       :: up
    INTEGER,OPTIONAL,INTENT(IN)       :: down      
    TYPE(request),INTENT(INOUT)         :: a_request

    INTEGER                           :: halo_up
    INTEGER                           :: halo_down
    
    
    halo_up=0
    halo_down=0
    IF (PRESENT(up))   halo_up=up
    IF (PRESENT(down)) halo_down=down

    IF (PRESENT(old_dist)) THEN
      CALL  register_swapfield_gen_u(fields,fieldr,1,old_dist,new_dist,halo_up,halo_down,a_request)
    ELSE
      CALL  register_swapfield_gen_u(fields,fieldr,1,current_dist,new_dist,halo_up,halo_down,a_request)
    ENDIF
        
  END SUBROUTINE  register_swapfield1d_u 


  SUBROUTINE register_swapfield2d_u1d(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
  USE parallel_lmdz
  USE dimensions_mod
    IMPLICIT NONE
    
    REAL, DIMENSION(:,:),INTENT(IN)     :: FieldS
    REAL, DIMENSION(:,:),INTENT(OUT)    :: FieldR
    TYPE(distrib),OPTIONAL,INTENT(IN) :: old_dist
    TYPE(distrib),INTENT(IN)          :: new_dist
    INTEGER,OPTIONAL,INTENT(IN)       :: up
    INTEGER,OPTIONAL,INTENT(IN)       :: down      
    TYPE(request),INTENT(INOUT)         :: a_request

    INTEGER                           :: halo_up
    INTEGER                           :: halo_down
    INTEGER                           :: ll
        
    
    halo_up=0
    halo_down=0
    IF (PRESENT(up))   halo_up=up
    IF (PRESENT(down)) halo_down=down
    
    ll=size(fields,2)
    
    IF (PRESENT(old_dist)) THEN
      CALL  register_swapfield_gen_u(fields,fieldr,ll,old_dist,new_dist,halo_up,halo_down,a_request)
    ELSE
      CALL  register_swapfield_gen_u(fields,fieldr,ll,current_dist,new_dist,halo_up,halo_down,a_request)
    ENDIF
    
  END SUBROUTINE  register_swapfield2d_u1d
   

  SUBROUTINE register_swapfield3d_u(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
  USE parallel_lmdz
  USE dimensions_mod
      IMPLICIT NONE
    
    REAL, DIMENSION(:,:,:),INTENT(IN)     :: FieldS
    REAL, DIMENSION(:,:,:),INTENT(OUT)    :: FieldR
    TYPE(distrib),OPTIONAL,INTENT(IN) :: old_dist
    TYPE(distrib),INTENT(IN)          :: new_dist
    INTEGER,OPTIONAL,INTENT(IN)       :: up
    INTEGER,OPTIONAL,INTENT(IN)       :: down      
    TYPE(request),INTENT(INOUT)         :: a_request

    INTEGER                           :: halo_up
    INTEGER                           :: halo_down
    INTEGER                           :: ll
        
    
    halo_up=0
    halo_down=0
    IF (PRESENT(up))   halo_up=up
    IF (PRESENT(down)) halo_down=down
    
    ll=size(fields,2)*size(fields,3)
    
    IF (PRESENT(old_dist)) THEN
      CALL  register_swapfield_gen_u(fields,fieldr,ll,old_dist,new_dist,halo_up,halo_down,a_request)
    ELSE
      CALL  register_swapfield_gen_u(fields,fieldr,ll,current_dist,new_dist,halo_up,halo_down,a_request)
    ENDIF
    
  END SUBROUTINE  register_swapfield3d_u 
  


 SUBROUTINE register_swapfield1d_u2d(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
  USE parallel_lmdz
  USE dimensions_mod

      IMPLICIT NONE
    
    REAL, DIMENSION(:,:),INTENT(IN)     :: FieldS
    REAL, DIMENSION(:,:),INTENT(OUT)    :: FieldR
    TYPE(distrib),OPTIONAL,INTENT(IN) :: old_dist
    TYPE(distrib),OPTIONAL,INTENT(IN)          :: new_dist !LF
    INTEGER,OPTIONAL,INTENT(IN)       :: up
    INTEGER,OPTIONAL,INTENT(IN)       :: down      
    TYPE(request),INTENT(INOUT)         :: a_request

    INTEGER                           :: halo_up
    INTEGER                           :: halo_down
    
    
    halo_up=0
    halo_down=0
    IF (PRESENT(up))   halo_up=up
    IF (PRESENT(down)) halo_down=down

    IF (PRESENT(old_dist)) THEN
      CALL  register_swapfield_gen_u(fields,fieldr,1,old_dist,new_dist,halo_up,halo_down,a_request)
    ELSE
      CALL  register_swapfield_gen_u(fields,fieldr,1,current_dist,new_dist,halo_up,halo_down,a_request)
    ENDIF
        
  END SUBROUTINE  register_swapfield1d_u2d 


  SUBROUTINE register_swapfield2d_u2d(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
  USE parallel_lmdz
  USE dimensions_mod

      IMPLICIT NONE
    
    REAL, DIMENSION(:,:,:),INTENT(IN)     :: FieldS
    REAL, DIMENSION(:,:,:),INTENT(OUT)    :: FieldR
    TYPE(distrib),OPTIONAL,INTENT(IN) :: old_dist
    TYPE(distrib),INTENT(IN)          :: new_dist
    INTEGER,OPTIONAL,INTENT(IN)       :: up
    INTEGER,OPTIONAL,INTENT(IN)       :: down      
    TYPE(request),INTENT(INOUT)         :: a_request

    INTEGER                           :: halo_up
    INTEGER                           :: halo_down
    INTEGER                           :: ll
        
    
    halo_up=0
    halo_down=0
    IF (PRESENT(up))   halo_up=up
    IF (PRESENT(down)) halo_down=down
    
    ll=size(fields,3)
    
    IF (PRESENT(old_dist)) THEN
      CALL  register_swapfield_gen_u(fields,fieldr,ll,old_dist,new_dist,halo_up,halo_down,a_request)
    ELSE
      CALL  register_swapfield_gen_u(fields,fieldr,ll,current_dist,new_dist,halo_up,halo_down,a_request)
    ENDIF
    
  END SUBROUTINE  register_swapfield2d_u2d
   

  SUBROUTINE register_swapfield3d_u2d(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
  USE parallel_lmdz
  USE dimensions_mod
      IMPLICIT NONE
    
    REAL, DIMENSION(:,:,:,:),INTENT(IN)     :: FieldS
    REAL, DIMENSION(:,:,:,:),INTENT(OUT)    :: FieldR
    TYPE(distrib),OPTIONAL,INTENT(IN) :: old_dist
    TYPE(distrib),INTENT(IN)          :: new_dist
    INTEGER,OPTIONAL,INTENT(IN)       :: up
    INTEGER,OPTIONAL,INTENT(IN)       :: down      
    TYPE(request),INTENT(INOUT)         :: a_request

    INTEGER                           :: halo_up
    INTEGER                           :: halo_down
    INTEGER                           :: ll
        
    
    halo_up=0
    halo_down=0
    IF (PRESENT(up))   halo_up=up
    IF (PRESENT(down)) halo_down=down
    
    ll=size(fields,3)*size(fields,4)
    
    IF (PRESENT(old_dist)) THEN
      CALL  register_swapfield_gen_u(fields,fieldr,ll,old_dist,new_dist,halo_up,halo_down,a_request)
    ELSE
      CALL  register_swapfield_gen_u(fields,fieldr,ll,current_dist,new_dist,halo_up,halo_down,a_request)
    ENDIF
    
  END SUBROUTINE  register_swapfield3d_u2d 







  SUBROUTINE register_swapfield1d_v(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
  USE parallel_lmdz
  USE dimensions_mod
      IMPLICIT NONE
    
    REAL, DIMENSION(:),INTENT(IN)     :: FieldS
    REAL, DIMENSION(:),INTENT(OUT)    :: FieldR
    TYPE(distrib),OPTIONAL,INTENT(IN) :: old_dist
    TYPE(distrib),INTENT(IN)          :: new_dist
    INTEGER,OPTIONAL,INTENT(IN)       :: up
    INTEGER,OPTIONAL,INTENT(IN)       :: down      
    TYPE(request),INTENT(INOUT)         :: a_request

    INTEGER                           :: halo_up
    INTEGER                           :: halo_down
    
    
    halo_up=0
    halo_down=0
    IF (PRESENT(up))   halo_up=up
    IF (PRESENT(down)) halo_down=down

    IF (PRESENT(old_dist)) THEN
      CALL  register_swapfield_gen_v(fields,fieldr,1,old_dist,new_dist,halo_up,halo_down,a_request)
    ELSE
      CALL  register_swapfield_gen_v(fields,fieldr,1,current_dist,new_dist,halo_up,halo_down,a_request)
    ENDIF
        
  END SUBROUTINE  register_swapfield1d_v 


  SUBROUTINE register_swapfield2d_v1d(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
  USE parallel_lmdz
  USE dimensions_mod
      IMPLICIT NONE
   
    REAL, DIMENSION(:,:),INTENT(IN)     :: FieldS
    REAL, DIMENSION(:,:),INTENT(OUT)    :: FieldR
    TYPE(distrib),OPTIONAL,INTENT(IN) :: old_dist
    TYPE(distrib),INTENT(IN)          :: new_dist
    INTEGER,OPTIONAL,INTENT(IN)       :: up
    INTEGER,OPTIONAL,INTENT(IN)       :: down      
    TYPE(request),INTENT(INOUT)         :: a_request

    INTEGER                           :: halo_up
    INTEGER                           :: halo_down
    INTEGER                           :: ll
        
    
    halo_up=0
    halo_down=0
    IF (PRESENT(up))   halo_up=up
    IF (PRESENT(down)) halo_down=down
    
    ll=size(fields,2)
    
    IF (PRESENT(old_dist)) THEN
      CALL  register_swapfield_gen_v(fields,fieldr,ll,old_dist,new_dist,halo_up,halo_down,a_request)
    ELSE
      CALL  register_swapfield_gen_v(fields,fieldr,ll,current_dist,new_dist,halo_up,halo_down,a_request)
    ENDIF
    
  END SUBROUTINE  register_swapfield2d_v1d
   

  SUBROUTINE register_swapfield3d_v(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
  USE parallel_lmdz
  USE dimensions_mod
      IMPLICIT NONE
    
    REAL, DIMENSION(:,:,:),INTENT(IN)     :: FieldS
    REAL, DIMENSION(:,:,:),INTENT(OUT)    :: FieldR
    TYPE(distrib),OPTIONAL,INTENT(IN) :: old_dist
    TYPE(distrib),INTENT(IN)          :: new_dist
    INTEGER,OPTIONAL,INTENT(IN)       :: up
    INTEGER,OPTIONAL,INTENT(IN)       :: down      
    TYPE(request),INTENT(INOUT)         :: a_request

    INTEGER                           :: halo_up
    INTEGER                           :: halo_down
    INTEGER                           :: ll
        
    
    halo_up=0
    halo_down=0
    IF (PRESENT(up))   halo_up=up
    IF (PRESENT(down)) halo_down=down
    
    ll=size(fields,2)*size(fields,3)
    
    IF (PRESENT(old_dist)) THEN
      CALL  register_swapfield_gen_v(fields,fieldr,ll,old_dist,new_dist,halo_up,halo_down,a_request)
    ELSE
      CALL  register_swapfield_gen_v(fields,fieldr,ll,current_dist,new_dist,halo_up,halo_down,a_request)
    ENDIF
    
  END SUBROUTINE  register_swapfield3d_v 




  SUBROUTINE register_swapfield1d_v2d(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
  USE parallel_lmdz
  USE dimensions_mod
      IMPLICIT NONE
    
    REAL, DIMENSION(:,:),INTENT(IN)     :: FieldS
    REAL, DIMENSION(:,:),INTENT(OUT)    :: FieldR
    TYPE(distrib),OPTIONAL,INTENT(IN) :: old_dist
    TYPE(distrib),OPTIONAL,INTENT(IN)          :: new_dist !LF
    INTEGER,OPTIONAL,INTENT(IN)       :: up
    INTEGER,OPTIONAL,INTENT(IN)       :: down      
    TYPE(request),INTENT(INOUT)         :: a_request

    INTEGER                           :: halo_up
    INTEGER                           :: halo_down
    
    
    halo_up=0
    halo_down=0
    IF (PRESENT(up))   halo_up=up
    IF (PRESENT(down)) halo_down=down

    IF (PRESENT(old_dist)) THEN
      CALL  register_swapfield_gen_v(fields,fieldr,1,old_dist,new_dist,halo_up,halo_down,a_request)
    ELSE
      CALL  register_swapfield_gen_v(fields,fieldr,1,current_dist,new_dist,halo_up,halo_down,a_request)
    ENDIF
        
  END SUBROUTINE  register_swapfield1d_v2d


  SUBROUTINE register_swapfield2d_v2d(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
  USE parallel_lmdz
  USE dimensions_mod
      IMPLICIT NONE
    
    REAL, DIMENSION(:,:,:),INTENT(IN)     :: FieldS
    REAL, DIMENSION(:,:,:),INTENT(OUT)    :: FieldR
    TYPE(distrib),OPTIONAL,INTENT(IN) :: old_dist
    TYPE(distrib),INTENT(IN)          :: new_dist
    INTEGER,OPTIONAL,INTENT(IN)       :: up
    INTEGER,OPTIONAL,INTENT(IN)       :: down      
    TYPE(request),INTENT(INOUT)         :: a_request

    INTEGER                           :: halo_up
    INTEGER                           :: halo_down
    INTEGER                           :: ll
        
    
    halo_up=0
    halo_down=0
    IF (PRESENT(up))   halo_up=up
    IF (PRESENT(down)) halo_down=down
    
    ll=size(fields,3)
    
    IF (PRESENT(old_dist)) THEN
      CALL  register_swapfield_gen_v(fields,fieldr,ll,old_dist,new_dist,halo_up,halo_down,a_request)
    ELSE
      CALL  register_swapfield_gen_v(fields,fieldr,ll,current_dist,new_dist,halo_up,halo_down,a_request)
    ENDIF
    
  END SUBROUTINE  register_swapfield2d_v2d
   

  SUBROUTINE register_swapfield3d_v2d(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
  USE parallel_lmdz
  USE dimensions_mod
      IMPLICIT NONE
    
    REAL, DIMENSION(:,:,:,:),INTENT(IN)     :: FieldS
    REAL, DIMENSION(:,:,:,:),INTENT(OUT)    :: FieldR
    TYPE(distrib),OPTIONAL,INTENT(IN) :: old_dist
    TYPE(distrib),INTENT(IN)          :: new_dist
    INTEGER,OPTIONAL,INTENT(IN)       :: up
    INTEGER,OPTIONAL,INTENT(IN)       :: down      
    TYPE(request),INTENT(INOUT)         :: a_request

    INTEGER                           :: halo_up
    INTEGER                           :: halo_down
    INTEGER                           :: ll
        
    
    halo_up=0
    halo_down=0
    IF (PRESENT(up))   halo_up=up
    IF (PRESENT(down)) halo_down=down
    
    ll=size(fields,3)*size(fields,4)
    
    IF (PRESENT(old_dist)) THEN
      CALL  register_swapfield_gen_v(fields,fieldr,ll,old_dist,new_dist,halo_up,halo_down,a_request)
    ELSE
      CALL  register_swapfield_gen_v(fields,fieldr,ll,current_dist,new_dist,halo_up,halo_down,a_request)
    ENDIF
    
  END SUBROUTINE  register_swapfield3d_v2d 
  
  

  SUBROUTINE register_swapfield_gen_u(FieldS,FieldR,ll,old_dist,new_dist,Up,Down,a_request)
  USE parallel_lmdz
  USE dimensions_mod
      IMPLICIT NONE
   
    INTEGER :: ll,Up,Down
    TYPE(distrib)  :: old_dist
    TYPE(distrib)  :: new_dist
    REAL, DIMENSION(old_dist%ijb_u:old_dist%ije_u,ll) :: FieldS
    REAL, DIMENSION(new_dist%ijb_u:new_dist%ije_u,ll) :: FieldR
    TYPE(request) :: a_request
    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New   
    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
    
    INTEGER ::i,l,jje,jjb,ijb,ije
    
    DO i=0,mpi_size-1
      jj_begin_new(i)=max(1,new_dist%jj_begin_para(i)-up)
      jj_end_new(i)=min(jjp1,new_dist%jj_end_para(i)+down)
    ENDDO
   
    DO i=0,mpi_size-1
      IF (i /= mpi_rank) THEN
        jjb=max(jj_begin_new(i),old_dist%jj_begin)
        jje=min(jj_end_new(i),old_dist%jj_end)
        
        IF (jje >= jjb) THEN
          CALL register_sendfield(fields,old_dist%ijnb_u,ll,jjb-old_dist%jjb_u+1,jje-jjb+1,i,a_request) 
        ENDIF
        
        jjb=max(jj_begin_new(mpi_rank),old_dist%jj_begin_Para(i))
        jje=min(jj_end_new(mpi_rank),old_dist%jj_end_Para(i))
        
        IF (jje >= jjb) THEN
          CALL register_recvfield(fieldr,new_dist%ijnb_u,ll,jjb-new_dist%jjb_u+1,jje-jjb+1,i,a_request) 
        ENDIF
      ELSE
        jjb=max(jj_begin_new(i),old_dist%jj_begin)
        jje=min(jj_end_new(i),old_dist%jj_end)
        ijb=(jjb-1)*iip1+1
        ije=jje*iip1
!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
        DO l=1,ll
          fieldr(ijb:ije,l)=fields(ijb:ije,l)              
        ENDDO
!$OMP END DO NOWAIT
      ENDIF
    ENDDO
    
  END SUBROUTINE register_swapfield_gen_u



  SUBROUTINE register_swapfield_gen_v(FieldS,FieldR,ll,old_dist,new_dist,Up,Down,a_request)
  USE parallel_lmdz
  USE dimensions_mod
    IMPLICIT NONE
    
    INTEGER :: ll,Up,Down
    TYPE(distrib)  :: old_dist
    TYPE(distrib)  :: new_dist
    REAL, DIMENSION(old_dist%ijb_v:old_dist%ije_v,ll) :: FieldS
    REAL, DIMENSION(new_dist%ijb_v:new_dist%ije_v,ll) :: FieldR
    TYPE(request) :: a_request
    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New   
    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
    
    INTEGER ::i,l,jje,jjb,ijb,ije
    
    DO i=0,mpi_size-1
      jj_begin_new(i)=max(1,new_dist%jj_begin_para(i)-up)
      jj_end_new(i)=min(jjp1,new_dist%jj_end_para(i)+down)
    ENDDO
   
    DO i=0,mpi_size-1
      IF (i /= mpi_rank) THEN
        jjb=max(jj_begin_new(i),old_dist%jj_begin)
        jje=min(jj_end_new(i),old_dist%jj_end)

        IF (jje==jjp1) jje=jjm        

        IF (jje >= jjb) THEN
          CALL register_sendfield(fields,old_dist%ijnb_v,ll,jjb-old_dist%jjb_v+1,jje-jjb+1,i,a_request) 
        ENDIF
        
        jjb=max(jj_begin_new(mpi_rank),old_dist%jj_begin_Para(i))
        jje=min(jj_end_new(mpi_rank),old_dist%jj_end_Para(i))

        IF (jje==jjp1) jje=jjm
        
        IF (jje >= jjb) THEN
          CALL register_recvfield(fieldr,new_dist%ijnb_v,ll,jjb-new_dist%jjb_v+1,jje-jjb+1,i,a_request) 
        ENDIF
      ELSE
        jjb=max(jj_begin_new(i),old_dist%jj_begin)
        jje=min(jj_end_new(i),old_dist%jj_end)
        IF (jje==jjp1) jje=jjm
        ijb=(jjb-1)*iip1+1
        ije=jje*iip1
!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
        DO l=1,ll
          fieldr(ijb:ije,l)=fields(ijb:ije,l)
        ENDDO              
!$OMP END DO NOWAIT
      ENDIF
    ENDDO
    
  END SUBROUTINE register_swapfield_gen_v


 

  
  subroutine register_hallo(Field,ij,ll,RUp,Rdown,SUp,SDown,a_request)
  USE dimensions_mod
      implicit none

#ifdef CPP_MPI
    include 'mpif.h'
#endif    
      INTEGER :: ij,ll
      REAL, dimension(ij,ll) :: Field
      INTEGER :: Sup,Sdown,rup,rdown
      type(request) :: a_request
      type(hallo),pointer :: PtrHallo
      LOGICAL :: SendUp,SendDown
      LOGICAL :: RecvUp,RecvDown
   
 
      sendup=.true.
      senddown=.true.
      recvup=.true.
      recvdown=.true.
        
      IF (pole_nord) THEN
        sendup=.false.
        recvup=.false.
      ENDIF
  
      IF (pole_sud) THEN
        senddown=.false.
        recvdown=.false.
      ENDIF
      
      if (sup.eq.0) then
        sendup=.false.
       endif
      
      if (sdown.eq.0) then
        senddown=.false.
      endif

      if (rup.eq.0) then
        recvup=.false.
      endif
      
      if (rdown.eq.0) then
        recvdown=.false.
      endif
      
      IF (sendup) THEN
        call register_sendfield(field,ij,ll,jj_begin,sup,mpi_rank-1,a_request)
      ENDIF
  
      IF (senddown) THEN
        call register_sendfield(field,ij,ll,jj_end-sdown+1,sdown,mpi_rank+1,a_request)
      ENDIF
    
  
      IF (recvup) THEN
        call register_recvfield(field,ij,ll,jj_begin-rup,rup,mpi_rank-1,a_request)
      ENDIF
  
      IF (recvdown) THEN
        call register_recvfield(field,ij,ll,jj_end+1,rdown,mpi_rank+1,a_request)
      ENDIF
  
    end subroutine register_hallo


  subroutine register_hallo_u(Field,ll,RUp,Rdown,SUp,SDown,a_request)
  USE dimensions_mod
      implicit none
#ifdef CPP_MPI
    include 'mpif.h'
#endif    
      INTEGER :: ll
      REAL, dimension(ijb_u:ije_u,ll) :: Field
      INTEGER :: Sup,Sdown,rup,rdown
      type(request) :: a_request
      type(hallo),pointer :: PtrHallo
      LOGICAL :: SendUp,SendDown
      LOGICAL :: RecvUp,RecvDown
   
 
      sendup=.true.
      senddown=.true.
      recvup=.true.
      recvdown=.true.
        
      IF (pole_nord) THEN
        sendup=.false.
        recvup=.false.
      ENDIF
  
      IF (pole_sud) THEN
        senddown=.false.
        recvdown=.false.
      ENDIF
      
      if (sup.eq.0) then
        sendup=.false.
       endif
      
      if (sdown.eq.0) then
        senddown=.false.
      endif

      if (rup.eq.0) then
        recvup=.false.
      endif
      
      if (rdown.eq.0) then
        recvdown=.false.
      endif
      
      IF (sendup) THEN
        call register_sendfield(field,ijnb_u,ll,jj_begin-jjb_u+1,sup,mpi_rank-1,a_request)
      ENDIF
  
      IF (senddown) THEN
        call register_sendfield(field,ijnb_u,ll,jj_end-sdown+1-jjb_u+1,sdown,mpi_rank+1,a_request)
      ENDIF
    
  
      IF (recvup) THEN
        call register_recvfield(field,ijnb_u,ll,jj_begin-rup-jjb_u+1,rup,mpi_rank-1,a_request)
      ENDIF
  
      IF (recvdown) THEN
        call register_recvfield(field,ijnb_u,ll,jj_end+1-jjb_u+1,rdown,mpi_rank+1,a_request)
      ENDIF
  
    end subroutine register_hallo_u

  subroutine register_hallo_v(Field,ll,RUp,Rdown,SUp,SDown,a_request)
  USE dimensions_mod
      implicit none
#ifdef CPP_MPI
    include 'mpif.h'
#endif    
      INTEGER :: ll
      REAL, dimension(ijb_v:ije_v,ll) :: Field
      INTEGER :: Sup,Sdown,rup,rdown
      type(request) :: a_request
      type(hallo),pointer :: PtrHallo
      LOGICAL :: SendUp,SendDown
      LOGICAL :: RecvUp,RecvDown
   
 
      sendup=.true.
      senddown=.true.
      recvup=.true.
      recvdown=.true.
        
      IF (pole_nord) THEN
        sendup=.false.
        recvup=.false.
      ENDIF
  
      IF (pole_sud) THEN
        senddown=.false.
        recvdown=.false.
      ENDIF
      
      if (sup.eq.0) then
        sendup=.false.
       endif
      
      if (sdown.eq.0) then
        senddown=.false.
      endif

      if (rup.eq.0) then
        recvup=.false.
      endif
      
      if (rdown.eq.0) then
        recvdown=.false.
      endif
      
      IF (sendup) THEN
        call register_sendfield(field,ijnb_v,ll,jj_begin-jjb_v+1,sup,mpi_rank-1,a_request)
      ENDIF
  
      IF (senddown) THEN
        call register_sendfield(field,ijnb_v,ll,jj_end-sdown+1-jjb_v+1,sdown,mpi_rank+1,a_request)
      ENDIF
    
  
      IF (recvup) THEN
        call register_recvfield(field,ijnb_v,ll,jj_begin-rup-jjb_v+1,rup,mpi_rank-1,a_request)
      ENDIF
  
      IF (recvdown) THEN
        call register_recvfield(field,ijnb_v,ll,jj_end+1-jjb_v+1,rdown,mpi_rank+1,a_request)
      ENDIF
  
    end subroutine register_hallo_v
    
    subroutine sendrequest(a_Request)
    USE dimensions_mod
      implicit none

#ifdef CPP_MPI
      include 'mpif.h'
#endif

      type(request),target :: a_request
      type(request_sr),pointer :: Req
      type(hallo),pointer :: PtrHallo
      integer :: SizeBuffer
      integer :: i,rank,l,ij,Pos,ierr
      integer :: offset
      real,dimension(:,:),pointer :: Field
      integer :: Nb
       
      do rank=0,mpi_size-1
      
        req=>a_request%RequestSend(rank)
        
        sizebuffer=0
        do i=1,req%NbRequest
          ptrhallo=>req%Hallo(i)
!$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
          DO l=1,ptrhallo%NbLevel
            sizebuffer=sizebuffer+ptrhallo%size*iip1
          ENDDO
!$OMP ENDDO NOWAIT          
        enddo
      
         req%BufferSize=sizebuffer
         if (req%NbRequest>0) then
       
          call allocate_buffer(sizebuffer,req%Index,req%pos)

          pos=req%Pos
          do i=1,req%NbRequest
            ptrhallo=>req%Hallo(i)
            offset=(ptrhallo%offset-1)*iip1+1
            nb=iip1*ptrhallo%size-1
            field=>ptrhallo%Field

!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
            do l=1,ptrhallo%NbLevel
!cdir NODEP
              do ij=0,nb
                        buffer(pos+ij)=field(offset+ij,l)
                      enddo
              
              pos=pos+nb+1
            enddo
!$OMP END DO NOWAIT            
          enddo
    
         if (sizebuffer>0) then
!$OMP CRITICAL (MPI)
         
#ifdef CPP_MPI
         call mpi_issend(buffer(req%Pos),sizebuffer,mpi_real_lmdz,rank,a_request%tag+1000*omp_rank,     &
                         comm_lmdz,req%MSG_Request,ierr)
#endif
         IF (.NOT.using_mpi) THEN
           print *,'Erreur, echange MPI en mode sequentiel !!!'
           stop
         ENDIF
!         PRINT *,"-------------------------------------------------------------------"
!         PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
!         PRINT *,"Requete envoye au proc :",rank,"tag :",a_request%tag+1000*omp_rank
!         PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
!         PRINT *,"-------------------------------------------------------------------"
!$OMP END CRITICAL (MPI)
        endif
       endif
    enddo
   
           
      do rank=0,mpi_size-1
         
          req=>a_request%RequestRecv(rank)
          sizebuffer=0
          
                  do i=1,req%NbRequest
            ptrhallo=>req%Hallo(i)

!$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
            DO l=1,ptrhallo%NbLevel
              sizebuffer=sizebuffer+ptrhallo%size*iip1
            ENDDO
!$OMP ENDDO NOWAIT          
          enddo
          
          req%BufferSize=sizebuffer
          
          if (req%NbRequest>0) then
          call allocate_buffer(sizebuffer,req%Index,req%Pos)
   
          if (sizebuffer>0) then

!$OMP CRITICAL (MPI)

#ifdef CPP_MPI
             call mpi_irecv(buffer(req%Pos),sizebuffer,mpi_real_lmdz,rank,a_request%tag+1000*omp_rank,     &
                           comm_lmdz,req%MSG_Request,ierr)
#endif             
             IF (.NOT.using_mpi) THEN
               print *,'Erreur, echange MPI en mode sequentiel !!!'
               stop
             ENDIF

!         PRINT *,"-------------------------------------------------------------------"
!         PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
!         PRINT *,"Requete en attente du proc :",rank,"tag :",a_request%tag+1000*omp_rank
!         PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
!         PRINT *,"-------------------------------------------------------------------"

!$OMP END CRITICAL (MPI)
          endif
        endif
      
      enddo
                        
   end subroutine sendrequest 
   
   subroutine waitrequest(a_Request)
   USE dimensions_mod
   implicit none
   
#ifdef CPP_MPI
      include 'mpif.h'   
#endif
      
      type(request),target :: a_request
      type(request_sr),pointer :: Req
      type(hallo),pointer :: PtrHallo
      integer, dimension(2*mpi_size) :: TabRequest
#ifdef CPP_MPI
      integer, dimension(MPI_STATUS_SIZE,2*mpi_size) :: TabStatus
#else
      integer, dimension(1,2*mpi_size) :: TabStatus
#endif
      integer :: NbRequest
      integer :: i,rank,pos,ij,l,ierr
      integer :: offset
      integer :: Nb
      
      
      nbrequest=0
      do rank=0,mpi_size-1
        req=>a_request%RequestSend(rank)
        if (req%NbRequest>0 .AND. req%BufferSize > 0) then
          nbrequest=nbrequest+1
          tabrequest(nbrequest)=req%MSG_Request
        endif
      enddo
      
      do rank=0,mpi_size-1
        req=>a_request%RequestRecv(rank)
        if (req%NbRequest>0 .AND. req%BufferSize > 0 ) then
          nbrequest=nbrequest+1
          tabrequest(nbrequest)=req%MSG_Request
        endif
      enddo
     
      if (nbrequest>0) then
!$OMP CRITICAL (MPI)
!        PRINT *,"-------------------------------------------------------------------"
!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
!        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
#ifdef CPP_MPI
        call mpi_waitall(nbrequest,tabrequest,tabstatus,ierr)
#endif
!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
!        PRINT *,"-------------------------------------------------------------------"
!$OMP END CRITICAL (MPI)
      endif
      do rank=0,mpi_size-1
        req=>a_request%RequestRecv(rank)
        if (req%NbRequest>0) then
          pos=req%Pos
          do i=1,req%NbRequest
            ptrhallo=>req%Hallo(i)
            offset=(ptrhallo%offset-1)*iip1+1
                    nb=iip1*ptrhallo%size-1

!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)            
                    do l=1,ptrhallo%NbLevel
!cdir NODEP
              do ij=0,nb
                        ptrhallo%Field(offset+ij,l)=buffer(pos+ij)
                      enddo

              pos=pos+nb+1
                    enddo
!$OMP ENDDO NOWAIT                  
          enddo
        endif
      enddo
      
      do rank=0,mpi_size-1
        req=>a_request%RequestSend(rank)
        if (req%NbRequest>0) then
          call deallocate_buffer(req%Index)
          req%NbRequest=0 
        endif
      enddo
              
      do rank=0,mpi_size-1
        req=>a_request%RequestRecv(rank)
        if (req%NbRequest>0) then
          call deallocate_buffer(req%Index)
          req%NbRequest=0 
        endif
      enddo
     
      a_request%tag=1
    end subroutine waitrequest
     
   subroutine waitsendrequest(a_Request)
   USE dimensions_mod
   implicit none
   
#ifdef CPP_MPI
      include 'mpif.h'   
#endif      
      type(request),target :: a_request
      type(request_sr),pointer :: Req
      type(hallo),pointer :: PtrHallo
      integer, dimension(mpi_size) :: TabRequest
#ifdef CPP_MPI
      integer, dimension(MPI_STATUS_SIZE,mpi_size) :: TabStatus
#else
      integer, dimension(1,mpi_size) :: TabStatus
#endif
      integer :: NbRequest
      integer :: i,rank,pos,ij,l,ierr
      integer :: offset
      
      
      nbrequest=0
      do rank=0,mpi_size-1
        req=>a_request%RequestSend(rank)
        if (req%NbRequest>0) then
          nbrequest=nbrequest+1
          tabrequest(nbrequest)=req%MSG_Request
        endif
      enddo
      

      if (nbrequest>0 .AND. req%BufferSize > 0 ) THEN 
!$OMP CRITICAL (MPI)     
!        PRINT *,"-------------------------------------------------------------------"
!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
!        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
#ifdef CPP_MPI
        call mpi_waitall(nbrequest,tabrequest,tabstatus,ierr)
#endif
!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
!        PRINT *,"-------------------------------------------------------------------"

!$OMP END CRITICAL (MPI)
      endif      
      
      do rank=0,mpi_size-1
        req=>a_request%RequestSend(rank)
        if (req%NbRequest>0) then
          call deallocate_buffer(req%Index)
          req%NbRequest=0 
        endif
      enddo
              
      a_request%tag=1
    end subroutine waitsendrequest
    
   subroutine waitrecvrequest(a_Request)
   USE dimensions_mod
   implicit none
   
#ifdef CPP_MPI
      include 'mpif.h'   
#endif
      
      type(request),target :: a_request
      type(request_sr),pointer :: Req
      type(hallo),pointer :: PtrHallo
      integer, dimension(mpi_size) :: TabRequest
#ifdef CPP_MPI
      integer, dimension(MPI_STATUS_SIZE,mpi_size) :: TabStatus
#else
      integer, dimension(1,mpi_size) :: TabStatus
#endif
      integer :: NbRequest
      integer :: i,rank,pos,ij,l,ierr
      integer :: offset,Nb
      
      
      nbrequest=0
      
      do rank=0,mpi_size-1
        req=>a_request%RequestRecv(rank)
        if (req%NbRequest>0 .AND. req%BufferSize > 0 ) then
          nbrequest=nbrequest+1
          tabrequest(nbrequest)=req%MSG_Request
        endif
      enddo
     
      
      if (nbrequest>0) then
!$OMP CRITICAL (MPI)     
!        PRINT *,"-------------------------------------------------------------------"
!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
!        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
#ifdef CPP_MPI
        call mpi_waitall(nbrequest,tabrequest,tabstatus,ierr)
#endif
!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
!        PRINT *,"-------------------------------------------------------------------"
!$OMP END CRITICAL (MPI)     
      endif
      
      do rank=0,mpi_size-1
        req=>a_request%RequestRecv(rank)
        if (req%NbRequest>0) then
          pos=req%Pos
          do i=1,req%NbRequest
            ptrhallo=>req%Hallo(i)
            offset=(ptrhallo%offset-1)*iip1+1
                    nb=iip1*ptrhallo%size-1
!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)            
                    do l=1,ptrhallo%NbLevel
!cdir NODEP
              do ij=0,nb
                        ptrhallo%Field(offset+ij,l)=buffer(pos+ij)
                      enddo
                 pos=pos+nb+1
            enddo
!$OMP END DO NOWAIT
          enddo
        endif
      enddo
      
           
      do rank=0,mpi_size-1
        req=>a_request%RequestRecv(rank)
        if (req%NbRequest>0) then
          call deallocate_buffer(req%Index)
          req%NbRequest=0 
        endif
      enddo
     
      a_request%tag=1
    end subroutine waitrecvrequest
    
    
    
    subroutine copyfield(FieldS,FieldR,ij,ll,jj_Nb_New)
    USE dimensions_mod
  
      implicit none
    
    INTEGER :: ij,ll,l
    REAL, dimension(ij,ll) :: FieldS
    REAL, dimension(ij,ll) :: FieldR
    integer,dimension(0:MPI_Size-1) :: jj_Nb_New   
    integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
    
    integer ::i,jje,jjb,ijb,ije
    
    jj_begin_new(0)=1
    jj_end_new(0)=jj_nb_new(0)
    do i=1,mpi_size-1
      jj_begin_new(i)=jj_end_new(i-1)+1
      jj_end_new(i)=jj_begin_new(i)+jj_nb_new(i)-1
    enddo
    
    jjb=max(jj_begin,jj_begin_new(mpi_rank))
    jje=min(jj_end,jj_end_new(mpi_rank))
    if (ij==ip1jm) jje=min(jje,jjm)

    if (jje >= jjb) then
      ijb=(jjb-1)*iip1+1
      ije=jje*iip1

!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
      do l=1,ll
        fieldr(ijb:ije,l)=fields(ijb:ije,l)
      enddo
!$OMP ENDDO NOWAIT
    endif


  end subroutine copyfield    

  subroutine copyfieldhallo(FieldS,FieldR,ij,ll,jj_Nb_New,Up,Down)
  USE dimensions_mod
  
      implicit none
    
    INTEGER :: ij,ll,Up,Down
    REAL, dimension(ij,ll) :: FieldS
    REAL, dimension(ij,ll) :: FieldR
    integer,dimension(0:MPI_Size-1) :: jj_Nb_New   
    integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New

    integer ::i,jje,jjb,ijb,ije,l

     
    jj_begin_new(0)=1
    jj_end_new(0)=jj_nb_new(0)
    do i=1,mpi_size-1
      jj_begin_new(i)=jj_end_new(i-1)+1
      jj_end_new(i)=jj_begin_new(i)+jj_nb_new(i)-1
    enddo

        
    jjb=max(jj_begin,jj_begin_new(mpi_rank)-up)
    jje=min(jj_end,jj_end_new(mpi_rank)+down)
    if (ij==ip1jm) jje=min(jje,jjm)
    
    
    if (jje >= jjb) then
      ijb=(jjb-1)*iip1+1
      ije=jje*iip1

!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
      do l=1,ll
        fieldr(ijb:ije,l)=fields(ijb:ije,l)
      enddo
!$OMP ENDDO NOWAIT

    endif
   end subroutine copyfieldhallo        

   subroutine gather_field_u(field_loc,field_glo,ll)
   USE dimensions_mod
   implicit none
     integer :: ll
     real :: field_loc(ijb_u:ije_u,ll)
     real :: field_glo(ip1jmp1,ll)
     type(request) :: request_gather
     integer       :: l


!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l=1,ll
       field_glo(ij_begin:ij_end,l)=field_loc(ij_begin:ij_end,l)
     ENDDO
     
     call register_swapfield(field_glo,field_glo,ip1jmp1,ll,distrib_gather%jj_nb_para,request_gather)
     call sendrequest(request_gather)
!$OMP BARRIER
     call waitrequest(request_gather)       
!$OMP BARRIER

    end subroutine gather_field_u
        
   subroutine gather_field_v(field_loc,field_glo,ll)
   USE dimensions_mod
   implicit none
     integer :: ll
     real :: field_loc(ijb_v:ije_v,ll)
     real :: field_glo(ip1jm,ll)
     type(request) :: request_gather
     integer :: ijb,ije
     integer       :: l
     
   
     ijb=ij_begin
     ije=ij_end
     if (pole_sud) ije=ij_end-iip1
        
!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l=1,ll
       field_glo(ijb:ije,l)=field_loc(ijb:ije,l)
     ENDDO
     
     call register_swapfield(field_glo,field_glo,ip1jm,ll,distrib_gather%jj_nb_para,request_gather)
     call sendrequest(request_gather)
!$OMP BARRIER
     call waitrequest(request_gather)       
!$OMP BARRIER

    end subroutine gather_field_v
     
   subroutine scatter_field_u(field_glo,field_loc,ll)
   USE dimensions_mod
   implicit none
     integer :: ll
     real :: field_glo(ip1jmp1,ll)
     real :: field_loc(ijb_u:ije_u,ll)
     type(request) :: request_gather
     TYPE(distrib) :: distrib_swap
     integer       :: l
     
!$OMP BARRIER
!$OMP MASTER     
     call get_current_distrib(distrib_swap)
     call set_distrib(distrib_gather)
!$OMP END MASTER
!$OMP BARRIER
 
     call register_swapfield(field_glo,field_glo,ip1jmp1,ll,distrib_swap%jj_nb_para,request_gather)
     call sendrequest(request_gather)
!$OMP BARRIER
     call waitrequest(request_gather)       
!$OMP BARRIER
!$OMP MASTER     
     call set_distrib(distrib_swap)
!$OMP END MASTER
!$OMP BARRIER

!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
       DO l=1,ll
         field_loc(ij_begin:ij_end,l)=field_glo(ij_begin:ij_end,l)
       ENDDO

    end subroutine scatter_field_u

   subroutine scatter_field_v(field_glo,field_loc,ll)
   USE dimensions_mod
   implicit none
     integer :: ll
     real :: field_glo(ip1jmp1,ll)
     real :: field_loc(ijb_v:ije_v,ll)
     type(request) :: request_gather
     TYPE(distrib) :: distrib_swap
     integer       :: ijb,ije,l
     

!$OMP BARRIER
!$OMP MASTER     
     call get_current_distrib(distrib_swap)
     call set_distrib(distrib_gather)
!$OMP END MASTER
!$OMP BARRIER
     call register_swapfield(field_glo,field_glo,ip1jm,ll,distrib_swap%jj_nb_para,request_gather)
     call sendrequest(request_gather)
!$OMP BARRIER
     call waitrequest(request_gather)       
!$OMP BARRIER
!$OMP MASTER
     call set_distrib(distrib_swap)
!$OMP END MASTER
!$OMP BARRIER
     ijb=ij_begin
     ije=ij_end
     if (pole_sud) ije=ij_end-iip1
     
!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
       DO l=1,ll
         field_loc(ijb:ije,l)=field_glo(ijb:ije,l)
       ENDDO

    end subroutine scatter_field_v
              
end module mod_hallo