mpl_groups.F90

Go to the documentation of this file.

MODULE mpl_groups

!     Purpose.
!     --------
!       Use MPI groups for easier to read code (and more efficient
!       communications, at least on IBM).

!     Author.
!     -------
!       Y. Tremolet

!     Modifications.
!     --------------
!       Original: 02-03-13
! ------------------------------------------------------------------

! --- *NOT* THREAD SAFE YET ---

USE parkind1  ,ONLY : jpim     ,jprb

USE mpl_mpif
USE mpl_data_module
USE mpl_message_mod

IMPLICIT NONE
PRIVATE
PUBLIC mpl_comm_grid, mpl_all_levs_comm, mpl_all_ms_comm, &
     & mpl_groups_create, mpl_cart_rank, mpl_cart_coords

INTEGER(KIND=JPIM) :: mpl_comm_grid, mpl_all_levs_comm, mpl_all_ms_comm, &
           & MPL_GP_GRID
LOGICAL,SAVE :: lgroupsetup=.false.
CONTAINS
! ------------------------------------------------------------------

SUBROUTINE mpl_groups_create(KPROCW, KPROCV)


#ifdef USE_8_BYTE_WORDS
  USE mpi4to8, ONLY : &
    mpi_cart_create => mpi_cart_create8, mpi_comm_group => mpi_comm_group8, &
    mpi_cart_sub => mpi_cart_sub8
#endif


IMPLICIT NONE
INTEGER(KIND=JPIM), INTENT(IN) :: KPROCW, KPROCV

INTEGER(KIND=JPIM) :: IDIMS(2), IERR
LOGICAL :: LTORUS(2), LDIMS(2), LREORDER

IF(lgroupsetup) RETURN

idims(1)=kprocw
idims(2)=kprocv
ltorus(1)=.false.
ltorus(2)=.false.
lreorder=.false.

CALL mpi_cart_create(mpl_comm_oml(1), 2, idims, ltorus, lreorder, &
                   & mpl_comm_grid, ierr)
IF (ierr/=0) CALL mpl_message(ierr,'MPL_GROUPS_CREATE: MPI_CART_CREATE')

CALL mpi_comm_group(mpl_comm_grid, mpl_gp_grid, ierr)
IF (ierr/=0) CALL mpl_message(ierr,'MPL_GROUPS_CREATE: mpi_comm_group')

! Group all levels for same Ms
! ----------------------------
ldims(1)=.false.
ldims(2)=.true.
CALL mpi_cart_sub(mpl_comm_grid, ldims, mpl_all_levs_comm, ierr)
IF (ierr/=0) CALL mpl_message(ierr,'MPL_GROUPS_CREATE: mpi_cart_sub 1')

! Group all Ms for same levels
! ----------------------------
ldims(1)=.true.
ldims(2)=.false.
CALL mpi_cart_sub(mpl_comm_grid, ldims, mpl_all_ms_comm, ierr)
IF (ierr/=0) CALL mpl_message(ierr,'MPL_GROUPS_CREATE: mpi_cart_sub 2')

lgroupsetup=.true.

END SUBROUTINE mpl_groups_create

! ------------------------------------------------------------------

FUNCTION mpl_cart_rank(KPROCW, KPROCV)

#ifdef USE_8_BYTE_WORDS
  USE mpi4to8, ONLY : &
    mpi_cart_rank => mpi_cart_rank8
#endif

IMPLICIT NONE
INTEGER(KIND=JPIM), INTENT(IN)  :: KPROCW, KPROCV
INTEGER(KIND=JPIM) :: MPL_CART_RANK

INTEGER(KIND=JPIM) :: IDIMS(2), IPROC, IERR

idims(1)=kprocw-1
idims(2)=kprocv-1

CALL mpi_cart_rank(mpl_comm_grid, idims, iproc, ierr)
IF (ierr/=0) CALL mpl_message(ierr,'MPL_CART_RANK: mpi_cart_rank')

mpl_cart_rank=iproc+1

END FUNCTION mpl_cart_rank

! ------------------------------------------------------------------

SUBROUTINE mpl_cart_coords(KPROC, KPROCW, KPROCV)

#ifdef USE_8_BYTE_WORDS
  USE mpi4to8, ONLY : &
    mpi_cart_coords => mpi_cart_coords8
#endif


IMPLICIT NONE
INTEGER(KIND=JPIM), INTENT(IN)   :: KPROC
INTEGER(KIND=JPIM), INTENT(OUT)  :: KPROCW, KPROCV

INTEGER(KIND=JPIM) :: IDIMS(2), IPROC, IERR

iproc=kproc-1

CALL mpi_cart_coords(mpl_comm_grid, iproc, 2, idims, ierr)
IF (ierr/=0) CALL mpl_message(ierr,'MPL_CART_COORDS: mpi_cart_coords')

kprocw=idims(1)+1
kprocv=idims(2)+1

END SUBROUTINE mpl_cart_coords

! ------------------------------------------------------------------

END MODULE mpl_groups