mpi_lib.F90

Go to the documentation of this file.

!! Copyright (C) 2002-2006 M. Marques, A. Castro, A. Rubio, G. Bertsch
!!
!! This program is free software; you can redistribute it and/or modify
!! it under the terms of the GNU General Public License as published by
!! the Free Software Foundation; either version 2, or (at your option)
!! any later version.
!!
!! This program is distributed in the hope that it will be useful,
!! but WITHOUT ANY WARRANTY; without even the implied warranty of
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!! GNU General Public License for more details.
!!
!! You should have received a copy of the GNU General Public License
!! along with this program; if not, write to the Free Software
!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
!! 02110-1301, USA.
!!
 
#include "global.h"
 
module mpi_lib_oct_m
  use debug_oct_m
  use global_oct_m
  use messages_oct_m
  use mpi_oct_m
  use mpi_debug_oct_m
  use profiling_oct_m
 
  implicit none
 
  private
 
#if !defined(HAVE_MPI)
  integer, public :: mpi_lib_dummy
#else
  public ::                            &
    create_intranode_communicator,     &
    lmpi_create_shared_memory_window,  &
    lmpi_destroy_shared_memory_window, &
    lmpi_sync_shared_memory_window,    &
    lmpi_gen_allgatherv,               &
    lmpi_translate_rank
 
  interface lmpi_create_shared_memory_window
    module procedure dlmpi_create_shared_memory_window, zlmpi_create_shared_memory_window
    module procedure ilmpi_create_shared_memory_window, llmpi_create_shared_memory_window
  end interface lmpi_create_shared_memory_window
 
  interface lmpi_gen_allgatherv
    module procedure dlmpi_gen_allgatherv, zlmpi_gen_allgatherv
    module procedure ilmpi_gen_allgatherv, llmpi_gen_allgatherv
  end interface lmpi_gen_allgatherv
 
#endif
 
contains
#if defined(HAVE_MPI)
  ! ---------------------------------------------------------
  integer function lmpi_translate_rank(from_comm, to_comm, rank)
    type(MPI_Comm), intent(in) :: from_comm
    type(MPI_Comm), intent(in) :: to_comm
    integer, intent(in) :: rank
 
    type(MPI_Group) :: from_group, to_group
    integer :: from_rank(1), to_rank(1)
 
    push_sub(lmpi_translate_rank)
 
    call mpi_comm_group(from_comm, from_group, mpi_err)
    call mpi_comm_group(to_comm, to_group, mpi_err)
 
    from_rank(1) = rank
    call mpi_group_translate_ranks(from_group, 1, from_rank, to_group, to_rank, mpi_err)
 
    lmpi_translate_rank = to_rank(1)
 
    pop_sub(lmpi_translate_rank)
  end function lmpi_translate_rank
 
  ! destroy a shared memory segment as an MPI window
  subroutine lmpi_destroy_shared_memory_window(window)
    type(MPI_Win), intent(inout) :: window
 
    push_sub(lmpi_destroy_shared_memory_window)
 
    ! end access epoch
    call mpi_win_unlock_all(window, mpi_err)
    ! destroy window
    call mpi_win_free(window, mpi_err)
 
    pop_sub(lmpi_destroy_shared_memory_window)
  end subroutine lmpi_destroy_shared_memory_window
 
  ! synchronize a shared memory segment
  subroutine lmpi_sync_shared_memory_window(window, intranode_grp)
    type(MPI_Win),   intent(in) :: window
    type(mpi_grp_t), intent(in) :: intranode_grp
 
    push_sub(lmpi_sync_shared_memory_window)
 
    call mpi_win_sync(window, mpi_err)
    call intranode_grp%barrier()
 
    pop_sub(lmpi_sync_shared_memory_window)
  end subroutine lmpi_sync_shared_memory_window
 
  subroutine create_intranode_communicator(base_grp, intranode_grp, internode_grp)
    type(mpi_grp_t), intent(in)  :: base_grp
    type(mpi_grp_t), intent(out) :: intranode_grp
    type(mpi_grp_t), intent(out) :: internode_grp
    type(MPI_Comm) :: comm
 
    push_sub(create_intranode_communicator)
 
    ! create communicator for intranode communication
    ! this is used for MPI-3 shared memory windows
    call mpi_comm_split_type(base_grp%comm, mpi_comm_type_shared, base_grp%rank, mpi_info_null, comm, mpi_err)
    call mpi_grp_init(intranode_grp, comm)
 
    ! create communicator for internode communication
    ! we have one communicator for each local rank
    call mpi_comm_split(base_grp%comm, intranode_grp%rank, base_grp%rank, comm, mpi_err)
    call mpi_grp_init(internode_grp, comm)
 
    pop_sub(create_intranode_communicator)
  end subroutine create_intranode_communicator
 
#include "undef.F90"
#include "real.F90"
#include "mpi_lib_inc.F90"
 
#include "undef.F90"
#include "complex.F90"
#include "mpi_lib_inc.F90"
 
#include "undef.F90"
#include "integer.F90"
#include "mpi_lib_inc.F90"
 
#include "undef.F90"
#include "integer8.F90"
#include "mpi_lib_inc.F90"
#endif
end module mpi_lib_oct_m
 
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: