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