#if defined MULTI
#   define NAT_IN(k)                cd_nat(k)   
#   define SGN_IN(k)                psgn(k)
#   define F_SIZE(ptab)             kfld
#   define OPT_K(k)                 ,ipf
#   if defined DIM_2d
#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)                , INTENT(inout) ::   ptab(f)
#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
#      define K_SIZE(ptab)             1
#      define L_SIZE(ptab)             1
#   endif
#   if defined DIM_3d
#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D)                , INTENT(inout) ::   ptab(f)
#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
#      define L_SIZE(ptab)             1
#   endif
#   if defined DIM_4d
#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D)                , INTENT(inout) ::   ptab(f)
#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
#   endif
#else
#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
#   define NAT_IN(k)                cd_nat
#   define SGN_IN(k)                psgn
#   define F_SIZE(ptab)             1
#   define OPT_K(k)                 
#   if defined DIM_2d
#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
#      define K_SIZE(ptab)          1
#      define L_SIZE(ptab)          1
#   endif
#   if defined DIM_3d
#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
#      define K_SIZE(ptab)          SIZE(ptab,3)
#      define L_SIZE(ptab)          1
#   endif
#   if defined DIM_4d
#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
#      define K_SIZE(ptab)          SIZE(ptab,3)
#      define L_SIZE(ptab)          SIZE(ptab,4)
#   endif
#endif
      !!----------------------------------------------------------------------
      !!                  ***  routine mpp_lnk_bdy  ***
      !!
      !! ** Purpose :   Message passing management
      !!
      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries 
      !!      between processors following neighboring subdomains.
      !!            domain parameters
      !!                    nlci   : first dimension of the local subdomain
      !!                    nlcj   : second dimension of the local subdomain
      !!                    noea   : number for local neighboring processors 
      !!                    nowe   : number for local neighboring processors
      !!                    noso   : number for local neighboring processors
      !!                    nono   : number for local neighboring processors
      !!
      !! ** Action  :   ptab with update value at its periphery
      !!
      !!----------------------------------------------------------------------
#if defined MULTI
   SUBROUTINE ROUTINE_BDY( cdname, lsend, lrecv, ptab, cd_nat, psgn, kfld )
      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays
#else
   SUBROUTINE ROUTINE_BDY( cdname, lsend, lrecv, ptab, cd_nat, psgn       )
#endif
      CHARACTER(len=*)            , INTENT(in   ) ::   cdname        ! name of the calling subroutine
      ARRAY_TYPE(:,:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied
      CHARACTER(len=1)            , INTENT(in   ) ::   NAT_IN(:)     ! nature of array grid-points
      REAL(wp)                    , INTENT(in   ) ::   SGN_IN(:)     ! sign used across the north fold boundary
      LOGICAL, DIMENSION(4)       , INTENT(in   ) ::   lsend, lrecv  ! communication with other 4 proc
      !
      INTEGER  ::   ji, jj, jk, jl, jh, jf     ! dummy loop indices
      INTEGER  ::   ipk, ipl, ipf              ! 3dimension of the input array
      INTEGER  ::   imigr, iihom, ijhom        ! local integers
      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
      LOGICAL  ::   llsend_we, llsend_ea, llsend_no, llsend_so       ! communication send
      LOGICAL  ::   llrecv_we, llrecv_ea, llrecv_no, llrecv_so       ! communication receive 
      !
      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zsend_no, zsend_so   ! 3d for north-south & south-north send
      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zsend_ea, zsend_we   ! 3d for east-west   & west-east   send
      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zrecv_no, zrecv_so   ! 3d for north-south & south-north receive
      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zrecv_ea, zrecv_we   ! 3d for east-west   & west-east   receive
      !!----------------------------------------------------------------------
      !
      ipk = K_SIZE(ptab)   ! 3rd dimension
      ipl = L_SIZE(ptab)   ! 4th    -
      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
      llsend_we = lsend(1);  llsend_ea = lsend(2);  llsend_so = lsend(3);  llsend_no = lsend(4);
      llrecv_we = lrecv(1);  llrecv_ea = lrecv(2);  llrecv_so = lrecv(3);  llrecv_no = lrecv(4);
      !
      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. )


      ! 1. standard boundary treatment
      ! ------------------------------
      ! Bdy treatment does not update land points
      DO jf = 1, ipf                   ! number of arrays to be treated
         IF( nbondi == 2 ) THEN                  ! neither subdomain to the east nor to the west
            !                                      !* Cyclic East-West boundaries
            IF( l_Iperio ) THEN
               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf)
            END IF
         END IF
         IF( nbondj == 2) THEN                  ! neither subdomain to the north nor to the south
            !                                      !* Cyclic North-South boundaries
            IF( l_Jperio ) THEN
               ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:,jpjm1,:,:,jf)
               ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:,  2  ,:,:,jf)
            END IF
         END IF
      END DO


      ! 2. East and west directions exchange
      ! ------------------------------------
      ! we play with the neigbours AND the row number because of the periodicity 
      !
      IF( llsend_we )   ALLOCATE( zsend_we(jpj,nn_hls,ipk,ipl,ipf) )
      IF( llsend_ea )   ALLOCATE( zsend_ea(jpj,nn_hls,ipk,ipl,ipf) )
      IF( llrecv_we )   ALLOCATE( zrecv_we(jpj,nn_hls,ipk,ipl,ipf) )
      IF( llrecv_ea )   ALLOCATE( zrecv_ea(jpj,nn_hls,ipk,ipl,ipf) )
      !
      ! Load arrays to the east and to the west to be sent
      IF( llsend_we )   THEN   ! Read Dirichlet lateral conditions
         DO jf = 1, ipf
            DO jl = 1, ipl
               DO jk = 1, ipk
                  DO jh = 1, nn_hls
                     zsend_we(:,jh,jk,jl,jf) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf)
                  END DO
               END DO
            END DO
         END DO
      END IF
      !
      IF( llsend_ea )   THEN   ! Read Dirichlet lateral conditions
         iihom = nlci-nreci
         DO jf = 1, ipf
            DO jl = 1, ipl
               DO jk = 1, ipk
                  DO jh = 1, nn_hls
                     zsend_ea(:,jh,jk,jl,jf) = ARRAY_IN(iihom +jh,:,jk,jl,jf)
                  END DO
               END DO
            END DO
         END DO
      END IF
      !
      ! Send/receive arrays to the east and to the west                            
      imigr = nn_hls * jpj * ipk * ipl * ipf   ! Migrations
      !
      IF( ln_timing ) CALL tic_tac(.TRUE.)
      !
      IF( llsend_ea )   CALL mppsend( 2, zsend_ea(1,1,1,1,1), imigr, noea, ml_req1 )
      IF( llsend_we )   CALL mppsend( 1, zsend_we(1,1,1,1,1), imigr, nowe, ml_req2 )
      !
      IF( llrecv_ea )   CALL mpprecv( 1, zrecv_ea(1,1,1,1,1), imigr, noea )
      IF( llrecv_we )   CALL mpprecv( 2, zrecv_we(1,1,1,1,1), imigr, nowe )
      !
      IF( l_isend .AND. llsend_ea ) CALL mpi_wait(ml_req1, ml_stat, ml_err)
      IF( l_isend .AND. llsend_we ) CALL mpi_wait(ml_req2, ml_stat, ml_err)
      !
      IF( ln_timing ) CALL tic_tac(.FALSE.)
      !
      !                           ! Write Dirichlet lateral conditions
      ! Update with the received arrays 
      IF( llrecv_we )   THEN
         DO jf = 1, ipf
            DO jl = 1, ipl
               DO jk = 1, ipk
                  DO jh = 1, nn_hls
                     ARRAY_IN(      jh,:,jk,jl,jf) = zrecv_we(:,jh,jk,jl,jf)
                  END DO
               END DO
            END DO
         END DO
      END IF
      !
      IF( llrecv_ea )   THEN
         iihom = nlci-nn_hls
         DO jf = 1, ipf
            DO jl = 1, ipl
               DO jk = 1, ipk
                  DO jh = 1, nn_hls
                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zrecv_ea(:,jh,jk,jl,jf)
                  END DO
               END DO
            END DO
         END DO
      END IF
      !
      ! Clean up
      IF( llsend_we )   DEALLOCATE( zsend_we )
      IF( llsend_ea )   DEALLOCATE( zsend_ea )
      IF( llrecv_we )   DEALLOCATE( zrecv_we )
      IF( llrecv_ea )   DEALLOCATE( zrecv_ea )

      ! 3. north fold treatment
      ! -----------------------
      !
      ! do it before south directions so concerned processes can do it without waiting for the comm with the sourthern neighbor
      IF( npolj /= 0) THEN
         !
         SELECT CASE ( jpni )
         CASE ( 1 )     ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! only 1 northern proc, no mpp
         CASE DEFAULT   ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! for all northern procs.
         END SELECT
         !
      ENDIF

      ! 4. North and south directions
      ! -----------------------------
      ! always closed : we play only with the neigbours
      !
      IF( llsend_so )   ALLOCATE( zsend_so(jpi,nn_hls,ipk,ipl,ipf) )
      IF( llsend_no )   ALLOCATE( zsend_no(jpi,nn_hls,ipk,ipl,ipf) )
      IF( llrecv_so )   ALLOCATE( zrecv_so(jpi,nn_hls,ipk,ipl,ipf) )
      IF( llrecv_no )   ALLOCATE( zrecv_no(jpi,nn_hls,ipk,ipl,ipf) )
      !
      ! Load arrays to the south and to the north to be sent
      IF( llsend_so )   THEN   ! Read Dirichlet lateral conditions
         DO jf = 1, ipf
            DO jl = 1, ipl
               DO jk = 1, ipk
                  DO jh = 1, nn_hls
                     zsend_so(:,jh,jk,jl,jf) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf)
                  END DO
               END DO
            END DO
         END DO
      END IF
      !
      IF( llsend_no )   THEN   ! Read Dirichlet lateral conditions
         ijhom = nlcj-nrecj
         DO jf = 1, ipf
            DO jl = 1, ipl
               DO jk = 1, ipk
                  DO jh = 1, nn_hls
                     zsend_no(:,jh,jk,jl,jf) = ARRAY_IN(:,ijhom +jh,jk,jl,jf)
                  END DO
               END DO
            END DO
         END DO
      END IF
      !
      ! Send/receive arrays to the south and to the north
      imigr = nn_hls * jpi * ipk * ipl * ipf   ! Migrations
      !
      IF( ln_timing ) CALL tic_tac(.TRUE.)
      ! 
      IF( llsend_no )   CALL mppsend( 4, zsend_no(1,1,1,1,1), imigr, nono, ml_req1 )
      IF( llsend_so )   CALL mppsend( 3, zsend_so(1,1,1,1,1), imigr, noso, ml_req2 )
      !
      IF( llrecv_no )   CALL mpprecv( 3, zrecv_no(1,1,1,1,1), imigr, nono )
      IF( llrecv_so )   CALL mpprecv( 4, zrecv_so(1,1,1,1,1), imigr, noso )
      !
      IF( l_isend .AND. llsend_no ) CALL mpi_wait(ml_req1, ml_stat, ml_err)
      IF( l_isend .AND. llsend_so ) CALL mpi_wait(ml_req2, ml_stat, ml_err)
      !
      IF( ln_timing ) CALL tic_tac(.FALSE.)
      !
      !                           ! Write Dirichlet lateral conditions
      ! Update with the received arrays 
      IF( llrecv_so )   THEN
         DO jf = 1, ipf
            DO jl = 1, ipl
               DO jk = 1, ipk
                  DO jh = 1, nn_hls
                     ARRAY_IN(:,      jh,jk,jl,jf) = zrecv_so(:,jh,jk,jl,jf)
                  END DO
               END DO
            END DO
         END DO
      END IF
      IF( llrecv_no )   THEN
         ijhom = nlcj-nn_hls
         DO jf = 1, ipf
            DO jl = 1, ipl
               DO jk = 1, ipk
                  DO jh = 1, nn_hls
                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zrecv_no(:,jh,jk,jl,jf)
                  END DO
               END DO
            END DO
         END DO
      END IF
      !
      ! Clean up
      IF( llsend_so )   DEALLOCATE( zsend_so )
      IF( llsend_no )   DEALLOCATE( zsend_no )
      IF( llrecv_so )   DEALLOCATE( zrecv_so )
      IF( llrecv_no )   DEALLOCATE( zrecv_no )
      !
   END SUBROUTINE ROUTINE_BDY

#undef ARRAY_TYPE
#undef NAT_IN
#undef SGN_IN
#undef ARRAY_IN
#undef K_SIZE
#undef L_SIZE
#undef F_SIZE
#undef OPT_K