Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90	(revision 8226)
@@ -69,5 +69,5 @@
       REAL(wp), POINTER, DIMENSION(:,:)   ::  zflu, zflv, zdiv
       !!-------------------------------------------------------------------
-      TYPE(arrayptr)   , ALLOCATABLE, DIMENSION(:) ::   pt2d_array, zrlx_array
+      TYPE(PTR_2D)   , ALLOCATABLE, DIMENSION(:) ::   pt2d_array, zrlx_array
       CHARACTER(len=1) , ALLOCATABLE, DIMENSION(:) ::   type_array      ! define the nature of ptab array grid-points
       !                                                                 ! = T , U , V , F , W and I points
@@ -156,5 +156,5 @@
          END DO
 
-         CALL lbc_lnk_multi( zrlx_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables
+         CALL lbc_lnk_ptr( zrlx_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables
          !
 
@@ -195,5 +195,5 @@
       END DO
 
-      CALL lbc_lnk_multi( pt2d_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables
+      CALL lbc_lnk_ptr( pt2d_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables
 
       !
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90	(revision 8226)
@@ -52,5 +52,5 @@
       !!-----------------------------------------------------------------------
       !
-      IF( Agrif_Root() )  RETURN
+      IF( Agrif_Root() .OR. nn_ice==0 )  RETURN   ! clem2017: do not interpolate if inside Parent domain or if child domain does not have ice
       !
       SELECT CASE(cd_type)
@@ -90,5 +90,5 @@
       !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
       !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points,
-      !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
+      !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
       !!-----------------------------------------------------------------------
       INTEGER , INTENT(in) :: i1, i2, j1, j2
@@ -101,8 +101,8 @@
       IF( before ) THEN  ! parent grid
          ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice_b(i1:i2,j1:j2)
-         WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
+         WHERE( umask(i1:i2,j1:j2,1) == 0. )   ptab(i1:i2,j1:j2) = Agrif_SpecialValue
       ELSE               ! child grid
          zrhoy = Agrif_Rhoy()
-         u_ice(i1:i2,j1:j2) = ptab(:,:) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1)
+         u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1)
       ENDIF
       !
@@ -116,5 +116,5 @@
       !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
       !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points,
-      !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
+      !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
       !!-----------------------------------------------------------------------      
       INTEGER , INTENT(in) :: i1, i2, j1, j2
@@ -127,8 +127,8 @@
       IF( before ) THEN  ! parent grid
          ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice_b(i1:i2,j1:j2)
-         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
+         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2) = Agrif_SpecialValue
       ELSE               ! child grid
          zrhox = Agrif_Rhox()
-         v_ice(i1:i2,j1:j2) = ptab(:,:) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1)
+         v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1)
       ENDIF
       !
@@ -142,5 +142,5 @@
       !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
       !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points,
-      !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
+      !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
       !!-----------------------------------------------------------------------
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
@@ -158,14 +158,15 @@
       ! tracers are not multiplied by grid cell here => before: * e12t ; after: * r1_e12t / rhox / rhoy
       ! and it is ok since we conserve tracers (same as in the ocean).
-      ALLOCATE( ztab(SIZE(a_i_b,1),SIZE(a_i_b,2),SIZE(ptab,3)) )
+      ALLOCATE( ztab(SIZE(a_i,1),SIZE(a_i,2),SIZE(ptab,3)) )
      
       IF( before ) THEN  ! parent grid
          jm = 1
          DO jl = 1, jpl
-            ptab(i1:i2,j1:j2,jm) = a_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1
-            ptab(i1:i2,j1:j2,jm) = v_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1
-            ptab(i1:i2,j1:j2,jm) = v_s_b  (i1:i2,j1:j2,jl) ; jm = jm + 1
-            ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl) ; jm = jm + 1
-            ptab(i1:i2,j1:j2,jm) = oa_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1
+            ptab(i1:i2,j1:j2,jm  ) = a_i_b  (i1:i2,j1:j2,jl)
+            ptab(i1:i2,j1:j2,jm+1) = v_i_b  (i1:i2,j1:j2,jl)
+            ptab(i1:i2,j1:j2,jm+2) = v_s_b  (i1:i2,j1:j2,jl)
+            ptab(i1:i2,j1:j2,jm+3) = smv_i_b(i1:i2,j1:j2,jl)
+            ptab(i1:i2,j1:j2,jm+4) = oa_i_b (i1:i2,j1:j2,jl)
+            jm = jm + 5
             DO jk = 1, nlay_s
                ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
@@ -177,140 +178,173 @@
          
          DO jk = k1, k2
-            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2,jk) = -9999.
+            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValue
          ENDDO
          
       ELSE               ! child grid
-!! ==> The easiest interpolation is the following commented lines
-         jm = 1
-         DO jl = 1, jpl
-            a_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            v_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            v_s  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            DO jk = 1, nlay_s
-               e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            ENDDO
-            DO jk = 1, nlay_i
-               e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            ENDDO
-         ENDDO
-
-!! ==> this is a more complex interpolation since we mix solutions over a couple of grid points
-!!     it is advised to use it for fields modified by high order schemes (e.g. advection UM5...)
-!!        clem: for some reason (I don't know why), the following lines do not work 
-!!              with mpp (or in realistic configurations?). It makes the model crash
-!         ! record ztab
-!         jm = 1
-!         DO jl = 1, jpl
-!            ztab(:,:,jm) = a_i  (:,:,jl) ; jm = jm + 1
-!            ztab(:,:,jm) = v_i  (:,:,jl) ; jm = jm + 1
-!            ztab(:,:,jm) = v_s  (:,:,jl) ; jm = jm + 1
-!            ztab(:,:,jm) = smv_i(:,:,jl) ; jm = jm + 1
-!            ztab(:,:,jm) = oa_i (:,:,jl) ; jm = jm + 1
-!            DO jk = 1, nlay_s
-!               ztab(:,:,jm) = e_s(:,:,jk,jl) ; jm = jm + 1
-!            ENDDO
-!            DO jk = 1, nlay_i
-!               ztab(:,:,jm) = e_i(:,:,jk,jl) ; jm = jm + 1
-!            ENDDO
-!         ENDDO
-!         !
-!         ! borders of the domain
-!         western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2)
-!         southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2)
-!         !
-!         ! spatial smoothing
-!         zrhox = Agrif_Rhox()
-!         z1 =      ( zrhox - 1. ) * 0.5 
-!         z3 =      ( zrhox - 1. ) / ( zrhox + 1. )
-!         z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
-!         z7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
-!         z2 = 1. - z1
-!         z4 = 1. - z3
-!         z5 = 1. - z6 - z7
-!         !
-!         ! Remove corners
-!         imin = i1  ;  imax = i2  ;  jmin = j1  ;  jmax = j2
-!         IF( (nbondj == -1) .OR. (nbondj == 2) )   jmin = 3
-!         IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = nlcj-2
-!         IF( (nbondi == -1) .OR. (nbondi == 2) )   imin = 3
-!         IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = nlci-2
-!
-!         ! smoothed fields
-!         IF( eastern_side ) THEN
-!            ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:)
-!            DO jj = jmin, jmax
-!               rswitch = 0.
-!               IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1.
-!               ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:)  &
-!                  &                +      umask(nlci-2,jj,1)   *  &
-!                  &                ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:)   + z3 * ztab(nlci-2,jj,:) )  &
-!                  &                  +      rswitch   * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) )
-!               ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1)
-!            END DO
-!         ENDIF
-!         ! 
-!         IF( northern_side ) THEN
-!            ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:)
-!            DO ji = imin, imax
-!               rswitch = 0.
-!               IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1.
-!               ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:)  &
-!                  &                +      vmask(ji,nlcj-2,1)   *  &
-!                  &                ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:)   + z3 * ztab(ji,nlcj-2,:) ) &
-!                  &                  +      rswitch   * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) )
-!               ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1)
-!            END DO
-!         END IF
-!         !
-!         IF( western_side) THEN
-!            ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:)
-!            DO jj = jmin, jmax
-!               rswitch = 0.
-!               IF( u_ice(2,jj) < 0._wp ) rswitch = 1.
-!               ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:)  &
-!                  &           +      umask(2,jj,1)   *   &
-!                  &           ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) &
-!                  &             +      rswitch   * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) )
-!               ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1)
-!            END DO
-!         ENDIF
-!         !
-!         IF( southern_side ) THEN
-!            ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:)
-!            DO ji = imin, imax
-!               rswitch = 0.
-!               IF( v_ice(ji,2) < 0._wp ) rswitch = 1.
-!               ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:)  &
-!                  &           +      vmask(ji,2,1)   *  &
-!                  &           ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) &
-!                  &             +      rswitch   * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) )
-!               ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1)
-!            END DO
-!         END IF
-!         !
-!         ! Treatment of corners
-!         IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(nlci-1,2,:)      = ptab(nlci-1,2,:)      ! East south
-!         IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north
-!         IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(2,2,:)           = ptab(2,2,:)           ! West south
-!         IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(2,nlcj-1,:)      = ptab(2,nlcj-1,:)      ! West north
-!
-!         ! retrieve ice tracers
-!         jm = 1
-!         DO jl = 1, jpl
-!            a_i  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
-!            v_i  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
-!            v_s  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
-!            smv_i(i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
-!            oa_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
-!            DO jk = 1, nlay_s
-!               e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
-!            ENDDO
-!            DO jk = 1, nlay_i
-!               e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
-!            ENDDO
-!         ENDDO
-       
+
+         IF( nbghostcells > 1 ) THEN
+            !! ==> The easiest interpolation is the following lines
+
+            jm = 1
+            DO jl = 1, jpl
+               !
+               DO jj = j1, j2
+                  DO ji = i1, i2
+                     a_i  (ji,jj,jl) = ptab(ji,jj,jm  ) * tmask(ji,jj,1)
+                     v_i  (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1)
+                     v_s  (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1)
+                     smv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1)
+                     oa_i (ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1)
+                  ENDDO
+               ENDDO
+               jm = jm + 5
+               !
+               DO jk = 1, nlay_s
+                  e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)
+                  jm = jm + 1
+               ENDDO
+               !
+               DO jk = 1, nlay_i
+                  e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)
+                  jm = jm + 1
+               ENDDO
+               !
+            ENDDO
+            
+         ELSE
+            !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points
+            !!     it is advised to use it for fields modified by high order schemes (e.g. advection UM5...)
+            !!        clem: for some reason (I don't know why), the following lines do not work 
+            !!              with mpp (or in realistic configurations?). It makes the model crash
+            !      I think there is an issue with Agrif_SpecialValue here (not taken into account properly)
+            ! record ztab
+            jm = 1
+            DO jl = 1, jpl
+               ztab(:,:,jm  ) = a_i  (:,:,jl)
+               ztab(:,:,jm+1) = v_i  (:,:,jl)
+               ztab(:,:,jm+2) = v_s  (:,:,jl)
+               ztab(:,:,jm+3) = smv_i(:,:,jl)
+               ztab(:,:,jm+4) = oa_i (:,:,jl)
+               jm = jm + 5
+               DO jk = 1, nlay_s
+                  ztab(:,:,jm) = e_s(:,:,jk,jl)
+                  jm = jm + 1
+               ENDDO
+               DO jk = 1, nlay_i
+                  ztab(:,:,jm) = e_i(:,:,jk,jl)
+                  jm = jm + 1
+               ENDDO
+               !
+            ENDDO
+            !
+            ! borders of the domain
+            western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2)
+            southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2)
+            !
+            ! spatial smoothing
+            zrhox = Agrif_Rhox()
+            z1 =      ( zrhox - 1. ) * 0.5 
+            z3 =      ( zrhox - 1. ) / ( zrhox + 1. )
+            z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+            z7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
+            z2 = 1. - z1
+            z4 = 1. - z3
+            z5 = 1. - z6 - z7
+            !
+            ! Remove corners
+            imin = i1  ;  imax = i2  ;  jmin = j1  ;  jmax = j2
+            IF( (nbondj == -1) .OR. (nbondj == 2) )   jmin = 3
+            IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = nlcj-2
+            IF( (nbondi == -1) .OR. (nbondi == 2) )   imin = 3
+            IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = nlci-2
+
+            ! smoothed fields
+            IF( eastern_side ) THEN
+               ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:)
+               DO jj = jmin, jmax
+                  rswitch = 0.
+                  IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1.
+                  ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:)  &
+                     &                +      umask(nlci-2,jj,1)   *  &
+                     &                ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:)   + z3 * ztab(nlci-2,jj,:) )  &
+                     &                  +      rswitch   * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) )
+                  ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1)
+               END DO
+            ENDIF
+            ! 
+            IF( northern_side ) THEN
+               ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:)
+               DO ji = imin, imax
+                  rswitch = 0.
+                  IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1.
+                  ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:)  &
+                     &                +      vmask(ji,nlcj-2,1)   *  &
+                     &                ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:)   + z3 * ztab(ji,nlcj-2,:) ) &
+                     &                  +      rswitch   * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) )
+                  ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1)
+               END DO
+            END IF
+            !
+            IF( western_side) THEN
+               ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:)
+               DO jj = jmin, jmax
+                  rswitch = 0.
+                  IF( u_ice(2,jj) < 0._wp ) rswitch = 1.
+                  ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:)  &
+                     &           +      umask(2,jj,1)   *   &
+                     &           ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) &
+                     &             +      rswitch   * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) )
+                  ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1)
+               END DO
+            ENDIF
+            !
+            IF( southern_side ) THEN
+               ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:)
+               DO ji = imin, imax
+                  rswitch = 0.
+                  IF( v_ice(ji,2) < 0._wp ) rswitch = 1.
+                  ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:)  &
+                     &           +      vmask(ji,2,1)   *  &
+                     &           ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) &
+                     &             +      rswitch   * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) )
+                  ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1)
+               END DO
+            END IF
+            !
+            ! Treatment of corners
+            IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(nlci-1,2,:)      = ptab(nlci-1,2,:)      ! East south
+            IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north
+            IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(2,2,:)           = ptab(2,2,:)           ! West south
+            IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(2,nlcj-1,:)      = ptab(2,nlcj-1,:)      ! West north
+            
+            ! retrieve ice tracers
+            jm = 1
+            DO jl = 1, jpl
+               !
+               DO jj = j1, j2
+                  DO ji = i1, i2
+                     a_i  (ji,jj,jl) = ztab(ji,jj,jm  ) * tmask(ji,jj,1)
+                     v_i  (ji,jj,jl) = ztab(ji,jj,jm+1) * tmask(ji,jj,1)
+                     v_s  (ji,jj,jl) = ztab(ji,jj,jm+2) * tmask(ji,jj,1)
+                     smv_i(ji,jj,jl) = ztab(ji,jj,jm+3) * tmask(ji,jj,1)
+                     oa_i (ji,jj,jl) = ztab(ji,jj,jm+4) * tmask(ji,jj,1)
+                  ENDDO
+               ENDDO
+               jm = jm + 5
+               !
+               DO jk = 1, nlay_s
+                  e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
+                  jm = jm + 1
+               ENDDO
+               !
+               DO jk = 1, nlay_i
+                  e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
+                  jm = jm + 1
+               ENDDO
+               !
+            ENDDO
+          
+         ENDIF  ! nbghostcells=1
+         
          ! integrated values
          vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 )
@@ -319,8 +353,9 @@
          et_s(i1:i2,j1:j2)  = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 )
          et_i(i1:i2,j1:j2)  = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 )
-
+         
       ENDIF
+
+      DEALLOCATE( ztab )
       
-      DEALLOCATE( ztab )
       !
    END SUBROUTINE interp_tra_ice
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90	(revision 8226)
@@ -56,6 +56,8 @@
       IF( ( MOD( (kt-nit000)/nn_fsbc + 1, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) /=0 ) .AND. (kt /= 0) ) RETURN ! do not update if nb of child time steps differ from time refinement
                                                                                                                            ! i.e. update only at the parent time step
+      IF( nn_ice == 0 ) RETURN   ! clem2017: do not update if child domain does not have ice
+      !
+      Agrif_SpecialValueFineGrid = -9999.
       Agrif_UseSpecialValueInUpdate = .TRUE.
-      Agrif_SpecialValueFineGrid = -9999.
 # if defined TWO_WAY
       IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps
@@ -70,4 +72,5 @@
       ENDIF
 # endif
+      Agrif_SpecialValueFineGrid = 0.
       Agrif_UseSpecialValueInUpdate = .FALSE.
       !
@@ -88,5 +91,5 @@
       LOGICAL , INTENT(in) :: before
       !!
-      INTEGER  :: jk, jl, jm
+      INTEGER  :: ji, jj, jk, jl, jm
       !!-----------------------------------------------------------------------
       ! it is ok not to multiply by e1*e2 since we conserve tracers here (same as in the ocean).
@@ -94,37 +97,56 @@
          jm = 1
          DO jl = 1, jpl
-            ptab(:,:,jm) = a_i  (i1:i2,j1:j2,jl) ; jm = jm + 1
-            ptab(:,:,jm) = v_i  (i1:i2,j1:j2,jl) ; jm = jm + 1
-            ptab(:,:,jm) = v_s  (i1:i2,j1:j2,jl) ; jm = jm + 1
-            ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl) ; jm = jm + 1
-            ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl) ; jm = jm + 1
+            ptab(i1:i2,j1:j2,jm  ) = a_i  (i1:i2,j1:j2,jl)
+            ptab(i1:i2,j1:j2,jm+1) = v_i  (i1:i2,j1:j2,jl)
+            ptab(i1:i2,j1:j2,jm+2) = v_s  (i1:i2,j1:j2,jl)
+            ptab(i1:i2,j1:j2,jm+3) = smv_i(i1:i2,j1:j2,jl)
+            ptab(i1:i2,j1:j2,jm+4) = oa_i (i1:i2,j1:j2,jl)
+            jm = jm + 5
             DO jk = 1, nlay_s
-               ptab(:,:,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
+               ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
             ENDDO
             DO jk = 1, nlay_i
-               ptab(:,:,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
+               ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
             ENDDO
          ENDDO
-
+         !
          DO jk = k1, k2
-            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:,jk) = -9999.
+            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValueFineGrid 
          ENDDO
-                  
+         !
       ELSE
+         !
          jm = 1
          DO jl = 1, jpl
-            a_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            v_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            v_s  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            !
+            DO jj = j1, j2
+               DO ji = i1, i2
+                  IF( ptab(ji,jj,jm) /= Agrif_SpecialValueFineGrid ) THEN
+                     a_i  (ji,jj,jl) = ptab(ji,jj,jm  ) * tmask(ji,jj,1)
+                     v_i  (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1)
+                     v_s  (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1)
+                     smv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1)
+                     oa_i (ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1)
+                  ENDIF
+               ENDDO
+            ENDDO
+            jm = jm + 5
+            !
             DO jk = 1, nlay_s
-               e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            ENDDO
+               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid )
+                  e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
+               ENDWHERE
+               jm = jm + 1
+            ENDDO
+            !
             DO jk = 1, nlay_i
-               e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
-            ENDDO
+               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid )
+                  e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
+               ENDWHERE
+               jm = jm + 1
+            ENDDO
+            !
          ENDDO
-
+         !
          ! integrated values
          vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 )
@@ -154,7 +176,9 @@
          zrhoy = Agrif_Rhoy()
          ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy
-         WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
+         WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = Agrif_SpecialValueFineGrid
       ELSE
-         u_ice(i1:i2,j1:j2) = ptab(:,:) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1)
+         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid )
+            u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1)
+         ENDWHERE
       ENDIF
       ! 
@@ -177,7 +201,9 @@
          zrhox = Agrif_Rhox()
          ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox
-         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
+         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = Agrif_SpecialValueFineGrid
       ELSE
-         v_ice(i1:i2,j1:j2) = ptab(:,:) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1)
+         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid )
+            v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1)
+         ENDWHERE
       ENDIF
       !
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 8226)
@@ -35,5 +35,5 @@
    PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts
    PUBLIC   interpun, interpvn
-   PUBLIC   interptsn,  interpsshn
+   PUBLIC   interptsn, interpsshn
    PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b
    PUBLIC   interpe3t, interpumsk, interpvmsk
@@ -100,277 +100,251 @@
       IF( nbondi == +1 .OR. nbondi == 2 )   i2 = nlci-2
 
+      ! --- West --- !
       IF( nbondi == -1 .OR. nbondi == 2 ) THEN
          !
-         ! Smoothing
-         ! ---------
          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
-            ua_b(2,:) = 0._wp
+            ua_b(2:1+nbghostcells,:) = 0._wp
             DO jk = 1, jpkm1
                DO jj = 1, jpj
-                  ua_b(2,jj) = ua_b(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk)
+                  ua_b(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) + e3u_a(2:1+nbghostcells,jj,jk) * ua(2:1+nbghostcells,jj,jk)
                END DO
             END DO
             DO jj = 1, jpj
-               ua_b(2,jj) = ua_b(2,jj) * r1_hu_a(2,jj)            
-            END DO
-         ENDIF
-         !
-         DO jk=1,jpkm1                 ! Smooth
-            DO jj=j1,j2
-               ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk))
-               ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk)
-            END DO
-         END DO
-         !
-         zub(2,:) = 0._wp              ! Correct transport
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk)
-            END DO
-         END DO
-         DO jj=1,jpj
-            zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj)
-         END DO
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk)
-            END DO
-         END DO
-
-         ! Set tangential velocities to time splitting estimate
-         !-----------------------------------------------------
-         IF( ln_dynspg_ts ) THEN
-            zvb(2,:) = 0._wp
+               ua_b(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) * r1_hu_a(2:1+nbghostcells,jj)
+            END DO
+         ENDIF
+         !
+         ! Smoothing if only 1 ghostcell
+         ! -----------------------------
+         IF( nbghostcells == 1 ) THEN
+            DO jk=1,jpkm1                 ! Smooth
+               DO jj=j1,j2
+                  ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk))
+                  ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk)
+               END DO
+            END DO
+            !
+            zub(2,:) = 0._wp              ! Correct transport
             DO jk = 1, jpkm1
                DO jj = 1, jpj
-                  zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk)
-               END DO
-            END DO
-            DO jj = 1, jpj
-               zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj)
-            END DO
+                  zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk)
+               END DO
+            END DO
+            DO jj=1,jpj
+               zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj)
+            END DO
+            
+            DO jk=1,jpkm1
+               DO jj=1,jpj
+                  ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk)
+               END DO
+            END DO
+            
+            IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
+               zvb(2,:) = 0._wp
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk)
+                  END DO
+               END DO
+               DO jj = 1, jpj
+                  zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj)
+               END DO
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk)
+                  END DO
+               END DO
+            ENDIF
+            !
+         ENDIF
+         !
+      ENDIF
+
+      ! --- East --- !
+      IF( nbondi == 1 .OR. nbondi == 2 ) THEN
+
+         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+            ua_b(nlci-nbghostcells-1:nlci-2,:) = 0._wp
+            DO jk=1,jpkm1
+               DO jj=1,jpj
+                  ua_b(nlci-nbghostcells-1:nlci-2,jj) = ua_b(nlci-nbghostcells-1:nlci-2,jj) + e3u_a(nlci-nbghostcells-1:nlci-2,jj,jk)  &
+                     &                                                                         * ua(nlci-nbghostcells-1:nlci-2,jj,jk)
+               END DO
+            END DO
+            DO jj=1,jpj
+               ua_b(nlci-nbghostcells-1:nlci-2,jj) = ua_b(nlci-nbghostcells-1:nlci-2,jj) * r1_hu_a(nlci-nbghostcells-1:nlci-2,jj) 
+            END DO
+         ENDIF
+         !
+         ! Smoothing if only 1 ghostcell
+         ! -----------------------------
+         IF( nbghostcells == 1 ) THEN
+            DO jk = 1, jpkm1              ! Smooth
+               DO jj = j1, j2
+                  ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      &
+                     &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) )
+               END DO
+            END DO
+            
+            zub(nlci-2,:) = 0._wp        ! Correct transport
             DO jk = 1, jpkm1
                DO jj = 1, jpj
-                  va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk)
-               END DO
-            END DO
-         ENDIF
-         !
-         ! Mask domain edges:
-         !-------------------
-         DO jk = 1, jpkm1
+                  zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk)
+               END DO
+            END DO
             DO jj = 1, jpj
-               ua(1,jj,jk) = 0._wp
-               va(1,jj,jk) = 0._wp
-            END DO
-         END DO         
-         !
-      ENDIF
-
-      IF( nbondi == 1 .OR. nbondi == 2 ) THEN
-
-         ! Smoothing
-         ! ---------
-         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
-            ua_b(nlci-2,:) = 0._wp
-            DO jk=1,jpkm1
-               DO jj=1,jpj
-                  ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk)
-               END DO
-            END DO
-            DO jj=1,jpj
-               ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * r1_hu_a(nlci-2,jj)            
-            END DO
-         ENDIF
-
-         DO jk = 1, jpkm1              ! Smooth
-            DO jj = j1, j2
-               ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      &
-                  &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) )
-            END DO
-         END DO
-
-         zub(nlci-2,:) = 0._wp        ! Correct transport
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk)
-            END DO
-         END DO
-         DO jj = 1, jpj
-            zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj)
-         END DO
-
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk)
-            END DO
-         END DO
-         !
-         ! Set tangential velocities to time splitting estimate
-         !-----------------------------------------------------
-         IF( ln_dynspg_ts ) THEN
-            zvb(nlci-1,:) = 0._wp
+               zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj)
+            END DO
+            
             DO jk = 1, jpkm1
                DO jj = 1, jpj
-                  zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk)
-               END DO
-            END DO
-            DO jj=1,jpj
-               zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj)
-            END DO
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk)
-               END DO
-            END DO
-         ENDIF
-         !
-         ! Mask domain edges:
-         !-------------------
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               ua(nlci-1,jj,jk) = 0._wp
-               va(nlci  ,jj,jk) = 0._wp
-            END DO
-         END DO 
-         !
-      ENDIF
-
+                  ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk)
+               END DO
+            END DO
+            !
+            IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
+               zvb(nlci-1,:) = 0._wp
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk)
+                  END DO
+               END DO
+               DO jj=1,jpj
+                  zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj)
+               END DO
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk)
+                  END DO
+               END DO
+            ENDIF
+            !
+         ENDIF
+         !
+      ENDIF
+
+      ! --- South --- !
       IF( nbondj == -1 .OR. nbondj == 2 ) THEN
 
-         ! Smoothing
-         ! ---------
          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
-            va_b(:,2) = 0._wp
+            va_b(:,2:nbghostcells+1) = 0._wp
             DO jk = 1, jpkm1
                DO ji = 1, jpi
-                  va_b(ji,2) = va_b(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk)
+                  va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) + e3v_a(ji,2:nbghostcells+1,jk) * va(ji,2:nbghostcells+1,jk)
                END DO
             END DO
             DO ji=1,jpi
-               va_b(ji,2) = va_b(ji,2) * r1_hv_a(ji,2)            
-            END DO
-         ENDIF
-         !
-         DO jk = 1, jpkm1              ! Smooth
-            DO ji = i1, i2
-               va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    &
-                  &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) )
-            END DO
-         END DO
-         !
-         zvb(:,2) = 0._wp              ! Correct transport
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk)
-            END DO
-         END DO
-         DO ji = 1, jpi
-            zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2)
-         END DO
-         DO jk = 1, jpkm1
+               va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) * r1_hv_a(ji,2:nbghostcells+1)
+            END DO
+         ENDIF
+         !
+         ! Smoothing if only 1 ghostcell
+         ! -----------------------------
+         IF( nbghostcells == 1 ) THEN
+            DO jk = 1, jpkm1              ! Smooth
+               DO ji = i1, i2
+                  va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    &
+                     &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) )
+               END DO
+            END DO
+            !
+            zvb(:,2) = 0._wp              ! Correct transport
+            DO jk=1,jpkm1
+               DO ji=1,jpi
+                  zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk)
+               END DO
+            END DO
             DO ji = 1, jpi
-               va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk)
-            END DO
-         END DO
-
-         ! Set tangential velocities to time splitting estimate
-         !-----------------------------------------------------
-         IF( ln_dynspg_ts ) THEN
-            zub(:,2) = 0._wp
+               zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2)
+            END DO
             DO jk = 1, jpkm1
                DO ji = 1, jpi
-                  zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk)
-               END DO
-            END DO
-            DO ji = 1, jpi
-               zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2)
-            END DO
-
+                  va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk)
+               END DO
+            END DO
+            
+            IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
+               zub(:,2) = 0._wp
+               DO jk = 1, jpkm1
+                  DO ji = 1, jpi
+                     zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk)
+                  END DO
+               END DO
+               DO ji = 1, jpi
+                  zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2)
+               END DO
+               
+               DO jk = 1, jpkm1
+                  DO ji = 1, jpi
+                     ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk)
+                  END DO
+               END DO
+            ENDIF
+            !
+         ENDIF
+         !
+      ENDIF
+
+      ! --- North --- !
+      IF( nbondj == 1 .OR. nbondj == 2 ) THEN
+         !
+         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+            va_b(:,nlcj-nbghostcells-1:nlcj-2) = 0._wp
             DO jk = 1, jpkm1
                DO ji = 1, jpi
-                  ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk)
-               END DO
-            END DO
-         ENDIF
-
-         ! Mask domain edges:
-         !-------------------
-         DO jk = 1, jpkm1
+                  va_b(ji,nlcj-nbghostcells-1:nlcj-2) = va_b(ji,nlcj-nbghostcells-1:nlcj-2) + e3v_a(ji,nlcj-nbghostcells-1:nlcj-2,jk)  &
+                     &                                                                         * va(ji,nlcj-nbghostcells-1:nlcj-2,jk)
+               END DO
+            END DO
             DO ji = 1, jpi
-               ua(ji,1,jk) = 0._wp
-               va(ji,1,jk) = 0._wp
-            END DO
-         END DO 
-
-      ENDIF
-
-      IF( nbondj == 1 .OR. nbondj == 2 ) THEN
-         !
-         ! Smoothing
-         ! ---------
-         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
-            va_b(:,nlcj-2) = 0._wp
+               va_b(ji,nlcj-nbghostcells-1:nlcj-2) = va_b(ji,nlcj-nbghostcells-1:nlcj-2) * r1_hv_a(ji,nlcj-nbghostcells-1:nlcj-2)
+            END DO
+         ENDIF
+         !
+         ! Smoothing if only 1 ghostcell
+         ! -----------------------------
+         IF( nbghostcells == 1 ) THEN
+            DO jk = 1, jpkm1              ! Smooth
+               DO ji = i1, i2
+                  va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   &
+                     &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) )
+               END DO
+            END DO
+            !
+            zvb(:,nlcj-2) = 0._wp         ! Correct transport
             DO jk = 1, jpkm1
                DO ji = 1, jpi
-                  va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk)
+                  zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk)
                END DO
             END DO
             DO ji = 1, jpi
-               va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * r1_hv_a(ji,nlcj-2)            
-            END DO
-         ENDIF
-         !
-         DO jk = 1, jpkm1              ! Smooth
-            DO ji = i1, i2
-               va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   &
-                  &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) )
-            END DO
-         END DO
-         !
-         zvb(:,nlcj-2) = 0._wp         ! Correct transport
-         DO jk = 1, jpkm1
-            DO ji = 1, jpi
-               zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk)
-            END DO
-         END DO
-         DO ji = 1, jpi
-            zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2)
-         END DO
-         DO jk = 1, jpkm1
-            DO ji = 1, jpi
-               va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk)
-            END DO
-         END DO
-         !
-         ! Set tangential velocities to time splitting estimate
-         !-----------------------------------------------------
-         IF( ln_dynspg_ts ) THEN
-            zub(:,nlcj-1) = 0._wp
+               zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2)
+            END DO
             DO jk = 1, jpkm1
                DO ji = 1, jpi
-                  zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk)
-               END DO
-            END DO
-            DO ji = 1, jpi
-               zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1)
-            END DO
-            !
-            DO jk = 1, jpkm1
+                  va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk)
+               END DO
+            END DO
+            !
+            IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate
+               zub(:,nlcj-1) = 0._wp
+               DO jk = 1, jpkm1
+                  DO ji = 1, jpi
+                     zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk)
+                  END DO
+               END DO
                DO ji = 1, jpi
-                  ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk)
-               END DO
-            END DO
-         ENDIF
-         !
-         ! Mask domain edges:
-         !-------------------
-         DO jk = 1, jpkm1
-            DO ji = 1, jpi
-               ua(ji,nlcj  ,jk) = 0._wp
-               va(ji,nlcj-1,jk) = 0._wp
-            END DO
-         END DO 
+                  zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1)
+               END DO
+               !
+               DO jk = 1, jpkm1
+                  DO ji = 1, jpi
+                     ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk)
+                  END DO
+               END DO
+            ENDIF
+            !
+         ENDIF
          !
       ENDIF
@@ -392,13 +366,15 @@
       !
       IF( Agrif_Root() )   RETURN
-      !
+      !! clem ghost
       IF((nbondi == -1).OR.(nbondi == 2)) THEN
          DO jj=1,jpj
-            va_e(2,jj) = vbdy_w(jj) * hvr_e(2,jj)
-            ! Specified fluxes:
-            ua_e(2,jj) = ubdy_w(jj) * hur_e(2,jj)
-            ! Characteristics method:
-            !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) &
-            !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) )
+            IF( vmask(2,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary
+               va_e(2:nbghostcells+1,jj) = vbdy_w(jj) * hvr_e(2:nbghostcells+1,jj)
+               ! Specified fluxes:
+               ua_e(2:nbghostcells+1,jj) = ubdy_w(jj) * hur_e(2:nbghostcells+1,jj)
+               ! Characteristics method (only if ghostcells=1):
+               !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) &
+               !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) )
+            ENDIF
          END DO
       ENDIF
@@ -406,10 +382,12 @@
       IF((nbondi == 1).OR.(nbondi == 2)) THEN
          DO jj=1,jpj
-            va_e(nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj)
-            ! Specified fluxes:
-            ua_e(nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj)
-            ! Characteristics method:
-            !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) &
-            !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) )
+            IF( vmask(nlci-1,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary
+               va_e(nlci-nbghostcells:nlci-1,jj)   = vbdy_e(jj) * hvr_e(nlci-nbghostcells:nlci-1,jj)
+               ! Specified fluxes:
+               ua_e(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-nbghostcells-1:nlci-2,jj)
+               ! Characteristics method (only if ghostcells=1):
+               !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) &
+               !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) )
+            ENDIF
          END DO
       ENDIF
@@ -417,10 +395,12 @@
       IF((nbondj == -1).OR.(nbondj == 2)) THEN
          DO ji=1,jpi
-            ua_e(ji,2) = ubdy_s(ji) * hur_e(ji,2)
-            ! Specified fluxes:
-            va_e(ji,2) = vbdy_s(ji) * hvr_e(ji,2)
-            ! Characteristics method:
-            !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) &
-            !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) )
+            IF( umask(ji,2,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary
+               ua_e(ji,2:nbghostcells+1) = ubdy_s(ji) * hur_e(ji,2:nbghostcells+1)
+               ! Specified fluxes:
+               va_e(ji,2:nbghostcells+1) = vbdy_s(ji) * hvr_e(ji,2:nbghostcells+1)
+               ! Characteristics method (only if ghostcells=1):
+               !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) &
+               !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) )
+            ENDIF
          END DO
       ENDIF
@@ -428,10 +408,12 @@
       IF((nbondj == 1).OR.(nbondj == 2)) THEN
          DO ji=1,jpi
-            ua_e(ji,nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-1)
-            ! Specified fluxes:
-            va_e(ji,nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-2)
-            ! Characteristics method:
-            !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) &
-            !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) )
+            IF( umask(ji,nlcj-1,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary
+               ua_e(ji,nlcj-nbghostcells:nlcj-1)   = ubdy_n(ji) * hur_e(ji,nlcj-nbghostcells:nlcj-1)
+               ! Specified fluxes:
+               va_e(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-2)
+               ! Characteristics method (only if ghostcells=1):
+               !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) &
+               !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) )
+            ENDIF
          END DO
       ENDIF
@@ -476,5 +458,5 @@
       !
       IF( ll_int_cons ) THEN  ! Conservative interpolation
-         ! orders matters here !!!!!!
+         ! order matters here !!!!!!
          CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated
          CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b )
@@ -504,27 +486,60 @@
       !!----------------------------------------------------------------------  
       INTEGER, INTENT(in) ::   kt
-      !!
+      !
+      INTEGER  :: ji, jj, indx
       !!----------------------------------------------------------------------  
       !
       IF( Agrif_Root() )   RETURN
-      !
+      !! clem ghost
+      ! --- West --- !
       IF((nbondi == -1).OR.(nbondi == 2)) THEN
-         ssha(2,:)=ssha(3,:)
-         sshn(2,:)=sshn(3,:)
-      ENDIF
-      !
+         indx = 1+nbghostcells
+         DO jj = 1, jpj
+            DO ji = 2, indx
+               IF( tmask(2,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary
+                  ssha(ji,jj)=ssha(indx+1,jj)
+                  sshn(ji,jj)=sshn(indx+1,jj)
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDIF
+      !
+      ! --- East --- !
       IF((nbondi == 1).OR.(nbondi == 2)) THEN
-         ssha(nlci-1,:)=ssha(nlci-2,:)
-         sshn(nlci-1,:)=sshn(nlci-2,:)
-      ENDIF
-      !
+         indx = nlci-nbghostcells
+         DO jj = 1, jpj
+            DO ji = indx, nlci-1
+               IF( tmask(nlci-1,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary
+                  ssha(ji,jj)=ssha(indx-1,jj)
+                  sshn(ji,jj)=sshn(indx-1,jj)
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDIF
+      !
+      ! --- South --- !
       IF((nbondj == -1).OR.(nbondj == 2)) THEN
-         ssha(:,2)=ssha(:,3)
-         sshn(:,2)=sshn(:,3)
-      ENDIF
-      !
+         indx = 1+nbghostcells
+         DO jj = 2, indx
+            DO ji = 1, jpi
+               IF( tmask(ji,2,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary
+                  ssha(ji,jj)=ssha(ji,indx+1)
+                  sshn(ji,jj)=sshn(ji,indx+1)
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDIF
+      !
+      ! --- North --- !
       IF((nbondj == 1).OR.(nbondj == 2)) THEN
-         ssha(:,nlcj-1)=ssha(:,nlcj-2)
-         sshn(:,nlcj-1)=sshn(:,nlcj-2)
+         indx = nlcj-nbghostcells
+         DO jj = indx, nlcj-1
+            DO ji = 1, jpi
+               IF( tmask(ji,nlcj-1,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary
+                  ssha(ji,jj)=ssha(ji,indx-1)
+                  sshn(ji,jj)=sshn(ji,indx-1)
+               ENDIF
+            ENDDO
+         ENDDO
       ENDIF
       !
@@ -538,10 +553,12 @@
       INTEGER, INTENT(in) ::   jn
       !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-      !
+      INTEGER :: ji, jj
+      !!----------------------------------------------------------------------  
+      !! clem ghost (starting at i,j=1 is important I think otherwise you introduce a grad(ssh)/=0 at point 2)
       IF((nbondi == -1).OR.(nbondi == 2)) THEN
          DO jj = 1, jpj
-            ssha_e(2,jj) = hbdy_w(jj)
+            IF( tmask(2,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary
+               ssha_e(2:nbghostcells+1,jj) = hbdy_w(jj)
+            ENDIF
          END DO
       ENDIF
@@ -549,5 +566,7 @@
       IF((nbondi == 1).OR.(nbondi == 2)) THEN
          DO jj = 1, jpj
-            ssha_e(nlci-1,jj) = hbdy_e(jj)
+            IF( tmask(nlci-1,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary
+               ssha_e(nlci-nbghostcells:nlci-1,jj) = hbdy_e(jj)
+            ENDIF
          END DO
       ENDIF
@@ -555,5 +574,7 @@
       IF((nbondj == -1).OR.(nbondj == 2)) THEN
          DO ji = 1, jpi
-            ssha_e(ji,2) = hbdy_s(ji)
+            IF( tmask(ji,2,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary
+               ssha_e(ji,2:nbghostcells+1) = hbdy_s(ji)
+            ENDIF
          END DO
       ENDIF
@@ -561,5 +582,7 @@
       IF((nbondj == 1).OR.(nbondj == 2)) THEN
          DO ji = 1, jpi
-            ssha_e(ji,nlcj-1) = hbdy_n(ji)
+            IF( tmask(ji,nlcj-1,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary
+               ssha_e(ji,nlcj-nbghostcells:nlcj-1) = hbdy_n(ji)
+            ENDIF
          END DO
       ENDIF
@@ -601,6 +624,5 @@
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
       INTEGER  ::   imin, imax, jmin, jmax
-      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3
-      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7
+      REAL(wp) ::   zrhox, z1, z2, z3, z4, z5, z6, z7
       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
       !!----------------------------------------------------------------------
@@ -610,129 +632,115 @@
       ELSE
          !
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-         !
-         zrhox = Agrif_Rhox()
-         ! 
-         zalpha1 = ( zrhox - 1. ) * 0.5
-         zalpha2 = 1. - zalpha1
-         ! 
-         zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
-         zalpha4 = 1. - zalpha3
-         ! 
-         zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
-         zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
-         zalpha5 = 1. - zalpha6 - zalpha7
-         !
-         imin = i1
-         imax = i2
-         jmin = j1
-         jmax = j2
-         ! 
-         ! Remove CORNERS
-         IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
-         IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
-         IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
-         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2        
-         !
-         IF( eastern_side ) THEN
-            DO jn = 1, jpts
-               tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO jj = jmin,jmax
-                     IF( umask(nlci-2,jj,jk) == 0._wp ) THEN
-                        tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
-                     ELSE
-                        tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
-                        IF( un(nlci-2,jj,jk) > 0._wp ) THEN
-                           tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) & 
-                                 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+         western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2)
+         !
+         IF( nbghostcells > 1 ) THEN  ! no smoothing
+            tsa(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2)
+         ELSE                         ! smoothing
+            !
+            zrhox = Agrif_Rhox()
+            z1 = ( zrhox - 1. ) * 0.5
+            z3 = ( zrhox - 1. ) / ( zrhox + 1. )
+            z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+            z7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
+            !
+            z2 = 1. - z1
+            z4 = 1. - z3
+            z5 = 1. - z6 - z7
+            !
+            imin = i1 ; imax = i2
+            jmin = j1 ; jmax = j2
+            ! 
+            ! Remove CORNERS
+            IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
+            IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
+            IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
+            IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2        
+            !
+            IF( eastern_side ) THEN
+               DO jn = 1, jpts
+                  tsa(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn)
+                  DO jk = 1, jpkm1
+                     DO jj = jmin,jmax
+                        IF( umask(nlci-2,jj,jk) == 0._wp ) THEN
+                           tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
+                        ELSE
+                           tsa(nlci-1,jj,jk,jn)=(z4*tsa(nlci,jj,jk,jn)+z3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                           IF( un(nlci-2,jj,jk) > 0._wp ) THEN
+                              tsa(nlci-1,jj,jk,jn)=( z6*tsa(nlci-2,jj,jk,jn)+z5*tsa(nlci,jj,jk,jn) & 
+                                                   + z7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+                           ENDIF
                         ENDIF
-                     ENDIF
+                     END DO
                   END DO
-               END DO
-               tsa(nlci,j1:j2,k1:k2,jn) = 0._wp
-            END DO
-         ENDIF
-         ! 
-         IF( northern_side ) THEN            
-            DO jn = 1, jpts
-               tsa(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO ji = imin,imax
-                     IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN
-                        tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
-                     ELSE
-                        tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
-                        IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN
-                           tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn)  &
-                                 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+                  tsa(nlci,j1:j2,k1:k2,jn) = 0._wp
+               END DO
+            ENDIF
+            ! 
+            IF( northern_side ) THEN            
+               DO jn = 1, jpts
+                  tsa(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
+                  DO jk = 1, jpkm1
+                     DO ji = imin,imax
+                        IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN
+                           tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                        ELSE
+                           tsa(ji,nlcj-1,jk,jn)=(z4*tsa(ji,nlcj,jk,jn)+z3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
+                           IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN
+                              tsa(ji,nlcj-1,jk,jn)=( z6*tsa(ji,nlcj-2,jk,jn)+z5*tsa(ji,nlcj,jk,jn)  &
+                                                   + z7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+                           ENDIF
                         ENDIF
-                     ENDIF
+                     END DO
                   END DO
-               END DO
-               tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp
-            END DO
-         ENDIF
-         !
-         IF( western_side ) THEN            
-            DO jn = 1, jpts
-               tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO jj = jmin,jmax
-                     IF( umask(2,jj,jk) == 0._wp ) THEN
-                        tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)
-                     ELSE
-                        tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)        
-                        IF( un(2,jj,jk) < 0._wp ) THEN
-                           tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)
+                  tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp
+               END DO
+            ENDIF
+            !
+            IF( western_side ) THEN            
+               DO jn = 1, jpts
+                  tsa(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn)
+                  DO jk = 1, jpkm1
+                     DO jj = jmin,jmax
+                        IF( umask(2,jj,jk) == 0._wp ) THEN
+                           tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)
+                        ELSE
+                           tsa(2,jj,jk,jn)=(z4*tsa(1,jj,jk,jn)+z3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)        
+                           IF( un(2,jj,jk) < 0._wp ) THEN
+                              tsa(2,jj,jk,jn)=(z6*tsa(3,jj,jk,jn)+z5*tsa(1,jj,jk,jn)+z7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)
+                           ENDIF
                         ENDIF
-                     ENDIF
+                     END DO
                   END DO
-               END DO
-               tsa(1,j1:j2,k1:k2,jn) = 0._wp
-            END DO
-         ENDIF
-         !
-         IF( southern_side ) THEN           
-            DO jn = 1, jpts
-               tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)
-               DO jk = 1, jpk      
-                  DO ji=imin,imax
-                     IF( vmask(ji,2,jk) == 0._wp ) THEN
-                        tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)
-                     ELSE
-                        tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)
-                        IF( vn(ji,2,jk) < 0._wp ) THEN
-                           tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)
+                  tsa(1,j1:j2,k1:k2,jn) = 0._wp
+               END DO
+            ENDIF
+            !
+            IF( southern_side ) THEN           
+               DO jn = 1, jpts
+                  tsa(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn)
+                  DO jk = 1, jpk      
+                     DO ji=imin,imax
+                        IF( vmask(ji,2,jk) == 0._wp ) THEN
+                           tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)
+                        ELSE
+                           tsa(ji,2,jk,jn)=(z4*tsa(ji,1,jk,jn)+z3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)
+                           IF( vn(ji,2,jk) < 0._wp ) THEN
+                              tsa(ji,2,jk,jn)=(z6*tsa(ji,3,jk,jn)+z5*tsa(ji,1,jk,jn)+z7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)
+                           ENDIF
                         ENDIF
-                     ENDIF
+                     END DO
                   END DO
-               END DO
-               tsa(i1:i2,1,k1:k2,jn) = 0._wp
-            END DO
-         ENDIF
-         !
-         ! Treatment of corners
-         ! 
-         ! East south
-         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
-            tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)
-         ENDIF
-         ! East north
-         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
-            tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)
-         ENDIF
-         ! West south
-         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
-            tsa(2,2,:,:) = ptab(2,2,:,:)
-         ENDIF
-         ! West north
-         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
-            tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)
-         ENDIF
-         !
+                  tsa(i1:i2,1,k1:k2,jn) = 0._wp
+               END DO
+            ENDIF
+            !
+            ! Treatment of corners
+            IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2)))   tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)            ! East south
+            IF ((eastern_side).AND.((nbondj ==  1).OR.(nbondj == 2)))   tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)  ! East north
+            IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2)))   tsa(2,2,:,:) = ptab(2,2,:,:)                      ! West south
+            IF ((western_side).AND.((nbondj ==  1).OR.(nbondj == 2)))   tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)            ! West north
+            !
+         ENDIF
       ENDIF
       !
@@ -759,7 +767,8 @@
          southern_side = (nb == 2).AND.(ndir == 1)
          northern_side = (nb == 2).AND.(ndir == 2)
-         IF(western_side)  hbdy_w(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1)
-         IF(eastern_side)  hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1)
-         IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1)
+         !! clem ghost
+         IF(western_side)  hbdy_w(j1:j2) = ptab(i2,j1:j2) * tmask(i2,j1:j2,1)
+         IF(eastern_side)  hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) !clem previously i1
+         IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j2) * tmask(i1:i2,j2,1) !clem previously j1
          IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1)
       ENDIF
@@ -854,36 +863,19 @@
          ELSEIF( bdy_tinterp == 2 ) THEN
             ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
-               &               - zt0        * (       zt0 - 1._wp)**2._wp ) 
-
+               &               - zt0        * (       zt0 - 1._wp)**2._wp )
          ELSE
             ztcoeff = 1
          ENDIF
-         !   
-         IF(western_side) THEN
-            ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
-         ENDIF
-         IF(eastern_side) THEN
-            ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
-         ENDIF
-         IF(southern_side) THEN
-            ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
-         ENDIF
-         IF(northern_side) THEN
-            ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
-         ENDIF
+         !! clem ghost   
+         IF(western_side)   ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2)  
+         IF(eastern_side)   ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) !clem previously i1  
+         IF(southern_side)  ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1
+         IF(northern_side)  ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
          !            
          IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
-            IF(western_side) THEN
-               ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1)
-            ENDIF
-            IF(eastern_side) THEN
-               ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1)
-            ENDIF
-            IF(southern_side) THEN
-               ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1)
-            ENDIF
-            IF(northern_side) THEN
-               ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1)
-            ENDIF
+            IF(western_side)   ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i2,j1:j2)) * umask(i2,j1:j2,1)
+            IF(eastern_side)   ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1)
+            IF(southern_side)  ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j2)) * umask(i1:i2,j2,1)
+            IF(northern_side)  ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1)
          ENDIF
       ENDIF
@@ -927,35 +919,15 @@
             ztcoeff = 1
          ENDIF
-         !
-         IF(western_side) THEN
-            vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
-         ENDIF
-         IF(eastern_side) THEN
-            vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
-         ENDIF
-         IF(southern_side) THEN
-            vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1)
-         ENDIF
-         IF(northern_side) THEN
-            vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
-         ENDIF
+         !! clem ghost
+         IF(western_side)   vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2)  
+         IF(eastern_side)   vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) !clem previously i1  
+         IF(southern_side)  vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1
+         IF(northern_side)  vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
          !            
          IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
-            IF(western_side) THEN
-               vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2))   &
-                     &                                  * vmask(i1,j1:j2,1)
-            ENDIF
-            IF(eastern_side) THEN
-               vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2))   &
-                     &                                  * vmask(i1,j1:j2,1)
-            ENDIF
-            IF(southern_side) THEN
-               vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1))   &
-                     &                                  * vmask(i1:i2,j1,1)
-            ENDIF
-            IF(northern_side) THEN
-               vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1))   &
-                     &                                  * vmask(i1:i2,j1,1)
-            ENDIF
+            IF(western_side)   vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i2,j1:j2)) * vmask(i2,j1:j2,1)
+            IF(eastern_side)   vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1)
+            IF(southern_side)  vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j2)) * vmask(i1:i2,j2,1)
+            IF(northern_side)  vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1)
          ENDIF
       ENDIF
@@ -991,8 +963,8 @@
          zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)    &
             &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    ) 
-         ! 
-         IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2)  
-         IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
-         IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j1) 
+         !! clem ghost
+         IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i2,j1:j2)  
+         IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2) !clem previously i1  
+         IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1
          IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1) 
       ENDIF
@@ -1030,7 +1002,7 @@
             &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    ) 
          !
-         IF(western_side )   vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)  
-         IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
-         IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j1) 
+         IF(western_side )   vbdy_w(j1:j2) = zat * ptab(i2,j1:j2)  
+         IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2) !clem previously i1  
+         IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 
          IF(northern_side)   vbdy_n(i1:i2) = zat * ptab(i1:i2,j1) 
       ENDIF
@@ -1050,5 +1022,4 @@
       INTEGER :: ji, jj, jk
       LOGICAL :: western_side, eastern_side, northern_side, southern_side
-      REAL(wp) :: ztmpmsk      
       !!----------------------------------------------------------------------  
       !    
@@ -1060,15 +1031,10 @@
          southern_side = (nb == 2).AND.(ndir == 1)
          northern_side = (nb == 2).AND.(ndir == 2)
-
+         !
          DO jk = k1, k2
             DO jj = j1, j2
                DO ji = i1, i2
-                  ! Get velocity mask at boundary edge points:
-                  IF( western_side )   ztmpmsk = umask(ji    ,jj    ,1)
-                  IF( eastern_side )   ztmpmsk = umask(nlci-2,jj    ,1)
-                  IF( northern_side)   ztmpmsk = vmask(ji    ,nlcj-2,1)
-                  IF( southern_side)   ztmpmsk = vmask(ji    ,2     ,1)
                   !
-                  IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) )*ztmpmsk > 1.D-2) THEN
+                  IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) > 1.D-2) THEN
                      IF (western_side) THEN
                         WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 8226)
@@ -34,9 +34,9 @@
       !!   *** ROUTINE Agrif_Sponge_Tra ***
       !!---------------------------------------------
-      REAL(wp) :: timecoeff
+      REAL(wp) :: zcoef
       !!---------------------------------------------
       !
 #if defined SPONGE
-      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
+      zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
 
       CALL Agrif_Sponge
@@ -45,5 +45,5 @@
       tabspongedone_tsn = .FALSE.
 
-      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge)
+      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=zcoef,procname=interptsn_sponge)
 
       Agrif_UseSpecialValue = .FALSE.
@@ -57,9 +57,9 @@
       !!   *** ROUTINE Agrif_Sponge_dyn ***
       !!---------------------------------------------
-      REAL(wp) :: timecoeff
+      REAL(wp) :: zcoef
       !!---------------------------------------------
 
 #if defined SPONGE
-      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
+      zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
 
       Agrif_SpecialValue=0.
@@ -68,9 +68,9 @@
       tabspongedone_u = .FALSE.
       tabspongedone_v = .FALSE.         
-      CALL Agrif_Bc_Variable(un_sponge_id,calledweight=timecoeff,procname=interpun_sponge)
+      CALL Agrif_Bc_Variable(un_sponge_id,calledweight=zcoef,procname=interpun_sponge)
 
       tabspongedone_u = .FALSE.
       tabspongedone_v = .FALSE.
-      CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge)
+      CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=zcoef,procname=interpvn_sponge)
 
       Agrif_UseSpecialValue = .FALSE.
@@ -84,67 +84,62 @@
       !!   *** ROUTINE  Agrif_Sponge ***
       !!---------------------------------------------
-      INTEGER  :: ji,jj,jk
-      INTEGER  :: ispongearea, ilci, ilcj
-      LOGICAL  :: ll_spdone
-      REAL(wp) :: z1spongearea, zramp
-      REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp
+      REAL(wp), DIMENSION(jpi,jpj) :: ztabramp
+      !
+      INTEGER  :: ji, jj, ind1, ind2
+      INTEGER  :: ispongearea
+      REAL(wp) :: z1_spongearea
+      !!---------------------------------------------
 
 #if defined SPONGE || defined SPONGE_TOP
-      ll_spdone=.TRUE.
       IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN
-         ! Define ramp from boundaries towards domain interior
-         ! at T-points
+         ! Define ramp from boundaries towards domain interior at T-points
          ! Store it in ztabramp
-         ll_spdone=.FALSE.
-
-         CALL wrk_alloc( jpi, jpj, ztabramp )
 
          ispongearea  = 2 + nn_sponge_len * Agrif_irhox()
-         ilci = nlci - ispongearea
-         ilcj = nlcj - ispongearea 
-         z1spongearea = 1._wp / REAL( ispongearea - 2 )
-
+         z1_spongearea = 1._wp / REAL( ispongearea - 1 )
+         
          ztabramp(:,:) = 0._wp
 
+         ! --- West --- !
          IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
+            ind1 = 1+nbghostcells
+            ind2 = 1+nbghostcells + (ispongearea-1)
             DO jj = 1, jpj
-               IF ( umask(2,jj,1) == 1._wp ) THEN
-                 DO ji = 2, ispongearea                  
-                    ztabramp(ji,jj) = ( ispongearea-ji ) * z1spongearea
-                 END DO
-               ENDIF
+               DO ji = ind1, ind2                  
+                  ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1)
+               END DO
             ENDDO
          ENDIF
 
+         ! --- East --- !
          IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
+            ind1 = nlci - (1+nbghostcells) - (ispongearea-1)
+            ind2 = nlci - (1+nbghostcells)
             DO jj = 1, jpj
-               IF ( umask(nlci-2,jj,1) == 1._wp ) THEN
-                  DO ji = ilci+1,nlci-1
-                     zramp = (ji - (ilci+1) ) * z1spongearea
-                     ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp )
-                  ENDDO
-               ENDIF
+               DO ji = ind1, ind2
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind2 ) * z1_spongearea * umask(ind2-1,jj,1) )
+               ENDDO
             ENDDO
          ENDIF
 
+         ! --- South --- !
          IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN
-            DO ji = 1, jpi
-               IF ( vmask(ji,2,1) == 1._wp ) THEN
-                  DO jj = 2, ispongearea
-                     zramp = ( ispongearea-jj ) * z1spongearea
-                     ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp )
-                  END DO
-               ENDIF
+            ind1 = 1+nbghostcells
+            ind2 = 1+nbghostcells + (ispongearea-1)
+            DO jj = ind1, ind2
+               DO ji = 1, jpi
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) )
+               END DO
             ENDDO
          ENDIF
 
+         ! --- North --- !
          IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
-            DO ji = 1, jpi
-               IF ( vmask(ji,nlcj-2,1) == 1._wp ) THEN
-                  DO jj = ilcj+1,nlcj-1
-                     zramp = (jj - (ilcj+1) ) * z1spongearea
-                     ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp )
-                  END DO
-               ENDIF
+            ind1 = nlcj - (1+nbghostcells) - (ispongearea-1)
+            ind2 = nlcj - (1+nbghostcells)
+            DO jj = ind1, ind2
+               DO ji = 1, jpi
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind2 ) * z1_spongearea * vmask(ji,ind2-1,1) )
+               END DO
             ENDDO
          ENDIF
@@ -158,11 +153,11 @@
          DO jj = 2, jpjm1
             DO ji = 2, jpim1   ! vector opt.
-               fsaht_spu(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji+1,jj  ))
-               fsaht_spv(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji  ,jj+1))
-            END DO
-         END DO
-
+               fsaht_spu(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji+1,jj  ) )
+               fsaht_spv(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) )
+            END DO
+         END DO
          CALL lbc_lnk( fsaht_spu, 'U', 1. )   ! Lateral boundary conditions
          CALL lbc_lnk( fsaht_spv, 'V', 1. )
+         
          spongedoneT = .TRUE.
       ENDIF
@@ -179,11 +174,9 @@
             END DO
          END DO
-
          CALL lbc_lnk( fsahm_spt, 'T', 1. )   ! Lateral boundary conditions
          CALL lbc_lnk( fsahm_spf, 'F', 1. )
+         
          spongedoneU = .TRUE.
       ENDIF
-      !
-      IF (.NOT.ll_spdone) CALL wrk_dealloc( jpi, jpj, ztabramp )
       !
 #endif
@@ -205,4 +198,5 @@
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff
+      !!---------------------------------------------    
       !
       IF( before ) THEN
@@ -327,5 +321,5 @@
 
          jmax = j2-1
-         IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-3)
+         IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-nbghostcells-2)   ! North
 
          DO jj = j1+1, jmax
@@ -404,5 +398,5 @@
 
          imax = i2-1
-         IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-3)
+         IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-nbghostcells-2)   ! East
 
          DO jj = j1+1, j2
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 8226)
@@ -50,134 +50,120 @@
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      INTEGER :: imin, imax, jmin, jmax
-      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3
-      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7
-      LOGICAL :: western_side, eastern_side,northern_side,southern_side
-
+      INTEGER  ::   imin, imax, jmin, jmax
+      REAL(wp) ::   zrhox, z1, z2, z3, z4, z5, z6, z7
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !!-----------------------------------------------------------------------
+      !
       IF (before) THEN         
          ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
       ELSE
          !
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-         !
-         zrhox = Agrif_Rhox()
-         ! 
-         zalpha1 = ( zrhox - 1. ) * 0.5
-         zalpha2 = 1. - zalpha1
-         ! 
-         zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
-         zalpha4 = 1. - zalpha3
-         ! 
-         zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
-         zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
-         zalpha5 = 1. - zalpha6 - zalpha7
-         !
-         imin = i1
-         imax = i2
-         jmin = j1
-         jmax = j2
-         ! 
-         ! Remove CORNERS
-         IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
-         IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
-         IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
-         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2        
-         !
-         IF( eastern_side) THEN
-            DO jn = 1, jptra
-               tra(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO jj = jmin,jmax
-                     IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
-                        tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
-                     ELSE
-                        tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
-                        IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
-                           tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) & 
-                                 + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+         IF( nbghostcells > 1 ) THEN  ! no smoothing
+            tra(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2)
+         ELSE                         ! smoothing
+            !
+            western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2)
+            southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2)
+            !
+            zrhox = Agrif_Rhox()
+            z1 = ( zrhox - 1. ) * 0.5
+            z3 = ( zrhox - 1. ) / ( zrhox + 1. )
+            z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+            z7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
+            !
+            z2 = 1. - z1
+            z4 = 1. - z3
+            z5 = 1. - z6 - z7
+            !
+            imin = i1 ; imax = i2
+            jmin = j1 ; jmax = j2
+            ! 
+            ! Remove CORNERS
+            IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
+            IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
+            IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
+            IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2        
+            !
+            IF( eastern_side) THEN
+               DO jn = 1, jptra
+                  tra(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn)
+                  DO jk = 1, jpkm1
+                     DO jj = jmin,jmax
+                        IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
+                           tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
+                        ELSE
+                           tra(nlci-1,jj,jk,jn)=(z4*tra(nlci,jj,jk,jn)+z3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                           IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
+                              tra(nlci-1,jj,jk,jn)=( z6*tra(nlci-2,jj,jk,jn)+z5*tra(nlci,jj,jk,jn) & 
+                                                   + z7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+                           ENDIF
                         ENDIF
-                     ENDIF
+                     END DO
+                  END DO
+               ENDDO
+            ENDIF
+            ! 
+            IF( northern_side ) THEN            
+               DO jn = 1, jptra
+                  tra(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
+                  DO jk = 1, jpkm1
+                     DO ji = imin,imax
+                        IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
+                           tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                        ELSE
+                           tra(ji,nlcj-1,jk,jn)=(z4*tra(ji,nlcj,jk,jn)+z3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
+                           IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
+                              tra(ji,nlcj-1,jk,jn)=( z6*tra(ji,nlcj-2,jk,jn)+z5*tra(ji,nlcj,jk,jn)  &
+                                                   + z7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+                           ENDIF
+                        ENDIF
+                     END DO
+                  END DO
+               ENDDO
+            ENDIF
+            !
+            IF( western_side) THEN            
+               DO jn = 1, jptra
+                  tra(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn)
+                  DO jk = 1, jpkm1
+                     DO jj = jmin,jmax
+                        IF( umask(2,jj,jk) == 0.e0 ) THEN
+                           tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
+                        ELSE
+                           tra(2,jj,jk,jn)=(z4*tra(1,jj,jk,jn)+z3*tra(3,jj,jk,jn))*tmask(2,jj,jk)        
+                           IF( un(2,jj,jk) < 0.e0 ) THEN
+                              tra(2,jj,jk,jn)=(z6*tra(3,jj,jk,jn)+z5*tra(1,jj,jk,jn)+z7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
+                           ENDIF
+                        ENDIF
+                     END DO
                   END DO
                END DO
-            ENDDO
+            ENDIF
+            !
+            IF( southern_side ) THEN           
+               DO jn = 1, jptra
+                  tra(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn)
+                  DO jk=1,jpk      
+                     DO ji=imin,imax
+                        IF( vmask(ji,2,jk) == 0.e0 ) THEN
+                           tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
+                        ELSE
+                           tra(ji,2,jk,jn)=(z4*tra(ji,1,jk,jn)+z3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
+                           IF( vn(ji,2,jk) < 0.e0 ) THEN
+                              tra(ji,2,jk,jn)=(z6*tra(ji,3,jk,jn)+z5*tra(ji,1,jk,jn)+z7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
+                           ENDIF
+                        ENDIF
+                     END DO
+                  END DO
+               ENDDO
+            ENDIF
+            !
+            ! Treatment of corners
+            IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2)))  tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)            ! East south
+            IF ((eastern_side).AND.((nbondj ==  1).OR.(nbondj == 2)))  tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)  ! East north
+            IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2)))  tra(2,2,:,:) = ptab(2,2,:,:)                      ! West south
+            IF ((western_side).AND.((nbondj ==  1).OR.(nbondj == 2)))  tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)            ! West north
+            !
          ENDIF
-         ! 
-         IF( northern_side ) THEN            
-            DO jn = 1, jptra
-               tra(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO ji = imin,imax
-                     IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
-                        tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
-                     ELSE
-                        tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
-                        IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
-                           tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn)  &
-                                 + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
-                        ENDIF
-                     ENDIF
-                  END DO
-               END DO
-            ENDDO
-         ENDIF
-         !
-         IF( western_side) THEN            
-            DO jn = 1, jptra
-               tra(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO jj = jmin,jmax
-                     IF( umask(2,jj,jk) == 0.e0 ) THEN
-                        tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
-                     ELSE
-                        tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)        
-                        IF( un(2,jj,jk) < 0.e0 ) THEN
-                           tra(2,jj,jk,jn)=(zalpha6*tra(3,jj,jk,jn)+zalpha5*tra(1,jj,jk,jn)+zalpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
-                        ENDIF
-                     ENDIF
-                  END DO
-               END DO
-            END DO
-         ENDIF
-         !
-         IF( southern_side ) THEN           
-            DO jn = 1, jptra
-               tra(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)
-               DO jk=1,jpk      
-                  DO ji=imin,imax
-                     IF( vmask(ji,2,jk) == 0.e0 ) THEN
-                        tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
-                     ELSE
-                        tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
-                        IF( vn(ji,2,jk) < 0.e0 ) THEN
-                           tra(ji,2,jk,jn)=(zalpha6*tra(ji,3,jk,jn)+zalpha5*tra(ji,1,jk,jn)+zalpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
-                        ENDIF
-                     ENDIF
-                  END DO
-               END DO
-            ENDDO
-         ENDIF
-         !
-         ! Treatment of corners
-         ! 
-         ! East south
-         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
-            tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)
-         ENDIF
-         ! East north
-         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
-            tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)
-         ENDIF
-         ! West south
-         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
-            tra(2,2,:,:) = ptab(2,2,:,:)
-         ENDIF
-         ! West north
-         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
-            tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)
-         ENDIF
-         !
       ENDIF
       !
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 8226)
@@ -127,10 +127,17 @@
    !!
    IMPLICIT NONE
+   !
+   INTEGER :: ind1, ind2, ind3
    !!----------------------------------------------------------------------
 
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
+   !!clem ghost
+   ind1 =     nbghostcells
+   ind2 = 1 + nbghostcells
+   ind3 = 2 + nbghostcells
+   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
+   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
+   !!clem ghost
 
    ! 2. Type of interpolation
@@ -141,6 +148,8 @@
    ! 3. Location of interpolation
    !-----------------------------
-   CALL Agrif_Set_bc(e1u_id,(/0,0/))
-   CALL Agrif_Set_bc(e2v_id,(/0,0/))
+   !!clem ghost (previously set to /0,0/)
+   CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/))
+   CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))
+   !!clem ghost
 
    ! 5. Update type
@@ -337,43 +346,50 @@
    !!----------------------------------------------------------------------
    USE agrif_util
-   USE par_oce       !   ONLY : jpts
+   USE par_oce       !   ONLY : jpts and ghostcells
    USE oce
    USE agrif_oce
    !!
    IMPLICIT NONE
+   !
+   INTEGER :: ind1, ind2, ind3
    !!----------------------------------------------------------------------
 
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)
-
-   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id)
-   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id)
-   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id)
-   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id)
-   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id)
-   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id)
-
-   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
-   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
-   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
-
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)
-
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
-
-   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
+   !!clem ghost
+   ind1 =     nbghostcells
+   ind2 = 1 + nbghostcells
+   ind3 = 2 + nbghostcells
+   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)
+
+   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id)
+   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id)
+   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id)
+   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id)
+   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id)
+   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id)
+
+   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
+   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
+   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
+
+   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)
+
+   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
+   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
+   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
+   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
+   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
+   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
+
+   CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
 
 # if defined key_zdftke
