Index: /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/CONFIG/GYRE/EXP00/namelist
===================================================================
--- /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/CONFIG/GYRE/EXP00/namelist	(revision 2881)
+++ /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/CONFIG/GYRE/EXP00/namelist	(revision 2882)
@@ -695,4 +695,5 @@
                            !  buffer blocking send or immediate non-blocking sends, resp.
    nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
+   ln_nnogather=  .false.  !  activate code to avoid mpi_allgather use at the northfold
    jpni        =   0       !  jpni   number of processors following i (set automatically if < 1)     
    jpnj        =   0       !  jpnj   number of processors following j (set automatically if < 1)     
Index: /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist
===================================================================
--- /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist	(revision 2881)
+++ /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist	(revision 2882)
@@ -695,4 +695,5 @@
                            !  buffer blocking send or immediate non-blocking sends, resp.
    nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
+   ln_nnogather=  .false.  !  activate code to avoid mpi_allgather use at the northfold
    jpni        =   0       !  jpni   number of processors following i (set automatically if < 1)
    jpnj        =   0       !  jpnj   number of processors following j (set automatically if < 1)
Index: /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist
===================================================================
--- /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist	(revision 2881)
+++ /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist	(revision 2882)
@@ -709,4 +709,5 @@
                            !  buffer blocking send or immediate non-blocking sends, resp.
    nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
+   ln_nnogather=  .false.  !  activate code to avoid mpi_allgather use at the northfold
    jpni        =   0       !  jpni   number of processors following i (set automatically if < 1)
    jpnj        =   0       !  jpnj   number of processors following j (set automatically if < 1)
Index: /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
===================================================================
--- /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 2881)
+++ /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 2882)
@@ -236,4 +236,20 @@
                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
          !
@@ -285,4 +301,20 @@
                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
          !
@@ -298,4 +330,10 @@
             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
          END SELECT
          !
Index: /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 2881)
+++ /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 2882)
@@ -164,8 +164,10 @@
    REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE, SAVE   ::   ztab, znorthloc
    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE   ::   znorthgloio
+   REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE, SAVE   ::   zfoldwk      ! Workspace for message transfers avoiding mpi_allgather
 
    ! Arrays used in mpp_lbc_north_2d()
    REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   ztab_2d, znorthloc_2d
    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   znorthgloio_2d
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   zfoldwk_2d    ! Workspace for message transfers avoiding mpi_allgather
 
    ! Arrays used in mpp_lbc_north_e()
@@ -173,4 +175,12 @@
    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   znorthgloio_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
+   INTEGER, PUBLIC                                  ::   ityp
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -203,6 +213,8 @@
          !
          &      ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk) , znorthgloio(jpi,4,jpk,jpni) ,                        &
+         &      zfoldwk(jpi,4,jpk) ,                                                                             &
          !
          &      ztab_2d(jpiglo,4)  , znorthloc_2d(jpi,4)  , znorthgloio_2d(jpi,4,jpni)  ,                        &
+         &      zfoldwk_2d(jpi,4)  ,                                                                             &
          !
          &      ztab_e(jpiglo,4+2*jpr2dj) , znorthloc_e(jpi,4+2*jpr2dj) , znorthgloio_e(jpi,4+2*jpr2dj,jpni) ,   &
@@ -232,5 +244,5 @@
       LOGICAL ::   mpi_was_called
       !
-      NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, jpnij
+      NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, jpnij, ln_nnogather
       !!----------------------------------------------------------------------
       !
@@ -269,4 +281,6 @@
          WRITE(ldtxt(ii),*) '      number of local domains           jpnij = ',jpnij; ii = ii +1
       END IF
+
+      WRITE(ldtxt(ii),*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather  ; ii = ii + 1
 
       CALL mpi_initialized ( mpi_was_called, code )
@@ -441,16 +455,16 @@
       CASE ( -1 )
          CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
+         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       CASE ( 0 )
          CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
          CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
-         CALL mpprecv( 2, t3we(1,1,1,2), imigr )
+         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, t3we(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, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, t3we(1,1,1,2), imigr )
+         CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       END SELECT
@@ -494,16 +508,16 @@
       CASE ( -1 )
          CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, t3ns(1,1,1,2), imigr )
+         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       CASE ( 0 )
          CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
          CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, t3ns(1,1,1,2), imigr )
