Changeset 14314 for NEMO/branches/2021

Timestamp:

2021-01-19T13:07:35+01:00 (3 years ago)

Author:

smasson

Message:

dev_r14312_MPI_Interface: first implementation, #2598

Location:

NEMO/branches/2021/dev_r14312_MPI_Interface/src

Files:

• OCE/BDY/bdyini.F90 (modified) (3 diffs)
• OCE/CRS/crs.F90 (modified) (8 diffs)
• OCE/CRS/crsdom.F90 (modified) (2 diffs)
• OCE/DOM/dom_oce.F90 (modified) (3 diffs)
• OCE/ICB/icbini.F90 (modified) (2 diffs)
• OCE/ICB/icblbc.F90 (modified) (6 diffs)
• OCE/LBC/lbc_lnk_multi_generic.h90 (modified) (3 diffs)
• OCE/LBC/lbc_lnk_nc_generic.h90 (modified) (3 diffs)
• OCE/LBC/lbc_nfd_ext_generic.h90 (modified) (4 diffs)
• OCE/LBC/lbc_nfd_generic.h90 (modified) (4 diffs)
• OCE/LBC/lbc_nfd_nogather_generic.h90 (modified) (4 diffs)
• OCE/LBC/lbclnk.F90 (modified) (1 diff)
• OCE/LBC/lib_mpp.F90 (modified) (6 diffs)
• OCE/LBC/mpp_lbc_north_icb_generic.h90 (modified) (1 diff)
• OCE/LBC/mpp_lnk_generic.h90 (modified) (3 diffs)
• OCE/LBC/mpp_lnk_icb_generic.h90 (modified) (9 diffs)
• OCE/LBC/mpp_nc_generic.h90 (modified) (2 diffs)
• OCE/LBC/mpp_nfd_generic.h90 (modified) (4 diffs)
• OCE/LBC/mppini.F90 (modified) (28 diffs)
• OCE/lib_fortran.F90 (modified) (4 diffs)
• OCE/nemogcm.F90 (modified) (1 diff)
• OCE/par_kind.F90 (modified) (1 diff)
• OCE/par_oce.F90 (modified) (1 diff)
• TOP/oce_trc.F90 (modified) (1 diff)

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/BDY/bdyini.F90

@@ -575 +575 @@
                ! check if point has to be sent     to   a neighbour
                ! W neighbour and on the inner left  side
-               IF( ii == 2     .and. (nbondi == 0 .or. nbondi ==  1) )   lsend_bdy(ib_bdy,igrd,1,ir) = .true.
+               IF( ii == 2     .AND. mpinei(jpwe) > -1 )   lsend_bdy(ib_bdy,igrd,jpwe,ir) = .TRUE.
                ! E neighbour and on the inner right side
-               IF( ii == jpi-1 .and. (nbondi == 0 .or. nbondi == -1) )   lsend_bdy(ib_bdy,igrd,2,ir) = .true.
+               IF( ii == jpi-1 .AND. mpinei(jpea) > -1 )   lsend_bdy(ib_bdy,igrd,jpea,ir) = .TRUE.
                ! S neighbour and on the inner down side
-               IF( ij == 2     .and. (nbondj == 0 .or. nbondj ==  1) )   lsend_bdy(ib_bdy,igrd,3,ir) = .true.
+               IF( ij == 2     .AND. mpinei(jpso) > -1 )   lsend_bdy(ib_bdy,igrd,jpso,ir) = .TRUE.
                ! N neighbour and on the inner up   side
-               IF( ij == jpj-1 .and. (nbondj == 0 .or. nbondj == -1) )   lsend_bdy(ib_bdy,igrd,4,ir) = .true.
+               IF( ij == jpj-1 .AND. mpinei(jpno) > -1 )   lsend_bdy(ib_bdy,igrd,jpno,ir) = .TRUE.
                !
                ! check if point has to be received from a neighbour
                ! W neighbour and on the outter left  side
-               IF( ii == 1     .and. (nbondi == 0 .or. nbondi ==  1) )   lrecv_bdy(ib_bdy,igrd,1,ir) = .true.
+               IF( ii == 1     .AND. mpinei(jpwe) > -1 )   lrecv_bdy(ib_bdy,igrd,jpwe,ir) = .TRUE.
                ! E neighbour and on the outter right side
-               IF( ii == jpi   .and. (nbondi == 0 .or. nbondi == -1) )   lrecv_bdy(ib_bdy,igrd,2,ir) = .true.
+               IF( ii == jpi   .AND. mpinei(jpea) > -1 )   lrecv_bdy(ib_bdy,igrd,jpea,ir) = .TRUE.
                ! S neighbour and on the outter down side
-               IF( ij == 1     .and. (nbondj == 0 .or. nbondj ==  1) )   lrecv_bdy(ib_bdy,igrd,3,ir) = .true.
+               IF( ij == 1     .AND. mpinei(jpso) > -1 )   lrecv_bdy(ib_bdy,igrd,jpso,ir) = .TRUE.
                ! N neighbour and on the outter up   side
-               IF( ij == jpj   .and. (nbondj == 0 .or. nbondj == -1) )   lrecv_bdy(ib_bdy,igrd,4,ir) = .true.
+               IF( ij == jpj   .AND. mpinei(jpno) > -1 )   lrecv_bdy(ib_bdy,igrd,jpno,ir) = .TRUE.
                !
             END DO
@@ -739 +739 @@
                !      <--    (o exterior)     -->  
                ! (1)  o|x         OR    (2)   x|o
-               !       |___                 ___| 
-               IF( iibi == 0     .OR. ii1 == 0     .OR. ii2 == 0     .OR. ii3 == 0     )   lrecv_bdyint(ib_bdy,igrd,1,ir) = .true.
-               IF( iibi == jpi+1 .OR. ii1 == jpi+1 .OR. ii2 == jpi+1 .OR. ii3 == jpi+1 )   lrecv_bdyint(ib_bdy,igrd,2,ir) = .true.  
-               IF( iibe == 0                                                           )   lrecv_bdyext(ib_bdy,igrd,1,ir) = .true.
-               IF( iibe == jpi+1                                                       )   lrecv_bdyext(ib_bdy,igrd,2,ir) = .true.  
+               !       |___                 ___|
+               IF( iibi==0     .OR. ii1==0     .OR. ii2==0     .OR. ii3==0     )   lrecv_bdyint(ib_bdy,igrd,jpwe,ir) = .TRUE.
+               IF( iibi==jpi+1 .OR. ii1==jpi+1 .OR. ii2==jpi+1 .OR. ii3==jpi+1 )   lrecv_bdyint(ib_bdy,igrd,jpea,ir) = .TRUE.  
+               IF( iibe==0                                                     )   lrecv_bdyext(ib_bdy,igrd,jpwe,ir) = .TRUE.
+               IF( iibe==jpi+1                                                 )   lrecv_bdyext(ib_bdy,igrd,jpea,ir) = .TRUE.  
                ! Check if neighbour has its rim parallel to its mpi subdomain border and located next to its halo
                ! :¨¨¨¨¨|¨¨-->    |                                             |    <--¨¨|¨¨¨¨¨: 
                ! :     |  x:o    |    neighbour limited by ... would need o    |    o:x  |     :
                ! :.....|_._:_____|   (1) W neighbour         E neighbour (2)   |_____:_._|.....:
-               IF( ii == 2     .AND. ( nbondi ==  1 .OR. nbondi == 0 ) .AND. &
-                  & ( iibi == 3     .OR. ii1 == 3     .OR. ii2 == 3     .OR. ii3 == 3    ) )   lsend_bdyint(ib_bdy,igrd,1,ir)=.true.
-               IF( ii == jpi-1 .AND. ( nbondi == -1 .OR. nbondi == 0 ) .AND. &
-                  & ( iibi == jpi-2 .OR. ii1 == jpi-2 .OR. ii2 == jpi-2 .OR. ii3 == jpi-2) )   lsend_bdyint(ib_bdy,igrd,2,ir)=.true.
-               IF( ii == 2     .AND. ( nbondi ==  1 .OR. nbondi == 0 ) .AND. iibe == 3     )   lsend_bdyext(ib_bdy,igrd,1,ir)=.true.
-               IF( ii == jpi-1 .AND. ( nbondi == -1 .OR. nbondi == 0 ) .AND. iibe == jpi-2 )   lsend_bdyext(ib_bdy,igrd,2,ir)=.true.
+               IF( ii==2     .AND. mpinei(jpwe) > -1 .AND. &
+                  & ( iibi==3     .OR. ii1==3     .OR. ii2==3     .OR. ii3==3    ) )   lsend_bdyint(ib_bdy,igrd,jpwe,ir) = .TRUE.
+               IF( ii==jpi-1 .AND. mpinei(jpea) > -1 .AND. &
+                  & ( iibi==jpi-2 .OR. ii1==jpi-2 .OR. ii2==jpi-2 .OR. ii3==jpi-2) )   lsend_bdyint(ib_bdy,igrd,jpea,ir) = .TRUE.
+               IF( ii==2     .AND. mpinei(jpwe) > -1             .AND. iibe==3     )   lsend_bdyext(ib_bdy,igrd,jpwe,ir) = .TRUE.
+               IF( ii==jpi-1 .AND. mpinei(jpea) > -1             .AND. iibe==jpi-2 )   lsend_bdyext(ib_bdy,igrd,jpea,ir) = .TRUE.
                !
                ! search neighbour in the north/south direction   
@@ -760 +760 @@
                !  |   |___x___|   OR    |  |   x   |
                !  v       o           (4)  |       |
-               IF( ijbi == 0     .OR. ij1 == 0     .OR. ij2 == 0     .OR. ij3 == 0     )   lrecv_bdyint(ib_bdy,igrd,3,ir) = .true.
-               IF( ijbi == jpj+1 .OR. ij1 == jpj+1 .OR. ij2 == jpj+1 .OR. ij3 == jpj+1 )   lrecv_bdyint(ib_bdy,igrd,4,ir) = .true.
-               IF( ijbe == 0                                                           )   lrecv_bdyext(ib_bdy,igrd,3,ir) = .true.
-               IF( ijbe == jpj+1                                                       )   lrecv_bdyext(ib_bdy,igrd,4,ir) = .true.
+               IF( ijbi==0     .OR. ij1==0     .OR. ij2==0     .OR. ij3==0     )   lrecv_bdyint(ib_bdy,igrd,jpso,ir) = .TRUE.
+               IF( ijbi==jpj+1 .OR. ij1==jpj+1 .OR. ij2==jpj+1 .OR. ij3==jpj+1 )   lrecv_bdyint(ib_bdy,igrd,jpno,ir) = .TRUE.
+               IF( ijbe==0                                                     )   lrecv_bdyext(ib_bdy,igrd,jpso,ir) = .TRUE.
+               IF( ijbe==jpj+1                                                 )   lrecv_bdyext(ib_bdy,igrd,jpno,ir) = .TRUE.
                ! Check if neighbour has its rim parallel to its mpi subdomain     _________  border and next to its halo
                !   ^  |    o    |                                                :         : 
                !   |  |¨¨¨¨x¨¨¨¨|   neighbour limited by ... would need o     |  |....x....|
                !      :_________:  (3) S neighbour          N neighbour (4)   v  |    o    |   
-               IF( ij == 2     .AND. ( nbondj ==  1 .OR. nbondj == 0 ) .AND. &
-                  & ( ijbi == 3     .OR. ij1 == 3     .OR. ij2 == 3     .OR. ij3 == 3    ) )   lsend_bdyint(ib_bdy,igrd,3,ir)=.true.
-               IF( ij == jpj-1 .AND. ( nbondj == -1 .OR. nbondj == 0 ) .AND. &
-                  & ( ijbi == jpj-2 .OR. ij1 == jpj-2 .OR. ij2 == jpj-2 .OR. ij3 == jpj-2) )   lsend_bdyint(ib_bdy,igrd,4,ir)=.true.
-               IF( ij == 2     .AND. ( nbondj ==  1 .OR. nbondj == 0 ) .AND. ijbe == 3     )   lsend_bdyext(ib_bdy,igrd,3,ir)=.true.
-               IF( ij == jpj-1 .AND. ( nbondj == -1 .OR. nbondj == 0 ) .AND. ijbe == jpj-2 )   lsend_bdyext(ib_bdy,igrd,4,ir)=.true.
+               IF( ij==2     .AND. mpinei(jpso) > -1 .AND. &
+                  & ( ijbi==3     .OR. ij1==3     .OR. ij2==3     .OR. ij3==3    ) )   lsend_bdyint(ib_bdy,igrd,jpso,ir) = .TRUE.
+               IF( ij==jpj-1 .AND. mpinei(jpno) > -1 .AND. &
+                  & ( ijbi==jpj-2 .OR. ij1==jpj-2 .OR. ij2==jpj-2 .OR. ij3==jpj-2) )   lsend_bdyint(ib_bdy,igrd,jpno,ir) = .TRUE.
+               IF( ij==2     .AND. mpinei(jpso) > -1             .AND. ijbe==3     )   lsend_bdyext(ib_bdy,igrd,jpso,ir) = .TRUE.
+               IF( ij==jpj-1 .AND. mpinei(jpno) > -1             .AND. ijbe==jpj-2 )   lsend_bdyext(ib_bdy,igrd,jpno,ir) = .TRUE.
             END DO
          END DO

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/CRS/crs.F90

@@ -32 +32 @@
       INTEGER  ::  jpi_crsm1, jpj_crsm1         !: loop indices      
       INTEGER  ::  jpiglo_crsm1, jpjglo_crsm1   !: loop indices      
-      INTEGER  ::  nperio_full, nperio_crs      !: jperio of parent and coarse grids
-      INTEGER  ::  npolj_full, npolj_crs        !: north fold mark
+!!$      INTEGER  ::  nperio_full, nperio_crs      !: jperio of parent and coarse grids
+!!$      INTEGER  ::  npolj_full, npolj_crs        !: north fold mark
       INTEGER  ::  jpiglo_full, jpjglo_full     !: jpiglo / jpjglo
       INTEGER  ::  npiglo, npjglo               !: jpjglo
@@ -46 +46 @@
       INTEGER  ::  nimpp_full, njmpp_full       !: global position of point (1,1) of subdomain on parent grid
       INTEGER  ::  nimpp_crs, njmpp_crs         !: set to 1,1 for now .  Valid only for monoproc
-      !cc
-      INTEGER ::   noea_full, nowe_full        !: index of the local neighboring processors in
-      INTEGER ::   noso_full, nono_full        !: east, west, south and north directions
-      INTEGER ::   npne_full, npnw_full        !: index of north east and north west processor
-      INTEGER ::   npse_full, npsw_full        !: index of south east and south west processor
-      INTEGER ::   nbne_full, nbnw_full        !: logical of north east & north west processor
-      INTEGER ::   nbse_full, nbsw_full        !: logical of south east & south west processor
-      INTEGER ::   nidom_full                  !: ???
-      INTEGER ::   nproc_full                  !:number for local processor
-      INTEGER ::   nbondi_full, nbondj_full    !: mark of i- and j-direction local boundaries
-      INTEGER ::   noea_crs, nowe_crs          !: index of the local neighboring processors in
-      INTEGER ::   noso_crs, nono_crs          !: east, west, south and north directions
-      INTEGER ::   npne_crs, npnw_crs          !: index of north east and north west processor
-      INTEGER ::   npse_crs, npsw_crs          !: index of south east and south west processor
-      INTEGER ::   nbne_crs, nbnw_crs          !: logical of north east & north west processor
-      INTEGER ::   nbse_crs, nbsw_crs          !: logical of south east & south west processor
-      INTEGER ::   nidom_crs                   !: ???
-      INTEGER ::   nproc_crs                   !:number for local processor
-      INTEGER ::   nbondi_crs, nbondj_crs      !: mark of i- and j-direction local boundaries
-      
-
+     
       INTEGER, DIMENSION(:), ALLOCATABLE :: mis_crs, mie_crs, mis2_crs, mie2_crs  ! starting and ending i-indices of parent subset
       INTEGER, DIMENSION(:), ALLOCATABLE :: mjs_crs, mje_crs, mjs2_crs, mje2_crs ! starting and ending  j-indices of parent subset
@@ -72 +52 @@
       INTEGER, DIMENSION(:), ALLOCATABLE :: mi0_crs, mi1_crs, mj0_crs, mj1_crs
       INTEGER  :: mxbinctr, mybinctr            ! central point in grid box
-      INTEGER, DIMENSION(:), ALLOCATABLE ::    jpiall_crs,  jpiall_full   !: dimensions of every subdomain
-      INTEGER, DIMENSION(:), ALLOCATABLE ::   nis0all_crs, nis0all_full   !: first, last indoor index for each i-domain
-      INTEGER, DIMENSION(:), ALLOCATABLE ::   nie0all_crs, nie0all_full   !: first, last indoor index for each j-domain
-      INTEGER, DIMENSION(:), ALLOCATABLE ::    nimppt_crs,  nimppt_full   !: first, last indoor index for each j-domain
-      INTEGER, DIMENSION(:), ALLOCATABLE ::    jpjall_crs,  jpjall_full   !: dimensions of every subdomain
-      INTEGER, DIMENSION(:), ALLOCATABLE ::   njs0all_crs, njs0all_full   !: first, last indoor index for each i-domain
-      INTEGER, DIMENSION(:), ALLOCATABLE ::   nje0all_crs, nje0all_full   !: first, last indoor index for each j-domain
-      INTEGER, DIMENSION(:), ALLOCATABLE ::    njmppt_crs,  njmppt_full   !: first, last indoor index for each j-domain
+!!$      INTEGER, DIMENSION(:), ALLOCATABLE ::    jpiall_crs,  jpiall_full   !: dimensions of every subdomain
+!!$      INTEGER, DIMENSION(:), ALLOCATABLE ::   nis0all_crs, nis0all_full   !: first, last indoor index for each i-domain
+!!$      INTEGER, DIMENSION(:), ALLOCATABLE ::   nie0all_crs, nie0all_full   !: first, last indoor index for each j-domain
+!!$      INTEGER, DIMENSION(:), ALLOCATABLE ::    nimppt_crs,  nimppt_full   !: first, last indoor index for each j-domain
+!!$      INTEGER, DIMENSION(:), ALLOCATABLE ::    jpjall_crs,  jpjall_full   !: dimensions of every subdomain
+!!$      INTEGER, DIMENSION(:), ALLOCATABLE ::   njs0all_crs, njs0all_full   !: first, last indoor index for each i-domain
+!!$      INTEGER, DIMENSION(:), ALLOCATABLE ::   nje0all_crs, nje0all_full   !: first, last indoor index for each j-domain
+!!$      INTEGER, DIMENSION(:), ALLOCATABLE ::    njmppt_crs,  njmppt_full   !: first, last indoor index for each j-domain
 
  
@@ -231 +211 @@
          &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) )
          
-      ALLOCATE( nimppt_crs (jpnij) , jpiall_crs (jpnij) , nis0all_crs (jpnij) , nie0all_crs (jpnij),   &
-         &      nimppt_full(jpnij) , jpiall_full(jpnij) , nis0all_full(jpnij) , nie0all_full(jpnij),   &
-                njmppt_crs (jpnij) , jpjall_crs (jpnij) , njs0all_crs (jpnij) , nje0all_crs (jpnij),   &
-         &      njmppt_full(jpnij) , jpjall_full(jpnij) , njs0all_full(jpnij) , nje0all_full(jpnij)  , STAT=ierr(15) )
+!!$      ALLOCATE( nimppt_crs (jpnij) , jpiall_crs (jpnij) , nis0all_crs (jpnij) , nie0all_crs (jpnij),   &
+!!$         &      nimppt_full(jpnij) , jpiall_full(jpnij) , nis0all_full(jpnij) , nie0all_full(jpnij),   &
+!!$                njmppt_crs (jpnij) , jpjall_crs (jpnij) , njs0all_crs (jpnij) , nje0all_crs (jpnij),   &
+!!$         &      njmppt_full(jpnij) , jpjall_full(jpnij) , njs0all_full(jpnij) , nje0all_full(jpnij)  , STAT=ierr(15) )
    
       crs_dom_alloc = MAXVAL(ierr)
@@ -269 +249 @@
       jpim1  = jpim1_full
       jpjm1  = jpjm1_full
-      jperio = nperio_full
-
-      npolj  = npolj_full
+!!$      jperio = nperio_full
+
+!!$      npolj  = npolj_full
       jpiglo = jpiglo_full
       jpjglo = jpjglo_full
@@ -284 +264 @@
       njmpp = njmpp_full
       
-      jpiall (:) = jpiall_full (:)
-      nis0all(:) = nis0all_full(:)
-      nie0all(:) = nie0all_full(:)
-      nimppt (:) = nimppt_full (:)
-      jpjall (:) = jpjall_full (:)
-      njs0all(:) = njs0all_full(:)
-      nje0all(:) = nje0all_full(:)
-      njmppt (:) = njmppt_full (:)
+!!$      jpiall (:) = jpiall_full (:)
+!!$      nis0all(:) = nis0all_full(:)
+!!$      nie0all(:) = nie0all_full(:)
+!!$      nimppt (:) = nimppt_full (:)
+!!$      jpjall (:) = jpjall_full (:)
+!!$      njs0all(:) = njs0all_full(:)
+!!$      nje0all(:) = nje0all_full(:)
+!!$      njmppt (:) = njmppt_full (:)
 
    END SUBROUTINE dom_grid_glo
@@ -308 +288 @@
       jpim1  = jpi_crsm1
       jpjm1  = jpj_crsm1
-      jperio = nperio_crs
-
-      npolj  = npolj_crs
+!!$      jperio = nperio_crs
+
+!!$      npolj  = npolj_crs
       jpiglo = jpiglo_crs
       jpjglo = jpjglo_crs
@@ -324 +304 @@
       njmpp = njmpp_crs
       
-      jpiall (:) = jpiall_crs (:)
-      nis0all(:) = nis0all_crs(:)
-      nie0all(:) = nie0all_crs(:)
-      nimppt (:) = nimppt_crs (:)
-      jpjall (:) = jpjall_crs (:)
-      njs0all(:) = njs0all_crs(:)
-      nje0all(:) = nje0all_crs(:)
-      njmppt (:) = njmppt_crs (:)
+!!$      jpiall (:) = jpiall_crs (:)
+!!$      nis0all(:) = nis0all_crs(:)
+!!$      nie0all(:) = nie0all_crs(:)
+!!$      nimppt (:) = nimppt_crs (:)
+!!$      jpjall (:) = jpjall_crs (:)
+!!$      njs0all(:) = njs0all_crs(:)
+!!$      nje0all(:) = nje0all_crs(:)
+!!$      njmppt (:) = njmppt_crs (:)
       !
    END SUBROUTINE dom_grid_crs

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/CRS/crsdom.F90

@@ -1877 +1877 @@
  
   
-     ! 1.a. Define global domain indices  : take into account the interior domain only ( removes i/j=1 , i/j=jpiglo/jpjglo ) then add 2/3 grid points 
-      jpiglo_crs   = INT( (jpiglo - 2) / nn_factx ) + 2
-  !    jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 2  ! the -2 removes j=1, j=jpj
-  !    jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 3
-      jpjglo_crs   = INT( (jpjglo - MOD(jpjglo, nn_facty)) / nn_facty ) + 3
-      jpiglo_crsm1 = jpiglo_crs - 1
-      jpjglo_crsm1 = jpjglo_crs - 1  
-
-      jpi_crs = ( jpiglo_crs   - 2 * nn_hls + (jpni-1) ) / jpni + 2 * nn_hls
-      jpj_crs = ( jpjglo_crsm1 - 2 * nn_hls + (jpnj-1) ) / jpnj + 2 * nn_hls   
-              
-      IF( noso < 0 ) jpj_crs = jpj_crs + 1    ! add a local band on southern processors  
-       
-      jpi_crsm1   = jpi_crs - 1
-      jpj_crsm1   = jpj_crs - 1
-      nperio_crs  = jperio
-      npolj_crs   = npolj
-      
-      ierr = crs_dom_alloc()          ! allocate most coarse grid arrays
-
-      ! 2.a Define processor domain
-      IF( .NOT. lk_mpp ) THEN
-         nimpp_crs = 1
-         njmpp_crs = 1
-         Nis0_crs  = 1
-         Njs0_crs  = 1
-         Nie0_crs  = jpi_crs
-         Nje0_crs  = jpj_crs
-      ELSE
-         ! Initialisation of most local variables -
-         nimpp_crs = 1
-         njmpp_crs = 1
-         Nis0_crs  = 1
-         Njs0_crs  = 1
-         Nie0_crs  = jpi_crs
-         Nje0_crs  = jpj_crs
-         
-        ! Calculs suivant une découpage en j
-        DO jn = 1, jpnij, jpni
-           IF( jn < ( jpnij - jpni + 1 ) ) THEN
-              nje0all_crs(jn) = AINT( REAL( ( jpjglo - (njmppt(jn     ) - 1) ) / nn_facty, wp ) ) &
-                       &    - AINT( REAL( ( jpjglo - (njmppt(jn+jpni) - 1) ) / nn_facty, wp ) )
-           ELSE                                             
-              nje0all_crs(jn) = AINT( REAL(  nje0all(jn) / nn_facty, wp ) ) + 1            
-           ENDIF
-           IF( noso < 0 ) nje0all_crs(jn) = nje0all_crs(jn) + 1             
-           SELECT CASE( ibonjt(jn) )
-              CASE ( -1 )
-                IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )  nje0all_crs(jn) = nje0all_crs(jn) + 1
-                jpjall_crs (jn) = nje0all_crs(jn) + nn_hls
-                njs0all_crs(jn) = njs0all(jn)
-              
-              CASE ( 0 )
-              
-                njs0all_crs(jn) = njs0all(jn)
-                IF( njs0all(jn) == 1 )  nje0all_crs(jn) = nje0all_crs(jn) + 1
-                nje0all_crs(jn) = nje0all_crs(jn) + nn_hls
-                jpjall_crs (jn) = nje0all_crs(jn) + nn_hls
-                
-              CASE ( 1, 2 )
-              
-                nje0all_crs(jn) = nje0all_crs(jn) + nn_hls
-                jpjall_crs (jn) = nje0all_crs(jn)
-                njs0all_crs(jn) = njs0all(jn)
-                
-              CASE DEFAULT
-                 CALL ctl_stop( 'STOP', 'error from crs_dom_def, you should not be there (1) ...' )
-           END SELECT
-           IF( jpjall_crs(jn) > jpj_crs )     jpj_crs = jpj_crs + 1
-
-           IF(njs0all_crs(jn) == 1 ) THEN
-              njmppt_crs(jn) = 1
-           ELSE
-              njmppt_crs(jn) = 2 + ANINT(REAL((njmppt(jn) + 1 - MOD( jpjglo , nn_facty )) / nn_facty, wp ) )
-           ENDIF           
-           
-           DO jj = jn + 1, jn + jpni - 1
-              nje0all_crs(jj) = nje0all_crs(jn) 
-              jpjall_crs (jj) = jpjall_crs(jn)
-              njs0all_crs(jj) = njs0all_crs(jn)
-              njmppt_crs (jj) = njmppt_crs(jn)
-           ENDDO
-        ENDDO 
-        Nje0_crs  = nje0all_crs(narea) 
-        jpj_crs   = jpjall_crs (narea)
-        Njs0_crs  = njs0all_crs(narea)
-        njmpp_crs = njmppt_crs (narea)
-
-        ! Calcul suivant un decoupage en i
-        DO jn = 1, jpni
-           IF( jn == 1 ) THEN          
-              nie0all_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + jpiall(jn  ) )  / nn_factx, wp) )
-           ELSE
-              nie0all_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + jpiall(jn  ) )  / nn_factx, wp) ) &
-                 &            - AINT( REAL( ( nimppt(jn-1) - 1 + jpiall(jn-1) )  / nn_factx, wp) )
-           ENDIF
-
-           SELECT CASE( ibonit(jn) )
-              CASE ( -1 )
-                 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls           
-                 jpiall_crs (jn) = nie0all_crs(jn) + nn_hls
-                 nis0all_crs(jn) = nis0all(jn) 
-              
-              CASE ( 0 )
-                 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls
-                 jpiall_crs (jn) = nie0all_crs(jn) + nn_hls
-                 nis0all_crs(jn) = nis0all(jn) 
-                
-              CASE ( 1, 2 )
-                 IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 )  nie0all_crs(jn) = nie0all_crs(jn) + 1
-                 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls
-                 jpiall_crs (jn) = nie0all_crs(jn)
-                 nis0all_crs(jn) = nis0all(jn) 
-
-              CASE DEFAULT
-                 CALL ctl_stop( 'STOP', 'error from crs_dom_def, you should not be there (2) ...' )
-           END SELECT
-
-           nimppt_crs(jn) = ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 1
-           DO jj = jn + jpni , jpnij, jpni
-              nie0all_crs(jj) = nie0all_crs(jn) 
-              jpiall_crs (jj) = jpiall_crs (jn)
-              nis0all_crs(jj) = nis0all_crs(jn)
-              nimppt_crs (jj) = nimppt_crs (jn)
-           ENDDO
-         ENDDO 
-        
-         Nie0_crs  = nie0all_crs(narea) 
-         jpi_crs   = jpiall_crs (narea)
-         Nis0_crs  = nis0all_crs(narea)
-         nimpp_crs = nimppt_crs (narea)
-
-         DO ji = 1, jpi_crs
-            mig_crs(ji) = ji + nimpp_crs - 1
-         ENDDO
-         DO jj = 1, jpj_crs
-            mjg_crs(jj) = jj + njmpp_crs - 1!
-         ENDDO
-       
-         DO ji = 1, jpiglo_crs
-            mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) )
-            mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs     ) )
-         ENDDO
-         
-         DO jj = 1, jpjglo_crs
-            mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) )
-            mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs     ) )
-         ENDDO
-
-      ENDIF
-      
-      !                         Save the parent grid information
-      jpi_full    = jpi
-      jpj_full    = jpj
-      jpim1_full  = jpim1
-      jpjm1_full  = jpjm1
-      nperio_full = jperio
-
-      npolj_full  = npolj
-      jpiglo_full = jpiglo
-      jpjglo_full = jpjglo
-
-      jpj_full   = jpj
-      jpi_full   = jpi
-      Nis0_full  = Nis0
-      Njs0_full  = Njs0
-      Nie0_full  = Nie0
-      Nje0_full  = Nje0
-      nimpp_full = nimpp     
-      njmpp_full = njmpp
-      
-      jpiall_full (:) = jpiall (:)
-      nis0all_full(:) = nis0all(:)
-      nie0all_full(:) = nie0all(:)
-      nimppt_full (:) = nimppt (:)
-      jpjall_full (:) = jpjall (:)
-      njs0all_full(:) = njs0all(:)
-      nje0all_full(:) = nje0all(:)
-      njmppt_full (:) = njmppt (:)
+!!$     ! 1.a. Define global domain indices  : take into account the interior domain only ( removes i/j=1 , i/j=jpiglo/jpjglo ) then add 2/3 grid points 
+!!$      jpiglo_crs   = INT( (jpiglo - 2) / nn_factx ) + 2
+!!$  !    jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 2  ! the -2 removes j=1, j=jpj
+!!$  !    jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 3
+!!$      jpjglo_crs   = INT( (jpjglo - MOD(jpjglo, nn_facty)) / nn_facty ) + 3
+!!$      jpiglo_crsm1 = jpiglo_crs - 1
+!!$      jpjglo_crsm1 = jpjglo_crs - 1  
+!!$
+!!$      jpi_crs = ( jpiglo_crs   - 2 * nn_hls + (jpni-1) ) / jpni + 2 * nn_hls
+!!$      jpj_crs = ( jpjglo_crsm1 - 2 * nn_hls + (jpnj-1) ) / jpnj + 2 * nn_hls   
+!!$              
+!!$      IF( noso < 0 ) jpj_crs = jpj_crs + 1    ! add a local band on southern processors  
+!!$       
+!!$      jpi_crsm1   = jpi_crs - 1
+!!$      jpj_crsm1   = jpj_crs - 1
+!!$      nperio_crs  = jperio
+!!$      npolj_crs   = npolj
+!!$      
+!!$      ierr = crs_dom_alloc()          ! allocate most coarse grid arrays
+!!$
+!!$      ! 2.a Define processor domain
+!!$      IF( .NOT. lk_mpp ) THEN
+!!$         nimpp_crs = 1
+!!$         njmpp_crs = 1
+!!$         Nis0_crs  = 1
+!!$         Njs0_crs  = 1
+!!$         Nie0_crs  = jpi_crs
+!!$         Nje0_crs  = jpj_crs
+!!$      ELSE
+!!$         ! Initialisation of most local variables -
+!!$         nimpp_crs = 1
+!!$         njmpp_crs = 1
+!!$         Nis0_crs  = 1
+!!$         Njs0_crs  = 1
+!!$         Nie0_crs  = jpi_crs
+!!$         Nje0_crs  = jpj_crs
+!!$         
+!!$        ! Calculs suivant une découpage en j
+!!$        DO jn = 1, jpnij, jpni
+!!$           IF( jn < ( jpnij - jpni + 1 ) ) THEN
+!!$              nje0all_crs(jn) = AINT( REAL( ( jpjglo - (njmppt(jn     ) - 1) ) / nn_facty, wp ) ) &
+!!$                       &    - AINT( REAL( ( jpjglo - (njmppt(jn+jpni) - 1) ) / nn_facty, wp ) )
+!!$           ELSE                                             
+!!$              nje0all_crs(jn) = AINT( REAL(  nje0all(jn) / nn_facty, wp ) ) + 1            
+!!$           ENDIF
+!!$           IF( noso < 0 ) nje0all_crs(jn) = nje0all_crs(jn) + 1             
+!!$           SELECT CASE( ibonjt(jn) )
+!!$              CASE ( -1 )
+!!$                IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )  nje0all_crs(jn) = nje0all_crs(jn) + 1
+!!$                jpjall_crs (jn) = nje0all_crs(jn) + nn_hls
+!!$                njs0all_crs(jn) = njs0all(jn)
+!!$              
+!!$              CASE ( 0 )
+!!$              
+!!$                njs0all_crs(jn) = njs0all(jn)
+!!$                IF( njs0all(jn) == 1 )  nje0all_crs(jn) = nje0all_crs(jn) + 1
+!!$                nje0all_crs(jn) = nje0all_crs(jn) + nn_hls
+!!$                jpjall_crs (jn) = nje0all_crs(jn) + nn_hls
+!!$                
+!!$              CASE ( 1, 2 )
+!!$              
+!!$                nje0all_crs(jn) = nje0all_crs(jn) + nn_hls
+!!$                jpjall_crs (jn) = nje0all_crs(jn)
+!!$                njs0all_crs(jn) = njs0all(jn)
+!!$                
+!!$              CASE DEFAULT
+!!$                 CALL ctl_stop( 'STOP', 'error from crs_dom_def, you should not be there (1) ...' )
+!!$           END SELECT
+!!$           IF( jpjall_crs(jn) > jpj_crs )     jpj_crs = jpj_crs + 1
+!!$
+!!$           IF(njs0all_crs(jn) == 1 ) THEN
+!!$              njmppt_crs(jn) = 1
+!!$           ELSE
+!!$              njmppt_crs(jn) = 2 + ANINT(REAL((njmppt(jn) + 1 - MOD( jpjglo , nn_facty )) / nn_facty, wp ) )
+!!$           ENDIF           
+!!$           
+!!$           DO jj = jn + 1, jn + jpni - 1
+!!$              nje0all_crs(jj) = nje0all_crs(jn) 
+!!$              jpjall_crs (jj) = jpjall_crs(jn)
+!!$              njs0all_crs(jj) = njs0all_crs(jn)
+!!$              njmppt_crs (jj) = njmppt_crs(jn)
+!!$           ENDDO
+!!$        ENDDO 
+!!$        Nje0_crs  = nje0all_crs(narea) 
+!!$        jpj_crs   = jpjall_crs (narea)
+!!$        Njs0_crs  = njs0all_crs(narea)
+!!$        njmpp_crs = njmppt_crs (narea)
+!!$
+!!$        ! Calcul suivant un decoupage en i
+!!$        DO jn = 1, jpni
+!!$           IF( jn == 1 ) THEN          
+!!$              nie0all_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + jpiall(jn  ) )  / nn_factx, wp) )
+!!$           ELSE
+!!$              nie0all_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + jpiall(jn  ) )  / nn_factx, wp) ) &
+!!$                 &            - AINT( REAL( ( nimppt(jn-1) - 1 + jpiall(jn-1) )  / nn_factx, wp) )
+!!$           ENDIF
+!!$
+!!$           SELECT CASE( ibonit(jn) )
+!!$              CASE ( -1 )
+!!$                 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls           
+!!$                 jpiall_crs (jn) = nie0all_crs(jn) + nn_hls
+!!$                 nis0all_crs(jn) = nis0all(jn) 
+!!$              
+!!$              CASE ( 0 )
+!!$                 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls
+!!$                 jpiall_crs (jn) = nie0all_crs(jn) + nn_hls
+!!$                 nis0all_crs(jn) = nis0all(jn) 
+!!$                
+!!$              CASE ( 1, 2 )
+!!$                 IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 )  nie0all_crs(jn) = nie0all_crs(jn) + 1
+!!$                 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls
+!!$                 jpiall_crs (jn) = nie0all_crs(jn)
+!!$                 nis0all_crs(jn) = nis0all(jn) 
+!!$
+!!$              CASE DEFAULT
+!!$                 CALL ctl_stop( 'STOP', 'error from crs_dom_def, you should not be there (2) ...' )
+!!$           END SELECT
+!!$
+!!$           nimppt_crs(jn) = ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 1
+!!$           DO jj = jn + jpni , jpnij, jpni
+!!$              nie0all_crs(jj) = nie0all_crs(jn) 
+!!$              jpiall_crs (jj) = jpiall_crs (jn)
+!!$              nis0all_crs(jj) = nis0all_crs(jn)
+!!$              nimppt_crs (jj) = nimppt_crs (jn)
+!!$           ENDDO
+!!$         ENDDO 
+!!$        
+!!$         Nie0_crs  = nie0all_crs(narea) 
+!!$         jpi_crs   = jpiall_crs (narea)
+!!$         Nis0_crs  = nis0all_crs(narea)
+!!$         nimpp_crs = nimppt_crs (narea)
+!!$
+!!$         DO ji = 1, jpi_crs
+!!$            mig_crs(ji) = ji + nimpp_crs - 1
+!!$         ENDDO
+!!$         DO jj = 1, jpj_crs
+!!$            mjg_crs(jj) = jj + njmpp_crs - 1!
+!!$         ENDDO
+!!$       
+!!$         DO ji = 1, jpiglo_crs
+!!$            mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) )
+!!$            mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs     ) )
+!!$         ENDDO
+!!$         
+!!$         DO jj = 1, jpjglo_crs
+!!$            mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) )
+!!$            mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs     ) )
+!!$         ENDDO
+!!$
+!!$      ENDIF
+!!$      
+!!$      !                         Save the parent grid information
+!!$      jpi_full    = jpi
+!!$      jpj_full    = jpj
+!!$      jpim1_full  = jpim1
+!!$      jpjm1_full  = jpjm1
+!!$      nperio_full = jperio
+!!$
+!!$      npolj_full  = npolj
+!!$      jpiglo_full = jpiglo
+!!$      jpjglo_full = jpjglo
+!!$
+!!$      jpj_full   = jpj
+!!$      jpi_full   = jpi
+!!$      Nis0_full  = Nis0
+!!$      Njs0_full  = Njs0
+!!$      Nie0_full  = Nie0
+!!$      Nje0_full  = Nje0
+!!$      nimpp_full = nimpp     
+!!$      njmpp_full = njmpp
+!!$      
+!!$      jpiall_full (:) = jpiall (:)
+!!$      nis0all_full(:) = nis0all(:)
+!!$      nie0all_full(:) = nie0all(:)
+!!$      nimppt_full (:) = nimppt (:)
+!!$      jpjall_full (:) = jpjall (:)
+!!$      njs0all_full(:) = njs0all(:)
+!!$      nje0all_full(:) = nje0all(:)
+!!$      njmppt_full (:) = njmppt (:)
       
       CALL dom_grid_crs  !swich de grille
@@ -2097 +2097 @@
       IF ( nresty == 0 ) THEN
          mybinctr = mybinctr - 1
-         IF ( jperio == 3 .OR. jperio == 4 )  nperio_crs = jperio + 2
-         IF ( jperio == 5 .OR. jperio == 6 )  nperio_crs = jperio - 2 
-
-         IF ( npolj == 3 ) npolj_crs = 5
-         IF ( npolj == 5 ) npolj_crs = 3
+!!$         IF ( jperio == 3 .OR. jperio == 4 )  nperio_crs = jperio + 2
+!!$         IF ( jperio == 5 .OR. jperio == 6 )  nperio_crs = jperio - 2 
+!!$
+!!$         IF ( npolj == 3 ) npolj_crs = 5
+!!$         IF ( npolj == 5 ) npolj_crs = 3
       ENDIF     
       

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DOM/dom_oce.F90

@@ -73 +73 @@
    !                                !  = 7 bi-cyclic East-West AND North-South
    LOGICAL, PUBLIC ::   l_Iperio, l_Jperio   !   should we explicitely take care I/J periodicity
+   LOGICAL, PUBLIC ::   l_NFoldT, l_NFoldF
 
    ! Tiling namelist
@@ -85 +86 @@
 
    !                             !: domain MPP decomposition parameters
-   INTEGER             , PUBLIC ::   nimpp, njmpp     !: i- & j-indexes for mpp-subdomain left bottom
-   INTEGER             , PUBLIC ::   narea            !: number for local area = MPI rank + 1
-   INTEGER             , PUBLIC ::   nbondi, nbondj   !: mark of i- and j-direction local boundaries
-   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy(:)    !: mark i-direction local boundaries for BDY open boundaries
-   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy(:)    !: mark j-direction local boundaries for BDY open boundaries
-   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy_b(:)  !: mark i-direction of neighbours local boundaries for BDY open boundaries
-   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy_b(:)  !: mark j-direction of neighbours local boundaries for BDY open boundaries
-
-   INTEGER, PUBLIC ::   npolj             !: north fold mark (0, 3 or 4)
-   INTEGER, PUBLIC ::   noea, nowe        !: index of the local neighboring processors in
-   INTEGER, PUBLIC ::   noso, nono        !: east, west, south and north directions
-   INTEGER, PUBLIC ::   nones, nonws        !: north-east, north-west directions for sending
-   INTEGER, PUBLIC ::   noses, nosws        !: south-east, south-west directions for sending
-   INTEGER, PUBLIC ::   noner, nonwr        !: north-east, north-west directions for receiving
-   INTEGER, PUBLIC ::   noser, noswr        !: south-east, south-west directions for receiving
-   INTEGER, PUBLIC ::   nidom             !: ???
+   INTEGER              , PUBLIC ::   nimpp, njmpp     !: i- & j-indexes for mpp-subdomain left bottom
+   INTEGER              , PUBLIC ::   narea            !: number for local area (starting at 1) = MPI rank + 1
+   INTEGER,               PUBLIC ::   nidom      !: IOIPSL things...
 
    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mig        !: local ==> global domain, including halos (jpiglo), i-index
@@ -110 +98 @@
    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mj0, mj1   !: global, including halos (jpjglo) ==> local domain j-index
    !                                                                !:    (mj0=1 and mj1=0 if global index not in local domain)
-   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimppt,  njmppt   !: i-, j-indexes for each processor
-   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ibonit,  ibonjt   !: i-, j- processor neighbour existence
-   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   jpiall,  jpjall   !: dimensions of all subdomain
-   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nis0all, njs0all  !: first, last indoor index for all i-subdomain
-   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nie0all, nje0all  !: first, last indoor index for all j-subdomain
    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nfimpp, nfproc, nfjpi
 

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ICB/icbini.F90

@@ -189 +189 @@
       
       ! north fold
-      IF( npolj > 0 ) THEN
+      IF( l_NFoldT .OR.  l_NFoldF ) THEN
          !
          ! icebergs in row nicbej+1 get passed across fold
@@ -235 +235 @@
          WRITE(numicb,*) "j point"
          WRITE(numicb,*) (INT(src_calving(ji,jj)), jj=1,jpj)
-         IF( npolj > 0 ) THEN
+         IF( l_NFoldT .OR. l_NFoldF ) THEN
             WRITE(numicb,*) 'north fold destination points '
             WRITE(numicb,*) nicbfldpts

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ICB/icblbc.F90

@@ -105 +105 @@
       IF( l_Jperio)      CALL ctl_stop(' north-south periodicity not implemented for icebergs')
       ! north fold
-      IF( npolj /= 0 )   CALL icb_lbc_nfld()
+      IF( l_NFoldT .OR. l_NFoldF )   CALL icb_lbc_nfld()
       !
    END SUBROUTINE icb_lbc
@@ -179 +179 @@
       ipe_W = -1
       ipe_E = -1
-      IF( nbondi .EQ.  0 .OR. nbondi .EQ. 1) ipe_W = nowe
-      IF( nbondi .EQ. -1 .OR. nbondi .EQ. 0) ipe_E = noea
-      IF( nbondj .EQ.  0 .OR. nbondj .EQ. 1) ipe_S = noso
-      IF( nbondj .EQ. -1 .OR. nbondj .EQ. 0) ipe_N = nono
+      IF( mpinei(jpwe) >= 0 ) ipe_W = mpinei(jpwe)
+      IF( mpinei(jpea) >= 0 ) ipe_E = mpinei(jpea)
+      IF( mpinei(jpso) >= 0 ) ipe_S = mpinei(jpso)
+      IF( mpinei(jpno) >= 0 ) ipe_N = mpinei(jpno)
       !
       ! at northern line of processors with north fold handle bergs differently
-      IF( npolj > 0 ) ipe_N = -1
+      IF( l_NFoldT .OR. l_NFoldF )   ipe_N = -1
 
       ! if there's only one processor in x direction then don't let mpp try to handle periodicity
@@ -200 +200 @@
          WRITE(numicb,*) 'processor nimpp : ', nimpp
          WRITE(numicb,*) 'processor njmpp : ', njmpp
-         WRITE(numicb,*) 'processor nbondi: ', nbondi
-         WRITE(numicb,*) 'processor nbondj: ', nbondj
          CALL flush( numicb )
       ENDIF
@@ -271 +269 @@
       ! pattern here is copied from lib_mpp code
 
-      SELECT CASE ( nbondi )
-      CASE( -1 )
-         zwebergs(1) = ibergs_to_send_e
-         CALL mppsend( 12, zwebergs(1), 1, ipe_E, iml_req1)
-         CALL mpprecv( 11, zewbergs(2), 1, ipe_E )
-         CALL mpi_wait( iml_req1, iml_stat, iml_err )
-         ibergs_rcvd_from_e = INT( zewbergs(2) )
-      CASE(  0 )
-         zewbergs(1) = ibergs_to_send_w
-         zwebergs(1) = ibergs_to_send_e
-         CALL mppsend( 11, zewbergs(1), 1, ipe_W, iml_req2)
-         CALL mppsend( 12, zwebergs(1), 1, ipe_E, iml_req3)
-         CALL mpprecv( 11, zewbergs(2), 1, ipe_E )
-         CALL mpprecv( 12, zwebergs(2), 1, ipe_W )
-         CALL mpi_wait( iml_req2, iml_stat, iml_err )
-         CALL mpi_wait( iml_req3, iml_stat, iml_err )
-         ibergs_rcvd_from_e = INT( zewbergs(2) )
-         ibergs_rcvd_from_w = INT( zwebergs(2) )
-      CASE(  1 )
-         zewbergs(1) = ibergs_to_send_w
-         CALL mppsend( 11, zewbergs(1), 1, ipe_W, iml_req4)
-         CALL mpprecv( 12, zwebergs(2), 1, ipe_W )
-         CALL mpi_wait( iml_req4, iml_stat, iml_err )
-         ibergs_rcvd_from_w = INT( zwebergs(2) )
-      END SELECT
+      IF( mpinei(jpwe) >= 0  )   zewbergs(1) = ibergs_to_send_w
+      IF( mpinei(jpea) >= 0  )   zwebergs(1) = ibergs_to_send_e
+      IF( mpinei(jpwe) >= 0  )   CALL mppsend( 11, zewbergs(1), 1, ipe_W, iml_req2)
+      IF( mpinei(jpea) >= 0  )   CALL mppsend( 12, zwebergs(1), 1, ipe_E, iml_req3)
+      IF( mpinei(jpea) >= 0  )   CALL mpprecv( 11, zewbergs(2), 1, ipe_E )
+      IF( mpinei(jpwe) >= 0  )   CALL mpprecv( 12, zwebergs(2), 1, ipe_W )
+      IF( mpinei(jpwe) >= 0  )   CALL mpi_wait( iml_req2, iml_stat, iml_err )
+      IF( mpinei(jpea) >= 0  )   CALL mpi_wait( iml_req3, iml_stat, iml_err )
+      IF( mpinei(jpea) >= 0  )   ibergs_rcvd_from_e = INT( zewbergs(2) )
+      IF( mpinei(jpwe) >= 0  )   ibergs_rcvd_from_w = INT( zwebergs(2) )
+      
       IF( nn_verbose_level >= 3) THEN
          WRITE(numicb,*) 'bergstep ',nktberg,' recv ew: ', ibergs_rcvd_from_w, ibergs_rcvd_from_e
          CALL flush(numicb)
       ENDIF
-
-      SELECT CASE ( nbondi )
-      CASE( -1 )
-         IF( ibergs_to_send_e > 0 ) CALL mppsend( 14, obuffer_e%data, ibergs_to_send_e*jp_buffer_width, ipe_E, iml_req1 )
-         IF( ibergs_rcvd_from_e > 0 ) THEN
-            CALL icb_increase_ibuffer(ibuffer_e, ibergs_rcvd_from_e)
-            CALL mpprecv( 13, ibuffer_e%data, ibergs_rcvd_from_e*jp_buffer_width )
-         ENDIF
-         IF( ibergs_to_send_e > 0 ) CALL mpi_wait( iml_req1, iml_stat, iml_err )
-         DO i = 1, ibergs_rcvd_from_e
-            IF( nn_verbose_level >= 4 ) THEN
-               WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_e%data(16,i)),' from east'
-               CALL flush( numicb )
-            ENDIF
-            CALL icb_unpack_from_buffer(first_berg, ibuffer_e, i)
-         ENDDO
-      CASE(  0 )
-         IF( ibergs_to_send_w > 0 ) CALL mppsend( 13, obuffer_w%data, ibergs_to_send_w*jp_buffer_width, ipe_W, iml_req2 )
-         IF( ibergs_to_send_e > 0 ) CALL mppsend( 14, obuffer_e%data, ibergs_to_send_e*jp_buffer_width, ipe_E, iml_req3 )
-         IF( ibergs_rcvd_from_e > 0 ) THEN
-            CALL icb_increase_ibuffer(ibuffer_e, ibergs_rcvd_from_e)
-            CALL mpprecv( 13, ibuffer_e%data, ibergs_rcvd_from_e*jp_buffer_width )
-         ENDIF
-         IF( ibergs_rcvd_from_w > 0 ) THEN
-            CALL icb_increase_ibuffer(ibuffer_w, ibergs_rcvd_from_w)
-            CALL mpprecv( 14, ibuffer_w%data, ibergs_rcvd_from_w*jp_buffer_width )
-         ENDIF
-         IF( ibergs_to_send_w > 0 ) CALL mpi_wait( iml_req2, iml_stat, iml_err )
-         IF( ibergs_to_send_e > 0 ) CALL mpi_wait( iml_req3, iml_stat, iml_err )
-         DO i = 1, ibergs_rcvd_from_e
-            IF( nn_verbose_level >= 4 ) THEN
-               WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_e%data(16,i)),' from east'
-               CALL flush( numicb )
-            ENDIF
-            CALL icb_unpack_from_buffer(first_berg, ibuffer_e, i)
-         END DO
-         DO i = 1, ibergs_rcvd_from_w
-            IF( nn_verbose_level >= 4 ) THEN
-               WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_w%data(16,i)),' from west'
-               CALL flush( numicb )
-            ENDIF
-            CALL icb_unpack_from_buffer(first_berg, ibuffer_w, i)
-         ENDDO
-      CASE(  1 )
-         IF( ibergs_to_send_w > 0 ) CALL mppsend( 13, obuffer_w%data, ibergs_to_send_w*jp_buffer_width, ipe_W, iml_req4 )
-         IF( ibergs_rcvd_from_w > 0 ) THEN
-            CALL icb_increase_ibuffer(ibuffer_w, ibergs_rcvd_from_w)
-            CALL mpprecv( 14, ibuffer_w%data, ibergs_rcvd_from_w*jp_buffer_width )
-         ENDIF
-         IF( ibergs_to_send_w > 0 ) CALL mpi_wait( iml_req4, iml_stat, iml_err )
-         DO i = 1, ibergs_rcvd_from_w
-            IF( nn_verbose_level >= 4 ) THEN
-               WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_w%data(16,i)),' from west'
-               CALL flush( numicb )
-            ENDIF
-            CALL icb_unpack_from_buffer(first_berg, ibuffer_w, i)
-         END DO
-      END SELECT
+      
+      IF( ibergs_to_send_w > 0 ) CALL mppsend( 13, obuffer_w%DATA, ibergs_to_send_w*jp_buffer_width, ipe_W, iml_req2 )
+      IF( ibergs_to_send_e > 0 ) CALL mppsend( 14, obuffer_e%DATA, ibergs_to_send_e*jp_buffer_width, ipe_E, iml_req3 )
+      IF( ibergs_rcvd_from_e > 0 ) THEN
+         CALL icb_increase_ibuffer(ibuffer_e, ibergs_rcvd_from_e)
+         CALL mpprecv( 13, ibuffer_e%DATA, ibergs_rcvd_from_e*jp_buffer_width )
+      ENDIF
+      IF( ibergs_rcvd_from_w > 0 ) THEN
+         CALL icb_increase_ibuffer(ibuffer_w, ibergs_rcvd_from_w)
+         CALL mpprecv( 14, ibuffer_w%DATA, ibergs_rcvd_from_w*jp_buffer_width )
+      ENDIF
+      IF( ibergs_to_send_w > 0 ) CALL mpi_wait( iml_req2, iml_stat, iml_err )
+      IF( ibergs_to_send_e > 0 ) CALL mpi_wait( iml_req3, iml_stat, iml_err )
+      DO i = 1, ibergs_rcvd_from_e
+         IF( nn_verbose_level >= 4 ) THEN
+            WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_e%DATA(16,i)),' from east'
+            CALL FLUSH( numicb )
+         ENDIF
+         CALL icb_unpack_from_buffer(first_berg, ibuffer_e, i)
+      END DO
+      DO i = 1, ibergs_rcvd_from_w
+         IF( nn_verbose_level >= 4 ) THEN
+            WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_w%DATA(16,i)),' from west'
+            CALL FLUSH( numicb )
+         ENDIF
+         CALL icb_unpack_from_buffer(first_berg, ibuffer_w, i)
+      ENDDO
 
       ! Find number of bergs that headed north/south
@@ -400 +353 @@
       ! send bergs north
       ! and receive bergs from south (ie ones sent north)
-
-      SELECT CASE ( nbondj )
-      CASE( -1 )
-         zsnbergs(1) = ibergs_to_send_n
-         CALL mppsend( 16, zsnbergs(1), 1, ipe_N, iml_req1)
-         CALL mpprecv( 15, znsbergs(2), 1, ipe_N )
-         CALL mpi_wait( iml_req1, iml_stat, iml_err )
-         ibergs_rcvd_from_n = INT( znsbergs(2) )
-      CASE(  0 )
-         znsbergs(1) = ibergs_to_send_s
-         zsnbergs(1) = ibergs_to_send_n
-         CALL mppsend( 15, znsbergs(1), 1, ipe_S, iml_req2)
-         CALL mppsend( 16, zsnbergs(1), 1, ipe_N, iml_req3)
-         CALL mpprecv( 15, znsbergs(2), 1, ipe_N )
-         CALL mpprecv( 16, zsnbergs(2), 1, ipe_S )
-         CALL mpi_wait( iml_req2, iml_stat, iml_err )
-         CALL mpi_wait( iml_req3, iml_stat, iml_err )
-         ibergs_rcvd_from_n = INT( znsbergs(2) )
-         ibergs_rcvd_from_s = INT( zsnbergs(2) )
-      CASE(  1 )
-         znsbergs(1) = ibergs_to_send_s
-         CALL mppsend( 15, znsbergs(1), 1, ipe_S, iml_req4)
-         CALL mpprecv( 16, zsnbergs(2), 1, ipe_S )
-         CALL mpi_wait( iml_req4, iml_stat, iml_err )
-         ibergs_rcvd_from_s = INT( zsnbergs(2) )
-      END SELECT
-      if( nn_verbose_level >= 3) then
-         write(numicb,*) 'bergstep ',nktberg,' recv ns: ', ibergs_rcvd_from_s, ibergs_rcvd_from_n
-         call flush(numicb)
-      endif
-
-      SELECT CASE ( nbondj )
-      CASE( -1 )
-         IF( ibergs_to_send_n > 0 ) CALL mppsend( 18, obuffer_n%data, ibergs_to_send_n*jp_buffer_width, ipe_N, iml_req1 )
-         IF( ibergs_rcvd_from_n > 0 ) THEN
-            CALL icb_increase_ibuffer(ibuffer_n, ibergs_rcvd_from_n)
-            CALL mpprecv( 17, ibuffer_n%data, ibergs_rcvd_from_n*jp_buffer_width )
-         ENDIF
-         IF( ibergs_to_send_n > 0 ) CALL mpi_wait( iml_req1, iml_stat, iml_err )
-         DO i = 1, ibergs_rcvd_from_n
-            IF( nn_verbose_level >= 4 ) THEN
-               WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_n%data(16,i)),' from north'
-               CALL flush( numicb )
-            ENDIF
-            CALL icb_unpack_from_buffer(first_berg, ibuffer_n, i)
-         END DO
-      CASE(  0 )
-         IF( ibergs_to_send_s > 0 ) CALL mppsend( 17, obuffer_s%data, ibergs_to_send_s*jp_buffer_width, ipe_S, iml_req2 )
-         IF( ibergs_to_send_n > 0 ) CALL mppsend( 18, obuffer_n%data, ibergs_to_send_n*jp_buffer_width, ipe_N, iml_req3 )
-         IF( ibergs_rcvd_from_n > 0 ) THEN
-            CALL icb_increase_ibuffer(ibuffer_n, ibergs_rcvd_from_n)
-            CALL mpprecv( 17, ibuffer_n%data, ibergs_rcvd_from_n*jp_buffer_width )
-         ENDIF
-         IF( ibergs_rcvd_from_s > 0 ) THEN
-            CALL icb_increase_ibuffer(ibuffer_s, ibergs_rcvd_from_s)
-            CALL mpprecv( 18, ibuffer_s%data, ibergs_rcvd_from_s*jp_buffer_width )
-         ENDIF
-         IF( ibergs_to_send_s > 0 ) CALL mpi_wait( iml_req2, iml_stat, iml_err )
-         IF( ibergs_to_send_n > 0 ) CALL mpi_wait( iml_req3, iml_stat, iml_err )
-         DO i = 1, ibergs_rcvd_from_n
-            IF( nn_verbose_level >= 4 ) THEN
-               WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_n%data(16,i)),' from north'
-               CALL flush( numicb )
-            ENDIF
-            CALL icb_unpack_from_buffer(first_berg, ibuffer_n, i)
-         END DO
-         DO i = 1, ibergs_rcvd_from_s
-            IF( nn_verbose_level >= 4 ) THEN
-               WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_s%data(16,i)),' from south'
-               CALL flush( numicb )
-            ENDIF
-            CALL icb_unpack_from_buffer(first_berg, ibuffer_s, i)
-         ENDDO
-      CASE(  1 )
-         IF( ibergs_to_send_s > 0 ) CALL mppsend( 17, obuffer_s%data, ibergs_to_send_s*jp_buffer_width, ipe_S, iml_req4 )
-         IF( ibergs_rcvd_from_s > 0 ) THEN
-            CALL icb_increase_ibuffer(ibuffer_s, ibergs_rcvd_from_s)
-            CALL mpprecv( 18, ibuffer_s%data, ibergs_rcvd_from_s*jp_buffer_width )
-         ENDIF
-         IF( ibergs_to_send_s > 0 ) CALL mpi_wait( iml_req4, iml_stat, iml_err )
-         DO i = 1, ibergs_rcvd_from_s
-            IF( nn_verbose_level >= 4 ) THEN
-               WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_s%data(16,i)),' from south'
-               CALL flush( numicb )
-            ENDIF
-            CALL icb_unpack_from_buffer(first_berg, ibuffer_s, i)
-         END DO
-      END SELECT
-
+      
+      IF( mpinei(jpso) >= 0  )   znsbergs(1) = ibergs_to_send_s
+      IF( mpinei(jpno) >= 0  )   zsnbergs(1) = ibergs_to_send_n
+      IF( mpinei(jpso) >= 0  )   CALL mppsend( 15, znsbergs(1), 1, ipe_S, iml_req2)
+      IF( mpinei(jpno) >= 0  )   CALL mppsend( 16, zsnbergs(1), 1, ipe_N, iml_req3)
+      IF( mpinei(jpno) >= 0  )   CALL mpprecv( 15, znsbergs(2), 1, ipe_N )
+      IF( mpinei(jpso) >= 0  )   CALL mpprecv( 16, zsnbergs(2), 1, ipe_S )
+      IF( mpinei(jpso) >= 0  )   CALL mpi_wait( iml_req2, iml_stat, iml_err )
+      IF( mpinei(jpno) >= 0  )   CALL mpi_wait( iml_req3, iml_stat, iml_err )
+      IF( mpinei(jpno) >= 0  )   ibergs_rcvd_from_n = INT( znsbergs(2) )
+      IF( mpinei(jpso) >= 0  )   ibergs_rcvd_from_s = INT( zsnbergs(2) )
+      
+      IF( nn_verbose_level >= 3) THEN
+         WRITE(numicb,*) 'bergstep ',nktberg,' recv ns: ', ibergs_rcvd_from_s, ibergs_rcvd_from_n
+         CALL FLUSH(numicb)
+      ENDIF
+
+      IF( ibergs_to_send_s > 0 ) CALL mppsend( 17, obuffer_s%DATA, ibergs_to_send_s*jp_buffer_width, ipe_S, iml_req2 )
+      IF( ibergs_to_send_n > 0 ) CALL mppsend( 18, obuffer_n%DATA, ibergs_to_send_n*jp_buffer_width, ipe_N, iml_req3 )
+      IF( ibergs_rcvd_from_n > 0 ) THEN
+         CALL icb_increase_ibuffer(ibuffer_n, ibergs_rcvd_from_n)
+         CALL mpprecv( 17, ibuffer_n%DATA, ibergs_rcvd_from_n*jp_buffer_width )
+      ENDIF
+      IF( ibergs_rcvd_from_s > 0 ) THEN
+         CALL icb_increase_ibuffer(ibuffer_s, ibergs_rcvd_from_s)
+         CALL mpprecv( 18, ibuffer_s%DATA, ibergs_rcvd_from_s*jp_buffer_width )
+      ENDIF
+      IF( ibergs_to_send_s > 0 ) CALL mpi_wait( iml_req2, iml_stat, iml_err )
+      IF( ibergs_to_send_n > 0 ) CALL mpi_wait( iml_req3, iml_stat, iml_err )
+      DO i = 1, ibergs_rcvd_from_n
+         IF( nn_verbose_level >= 4 ) THEN
+            WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_n%DATA(16,i)),' from north'
+            CALL FLUSH( numicb )
+         ENDIF
+         CALL icb_unpack_from_buffer(first_berg, ibuffer_n, i)
+      END DO
+      DO i = 1, ibergs_rcvd_from_s
+         IF( nn_verbose_level >= 4 ) THEN
+            WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_s%DATA(16,i)),' from south'
+            CALL FLUSH( numicb )
+         ENDIF
+         CALL icb_unpack_from_buffer(first_berg, ibuffer_s, i)
+      ENDDO
+      
       IF( nn_verbose_level > 0 ) THEN
          ! compare the number of icebergs on this processor from the start to the end
@@ -527 +435 @@
       ! deal with north fold if we necessary when there is more than one top row processor
       ! note that for jpni=1 north fold has been dealt with above in call to icb_lbc
-      IF( npolj /= 0 .AND. jpni > 1 ) CALL icb_lbc_mpp_nfld( )
+      IF( ( l_NFoldT .OR. l_NFoldF ) .AND. jpni > 1 ) CALL icb_lbc_mpp_nfld( )
 
       IF( nn_verbose_level > 0 ) THEN

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_lnk_multi_generic.h90

@@ -49 +49 @@
       CHARACTER(len=1)     , OPTIONAL        , INTENT(in   ) ::   cdna2 , cdna3 , cdna4 , cdna5 , cdna6 , cdna7 , cdna8 , cdna9, &
          &                                                        cdna10, cdna11, cdna12, cdna13, cdna14, cdna15, cdna16
-      REAL(wp)                               , INTENT(in   ) ::   psgn1   ! sign used across the north fold
-      REAL(wp)             , OPTIONAL        , INTENT(in   ) ::   psgn2 , psgn3 , psgn4 , psgn5 , psgn6 , psgn7 , psgn8 , psgn9, &
+      REAL(PRECISION)                        , INTENT(in   ) ::   psgn1   ! sign used across the north fold
+      REAL(PRECISION)      , OPTIONAL        , INTENT(in   ) ::   psgn2 , psgn3 , psgn4 , psgn5 , psgn6 , psgn7 , psgn8 , psgn9, &
          &                                                        psgn10, psgn11, psgn12, psgn13, psgn14, psgn15, psgn16
       INTEGER              , OPTIONAL        , INTENT(in   ) ::   kfillmode   ! filling method for halo over land (default = constant)
-      REAL(wp)             , OPTIONAL        , INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries)
+      REAL(PRECISION)      , OPTIONAL        , INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries)
       LOGICAL, DIMENSION(4), OPTIONAL        , INTENT(in   ) ::   lsend, lrecv   ! indicate how communications are to be carried out
       LOGICAL              , OPTIONAL        , INTENT(in   ) ::   ncsten
@@ -60 +60 @@
       PTR_TYPE         , DIMENSION(16) ::   ptab_ptr    ! pointer array
       CHARACTER(len=1) , DIMENSION(16) ::   cdna_ptr    ! nature of ptab_ptr grid-points
-      REAL(wp)         , DIMENSION(16) ::   psgn_ptr    ! sign used across the north fold boundary
+      REAL(PRECISION)  , DIMENSION(16) ::   psgn_ptr    ! sign used across the north fold boundary
       !!---------------------------------------------------------------------
       !
@@ -94 +94 @@
       ARRAY_TYPE(:,:,:,:)   , TARGET, INTENT(inout) ::   ptab       ! arrays on which the lbc is applied
       CHARACTER(len=1)              , INTENT(in   ) ::   cdna       ! nature of pt2d array grid-points
-      REAL(wp)                      , INTENT(in   ) ::   psgn       ! sign used across the north fold boundary
+      REAL(PRECISION)               , INTENT(in   ) ::   psgn       ! sign used across the north fold boundary
       PTR_TYPE        , DIMENSION(:), INTENT(inout) ::   ptab_ptr   ! array of pointers
       CHARACTER(len=1), DIMENSION(:), INTENT(inout) ::   cdna_ptr   ! nature of pt2d_array array grid-points
-      REAL(wp)        , DIMENSION(:), INTENT(inout) ::   psgn_ptr   ! sign used across the north fold boundary
+      REAL(PRECISION) , DIMENSION(:), INTENT(inout) ::   psgn_ptr   ! sign used across the north fold boundary
       INTEGER                       , INTENT(inout) ::   kfld       ! number of elements that has been attributed
       !!---------------------------------------------------------------------

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_lnk_nc_generic.h90

@@ -49 +49 @@
       CHARACTER(len=1)   , OPTIONAL        , INTENT(in   ) :: cdna2, cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9, &
          &                                                    cdna10, cdna11, cdna12, cdna13, cdna14, cdna15, cdna16
-      REAL(wp)                             , INTENT(in   ) :: psgn1   ! sign used across the north fold
-      REAL(wp)           , OPTIONAL        , INTENT(in   ) :: psgn2, psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9, &
+      REAL(PRECISION)                      , INTENT(in   ) :: psgn1   ! sign used across the north fold
+      REAL(PRECISION)    , OPTIONAL        , INTENT(in   ) :: psgn2, psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9, &
          &                                                    psgn10, psgn11, psgn12, psgn13, psgn14, psgn15, psgn16
       INTEGER            , OPTIONAL        , INTENT(in   ) :: kfillmode   ! filling method for halo over land (default = constant)
-      REAL(wp)           , OPTIONAL        , INTENT(in   ) :: pfillval    ! background value (used at closed boundaries)
+      REAL(PRECISION)    , OPTIONAL        , INTENT(in   ) :: pfillval    ! background value (used at closed boundaries)
       LOGICAL, DIMENSION(4), OPTIONAL      , INTENT(in   ) :: lsend, lrecv   ! indicate how communications are to be carried out
       LOGICAL            , OPTIONAL      , INTENT(in   ) :: ncsten
@@ -60 +60 @@
       PTR_TYPE         , DIMENSION(16) ::   ptab_ptr    ! pointer array
       CHARACTER(len=1) , DIMENSION(16) ::   cdna_ptr    ! nature of ptab_ptr grid-points
-      REAL(wp)         , DIMENSION(16) ::   psgn_ptr    ! sign used across the north fold boundary
+      REAL(PRECISION)  , DIMENSION(16) ::   psgn_ptr    ! sign used across the north fold boundary
       !!---------------------------------------------------------------------
       !
@@ -94 +94 @@
       ARRAY_TYPE(:,:,:,:)   , TARGET, INTENT(inout) ::   ptab       ! arrays on which the lbc is applied
       CHARACTER(len=1)              , INTENT(in   ) ::   cdna       ! nature of pt2d array grid-points
-      REAL(wp)                      , INTENT(in   ) ::   psgn       ! sign used across the north fold boundary
+      REAL(PRECISION)               , INTENT(in   ) ::   psgn       ! sign used across the north fold boundary
       PTR_TYPE        , DIMENSION(:), INTENT(inout) ::   ptab_ptr   ! array of pointers
       CHARACTER(len=1), DIMENSION(:), INTENT(inout) ::   cdna_ptr   ! nature of pt2d_array array grid-points
-      REAL(wp)        , DIMENSION(:), INTENT(inout) ::   psgn_ptr   ! sign used across the north fold boundary
+      REAL(PRECISION) , DIMENSION(:), INTENT(inout) ::   psgn_ptr   ! sign used across the north fold boundary
       INTEGER                       , INTENT(inout) ::   kfld       ! number of elements that has been attributed
       !!---------------------------------------------------------------------

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_nfd_ext_generic.h90

@@ -21 +21 @@
       ARRAY_TYPE(:,1-kextj:,:,:,:)                      ! array or pointer of arrays on which the boundary condition is applied
       CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
-      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      REAL(PRECISION)  , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
       !
       INTEGER  ::    ji,  jj,  jk,  jl, jh,  jf   ! dummy loop indices
@@ -43 +43 @@
       DO jf = 1, ipf                      ! Loop on the number of arrays to be treated
          !
-         SELECT CASE ( npolj )
-         !
-         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+         IF( l_NFoldT ) THEN                   ! *  North fold  T-point pivot
             !
             SELECT CASE ( NAT_IN(jf)  )
@@ -96 +94 @@
             END SELECT
             !
-         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+         ENDIF   ! l_NFoldT
+         !
+         IF( l_NFoldF ) THEN                   ! *  North fold  F-point pivot
             !
             SELECT CASE ( NAT_IN(jf)  )
@@ -139 +139 @@
             END SELECT
             !
-         CASE DEFAULT                           ! *  closed : the code probably never go through
-            !
-            SELECT CASE ( NAT_IN(jf) )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               ARRAY_IN(:,  1:1-kextj  ,:,:,jf) = 0._wp
-               ARRAY_IN(:,ipj:ipj+kextj,:,:,jf) = 0._wp
-            CASE ( 'F' )                               ! F-point
-               ARRAY_IN(:,ipj:ipj+kextj,:,:,jf) = 0._wp
-            END SELECT
-            !
-         END SELECT     !  npolj
+         ENDIF   ! l_NFoldF
          !
       END DO

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_nfd_generic.h90

@@ -80 +80 @@
       ARRAY_TYPE(:,:,:,:,:)                             ! array or pointer of arrays on which the boundary condition is applied
       CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
-      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      REAL(PRECISION)  , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
       !
       INTEGER  ::    ji,  jj,  jk,  jl,  jf   ! dummy loop indices
@@ -94 +94 @@
       DO jf = 1, ipf                      ! Loop on the number of arrays to be treated
          !
-         SELECT CASE ( npolj )
-         !
-         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+         IF( l_NFoldT ) THEN                   ! *  North fold  T-point pivot
             !
             SELECT CASE ( NAT_IN(jf)  )
@@ -263 +261 @@
             END SELECT   ! NAT_IN(jf)
             !
-         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+         ENDIF   ! l_NFoldT
+         !
+         IF( l_NFoldF ) THEN                   ! *  North fold  F-point pivot
             !
             SELECT CASE ( NAT_IN(jf)  )
@@ -453 +453 @@
             END SELECT   ! NAT_IN(jf)
             !
-         END SELECT   ! npolj
+         ENDIF   ! l_NFoldF
          !
       END DO   ! ipf

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_nfd_nogather_generic.h90

@@ -85 +85 @@
       ARRAY2_TYPE(:,:,:,:,:) 
       CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
-      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      REAL(PRECISION)  , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
       INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays
       !
@@ -109 +109 @@
       DO jf = 1, ipf                      ! Loop over the number of arrays to be processed
          !
-         SELECT CASE ( npolj )
-         !
-         CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+         IF( l_NFoldT ) THEN                 ! *  North fold  T-point pivot
             !
             SELECT CASE ( NAT_IN(jf) )
@@ -305 +303 @@
                   ENDIF
                   !
-       END SELECT
+            END SELECT
             !
-         CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+         ENDIF   ! l_NFoldT
+         !
+         IF( l_NFoldF ) THEN                  ! *  North fold  F-point pivot
             !
             SELECT CASE ( NAT_IN(jf) )
@@ -429 +429 @@
             END SELECT
             !
-         CASE DEFAULT                           ! *  closed : the code probably never go through
-            !
-            WRITE(*,*) 'lbc_nfd_nogather_generic: You should not have seen this print! error?', npolj
-            !
-         END SELECT     !  npolj
+         ENDIF   ! l_NFoldF
          !
       END DO            ! End jf loop

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbclnk.F90

@@ -541 +541 @@
       !!                    jpi    : first dimension of the local subdomain
       !!                    jpj    : second dimension of the local subdomain
-      !!                    kexti  : number of columns for extra outer halo
-      !!                    kextj  : number of rows for extra outer halo
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
+      !!                    mpinei : number of neighboring domains (starting at 0, -1 if no neighbourg)
       !!----------------------------------------------------------------------
 

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lib_mpp.F90

@@ -130 +130 @@
    INTEGER :: MPI_SUMDD
 
+   ! Neighbourgs informations
+   INTEGER, DIMENSION(8), PUBLIC ::   mpinei     !: 8-neighbourg MPI indexes (starting at 0, -1 if no neighbourg)
+   INTEGER,    PARAMETER, PUBLIC ::   jpwe = 1   !: WEst
+   INTEGER,    PARAMETER, PUBLIC ::   jpea = 2   !: EAst
+   INTEGER,    PARAMETER, PUBLIC ::   jpso = 3   !: SOuth
+   INTEGER,    PARAMETER, PUBLIC ::   jpno = 4   !: NOrth
+   INTEGER,    PARAMETER, PUBLIC ::   jpsw = 5   !: South-West
+   INTEGER,    PARAMETER, PUBLIC ::   jpse = 6   !: South-East
+   INTEGER,    PARAMETER, PUBLIC ::   jpnw = 7   !: North-West
+   INTEGER,    PARAMETER, PUBLIC ::   jpne = 8   !: North-East
+
+   LOGICAL, DIMENSION(8), PUBLIC ::   l_SelfPerio  !   should we explicitely take care of I/J periodicity
+   LOGICAL,               PUBLIC ::   l_IdoNFold
+
    ! variables used for zonal integration
-   INTEGER, PUBLIC ::   ncomm_znl       !: communicator made by the processors on the same zonal average
-   LOGICAL, PUBLIC ::   l_znl_root      !: True on the 'left'most processor on the same row
-   INTEGER         ::   ngrp_znl        !  group ID for the znl processors
-   INTEGER         ::   ndim_rank_znl   !  number of processors on the same zonal average
+   INTEGER, PUBLIC ::   ncomm_znl         !: communicator made by the processors on the same zonal average
+   LOGICAL, PUBLIC ::   l_znl_root        !: True on the 'left'most processor on the same row
+   INTEGER         ::   ngrp_znl          !: group ID for the znl processors
+   INTEGER         ::   ndim_rank_znl     !: number of processors on the same zonal average
    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
 
    ! variables used for MPI3 neighbourhood collectives
-   INTEGER, PUBLIC :: mpi_nc_com                   ! MPI3 neighbourhood collectives communicator
-   INTEGER, PUBLIC :: mpi_nc_all_com               ! MPI3 neighbourhood collectives communicator (with diagionals)
+   INTEGER, PUBLIC ::   mpi_nc_com4       ! MPI3 neighbourhood collectives communicator
+   INTEGER, PUBLIC ::   mpi_nc_com8       ! MPI3 neighbourhood collectives communicator (with diagionals)
 
    ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM)
@@ -185 +199 @@
 
    LOGICAL, PUBLIC ::   ln_nnogather                !: namelist control of northfold comms
-   LOGICAL, PUBLIC ::   l_north_nogather = .FALSE.  !: internal control of northfold comms
 
    !! * Substitutions
@@ -1071 +1084 @@
    END SUBROUTINE mpp_ini_znl
 
+   
    SUBROUTINE mpp_ini_nc
       !!----------------------------------------------------------------------
@@ -1082 +1096 @@
       !
       !! ** output
-      !!         mpi_nc_com = MPI3 neighbourhood collectives communicator
-      !!         mpi_nc_all_com = MPI3 neighbourhood collectives communicator
-      !!                          (with diagonals)
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, DIMENSION(:), ALLOCATABLE :: ineigh, ineighalls, ineighallr
-      INTEGER :: ideg, idegalls, idegallr, icont, icont1
+      !!         mpi_nc_com4 = MPI3 neighbourhood collectives communicator
+      !!         mpi_nc_com8 = MPI3 neighbourhood collectives communicator (with diagonals)
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(:), ALLOCATABLE :: inei4, inei8
+      INTEGER :: icnt4, icnt8
       INTEGER :: ierr
       LOGICAL, PARAMETER :: ireord = .FALSE.
-
-#if ! defined key_mpi_off
-
-      ideg = 0
-      idegalls = 0
-      idegallr = 0
-      icont = 0
-      icont1 = 0
-
-      IF (nbondi .eq. 1) THEN
-         ideg = ideg + 1
-      ELSEIF (nbondi .eq. -1) THEN
-         ideg = ideg + 1
-      ELSEIF (nbondi .eq. 0) THEN
-         ideg = ideg + 2
-      ENDIF
-
-      IF (nbondj .eq. 1) THEN
-         ideg = ideg + 1
-      ELSEIF (nbondj .eq. -1) THEN
-         ideg = ideg + 1
-      ELSEIF (nbondj .eq. 0) THEN
-         ideg = ideg + 2
-      ENDIF
-
-      idegalls = ideg
-      idegallr = ideg
-
-      IF (nones .ne. -1) idegalls = idegalls + 1
-      IF (nonws .ne. -1) idegalls = idegalls + 1
-      IF (noses .ne. -1) idegalls = idegalls + 1
-      IF (nosws .ne. -1) idegalls = idegalls + 1
-      IF (noner .ne. -1) idegallr = idegallr + 1
-      IF (nonwr .ne. -1) idegallr = idegallr + 1
-      IF (noser .ne. -1) idegallr = idegallr + 1
-      IF (noswr .ne. -1) idegallr = idegallr + 1
-
-      ALLOCATE(ineigh(ideg))
-      ALLOCATE(ineighalls(idegalls))
-      ALLOCATE(ineighallr(idegallr))
-
-      IF (nbondi .eq. 1) THEN
-         icont = icont + 1
-         ineigh(icont) = nowe
-         ineighalls(icont) = nowe
-         ineighallr(icont) = nowe
-      ELSEIF (nbondi .eq. -1) THEN
-         icont = icont + 1
-         ineigh(icont) = noea
-         ineighalls(icont) = noea
-         ineighallr(icont) = noea
-      ELSEIF (nbondi .eq. 0) THEN
-         icont = icont + 1
-         ineigh(icont) = nowe
-         ineighalls(icont) = nowe
-         ineighallr(icont) = nowe
-         icont = icont + 1
-         ineigh(icont) = noea
-         ineighalls(icont) = noea
-         ineighallr(icont) = noea
-      ENDIF
-
-      IF (nbondj .eq. 1) THEN
-         icont = icont + 1
-         ineigh(icont) = noso
-         ineighalls(icont) = noso
-         ineighallr(icont) = noso
-      ELSEIF (nbondj .eq. -1) THEN
-         icont = icont + 1
-         ineigh(icont) = nono
-         ineighalls(icont) = nono
-         ineighallr(icont) = nono
-      ELSEIF (nbondj .eq. 0) THEN
-         icont = icont + 1
-         ineigh(icont) = noso
-         ineighalls(icont) = noso
-         ineighallr(icont) = noso
-         icont = icont + 1
-         ineigh(icont) = nono
-         ineighalls(icont) = nono
-         ineighallr(icont) = nono
-      ENDIF
-
-      icont1 = icont
-      IF (nosws .ne. -1) THEN
-         icont = icont + 1
-         ineighalls(icont) = nosws
-      ENDIF
-      IF (noses .ne. -1) THEN
-         icont = icont + 1
-         ineighalls(icont) = noses
-      ENDIF
-      IF (nonws .ne. -1) THEN
-         icont = icont + 1
-         ineighalls(icont) = nonws
-      ENDIF
-      IF (nones .ne. -1) THEN
-         icont = icont + 1
-         ineighalls(icont) = nones
-      ENDIF
-      IF (noswr .ne. -1) THEN
-         icont1 = icont1 + 1
-         ineighallr(icont1) = noswr
-      ENDIF
-      IF (noser .ne. -1) THEN
-         icont1 = icont1 + 1
-         ineighallr(icont1) = noser
-      ENDIF
-      IF (nonwr .ne. -1) THEN
-         icont1 = icont1 + 1
-         ineighallr(icont1) = nonwr
-      ENDIF
-      IF (noner .ne. -1) THEN
-         icont1 = icont1 + 1
-         ineighallr(icont1) = noner
-      ENDIF
-
-      CALL MPI_Dist_graph_create_adjacent(mpi_comm_oce, ideg, ineigh, MPI_UNWEIGHTED, ideg, ineigh, MPI_UNWEIGHTED, MPI_INFO_NULL, ireord, mpi_nc_com, ierr)
-      CALL MPI_Dist_graph_create_adjacent(mpi_comm_oce, idegallr, ineighallr, MPI_UNWEIGHTED, idegalls, ineighalls, MPI_UNWEIGHTED, MPI_INFO_NULL, ireord, mpi_nc_all_com, ierr)
-
-      DEALLOCATE (ineigh)
-      DEALLOCATE (ineighalls)
-      DEALLOCATE (ineighallr)
+      !!----------------------------------------------------------------------
+#if ! defined key_mpi_off && ! defined key_mpi2
+      
+      icnt4 = COUNT( mpinei(1:4) >= 0 )
+      icnt8 = COUNT( mpinei(1:8) >= 0 )
+
+      ALLOCATE( inei4(icnt4), inei8(icnt8) )   ! ok if icnt4 or icnt8 = 0
+
+      inei4 = PACK( mpinei(1:4), mask = mpinei(1:4) >= 0 )
+      inei8 = PACK( mpinei(1:8), mask = mpinei(1:8) >= 0 )
+
+      CALL MPI_Dist_graph_create_adjacent(mpi_comm_oce, icnt4, inei4, MPI_UNWEIGHTED,   &
+         &                                              icnt4, inei4, MPI_UNWEIGHTED, MPI_INFO_NULL, ireord, mpi_nc_com4, ierr)
+      CALL MPI_Dist_graph_create_adjacent(mpi_comm_oce, icnt8, inei8, MPI_UNWEIGHTED,   &
+         &                                              icnt8, inei8, MPI_UNWEIGHTED, MPI_INFO_NULL, ireord, mpi_nc_com8, ierr)
+
+      DEALLOCATE (inei4, inei8)
 #endif
    END SUBROUTINE mpp_ini_nc
