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~3~~CallsGraph proc~restrict_set_buffer~3 restrict_set_buffer proc~mg_ix_to_ichild~3 mg_ix_to_ichild proc~restrict_set_buffer~3->proc~mg_ix_to_ichild~3

Called by

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

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, k, n, hnc, p_id, p_rank
    real(dp) :: tmp(mg%box_size/2, 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 k = 1, hnc
          do j = 1, hnc
             do i = 1, hnc
                tmp(i, j, k) = 0.125_dp * sum(mg%boxes(id)%cc(2*i-1:2*i,&
                    2*j-1:2*j, 2*k-1:2*k, iv))
             end do
          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