1!--------------------------------------------------------------------------------------------------!
2!  DFTB+: general package for performing fast atomistic simulations                                !
3!  Copyright (C) 2006 - 2019  DFTB+ developers group                                               !
4!                                                                                                  !
5!  See the LICENSE file for terms of usage and distribution.                                       !
6!--------------------------------------------------------------------------------------------------!
7
8!> Contains MPI related environment settings
9module dftbp_mpienv
10  use dftbp_accuracy, only : lc
11  use dftbp_mpifx
12  use dftbp_message
13  implicit none
14  private
15
16  public :: TMpiEnv, TMpiEnv_init
17
18
19  !> Contains MPI related environment settings
20  type :: TMpiEnv
21
22    !> Global MPI communicator
23    type(mpifx_comm) :: globalComm
24
25    !> Communicator to access processes within current group
26    type(mpifx_comm) :: groupComm
27
28    !> Communicator to access equivalent processes in other groups
29    type(mpifx_comm) :: interGroupComm
30
31    !> Size of the process groups
32    integer :: groupSize
33
34    !> Number of processor groups
35    integer :: nGroup
36
37    !> Group index of the current process (starts with 0)
38    integer :: myGroup
39
40    !> Global rank of the processes in the given group
41    integer, allocatable :: groupMembers(:)
42
43    !> Whether current process is the global master
44    logical :: tGlobalMaster
45
46    !> Whether current process is the group master
47    logical :: tGroupMaster
48
49  end type TMpiEnv
50
51
52contains
53
54  !> Initializes MPI environment.
55  subroutine TMpiEnv_init(this, nGroup)
56
57    !> Initialised instance on exit
58    type(TMpiEnv), intent(out) :: this
59
60    !> Number of process groups to create
61    integer, intent(in) :: nGroup
62
63    character(lc) :: tmpStr
64    integer :: myRank, myGroup
65
66    call this%globalComm%init()
67    this%nGroup = nGroup
68    this%groupSize = this%globalComm%size / this%nGroup
69    if (this%nGroup * this%groupSize /= this%globalComm%size) then
70      write(tmpStr, "(A,I0,A,I0,A)") "Number of groups (", this%nGroup,&
71          & ") not compatible with number of processes (", this%globalComm%size, ")"
72      call error(tmpStr)
73    end if
74
75    this%myGroup = this%globalComm%rank / this%groupSize
76    myRank = mod(this%globalComm%rank, this%groupSize)
77    call this%globalComm%split(this%myGroup, myRank, this%groupComm)
78    allocate(this%groupMembers(this%groupSize))
79    call mpifx_allgather(this%groupComm, this%globalComm%rank, this%groupMembers)
80
81    myGroup = myRank
82    myRank = this%myGroup
83    call this%globalComm%split(myGroup, myRank, this%interGroupComm)
84
85    this%tGlobalMaster = this%globalComm%master
86    this%tGroupMaster = this%groupComm%master
87
88    if (this%tGlobalMaster .and. .not. this%tGroupMaster) then
89      call error("Internal error: Global master process is not a group master process")
90    end if
91
92  end subroutine TMpiEnv_init
93
94
95end module dftbp_mpienv
96