Index: branches/2013/dev_CMCC_2013/NEMOGCM/ARCH/CMCC/arch-X64_athena.fcm
===================================================================
--- branches/2013/dev_CMCC_2013/NEMOGCM/ARCH/CMCC/arch-X64_athena.fcm	(revision 4174)
+++ branches/2013/dev_CMCC_2013/NEMOGCM/ARCH/CMCC/arch-X64_athena.fcm	(revision 4174)
@@ -0,0 +1,48 @@
+# Curie BULL at TGCC, http://www-hpc.cea.fr/en/complexe/tgcc-curie.htm
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+
+
+
+%NCDF_INC            -I/users/home/sco003/mylib/include
+%NCDF_LIB            -L/users/home/sco003/mylib/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5
+%XIOS_INC            -I/users/home/sco003/XIOS/inc
+%XIOS_LIB            -L/users/home/sco003/XIOS/lib  -lxios
+%FC                  mpiifort
+%FCFLAGS 	     -r8 -O3 -xHost -fp-model source -traceback
+%FFLAGS 	     -r8 -O3 -xHost -fp-model source -traceback
+%LD                  mpiifort
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS             -lstdc++ -lz -lgpfs -lcurl
+%AR                  ar 
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %XIOS_INC %NCDF_INC
+%USER_LIB            %XIOS_LIB %NCDF_LIB
Index: branches/2013/dev_CMCC_2013/NEMOGCM/CONFIG/cfg.txt
===================================================================
--- branches/2013/dev_CMCC_2013/NEMOGCM/CONFIG/cfg.txt	(revision 4173)
+++ branches/2013/dev_CMCC_2013/NEMOGCM/CONFIG/cfg.txt	(revision 4174)
@@ -9,2 +9,3 @@
 ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC
 ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC
+GYRE_TEST OPA_SRC
Index: branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
===================================================================
--- branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 4173)
+++ branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 4174)
@@ -283,38 +283,4 @@
    END SUBROUTINE lbc_lnk_3d
 
-   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                                                   ::   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                                                   ::   ib_bdy    ! BDY boundary set
-      !!
-      CALL lbc_lnk_2d( pt2d, cd_type, psgn)
-
-   END SUBROUTINE lbc_bdy_lnk_2d
-
    SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
       !!---------------------------------------------------------------------
@@ -406,4 +372,44 @@
    END SUBROUTINE lbc_lnk_2d
 
+#endif
+
+
+   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                                                   ::   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                                                   ::   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 )
       !!---------------------------------------------------------------------
@@ -430,5 +436,4 @@
    END SUBROUTINE lbc_lnk_2d_e
 
-# endif
 #endif
 
Index: branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
===================================================================
--- branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 4173)
+++ branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 4174)
@@ -5,4 +5,5 @@
    !!======================================================================
    !! History :  3.2  ! 2009-03  (R. Benshila)  Original code 
+   !!            3.5  ! 2013-07 (I. Epicoco, S. Mocavero - CMCC) MPP optimization 
    !!----------------------------------------------------------------------
 
@@ -11,4 +12,6 @@
    !!   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
    !!----------------------------------------------------------------------
    USE dom_oce        ! ocean space and time domain 
@@ -23,4 +26,15 @@
 
    PUBLIC   lbc_nfd   ! north fold conditions
+   INTERFACE mpp_lbc_nfd
+      MODULE PROCEDURE   mpp_lbc_nfd_3d, mpp_lbc_nfd_2d
+   END INTERFACE
+
+   PUBLIC   mpp_lbc_nfd   ! north fold conditions in parallel case
+
+   INTEGER, PUBLIC,  PARAMETER :: jpmaxngh = 3
+   INTEGER, PUBLIC                                  ::   nsndto
+   INTEGER, PUBLIC,  DIMENSION (jpmaxngh)           ::   isendto ! processes to which communicate
+
+
 
    !!----------------------------------------------------------------------
@@ -342,4 +356,547 @@
    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 (narea .ne. (jpnij - jpni + 1)) THEN
