Changeset 9436 for branches/2017/dev_merge_2017/NEMOGCM

Timestamp:

2018-03-27T15:30:51+02:00 (6 years ago)

Author:

acc

Message:

Branch 2017/dev_merge_2017. Reorganisation of nemogcm.F90 and mppini.F90 to better separate domain decomposition functions from the rest of the initialisation. Stage 1: Main reorganisation; see ticket #2070

Location:

branches/2017/dev_merge_2017/NEMOGCM/NEMO

Files:

• OFF_SRC/nemogcm.F90 (modified) (8 diffs)
• OPA_SRC/DOM/dom_oce.F90 (modified) (1 diff)
• OPA_SRC/LBC/mppini.F90 (modified) (20 diffs)
• OPA_SRC/nemogcm.F90 (modified) (7 diffs)
• SAO_SRC/nemogcm.F90 (modified) (12 diffs)
• SAS_SRC/nemogcm.F90 (modified) (6 diffs)

branches/2017/dev_merge_2017/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

@@ -16 +16 @@
    !!   nemo_closefile: close remaining open files
    !!   nemo_alloc    : dynamical allocation
-   !!   nemo_partition: calculate MPP domain decomposition
-   !!   factorise     : calculate the factors of the no. of MPI processes
-   !!   nemo_nfdcom   : Setup for north fold exchanges with explicit point-to-point messaging
    !!   istate_init   : simple initialization to zero of ocean fields
    !!   stp_ctl       : reduced step control (no dynamics in off-line)
@@ -157 +154 @@
       INTEGER  ::   ji                 ! dummy loop indices
       INTEGER  ::   ios, ilocal_comm   ! local integers
-      INTEGER  ::   iiarea, ijarea     !   -       -
-      INTEGER  ::   iirest, ijrest     !   -       -
       CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam
       !!
@@ -232 +227 @@
       ENDIF
 