-
 
 
@@ -1232 +1137 @@
       !!
       !! ** output
-      !!      njmppmax = njmpp for northern procs
       !!      ndim_rank_north = number of processors in the northern line
       !!      nrank_north (ndim_rank_north) = number  of the northern procs.
@@ -1247 +1151 @@
       !
 #if ! defined key_mpi_off
-      njmppmax = MAXVAL( njmppt )
       !
       ! Look for how many procs on the northern boundary

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/mpp_lbc_north_icb_generic.h90

@@ -31 +31 @@
       CHARACTER(len=1)        , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points
       !                                                     !   = T ,  U , V , F or W -points
-      REAL(wp)                , INTENT(in   ) ::   psgn     ! = -1. the sign change across the
+      REAL(PRECISION)         , INTENT(in   ) ::   psgn     ! = -1. the sign change across the
       !!                                                    ! north fold, =  1. otherwise
       INTEGER                 , INTENT(in   ) ::   kextj    ! Extra halo width at north fold

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/mpp_lnk_generic.h90

@@ -80 +80 @@
       CHARACTER(len=*)              , INTENT(in   ) ::   cdname      ! name of the calling subroutine
       CHARACTER(len=1)              , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
-      REAL(wp)                      , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      REAL(PRECISION)               , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
       INTEGER ,             OPTIONAL, INTENT(in   ) ::   kfillmode   ! filling method for halo over land (default = constant)
-      REAL(wp),             OPTIONAL, INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries)
+      REAL(PRECISION),      OPTIONAL, INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries)
       LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in   ) ::   lsend, lrecv  ! communication with other 4 proc
       LOGICAL,              OPTIONAL, INTENT(in   ) ::   ncsten      ! 5-point or 9-point stencil
       !
-      INTEGER  ::    ji,  jj,  jk,  jl,  jf      ! dummy loop indices
-      INTEGER  ::   ipi, ipj, ipk, ipl, ipf      ! dimension of the input array
-      INTEGER  ::   isize, ishift, ishift2       ! local integers
-      INTEGER  ::   ireq_we, ireq_ea, ireq_so, ireq_no     ! mpi_request id
+      INTEGER  ::   ji, jj, jk, jl, jf, jn      ! dummy loop indices
+      INTEGER  ::   ipk, ipl, ipf      ! dimension of the input array
+      INTEGER  ::   ip0i, ip1i, im0i, im1i
+      INTEGER  ::   ip0j, ip1j, im0j, im1j
+      INTEGER  ::   ishti, ishtj, ishti2, ishtj2
       INTEGER  ::   ierr
-      INTEGER  ::   ifill_we, ifill_ea, ifill_so, ifill_no
-      REAL(wp) ::   zland
-      INTEGER , DIMENSION(MPI_STATUS_SIZE)        ::   istat          ! for mpi_isend
-      REAL(PRECISION), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zsnd_we, zrcv_we, zsnd_ea, zrcv_ea   ! east -west  & west - east  halos
-      REAL(PRECISION), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zsnd_so, zrcv_so, zsnd_no, zrcv_no   ! north-south & south-north  halos
-      LOGICAL  ::   llsend_we, llsend_ea, llsend_no, llsend_so       ! communication send
-      LOGICAL  ::   llrecv_we, llrecv_ea, llrecv_no, llrecv_so       ! communication receive
-      LOGICAL  ::   lldo_nfd                                     ! do north pole folding
+      INTEGER  ::   idxs, idxr
+      INTEGER, DIMENSION(4)  ::   isizei, ishtsi, ishtri, ishtpi
+      INTEGER, DIMENSION(4)  ::   isizej, ishtsj, ishtrj, ishtpj
+      INTEGER, DIMENSION(4)  ::   ifill, iszall, ishts, ishtr
+      INTEGER, DIMENSION(4)  ::   ireq  ! mpi_request id
+      REAL(PRECISION) ::   zland
+      REAL(PRECISION), DIMENSION(:), ALLOCATABLE  ::   zsnd, zrcv          ! halos arrays
+      LOGICAL, DIMENSION(4)  ::   llsend, llrecv
+      LOGICAL  ::   ll_IdoNFold
       !!----------------------------------------------------------------------
+#if defined PRINT_CAUTION
+      !
+      ! ================================================================================== !
+      ! CAUTION: semi-column notation is often impossible because of the cpp preprocessing !
+      ! ================================================================================== !
+      !
+#endif
       !
 #if defined key_mpi3
@@ -108 +117 @@
 #   endif
 #else
-
       ! ----------------------------------------- !
-      !     0. local variables initialization     !
+      !     1. local variables initialization     !
       ! ----------------------------------------- !
       !
@@ -119 +127 @@
       IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. )
       !
-      IF     ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN
-         llsend_we = lsend(1)   ;   llsend_ea = lsend(2)   ;   llsend_so = lsend(3)   ;   llsend_no = lsend(4)
-         llrecv_we = lrecv(1)   ;   llrecv_ea = lrecv(2)   ;   llrecv_so = lrecv(3)   ;   llrecv_no = lrecv(4)
-      ELSE IF( PRESENT(lsend) .OR.  PRESENT(lrecv) ) THEN
-         WRITE(ctmp1,*) ' E R R O R : Routine ', cdname, '  is calling lbc_lnk with only one of the two arguments lsend or lrecv'
-         WRITE(ctmp2,*) ' ========== '
-         CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' )
-      ELSE   ! send and receive with every neighbour
-         llsend_we = nbondi ==  1 .OR. nbondi == 0   ! keep for compatibility, should be defined in mppini
-         llsend_ea = nbondi == -1 .OR. nbondi == 0   ! keep for compatibility, should be defined in mppini
-         llsend_so = nbondj ==  1 .OR. nbondj == 0   ! keep for compatibility, should be defined in mppini
-         llsend_no = nbondj == -1 .OR. nbondj == 0   ! keep for compatibility, should be defined in mppini
-         llrecv_we = llsend_we   ;   llrecv_ea = llsend_ea   ;   llrecv_so = llsend_so   ;   llrecv_no = llsend_no
-      END IF
-
-
-      lldo_nfd = npolj /= 0                      ! keep for compatibility, should be defined in mppini
-
+      ! take care of optional parameters
+      !
       zland = 0._wp                                     ! land filling value: zero by default
       IF( PRESENT( pfillval ) )   zland = pfillval      ! set land value
+      !
+      ! define llsend and llrecv: logicals which say if mpi-neibourgs for send or receive exist or not.
+      IF     ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN   ! localy defined neighbourgs 
+         llsend(1:4) = lsend(1:4)   ;   llrecv(1:4) = lrecv(1:4)
+      ELSE IF( PRESENT(lsend) .OR.  PRESENT(lrecv) ) THEN
+         WRITE(ctmp1,*) ' Routine ', cdname, '  is calling lbc_lnk with only one of the two arguments lsend or lrecv'
+         CALL ctl_stop( 'STOP', ctmp1 )
+      ELSE                                                  ! default neighbours
+         llsend(1:4) = mpinei(1:4) >= 0
+         llrecv(:) = llsend(:)
+      END IF
+      !
+      ! define ifill: which method should be used to fill each parts (sides+corners) of the halos
+      ! default definition
+      DO jn = 1, 4
+         IF(             llrecv(jn) ) THEN   ;   ifill(jn) = jpfillmpi    ! with an mpi communication
+         ELSEIF(    l_SelfPerio(jn) ) THEN   ;   ifill(jn) = jpfillperio  ! with self-periodicity
+         ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill(jn) = kfillmode    ! localy defined
+         ELSE                                ;   ifill(jn) = jpfillcst    ! constant value (zland)
+         END IF
+      END DO
+      ! north fold treatment
+      ll_IdoNFold = l_IdoNFold .AND. ifill(jpno) /= jpfillnothing
+      IF( ll_IdoNFold )   ifill( (/jpno/) ) = jpfillnothing   ! we do north fold -> do nothing for northern halo
+      
+      !                    !                       ________________________
+      ip0i =          0    !          im0j = inner |__|__|__________|__|__|
+      ip1i =      nn_hls   !   im1j = inner - halo |__|__|__________|__|__|
+      im1i = Nie0-nn_hls   !                       |  |  |          |  |  |
+      im0i = Nie0          !                       |  |  |          |  |  |
+      ip0j =          0    !                       |  |  |          |  |  |
+      ip1j =      nn_hls   !                       |__|__|__________|__|__|
+      im1j = Nje0-nn_hls   !           ip1j = halo |__|__|__________|__|__|
+      im0j = Nje0          !              ip0j = 0 |__|__|__________|__|__|
+      !                    !                    ip0i ip1i        im1i im0i
+      !
+      !     sides:       west    east   south   north
+      isizei(1:4) = (/ nn_hls, nn_hls,    jpi,    jpi /)   ! i- count
+      isizej(1:4) = (/    jpj,    jpj, nn_hls, nn_hls /)   ! j- count
+      ishtsi(1:4) = (/   ip1i,   im1i,   ip0i,   ip0i /)   ! i- shift send data
+      ishtsj(1:4) = (/   ip0j,   ip0j,   ip1j,   im1j /)   ! j- shift send data
+      ishtri(1:4) = (/   ip0i,   im0i,   ip0i,   ip0i /)   ! i- shift received data location
+      ishtrj(1:4) = (/   ip0j,   ip0j,   ip0j,   im0j /)   ! j- shift received data location
+      ishtpi(1:4) = (/   im1i,   ip1i,   ip0i,   ip0i /)   ! i- shift data used for periodicity
+      ishtpj(1:4) = (/   ip0j,   ip0j,   im1j,   ip1j /)   ! j- shift data used for periodicity
+      !
+      ! -------------------------------- !
+      !     2. Prepare MPI exchanges     !
+      ! -------------------------------- !
+      !
+      ireq(:) = MPI_REQUEST_NULL
+      iszall(:) = isizei(:) * isizej(:) * ipk * ipl * ipf
+      ishts(1) = 0
+      DO jn = 2,4
+         ishts(jn) = ishts(jn-1) + iszall(jn-1) * COUNT( (/llsend(jn-1)/) )   ! with _alltoallv: in units of sendtype
+      END DO
+      ishtr(1) = 0
+      DO jn = 2,4
+         ishtr(jn) = ishtr(jn-1) + iszall(jn-1) * COUNT( (/llrecv(jn-1)/) )   ! with _alltoallv: in units of sendtype
+      END DO
 
-      ! define the method we will use to fill the halos in each direction
-      IF(              llrecv_we ) THEN   ;   ifill_we = jpfillmpi
-      ELSEIF(           l_Iperio ) THEN   ;   ifill_we = jpfillperio
-      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_we = kfillmode
-      ELSE                                ;   ifill_we = jpfillcst
-      END IF
-      !
-      IF(              llrecv_ea ) THEN   ;   ifill_ea = jpfillmpi
-      ELSEIF(           l_Iperio ) THEN   ;   ifill_ea = jpfillperio
-      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_ea = kfillmode
-      ELSE                                ;   ifill_ea = jpfillcst
-      END IF
-      !
-      IF(              llrecv_so ) THEN   ;   ifill_so = jpfillmpi
-      ELSEIF(           l_Jperio ) THEN   ;   ifill_so = jpfillperio
-      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_so = kfillmode
-      ELSE                                ;   ifill_so = jpfillcst
-      END IF
-      !
-      IF(              llrecv_no ) THEN   ;   ifill_no = jpfillmpi
-      ELSEIF(           l_Jperio ) THEN   ;   ifill_no = jpfillperio
-      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_no = kfillmode
-      ELSE                                ;   ifill_no = jpfillcst
-      END IF
-      !
-#if defined PRINT_CAUTION
-      !
-      ! ================================================================================== !
-      ! CAUTION: semi-column notation is often impossible because of the cpp preprocessing !
-      ! ================================================================================== !
-      !
-#endif
+      ! Allocate local temporary arrays to be sent/received.
+      ALLOCATE( zsnd( SUM(iszall, mask = llsend) ), zrcv( SUM(iszall, mask = llrecv) ) )
       !
       ! -------------------------------------------------- !
-      !     1. Do east and west MPI exchange if needed     !
+      !     3. Do east and west MPI exchange if needed     !
       ! -------------------------------------------------- !
       !
-      ! Must exchange the whole column (from 1 to jpj) to get the corners if we have no south/north neighbourg
-      isize = nn_hls * jpj * ipk * ipl * ipf
-      !
-      ! Allocate local temporary arrays to be sent/received. Fill arrays to be sent
-      IF( llsend_we )   ALLOCATE( zsnd_we(nn_hls,jpj,ipk,ipl,ipf) )
-      IF( llsend_ea )   ALLOCATE( zsnd_ea(nn_hls,jpj,ipk,ipl,ipf) )
-      IF( llrecv_we )   ALLOCATE( zrcv_we(nn_hls,jpj,ipk,ipl,ipf) )
-      IF( llrecv_ea )   ALLOCATE( zrcv_ea(nn_hls,jpj,ipk,ipl,ipf) )
-      !
-      IF( llsend_we ) THEN   ! copy western side of the inner mpi domain in local temporary array to be sent by MPI
-         ishift = nn_hls
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-            zsnd_we(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! nn_hls + 1 -> 2*nn_hls
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      ! fill sending buffer with ARRAY_IN
+      idxs = 1
+      DO jn = 1, 2
+         IF( llsend(jn) ) THEN
+            ishti = ishtsi(jn)
+            ishtj = ishtsj(jn)
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               zsnd(idxs) = ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf)
+               idxs = idxs + 1
+            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+         END IF
+      END DO
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE.)
+      !
+      ! non-blocking send of the western/eastern side using local temporary arrays
+      jn = jpwe   ;   IF( llsend(jn) )   CALL SENDROUTINE( 1, zsnd(ishts(jn)+1), iszall(jn), mpinei(jn), ireq(jn) )
+      jn = jpea   ;   IF( llsend(jn) )   CALL SENDROUTINE( 2, zsnd(ishts(jn)+1), iszall(jn), mpinei(jn), ireq(jn) )
+      ! blocking receive of the western/eastern halo in local temporary arrays
+      jn = jpwe   ;   IF( llrecv(jn) )   CALL RECVROUTINE( 2, zrcv(ishtr(jn)+1), iszall(jn), mpinei(jn) )
+      jn = jpea   ;   IF( llrecv(jn) )   CALL RECVROUTINE( 1, zrcv(ishtr(jn)+1), iszall(jn), mpinei(jn) )
+      !
+      IF( ln_timing ) CALL tic_tac(.FALSE.)
+      !
+      ! ----------------------------------- !
+      !     4. Fill east and west halos     !
+      ! ----------------------------------- !
+      !
+      idxr = 1
+      DO jn = 1, 2
+         ishti = ishtri(jn)
+         ishtj = ishtrj(jn)
+         SELECT CASE ( ifill(jn) )
+         CASE ( jpfillnothing )               ! no filling 
+         CASE ( jpfillmpi   )                 ! fill with data received by MPI
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf) = zrcv(idxr)
+               idxr = idxr + 1
+            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+         CASE ( jpfillperio )                 ! use periodicity
+            ishti2 = ishtpi(jn)
+            ishtj2 = ishtpj(jn)
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf) = ARRAY_IN(ishti2+ji,ishtj2+jj,jk,jl,jf)
+            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+         CASE ( jpfillcopy  )                 ! filling with inner domain values
+            ishti2 = ishtsi(jn)
+            ishtj2 = ishtsj(jn)
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf) = ARRAY_IN(ishti2+ji,ishtj2+jj,jk,jl,jf)
+            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+         CASE ( jpfillcst   )                 ! filling with constant value
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf) = zland
+            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+         END SELECT
+      END DO
+      !
+      ! ------------------------------- !
+      !     5. north fold treatment     !
+      ! ------------------------------- !
+      !
+      ! do it before south directions so concerned processes can do it without waiting for the comm with the sourthern neighbor
+      !
+      IF( ll_IdoNFold ) THEN
+         IF( jpni == 1 )  THEN   ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:)                     OPT_K(:) )   ! self NFold
+         ELSE                    ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:), ifill(jpno), zland OPT_K(:) )   ! mpi  NFold
+         ENDIF
       ENDIF
       !
-      IF(llsend_ea  ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI
-         ishift = jpi - 2 * nn_hls
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-            zsnd_ea(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! jpi - 2*nn_hls + 1 -> jpi - nn_hls
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      ENDIF
+      ! ---------------------------------------------------- !
+      !     6. Do north and south MPI exchange if needed     !
+      ! ---------------------------------------------------- !
+      !
+      DO jn = 3, 4
+         IF( llsend(jn) ) THEN
+            ishti = ishtsi(jn)
+            ishtj = ishtsj(jn)
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               zsnd(idxs) = ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf)
+               idxs = idxs + 1
+            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+         END IF
+      END DO
       !
       IF( ln_timing ) CALL tic_tac(.TRUE.)
       !
       ! non-blocking send of the western/eastern side using local temporary arrays
-      IF( llsend_we )   CALL SENDROUTINE( 1, zsnd_we(1,1,1,1,1), isize, nowe, ireq_we )
-      IF( llsend_ea )   CALL SENDROUTINE( 2, zsnd_ea(1,1,1,1,1), isize, noea, ireq_ea )
+      jn = jpso   ;   IF( llsend(jn) )   CALL SENDROUTINE( 3, zsnd(ishts(jn)+1), iszall(jn), mpinei(jn), ireq(jn) )
+      jn = jpno   ;   IF( llsend(jn) )   CALL SENDROUTINE( 4, zsnd(ishts(jn)+1), iszall(jn), mpinei(jn), ireq(jn) )
       ! blocking receive of the western/eastern halo in local temporary arrays
-      IF( llrecv_we )   CALL RECVROUTINE( 2, zrcv_we(1,1,1,1,1), isize, nowe )
-      IF( llrecv_ea )   CALL RECVROUTINE( 1, zrcv_ea(1,1,1,1,1), isize, noea )
+      jn = jpso   ;   IF( llrecv(jn) )   CALL RECVROUTINE( 4, zrcv(ishtr(jn)+1), iszall(jn), mpinei(jn) )
+      jn = jpno   ;   IF( llrecv(jn) )   CALL RECVROUTINE( 3, zrcv(ishtr(jn)+1), iszall(jn), mpinei(jn) )
       !
       IF( ln_timing ) CALL tic_tac(.FALSE.)
       !
-      !
-      ! ----------------------------------- !
-      !     2. Fill east and west halos     !
-      ! ----------------------------------- !
-      !
-      ! 2.1 fill weastern halo
-      ! ----------------------
-      ! ishift = 0                         ! fill halo from ji = 1 to nn_hls
-      SELECT CASE ( ifill_we )
-      CASE ( jpfillnothing )               ! no filling
-      CASE ( jpfillmpi   )                 ! use data received by MPI
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-            ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf)   ! 1 -> nn_hls
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      CASE ( jpfillperio )                 ! use east-weast periodicity
-         ishift2 = jpi - 2 * nn_hls
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      CASE ( jpfillcopy  )                 ! filling with inner domain values
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(nn_hls+1,jj,jk,jl,jf)
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      CASE ( jpfillcst   )                 ! filling with constant value
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-            ARRAY_IN(ji,jj,jk,jl,jf) = zland
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      END SELECT
-      !
-      ! 2.2 fill eastern halo
-      ! ---------------------
-      ishift = jpi - nn_hls                ! fill halo from ji = jpi-nn_hls+1 to jpi
-      SELECT CASE ( ifill_ea )
-      CASE ( jpfillnothing )               ! no filling
-      CASE ( jpfillmpi   )                 ! use data received by MPI
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv_ea(ji,jj,jk,jl,jf)   ! jpi - nn_hls + 1 -> jpi
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      CASE ( jpfillperio )                 ! use east-weast periodicity
-         ishift2 = nn_hls
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      CASE ( jpfillcopy  )                 ! filling with inner domain values
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf)
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      CASE ( jpfillcst   )                 ! filling with constant value
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      END SELECT
-      !
-      ! ------------------------------- !
-      !     3. north fold treatment     !
-      ! ------------------------------- !
-      !
-      ! do it before south directions so concerned processes can do it without waiting for the comm with the sourthern neighbor
-      !
-      IF( lldo_nfd .AND. ifill_no /= jpfillnothing ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:)                  OPT_K(:) )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:), ifill_no, zland OPT_K(:) )   ! for all northern procs.
+      ! ------------------------------------- !
+      !     7. Fill south and north halos     !
+      ! ------------------------------------- !
+      !
+      DO jn = 3, 4
+         ishti = ishtri(jn)
+         ishtj = ishtrj(jn)
+         SELECT CASE ( ifill(jn) )
+         CASE ( jpfillnothing )               ! no filling 
+         CASE ( jpfillmpi   )                 ! fill with data received by MPI
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf) = zrcv(idxr)
+               idxr = idxr + 1
+            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+         CASE ( jpfillperio )                 ! use periodicity
+            ishti2 = ishtpi(jn)
+            ishtj2 = ishtpj(jn)
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf) = ARRAY_IN(ishti2+ji,ishtj2+jj,jk,jl,jf)
+            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+         CASE ( jpfillcopy  )                 ! filling with inner domain values
+            ishti2 = ishtsi(jn)
+            ishtj2 = ishtsj(jn)
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf) = ARRAY_IN(ishti2+ji,ishtj2+jj,jk,jl,jf)
+            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+         CASE ( jpfillcst   )                 ! filling with constant value
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf) = zland
+            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
          END SELECT
-         !
-         ifill_no = jpfillnothing  ! force to do nothing for the northern halo as we just done the north pole folding
-         !
-      ENDIF
-      !
-      ! ---------------------------------------------------- !
-      !     4. Do north and south MPI exchange if needed     !
-      ! ---------------------------------------------------- !
-      !
-      IF( llsend_so )   ALLOCATE( zsnd_so(jpi,nn_hls,ipk,ipl,ipf) )
-      IF( llsend_no )   ALLOCATE( zsnd_no(jpi,nn_hls,ipk,ipl,ipf) )
-      IF( llrecv_so )   ALLOCATE( zrcv_so(jpi,nn_hls,ipk,ipl,ipf) )
-      IF( llrecv_no )   ALLOCATE( zrcv_no(jpi,nn_hls,ipk,ipl,ipf) )
-      !
-      isize = jpi * nn_hls * ipk * ipl * ipf
-
-      ! allocate local temporary arrays to be sent/received. Fill arrays to be sent
-      IF( llsend_so ) THEN   ! copy sourhern side of the inner mpi domain in local temporary array to be sent by MPI
-         ishift = nn_hls
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-            zsnd_so(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! nn_hls+1 -> 2*nn_hls
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      ENDIF
-      !
-      IF( llsend_no ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI
-         ishift = jpj - 2 * nn_hls
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-            zsnd_no(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! jpj-2*nn_hls+1 -> jpj-nn_hls
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      ENDIF
-      !
-      IF( ln_timing ) CALL tic_tac(.TRUE.)
-      !
-      ! non-blocking send of the southern/northern side
-      IF( llsend_so )   CALL SENDROUTINE( 3, zsnd_so(1,1,1,1,1), isize, noso, ireq_so )
-      IF( llsend_no )   CALL SENDROUTINE( 4, zsnd_no(1,1,1,1,1), isize, nono, ireq_no )
-      ! blocking receive of the southern/northern halo
-      IF( llrecv_so )   CALL RECVROUTINE( 4, zrcv_so(1,1,1,1,1), isize, noso )
-      IF( llrecv_no )   CALL RECVROUTINE( 3, zrcv_no(1,1,1,1,1), isize, nono )
-      !
-      IF( ln_timing ) CALL tic_tac(.FALSE.)
-      !
-      ! ------------------------------------- !
-      !     5. Fill south and north halos     !
-      ! ------------------------------------- !
-      !
-      ! 5.1 fill southern halo
-      ! ----------------------
-      ! ishift = 0                         ! fill halo from jj = 1 to nn_hls
-      SELECT CASE ( ifill_so )
-      CASE ( jpfillnothing )               ! no filling
-      CASE ( jpfillmpi   )                 ! use data received by MPI
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-            ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf)   ! 1 -> nn_hls
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      CASE ( jpfillperio )                 ! use north-south periodicity
-         ishift2 = jpj - 2 * nn_hls
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf)
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      CASE ( jpfillcopy  )                 ! filling with inner domain values
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf)
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      CASE ( jpfillcst   )                 ! filling with constant value
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-            ARRAY_IN(ji,jj,jk,jl,jf) = zland
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      END SELECT
-      !
-      ! 5.2 fill northern halo
-      ! ----------------------
-      ishift = jpj - nn_hls                ! fill halo from jj = jpj-nn_hls+1 to jpj
-      SELECT CASE ( ifill_no )
-      CASE ( jpfillnothing )               ! no filling
-      CASE ( jpfillmpi   )                 ! use data received by MPI
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv_no(ji,jj,jk,jl,jf)   ! jpj-nn_hls+1 -> jpj
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      CASE ( jpfillperio )                 ! use north-south periodicity
-         ishift2 = nn_hls
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf)
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      CASE ( jpfillcopy  )                 ! filling with inner domain values
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf)
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      CASE ( jpfillcst   )                 ! filling with constant value
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-      END SELECT
+      END DO
       !
       ! -------------------------------------------- !
