1!
2! Copyright (C) by Argonne National Laboratory
3!     See COPYRIGHT in top-level directory
4!
5
6subroutine MPI_Cart_sub_f08(comm, remain_dims, newcomm, ierror)
7    use, intrinsic :: iso_c_binding, only : c_int
8    use :: mpi_f08, only : MPI_Comm, MPI_SUCCESS
9    use :: mpi_c_interface, only : c_Comm
10    use :: mpi_c_interface, only : MPIR_Cart_sub_c, MPIR_Cartdim_get_c
11
12    implicit none
13
14    type(MPI_Comm), intent(in) :: comm
15    logical, intent(in) :: remain_dims(*)
16    type(MPI_Comm), intent(out) :: newcomm
17    integer, optional, intent(out) :: ierror
18
19    integer(c_Comm) :: comm_c
20    integer(c_int), allocatable :: remain_dims_c(:)
21    integer(c_Comm) :: newcomm_c
22    integer(c_int) :: ierror_c
23    integer(c_int) :: err, ndims! To get length of assumed-size arrays
24
25    comm_c = comm%MPI_VAL
26    ierror_c = MPIR_Cartdim_get_c(comm_c, ndims)
27
28    if (ierror_c == MPI_SUCCESS) then
29        remain_dims_c = merge(1, 0, remain_dims(1:ndims))
30        ierror_c = MPIR_Cart_sub_c(comm_c, remain_dims_c, newcomm_c)
31        newcomm%MPI_VAL = newcomm_c
32    end if
33
34    if(present(ierror)) ierror = ierror_c
35
36end subroutine MPI_Cart_sub_f08
37