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
|
!----------------------------------------------------------------------------
MODULE mp_world
!----------------------------------------------------------------------------
!
USE parallel_include
USE mp, ONLY : mp_barrier, mp_start, mp_end, mp_stop
USE mp, ONLY : mp_count_nodes
!
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
#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_FUNNELED, 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, world_comm )
!
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, .true. )
#if defined(__MPI)
CALL mpi_finalize(ierr)
IF (ierr/=0) CALL mp_stop( 8002 )
#endif
!
END SUBROUTINE mp_world_end
!
END MODULE mp_world
|