+                 startloop = 1
+               ELSE
+                 startloop = 2
+               ENDIF
+
+               DO jk = 1, jpk
+                  DO ji = startloop, nlci
+                     ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4
+                     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 - nimppt(isendto(1)) + 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 (narea .ne. (jpnij)) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jk = 1, jpk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3
+                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk)
+                  END DO
+               END DO
+
+               IF (narea .ne. (jpnij)) 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 - nimppt(isendto(1)) + 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 (narea .ne. (jpnij - jpni + 1)) THEN
+                  startloop = 1
+               ELSE
+                  startloop = 2
+               ENDIF
+               DO jk = 1, jpk
+                  DO ji = startloop, nlci
+                     ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4
+                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
+                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(ijt,ijpj-3,jk)
+                  END DO
+               END DO
+            CASE ( 'F' )                               ! F-point
+               IF (narea .ne. (jpnij)) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jk = 1, jpk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3
+                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk)
+                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(iju,ijpj-3,jk)
+                  END DO
+               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 - nimppt(isendto(1)) + 3
+                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk)
+                  END DO
+               END DO
+
+            CASE ( 'U' )                               ! U-point
+               IF (narea .ne. (jpnij)) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jk = 1, jpk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2
+                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk)
+                  END DO
+               END DO
+
+            CASE ( 'V' )                               ! V-point
+               DO jk = 1, jpk
+                  DO ji = 1, nlci
+                     ijt = jpiglo - ji- nimpp - nimppt(isendto(1)) + 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 - nimppt(isendto(1)) + 3
+                       pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk)
+                    END DO
+                 END DO
+               ENDIF
+
+            CASE ( 'F' )                               ! F-point
+               IF (narea .ne. (jpnij)) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jk = 1, jpk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2
+                     pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk)
+                  END DO
+               END DO
+
+               IF (narea .ne. (jpnij)) 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 - nimppt(isendto(1)) + 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 (narea .ne. (jpnij - jpni + 1)) THEN
+              startloop = 1
+            ELSE
+              startloop = 2
+            ENDIF
+            DO ji = startloop, nlci
+              ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4
+              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 - nimppt(isendto(1)) + 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 (narea .ne. (jpnij)) THEN
+               endloop = nlci
+            ELSE
+               endloop = nlci - 1
+            ENDIF
+            DO ji = 1, endloop
+               iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)
+            END DO
+
+            IF (narea .ne. (jpnij)) 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 - nimppt(isendto(1)) + 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 (narea .ne. (jpnij - jpni + 1)) THEN
+              startloop = 1
+            ELSE
+              startloop = 2
+            ENDIF
+            DO ji = startloop, nlci
+              ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4
+              pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1)
+              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2)
+            END DO
+
+         CASE ( 'F' )                                     ! F-point
+            IF (narea .ne. (jpnij)) THEN
+               endloop = nlci
+            ELSE
+               endloop = nlci - 1
+            ENDIF
+            DO ji = 1, endloop
+               iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3
+               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1)
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2)
+            END DO
+
+         CASE ( 'I' )                                     ! ice U-V point (I-point)
+            IF (narea .ne. (jpnij - jpni + 1)) THEN
+               startloop = 1
+            ELSE
+               startloop = 3
+               pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1)
+            ENDIF
+            DO ji = startloop, nlci
+               iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
+            END DO
+
+         CASE ( 'J' )                                     ! first ice U-V point
+            IF (narea .ne. (jpnij - jpni + 1)) THEN
+               startloop = 1
+            ELSE
+               startloop = 3
+               pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1)
+            ENDIF
+            DO ji = startloop, nlci
+               iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
+            END DO
+
+         CASE ( 'K' )                                     ! second ice U-V point
+            IF (narea .ne. (jpnij - jpni + 1)) THEN
+               startloop = 1
+            ELSE
+               startloop = 3
+               pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1)
+            ENDIF
+            DO ji = startloop, nlci
+               iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 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 - nimppt(isendto(1)) + 3
+               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1)
+            END DO
+
+         CASE ( 'U' )                                     ! U-point
+            IF (narea .ne. (jpnij)) THEN
+               endloop = nlci
+            ELSE
+               endloop = nlci - 1
+            ENDIF
+            DO ji = 1, endloop
+               iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
+            END DO
+
+         CASE ( 'V' )                                     ! V-point
+            DO ji = 1, nlci
+               ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 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 - nimppt(isendto(1)) + 3
+               pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1)
+            END DO
+
+         CASE ( 'F' )                               ! F-point
+            IF (narea .ne. (jpnij)) THEN
+               endloop = nlci
+            ELSE
+               endloop = nlci - 1
+            ENDIF
+            DO ji = 1, endloop
+               iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)
+            END DO
+
+            IF (narea .ne. (jpnij)) 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 - nimppt(isendto(1)) + 2
+               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1)
+            END DO
+
+         CASE ( 'I' )                                  ! ice U-V point (I-point)
+               IF (narea .ne. (jpnij - jpni + 1)) THEN
+                  startloop = 1
+               ELSE
+                  startloop = 2
+               ENDIF
+               IF (narea .ne. jpnij) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = startloop , endloop
+                  ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4
+                  pt2dl(ji,ijpj)= 0.5 * (pt2dr(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1))
+               END DO
+
+         CASE ( 'J' )                                  ! first ice U-V point
+               IF (narea .ne. (jpnij - jpni + 1)) THEN
+                  startloop = 1
+               ELSE
+                  startloop = 2
+               ENDIF
+               IF (narea .ne. jpnij) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = startloop , endloop
+                  ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4
+                  pt2dl(ji,ijpj) = pt2dr(ji,ijpjm1)
+               END DO
+
+         CASE ( 'K' )                                  ! second ice U-V point
+               IF (narea .ne. (jpnij - jpni + 1)) THEN
+                  startloop = 1
+               ELSE
+                  startloop = 2
+               ENDIF
+               IF (narea .ne. jpnij) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = startloop, endloop
+                  ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 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 MODULE lbcnfd
Index: branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 4173)
+++ branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 4174)
@@ -22,4 +22,5 @@
    !!                          '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 (S.Mocavero, I.Epicoco - CMCC) north fold optimizations
    !!----------------------------------------------------------------------
 
