restrict_set_buffer Subroutine

private subroutine restrict_set_buffer(mg, id, iv)

Arguments

Type IntentOptional Attributes Name
type(mg_t), intent(inout) :: mg
integer, intent(in) :: id
integer, intent(in) :: iv

Calls

proc~~restrict_set_buffer~~CallsGraph proc~restrict_set_buffer restrict_set_buffer proc~mg_ix_to_ichild mg_ix_to_ichild proc~restrict_set_buffer->proc~mg_ix_to_ichild

Called by

proc~~restrict_set_buffer~~CalledByGraph proc~restrict_set_buffer restrict_set_buffer proc~mg_restrict_lvl mg_restrict_lvl proc~mg_restrict_lvl->proc~restrict_set_buffer proc~mg_restrict mg_restrict proc~mg_restrict->proc~mg_restrict_lvl proc~update_coarse update_coarse proc~update_coarse->proc~mg_restrict_lvl proc~mg_fas_fmg mg_fas_fmg proc~mg_fas_fmg->proc~update_coarse proc~mg_fas_vcycle mg_fas_vcycle proc~mg_fas_fmg->proc~mg_fas_vcycle proc~mg_fas_vcycle->proc~update_coarse proc~diffusion_solve diffusion_solve proc~diffusion_solve->proc~mg_fas_fmg proc~diffusion_solve->proc~mg_fas_vcycle proc~diffusion_solve_acoeff diffusion_solve_acoeff proc~diffusion_solve_acoeff->proc~mg_fas_fmg proc~diffusion_solve_acoeff->proc~mg_fas_vcycle proc~diffusion_solve_vcoeff diffusion_solve_vcoeff proc~diffusion_solve_vcoeff->proc~mg_fas_fmg proc~diffusion_solve_vcoeff->proc~mg_fas_vcycle

Source Code

  subroutine restrict_set_buffer(mg, id, iv)
    type(mg_t), intent(inout) :: mg
    integer, intent(in)          :: id
    integer, intent(in)          :: iv
    integer                      :: i, j, n, hnc, p_id, p_rank
    real(dp) :: tmp(mg%box_size/2, mg%box_size/2)

    hnc    = mg%box_size/2
    p_id   = mg%boxes(id)%parent
    p_rank = mg%boxes(p_id)%rank

    if (p_rank /= mg%my_rank) then
       do j = 1, hnc
          do i = 1, hnc
             tmp(i, j) = 0.25_dp * sum(mg%boxes(id)%cc(2*i-1:2*i, 2*j-1:2*j,&
                 iv))
          end do
       end do

       ! Buffer
       n = size(tmp)
       i = mg%buf(p_rank)%i_send
       mg%buf(p_rank)%send(i+1:i+n) = pack(tmp, .true.)
       mg%buf(p_rank)%i_send = mg%buf(p_rank)%i_send + n

       ! To later sort the send buffer according to parent order
       i = mg%buf(p_rank)%i_ix
       n = mg_ix_to_ichild(mg%boxes(id)%ix)
       mg%buf(p_rank)%ix(i+1) = mg_num_children * p_id + n
       mg%buf(p_rank)%i_ix = mg%buf(p_rank)%i_ix + 1
    end if
  end subroutine restrict_set_buffer