FIXME : Add documentation
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | wcomm | |||
logical, | intent(in), | optional | :: | split_ |
subroutine shm_init(wcomm, split_)
implicit none
integer, intent(in) :: wcomm
logical, intent(in), optional :: split_
integer comm, xcomm, id_world, id_node, i, n, ierr
logical split
integer(kind=MPI_ADDRESS_KIND) ta
if (initialized_shm) return
initialized_shm = .true.
split=.false.
if (present(split_)) split = split_
call mpi_comm_rank(wcomm, id_world, ierr)
! test for MPI version
call mpi_comm_split_type(wcomm, MPI_COMM_TYPE_SHARED, id_world, MPI_INFO_NULL, comm, ierr)
call mpi_comm_size(comm, n, ierr)
call mpi_comm_rank(comm, id_node, ierr)
if (split) then
i = 0
xcomm=comm
if (id_node < n/2) i = 1
call mpi_comm_split(xcomm, i, id_node, comm, ierr)
call mpi_comm_size(comm, n, ierr)
call mpi_comm_rank(comm, id_node, ierr)
endif
shm_info%id = id_node
shm_info%size = n
shm_info%comm = comm
shm_info%wcomm = wcomm
allocate(shm_info%wranks(0:n-1))
call mpi_allgather(id_world, 1, mpi_integer, &
shm_info%wranks, 1, mpi_integer, comm, ierr)
! use contigous block for accelerated ffts
!call mpi_info_create(info_noncontig, ierr)
!call mpi_info_set(info_noncontig, "alloc_shared_noncontig", "true", ierr)
! check the size of MPI_ADRESS_KIND
if (id_world == 0) then
write(*,*) "shm_mpi3 init: test MPI_ADDRESS_KIND vs integer ", kind(ta), kind(n)
endif
end subroutine shm_init