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

Called by

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

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, hnc, dsize, i_c, c_id
    integer                   :: c_rank, dix(1)

    hnc   = nc/2
    dsize = hnc**1

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

  end subroutine restrict_onto