Initialise the 1 library, communicators, and related variables
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(inout), | optional | :: | comm_in |
Communicator to use instead of |
|
logical, | intent(in), | optional | :: | multigs2 |
If true, initialise multiscale communicator and variables |
|
integer, | intent(in), | optional | :: | err_unit_in |
Unit of open file to write any error messages to. Defaults to stderr |
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
# ifdef MPI
integer :: ierror, err_unit_local
#ifdef OPENMP
integer :: provided
#endif
logical :: is_initialised, 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'
error stop 'ERROR: precision mismatch in mpi'
end if
# else
UNUSED_DUMMY(comm_in); UNUSED_DUMMY(multigs2); UNUSED_DUMMY(err_unit_in)
# endif
mp_initialized = .true.
end subroutine init_mp