restrict_onto Subroutine

private subroutine restrict_onto(mg, id, nc, iv)

Arguments

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

Calls

proc~~restrict_onto~3~~CallsGraph proc~restrict_onto~3 restrict_onto proc~mg_get_child_offset~3 mg_get_child_offset proc~restrict_onto~3->proc~mg_get_child_offset~3

Called by

proc~~restrict_onto~3~~CalledByGraph proc~restrict_onto~3 restrict_onto proc~mg_restrict_lvl~3 mg_restrict_lvl proc~mg_restrict_lvl~3->proc~restrict_onto~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_onto(mg, id, nc, iv)
    type(mg_t), intent(inout) :: mg
    integer, intent(in)       :: id
    integer, intent(in)       :: nc
    integer, intent(in)       :: iv
    integer                   :: i, j, k, hnc, dsize, i_c, c_id
    integer                   :: c_rank, dix(3)

    hnc   = nc/2
    dsize = hnc**3

    do i_c = 1, mg_num_children
       c_id   = mg%boxes(id)%children(i_c)
       if (c_id == mg_no_box) cycle ! For coarsened grid
       c_rank = mg%boxes(c_id)%rank
       dix    = mg_get_child_offset(mg, c_id)

       if (c_rank == mg%my_rank) then
          do j=1, hnc; do i=1, hnc; do k=1, hnc
             mg%boxes(id)%cc(dix(1)+i, dix(2)+j, dix(3)+k,&
                 iv) = 0.125_dp * sum(mg%boxes(c_id)%cc(2*i-1:2*i, 2*j-1:2*j,&
                 2*k-1:2*k, iv))
          end do; end do; end do
       else
          i = mg%buf(c_rank)%i_recv
          mg%boxes(id)%cc(dix(1)+1:dix(1)+hnc, dix(2)+1:dix(2)+hnc,&
              dix(3)+1:dix(3)+hnc, iv) = &
             reshape(mg%buf(c_rank)%recv(i+1:i+dsize), [hnc, hnc, hnc])
          mg%buf(c_rank)%i_recv = mg%buf(c_rank)%i_recv + dsize
       end if
    end do

  end subroutine restrict_onto