Line data    Source code

       1             : module m_distribute_mpi 
       2             : contains 
       3          36 :    subroutine distribute_mpi(weights, glob_mpi, group_mpi, group_rank)
       4             :       use m_types_hybmpi
       5             :       use m_types_mpi
       6             :       implicit none 
       7             :       integer, intent(in)           :: weights(:)
       8             :       type(t_hybmpi), intent(in)    :: glob_mpi
       9             :       type(t_hybmpi), intent(inout) :: group_mpi
      10             :       integer, intent(inout)        :: group_rank 
      11             : 
      12          36 :       integer, allocatable :: nprocs(:), color(:)
      13             :       integer              :: idx(1), i, j, cnt, n_grps, new_comm
      14             : 
      15             : 
      16          36 :       n_grps = size(weights)
      17         156 :       allocate(nprocs(n_grps), source=0)
      18         156 :       allocate(color(glob_mpi%size), source=0)
      19             :          
      20          84 :       do i = 1,glob_mpi%size 
      21         216 :          idx = minloc(1.0*nprocs/weights)
      22          84 :          nprocs(idx(1)) = nprocs(idx(1)) + 1
      23             :       enddo
      24             : 
      25             :       cnt = 1
      26          84 :       do i = 1,n_grps
      27         132 :          do j = 1,nprocs(i)
      28          48 :             color(cnt) = i - 1
      29          96 :             cnt = cnt + 1 
      30             :          enddo 
      31             :       enddo
      32             : 
      33          36 :       group_rank = color(glob_mpi%rank+1) 
      34          36 :       call judft_comm_split(glob_mpi%comm, group_rank, glob_mpi%rank, new_comm)
      35             : 
      36          36 :       call group_mpi%init(new_comm)
      37          36 :    end subroutine distribute_mpi
      38             : end module m_distribute_mpi