-   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
-   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
-   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
+   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
+   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
+   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
 # endif
+   !!clem ghost
 
    ! 2. Type of interpolation
@@ -407,28 +423,29 @@
    ! 3. Location of interpolation
    !-----------------------------
-   CALL Agrif_Set_bc(tsn_id,(/0,1/))
-   CALL Agrif_Set_bc(un_interp_id,(/0,1/))
-   CALL Agrif_Set_bc(vn_interp_id,(/0,1/))
-
-!   CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/))
-!   CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/))
-!   CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/))
-   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
+   !!clem ghost
+   CALL Agrif_Set_bc(tsn_id,(/0,ind1/))
+   CALL Agrif_Set_bc(un_interp_id,(/0,ind1/))
+   CALL Agrif_Set_bc(vn_interp_id,(/0,ind1/))
+
+   ! clem: previously set to /-,0/
+   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))  ! if west and rhox=3 and sponge=2 and ghost=1: columns 2 to 9 
    CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
    CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
 
-   CALL Agrif_Set_bc(sshn_id,(/0,0/))
-   CALL Agrif_Set_bc(unb_id ,(/0,0/))
-   CALL Agrif_Set_bc(vnb_id ,(/0,0/))
-   CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/))
-   CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/))
-
-   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/))   ! if west and rhox=3: column 2 to 9
-   CALL Agrif_Set_bc(umsk_id,(/0,0/))
-   CALL Agrif_Set_bc(vmsk_id,(/0,0/))
-
+   CALL Agrif_Set_bc(sshn_id,(/0,ind1-1/))
+   CALL Agrif_Set_bc(unb_id ,(/0,ind1-1/))
+   CALL Agrif_Set_bc(vnb_id ,(/0,ind1-1/))
+   CALL Agrif_Set_bc(ub2b_interp_id,(/0,ind1-1/))
+   CALL Agrif_Set_bc(vb2b_interp_id,(/0,ind1-1/))
+
+   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,ind1-1/))   ! if west and rhox=3 and ghost=1: column 2 to 9
+   CALL Agrif_Set_bc(umsk_id,(/0,ind1-1/))
+   CALL Agrif_Set_bc(vmsk_id,(/0,ind1-1/))
+
+   ! clem: previously set to /0,1/
 # if defined key_zdftke
-   CALL Agrif_Set_bc(avm_id ,(/0,1/))
+   CALL Agrif_Set_bc(avm_id ,(/0,ind1/))
 # endif
+   !!clem ghost
 
    ! 5. Update type
@@ -623,6 +640,9 @@
    USE Agrif_Util
    USE ice
-
-   IMPLICIT NONE
+   USE par_oce, ONLY : nbghostcells
+   !
+   IMPLICIT NONE
+   !
+   INTEGER :: ind1, ind2, ind3
    !!----------------------------------------------------------------------
    !
@@ -634,7 +654,12 @@
    !                            2,2 = two ghost lines
    !-------------------------------------------------------------------------------------
-   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id )
-   CALL agrif_declare_variable((/1,2/)    ,(/2,3/),(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id   )
-   CALL agrif_declare_variable((/2,1/)    ,(/3,2/),(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id   )
+   !!clem ghost
+   ind1 =     nbghostcells
+   ind2 = 1 + nbghostcells
+   ind3 = 2 + nbghostcells
+   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id )
+   CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id   )
+   CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id   )
+   !!clem ghost
 
    ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
@@ -646,7 +671,9 @@
    ! 3. Set location of interpolations
    !----------------------------------
-   CALL Agrif_Set_bc(tra_ice_id,(/0,1/))
-   CALL Agrif_Set_bc(u_ice_id  ,(/0,1/))
-   CALL Agrif_Set_bc(v_ice_id  ,(/0,1/))
+   !!clem ghost
+   CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
+   CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/))
+   CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/))
+   !!clem ghost
 
    ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
@@ -777,10 +804,16 @@
    !!
    IMPLICIT NONE
+   !
+   INTEGER :: ind1, ind2, ind3
    !!----------------------------------------------------------------------
 
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id)
+   !!clem ghost
+   ind1 =     nbghostcells
+   ind2 = 1 + nbghostcells
+   ind3 = 2 + nbghostcells
+   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id)
 
    ! 2. Type of interpolation
@@ -791,6 +824,7 @@
    ! 3. Location of interpolation
    !-----------------------------
-   CALL Agrif_Set_bc(trn_id,(/0,1/))
-!   CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/))
+   !!clem ghost
+   CALL Agrif_Set_bc(trn_id,(/0,ind1/))
+   !clem: previously set to /-,0/
    CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
 
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90	(revision 8226)
@@ -15,5 +15,5 @@
    
    INTERFACE crs_lbc_lnk
-      MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_3d_gather, crs_lbc_lnk_2d
+      MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_2d
    END INTERFACE
    
@@ -56,5 +56,5 @@
       !
       IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval  )
-      ELSE                         ; CALL lbc_lnk( pt3d1, cd_type1, psgn, pval=zval  )
+      ELSE                         ; CALL lbc_lnk( pt3d1, cd_type1, psgn        , pval=zval  )
       ENDIF
       !
@@ -62,33 +62,4 @@
       !
    END SUBROUTINE crs_lbc_lnk_3d
-   
-   
-   SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
-      !!---------------------------------------------------------------------
-      !!                  ***  SUBROUTINE crs_lbc_lnk  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions for coarsened grid
-      !!
-      !! ** Method  :   Swap domain indices from full to coarse domain
-      !!                before arguments are passed directly to lbc_lnk.
-      !!                Upon exiting, switch back to full domain indices.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type1, cd_type2 ! grid type
-      REAL(wp)                                , INTENT(in   ) ::   psgn               ! control of the sign
-      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) ::   pt3d1   , pt3d2    ! 3D array on which the lbc is applied
-      !
-      LOGICAL ::   ll_grid_crs
-      !!----------------------------------------------------------------------
-      !
-      ll_grid_crs = ( jpi == jpi_crs )
-      !
-      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
-      !
-      CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn  )
-      !
-      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
-      !
-   END SUBROUTINE crs_lbc_lnk_3d_gather
-
    
    
@@ -121,6 +92,6 @@
       IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
       !
-      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  )
-      ELSE                         ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval  )
+      IF( PRESENT( cd_mpp ) ) THEN   ;   CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  )
+      ELSE                           ;   CALL lbc_lnk( pt2d, cd_type, psgn,         pval=zval  )
       ENDIF
       !
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 8226)
@@ -1012,5 +1012,7 @@
       CALL lim_wri_state_2( kt, id_i, nh_i )
 #elif defined key_lim3
-      CALL lim_wri_state( kt, id_i, nh_i )
+      IF( nn_ice == 3 ) THEN   ! clem2017: condition in case agrif + lim but no-ice in child grid
+         CALL lim_wri_state( kt, id_i, nh_i )
+      ENDIF
 #else
       CALL histend( id_i, snc4chunks=snc4set )
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90	(revision 8226)
@@ -184,8 +184,12 @@
       END DO
 
-      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1.)
-      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1.)
-      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1.)
-
+!!gm  ERROR !!!!
+!!    juste use tmask_i  or in case of ISF smask_i (to be created to compute the sum without halos)
+!
+!      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1.)
+!      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1.)
+!      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1.)
+      STOP ' iscpl_cons:   please modify this module !'
+!!gm end
       ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point 
       ! allocation and initialisation of the list of problematic point
@@ -283,8 +287,12 @@
       pts_flx (:,:,:,jp_tem) = pts_flx (:,:,:,jp_tem) * tmask(:,:,:)
 
-      ! compute sum over the halo and set it to 0.
-      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1._wp)
-      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp)
-      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp)
+!!gm  ERROR !!!!
+!!    juste use tmask_i  or in case of ISF smask_i (to be created to compute the sum without halos)
+!
+!      ! compute sum over the halo and set it to 0.
+!      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1._wp)
+!      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp)
+!      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp)
+!!gm end
 
       ! deallocate variables
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90	(revision 8226)
@@ -82,11 +82,11 @@
             END DO  
          END DO  
-         IF( .NOT. AGRIF_Root() ) THEN
-            IF( nbondi ==  1 .OR. nbondi == 2 )   hdivn(nlci-1,   :  ,jk) = 0._wp      ! east
-            IF( nbondi == -1 .OR. nbondi == 2 )   hdivn(  2   ,   :  ,jk) = 0._wp      ! west
-            IF( nbondj ==  1 .OR. nbondj == 2 )   hdivn(  :   ,nlcj-1,jk) = 0._wp      ! north
-            IF( nbondj == -1 .OR. nbondj == 2 )   hdivn(  :   ,  2   ,jk) = 0._wp      ! south
-         ENDIF
       END DO
+      IF( .NOT. Agrif_Root() ) THEN
+         IF( nbondi == -1 .OR. nbondi == 2 )   hdivn( 2:nbghostcells+1,:        ,:) = 0._wp      ! west
+         IF( nbondi ==  1 .OR. nbondi == 2 )   hdivn( nlci-nbghostcells:nlci-1,:,:) = 0._wp      ! east
+         IF( nbondj == -1 .OR. nbondj == 2 )   hdivn( :,2:nbghostcells+1        ,:) = 0._wp      ! south
+         IF( nbondj ==  1 .OR. nbondj == 2 )   hdivn( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp      ! north
+      ENDIF
       !
       IF( ln_rnf )   CALL sbc_rnf_div( hdivn )      !==  runoffs    ==!   (update hdivn field)
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 8226)
@@ -686,20 +686,20 @@
             IF((nbondi == -1).OR.(nbondi == 2)) THEN
                DO jj=1,jpj
-                  zwx(2,jj) = ubdy_w(jj) * e2u(2,jj)
+                  zwx(2:nbghostcells+1,jj) = ubdy_w(jj) * e2u(2:nbghostcells+1,jj)
                END DO
             ENDIF
             IF((nbondi ==  1).OR.(nbondi == 2)) THEN
                DO jj=1,jpj
-                  zwx(nlci-2,jj) = ubdy_e(jj) * e2u(nlci-2,jj)
+                  zwx(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(jj) * e2u(nlci-nbghostcells-1:nlci-2,jj)
                END DO
             ENDIF
             IF((nbondj == -1).OR.(nbondj == 2)) THEN
                DO ji=1,jpi
-                  zwy(ji,2) = vbdy_s(ji) * e1v(ji,2)
+                  zwy(ji,2:nbghostcells+1) = vbdy_s(ji) * e1v(ji,2:nbghostcells+1)
                END DO
             ENDIF
             IF((nbondj ==  1).OR.(nbondj == 2)) THEN
                DO ji=1,jpi
-                  zwy(ji,nlcj-2) = vbdy_n(ji) * e1v(ji,nlcj-2)
+                  zwy(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji) * e1v(ji,nlcj-nbghostcells-1:nlcj-2)
                END DO
             ENDIF
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 8226)
@@ -126,5 +126,5 @@
    INTEGER ::   numoni          =   -1      !: logical unit for Output Namelist Ice
    INTEGER ::   numevo_ice      =   -1      !: logical unit for ice variables (temp. evolution)
-   INTEGER ::   numsol          =   -1      !: logical unit for solver statistics
+   INTEGER ::   numrun          =   -1      !: logical unit for run statistics
    INTEGER ::   numdct_in       =   -1      !: logical unit for transports computing
    INTEGER ::   numdct_vol      =   -1      !: logical unit for voulume transports output
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_lnk_generic.h90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_lnk_generic.h90	(revision 8226)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_lnk_generic.h90	(revision 8226)
@@ -0,0 +1,120 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   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
+#   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
+
+#if defined MULTI
+   SUBROUTINE ROUTINE_LNK( ptab, cd_nat, psgn, kfld, cd_mpp, pval )
+      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays
+#else
+   SUBROUTINE ROUTINE_LNK( ptab, cd_nat, psgn      , cd_mpp, pval )
+#endif
+      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
+      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp      ! fill the overlap area only
+      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval        ! background value (used at closed boundaries)
+      !
+      INTEGER  ::    ji,  jj,  jk,  jl, jh, jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl, ipf      ! dimension of the input array
+      REAL(wp) ::   zland
+      LOGICAL  ::   ll_Iperio, ll_Jperio, ll_nfd
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      ll_Iperio = nperio==1 .OR. nperio==4 .OR. nperio==6
+      ll_Jperio = jperio==7
+      ll_nfd    = nperio==3 .OR. nperio==4 .OR. nperio==5 .OR. nperio==6
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0._wp     ! zero by default
+      ENDIF
+
+      ! ------------------------------- !
+      !   standard boundary treatment   !    ! CAUTION: semi-column notation is often impossible
+      ! ------------------------------- !
+      !
+      IF( PRESENT( cd_mpp ) ) THEN     !==  halos filled with inner values  ==!
+         !
+         ! only fill the overlap area and extra allows 
+         ! this is in mpp case. In this module, just do nothing
+         !
+      ELSE                             !==  standard close or cyclic treatment  ==!
+         !
+         DO jf = 1, ipf                   ! number of arrays to be treated
+            !
+            !                                ! East-West boundaries
+            IF( ll_Iperio ) THEN                   !* cyclic
+               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
+               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf)
+            ELSE                                   !* closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN( 1 ,:,:,:,jf) = zland    ! east except F-point
+                                               ARRAY_IN(jpi,:,:,:,jf) = zland    ! west
+            ENDIF
+            !                                ! North-South boundaries
+            IF( ll_Jperio ) THEN                   !* cyclic
+               ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:, jpjm1,:,:,jf)
+               ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:,   2  ,:,:,jf)
+            ELSEIF( ll_nfd ) THEN                  !* north fold
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:, 1 ,:,:,jf) = zland    ! south except F-point
+               CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:)  )                       ! north fold treatment         
+            ELSE                                   !* closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:, 1 ,:,:,jf) = zland    ! south except F-point
+                                               ARRAY_IN(:,jpj,:,:,jf) = zland    ! north
+            ENDIF
+            !
+         END DO
+         !
+      ENDIF
+      !
+   END SUBROUTINE ROUTINE_LNK
+
+#undef ARRAY_TYPE
+#undef NAT_IN
+#undef SGN_IN
+#undef ARRAY_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_lnk_multi_generic.h90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_lnk_multi_generic.h90	(revision 8226)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_lnk_multi_generic.h90	(revision 8226)
@@ -0,0 +1,74 @@
+#if defined DIM_2d
+#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j)
+#   define PTR_TYPE              TYPE(PTR_2D)
+#   define PTR_ptab              pt2d
+#endif
+#if defined DIM_3d
+#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j,k)
+#   define PTR_TYPE              TYPE(PTR_3D)
+#   define PTR_ptab              pt3d
+#endif
+#if defined DIM_4d
+#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j,k,l)
+#   define PTR_TYPE              TYPE(PTR_4D)
+#   define PTR_ptab              pt4d
+#endif
+   SUBROUTINE ROUTINE_MULTI( pt1, cdna1, psgn1, pt2, cdna2, psgn2, pt3, cdna3, psgn3   &
+      &                    , pt4, cdna4, psgn4, pt5, cdna5, psgn5, pt6, cdna6, psgn6   &
+      &                    , pt7, cdna7, psgn7, pt8, cdna8, psgn8, pt9, cdna9, psgn9, cd_mpp, pval)
+      !!---------------------------------------------------------------------
+      ARRAY_TYPE(:,:,:,:)          , TARGET, INTENT(inout) ::   pt1     ! arrays on which the lbc is applied
+      ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) ::   pt2  ,  pt3  , pt4  , pt5  , pt6  , pt7  , pt8  , pt9
+      CHARACTER(len=1)                     , INTENT(in   ) ::   cdna1   ! nature of pt2D. array grid-points
+      CHARACTER(len=1)   , OPTIONAL        , INTENT(in   ) ::   cdna2,  cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9
+      REAL(wp)                             , INTENT(in   ) ::   psgn1   ! sign used across the north fold
+      REAL(wp)           , OPTIONAL        , INTENT(in   ) ::   psgn2,  psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9   
+      CHARACTER(len=3)   , OPTIONAL        , INTENT(in   ) ::   cd_mpp  ! fill the overlap area only
+      REAL(wp)           , OPTIONAL        , INTENT(in   ) ::   pval    ! background value (used at closed boundaries)
+      !!
+      INTEGER                         ::   kfld        ! number of elements that will be attributed
+      PTR_TYPE         , DIMENSION(9) ::   ptab_ptr    ! pointer array
+      CHARACTER(len=1) , DIMENSION(9) ::   cdna_ptr    ! nature of ptab_ptr grid-points
+      REAL(wp)         , DIMENSION(9) ::   psgn_ptr    ! sign used across the north fold boundary
+      !!---------------------------------------------------------------------
+      !
+      kfld = 0          ! initial array of pointer size
+      !
+      !                 ! Load the first array
+      CALL ROUTINE_LOAD( pt1, cdna1, psgn1, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      !
+      !                 ! Look if more arrays are added
+      IF( PRESENT(psgn2) )   CALL ROUTINE_LOAD( pt2, cdna2, psgn2, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn3) )   CALL ROUTINE_LOAD( pt3, cdna3, psgn3, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn4) )   CALL ROUTINE_LOAD( pt4, cdna4, psgn4, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn5) )   CALL ROUTINE_LOAD( pt5, cdna5, psgn5, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn6) )   CALL ROUTINE_LOAD( pt6, cdna6, psgn6, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn7) )   CALL ROUTINE_LOAD( pt7, cdna7, psgn7, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn8) )   CALL ROUTINE_LOAD( pt8, cdna8, psgn8, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn9) )   CALL ROUTINE_LOAD( pt9, cdna9, psgn9, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      !
+      CALL lbc_lnk_ptr( ptab_ptr, cdna_ptr, psgn_ptr, kfld, cd_mpp, pval )
+      !
+   END SUBROUTINE ROUTINE_MULTI
+
+
+   SUBROUTINE ROUTINE_LOAD( ptab, cdna, psgn, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      !!---------------------------------------------------------------------
+      ARRAY_TYPE(:,:,:,:)   , TARGET, INTENT(inout) ::   ptab       ! arrays on which the lbc is applied
+      CHARACTER(len=1)              , INTENT(in   ) ::   cdna       ! nature of pt2d array grid-points
+      REAL(wp)                      , INTENT(in   ) ::   psgn       ! sign used across the north fold boundary
+      PTR_TYPE        , DIMENSION(:), INTENT(inout) ::   ptab_ptr   ! array of pointers
+      CHARACTER(len=1), DIMENSION(:), INTENT(inout) ::   cdna_ptr   ! nature of pt2d_array array grid-points
+      REAL(wp)        , DIMENSION(:), INTENT(inout) ::   psgn_ptr   ! sign used across the north fold boundary
+      INTEGER                       , INTENT(inout) ::   kfld       ! number of elements that has been attributed
+      !!---------------------------------------------------------------------
+      !
+      kfld                    =  kfld + 1
+      ptab_ptr(kfld)%PTR_ptab => ptab
+      cdna_ptr(kfld)          =  cdna
+      psgn_ptr(kfld)          =  psgn
+      !
+   END SUBROUTINE ROUTINE_LOAD
+#undef ARRAY_TYPE
+#undef PTR_TYPE
+#undef PTR_ptab
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_generic.h90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_generic.h90	(revision 8226)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_generic.h90	(revision 8226)
@@ -0,0 +1,171 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   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
+!                          !==  IN: ptab is an array  ==!
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   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
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
+#endif
+
+   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld )
+      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
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays
+      !
+      INTEGER  ::    ji,  jj,  jk,  jl, jh,  jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl,     ipf   ! dimension of the input array
+      INTEGER  ::   ijt, iju, ipjm1
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      !
+      SELECT CASE ( jpni )
+      CASE ( 1 )     ;   ipj = nlcj       ! 1 proc only  along the i-direction
+      CASE DEFAULT   ;   ipj = 4          ! several proc along the i-direction
+      END SELECT
+      ipjm1 = ipj-1
+
+      !
+      DO jf = 1, ipf                      ! Loop on the number of arrays to be treated
+         !
+         SELECT CASE ( npolj )
+         !
+         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf)  )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf)
+               END DO
+               ARRAY_IN(1,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-2,:,:,jf)
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+2
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf)
+               END DO
+               ARRAY_IN(   1  ,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-2,:,:,jf)
+               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-2,:,:,jf) 
+               DO ji = jpiglo/2, jpiglo-1
+                  iju = jpiglo-ji+1
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'V' )                               ! V-point
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  ARRAY_IN(ji,ipj-1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf)
+                  ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-3,:,:,jf)
+               END DO
+               ARRAY_IN(1,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-3,:,:,jf) 
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  ARRAY_IN(ji,ipj-1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf)
+                  ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-3,:,:,jf)
+               END DO
+               ARRAY_IN(   1  ,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-3,:,:,jf)
+               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-3,:,:,jf) 
+            END SELECT
+            !
+         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf)  )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-1,:,:,jf)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-1,:,:,jf)
+               END DO
+               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(1,ipj-1,:,:,jf)
+            CASE ( 'V' )                               ! V-point
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+1
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf)
+               END DO
+               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(1,ipj-2,:,:,jf)
+               DO ji = jpiglo/2+1, jpiglo-1
+                  iju = jpiglo-ji
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
+               END DO
+            END SELECT
+            !
+         CASE DEFAULT                           ! *  closed : the code probably never go through
+            !
+            SELECT CASE ( NAT_IN(jf) )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               ARRAY_IN(:, 1 ,:,:,jf) = 0._wp
+               ARRAY_IN(:,ipj,:,:,jf) = 0._wp
+            CASE ( 'F' )                               ! F-point
+               ARRAY_IN(:,ipj,:,:,jf) = 0._wp
+            END SELECT
+            !
+         END SELECT     !  npolj
+         !
+      END DO
+      !
+   END SUBROUTINE ROUTINE_NFD
+
+#undef ARRAY_TYPE
+#undef ARRAY_IN
+#undef NAT_IN
+#undef SGN_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_nogather_generic.h90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_nogather_generic.h90	(revision 8226)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_nogather_generic.h90	(revision 8226)
@@ -0,0 +1,333 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   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
+#      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_2D),INTENT(inout)::ptab2(f)
+#      define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt2d(i,j)
+#   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
+#      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_3D),INTENT(inout)::ptab2(f)
+#      define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt3d(i,j,k)
+#   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)
+#      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_4D),INTENT(inout)::ptab2(f)
+#      define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt4d(i,j,k,l)
+#   endif
+#else
+!                          !==  IN: ptab is an array  ==!
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   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
+#      define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j)
+#   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
+#      define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j,k)
+#   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)
+#      define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j,k,l)
+#   endif
+#   define ARRAY_TYPE(i,j,k,l,f)     REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
+#   define ARRAY2_TYPE(i,j,k,l,f)    REAL(wp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f)
+#endif
+
+   SUBROUTINE ROUTINE_NFD( ptab, ptab2, cd_nat, psgn, kfld )
+      !
+      !!----------------------------------------------------------------------
+      !!
+      !! ** Purpose :   lateral boundary condition : North fold treatment
+      !!                without allgather exchanges. 
+      !!
+      !!----------------------------------------------------------------------
+      ARRAY_TYPE(:,:,:,:,:)                             ! array or pointer of arrays on which the boundary condition is applied
+      ARRAY2_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
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays
+      !
+      INTEGER  ::    ji,  jj,   jk,     jl,   jh,  jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj,  ipk,    ipl,  ipf        ! dimension of the input array
+      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
+      !!----------------------------------------------------------------------
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      !
+      SELECT CASE ( jpni )
+      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
+      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
+      END SELECT
+      ijpjm1 = ijpj-1
+      !
+      !
+      DO jf = 1, ipf                      ! Loop over the number of arrays to be processed
+         SELECT CASE ( npolj )
+         !
+         CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf) )
+               CASE ( 'T' , 'W' )                         ! T-, W-point
+                  IF ( nimpp /= 1 ) THEN   ;   startloop = 1
+                  ELSE                     ;   startloop = 2
+               ENDIF
+                  !
+               DO ji = startloop, nlci
+                 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                        ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf)
+               END DO
+               IF(nimpp .eq. 1) THEN
+                 ARRAY_IN(1,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ijpj-2,:,:,jf)
+               ENDIF
+   
+               IF( nimpp >= jpiglo/2+1 ) THEN
+                  startloop = 1
+               ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
+                  startloop = jpiglo/2+1 - nimpp + 1
+               ELSE
+                  startloop = nlci + 1
+               ENDIF
+               IF(startloop <= nlci) THEN
+               DO ji = startloop, nlci
+                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                  jia = ji + nimpp - 1
+                  ijta = jpiglo - jia + 2
+                  IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN
+                             ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+1,ijpjm1,:,:,jf)
+                  ELSE
+                             ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf)
+                  ENDIF
+               END DO
+               ENDIF
+               !
+            CASE ( 'U' )                                     ! U-point
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = 1, endloop
+                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                        ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-2,:,:,jf)
+               END DO
+               IF (nimpp .eq. 1) THEN
+                        ARRAY_IN(   1  ,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(    2   ,ijpj-2,:,:,jf)
+               ENDIF
+               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                        ARRAY_IN(nlci,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,ijpj-2,:,:,jf)
+               ENDIF
+               !
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               IF( nimpp >= jpiglo/2 ) THEN
+                  startloop = 1
+                  ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN
+                  startloop = jpiglo/2 - nimpp + 1
+               ELSE
+                  startloop = endloop + 1
+               ENDIF
+               IF( startloop <= endloop ) THEN
+               DO ji = startloop, endloop
+                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                  jia = ji + nimpp - 1
+                  ijua = jpiglo - jia + 1
+                  IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN
+                           ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,ijpjm1,:,:,jf)
+                  ELSE
+                           ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjm1,:,:,jf)
+                  ENDIF
+               END DO
+               ENDIF
+               !
+            CASE ( 'V' )                                     ! V-point
+               IF( nimpp /= 1 ) THEN
+                 startloop = 1
+               ELSE
+                 startloop = 2
+               ENDIF
+               DO ji = startloop, nlci
+                 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                        ARRAY_IN(ji,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf)
+                        ARRAY_IN(ji,ijpj  ,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-3,:,:,jf)
+               END DO
+               IF (nimpp .eq. 1) THEN
+                        ARRAY_IN(1,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ijpj-3,:,:,jf)
+               ENDIF
+            CASE ( 'F' )                                     ! F-point
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = 1, endloop
+                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                        ARRAY_IN(ji,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-2,:,:,jf)
+                        ARRAY_IN(ji,ijpj  ,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-3,:,:,jf)
+               END DO
+               IF (nimpp .eq. 1) THEN
+                        ARRAY_IN(   1  ,ijpj  ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(    2   ,ijpj-3,:,:,jf)
+                        ARRAY_IN(   1  ,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(    2   ,ijpj-2,:,:,jf)
+               ENDIF
+               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                        ARRAY_IN(nlci,ijpj  ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,ijpj-3,:,:,jf)
+                        ARRAY_IN(nlci,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,ijpj-2,:,:,jf) 
+               ENDIF
+               !
+            CASE ( 'I' )                                     ! ice U-V point (I-point)
+               IF( nimpp /= 1 ) THEN
+                  startloop = 1
+               ELSE
+                  startloop = 3
+                  ARRAY_IN(2,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(3,ijpjm1,:,:,jf)
+               ENDIF
+               DO ji = startloop, nlci
+                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
+                  ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjm1,:,:,jf)
+               END DO
+            END SELECT
+            !
+         CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf) )
+            CASE ( 'T' , 'W' )                               ! T-, W-point
+               DO ji = 1, nlci
+                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                        ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-1,:,:,jf)
+               END DO
+               !
+            CASE ( 'U' )                                     ! U-point
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = 1, endloop
+                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                        ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-1,:,:,jf)
+               END DO
+               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                        ARRAY_IN(nlci,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(1,ijpj-1,:,:,jf)
+               ENDIF
+               !
+            CASE ( 'V' )                                     ! V-point
+               DO ji = 1, nlci
+                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                        ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf)
+               END DO
+                  !
+               IF( nimpp >= jpiglo/2+1 ) THEN
+                  startloop = 1
+               ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
+                  startloop = jpiglo/2+1 - nimpp + 1
+               ELSE
+                  startloop = nlci + 1
+               ENDIF
+               IF( startloop <= nlci ) THEN
+               DO ji = startloop, nlci
+                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                          ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf)
+               END DO
+               ENDIF
+               !
+            CASE ( 'F' )                               ! F-point
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = 1, endloop
+                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                        ARRAY_IN(ji,ijpj ,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-2,:,:,jf)
+               END DO
+               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                        ARRAY_IN(nlci,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(1,ijpj-2,:,:,jf)
+               ENDIF
+               !
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               IF( nimpp >= jpiglo/2+1 ) THEN
+                  startloop = 1
+               ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
+                  startloop = jpiglo/2+1 - nimpp + 1
+               ELSE
+                  startloop = endloop + 1
+               ENDIF
+               IF( startloop <= endloop ) THEN
+                  DO ji = startloop, endloop
+                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                      ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjm1,:,:,jf)
+                  END DO
+               ENDIF
+               !
+            CASE ( 'I' )                                  ! ice U-V point (I-point)
+                  IF( nimpp /= 1 ) THEN
+                     startloop = 1
+                  ELSE
+                     startloop = 2
+                  ENDIF
+                  IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                     endloop = nlci
+                  ELSE
+                     endloop = nlci - 1
+                  ENDIF
+                  DO ji = startloop , endloop
+                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                     ARRAY_IN(ji,ijpj,:,:,jf) = 0.5 * (ARRAY_IN(ji,ijpjm1,:,:,jf) + SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf))
+                  END DO
+                  !
+            END SELECT
+            !
+         CASE DEFAULT                           ! *  closed : the code probably never go through
+            !
+            SELECT CASE ( NAT_IN(jf))
+            CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
+                  ARRAY_IN(:, 1  ,:,:,jf) = 0._wp
+                  ARRAY_IN(:,ijpj,:,:,jf) = 0._wp
+            CASE ( 'F' )                                   ! F-point
+                  ARRAY_IN(:,ijpj,:,:,jf) = 0._wp
+            CASE ( 'I' )                                   ! ice U-V point
+                  ARRAY_IN(:, 1  ,:,:,jf) = 0._wp
+                  ARRAY_IN(:,ijpj,:,:,jf) = 0._wp
+            END SELECT
+            !
+         END SELECT     !  npolj
+         !
+      END DO            ! End jf loop
+   END SUBROUTINE ROUTINE_NFD
+#undef ARRAY_TYPE
+#undef ARRAY_IN
+#undef NAT_IN
+#undef SGN_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
+#undef ARRAY2_TYPE
+#undef ARRAY2_IN
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 8226)
@@ -2,12 +2,15 @@
    !!======================================================================
    !!                       ***  MODULE  lbclnk  ***
-   !! Ocean        : lateral boundary conditions
+   !! NEMO        : lateral boundary conditions
    !!=====================================================================
    !! History :  OPA  ! 1997-06  (G. Madec)  Original code
    !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
    !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment  
-   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco) optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk
+   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco)  optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk
    !!            3.4  ! 2012-12  (R. Bourdalle-Badie, G. Reffray)  add a C1D case  
    !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi  
+   !!            4.0  ! 2017-03  (G. Madec) automatique allocation of array size (use with any 3rd dim size)
+   !!             -   ! 2017-04  (G. Madec) remove duplicated routines (lbc_lnk_2d_9, lbc_lnk_2d_multiple, lbc_lnk_3d_gather)
+   !!             -   ! 2017-05  (G. Madec) create generic.h90 files to generate all lbc and north fold routines
    !!----------------------------------------------------------------------
 #if defined key_mpp_mpi
@@ -15,21 +18,22 @@
    !!   'key_mpp_mpi'             MPI massively parallel processing library
    !!----------------------------------------------------------------------
-   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
-   !!   lbc_sum      : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d routines defined in lib_mpp
-   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
-   !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
-   !!----------------------------------------------------------------------
+   !!           define the generic interfaces of lib_mpp routines
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk       : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
+   !!   lbc_lnk_e     : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
+   !!   lbc_bdy_lnk   : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean dynamics and tracers   
    USE lib_mpp        ! distributed memory computing library
-
+   USE lbcnfd         ! north fold
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE   mpp_lnk_2d      , mpp_lnk_3d      , mpp_lnk_4d
+   END INTERFACE
+   INTERFACE lbc_lnk_ptr
+      MODULE PROCEDURE   mpp_lnk_2d_ptr  , mpp_lnk_3d_ptr  , mpp_lnk_4d_ptr
+   END INTERFACE
    INTERFACE lbc_lnk_multi
-      MODULE PROCEDURE mpp_lnk_2d_9, mpp_lnk_2d_multiple
-   END INTERFACE
-   !
-   INTERFACE lbc_lnk
-      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
-   END INTERFACE
-   !
-   INTERFACE lbc_sum
-      MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d
+      MODULE PROCEDURE   lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi
    END INTERFACE
    !
@@ -46,21 +50,24 @@
    END INTERFACE
 
-   PUBLIC   lbc_lnk       ! ocean lateral boundary conditions
-   PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions
-   PUBLIC   lbc_sum
-   PUBLIC   lbc_lnk_e     !
+   PUBLIC   lbc_lnk       ! ocean/ice lateral boundary conditions
+   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions
+   PUBLIC   lbc_lnk_e     ! extended ocean/ice lateral boundary conditions
    PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
-   PUBLIC   lbc_lnk_icb   !
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
+CONTAINS
+
 #else
    !!----------------------------------------------------------------------
    !!   Default option                              shared memory computing
    !!----------------------------------------------------------------------
-   !!   lbc_sum       : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d 
+   !!                routines setting the appropriate values
+   !!         on first and last row and column of the global domain
+   !!----------------------------------------------------------------------
    !!   lbc_lnk_sum_3d: compute sum over the halos on a 3D variable on ocean mesh
    !!   lbc_lnk_sum_3d: compute sum over the halos on a 2D variable on ocean mesh
@@ -70,8 +77,8 @@
    !!   lbc_bdy_lnk   : set the lateral BDY boundary condition
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers   
-   USE dom_oce         ! ocean space and time domain 
-   USE in_out_manager  ! I/O manager
-   USE lbcnfd          ! north fold
+   USE oce            ! ocean dynamics and tracers   
+   USE dom_oce        ! ocean space and time domain 
+   USE in_out_manager ! I/O manager
+   USE lbcnfd         ! north fold
 
    IMPLICIT NONE