-      ! If dimensions of processor grid weren't specified in the namelist file 
-      ! then we calculate them here now that we have our communicator size
-      IF( jpni < 1  .OR.  jpnj < 1 ) THEN
-#if   defined key_mpp_mpi
-         CALL nemo_partition( mppsize )
-#else
-         jpni  = 1
-         jpnj  = 1
-         jpnij = jpni*jpnj
-#endif
-      ENDIF
-
-      iiarea = 1 + MOD( narea - 1 , jpni )
-      ijarea = 1 + ( narea - 1 ) / jpni
-      iirest = 1 + MOD( jpiglo - 2*nn_hls - 1 , jpni )
-      ijrest = 1 + MOD( jpjglo - 2*nn_hls - 1 , jpnj )
-#if defined key_nemocice_decomp
-      jpi = ( nx_global+2-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim.
-      jpj = ( ny_global+2-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim. 
-      jpimax  = jpi
-      jpjmax  = jpj
-      IF( iiarea == jpni ) jpi = jpiglo - (jpni - 1) * (jpi - 2*nn_hls)
-      IF( ijarea == jpnj ) jpj = jpjglo - (jpnj - 1) * (jpj - 2*nn_hls)
-#else
-      jpi = ( jpiglo     -2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim.
-      jpj = ( jpjglo     -2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim.
-      jpimax  = jpi
-      jpjmax  = jpj
-      IF( iiarea > iirest ) jpi = jpi - 1
-      IF( ijarea > ijrest ) jpj = jpj - 1
-#endif
-
-      jpk   = jpkglo                                           ! third dim
-
-      jpim1 = jpi-1                                            ! inner domain indices
-      jpjm1 = jpj-1                                            !   "           "
-      jpkm1 = MAX( 1, jpk-1 )                                  !   "           "
-      jpij  = jpi*jpj                                          !  jpi x j
-
-
       IF(lwp) THEN                            ! open listing units
          !
@@ -295 +250 @@
          !
       ENDIF
+      !                                      ! Domain decomposition
+      CALL mpp_init                          ! MPP
 
       ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
@@ -304 +261 @@
 
       CALL nemo_ctl                          ! Control prints
-
-      !                                      ! Domain decomposition
-      CALL mpp_init                             ! MPP
-      IF( ln_nnogather )   CALL nemo_nfdcom     ! northfold neighbour lists
       !
       !                                      ! General initialization
@@ -385 +338 @@
          WRITE(numout,*) '      read domain configuration file              ln_read_cfg      = ', ln_read_cfg
          WRITE(numout,*) '         filename to be read                         cn_domcfg     = ', TRIM(cn_domcfg)
-         WRITE(numout,*) '         keep closed seas in the domain (if exist)   ln_closea     = ', TRIM(cn_domcfg)
+         WRITE(numout,*) '         keep closed seas in the domain (if exist)   ln_closea     = ', ln_closea
          WRITE(numout,*) '      create a configuration definition file      ln_write_cfg     = ', ln_write_cfg
          WRITE(numout,*) '         filename to be written                      cn_domcfg_out = ', TRIM(cn_domcfg_out)
@@ -486 +439 @@
    END SUBROUTINE nemo_alloc
 
-
-   SUBROUTINE nemo_partition( num_pes )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE nemo_partition  ***
-      !!
-      !! ** Purpose :   
-      !!
-      !! ** Method  :
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have
-      !
-      INTEGER, PARAMETER :: nfactmax = 20
-      INTEGER :: nfact ! The no. of factors returned
-      INTEGER :: ierr  ! Error flag
-      INTEGER :: ji
-      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
-      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
-      !!----------------------------------------------------------------------
-      !
-      ierr = 0
-      !
-      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
-      !
-      IF( nfact <= 1 ) THEN
-         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
-         WRITE (numout, *) '       : using grid of ',num_pes,' x 1'
-         jpnj = 1
-         jpni = num_pes
-      ELSE
-         ! Search through factors for the pair that are closest in value
-         mindiff = 1000000
-         imin    = 1
-         DO ji = 1, nfact-1, 2
-            idiff = ABS( ifact(ji) - ifact(ji+1) )
-            IF( idiff < mindiff ) THEN
-               mindiff = idiff
-               imin = ji
-            ENDIF
-         END DO
-         jpnj = ifact(imin)
-         jpni = ifact(imin + 1)
-      ENDIF
-      !
-      jpnij = jpni*jpnj
-      !
-   END SUBROUTINE nemo_partition
-
-
-   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE factorise  ***
-      !!
-      !! ** Purpose :   return the prime factors of n.
-      !!                knfax factors are returned in array kfax which is of
-      !!                maximum dimension kmaxfax.
-      !! ** Method  :
-      !!----------------------------------------------------------------------
-      INTEGER                    , INTENT(in   ) ::   kn, kmaxfax
-      INTEGER                    , INTENT(  out) ::   kerr, knfax
-      INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax
-      !
-      INTEGER :: ifac, jl, inu
-      INTEGER, PARAMETER :: ntest = 14
-      INTEGER, DIMENSION(ntest) ::   ilfax
-      !!----------------------------------------------------------------------
-      !
-      ! lfax contains the set of allowed factors.
-      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
-      !
-      ! Clear the error flag and initialise output vars
-      kerr  = 0
-      kfax  = 1
-      knfax = 0
-      !
-      IF( kn /= 1 ) THEN      ! Find the factors of n
-         !
-         ! nu holds the unfactorised part of the number.
-         ! knfax holds the number of factors found.
-         ! l points to the allowed factor list.
-         ! ifac holds the current factor.
-         !
-         inu   = kn
-         knfax = 0
-         !
-         DO jl = ntest, 1, -1
-            !
-            ifac = ilfax(jl)
-            IF( ifac > inu )   CYCLE
-            !
-            ! Test whether the factor will divide.
-            !
-            IF( MOD(inu,ifac) == 0 ) THEN
-               !
-               knfax = knfax + 1            ! Add the factor to the list
-               IF( knfax > kmaxfax ) THEN
-                  kerr = 6
-                  write (*,*) 'FACTOR: insufficient space in factor array ', knfax
-                  return
-               ENDIF
-               kfax(knfax) = ifac
-               ! Store the other factor that goes with this one
-               knfax = knfax + 1
-               kfax(knfax) = inu / ifac
-               !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
-            ENDIF
-            !
-         END DO
-         !
-      ENDIF
-      !
-   END SUBROUTINE factorise
-
-#if defined key_mpp_mpi
-
-   SUBROUTINE nemo_nfdcom
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE  nemo_nfdcom  ***
-      !! ** Purpose :   Setup for north fold exchanges with explicit 
-      !!                point-to-point messaging
-      !!
-      !! ** Method :   Initialization of the northern neighbours lists.
-      !!----------------------------------------------------------------------
-      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
-      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
-      !!----------------------------------------------------------------------
-      INTEGER  ::   sxM, dxM, sxT, dxT, jn
-      INTEGER  ::   njmppmax
-      !!----------------------------------------------------------------------
-      !
-      njmppmax = MAXVAL( njmppt )
-      !
-      !initializes the north-fold communication variables
-      isendto(:) = 0
-      nsndto     = 0
-      !
-      IF ( njmpp == njmppmax ) THEN      ! if I am a process in the north
-         !
-         !sxM is the first point (in the global domain) needed to compute the north-fold for the current process
-         sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
-         !dxM is the last point (in the global domain) needed to compute the north-fold for the current process
-         dxM = jpiglo - nimppt(narea) + 2
-         !
-         ! loop over the other north-fold processes to find the processes
-         ! managing the points belonging to the sxT-dxT range
-         !
-         DO jn = 1, jpni
-            !
-            sxT = nfiimpp(jn, jpnj)                            ! sxT = 1st  point (in the global domain) of the jn process
-            dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1    ! dxT = last point (in the global domain) of the jn process
-            !
-            IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN
-               nsndto          = nsndto + 1
-               isendto(nsndto) = jn
-            ELSEIF( sxM <= sxT  .AND.  dxM >= dxT ) THEN
-               nsndto          = nsndto + 1
-               isendto(nsndto) = jn
-            ELSEIF( dxM <  dxT  .AND.  sxT <  dxM ) THEN
-               nsndto          = nsndto + 1
-               isendto(nsndto) = jn
-            ENDIF
-            !
-         END DO
-         nfsloop = 1
-         nfeloop = nlci
-         DO jn = 2,jpni-1
-            IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN
-               IF( nfipproc(jn-1,jpnj) == -1 )   nfsloop = nldi
-               IF( nfipproc(jn+1,jpnj) == -1 )   nfeloop = nlei
-            ENDIF
-         END DO
-         !
-      ENDIF
-      l_north_nogather = .TRUE.
-      !
-   END SUBROUTINE nemo_nfdcom
-
-#else
-   SUBROUTINE nemo_nfdcom      ! Dummy routine
-      WRITE(*,*) 'nemo_nfdcom: You should not have seen this print! error?'
-   END SUBROUTINE nemo_nfdcom
-#endif
-
    SUBROUTINE istate_init
       !!----------------------------------------------------------------------
@@ -715 +486 @@
       !
    END SUBROUTINE stp_ctl
-
    !!======================================================================
 END MODULE nemogcm

branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

@@ -239 +239 @@
       ierr(:) = 0
       !
-      ALLOCATE( mig(jpi), mjg(jpj), nfiimpp(jpni,jpnj),  &
-         &      nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), STAT=ierr(1) )
-         !
-      ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,     &
-         &      njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,     &
-         &                                      nleit(jpnij) , nlejt(jpnij) ,     &
-         &      mi0(jpiglo)   , mi1 (jpiglo),  mj0(jpjglo)   , mj1 (jpjglo) ,     &
+      ALLOCATE( mig(jpi), mjg(jpj), STAT=ierr(1) )
+         !
+      ALLOCATE( mi0(jpiglo)   , mi1 (jpiglo),  mj0(jpjglo)   , mj1 (jpjglo) ,     &
          &      tpol(jpiglo)  , fpol(jpiglo)                                , STAT=ierr(2) )
          !

branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

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

branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

@@ -28 +28 @@
    !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
-   !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_nfdcom
    !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE
    !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 
-   !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_nfdcom: setup avoiding MPI communication 
    !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla)
    !!            4.0  ! 2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface
@@ -42 +40 @@
    !!   nemo_closefile: close remaining open files
    !!   nemo_alloc    : dynamical allocation
-   !!   nemo_partition: calculate MPP domain decomposition
-   !!   factorise     : calculate the factors of the no. of MPI processes
-   !!   nemo_nfdcom   : Setup for north fold exchanges with explicit point-to-point messaging
    !!----------------------------------------------------------------------
    USE step_oce       ! module used in the ocean time stepping module (step.F90)
@@ -239 +234 @@
       INTEGER  ::   ji                 ! dummy loop indices
       INTEGER  ::   ios, ilocal_comm   ! local integers
-      INTEGER  ::   iiarea, ijarea     !   -       -
-      INTEGER  ::   iirest, ijrest     !   -       -
       CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam
       !!
@@ -329 +322 @@
       ENDIF
 
-      ! If dimensions of processor grid weren't specified in the namelist file
-      ! then we calculate them here now that we have our communicator size
-      IF( jpni < 1 .OR. jpnj < 1 ) THEN
-#if   defined key_mpp_mpi
-         IF( Agrif_Root() )   CALL nemo_partition( mppsize )
-#else
-         jpni  = 1
-         jpnj  = 1
-         jpnij = jpni*jpnj
-#endif
-      ENDIF
-      !
-#if defined key_agrif
-      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90)
-         jpiglo  = nbcellsx + 2 + 2*nbghostcells
-         jpjglo  = nbcellsy + 2 + 2*nbghostcells
-         jpi     = ( jpiglo-2*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls
-         jpj     = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls
-         jpimax  = jpi
-         jpjmax  = jpj
-         nperio  = 0
-         jperio  = 0
-         ln_use_jattr = .false.
-      ENDIF
-#endif
-
-      IF( Agrif_Root() ) THEN       ! AGRIF mother: specific setting from jpni and jpnj
-         iiarea = 1 + MOD( narea - 1 , jpni )
-         ijarea = 1 + ( narea - 1 ) / jpni
-         iirest = 1 + MOD( jpiglo - 2*nn_hls - 1 , jpni )
-         ijrest = 1 + MOD( jpjglo - 2*nn_hls - 1 , jpnj )
-#if defined key_nemocice_decomp
-         jpi = ( nx_global+2-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim.
-         jpj = ( ny_global+2-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim. 
-         jpimax  = jpi
-         jpjmax  = jpj
-         IF( iiarea == jpni ) jpi = jpiglo - (jpni - 1) * (jpi - 2*nn_hls)
-         IF( ijarea == jpnj ) jpj = jpjglo - (jpnj - 1) * (jpj - 2*nn_hls)
-#else
-         jpi = ( jpiglo     -2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim.
-         jpj = ( jpjglo     -2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim.
-         jpimax  = jpi
-         jpjmax  = jpj
-         IF( iiarea > iirest ) jpi = jpi - 1
-         IF( ijarea > ijrest ) jpj = jpj - 1
-#endif
-      ENDIF
-
-      jpk = jpkglo                                             ! third dim
-
-#if defined key_agrif
-      ! simple trick to use same vertical grid as parent but different number of levels: 
-      ! Save maximum number of levels in jpkglo, then define all vertical grids with this number.
-      ! Suppress once vertical online interpolation is ok
-      IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo )
-#endif
-      jpim1 = jpi-1                                            ! inner domain indices
-      jpjm1 = jpj-1                                            !   "           "
-      jpkm1 = MAX( 1, jpk-1 )                                  !   "           "
-      jpij  = jpi*jpj                                          !  jpi x j
-
       IF(lwp) THEN                            ! open listing units
          !
@@ -413 +345 @@
          !
       ENDIF
+      !                                      ! Domain decomposition
+      CALL mpp_init                          ! MPP
 
       ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
@@ -422 +356 @@
 
       CALL nemo_ctl                          ! Control prints
-
-      !                                      ! Domain decomposition
-      CALL mpp_init                             ! MPP
-      IF( ln_nnogather )   CALL nemo_nfdcom     ! northfold neighbour lists
       !
       !                                      ! General initialization
@@ -681 +611 @@
    END SUBROUTINE nemo_alloc
 
-
-   SUBROUTINE nemo_partition( num_pes )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE nemo_partition  ***
-      !!
-      !! ** Purpose :
-      !!
-      !! ** Method  :
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have
-      !
-      INTEGER, PARAMETER :: nfactmax = 20
-      INTEGER :: nfact ! The no. of factors returned
-      INTEGER :: ierr  ! Error flag
-      INTEGER :: ji
-      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
-      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
-      !!----------------------------------------------------------------------
-      !
-      ierr = 0
-      !
-      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
-      !
-      IF( nfact <= 1 ) THEN
-         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
-         WRITE (numout, *) '       : using grid of ',num_pes,' x 1'
-         jpnj = 1
-         jpni = num_pes
-      ELSE
-         ! Search through factors for the pair that are closest in value
-         mindiff = 1000000
-         imin    = 1
-         DO ji = 1, nfact-1, 2
-            idiff = ABS( ifact(ji) - ifact(ji+1) )
-            IF( idiff < mindiff ) THEN
-               mindiff = idiff
-               imin = ji
-            ENDIF
-         END DO
-         jpnj = ifact(imin)
-         jpni = ifact(imin + 1)
-      ENDIF
-      !
-      jpnij = jpni*jpnj
-      !
-   END SUBROUTINE nemo_partition
-
-
-   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE factorise  ***
-      !!
-      !! ** Purpose :   return the prime factors of n.
-      !!                knfax factors are returned in array kfax which is of
-      !!                maximum dimension kmaxfax.
-      !! ** Method  :
-      !!----------------------------------------------------------------------
-      INTEGER                    , INTENT(in   ) ::   kn, kmaxfax
-      INTEGER                    , INTENT(  out) ::   kerr, knfax
-      INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax
-      !
-      INTEGER :: ifac, jl, inu
-      INTEGER, PARAMETER :: ntest = 14
-      INTEGER, DIMENSION(ntest) ::   ilfax
-      !!----------------------------------------------------------------------
-      !
-      ! lfax contains the set of allowed factors.
-      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
-      !
-      ! Clear the error flag and initialise output vars
-      kerr  = 0
-      kfax  = 1
-      knfax = 0
-      !
-      IF( kn /= 1 ) THEN      ! Find the factors of n
-         !
-         ! nu holds the unfactorised part of the number.
-         ! knfax holds the number of factors found.
-         ! l points to the allowed factor list.
-         ! ifac holds the current factor.
-         !
-         inu   = kn
-         knfax = 0
-         !
-         DO jl = ntest, 1, -1
-            !
-            ifac = ilfax(jl)
-            IF( ifac > inu )   CYCLE
-            !
-            ! Test whether the factor will divide.
-            !
-            IF( MOD(inu,ifac) == 0 ) THEN
-               !
-               knfax = knfax + 1            ! Add the factor to the list
-               IF( knfax > kmaxfax ) THEN
-                  kerr = 6
-                  write (*,*) 'FACTOR: insufficient space in factor array ', knfax
-                  return
-               ENDIF
-               kfax(knfax) = ifac
-               ! Store the other factor that goes with this one
-               knfax = knfax + 1
-               kfax(knfax) = inu / ifac
-               !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
-            ENDIF
-            !
-         END DO
-         !
-      ENDIF
-      !
-   END SUBROUTINE factorise
-
-#if defined key_mpp_mpi
-
-   SUBROUTINE nemo_nfdcom
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE  nemo_nfdcom  ***
-      !! ** Purpose :   Setup for north fold exchanges with explicit 
-      !!                point-to-point messaging
-      !!
-      !! ** Method :   Initialization of the northern neighbours lists.
-      !!----------------------------------------------------------------------
-      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
-      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
-      !!----------------------------------------------------------------------
-      INTEGER  ::   sxM, dxM, sxT, dxT, jn
-      INTEGER  ::   njmppmax
-      !!----------------------------------------------------------------------
-      !
-      njmppmax = MAXVAL( njmppt )
-      !
-      !initializes the north-fold communication variables
-      isendto(:) = 0
-      nsndto     = 0
-      !
-      IF ( njmpp == njmppmax ) THEN      ! if I am a process in the north
-         !
-         !sxM is the first point (in the global domain) needed to compute the north-fold for the current process
-         sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
-         !dxM is the last point (in the global domain) needed to compute the north-fold for the current process
-         dxM = jpiglo - nimppt(narea) + 2
-         !
-         ! loop over the other north-fold processes to find the processes
-         ! managing the points belonging to the sxT-dxT range
-         !
-         DO jn = 1, jpni
-            !
-            sxT = nfiimpp(jn, jpnj)                            ! sxT = 1st  point (in the global domain) of the jn process
-            dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1    ! dxT = last point (in the global domain) of the jn process
-            !
-            IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN
-               nsndto          = nsndto + 1
-               isendto(nsndto) = jn
-            ELSEIF( sxM <= sxT  .AND.  dxM >= dxT ) THEN
-               nsndto          = nsndto + 1
-               isendto(nsndto) = jn
-            ELSEIF( dxM <  dxT  .AND.  sxT <  dxM ) THEN
-               nsndto          = nsndto + 1
-               isendto(nsndto) = jn
-            ENDIF
-            !
-         END DO
-         nfsloop = 1
-         nfeloop = nlci
-         DO jn = 2,jpni-1
-            IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN
-               IF( nfipproc(jn-1,jpnj) == -1 )   nfsloop = nldi
-               IF( nfipproc(jn+1,jpnj) == -1 )   nfeloop = nlei
-            ENDIF
-         END DO
-         !
-      ENDIF
-      l_north_nogather = .TRUE.
-      !
-   END SUBROUTINE nemo_nfdcom
-
-#else
-   SUBROUTINE nemo_nfdcom      ! Dummy routine
-      WRITE(*,*) 'nemo_nfdcom: You should not have seen this print! error?'
-   END SUBROUTINE nemo_nfdcom
-#endif
-
    !!======================================================================
 END MODULE nemogcm

branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90

@@ -14 +14 @@
    !!   nemo_closefile: close remaining open files
    !!   nemo_alloc    : dynamical allocation
-   !!   nemo_partition: calculate MPP domain decomposition
-   !!   factorise     : calculate the factors of the no. of MPI processes
    !!----------------------------------------------------------------------
    USE step_oce       ! module used in the ocean time stepping module (step.F90)
@@ -93 +91 @@
       INTEGER ::   ji                 ! dummy loop indices
       INTEGER ::   ios, ilocal_comm   ! local integer
-      INTEGER  ::   iiarea, ijarea     ! local integers
-      INTEGER  ::   iirest, ijrest     ! local integers
       CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam
       !
@@ -100 +96 @@
          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,   &
          &             ln_timing, ln_diacfl
-      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr
+      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
       !!----------------------------------------------------------------------
       !
@@ -136 +132 @@
       ENDIF
       !
-      jpk = jpkglo
-      !
-#if defined key_agrif
-      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90)
-         jpiglo  = nbcellsx + 2 + 2*nbghostcells
-         jpjglo  = nbcellsy + 2 + 2*nbghostcells
-         jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
-         jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
-         nperio  = 0
-         jperio  = 0
-         ln_use_jattr = .false.
-      ENDIF
-#endif
       !
       !                             !--------------------------------------------!
@@ -174 +157 @@
          narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
       ELSE
-         ilocal_comm = 0
-         ! Nodes selection (control print return in cltxt)
+         ilocal_comm = 0                                    ! Nodes selection (control print return in cltxt)
          narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )
       ENDIF
@@ -198 +180 @@
       ENDIF
 
-      ! If dimensions of processor grid weren't specified in the namelist file
-      ! then we calculate them here now that we have our communicator size
-      IF( jpni < 1 .OR. jpnj < 1 ) THEN
-#if   defined key_mpp_mpi
-         IF( Agrif_Root() )   CALL nemo_partition( mppsize )
-#else
-         jpni  = 1
-         jpnj  = 1
-         jpnij = jpni*jpnj
-#endif
-      ENDIF
-      !
-#if defined key_agrif
-      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90)
-         jpiglo  = nbcellsx + 2 + 2*nbghostcells
-         jpjglo  = nbcellsy + 2 + 2*nbghostcells
-         jpi     = ( jpiglo-2*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls
-         jpj     = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls
-         jpimax  = jpi
-         jpjmax  = jpj
-         nperio  = 0
-         jperio  = 0
-         ln_use_jattr = .false.
-      ENDIF
-#endif
-
-      IF( Agrif_Root() ) THEN       ! AGRIF mother: specific setting from jpni and jpnj
-         iiarea = 1 + MOD( narea - 1 , jpni )
-         ijarea = 1 + ( narea - 1 ) / jpni
-         iirest = 1 + MOD( jpiglo - 2*nn_hls - 1 , jpni )
-         ijrest = 1 + MOD( jpjglo - 2*nn_hls - 1 , jpnj )
-#if defined key_nemocice_decomp
-         jpi = ( nx_global+2-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim.
-         jpj = ( ny_global+2-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim. 
-         jpimax  = jpi
-         jpjmax  = jpj
-         IF( iiarea == jpni ) jpi = jpiglo - (jpni - 1) * (jpi - 2*nn_hls)
-         IF( ijarea == jpnj ) jpj = jpjglo - (jpnj - 1) * (jpj - 2*nn_hls)
-#else
-         jpi = ( jpiglo     -2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim.
-         jpj = ( jpjglo     -2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim.
-         jpimax  = jpi
-         jpjmax  = jpj
-         IF( iiarea > iirest ) jpi = jpi - 1
-         IF( ijarea > ijrest ) jpj = jpj - 1
-#endif
-      ENDIF
-
-      jpk = jpkglo                                             ! third dim
-
-#if defined key_agrif
-      ! simple trick to use same vertical grid as parent but different number of levels: 
-      ! Save maximum number of levels in jpkglo, then define all vertical grids with this number.
-      ! Suppress once vertical online interpolation is ok
-      IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo )
-#endif
-      jpim1 = jpi-1                                            ! inner domain indices
-      jpjm1 = jpj-1                                            !   "           "
-      jpkm1 = MAX( 1, jpk-1 )                                  !   "           "
-      jpij  = jpi*jpj                                          !  jpi x j
-
       IF(lwp) THEN                            ! open listing units
          !
@@ -267 +188 @@
          WRITE(numout,*) '                       NEMO team'
          WRITE(numout,*) '            Stand Alone Observation operator'
-         WRITE(numout,*) '                NEMO version 3.7  (2015) '
+         WRITE(numout,*) '                NEMO version 4.0  (2017) '
          WRITE(numout,*)
          WRITE(numout,*)
@@ -282 +203 @@
          !
       ENDIF
+      !                                      ! Domain decomposition
+      CALL mpp_init                          ! MPP
 
       ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
@@ -290 +213 @@
       !                             !-------------------------------!
 
-      CALL nemo_ctl                             ! Control prints & Benchmark
-
-      !                                      ! Domain decomposition
-      CALL mpp_init
-      !
-      IF( ln_timing    )   CALL timing_init     ! timing by routine
+      CALL nemo_ctl                          ! Control prints
       !
       !                                         ! General initialization
+      IF( ln_timing    )   CALL timing_init     ! timing
+      IF( ln_timing    )   CALL timing_start( 'nemo_init')
+      !
                            CALL phy_cst            ! Physical constants
                            CALL eos_init           ! Equation of state
                            CALL dom_init('SAO')    ! Domain
 
-      IF( ln_nnogather )   CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined)
 
       IF( ln_ctl       )   CALL prt_ctl_init    ! Print control
@@ -322 +242 @@
          WRITE(numout,*)
          WRITE(numout,*) 'nemo_ctl: Control prints'
-         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '~~~~~~~~'
          WRITE(numout,*) '   Namelist namctl'
          WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
@@ -351 +271 @@
          WRITE(numout,*) '      read domain configuration file                ln_read_cfg      = ', ln_read_cfg
          WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg)
+         WRITE(numout,*) '         keep closed seas in the domain (if exist)     ln_closea     = ', ln_closea
          WRITE(numout,*) '      write configuration definition file           ln_write_cfg     = ', ln_write_cfg
          WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out)
          WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr
       ENDIF
+      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file
+      !
       !                             ! Parameter control
       !
@@ -454 +377 @@
    END SUBROUTINE nemo_alloc
 
-
-   SUBROUTINE nemo_partition( num_pes )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE nemo_partition  ***
-      !!
-      !! ** Purpose :
-      !!
-      !! ** Method  :
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have
-      !
-      INTEGER, PARAMETER :: nfactmax = 20
-      INTEGER :: nfact ! The no. of factors returned
-      INTEGER :: ierr  ! Error flag
-      INTEGER :: ji
-      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
-      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
-      !!----------------------------------------------------------------------
-      !
-      ierr = 0
-      !
-      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
-      !
-      IF( nfact <= 1 ) THEN
-         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
-         WRITE (numout, *) '       : using grid of ',num_pes,' x 1'
-         jpnj = 1
-         jpni = num_pes
-      ELSE
-         ! Search through factors for the pair that are closest in value
-         mindiff = 1000000
-         imin    = 1
-         DO ji = 1, nfact-1, 2
-            idiff = ABS( ifact(ji) - ifact(ji+1) )
-            IF( idiff < mindiff ) THEN
-               mindiff = idiff
-               imin = ji
-            ENDIF
-         END DO
-         jpnj = ifact(imin)
-         jpni = ifact(imin + 1)
-      ENDIF
-      !
-      jpnij = jpni*jpnj
-      !
-   END SUBROUTINE nemo_partition
-
-
-   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE factorise  ***
-      !!
-      !! ** Purpose :   return the prime factors of n.
-      !!                knfax factors are returned in array kfax which is of
-      !!                maximum dimension kmaxfax.
-      !! ** Method  :
-      !!----------------------------------------------------------------------
-      INTEGER                    , INTENT(in   ) ::   kn, kmaxfax
-      INTEGER                    , INTENT(  out) ::   kerr, knfax
-      INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax
-      !
-      INTEGER :: ifac, jl, inu
-      INTEGER, PARAMETER :: ntest = 14
-      INTEGER, DIMENSION(ntest) ::   ilfax
-      !!----------------------------------------------------------------------
-      !
-      ! lfax contains the set of allowed factors.
-      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
-      !
-      ! Clear the error flag and initialise output vars
-      kerr  = 0
-      kfax  = 1
-      knfax = 0
-      !
-      ! Find the factors of n.
-      IF( kn .NE. 1 ) THEN
-
-         ! nu holds the unfactorised part of the number.
-         ! knfax holds the number of factors found.
-         ! l points to the allowed factor list.
-         ! ifac holds the current factor.
-         !
-         inu   = kn
-         knfax = 0
-         !
-         DO jl = ntest, 1, -1
-            !
-            ifac = ilfax(jl)
-            IF( ifac > inu )   CYCLE
-   
-            ! Test whether the factor will divide.
-   
-            IF( MOD(inu,ifac) == 0 ) THEN
-               !
-               knfax = knfax + 1            ! Add the factor to the list
-               IF( knfax > kmaxfax ) THEN
-                  kerr = 6
-                  write (*,*) 'FACTOR: insufficient space in factor array ', knfax
-                  return
-               ENDIF
-               kfax(knfax) = ifac
-               ! Store the other factor that goes with this one
-               knfax = knfax + 1
-               kfax(knfax) = inu / ifac
-               !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
-            ENDIF
-            !
-         END DO
-         !
-      ENDIF
-      !
-   END SUBROUTINE factorise
-
-#if defined key_mpp_mpi
-
-   SUBROUTINE nemo_northcomms
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE  nemo_northcomms  ***
-      !! ** Purpose :   Setup for north fold exchanges with explicit 
-      !!                point-to-point messaging
-      !!
-      !! ** Method :   Initialization of the northern neighbours lists.
-      !!----------------------------------------------------------------------
-      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
-      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
-      !!----------------------------------------------------------------------
-      INTEGER  ::   sxM, dxM, sxT, dxT, jn
-      INTEGER  ::   njmppmax
-      !!----------------------------------------------------------------------
-      !
-      njmppmax = MAXVAL( njmppt )
-      !
-      !initializes the north-fold communication variables
-      isendto(:) = 0
-      nsndto     = 0
-      !
-      !if I am a process in the north
-      IF ( njmpp == njmppmax ) THEN
-          !sxM is the first point (in the global domain) needed to compute the
-          !north-fold for the current process
-          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
-          !dxM is the last point (in the global domain) needed to compute the
-          !north-fold for the current process
-          dxM = jpiglo - nimppt(narea) + 2
-
-          !loop over the other north-fold processes to find the processes
-          !managing the points belonging to the sxT-dxT range
-  
-          DO jn = 1, jpni
-                !sxT is the first point (in the global domain) of the jn
-                !process
-                sxT = nfiimpp(jn, jpnj)
-                !dxT is the last point (in the global domain) of the jn
-                !process
-                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
-                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
-                   nsndto = nsndto + 1
-                   isendto(nsndto) = jn
-                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
-                   nsndto = nsndto + 1
-                   isendto(nsndto) = jn
-                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
-                   nsndto = nsndto + 1
-                   isendto(nsndto) = jn
-                ENDIF
-          END DO
-          nfsloop = 1
-          nfeloop = nlci
-          DO jn = 2,jpni-1
-           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
-              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
-                 nfsloop = nldi
-              ENDIF
-              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
-                 nfeloop = nlei
-              ENDIF
-           ENDIF
-        END DO
-
-      ENDIF
-      l_north_nogather = .TRUE.
-   END SUBROUTINE nemo_northcomms
-
-#else
-   SUBROUTINE nemo_northcomms      ! Dummy routine
-      WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?'
-   END SUBROUTINE nemo_northcomms
-#endif
-
    !!======================================================================
 END MODULE nemogcm

branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

@@ -16 +16 @@
    !!   nemo_closefile: close remaining open files
    !!   nemo_alloc    : dynamical allocation
-   !!   nemo_partition: calculate MPP domain decomposition
-   !!   factorise     : calculate the factors of the no. of MPI processes
-   !!   nemo_nfdcom   : Setup for north fold exchanges with explicit point-to-point messaging
    !!----------------------------------------------------------------------
    USE step_oce       ! module used in the ocean time stepping module
@@ -175 +172 @@
       INTEGER  ::   ji                 ! dummy loop indices
       INTEGER  ::   ios, ilocal_comm   ! local integers
-      INTEGER  ::   iiarea, ijarea     !   -       -
-      INTEGER  ::   iirest, ijrest     !   -       -
       CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam
       CHARACTER(len=80)                 ::   clname
@@ -273 +268 @@
       ENDIF
 
-      ! If dimensions of processor grid weren't specified in the namelist file
-      ! then we calculate them here now that we have our communicator size
-      IF( jpni < 1 .OR. jpnj < 1 ) THEN
-#if   defined key_mpp_mpi
-         IF( Agrif_Root() )   CALL nemo_partition( mppsize )
-#else
-         jpni  = 1
-         jpnj  = 1
-         jpnij = jpni*jpnj
-#endif
-      ENDIF
-      !
-#if defined key_agrif
-      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90)
-         jpiglo  = nbcellsx + 2 + 2*nbghostcells
-         jpjglo  = nbcellsy + 2 + 2*nbghostcells
-         jpi     = ( jpiglo-2*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls
-         jpj     = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls
-         jpimax  = jpi
-         jpjmax  = jpj
-         nperio  = 0
-         jperio  = 0
-         ln_use_jattr = .false.
-      ENDIF
-#endif
-
-      IF( Agrif_Root() ) THEN       ! AGRIF mother: specific setting from jpni and jpnj
-         iiarea = 1 + MOD( narea - 1 , jpni )
-         ijarea = 1 + ( narea - 1 ) / jpni
-         iirest = 1 + MOD( jpiglo - 2*nn_hls - 1 , jpni )
-         ijrest = 1 + MOD( jpjglo - 2*nn_hls - 1 , jpnj )
-#if defined key_nemocice_decomp
-         jpi = ( nx_global+2-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim.
-         jpj = ( ny_global+2-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim. 
-         jpimax  = jpi
-         jpjmax  = jpj
-         IF( iiarea == jpni ) jpi = jpiglo - (jpni - 1) * (jpi - 2*nn_hls)
-         IF( ijarea == jpnj ) jpj = jpjglo - (jpnj - 1) * (jpj - 2*nn_hls)
-#else
-         jpi = ( jpiglo     -2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim.
-         jpj = ( jpjglo     -2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim.
-         jpimax  = jpi
-         jpjmax  = jpj
-         IF( iiarea > iirest ) jpi = jpi - 1
-         IF( ijarea > ijrest ) jpj = jpj - 1
-#endif
-      ENDIF
-
-      jpk = jpkglo                                             ! third dim
-
-#if defined key_agrif
-      ! simple trick to use same vertical grid as parent but different number of levels: 
-      ! Save maximum number of levels in jpkglo, then define all vertical grids with this number.
-      ! Suppress once vertical online interpolation is ok
-      IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo )
-#endif
-      jpim1 = jpi-1                                            ! inner domain indices
-      jpjm1 = jpj-1                                            !   "           "
-      jpkm1 = MAX( 1, jpk-1 )                                  !   "           "
-      jpij  = jpi*jpj                                          !  jpi x j
-
       IF(lwp) THEN                            ! open listing units
          !
@@ -360 +294 @@
          !
       ENDIF
+      !                                      ! Domain decomposition
+      CALL mpp_init                          ! MPP
 
       ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
@@ -369 +305 @@
 
       CALL nemo_ctl                          ! Control prints
-
-      !                                      ! Domain decomposition
-      CALL mpp_init                             ! MPP
-      IF( ln_nnogather )   CALL nemo_nfdcom     ! northfold neighbour lists
-      !
       !
       !                                      ! General initialization
@@ -552 +483 @@
    END SUBROUTINE nemo_alloc
 
-
-   SUBROUTINE nemo_partition( num_pes )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE nemo_partition  ***
-      !!
-      !! ** Purpose :
-      !!
-      !! ** Method  :
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have
-      !
-      INTEGER, PARAMETER :: nfactmax = 20
-      INTEGER :: nfact ! The no. of factors returned
-      INTEGER :: ierr  ! Error flag
-      INTEGER :: ji
-      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
-      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
-      !!----------------------------------------------------------------------
-      !
-      ierr = 0
-      !
-      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
-      !
-      IF( nfact <= 1 ) THEN
-         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
-         WRITE (numout, *) '       : using grid of ',num_pes,' x 1'
-         jpnj = 1
-         jpni = num_pes
-      ELSE
-         ! Search through factors for the pair that are closest in value
-         mindiff = 1000000
-         imin    = 1
-         DO ji = 1, nfact-1, 2
-            idiff = ABS( ifact(ji) - ifact(ji+1) )
-            IF( idiff < mindiff ) THEN
-               mindiff = idiff
-               imin = ji
-            ENDIF
-         END DO
-         jpnj = ifact(imin)
-         jpni = ifact(imin + 1)
-      ENDIF
-      !
-      jpnij = jpni*jpnj
-      !
-   END SUBROUTINE nemo_partition
-
-
-   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE factorise  ***
-      !!
-      !! ** Purpose :   return the prime factors of n.
-      !!                knfax factors are returned in array kfax which is of
-      !!                maximum dimension kmaxfax.
-      !! ** Method  :
-      !!----------------------------------------------------------------------
-      INTEGER                    , INTENT(in   ) ::   kn, kmaxfax
-      INTEGER                    , INTENT(  out) ::   kerr, knfax
-      INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax
-      !
-      INTEGER :: ifac, jl, inu
-      INTEGER, PARAMETER :: ntest = 14
-      INTEGER, DIMENSION(ntest) ::   ilfax
-      !!----------------------------------------------------------------------
-      !
-      ! lfax contains the set of allowed factors.
-      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
-      !
-      ! Clear the error flag and initialise output vars
-      kerr  = 0
-      kfax  = 1
-      knfax = 0
-      !
-      IF( kn /= 1 ) THEN      ! Find the factors of n
-         !
-         ! nu holds the unfactorised part of the number.
-         ! knfax holds the number of factors found.
-         ! l points to the allowed factor list.
-         ! ifac holds the current factor.
-         !
-         inu   = kn
-         knfax = 0
-         !
-         DO jl = ntest, 1, -1
-            !
-            ifac = ilfax(jl)
-            IF( ifac > inu )   CYCLE
-            !
-            ! Test whether the factor will divide.
-            !
-            IF( MOD(inu,ifac) == 0 ) THEN
-               !
-               knfax = knfax + 1            ! Add the factor to the list
-               IF( knfax > kmaxfax ) THEN
-                  kerr = 6
-                  write (*,*) 'FACTOR: insufficient space in factor array ', knfax
-                  return
-               ENDIF
-               kfax(knfax) = ifac
-               ! Store the other factor that goes with this one
-               knfax = knfax + 1
-               kfax(knfax) = inu / ifac
-               !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
-            ENDIF
-            !
-         END DO
-         !
-      ENDIF
-      !
-   END SUBROUTINE factorise
-
-#if defined key_mpp_mpi
-
-   SUBROUTINE nemo_nfdcom
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE  nemo_nfdcom  ***
-      !! ** Purpose :   Setup for north fold exchanges with explicit 
-      !!                point-to-point messaging
-      !!
-      !! ** Method :   Initialization of the northern neighbours lists.
-      !!----------------------------------------------------------------------
-      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
-      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
-      !!----------------------------------------------------------------------
-      INTEGER  ::   sxM, dxM, sxT, dxT, jn
-      INTEGER  ::   njmppmax
-      !!----------------------------------------------------------------------
-      !
-      njmppmax = MAXVAL( njmppt )
-      !
-      !initializes the north-fold communication variables
-      isendto(:) = 0
-      nsndto     = 0
-      !
-      IF ( njmpp == njmppmax ) THEN      ! if I am a process in the north
-         !
-         !sxM is the first point (in the global domain) needed to compute the north-fold for the current process
-         sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
-         !dxM is the last point (in the global domain) needed to compute the north-fold for the current process
-         dxM = jpiglo - nimppt(narea) + 2
-         !
-         ! loop over the other north-fold processes to find the processes
-         ! managing the points belonging to the sxT-dxT range
-         !
-         DO jn = 1, jpni
-            !
-            sxT = nfiimpp(jn, jpnj)                            ! sxT = 1st  point (in the global domain) of the jn process
-            dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1    ! dxT = last point (in the global domain) of the jn process
-            !
-            IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN
-               nsndto          = nsndto + 1
-               isendto(nsndto) = jn
-            ELSEIF( sxM <= sxT  .AND.  dxM >= dxT ) THEN
-               nsndto          = nsndto + 1
-               isendto(nsndto) = jn
-            ELSEIF( dxM <  dxT  .AND.  sxT <  dxM ) THEN
-               nsndto          = nsndto + 1
-               isendto(nsndto) = jn
-            ENDIF
-            !
-         END DO
-         nfsloop = 1
-         nfeloop = nlci
-         DO jn = 2,jpni-1
-            IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN
-               IF( nfipproc(jn-1,jpnj) == -1 )   nfsloop = nldi
-               IF( nfipproc(jn+1,jpnj) == -1 )   nfeloop = nlei
-            ENDIF
-         END DO
-         !
-      ENDIF
-      l_north_nogather = .TRUE.
-      !
-   END SUBROUTINE nemo_nfdcom
-
-#else
-   SUBROUTINE nemo_nfdcom      ! Dummy routine
-      WRITE(*,*) 'nemo_nfdcom: You should not have seen this print! error?'
-   END SUBROUTINE nemo_nfdcom
-#endif
-
    !!======================================================================
 END MODULE nemogcm