1!
2! Copyright (C) by Argonne National Laboratory
3!     See COPYRIGHT in top-level directory
4!
5
6subroutine PMPIR_Type_create_indexed_block_f08(count, blocklength, &
7    array_of_displacements, oldtype, newtype, ierror)
8    use, intrinsic :: iso_c_binding, only : c_int
9    use :: mpi_f08, only : MPI_Datatype
10    use :: mpi_c_interface, only : c_Datatype
11    use :: mpi_c_interface, only : MPIR_Type_create_indexed_block_c
12
13    implicit none
14
15    integer, intent(in) :: count
16    integer, intent(in) :: blocklength
17    integer, intent(in) :: array_of_displacements(count)
18    type(MPI_Datatype), intent(in) :: oldtype
19    type(MPI_Datatype), intent(out) :: newtype
20    integer, optional, intent(out) :: ierror
21
22    integer(c_int) :: count_c
23    integer(c_int) :: blocklength_c
24    integer(c_int) :: array_of_displacements_c(count)
25    integer(c_Datatype) :: oldtype_c
26    integer(c_Datatype) :: newtype_c
27    integer(c_int) :: ierror_c
28
29    if (c_int == kind(0)) then
30        ierror_c = MPIR_Type_create_indexed_block_c(count, blocklength, array_of_displacements, oldtype%MPI_VAL, &
31            newtype%MPI_VAL)
32    else
33        count_c = count
34        blocklength_c = blocklength
35        array_of_displacements_c = array_of_displacements
36        oldtype_c = oldtype%MPI_VAL
37        ierror_c = MPIR_Type_create_indexed_block_c(count_c, blocklength_c, array_of_displacements_c, &
38            oldtype_c, newtype_c)
39        newtype%MPI_VAL = newtype_c
40    end if
41
42    if (present(ierror)) ierror = ierror_c
43
44end subroutine PMPIR_Type_create_indexed_block_f08
45