Index: branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
===================================================================
--- branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 9425)
+++ branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 9436)
@@ -8,4 +8,6 @@
    !!            8.0  !  1998-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
    !!  NEMO      1.0  !  2004-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
+   !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add mpp_init_nfdcom
+   !!            3.   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) mpp_init_nfdcom: setup avoiding MPI communication 
    !!            4.0  !  2016-06  (G. Madec)  use domain configuration file instead of bathymetry file
    !!            4.0  !  2017-06  (J.M. Molines, T. Lovato) merge of mppini and mppini_2
@@ -13,11 +15,15 @@
 
    !!----------------------------------------------------------------------
-   !!  mpp_init       : Lay out the global domain over processors with/without land processor elimination
-   !!  mpp_init_mask  : 
-   !!  mpp_init_ioipsl: IOIPSL initialization in mpp 
+   !!  mpp_init          : Lay out the global domain over processors with/without land processor elimination
+   !!  mpp_init_mask     : Read global bathymetric information to facilitate land suppression
+   !!  mpp_init_ioipsl   : IOIPSL initialization in mpp 
+   !!  mpp_init_partition: Calculate MPP domain decomposition
+   !!  factorise         : Calculate the factors of the no. of MPI processes
+   !!  mpp_init_nfdcom   : Setup for north fold exchanges with explicit point-to-point messaging
    !!----------------------------------------------------------------------
    USE dom_oce        ! ocean space and time domain
    USE bdy_oce        ! open BounDarY  
    !
+   USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
    USE lib_mpp        ! distribued memory computing library
    USE iom            ! nemo I/O library 
@@ -52,4 +58,16 @@
       !!----------------------------------------------------------------------
       !
+      jpimax = jpiglo
+      jpjmax = jpjglo
+      jpi    = jpiglo
+      jpj    = jpjglo
+      jpk    = jpjglo
+      jpim1  = jpi-1                                            ! inner domain indices
+      jpjm1  = jpj-1                                            !   "           "
+      jpkm1  = MAX( 1, jpk-1 )                                  !   "           "
+      jpij   = jpi*jpj
+      jpni   = 1
+      jpnj   = 1
+      jpnij  = jpni*jpnj
       nimpp  = 1           ! 
       njmpp  = 1
@@ -128,13 +146,56 @@
       INTEGER ::   iiea, ijea, iiwe, ijwe     !   -       -
       INTEGER ::   iresti, irestj, iproc      !   -       -
+      INTEGER ::   ierr                       ! local logical unit
       REAL(wp)::   zidom, zjdom               ! local scalars
-      INTEGER, DIMENSION(jpnij)     ::   iin, ii_nono, ii_noea   ! 1D workspace
-      INTEGER, DIMENSION(jpnij)     ::   ijn, ii_noso, ii_nowe   !  -     -
+      INTEGER, DIMENSION(jpnij)     ::   iin, ii_nono, ii_noea          ! 1D workspace
+      INTEGER, DIMENSION(jpnij)     ::   ijn, ii_noso, ii_nowe          !  -     -
       INTEGER, DIMENSION(jpni,jpnj) ::   iimppt, ilci, ibondi, ipproc   ! 2D workspace
       INTEGER, DIMENSION(jpni,jpnj) ::   ijmppt, ilcj, ibondj, ipolj    !  -     -
       INTEGER, DIMENSION(jpni,jpnj) ::   ilei, ildi, iono, ioea         !  -     -
       INTEGER, DIMENSION(jpni,jpnj) ::   ilej, ildj, ioso, iowe         !  -     -
-      INTEGER, DIMENSION(jpiglo,jpjglo) ::   imask   ! 2D golbal domain workspace
-      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(jpiglo,jpjglo) ::   imask   ! 2D global domain workspace
+      !!----------------------------------------------------------------------
+
+      ! If dimensions of processor grid weren't specified in the namelist file
+      ! then we calculate them here now that we have our communicator size
+      IF( jpni < 1 .OR. jpnj < 1 ) THEN
+         IF( Agrif_Root() )   CALL mpp_init_partition( mppsize )
+      ENDIF
+      !
+#if defined key_agrif
+      IF( jpnij /= jpni*jpnj ) CALL ctl_stop( 'STOP', 'Cannot remove land proc with AGRIF' )
+#endif
+
+      !
+      ALLOCATE(  nfiimpp(jpni,jpnj), nfipproc(jpni,jpnj), nfilcit(jpni,jpnj) ,    &
+         &       nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,    &
+         &       njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,    &
+         &                                       nleit(jpnij) , nlejt(jpnij) , STAT=ierr )
+      CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'mpp_init: unable to allocate standard ocean arrays' )
+      
+      !
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90)
+         jpiglo  = nbcellsx + 2 + 2*nbghostcells
+         jpjglo  = nbcellsy + 2 + 2*nbghostcells
+         jpimax  = ( jpiglo-2*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls
+         jpjmax  = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls
+         nperio  = 0
+         jperio  = 0
+         ln_use_jattr = .false.
+      ENDIF
+#endif
+
+      IF( Agrif_Root() ) THEN       ! AGRIF mother: specific setting from jpni and jpnj
+#if defined key_nemocice_decomp
+         jpimax = ( nx_global+2-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim.
+         jpjmax = ( ny_global+2-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim. 
+#else
+         jpimax = ( jpiglo - 2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim.
+         jpjmax = ( jpjglo - 2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim.
+#endif
+      ENDIF
+
       !
       IF ( jpni * jpnj == jpnij ) THEN    ! regular domain lay out over processors
@@ -158,6 +219,5 @@
       irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
       !
-      !  Need to use jpimax and jpjmax here since jpi and jpj have already been
-      !  shrunk to local sizes in nemogcm
+      !  Need to use jpimax and jpjmax here since jpi and jpj not yet defined
 #if defined key_nemocice_decomp
       ! Change padding to be consistent with CICE
@@ -174,6 +234,4 @@
       ilcj(:, irestj+1:jpnj) = jpjmax-1
 #endif
-      !
-      nfilcit(:,:) = ilci(:,:)
       !
       zidom = nreci + sum(ilci(:,1) - nreci )
@@ -233,5 +291,5 @@
          IF( jpni            ==  1  )   ibondi(ii,ij) =  2
 
-         ! Subdomain neighbors
+         ! Subdomain neighbors (get their zone number): default definition
          iproc = jarea - 1
          ioso(ii,ij) = iproc - jpni
@@ -241,14 +299,8 @@
          ildi(ii,ij) =  1  + nn_hls
          ilei(ii,ij) = ili - nn_hls
-
-         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 )   ildi(ii,ij) =  1
-         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 )   ilei(ii,ij) = ili
          ildj(ii,ij) =  1  + nn_hls
          ilej(ii,ij) = ilj - nn_hls
-         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 )   ildj(ii,ij) =  1
-         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 )   ilej(ii,ij) = ilj
-
-         ! warning ii*ij (zone) /= nproc (processors)!
-
+
+         ! East-West periodicity: change ibondi, ioea, iowe
          IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN
             IF( jpni == 1 )THEN
@@ -265,4 +317,6 @@
             ENDIF
          ENDIF
+
+         ! North fold: define ipolj, change iono. Warning: we do not change ibondj...
          ipolj(ii,ij) = 0
          IF( jperio == 3 .OR. jperio == 4 ) THEN
@@ -304,5 +358,5 @@
          WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' 
          WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
-         CALL ctl_stop( 'mpp_init: Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
+         CALL ctl_stop( 'STOP', 'mpp_init: Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
       ENDIF
 
@@ -333,5 +387,5 @@
       ENDIF
 
-      ! 5. neighbour treatment
+      ! 5. neighbour treatment: change ibondi, ibondj if next to a land zone
       ! ----------------------
       DO jarea = 1, jpni*jpnj
@@ -371,10 +425,22 @@
       END DO
 
+      ! Update il[de][ij] according to modified ibond[ij]
+      ! ----------------------
+      DO jarea = 1, jpni*jpnj
+         ii = iin(narea)
+         ij = ijn(narea)
+         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) =  1
+         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ilci(ii,ij)
+         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) =  1
+         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilcj(ii,ij)
+      END DO
+         
       ! just to save nono etc for all proc
+      ! warning ii*ij (zone) /= nproc (processors)!
+      ! ioso = zone number, ii_noso = proc number
       ii_noso(:) = -1
       ii_nono(:) = -1
       ii_noea(:) = -1
       ii_nowe(:) = -1 
-      nproc = narea-1
       DO jarea = 1, jpnij
          ii = iin(jarea)
@@ -383,24 +449,20 @@
             iiso = 1 + MOD( ioso(ii,ij) , jpni )
             ijso = 1 +      ioso(ii,ij) / jpni
-            noso = ipproc(iiso,ijso)
-            ii_noso(jarea)= noso
+            ii_noso(jarea) = ipproc(iiso,ijso)
          ENDIF
          IF( 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
           iiwe = 1 + MOD( iowe(ii,ij) , jpni )
           ijwe = 1 +      iowe(ii,ij) / jpni
-          nowe = ipproc(iiwe,ijwe)
-          ii_nowe(jarea)= nowe
+          ii_nowe(jarea) = ipproc(iiwe,ijwe)
          ENDIF
          IF( 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
             iiea = 1 + MOD( ioea(ii,ij) , jpni )
             ijea = 1 +      ioea(ii,ij) / jpni
-            noea = ipproc(iiea,ijea)
-            ii_noea(jarea)= noea
+            ii_noea(jarea)= ipproc(iiea,ijea)
          ENDIF
          IF( 0 <= iono(ii,ij) .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
             iino = 1 + MOD( iono(ii,ij) , jpni )
             ijno = 1 +      iono(ii,ij) / jpni
-            nono = ipproc(iino,ijno)
-            ii_nono(jarea)= nono
+            ii_nono(jarea)= ipproc(iino,ijno)
          ENDIF
       END DO
@@ -408,5 +470,4 @@
       ! 6. Change processor name
       ! ------------------------
-      nproc = narea-1
       ii = iin(narea)
       ij = ijn(narea)
@@ -417,8 +478,8 @@
       noea = ii_noea(narea)
       nono = ii_nono(narea)
-      nlcj = ilcj(ii,ij)  
       nlci = ilci(ii,ij)  
       nldi = ildi(ii,ij)
       nlei = ilei(ii,ij)
+      nlcj = ilcj(ii,ij)  
       nldj = ildj(ii,ij)
       nlej = ilej(ii,ij)
@@ -426,16 +487,32 @@
       nbondj = ibondj(ii,ij)
       nimpp = iimppt(ii,ij)  
-      njmpp = ijmppt(ii,ij)  
+      njmpp = ijmppt(ii,ij)
+      jpi = nlci
+      jpj = nlcj
+      jpk = jpkglo                                             ! third dim
+#if defined key_agrif
+      ! simple trick to use same vertical grid as parent but different number of levels: 
+      ! Save maximum number of levels in jpkglo, then define all vertical grids with this number.
+      ! Suppress once vertical online interpolation is ok
+      IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo )
+#endif
+      jpim1 = jpi-1                                            ! inner domain indices
+      jpjm1 = jpj-1                                            !   "           "
+      jpkm1 = MAX( 1, jpk-1 )                                  !   "           "
+      jpij  = jpi*jpj                                          !  jpi x j
       DO jproc = 1, jpnij
          ii = iin(jproc)
          ij = ijn(jproc)
-         nimppt(jproc) = iimppt(ii,ij)  
-         njmppt(jproc) = ijmppt(ii,ij) 
-         nlcjt(jproc) = ilcj(ii,ij)
          nlcit(jproc) = ilci(ii,ij)
          nldit(jproc) = ildi(ii,ij)
          nleit(jproc) = ilei(ii,ij)
+         nlcjt(jproc) = ilcj(ii,ij)
          nldjt(jproc) = ildj(ii,ij)
          nlejt(jproc) = ilej(ii,ij)
+         ibonit(jproc) = ibondi(ii,ij)
+         ibonjt(jproc) = ibondj(ii,ij)
+         nimppt(jproc) = iimppt(ii,ij)  
+         njmppt(jproc) = ijmppt(ii,ij) 
+         nfilcit(ii,ij) = ilci(ii,ij)
       END DO
 
@@ -444,19 +521,19 @@
          CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
          WRITE(inum,'(a)') '   jpnij   jpimax  jpjmax    jpk  jpiglo  jpjglo'//&
-   &           ' ( local:    narea     jpi     jpj)'
+   &           ' ( local:    narea     jpi     jpj )'
          WRITE(inum,'(6i8,a,3i8,a)') jpnij,jpimax,jpjmax,jpk,jpiglo,jpjglo,&
    &           ' ( local: ',narea,jpi,jpj,' )'
-         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj '
+         WRITE(inum,'(a)') 'nproc nlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj '
 
          DO jproc = 1, jpnij
             ii = iin(jproc)
             ij = ijn(jproc)
-            WRITE(inum,'(15i5)') jproc-1, nlcit  (jproc), nlcjt  (jproc),   &
-               &                          nldit  (jproc), nldjt  (jproc),   &
-               &                          nleit  (jproc), nlejt  (jproc),   &
-               &                          nimppt (jproc), njmppt (jproc),   & 
-               &                          ii_nono(jproc), ii_noso(jproc),   &
-               &                          ii_nowe(jproc), ii_noea(jproc),   &
-               &                          ibondi (ii,ij), ibondj (ii,ij) 
+            WRITE(inum,'(13i5,2i7)')   jproc-1, nlcit  (jproc), nlcjt  (jproc),   &
+               &                                nldit  (jproc), nldjt  (jproc),   &
+               &                                nleit  (jproc), nlejt  (jproc),   &
+               &                                nimppt (jproc), njmppt (jproc),   & 
+               &                                ii_nono(jproc), ii_noso(jproc),   &
+               &                                ii_nowe(jproc), ii_noea(jproc),   &
+               &                                ibondi (ii,ij), ibondj (ii,ij) 
          END DO
          CLOSE(inum)   
@@ -477,4 +554,5 @@
       ENDIF
       !
+      nproc = narea-1
       IF(lwp) THEN
          WRITE(numout,*)
@@ -510,4 +588,6 @@
       CALL mpp_init_ioipsl       ! Prepare NetCDF output file (if necessary)
       !
+      IF( ln_nnogather )   CALL mpp_init_nfdcom     ! northfold neighbour lists
+      !
     END SUBROUTINE mpp_init
 
@@ -619,4 +699,180 @@
    END SUBROUTINE mpp_init_ioipsl  
 
+
+   SUBROUTINE mpp_init_partition( num_pes )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE mpp_init_partition  ***
+      !!
+      !! ** Purpose :
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have
+      !
+      INTEGER, PARAMETER :: nfactmax = 20
+      INTEGER :: nfact ! The no. of factors returned
+      INTEGER :: ierr  ! Error flag
+      INTEGER :: ji
+      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
+      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
+      !!----------------------------------------------------------------------
+      !
+      ierr = 0
+      !
+      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
+      !
+      IF( nfact <= 1 ) THEN
+         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
+         WRITE (numout, *) '       : using grid of ',num_pes,' x 1'
+         jpnj = 1
+         jpni = num_pes
+      ELSE
+         ! Search through factors for the pair that are closest in value
+         mindiff = 1000000
+         imin    = 1
+         DO ji = 1, nfact-1, 2
+            idiff = ABS( ifact(ji) - ifact(ji+1) )
+            IF( idiff < mindiff ) THEN
+               mindiff = idiff
+               imin = ji
+            ENDIF
+         END DO
+         jpnj = ifact(imin)
+         jpni = ifact(imin + 1)
+      ENDIF
+      !
+      jpnij = jpni*jpnj
+      !
+   END SUBROUTINE mpp_init_partition
+
+
+   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE factorise  ***
+      !!
+      !! ** Purpose :   return the prime factors of n.
+      !!                knfax factors are returned in array kfax which is of
+      !!                maximum dimension kmaxfax.
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   ) ::   kn, kmaxfax
+      INTEGER                    , INTENT(  out) ::   kerr, knfax
+      INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax
+      !
+      INTEGER :: ifac, jl, inu
+      INTEGER, PARAMETER :: ntest = 14
+      INTEGER, DIMENSION(ntest) ::   ilfax
+      !!----------------------------------------------------------------------
+      !
+      ! lfax contains the set of allowed factors.
+      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
+      !
+      ! Clear the error flag and initialise output vars
+      kerr  = 0
+      kfax  = 1
+      knfax = 0
+      !
+      IF( kn /= 1 ) THEN      ! Find the factors of n
+         !
+         ! nu holds the unfactorised part of the number.
+         ! knfax holds the number of factors found.
+         ! l points to the allowed factor list.
+         ! ifac holds the current factor.
+         !
+         inu   = kn
+         knfax = 0
+         !
+         DO jl = ntest, 1, -1
+            !
+            ifac = ilfax(jl)
+            IF( ifac > inu )   CYCLE
+            !
+            ! Test whether the factor will divide.
+            !
+            IF( MOD(inu,ifac) == 0 ) THEN
+               !
+               knfax = knfax + 1            ! Add the factor to the list
+               IF( knfax > kmaxfax ) THEN
+                  kerr = 6
+                  write (*,*) 'FACTOR: insufficient space in factor array ', knfax
+                  return
+               ENDIF
+               kfax(knfax) = ifac
+               ! Store the other factor that goes with this one
+               knfax = knfax + 1
+               kfax(knfax) = inu / ifac
+               !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
+            ENDIF
+            !
+         END DO
+         !
+      ENDIF
+      !
+   END SUBROUTINE factorise
+
+
+   SUBROUTINE mpp_init_nfdcom
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE  mpp_init_nfdcom  ***
+      !! ** Purpose :   Setup for north fold exchanges with explicit 
+      !!                point-to-point messaging
+      !!
+      !! ** Method :   Initialization of the northern neighbours lists.
+      !!----------------------------------------------------------------------
+      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
+      !!    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
+      !
+      IF ( njmpp == njmppmax ) THEN      ! if I am a process in the north
+         !
+         !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 = 1, jpni
+            !
+            sxT = nfiimpp(jn, jpnj)                            ! sxT = 1st  point (in the global domain) of the jn process
+            dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1    ! dxT = last point (in the global domain) of the jn process
+            !
+            IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ELSEIF( sxM <= sxT  .AND.  dxM >= dxT ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ELSEIF( dxM <  dxT  .AND.  sxT <  dxM ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ENDIF
+            !
+         END DO
+         nfsloop = 1
+         nfeloop = nlci
+         DO jn = 2,jpni-1
+            IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN
+               IF( nfipproc(jn-1,jpnj) == -1 )   nfsloop = nldi
+               IF( nfipproc(jn+1,jpnj) == -1 )   nfeloop = nlei
+            ENDIF
+         END DO
+         !
+      ENDIF
+      l_north_nogather = .TRUE.
+      !
+   END SUBROUTINE mpp_init_nfdcom
+
+   
 #endif
 
