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~~CallsGraph proc~restrict_onto restrict_onto proc~mg_get_child_offset mg_get_child_offset proc~restrict_onto->proc~mg_get_child_offset

Called by

proc~~restrict_onto~~CalledByGraph proc~restrict_onto restrict_onto proc~mg_restrict_lvl mg_restrict_lvl proc~mg_restrict_lvl->proc~restrict_onto 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_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, hnc, dsize, i_c, c_id
    integer                   :: c_rank, dix(2)

    hnc   = nc/2
    dsize = hnc**2

    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
             mg%boxes(id)%cc(dix(1)+i, dix(2)+j,&
                 iv) = 0.25_dp * sum(mg%boxes(c_id)%cc(2*i-1:2*i, 2*j-1:2*j,&
                 iv))
          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,&
              iv) = reshape(mg%buf(c_rank)%recv(i+1:i+dsize), [hnc, hnc])
          mg%buf(c_rank)%i_recv = mg%buf(c_rank)%i_recv + dsize
       end if
    end do

  end subroutine restrict_onto