-      !     6. deallocate local temporary arrays     !
+      !     8. deallocate local temporary arrays     !
       ! -------------------------------------------- !
       !
-      IF( llsend_we ) THEN
-         CALL mpi_wait(ireq_we, istat, ierr )
-         DEALLOCATE( zsnd_we )
-      ENDIF
-      IF( llsend_ea )  THEN
-         CALL mpi_wait(ireq_ea, istat, ierr )
-         DEALLOCATE( zsnd_ea )
-      ENDIF
-      IF( llsend_so ) THEN
-         CALL mpi_wait(ireq_so, istat, ierr )
-         DEALLOCATE( zsnd_so )
-      ENDIF
-      IF( llsend_no ) THEN
-         CALL mpi_wait(ireq_no, istat, ierr )
-         DEALLOCATE( zsnd_no )
-      ENDIF
-      !
-      IF( llrecv_we )   DEALLOCATE( zrcv_we )
-      IF( llrecv_ea )   DEALLOCATE( zrcv_ea )
-      IF( llrecv_so )   DEALLOCATE( zrcv_so )
-      IF( llrecv_no )   DEALLOCATE( zrcv_no )
+      CALL mpi_waitall(4, ireq, MPI_STATUSES_IGNORE, ierr)
+      DEALLOCATE( zsnd, zrcv )
       !
 #endif

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/mpp_lnk_icb_generic.h90

@@ -24 +24 @@
       !!                    jpi    : first dimension of the local subdomain
       !!                    jpj    : second dimension of the local subdomain
+      !!                    mpinei : number of neighboring domains (starting at 0, -1 if no neighbourg)
       !!                    kexti  : number of columns for extra outer halo
       !!                    kextj  : number of rows for extra outer halo
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
       !!----------------------------------------------------------------------
       CHARACTER(len=*)                                        , INTENT(in   ) ::   cdname      ! name of the calling subroutine
       REAL(PRECISION), DIMENSION(1-kexti:jpi+kexti,1-kextj:jpj+kextj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
       CHARACTER(len=1)                                        , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
-      REAL(wp)                                                , INTENT(in   ) ::   psgn     ! sign used across the north fold
+      REAL(PRECISION)                                         , INTENT(in   ) ::   psgn     ! sign used across the north fold
       INTEGER                                                 , INTENT(in   ) ::   kexti    ! extra i-halo width
       INTEGER                                                 , INTENT(in   ) ::   kextj    ! extra j-halo width
@@ -90 +85 @@
       ! north fold treatment
       ! -----------------------
-      IF( npolj /= 0 ) THEN
+      IF( l_NFoldT .OR. l_NFoldF ) THEN
          !
          SELECT CASE ( jpni )
@@ -103 +98 @@
       ! we play with the neigbours AND the row number because of the periodicity
       !
-      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+      IF( mpinei(jpwe) >= 0 .OR. mpinei(jpea) >= 0 ) THEN   ! Read Dirichlet lateral conditions: all exept 2 (i.e. close case)
          iihom = jpi - (2 * nn_hls) -kexti
          DO jl = 1, ipreci
@@ -110 +104 @@
             r2dwe(:,jl,1) = pt2d(iihom +jl,:)
          END DO
-      END SELECT
+      ENDIF
       !
       !                           ! Migrations
@@ -120 +114 @@
       IF( ln_timing ) CALL tic_tac(.TRUE.)
       !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL SENDROUTINE( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req1 )
-         CALL RECVROUTINE( 1, r2dew(1-kextj,1,2), imigr, noea )
-         CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL SENDROUTINE( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 )
-         CALL SENDROUTINE( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req2 )
-         CALL RECVROUTINE( 1, r2dew(1-kextj,1,2), imigr, noea )
-         CALL RECVROUTINE( 2, r2dwe(1-kextj,1,2), imigr, nowe )
-         CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL SENDROUTINE( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 )
-         CALL RECVROUTINE( 2, r2dwe(1-kextj,1,2), imigr, nowe )
-         CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
+      IF( mpinei(jpwe) >= 0  )   CALL SENDROUTINE( 1, r2dew(1-kextj,1,1), imigr, mpinei(jpwe), ml_req1 )
+      IF( mpinei(jpea) >= 0  )   CALL SENDROUTINE( 2, r2dwe(1-kextj,1,1), imigr, mpinei(jpea), ml_req2 )
+      IF( mpinei(jpwe) >= 0  )   CALL RECVROUTINE( 2, r2dwe(1-kextj,1,2), imigr, mpinei(jpwe) )
+      IF( mpinei(jpea) >= 0  )   CALL RECVROUTINE( 1, r2dew(1-kextj,1,2), imigr, mpinei(jpea) )
+      IF( mpinei(jpwe) >= 0  )   CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      IF( mpinei(jpea) >= 0  )   CALL mpi_wait(ml_req2,ml_stat,ml_err)
       !
       IF( ln_timing ) CALL tic_tac(.FALSE.)
@@ -142 +125 @@
       !                           ! Write Dirichlet lateral conditions
       iihom = jpi - nn_hls
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
+      IF( mpinei(jpwe) >= 0  ) THEN
+         DO jl = 1, ipreci
+            pt2d(jl-kexti,:) = r2dwe(:,jl,2)
+         END DO
+      ENDIF
+      IF( mpinei(jpea) >= 0  ) THEN
          DO jl = 1, ipreci
             pt2d(iihom+jl,:) = r2dew(:,jl,2)
          END DO
-      CASE ( 0 )
-         DO jl = 1, ipreci
-            pt2d(jl-kexti,:) = r2dwe(:,jl,2)
-            pt2d(iihom+jl,:) = r2dew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, ipreci
-            pt2d(jl-kexti,:) = r2dwe(:,jl,2)
-         END DO
-      END SELECT
-
+      ENDIF
 
       ! 3. North and south directions
@@ -164 +140 @@
       ! always closed : we play only with the neigbours
       !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+      IF( mpinei(jpso) >= 0 .OR. mpinei(jpno) >= 0 ) THEN   ! Read Dirichlet lateral conditions: all exept 2 (i.e. close case)
          ijhom = jpj - (2 * nn_hls) - kextj
          DO jl = 1, iprecj
@@ -177 +153 @@
       IF( ln_timing ) CALL tic_tac(.TRUE.)
       !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL SENDROUTINE( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req1 )
-         CALL RECVROUTINE( 3, r2dns(1-kexti,1,2), imigr, nono )
-         CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL SENDROUTINE( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 )
-         CALL SENDROUTINE( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req2 )
-         CALL RECVROUTINE( 3, r2dns(1-kexti,1,2), imigr, nono )
-         CALL RECVROUTINE( 4, r2dsn(1-kexti,1,2), imigr, noso )
-         CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL SENDROUTINE( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 )
-         CALL RECVROUTINE( 4, r2dsn(1-kexti,1,2), imigr, noso )
-         CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
+      IF( mpinei(jpso) >= 0  )   CALL SENDROUTINE( 3, r2dns(1-kexti,1,1), imigr, mpinei(jpso), ml_req1 )
+      IF( mpinei(jpno) >= 0  )   CALL SENDROUTINE( 4, r2dsn(1-kexti,1,1), imigr, mpinei(jpno), ml_req2 )
+      IF( mpinei(jpso) >= 0  )   CALL RECVROUTINE( 4, r2dsn(1-kexti,1,2), imigr, mpinei(jpso) )
+      IF( mpinei(jpno) >= 0  )   CALL RECVROUTINE( 3, r2dns(1-kexti,1,2), imigr, mpinei(jpno) )
+      IF( mpinei(jpso) >= 0  )   CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      IF( mpinei(jpso) >= 0  )   CALL mpi_wait(ml_req2,ml_stat,ml_err)
       !
       IF( ln_timing ) CALL tic_tac(.FALSE.)
@@ -200 +165 @@
       ijhom = jpj - nn_hls
       !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, iprecj
-            pt2d(:,ijhom+jl) = r2dns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, iprecj
-            pt2d(:,jl-kextj) = r2dsn(:,jl,2)
-            pt2d(:,ijhom+jl) = r2dns(:,jl,2)
-         END DO
-      CASE ( 1 )
+      IF( mpinei(jpso) >= 0  ) THEN
          DO jl = 1, iprecj
             pt2d(:,jl-kextj) = r2dsn(:,jl,2)
          END DO
-      END SELECT
+      ENDIF
+       IF( mpinei(jpno) >= 0  ) THEN
+        DO jl = 1, iprecj
+            pt2d(:,ijhom+jl) = r2dns(:,jl,2)
+         END DO
+      ENDIF
       !
    END SUBROUTINE ROUTINE_LNK

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/mpp_nc_generic.h90

@@ -46 +46 @@
       CHARACTER(len=*)              , INTENT(in   ) ::   cdname      ! name of the calling subroutine
       CHARACTER(len=1)              , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
-      REAL(wp)                      , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      REAL(PRECISION)               , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
       INTEGER ,             OPTIONAL, INTENT(in   ) ::   kfillmode   ! filling method for halo over land (default = constant)
-      REAL(wp),             OPTIONAL, INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries)
+      REAL(PRECISION),      OPTIONAL, INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries)
       LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in   ) ::   lsend, lrecv  ! communication with other 4 proc
       LOGICAL,              OPTIONAL, INTENT(in   ) ::   ncsten      ! 5-point or 9-point stencil
       !
-      INTEGER  ::   ji,  jj,  jk,  jl,  jf                                      ! dummy loop indices
-      INTEGER  ::   ipi, ipj, ipk, ipl, ipf                                     ! dimension of the input array
-      INTEGER  ::   ishift, ishift2, idx, icount, icount1                       ! local integers
-      INTEGER  ::   idims, idimr, isizet, isizets, isizetr, izsnd, izrcv        ! local integers
+      INTEGER  ::   ji, jj, jk, jl, jf, jn      ! dummy loop indices
+      INTEGER  ::   ipk, ipl, ipf                                     ! dimension of the input array
+      INTEGER  ::   ip0i, ip1i, im0i, im1i
+      INTEGER  ::   ip0j, ip1j, im0j, im1j
+      INTEGER  ::   ishti, ishtj, ishti2, ishtj2
+      INTEGER  ::   iszs, iszr
       INTEGER  ::   ierr
-      INTEGER  ::   ifill_we, ifill_ea, ifill_so, ifill_no
-      INTEGER  ::   ifill_web, ifill_eab
-      REAL(wp) ::   zland
-      INTEGER , DIMENSION(MPI_STATUS_SIZE)                        ::   istate              ! for mpi_isend
-      REAL(PRECISION), DIMENSION(:), ALLOCATABLE                  ::   zsnd, zrcv          ! halos arrays
-      INTEGER , DIMENSION(:), ALLOCATABLE                         ::   isizes              ! number of elements to be sent
-      INTEGER , DIMENSION(:), ALLOCATABLE                         ::   isizer              ! number of elements to be received
-      INTEGER , DIMENSION(:), ALLOCATABLE                         ::   idatatys, idatatyr  ! datatype of halos arrays
-      INTEGER (KIND=MPI_ADDRESS_KIND), DIMENSION (:), ALLOCATABLE ::   idispls, idisplr    ! displacement in halos arrays
-      LOGICAL  ::   llsend_we, llsend_ea, llsend_no, llsend_so       ! communication send
-      LOGICAL  ::   llrecv_we, llrecv_ea, llrecv_no, llrecv_so       ! communication receive 
-      LOGICAL  ::   lldo_nfd                                         ! do north pole folding
+      INTEGER  ::   idx
+      INTEGER  ::   impi_nc
+      INTEGER, DIMENSION(4)  ::   iwewe, issnn
+      INTEGER, DIMENSION(8)  ::   isizei, ishtsi, ishtri, ishtpi
+      INTEGER, DIMENSION(8)  ::   isizej, ishtsj, ishtrj, ishtpj
+      INTEGER, DIMENSION(8)  ::   ifill, iszall
+      INTEGER, DIMENSION(:), ALLOCATABLE  ::   icounts, icountr    ! number of elements to be sent/received
+      INTEGER, DIMENSION(:), ALLOCATABLE  ::   idispls, idisplr    ! displacement in halos arrays
+      LOGICAL, DIMENSION(8)  ::   llsend, llrecv
+      REAL(PRECISION) ::   zland
+      REAL(PRECISION), DIMENSION(:), ALLOCATABLE  ::   zsnd, zrcv          ! halos arrays
       LOGICAL  ::   llncall                                          ! default: 9-point stencil
-
+      LOGICAL  ::   ll_IdoNFold
       !!----------------------------------------------------------------------
+#if defined PRINT_CAUTION
+      !
+      ! ================================================================================== !
+      ! CAUTION: semi-column notation is often impossible because of the cpp preprocessing !
+      ! ================================================================================== !
+      !
+#endif
       !
       ! ----------------------------------------- !
-      !     0. local variables initialization     !
+      !     1. local variables initialization     !
       ! ----------------------------------------- !
       !
-      llncall = .TRUE. 
       ipk = K_SIZE(ptab)   ! 3rd dimension
       ipl = L_SIZE(ptab)   ! 4th    -
@@ -84 +91 @@
       IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. )
       !
-      IF     ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN
-         llsend_we = lsend(1)   ;   llsend_ea = lsend(2)   ;   llsend_so = lsend(3)   ;   llsend_no = lsend(4)
-         llrecv_we = lrecv(1)   ;   llrecv_ea = lrecv(2)   ;   llrecv_so = lrecv(3)   ;   llrecv_no = lrecv(4)
-      ELSE IF( PRESENT(lsend) .OR.  PRESENT(lrecv) ) THEN
-         WRITE(ctmp1,*) ' E R R O R : Routine ', cdname, '  is calling lbc_lnk with only one of the two arguments lsend or lrecv'
-         WRITE(ctmp2,*) ' ========== '
-         CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' )
-      ELSE   ! send and receive with every neighbour
-         llsend_we = nbondi ==  1 .OR. nbondi == 0   ! keep for compatibility, should be defined in mppini
-         llsend_ea = nbondi == -1 .OR. nbondi == 0   ! keep for compatibility, should be defined in mppini
-         llsend_so = nbondj ==  1 .OR. nbondj == 0   ! keep for compatibility, should be defined in mppini
-         llsend_no = nbondj == -1 .OR. nbondj == 0   ! keep for compatibility, should be defined in mppini
-         llrecv_we = llsend_we   ;   llrecv_ea = llsend_ea   ;   llrecv_so = llsend_so   ;   llrecv_no = llsend_no
-      END IF
-         
-      lldo_nfd = npolj /= 0                      ! keep for compatibility, should be defined in mppini
-
+      ! take care of optional parameters
+      !
+      llncall = .TRUE. 
+      IF( PRESENT(ncsten) ) llncall = ncsten
+      !
+      impi_nc = mpi_nc_com4
+      IF(llncall)   impi_nc = mpi_nc_com8
+      !
       zland = 0._wp                                     ! land filling value: zero by default
       IF( PRESENT( pfillval ) )   zland = pfillval      ! set land value
-
-
-      ! define the method we will use to fill the halos in each direction
-      IF(              llrecv_we ) THEN   ;   ifill_we = jpfillmpi
-      ELSEIF(           l_Iperio ) THEN   ;   ifill_we = jpfillperio
-      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_we = kfillmode
-      ELSE                                ;   ifill_we = jpfillcst
+      !
+      ! define llsend and llrecv: logicals which say if mpi-neibourgs for send or receive exist or not.
+      IF     ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN   ! localy defined neighbourgs 
+         CALL ctl_stop( 'STOP', 'mpp_nc_generic+BDY not yet implemented')
+!!$         ---> llsend(:) = lsend(:)   ;   llrecv(:) = lrecv(:) ???
+      ELSE IF( PRESENT(lsend) .OR.  PRESENT(lrecv) ) THEN
+         WRITE(ctmp1,*) ' Routine ', cdname, '  is calling lbc_lnk with only one of the two arguments lsend or lrecv'
+         CALL ctl_stop( 'STOP', ctmp1 )
+      ELSE                                                  ! default neighbours
+         llsend(:) = mpinei(:) >= 0
+         IF( .NOT. llncall )   llsend(5:8) = .FALSE.        ! exclude corners
+         llrecv(:) = llsend(:)
       END IF
-      IF(               l_Iperio ) THEN   ;   ifill_web = jpfillperio
-      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_web = kfillmode
-      ELSE                                ;   ifill_web = jpfillcst
-      END IF
-      !
-      IF(              llrecv_ea ) THEN   ;   ifill_ea = jpfillmpi
-      ELSEIF(           l_Iperio ) THEN   ;   ifill_ea = jpfillperio
-      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_ea = kfillmode
-      ELSE                                ;   ifill_ea = jpfillcst
-      END IF
-      IF(               l_Iperio ) THEN   ;   ifill_eab = jpfillperio
-      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_eab = kfillmode
-      ELSE                                ;   ifill_eab = jpfillcst
-      END IF
-      !
-      IF(              llrecv_so ) THEN   ;   ifill_so = jpfillmpi
-      ELSEIF(           l_Jperio ) THEN   ;   ifill_so = jpfillperio
-      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_so = kfillmode
-      ELSE                                ;   ifill_so = jpfillcst
-      END IF
-      !
-      IF(              llrecv_no ) THEN   ;   ifill_no = jpfillmpi
-      ELSEIF(           l_Jperio ) THEN   ;   ifill_no = jpfillperio
-      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_no = kfillmode
-      ELSE                                ;   ifill_no = jpfillcst
-      END IF
-      !
-      IF(PRESENT(ncsten)) llncall = ncsten 
-#if defined PRINT_CAUTION
-      !
-      ! ================================================================================== !
-      ! CAUTION: semi-column notation is often impossible because of the cpp preprocessing !
-      ! ================================================================================== !
-      !
-#endif
-      !
-      ! -------------------------------------------------- !
-      !     1. Do west, east, south and north MPI exchange !
-      ! -------------------------------------------------- !
-      !
-      ! Allocate local temporary arrays to be sent/received. Fill arrays to be sent
-
-      idims = 0
-      idimr = 0
-      izsnd = 0
-      izrcv = 0
-
-      IF(llsend_we) idims = idims + 1
-      IF(llsend_ea) idims = idims + 1
-      IF(llsend_so) idims = idims + 1
-      IF(llsend_no) idims = idims + 1
-
-      idimr = idims
-
-      IF(llncall) THEN
-         IF(noswr .ne. -1) idimr = idimr + 1
-         IF(noser .ne. -1) idimr = idimr + 1
-         IF(nonwr .ne. -1) idimr = idimr + 1
-         IF(noner .ne. -1) idimr = idimr + 1
+      !
+      ! define ifill: which method should be used to fill each parts (sides+corners) of the halos
+      ! default definition
+      DO jn = 1, 8
+         IF(             llrecv(jn) ) THEN   ;   ifill(jn) = jpfillmpi    ! with an mpi communication
+         ELSEIF(    l_SelfPerio(jn) ) THEN   ;   ifill(jn) = jpfillperio  ! with self-periodicity
+         ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill(jn) = kfillmode    ! localy defined
+         ELSE                                ;   ifill(jn) = jpfillcst    ! constant value (zland)
+         END IF
+      END DO
+      ! take care of "indirect self-periodicity" for the corners
+      DO jn = 5, 8
+         IF(.NOT.l_SelfPerio(jn) .AND. l_SelfPerio(jpwe))   ifill(jn) = jpfillnothing   ! no bi-perio but ew-perio: do corners later
+         IF(.NOT.l_SelfPerio(jn) .AND. l_SelfPerio(jpso))   ifill(jn) = jpfillnothing   ! no bi-perio but ns-perio: do corners later
+      END DO
+      ! north fold treatment
+      ll_IdoNFold = l_IdoNFold .AND. ifill(jpno) /= jpfillnothing
+      IF( ll_IdoNFold )   ifill( (/jpno,jpnw,jpne/) ) = jpfillnothing   ! we do north fold -> do nothing for northern halos
       
-         IF(nosws .ne. -1) idims = idims + 1
-         IF(noses .ne. -1) idims = idims + 1
-         IF(nonws .ne. -1) idims = idims + 1
-         IF(nones .ne. -1) idims = idims + 1
-      END IF
-
-      IF(llsend_we) izsnd = izsnd + nn_hls * (jpj - 2*nn_hls) * ipk * ipl * ipf
-      IF(llsend_ea) izsnd = izsnd + nn_hls * (jpj - 2*nn_hls) * ipk * ipl * ipf
-      IF(llsend_so) izsnd = izsnd + (jpi - 2*nn_hls) * nn_hls * ipk * ipl * ipf
-      IF(llsend_no) izsnd = izsnd + (jpi - 2*nn_hls) * nn_hls * ipk * ipl * ipf
-
-      izrcv = izsnd
+      !                    !                       ________________________
+      ip0i =          0    !          im0j = inner |__|________________|__|
+      ip1i =      nn_hls   !   im1j = inner - halo |  |__|__________|__|  |
+      im1i = Nie0-nn_hls   !                       |  |  |          |  |  |
+      im0i = Nie0          !                       |  |  |          |  |  |
+      ip0j =          0    !                       |  |  |          |  |  |
+      ip1j =      nn_hls   !                       |  |__|__________|__|  |
+      im1j = Nje0-nn_hls   !           ip1j = halo |__|__|__________|__|__|
+      im0j = Nje0          !              ip0j = 0 |__|________________|__|
+      !                    !                    ip0i ip1i        im1i im0i
+      !
+      iwewe(:) = (/ jpwe,jpea,jpwe,jpea /)   ;   issnn(:) = (/ jpso,jpso,jpno,jpno /)
+      !     sides:       west    east   south   north      ;       corners: so-we, so-ea, no-we, no-ea
+      isizei(1:4) = (/ nn_hls, nn_hls,   Ni_0,   Ni_0 /)   ;   isizei(5:8) = nn_hls            ! i- count
+      isizej(1:4) = (/   Nj_0,   Nj_0, nn_hls, nn_hls /)   ;   isizej(5:8) = nn_hls            ! j- count
+      ishtsi(1:4) = (/   ip1i,   im1i,   ip1i,   ip1i /)   ;   ishtsi(5:8) = ishtsi( iwewe )   ! i- shift send data
+      ishtsj(1:4) = (/   ip1j,   ip1j,   ip1j,   im1j /)   ;   ishtsj(5:8) = ishtsj( issnn )   ! j- shift send data
+      ishtri(1:4) = (/   ip0i,   im0i,   ip1i,   ip1i /)   ;   ishtri(5:8) = ishtri( iwewe )   ! i- shift received data location
+      ishtrj(1:4) = (/   ip1j,   ip1j,   ip0j,   im0j /)   ;   ishtrj(5:8) = ishtrj( issnn )   ! j- shift received data location
+      ishtpi(1:4) = (/   im1i,   ip1i,   ip1i,   ip1i /)   ;   ishtpi(5:8) = ishtpi( iwewe )   ! i- shift data used for periodicity
+      ishtpj(1:4) = (/   ip1j,   ip1j,   im1j,   ip1j /)   ;   ishtpj(5:8) = ishtpj( issnn )   ! j- shift data used for periodicity
+      !
+      ! -------------------------------- !
+      !     2. Prepare MPI exchanges     !
+      ! -------------------------------- !
+      !
+      ! Allocate local temporary arrays to be sent/received.
+      iszs = COUNT( llsend )
+      iszr = COUNT( llrecv )
+      ALLOCATE( icounts(iszs), icountr(iszr), idispls(iszs), idisplr(iszr) )   ! ok if iszs = 0 or iszr = 0
+      iszall(:) = isizei(:) * isizej(:) * ipk * ipl * ipf
+      icounts(:) = PACK( iszall, mask = llsend )                                       ! ok if mask = .false.
+      icountr(:) = PACK( iszall, mask = llrecv )
+      idispls(1) = 0
+      DO jn = 2,iszs
+         idispls(jn) = idispls(jn-1) + icounts(jn-1)   ! with _alltoallv: in units of sendtype
+      END DO
+      idisplr(1) = 0
+      DO jn = 2,iszr
+         idisplr(jn) = idisplr(jn-1) + icountr(jn-1)   ! with _alltoallv: in units of sendtype
+      END DO
       
-      IF(llncall) THEN
-         IF(noswr .ne. -1) izrcv = izrcv + nn_hls * nn_hls * ipk * ipl * ipf
-         IF(noser .ne. -1) izrcv = izrcv + nn_hls * nn_hls * ipk * ipl * ipf
-         IF(nonwr .ne. -1) izrcv = izrcv + nn_hls * nn_hls * ipk * ipl * ipf
-         IF(noner .ne. -1) izrcv = izrcv + nn_hls * nn_hls * ipk * ipl * ipf
-
-         IF(nosws .ne. -1) izsnd = izsnd + nn_hls * nn_hls * ipk * ipl * ipf
-         IF(noses .ne. -1) izsnd = izsnd + nn_hls * nn_hls * ipk * ipl * ipf
-         IF(nonws .ne. -1) izsnd = izsnd + nn_hls * nn_hls * ipk * ipl * ipf
-         IF(nones .ne. -1) izsnd = izsnd + nn_hls * nn_hls * ipk * ipl * ipf
-      END IF
-
-      ALLOCATE(zsnd(izsnd))
-      ALLOCATE(zrcv(izrcv))
-      ALLOCATE(isizes(idims))
-      ALLOCATE(isizer(idimr))
-      ALLOCATE(idatatys(idims))
-      ALLOCATE(idatatyr(idimr))
-      ALLOCATE(idispls(idims))
-      ALLOCATE(idisplr(idimr))
-
-      zrcv(:)=-1
-      zsnd(:)=-1
-      isizes(:) = 0
-      isizer(:) = 0
-      idispls(:) = 0
-      idisplr(:) = 0
-      isizet = 0 
-     
+      ALLOCATE( zsnd(SUM(icounts)), zrcv(SUM(icountr)) )
+
+      ! fill sending buffer with ARRAY_IN
       idx = 1
-      icount = 1
-
-      IF(llsend_we) THEN
-         DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = nn_hls + 1, jpj - nn_hls  ;  DO ji = 1, nn_hls
-            zsnd(idx) = ARRAY_IN(nn_hls+ji,jj,jk,jl,jf)
-            idx = idx + 1
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-
-         isizes(icount) = nn_hls * (jpj - 2*nn_hls) * ipk * ipl * ipf
-         IF(icount .gt. 1) isizet = isizet + isizes(icount - 1)
-         idispls(icount) = jpbyt*isizet
-         icount = icount + 1
-      END IF
-
-      IF(llsend_ea) THEN
-         ishift = jpi-2*nn_hls
-
-         DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = nn_hls + 1, jpj - nn_hls  ;  DO ji = 1, nn_hls
-            zsnd(idx) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)
-            idx = idx + 1
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-
-         isizes(icount) = nn_hls * (jpj - 2*nn_hls) * ipk * ipl * ipf
-         IF(icount .gt. 1) isizet = isizet + isizes(icount - 1)
-         idispls(icount) = jpbyt*isizet
-         icount = icount + 1
-      END IF
-
-      IF(llsend_so) THEN
-         DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1, nn_hls  ;  DO ji = nn_hls + 1, jpi - nn_hls
-            zsnd(idx) = ARRAY_IN(ji,nn_hls+jj,jk,jl,jf)
-            idx = idx + 1
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-
-         isizes(icount) = (jpi - 2*nn_hls) * nn_hls * ipk * ipl * ipf
-         IF(icount .gt. 1) isizet = isizet + isizes(icount - 1)
-         idispls(icount) = jpbyt*isizet
-         icount = icount + 1
-      END IF
-
-      IF(llsend_no) THEN
-         ishift = jpj-2*nn_hls
-
-         DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1, nn_hls  ;  DO ji = nn_hls + 1, jpi - nn_hls
-            zsnd(idx) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)
-            idx = idx + 1
-         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-
-         isizes(icount) = (jpi - 2*nn_hls) * nn_hls * ipk * ipl * ipf
-         IF(icount .gt. 1) isizet = isizet + isizes(icount - 1)
-         idispls(icount) = jpbyt*isizet
-         icount = icount + 1
-      END IF
-
-      isizer(:) = isizes(:)
-      idisplr(:) = idispls(:)
-      
-      icount1 = icount
-      isizets = isizet 
-      isizetr = isizet 
-
-      IF(llncall) THEN
-         IF(noswr .ne. -1) THEN
-            isizer(icount1) = nn_hls * nn_hls * ipk * ipl * ipf
-            IF(icount1 .gt. 1) isizetr = isizetr + isizer(icount1 - 1)
-            idisplr(icount1) = jpbyt*isizetr
-            icount1 = icount1 + 1
+      DO jn = 1, 8
+         IF( llsend(jn) ) THEN
+            ishti = ishtsi(jn)
+            ishtj = ishtsj(jn)
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               zsnd(idx) = ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf)
+               idx = idx + 1
+            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
          END IF
