Index: NEMO/trunk/src/OCE/LBC/mpp_nfd_generic.h90
===================================================================
--- NEMO/trunk/src/OCE/LBC/mpp_nfd_generic.h90	(revision 14433)
+++ NEMO/trunk/src/OCE/LBC/mpp_nfd_generic.h90	(revision 15267)
@@ -10,20 +10,20 @@
       !
       LOGICAL  ::   ll_add_line
-      INTEGER  ::   ji,  jj,  jk,  jl, jh, jf, jr   ! dummy loop indices
+      INTEGER  ::   ji,  jj,  jk,  jl, jf, jr, jg, jn   ! dummy loop indices
       INTEGER  ::   ipi, ipj, ipj2, ipk, ipl, ipf   ! dimension of the input array
-      INTEGER  ::   imigr, iihom, ijhom             ! local integers
       INTEGER  ::   ierr, ibuffsize, iis0, iie0, impp
-      INTEGER  ::   ii1, ii2, ij1, ij2
-      INTEGER  ::   ipimax, i0max
+      INTEGER  ::   ii1, ii2, ij1, ij2, iis, iie, iib, iig, iin
+      INTEGER  ::   i0max
       INTEGER  ::   ij, iproc, ipni, ijnr
-      INTEGER, DIMENSION (jpmaxngh)       ::   ml_req_nf   ! for mpi_isend when avoiding mpi_allgather
-      INTEGER                             ::   ml_err      ! for mpi_isend when avoiding mpi_allgather
-      !                                                    ! Workspace for message transfers avoiding mpi_allgather
-      INTEGER                             ::   ipj_b       ! sum of lines for all multi fields
-      INTEGER                             ::   i012        ! 0, 1 or 2
-      INTEGER , DIMENSION(:,:)        , ALLOCATABLE ::   jj_s  ! position of sent lines
-      INTEGER , DIMENSION(:,:)        , ALLOCATABLE ::   jj_b  ! position of buffer lines
-      INTEGER , DIMENSION(:)          , ALLOCATABLE ::   ipj_s ! number of sent lines
-      REAL(PRECISION), DIMENSION(:,:,:,:)    , ALLOCATABLE ::   ztabb, ztabr, ztabw  ! buffer, receive and work arrays
+      INTEGER, DIMENSION (:), ALLOCATABLE ::   ireq_s, ireq_r   ! for mpi_isend when avoiding mpi_allgather
+      INTEGER                             ::   ipjtot           ! sum of lines for all multi fields
+      INTEGER                             ::   i012             ! 0, 1 or 2
+      INTEGER , DIMENSION(:,:)        , ALLOCATABLE ::   ijsnd  ! j-position of sent lines for each field
+      INTEGER , DIMENSION(:,:)        , ALLOCATABLE ::   ijbuf  ! j-position of send buffer lines for each field
+      INTEGER , DIMENSION(:,:)        , ALLOCATABLE ::   ijrcv  ! j-position of recv buffer lines for each field
+      INTEGER , DIMENSION(:,:)        , ALLOCATABLE ::   ii1st, iiend
+      INTEGER , DIMENSION(:)          , ALLOCATABLE ::   ipjfld ! number of sent lines for each field
+      REAL(PRECISION), DIMENSION(:,:,:,:)    , ALLOCATABLE ::   zbufs  ! buffer, receive and work arrays
+      REAL(PRECISION), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   zbufr  ! buffer, receive and work arrays
       REAL(PRECISION), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   znorthloc
       REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   znorthglo
@@ -62,54 +62,69 @@
          ll_add_line = l_full_nf_update .OR. ( ncom_stp <= nit000+1 .AND. .NOT. ln_rstart )
          
-         ALLOCATE(ipj_s(ipf))                ! how many lines do we exchange?
+         ALLOCATE(ipjfld(ipf))                 ! how many lines do we exchange for each field?
          IF( ll_add_line ) THEN