-         CALL mpprecv( 4, t3sn(1,1,1,2), imigr )
+         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, t3sn(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, t3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, t3sn(1,1,1,2), imigr )
+         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       END SELECT
@@ -635,16 +649,16 @@
       CASE ( -1 )
          CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, t2ew(1,1,2), imigr )
+         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       CASE ( 0 )
          CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
          CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, t2ew(1,1,2), imigr )
-         CALL mpprecv( 2, t2we(1,1,2), imigr )
+         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
+         CALL mpprecv( 2, t2we(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, t2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, t2we(1,1,2), imigr )
+         CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       END SELECT
@@ -688,16 +702,16 @@
       CASE ( -1 )
          CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, t2ns(1,1,2), imigr )
+         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       CASE ( 0 )
          CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
          CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, t2ns(1,1,2), imigr )
-         CALL mpprecv( 4, t2sn(1,1,2), imigr )
+         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
+         CALL mpprecv( 4, t2sn(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, t2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, t2sn(1,1,2), imigr )
+         CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       END SELECT
@@ -816,16 +830,16 @@
       CASE ( -1 )
          CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )
+         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       CASE ( 0 )
          CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
          CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )
-         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )
+         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, t4we(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, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )
+         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr, nowe )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       END SELECT
@@ -875,16 +889,16 @@
       CASE ( -1 )
          CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr )
+         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       CASE ( 0 )
          CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )
          CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr )
-         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr )
+         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, t4sn(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, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr )
+         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr, noso )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       END SELECT
@@ -1019,16 +1033,16 @@
       CASE ( -1 )
          CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
+         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       CASE ( 0 )
          CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
          CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
-         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
+         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea )
+         CALL mpprecv( 2, tr2we(1-jpr2dj,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, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
+         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr, nowe )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       END SELECT
@@ -1072,16 +1086,16 @@
       CASE ( -1 )
          CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )
+         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       CASE ( 0 )
          CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
          CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )
-         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )
+         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono )
+         CALL mpprecv( 4, tr2sn(1-jpr2di,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, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )
+         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr, noso )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       END SELECT
@@ -1138,5 +1152,5 @@
 
 
-   SUBROUTINE mpprecv( ktyp, pmess, kbytes )
+   SUBROUTINE mpprecv( ktyp, pmess, kbytes, ksource )
       !!----------------------------------------------------------------------
       !!                  ***  routine mpprecv  ***
@@ -1148,10 +1162,20 @@
       INTEGER , INTENT(in   ) ::   kbytes     ! suze of the array pmess
       INTEGER , INTENT(in   ) ::   ktyp       ! Tag of the recevied message
+      INTEGER, OPTIONAL, INTENT(in) :: ksource    ! source process number 
       !!
       INTEGER :: istatus(mpi_status_size)
       INTEGER :: iflag
-      !!----------------------------------------------------------------------
-      !
-      CALL mpi_recv( pmess, kbytes, mpi_double_precision, mpi_any_source, ktyp, mpi_comm_opa, istatus, iflag )
+      INTEGER :: use_source
+      !!----------------------------------------------------------------------
+      !
+
+      ! If a specific process number has been passed to the receive call, 
+      ! use that one. Default is to use mpi_any_source
+      use_source=mpi_any_source
+      if(present(ksource)) then
+         use_source=ksource
+      end if
+
+      CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_opa, istatus, iflag )
       !
    END SUBROUTINE mpprecv
@@ -1833,16 +1857,16 @@
          IF( nbondi == -1 ) THEN
             CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
-            CALL mpprecv( 1, t2ew(1,1,2), imigr )
+            CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
             IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err )
          ELSEIF( nbondi == 0 ) THEN
             CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
             CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
-            CALL mpprecv( 1, t2ew(1,1,2), imigr )
-            CALL mpprecv( 2, t2we(1,1,2), imigr )
+            CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
+            CALL mpprecv( 2, t2we(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 )
          ELSEIF( nbondi == 1 ) THEN
             CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
-            CALL mpprecv( 2, t2we(1,1,2), imigr )
+            CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )
             IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
          ENDIF
@@ -1879,16 +1903,16 @@
          IF( nbondj == -1 ) THEN
             CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
