init_mp Subroutine

  subroutine init_mp (comm_in, multigs2, err_unit_in)
#ifdef MPI
    use constants, only: pi, kind_rs, kind_rd
#ifdef SHMEM
    use shm_mpi3
#endif
#endif
    use optionals, only : get_option_with_default
    implicit none
    !> Communicator to use instead of `MPI_COMM_WORLD`. If present and
    !> set to `MPI_COMM_NULL`, gets set to `MPI_COMM_WORLD`
    integer, intent (inout), optional :: comm_in
    !> If true, initialise multiscale communicator and variables
    logical, intent (in), optional :: multigs2
    !> Unit of open file to write any error messages to. Defaults to stderr
    integer, intent (in), optional :: err_unit_in
    integer :: err_unit_local
# ifdef MPI
    integer :: ierror
#ifdef OPENMP
    integer :: provided
#endif
    logical :: is_initialised
    logical :: is_multiscale

    err_unit_local = get_option_with_default(err_unit_in, err_unit)
    call mpi_initialized (is_initialised, ierror)
#ifdef OPENMP
    if (.not. is_initialised) then
       call mpi_init_thread(MPI_THREAD_MULTIPLE, provided, ierror)
       if(provided .ne. MPI_THREAD_MULTIPLE) then
          write(err_unit_local,*) 'Problem with MPI_INIT_THREAD, stopping'
          stop
       end if
    end if
#else
    if (.not. is_initialised) call mpi_init (ierror)
#endif

    is_multiscale = get_option_with_default(multigs2, .false.)

    if (is_multiscale) then
      call init_comm(comm_multigs2, mulntot_proc, mulproc, mulproc0, comm_in)
    else
      call init_comm(comm_all, ntot_proc, aproc, aproc0, comm_in)
    end if

    if (is_multiscale) then
      call scope(multigs2procs)
    else
      call scope(allprocs)
#ifdef SHMEM
      call shm_init(comm_all)
#endif
    end if

#ifndef SINGLE_PRECISION
    mpicmplx8 = MPI_COMPLEX
#endif
    if ( (kind(pi)==kind_rs) .and. (kind_rs/=kind_rd) ) then
       mpireal = MPI_REAL
       mpi2real = MPI_2REAL
       mpicmplx = MPI_COMPLEX
    else if (kind(pi)==kind_rd) then
       mpireal = MPI_DOUBLE_PRECISION
       mpi2real = MPI_2DOUBLE_PRECISION
       mpicmplx = MPI_DOUBLE_COMPLEX
    else
       write (err_unit_local, *) 'ERROR: precision mismatch in mpi'
       stop
    end if
# endif

    mp_initialized = .true.
  end subroutine init_mp