-         IF(noser .ne. -1) THEN
-            isizer(icount1) = nn_hls * nn_hls * ipk * ipl * ipf
-            IF(icount1 .gt. 1) isizetr = isizetr + isizer(icount1 - 1)
-            idisplr(icount1) = jpbyt*isizetr
-            icount1 = icount1 + 1
-         END IF
-         IF(nonwr .ne. -1) THEN
-            isizer(icount1) = nn_hls * nn_hls * ipk * ipl * ipf
-            IF(icount1 .gt. 1) isizetr = isizetr + isizer(icount1 - 1)
-            idisplr(icount1) = jpbyt*isizetr
-            icount1 = icount1 + 1
-         END IF
-         IF(noner .ne. -1) THEN
-            isizer(icount1) = nn_hls * nn_hls * ipk * ipl * ipf
-            IF(icount1 .gt. 1) isizetr = isizetr + isizer(icount1 - 1)
-            idisplr(icount1) = jpbyt*isizetr
-            icount1 = icount1 + 1
-         END IF
-
-         IF(nosws .ne. -1) THEN
-            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1, nn_hls  ;  DO ji = 1, nn_hls
-               zsnd(idx) = ARRAY_IN(nn_hls+ji,nn_hls+jj,jk,jl,jf)
+      END DO
+      !
+      ! ------------------------------------------------ !
+      !     3. Do all MPI exchanges in 1 unique call     !
+      ! ------------------------------------------------ !
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE.)
+      CALL mpi_neighbor_alltoallv (zsnd, icounts, idispls, MPI_TYPE, zrcv, icountr, idisplr, MPI_TYPE, impi_nc, ierr)
+      IF( ln_timing ) CALL tic_tac(.FALSE.)
+      !
+      ! ------------------------- !
+      !     4. Fill all halos     !
+      ! ------------------------- !
+      !
+      idx = 1
+      DO jn = 1, 8
+         ishti = ishtri(jn)
+         ishtj = ishtrj(jn)
+         SELECT CASE ( ifill(jn) )
+         CASE ( jpfillnothing )               ! no filling 
+         CASE ( jpfillmpi   )                 ! fill with data received by MPI
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf) = zrcv(idx)
                idx = idx + 1
             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-
-            isizes(icount) = nn_hls * nn_hls * ipk * ipl * ipf
-            IF(icount .gt. 1) isizets = isizets + isizes(icount - 1)
-            idispls(icount) = jpbyt*isizets
-            icount = icount + 1
-         END IF
-         IF(noses .ne. -1) THEN
-            ishift = jpi-2*nn_hls
-            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1, nn_hls  ;  DO ji = 1, nn_hls
-               zsnd(idx) = ARRAY_IN(ji+ishift,nn_hls+jj,jk,jl,jf)
-               idx = idx + 1
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-
-            isizes(icount) = nn_hls * nn_hls * ipk * ipl * ipf
-            IF(icount .gt. 1) isizets = isizets + isizes(icount - 1)
-            idispls(icount) = jpbyt*isizets
-            icount = icount + 1
-         END IF
-         IF(nonws .ne. -1) THEN
-            ishift = jpj-2*nn_hls
-            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1, nn_hls  ;  DO ji = 1, nn_hls
-               zsnd(idx) = ARRAY_IN(nn_hls+ji,jj+ishift,jk,jl,jf)
-               idx = idx + 1
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-
-            isizes(icount) = nn_hls * nn_hls * ipk * ipl * ipf
-            IF(icount .gt. 1) isizets = isizets + isizes(icount - 1)
-            idispls(icount) = jpbyt*isizets
-            icount = icount + 1
-         END IF
-         IF(nones .ne. -1) THEN
-            ishift = jpi-2*nn_hls
-            ishift2 = jpj-2*nn_hls
-            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1, nn_hls  ;  DO ji = 1, nn_hls
-               zsnd(idx) = ARRAY_IN(ji+ishift,jj+ishift2,jk,jl,jf)
-               idx = idx + 1
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-
-            isizes(icount) = nn_hls * nn_hls * ipk * ipl * ipf
-            IF(icount .gt. 1) isizets = isizets + isizes(icount - 1)
-            idispls(icount) = jpbyt*isizets
-            icount = icount + 1
-         END IF
-      END IF
-
-      idatatys(:) = MPI_TYPE
-      idatatyr(:) = MPI_TYPE
-
-      IF(llncall) THEN
-         IF( ln_timing ) CALL tic_tac(.TRUE.)
-         CALL mpi_neighbor_alltoallw (zsnd, isizes, idispls, idatatys, zrcv, isizer, idisplr, idatatyr, mpi_nc_all_com, ierr)
-         IF( ln_timing ) CALL tic_tac(.FALSE.)
-      ELSE
-         IF( ln_timing ) CALL tic_tac(.TRUE.)
-         CALL mpi_neighbor_alltoallw (zsnd, isizes, idispls, idatatys, zrcv, isizer, idisplr, idatatyr, mpi_nc_com, ierr)
-         IF( ln_timing ) CALL tic_tac(.FALSE.)
-      END IF
-
-      ! --------------------------------------------------- !
-      !     2. Fill east and west north and south halos     !
-      ! --------------------------------------------------- !
-      !
-      !!! Patch to solve MPI3 bug when we have only two processes columns
-      IF(jpni .eq. 2) THEN
-         ! ---------------------
-         ! 2.2 fill eastern halo
-         ! ---------------------
-         idx = 1
-         ishift = jpi - nn_hls                ! fill halo from ji = jpi-nn_hls+1 to jpi
-         SELECT CASE ( ifill_ea )
-         CASE ( jpfillnothing )               ! no filling
-         CASE ( jpfillmpi   )                 ! use data received by MPI
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = nn_hls + 1, jpj - nn_hls   ;   DO ji = 1, nn_hls
-               ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv(idx)   ! jpi - nn_hls + 1 -> jpi
-               idx = idx + 1
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillperio )                 ! use east-weast periodicity
-            ishift2 = nn_hls
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-               ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)
+         CASE ( jpfillperio )                 ! use periodicity
+            ishti2 = ishtpi(jn)
+            ishtj2 = ishtpj(jn)
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf) = ARRAY_IN(ishti2+ji,ishtj2+jj,jk,jl,jf)
             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
          CASE ( jpfillcopy  )                 ! filling with inner domain values
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-               ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf)
+            ishti2 = ishtsi(jn)
+            ishtj2 = ishtsj(jn)
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf) = ARRAY_IN(ishti2+ji,ishtj2+jj,jk,jl,jf)
             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
          CASE ( jpfillcst   )                 ! filling with constant value
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-               ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf) = zland
             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
          END SELECT
-         ! ----------------------
-         ! 2.1 fill weastern halo
-         ! ----------------------
-         SELECT CASE ( ifill_we )
-         CASE ( jpfillnothing )               ! no filling
-         CASE ( jpfillmpi   )                 ! use data received by MPI
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = nn_hls + 1, jpj - nn_hls   ;   DO ji = 1, nn_hls
-               ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx)   ! 1 -> nn_hls
-               idx = idx + 1
-            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillperio )                 ! use east-weast periodicity
-            ishift2 = jpi - 2 * nn_hls
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-               ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillcopy  )                 ! filling with inner domain values
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-               ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(nn_hls+1,jj,jk,jl,jf)
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillcst   )                 ! filling with constant value
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-               ARRAY_IN(ji,jj,jk,jl,jf) = zland
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         END SELECT
-
-      ELSE
-
-         ! ----------------------
-         ! 2.1 fill weastern halo
-         ! ----------------------
-         idx = 1
-         SELECT CASE ( ifill_we )
-         CASE ( jpfillnothing )               ! no filling 
-         CASE ( jpfillmpi   )                 ! use data received by MPI 
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = nn_hls + 1, jpj - nn_hls   ;   DO ji = 1, nn_hls
-               ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx)   ! 1 -> nn_hls
-               idx = idx + 1
-            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillperio )                 ! use east-weast periodicity
-            ishift2 = jpi - 2 * nn_hls
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-               ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillcopy  )                 ! filling with inner domain values
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-               ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(nn_hls+1,jj,jk,jl,jf)
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillcst   )                 ! filling with constant value
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-               ARRAY_IN(ji,jj,jk,jl,jf) = zland
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         END SELECT
-         ! ---------------------
-         ! 2.2 fill eastern halo
-         ! ---------------------
-         ishift = jpi - nn_hls                ! fill halo from ji = jpi-nn_hls+1 to jpi 
-         SELECT CASE ( ifill_ea )
-         CASE ( jpfillnothing )               ! no filling 
-         CASE ( jpfillmpi   )                 ! use data received by MPI 
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = nn_hls + 1, jpj - nn_hls   ;   DO ji = 1, nn_hls
-               ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv(idx)   ! jpi - nn_hls + 1 -> jpi
-               idx = idx + 1
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillperio )                 ! use east-weast periodicity
-            ishift2 = nn_hls
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-               ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillcopy  )                 ! filling with inner domain values
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-               ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf)
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillcst   )                 ! filling with constant value
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
-               ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         END SELECT
-
-      ENDIF
-
-      !!! Patch to solve MPI3 bug when we have only two processes rows
-      IF(jpnj .eq. 2) THEN
-         ! ----------------------
-         ! 2.3 fill northern halo
-         ! ----------------------
-         ishift = jpj - nn_hls                ! fill halo from jj = jpj-nn_hls+1 to jpj 
-         SELECT CASE ( ifill_no )
-         CASE ( jpfillnothing )               ! no filling 
-         CASE ( jpfillmpi   )                 ! use data received by MPI 
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = nn_hls + 1, jpi - nn_hls
-               ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv(idx)   ! jpj-nn_hls+1 -> jpj
-               idx = idx + 1
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-            IF(nonwr .eq. -1) THEN
-               ishift = jpj - nn_hls
-               SELECT CASE ( ifill_web )
-                  CASE ( jpfillperio )
-                     ishift2 = jpi - 2 * nn_hls
-                     DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1 + ishift, jpj   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                  CASE ( jpfillcopy  )
-                     DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1 + ishift, jpj   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(nn_hls+1,jj,jk,jl,jf)
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-
-                  CASE ( jpfillcst   )
-                     DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1 + ishift, jpj   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ji,jj,jk,jl,jf) = zland
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-               END SELECT
-            END IF
-            IF(noner .eq. -1) THEN
-               ishift = jpi - nn_hls
-               ishift2 = jpj - nn_hls
-               SELECT CASE ( ifill_eab )
-                  CASE ( jpfillperio )
-                     DO jf = 1, ipf  ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1 + ishift2, jpj   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ji,jj,jk,jl,jf)
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-
-                  CASE ( jpfillcopy  )
-                     DO jf = 1, ipf  ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1 + ishift2, jpj   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf)
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                  CASE ( jpfillcst   )
-                     DO jf = 1, ipf  ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1 + ishift2, jpj   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-               END SELECT
-            END IF
-         CASE ( jpfillperio )                 ! use north-south periodicity
-            ishift2 = nn_hls
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-               ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf)
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillcopy  )                 ! filling with inner domain values
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-               ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf)
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillcst   )                 ! filling with constant value
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-               ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         END SELECT
-
-         ! ----------------------
-         ! 2.4 fill southern halo
-         ! ----------------------
-         SELECT CASE ( ifill_so )
-         CASE ( jpfillnothing )               ! no filling 
-         CASE ( jpfillmpi   )                 ! use data received by MPI 
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls
-               ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx)   ! 1 -> nn_hls
-               idx = idx + 1
-            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO
-            IF(noswr .eq. -1) THEN
-               SELECT CASE ( ifill_web )
-                  CASE ( jpfillperio )
-                     ishift2 = jpi - 2 * nn_hls
-                     DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                  CASE ( jpfillcopy  )
-                     DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(nn_hls+1,jj,jk,jl,jf)
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-
-                  CASE ( jpfillcst   )
-                     DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ji,jj,jk,jl,jf) = zland
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-               END SELECT
-            END IF
-            IF(noser .eq. -1) THEN
-               ishift = jpi - nn_hls
-               SELECT CASE ( ifill_eab )
-                  CASE ( jpfillperio )
-                     DO jf = 1, ipf  ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ji+nn_hls,jj,jk,jl,jf)
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-
-                  CASE ( jpfillcopy  )
-                     DO jf = 1, ipf  ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf)
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                  CASE ( jpfillcst   )
-                     DO jf = 1, ipf  ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-               END SELECT
-            END IF
-         CASE ( jpfillperio )                 ! use north-south periodicity
-            ishift2 = jpj - 2 * nn_hls
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-               ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf)
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillcopy  )                 ! filling with inner domain values
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-               ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf)
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillcst   )                 ! filling with constant value
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-               ARRAY_IN(ji,jj,jk,jl,jf) = zland
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         END SELECT
-      ELSE
-         ! ----------------------
-         ! 2.3 fill southern halo
-         ! ----------------------
-         SELECT CASE ( ifill_so )
-         CASE ( jpfillnothing )               ! no filling 
-         CASE ( jpfillmpi   )                 ! use data received by MPI 
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls
-               ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx)   ! 1 -> nn_hls
-               idx = idx + 1
-            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO
-            IF(noswr .eq. -1) THEN
-               SELECT CASE ( ifill_web )
-                  CASE ( jpfillperio )
-                     ishift2 = jpi - 2 * nn_hls
-                     DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                  CASE ( jpfillcopy  )
-                     DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(nn_hls+1,jj,jk,jl,jf)
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-
-                  CASE ( jpfillcst   )
-                     DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ji,jj,jk,jl,jf) = zland
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-               END SELECT
-            END IF
-            IF(noser .eq. -1) THEN
-               ishift = jpi - nn_hls
-               SELECT CASE ( ifill_eab )
-                  CASE ( jpfillperio )
-                     DO jf = 1, ipf  ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ji+nn_hls,jj,jk,jl,jf)
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-
-                  CASE ( jpfillcopy  )
-                     DO jf = 1, ipf  ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf)
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                  CASE ( jpfillcst   )
-                     DO jf = 1, ipf  ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-               END SELECT
-            END IF
-         CASE ( jpfillperio )                 ! use north-south periodicity
-            ishift2 = jpj - 2 * nn_hls
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-               ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf)
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillcopy  )                 ! filling with inner domain values
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-               ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf)
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillcst   )                 ! filling with constant value
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-               ARRAY_IN(ji,jj,jk,jl,jf) = zland
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         END SELECT
-
-         ! ----------------------
-         ! 2.4 fill northern halo
-         ! ----------------------
-         ishift = jpj - nn_hls                ! fill halo from jj = jpj-nn_hls+1 to jpj 
-         SELECT CASE ( ifill_no )
-         CASE ( jpfillnothing )               ! no filling 
-         CASE ( jpfillmpi   )                 ! use data received by MPI 
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = nn_hls + 1, jpi - nn_hls
-               ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv(idx)   ! jpj-nn_hls+1 -> jpj
-               idx = idx + 1
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-            IF(nonwr .eq. -1) THEN
-               ishift = jpj - nn_hls
-               SELECT CASE ( ifill_web )
-                  CASE ( jpfillperio )
-                     ishift2 = jpi - 2 * nn_hls
-                     DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1 + ishift, jpj   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                  CASE ( jpfillcopy  )
-                     DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1 + ishift, jpj   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(nn_hls+1,jj,jk,jl,jf)
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-
-                  CASE ( jpfillcst   )
-                     DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1 + ishift, jpj   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ji,jj,jk,jl,jf) = zland
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-               END SELECT
-            END IF
-            IF(noner .eq. -1) THEN
-               ishift = jpi - nn_hls
-               ishift2 = jpj - nn_hls
-               SELECT CASE ( ifill_eab )
-                  CASE ( jpfillperio )
-                     DO jf = 1, ipf  ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1 + ishift2, jpj   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ji,jj,jk,jl,jf)
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-
-                  CASE ( jpfillcopy  )
-                     DO jf = 1, ipf  ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1 + ishift2, jpj   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf)
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                  CASE ( jpfillcst   )
-                     DO jf = 1, ipf  ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1 + ishift2, jpj   ;  DO ji = 1, nn_hls
-                        ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland
-                     END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-               END SELECT
-            END IF
-         CASE ( jpfillperio )                 ! use north-south periodicity
-            ishift2 = nn_hls
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-               ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf)
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillcopy  )                 ! filling with inner domain values
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-               ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf)
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         CASE ( jpfillcst   )                 ! filling with constant value
-            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
-               ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland
-            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-         END SELECT
-      ENDIF
-
-      IF(llncall) THEN
-
-         !!! Patch to solve MPI3 bug when we have only two processes columns
-         IF(jpni .eq. 2) THEN
-            !!! Patch to solve MPI3 bug when we have only two processes rows
-            IF(jpnj .eq. 2) THEN
-               ! ---------------------------
-               ! 2.5 fill east-nouthern halo
-               ! ---------------------------
-                 IF(noner .ne. -1) THEN
-                    ishift = jpi - nn_hls
-                    ishift2 = jpj - nn_hls
-                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                       ARRAY_IN(ji+ishift,jj+ishift2,jk,jl,jf) = zrcv(idx)
-                       idx = idx + 1
-                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                 END IF
-               ! ---------------------------
-               ! 2.6 fill west-nouthern halo
-               ! ---------------------------
-                 IF(nonwr .ne. -1) THEN
-                    ishift = jpj - nn_hls
-                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                       ARRAY_IN(ji,jj+ishift,jk,jl,jf) = zrcv(idx)
-                       idx = idx + 1
-                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                 END IF
-               ! ---------------------------
-               ! 2.7 fill east-southern halo
-               ! ---------------------------
-                 IF(noser .ne. -1) THEN
-                    ishift = jpi - nn_hls
-                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                       ARRAY_IN(ji+ishift,jj,jk,jl,jf) = zrcv(idx)
-                       idx = idx + 1
-                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                 END IF
-               ! ---------------------------
-               ! 2.8 fill west-southern halo
-               ! ---------------------------
-                 IF(noswr .ne. -1) THEN
-                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                       ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx)
-                       idx = idx + 1
-                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                 END IF
-
-            ELSE
-               ! ---------------------------
-               ! 2.5 fill east-southern halo
-               ! ---------------------------
-                 IF(noser .ne. -1) THEN
-                    ishift = jpi - nn_hls
-                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                       ARRAY_IN(ji+ishift,jj,jk,jl,jf) = zrcv(idx)
-                       idx = idx + 1
-                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                 END IF
-               ! ---------------------------
-               ! 2.6 fill west-southern halo
-               ! ---------------------------
-                 IF(noswr .ne. -1) THEN
-                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                       ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx)
-                       idx = idx + 1
-                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                 END IF
-               ! ---------------------------
-               ! 2.7 fill east-nouthern halo
-               ! ---------------------------
-                 IF(noner .ne. -1) THEN
-                    ishift = jpi - nn_hls
-                    ishift2 = jpj - nn_hls
-                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                       ARRAY_IN(ji+ishift,jj+ishift2,jk,jl,jf) = zrcv(idx)
-                       idx = idx + 1
-                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                 END IF
-               ! ---------------------------
-               ! 2.8 fill west-nouthern halo
-               ! ---------------------------
-                 IF(nonwr .ne. -1) THEN
-                    ishift = jpj - nn_hls
-                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                       ARRAY_IN(ji,jj+ishift,jk,jl,jf) = zrcv(idx)
-                       idx = idx + 1
-                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                 END IF
-            ENDIF
-         ELSE
-            !!! Patch to solve MPI3 bug when we have only two processes rows
-            IF(jpnj .eq. 2) THEN
-               ! ---------------------------
-               ! 2.5 fill west-nouthern halo
-               ! ---------------------------
-                 IF(nonwr .ne. -1) THEN
-                    ishift = jpj - nn_hls
-                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                       ARRAY_IN(ji,jj+ishift,jk,jl,jf) = zrcv(idx)
-                       idx = idx + 1
-                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                 END IF
-               ! ---------------------------
-               ! 2.6 fill east-nouthern halo
-               ! ---------------------------
-                 IF(noner .ne. -1) THEN
-                    ishift = jpi - nn_hls
-                    ishift2 = jpj - nn_hls
-                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                       ARRAY_IN(ji+ishift,jj+ishift2,jk,jl,jf) = zrcv(idx)
-                       idx = idx + 1
-                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                 END IF
-               ! ---------------------------
-               ! 2.7 fill west-southern halo
-               ! ---------------------------
-                 IF(noswr .ne. -1) THEN
-                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                       ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx)
-                       idx = idx + 1
-                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                 END IF
-               ! ---------------------------
-               ! 2.8 fill east-southern halo
-               ! ---------------------------
-                 IF(noser .ne. -1) THEN
-                    ishift = jpi - nn_hls
-                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                       ARRAY_IN(ji+ishift,jj,jk,jl,jf) = zrcv(idx)
-                       idx = idx + 1
-                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                 END IF
-
-            ELSE
-               ! ---------------------------
-               ! 2.5 fill west-southern halo
-               ! ---------------------------
-                 IF(noswr .ne. -1) THEN
-                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                       ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx)
-                       idx = idx + 1
-                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                 END IF
-               ! ---------------------------
-               ! 2.6 fill east-southern halo
-               ! ---------------------------
-                 IF(noser .ne. -1) THEN
-                    ishift = jpi - nn_hls
-                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                       ARRAY_IN(ji+ishift,jj,jk,jl,jf) = zrcv(idx)
-                       idx = idx + 1
-                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                 END IF
-               ! ---------------------------
-               ! 2.7 fill west-nouthern halo
-               ! ---------------------------
-                 IF(nonwr .ne. -1) THEN
-                    ishift = jpj - nn_hls
-                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                       ARRAY_IN(ji,jj+ishift,jk,jl,jf) = zrcv(idx)
-                       idx = idx + 1
-                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                 END IF
-               ! ---------------------------
-               ! 2.8 fill east-nouthern halo
-               ! ---------------------------
-                 IF(noner .ne. -1) THEN
-                    ishift = jpi - nn_hls
-                    ishift2 = jpj - nn_hls
-                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls
-                       ARRAY_IN(ji+ishift,jj+ishift2,jk,jl,jf) = zrcv(idx)
-                       idx = idx + 1
-                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
-                 END IF
-            ENDIF
-         END IF
-      END IF
-
-
-      !
-      ! -------------------------------------------- !
-      !     3. deallocate local temporary arrays     !
-      ! -------------------------------------------- !
-      !
-      DEALLOCATE( zsnd )
-      DEALLOCATE( zrcv )
-      DEALLOCATE(isizes)
-      DEALLOCATE(isizer)
-      DEALLOCATE(idatatys)
-      DEALLOCATE(idatatyr)
-      DEALLOCATE(idispls)
-      DEALLOCATE(idisplr)
+      END DO
+
+      DEALLOCATE( icounts, icountr, idispls, idisplr, zsnd, zrcv )
+
+      ! potential "indirect self-periodicity" for the corners
+      DO jn = 5, 8
+         IF( .NOT. l_SelfPerio(jn) .AND. l_SelfPerio(jpwe)  ) THEN   ! no bi-perio but ew-perio: corners indirect definition
+            ishti  = ishtri(jn)
+            ishtj  = ishtrj(jn)
+            ishti2 = ishtpi(jn)   ! use i- shift periodicity
+            ishtj2 = ishtrj(jn)   ! use j- shift recv location: use ew-perio -> ok as filling of the south and north halos now done
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf) = ARRAY_IN(ishti2+ji,ishtj2+jj,jk,jl,jf)
+            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+         ENDIF
+         IF( .NOT. l_SelfPerio(jn) .AND. l_SelfPerio(jpso)  ) THEN   ! no bi-perio but ns-perio: corners indirect definition
+            ishti  = ishtri(jn)
+            ishtj  = ishtrj(jn)
+            ishti2 = ishtri(jn)   ! use i- shift recv location: use ns-perio -> ok as filling of the west and east halos now done
+            ishtj2 = ishtpj(jn)   ! use j- shift periodicity
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
+               ARRAY_IN(ishti+ji,ishtj+jj,jk,jl,jf) = ARRAY_IN(ishti2+ji,ishtj2+jj,jk,jl,jf)
+            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+         ENDIF
+      END DO
       !
       ! ------------------------------- !
-      !     4. north fold treatment     !
+      !     5. north fold treatment     !
       ! ------------------------------- !
       !
-      IF( lldo_nfd .AND. ifill_no /= jpfillnothing ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:)                  OPT_K(:) )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:), ifill_no, zland OPT_K(:) )   ! for all northern procs.
-         END SELECT
-         !
-         ifill_no = jpfillnothing  ! force to do nothing for the northern halo as we just done the north pole folding
-         !
+      IF( ll_IdoNFold ) THEN
+         IF( jpni == 1 )  THEN   ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:)                     OPT_K(:) )   ! self NFold
+         ELSE                    ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:), ifill(jpno), zland OPT_K(:) )   ! mpi  NFold
+         ENDIF
       ENDIF
 

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/mpp_nfd_generic.h90

@@ -80 +80 @@
       ARRAY_TYPE(:,:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied
       CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
-      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      REAL(PRECISION)  , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
       INTEGER          , INTENT(in   ) ::   kfillmode   ! filling method for halo over land 
-      REAL(wp)         , INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries)
+      REAL(PRECISION)  , INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries)
       INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays
       !
@@ -111 +111 @@
       ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
       !
-      IF( l_north_nogather ) THEN      !==  no allgather exchanges  ==!
+      IF( ln_nnogather ) THEN      !==  no allgather exchanges  ==!
 
          !   ---   define number of exchanged lines   ---
@@ -141 +141 @@
          IF( ll_add_line ) THEN
             DO jf = 1, ipf                      ! Loop over the number of arrays to be processed
-               ipj_s(jf) = nn_hls + COUNT( (/ npolj == 3 .OR. npolj == 4 .OR. NAT_IN(jf) == 'V' .OR. NAT_IN(jf) == 'F' /) ) 
+               ipj_s(jf) = nn_hls + COUNT( (/ l_NFoldT .OR. NAT_IN(jf) == 'V' .OR. NAT_IN(jf) == 'F' /) ) 
             END DO
          ELSE
@@ -155 +155 @@
          DO jf = 1, ipf                      ! Loop over the number of arrays to be processed
             !
-            SELECT CASE ( npolj )
-            CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+            IF( l_NFoldT ) THEN          ! *  North fold  T-point pivot
                SELECT CASE ( NAT_IN(jf) )
                CASE ( 'T', 'W', 'U' )   ;   i012 = 1   ! T-, U-, W-point
                CASE ( 'V', 'F'      )   ;   i012 = 2   ! V-, F-point
                END SELECT
