ecearth3/sources/nemo-3.6/CONFIG/ORCA1L75_LIM3/MY_SRC/mppini_2.h90

   SUBROUTINE mpp_init2
      !!----------------------------------------------------------------------
      !!                  ***  ROUTINE mpp_init2  ***
      !!
      !! * Purpose :   Lay out the global domain over processors.
      !!     FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED
      !!     FOR DEFINING BETTER CUTTING OUT.
      !!       This routine is used with a the bathymetry file.
      !!       In this version, the land processors are avoided and the adress
      !!     processor (nproc, narea,noea, ...) are calculated again.
      !!     The jpnij parameter can be lesser than jpni x jpnj
      !!     and this jpnij parameter must be calculated before with an
      !!     algoritmic preprocessing program.
      !!
      !! ** Method  :   Global domain is distributed in smaller local domains.
      !!      Periodic condition is a function of the local domain position
      !!      (global boundary or neighbouring domain) and of the global
      !!      periodic
      !!      Type :         jperio global periodic condition
      !!                     nperio local  periodic condition
      !!
      !! ** Action :        nimpp     : longitudinal index 
      !!                    njmpp     : latitudinal  index
      !!                    nperio    : lateral condition type 
      !!                    narea     : number for local area
      !!                    nlci      : first dimension
      !!                    nlcj      : second dimension
      !!                    nproc     : number for local processor
      !!                    noea      : number for local neighboring processor
      !!                    nowe      : number for local neighboring processor
      !!                    noso      : number for local neighboring processor
      !!                    nono      : number for local neighboring processor
      !!
      !! History :
      !!        !  94-11  (M. Guyon)  Original code
      !!        !  95-04  (J. Escobar, M. Imbard)
      !!        !  98-02  (M. Guyon)  FETI method
      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
      !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
      !!----------------------------------------------------------------------
      USE in_out_manager  ! I/O Manager
      USE iom
      USE dom_xios
      !! 
      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
      INTEGER ::  inum                        ! temporary logical unit
      INTEGER ::  idir                        ! temporary integers
      INTEGER ::  jstartrow                   ! temporary integers
      INTEGER ::   ios                        ! Local integer output status for namelist read
      INTEGER ::   &
         ii, ij, ifreq, il1, il2,          &  ! temporary integers
         icont, ili, ilj,                  &  !    "          "
         isurf, ijm1, imil,                &  !    "          "
         iino, ijno, iiso, ijso,           &  !    "          " 
         iiea, ijea, iiwe, ijwe,           &  !    "          "
         iinw, ijnw, iine, ijne,           &  !    "          "
         iisw, ijsw, iise, ijse,           &  !    "          "
         iresti, irestj, iproc                !    "          "
      INTEGER, DIMENSION(jpnij) ::   &
         iin, ijn          
      INTEGER, DIMENSION(jpni,jpnj) ::   &
         iimppt, ijmppt, ilci  , ilcj  ,   &  ! temporary workspace
         ipproc, ibondj, ibondi, ipolj ,   &  !    "           "
         ilei  , ilej  , ildi  , ildj  ,   &  !    "           "
         ioea  , iowe  , ioso  , iono  ,   &  !    "           "
         ione  , ionw  , iose  , iosw  ,   &  !    "           "
         ibne  , ibnw  , ibse  , ibsw         !    "           "
      INTEGER,  DIMENSION(jpiglo,jpjglo) ::   &
         imask                                ! temporary global workspace
      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   &
         zdta, zdtaisf                     ! temporary data workspace
      REAL(wp) ::   zidom , zjdom          ! temporary scalars

      ! read namelist for ln_zco
      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav

      !!----------------------------------------------------------------------
      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
      !! $Id: mppini_2.h90 6413 2016-03-31 16:22:52Z lovato $
      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
      !!----------------------------------------------------------------------

      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901)