@@ -79,19 +86,17 @@
 
    INTERFACE lbc_lnk
-      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
-   END INTERFACE
-   !
-   INTERFACE lbc_sum
-      MODULE PROCEDURE lbc_lnk_sum_3d, lbc_lnk_sum_2d
-   END INTERFACE
-
+      MODULE PROCEDURE   lbc_lnk_2d      , lbc_lnk_3d      , lbc_lnk_4d
+   END INTERFACE
+   INTERFACE lbc_lnk_ptr
+      MODULE PROCEDURE   lbc_lnk_2d_ptr  , lbc_lnk_3d_ptr  , lbc_lnk_4d_ptr
+   END INTERFACE
+   INTERFACE lbc_lnk_multi
+      MODULE PROCEDURE   lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi
+   END INTERFACE
+   !
    INTERFACE lbc_lnk_e
       MODULE PROCEDURE lbc_lnk_2d_e
    END INTERFACE
    !
-   INTERFACE lbc_lnk_multi
-      MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple
-   END INTERFACE
-
    INTERFACE lbc_bdy_lnk
       MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d
@@ -102,18 +107,12 @@
    END INTERFACE
    
-   TYPE arrayptr
-      REAL , DIMENSION (:,:),  POINTER :: pt2d
-   END TYPE arrayptr
-   PUBLIC   arrayptr
-
    PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
-   PUBLIC   lbc_sum       ! ocean/ice  lateral boundary conditions (sum of the overlap region)
-   PUBLIC   lbc_lnk_e     !
-   PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions
+   PUBLIC   lbc_lnk_e     ! extended ocean/ice lateral boundary conditions
+   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions
    PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
-   PUBLIC   lbc_lnk_icb   !
-   
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -122,26 +121,9 @@
 
 # if defined key_c1d
-   !!----------------------------------------------------------------------
+   !!======================================================================
    !!   'key_c1d'                                          1D configuration
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (C1D case)
-      !!
-      !! ** Method  :   call lbc_lnk_3d on pt3d1 and pt3d2
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign 
-      !!----------------------------------------------------------------------
-      !
-      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
-      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
-      !
-   END SUBROUTINE lbc_lnk_3d_gather
-
+   !!======================================================================
+   !!     central point value replicated over the 8 surrounding points
+   !!----------------------------------------------------------------------
 
    SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
@@ -153,9 +135,9 @@
       !! ** Method  :   1D case, the central water column is set everywhere
       !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign 
-      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
-      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)          , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                  , INTENT(in   )           ::   psgn      ! sign used across north fold 
+      CHARACTER(len=3)          , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
+      REAL(wp)                  , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
       !
       INTEGER  ::   jk     ! dummy loop index
@@ -163,5 +145,5 @@
       !!----------------------------------------------------------------------
       !
-      DO jk = 1, jpk
+      DO jk = 1, SIZE( pt3d, 3 )
          ztab = pt3d(2,2,jk)
          pt3d(:,:,jk) = ztab
@@ -179,7 +161,7 @@
       !! ** Method  :   1D case, the central water column is set everywhere
       !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
       CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
-      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign 
+      REAL(wp)                    , INTENT(in   )           ::   psgn      ! sign used across north fold 
       CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
       REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
@@ -193,490 +175,166 @@
    END SUBROUTINE lbc_lnk_2d
    
-   SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields )
-      !!
-      INTEGER :: num_fields
-      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
-      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
-      !                                                               ! = T , U , V , F , W and I points
-      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary
-      !                                                               ! =  1. , the sign is kept
-      !
-      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES
-      !
-      DO ii = 1, num_fields
-        CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) )
-      END DO     
-      !
-   END SUBROUTINE lbc_lnk_2d_multiple
-
-   SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
-      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
-      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
-      !!---------------------------------------------------------------------
-      ! Second 2D array on which the boundary condition is applied
-      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI
-      ! define the nature of ptab array grid-points
-      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA
-      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
-      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
-      ! =-1 the sign change across the north fold boundary
-      REAL(wp)                                      , INTENT(in   ) ::   psgnA
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI
-      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      !!---------------------------------------------------------------------
-
-      !!The first array
-      CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 
-
-      !! Look if more arrays to process
-      IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dB, cd_typeB, psgnB )
-      IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC ) 
-      IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD ) 
-      IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE ) 
-      IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF ) 
-      IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG ) 
-      IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH ) 
-      IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI ) 
-
-   END SUBROUTINE lbc_lnk_2d_9
-
-
-
-
-
 #else
-   !!----------------------------------------------------------------------
+   !!======================================================================
    !!   Default option                           3D shared memory computing
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (non mpp case)
-      !!
-      !! ** Method  :   psign = -1 :    change the sign across the north fold
-      !!                      =  1 : no change of the sign across the north fold
-      !!                      =  0 : no change of the sign across the north fold and
-      !!                             strict positivity preserved: use inner row/column
-      !!                             for closed boundaries.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign 
-      !!----------------------------------------------------------------------
-      !
-      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
-      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
-      !
-   END SUBROUTINE lbc_lnk_3d_gather
-
-
-   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_lnk_3d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
-      !!
-      !! ** Method  :   psign = -1 :    change the sign across the north fold
-      !!                      =  1 : no change of the sign across the north fold
-      !!                      =  0 : no change of the sign across the north fold and
-      !!                             strict positivity preserved: use inner row/column
-      !!                             for closed boundaries.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign 
-      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
-      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
-      !!
-      REAL(wp) ::   zland
-      !!----------------------------------------------------------------------
-
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
-      ELSE                         ;   zland = 0._wp
-      ENDIF
-
-
-      IF( PRESENT( cd_mpp ) ) THEN
-         ! only fill the overlap area and extra allows 
-         ! this is in mpp case. In this module, just do nothing
-      ELSE
-         !                                     !  East-West boundaries
-         !                                     ! ======================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
-            pt3d( 1 ,:,:) = pt3d(jpim1,:,:)            ! all points
-            pt3d(jpi,:,:) = pt3d(  2  ,:,:)
-            !
-         CASE DEFAULT                             !**  East closed  --  West closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d( 1 ,:,:) = zland
-               pt3d(jpi,:,:) = zland
-            CASE ( 'F' )                               ! F-point
-               pt3d(jpi,:,:) = zland
-            END SELECT
-            !
-         END SELECT
-         !                                     ! North-South boundaries
-         !                                     ! ======================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 2 )                               !**  South symmetric  --  North closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
-               pt3d(:, 1 ,:) = pt3d(:,3,:)
-               pt3d(:,jpj,:) = zland
-            CASE ( 'V' , 'F' )                         ! V-, F-points
-               pt3d(:, 1 ,:) = psgn * pt3d(:,2,:)
-               pt3d(:,jpj,:) = zland
-            END SELECT
-            !
-         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
-            SELECT CASE ( cd_type )                    ! South : closed
-            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
-               pt3d(:, 1 ,:) = zland
-            END SELECT
-            !                                          ! North fold
-            CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
-            !
-         CASE DEFAULT                             !**  North closed  --  South closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d(:, 1 ,:) = zland
-               pt3d(:,jpj,:) = zland
-            CASE ( 'F' )                               ! F-point
-               pt3d(:,jpj,:) = zland
-            END SELECT
-            !
-         END SELECT
-         !
-      ENDIF
-      !
-   END SUBROUTINE lbc_lnk_3d
-
-
-   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE lbc_lnk_2d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
-      !!
-      !! ** Method  :   psign = -1 :    change the sign across the north fold
-      !!                      =  1 : no change of the sign across the north fold
-      !!                      =  0 : no change of the sign across the north fold and
-      !!                             strict positivity preserved: use inner row/column
-      !!                             for closed boundaries.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
-      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign 
-      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
-      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
-      !!
-      REAL(wp) ::   zland
-      !!----------------------------------------------------------------------
-
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
-      ELSE                         ;   zland = 0._wp
-      ENDIF
-
-      IF (PRESENT(cd_mpp)) THEN
-         ! only fill the overlap area and extra allows 
-         ! this is in mpp case. In this module, just do nothing
-      ELSE      
-         !                                     ! East-West boundaries
-         !                                     ! ====================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
-            pt2d( 1 ,:) = pt2d(jpim1,:)               ! all points
-            pt2d(jpi,:) = pt2d(  2  ,:)
-            !
-         CASE DEFAULT                             !** East closed  --  West closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
-               pt2d( 1 ,:) = zland
-               pt2d(jpi,:) = zland
-            CASE ( 'F' )                              ! F-point
-               pt2d(jpi,:) = zland
-            END SELECT
-            !
-         END SELECT
-         !                                     ! North-South boundaries
-         !                                     ! ======================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 2 )                               !**  South symmetric  --  North closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
-               pt2d(:, 1 ) = pt2d(:,3)
-               pt2d(:,jpj) = zland
-            CASE ( 'V' , 'F' )                         ! V-, F-points
-               pt2d(:, 1 ) = psgn * pt2d(:,2)
-               pt2d(:,jpj) = zland
-            END SELECT
-            !
-         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
-            SELECT CASE ( cd_type )                    ! South : closed
-            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
-               pt2d(:, 1 ) = zland
-            END SELECT
-            !                                          ! North fold
-            CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
-            !
-         CASE DEFAULT                             !**  North closed  --  South closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt2d(:, 1 ) = zland
-               pt2d(:,jpj) = zland
-            CASE ( 'F' )                               ! F-point
-               pt2d(:,jpj) = zland
-            END SELECT
-            !
-         END SELECT
-         !
-      ENDIF
-      !    
-   END SUBROUTINE lbc_lnk_2d
-   
-   SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields )
-      !!
-      INTEGER :: num_fields
-      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
-      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
-      !                                                               ! = T , U , V , F , W and I points
-      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary
-      !                                                               ! =  1. , the sign is kept
-      !
-      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES
-      !
-      DO ii = 1, num_fields
-        CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) )
-      END DO     
-      !
-   END SUBROUTINE lbc_lnk_2d_multiple
-
-   SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
-      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
-      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
-      !!---------------------------------------------------------------------
-      ! Second 2D array on which the boundary condition is applied
-      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI
-      ! define the nature of ptab array grid-points
-      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA
-      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
-      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
-      ! =-1 the sign change across the north fold boundary
-      REAL(wp)                                      , INTENT(in   ) ::   psgnA
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI
-      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      !!---------------------------------------------------------------------
-
-      !!The first array
-      CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 
-
-      !! Look if more arrays to process
-      IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dB, cd_typeB, psgnB )
-      IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC ) 
-      IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD ) 
-      IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE ) 
-      IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF ) 
-      IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG ) 
-      IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH ) 
-      IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI ) 
-
-   END SUBROUTINE lbc_lnk_2d_9
-
-   SUBROUTINE lbc_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval )
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE lbc_lnk_sum_2d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
-      !!
-      !! ** Comments:   compute the sum of the common cell (overlap region) for the ice sheet/ocean 
-      !!                coupling if conservation option activated. As no ice shelf are present along
-      !!                this line, nothing is done along the north fold.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
-      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign 
-      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
-      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
-      !!
-      REAL(wp) ::   zland
-      !!----------------------------------------------------------------------
-
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
-      ELSE                         ;   zland = 0._wp
-      ENDIF
-
-      IF (PRESENT(cd_mpp)) THEN
-         ! only fill the overlap area and extra allows 
-         ! this is in mpp case. In this module, just do nothing
-      ELSE
-         !                                     ! East-West boundaries
-         !                                     ! ====================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
-            pt2d(jpim1,:) = pt2d(jpim1,:) + pt2d( 1 ,:)
-            pt2d(  2  ,:) = pt2d(  2  ,:) + pt2d(jpi,:)
-            pt2d( 1 ,:) = 0.0_wp               ! all points
-            pt2d(jpi,:) = 0.0_wp
-            !
-         CASE DEFAULT                             !** East closed  --  West closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
-               pt2d( 1 ,:) = zland
-               pt2d(jpi,:) = zland
-            CASE ( 'F' )                              ! F-point
-               pt2d(jpi,:) = zland
-            END SELECT
-            !
-         END SELECT
-         !                                     ! North-South boundaries
-         !                                     ! ======================
-         ! Nothing to do for the north fold, there is no ice shelf along this line.
-         !
-      END IF
-
-   END SUBROUTINE
-
-   SUBROUTINE lbc_lnk_sum_3d( pt3d, cd_type, psgn, cd_mpp, pval )
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE lbc_lnk_sum_3d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
-      !!
-      !! ** Comments:   compute the sum of the common cell (overlap region) for the ice sheet/ocean 
-      !!                coupling if conservation option activated. As no ice shelf are present along
-      !!                this line, nothing is done along the north fold.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign 
-      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
-      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
-      !!
-      REAL(wp) ::   zland
-      !!----------------------------------------------------------------------
-
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
-      ELSE                         ;   zland = 0._wp
-      ENDIF
-
-
-      IF( PRESENT( cd_mpp ) ) THEN
-         ! only fill the overlap area and extra allows 
-         ! this is in mpp case. In this module, just do nothing
-      ELSE
-         !                                     !  East-West boundaries
-         !                                     ! ======================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
-            pt3d(jpim1,:,:) = pt3d(jpim1,:,:) + pt3d( 1 ,:,:)
-            pt3d(  2  ,:,:) = pt3d(  2  ,:,:) + pt3d(jpi,:,:) 
-            pt3d( 1 ,:,:) = 0.0_wp            ! all points
-            pt3d(jpi,:,:) = 0.0_wp
-            !
-         CASE DEFAULT                             !**  East closed  --  West closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d( 1 ,:,:) = zland
-               pt3d(jpi,:,:) = zland
-            CASE ( 'F' )                               ! F-point
-               pt3d(jpi,:,:) = zland
-            END SELECT
-            !
-         END SELECT
-         !                                     ! North-South boundaries
-         !                                     ! ======================
-         ! Nothing to do for the north fold, there is no ice shelf along this line.
-         !
-      END IF
-   END SUBROUTINE
-
-
+   !!======================================================================
+   !!          routines setting land point, or east-west cyclic,
+   !!             or north-south cyclic, or north fold values
+   !!         on first and last row and column of the global domain
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine lbc_lnk_(2,3,4)d  ***
+   !!
+   !!   * Argument : dummy argument use in lbc_lnk_... routines
+   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
+   !!                cd_nat :   nature of array grid-points
+   !!                psgn   :   sign used across the north fold boundary
+   !!                kfld   :   optional, number of pt3d arrays
+   !!                cd_mpp :   optional, fill the overlap area only
+   !!                pval   :   optional, background value (used at closed boundaries)
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_LNK           lbc_lnk_2d
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           lbc_lnk_2d_ptr
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_LNK           lbc_lnk_3d
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           lbc_lnk_3d_ptr
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_LNK           lbc_lnk_4d
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           lbc_lnk_4d_ptr
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_4d
+   
 #endif
 
+   !!======================================================================
+   !!   identical routines in both C1D and shared memory computing
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine lbc_bdy_lnk_(2,3)d  ***
+   !!
+   !!   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
+   !!   to maintain the same interface with regards to the mpp case
+   !!----------------------------------------------------------------------
+   
    SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_bdy_lnk  ***
-      !!
-      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
-      !!              to maintain the same interface with regards to the mpp case
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   ) ::   psgn      ! control of the sign 
-      INTEGER                         , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
-      !!----------------------------------------------------------------------
-      !
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                  , INTENT(in   ) ::   psgn      ! sign used across north fold 
+      INTEGER                   , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
+      !!----------------------------------------------------------------------
       CALL lbc_lnk_3d( pt3d, cd_type, psgn)
-      !
    END SUBROUTINE lbc_bdy_lnk_3d
 
 
    SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_bdy_lnk  ***
-      !!
-      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
-      !!              to maintain the same interface with regards to the mpp case
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied
-      REAL(wp)                    , INTENT(in   ) ::   psgn      ! control of the sign 
-      INTEGER                     , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
-      !!----------------------------------------------------------------------
-      !
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold 
+      INTEGER                 , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
+      !!----------------------------------------------------------------------
       CALL lbc_lnk_2d( pt2d, cd_type, psgn)
-      !
    END SUBROUTINE lbc_bdy_lnk_2d
 
 
-   SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj )
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE lbc_lnk_2d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
-      !!                special dummy routine to allow for use of halo indexing in mpp case
-      !!
-      !! ** Method  :   psign = -1 :    change the sign across the north fold
-      !!                      =  1 : no change of the sign across the north fold
-      !!                      =  0 : no change of the sign across the north fold and
-      !!                             strict positivity preserved: use inner row/column
-      !!                             for closed boundaries.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 2D array on which the lbc is applied
-      REAL(wp)                    , INTENT(in   ) ::   psgn      ! control of the sign 
-      INTEGER                     , INTENT(in   ) ::   jpri      ! size of extra halo (not needed in non-mpp)
-      INTEGER                     , INTENT(in   ) ::   jprj      ! size of extra halo (not needed in non-mpp)
-      !!----------------------------------------------------------------------
-      !
+!!gm  This routine should be remove with an optional halos size added in orgument of generic routines
+
+   SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, ki, kj )
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the lbc is applied
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold 
+      INTEGER                 , INTENT(in   ) ::   ki, kj    ! sizes of extra halo (not needed in non-mpp)
+      !!----------------------------------------------------------------------
       CALL lbc_lnk_2d( pt2d, cd_type, psgn )
-      !    
    END SUBROUTINE lbc_lnk_2d_e
+!!gm end
 
 #endif
 
    !!======================================================================
+   !!   identical routines in both distributed and shared memory computing
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!                   ***   load_ptr_(2,3,4)d   ***
+   !!
+   !!   * Dummy Argument :
+   !!       in    ==>   ptab       ! array to be loaded (2D, 3D or 4D)
+   !!                   cd_nat     ! nature of pt2d array grid-points
+   !!                   psgn       ! sign used across the north fold boundary
+   !!       inout <=>   ptab_ptr   ! array of 2D, 3D or 4D pointers
+   !!                   cdna_ptr   ! nature of ptab array grid-points
+   !!                   psgn_ptr   ! sign used across the north fold boundary
+   !!                   kfld       ! number of elements that has been attributed
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!                  ***   lbc_lnk_(2,3,4)d_multi   ***
+   !!                     ***   load_ptr_(2,3,4)d   ***
+   !!
+   !!   * Argument : dummy argument use in lbc_lnk_multi_... routines
+   !!
+   !!----------------------------------------------------------------------
+
+#  define DIM_2d
+#     define ROUTINE_MULTI          lbc_lnk_2d_multi
+#     define ROUTINE_LOAD           load_ptr_2d
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_2d
+
+
+#  define DIM_3d
+#     define ROUTINE_MULTI          lbc_lnk_3d_multi
+#     define ROUTINE_LOAD           load_ptr_3d
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_3d
+
+
+#  define DIM_4d
+#     define ROUTINE_MULTI          lbc_lnk_4d_multi
+#     define ROUTINE_LOAD           load_ptr_4d
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_4d
+
+   !!======================================================================
 END MODULE lbclnk
 
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 8226)
@@ -5,5 +5,6 @@
    !!======================================================================
    !! History :  3.2  ! 2009-03  (R. Benshila)  Original code 
-   !!            3.5  ! 2013-07 (I. Epicoco, S. Mocavero - CMCC) MPP optimization 
+   !!            3.5  ! 2013-07  (I. Epicoco, S. Mocavero - CMCC) MPP optimization
+   !!            4.0  ! 2017-04  (G. Madec) automatique allocation of array argument (use any 3rd dimension)
    !!----------------------------------------------------------------------
 
@@ -12,6 +13,8 @@
    !!   lbc_nfd_3d    : lateral boundary condition: North fold treatment for a 3D arrays   (lbc_nfd)
    !!   lbc_nfd_2d    : lateral boundary condition: North fold treatment for a 2D arrays   (lbc_nfd)
-   !!   mpp_lbc_nfd_3d    : North fold treatment for a 3D arrays optimized for MPP
-   !!   mpp_lbc_nfd_2d    : North fold treatment for a 2D arrays optimized for MPP
+   !!   lbc_nfd_nogather       : generic interface for lbc_nfd_nogather_3d and 
+   !!                            lbc_nfd_nogather_2d routines (designed for use
+   !!                            with ln_nnogather to avoid global width arrays
+   !!                            mpi all gather operations)
    !!----------------------------------------------------------------------
    USE dom_oce        ! ocean space and time domain 
@@ -22,13 +25,28 @@
 
    INTERFACE lbc_nfd
-      MODULE PROCEDURE   lbc_nfd_3d, lbc_nfd_2d
+      MODULE PROCEDURE   lbc_nfd_2d    , lbc_nfd_3d    , lbc_nfd_4d
+      MODULE PROCEDURE   lbc_nfd_2d_ptr, lbc_nfd_3d_ptr, lbc_nfd_4d_ptr
    END INTERFACE
    !
-   INTERFACE mpp_lbc_nfd
-      MODULE PROCEDURE   mpp_lbc_nfd_3d, mpp_lbc_nfd_2d
+   INTERFACE lbc_nfd_nogather
+!                        ! Currently only 4d array version is needed
+!     MODULE PROCEDURE   lbc_nfd_nogather_2d    , lbc_nfd_nogather_3d
+      MODULE PROCEDURE   lbc_nfd_nogather_4d
+!     MODULE PROCEDURE   lbc_nfd_nogather_2d_ptr, lbc_nfd_nogather_3d_ptr
+!     MODULE PROCEDURE   lbc_nfd_nogather_4d_ptr
    END INTERFACE
 
-   PUBLIC   lbc_nfd       ! north fold conditions
-   PUBLIC   mpp_lbc_nfd   ! north fold conditions (parallel case)
+   TYPE, PUBLIC ::   PTR_2D   !: array of 2D pointers (also used in lib_mpp)
+      REAL(wp), DIMENSION (:,:)    , POINTER ::   pt2d
+   END TYPE PTR_2D
+   TYPE, PUBLIC ::   PTR_3D   !: array of 3D pointers (also used in lib_mpp)
+      REAL(wp), DIMENSION (:,:,:)  , POINTER ::   pt3d
+   END TYPE PTR_3D
+   TYPE, PUBLIC ::   PTR_4D   !: array of 4D pointers (also used in lib_mpp)
+      REAL(wp), DIMENSION (:,:,:,:), POINTER ::   pt4d
+   END TYPE PTR_4D
+
+   PUBLIC   lbc_nfd            ! north fold conditions
+   PUBLIC   lbc_nfd_nogather   ! north fold conditions (no allgather case)
 
    INTEGER, PUBLIC, PARAMETER            ::   jpmaxngh = 3               !:
@@ -43,130 +61,104 @@
 CONTAINS
 
-   SUBROUTINE lbc_nfd_3d( pt3d, cd_type, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine lbc_nfd_3d  ***
-      !!
-      !! ** Purpose :   3D lateral boundary condition : North fold treatment
-      !!              without processor exchanges. 
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  :   pt3d with updated values along the north fold
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                        !   = T , U , V , F , W points
-      REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                        !   = -1. , the sign is changed if north fold boundary
-      !                                                        !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the boundary condition is applied
-      !
-      INTEGER  ::   ji, jk
-      INTEGER  ::   ijt, iju, ijpj, ijpjm1
-      !!----------------------------------------------------------------------
-
-      SELECT CASE ( jpni )
-      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
-      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
-      END SELECT
-      ijpjm1 = ijpj-1
-
-      DO jk = 1, jpk
-         !
-         SELECT CASE ( npolj )
-         !
-         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
-            !
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO ji = 2, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
-               END DO
-               pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-2,jk)
-               DO ji = jpiglo/2+1, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
-               END DO
-            CASE ( 'U' )                               ! U-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk)
-               END DO
-               pt3d(   1  ,ijpj,jk) = psgn * pt3d(    2   ,ijpj-2,jk)
-               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-2,jk) 
-               DO ji = jpiglo/2, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
-               END DO
-            CASE ( 'V' )                               ! V-point
-               DO ji = 2, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk)
-                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(ijt,ijpj-3,jk)
-               END DO
-               pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-3,jk) 
-            CASE ( 'F' )                               ! F-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk)
-                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-3,jk)
-               END DO
-               pt3d(   1  ,ijpj,jk) = psgn * pt3d(    2   ,ijpj-3,jk)
-               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-3,jk) 
-            END SELECT
-            !
-         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
-            !
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO ji = 1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk)
-               END DO
-            CASE ( 'U' )                               ! U-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk)
-               END DO
-               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-1,jk)
-            CASE ( 'V' )                               ! V-point
-               DO ji = 1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
-               END DO
-               DO ji = jpiglo/2+1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
-               END DO
-            CASE ( 'F' )                               ! F-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-2,jk)
-               END DO
-               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-2,jk)
-               DO ji = jpiglo/2+1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
-               END DO
-            END SELECT
-            !
-         CASE DEFAULT                           ! *  closed : the code probably never go through
-            !
-            SELECT CASE ( cd_type)
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d(:, 1  ,jk) = 0.e0
-               pt3d(:,ijpj,jk) = 0.e0
-            CASE ( 'F' )                               ! F-point
-               pt3d(:,ijpj,jk) = 0.e0
-            END SELECT
-            !
-         END SELECT     !  npolj
-         !
-      END DO
-      !
-   END SUBROUTINE lbc_nfd_3d
-
-
-   SUBROUTINE lbc_nfd_2d( pt2d, cd_type, psgn, pr2dj )
+   !!----------------------------------------------------------------------
+   !!                   ***  routine lbc_nfd_(2,3,4)d  ***
+   !!----------------------------------------------------------------------
+   !!
+   !! ** Purpose :   lateral boundary condition 
+   !!                North fold treatment without processor exchanges. 
+   !!
+   !! ** Method  :   
+   !!
+   !! ** Action  :   ptab with updated values along the north fold
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_NFD           lbc_nfd_2d
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_2d_ptr
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_NFD           lbc_nfd_3d
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_3d_ptr
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_NFD           lbc_nfd_4d
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_4d_ptr
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_4d
+   !
+   !  lbc_nfd_nogather routines
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+!#  define DIM_2d
+!#     define ROUTINE_NFD           lbc_nfd_nogather_2d
+!#     include "lbc_nfd_nogather_generic.h90"
+!#     undef ROUTINE_NFD
+!#     define MULTI
+!#     define ROUTINE_NFD           lbc_nfd_nogather_2d_ptr
+!#     include "lbc_nfd_nogather_generic.h90"
+!#     undef ROUTINE_NFD
+!#     undef MULTI
+!#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+!#  define DIM_3d
+!#     define ROUTINE_NFD           lbc_nfd_nogather_3d
+!#     include "lbc_nfd_nogather_generic.h90"
+!#     undef ROUTINE_NFD
+!#     define MULTI
+!#     define ROUTINE_NFD           lbc_nfd_nogather_3d_ptr
+!#     include "lbc_nfd_nogather_generic.h90"
+!#     undef ROUTINE_NFD
+!#     undef MULTI
+!#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_NFD           lbc_nfd_nogather_4d
+#     include "lbc_nfd_nogather_generic.h90"
+#     undef ROUTINE_NFD
+!#     define MULTI
+!#     define ROUTINE_NFD           lbc_nfd_nogather_4d_ptr
+!#     include "lbc_nfd_nogather_generic.h90"
+!#     undef ROUTINE_NFD
+!#     undef MULTI
+#  undef DIM_4d
+
+   !!----------------------------------------------------------------------
+
+
+!!gm   CAUTION HERE  optional pr2dj  not implemented in generic case
+!!gm                 furthermore, in the _org routine it is OK only for T-point pivot !!
+
+
+   SUBROUTINE lbc_nfd_2d_org( pt2d, cd_nat, psgn, pr2dj )
       !!----------------------------------------------------------------------
       !!                  ***  routine lbc_nfd_2d  ***
@@ -179,10 +171,7 @@
       !! ** Action  :   pt2d with updated values along the north fold
       !!----------------------------------------------------------------------
-      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                      ! = T , U , V , F , W points
-      REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                      !   = -1. , the sign is changed if north fold boundary
-      !                                                      !   =  1. , the sign is kept  if north fold boundary
       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the boundary condition is applied
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_nat   ! nature of pt2d grid-point
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold
       INTEGER , OPTIONAL      , INTENT(in   ) ::   pr2dj     ! number of additional halos
       !
@@ -210,5 +199,5 @@
       CASE ( 3, 4 )                       ! *  North fold  T-point pivot
          !
-         SELECT CASE ( cd_type )
+         SELECT CASE ( cd_nat )
          !
          CASE ( 'T' , 'W' )                               ! T- , W-points
@@ -265,25 +254,9 @@
                END DO
             END DO
-         CASE ( 'J' )                                     ! first ice U-V point
-            DO jl =0, ipr2dj
-               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
-               DO ji = 3, jpiglo
-                  iju = jpiglo - ji + 3
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
-               END DO
-            END DO
-         CASE ( 'K' )                                     ! second ice U-V point
-            DO jl =0, ipr2dj
-               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
-               DO ji = 3, jpiglo
-                  iju = jpiglo - ji + 3
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
-               END DO
-            END DO
          END SELECT
          !
       CASE ( 5, 6 )                        ! *  North fold  F-point pivot
          !
-         SELECT CASE ( cd_type )
+         SELECT CASE ( cd_nat )
          CASE ( 'T' , 'W' )                               ! T-, W-point
             DO jl = 0, ipr2dj
@@ -325,5 +298,5 @@
             END DO
          CASE ( 'I' )                                  ! ice U-V point (I-point)
-            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
+            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0._wp
             DO jl = 0, ipr2dj
                DO ji = 2 , jpiglo-1
@@ -332,639 +305,22 @@
                END DO
             END DO
-         CASE ( 'J' )                                  ! first ice U-V point
-            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
-            DO jl = 0, ipr2dj
-               DO ji = 2 , jpiglo-1
-                  ijt = jpiglo - ji + 2
-                  pt2d(ji,ijpj+jl)= pt2d(ji,ijpj-1-jl)
-               END DO
-            END DO
-         CASE ( 'K' )                                  ! second ice U-V point
-            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
-            DO jl = 0, ipr2dj
-               DO ji = 2 , jpiglo-1
-                  ijt = jpiglo - ji + 2
-                  pt2d(ji,ijpj+jl)= pt2d(ijt,ijpj-1-jl)
-               END DO
-            END DO
          END SELECT
          !
       CASE DEFAULT                           ! *  closed : the code probably never go through
          !
-         SELECT CASE ( cd_type)
+         SELECT CASE ( cd_nat)
          CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
-            pt2d(:, 1:1-ipr2dj     ) = 0.e0
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+            pt2d(:, 1:1-ipr2dj     ) = 0._wp
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp
          CASE ( 'F' )                                   ! F-point
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp
          CASE ( 'I' )                                   ! ice U-V point
-            pt2d(:, 1:1-ipr2dj     ) = 0.e0
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
-         CASE ( 'J' )                                   ! first ice U-V point
-            pt2d(:, 1:1-ipr2dj     ) = 0.e0
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
-         CASE ( 'K' )                                   ! second ice U-V point
-            pt2d(:, 1:1-ipr2dj     ) = 0.e0
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+            pt2d(:, 1:1-ipr2dj     ) = 0._wp
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp
          END SELECT
          !
       END SELECT
       !