-            DO jf = 1, ipf                      ! Loop over the number of arrays to be processed
-               ipj_s(jf) = khls + COUNT( (/ c_NFtype == 'T' .OR. cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) ) 
+            DO jf = 1, ipf                     ! Loop over the number of arrays to be processed
+               ipjfld(jf) = khls + COUNT( (/ c_NFtype == 'T' .OR. cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) )
             END DO
          ELSE
-            ipj_s(:) = khls
+            ipjfld(:) = khls
          ENDIF
          
-         ipj   = MAXVAL(ipj_s(:))            ! Max 2nd dimension of message transfers
-         ipj_b = SUM(   ipj_s(:))            ! Total number of lines to be exchanged
-         ALLOCATE( jj_s(ipj, ipf), jj_b(ipj, ipf) )
+         ipj    = MAXVAL(ipjfld(:))            ! Max 2nd dimension of message transfers
+         ipjtot = SUM(   ipjfld(:))            ! Total number of lines to be exchanged
 
          ! Index of modifying lines in input
+         ALLOCATE( ijsnd(ipj, ipf), ijbuf(ipj, ipf), ijrcv(ipj, ipf), ii1st(ipj, ipf), iiend(ipj, ipf) )
+
          ij1 = 0
-         DO jf = 1, ipf                      ! Loop over the number of arrays to be processed
-            !
+         DO jf = 1, ipf                        ! Loop over the number of arrays to be processed
+            !
+            DO jj = 1, khls   ! first khls lines (starting from top) must be fully defined
+               ii1st(jj, jf) = 1
+               iiend(jj, jf) = jpi
+            END DO
+            !
+            ! what do we do with line khls+1 (starting from top)
             IF( c_NFtype == 'T' ) THEN          ! *  North fold  T-point pivot
                SELECT CASE ( cd_nat(jf) )
-               CASE ( 'T', 'W', 'U' )   ;   i012 = 1   ! T-, U-, W-point
-               CASE ( 'V', 'F'      )   ;   i012 = 2   ! V-, F-point
+               CASE ('T','W')   ;   i012 = 1   ;   ii1st(khls+1, jf) = mi0(jpiglo/2+2)   ;   iiend(khls+1, jf) = mi1(jpiglo-khls)
+               CASE ('U'    )   ;   i012 = 1   ;   ii1st(khls+1, jf) = mi0(jpiglo/2+1)   ;   iiend(khls+1, jf) = mi1(jpiglo-khls)
+               CASE ('V'    )   ;   i012 = 2   ;   ii1st(khls+1, jf) = 1                 ;   iiend(khls+1, jf) = jpi
+               CASE ('F'    )   ;   i012 = 2   ;   ii1st(khls+1, jf) = 1                 ;   iiend(khls+1, jf) = jpi
                END SELECT
             ENDIF
             IF( c_NFtype == 'F' ) THEN          ! *  North fold  F-point pivot
                SELECT CASE ( cd_nat(jf) )
-               CASE ( 'T', 'W', 'U' )   ;   i012 = 0   ! T-, U-, W-point
-               CASE ( 'V', 'F'      )   ;   i012 = 1   ! V-, F-point
+               CASE ('T','W')   ;   i012 = 0   ! we don't touch line khls+1
+               CASE ('U'    )   ;   i012 = 0   ! we don't touch line khls+1
+               CASE ('V'    )   ;   i012 = 1   ;   ii1st(khls+1, jf) = mi0(jpiglo/2+1)   ;   iiend(khls+1, jf) = mi1(jpiglo-khls  )
+               CASE ('F'    )   ;   i012 = 1   ;   ii1st(khls+1, jf) = mi0(jpiglo/2+1)   ;   iiend(khls+1, jf) = mi1(jpiglo-khls-1)
                END SELECT
             ENDIF
-               !
-            DO jj = 1, ipj_s(jf)
+            !
+            DO jj = 1, ipjfld(jf)
                ij1 = ij1 + 1
