shm_init Subroutine

public subroutine shm_init(wcomm, split_)

FIXME : Add documentation

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: wcomm
logical, intent(in), optional :: split_

Contents

Source Code


Source Code

  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