-   END SUBROUTINE lbc_nfd_2d
-
-
-   SUBROUTINE mpp_lbc_nfd_3d( pt3dl, pt3dr, cd_type, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lbc_nfd_3d  ***
-      !!
-      !! ** Purpose :   3D lateral boundary condition : North fold treatment
-      !!              without processor exchanges. 
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  :   pt3d with updated values along the north fold
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                        !   = T , U , V , F , W points
-      REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                        !   = -1. , the sign is changed if north fold boundary
-      !                                                        !   =  1. , the sign is kept    if north fold boundary
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3dl     ! 3D array on which the boundary condition is applied
-      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pt3dr     ! 3D array on which the boundary condition is applied
-      !
-      INTEGER  ::   ji, jk
-      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
-      !!----------------------------------------------------------------------
-      !
-      SELECT CASE ( jpni )
-      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
-      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
-      END SELECT
-      ijpjm1 = ijpj-1
-
-         !
-         SELECT CASE ( npolj )
-         !
-         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
-            !
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               IF (nimpp .ne. 1) THEN
-                 startloop = 1
-               ELSE
-                 startloop = 2
-               ENDIF
-
-               DO jk = 1, jpk
-                  DO ji = startloop, nlci
-                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
-                  END DO
-                  IF(nimpp .eq. 1) THEN
-                     pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-2,jk)
-                  ENDIF
-               END DO
-
-               IF(nimpp .ge. (jpiglo/2+1)) THEN
-                 startloop = 1
-               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-                 startloop = jpiglo/2+1 - nimpp + 1
-               ELSE
-                 startloop = nlci + 1
-               ENDIF
-               IF(startloop .le. nlci) THEN
-                 DO jk = 1, jpk
-                    DO ji = startloop, nlci
-                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                       jia = ji + nimpp - 1
-                       ijta = jpiglo - jia + 2
-                       IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN
-                          pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijta-nimpp+1,ijpjm1,jk)
-                       ELSE
-                          pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk)
-                       ENDIF
-                    END DO
-                 END DO
-               ENDIF
-
-
-            CASE ( 'U' )                               ! U-point
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO jk = 1, jpk
-                  DO ji = 1, endloop
-                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk)
-                  END DO
-                  IF(nimpp .eq. 1) THEN
-                     pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-2,jk)
-                  ENDIF
-                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-                     pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-2,jk)
-                  ENDIF
-               END DO
-
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               IF(nimpp .ge. (jpiglo/2)) THEN
-                  startloop = 1
-               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN
-                  startloop = jpiglo/2 - nimpp + 1
-               ELSE
-                  startloop = endloop + 1
-               ENDIF
-               IF (startloop .le. endloop) THEN
-                 DO jk = 1, jpk
-                    DO ji = startloop, endloop
-                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-                      jia = ji + nimpp - 1
-                      ijua = jpiglo - jia + 1
-                      IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN
-                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijua-nimpp+1,ijpjm1,jk)
-                      ELSE
-                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk)
-                      ENDIF
-                    END DO
-                 END DO
-               ENDIF
-
-            CASE ( 'V' )                               ! V-point
-               IF (nimpp .ne. 1) THEN
-                  startloop = 1
-               ELSE
-                  startloop = 2
-               ENDIF
-               DO jk = 1, jpk
-                  DO ji = startloop, nlci
-                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
-                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(ijt,ijpj-3,jk)
-                  END DO
-                  IF(nimpp .eq. 1) THEN
-                     pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-3,jk)
-                  ENDIF
-               END DO
-            CASE ( 'F' )                               ! F-point
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO jk = 1, jpk
-                  DO ji = 1, endloop
-                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk)
-                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(iju,ijpj-3,jk)
-                  END DO
-                  IF(nimpp .eq. 1) THEN
-                     pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-3,jk)
-                  ENDIF
-                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-                     pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-3,jk)
-                  ENDIF
-               END DO
-            END SELECT
-            !
-
-         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
-            !
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO jk = 1, jpk
-                  DO ji = 1, nlci
-                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk)
-                  END DO
-               END DO
-
-            CASE ( 'U' )                               ! U-point
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO jk = 1, jpk
-                  DO ji = 1, endloop
-                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk)
-                  END DO
-                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-                     pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-1,jk)
-                  ENDIF
-               END DO
-
-            CASE ( 'V' )                               ! V-point
-               DO jk = 1, jpk
-                  DO ji = 1, nlci
-                     ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3
-                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
-                  END DO
-               END DO
-
-               IF(nimpp .ge. (jpiglo/2+1)) THEN
-                  startloop = 1
-               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-                  startloop = jpiglo/2+1 - nimpp + 1
-               ELSE
-                  startloop = nlci + 1
-               ENDIF
-               IF(startloop .le. nlci) THEN
-                 DO jk = 1, jpk
-                    DO ji = startloop, nlci
-                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-                       pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk)
-                    END DO
-                 END DO
-               ENDIF
-
-            CASE ( 'F' )                               ! F-point
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO jk = 1, jpk
-                  DO ji = 1, endloop
-                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-                     pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk)
-                  END DO
-                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-                     pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-2,jk)
-                  ENDIF
-               END DO
-
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               IF(nimpp .ge. (jpiglo/2+1)) THEN
-                  startloop = 1
-               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-                  startloop = jpiglo/2+1 - nimpp + 1
-               ELSE
-                  startloop = endloop + 1
-               ENDIF
-               IF (startloop .le. endloop) THEN
-                  DO jk = 1, jpk
-                     DO ji = startloop, endloop
-                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk)
-                     END DO
-                  END DO
-               ENDIF
-
-            END SELECT
-
-         CASE DEFAULT                           ! *  closed : the code probably never go through
-            !
-            SELECT CASE ( cd_type)
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3dl(:, 1  ,jk) = 0.e0
-               pt3dl(:,ijpj,jk) = 0.e0
-            CASE ( 'F' )                               ! F-point
-               pt3dl(:,ijpj,jk) = 0.e0
-            END SELECT
-            !
-         END SELECT     !  npolj
-         !
-      !
-   END SUBROUTINE mpp_lbc_nfd_3d
-
-
-   SUBROUTINE mpp_lbc_nfd_2d( pt2dl, pt2dr, cd_type, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lbc_nfd_2d  ***
-      !!
-      !! ** Purpose :   2D lateral boundary condition : North fold treatment
-      !!       without processor exchanges. 
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  :   pt2d with updated values along the north fold
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                      ! = T , U , V , F , W points
-      REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                      !   = -1. , the sign is changed if north fold boundary
-      !                                                      !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2dl     ! 2D array on which the boundary condition is applied
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pt2dr     ! 2D array on which the boundary condition is applied
-      !
-      INTEGER  ::   ji
-      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
-      !!----------------------------------------------------------------------
-
-      SELECT CASE ( jpni )
-      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
-      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
-      END SELECT
-      !
-      ijpjm1 = ijpj-1
-
-
-      SELECT CASE ( npolj )
-      !
-      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
-         !
-         SELECT CASE ( cd_type )
-         !
-         CASE ( 'T' , 'W' )                               ! T- , W-points
-            IF (nimpp .ne. 1) THEN
-              startloop = 1
-            ELSE
-              startloop = 2
-            ENDIF
-            DO ji = startloop, nlci
-              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1)
-            END DO
-            IF (nimpp .eq. 1) THEN
-              pt2dl(1,ijpj)   = psgn * pt2dl(3,ijpj-2)
-            ENDIF
-
-            IF(nimpp .ge. (jpiglo/2+1)) THEN
-               startloop = 1
-            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-               startloop = jpiglo/2+1 - nimpp + 1
-            ELSE
-               startloop = nlci + 1
-            ENDIF
-            DO ji = startloop, nlci
-               ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-               jia = ji + nimpp - 1
-               ijta = jpiglo - jia + 2
-               IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN
-                  pt2dl(ji,ijpjm1) = psgn * pt2dl(ijta-nimpp+1,ijpjm1)
-               ELSE
-                  pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1)
-               ENDIF
-            END DO
-
-         CASE ( 'U' )                                     ! U-point
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            DO ji = 1, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)
-            END DO
-
-            IF (nimpp .eq. 1) THEN
-              pt2dl(   1  ,ijpj  ) = psgn * pt2dl(    2   ,ijpj-2)
-              pt2dl(1     ,ijpj-1) = psgn * pt2dr(jpiglo - nfiimpp(isendto(1), jpnj) + 1, ijpj-1)
-            ENDIF
-            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-              pt2dl(nlci,ijpj  ) = psgn * pt2dl(nlci-1,ijpj-2)
-            ENDIF
-
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            IF(nimpp .ge. (jpiglo/2)) THEN
-               startloop = 1
-            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN
-               startloop = jpiglo/2 - nimpp + 1
-            ELSE
-               startloop = endloop + 1
-            ENDIF
-            DO ji = startloop, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               jia = ji + nimpp - 1
-               ijua = jpiglo - jia + 1
-               IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN
-                  pt2dl(ji,ijpjm1) = psgn * pt2dl(ijua-nimpp+1,ijpjm1)
-               ELSE
-                  pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1)
-               ENDIF
-            END DO
-
-         CASE ( 'V' )                                     ! V-point
-            IF (nimpp .ne. 1) THEN
-              startloop = 1
-            ELSE
-              startloop = 2
-            ENDIF
-            DO ji = startloop, nlci
-              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-              pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1)
-              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2)
-            END DO
-            IF (nimpp .eq. 1) THEN
-              pt2dl( 1 ,ijpj)   = psgn * pt2dl( 3 ,ijpj-3) 
-            ENDIF
-
-         CASE ( 'F' )                                     ! F-point
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            DO ji = 1, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1)
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2)
-            END DO
-            IF (nimpp .eq. 1) THEN
-              pt2dl(   1  ,ijpj)   = psgn * pt2dl(    2   ,ijpj-3)
-              pt2dl(   1  ,ijpj-1) = psgn * pt2dl(    2   ,ijpj-2)
-            ENDIF
-            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-              pt2dl(nlci,ijpj)   = psgn * pt2dl(nlci-1,ijpj-3)
-              pt2dl(nlci,ijpj-1) = psgn * pt2dl(nlci-1,ijpj-2) 
-            ENDIF
-
-         CASE ( 'I' )                                     ! ice U-V point (I-point)
-            IF (nimpp .ne. 1) THEN
-               startloop = 1
-            ELSE
-               startloop = 3
-               pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1)
-            ENDIF
-            DO ji = startloop, nlci
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
-            END DO
-
-         CASE ( 'J' )                                     ! first ice U-V point
-            IF (nimpp .ne. 1) THEN
-               startloop = 1
-            ELSE
-               startloop = 3
-               pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1)
-            ENDIF
-            DO ji = startloop, nlci
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
-            END DO
-
-         CASE ( 'K' )                                     ! second ice U-V point
-            IF (nimpp .ne. 1) THEN
-               startloop = 1
-            ELSE
-               startloop = 3
-               pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1)
-            ENDIF
-            DO ji = startloop, nlci
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
-            END DO
-
-         END SELECT
-         !
-      CASE ( 5, 6 )                        ! *  North fold  F-point pivot
-         !
-         SELECT CASE ( cd_type )
-         CASE ( 'T' , 'W' )                               ! T-, W-point
-            DO ji = 1, nlci
-               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1)
-            END DO
-
-         CASE ( 'U' )                                     ! U-point
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            DO ji = 1, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
-            END DO
-            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-               pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-1)
-            ENDIF
-
-         CASE ( 'V' )                                     ! V-point
-            DO ji = 1, nlci
-               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1)
-            END DO
-            IF(nimpp .ge. (jpiglo/2+1)) THEN
-               startloop = 1
-            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-               startloop = jpiglo/2+1 - nimpp + 1
-            ELSE
-               startloop = nlci + 1
-            ENDIF
-            DO ji = startloop, nlci
-               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
-               pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1)
-            END DO
-
-         CASE ( 'F' )                               ! F-point
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            DO ji = 1, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)
-            END DO
-            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
-                pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-2)
-            ENDIF
-
-            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-               endloop = nlci
-            ELSE
-               endloop = nlci - 1
-            ENDIF
-            IF(nimpp .ge. (jpiglo/2+1)) THEN
-               startloop = 1
-            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
-               startloop = jpiglo/2+1 - nimpp + 1
-            ELSE
-               startloop = endloop + 1
-            ENDIF
-
-            DO ji = startloop, endloop
-               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
-               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1)
-            END DO
-
-         CASE ( 'I' )                                  ! ice U-V point (I-point)
-               IF (nimpp .ne. 1) THEN
-                  startloop = 1
-               ELSE
-                  startloop = 2
-               ENDIF
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO ji = startloop , endloop
-                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                  pt2dl(ji,ijpj)= 0.5 * (pt2dl(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1))
-               END DO
-
-         CASE ( 'J' )                                  ! first ice U-V point
-               IF (nimpp .ne. 1) THEN
-                  startloop = 1
-               ELSE
-                  startloop = 2
-               ENDIF
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO ji = startloop , endloop
-                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                  pt2dl(ji,ijpj) = pt2dl(ji,ijpjm1)
-               END DO
-
-         CASE ( 'K' )                                  ! second ice U-V point
-               IF (nimpp .ne. 1) THEN
-                  startloop = 1
-               ELSE
-                  startloop = 2
-               ENDIF
-               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
-                  endloop = nlci
-               ELSE
-                  endloop = nlci - 1
-               ENDIF
-               DO ji = startloop, endloop
-                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
-                  pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1)
-               END DO
-
-         END SELECT
-         !
-      CASE DEFAULT                           ! *  closed : the code probably never go through
-         !
-         SELECT CASE ( cd_type)
-         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
-            pt2dl(:, 1     ) = 0.e0
-            pt2dl(:,ijpj) = 0.e0
-         CASE ( 'F' )                                   ! F-point
-            pt2dl(:,ijpj) = 0.e0
-         CASE ( 'I' )                                   ! ice U-V point
-            pt2dl(:, 1     ) = 0.e0
-            pt2dl(:,ijpj) = 0.e0
-         CASE ( 'J' )                                   ! first ice U-V point
-            pt2dl(:, 1     ) = 0.e0
-            pt2dl(:,ijpj) = 0.e0
-         CASE ( 'K' )                                   ! second ice U-V point
-            pt2dl(:, 1     ) = 0.e0
-            pt2dl(:,ijpj) = 0.e0
-         END SELECT
-         !
-      END SELECT
-      !
-   END SUBROUTINE mpp_lbc_nfd_2d
+   END SUBROUTINE lbc_nfd_2d_org
 
    !!======================================================================
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 8226)
@@ -8,5 +8,5 @@
    !!            8.0  !  1998  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
    !!                 !  1998  (J.M. Molines) Open boundary conditions
-   !!   NEMO     1.0  !  2003  (J.-M. Molines, G. Madec)  F90, free form
+   !!   NEMO     1.0  !  2003  (J.M. Molines, G. Madec)  F90, free form
    !!                 !  2003  (J.M. Molines) add mpp_ini_north(_3d,_2d)
    !!             -   !  2004  (R. Bourdalle Badie)  isend option in mpi
@@ -19,10 +19,10 @@
    !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl
    !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager
-   !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add 'mpp_lnk_bdy_3d', 'mpp_lnk_obc_3d', 
-   !!                          'mpp_lnk_bdy_2d' and 'mpp_lnk_obc_2d' routines and update
-   !!                          the mppobc routine to optimize the BDY and OBC communications
-   !!            3.5  !  2013  ( C. Ethe, G. Madec ) message passing arrays as local variables 
+   !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add mpp_lnk_bdy_3d/2d routines to optimize the BDY comm.
+   !!            3.5  !  2013  (C. Ethe, G. Madec)  message passing arrays as local variables 
    !!            3.5  !  2013  (S.Mocavero, I.Epicoco - CMCC) north fold optimizations
-   !!            3.6  !  2015 (O. Tintó and M. Castrillo - BSC) Added 'mpp_lnk_2d_multiple', 'mpp_lbc_north_2d_multiple', 'mpp_max_multiple' 
+   !!            3.6  !  2015  (O. Tintó and M. Castrillo - BSC) Added '_multiple' case for 2D lbc and max
+   !!            4.0  !  2017  (G. Madec) automatique allocation of array argument (use any 3rd dimension)
+   !!             -   !  2017  (G. Madec) create generic.h90 files to generate all lbc and north fold routines
    !!----------------------------------------------------------------------
 
@@ -41,9 +41,8 @@
    !!   mynode        : indentify the processor unit
    !!   mpp_lnk       : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d)
-   !!   mpp_lnk_3d_gather :  Message passing manadgement for two 3D arrays
    !!   mpp_lnk_e     : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e)
    !!   mpp_lnk_icb   : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb)
    !!   mpprecv       :
-   !!   mppsend       :   SUBROUTINE mpp_ini_znl
+   !!   mppsend       :
    !!   mppscatter    :
    !!   mppgather     :
@@ -56,5 +55,5 @@
    !!   mppstop       :
    !!   mpp_ini_north : initialisation of north fold
-   !!   mpp_lbc_north : north fold processors gathering
+!!gm   !!   mpp_lbc_north : north fold processors gathering
    !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo
    !!   mpp_lbc_north_icb : variant of mpp_lbc_north for extra outer halo with icebergs
@@ -67,13 +66,29 @@
    IMPLICIT NONE
    PRIVATE
-   
+
+   INTERFACE mpp_nfd
+      MODULE PROCEDURE   mpp_nfd_2d      , mpp_nfd_3d      , mpp_nfd_4d
+      MODULE PROCEDURE   mpp_nfd_2d_ptr, mpp_nfd_3d_ptr, mpp_nfd_4d_ptr
+   END INTERFACE
+
+   ! Interface associated to the mpp_lnk_... routines is defined in lbclnk
+   PUBLIC   mpp_lnk_2d      , mpp_lnk_3d      , mpp_lnk_4d
+   PUBLIC   mpp_lnk_2d_ptr, mpp_lnk_3d_ptr, mpp_lnk_4d_ptr
+   PUBLIC   mpp_lnk_2d_e
+   !
+!!gm  this should be useless
+   PUBLIC   mpp_nfd_2d    , mpp_nfd_3d    , mpp_nfd_4d
+   PUBLIC   mpp_nfd_2d_ptr, mpp_nfd_3d_ptr, mpp_nfd_4d_ptr
+!!gm end
+   !
    PUBLIC   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam
    PUBLIC   mynode, mppstop, mppsync, mpp_comm_free
-   PUBLIC   mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e
+   PUBLIC   mpp_ini_north, mpp_lbc_north_e
+!!gm   PUBLIC   mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e
+   PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb
    PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc
    PUBLIC   mpp_max_multiple
-   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e
-   PUBLIC   mpp_lnk_2d_9 , mpp_lnk_2d_multiple 
-   PUBLIC   mpp_lnk_sum_3d, mpp_lnk_sum_2d
+!!gm   PUBLIC   mpp_lnk_2d_9 
+!!gm   PUBLIC   mpp_lnk_sum_3d, mpp_lnk_sum_2d
    PUBLIC   mppscatter, mppgather
    PUBLIC   mpp_ini_ice, mpp_ini_znl
@@ -81,11 +96,5 @@
    PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines
    PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
-   PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb
    PUBLIC   mpprank
-
-   TYPE arrayptr
-      REAL , DIMENSION (:,:),  POINTER :: pt2d
-   END TYPE arrayptr
-   PUBLIC   arrayptr
    
    !! * Interfaces
@@ -101,9 +110,9 @@
    INTERFACE mpp_sum
       MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real,   &
-                       mppsum_realdd, mppsum_a_realdd
+         &             mppsum_realdd, mppsum_a_realdd
    END INTERFACE
-   INTERFACE mpp_lbc_north
-      MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d
-   END INTERFACE
+!!gm   INTERFACE mpp_lbc_north
+!!gm      MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d
+!!gm   END INTERFACE
    INTERFACE mpp_minloc
       MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
@@ -112,5 +121,4 @@
       MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
    END INTERFACE
-
    INTERFACE mpp_max_multiple
       MODULE PROCEDURE mppmax_real_multiple
@@ -138,39 +146,39 @@
    ! variables used in case of sea-ice
    INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice (public so that it can be freed in limthd)
-   INTEGER ::   ngrp_iworld     !  group ID for the world processors (for rheology)
-   INTEGER ::   ngrp_ice        !  group ID for the ice processors (for rheology)
-   INTEGER ::   ndim_rank_ice   !  number of 'ice' processors
-   INTEGER ::   n_ice_root      !  number (in the comm_ice) of proc 0 in the ice comm
+   INTEGER         ::   ngrp_iworld     !  group ID for the world processors (for rheology)
+   INTEGER         ::   ngrp_ice        !  group ID for the ice processors (for rheology)
+   INTEGER         ::   ndim_rank_ice   !  number of 'ice' processors
+   INTEGER         ::   n_ice_root      !  number (in the comm_ice) of proc 0 in the ice comm
    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_ice     ! dimension ndim_rank_ice
 
    ! variables used for zonal integration
    INTEGER, PUBLIC ::   ncomm_znl       !: communicator made by the processors on the same zonal average
-   LOGICAL, PUBLIC ::   l_znl_root      ! True on the 'left'most processor on the same row
-   INTEGER ::   ngrp_znl        ! group ID for the znl processors
-   INTEGER ::   ndim_rank_znl   ! number of processors on the same zonal average
+   LOGICAL, PUBLIC ::   l_znl_root      !: True on the 'left'most processor on the same row
+   INTEGER         ::   ngrp_znl        !  group ID for the znl processors
+   INTEGER         ::   ndim_rank_znl   !  number of processors on the same zonal average
    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
 
    ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM)
-   INTEGER, PUBLIC ::   ngrp_world        ! group ID for the world processors
-   INTEGER, PUBLIC ::   ngrp_opa          ! group ID for the opa processors
-   INTEGER, PUBLIC ::   ngrp_north        ! group ID for the northern processors (to be fold)
-   INTEGER, PUBLIC ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north
-   INTEGER, PUBLIC ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !)
-   INTEGER, PUBLIC ::   njmppmax          ! value of njmpp for the processors of the northern line
-   INTEGER, PUBLIC ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm
-   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, PUBLIC ::   nrank_north   ! dimension ndim_rank_north
+   INTEGER, PUBLIC ::   ngrp_world        !: group ID for the world processors
+   INTEGER, PUBLIC ::   ngrp_opa          !: group ID for the opa processors
+   INTEGER, PUBLIC ::   ngrp_north        !: group ID for the northern processors (to be fold)
+   INTEGER, PUBLIC ::   ncomm_north       !: communicator made by the processors belonging to ngrp_north
+   INTEGER, PUBLIC ::   ndim_rank_north   !: number of 'sea' processor in the northern line (can be /= jpni !)
+   INTEGER, PUBLIC ::   njmppmax          !: value of njmpp for the processors of the northern line
+   INTEGER, PUBLIC ::   north_root        !: number (in the comm_opa) of proc 0 in the northern comm
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_north   !: dimension ndim_rank_north
 
    ! Type of send : standard, buffered, immediate
-   CHARACTER(len=1), PUBLIC ::   cn_mpi_send   ! type od mpi send/recieve (S=standard, B=bsend, I=isend)
-   LOGICAL, PUBLIC          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I')
-   INTEGER, PUBLIC          ::   nn_buffer     ! size of the buffer in case of mpi_bsend
-
-   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon  ! buffer in case of bsend
-
-   LOGICAL, PUBLIC                                  ::   ln_nnogather       ! namelist control of northfold comms
-   LOGICAL, PUBLIC                                  ::   l_north_nogather = .FALSE.  ! internal control of northfold comms
-   INTEGER, PUBLIC                                  ::   ityp
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   CHARACTER(len=1), PUBLIC ::   cn_mpi_send        !: type od mpi send/recieve (S=standard, B=bsend, I=isend)
+   LOGICAL         , PUBLIC ::   l_isend = .FALSE.  !: isend use indicator (T if cn_mpi_send='I')
+   INTEGER         , PUBLIC ::   nn_buffer          !: size of the buffer in case of mpi_bsend
+
+   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   tampon   ! buffer in case of bsend
+
+   LOGICAL, PUBLIC ::   ln_nnogather                !: namelist control of northfold comms
+   LOGICAL, PUBLIC ::   l_north_nogather = .FALSE.  !: internal control of northfold comms
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -178,6 +186,5 @@
 CONTAINS
 
-
-   FUNCTION mynode( ldtxt, ldname, kumnam_ref , kumnam_cfg , kumond , kstop, localComm )
+   FUNCTION mynode( ldtxt, ldname, kumnam_ref, kumnam_cfg, kumond, kstop, localComm )
       !!----------------------------------------------------------------------
       !!                  ***  routine mynode  ***
@@ -204,18 +211,17 @@
       WRITE(ldtxt(ii),*) '~~~~~~ '                                                        ;   ii = ii + 1
       !
-
       REWIND( kumnam_ref )              ! Namelist nammpp in reference namelist: mpi variables
       READ  ( kumnam_ref, nammpp, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in reference namelist', lwp )
-
+      !
       REWIND( kumnam_cfg )              ! Namelist nammpp in configuration namelist: mpi variables
       READ  ( kumnam_cfg, nammpp, IOSTAT = ios, ERR = 902 )
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist', lwp )
-
+      !
       !                              ! control print
       WRITE(ldtxt(ii),*) '   Namelist nammpp'                                             ;   ii = ii + 1
       WRITE(ldtxt(ii),*) '      mpi send type          cn_mpi_send = ', cn_mpi_send       ;   ii = ii + 1
       WRITE(ldtxt(ii),*) '      size exported buffer   nn_buffer   = ', nn_buffer,' bytes';   ii = ii + 1
-
+      !
 #if defined key_agrif
       IF( .NOT. Agrif_Root() ) THEN
@@ -225,12 +231,10 @@
       ENDIF
 #endif
-
-      IF(jpnij < 1)THEN
-         ! If jpnij is not specified in namelist then we calculate it - this
-         ! means there will be no land cutting out.
-         jpnij = jpni * jpnj
-      END IF
-
-      IF( (jpni < 1) .OR. (jpnj < 1) )THEN
+      !
+      IF( jpnij < 1 ) THEN         ! If jpnij is not specified in namelist then we calculate it
+         jpnij = jpni * jpnj       ! this means there will be no land cutting out.
+      ENDIF
+
+      IF( jpni < 1 .OR. jpnj < 1  ) THEN
          WRITE(ldtxt(ii),*) '      jpni, jpnj and jpnij will be calculated automatically' ;   ii = ii + 1
       ELSE
@@ -238,5 +242,5 @@
          WRITE(ldtxt(ii),*) '      processor grid extent in j         jpnj = ',jpnj       ;   ii = ii + 1
          WRITE(ldtxt(ii),*) '      number of local domains           jpnij = ',jpnij      ;   ii = ii + 1
-      END IF
+      ENDIF
 
       WRITE(ldtxt(ii),*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather  ; ii = ii + 1
@@ -268,5 +272,6 @@
             kstop = kstop + 1
          END SELECT
-      ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN
+         !
+      ELSEIF ( PRESENT(localComm) .AND. .NOT. mpi_was_called ) THEN
          WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '          ;   ii = ii + 1
          WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                ;   ii = ii + 1
@@ -309,5 +314,5 @@
 
 #if defined key_agrif
-      IF (Agrif_Root()) THEN
+      IF( Agrif_Root() ) THEN
          CALL Agrif_MPI_Init(mpi_comm_opa)
       ELSE
@@ -329,913 +334,169 @@
    END FUNCTION mynode
 
-
-   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_3d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    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
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                             ! = T , U , V , F , W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                             ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !
-      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER , DIMENSION(MPI_STATUS_SIZE)      ::   ml_stat        ! for key_mpi_isend
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
-      !!----------------------------------------------------------------------
-      
-      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
-         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
-
-      !
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0._wp     ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
-         !
-         ! WARNING ptab is defined only between nld and nle
-         DO jk = 1, jpk
-            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
-               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)
-               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk)
-               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk)
-            END DO
-            DO ji = nlci+1, jpi                 ! added column(s) (full)
-               ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk)
-               ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk)
-               ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk)
-            END DO
-         END DO
-         !
-      ELSE                              ! standard close or cyclic treatment
-         !
-         !                                   ! East-West boundaries
-         !                                        !* Cyclic east-west
-         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-            ptab( 1 ,:,:) = ptab(jpim1,:,:)
-            ptab(jpi,:,:) = ptab(  2  ,:,:)
-         ELSE                                     !* closed
-            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
-                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
-         ENDIF
-                                          ! North-south cyclic
-         IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south only with no mpp split in latitude
-            ptab(:,1 , :) = ptab(:, jpjm1,:)
-            ptab(:,jpj,:) = ptab(:,     2,:)
-         ELSE   !                                   ! North-South boundaries (closed)
-            IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
-                                         ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
-         ENDIF
-         !
-      ENDIF
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
-      !
-      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
-            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci-jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
-            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
-         END DO
-      END SELECT
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
-            zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj-jprecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab(:,jl      ,:) = zt3sn(:,jl,:,2)
-            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jl,:) = zt3sn(:,jl,:,2)
-         END DO
-      END SELECT
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
-      !
-   END SUBROUTINE mpp_lnk_3d
-
-
-   SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_2d_multiple  ***
-      !!
-      !! ** Purpose :   Message passing management for multiple 2d arrays
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
-      !                                                               ! = T , U , V , F , W and I points
-      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary
-      !                                                               ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL    , INTENT(in   ) ::   cd_mpp       ! fill the overlap area only
-      REAL(wp)        , OPTIONAL    , INTENT(in   ) ::   pval         ! background value (used at closed boundaries)
-      !!
-      INTEGER  ::   ji, jj, jl   ! dummy loop indices
-      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      INTEGER :: num_fields
-      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
-      REAL(wp) ::   zland
-      INTEGER , DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat       ! for key_mpi_isend
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
-
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields),  &
-         &      zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields)   )
-      !
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0._wp     ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !
-      !First Array
-      DO ii = 1 , num_fields
-         IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
-            !
-            ! WARNING pt2d is defined only between nld and nle
-            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
-               pt2d_array(ii)%pt2d(nldi  :nlei  , jj) = pt2d_array(ii)%pt2d(nldi:nlei, nlej)
-               pt2d_array(ii)%pt2d(1     :nldi-1, jj) = pt2d_array(ii)%pt2d(nldi     , nlej)
-               pt2d_array(ii)%pt2d(nlei+1:nlci  , jj) = pt2d_array(ii)%pt2d(     nlei, nlej) 
-            END DO
-            DO ji = nlci+1, jpi                 ! added column(s) (full)
-               pt2d_array(ii)%pt2d(ji, nldj  :nlej  ) = pt2d_array(ii)%pt2d(nlei, nldj:nlej)
-               pt2d_array(ii)%pt2d(ji, 1     :nldj-1) = pt2d_array(ii)%pt2d(nlei, nldj     )
-               pt2d_array(ii)%pt2d(ji, nlej+1:jpj   ) = pt2d_array(ii)%pt2d(nlei,      nlej)
-            END DO
-            !
-         ELSE                              ! standard close or cyclic treatment
-            !
-            !                                   ! East-West boundaries
-            IF( nbondi == 2 .AND.   &                ! Cyclic east-west
-               &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-               pt2d_array(ii)%pt2d(  1  , : ) = pt2d_array(ii)%pt2d( jpim1, : )                                    ! west
-               pt2d_array(ii)%pt2d( jpi , : ) = pt2d_array(ii)%pt2d(   2  , : )                                    ! east
-            ELSE                                     ! closed
-               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(            1 : jpreci,:) = zland    ! south except F-point
-                                                   pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi   ,:) = zland    ! north
-            ENDIF
-                                                ! Noth-South boundaries
-            IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south
-               pt2d_array(ii)%pt2d(:, 1   ) =   pt2d_array(ii)%pt2d(:, jpjm1 )
-               pt2d_array(ii)%pt2d(:, jpj ) =   pt2d_array(ii)%pt2d(:, 2 )          
-            ELSE   !             
-               !                                   ! North-South boundaries (closed)
-               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(:,             1:jprecj ) = zland    ! south except F-point
-                                                   pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj    ) = zland    ! north
-            !
-            ENDIF
-          ENDIF
-      END DO
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
-      !
-      DO ii = 1 , num_fields
-         SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-         CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-            iihom = nlci-nreci
-            DO jl = 1, jpreci
-               zt2ew( : , jl , ii ) = pt2d_array(ii)%pt2d( jpreci+jl , : )
-               zt2we( : , jl , ii ) = pt2d_array(ii)%pt2d( iihom +jl , : )
-            END DO
-         END SELECT
-      END DO
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
-         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-
-      DO ii = 1 , num_fields
-         SELECT CASE ( nbondi )
-         CASE ( -1 )
-            DO jl = 1, jpreci
-               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
-            END DO
-         CASE ( 0 )
-            DO jl = 1, jpreci
-               pt2d_array(ii)%pt2d( jl , : ) = zt2we(:,jl,num_fields+ii)
-               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
-            END DO
-         CASE ( 1 )
-            DO jl = 1, jpreci
-               pt2d_array(ii)%pt2d( jl , : )= zt2we(:,jl,num_fields+ii)
-            END DO
-         END SELECT
-      END DO
-      
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      !First Array
-      DO ii = 1 , num_fields
-         IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-            ijhom = nlcj-nrecj
-            DO jl = 1, jprecj
-               zt2sn(:,jl , ii) = pt2d_array(ii)%pt2d( : , ijhom +jl )
-               zt2ns(:,jl , ii) = pt2d_array(ii)%pt2d( : , jprecj+jl )
-            END DO
-         ENDIF
-      END DO
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
-         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
-      !
-
-      DO ii = 1 , num_fields
-         !First Array
-         SELECT CASE ( nbondj )
-         CASE ( -1 )
-            DO jl = 1, jprecj
-               pt2d_array(ii)%pt2d( : , ijhom+jl ) = zt2ns( : , jl , num_fields+ii )
-            END DO
-         CASE ( 0 )
-            DO jl = 1, jprecj
-               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii)
-               pt2d_array(ii)%pt2d( : , ijhom + jl ) = zt2ns( : , jl , num_fields + ii )
-            END DO
-         CASE ( 1 )
-            DO jl = 1, jprecj
-               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii )
-            END DO
-         END SELECT
-      END DO
-      
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-         !First Array
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   
-             DO ii = 1 , num_fields  
-                       CALL lbc_nfd      ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) )   ! only 1 northern proc, no mpp
-             END DO
-         CASE DEFAULT   ;   CALL mpp_lbc_north_2d_multiple( pt2d_array, type_array, psgn_array, num_fields )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-        !
-      !
-      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
-      !
-   END SUBROUTINE mpp_lnk_2d_multiple
-
-   
-   SUBROUTINE load_array( pt2d, cd_type, psgn, pt2d_array, type_array, psgn_array, num_fields )
-      !!---------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, INTENT(inout) ::   pt2d    ! Second 2D array on which the boundary condition is applied
-      CHARACTER(len=1)                    , INTENT(in   ) ::   cd_type ! define the nature of ptab array grid-points
-      REAL(wp)                            , INTENT(in   ) ::   psgn    ! =-1 the sign change across the north fold boundary
-      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array
-      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
-      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
-      INTEGER                            , INTENT (inout) :: num_fields 
-      !!---------------------------------------------------------------------
-      num_fields = num_fields + 1
-      pt2d_array(num_fields)%pt2d => pt2d
-      type_array(num_fields)      =  cd_type
-      psgn_array(num_fields)      =  psgn
-   END SUBROUTINE load_array
+   !!----------------------------------------------------------------------
+   !!                   ***  routine mpp_lnk_(2,3,4)d  ***
+   !!
+   !!   * Argument : dummy argument use in mpp_lnk_... routines
+   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
+   !!                cd_nat :   nature of array grid-points
+   !!                psgn   :   sign used across the north fold boundary
+   !!                kfld   :   optional, number of pt3d arrays
+   !!                cd_mpp :   optional, fill the overlap area only
+   !!                pval   :   optional, background value (used at closed boundaries)
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_LNK           mpp_lnk_2d
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_2d_ptr
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_LNK           mpp_lnk_3d
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_3d_ptr
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_LNK           mpp_lnk_4d
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_4d_ptr
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_4d
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine mpp_nfd_(2,3,4)d  ***
+   !!
+   !!   * Argument : dummy argument use in mpp_nfd_... routines
+   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
+   !!                cd_nat :   nature of array grid-points
+   !!                psgn   :   sign used across the north fold boundary
+   !!                kfld   :   optional, number of pt3d arrays
+   !!                cd_mpp :   optional, fill the overlap area only
+   !!                pval   :   optional, background value (used at closed boundaries)
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_NFD           mpp_nfd_2d
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_2d_ptr
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_NFD           mpp_nfd_3d
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_3d_ptr
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_NFD           mpp_nfd_4d
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_4d_ptr
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_4d
+
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine mpp_lnk_bdy_(2,3,4)d  ***
+   !!
+   !!   * Argument : dummy argument use in mpp_lnk_... routines
+   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
+   !!                cd_nat :   nature of array grid-points
+   !!                psgn   :   sign used across the north fold boundary
+   !!                kb_bdy :   BDY boundary set
+   !!                kfld   :   optional, number of pt3d arrays
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_BDY           mpp_lnk_bdy_2d
+#     include "mpp_bdy_generic.h90"
+#     undef ROUTINE_BDY
+#     define MULTI
+#     define ROUTINE_BDY           mpp_lnk_bdy_2d_ptr
+#     include "mpp_bdy_generic.h90"
+#     undef ROUTINE_BDY
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_BDY           mpp_lnk_bdy_3d
+#     include "mpp_bdy_generic.h90"
+#     undef ROUTINE_BDY
+#     define MULTI
+#     define ROUTINE_BDY           mpp_lnk_bdy_3d_ptr
+#     include "mpp_bdy_generic.h90"
+#     undef ROUTINE_BDY
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+!!#  define DIM_4d
+!!#     define ROUTINE_BDY           mpp_lnk_bdy_4d
+!!#     include "mpp_bdy_generic.h90"
+!!#     undef ROUTINE_BDY
+!!#     define MULTI
+!!#     define ROUTINE_BDY           mpp_lnk_bdy_4d_ptr
+!!#     include "mpp_bdy_generic.h90"
+!!#     undef ROUTINE_BDY
+!!#     undef MULTI
+!!#  undef DIM_4d
+
+   !!----------------------------------------------------------------------
+   !!
+   !!   load_array  &   mpp_lnk_2d_9    à generaliser a 3D et 4D
    
    
-   SUBROUTINE mpp_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
-      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
-      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
-      !!---------------------------------------------------------------------
-      ! Second 2D array on which the boundary condition is applied
-      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA    
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
-      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI 
-      ! define the nature of ptab array grid-points
-      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA
-      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
-      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
-      ! =-1 the sign change across the north fold boundary
-      REAL(wp)                                      , INTENT(in   ) ::   psgnA    
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI   
-      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array 
-      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
-      !                                                         ! = T , U , V , F , W and I points
-      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
-      INTEGER :: num_fields
-      !!---------------------------------------------------------------------
-      !
-      num_fields = 0
-      !
-      ! Load the first array
-      CALL load_array( pt2dA, cd_typeA, psgnA, pt2d_array, type_array, psgn_array, num_fields )
-      !
-      ! Look if more arrays are added
-      IF( PRESENT(psgnB) )   CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnC) )   CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnD) )   CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnE) )   CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnF) )   CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnG) )   CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnH) )   CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields)
-      IF( PRESENT(psgnI) )   CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields)
-      !
-      CALL mpp_lnk_2d_multiple( pt2d_array, type_array, psgn_array, num_fields, cd_mpp,pval )
-      !
-   END SUBROUTINE mpp_lnk_2d_9
-
-
-   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_2d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for 2d array
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                         ! = T , U , V , F , W and I points
-      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                         ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      INTEGER  ::   ji, jj, jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE)     ::   ml_stat       ! for key_mpi_isend
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
-         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
-      !
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0._wp     ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !
-      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
-         !
-         ! WARNING pt2d is defined only between nld and nle
-         DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
-            pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej)
-            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej)
-            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej)
-         END DO
-         DO ji = nlci+1, jpi                 ! added column(s) (full)
-            pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej)
-            pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     )
-            pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej)
-         END DO
-         !
-      ELSE                              ! standard close or cyclic treatment
-         !
-         !                                   ! East-West boundaries
-         IF( nbondi == 2 .AND.   &                ! Cyclic east-west
-            &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-            pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west
-            pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east
-         ELSE                                     ! closed
-            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point
-                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north
-         ENDIF
-                                            ! North-South boudaries
-         IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south
-            pt2d(:,  1 ) = pt2d(:,jpjm1)
-            pt2d(:, jpj) = pt2d(:,    2)
-         ELSE    
-         !                                   ! North-South boundaries (closed)
-            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point
-                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north
-         ENDIF     
-      ENDIF
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
-      !
-      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            zt2ew(:,jl,1) = pt2d(jpreci+jl,:)
-            zt2we(:,jl,1) = pt2d(iihom +jl,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            pt2d(jl      ,:) = zt2we(:,jl,2)
-            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            pt2d(jl      ,:) = zt2we(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            zt2sn(:,jl,1) = pt2d(:,ijhom +jl)
-            zt2ns(:,jl,1) = pt2d(:,jprecj+jl)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            pt2d(:,jl      ) = zt2sn(:,jl,2)
-            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            pt2d(:,jl      ) = zt2sn(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
-      !
-   END SUBROUTINE mpp_lnk_2d
-
-
-   SUBROUTINE mpp_lnk_3d_gather( ptab1, cd_type1, ptab2, cd_type2, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_3d_gather  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for two 3D arrays
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    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  :   ptab1 and ptab2  with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab2     ! the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1  ! nature of ptab1 and ptab2 arrays
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type2  ! i.e. grid-points = T , U , V , F or W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn      ! =-1 the sign change across the north fold boundary
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER  ::   jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      INTEGER , DIMENSION(MPI_STATUS_SIZE)        ::   ml_stat   ! for key_mpi_isend
-      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ns, zt4sn   ! 2 x 3d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ew, zt4we   ! 2 x 3d for east-west & west-east
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) ,    &
-         &      zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) )
-      !
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !                                      ! East-West boundaries
-      !                                           !* Cyclic east-west
-      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-         ptab1( 1 ,:,:) = ptab1(jpim1,:,:)
-         ptab1(jpi,:,:) = ptab1(  2  ,:,:)
-         ptab2( 1 ,:,:) = ptab2(jpim1,:,:)
-         ptab2(jpi,:,:) = ptab2(  2  ,:,:)
-      ELSE                                        !* closed
-         IF( .NOT. cd_type1 == 'F' )   ptab1(     1       :jpreci,:,:) = 0.e0    ! south except at F-point
-         IF( .NOT. cd_type2 == 'F' )   ptab2(     1       :jpreci,:,:) = 0.e0
-                                       ptab1(nlci-jpreci+1:jpi   ,:,:) = 0.e0    ! north
-                                       ptab2(nlci-jpreci+1:jpi   ,:,:) = 0.e0
-      ENDIF
-                                            ! North-South boundaries
-      IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south
-         ptab1(:,     1       ,:) = ptab1(: ,  jpjm1 , :)
-         ptab1(:,   jpj       ,:) = ptab1(: ,      2 , :)
-         ptab2(:,     1       ,:) = ptab2(: ,  jpjm1 , :)
-         ptab2(:,   jpj       ,:) = ptab2(: ,      2 , :)
-      ELSE     
-      !                                      ! North-South boundaries closed
-      IF( .NOT. cd_type1 == 'F' )   ptab1(:,     1       :jprecj,:) = 0.e0    ! south except at F-point
-      IF( .NOT. cd_type2 == 'F' )   ptab2(:,     1       :jprecj,:) = 0.e0
-                                    ptab1(:,nlcj-jprecj+1:jpj   ,:) = 0.e0    ! north
-                                    ptab2(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
-      ENDIF     
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
-      !
-      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            zt4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)
-            zt4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)
-            zt4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)
-            zt4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk *2
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2)
-            ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab1(jl      ,:,:) = zt4we(:,jl,:,1,2)
-            ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2)
-            ptab2(jl      ,:,:) = zt4we(:,jl,:,2,2)
-            ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab1(jl      ,:,:) = zt4we(:,jl,:,1,2)
-            ptab2(jl      ,:,:) = zt4we(:,jl,:,2,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj - nrecj
-         DO jl = 1, jprecj
-            zt4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:)
-            zt4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:)
-            zt4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:)
-            zt4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk * 2
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2)
-            ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab1(:,jl      ,:) = zt4sn(:,jl,:,1,2)
-            ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2)
-            ptab2(:,jl      ,:) = zt4sn(:,jl,:,2,2)
-            ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab1(:,jl,:) = zt4sn(:,jl,:,1,2)
-            ptab2(:,jl,:) = zt4sn(:,jl,:,2,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      IF( npolj /= 0 ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )
-            CALL lbc_nfd      ( ptab1, cd_type1, psgn )   ! only for northern procs.
-            CALL lbc_nfd      ( ptab2, cd_type2, psgn )
-         CASE DEFAULT
-            CALL mpp_lbc_north( ptab1, cd_type1, psgn )   ! for all northern procs.
-            CALL mpp_lbc_north (ptab2, cd_type2, psgn)
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt4ns, zt4sn, zt4ew, zt4we )
-      !
-   END SUBROUTINE mpp_lnk_3d_gather
+   !!    mpp_lnk_2d_e     utilisé dans ICB 
+
+
+   !!    mpp_lnk_sum_2d et 3D   ====>>>>>>   à virer du code !!!!
+   
+   
+   !!----------------------------------------------------------------------
 
 
@@ -1284,38 +545,32 @@
 
 
-      ! 1. standard boundary treatment
+      ! 1. standard boundary treatment   (CAUTION: the order matters Here !!!! )
       ! ------------------------------
