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