901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )

      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
      IF(lwm) WRITE ( numond, namzgr )

      IF(lwp)WRITE(numout,*)
      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
      IF(lwp)WRITE(numout,*) '~~~~~~~~'
      IF(lwp)WRITE(numout,*) ' '

      IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )

      ! 0. initialisation
      ! -----------------

      ! open the file
      ! Remember that at this level in the code, mpp is not yet initialized, so
      ! the file must be open with jpdom_unknown, and kstart and kcount forced 
      jstartrow = 1
      IF ( ln_zco ) THEN 
         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry
          ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
          ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
         CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
         jstartrow = MAX(1,jstartrow)
         CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/), kcount=(/jpiglo,jpjglo/) )
      ELSE
         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
         IF ( ln_isfcav ) THEN
             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry_isf' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
         ELSE
             ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
             ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
             CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
             jstartrow = MAX(1,jstartrow)
             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/)   &
                &                                                   , kcount=(/jpiglo,jpjglo/) )
         ENDIF
      ENDIF
      CALL iom_close (inum)
      
      ! used to compute the land processor in case of not masked bathy file.
      zdtaisf(:,:) = 0.0_wp
      IF ( ln_isfcav ) THEN
         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
         CALL iom_get ( inum, jpdom_unknown, 'isf_draft' , zdtaisf, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
      END IF
      CALL iom_close (inum)

      ! land/sea mask over the global/zoom domain

      imask(:,:)=1
      WHERE ( zdta(:,:) - zdtaisf(:,:) <= 0. ) imask = 0

      !  1. Dimension arrays for subdomains
      ! -----------------------------------

      !  Computation of local domain sizes ilci() ilcj()
      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
      !  The subdomains are squares leeser than or equal to the global
      !  dimensions divided by the number of processors minus the overlap
      !  array.

      nreci=2*jpreci
      nrecj=2*jprecj
      iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )

#if defined key_nemocice_decomp
      ! Change padding to be consistent with CICE
      ilci(1:jpni-1      ,:) = jpi
      ilci(jpni          ,:) = jpiglo - (jpni - 1) * (jpi - nreci)

      ilcj(:,      1:jpnj-1) = jpj
      ilcj(:,          jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj)
#else
      ilci(1:iresti      ,:) = jpi
      ilci(iresti+1:jpni ,:) = jpi-1

      ilcj(:,      1:irestj) = jpj
      ilcj(:, irestj+1:jpnj) = jpj-1