-      ! Order matters Here !!!!
-      !
-                                           ! North-South cyclic
-      IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south
-         pt2d(:, 1-jprj:  1     ) = pt2d ( :, jpjm1-jprj:jpjm1)
+      !                                !== North-South boundaries
+      !                                      !* cyclic
+      IF( nbondj == 2 .AND. jperio == 7 ) THEN
+         pt2d(:, 1-jprj:  1     ) = pt2d ( :, jpjm1-jprj:jpjm1 )
          pt2d(:, jpj   :jpj+jprj) = pt2d ( :, 2         :2+jprj)
-      ELSE
-        
-      !                                      !* North-South boundaries (closed)
-      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jprj   :  jprecj  ) = 0.e0    ! south except at F-point
-                                   pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0.e0    ! north
-      ENDIF
-                                
-      !                                      ! East-West boundaries
-      !                                           !* Cyclic east-west
+      ELSE                                   !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jprj   :  jprecj  ) = 0._wp     ! south except at F-point
+                                      pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0._wp     ! north
+      ENDIF
+      !                                !== East-West boundaries
+      !                                      !* Cyclic east-west
       IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-         pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)       ! east
-         pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)       ! west
-         !
-      ELSE                                        !* closed
-         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point
-                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north
-      ENDIF
-      !
-
+         pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)              ! east
+         pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)              ! west
+      ELSE                                   !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0._wp  ! south except at F-point
+                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0._wp  ! north
+      ENDIF
+      !
       ! north fold treatment
-      ! -----------------------
+      ! --------------------
       IF( npolj /= 0 ) THEN
          !
          SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )
-         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               )
+!!gm ERROR        CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )
+!!gm ERROR         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                  , cd_type, psgn             )
          END SELECT
          !
@@ -1375,5 +630,4 @@
       END SELECT
 
-
       ! 3. North and south directions
       ! -----------------------------
@@ -1430,347 +684,4 @@
    END SUBROUTINE mpp_lnk_2d_e
 
-   SUBROUTINE mpp_lnk_sum_3d( ptab, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_sum_3d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement (sum the overlap region)
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    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
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                             ! = T , U , V , F , W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                             ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
-
-      !!----------------------------------------------------------------------
-      
-      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
-         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
-
-      !
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0.e0      ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
-      !
-      SELECT CASE ( nbondi )      ! Read lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-      iihom = nlci-jpreci
-         DO jl = 1, jpreci
-            zt3ew(:,jl,:,1) = ptab(jl      ,:,:) ; ptab(jl      ,:,:) = 0.0_wp
-            zt3we(:,jl,:,1) = ptab(iihom+jl,:,:) ; ptab(iihom+jl,:,:) = 0.0_wp 
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write lateral conditions
-      iihom = nlci-nreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = ptab(iihom+jl,:,:) + zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2)
-            ptab(iihom +jl,:,:) = ptab(iihom +jl,:,:) + zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read lateral conditions
-         ijhom = nlcj-jprecj
-         DO jl = 1, jprecj
-            zt3sn(:,jl,:,1) = ptab(:,ijhom+jl,:) ; ptab(:,ijhom+jl,:) = 0.0_wp
-            zt3ns(:,jl,:,1) = ptab(:,jl      ,:) ; ptab(:,jl      ,:) = 0.0_wp
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write lateral conditions
-      ijhom = nlcj-nrecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = ptab(:,ijhom+jl,:) + zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl,:,2)
-            ptab(:,ijhom +jl,:) = ptab(:,ijhom +jl,:) + zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl   ,:,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
-      !
-   END SUBROUTINE mpp_lnk_sum_3d
-
-   SUBROUTINE mpp_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_sum_2d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for 2d array (sum the overlap region)
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                         ! = T , U , V , F , W and I points
-      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                         ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
-      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      INTEGER  ::   ji, jj, jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
-
-      !!----------------------------------------------------------------------
-
-      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
-         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
-
-      !
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0.e0      ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
-      !
-      SELECT CASE ( nbondi )      ! Read lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci - jpreci
-         DO jl = 1, jpreci
-            zt2ew(:,jl,1) = pt2d(jl       ,:) ; pt2d(jl       ,:) = 0.0_wp
-            zt2we(:,jl,1) = pt2d(iihom +jl,:) ; pt2d(iihom +jl,:) = 0.0_wp
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write lateral conditions
-      iihom = nlci-nreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            pt2d(iihom+jl,:) = pt2d(iihom+jl,:) + zt2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2)
-            pt2d(iihom +jl,:) = pt2d(iihom +jl,:) + zt2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read lateral conditions
-         ijhom = nlcj - jprecj
-         DO jl = 1, jprecj
-            zt2sn(:,jl,1) = pt2d(:,ijhom +jl) ; pt2d(:,ijhom +jl) = 0.0_wp
-            zt2ns(:,jl,1) = pt2d(:,jl       ) ; pt2d(:,jl       ) = 0.0_wp
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write lateral conditions
-      ijhom = nlcj-nrecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            pt2d(:,ijhom+jl) = pt2d(:,ijhom+jl) + zt2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2)
-            pt2d(:,ijhom +jl) = pt2d(:,ijhom +jl) + zt2ns(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
-      !
-   END SUBROUTINE mpp_lnk_sum_2d
 
    SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req )
@@ -1874,59 +785,69 @@
    END SUBROUTINE mppscatter
 
-
+   !!----------------------------------------------------------------------
+   !!    ***  mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real  ***
+   !!   
+   !!----------------------------------------------------------------------
+   !!
    SUBROUTINE mppmax_a_int( ktab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_a_int  ***
-      !!
-      !! ** Purpose :   Find maximum value in an integer layout array
-      !!
       !!----------------------------------------------------------------------
       INTEGER , INTENT(in   )                  ::   kdim   ! size of array
       INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab   ! input array
       INTEGER , INTENT(in   ), OPTIONAL        ::   kcom   !
-      !
-      INTEGER :: ierror, localcomm   ! temporary integer
+      INTEGER :: ierror, ilocalcomm   ! temporary integer
       INTEGER, DIMENSION(kdim) ::   iwork
       !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_max, localcomm, ierror )
-      !
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_max, ilocalcomm, ierror )
       ktab(:) = iwork(:)
-      !
    END SUBROUTINE mppmax_a_int
-
-
+   !!
    SUBROUTINE mppmax_int( ktab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_int  ***
-      !!
-      !! ** Purpose :   Find maximum value in an integer layout array
-      !!
       !!----------------------------------------------------------------------
       INTEGER, INTENT(inout)           ::   ktab   ! ???
       INTEGER, INTENT(in   ), OPTIONAL ::   kcom   ! ???
-      !
-      INTEGER ::   ierror, iwork, localcomm   ! temporary integer
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, localcomm, ierror )
-      !
+      INTEGER ::   ierror, iwork, ilocalcomm   ! temporary integer
+      !!----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, ilocalcomm, ierror )
       ktab = iwork
-      !
    END SUBROUTINE mppmax_int
-
-
+   !!
+   SUBROUTINE mppmax_a_real( ptab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(kdim), INTENT(inout) ::   ptab
+      INTEGER                  , INTENT(in   ) ::   kdim
+      INTEGER , OPTIONAL       , INTENT(in   ) ::   kcom
+      INTEGER :: ierror, ilocalcomm
+      REAL(wp), DIMENSION(kdim) ::  zwork
+      !!----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_max, ilocalcomm, ierror )
+      ptab(:) = zwork(:)
+   END SUBROUTINE mppmax_a_real
+   !!
+   SUBROUTINE mppmax_real( ptab, kcom )
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout)           ::   ptab   ! ???
+      INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ???
+      INTEGER  ::   ierror, ilocalcomm
+      REAL(wp) ::   zwork
+      !!----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom!
+      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_max, ilocalcomm, ierror )
+      ptab = zwork
+   END SUBROUTINE mppmax_real
+
+
+   !!----------------------------------------------------------------------
+   !!    ***  mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real  ***
+   !!   
+   !!----------------------------------------------------------------------
+   !!
    SUBROUTINE mppmin_a_int( ktab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_a_int  ***
-      !!
-      !! ** Purpose :   Find minimum value in an integer layout array
-      !!
       !!----------------------------------------------------------------------
       INTEGER , INTENT( in  )                  ::   kdim   ! size of array
@@ -1934,298 +855,156 @@
       INTEGER , INTENT( in  ), OPTIONAL        ::   kcom   ! input array
       !!
-      INTEGER ::   ierror, localcomm   ! temporary integer
+      INTEGER ::   ierror, ilocalcomm   ! temporary integer
       INTEGER, DIMENSION(kdim) ::   iwork
       !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_min, localcomm, ierror )
-      !
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_min, ilocalcomm, ierror )
       ktab(:) = iwork(:)
-      !
    END SUBROUTINE mppmin_a_int
-
-
+   !!
    SUBROUTINE mppmin_int( ktab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_int  ***
-      !!
-      !! ** Purpose :   Find minimum value in an integer layout array
-      !!
       !!----------------------------------------------------------------------
       INTEGER, INTENT(inout) ::   ktab      ! ???
       INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array
       !!
-      INTEGER ::  ierror, iwork, localcomm
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror )
-      !
+      INTEGER ::  ierror, iwork, ilocalcomm
+      !!----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, ilocalcomm, ierror )
       ktab = iwork
-      !
    END SUBROUTINE mppmin_int
-
-
-   SUBROUTINE mppsum_a_int( ktab, kdim )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_a_int  ***
-      !!
-      !! ** Purpose :   Global integer sum, 1D array case
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in   )                   ::   kdim   ! ???
-      INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab   ! ???
-      !
-      INTEGER :: ierror
-      INTEGER, DIMENSION (kdim) ::  iwork
-      !!----------------------------------------------------------------------
-      !
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
-      !
-      ktab(:) = iwork(:)
-      !
-   END SUBROUTINE mppsum_a_int
-
-
-   SUBROUTINE mppsum_int( ktab )
-      !!----------------------------------------------------------------------
-      !!                 ***  routine mppsum_int  ***
-      !!
-      !! ** Purpose :   Global integer sum
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(inout) ::   ktab
-      !!
-      INTEGER :: ierror, iwork
-      !!----------------------------------------------------------------------
-      !
-      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
-      !
-      ktab = iwork
-      !
-   END SUBROUTINE mppsum_int
-
-
-   SUBROUTINE mppmax_a_real( ptab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                 ***  routine mppmax_a_real  ***
-      !!
-      !! ** Purpose :   Maximum
-      !!
+   !!
+   SUBROUTINE mppmin_a_real( ptab, kdim, kcom )
       !!----------------------------------------------------------------------
       INTEGER , INTENT(in   )                  ::   kdim
       REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
       INTEGER , INTENT(in   ), OPTIONAL        ::   kcom
-      !
-      INTEGER :: ierror, localcomm
-      REAL(wp), DIMENSION(kdim) ::  zwork
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_max, localcomm, ierror )
-      ptab(:) = zwork(:)
-      !
-   END SUBROUTINE mppmax_a_real
-
-
-   SUBROUTINE mppmax_real( ptab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_real  ***
-      !!
-      !! ** Purpose :   Maximum
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(inout)           ::   ptab   ! ???
-      INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ???
-      !!
-      INTEGER  ::   ierror, localcomm
-      REAL(wp) ::   zwork
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_max, localcomm, ierror )
-      ptab = zwork
-      !
-   END SUBROUTINE mppmax_real
-
-   SUBROUTINE mppmax_real_multiple( ptab, NUM , kcom  )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_real  ***
-      !!
-      !! ** Purpose :   Maximum
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:) ,  INTENT(inout)           ::   ptab   ! ???
-      INTEGER , INTENT(in   )           ::   NUM
-      INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ???
-      !!
-      INTEGER  ::   ierror, localcomm
-      REAL(wp) , POINTER , DIMENSION(:) ::   zwork
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc(NUM , zwork)
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, NUM, mpi_double_precision, mpi_max, localcomm, ierror )
-      ptab = zwork
-      CALL wrk_dealloc(NUM , zwork)
-      !
-   END SUBROUTINE mppmax_real_multiple
-
-
-   SUBROUTINE mppmin_a_real( ptab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                 ***  routine mppmin_a_real  ***
-      !!
-      !! ** Purpose :   Minimum of REAL, array case
-      !!
-      !!-----------------------------------------------------------------------
-      INTEGER , INTENT(in   )                  ::   kdim
-      REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
-      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom
-      !!
-      INTEGER :: ierror, localcomm
+      INTEGER :: ierror, ilocalcomm
       REAL(wp), DIMENSION(kdim) ::   zwork
       !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_min, localcomm, ierror )
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_min, ilocalcomm, ierror )
       ptab(:) = zwork(:)
-      !
    END SUBROUTINE mppmin_a_real
-
-
+   !!
    SUBROUTINE mppmin_real( ptab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_real  ***
-      !!
-      !! ** Purpose :   minimum of REAL, scalar case
-      !!
       !!-----------------------------------------------------------------------
       REAL(wp), INTENT(inout)           ::   ptab        !
       INTEGER , INTENT(in   ), OPTIONAL :: kcom
-      !!
-      INTEGER  ::   ierror
-      REAL(wp) ::   zwork
-      INTEGER :: localcomm
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_min, localcomm, ierror )
-      ptab = zwork
-      !
-   END SUBROUTINE mppmin_real
-
-
-   SUBROUTINE mppsum_a_real( ptab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_a_real  ***
-      !!
-      !! ** Purpose :   global sum, REAL ARRAY argument case
-      !!
-      !!-----------------------------------------------------------------------
-      INTEGER , INTENT( in )                     ::   kdim      ! size of ptab
-      REAL(wp), DIMENSION(kdim), INTENT( inout ) ::   ptab      ! input array
-      INTEGER , INTENT( in ), OPTIONAL           :: kcom
-      !!
-      INTEGER                   ::   ierror    ! temporary integer
-      INTEGER                   ::   localcomm
-      REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_sum, localcomm, ierror )
-      ptab(:) = zwork(:)
-      !
-   END SUBROUTINE mppsum_a_real
-
-
-   SUBROUTINE mppsum_real( ptab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_real  ***
-      !!
-      !! ** Purpose :   global sum, SCALAR argument case
-      !!
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(inout)           ::   ptab   ! input scalar
-      INTEGER , INTENT(in   ), OPTIONAL ::   kcom
-      !!
-      INTEGER  ::   ierror, localcomm
+      INTEGER  ::   ierror, ilocalcomm
       REAL(wp) ::   zwork
       !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_sum, localcomm, ierror )
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_min, ilocalcomm, ierror )
       ptab = zwork
-      !
+   END SUBROUTINE mppmin_real
+
+
+   !!----------------------------------------------------------------------
+   !!    ***  mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real  ***
+   !!   
+   !!   Global sum of 1D array or a variable (integer, real or complex)
+   !!----------------------------------------------------------------------
+   !!
+   SUBROUTINE mppsum_a_int( ktab, kdim )
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   )                   ::   kdim   ! ???
+      INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab   ! ???
+      INTEGER :: ierror
+      INTEGER, DIMENSION (kdim) ::  iwork
+      !!----------------------------------------------------------------------
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
+      ktab(:) = iwork(:)
+   END SUBROUTINE mppsum_a_int
+   !!
+   SUBROUTINE mppsum_int( ktab )
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(inout) ::   ktab
+      INTEGER :: ierror, iwork
+      !!----------------------------------------------------------------------
+      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
+      ktab = iwork
+   END SUBROUTINE mppsum_int
+   !!
+   SUBROUTINE mppsum_a_real( ptab, kdim, kcom )
+      !!-----------------------------------------------------------------------
+      INTEGER                  , INTENT(in   ) ::   kdim   ! size of ptab
+      REAL(wp), DIMENSION(kdim), INTENT(inout) ::   ptab   ! input array
+      INTEGER , OPTIONAL       , INTENT(in   ) ::   kcom   ! specific communicator
+      INTEGER  ::   ierror, ilocalcomm    ! local integer
+      REAL(wp) ::   zwork(kdim)           ! local workspace
+      !!-----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_sum, ilocalcomm, ierror )
+      ptab(:) = zwork(:)
+   END SUBROUTINE mppsum_a_real
+   !!
+   SUBROUTINE mppsum_real( ptab, kcom )
+      !!-----------------------------------------------------------------------
+      REAL(wp)          , INTENT(inout)           ::   ptab   ! input scalar
+      INTEGER , OPTIONAL, INTENT(in   ) ::   kcom
+      INTEGER  ::   ierror, ilocalcomm
+      REAL(wp) ::   zwork
+      !!-----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_sum, ilocalcomm, ierror )
+      ptab = zwork
    END SUBROUTINE mppsum_real
-
-
+   !!
    SUBROUTINE mppsum_realdd( ytab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_realdd ***
-      !!
-      !! ** Purpose :   global sum in Massively Parallel Processing
-      !!                SCALAR argument case for double-double precision
-      !!
       !!-----------------------------------------------------------------------
-      COMPLEX(wp), INTENT(inout)           ::   ytab    ! input scalar
-      INTEGER    , INTENT(in   ), OPTIONAL ::   kcom
-      !
-      INTEGER     ::   ierror
-      INTEGER     ::   localcomm
+      COMPLEX(wp)          , INTENT(inout) ::   ytab    ! input scalar
+      INTEGER    , OPTIONAL, INTENT(in   ) ::   kcom
+      INTEGER     ::   ierror, ilocalcomm
       COMPLEX(wp) ::   zwork
       !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      ! reduce local sums into global sum
-      CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror )
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL MPI_ALLREDUCE( ytab, zwork, 1, MPI_DOUBLE_COMPLEX, MPI_SUMDD, ilocalcomm, ierror )
       ytab = zwork
-      !
    END SUBROUTINE mppsum_realdd
-
-
+   !!
    SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom )
       !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_a_realdd  ***
-      !!
-      !! ** Purpose :   global sum in Massively Parallel Processing
-      !!                COMPLEX ARRAY case for double-double precision
-      !!
-      !!-----------------------------------------------------------------------
       INTEGER                     , INTENT(in   ) ::   kdim   ! size of ytab
       COMPLEX(wp), DIMENSION(kdim), INTENT(inout) ::   ytab   ! input array
       INTEGER    , OPTIONAL       , INTENT(in   ) ::   kcom
-      !
-      INTEGER:: ierror, localcomm    ! local integer
+      INTEGER:: ierror, ilocalcomm    ! local integer
       COMPLEX(wp), DIMENSION(kdim) :: zwork     ! temporary workspace
       !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL MPI_ALLREDUCE( ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror )
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      CALL MPI_ALLREDUCE( ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, MPI_SUMDD, ilocalcomm, ierror )
       ytab(:) = zwork(:)
-      !
    END SUBROUTINE mppsum_a_realdd
+   
+
+   SUBROUTINE mppmax_real_multiple( pt1d, kdim, kcom  )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmax_real  ***
+      !!
+      !! ** Purpose :   Maximum across processor of each element of a 1D arrays
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(kdim), INTENT(inout) ::   pt1d   ! 1D arrays
+      INTEGER                  , INTENT(in   ) ::   kdim
+      INTEGER , OPTIONAL       , INTENT(in   ) ::   kcom   ! local communicator
+      !!
+      INTEGER  ::   ierror, ilocalcomm
+      REAL(wp), DIMENSION(kdim) ::  zwork
+      !!----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      !
+      CALL mpi_allreduce( pt1d, zwork, kdim, mpi_double_precision, mpi_max, ilocalcomm, ierror )
+      pt1d(:) = zwork(:)
+      !
+   END SUBROUTINE mppmax_real_multiple
 
 
@@ -2243,5 +1022,5 @@
       REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask   ! Local mask
       REAL(wp)                     , INTENT(  out) ::   pmin    ! Global minimum of ptab
-      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of minimum in global frame
+      INTEGER                      , INTENT(  out) ::   ki, kj  ! index of minimum in global frame
       !
       INTEGER :: ierror
@@ -2251,6 +1030,6 @@
       !!-----------------------------------------------------------------------
       !
-      zmin  = MINVAL( ptab(:,:) , mask= pmask == 1.e0 )
-      ilocs = MINLOC( ptab(:,:) , mask= pmask == 1.e0 )
+      zmin  = MINVAL( ptab(:,:) , mask= pmask == 1._wp )
+      ilocs = MINLOC( ptab(:,:) , mask= pmask == 1._wp )
       !
       ki = ilocs(1) + nimpp - 1
@@ -2279,9 +1058,9 @@
       !!
       !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
-      REAL(wp)                         , INTENT(  out) ::   pmin         ! Global minimum of ptab
-      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of minimum in global frame
-      !!
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptab         ! Local 2D array
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pmask        ! Local mask
+      REAL(wp)                  , INTENT(  out) ::   pmin         ! Global minimum of ptab
+      INTEGER                   , INTENT(  out) ::   ki, kj, kk   ! index of minimum in global frame
+      !
       INTEGER  ::   ierror
       REAL(wp) ::   zmin     ! local minimum
@@ -2290,6 +1069,6 @@
       !!-----------------------------------------------------------------------
       !
-      zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
-      ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
+      zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1._wp )
+      ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1._wp )
       !
       ki = ilocs(1) + nimpp - 1
@@ -2297,6 +1076,6 @@
       kk = ilocs(3)
       !
-      zain(1,:)=zmin
-      zain(2,:)=ki+10000.*kj+100000000.*kk
+      zain(1,:) = zmin
+      zain(2,:) = ki + 10000.*kj + 100000000.*kk
       !
       CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
@@ -2331,6 +1110,6 @@
       !!-----------------------------------------------------------------------
       !
-      zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1.e0 )
-      ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1.e0 )
+      zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1._wp )
+      ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1._wp )
       !
       ki = ilocs(1) + nimpp - 1
@@ -2359,17 +1138,17 @@
       !!
       !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
-      REAL(wp)                         , INTENT(  out) ::   pmax         ! Global maximum of ptab
-      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame
-      !!
-      REAL(wp) :: zmax   ! local maximum
+      REAL(wp), DIMENSION (:,:,:), INTENT(in   ) ::   ptab         ! Local 2D array
+      REAL(wp), DIMENSION (:,:,:), INTENT(in   ) ::   pmask        ! Local mask
+      REAL(wp)                   , INTENT(  out) ::   pmax         ! Global maximum of ptab
+      INTEGER                    , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame
+      !
+      INTEGER  ::   ierror   ! local integer
+      REAL(wp) ::   zmax     ! local maximum
       REAL(wp), DIMENSION(2,1) ::   zain, zaout
       INTEGER , DIMENSION(3)   ::   ilocs
-      INTEGER :: ierror
       !!-----------------------------------------------------------------------
       !
-      zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
-      ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
+      zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1._wp )
+      ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1._wp )
       !
       ki = ilocs(1) + nimpp - 1
@@ -2377,6 +1156,6 @@
       kk = ilocs(3)
       !
-      zain(1,:)=zmax
-      zain(2,:)=ki+10000.*kj+100000000.*kk
+      zain(1,:) = zmax
+      zain(2,:) = ki + 10000.*kj + 100000000.*kk
       !
       CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
@@ -2422,5 +1201,4 @@
 
    SUBROUTINE mpp_comm_free( kcom )