-               jj_b(jj,jf) = ij1
-               jj_s(jj,jf) = jpj - 2*khls + jj - i012
+               ijsnd(jj,jf) = jpj - 2*khls + jj - i012   ! sent lines (from bottom of sent lines)
+               ijbuf(jj,jf) = ij1                        ! gather all lines in the snd/rcv buffers
+               ijrcv(jj,jf) = jpj - jj + 1               ! recv lines (from the top -> reverse order for jj)
             END DO
             !
          END DO
          !
-         ALLOCATE( ztabb(jpimax,ipj_b,ipk,ipl) )   ! store all the data to be sent in a buffer array
-         ibuffsize = jpimax * ipj_b * ipk * ipl
-         !
+         i0max = jpimax - 2 * khls                                    ! we are not sending the halos
+         ALLOCATE( zbufs(i0max,ipjtot,ipk,ipl), ireq_s(nfd_nbnei) )   ! store all the data to be sent in a buffer array
+         ibuffsize = i0max * ipjtot * ipk * ipl
+         !
+         ! fill the send buffer with all the lines
          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk
-            DO jj = 1, ipj_s(jf)
-               ij1 = jj_b(jj,jf)
-               ij2 = jj_s(jj,jf)
-               DO ji = 1, jpi
-                  ztabb(ji,ij1,jk,jl) = ptab(jf)%pt4d(ji,ij2,jk,jl)
-               END DO
-               DO ji = jpi+1, jpimax
-                  ztabb(ji,ij1,jk,jl) = HUGE(0._/**/PRECISION)   ! avoid sending uninitialized values (make sure we don't use it)
+            DO jj = 1, ipjfld(jf)
+               ij1 = ijbuf(jj,jf)
+               ij2 = ijsnd(jj,jf)
+               DO ji = Nis0, Nie0       ! should not use any other value
+                  iib = ji - Nis0 + 1
+                  zbufs(iib,ij1,jk,jl) = ptab(jf)%pt4d(ji,ij2,jk,jl)
+               END DO
+               DO ji = Ni_0+1, i0max    ! avoid sending uninitialized values (make sure we don't use it)
+                  zbufs(ji,ij1,jk,jl) = HUGE(0._/**/PRECISION)   ! make sure we don't use it...
                END DO
             END DO
@@ -119,63 +134,50 @@
          IF( ln_timing ) CALL tic_tac(.TRUE.)
          !
-         ! send the data as soon as possible
-         DO jr = 1, nsndto
-            iproc = nfproc(isendto(jr))
+         ! send the same buffer data to all neighbourgs as soon as possible
+         DO jn = 1, nfd_nbnei
+            iproc = nfd_rknei(jn)
             IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN
 #if ! defined key_mpi_off
-               CALL MPI_ISEND( ztabb, ibuffsize, MPI_TYPE, iproc, 5, mpi_comm_oce, ml_req_nf(jr), ierr )
+               CALL MPI_Isend( zbufs, ibuffsize, MPI_TYPE, iproc, 5, mpi_comm_oce, ireq_s(jn), ierr )
 #endif
+            ELSE
+               ireq_s(jn) = MPI_REQUEST_NULL
             ENDIF
          END DO
          !
-         ipimax = jpimax * jpmaxngh
-         ALLOCATE( ztabw(jpimax,ipj_b,ipk,ipl), ztabr(ipimax,ipj_b,ipk,ipl) ) 
-         !
-         DO jr = 1, nsndto
-            !
-            ipni  = isendto(jr)
-            iproc = nfproc(ipni)
-            ipi   = nfjpi (ipni)
-            !
-            IF( ipni ==   1  ) THEN   ;   iis0 =   1          ! domain  left side: as e-w comm already done -> from 1st column
-            ELSE                      ;   iis0 =   1 + khls   ! default: -> from inner domain 
-            ENDIF
-            IF( ipni == jpni ) THEN   ;   iie0 = ipi          ! domain right side: as e-w comm already done -> until last column
-            ELSE                      ;   iie0 = ipi - khls   ! default: -> until inner domain 
-            ENDIF
-            impp = nfimpp(ipni) - nfimpp(isendto(1))
+         ALLOCATE( zbufr(i0max,ipjtot,ipk,ipl,nfd_nbnei), ireq_r(nfd_nbnei) ) 
+         !
+         DO jn = 1, nfd_nbnei
+            !
+            iproc = nfd_rknei(jn)
             !
             IF(           iproc == -1 ) THEN   ! No neighbour (land proc that was suppressed)
                !
+               ireq_r(jn) = MPI_REQUEST_NULL                ! no message to be received
+               zbufr(:,:,:,:,jn) = HUGE(0._/**/PRECISION)   ! default: define it and make sure we don't use it...
                SELECT CASE ( kfillmode )
-               CASE ( jpfillnothing )               ! no filling 
-               CASE ( jpfillcopy    )               ! filling with inner domain values
+               CASE ( jpfillnothing )                       ! no filling 
+               CASE ( jpfillcopy    )                       ! filling with inner domain values
                   DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk
-                     DO jj = 1, ipj_s(jf)
-                        ij1 = jj_b(jj,jf)
-                        ij2 = jj_s(jj,jf)
-                        DO ji = iis0, iie0
-                           ztabr(impp+ji,ij1,jk,jl) = ptab(jf)%pt4d(Nis0,ij2,jk,jl)   ! chose to take the 1st iner domain point
-                        END DO
+                     DO jj = 1, ipjfld(jf)
+                        ij1 = ijbuf(jj,jf)
+                        ij2 = ijsnd(jj,jf)                                      ! we will use only the first value, see init_nfdcom
+                        zbufr(1,ij1,jk,jl,jn) = ptab(jf)%pt4d(Nis0,ij2,jk,jl)   ! chose to take the 1st inner domain point
                      END DO
                   END DO   ;   END DO   ;   END DO
-               CASE ( jpfillcst     )               ! filling with constant value
-                  DO jl = 1, ipl   ;   DO jk = 1, ipk
-                     DO jj = 1, ipj_b
-                        DO ji = iis0, iie0
-                           ztabr(impp+ji,jj,jk,jl) = pfillval
-                        END DO
-                     END DO
-                  END DO   ;   END DO
+               CASE ( jpfillcst     )                       ! filling with constant value
+                  zbufr(1,:,:,:,jn) = pfillval              ! we will use only the first value, see init_nfdcom
                END SELECT
                !
             ELSE IF( iproc == narea-1 ) THEN   ! get data from myself!
                !
+               ireq_r(jn) = MPI_REQUEST_NULL                ! no message to be received
                DO jf = 1, ipf   ;   DO jl = 1, ipl  ;   DO jk = 1, ipk
-                  DO jj = 1, ipj_s(jf)
-                     ij1 = jj_b(jj,jf)
-                     ij2 = jj_s(jj,jf)
-                     DO ji = iis0, iie0
-                        ztabr(impp+ji,ij1,jk,jl) = ptab(jf)%pt4d(ji,ij2,jk,jl)
+                  DO jj = 1, ipjfld(jf)
+                     ij1 = ijbuf(jj,jf)
+                     ij2 = ijsnd(jj,jf)
+                     DO ji = Nis0, Nie0                     ! should not use any other value
+                        iib = ji - Nis0 + 1
+                        zbufr(iib,ij1,jk,jl,jn) = ptab(jf)%pt4d(ji,ij2,jk,jl)
                      END DO
                   END DO
@@ -183,19 +185,12 @@
                !
             ELSE                               ! get data from a neighbour trough communication
-               !  
 #if ! defined key_mpi_off
-               CALL MPI_RECV( ztabw, ibuffsize, MPI_TYPE, iproc, 5, mpi_comm_oce, MPI_STATUS_IGNORE, ierr )
+               CALL MPI_Irecv( zbufr(:,:,:,:,jn), ibuffsize, MPI_TYPE, iproc, 5, mpi_comm_oce, ireq_r(jn), ierr )
 #endif
-               DO jl = 1, ipl   ;   DO jk = 1, ipk
-                  DO jj = 1, ipj_b
-                     DO ji = iis0, iie0
-                        ztabr(impp+ji,jj,jk,jl) = ztabw(ji,jj,jk,jl)
-                     END DO
-                  END DO
-               END DO   ;   END DO
-               
-            ENDIF
-            !
-         END DO   ! nsndto
+            ENDIF
+            !
+         END DO   ! nfd_nbnei
+         !
+         CALL mpi_waitall(nfd_nbnei, ireq_r, MPI_STATUSES_IGNORE, ierr)   ! wait for all Irecv
          !
          IF( ln_timing ) CALL tic_tac(.FALSE.)
@@ -204,18 +199,86 @@
          !
          DO jf = 1, ipf
-            ij1 = jj_b(       1 ,jf)
-            ij2 = jj_b(ipj_s(jf),jf)
-            CALL lbc_nfd_nogather( ptab(jf)%pt4d(:,:,:,:), ztabr(:,ij1:ij2,:,:), cd_nat(jf), psgn(jf), khls )
-         END DO
-         !
-         DEALLOCATE( ztabr, ztabw, jj_s, jj_b, ipj_s )
-         !
-         DO jr = 1,nsndto
-            iproc = nfproc(isendto(jr))
-            IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN
-               CALL mpi_wait( ml_req_nf(jr), MPI_STATUS_IGNORE, ml_err )   ! put the wait at the very end just before the deallocate
-            ENDIF
-         END DO
-         DEALLOCATE( ztabb )
+            !
+            SELECT CASE ( cd_nat(jf) )     ! which grid number?
+            CASE ('T','W')   ;   iig = 1   ! T-, W-point
+            CASE ('U')       ;   iig = 2   ! U-point
+            CASE ('V')       ;   iig = 3   ! V-point
+            CASE ('F')       ;   iig = 4   ! F-point
+            END SELECT
+            !
+            DO jl = 1, ipl   ;   DO jk = 1, ipk
+               !
+               ! if T point with F-point pivot : must be done first
+               !    --> specific correction of 3 points near the 2 pivots (to be clean, usually masked -> so useless) 
+               IF( c_NFtype == 'F' .AND. iig == 1 ) THEN
+                  ij1 = jpj - khls     ! j-index in the receiving array
+                  ij2 = 1              ! only 1 line in the buffer
+                  DO ji = mi0(khls), mi1(khls)
+                     iib = nfd_jisnd(mi0(       khls),iig)   ! i-index in the buffer
+                     iin = nfd_rksnd(mi0(       khls),iig)   ! neigbhour-index in the buffer
+                     IF( nfd_rknei(iin) == -1 .AND. kfillmode == jpfillnothing )   CYCLE
+                     ptab(jf)%pt4d(ji,ij1,jk,jl) = zbufr(iib,ij2,jk,jl,iin)   ! no psgn(jf)
+                  END DO
+                  DO ji = mi0(jpiglo/2+1), mi1(jpiglo/2+1)
+                     iib = nfd_jisnd(mi0( jpiglo/2+1),iig)   ! i-index in the buffer
+                     iin = nfd_rksnd(mi0( jpiglo/2+1),iig)   ! neigbhour-index in the buffer
+                     IF( nfd_rknei(iin) == -1 .AND. kfillmode == jpfillnothing )   CYCLE
+                     ptab(jf)%pt4d(ji,ij1,jk,jl) = zbufr(iib,ij2,jk,jl,iin)   ! no psgn(jf)
+                  END DO
+                  DO ji = mi0(jpiglo-khls), mi1(jpiglo-khls)
+                     iib = nfd_jisnd(mi0(jpiglo-khls),iig)   ! i-index in the buffer
+                     iin = nfd_rksnd(mi0(jpiglo-khls),iig)   ! neigbhour-index in the buffer
+                     IF( nfd_rknei(iin) == -1 .AND. kfillmode == jpfillnothing )   CYCLE
+                     ptab(jf)%pt4d(ji,ij1,jk,jl) = zbufr(iib,ij2,jk,jl,iin)   ! no psgn(jf)
+                  END DO
+               ENDIF
+               !
+               ! Apply the North pole folding.
+               DO jj = 1, ipjfld(jf)   ! for all lines to be exchanged for this field
+                  ij1 = ijrcv(jj,jf)   ! j-index in the receiving array
+                  ij2 = ijbuf(jj,jf)   ! j-index in the buffer
+                  iis = ii1st(jj,jf)   ! stating i-index in the receiving array
+                  iie = iiend(jj,jf)   !  ending i-index in the receiving array
+                  DO ji = iis, iie 
+                     iib = nfd_jisnd(ji,iig)   ! i-index in the buffer
+                     iin = nfd_rksnd(ji,iig)   ! neigbhour-index in the buffer
+                     IF( nfd_rknei(iin) == -1 .AND. kfillmode == jpfillnothing )   CYCLE
+                     ptab(jf)%pt4d(ji,ij1,jk,jl) = psgn(jf) * zbufr(iib,ij2,jk,jl,iin)
+                  END DO
+               END DO
+               !
+               ! re-apply periodocity when we modified the eastern side of the inner domain (and not the full line)
+               IF( c_NFtype == 'T' ) THEN          ! *  North fold  T-point pivot
+                  IF(     iig <= 2 ) THEN   ;   iis = mi0(1)   ;   iie = mi1(khls)   ! 'T','W','U': update west halo
+                  ELSE                      ;   iis = 1        ;   iie = 0           ! 'V','F'    : full line already exchanged
+                  ENDIF
+               ENDIF
+               IF( c_NFtype == 'F' ) THEN          ! *  North fold  F-point pivot
+                  IF(     iig <= 2 ) THEN   ;   iis = 1        ;   iie = 0           ! 'T','W','U': nothing to do
+                  ELSEIF( iig == 3 ) THEN   ;   iis = mi0(1)   ;   iie = mi1(khls)   ! 'V'        : update west halo
+                  ELSEIF( khls > 1 ) THEN   ;   iis = mi0(1)   ;   iie = mi1(khls-1) ! 'F' and khls > 1
+                  ELSE                      ;   iis = 1        ;   iie = 0           ! 'F' and khls == 1 : nothing to do
+                  ENDIF
+               ENDIF
+               jj  = ipjfld(jf)     ! only for the last line of this field
+               ij1 = ijrcv(jj,jf)   ! j-index in the receiving array
+               ij2 = ijbuf(jj,jf)   ! j-index in the buffer
+               DO ji = iis, iie
+                  iib = nfd_jisnd(ji,iig)   ! i-index in the buffer
+                  iin = nfd_rksnd(ji,iig)   ! neigbhour-index in the buffer
+                  IF( nfd_rknei(iin) == -1 .AND. kfillmode == jpfillnothing )   CYCLE
+                  ptab(jf)%pt4d(ji,ij1,jk,jl) = psgn(jf) * zbufr(iib,ij2,jk,jl,iin)
+               END DO
+               !               
+            END DO   ;   END DO   ! ipl   ; ipk
+            !               
+         END DO   ! ipf
+       
+         !
+         DEALLOCATE( zbufr, ireq_r, ijsnd, ijbuf, ijrcv, ii1st, iiend, ipjfld )
+         !
+         CALL mpi_waitall(nfd_nbnei, ireq_s, MPI_STATUSES_IGNORE, ierr)   ! wait for all Isend
+         !
+         DEALLOCATE( zbufs, ireq_s )
          !
       ELSE                             !==  allgather exchanges  ==!
@@ -265,5 +328,6 @@
               !
                SELECT CASE ( kfillmode )
-               CASE ( jpfillnothing )               ! no filling 
+               CASE ( jpfillnothing )               ! no filling
+                  CALL ctl_stop( 'STOP', 'mpp_nfd_generic : cannot use jpfillnothing with ln_nnogather = F')
                CASE ( jpfillcopy    )               ! filling with inner domain values
                   DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk
@@ -329,5 +393,5 @@
          DEALLOCATE( ztabglo )
          !
-      ENDIF   ! l_north_nogather
+      ENDIF   ! ln_nnogather
       !
    END SUBROUTINE mpp_nfd_/**/PRECISION