-            CASE ( 5, 6 )                       ! *  North fold  F-point pivot
+            ENDIF
+            IF( l_NFoldF ) THEN          ! *  North fold  F-point pivot
                SELECT CASE ( NAT_IN(jf) )
                CASE ( 'T', 'W', 'U' )   ;   i012 = 0   ! T-, U-, W-point
                CASE ( 'V', 'F'      )   ;   i012 = 1   ! V-, F-point
                END SELECT
-            END SELECT
+            ENDIF
                !
             DO jj = 1, ipj_s(jf)

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/mppini.F90

@@ -69 +69 @@
       jpi    = jpiglo
       jpj    = jpjglo
-      jpk    = jpkglo
-      jpim1  = jpi-1                         ! inner domain indices
-      jpjm1  = jpj-1                         !   "           "
-      jpkm1  = MAX( 1, jpk-1 )               !   "           "
+      jpk    = MAX( 2, jpkglo )
       jpij   = jpi*jpj
       jpni   = 1
@@ -79 +76 @@
       nimpp  = 1
       njmpp  = 1
-      nbondi = 2
-      nbondj = 2
       nidom  = FLIO_DOM_NONE
-      npolj = 0
-      IF( jperio == 3 .OR. jperio == 4 )   npolj = 3
-      IF( jperio == 5 .OR. jperio == 6 )   npolj = 5
-      l_Iperio = jpni == 1 .AND. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7)
-      l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7)
       !
       CALL init_doloop                       ! set start/end indices or do-loop depending on the halo width value (nn_hls)
@@ -95 +85 @@
          WRITE(numout,*) '~~~~~~~~ '
          WRITE(numout,*) '   l_Iperio = ', l_Iperio, '    l_Jperio = ', l_Jperio
-         WRITE(numout,*) '     npolj  = ',   npolj , '      njmpp  = ', njmpp
+         WRITE(numout,*) '     njmpp  = ', njmpp
       ENDIF
       !
@@ -131 +121 @@
       !!                    njmpp     : latitudinal  index
       !!                    narea     : number for local area
-      !!                    nbondi    : mark for "east-west local boundary"
-      !!                    nbondj    : mark for "north-south local boundary"
-      !!                    noea      : number for local neighboring processor
-      !!                    nowe      : number for local neighboring processor
-      !!                    noso      : number for local neighboring processor
-      !!                    nono      : number for local neighboring processor
-      !!----------------------------------------------------------------------
-      INTEGER ::   ji, jj, jn, jproc, jarea   ! dummy loop indices
-      INTEGER ::   inijmin
-      INTEGER ::   inum                       ! local logical unit
-      INTEGER ::   idir, ifreq                ! local integers
-      INTEGER ::   ii, il1, ili, imil         !   -       -
-      INTEGER ::   ij, il2, ilj, ijm1         !   -       -
-      INTEGER ::   iino, ijno, iiso, ijso     !   -       -
-      INTEGER ::   iiea, ijea, iiwe, ijwe     !   -       -
-      INTEGER ::   iarea0                     !   -       -
-      INTEGER ::   ierr, ios                  !
-      INTEGER ::   inbi, inbj, iimax,  ijmax, icnt1, icnt2
+      !!                    mpinei    : number of neighboring domains (starting at 0, -1 if no neighbourg)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jn, jp
+      INTEGER ::   ii, ij, ii2, ij2
+      INTEGER ::   inijmin   ! number of oce subdomains
+      INTEGER ::   inum, inum0
+      INTEGER ::   ifreq, il1, imil, il2, ijm1
+      INTEGER ::   ierr, ios
+      INTEGER ::   inbi, inbj, iimax, ijmax, icnt1, icnt2
+      INTEGER, ALLOCATABLE, DIMENSION(:    ) ::   iin, ijn
+      INTEGER, ALLOCATABLE, DIMENSION(:,:  ) ::   iimppt, ijpi, ipproc
+      INTEGER, ALLOCATABLE, DIMENSION(:,:  ) ::   ijmppt, ijpj
+      INTEGER, ALLOCATABLE, DIMENSION(:,:  ) ::   impi
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) ::   inei
       LOGICAL ::   llbest, llauto
       LOGICAL ::   llwrtlay
+      LOGICAL ::   llmpi_Iperio, llmpi_Jperio, llmpiNfold
       LOGICAL ::   ln_listonly
-      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   iin, ii_nono, ii_noea          ! 1D workspace
-      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ijn, ii_noso, ii_nowe          !  -     -
-      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ijpi, ibondi, ipproc   ! 2D workspace
-      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ijpj, ibondj, ipolj    !  -     -
-      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iie0, iis0, iono, ioea         !  -     -
-      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ije0, ijs0, ioso, iowe         !  -     -
-      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   llisoce                        !  -     -
+      LOGICAL, ALLOCATABLE, DIMENSION(:,:  ) ::   llisOce  ! is not land-domain only?
+      LOGICAL, ALLOCATABLE, DIMENSION(:,:,:) ::   llnei    ! are neighbourgs existing?
       NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,           &
            &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
@@ -193 +175 @@
       IF(lwm)   WRITE( numond, nammpp )
       !
-!!!------------------------------------
-!!!  nn_hls shloud be read in nammpp
-!!!------------------------------------
       jpiglo = Ni0glo + 2 * nn_hls
       jpjglo = Nj0glo + 2 * nn_hls
@@ -213 +192 @@
       ! -----------------------------------
       !
-      ! If dimensions of processors grid weren't specified in the namelist file
+      ! If dimensions of MPI processes grid weren't specified in the namelist file
       ! then we calculate them here now that we have our communicator size
       IF(lwp) THEN
@@ -260 +239 @@
 
       ! look for land mpi subdomains...
-      ALLOCATE( llisoce(jpni,jpnj) )
-      CALL mpp_is_ocean( llisoce )
-      inijmin = COUNT( llisoce )   ! number of oce subdomains
+      ALLOCATE( llisOce(jpni,jpnj) )
+      CALL mpp_is_ocean( llisOce )
+      inijmin = COUNT( llisOce )   ! number of oce subdomains
 
       IF( mppsize < inijmin ) THEN   ! too many oce subdomains: can happen only if jpni and jpnj are prescribed...
@@ -319 +298 @@
 9003  FORMAT (a, i5)
 
-      ALLOCATE(  nfimpp(jpni ) , nfproc(jpni ) ,   nfjpi(jpni ) ,                     &
-         &       nimppt(jpnij) , ibonit(jpnij) ,  jpiall(jpnij) ,  jpjall(jpnij) ,    &
-         &       njmppt(jpnij) , ibonjt(jpnij) , nis0all(jpnij) , njs0all(jpnij) ,    &
-         &                                       nie0all(jpnij) , nje0all(jpnij) ,    &
-         &       iin(jpnij), ii_nono(jpnij), ii_noea(jpnij),   &
-         &       ijn(jpnij), ii_noso(jpnij), ii_nowe(jpnij),   &
-         &       iimppt(jpni,jpnj), ijpi(jpni,jpnj), ibondi(jpni,jpnj), ipproc(jpni,jpnj),   &
-         &       ijmppt(jpni,jpnj), ijpj(jpni,jpnj), ibondj(jpni,jpnj),  ipolj(jpni,jpnj),   &
-         &         iie0(jpni,jpnj), iis0(jpni,jpnj),   iono(jpni,jpnj),   ioea(jpni,jpnj),   &
-         &         ije0(jpni,jpnj), ijs0(jpni,jpnj),   ioso(jpni,jpnj),   iowe(jpni,jpnj),   &
-         &       STAT=ierr )
+      ALLOCATE( nfimpp(jpni), nfproc(jpni), nfjpi(jpni),   &
+         &      iin(jpnij), ijn(jpnij),   &
+         &      iimppt(jpni,jpnj), ijmppt(jpni,jpnj), ijpi(jpni,jpnj), ijpj(jpni,jpnj), ipproc(jpni,jpnj),   &
+         &      inei(8,jpni,jpnj), llnei(8,jpni,jpnj),   &
+         &      impi(8,jpnij),   &
+         &      STAT=ierr )
       CALL mpp_sum( 'mppini', ierr )
       IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'mpp_init: unable to allocate standard ocean arrays' )
@@ -343 +317 @@
       !
       CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ijpi, ijpj )
-      CALL mpp_getnum( llisoce, ipproc, iin, ijn )
-      !
-      !DO jn = 1, jpni
-      !   jproc = ipproc(jn,jpnj)
-      !   ii = iin(jproc+1)
-      !   ij = ijn(jproc+1)
-      !   nfproc(jn) = jproc
-      !   nfimpp(jn) = iimppt(ii,ij)
-      !   nfjpi (jn) =   ijpi(ii,ij)
-      !END DO
-      nfproc(:) = ipproc(:,jpnj)
-      nfimpp(:) = iimppt(:,jpnj)
-      nfjpi (:) =   ijpi(:,jpnj)
+      CALL mpp_getnum( llisOce, ipproc, iin, ijn )
+      !
+      ii = iin(narea)
+      ij = ijn(narea)
+      jpi   = ijpi(ii,ij)
+      jpj   = ijpj(ii,ij)
+      jpk   = MAX( 2, jpkglo )
+      jpij  = jpi*jpj
+      nimpp = iimppt(ii,ij)
+      njmpp = ijmppt(ii,ij)
+      !
+      CALL init_doloop                          ! set start/end indices of do-loop, depending on the halo width value (nn_hls)
       !
       IF(lwp) THEN
@@ -365 +338 @@
          WRITE(numout,*) '      jpnj = ', jpnj
          WRITE(numout,*) '     jpnij = ', jpnij
+         WRITE(numout,*) '     nimpp = ', nimpp
+         WRITE(numout,*) '     njmpp = ', njmpp
          WRITE(numout,*)
          WRITE(numout,*) '      sum ijpi(i,1) = ', sum(ijpi(:,1)), ' jpiglo = ', jpiglo
-         WRITE(numout,*) '      sum ijpj(1,j) = ', sum(ijpj(1,:)), ' jpjglo = ', jpjglo
-      ENDIF
-
-      ! 3. Subdomain description in the Regular Case
-      ! --------------------------------------------
-      ! specific cases where there is no communication -> must do the periodicity by itself
-      ! Warning: because of potential land-area suppression, do not use nbond[ij] == 2
-      l_Iperio = jpni == 1 .AND. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7)
-      l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7)
-
-      DO jarea = 1, jpni*jpnj
-         !
-         iarea0 = jarea - 1
-         ii = 1 + MOD(iarea0,jpni)
-         ij = 1 +     iarea0/jpni
-         ili = ijpi(ii,ij)
-         ilj = ijpj(ii,ij)
-         ibondi(ii,ij) = 0                         ! default: has e-w neighbours
-         IF( ii   ==    1 )   ibondi(ii,ij) = -1   ! first column, has only e neighbour
-         IF( ii   == jpni )   ibondi(ii,ij) =  1   ! last column,  has only w neighbour
-         IF( jpni ==    1 )   ibondi(ii,ij) =  2   ! has no e-w neighbour
-         ibondj(ii,ij) = 0                         ! default: has n-s neighbours
-         IF( ij   ==    1 )   ibondj(ii,ij) = -1   ! first row, has only n neighbour
-         IF( ij   == jpnj )   ibondj(ii,ij) =  1   ! last row,  has only s neighbour
-         IF( jpnj ==    1 )   ibondj(ii,ij) =  2   ! has no n-s neighbour
-
-         ! Subdomain neighbors (get their zone number): default definition
-         ioso(ii,ij) = iarea0 - jpni
-         iowe(ii,ij) = iarea0 - 1
-         ioea(ii,ij) = iarea0 + 1
-         iono(ii,ij) = iarea0 + jpni
-         iis0(ii,ij) =  1  + nn_hls
-         iie0(ii,ij) = ili - nn_hls
-         ijs0(ii,ij) =  1  + nn_hls
-         ije0(ii,ij) = ilj - nn_hls
-
-         ! East-West periodicity: change ibondi, ioea, iowe
-         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN
-            IF( jpni  /= 1 )   ibondi(ii,ij) = 0                        ! redefine: all have e-w neighbours
-            IF( ii ==    1 )   iowe(ii,ij) = iarea0 +        (jpni-1)   ! redefine: first column, address of w neighbour
-            IF( ii == jpni )   ioea(ii,ij) = iarea0 -        (jpni-1)   ! redefine: last column,  address of e neighbour
-         ENDIF
-
-         ! Simple North-South periodicity: change ibondj, ioso, iono
-         IF( jperio == 2 .OR. jperio == 7 ) THEN
-            IF( jpnj  /= 1 )   ibondj(ii,ij) = 0                        ! redefine: all have n-s neighbours
-            IF( ij ==    1 )   ioso(ii,ij) = iarea0 + jpni * (jpnj-1)   ! redefine: first row, address of s neighbour
-            IF( ij == jpnj )   iono(ii,ij) = iarea0 - jpni * (jpnj-1)   ! redefine: last row,  address of n neighbour
-         ENDIF
-
-         ! North fold: define ipolj, change iono. Warning: we do not change ibondj...
-         ipolj(ii,ij) = 0
-         IF( jperio == 3 .OR. jperio == 4 ) THEN
-            ijm1 = jpni*(jpnj-1)
-            imil = ijm1+(jpni+1)/2
-            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
-            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
-            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1   ! MPI rank of northern neighbour
-         ENDIF
-         IF( jperio == 5 .OR. jperio == 6 ) THEN
-            ijm1 = jpni*(jpnj-1)
-            imil = ijm1+(jpni+1)/2
-            IF( jarea > ijm1) ipolj(ii,ij) = 5
-            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
-            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1    ! MPI rank of northern neighbour
-         ENDIF
-         !
-      END DO
-
-      ! 4. deal with land subdomains
-      ! ----------------------------
-      !
-      ! neighbour treatment: change ibondi, ibondj if next to a land zone
-      DO jarea = 1, jpni*jpnj
-         ii = 1 + MOD( jarea-1  , jpni )
-         ij = 1 +     (jarea-1) / jpni
-         ! land-only area with an active n neigbour
-         IF ( ipproc(ii,ij) == -1 .AND. 0 <= iono(ii,ij) .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
-            iino = 1 + MOD( iono(ii,ij) , jpni )                    ! ii index of this n neigbour
-            ijno = 1 +      iono(ii,ij) / jpni                      ! ij index of this n neigbour
-            ! In case of north fold exchange: I am the n neigbour of my n neigbour!! (#1057)
-            ! --> for northern neighbours of northern row processors (in case of north-fold)
-            !     need to reverse the LOGICAL direction of communication
-            idir = 1                                           ! we are indeed the s neigbour of this n neigbour
-            IF( ij == jpnj .AND. ijno == jpnj )   idir = -1    ! both are on the last row, we are in fact the n neigbour
-            IF( ibondj(iino,ijno) == idir     )   ibondj(iino,ijno) =   2     ! this n neigbour had only a s/n neigbour -> no more
-            IF( ibondj(iino,ijno) == 0        )   ibondj(iino,ijno) = -idir   ! this n neigbour had both, n-s neighbours -> keep 1
-         ENDIF
-         ! land-only area with an active s neigbour
-         IF( ipproc(ii,ij) == -1 .AND. 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
-            iiso = 1 + MOD( ioso(ii,ij) , jpni )                    ! ii index of this s neigbour
-            ijso = 1 +      ioso(ii,ij) / jpni                      ! ij index of this s neigbour
-            IF( ibondj(iiso,ijso) == -1 )   ibondj(iiso,ijso) = 2   ! this s neigbour had only a n neigbour    -> no more neigbour
-            IF( ibondj(iiso,ijso) ==  0 )   ibondj(iiso,ijso) = 1   ! this s neigbour had both, n-s neighbours -> keep s neigbour
-         ENDIF
-         ! land-only area with an active e neigbour
-         IF( ipproc(ii,ij) == -1 .AND. 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= jpni*jpnj-1 ) THEN
-            iiea = 1 + MOD( ioea(ii,ij) , jpni )                    ! ii index of this e neigbour
-            ijea = 1 +      ioea(ii,ij) / jpni                      ! ij index of this e neigbour
-            IF( ibondi(iiea,ijea) == 1 )   ibondi(iiea,ijea) =  2   ! this e neigbour had only a w neigbour    -> no more neigbour
-            IF( ibondi(iiea,ijea) == 0 )   ibondi(iiea,ijea) = -1   ! this e neigbour had both, e-w neighbours -> keep e neigbour
-         ENDIF
-         ! land-only area with an active w neigbour
-         IF( ipproc(ii,ij) == -1 .AND. 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
-            iiwe = 1 + MOD( iowe(ii,ij) , jpni )                    ! ii index of this w neigbour
-            ijwe = 1 +      iowe(ii,ij) / jpni                      ! ij index of this w neigbour
-            IF( ibondi(iiwe,ijwe) == -1 )   ibondi(iiwe,ijwe) = 2   ! this w neigbour had only a e neigbour    -> no more neigbour
-            IF( ibondi(iiwe,ijwe) ==  0 )   ibondi(iiwe,ijwe) = 1   ! this w neigbour had both, e-w neighbours -> keep w neigbour
-         ENDIF
-      END DO
-
-      ! 5. Subdomain print
-      ! ------------------
-      IF(lwp) THEN
+         WRITE(numout,*) '      sum ijpj(1,j) = ', SUM(ijpj(1,:)), ' jpjglo = ', jpjglo
+         
+         ! Subdomain grid print
          ifreq = 4
          il1 = 1
@@ -503 +367 @@
  9404    FORMAT('           *  '   ,20('     ' ,i4,'   *   ') )
       ENDIF
-
-      ! just to save nono etc for all proc
-      ! warning ii*ij (zone) /= mpprank (processors)!
-      ! ioso = zone number, ii_noso = proc number
-      ii_noso(:) = -1
-      ii_nono(:) = -1
-      ii_noea(:) = -1
-      ii_nowe(:) = -1
-      DO jproc = 1, jpnij
-         ii = iin(jproc)
-         ij = ijn(jproc)
-         IF( 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
-            iiso = 1 + MOD( ioso(ii,ij) , jpni )
-            ijso = 1 +      ioso(ii,ij) / jpni
-            ii_noso(jproc) = 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
-          ii_nowe(jproc) = 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
-            ii_noea(jproc)= 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
-            ii_nono(jproc)= ipproc(iino,ijno)
-         ENDIF
+      !
+      ! Store informations for the north pole folding communications
+      nfproc(:) = ipproc(:,jpnj)
+      nfimpp(:) = iimppt(:,jpnj)
+      nfjpi (:) =   ijpi(:,jpnj)
+      !
+      ! 3. Define Western, Eastern, Southern and Northern neighbors + corners in the subdomain grid reference
+      ! ------------------------------------------------------------------------------------------------------
+      !
+      ! note that North fold is has specific treatment for its MPI communications.
+      ! This must not be treated as a "usual" communication with a northern neighbor.
+      !    -> North fold processes have no Northern neighbor in the definition done bellow
+      !
+      llmpi_Iperio = jpni > 1 .AND. l_Iperio                         ! do i-periodicity with an MPI communication?
+      llmpi_Jperio = jpnj > 1 .AND. l_Jperio                         ! do j-periodicity with an MPI communication?
+      !
+      l_SelfPerio(1:2) = l_Iperio .AND. jpni == 1                    !  west,  east periodicity by itself
+      l_SelfPerio(3:4) = l_Jperio .AND. jpnj == 1                    ! south, north periodicity by itself
+      l_SelfPerio(5:8) = l_SelfPerio(jpwe) .AND. l_SelfPerio(jpso)   ! corners bi-periodicity by itself
+      !
+      ! define neighbors mapping (1/2): default definition: ignore if neighbours are land-only subdomains or not
+      DO jj = 1, jpnj
+         DO ji = 1, jpni
+            !
+            IF ( llisOce(ji,jj) ) THEN                     ! this subdomain has some ocean: it has neighbours
+               !
+               inum0 = ji - 1 + ( jj - 1 ) * jpni             ! index in the subdomains grid. start at 0
+               !
+               ! Is there a neighbor?
+               llnei(jpwe,ji,jj) = ji >   1  .OR. llmpi_Iperio           ! West  nei exists if not the first column or llmpi_Iperio
+               llnei(jpea,ji,jj) = ji < jpni .OR. llmpi_Iperio           ! East  nei exists if not the last  column or llmpi_Iperio
+               llnei(jpso,ji,jj) = jj >   1  .OR. llmpi_Jperio           ! South nei exists if not the first line   or llmpi_Jperio
+               llnei(jpno,ji,jj) = jj < jpnj .OR. llmpi_Jperio           ! North nei exists if not the last  line   or llmpi_Jperio
+               llnei(jpsw,ji,jj) = llnei(jpwe,ji,jj) .AND. llnei(jpso,ji,jj)   ! So-We nei exists if both South and West nei exist
+               llnei(jpse,ji,jj) = llnei(jpea,ji,jj) .AND. llnei(jpso,ji,jj)   ! So-Ea nei exists if both South and East nei exist
+               llnei(jpnw,ji,jj) = llnei(jpwe,ji,jj) .AND. llnei(jpno,ji,jj)   ! No-We nei exists if both North and West nei exist
+               llnei(jpne,ji,jj) = llnei(jpea,ji,jj) .AND. llnei(jpno,ji,jj)   ! No-Ea nei exists if both North and East nei exist
+               !
+               ! Which index (starting at 0) have neighbors in the subdomains grid?
+               IF( llnei(jpwe,ji,jj) )   inei(jpwe,ji,jj) =            inum0 -    1 + jpni        * COUNT( (/ ji ==    1 /) )
+               IF( llnei(jpea,ji,jj) )   inei(jpea,ji,jj) =            inum0 +    1 - jpni        * COUNT( (/ ji == jpni /) )
+               IF( llnei(jpso,ji,jj) )   inei(jpso,ji,jj) =            inum0 - jpni + jpni * jpnj * COUNT( (/ jj ==    1 /) )
+               IF( llnei(jpno,ji,jj) )   inei(jpno,ji,jj) =            inum0 + jpni - jpni * jpnj * COUNT( (/ jj == jpnj /) )
+               IF( llnei(jpsw,ji,jj) )   inei(jpsw,ji,jj) = inei(jpso,ji,jj) -    1 + jpni        * COUNT( (/ ji ==    1 /) )
+               IF( llnei(jpse,ji,jj) )   inei(jpse,ji,jj) = inei(jpso,ji,jj) +    1 - jpni        * COUNT( (/ ji == jpni /) )
+               IF( llnei(jpnw,ji,jj) )   inei(jpnw,ji,jj) = inei(jpno,ji,jj) -    1 + jpni        * COUNT( (/ ji ==    1 /) )
+               IF( llnei(jpne,ji,jj) )   inei(jpne,ji,jj) = inei(jpno,ji,jj) +    1 - jpni        * COUNT( (/ ji == jpni /) )
+               !
+            ELSE                                           ! land-only domain has no neighbour
+               llnei(:,ji,jj) = .FALSE.
+            ENDIF
+            !
+         END DO
       END DO
-
-      ! 6. Change processor name
-      ! ------------------------
-      ii = iin(narea)
-      ij = ijn(narea)
-      !
-      jpi    = ijpi(ii,ij)
-!!$      Nis0  = iis0(ii,ij)
-!!$      Nie0  = iie0(ii,ij)
-      jpj    = ijpj(ii,ij)
-!!$      Njs0  = ijs0(ii,ij)
-!!$      Nje0  = ije0(ii,ij)
-      nbondi = ibondi(ii,ij)
-      nbondj = ibondj(ii,ij)
-      nimpp = iimppt(ii,ij)
-      njmpp = ijmppt(ii,ij)
-      jpk = jpkglo                              ! third dim
-
-      ! set default neighbours
-      noso = ii_noso(narea)
-      nowe = ii_nowe(narea)
-      noea = ii_noea(narea)
-      nono = ii_nono(narea)
-
-      nones = -1
-      nonws = -1
-      noses = -1
-      nosws = -1
-
-      noner = -1
-      nonwr = -1
-      noser = -1
-      noswr = -1
-
-      IF((nbondi .eq. -1) .or. (nbondi .eq. 0)) THEN ! east neighbour exists
-         IF(ibondj(iin(noea+1),ijn(noea+1)) .eq. 0) THEN
-            nones = ii_nono(noea+1)                  ! east neighbour has north and south neighbours
-            noses = ii_noso(noea+1)
-         ELSEIF(ibondj(iin(noea+1),ijn(noea+1)) .eq. -1) THEN
-            nones = ii_nono(noea+1)                  ! east neighbour has north neighbour
-         ELSEIF(ibondj(iin(noea+1),ijn(noea+1)) .eq. 1) THEN
-            noses = ii_noso(noea+1)                  ! east neighbour has south neighbour
-         END IF
-      END IF
-      IF((nbondi .eq. 1) .or. (nbondi .eq. 0)) THEN  ! west neighbour exists
-         IF(ibondj(iin(nowe+1),ijn(nowe+1)) .eq. 0) THEN
-            nonws = ii_nono(nowe+1)                  ! west neighbour has north and south neighbours
-            nosws = ii_noso(nowe+1)
-         ELSEIF(ibondj(iin(nowe+1),ijn(nowe+1)) .eq. -1) THEN
-            nonws = ii_nono(nowe+1)                  ! west neighbour has north neighbour
-         ELSEIF(ibondj(iin(nowe+1),ijn(nowe+1)) .eq. 1)  THEN
-            nosws = ii_noso(nowe+1)                  ! west neighbour has north neighbour
-         END IF
-      END IF
-
-      IF((nbondj .eq. -1) .or. (nbondj .eq. 0)) THEN ! north neighbour exists
-         IF(ibondi(iin(nono+1),ijn(nono+1)) .eq. 0) THEN
-            noner = ii_noea(nono+1)                  ! north neighbour has east and west neighbours
-            nonwr = ii_nowe(nono+1)
-         ELSEIF(ibondi(iin(nono+1),ijn(nono+1)) .eq. -1) THEN
-            noner = ii_noea(nono+1)                  ! north neighbour has east neighbour
-         ELSEIF(ibondi(iin(nono+1),ijn(nono+1)) .eq. 1) THEN
-            nonwr = ii_nowe(nono+1)                  ! north neighbour has west neighbour
-         END IF
-      END IF
-      IF((nbondj .eq. 1) .or. (nbondj .eq. 0)) THEN  ! south neighbour exists
-         IF(ibondi(iin(noso+1),ijn(noso+1)) .eq. 0) THEN
-            noser = ii_noea(noso+1)                  ! south neighbour has east and west neighbours
-            noswr = ii_nowe(noso+1)
-         ELSEIF(ibondi(iin(noso+1),ijn(noso+1)) .eq. -1) THEN
-            noser = ii_noea(noso+1)                  ! south neighbour has east neighbour
-         ELSEIF(ibondi(iin(noso+1),ijn(noso+1)) .eq. 1) THEN
-            noswr = ii_nowe(noso+1)                  ! south neighbour has west neighbour
-         END IF
-      END IF
-
-      !
-      CALL init_doloop                          ! set start/end indices of do-loop, depending on the halo width value (nn_hls)
-      !
-      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)
-         jpiall (jproc) = ijpi(ii,ij)
-         nis0all(jproc) = iis0(ii,ij)
-         nie0all(jproc) = iie0(ii,ij)
-         jpjall (jproc) = ijpj(ii,ij)
-         njs0all(jproc) = ijs0(ii,ij)
-         nje0all(jproc) = ije0(ii,ij)
-         ibonit(jproc) = ibondi(ii,ij)
-         ibonjt(jproc) = ibondj(ii,ij)
-         nimppt(jproc) = iimppt(ii,ij)
-         njmppt(jproc) = ijmppt(ii,ij)
+      !
+      ! define neighbors mapping (2/2): check if neighbours are not land-only subdomains
+      DO jj = 1, jpnj
+         DO ji = 1, jpni
+            DO jn = 1, 8
+               IF( llnei(jn,ji,jj) ) THEN   ! if a neighbour is existing -> this should not be a land-only domain
+                  ii = 1 + MOD( inei(jn,ji,jj) , jpni )
+                  ij = 1 +      inei(jn,ji,jj) / jpni
+                  llnei(jn,ji,jj) = llisOce( ii, ij )
+               ENDIF
+            END DO
+         END DO
       END DO
-
+      !
+      ! update index of the neighbours in the subdomains grid
+      WHERE( .NOT. llnei )   inei = -1
+      !
       ! Save processor layout in ascii file
       IF (llwrtlay) THEN
          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 )'
-         WRITE(inum,'(6i8,a,3i8,a)') jpnij,jpimax,jpjmax,jpk,jpiglo,jpjglo,&
-   &           ' ( local: ',narea,jpi,jpj,' )'
-         WRITE(inum,'(a)') 'narea   jpi  jpj Nis0 Njs0 Nie0 Nje0 nimp njmp nono noso nowe noea nbondi nbondj '
-
-         DO jproc = 1, jpnij
-            WRITE(inum,'(13i5,2i7)')     jproc,  jpiall(jproc),  jpjall(jproc),   &
-               &                                nis0all(jproc), njs0all(jproc),   &
-               &                                nie0all(jproc), nje0all(jproc),   &
-               &                                nimppt (jproc), njmppt (jproc),   &
-               &                                ii_nono(jproc), ii_noso(jproc),   &
-               &                                ii_nowe(jproc), ii_noea(jproc),   &
-               &                                ibonit (jproc), ibonjt (jproc)
+         WRITE(inum,'(a)') '  jpnij jpimax jpjmax    jpk jpiglo jpjglo ( local:   narea    jpi    jpj )'
+         WRITE(inum,'(6i7,a,3i7,a)') jpnij,jpimax,jpjmax,jpk,jpiglo,jpjglo,' ( local: ',narea,jpi,jpj,' )'
+         WRITE(inum,'(a)') ' narea    ii    ij   jpi   jpj nimpp njmpp mpiwe mpiea mpiso mpino mpisw mpise mpinw mpine'
+         DO jp = 1, jpnij
+            ii = iin(jp)
+            ij = ijn(jp)
+            WRITE(inum,'(15i6)')  jp, ii, ij, ijpi(ii,ij),  ijpj(ii,ij), iimppt(ii,ij), ijmppt(ii,ij), inei(:,ii,ij)
          END DO
       END IF
 
-      !                          ! north fold parameter
-      ! Defined npolj, either 0, 3 , 4 , 5 , 6
-      ! In this case the important thing is that npolj /= 0
-      ! Because if we go through these line it is because jpni >1 and thus
-      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
-      npolj = 0
-      ij = ijn(narea)
-      IF( jperio == 3 .OR. jperio == 4 ) THEN
-         IF( ij == jpnj )   npolj = 3
-      ENDIF
-      IF( jperio == 5 .OR. jperio == 6 ) THEN
-         IF( ij == jpnj )   npolj = 5
-      ENDIF
+      !
+      ! 4. Define Western, Eastern, Southern and Northern neighbors + corners for each mpi process
+      ! ------------------------------------------------------------------------------------------
+      ! 
+      ! rewrite information from "subdomain grid" to mpi process list
+      ! Warning, for example:
+      !    position of the northern neighbor in the "subdomain grid"
+      !    position of the northern neighbor in the "mpi process list"
+      
+      ! default definition: no neighbors
+      impi(:,:) = -1   ! (starting at 0, -1 if no neighbourg)
+      
+      DO jp = 1, jpnij
+         ii = iin(jp)
+         ij = ijn(jp)
+         DO jn = 1, 8
+            IF( llnei(jn,ii,ij) ) THEN   ! must be tested as some land-domain can be kept to fit mppsize
+               ii2 = 1 + MOD( inei(jn,ii,ij) , jpni )
+               ij2 = 1 +      inei(jn,ii,ij) / jpni
+               impi(jn,jp) = ipproc( ii2, ij2 )
+            ENDIF
+         END DO
+      END DO
+
+      !
+      ! 4. keep information for the local process
+      ! -----------------------------------------
+      !
+      ! set default neighbours
+      mpinei(:) = impi(:,narea)
       !
       IF(lwp) THEN
          WRITE(numout,*)
          WRITE(numout,*) '   resulting internal parameters : '
-         WRITE(numout,*) '      narea  = ', narea
-         WRITE(numout,*) '      nowe   = ', nowe  , '   noea  =  ', noea
-         WRITE(numout,*) '      nono   = ', nono  , '   noso  =  ', noso
-         WRITE(numout,*) '      nbondi = ', nbondi
-         WRITE(numout,*) '      nbondj = ', nbondj
-         WRITE(numout,*) '      npolj  = ', npolj
-         WRITE(numout,*) '    l_Iperio = ', l_Iperio
-         WRITE(numout,*) '    l_Jperio = ', l_Jperio
-         WRITE(numout,*) '      nimpp  = ', nimpp
-         WRITE(numout,*) '      njmpp  = ', njmpp
-      ENDIF
-
+         WRITE(numout,*) '      narea = ', narea
+         WRITE(numout,*) '      mpi nei  west = ', mpinei(jpwe)  , '   mpi nei  east = ', mpinei(jpea)
+         WRITE(numout,*) '      mpi nei south = ', mpinei(jpso)  , '   mpi nei north = ', mpinei(jpno)
+         WRITE(numout,*) '      mpi nei so-we = ', mpinei(jpsw)  , '   mpi nei so-ea = ', mpinei(jpse)
+         WRITE(numout,*) '      mpi nei no-we = ', mpinei(jpnw)  , '   mpi nei no-ea = ', mpinei(jpne)
+      ENDIF
+      !
       !                          ! Prepare mpp north fold
-      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+      !
+      llmpiNfold =          jpnj  > 1 .AND. ( l_NFoldT .OR. l_NFoldF )   ! is the North fold done with an MPI communication?
+      l_IdoNFold = ijn(narea) == jpnj .AND. ( l_NFoldT .OR. l_NFoldF )   ! is this process doing North fold?
+      !
+      IF( llmpiNfold ) THEN
          CALL mpp_ini_north
          IF (lwp) THEN
             WRITE(numout,*)
             WRITE(numout,*) '   ==>>>   North fold boundary prepared for jpni >1'
-            ! additional prints in layout.dat
-         ENDIF
-         IF (llwrtlay) THEN
+         ENDIF
+         IF (llwrtlay) THEN   ! additional prints in layout.dat
             WRITE(inum,*)
             WRITE(inum,*)
             WRITE(inum,*) 'number of subdomains located along the north fold : ', ndim_rank_north
             WRITE(inum,*) 'Rank of the subdomains located along the north fold : ', ndim_rank_north
-            DO jproc = 1, ndim_rank_north, 5
-               WRITE(inum,*) nrank_north( jproc:MINVAL( (/jproc+4,ndim_rank_north/) ) )
+            DO jp = 1, ndim_rank_north, 5
+               WRITE(inum,*) nrank_north( jp:MINVAL( (/jp+4,ndim_rank_north/) ) )
             END DO
          ENDIF
-      ENDIF
-
+         IF ( l_IdoNFold .AND. ln_nnogather ) THEN
+            CALL init_nfdcom     ! northfold neighbour lists
+            IF (llwrtlay) THEN
+               WRITE(inum,*)
+               WRITE(inum,*) 'north fold exchanges with explicit point-to-point messaging :'
+               WRITE(inum,*) '   nsndto  : ', nsndto
+               WRITE(inum,*) '   isendto : ', isendto(1:nsndto)
+            ENDIF
+         ENDIF
+      ENDIF
       !
       CALL mpp_ini_nc        ! Initialize communicator for neighbourhood collective communications
@@ -706 +527 @@
       CALL init_ioipsl       ! Prepare NetCDF output file (if necessary)
       !
-      IF (( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ).AND.( ln_nnogather )) THEN
-         CALL init_nfdcom     ! northfold neighbour lists
-         IF (llwrtlay) THEN
-            WRITE(inum,*)
-            WRITE(inum,*)
-            WRITE(inum,*) 'north fold exchanges with explicit point-to-point messaging :'
-            WRITE(inum,*) 'nsndto : ', nsndto
-            WRITE(inum,*) 'isendto : ', isendto
-         ENDIF
-      ENDIF
-      !
       IF (llwrtlay) CLOSE(inum)
       !
-      DEALLOCATE(iin, ijn, ii_nono, ii_noea, ii_noso, ii_nowe,    &
-         &       iimppt, ijmppt, ibondi, ibondj, ipproc, ipolj,   &
-         &       ijpi, ijpj, iie0, ije0, iis0, ijs0,              &
-         &       iono, ioea, ioso, iowe, llisoce)
+      DEALLOCATE(iin, ijn, iimppt, ijmppt, ijpi, ijpj, ipproc, inei, llnei, impi, llisOce)
       !
     END SUBROUTINE mpp_init
@@ -860 +667 @@
       LOGICAL :: llist
       LOGICAL, DIMENSION(:,:), ALLOCATABLE :: llmsk2d                 ! max size of the subdomains along i,j
-      LOGICAL, DIMENSION(:,:), ALLOCATABLE :: llisoce              !  -     -
+      LOGICAL, DIMENSION(:,:), ALLOCATABLE :: llisOce              !  -     -
       REAL(wp)::   zpropland
       !!----------------------------------------------------------------------
@@ -991 +798 @@
          END IF
          ji = isz0   ! initialization with the largest value
-         ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) )
-         CALL mpp_is_ocean( llisoce )   ! Warning: must be call by all cores (call mpp_sum)
-         inbijold = COUNT(llisoce)
-         DEALLOCATE( llisoce )
+         ALLOCATE( llisOce(inbi0(ji), inbj0(ji)) )
+         CALL mpp_is_ocean( llisOce )   ! Warning: must be call by all cores (call mpp_sum)
+         inbijold = COUNT(llisOce)
+         DEALLOCATE( llisOce )
          DO ji =isz0-1,1,-1
-            ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) )
-            CALL mpp_is_ocean( llisoce )   ! Warning: must be call by all cores (call mpp_sum)
-            inbij = COUNT(llisoce)
-            DEALLOCATE( llisoce )
+            ALLOCATE( llisOce(inbi0(ji), inbj0(ji)) )
+            CALL mpp_is_ocean( llisOce )   ! Warning: must be call by all cores (call mpp_sum)
+            inbij = COUNT(llisOce)
+            DEALLOCATE( llisOce )
             IF(lwp .AND. inbij < inbijold) THEN
                WRITE(numout,'(a, i6, a, i6, a, f4.1, a, i9, a, i6, a, i6, a)')                                 &