#endif

      nfilcit(:,:) = ilci(:,:)

      IF(lwp) WRITE(numout,*)
      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
      IF(lwp) WRITE(numout,*)
      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
      IF(lwp) WRITE(numout,*)
      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj

      zidom = nreci + sum(ilci(:,1) - nreci ) 
      IF(lwp) WRITE(numout,*)
      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo

      zjdom = nrecj + sum(ilcj(1,:) - nrecj ) 
      IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
      IF(lwp) WRITE(numout,*)


      !  2. Index arrays for subdomains
      ! -------------------------------

      iimppt(:,:) = 1
      ijmppt(:,:) = 1
      ipproc(:,:) = -1

      IF( jpni > 1 )THEN
         DO jj = 1, jpnj
            DO ji = 2, jpni
               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
            END DO
         END DO
      ENDIF
      nfiimpp(:,:) = iimppt(:,:)

      IF( jpnj > 1 )THEN
         DO jj = 2, jpnj
            DO ji = 1, jpni
               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
            END DO
         END DO
      ENDIF


      ! 3. Subdomain description in the Regular Case
      ! --------------------------------------------

      nperio = 0
      icont = -1
      DO jarea = 1, jpni*jpnj
         ii = 1 + MOD(jarea-1,jpni)
         ij = 1 +    (jarea-1)/jpni
         ili = ilci(ii,ij)
         ilj = ilcj(ii,ij)
         ibondj(ii,ij) = -1
         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
         ibondi(ii,ij) = 0
         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
         IF( jpni            == 1 )   ibondi(ii,ij) =  2

         ! 2.4 Subdomain neighbors

         iproc = jarea - 1
         ioso(ii,ij) = iproc - jpni
         iowe(ii,ij) = iproc - 1
         ioea(ii,ij) = iproc + 1
         iono(ii,ij) = iproc + jpni
         ildi(ii,ij) = 1 + jpreci
         ilei(ii,ij) = ili -jpreci
         ionw(ii,ij) = iono(ii,ij) - 1
         ione(ii,ij) = iono(ii,ij) + 1
         iosw(ii,ij) = ioso(ii,ij) - 1
         iose(ii,ij) = ioso(ii,ij) + 1
         ibsw(ii,ij) = 1
         ibnw(ii,ij) = 1
         IF( MOD(iproc,jpni) == 0 ) THEN
            ibsw(ii,ij) = 0
            ibnw(ii,ij) = 0
         ENDIF
         ibse(ii,ij) = 1
         ibne(ii,ij) = 1
         IF( MOD(iproc,jpni) == jpni-1 ) THEN
            ibse(ii,ij) = 0
            ibne(ii,ij) = 0
         ENDIF
         IF( iproc < jpni ) THEN
            ibsw(ii,ij) = 0
            ibse(ii,ij) = 0
         ENDIF
         IF( iproc >= (jpnj-1)*jpni ) THEN
            ibnw(ii,ij) = 0
            ibne(ii,ij) = 0
         ENDIF
         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
         ildj(ii,ij) =  1  + jprecj
         ilej(ii,ij) = ilj - jprecj
         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj

         ! warning ii*ij (zone) /= nproc (processors)!

         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
            IF( jpni == 1 )THEN
               ibondi(ii,ij) = 2
               nperio = 1
            ELSE
               ibondi(ii,ij) = 0
            ENDIF
            IF( MOD(jarea,jpni) == 0 ) THEN
               ioea(ii,ij) = iproc - (jpni-1)
               ione(ii,ij) = ione(ii,ij) - jpni
               iose(ii,ij) = iose(ii,ij) - jpni
            ENDIF
            IF( MOD(jarea,jpni) == 1 ) THEN
               iowe(ii,ij) = iproc + jpni - 1
               ionw(ii,ij) = ionw(ii,ij) + jpni
               iosw(ii,ij) = iosw(ii,ij) + jpni 
            ENDIF
            ibsw(ii,ij) = 1
            ibnw(ii,ij) = 1
            ibse(ii,ij) = 1
            ibne(ii,ij) = 1
            IF( iproc < jpni ) THEN
               ibsw(ii,ij) = 0
               ibse(ii,ij) = 0
            ENDIF
            IF( iproc >= (jpnj-1)*jpni ) THEN
               ibnw(ii,ij) = 0
               ibne(ii,ij) = 0
            ENDIF
         ENDIF
         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

         ! Check wet points over the entire domain to preserve the MPI communication stencil
         isurf = 0
         DO jj = 1, ilj
            DO  ji = 1, ili
               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
            END DO
         END DO

         IF(isurf /= 0) THEN
            icont = icont + 1
            ipproc(ii,ij) = icont
            iin(icont+1) = ii
            ijn(icont+1) = ij
         ENDIF
      END DO

      nfipproc(:,:) = ipproc(:,:)

      ! Control
      IF(icont+1 /= jpnij) THEN
         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' 
         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
      ENDIF

      ! 4. Subdomain print
      ! ------------------

      IF(lwp) THEN
         ifreq = 4
         il1 = 1
         DO jn = 1,(jpni-1)/ifreq+1
            il2 = MIN(jpni,il1+ifreq-1)
            WRITE(numout,*)
            WRITE(numout,9400) ('***',ji=il1,il2-1)
            DO jj = jpnj, 1, -1
               WRITE(numout,9403) ('   ',ji=il1,il2-1)
               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
               WRITE(numout,9403) ('   ',ji=il1,il2-1)
               WRITE(numout,9400) ('***',ji=il1,il2-1)
            END DO
            WRITE(numout,9401) (ji,ji=il1,il2)
            il1 = il1+ifreq
         END DO
 9400     FORMAT('     ***',20('*************',a3))
 9403     FORMAT('     *     ',20('         *   ',a3))
 9401     FORMAT('        ',20('   ',i3,'          '))
 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
      ENDIF


      ! 5. neighbour treatment
      ! ----------------------

      DO jarea = 1, jpni*jpnj
         iproc = jarea-1
         ii = 1 + MOD(jarea-1,jpni)
         ij = 1 +    (jarea-1)/jpni
         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
            iino = 1 + MOD(iono(ii,ij),jpni)
            ijno = 1 +    (iono(ii,ij))/jpni
! JD based on SM BEGIN
            icont = 0
            IF( ipproc(iino,ijno) /= -1 .AND. ij /= jpnj .AND. ij /= 1 ) THEN
              DO jj = 1, ij-1
                 IF( ipproc(ii,jj) /= -1 ) THEN
                    ioso(iino,ijno) = ii - 1 + (jj-1)*jpni
                    icont=1
                 ENDIF
              END DO
            ENDIF
            IF( icont == 0) THEN
              ! Need to reverse the logical direction of communication 
              ! for northern neighbours of northern row processors (north-fold)
              ! i.e. need to check that the northern neighbour only communicates
              ! to the SOUTH (or not at all) if this area is land-only (#1057)
              idir = 1
              IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1    
              IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2
              IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir
           ENDIF
         ENDIF
         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
            iiso = 1 + MOD(ioso(ii,ij),jpni)
            ijso = 1 +    (ioso(ii,ij))/jpni
            icont = 0
            IF( ipproc(iiso,ijso) /= -1 .AND. ij /= jpnj .AND. ij /= 1 ) THEN
              DO jj = jpnj, ij+1,-1
                 IF( ipproc(ii,jj) /= -1 ) THEN
                    iono(iiso,ijso) = ii - 1 + (jj-1)*jpni
                    icont=1
                 ENDIF
              END DO
            ENDIF
            IF( icont == 0) THEN
              IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
              IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
            ENDIF
! JD based on SM END
         ENDIF
         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
            iiea = 1 + MOD(ioea(ii,ij),jpni)
            ijea = 1 +    (ioea(ii,ij))/jpni
            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
         ENDIF
         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
            iiwe = 1 + MOD(iowe(ii,ij),jpni)
            ijwe = 1 +    (iowe(ii,ij))/jpni
            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
         ENDIF
         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
            iine = 1 + MOD(ione(ii,ij),jpni)
            ijne = 1 +    (ione(ii,ij))/jpni
            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
         ENDIF
         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
            iisw = 1 + MOD(iosw(ii,ij),jpni)
            ijsw = 1 +    (iosw(ii,ij))/jpni
            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
         ENDIF
         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
            iinw = 1 + MOD(ionw(ii,ij),jpni)
            ijnw = 1 +    (ionw(ii,ij))/jpni
            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
         ENDIF
         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
            iise = 1 + MOD(iose(ii,ij),jpni)
            ijse = 1 +    (iose(ii,ij))/jpni
            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
         ENDIF
      END DO


      ! 6. Change processor name
      ! ------------------------

      nproc = narea-1
      ii = iin(narea)
      ij = ijn(narea)

      ! set default neighbours
      noso = ioso(ii,ij)
      nowe = iowe(ii,ij)
      noea = ioea(ii,ij)
      nono = iono(ii,ij) 
      npse = iose(ii,ij)
      npsw = iosw(ii,ij)
      npne = ione(ii,ij)
      npnw = ionw(ii,ij)

      ! check neighbours location
      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
         iiso = 1 + MOD(ioso(ii,ij),jpni)
         ijso = 1 +    (ioso(ii,ij))/jpni
         noso = ipproc(iiso,ijso)
      ENDIF
      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 
         iiwe = 1 + MOD(iowe(ii,ij),jpni)
         ijwe = 1 +    (iowe(ii,ij))/jpni
         nowe = ipproc(iiwe,ijwe)
      ENDIF
      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 
         iiea = 1 + MOD(ioea(ii,ij),jpni)
         ijea = 1 +    (ioea(ii,ij))/jpni
         noea = ipproc(iiea,ijea)
      ENDIF
      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 
         iino = 1 + MOD(iono(ii,ij),jpni)
         ijno = 1 +    (iono(ii,ij))/jpni
         nono = ipproc(iino,ijno)
      ENDIF
      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN 
         iise = 1 + MOD(iose(ii,ij),jpni)
         ijse = 1 +    (iose(ii,ij))/jpni
         npse = ipproc(iise,ijse)
      ENDIF
      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN 
         iisw = 1 + MOD(iosw(ii,ij),jpni)
         ijsw = 1 +    (iosw(ii,ij))/jpni
         npsw = ipproc(iisw,ijsw)
      ENDIF
      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN 
         iine = 1 + MOD(ione(ii,ij),jpni)
         ijne = 1 +    (ione(ii,ij))/jpni
         npne = ipproc(iine,ijne)
      ENDIF
      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN 
         iinw = 1 + MOD(ionw(ii,ij),jpni)
         ijnw = 1 +    (ionw(ii,ij))/jpni
         npnw = ipproc(iinw,ijnw)
      ENDIF
      nbnw = ibnw(ii,ij)
      nbne = ibne(ii,ij)
      nbsw = ibsw(ii,ij)
      nbse = ibse(ii,ij)
      nlcj = ilcj(ii,ij)  
      nlci = ilci(ii,ij)  
      nldi = ildi(ii,ij)
      nlei = ilei(ii,ij)
      nldj = ildj(ii,ij)
      nlej = ilej(ii,ij)
      nbondi = ibondi(ii,ij)
      nbondj = ibondj(ii,ij)
      nimpp = iimppt(ii,ij)  
      njmpp = ijmppt(ii,ij)  
      DO jproc = 1, jpnij
         ii = iin(jproc)
         ij = ijn(jproc)
         nimppt(jproc) = iimppt(ii,ij)  
         njmppt(jproc) = ijmppt(ii,ij)  
         nlcjt(jproc) = ilcj(ii,ij)
         nlcit(jproc) = ilci(ii,ij)
         nldit(jproc) = ildi(ii,ij)
         nleit(jproc) = ilei(ii,ij)
         nldjt(jproc) = ildj(ii,ij)
         nlejt(jproc) = ilej(ii,ij)
      END DO

      CALL init_dom_xios(iin,ijn,iimppt,ijmppt,ildi,ildj,ilei,ilej)
      
      ! Save processor layout in ascii file
      IF (lwp) THEN
         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
         WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo'
         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'

        DO  jproc = 1, jpnij
         WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
                                      nldit(jproc), nldjt(jproc), &
                                      nleit(jproc), nlejt(jproc), &
                                      nimppt(jproc), njmppt(jproc)
        END DO
        CLOSE(inum)   
      END IF

      ! 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

      ! Periodicity : no corner if nbondi = 2 and nperio != 1

      IF(lwp) THEN
         WRITE(numout,*) ' nproc  = ', nproc
         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,*) ' nperio = ', nperio
         WRITE(numout,*) ' nlci   = ', nlci
         WRITE(numout,*) ' nlcj   = ', nlcj
         WRITE(numout,*) ' nimpp  = ', nimpp
         WRITE(numout,*) ' njmpp  = ', njmpp
         WRITE(numout,*) ' nreci  = ', nreci  , ' npse   = ', npse
         WRITE(numout,*) ' nrecj  = ', nrecj  , ' npsw   = ', npsw
         WRITE(numout,*) ' jpreci = ', jpreci , ' npne   = ', npne
         WRITE(numout,*) ' jprecj = ', jprecj , ' npnw   = ', npnw
         WRITE(numout,*)
      ENDIF

      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' )

      ! Prepare mpp north fold

      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
         CALL mpp_ini_north
         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
      ENDIF

      ! Prepare NetCDF output file (if necessary)
      CALL mpp_init_ioipsl
      !
      CALL dom_xios_read_coordinates
      !
   END SUBROUTINE mpp_init2