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, &
            Register_SwapField1d_u_bis, Register_SwapField2d_u1d_bis, Register_SwapField3d_u_bis
  END INTERFACE Register_SwapField_u

  INTERFACE Register_SwapField_v
    MODULE PROCEDURE Register_SwapField1d_v, Register_SwapField2d_v1d, Register_SwapField3d_v, &
            Register_SwapField1d_v_bis, Register_SwapField2d_v1d_bis, Register_SwapField3d_v_bis
  END INTERFACE Register_SwapField_v

  INTERFACE Register_SwapField2d_u
    MODULE PROCEDURE Register_SwapField1d_u2d, Register_SwapField2d_u2d, Register_SwapField3d_u2d, &
            Register_SwapField1d_u2d_bis, Register_SwapField2d_u2d_bis, Register_SwapField3d_u2d_bis
  END INTERFACE Register_SwapField2d_u

  INTERFACE Register_SwapField2d_v
    MODULE PROCEDURE Register_SwapField1d_v2d, Register_SwapField2d_v2d, Register_SwapField3d_v2d, &
            Register_SwapField1d_v2d_bis, Register_SwapField2d_v2d_bis, Register_SwapField3d_v2d_bis
  END INTERFACE Register_SwapField2d_v

CONTAINS

  SUBROUTINE Init_mod_hallo
    USE lmdz_dimensions
    USE lmdz_paramet
    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
    USE lmdz_mpi
    IMPLICIT NONE
    POINTER (Pbuffer, MPI_Buffer(MaxBufferSize))
    REAL :: MPI_Buffer
    INTEGER(KIND = MPI_ADDRESS_KIND) :: BS
    INTEGER :: i, ierr

    !  Allocation du buffer MPI
    Bs = 8 * MaxBufferSize
    !$OMP CRITICAL (MPI)
    CALL MPI_ALLOC_MEM(BS, MPI_INFO_NULL, Pbuffer, ierr)
    !$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 !!!!'
      CALL abort_gcm("mod_hallo", "stopped", 1)
    endif

    IF (Index_pos>=ListSize) THEN
      print *, 'STOP :: La taille de ListSize dans mod_hallo.F90 est trop petite !!!!'
      CALL abort_gcm("mod_hallo", "stopped", 1)
    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 lmdz_dimensions
    USE lmdz_paramet
    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 lmdz_dimensions
    USE lmdz_paramet
    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 lmdz_dimensions
    USE lmdz_paramet
    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 lmdz_dimensions
    USE lmdz_paramet

    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, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    REAL, DIMENSION(current_dist%ijb_u:), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%ijb_u:), INTENT(OUT) :: FieldR
    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

    CALL  Register_SwapField_gen_u(FieldS, FieldR, 1, current_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField1d_u

  SUBROUTINE Register_SwapField1d_u_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    TYPE(distrib), INTENT(IN) :: old_dist
    REAL, DIMENSION(old_dist%ijb_u:), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%ijb_u:), INTENT(OUT) :: FieldR
    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

    CALL  Register_SwapField_gen_u(FieldS, FieldR, 1, old_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField1d_u_bis


  SUBROUTINE Register_SwapField2d_u1d(FieldS, FieldR, new_dist, a_request, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    REAL, DIMENSION(current_dist%ijb_u:, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%ijb_u:, :), INTENT(OUT) :: FieldR
    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)

    CALL  Register_SwapField_gen_u(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField2d_u1d

  SUBROUTINE Register_SwapField2d_u1d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    TYPE(distrib), INTENT(IN) :: old_dist
    REAL, DIMENSION(old_dist%ijb_u:, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%ijb_u:, :), INTENT(OUT) :: FieldR
    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)

    CALL  Register_SwapField_gen_u(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField2d_u1d_bis


  SUBROUTINE Register_SwapField3d_u(FieldS, FieldR, new_dist, a_request, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    REAL, DIMENSION(current_dist%ijb_u:, :, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%ijb_u:, :, :), INTENT(OUT) :: FieldR
    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)

    CALL  Register_SwapField_gen_u(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField3d_u

  SUBROUTINE Register_SwapField3d_u_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    TYPE(distrib), INTENT(IN) :: old_dist
    REAL, DIMENSION(old_dist%ijb_u:, :, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%ijb_u:, :, :), INTENT(OUT) :: FieldR
    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)

    CALL  Register_SwapField_gen_u(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField3d_u_bis


  SUBROUTINE Register_SwapField1d_u2d(FieldS, FieldR, new_dist, a_request, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet

    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist !LF
    REAL, DIMENSION(current_dist%jjb_u:, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%jjb_u:, :), INTENT(OUT) :: FieldR
    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

    CALL  Register_SwapField_gen_u(FieldS, FieldR, 1, current_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField1d_u2d

  SUBROUTINE Register_SwapField1d_u2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet

    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist !LF
    TYPE(distrib), INTENT(IN) :: old_dist
    REAL, DIMENSION(old_dist%jjb_u:, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%jjb_u:, :), INTENT(OUT) :: FieldR
    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

    CALL  Register_SwapField_gen_u(FieldS, FieldR, 1, old_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField1d_u2d_bis


  SUBROUTINE Register_SwapField2d_u2d(FieldS, FieldR, new_dist, a_request, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet

    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    REAL, DIMENSION(current_dist%jjb_u:, :, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%jjb_u:, :, :), INTENT(OUT) :: FieldR
    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)

    CALL  Register_SwapField_gen_u(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField2d_u2d

  SUBROUTINE Register_SwapField2d_u2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet

    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    TYPE(distrib), INTENT(IN) :: old_dist
    REAL, DIMENSION(old_dist%jjb_u:, :, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%jjb_u:, :, :), INTENT(OUT) :: FieldR
    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)

    CALL  Register_SwapField_gen_u(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField2d_u2d_bis


  SUBROUTINE Register_SwapField3d_u2d(FieldS, FieldR, new_dist, a_request, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    REAL, DIMENSION(current_dist%jjb_u:, :, :, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%jjb_u:, :, :, :), INTENT(OUT) :: FieldR
    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)

    CALL  Register_SwapField_gen_u(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField3d_u2d

  SUBROUTINE Register_SwapField3d_u2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    TYPE(distrib), INTENT(IN) :: old_dist
    REAL, DIMENSION(old_dist%jjb_u:, :, :, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%jjb_u:, :, :, :), INTENT(OUT) :: FieldR
    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)

    CALL  Register_SwapField_gen_u(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField3d_u2d_bis


  SUBROUTINE Register_SwapField1d_v(FieldS, FieldR, new_dist, a_request, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    REAL, DIMENSION(current_dist%ijb_v:), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%ijb_v:), INTENT(OUT) :: FieldR
    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

    CALL  Register_SwapField_gen_v(FieldS, FieldR, 1, current_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField1d_v

  SUBROUTINE Register_SwapField1d_v_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    TYPE(distrib), INTENT(IN) :: old_dist
    REAL, DIMENSION(old_dist%ijb_v:), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%ijb_v:), INTENT(OUT) :: FieldR
    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

    CALL  Register_SwapField_gen_v(FieldS, FieldR, 1, old_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField1d_v_bis


  SUBROUTINE Register_SwapField2d_v1d(FieldS, FieldR, new_dist, a_request, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    REAL, DIMENSION(current_dist%ijb_v:, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%ijb_v:, :), INTENT(OUT) :: FieldR
    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)

    CALL  Register_SwapField_gen_v(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField2d_v1d

  SUBROUTINE Register_SwapField2d_v1d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    TYPE(distrib), INTENT(IN) :: old_dist
    REAL, DIMENSION(old_dist%ijb_v:, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%ijb_v:, :), INTENT(OUT) :: FieldR
    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)

    CALL  Register_SwapField_gen_v(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField2d_v1d_bis


  SUBROUTINE Register_SwapField3d_v(FieldS, FieldR, new_dist, a_request, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    REAL, DIMENSION(current_dist%ijb_v:, :, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%ijb_v:, :, :), INTENT(OUT) :: FieldR
    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)

    CALL  Register_SwapField_gen_v(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField3d_v

  SUBROUTINE Register_SwapField3d_v_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    TYPE(distrib), INTENT(IN) :: old_dist
    REAL, DIMENSION(old_dist%ijb_v:, :, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%ijb_v:, :, :), INTENT(OUT) :: FieldR
    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)

    CALL  Register_SwapField_gen_v(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField3d_v_bis


  SUBROUTINE Register_SwapField1d_v2d(FieldS, FieldR, new_dist, a_request, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist !LF
    REAL, DIMENSION(current_dist%jjb_v:, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%jjb_v:, :), INTENT(OUT) :: FieldR
    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

    CALL  Register_SwapField_gen_v(FieldS, FieldR, 1, current_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField1d_v2d

  SUBROUTINE Register_SwapField1d_v2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist !LF
    TYPE(distrib), INTENT(IN) :: old_dist
    REAL, DIMENSION(old_dist%jjb_v:, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%jjb_v:, :), INTENT(OUT) :: FieldR
    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

    CALL  Register_SwapField_gen_v(FieldS, FieldR, 1, old_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField1d_v2d_bis


  SUBROUTINE Register_SwapField2d_v2d(FieldS, FieldR, new_dist, a_request, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    REAL, DIMENSION(current_dist%jjb_v:, :, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%jjb_v:, :, :), INTENT(OUT) :: FieldR
    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)

    CALL  Register_SwapField_gen_v(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField2d_v2d

  SUBROUTINE Register_SwapField2d_v2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    TYPE(distrib), INTENT(IN) :: old_dist
    REAL, DIMENSION(old_dist%jjb_v:, :, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%jjb_v:, :, :), INTENT(OUT) :: FieldR
    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)

    CALL  Register_SwapField_gen_v(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField2d_v2d_bis


  SUBROUTINE Register_SwapField3d_v2d(FieldS, FieldR, new_dist, a_request, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    REAL, DIMENSION(current_dist%jjb_v:, :, :, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%jjb_v:, :, :, :), INTENT(OUT) :: FieldR
    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)

    CALL  Register_SwapField_gen_v(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField3d_v2d

  SUBROUTINE Register_SwapField3d_v2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    TYPE(distrib), INTENT(IN) :: new_dist
    TYPE(distrib), INTENT(IN) :: old_dist
    REAL, DIMENSION(old_dist%jjb_v:, :, :, :), INTENT(IN) :: FieldS
    REAL, DIMENSION(new_dist%jjb_v:, :, :, :), INTENT(OUT) :: FieldR
    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)

    CALL  Register_SwapField_gen_v(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)

  END SUBROUTINE  Register_SwapField3d_v2d_bis


  SUBROUTINE Register_SwapField_gen_u(FieldS, FieldR, ll, old_dist, new_dist, Up, Down, a_request)
    USE parallel_lmdz
    USE lmdz_dimensions
    USE lmdz_paramet
    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 lmdz_dimensions
    USE lmdz_paramet
    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 lmdz_dimensions
    USE lmdz_paramet
    USE lmdz_mpi
    IMPLICIT NONE

    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==0) THEN
      SendUp = .FALSE.
    endif

    IF (Sdown==0) THEN
      SendDown = .FALSE.
    endif

    IF (Rup==0) THEN
      RecvUp = .FALSE.
    endif

    IF (Rdown==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 lmdz_dimensions
    USE lmdz_paramet
    USE lmdz_mpi
    IMPLICIT NONE
    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==0) THEN
      SendUp = .FALSE.
    endif

    IF (Sdown==0) THEN
      SendDown = .FALSE.
    endif

    IF (Rup==0) THEN
      RecvUp = .FALSE.
    endif

    IF (Rdown==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 lmdz_dimensions
    USE lmdz_paramet
    USE lmdz_mpi
    IMPLICIT NONE
    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==0) THEN
      SendUp = .FALSE.
    endif

    IF (Sdown==0) THEN
      SendDown = .FALSE.
    endif

    IF (Rup==0) THEN
      RecvUp = .FALSE.
    endif

    IF (Rdown==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 lmdz_dimensions
    USE lmdz_paramet
    USE lmdz_mpi
    IMPLICIT NONE

    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)

          CALL MPI_ISEND(Buffer(req%Pos), SizeBuffer, MPI_REAL_LMDZ, rank, a_request%tag + 1000 * omp_rank, &
                  COMM_LMDZ, Req%MSG_Request, ierr)
          IF (.NOT.using_mpi) THEN
            PRINT *, 'Erreur, echange MPI en mode sequentiel !!!'
            CALL abort_gcm("mod_hallo", "stopped", 1)
          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)

          CALL MPI_IRECV(Buffer(Req%Pos), SizeBuffer, MPI_REAL_LMDZ, rank, a_request%tag + 1000 * omp_rank, &
                  COMM_LMDZ, Req%MSG_Request, ierr)

          IF (.NOT.using_mpi) THEN
            PRINT *, 'Erreur, echange MPI en mode sequentiel !!!'
            CALL abort_gcm("mod_hallo", "stopped", 1)
          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 lmdz_dimensions
    USE lmdz_paramet
    USE lmdz_mpi
    IMPLICIT NONE

    type(request), target :: a_request
    type(request_SR), pointer :: Req
    type(Hallo), pointer :: PtrHallo
    INTEGER, DIMENSION(2 * mpi_size) :: TabRequest
    INTEGER, DIMENSION(MPI_STATUS_SIZE, 2 * mpi_size) :: TabStatus
    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)
      CALL MPI_WAITALL(NbRequest, TabRequest, TabStatus, ierr)
      !        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 lmdz_mpi
    USE lmdz_dimensions
    USE lmdz_paramet
    IMPLICIT NONE

    type(request), target :: a_request
    type(request_SR), pointer :: Req
    type(Hallo), pointer :: PtrHallo
    INTEGER, DIMENSION(mpi_size) :: TabRequest
    INTEGER, DIMENSION(MPI_STATUS_SIZE, mpi_size) :: TabStatus
    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)
      CALL MPI_WAITALL(NbRequest, TabRequest, TabStatus, ierr)
      !        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 lmdz_dimensions
    USE lmdz_paramet
    USE lmdz_mpi
    IMPLICIT NONE
    type(request), target :: a_request
    type(request_SR), pointer :: Req
    type(Hallo), pointer :: PtrHallo
    INTEGER, DIMENSION(mpi_size) :: TabRequest
    INTEGER, DIMENSION(MPI_STATUS_SIZE, mpi_size) :: TabStatus
    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)
      CALL MPI_WAITALL(NbRequest, TabRequest, TabStatus, ierr)
      !        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 lmdz_dimensions
    USE lmdz_paramet

    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 lmdz_dimensions
    USE lmdz_paramet

    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 lmdz_dimensions
    USE lmdz_paramet
    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 lmdz_dimensions
    USE lmdz_paramet
    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 lmdz_dimensions
    USE lmdz_paramet
    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 lmdz_dimensions
    USE lmdz_paramet
    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