@@ -1022 +829 @@
       DO WHILE( inbij > knbij )   ! while the number of ocean subdomains exceed the number of procs
          ii = ii -1
-         ALLOCATE( llisoce(inbi0(ii), inbj0(ii)) )
-         CALL mpp_is_ocean( llisoce )            ! must be done by all core
-         inbij = COUNT(llisoce)
-         DEALLOCATE( llisoce )
+         ALLOCATE( llisOce(inbi0(ii), inbj0(ii)) )
+         CALL mpp_is_ocean( llisOce )            ! must be done by all core
+         inbij = COUNT(llisOce)
+         DEALLOCATE( llisOce )
       END DO
       knbi = inbi0(ii)
@@ -1087 +894 @@
 
 
-   SUBROUTINE mpp_is_ocean( ldisoce )
+   SUBROUTINE mpp_is_ocean( ldIsOce )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE mpp_is_ocean  ***
@@ -1095 +902 @@
       !!              at least 1 ocean point.
       !!              We must indeed ensure that each subdomain that is a neighbour
-      !!              of a land subdomain as only land points on its boundary
+      !!              of a land subdomain, has only land points on its boundary
       !!              (inside the inner subdomain) with the land subdomain.
       !!              This is needed to get the proper bondary conditions on
@@ -1102 +909 @@
       !! ** Method  : read inbj strips (of length Ni0glo) of the land-sea mask
       !!----------------------------------------------------------------------
-      LOGICAL, DIMENSION(:,:), INTENT(  out) ::   ldisoce        ! .true. if a sub domain constains 1 ocean point
+      LOGICAL, DIMENSION(:,:), INTENT(  out) ::   ldIsOce        ! .true. if a sub domain constains 1 ocean point
       !
       INTEGER :: idiv, iimax, ijmax, iarea
@@ -1115 +922 @@
       ! do nothing if there is no land-sea mask
       IF( numbot == -1 .AND. numbdy == -1 ) THEN
-         ldisoce(:,:) = .TRUE.
+         ldIsOce(:,:) = .TRUE.
          RETURN
       ENDIF
       !
-      inbi = SIZE( ldisoce, dim = 1 )
-      inbj = SIZE( ldisoce, dim = 2 )
+      inbi = SIZE( ldIsOce, dim = 1 )
+      inbj = SIZE( ldIsOce, dim = 2 )
       !
       ! we want to read inbj strips of the land-sea mask. -> pick up inbj processes every idiv processes starting at 1
@@ -1193 +1000 @@
       CALL mpp_sum( 'mppini', inboce_1d )
       inboce = RESHAPE(inboce_1d, (/inbi, inbj/))
-      ldisoce(:,:) = inboce(:,:) /= 0
+      ldIsOce(:,:) = inboce(:,:) /= 0
       DEALLOCATE(inboce, inboce_1d)
       !
@@ -1236 +1043 @@
 
 
-   SUBROUTINE mpp_getnum( ldisoce, kproc, kipos, kjpos )
+   SUBROUTINE mpp_getnum( ldIsOce, kproc, kipos, kjpos )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE mpp_getnum  ***
@@ -1244 +1051 @@
       !! ** Method  : start from bottom left. First skip land subdomain, and finally use them if needed
       !!----------------------------------------------------------------------
-      LOGICAL, DIMENSION(:,:), INTENT(in   ) ::   ldisoce     ! F if land process
-      INTEGER, DIMENSION(:,:), INTENT(  out) ::   kproc       ! subdomain number (-1 if supressed, starting at 0)
+      LOGICAL, DIMENSION(:,:), INTENT(in   ) ::   ldIsOce     ! F if land process
+      INTEGER, DIMENSION(:,:), INTENT(  out) ::   kproc       ! subdomain number (-1 if not existing, starting at 0)
       INTEGER, DIMENSION(  :), INTENT(  out) ::   kipos       ! i-position of the subdomain (from 1 to jpni)
       INTEGER, DIMENSION(  :), INTENT(  out) ::   kjpos       ! j-position of the subdomain (from 1 to jpnj)
@@ -1253 +1060 @@
       !!----------------------------------------------------------------------
       !
-      ini = SIZE(ldisoce, dim = 1)
-      inj = SIZE(ldisoce, dim = 2)
+      ini = SIZE(ldIsOce, dim = 1)
+      inj = SIZE(ldIsOce, dim = 2)
       inij = SIZE(kipos)
       !
@@ -1264 +1071 @@
          ii = 1 + MOD(iarea0,ini)
          ij = 1 +     iarea0/ini
-         IF( ldisoce(ii,ij) ) THEN
+         IF( ldIsOce(ii,ij) ) THEN
             icont = icont + 1
             kproc(ii,ij) = icont
@@ -1272 +1079 @@
       END DO
       ! if needed add some land subdomains to reach inij active subdomains
-      i2add = inij - COUNT( ldisoce )
+      i2add = inij - COUNT( ldIsOce )
       DO jarea = 1, ini*inj
          iarea0 = jarea - 1
          ii = 1 + MOD(iarea0,ini)
          ij = 1 +     iarea0/ini
-         IF( .NOT. ldisoce(ii,ij) .AND. i2add > 0 ) THEN
+         IF( .NOT. ldIsOce(ii,ij) .AND. i2add > 0 ) THEN
             icont = icont + 1
             kproc(ii,ij) = icont
@@ -1343 +1150 @@
       !!----------------------------------------------------------------------
       !
-      !initializes the north-fold communication variables
-      isendto(:) = 0
-      nsndto     = 0
-      !
-      IF ( njmpp == MAXVAL( njmppt ) ) 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 - nimpp - jpi + 1
+      !dxM is the last point (in the global domain) needed to compute the north-fold for the current process
+      dxM = jpiglo - nimpp + 2
+      !
+      ! loop over the other north-fold processes to find the processes
+      ! managing the points belonging to the sxT-dxT range
+      !
+      nsndto = 0
+      DO jn = 1, jpni
          !
-         !sxM is the first point (in the global domain) needed to compute the north-fold for the current process
-         sxM = jpiglo - nimppt(narea) - jpiall(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
+         sxT = nfimpp(jn)                    ! sxT = 1st  point (in the global domain) of the jn process
+         dxT = nfimpp(jn) + nfjpi(jn) - 1    ! dxT = last point (in the global domain) of the jn process
          !
-         ! loop over the other north-fold processes to find the processes
-         ! managing the points belonging to the sxT-dxT range
+         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
          !
-         DO jn = 1, jpni
-            !
-            sxT = nfimpp(jn)                    ! sxT = 1st  point (in the global domain) of the jn process
-            dxT = nfimpp(jn) + nfjpi(jn) - 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
-         !
-      ENDIF
-      l_north_nogather = .TRUE.
+      END DO
       !
    END SUBROUTINE init_nfdcom
@@ -1394 +1193 @@
       Nie0 = jpi-nn_hls   ;   Nie1 = Nie0+1   ;   Nie2 = MIN(jpi, Nie0+2)
       Nje0 = jpj-nn_hls   ;   Nje1 = Nje0+1   ;   Nje2 = MIN(jpj, Nje0+2)
-      !
-      IF( nn_hls == 1 ) THEN          !* halo size of 1
-         !
-         Nis1nxt2 = Nis0   ;   Njs1nxt2 = Njs0
-         Nie1nxt2 = Nie0   ;   Nje1nxt2 = Nje0
-         !
-      ELSE                            !* larger halo size...
-         !
-         Nis1nxt2 = Nis1   ;   Njs1nxt2 = Njs1
-         Nie1nxt2 = Nie1   ;   Nje1nxt2 = Nje1
-         !
-      ENDIF
       !
       Ni_0 = Nie0 - Nis0 + 1
@@ -1414 +1201 @@
       Nj_2 = Nje2 - Njs2 + 1
       !
+      ! old indices to be removed...
+      jpim1 = jpi-1                             ! inner domain indices
+      jpjm1 = jpj-1                             !   "           "
+      jpkm1 = jpk-1                             !   "           "
+      !
    END SUBROUTINE init_doloop
 

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/lib_fortran.F90

@@ -220 +220 @@
       !
       DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
-         IF( MOD(mig(ji), 3) == MOD(nn_hls, 3) .AND.   &
+         IF( MOD(mig(ji), 3) == MOD(nn_hls, 3) .AND.   &              ! 1st bottom left corner always at (Nis0-1, Njs0-1)
            & MOD(mjg(jj), 3) == MOD(nn_hls, 3)         ) THEN         ! bottom left corner of a 3x3 box
             ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box
@@ -230 +230 @@
       END_2D
       CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp )
-      ! no need for 2nd exchange when nn_hls = 2
-      IF( nn_hls /= 2 ) THEN
-         IF( nbondi /= -1 ) THEN
-            IF( MOD(mig(    1), 3) == 1 )   p2d(    1,:) = p2d(    2,:)
-            IF( MOD(mig(    1), 3) == 2 )   p2d(    2,:) = p2d(    1,:)
-         ENDIF
-         IF( nbondi /=  1 ) THEN
+      ! no need for 2nd exchange when nn_hls > 1
+      IF( nn_hls == 1 ) THEN
+         IF( mpinei(jpwe) > -1 ) THEN   ! 1st column was changed beacuse of an MPI communication during the previous call to lbc_lnk
+            IF( MOD(mig(    1), 3) == 1 )   &   ! 1st box start at i=1 -> column 1 to 3 correctly computed locally
+               p2d(    1,:) = p2d(    2,:)      ! previous lbc_lnk corrupted column 1 -> put it back using column 2 
+            IF( MOD(mig(    1), 3) == 2 )   &   ! 1st box start at i=3 -> column 1 and 2 correctly computed on west neighbourh
+               p2d(    2,:) = p2d(    1,:)      !  previous lbc_lnk fix column 1 -> copy it to column 2 
+         ENDIF
+         IF( mpinei(jpea) > -1 ) THEN
             IF( MOD(mig(jpi-2), 3) == 1 )   p2d(  jpi,:) = p2d(jpi-1,:)
             IF( MOD(mig(jpi-2), 3) == 0 )   p2d(jpi-1,:) = p2d(  jpi,:)
          ENDIF
-         IF( nbondj /= -1 ) THEN
+         IF( mpinei(jpso) > -1 ) THEN
             IF( MOD(mjg(    1), 3) == 1 )   p2d(:,    1) = p2d(:,    2)
             IF( MOD(mjg(    1), 3) == 2 )   p2d(:,    2) = p2d(:,    1)
          ENDIF
-         IF( nbondj /=  1 ) THEN
+         IF( mpinei(jpno) > -1 ) THEN
             IF( MOD(mjg(jpj-2), 3) == 1 )   p2d(:,  jpj) = p2d(:,jpj-1)
             IF( MOD(mjg(jpj-2), 3) == 0 )   p2d(:,jpj-1) = p2d(:,  jpj)
@@ -274 +276 @@
          !
          DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
-            IF( MOD(mig(ji), 3) == MOD(nn_hls, 3) .AND.   &
+            IF( MOD(mig(ji), 3) == MOD(nn_hls, 3) .AND.   &              ! 1st bottom left corner always at (Nis0-1, Njs0-1)
               & MOD(mjg(jj), 3) == MOD(nn_hls, 3)         ) THEN         ! bottom left corner of a 3x3 box
                ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box
@@ -285 +287 @@
       END DO
       CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp )
-      ! no need for 2nd exchange when nn_hls = 2
-      IF( nn_hls /= 2 ) THEN
-         IF( nbondi /= -1 ) THEN
-            IF( MOD(mig(    1), 3) == 1 )   p3d(    1,:,:) = p3d(    2,:,:)
-            IF( MOD(mig(    1), 3) == 2 )   p3d(    2,:,:) = p3d(    1,:,:)
-         ENDIF
-         IF( nbondi /=  1 ) THEN
+      ! no need for 2nd exchange when nn_hls > 1
+      IF( nn_hls == 1 ) THEN
+         IF( mpinei(jpwe) > -1 ) THEN   ! 1st column was changed beacuse of an MPI communication during the previous call to lbc_lnk
+            IF( MOD(mig(    1), 3) == 1 )   &    ! 1st box start at i=1 -> column 1 to 3 correctly computed locally
+               p3d(    1,:,:) = p3d(    2,:,:)   ! previous lbc_lnk corrupted column 1 -> put it back using column 2 
+            IF( MOD(mig(    1), 3) == 2 )   &    ! 1st box start at i=3 -> column 1 and 2 correctly computed on west neighbourh
+               p3d(    2,:,:) = p3d(    1,:,:)   !  previous lbc_lnk fix column 1 -> copy it to column 2 
+         ENDIF
+         IF( mpinei(jpea) > -1 ) THEN
             IF( MOD(mig(jpi-2), 3) == 1 )   p3d(  jpi,:,:) = p3d(jpi-1,:,:)
             IF( MOD(mig(jpi-2), 3) == 0 )   p3d(jpi-1,:,:) = p3d(  jpi,:,:)
          ENDIF
-         IF( nbondj /= -1 ) THEN
+         IF( mpinei(jpso) > -1 ) THEN
             IF( MOD(mjg(    1), 3) == 1 )   p3d(:,    1,:) = p3d(:,    2,:)
             IF( MOD(mjg(    1), 3) == 2 )   p3d(:,    2,:) = p3d(:,    1,:)
          ENDIF
-         IF( nbondj /=  1 ) THEN
+         IF( mpinei(jpno) > -1 ) THEN
             IF( MOD(mjg(jpj-2), 3) == 1 )   p3d(:,  jpj,:) = p3d(:,jpj-1,:)
             IF( MOD(mjg(jpj-2), 3) == 0 )   p3d(:,jpj-1,:) = p3d(:,  jpj,:)

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/nemogcm.F90

@@ -382 +382 @@
          CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio )
       ENDIF
+      l_Iperio = jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7   ! i-periodicity?
+      l_Jperio = jperio == 2 .OR. jperio == 7                                     ! j-periodicity ?
+      l_NFoldT = jperio == 3 .OR. jperio == 4                                ! 
+      l_NFoldF = jperio == 5 .OR. jperio == 6                               ! 
       !
       IF(lwm)   WRITE( numond, namcfg )

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/par_kind.F90

@@ -10 +10 @@
    IMPLICIT NONE
    PRIVATE
-
-   INTEGER, PUBLIC, PARAMETER ::   jpbyt   = 8    !: real size for mpp communications
-   INTEGER, PUBLIC, PARAMETER ::   jpbytda = 4    !: real size in input data files 4 or 8
 
    ! Number model from which the SELECTED_*_KIND are requested:

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/par_oce.F90

@@ -92 +92 @@
    ! halo with and starting/inding DO-loop indices
    INTEGER, PUBLIC ::   nn_hls   !: halo width (applies to both rows and columns)
-   INTEGER, PUBLIC ::   Nis0, Nis1, Nis1nxt2, Nis2   !: start I-index (_0: without halo, _1 or _2: with 1 or 2 halos)
-   INTEGER, PUBLIC ::   Nie0, Nie1, Nie1nxt2, Nie2   !: end   I-index (_0: without halo, _1 or _2: with 1 or 2 halos)
-   INTEGER, PUBLIC ::   Njs0, Njs1, Njs1nxt2, Njs2   !: start J-index (_0: without halo, _1 or _2: with 1 or 2 halos)
-   INTEGER, PUBLIC ::   Nje0, Nje1, Nje1nxt2, Nje2   !: end   J-index (_0: without halo, _1 or _2: with 1 or 2 halos)
+   INTEGER, PUBLIC ::   Nis0, Nis1, Nis2   !: start I-index (_0: without halo, _1 or _2: with 1 or 2 halos)
+   INTEGER, PUBLIC ::   Nie0, Nie1, Nie2   !: end   I-index (_0: without halo, _1 or _2: with 1 or 2 halos)
+   INTEGER, PUBLIC ::   Njs0, Njs1, Njs2   !: start J-index (_0: without halo, _1 or _2: with 1 or 2 halos)
+   INTEGER, PUBLIC ::   Nje0, Nje1, Nje2   !: end   J-index (_0: without halo, _1 or _2: with 1 or 2 halos)
    INTEGER, PUBLIC ::   Ni_0, Nj_0, Ni_1, Nj_1, Ni_2, Nj_2   !: domain size (_0: without halo, _1 or _2: with 1 or 2 halos)
    INTEGER, PUBLIC ::   Ni0glo, Nj0glo

NEMO/branches/2021/dev_r14312_MPI_Interface/src/TOP/oce_trc.F90

@@ -27 +27 @@
    USE par_oce , ONLY :   Nie1    =>   Nie1      !: 
    USE par_oce , ONLY :   Nje1    =>   Nje1      !: 
-   USE par_oce , ONLY :   Nis1nxt2    =>   Nis1nxt2      !: 
-   USE par_oce , ONLY :   Njs1nxt2    =>   Njs1nxt2      !: 
-   USE par_oce , ONLY :   Nie1nxt2    =>   Nie1nxt2      !: 
-   USE par_oce , ONLY :   Nje1nxt2    =>   Nje1nxt2      !: 
    USE par_oce , ONLY :   Nis2    =>   Nis2      !: 
    USE par_oce , ONLY :   Njs2    =>   Njs2      !: