Changeset 9436 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

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

File:

• branches/2017/dev_merge_2017/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90 (modified) (8 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