distributed.F90

Go to the documentation of this file.

!! Copyright (C) 2008-2016 X. Andrade
!!
!! This program is free software; you can redistribute it and/or modify
!! it under the terms of the GNU General Public License as published by
!! the Free Software Foundation; either version 2, or (at your option)
!! any later version.
!!
!! This program is distributed in the hope that it will be useful,
!! but WITHOUT ANY WARRANTY; without even the implied warranty of
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!! GNU General Public License for more details.
!!
!! You should have received a copy of the GNU General Public License
!! along with this program; if not, write to the Free Software
!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
!! 02110-1301, USA.
!!
 
#include "global.h"
 
module distributed_oct_m
  use debug_oct_m
  use global_oct_m
  use messages_oct_m
  use mpi_oct_m
  use multicomm_oct_m
  use profiling_oct_m
 
  implicit none
 
  private
 
  public ::                      &
    distributed_t,               &
    distributed_nullify,         &
    distributed_init,            &
    distributed_copy,            &
    distributed_end,             &
    distributed_allgather
 
  ! TODO(Alex) Create an issue for refactoring type distributed_t attributes
  ! `distributed_nullify` is a meaningless routine - look at removing/consolidating
  ! `distributed_allgather` is pointless and should be scrapped
  !   - Only called in xc_vxc_inc.F90
 
  type distributed_t
    integer              :: start    = 1
    integer              :: end      = 0
    integer              :: nlocal   = 0
    !                                             or (range(2, mpi_grp%rank) - range(1, mpi_grp%rank) + 1)
    integer              :: nglobal  = 0
    logical              :: parallel = .false. 
    integer, allocatable :: node(:)
    integer, allocatable :: range(:, :)
    !                                             dim(2, 0:n_processes-1)
    !                                             Defined the same for all processes of mpi_grp
    integer, allocatable :: num(:)
    !                                             dim(mpi_grp%size)
    type(mpi_grp_t)      :: mpi_grp
  end type distributed_t
 
contains
 
  subroutine distributed_nullify(this, total)
    type(distributed_t), intent(out) :: this
    integer, optional,   intent(in)  :: total
 
    push_sub(distributed_nullify)
 
    if (present(total)) then
      this%end             = total
      this%nlocal          = total
      this%nglobal         = total
    end if
 
    pop_sub(distributed_nullify)
  end subroutine distributed_nullify
 
 
  subroutine distributed_init(this, total, comm, tag, scalapack_compat)
    type(distributed_t),        intent(out) :: this
    integer,                    intent(in)  :: total
    type(MPI_Comm),             intent(in)  :: comm
    character(len=*), optional, intent(in)  :: tag
    logical,          optional, intent(in)  :: scalapack_compat
 
    integer :: i
 
    push_sub(distributed_init)
 
    this%nglobal = total
    safe_allocate(this%node(1:this%nglobal))
 
    call mpi_grp_init(this%mpi_grp, comm)
    safe_allocate(this%num(0:this%mpi_grp%size - 1))
    safe_allocate(this%range(1:2, 0:this%mpi_grp%size - 1))
 
    ! Defaults
    if (this%mpi_grp%size == 1 .or. this%nglobal == 1) then
      this%node(1:total)   = 0
      this%start           = 1
      this%end             = total
      this%nlocal          = total
      this%parallel        = .false.
      this%range(:, 0)     = [1, total]
      this%num(0)          = total
      call mpi_grp_init(this%mpi_grp, mpi_comm_undefined)
 
    else
      this%parallel = .true.
 
      call multicomm_divide_range(this%nglobal, this%mpi_grp%size, this%range(1, :), this%range(2, :), &
        lsize = this%num, scalapack_compat = scalapack_compat)
 
      this%start  = this%range(1, this%mpi_grp%rank)
      this%end    = this%range(2, this%mpi_grp%rank)
      this%nlocal = this%num(this%mpi_grp%rank)
 
      do i = 0, this%mpi_grp%size - 1
        this%node(this%range(1, i):this%range(2, i)) = i
      end do
 
      if (present(tag)) then
        message(1) = 'Info: Parallelization in ' // trim(tag)
        call messages_info(1)
        do i = 0, this%mpi_grp%size - 1
          write(message(1),'(a,i4,a,i6,a)') 'Info: Node in group ', i, &
            ' will manage ', this%num(i), ' '//trim(tag)
          if (this%num(i) > 0) then
            write(message(1),'(a,a,i6,a,i6)') trim(message(1)), ':', this%range(1, i), " - ", this%range(2, i)
          end if
          call messages_info(1)
        end do
      end if
 
    end if
 
    pop_sub(distributed_init)
  end subroutine distributed_init
 
 
  subroutine distributed_copy(in, out)
    type(distributed_t), intent(in)    :: in
    type(distributed_t), intent(inout) :: out
 
    integer :: size
 
    push_sub(distributed_copy)
 
    call distributed_end(out)
 
    out%start    = in%start
    out%end      = in%end
    out%nlocal   = in%nlocal
    out%nglobal  = in%nglobal
    out%parallel = in%parallel
 
    ! TODO(Alex) This is a weird choice, could retreive from size(num), for example
    size = in%mpi_grp%size
 
    call mpi_grp_init(out%mpi_grp, in%mpi_grp%comm)
 
    if (allocated(in%node)) then
      safe_allocate(out%node(1:in%nglobal))
      out%node(1:in%nglobal) = in%node(1:in%nglobal)
    end if
 
    if (allocated(in%range)) then
      safe_allocate(out%range(1:2, 0:size - 1))
      out%range(1:2, 0:size - 1) = in%range(1:2, 0:size - 1)
    end if
 
    if (allocated(in%num)) then
      safe_allocate(out%num(0:size - 1))
      out%num(0:size - 1) = in%num(0:size - 1)
    end if
 
    pop_sub(distributed_copy)
  end subroutine distributed_copy
 
 
  subroutine distributed_end(this)
    type(distributed_t), intent(inout) :: this
 
    push_sub(distributed_end)
 
    safe_deallocate_a(this%node)
    safe_deallocate_a(this%range)
    safe_deallocate_a(this%num)
 
    pop_sub(distributed_end)
  end subroutine distributed_end
 
 
  subroutine distributed_allgather(this, aa)
    type(distributed_t), intent(in)    :: this
    real(real64), contiguous,   intent(inout) :: aa(:)
 
    integer, allocatable :: displs(:)
 
    if (.not. this%parallel) return
 
    push_sub(distributed_allgather)
 
    safe_allocate(displs(0:this%mpi_grp%size - 1))
 
    displs(0:this%mpi_grp%size - 1) = this%range(1, 0:this%mpi_grp%size - 1) - 1
 
#ifdef HAVE_MPI
    call mpi_allgatherv(mpi_in_place, this%nlocal, mpi_double_precision, &
      aa(1), this%num, displs, mpi_double_precision, this%mpi_grp%comm, mpi_err)
#endif
 
    safe_deallocate_a(displs)
 
    pop_sub(distributed_allgather)
  end subroutine distributed_allgather
 
end module distributed_oct_m
 
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: