1!----------------------------------------------------------------------------
2MODULE mp_world
3  !----------------------------------------------------------------------------
4  !
5  USE parallel_include
6  USE mp, ONLY : mp_barrier, mp_start, mp_end, mp_stop
7  USE mp, ONLY : mp_count_nodes
8  !
9  IMPLICIT NONE
10  SAVE
11  !
12  ! ... World group - all QE routines using mp_world_start to start MPI
13  ! ... will work in the communicator passed as input to mp_world_start
14  !
15  INTEGER :: nnode = 1 ! number of nodes
16  INTEGER :: nproc = 1  ! number of processors
17  INTEGER :: mpime = 0  ! processor index (starts from 0 to nproc-1)
18  INTEGER :: root  = 0  ! index of the root processor
19  INTEGER :: world_comm = 0  ! communicator
20  !
21  ! ... library_mode =.true. if QE is called as a library by an external code
22  ! ... if true, MPI_Init()     is not called when starting MPI,
23  ! ...          MPI_Finalize() is not called when stopping MPI
24  !
25  !
26#if defined(__MPI)
27  LOGICAL :: library_mode = .FALSE.
28#endif
29  PRIVATE
30  PUBLIC :: nnode, nproc, mpime, root, world_comm, mp_world_start, mp_world_end
31  !
32CONTAINS
33  !
34  !-----------------------------------------------------------------------
35  SUBROUTINE mp_world_start ( my_world_comm )
36    !-----------------------------------------------------------------------
37    !
38    IMPLICIT NONE
39    INTEGER, INTENT(IN) :: my_world_comm
40#if defined(__MPI)
41    INTEGER :: ierr
42#endif
43#if defined(_OPENMP)
44    INTEGER :: PROVIDED
45#endif
46    !
47    world_comm = my_world_comm
48    !
49    ! ... check if mpi is already initialized (library mode) or not
50    !
51#if defined(__MPI)
52    CALL MPI_Initialized ( library_mode, ierr)
53    IF (ierr/=0) CALL mp_stop( 8000 )
54    IF (.NOT. library_mode ) THEN
55#if defined(_OPENMP)
56       CALL MPI_Init_thread(MPI_THREAD_FUNNELED, PROVIDED, ierr)
57#else
58       CALL MPI_Init(ierr)
59#endif
60       IF (ierr/=0) CALL mp_stop( 8001 )
61    END IF
62#endif
63    !
64    CALL mp_start( nproc, mpime, world_comm )
65    !CALL mp_count_nodes ( nnode, world_comm )
66    !
67    RETURN
68    !
69  END SUBROUTINE mp_world_start
70  !
71  !-----------------------------------------------------------------------
72  SUBROUTINE mp_world_end ( )
73    !-----------------------------------------------------------------------
74#if defined(__MPI)
75    INTEGER :: ierr
76#endif
77    !
78    CALL mp_barrier( world_comm )
79    CALL mp_end ( world_comm, .true. )
80#if defined(__MPI)
81    CALL mpi_finalize(ierr)
82    IF (ierr/=0) CALL mp_stop( 8002 )
83#endif
84    !
85  END SUBROUTINE mp_world_end
86  !
87END MODULE mp_world
88