1!
2! Copyright (C) 2001-2015 Quantum ESPRESSO group
3! This file is distributed under the terms of the
4! GNU General Public License. See the file `License'
5! in the root directory of the present distribution,
6! or http://www.gnu.org/copyleft/gpl.txt .
7!
8!----------------------------------------------------------------------------
9MODULE mp_world
10  !----------------------------------------------------------------------------
11  !
12  USE mp, ONLY : mp_barrier, mp_start, mp_end, mp_stop, mp_count_nodes
13  USE io_global, ONLY : meta_ionode_id, meta_ionode
14  !
15  USE parallel_include
16  !
17  IMPLICIT NONE
18  SAVE
19  !
20  ! ... World group - all QE routines using mp_world_start to start MPI
21  ! ... will work in the communicator passed as input to mp_world_start
22  !
23  INTEGER :: nnode = 1  ! number of nodes
24  INTEGER :: nproc = 1  ! number of processors
25  INTEGER :: mpime = 0  ! processor index (starts from 0 to nproc-1)
26  INTEGER :: root  = 0  ! index of the root processor
27  INTEGER :: world_comm = 0  ! communicator
28  !
29  ! ... library_mode =.true. if QE is called as a library by an external code
30  ! ... if true, MPI_Init()     is not called when starting MPI,
31  ! ...          MPI_Finalize() is not called when stopping MPI
32  !
33#if defined(__MPI)
34  LOGICAL :: library_mode = .FALSE.
35#endif
36  !
37  PRIVATE
38  PUBLIC :: nnode, nproc, mpime, root, world_comm, mp_world_start, mp_world_end
39  !
40CONTAINS
41  !
42  !-----------------------------------------------------------------------
43  SUBROUTINE mp_world_start ( my_world_comm )
44    !-----------------------------------------------------------------------
45    !
46    IMPLICIT NONE
47    INTEGER, INTENT(IN) :: my_world_comm
48    INTEGER :: color, key
49#if defined(__MPI)
50    INTEGER :: ierr
51#endif
52#if defined(_OPENMP)
53    INTEGER :: PROVIDED
54#endif
55    !
56    world_comm = my_world_comm
57    !
58    ! ... check if mpi is already initialized (library mode) or not
59    !
60#if defined(__MPI)
61    CALL MPI_Initialized ( library_mode, ierr)
62    IF (ierr/=0) CALL mp_stop( 8000 )
63    IF (.NOT. library_mode ) THEN
64#if defined(_OPENMP)
65       CALL MPI_Init_thread(MPI_THREAD_MULTIPLE, PROVIDED, ierr)
66#else
67       CALL MPI_Init(ierr)
68#endif
69       IF (ierr/=0) CALL mp_stop( 8001 )
70    END IF
71#endif
72    !
73    CALL mp_start( nproc, mpime, world_comm )
74    !
75    CALL mp_count_nodes ( nnode, color, key, world_comm )
76    !
77    !
78    ! ... meta_ionode is true if this processor is the root processor
79    ! ... of the world group - "ionode_world" would be a better name
80    ! ... meta_ionode_id is the index of such processor
81    !
82    meta_ionode = ( mpime == root )
83    meta_ionode_id = root
84    !
85    RETURN
86    !
87  END SUBROUTINE mp_world_start
88  !
89  !-----------------------------------------------------------------------
90  SUBROUTINE mp_world_end ( )
91    !-----------------------------------------------------------------------
92#if defined(__MPI)
93    INTEGER :: ierr
94#endif
95    !
96    CALL mp_barrier( world_comm )
97    CALL mp_end ( world_comm )
98#if defined(__MPI)
99    IF (.NOT. library_mode ) THEN
100       CALL mpi_finalize(ierr)
101       IF (ierr/=0) CALL mp_stop( 8002 )
102    END IF
103#endif
104    !
105  END SUBROUTINE mp_world_end
106  !
107END MODULE mp_world
108