-            CALL mpprecv( 3, t2ns(1,1,2), imigr )
+            CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
             IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
          ELSEIF( nbondj == 0 ) THEN
             CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
             CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
-            CALL mpprecv( 3, t2ns(1,1,2), imigr )
-            CALL mpprecv( 4, t2sn(1,1,2), imigr )
+            CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
+            CALL mpprecv( 4, t2sn(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 )
          ELSEIF( nbondj == 1 ) THEN
             CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
-            CALL mpprecv( 4, t2sn(1,1,2), imigr)
+            CALL mpprecv( 4, t2sn(1,1,2), imigr, noso)
             IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err )
          ENDIF
@@ -2209,7 +2233,11 @@
       INTEGER ::   ierr, itaille, ildi, ilei, iilb
       INTEGER ::   ijpj, ijpjm1, ij, iproc
+      INTEGER, DIMENSION (jpmaxngh)          ::   ml_req5            ! 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
       !!----------------------------------------------------------------------
       !   
       ijpj   = 4
+      ityp = -1
       ijpjm1 = 3
       ztab(:,:,:) = 0.e0
@@ -2222,19 +2250,89 @@
       !                                     ! Build in procs of ncomm_north the znorthgloio
       itaille = jpi * jpk * ijpj
-      CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
-         &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+      IF ( l_north_nogather ) THEN
+!
+! Avoid the use of mpi_allgather by exchanging only with the processes already identified (in opa_northcomms)
+! as being  involved in this process' northern boundary exchange
+!
+! First put local values into the global arraay
+         DO jj = nlcj-ijpj+1, nlcj
+           ij = jj - nlcj + ijpj
+           DO ji = 1, nlci
+             ztab(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
+!
+! Set a default value for unsupported types which will cause a fallback to
+! the mpi_allgather method
+!
+             ityp = -1
+          END SELECT
+          IF ( ityp .gt. 0 ) THEN
+
+           DO jr = 1,nsndto(ityp)
+            CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req5(jr) )
+           END DO
+           DO jr = 1,nsndto(ityp)
+            CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp))
+            iproc = isendto(jr,ityp) + 1
+            ildi=nldit (iproc)
+            ilei=nleit (iproc)
+            iilb=nimppt(iproc)
+            DO jj = 1, 4
+               DO ji = ildi, ilei
+                  ztab(ji+iilb-1,jj,:) = zfoldwk(ji,jj,:)
+               END DO
+            END DO
+           END DO
+           IF(l_isend) THEN
+              DO jr = 1,nsndto(ityp)
+                CALL mpi_wait(ml_req5(jr), ml_stat, ml_err)
+              END DO
+           ENDIF
+
+          ENDIF
+
+      ENDIF
+
+      IF ( ityp .lt. 0 ) THEN
+         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
+            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
       !
       !                                     ! recover the global north array
-      DO jr = 1, ndim_rank_north
-         iproc = nrank_north(jr) + 1
-         ildi  = nldit (iproc)
-         ilei  = nleit (iproc)
-         iilb  = nimppt(iproc)
-         DO jj = 1, 4
-            DO ji = ildi, ilei
-               ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr)
+         DO jr = 1, ndim_rank_north
+            iproc = nrank_north(jr) + 1
+            ildi  = nldit (iproc)
+            ilei  = nleit (iproc)
+            iilb  = nimppt(iproc)
+            DO jj = 1, 4
+               DO ji = ildi, ilei
+                  ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr)
+               END DO
             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.
       !
       CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
@@ -2272,7 +2370,11 @@
       INTEGER ::   ierr, itaille, ildi, ilei, iilb
       INTEGER ::   ijpj, ijpjm1, ij, iproc
+      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req5            ! 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
       !!----------------------------------------------------------------------
       !
       ijpj   = 4
+      ityp = -1
       ijpjm1 = 3
       ztab_2d(:,:) = 0.e0
@@ -2285,18 +2387,90 @@
       !                                     ! Build in procs of ncomm_north the znorthgloio_2d
       itaille = jpi * ijpj
-      CALL MPI_ALLGATHER( znorthloc_2d  , itaille, MPI_DOUBLE_PRECISION,        &
-         &                znorthgloio_2d, 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)
-         DO jj = 1, 4
-            DO ji = ildi, ilei
-               ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr)
+      IF ( l_north_nogather ) THEN
+!
+! Avoid the use of mpi_allgather by exchanging only with the processes already identified (in opa_northcomms) 
+! as being  involved in this process' northern boundary exchange
+!
+! First put local values into the global array
+!
+         DO jj = nlcj-ijpj+1, nlcj
+           ij = jj - nlcj + ijpj
+           DO ji = 1, nlci
+             ztab_2d(ji+nimpp-1,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
+!
+! Set a default value for unsupported types which will cause a fallback to
+! the mpi_allgather method
+!
+             ityp = -1
+          END SELECT
+
+          IF ( ityp .gt. 0 ) THEN
+
+           DO jr = 1,nsndto(ityp)
+            CALL mppsend(5, znorthloc_2d, itaille, isendto(jr,ityp), ml_req5(jr) )
+           END DO
+           DO jr = 1,nsndto(ityp)
+            CALL mpprecv(5, zfoldwk_2d, itaille, isendto(jr,ityp))
+            iproc = isendto(jr,ityp) + 1
+            ildi=nldit (iproc)
+            ilei=nleit (iproc)
+            iilb=nimppt(iproc)
+            DO jj = 1, 4
+               DO ji = ildi, ilei
+                  ztab_2d(ji+iilb-1,jj) = zfoldwk_2d(ji,jj)
+               END DO
             END DO
-         END DO
-      END DO
+           END DO
+           IF(l_isend) THEN
+              DO jr = 1,nsndto(ityp)
+                CALL mpi_wait(ml_req5(jr), ml_stat, ml_err)
+              END DO
+           ENDIF
+
+          ENDIF
+
+      ENDIF
+
+      IF ( ityp .lt. 0 ) THEN
+       CALL MPI_ALLGATHER( znorthloc_2d  , itaille, MPI_DOUBLE_PRECISION,        &
+          &                znorthgloio_2d, 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)
+          DO jj = 1, 4
+             DO ji = ildi, ilei
+                ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr)
+             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.
       !
       CALL lbc_nfd( ztab_2d, cd_type, psgn )   ! North fold boundary condition
Index: /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 2881)
+++ /branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 2882)
@@ -291,4 +291,6 @@
                             CALL     dom_cfg    ! Domain configuration
                             CALL     dom_init   ! Domain
+
+      IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined)
 
       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
@@ -617,4 +619,159 @@
    END SUBROUTINE factorise
 
+   SUBROUTINE nemo_northcomms
+      !!======================================================================
+      !!                     ***  ROUTINE  nemo_northcomms  ***
+      !! nemo_northcomms    :  Setup for north fold exchanges with explicit peer to peer messaging
+      !!=====================================================================
+      !!----------------------------------------------------------------------
+      !! 
+      !! ** Purpose :   Initialization of the northern neighbours lists.
+      !!----------------------------------------------------------------------
+      !!    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
+      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
+        WRITE(numout,*) narea, njmppt(narea) , MAXVAL( njmppt ) ; FLUSH(numout)
+
+     DO jtyp = 1,4
+
+        lrankset = .FALSE.
+        znnbrs = narea
+        SELECT CASE (jtyp)
+        CASE(1)
+           !
+           ! Type 1: T,W-points
+           !
+           CALL lbc_lnk( znnbrs, 'T', 1. )
+        CASE(2)
+           !
+           ! Type 2: U-point
+           !
+           CALL lbc_lnk( znnbrs, 'U', 1. )
+        CASE(3)
+           !
+           ! Type 3: V-point
+           !
+           CALL lbc_lnk( znnbrs, 'V', 1. )
+        CASE(4)
+           !
+           ! Type 5: F-point
+           !
+           CALL lbc_lnk( znnbrs, 'F', 1. )
+        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.
+!
+        DO jtyp=1,5
+         write(numout,'(i4,a,2i4,a,8i5)') narea-1,' : ',jtyp,nsndto(jtyp),' ids ',(isendto(ij,jtyp),ij=1,nsndto(jtyp))
+        END DO
+        CALL FLUSH(numout)
+      ENDIF
+        WRITE(numout,*) narea, ' l_north_nogather ',l_north_nogather; FLUSH(numout)
+      DEALLOCATE( znnbrs )
+      DEALLOCATE( lrankset )
+
+   END SUBROUTINE nemo_northcomms
    !!======================================================================
 END MODULE nemogcm
