Changeset 13982 for NEMO/trunk/src/OCE/LBC/lib_mpp.F90

Timestamp:

2020-12-02T11:57:05+01:00 (3 years ago)

Author:

smasson

Message:

trunk: merge dev_r13923_Tiling_Cleanup_MPI3_LoopFusion into the trunk

File:

• NEMO/trunk/src/OCE/LBC/lib_mpp.F90 (modified) (3 diffs)

NEMO/trunk/src/OCE/LBC/lib_mpp.F90

@@ -66 +66 @@
    PUBLIC   mppscatter, mppgather
    PUBLIC   mpp_ini_znl
+   PUBLIC   mpp_ini_nc
    PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines
    PUBLIC   mppsend_sp, mpprecv_sp                          ! needed by TAM and ICB routines
@@ -137 +138 @@
    INTEGER         ::   ndim_rank_znl   !  number of processors on the same zonal average
    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
+
+   ! variables used for MPI3 neighbourhood collectives
+   INTEGER, PUBLIC :: mpi_nc_com                   ! MPI3 neighbourhood collectives communicator
+   INTEGER, PUBLIC :: mpi_nc_all_com               ! MPI3 neighbourhood collectives communicator (with diagionals)
 
    ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM)
@@ -1067 +1072 @@
 
    END SUBROUTINE mpp_ini_znl
+
+   SUBROUTINE mpp_ini_nc
+      !!----------------------------------------------------------------------
+      !!               ***  routine mpp_ini_nc  ***
+      !!
+      !! ** Purpose :   Initialize special communicators for MPI3 neighbourhood
+      !!                collectives
+      !!
+      !! ** Method  : - Create graph communicators starting from the processes   
+      !!                distribution along i and j directions
+      !
+      !! ** output
+      !!         mpi_nc_com = MPI3 neighbourhood collectives communicator
+      !!         mpi_nc_all_com = MPI3 neighbourhood collectives communicator
+      !!                          (with diagonals)
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(:), ALLOCATABLE :: ineigh, ineighalls, ineighallr
+      INTEGER :: ideg, idegalls, idegallr, icont, icont1
+      INTEGER :: ierr
+      LOGICAL, PARAMETER :: ireord = .FALSE.
+
+#if defined key_mpp_mpi
+
+      ideg = 0
+      idegalls = 0
+      idegallr = 0
+      icont = 0
+      icont1 = 0
+
+      IF (nbondi .eq. 1) THEN
+         ideg = ideg + 1
+      ELSEIF (nbondi .eq. -1) THEN
+         ideg = ideg + 1
+      ELSEIF (nbondi .eq. 0) THEN
+         ideg = ideg + 2
+      ENDIF
+
+      IF (nbondj .eq. 1) THEN
+         ideg = ideg + 1
+      ELSEIF (nbondj .eq. -1) THEN
+         ideg = ideg + 1
+      ELSEIF (nbondj .eq. 0) THEN
+         ideg = ideg + 2
+      ENDIF
+
+      idegalls = ideg
+      idegallr = ideg
+
+      IF (nones .ne. -1) idegalls = idegalls + 1
+      IF (nonws .ne. -1) idegalls = idegalls + 1
+      IF (noses .ne. -1) idegalls = idegalls + 1
+      IF (nosws .ne. -1) idegalls = idegalls + 1
+      IF (noner .ne. -1) idegallr = idegallr + 1
+      IF (nonwr .ne. -1) idegallr = idegallr + 1
+      IF (noser .ne. -1) idegallr = idegallr + 1
+      IF (noswr .ne. -1) idegallr = idegallr + 1
+
+      ALLOCATE(ineigh(ideg))
+      ALLOCATE(ineighalls(idegalls))
+      ALLOCATE(ineighallr(idegallr))
+
+      IF (nbondi .eq. 1) THEN
+         icont = icont + 1
+         ineigh(icont) = nowe
+         ineighalls(icont) = nowe
+         ineighallr(icont) = nowe
+      ELSEIF (nbondi .eq. -1) THEN
+         icont = icont + 1
+         ineigh(icont) = noea
+         ineighalls(icont) = noea
+         ineighallr(icont) = noea
+      ELSEIF (nbondi .eq. 0) THEN
+         icont = icont + 1
+         ineigh(icont) = nowe
+         ineighalls(icont) = nowe
+         ineighallr(icont) = nowe
+         icont = icont + 1
+         ineigh(icont) = noea
+         ineighalls(icont) = noea
+         ineighallr(icont) = noea
+      ENDIF
+
+      IF (nbondj .eq. 1) THEN
+         icont = icont + 1
+         ineigh(icont) = noso
+         ineighalls(icont) = noso
+         ineighallr(icont) = noso
+      ELSEIF (nbondj .eq. -1) THEN
+         icont = icont + 1
+         ineigh(icont) = nono
+         ineighalls(icont) = nono
+         ineighallr(icont) = nono
+      ELSEIF (nbondj .eq. 0) THEN
+         icont = icont + 1
+         ineigh(icont) = noso
+         ineighalls(icont) = noso
+         ineighallr(icont) = noso
+         icont = icont + 1
+         ineigh(icont) = nono
+         ineighalls(icont) = nono
+         ineighallr(icont) = nono
+      ENDIF
+
+      icont1 = icont
+      IF (nosws .ne. -1) THEN
+         icont = icont + 1
+         ineighalls(icont) = nosws
+      ENDIF
+      IF (noses .ne. -1) THEN
+         icont = icont + 1
+         ineighalls(icont) = noses
+      ENDIF
+      IF (nonws .ne. -1) THEN
+         icont = icont + 1
+         ineighalls(icont) = nonws
+      ENDIF
+      IF (nones .ne. -1) THEN
+         icont = icont + 1
+         ineighalls(icont) = nones
+      ENDIF
+      IF (noswr .ne. -1) THEN
+         icont1 = icont1 + 1
+         ineighallr(icont1) = noswr
+      ENDIF
+      IF (noser .ne. -1) THEN
+         icont1 = icont1 + 1
+         ineighallr(icont1) = noser
+      ENDIF
+      IF (nonwr .ne. -1) THEN
+         icont1 = icont1 + 1
+         ineighallr(icont1) = nonwr
+      ENDIF
+      IF (noner .ne. -1) THEN
+         icont1 = icont1 + 1
+         ineighallr(icont1) = noner
+      ENDIF
+
+      CALL MPI_Dist_graph_create_adjacent(mpi_comm_oce, ideg, ineigh, MPI_UNWEIGHTED, ideg, ineigh, MPI_UNWEIGHTED, MPI_INFO_NULL, ireord, mpi_nc_com, ierr)
+      CALL MPI_Dist_graph_create_adjacent(mpi_comm_oce, idegallr, ineighallr, MPI_UNWEIGHTED, idegalls, ineighalls, MPI_UNWEIGHTED, MPI_INFO_NULL, ireord, mpi_nc_all_com, ierr)
+
+      DEALLOCATE (ineigh)
+      DEALLOCATE (ineighalls)
+      DEALLOCATE (ineighallr)
+#endif
+   END SUBROUTINE mpp_ini_nc
+