comm.F90

Go to the documentation of this file.

module comm
  use mpi_f08
  use utils, only : neko_error
  use neko_config
  !$ use omp_lib
  implicit none
  
  interface
     subroutine neko_comm_wrapper_init(fcomm) &
          bind(c, name='neko_comm_wrapper_init')
       integer, value :: fcomm
     end subroutine neko_comm_wrapper_init
  end interface
  
  type(mpi_comm) :: neko_comm
 
#ifdef HAVE_MPI_PARAM_DTYPE
  type(mpi_datatype), parameter :: mpi_real_precision = mpi_double_precision
#else
  type(mpi_datatype) :: mpi_real_precision
#endif
  
  integer :: pe_rank
 
  integer :: pe_size
 
  logical :: nio
 
contains
  subroutine comm_init
    integer :: ierr
    logical :: initialized
    integer :: provided, nthrds
 
    pe_rank = -1
    pe_size = 0
    nio = .false.
 
    call mpi_initialized(initialized, ierr)
 
    nthrds = 1
    !$omp parallel
    !$omp master
    !$ nthrds = omp_get_num_threads()
    !$omp end master
    !$omp end parallel
    
    if (.not.initialized) then       
       if (nthrds .gt. 1) then
          call mpi_init_thread(mpi_thread_multiple, provided, ierr)
          if (provided .ne. mpi_thread_multiple) then
             ! MPI_THREAD_MULTIPLE is required for mt. device backends
             if (neko_bcknd_device .eq. 1) then 
                call neko_error('Invalid thread support provided by MPI')
             else
                call mpi_init_thread(mpi_thread_serialized, provided, ierr)
                if (provided .ne. mpi_thread_serialized) then
                   call neko_error('Invalid thread support provided by MPI')
                end if
             end if
          end if
       else
          call mpi_init(ierr)
       end if
    end if
 
#ifndef HAVE_MPI_PARAM_DTYPE
    mpi_real_precision = mpi_double_precision
#endif
    
 
#ifdef HAVE_ADIOS2
    ! We split the communicator it to work asynchronously (MPMD)
    call mpi_comm_rank(mpi_comm_world, pe_rank, ierr)
    call mpi_comm_split(mpi_comm_world, 0, pe_rank, neko_comm, ierr)
#else    
    ! Original version duplicates the communicator:
    call mpi_comm_dup(mpi_comm_world, neko_comm, ierr)
#endif
 
    call mpi_comm_rank(neko_comm, pe_rank, ierr)
    call mpi_comm_size(neko_comm, pe_size, ierr)
 
    ! Setup C/C++ wrapper
    call neko_comm_wrapper_init(neko_comm%mpi_val)
 
  end subroutine comm_init
 
  subroutine comm_free
    integer :: ierr
 
    call mpi_barrier(neko_comm, ierr)
    call mpi_comm_free(neko_comm, ierr)
    call mpi_finalize(ierr)
 
  end subroutine comm_free
 
end module comm