SUBROUTINE mp_cart_create(comm_old, ndims, dims, pos, comm_cart)
TYPE(mp_comm_type), INTENT(IN) :: comm_old
INTEGER, INTENT(IN) :: ndims
INTEGER, CONTIGUOUS, INTENT(INOUT) :: dims(:)
INTEGER, CONTIGUOUS, INTENT(OUT) :: pos(:)
TYPE(mp_comm_type), INTENT(OUT) :: comm_cart
CHARACTER(LEN=*), PARAMETER :: routineN = 'mp_cart_create'
INTEGER :: handle, ierr, nodes
#if defined(__parallel)
LOGICAL, DIMENSION(1:ndims) :: period
LOGICAL :: reorder
#endif
ierr = 0
CALL timeset(routineN, handle)
nodes = 0
pos(1:ndims) = -1
comm_cart = comm_old
#if defined(__parallel)
CALL mpi_comm_size(comm_old%handle, nodes, ierr)
IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_size @ "//routineN)
IF (ANY(dims == 0)) CALL mpi_dims_create(nodes, ndims, dims, ierr)
IF (ierr /= 0) CALL mp_stop(ierr, "mpi_dims_create @ "//routineN)
! FIX ME. Quick hack to avoid problems with realspace grids for compilers
! like IBM that actually reorder the processors when creating the new
! communicator
reorder = .FALSE.
period = .TRUE.
CALL mpi_cart_create(comm_old%handle, ndims, dims, period, reorder, comm_cart%handle, &
ierr)
IF (ierr /= 0) CALL mp_stop(ierr, "mpi_cart_create @ "//routineN)
IF (comm_cart /= MP_COMM_NULL) THEN
debug_comm_count = debug_comm_count + 1
CALL mpi_cart_get(comm_cart%handle, ndims, dims, period, pos, ierr)
IF (ierr /= 0) CALL mp_stop(ierr, "mpi_cart_get @ "//routineN)
END IF
#else
pos(1:ndims) = 0
dims = 1
comm_cart = mp_comm_self
#endif
CALL timestop(handle)
END SUBROUTINE mp_cart_create