@@ -165,4 +166,6 @@
    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE   ::   xnorthgloio
    REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE, SAVE   ::   foldwk      ! Workspace for message transfers avoiding mpi_allgather
+   REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE, SAVE   ::   ztabl_3d
+   REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE, SAVE   ::   ztabr_3d
 
    ! Arrays used in mpp_lbc_north_2d()
@@ -170,4 +173,6 @@
    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   xnorthgloio_2d
    REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   foldwk_2d    ! Workspace for message transfers avoiding mpi_allgather
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE   ::   ztabl_2d
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE   ::   ztabr_2d
 
    ! Arrays used in mpp_lbc_north_e()
@@ -175,9 +180,4 @@
    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   xnorthgloio_e
 
-   ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public
-   INTEGER, PUBLIC,  PARAMETER :: jpmaxngh = 8                 ! Assumed maximum number of active neighbours
-   INTEGER, PUBLIC,  PARAMETER :: jptyps   = 5                 ! Number of different neighbour lists to be used for northfold exchanges
-   INTEGER, PUBLIC,  DIMENSION (jpmaxngh,jptyps)    ::   isendto
-   INTEGER, PUBLIC,  DIMENSION (jptyps)             ::   nsndto
    LOGICAL, PUBLIC                                  ::   ln_nnogather     = .FALSE.  ! namelist control of northfold comms
    LOGICAL, PUBLIC                                  ::   l_north_nogather = .FALSE.  ! internal control of northfold comms
@@ -214,4 +214,6 @@
          !
          &      tab_e(jpiglo,4+2*jpr2dj) , xnorthloc_e(jpi,4+2*jpr2dj) , xnorthgloio_e(jpi,4+2*jpr2dj,jpni) ,   &
+         !
+         &      ztabl_3d(jpi,4,jpk), ztabr_3d(jpi*jpmaxngh, 4, jpk), ztabl_2d(jpi,4), ztabr_2d(jpi*jpmaxngh, 4), &
          !
          &      STAT=lib_mpp_alloc )
@@ -2585,84 +2587,93 @@
       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
+      REAL(wp)                        , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
       !!                                                             ! =  1. , the sign is kept
-      INTEGER ::   ji, jj, jr
+      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, 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
-      !!----------------------------------------------------------------------
-      !
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+      !!----------------------------------------------------------------------
+      !
+
       ijpj   = 4
-      ityp = -1
       ijpjm1 = 3
-      tab_3d(:,:,:) = 0.e0
-      !
-      DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d
-         ij = jj - nlcj + ijpj
-         xnorthloc(:,ij,:) = pt3d(:,jj,:)
+      !
+      DO jk = 1, jpk
+         DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d
+            ij = jj - nlcj + ijpj
+            xnorthloc(:,ij,jk) = pt3d(:,jj,jk)
+         END DO
       END DO
       !
       !                                     ! Build in procs of ncomm_north the xnorthgloio
       itaille = jpi * jpk * ijpj
+
+
       IF ( l_north_nogather ) THEN
          !
-         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified
+         ! 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
          !
-         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
-            ij = jj - nlcj + ijpj
-            DO ji = 1, nlci
-               tab_3d(ji+nimpp-1,ij,:) = pt3d(ji,jj,:)
-            END DO
-         END DO
-
-         !
-         ! Set the exchange type in order to access the correct list of active neighbours
-         !
-         SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )
-               ityp = 1
-            CASE ( 'U' )
-               ityp = 2
-            CASE ( 'V' )
-               ityp = 3
-            CASE ( 'F' )
-               ityp = 4
-            CASE ( 'I' )
-               ityp = 5
-            CASE DEFAULT
-               ityp = -1                    ! Set a default value for unsupported types which
-                                            ! will cause a fallback to the mpi_allgather method
-         END SELECT
-         IF ( ityp .gt. 0 ) THEN
-
-            DO jr = 1,nsndto(ityp)
-               CALL mppsend(5, xnorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) )
-            END DO
-            DO jr = 1,nsndto(ityp)
-               CALL mpprecv(5, foldwk, itaille, isendto(jr,ityp))
-               iproc = isendto(jr,ityp) + 1
-               ildi = nldit (iproc)
-               ilei = nleit (iproc)
-               iilb = nimppt(iproc)
-               DO jj = 1, ijpj
-                  DO ji = ildi, ilei
-                     tab_3d(ji+iilb-1,jj,:) = foldwk(ji,jj,:)
-                  END DO
+
+         ztabr_3d(:,:,:) = 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 = 1, nlci
+                  ztabl_3d(ji,ij,jk) = pt3d(ji,jj,jk)
                END DO
             END DO
-            IF (l_isend) THEN
-               DO jr = 1,nsndto(ityp)
-                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+         END DO
+
+         DO jr = 1,nsndto
+            IF (isendto(jr) .ne. narea) CALL mppsend(5, xnorthloc, itaille, isendto(jr)-1, ml_req_nf(jr))
+         END DO
+         DO jr = 1,nsndto
+            iproc = isendto(jr)
+            ildi = nldit (iproc)
+            ilei = nleit (iproc)
+            iilb = nimppt(isendto(jr)) - nimppt(isendto(1))
+            IF(isendto(jr) .ne. narea) THEN
+              CALL mpprecv(5, foldwk, itaille, isendto(jr)-1)
+              DO jk = 1, jpk
+                 DO jj = 1, ijpj
+                    DO ji = 1, ilei
+                       ztabr_3d(iilb+ji,jj,jk) = foldwk(ji,jj,jk)
+                    END DO
+                 END DO
+              END DO
+           ELSE
+              DO jk = 1, jpk
+                 DO jj = 1, ijpj
+                    DO ji = 1, ilei
+                       ztabr_3d(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 (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+            END DO
+         ENDIF
+         CALL mpp_lbc_nfd( ztabl_3d, ztabr_3d, 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_3d(ji,ij,jk)
                END DO
-            ENDIF
-
-         ENDIF
-
-      ENDIF
-
-      IF ( ityp .lt. 0 ) THEN
+            END DO
+         END DO
+         !
+
+      ELSE
          CALL MPI_ALLGATHER( xnorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
             &                xnorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
@@ -2673,28 +2684,25 @@
             ilei  = nleit (iproc)
             iilb  = nimppt(iproc)
-            DO jj = 1, ijpj
-               DO ji = ildi, ilei
-                  tab_3d(ji+iilb-1,jj,:) = xnorthgloio(ji,jj,:,jr)
+            DO jk=1, jpk
+               DO jj = 1, ijpj
+                  DO ji = ildi, ilei
+                     tab_3d(ji+iilb-1,jj,jk) = xnorthgloio(ji,jj,jk,jr)
+                  END DO
                END DO
             END DO
          END DO
-      ENDIF
-      !
-      ! The tab_3d 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.
-      !
-      CALL lbc_nfd( tab_3d, cd_type, psgn )   ! North fold boundary condition
-      !
-      DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
-         ij = jj - nlcj + ijpj
-         DO ji= 1, nlci
-            pt3d(ji,jj,:) = tab_3d(ji+nimpp-1,ij,:)
-         END DO
-      END DO
-      !
+         CALL lbc_nfd( tab_3d, 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) = tab_3d(ji+nimpp-1,ij,jk)
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+
    END SUBROUTINE mpp_lbc_north_3d
 
@@ -2714,21 +2722,22 @@
       !!
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 3D array on which the b.c. 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 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
+      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, 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
-      !!----------------------------------------------------------------------
-      !
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+      !!----------------------------------------------------------------------
+      !
+
       ijpj   = 4
-      ityp = -1
       ijpjm1 = 3
-      tab_2d(:,:) = 0.e0
       !
       DO jj = nlcj-ijpj+1, nlcj             ! put in xnorthloc_2d the last 4 jlines of pt2d
@@ -2741,61 +2750,56 @@
       IF ( l_north_nogather ) THEN
          !
-         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified
+         ! 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_2d(:,:) = 0
+
          DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
             ij = jj - nlcj + ijpj
             DO ji = 1, nlci
-               tab_2d(ji+nimpp-1,ij) = pt2d(ji,jj)
+               ztabl_2d(ji,ij) = pt2d(ji,jj)
             END DO
          END DO
 
-         !
-         ! Set the exchange type in order to access the correct list of active neighbours
-         !
-         SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )
-               ityp = 1
-            CASE ( 'U' )
-               ityp = 2
-            CASE ( 'V' )
-               ityp = 3
-            CASE ( 'F' )
-               ityp = 4
-            CASE ( 'I' )
-               ityp = 5
-            CASE DEFAULT
-               ityp = -1                    ! Set a default value for unsupported types which
-                                            ! will cause a fallback to the mpi_allgather method
-         END SELECT
-
-         IF ( ityp .gt. 0 ) THEN
-
-            DO jr = 1,nsndto(ityp)
-               CALL mppsend(5, xnorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) )
+         DO jr = 1,nsndto
+            IF (isendto(jr) .ne. narea) CALL mppsend(5, xnorthloc_2d, itaille, isendto(jr)-1, ml_req_nf(jr))
+         END DO
+         DO jr = 1,nsndto
+            iproc = isendto(jr)
+            ildi = nldit (iproc)
+            ilei = nleit (iproc)
+            iilb = nimppt(isendto(jr)) - nimppt(isendto(1))
+            IF(isendto(jr) .ne. narea) THEN
+              CALL mpprecv(5, foldwk_2d, itaille, isendto(jr)-1)
+              DO jj = 1, ijpj
+                 DO ji = 1, ilei
+                    ztabr_2d(iilb+ji,jj) = foldwk_2d(ji,jj)
+                 END DO
+              END DO
+            ELSE
+              DO jj = 1, ijpj
+                 DO ji = 1, ilei
+                    ztabr_2d(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj)
+                 END DO
+              END DO
+            ENDIF
+         END DO
+         IF (l_isend) THEN
+            DO jr = 1,nsndto
+               IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
             END DO
-            DO jr = 1,nsndto(ityp)
-               CALL mpprecv(5, foldwk_2d, itaille, isendto(jr,ityp))
-               iproc = isendto(jr,ityp) + 1
-               ildi = nldit (iproc)
-               ilei = nleit (iproc)
-               iilb = nimppt(iproc)
-               DO jj = 1, ijpj
-                  DO ji = ildi, ilei
-                     tab_2d(ji+iilb-1,jj) = foldwk_2d(ji,jj)
-                  END DO
-               END DO
+         ENDIF
+         CALL mpp_lbc_nfd( ztabl_2d, ztabr_2d, 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_2d(ji,ij)
             END DO
-            IF (l_isend) THEN
-               DO jr = 1,nsndto(ityp)
-                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
-               END DO
-            ENDIF
-
-         ENDIF
-
-      ENDIF
-
-      IF ( ityp .lt. 0 ) THEN
+         END DO
+         !
+
+      ELSE
          CALL MPI_ALLGATHER( xnorthloc_2d  , itaille, MPI_DOUBLE_PRECISION,        &
             &                xnorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
@@ -2812,23 +2816,14 @@
             END DO
          END DO
-      ENDIF
-      !
-      ! The tab 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.
-      !
-      CALL lbc_nfd( tab_2d, 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) = tab_2d(ji+nimpp-1,ij)
-         END DO
-      END DO
-      !
+         CALL lbc_nfd( tab_2d, 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) = tab_2d(ji+nimpp-1,ij)
+            END DO
+         END DO
+         !
+      ENDIF
    END SUBROUTINE mpp_lbc_north_2d
 
@@ -2860,5 +2855,4 @@
       !
       ijpj=4
-      tab_e(:,:) = 0.e0
 
       ij=0
Index: branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 4173)
+++ branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 4174)
@@ -84,4 +84,5 @@
 #endif
    USE sbctide, ONLY: lk_tide
+   USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges 
 
    IMPLICIT NONE
@@ -683,5 +684,6 @@
       !!======================================================================
       !!                     ***  ROUTINE  nemo_northcomms  ***
-      !! nemo_northcomms    :  Setup for north fold exchanges with explicit peer to peer messaging
+      !! nemo_northcomms    :  Setup for north fold exchanges with explicit 
+      !!                       point-to-point messaging
       !!=====================================================================
       !!----------------------------------------------------------------------
@@ -690,130 +692,49 @@
       !!----------------------------------------------------------------------
       !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
-      !!----------------------------------------------------------------------
-
-      INTEGER ::   ji, jj, jk, ij, jtyp    ! dummy loop indices
-      INTEGER ::   ijpj                    ! number of rows involved in north-fold exchange
-      INTEGER ::   northcomms_alloc        ! allocate return status
-      REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) ::   znnbrs     ! workspace
-      LOGICAL,  ALLOCATABLE, DIMENSION ( : )   ::   lrankset   ! workspace
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-
-      !!----------------------------------------------------------------------
-      ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc )
-      ALLOCATE( lrankset(jpnij), stat = northcomms_alloc )
-      IF( northcomms_alloc /= 0 ) THEN
-         WRITE(numout,cform_war)
-         WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays'
-         CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' )
-      ENDIF
+      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
+      !!----------------------------------------------------------------------
+
+      INTEGER  ::   sxM, dxM, sxT, dxT, jn
+      INTEGER  ::   njmppmax
+
+      njmppmax = MAXVAL( njmppt )
+    
+      !initializes the north-fold communication variables
+      isendto(:) = 0
       nsndto = 0
-      isendto = -1
-      ijpj   = 4
-      !
-      ! This routine has been called because ln_nnogather has been set true ( nammpp )
-      ! However, these first few exchanges have to use the mpi_allgather method to
-      ! establish the neighbour lists to use in subsequent peer to peer exchanges.
-      ! Consequently, set l_north_nogather to be false here and set it true only after
-      ! the lists have been established.
-      !
-      l_north_nogather = .FALSE.
-      !
-      ! Exchange and store ranks on northern rows
-
-      DO jtyp = 1,4
-
-         lrankset = .FALSE.
-         znnbrs = narea
-         SELECT CASE (jtyp)
-            CASE(1)
-               CALL lbc_lnk( znnbrs, 'T', 1. )      ! Type 1: T,W-points
-            CASE(2)
-               CALL lbc_lnk( znnbrs, 'U', 1. )      ! Type 2: U-point
-            CASE(3)
-               CALL lbc_lnk( znnbrs, 'V', 1. )      ! Type 3: V-point
-            CASE(4)
-               CALL lbc_lnk( znnbrs, 'F', 1. )      ! Type 4: F-point
-         END SELECT
-
-         IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN
-            DO jj = nlcj-ijpj+1, nlcj
-               ij = jj - nlcj + ijpj
-               DO ji = 1,jpi
-                  IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) &
-               &     lrankset(INT(znnbrs(ji,jj))) = .true.
-               END DO
-            END DO
-
-            DO jj = 1,jpnij
-               IF ( lrankset(jj) ) THEN
-                  nsndto(jtyp) = nsndto(jtyp) + 1
-                  IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN
-                     CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', &
-                  &                 ' jpmaxngh will need to be increased ')
-                  ENDIF
-                  isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank
-               ENDIF
-            END DO
-         ENDIF
-
-      END DO
-
-      !
-      ! Type 5: I-point
-      !
-      ! ICE point exchanges may involve some averaging. The neighbours list is
-      ! built up using two exchanges to ensure that the whole stencil is covered.
-      ! lrankset should not be reset between these 'J' and 'K' point exchanges
-
-      jtyp = 5
-      lrankset = .FALSE.
-      znnbrs = narea
-      CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point
-
-      IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN
-         DO jj = nlcj-ijpj+1, nlcj
-            ij = jj - nlcj + ijpj
-            DO ji = 1,jpi
-               IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) &
-            &     lrankset(INT(znnbrs(ji,jj))) = .true.
-         END DO
-        END DO
-      ENDIF
-
-      znnbrs = narea
-      CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point
-
-      IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN
-         DO jj = nlcj-ijpj+1, nlcj
-            ij = jj - nlcj + ijpj
-            DO ji = 1,jpi
-               IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND.  INT(znnbrs(ji,jj)) .NE. narea ) &
-            &       lrankset( INT(znnbrs(ji,jj))) = .true.
-            END DO
-         END DO
-
-         DO jj = 1,jpnij
-            IF ( lrankset(jj) ) THEN
-               nsndto(jtyp) = nsndto(jtyp) + 1
-               IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN
-                  CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', &
-               &                 ' jpmaxngh will need to be increased ')
-               ENDIF
-               isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank
-            ENDIF
-         END DO
-         !
-         ! For northern row areas, set l_north_nogather so that all subsequent exchanges
-         ! can use peer to peer communications at the north fold
-         !
-         l_north_nogather = .TRUE.
-         !
-      ENDIF
-      DEALLOCATE( znnbrs )
-      DEALLOCATE( lrankset )
-
+
+      !if I am a process in the north
+      IF ( njmpp == njmppmax ) THEN
+          !sxM is the first point (in the global domain) needed to compute the
+          !north-fold for the current process
+          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
+          !dxM is the last point (in the global domain) needed to compute the
+          !north-fold for the current process
+          dxM = jpiglo - nimppt(narea) + 2
+
+          !loop over the other north-fold processes to find the processes
+          !managing the points belonging to the sxT-dxT range
+          DO jn = jpnij - jpni +1, jpnij
+             IF ( njmppt(jn) == njmppmax ) THEN
+                !sxT is the first point (in the global domain) of the jn
+                !process
+                sxT = nimppt(jn)
+                !dxT is the last point (in the global domain) of the jn
+                !process
+                dxT = nimppt(jn) + nlcit(jn) - 1
+                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
+                   nsndto = nsndto + 1
+                   isendto(nsndto) = jn
+                ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN
+                   nsndto = nsndto + 1
+                   isendto(nsndto) = jn
+                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
+                   nsndto = nsndto + 1
+                   isendto(nsndto) = jn
+                END IF
+             END IF
+          END DO
+      ENDIF
+      l_north_nogather = .TRUE.
    END SUBROUTINE nemo_northcomms
 #else