-      !!----------------------------------------------------------------------
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kcom
@@ -2680,462 +1458,4 @@
 
 
-   SUBROUTINE mpp_lbc_north_3d( pt3d, cd_type, psgn )
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_3d  ***
-      !!
-      !! ** Purpose :   Ensure proper north fold horizontal bondary condition
-      !!              in mpp configuration in case of jpn1 > 1
-      !!
-      !! ** Method  :   North fold condition and mpp with more than one proc
-      !!              in i-direction require a specific treatment. We gather
-      !!              the 4 northern lines of the global domain on 1 processor
-      !!              and apply lbc north-fold on this sub array. Then we
-      !!              scatter the north fold array back to the processors.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the b.c. is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
-      !                                                              !   = T ,  U , V , F or W  gridpoints
-      REAL(wp)                        , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER ::   ji, jj, jr, jk
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ijpjm1, ij, iproc
-      INTEGER, DIMENSION (jpmaxngh)          ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather
-      INTEGER                                ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
-      INTEGER, DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
-      !                                                              ! Workspace for message transfers avoiding mpi_allgather
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztab
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk      
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   :: znorthgloio
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztabl, ztabr
-
-      INTEGER :: istatus(mpi_status_size)
-      INTEGER :: iflag
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk), zfoldwk(jpi,4,jpk), znorthgloio(jpi,4,jpk,jpni) )
-      ALLOCATE( ztabl(jpi,4,jpk), ztabr(jpi*jpmaxngh, 4, jpk) ) 
-
-      ijpj   = 4
-      ijpjm1 = 3
-      !
-      znorthloc(:,:,:) = 0
-      DO jk = 1, jpk
-         DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d
-            ij = jj - nlcj + ijpj
-            znorthloc(:,ij,jk) = pt3d(:,jj,jk)
-         END DO
-      END DO
-      !
-      !                                     ! Build in procs of ncomm_north the znorthgloio
-      itaille = jpi * jpk * ijpj
-
-      IF ( l_north_nogather ) THEN
-         !
-        ztabr(:,:,:) = 0
-        ztabl(:,:,:) = 0
-
-        DO jk = 1, jpk
-           DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
-              ij = jj - nlcj + ijpj
-              DO ji = nfsloop, nfeloop
-                 ztabl(ji,ij,jk) = pt3d(ji,jj,jk)
-              END DO
-           END DO
-        END DO
-
-         DO jr = 1,nsndto
-            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-              CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) )
-            ENDIF
-         END DO
-         DO jr = 1,nsndto
-            iproc = nfipproc(isendto(jr),jpnj)
-            IF(iproc .ne. -1) THEN
-               ilei = nleit (iproc+1)
-               ildi = nldit (iproc+1)
-               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
-            ENDIF
-            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
-              CALL mpprecv(5, zfoldwk, itaille, iproc)
-              DO jk = 1, jpk
-                 DO jj = 1, ijpj
-                    DO ji = ildi, ilei
-                       ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk)
-                    END DO
-                 END DO
-              END DO
-           ELSE IF (iproc .eq. (narea-1)) THEN
-              DO jk = 1, jpk
-                 DO jj = 1, ijpj
-                    DO ji = ildi, ilei
-                       ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk)
-                    END DO
-                 END DO
-              END DO
-           ENDIF
-         END DO
-         IF (l_isend) THEN
-            DO jr = 1,nsndto
-               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
-               ENDIF    
-            END DO
-         ENDIF
-         CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition
-         DO jk = 1, jpk
-            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
-               ij = jj - nlcj + ijpj
-               DO ji= 1, nlci
-                  pt3d(ji,jj,jk) = ztabl(ji,ij,jk)
-               END DO
-            END DO
-         END DO
-         !
-
-      ELSE
-         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
-            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
-         !
-         ztab(:,:,:) = 0.e0
-         DO jr = 1, ndim_rank_north         ! recover the global north array
-            iproc = nrank_north(jr) + 1
-            ildi  = nldit (iproc)
-            ilei  = nleit (iproc)
-            iilb  = nimppt(iproc)
-            DO jk = 1, jpk
-               DO jj = 1, ijpj
-                  DO ji = ildi, ilei
-                    ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr)
-                  END DO
-               END DO
-            END DO
-         END DO
-         CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
-         !
-         DO jk = 1, jpk
-            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
-               ij = jj - nlcj + ijpj
-               DO ji= 1, nlci
-                  pt3d(ji,jj,jk) = ztab(ji+nimpp-1,ij,jk)
-               END DO
-            END DO
-         END DO
-         !
-      ENDIF
-      !
-      ! The ztab array has been either:
-      !  a. Fully populated by the mpi_allgather operation or
-      !  b. Had the active points for this domain and northern neighbours populated
-      !     by peer to peer exchanges
-      ! Either way the array may be folded by lbc_nfd and the result for the span of
-      ! this domain will be identical.
-      !
-      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
-      DEALLOCATE( ztabl, ztabr ) 
-      !
-   END SUBROUTINE mpp_lbc_north_3d
-
-
-   SUBROUTINE mpp_lbc_north_2d( pt2d, cd_type, psgn)
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_2d  ***
-      !!
-      !! ** Purpose :   Ensure proper north fold horizontal bondary condition
-      !!              in mpp configuration in case of jpn1 > 1 (for 2d array )
-      !!
-      !! ** Method  :   North fold condition and mpp with more than one proc
-      !!              in i-direction require a specific treatment. We gather
-      !!              the 4 northern lines of the global domain on 1 processor
-      !!              and apply lbc north-fold on this sub array. Then we
-      !!              scatter the north fold array back to the processors.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 2D array on which the b.c. is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt2d grid-points
-      !                                                          !   = T ,  U , V , F or W  gridpoints
-      REAL(wp)                    , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER ::   ji, jj, jr
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ijpjm1, ij, iproc
-      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather
-      INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
-      INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
-      !                                                              ! Workspace for message transfers avoiding mpi_allgather
-      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: ztab
-      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk      
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   :: znorthgloio
-      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: ztabl, ztabr
-      INTEGER :: istatus(mpi_status_size)
-      INTEGER :: iflag
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( ztab(jpiglo,4), znorthloc(jpi,4), zfoldwk(jpi,4), znorthgloio(jpi,4,jpni) )
-      ALLOCATE( ztabl(jpi,4), ztabr(jpi*jpmaxngh, 4) ) 
-      !
-      ijpj   = 4
-      ijpjm1 = 3
-      !
-      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d
-         ij = jj - nlcj + ijpj
-         znorthloc(:,ij) = pt2d(:,jj)
-      END DO
-
-      !                                     ! Build in procs of ncomm_north the znorthgloio
-      itaille = jpi * ijpj
-      IF ( l_north_nogather ) THEN
-         !
-         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 
-         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange
-         !
-         ztabr(:,:) = 0
-         ztabl(:,:) = 0
-
-         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
-            ij = jj - nlcj + ijpj
-              DO ji = nfsloop, nfeloop
-               ztabl(ji,ij) = pt2d(ji,jj)
-            END DO
-         END DO
-
-         DO jr = 1,nsndto
-            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-               CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr))
-            ENDIF
-         END DO
-         DO jr = 1,nsndto
-            iproc = nfipproc(isendto(jr),jpnj)
-            IF(iproc .ne. -1) THEN
-               ilei = nleit (iproc+1)
-               ildi = nldit (iproc+1)
-               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
-            ENDIF
-            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
-              CALL mpprecv(5, zfoldwk, itaille, iproc)
-              DO jj = 1, ijpj
-                 DO ji = ildi, ilei
-                    ztabr(iilb+ji,jj) = zfoldwk(ji,jj)
-                 END DO
-              END DO
-            ELSE IF (iproc .eq. (narea-1)) THEN
-              DO jj = 1, ijpj
-                 DO ji = ildi, ilei
-                    ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj)
-                 END DO
-              END DO
-            ENDIF
-         END DO
-         IF (l_isend) THEN
-            DO jr = 1,nsndto
-               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
-               ENDIF
-            END DO
-         ENDIF
-         CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition
-         !
-         DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
-            ij = jj - nlcj + ijpj
-            DO ji = 1, nlci
-               pt2d(ji,jj) = ztabl(ji,ij)
-            END DO
-         END DO
-         !
-      ELSE
-         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,        &
-            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
-         !
-         ztab(:,:) = 0.e0
-         DO jr = 1, ndim_rank_north            ! recover the global north array
-            iproc = nrank_north(jr) + 1
-            ildi = nldit (iproc)
-            ilei = nleit (iproc)
-            iilb = nimppt(iproc)
-            DO jj = 1, ijpj
-               DO ji = ildi, ilei
-                  ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr)
-               END DO
-            END DO
-         END DO
-         CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
-         !
-         DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
-            ij = jj - nlcj + ijpj
-            DO ji = 1, nlci
-               pt2d(ji,jj) = ztab(ji+nimpp-1,ij)
-            END DO
-         END DO
-         !
-      ENDIF
-      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
-      DEALLOCATE( ztabl, ztabr ) 
-      !
-   END SUBROUTINE mpp_lbc_north_2d
-
-   SUBROUTINE mpp_lbc_north_2d_multiple( pt2d_array, cd_type, psgn, num_fields)
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_2d  ***
-      !!
-      !! ** Purpose :   Ensure proper north fold horizontal bondary condition
-      !!              in mpp configuration in case of jpn1 > 1
-      !!              (for multiple 2d arrays )
-      !!
-      !! ** Method  :   North fold condition and mpp with more than one proc
-      !!              in i-direction require a specific treatment. We gather
-      !!              the 4 northern lines of the global domain on 1 processor
-      !!              and apply lbc north-fold on this sub array. Then we
-      !!              scatter the north fold array back to the processors.
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER ,  INTENT (in   ) ::   num_fields  ! number of variables contained in pt2d
-      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
-      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   cd_type   ! nature of pt2d grid-points
-      !                                                          !   = T ,  U , V , F or W  gridpoints
-      REAL(wp), DIMENSION(:), INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER ::   ji, jj, jr, jk
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ijpjm1, ij, iproc
-      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather
-      INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
-      INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
-      !                                                              ! Workspace for message transfers avoiding mpi_allgather
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztab
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   :: znorthgloio
-      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztabl, ztabr
-      INTEGER :: istatus(mpi_status_size)
-      INTEGER :: iflag
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( ztab(jpiglo,4,num_fields), znorthloc(jpi,4,num_fields), zfoldwk(jpi,4,num_fields),   &
-            &   znorthgloio(jpi,4,num_fields,jpni) )   ! expanded to 3 dimensions
-      ALLOCATE( ztabl(jpi,4,num_fields), ztabr(jpi*jpmaxngh, 4,num_fields) )
-      !
-      ijpj   = 4
-      ijpjm1 = 3
-      !
-      
-      DO jk = 1, num_fields
-         DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d (for every variable)
-            ij = jj - nlcj + ijpj
-            znorthloc(:,ij,jk) = pt2d_array(jk)%pt2d(:,jj)
-         END DO
-      END DO
-      !                                     ! Build in procs of ncomm_north the znorthgloio
-      itaille = jpi * ijpj
-                                                                  
-      IF ( l_north_nogather ) THEN
-         !
-         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 
-         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange
-         !
-         ztabr(:,:,:) = 0
-         ztabl(:,:,:) = 0
-
-         DO jk = 1, num_fields
-            DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
-               ij = jj - nlcj + ijpj
-               DO ji = nfsloop, nfeloop
-                  ztabl(ji,ij,jk) = pt2d_array(jk)%pt2d(ji,jj)
-               END DO
-            END DO
-         END DO
-
-         DO jr = 1,nsndto
-            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-               CALL mppsend(5, znorthloc, itaille*num_fields, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) ! Buffer expanded "num_fields" times
-            ENDIF
-         END DO
-         DO jr = 1,nsndto
-            iproc = nfipproc(isendto(jr),jpnj)
-            IF(iproc .ne. -1) THEN
-               ilei = nleit (iproc+1)
-               ildi = nldit (iproc+1)
-               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
-            ENDIF
-            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
-              CALL mpprecv(5, zfoldwk, itaille*num_fields, iproc) ! Buffer expanded "num_fields" times
-              DO jk = 1 , num_fields
-                 DO jj = 1, ijpj
-                    DO ji = ildi, ilei
-                       ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk)       ! Modified to 3D
-                    END DO
-                 END DO
-              END DO
-            ELSE IF (iproc .eq. (narea-1)) THEN
-              DO jk = 1, num_fields
-                 DO jj = 1, ijpj
-                    DO ji = ildi, ilei
-                          ztabr(iilb+ji,jj,jk) = pt2d_array(jk)%pt2d(ji,nlcj-ijpj+jj)       ! Modified to 3D
-                    END DO
-                 END DO
-              END DO
-            ENDIF
-         END DO
-         IF (l_isend) THEN
-            DO jr = 1,nsndto
-               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
-                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
-               ENDIF
-            END DO
-         ENDIF
-         !
-         DO ji = 1, num_fields     ! Loop to manage 3D variables
-            CALL mpp_lbc_nfd( ztabl(:,:,ji), ztabr(:,:,ji), cd_type(ji), psgn(ji) )  ! North fold boundary condition
-         END DO
-         !
-         DO jk = 1, num_fields
-            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
-               ij = jj - nlcj + ijpj
-               DO ji = 1, nlci
-                  pt2d_array(jk)%pt2d(ji,jj) = ztabl(ji,ij,jk)       ! Modified to 3D
-               END DO
-            END DO
-         END DO
-         
-         !
-      ELSE
-         !
-         CALL MPI_ALLGATHER( znorthloc  , itaille*num_fields, MPI_DOUBLE_PRECISION,        &
-            &                znorthgloio, itaille*num_fields, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
-         !
-         ztab(:,:,:) = 0.e0
-         DO jk = 1, num_fields
-            DO jr = 1, ndim_rank_north            ! recover the global north array
-               iproc = nrank_north(jr) + 1
-               ildi = nldit (iproc)
-               ilei = nleit (iproc)
-               iilb = nimppt(iproc)
-               DO jj = 1, ijpj
-                  DO ji = ildi, ilei
-                     ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr)
-                  END DO
-               END DO
-            END DO
-         END DO
-         
-         DO ji = 1, num_fields
-            CALL lbc_nfd( ztab(:,:,ji), cd_type(ji), psgn(ji) )   ! North fold boundary condition
-         END DO
-         !
-         DO jk = 1, num_fields
-            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
-               ij = jj - nlcj + ijpj
-               DO ji = 1, nlci
-                  pt2d_array(jk)%pt2d(ji,jj) = ztab(ji+nimpp-1,ij,jk)
-               END DO
-            END DO
-         END DO
-         !
-         !
-      ENDIF
-      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
-      DEALLOCATE( ztabl, ztabr )
-      !
-   END SUBROUTINE mpp_lbc_north_2d_multiple
-
    SUBROUTINE mpp_lbc_north_e( pt2d, cd_type, psgn)
       !!---------------------------------------------------------------------
@@ -3155,40 +1475,36 @@
       REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
       CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points
-      !                                                                                         !   = T ,  U , V , F or W -points
-      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! = -1. the sign change across the
-      !!                                                                                        ! north fold, =  1. otherwise
+      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! sign used across the north fold
+      !
       INTEGER ::   ji, jj, jr
       INTEGER ::   ierr, itaille, ildi, ilei, iilb
       INTEGER ::   ijpj, ij, iproc
-      !
       REAL(wp), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e
-
       !!----------------------------------------------------------------------
       !
       ALLOCATE( ztab_e(jpiglo,4+2*jpr2dj), znorthloc_e(jpi,4+2*jpr2dj), znorthgloio_e(jpi,4+2*jpr2dj,jpni) )
-
       !
       ijpj=4
-      ztab_e(:,:) = 0.e0
-
-      ij=0
+      ztab_e(:,:) = 0._wp
+
+      ij = 0
       ! put in znorthloc_e the last 4 jlines of pt2d
       DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj
          ij = ij + 1
          DO ji = 1, jpi
-            znorthloc_e(ji,ij)=pt2d(ji,jj)
+            znorthloc_e(ji,ij) = pt2d(ji,jj)
          END DO
       END DO
       !
       itaille = jpi * ( ijpj + 2 * jpr2dj )
-      CALL MPI_ALLGATHER( znorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    &
+      CALL MPI_ALLGATHER( znorthloc_e(1,1)    , itaille, MPI_DOUBLE_PRECISION,    &
          &                znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
       !
       DO jr = 1, ndim_rank_north            ! recover the global north array
          iproc = nrank_north(jr) + 1
-         ildi = nldit (iproc)
-         ilei = nleit (iproc)
-         iilb = nimppt(iproc)
+         ildi  = nldit (iproc)
+         ilei  = nleit (iproc)
+         iilb  = nimppt(iproc)
          DO jj = 1, ijpj+2*jpr2dj
             DO ji = ildi, ilei
@@ -3198,8 +1514,7 @@
       END DO
 
-
       ! 2. North-Fold boundary conditions
       ! ----------------------------------
-      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj )
+!!gm ERROR      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj )
 
       ij = jpr2dj
@@ -3215,434 +1530,4 @@
       !
    END SUBROUTINE mpp_lbc_north_e
-
-
-   SUBROUTINE mpp_lnk_bdy_3d( ptab, cd_type, psgn, ib_bdy )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_bdy_3d  ***
-      !!
-      !! ** 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
-      !!                    nbondi_bdy : mark for "east-west local boundary"
-      !!                    nbondj_bdy : mark for "north-south local boundary"
-      !!                    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
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                             ! = T , U , V , F , W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                             ! =  1. , the sign is kept
-      INTEGER                         , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
-      !
-      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! local integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland                      ! local scalar
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
-         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
-
-      zland = 0._wp
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !                                   ! East-West boundaries
-      !                                        !* Cyclic east-west
-      IF( nbondi == 2) THEN
-         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
-            ptab( 1 ,:,:) = ptab(jpim1,:,:)
-            ptab(jpi,:,:) = ptab(  2  ,:,:)
-         ELSE
-            IF( .NOT. cd_type == 'F' )   ptab(1:jpreci,:,:) = zland    ! south except F-point
-            ptab(nlci-jpreci+1:jpi,:,:) = zland    ! north
-         ENDIF
-      ELSEIF(nbondi == -1) THEN
-         IF( .NOT. cd_type == 'F' )   ptab(1:jpreci,:,:) = zland    ! south except F-point
-      ELSEIF(nbondi == 1) THEN
-         ptab(nlci-jpreci+1:jpi,:,:) = zland    ! north
-      ENDIF                                     !* closed
-
-      IF (nbondj == 2 .OR. nbondj == -1) THEN
-        IF( .NOT. cd_type == 'F' )   ptab(:,1:jprecj,:) = zland       ! south except F-point
-      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
-        ptab(:,nlcj-jprecj+1:jpj,:) = zland       ! north
-      ENDIF
-      !
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity 
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
-            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )
-      CASE ( -1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
-      CASE ( 0 )
-         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
-      CASE ( 1 )
-         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
-      END SELECT
-      !
-      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-      CASE ( 0 )
-         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
-      CASE ( 1 )
-         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
-      END SELECT
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )
-      CASE ( -1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci-jpreci
-      !
-      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab(      jl,:,:) = zt3we(:,jl,:,2)
-            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(      jl,:,:) = zt3we(:,jl,:,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj_bdy(ib_bdy) /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
-            zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk
-      !
-      SELECT CASE ( nbondj_bdy(ib_bdy) )
-      CASE ( -1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
-      CASE ( 0 )
-         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
-      CASE ( 1 )
-         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
-      END SELECT
-      !
-      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-      CASE ( 0 )
-         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
-      CASE ( 1 )
-         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
-      END SELECT
-      !
-      SELECT CASE ( nbondj_bdy(ib_bdy) )
-      CASE ( -1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj-jprecj
-      !
-      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab(:,jl      ,:) = zt3sn(:,jl,:,2)
-            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jl,:) = zt3sn(:,jl,:,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we  )
-      !
-   END SUBROUTINE mpp_lnk_bdy_3d
-
-
-   SUBROUTINE mpp_lnk_bdy_2d( ptab, cd_type, psgn, ib_bdy )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_bdy_2d  ***
-      !!
-      !! ** 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
-      !!                    nbondi_bdy : mark for "east-west local boundary"
-      !!                    nbondj_bdy : mark for "north-south local boundary"
-      !!                    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
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                         ! = T , U , V , F , W points
-      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                         ! =  1. , the sign is kept
-      INTEGER                     , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
-      !
-      INTEGER  ::   ji, jj, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! local integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
-      !!----------------------------------------------------------------------
-
-      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
-         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
-
-      zland = 0._wp
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !                                   ! East-West boundaries
-      !                                      !* Cyclic east-west
-      IF( nbondi == 2 ) THEN
-         IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
-            ptab( 1 ,:) = ptab(jpim1,:)
-            ptab(jpi,:) = ptab(  2  ,:)
-         ELSE
-            IF(.NOT.cd_type == 'F' )  ptab(     1       :jpreci,:) = zland    ! south except F-point
-                                      ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
-         ENDIF
-      ELSEIF(nbondi == -1) THEN
-         IF( .NOT.cd_type == 'F' )    ptab(     1       :jpreci,:) = zland    ! south except F-point
-      ELSEIF(nbondi == 1) THEN
-                                      ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
-      ENDIF
-      !                                      !* closed
-      IF( nbondj == 2 .OR. nbondj == -1 ) THEN
-         IF( .NOT.cd_type == 'F' )    ptab(:,     1       :jprecj) = zland    ! south except F-point
-      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
-                                      ptab(:,nlcj-jprecj+1:jpj   ) = zland    ! north
-      ENDIF
-      !
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity 
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            zt2ew(:,jl,1) = ptab(jpreci+jl,:)
-            zt2we(:,jl,1) = ptab(iihom +jl,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )
-      CASE ( -1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
-      CASE ( 0 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
-      CASE ( 1 )
-         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
-      END SELECT
-      !
-      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-      CASE ( 0 )
-         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-      CASE ( 1 )
-         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
-      END SELECT
-      !
-      SELECT CASE ( nbondi_bdy(ib_bdy) )
-      CASE ( -1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci-jpreci
-      !
-      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:) = zt2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:) = zt2we(:,jl,2)
-            ptab(iihom+jl,:) = zt2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:) = zt2we(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj_bdy(ib_bdy) /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            zt2sn(:,jl,1) = ptab(:,ijhom +jl)
-            zt2ns(:,jl,1) = ptab(:,jprecj+jl)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
-      !
-      SELECT CASE ( nbondj_bdy(ib_bdy) )
-      CASE ( -1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
-      CASE ( 0 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
-      CASE ( 1 )
-         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
-      END SELECT
-      !
-      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-      CASE ( 0 )
-         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-      CASE ( 1 )
-         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
-      END SELECT
-      !
-      SELECT CASE ( nbondj_bdy(ib_bdy) )
-      CASE ( -1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj-jprecj
-      !
-      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl) = zt2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            ptab(:,jl      ) = zt2sn(:,jl,2)
-            ptab(:,ijhom+jl) = zt2ns(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jl) = zt2sn(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we  )
-      !
-   END SUBROUTINE mpp_lnk_bdy_2d
 
 
@@ -3706,5 +1591,6 @@
    END SUBROUTINE mpi_init_opa
 
-   SUBROUTINE DDPDD_MPI (ydda, yddb, ilen, itype)
+
+   SUBROUTINE DDPDD_MPI( ydda, yddb, ilen, itype )
       !!---------------------------------------------------------------------
       !!   Routine DDPDD_MPI: used by reduction operator MPI_SUMDD
@@ -3713,13 +1599,14 @@
       !!   This subroutine computes yddb(i) = ydda(i)+yddb(i)
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in)                         :: ilen, itype
-      COMPLEX(wp), DIMENSION(ilen), INTENT(in)     :: ydda
-      COMPLEX(wp), DIMENSION(ilen), INTENT(inout)  :: yddb
+      INTEGER                     , INTENT(in)    ::   ilen, itype
+      COMPLEX(wp), DIMENSION(ilen), INTENT(in)    ::   ydda
+      COMPLEX(wp), DIMENSION(ilen), INTENT(inout) ::   yddb
       !
       REAL(wp) :: zerr, zt1, zt2    ! local work variables
-      INTEGER :: ji, ztmp           ! local scalar
-
+      INTEGER  :: ji, ztmp           ! local scalar
+      !!---------------------------------------------------------------------
+      !
       ztmp = itype   ! avoid compilation warning
-
+      !
       DO ji=1,ilen
       ! Compute ydda + yddb using Knuth's trick.
@@ -3732,5 +1619,5 @@
          yddb(ji) = cmplx ( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1),wp )
       END DO
-
+      !
    END SUBROUTINE DDPDD_MPI
 
@@ -3802,8 +1689,7 @@
       END DO
 
-
       ! 2. North-Fold boundary conditions
       ! ----------------------------------
-      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = ipr2dj )
+!!gm ERROR      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = ipr2dj )
 
       ij = ipr2dj
@@ -3841,21 +1727,18 @@
       !!                    nono   : number for local neighboring processors
       !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
+      CHARACTER(len=1)                                    , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
+      REAL(wp)                                            , INTENT(in   ) ::   psgn     ! sign used across the north fold
       INTEGER                                             , INTENT(in   ) ::   jpri
       INTEGER                                             , INTENT(in   ) ::   jprj
-      REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
-      CHARACTER(len=1)                                    , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
-      !                                                                                 ! = T , U , V , F , W and I points
-      REAL(wp)                                            , INTENT(in   ) ::   psgn     ! =-1 the sign change across the
-      !!                                                                                ! north boundary, =  1. otherwise
+      !
       INTEGER  ::   jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ipreci, iprecj             ! temporary integers
+      INTEGER  ::   imigr, iihom, ijhom        ! local integers
+      INTEGER  ::   ipreci, iprecj             !   -       -
       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
       !!
-      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns
-      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn
-      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe
-      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) ::   r2dns, r2dsn
+      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) ::   r2dwe, r2dew
       !!----------------------------------------------------------------------
 
@@ -3875,6 +1758,6 @@
          !
       ELSE                                        !* closed
-         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point
-                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0._wp    ! south except at F-point
+                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0._wp    ! north
       ENDIF
       !
@@ -3885,6 +1768,6 @@
          !
          SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )
-         CASE DEFAULT   ;   CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+jprj)  , cd_type, psgn , pr2dj=jprj  )
+!!gm ERROR         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )
+!!gm ERROR         CASE DEFAULT   ;   CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+jprj)  , cd_type, psgn , pr2dj=jprj  )
          END SELECT
          !
@@ -3996,5 +1879,5 @@
          END DO
       END SELECT
-
+      !
    END SUBROUTINE mpp_lnk_2d_icb
    
@@ -4020,4 +1903,7 @@
       MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
    END INTERFACE
+   INTERFACE mpp_max_multiple
+      MODULE PROCEDURE mppmax_real_multiple
+   END INTERFACE
 
    LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag
@@ -4191,4 +2077,12 @@
       WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?', kcom
    END SUBROUTINE mpp_comm_free
+   
+   SUBROUTINE mppmax_real_multiple( ptab, kdim , kcom  )
+      REAL, DIMENSION(:) ::   ptab   ! 
+      INTEGER            ::   kdim   ! 
+      INTEGER, OPTIONAL  ::   kcom   ! 
+      WRITE(*,*) 'mppmax_real_multiple: You should not have seen this print! error?', ptab(1), kdim
+   END SUBROUTINE mppmax_real_multiple
+
 #endif
 
@@ -4225,5 +2119,5 @@
                                CALL FLUSH(numout    )
       IF( numstp     /= -1 )   CALL FLUSH(numstp    )
-      IF( numsol     /= -1 )   CALL FLUSH(numsol    )
+      IF( numrun     /= -1 )   CALL FLUSH(numrun    )
       IF( numevo_ice /= -1 )   CALL FLUSH(numevo_ice)
       !
@@ -4332,5 +2226,5 @@
             WRITE(kout,*)
          ENDIF
-         CALL FLUSH(kout) 
+         CALL FLUSH( kout ) 
          STOP 'ctl_opn bad opening'
       ENDIF
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_bdy_generic.h90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_bdy_generic.h90	(revision 8226)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_bdy_generic.h90	(revision 8226)
@@ -0,0 +1,298 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define IBD_IN(k)                kb_bdy(k)
+#   define F_SIZE(ptab)             kfld
+#   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 IBD_IN(k)                kb_bdy
+#   define F_SIZE(ptab)             1
+#   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
+
+#if defined MULTI
+   SUBROUTINE ROUTINE_BDY( ptab, cd_nat, psgn, kfld, kb_bdy )
+      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays
+#else
+   SUBROUTINE ROUTINE_BDY( ptab, cd_nat, psgn      , kb_bdy )
+#endif
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_bdy_3d  ***
+      !!
+      !! ** 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
+      !!                    nbondi_bdy : mark for "east-west local boundary"
+      !!                    nbondj_bdy : mark for "north-south local boundary"
+      !!                    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
+      !!
+      !!----------------------------------------------------------------------
+      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
+      INTEGER                     , INTENT(in   ) ::   IBD_IN(:)   ! BDY boundary set
+      !
+      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
+      REAL(wp) ::   zland                      ! local scalar
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !      
+      ALLOCATE( zt3ns(jpi,jprecj,ipk,ipl,ipf,2), zt3sn(jpi,jprecj,ipk,ipl,ipf,2),   &
+         &      zt3ew(jpj,jpreci,ipk,ipl,ipf,2), zt3we(jpj,jpreci,ipk,ipl,ipf,2)  )
+
+      zland = 0._wp
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !
+      DO jf = 1, ipf                   ! number of arrays to be treated
+         !
+         !                                ! East-West boundaries
+         !                    
+         IF( nbondi == 2) THEN                  ! neither subdomain to the east nor to the west
+            !                                      !* Cyclic
+            IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
+               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
+               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf)
+            ELSE                                   !* Closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(     1       :jpreci,:,:,:,jf) = zland  ! east except F-point
+                                               ARRAY_IN(nlci-jpreci+1:jpi   ,:,:,:,jf) = zland  ! west
+            ENDIF
+         ELSEIF(nbondi == -1) THEN              ! subdomain to the east only
+            IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(1:jpreci,:,:,:,jf) = zland     ! south except F-point
+            !
+         ELSEIF(nbondi == 1) THEN               ! subdomain to the west only
+            ARRAY_IN(nlci-jpreci+1:jpi,:,:,:,jf) = zland    ! north
+         ENDIF
+         !                                ! North-South boundaries
+         !
+         IF (nbondj == 2 .OR. nbondj == -1) THEN      !* closed
+           IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:,1:jprecj,:,:,jf) = zland            ! south except F-point
+         ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
+                                           ARRAY_IN(:,nlcj-jprecj+1:jpj,:,:,jf) = zland   ! north
+         ENDIF
+      END DO
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity 
+      !
+      !
+      DO jf = 1, ipf
+         SELECT CASE ( nbondi_bdy(IBD_IN(jf)) )      ! Read Dirichlet lateral conditions
+         CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+            iihom = nlci-nreci
+               DO jl = 1, ipl
+                  DO jk = 1, ipk
+                     DO jh = 1, jpreci
+                        zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(jpreci+jh,:,jk,jl,jf)
+                        zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf)
+                     END DO
+                  END DO
+               END DO
+         END SELECT
+         !
+         !                           ! Migrations
+!!gm      imigr = jpreci * jpj * ipk * ipl * ipf
+         imigr = jpreci * jpj * ipk * ipl
+         !
+         SELECT CASE ( nbondi_bdy(IBD_IN(jf)) )
+         CASE ( -1 )
+            CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req1 )
+            CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         CASE ( 0 )
+            CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+            CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req2 )
+            CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
+            CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+            IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+         CASE ( 1 )
+            CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+            CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         END SELECT
+         !
+         !                           ! Write Dirichlet lateral conditions
+         iihom = nlci-jpreci
+         !
+         !
+         SELECT CASE ( nbondi_bdy_b(IBD_IN(jf)) )
+         CASE ( -1 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jpreci
+                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         CASE ( 0 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jpreci
+                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
+                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         CASE ( 1 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jpreci
+                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END SELECT
+         !
+      END DO
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      DO jf = 1, ipf
+         IF( nbondj_bdy(IBD_IN(jf)) /= 2 ) THEN      ! Read Dirichlet lateral conditions
+            ijhom = nlcj-nrecj
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jprecj
+                     zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf)
+                     zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,jprecj+jh,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         !
+         !                           ! Migrations
+!!gm      imigr = jprecj * jpi * ipk * ipl * ipf
+         imigr = jprecj * jpi * ipk * ipl
+         !
+         SELECT CASE ( nbondj_bdy(IBD_IN(jf)) )
+         CASE ( -1 )
+            CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req1 )
+            CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         CASE ( 0 )
+            CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+            CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req2 )
+            CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
+            CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+            IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+         CASE ( 1 )
+            CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+            CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         END SELECT
+         !
+         !                           ! Write Dirichlet lateral conditions
+         ijhom = nlcj-jprecj
+         !
+         SELECT CASE ( nbondj_bdy_b(IBD_IN(jf)) )
+         CASE ( -1 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jprecj
+                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         CASE ( 0 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jprecj
+                     ARRAY_IN(:,      jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
+                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         CASE ( 1 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jprecj
+                     ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END SELECT
+      END DO
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:) )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we  )
+      !
+   END SUBROUTINE ROUTINE_BDY
+
+#undef ARRAY_TYPE
+#undef NAT_IN
+#undef SGN_IN
+#undef IBD_IN
+#undef ARRAY_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_lnk_generic.h90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_lnk_generic.h90	(revision 8226)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_lnk_generic.h90	(revision 8226)
@@ -0,0 +1,310 @@
+#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
+
+#if defined MULTI
+   SUBROUTINE ROUTINE_LNK( ptab, cd_nat, psgn, kfld, cd_mpp, pval )
+      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays
+#else
+   SUBROUTINE ROUTINE_LNK( ptab, cd_nat, psgn      , cd_mpp, pval )
+#endif
+      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
+      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp      ! fill the overlap area only
+      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval        ! background value (used at closed boundaries)
+      !
+      INTEGER  ::    ji,  jj,  jk,  jl, jh, jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl, ipf      ! dimension of the input array
+      INTEGER  ::   imigr, iihom, ijhom          ! local integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend
+      REAL(wp) ::   zland
+      LOGICAL  ::   ll_Iperio, ll_Jperio
+      INTEGER , DIMENSION(MPI_STATUS_SIZE)      ::   ml_stat        ! for key_mpi_isend
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! north-south & south-north  halos
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! east -west  & west - east  halos
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      ALLOCATE( zt3ns(jpi,jprecj,ipk,ipl,ipf,2), zt3sn(jpi,jprecj,ipk,ipl,ipf,2),   &
+         &      zt3ew(jpj,jpreci,ipk,ipl,ipf,2), zt3we(jpj,jpreci,ipk,ipl,ipf,2)  )
+      !
+      ll_Iperio = nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6)
+      ll_Jperio = nbondj == 2 .AND.  jperio == 7
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0._wp     ! zero by default
+      ENDIF
+
+      ! ------------------------------- !
+      !   standard boundary treatment   !    ! CAUTION: semi-column notation is often impossible
+      ! ------------------------------- !
+      !
+      IF( PRESENT( cd_mpp ) ) THEN     !==  halos filled with inner values  ==!
+         !
+         DO jf = 1, ipf                      ! number of arrays to be treated
+            !
+            DO jl = 1, ipl                   ! CAUTION: ptab is defined only between nld and nle
+               DO jk = 1, ipk
+                  DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
+                     ARRAY_IN(nldi  :nlei  ,jj,jk,jl,jf) = ARRAY_IN(nldi:nlei,nlej,jk,jl,jf)
+                     ARRAY_IN(1     :nldi-1,jj,jk,jl,jf) = ARRAY_IN(nldi     ,nlej,jk,jl,jf)
+                     ARRAY_IN(nlei+1:nlci  ,jj,jk,jl,jf) = ARRAY_IN(     nlei,nlej,jk,jl,jf)
+                  END DO
+                  DO ji = nlci+1, jpi                 ! added column(s) (full)
+                     ARRAY_IN(ji,nldj  :nlej  ,jk,jl,jf) = ARRAY_IN(nlei,nldj:nlej,jk,jl,jf)
+                     ARRAY_IN(ji,1     :nldj-1,jk,jl,jf) = ARRAY_IN(nlei,nldj     ,jk,jl,jf)
+                     ARRAY_IN(ji,nlej+1:jpj   ,jk,jl,jf) = ARRAY_IN(nlei,     nlej,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+            !
+         END DO
+         !
+      ELSE                              !==  standard close or cyclic treatment  ==!
+         !
+         DO jf = 1, ipf                      ! number of arrays to be treated
+            !
+            !                             ! East-West boundaries
+            IF( ll_Iperio ) THEN                   !* cyclic
+               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
+               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf)
+            ELSE                                   !* closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(     1       :jpreci,:,:,:,jf) = zland    ! east except F-point
+                                               ARRAY_IN(nlci-jpreci+1:jpi   ,:,:,:,jf) = zland    ! west
+            ENDIF
+            !                                ! North-South boundaries
+            IF( ll_Jperio ) THEN                   !* cyclic (only with no mpp j-split)
+               ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:, jpjm1,:,:,jf)
+               ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:,   2  ,:,:,jf)
+            ELSE                                   !* closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:,     1       :jprecj,:,:,jf) = zland    ! south except F-point
+                                               ARRAY_IN(:,nlcj-jprecj+1:jpj   ,:,:,jf) = zland    ! north
+            ENDIF
+         END DO
+         !
+      ENDIF
+
+      ! ------------------------------- !
+      !      East and west exchange     !
+      ! ------------------------------- !
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jpreci
+                     zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(jpreci+jh,:,jk,jl,jf)
+                     zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * ipk * ipl * ipf
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci-jpreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jpreci
+                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 0 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jpreci
+                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
+                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 1 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jpreci
+                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END DO
+      END SELECT
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jprecj
+                     zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf)
+                     zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,jprecj+jh,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * ipk * ipl * ipf
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )
+      CASE ( 0 )
+         CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+         IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err )
+      CASE ( 1 )
+         CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj-jprecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jprecj
+                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 0 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jprecj
+                     ARRAY_IN(:,      jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
+                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 1 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, jprecj
+                     ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END DO
+      END SELECT
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) )   ! 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
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
+      !
+   END SUBROUTINE ROUTINE_LNK
+
+#undef ARRAY_TYPE
+#undef NAT_IN
+#undef SGN_IN
+#undef ARRAY_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
+#undef OPT_K
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_nfd_generic.h90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_nfd_generic.h90	(revision 8226)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_nfd_generic.h90	(revision 8226)
@@ -0,0 +1,242 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   define LBC_ARG                  (jf)
+#   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
+!                          !==  IN: ptab is an array  ==!
+#   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 LBC_ARG
+#   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
+
+   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld )
+      !!----------------------------------------------------------------------
+      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
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays
+      !
+      INTEGER  ::   ji,  jj,  jk,  jl, jh, jf, jr   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl, ipf         ! dimension of the input array
+      INTEGER  ::   imigr, iihom, ijhom             ! local integers
+      INTEGER  ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER  ::   ij, iproc
+      INTEGER, DIMENSION (jpmaxngh)       ::   ml_req_nf   ! for mpi_isend when avoiding mpi_allgather
+      INTEGER                             ::   ml_err      ! for mpi_isend when avoiding mpi_allgather
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat     ! for mpi_isend when avoiding mpi_allgather
+      !                                                    ! Workspace for message transfers avoiding mpi_allgather
+      REAL(wp), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   ztab, ztabl, ztabr
+      REAL(wp), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   znorthloc, zfoldwk      
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   znorthgloio
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      ipj   = 4            ! 2nd dimension of message transfers (last j-lines)
+      !
+      ALLOCATE( znorthloc(jpi,4,ipk,ipl,ipf) )
+      !
+      znorthloc(:,:,:,:,:) = 0._wp
+      !
+      DO jf = 1, ipf                ! put in znorthloc the last ipj j-lines of ptab
+         DO jl = 1, ipl
+            DO jk = 1, ipk
+               DO jj = nlcj - ipj +1, nlcj
+                  ij = jj - nlcj + ipj
+                  znorthloc(:,ij,jk,jl,jf) = ARRAY_IN(:,jj,jk,jl,jf)
+               END DO
+            END DO
+         END DO
+      END DO
+      !
+      !
+      itaille = jpi * ipj * ipk * ipl * ipf
+      !
+      IF( l_north_nogather ) THEN      !==  ????  ==!
+         ALLOCATE( zfoldwk(jpi,4,ipk,ipl,ipf) )
+         ALLOCATE( ztabl(jpi   ,4,ipk,ipl,ipf) , ztabr(jpi*jpmaxngh,4,ipk,ipl,ipf) ) 
+         !
+         ztabr(:,:,:,:,:) = 0._wp
+         ztabl(:,:,:,:,:) = 0._wp
+         !
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jj = nlcj-ipj+1, nlcj          ! First put local values into the global array
+                     ij = jj - nlcj + ipj
+                     DO ji = nfsloop, nfeloop
+                        ztabl(ji,ij,jk,jl,jf) = ARRAY_IN(ji,jj,jk,jl,jf)
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+         DO jr = 1, nsndto
+            IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN
+              CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) )
+            ENDIF
+         END DO
+         DO jr = 1,nsndto
+            iproc = nfipproc(isendto(jr),jpnj)
+            IF(iproc /= -1) THEN
+               ilei = nleit (iproc+1)
+               ildi = nldit (iproc+1)
+               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
+            ENDIF
+            IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN
+              CALL mpprecv(5, zfoldwk, itaille, iproc)
+               DO jf = 1, ipf
+                  DO jl = 1, ipl
+                     DO jk = 1, ipk
+                        DO jj = 1, ipj
+                           DO ji = ildi, ilei
+                              ztabr(iilb+ji,jj,jk,jl,jf) = zfoldwk(ji,jj,jk,jl,jf)
+                           END DO
+                        END DO
+                     END DO
+                  END DO
+               END DO
+            ELSE IF( iproc == narea-1 ) THEN
+               DO jf = 1, ipf
+                  DO jl = 1, ipl
+                     DO jk = 1, ipk
+                        DO jj = 1, ipj
+                           DO ji = ildi, ilei
+                              ztabr(iilb+ji,jj,jk,jl,jf) = ARRAY_IN(ji,nlcj-ipj+jj,jk,jl,jf)
+                           END DO
+                        END DO
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+         END DO
+         IF( l_isend ) THEN
+            DO jr = 1,nsndto
+               IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN
+                  CALL mpi_wait( ml_req_nf(jr), ml_stat, ml_err )
+               ENDIF    
+            END DO
+         ENDIF
+         DO jf = 1, ipf
+            CALL lbc_nfd_nogather( ztabl(:,:,:,:,jf), ztabr(:,:,:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG )   ! North fold boundary condition
+         END DO
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jj = nlcj-ipj+1, nlcj             ! Scatter back to ARRAY_IN
+                     ij = jj - nlcj + ipj
+                     DO ji= 1, nlci
+                        ARRAY_IN(ji,jj,jk,jl,jf) = ztabl(ji,ij,jk,jl,jf)
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+         DEALLOCATE( zfoldwk )
+         DEALLOCATE( ztabl, ztabr ) 
+      ELSE                             !==  ????  ==!
+         ALLOCATE( ztab       (jpiglo,4,ipk,ipl,ipf     ) )
+         ALLOCATE( znorthgloio(jpi   ,4,ipk,ipl,ipf,jpni) )
+         !
+         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
+            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         !
+         ztab(:,:,:,:,:) = 0._wp
+         DO jr = 1, ndim_rank_north         ! recover the global north array
+            iproc = nrank_north(jr) + 1
+            ildi  = nldit (iproc)
+            ilei  = nleit (iproc)
+            iilb  = nimppt(iproc)
+            DO jf = 1, ipf
+               DO jl = 1, ipl
+                  DO jk = 1, ipk
+                     DO jj = 1, ipj
+                        DO ji = ildi, ilei
+                           ztab(ji+iilb-1,jj,jk,jl,jf) = znorthgloio(ji,jj,jk,jl,jf,jr)
+                        END DO
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         DO jf = 1, ipf
+            CALL lbc_nfd( ztab(:,:,:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG )   ! North fold boundary condition
+         END DO
+         !
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jj = nlcj-ipj+1, nlcj             ! Scatter back to ARRAY_IN
+                     ij = jj - nlcj + ipj
+                     DO ji= 1, nlci
+                        ARRAY_IN(ji,jj,jk,jl,jf) = ztab(ji+nimpp-1,ij,jk,jl,jf)
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+      !
+         DEALLOCATE( ztab )
+         DEALLOCATE( znorthgloio )
+      ENDIF
+      !
+      ! The ztab array has been either:
+      !  a. Fully populated by the mpi_allgather operation or
+      !  b. Had the active points for this domain and northern neighbours populated
+      !     by peer to peer exchanges
+      ! Either way the array may be folded by lbc_nfd and the result for the span of
+      ! this domain will be identical.
+      !
+      DEALLOCATE( znorthloc )
+      !
+   END SUBROUTINE ROUTINE_NFD
+
+#undef ARRAY_TYPE
+#undef NAT_IN
+#undef SGN_IN
+#undef ARRAY_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
+#undef LBC_ARG
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 8226)
@@ -116,5 +116,5 @@
    END TYPE WGT
 
-   INTEGER,     PARAMETER             ::   tot_wgts = 10
+   INTEGER,     PARAMETER             ::   tot_wgts = 20
    TYPE( WGT ), DIMENSION(tot_wgts)   ::   ref_wgts     ! array of wgts
    INTEGER                            ::   nxt_wgt = 1  ! point to next available space in ref_wgts array
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 8226)
@@ -328,11 +328,13 @@
       IF( ln_ssr      )   CALL sbc_ssr_init            ! Sea-Surface Restoring initialization
       !
-      IF( ln_isf      )   CALL sbc_isf_init               ! Compute iceshelves
+      IF( ln_isf      )   CALL sbc_isf_init            ! Compute iceshelves
       !
                           CALL sbc_rnf_init            ! Runof initialization
       !
-      IF( nn_ice == 3 )   CALL sbc_lim_init            ! LIM3 initialization
-      !
-      IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )   ! CICE initialization
+      IF    ( lk_agrif .AND. nn_ice == 0 ) THEN
+                         IF( sbc_ice_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_ice_alloc : unable to allocate arrays' )  ! clem2017: allocate ice arrays in case agrif + lim + no-ice in child grid              
+      ELSEIF(                nn_ice == 3 ) THEN   ;   CALL sbc_lim_init            ! LIM3 initialization
+      ELSEIF(                nn_ice == 4 ) THEN   ;   CALL cice_sbc_init( nsbc )   ! CICE initialization
+      ENDIF
       !
       IF( ln_wave     )   CALL sbc_wave_init              ! surface wave initialisation
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90	(revision 8226)
@@ -137,5 +137,9 @@
          END DO
       END DO   
-      CALL lbc_lnk( usd(:,:,:), 'U', vsd(:,:,:), 'V', -1. )
+!!gm      CALL lbc_lnk( usd(:,:,:), 'U', vsd(:,:,:), 'V', -1. )
+      CALL lbc_lnk( usd(:,:,:), 'U', -1. )
+      CALL lbc_lnk( vsd(:,:,:), 'V', -1. )
+
+
       !
       !                       !==  vertical Stokes Drift 3D velocity  ==!
@@ -152,9 +156,9 @@
       END DO
       !
-      IF( .NOT. AGRIF_Root() ) THEN
-         IF( nbondi ==  1 .OR. nbondi == 2 )   ze3divh(nlci-1,   :  ,:) = 0._wp      ! east
-         IF( nbondi == -1 .OR. nbondi == 2 )   ze3divh(  2   ,   :  ,:) = 0._wp      ! west
-         IF( nbondj ==  1 .OR. nbondj == 2 )   ze3divh(  :   ,nlcj-1,:) = 0._wp      ! north
-         IF( nbondj == -1 .OR. nbondj == 2 )   ze3divh(  :   ,  2   ,:) = 0._wp      ! south
+      IF( .NOT. Agrif_Root() ) THEN
+         IF( nbondi == -1 .OR. nbondi == 2 )   ze3divh( 2:nbghostcells+1,:        ,:) = 0._wp      ! west
+         IF( nbondi ==  1 .OR. nbondi == 2 )   ze3divh( nlci-nbghostcells:nlci-1,:,:) = 0._wp      ! east
+         IF( nbondj == -1 .OR. nbondj == 2 )   ze3divh( :,2:nbghostcells+1        ,:) = 0._wp      ! south
+         IF( nbondj ==  1 .OR. nbondj == 2 )   ze3divh( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp      ! north
       ENDIF
       !
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 8226)
@@ -206,10 +206,10 @@
       !
 #if defined key_agrif
-      IF( .NOT. Agrif_Root() ) THEN
+!!clem2017      IF( .NOT. Agrif_Root() ) THEN
                          CALL Agrif_ParentGrid_To_ChildGrid()
          IF( ln_diaobs ) CALL dia_obs_wri
          IF( nn_timing == 1 )   CALL timing_finalize
                                 CALL Agrif_ChildGrid_To_ParentGrid()
-      ENDIF
+!!clem2017      ENDIF
 #endif
       IF( nn_timing == 1 )   CALL timing_finalize
@@ -622,5 +622,5 @@
       !
       IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
-      IF( numsol          /= -1 )   CLOSE( numsol          )   ! solver file
+      IF( numrun          /= -1 )   CLOSE( numrun          )   ! run statistics file
       IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
       IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 8226)
@@ -9,4 +9,6 @@
    !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
    !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting
+   !!            3.7  ! 2016-09  (G. Madec)  Remove solver
+   !!            4.0  ! 2017-04  (G. Madec)  regroup global communications
    !!----------------------------------------------------------------------
 
@@ -21,5 +23,4 @@
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE lib_mpp         ! distributed memory computing
-   USE lib_fortran     ! Fortran routines library 
 
    IMPLICIT NONE
@@ -28,5 +29,5 @@
    PUBLIC stp_ctl           ! routine called by step.F90
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
@@ -42,8 +43,11 @@
       !! ** Method  : - Save the time step in numstp
       !!              - Print it each 50 time steps
-      !!              - Stop the run IF problem ( indic < 0 )
+      !!              - Stop the run IF problem encountered by setting indic=-3
+      !!                Problems checked: |ssh| maximum larger than 10 m
+      !!                                  |U|   maximum larger than 10 m/s 
+      !!                                  negative sea surface salinity
       !!
-      !! ** Actions :   'time.step' file containing the last ocean time-step
-      !!                
+      !! ** Actions :   "time.step" file = last ocean time-step
+      !!                "run.stat"  file = run statistics
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
@@ -51,8 +55,11 @@
       !!
       INTEGER  ::   ji, jj, jk             ! dummy loop indices
-      INTEGER  ::   ii, ij, ik             ! local integers
-      REAL(wp) ::   zumax, zsmin, zssh2, zsshmax    ! local scalars
-      INTEGER, DIMENSION(3) ::   ilocu     ! 
-      INTEGER, DIMENSION(2) ::   ilocs     ! 
+      INTEGER  ::   iih, ijh               ! local integers
+      INTEGER  ::   iiu, iju, iku          !   -       -
+      INTEGER  ::   iis, ijs               !   -       -
+      REAL(wp) ::   zzz                    ! local real 
+      INTEGER , DIMENSION(3) ::   ilocu
+      INTEGER , DIMENSION(2) ::   ilocs, iloch
+      REAL(wp), DIMENSION(3) ::   zmax
       !!----------------------------------------------------------------------
       !
@@ -61,126 +68,62 @@
          WRITE(numout,*) 'stp_ctl : time-stepping control'
          WRITE(numout,*) '~~~~~~~'
-         ! open time.step file
+         !                                ! open time.step file
          CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+         !                                ! open run.stat file
+         CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
       ENDIF
       !
-      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
-      IF(lwp) REWIND( numstp )                       !  --------------------------
+      IF(lwp) THEN                        !==  current time step  ==!   ("time.step" file)
+         WRITE ( numstp, '(1x, i8)' )   kt
+         REWIND( numstp )
+      ENDIF
       !
-      !                                              !* Test maximum of velocity (zonal only)
-      !                                              !  ------------------------
-      !! zumax = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5
-      zumax = 0.e0
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
-          END DO 
-        END DO 
-      END DO        
-      IF( lk_mpp )   CALL mpp_max( zumax )                 ! max over the global domain
+      !                                   !==  test of extrema  ==!
+      zmax(1) = MAXVAL(  ABS( sshn(:,:) )  )                                  ! ssh max
+      zmax(2) = MAXVAL(  ABS( un(:,:,:) )  )                                  ! velocity max (zonal only)
+      zmax(3) = MAXVAL( -tsn(:,:,1,jp_sal) , mask = tmask(:,:,1) == 1._wp )   ! minus surface salinity max
       !
-      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
+      IF( lk_mpp )   CALL mpp_max_multiple( zmax(:), 3 ) ! max over the global domain
       !
-      IF( zumax > 20.e0 ) THEN
+      IF( MOD( kt, nwrite ) == 1 .AND. lwp ) THEN
+         WRITE(numout,*) ' ==>> time-step= ', kt, ' |ssh| max: ',   zmax(1), ' |U| max: ', zmax(2),   &
+            &                                     ' SSS min: '  , - zmax(3)
+      ENDIF
+      !
+      IF ( zmax(1) > 10._wp .OR.   &                     ! too large sea surface height ( > 10 m)
+         & zmax(2) > 10._wp .OR.   &                     ! too large velocity ( > 10 m/s)
+         & zmax(3) >  0._wp ) THEN                       ! negative sea surface salinity
          IF( lk_mpp ) THEN
-            CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik)
+            CALL mpp_maxloc( ABS(sshn)        , tmask(:,:,1), zzz, iih, ijh )
+            CALL mpp_maxloc( ABS(un)          , umask       , zzz, iiu, iju, iku )
+            CALL mpp_minloc( tsn(:,:,1,jp_sal), tmask(:,:,1), zzz, iis, ijs )
          ELSE
+            iloch = MINLOC( ABS( sshn(:,:) ) )
             ilocu = MAXLOC( ABS( un(:,:,:) ) )
-            ii = ilocu(1) + nimpp - 1
-            ij = ilocu(2) + njmpp - 1
-            ik = ilocu(3)
+            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1._wp )
+            iih = iloch(1) + nimpp - 1   ;   ijh = iloch(2) + njmpp - 1
+            iiu = ilocu(1) + nimpp - 1   ;   iju = ilocu(2) + njmpp - 1   ;   iku = ilocu(3)
+            iis = ilocs(1) + nimpp - 1   ;   ijs = ilocs(2) + njmpp - 1
          ENDIF
          IF(lwp) THEN
             WRITE(numout,cform_err)
-            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
+            WRITE(numout,*) ' stpctl: |ssh| > 10 m   or   |U| > 10 m/s   or   SSS < 0'
             WRITE(numout,*) ' ====== '
-            WRITE(numout,9400) kt, zumax, ii, ij, ik
+            WRITE(numout,9100) kt,   zmax(1), iih, ijh
+            WRITE(numout,9200) kt,   zmax(2), iiu, iju, iku
+            WRITE(numout,9300) kt, - zmax(3), iis, ijs
             WRITE(numout,*)
-            WRITE(numout,*) '          output of last fields in numwso'
+            WRITE(numout,*) '          output of last computed fields in output.abort.nc file'
          ENDIF
          kindic = -3
       ENDIF
-9400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5)
+9100  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5)
+9200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5)
+9300  FORMAT (' kt=',i8,'   SSS   min: ',1pg11.4,', at  i j  : ',2i5)
       !
-      !                                              !* Test minimum of salinity
-      !                                              !  ------------------------
-      !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5
-      zsmin = 100._wp
-      DO jj = 2, jpjm1
-         DO ji = 1, jpi
-            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,tsn(ji,jj,1,jp_sal))
-         END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_min( zsmin )                ! min over the global domain
+      !                                            !==  run statistics  ==!   ("run.stat" file)
+      IF(lwp) WRITE(numrun,9400) kt, zmax(1), zmax(2), - zmax(3)
       !
-      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
-      !
-      IF( zsmin < 0.) THEN 
-         IF (lk_mpp) THEN
-            CALL mpp_minloc ( tsn(:,:,1,jp_sal),tmask(:,:,1), zsmin, ii,ij )
-         ELSE
-            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )
-            ii = ilocs(1) + nimpp - 1
-            ij = ilocs(2) + njmpp - 1
-         ENDIF
-         !
-         IF(lwp) THEN
-            WRITE(numout,cform_err)
-            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
-            WRITE(numout,*) '======= '
-            WRITE(numout,9500) kt, zsmin, ii, ij
-            WRITE(numout,*)
-            WRITE(numout,*) '          output of last fields in numwso'
-         ENDIF
-         kindic = -3
-      ENDIF
-9500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5)
-      !
-      !
-      IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration
-
-      ! log file (ssh statistics)
-      ! --------                                   !* ssh statistics (and others...)
-      IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file)
-         CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
-      ENDIF
-      !
-      zsshmax = 0.e0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( tmask(ji,jj,1) == 1) zsshmax = MAX( zsshmax, ABS(sshn(ji,jj)) )
-         END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_max( zsshmax )                ! min over the global domain
-      !
-      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' ssh max:', zsshmax
-      !
-      IF( zsshmax > 10.e0 ) THEN 
-         IF (lk_mpp) THEN
-            CALL mpp_maxloc( ABS(sshn(:,:)),tmask(:,:,1),zsshmax,ii,ij)
-         ELSE
-            ilocs = MAXLOC( ABS(sshn(:,:)) )
-            ii = ilocs(1) + nimpp - 1
-            ij = ilocs(2) + njmpp - 1
-         ENDIF
-         !
-         IF(lwp) THEN
-            WRITE(numout,cform_err)
-            WRITE(numout,*) 'stp_ctl : the ssh is larger than 10m'
-            WRITE(numout,*) '======= '
-            WRITE(numout,9600) kt, zsshmax, ii, ij
-            WRITE(numout,*)
-            WRITE(numout,*) '          output of last fields in numwso'
-         ENDIF
-         kindic = -3
-      ENDIF
-9600  FORMAT (' kt=',i6,' max ssh: ',1pg11.4,', i j: ',2i5)
-      !
-      zssh2 = glob_sum( sshn(:,:) * sshn(:,:) )
-      !
-      IF(lwp) WRITE(numsol,9700) kt, zssh2, zumax, zsmin      ! ssh statistics
-      !
-9700  FORMAT(' it :', i8, ' ssh2: ', d23.16, ' Umax: ',d23.16,' Smin: ',d23.16)
+9400  FORMAT(' it :', i8, '    |ssh|_max: ', e16.10, ' |U|_max: ',e16.10,' SSS_min: ',e16.10)
       !
    END SUBROUTINE stp_ctl
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/SAS_SRC/diawri.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/SAS_SRC/diawri.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/SAS_SRC/diawri.F90	(revision 8226)
@@ -400,5 +400,7 @@
       CALL lim_wri_state_2( kt, id_i, nh_i )
 #elif defined key_lim3
-      CALL lim_wri_state( kt, id_i, nh_i )
+      IF( nn_ice == 3 ) THEN   ! clem2017: condition in case agrif + lim but no-ice in child grid
+         CALL lim_wri_state( kt, id_i, nh_i )
+      ENDIF
 #else
       CALL histend( id_i, snc4chunks=snc4set )
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90	(revision 8226)
@@ -134,9 +134,9 @@
       !
 #if defined key_agrif
-      IF( .NOT. Agrif_Root() ) THEN
+!!clem2017      IF( .NOT. Agrif_Root() ) THEN
          CALL Agrif_ParentGrid_To_ChildGrid()
          IF( nn_timing == 1 )   CALL timing_finalize
          CALL Agrif_ChildGrid_To_ParentGrid()
-      ENDIF
+!!clem2017      ENDIF
 #endif
       IF( nn_timing == 1 )   CALL timing_finalize
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_MOBILIS
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_MOBILIS	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_MOBILIS	(revision 8226)
@@ -8,5 +8,5 @@
 module load intel/compiler/64/14.0/2013_sp1.2.144
 module load openmpi/intel/64/1.6.5
-module load slurm/2.5.7
+module load slurm/16.05.8
 
 #
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/README
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/README	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/README	(revision 8226)
@@ -45,5 +45,5 @@
                INPUT_DIR   	   : directory in which store input files (tar file)
                TMPDIR      	   : temporary directory NEEDED ONLY FOR IBM machines (put EXP00 directory)
-	       NEMO_VALIDATION_DIR : directory in which create NEMO_VALIDATION tree, and store restart, solver.stat, tracer.stat and ocean.output files in
+	       NEMO_VALIDATION_DIR : directory in which create NEMO_VALIDATION tree, and store restart, run.stat, tracer.stat and ocean.output files in
       			             tree NEMO_VALIDATION_DIR/WCONFIG_NAME/WCOMPILER_NAME/TEST_NAME/REVISION_NUMBER(or DATE)
  in fcm_job.sh :
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/all_functions.sh
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/all_functions.sh	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/all_functions.sh	(revision 8226)
@@ -219,17 +219,17 @@
     fi
     # Save output & debug files in NEMO_VALIDATION tree
-    echo "saving ocean & ice output, solver.stat, tracer.stat files ...." >> ${SETTE_DIR}/output.sette
+    echo "saving ocean & ice output, run.stat, tracer.stat files ...." >> ${SETTE_DIR}/output.sette
     echo "            " >> ${SETTE_DIR}/output.sette
     [ -f ${EXE_DIR}/ocean.output ] && cp ${EXE_DIR}/*ocean.output ${NEMO_VALID}/.
-    [ -f ${EXE_DIR}/solver.stat ] && cp ${EXE_DIR}/*solver.stat ${NEMO_VALID}/.
+    [ -f ${EXE_DIR}/run.stat ] && cp ${EXE_DIR}/*run.stat ${NEMO_VALID}/.
     [ -f ${EXE_DIR}/output.namelist.dyn ] && cp ${EXE_DIR}/*output.nam* ${NEMO_VALID}/.
     [ -f ${EXE_DIR}/tracer.stat ] && cp ${EXE_DIR}/*tracer.stat ${NEMO_VALID}/.
 
-    if [ -n "$(ls ${NEMO_VALID}/*solver*)" ] ; then
-	echo "moved solver.stat in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette
-	echo "moved solver.stat in ${NEMO_VALID} directory"  
+    if [ -n "$(ls ${NEMO_VALID}/*run*)" ] ; then
+	echo "moved run.stat in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette
+	echo "moved run.stat in ${NEMO_VALID} directory"  
     else
-	echo "problem in looking for solver.stat file in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette
-	echo "solver.stat IS NOT in ${NEMO_VALID} directory" 
+	echo "problem in looking for run.stat file in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette
+	echo "run.stat IS NOT in ${NEMO_VALID} directory" 
     fi
     if [ -n "$(ls ${NEMO_VALID}/*ocean.output*)" ] ; then
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/sette.sh
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/sette.sh	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/sette.sh	(revision 8226)
@@ -56,5 +56,5 @@
 #   set_namelist     : function declared in all_functions that sets namelist parameters 
 #   post_test_tidyup : creates validation storage directory and copies required output files 
-#                      (solver.stat and ocean.output) in it after execution of test.
+#                      (run.stat and ocean.output) in it after execution of test.
 #
 #  VALIDATION tree is:
@@ -137,5 +137,5 @@
 # ORCA2_OFF_PISCES  :  5 &  6
 # AMM12             :  7 &  8 
-# SAS               :  9     fos SAS there is no solver so is useless to test REPRO
+# SAS               :  9     fos SAS there is no run.stat so is useless to test REPRO
 # ISOMIP            : 10 & 11
 # ORCA2_LIM3_OBS    : 12
@@ -661,5 +661,5 @@
     export TEST_NAME="LONG"
     cd ${CONFIG_DIR0}
-    . ./makenemo -m ${CMP_NAM} -n AMM12_LONG -r AMM12 -j 8 add_key "key_tide" del_key ${DEL_KEYS}
+    . ./makenemo -m ${CMP_NAM} -n AMM12_LONG -r AMM12 -j 8 del_key ${DEL_KEYS}
     cd ${SETTE_DIR}
     . ./param.cfg
@@ -1121,4 +1121,5 @@
     set_namelist 1_namelist_cfg nn_it000 1
     set_namelist 1_namelist_cfg nn_itend 150
+    set_namelist 1_namelist_cfg nn_fsbc 1
     set_namelist 1_namelist_cfg ln_ctl .false.
     set_namelist 1_namelist_cfg ln_clobber .true.
@@ -1245,4 +1246,5 @@
     set_namelist 1_namelist_cfg nn_itend 300
     set_namelist 1_namelist_cfg nn_stock 150
+    set_namelist 1_namelist_cfg nn_fsbc 1
     set_namelist 1_namelist_cfg ln_ctl .false.
     set_namelist 1_namelist_cfg ln_clobber .true.
@@ -1283,4 +1285,5 @@
     set_namelist 1_namelist_cfg nn_itend 300
     set_namelist 1_namelist_cfg nn_stock 150
+    set_namelist 1_namelist_cfg nn_fsbc 1
     set_namelist 1_namelist_cfg ln_rstart .true.
     set_namelist 1_namelist_cfg nn_rstctl 2
@@ -1339,4 +1342,5 @@
     set_namelist 1_namelist_cfg nn_it000 1
     set_namelist 1_namelist_cfg nn_itend 150
+    set_namelist 1_namelist_cfg nn_fsbc 1
     set_namelist 1_namelist_cfg ln_ctl .false.
     set_namelist 1_namelist_cfg ln_clobber .true.
@@ -1378,4 +1382,5 @@
     set_namelist 1_namelist_cfg nn_itend 150
     set_namelist 1_namelist_cfg ln_ctl .false.
+    set_namelist 1_namelist_cfg nn_fsbc 1
     set_namelist 1_namelist_cfg ln_clobber .true.
     set_namelist 1_namelist_cfg ln_read_cfg .true.
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/sette_beginner.sh
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/sette_beginner.sh	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/sette_beginner.sh	(revision 8226)
@@ -55,5 +55,5 @@
 #   set_namelist     : function declared in all_functions that sets namelist parameters 
 #   post_test_tidyup : creates validation storage directory and copies required output files 
-#                      (solver.stat and ocean.output) in it after execution of test.
+#                      (run.stat and ocean.output) in it after execution of test.
 #
 #  VALIDATION tree is:
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/sette_rpt.sh
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/sette_rpt.sh	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/sette_rpt.sh	(revision 8226)
@@ -1,4 +1,5 @@
 #!/bin/bash -f
 #
+# set -vx
 # simple SETTE report generator.
 #
@@ -23,8 +24,8 @@
     dorv=`echo $dorv | sed -e 's:.*/::'`
     f1o=$vdir/$nam/$mach/$dorv/LONG/ocean.output
-    f1s=$vdir/$nam/$mach/$dorv/LONG/solver.stat
+    f1s=$vdir/$nam/$mach/$dorv/LONG/run.stat
     f1t=$vdir/$nam/$mach/$dorv/LONG/tracer.stat
     f2o=$vdir/$nam/$mach/$dorv/SHORT/ocean.output
-    f2s=$vdir/$nam/$mach/$dorv/SHORT/solver.stat
+    f2s=$vdir/$nam/$mach/$dorv/SHORT/run.stat
     f2t=$vdir/$nam/$mach/$dorv/SHORT/tracer.stat
 
@@ -46,13 +47,13 @@
       if [ $? == 0 ]; then
         if [ $pass == 0 ]; then 
-          printf "%-20s %s %s\n" $nam  " solver.stat restartability  passed : " $dorv
-        fi
-      else
-        printf "%-20s %s %s\n" $nam  " solver.stat restartability  FAILED : " $dorv 
-#
-# Offer view of differences on the second pass
-#
-        if [ $pass == 1 ]; then
-          echo "<return> to view solver.stat differences"
+          printf "%-20s %s %s\n" $nam  " run.stat    restartability  passed : " $dorv
+        fi
+      else
+        printf "%-20s %s %s\n" $nam  " run.stat    restartability  FAILED : " $dorv 
+#
+# Offer view of differences on the second pass
+#
+        if [ $pass == 1 ]; then
+          echo "<return> to view run.stat differences"
           read y
           sdiff f1.tmp$$ $f2s
@@ -118,8 +119,8 @@
     rep2=`ls -1rt $vdir/$nam/$mach/$dorv/ | tail -1l`
     f1o=$vdir/$nam/$mach/$dorv/$rep1/ocean.output
-    f1s=$vdir/$nam/$mach/$dorv/$rep1/solver.stat
+    f1s=$vdir/$nam/$mach/$dorv/$rep1/run.stat
     f1t=$vdir/$nam/$mach/$dorv/$rep1/tracer.stat
     f2o=$vdir/$nam/$mach/$dorv/$rep2/ocean.output
-    f2s=$vdir/$nam/$mach/$dorv/$rep2/solver.stat
+    f2s=$vdir/$nam/$mach/$dorv/$rep2/run.stat
     f2t=$vdir/$nam/$mach/$dorv/$rep2/tracer.stat
 
@@ -139,13 +140,13 @@
       if [ $? == 0 ]; then
         if [ $pass == 0 ]; then 
-          printf "%-20s %s %s\n" $nam  " solver.stat reproducibility passed : " $dorv
-        fi
-      else
-        printf "%-20s %s %s\n" $nam  " solver.stat reproducibility FAILED : " $dorv 
-#
-# Offer view of differences on the second pass
-#
-        if [ $pass == 1 ]; then
-          echo "<return> to view solver.stat differences"
+          printf "%-20s %s %s\n" $nam  " run.stat    reproducibility passed : " $dorv
+        fi
+      else
+        printf "%-20s %s %s\n" $nam  " run.stat    reproducibility FAILED : " $dorv 
+#
+# Offer view of differences on the second pass
+#
+        if [ $pass == 1 ]; then
+          echo "<return> to view run.stat differences"
           read y
           sdiff f1.tmp$$ $f2s
@@ -199,4 +200,5 @@
   mach=`grep "COMPILER=" ./sette.sh | sed -e 's/COMPILER=//'`
   NEMO_VALID=`grep "NEMO_VALIDATION_DIR=" ./param.cfg | sed -e 's/NEMO_VALIDATION_DIR=//'`
+  NEMO_VALID=`eval "echo $NEMO_VALID"`
 #
   if [ ! -d $NEMO_VALID ]; then
Index: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/sette_xios.sh
===================================================================
--- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/sette_xios.sh	(revision 8225)
+++ branches/2017/dev_r8183_ICEMODEL/NEMOGCM/SETTE/sette_xios.sh	(revision 8226)
@@ -52,5 +52,5 @@
 #   set_namelist     : function declared in all_functions that sets namelist parameters 
 #   post_test_tidyup : creates validation storage directory and copies required output files 
-#                      (solver.stat and ocean.output) in it after execution of test.
+#                      (run.stat and ocean.output) in it after execution of test.
 #
 #  VALIDATION tree is:
