ring_pattern.F90

Go to the documentation of this file.

!! Copyright (C) 2023 N. Tancogne-Dejean
!!
!! This Source Code Form is subject to the terms of the Mozilla Public
!! License, v. 2.0. If a copy of the MPL was not distributed with this
!! file, You can obtain one at https://mozilla.org/MPL/2.0/.
!!
 
#include "global.h"
 
!
module ring_pattern_oct_m
  use debug_oct_m
  use global_oct_m
  use messages_oct_m
  use mpi_oct_m
  use profiling_oct_m
 
  implicit none
 
  private
 
  public ::                      &
    ring_pattern_t
 
  type ring_pattern_t
    private
 
    type(mpi_grp_t) :: mpi_grp
    integer :: nsteps
    !                             !! Each step might imply more than one communication step (e.g. multiple batches per rank).
    logical :: double_sided_comms
 
  contains
    procedure :: start => ring_pattern_start
    procedure :: get_nsteps => ring_pattern_get_nsteps
    procedure :: get_rank_from => ring_pattern_get_rank_from
    procedure :: get_rank_to => ring_pattern_get_rank_to
  end type ring_pattern_t
 
contains
 
  subroutine ring_pattern_start(this, mpi_grp, double_sided_comms)
    class(ring_pattern_t),   intent(inout) :: this
    type(mpi_grp_t),         intent(in)    :: mpi_grp
    logical,                 intent(in)    :: double_sided_comms
 
    push_sub(ring_pattern_start)
 
    this%double_sided_comms = double_sided_comms
    this%mpi_grp = mpi_grp
 
    if (this%mpi_grp%size <= 0) then
      this%nsteps = 0
      pop_sub(ring_pattern_start)
      return
    end if
 
    if (double_sided_comms) then
      this%nsteps = int((mpi_grp%size+2)/2)-1
    else
      this%nsteps = mpi_grp%size-1
    end if
 
    if (this%nsteps > 0) then
      write(message(1), '(a,i0,a)') "Debug: The ring pattern will perform ", this%nsteps, " steps."
      call messages_info(1, debug_only=.true.)
    end if
 
    pop_sub(ring_pattern_start)
  end subroutine ring_pattern_start
 
  integer pure function ring_pattern_get_nsteps(this)
    class(ring_pattern_t), intent(in) :: this
 
    ring_pattern_get_nsteps = this%nsteps
  end function ring_pattern_get_nsteps
 
  integer pure function ring_pattern_get_rank_to(this, istep) result(rank_to)
    class(ring_pattern_t), intent(in) :: this
    integer,               intent(in) :: istep
 
    logical :: last_step, even_number_tasks, rank_to_first_half
 
    rank_to = mod(this%mpi_grp%rank + istep, this%mpi_grp%size)
 
    if (this%double_sided_comms) then
      last_step = istep == this%nsteps
      even_number_tasks = mod(this%mpi_grp%size, 2) == 0
      rank_to_first_half = rank_to < this%mpi_grp%size/2
 
      if (last_step .and. even_number_tasks .and. rank_to_first_half) then
        rank_to = -1
      end if
    end if
  end function ring_pattern_get_rank_to
 
  integer pure function ring_pattern_get_rank_from(this, istep) result(rank_fr)
    class(ring_pattern_t), intent(in) :: this
    integer,               intent(in) :: istep
 
    logical :: last_step, even_number_tasks, rank_first_half
 
    rank_fr = modulo(this%mpi_grp%rank - istep, this%mpi_grp%size)
 
    if (this%double_sided_comms) then
      last_step = istep == this%nsteps
      even_number_tasks = mod(this%mpi_grp%size, 2) == 0
      rank_first_half = this%mpi_grp%rank < this%mpi_grp%size/2
      if (last_step .and. even_number_tasks .and. rank_first_half) then
        rank_fr = -1
      end if
    end if
  end function ring_pattern_get_rank_from
 
end module ring_pattern_oct_m
 
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: