mg_fas_vcycle Subroutine

public subroutine mg_fas_vcycle(mg, highest_lvl, max_res, standalone)

Uses

  • proc~~mg_fas_vcycle~~UsesGraph proc~mg_fas_vcycle mg_fas_vcycle mpi mpi proc~mg_fas_vcycle->mpi

Perform FAS V-cycle (full approximation scheme).

Arguments

Type IntentOptional Attributes Name
type(mg_t), intent(inout) :: mg
integer, intent(in), optional :: highest_lvl

Maximum level for V-cycle

real(kind=dp), intent(out), optional :: max_res

Store max(abs(residual))

logical, intent(in), optional :: standalone

Whether the V-cycle is called by itself (default: true)


Calls

proc~~mg_fas_vcycle~~CallsGraph proc~mg_fas_vcycle mg_fas_vcycle mpi_allreduce mpi_allreduce proc~mg_fas_vcycle->mpi_allreduce proc~check_methods check_methods proc~mg_fas_vcycle->proc~check_methods proc~correct_children correct_children proc~mg_fas_vcycle->proc~correct_children proc~max_residual_lvl max_residual_lvl proc~mg_fas_vcycle->proc~max_residual_lvl proc~mg_add_timers mg_add_timers proc~mg_fas_vcycle->proc~mg_add_timers proc~mg_fill_ghost_cells_lvl mg_fill_ghost_cells_lvl proc~mg_fas_vcycle->proc~mg_fill_ghost_cells_lvl proc~mg_timer_end mg_timer_end proc~mg_fas_vcycle->proc~mg_timer_end proc~mg_timer_start mg_timer_start proc~mg_fas_vcycle->proc~mg_timer_start proc~smooth_boxes smooth_boxes proc~mg_fas_vcycle->proc~smooth_boxes proc~subtract_mean subtract_mean proc~mg_fas_vcycle->proc~subtract_mean proc~update_coarse update_coarse proc~mg_fas_vcycle->proc~update_coarse proc~mg_set_methods mg_set_methods proc~check_methods->proc~mg_set_methods proc~mg_prolong mg_prolong proc~correct_children->proc~mg_prolong proc~residual_box residual_box proc~max_residual_lvl->proc~residual_box proc~mg_add_timer mg_add_timer proc~mg_add_timers->proc~mg_add_timer proc~buffer_ghost_cells buffer_ghost_cells proc~mg_fill_ghost_cells_lvl->proc~buffer_ghost_cells proc~buffer_refinement_boundaries buffer_refinement_boundaries proc~mg_fill_ghost_cells_lvl->proc~buffer_refinement_boundaries proc~set_ghost_cells set_ghost_cells proc~mg_fill_ghost_cells_lvl->proc~set_ghost_cells proc~sort_and_transfer_buffers sort_and_transfer_buffers proc~mg_fill_ghost_cells_lvl->proc~sort_and_transfer_buffers mpi_wtime mpi_wtime proc~mg_timer_end->mpi_wtime proc~mg_timer_start->mpi_wtime proc~smooth_boxes->proc~mg_fill_ghost_cells_lvl proc~smooth_boxes->proc~mg_timer_end proc~smooth_boxes->proc~mg_timer_start proc~subtract_mean->mpi_allreduce proc~get_sum get_sum proc~subtract_mean->proc~get_sum proc~update_coarse->proc~mg_fill_ghost_cells_lvl proc~mg_restrict_lvl mg_restrict_lvl proc~update_coarse->proc~mg_restrict_lvl proc~update_coarse->proc~residual_box proc~buffer_for_nb buffer_for_nb proc~buffer_ghost_cells->proc~buffer_for_nb proc~buffer_for_fine_nb buffer_for_fine_nb proc~buffer_refinement_boundaries->proc~buffer_for_fine_nb proc~mg_has_children mg_has_children proc~buffer_refinement_boundaries->proc~mg_has_children proc~mg_prolong->proc~sort_and_transfer_buffers proc~prolong_onto prolong_onto proc~mg_prolong->proc~prolong_onto proc~prolong_set_buffer prolong_set_buffer proc~mg_prolong->proc~prolong_set_buffer proc~mg_restrict_lvl->proc~sort_and_transfer_buffers proc~restrict_onto restrict_onto proc~mg_restrict_lvl->proc~restrict_onto proc~restrict_set_buffer restrict_set_buffer proc~mg_restrict_lvl->proc~restrict_set_buffer proc~ahelmholtz_set_methods ahelmholtz_set_methods proc~mg_set_methods->proc~ahelmholtz_set_methods proc~helmholtz_set_methods helmholtz_set_methods proc~mg_set_methods->proc~helmholtz_set_methods proc~laplacian_set_methods laplacian_set_methods proc~mg_set_methods->proc~laplacian_set_methods proc~vhelmholtz_set_methods vhelmholtz_set_methods proc~mg_set_methods->proc~vhelmholtz_set_methods proc~vlaplacian_set_methods vlaplacian_set_methods proc~mg_set_methods->proc~vlaplacian_set_methods proc~bc_to_gc bc_to_gc proc~set_ghost_cells->proc~bc_to_gc proc~box_get_gc box_get_gc proc~set_ghost_cells->proc~box_get_gc proc~box_set_gc box_set_gc proc~set_ghost_cells->proc~box_set_gc proc~copy_from_nb copy_from_nb proc~set_ghost_cells->proc~copy_from_nb proc~fill_buffered_nb fill_buffered_nb proc~set_ghost_cells->proc~fill_buffered_nb proc~fill_refinement_bnd fill_refinement_bnd proc~set_ghost_cells->proc~fill_refinement_bnd mpi_waitall mpi_waitall proc~sort_and_transfer_buffers->mpi_waitall proc~mpi_irecv_wrapper mpi_irecv_wrapper proc~sort_and_transfer_buffers->proc~mpi_irecv_wrapper proc~mpi_isend_wrapper mpi_isend_wrapper proc~sort_and_transfer_buffers->proc~mpi_isend_wrapper proc~sort_sendbuf sort_sendbuf proc~sort_and_transfer_buffers->proc~sort_sendbuf proc~box_gc_for_fine_neighbor box_gc_for_fine_neighbor proc~buffer_for_fine_nb->proc~box_gc_for_fine_neighbor proc~mg_get_child_offset mg_get_child_offset proc~buffer_for_fine_nb->proc~mg_get_child_offset proc~box_gc_for_neighbor box_gc_for_neighbor proc~buffer_for_nb->proc~box_gc_for_neighbor proc~copy_from_nb->proc~box_set_gc proc~copy_from_nb->proc~box_gc_for_neighbor proc~fill_buffered_nb->proc~box_set_gc proc~fill_refinement_bnd->proc~box_gc_for_fine_neighbor proc~fill_refinement_bnd->proc~mg_get_child_offset proc~sides_rb sides_rb proc~fill_refinement_bnd->proc~sides_rb mpi_irecv mpi_irecv proc~mpi_irecv_wrapper->mpi_irecv mpi_isend mpi_isend proc~mpi_isend_wrapper->mpi_isend proc~prolong_onto->proc~mg_get_child_offset proc~prolong_set_buffer->proc~mg_get_child_offset proc~restrict_onto->proc~mg_get_child_offset proc~mg_ix_to_ichild mg_ix_to_ichild proc~restrict_set_buffer->proc~mg_ix_to_ichild interface~mrgrnk mrgrnk proc~sort_sendbuf->interface~mrgrnk proc~i_mrgrnk I_mrgrnk interface~mrgrnk->proc~i_mrgrnk

Called by

proc~~mg_fas_vcycle~~CalledByGraph proc~mg_fas_vcycle mg_fas_vcycle proc~diffusion_solve diffusion_solve proc~diffusion_solve->proc~mg_fas_vcycle proc~mg_fas_fmg mg_fas_fmg proc~diffusion_solve->proc~mg_fas_fmg proc~diffusion_solve_acoeff diffusion_solve_acoeff proc~diffusion_solve_acoeff->proc~mg_fas_vcycle proc~diffusion_solve_acoeff->proc~mg_fas_fmg proc~diffusion_solve_vcoeff diffusion_solve_vcoeff proc~diffusion_solve_vcoeff->proc~mg_fas_vcycle proc~diffusion_solve_vcoeff->proc~mg_fas_fmg proc~mg_fas_fmg->proc~mg_fas_vcycle

Source Code

  subroutine mg_fas_vcycle(mg, highest_lvl, max_res, standalone)
    use mpi
    type(mg_t), intent(inout)       :: mg
    integer, intent(in), optional   :: highest_lvl
    !< Maximum level for V-cycle
    real(dp), intent(out), optional :: max_res
    !< Store max(abs(residual))
    !> Whether the V-cycle is called by itself (default: true)
    logical, intent(in), optional   :: standalone
    integer                         :: lvl, min_lvl, i, max_lvl, ierr
    real(dp)                        :: init_res, res
    logical                         :: is_standalone

    is_standalone = .true.
    if (present(standalone)) is_standalone = standalone

    call check_methods(mg)
    if (timer_smoother == -1) call mg_add_timers(mg)

    if (is_standalone) call mg_timer_start(mg%timers(timer_total_vcycle))

    if (mg%subtract_mean .and. .not. present(highest_lvl)) then
       ! Assume that this is a stand-alone call. For fully periodic solutions,
       ! ensure the mean source term is zero.
       call subtract_mean(mg, mg_irhs, .false.)
    end if

    min_lvl = mg%lowest_lvl
    max_lvl = mg%highest_lvl
    if (present(highest_lvl)) max_lvl = highest_lvl

    ! Ensure ghost cells are filled correctly
    if (is_standalone) then
       call mg_fill_ghost_cells_lvl(mg, max_lvl, mg_iphi)
    end if

    do lvl = max_lvl,  min_lvl+1, -1
       ! Downwards relaxation
       call smooth_boxes(mg, lvl, mg%n_cycle_down)

       ! Set rhs on coarse grid, restrict phi, and copy mg_iphi to mg_iold for the
       ! correction later
       call mg_timer_start(mg%timers(timer_update_coarse))
       call update_coarse(mg, lvl)
       call mg_timer_end(mg%timers(timer_update_coarse))
    end do

    call mg_timer_start(mg%timers(timer_coarse))
    if (.not. all(mg%boxes(mg%lvls(min_lvl)%ids)%rank == &
       mg%boxes(mg%lvls(min_lvl)%ids(1))%rank)) then
       error stop "Multiple CPUs for coarse grid (not implemented yet)"
    end if

    init_res = max_residual_lvl(mg, min_lvl)
    do i = 1, mg%max_coarse_cycles
       call smooth_boxes(mg, min_lvl, mg%n_cycle_up+mg%n_cycle_down)
       res = max_residual_lvl(mg, min_lvl)
       if (res < mg%residual_coarse_rel * init_res .or. res < &
          mg%residual_coarse_abs) exit
    end do
    call mg_timer_end(mg%timers(timer_coarse))

    ! Do the upwards part of the v-cycle in the tree
    do lvl = min_lvl+1, max_lvl
       ! Correct solution at this lvl using lvl-1 data
       ! phi = phi + prolong(phi_coarse - phi_old_coarse)
       call mg_timer_start(mg%timers(timer_correct))
       call correct_children(mg, lvl-1)

       ! Have to fill ghost cells after correction
       call mg_fill_ghost_cells_lvl(mg, lvl, mg_iphi)
       call mg_timer_end(mg%timers(timer_correct))

       ! Upwards relaxation
       call smooth_boxes(mg, lvl, mg%n_cycle_up)
    end do

    if (present(max_res)) then
       init_res = 0.0_dp
       do lvl = min_lvl, max_lvl
          res = max_residual_lvl(mg, lvl)
          init_res = max(res, init_res)
       end do
       call mpi_allreduce(init_res, max_res, 1, mpi_double, mpi_max, mg%comm,&
           ierr)
    end if

    ! Subtract mean(phi) from phi
    if (mg%subtract_mean) then
       call subtract_mean(mg, mg_iphi, .true.)
    end if

    if (is_standalone) call mg_timer_end(mg%timers(timer_total_vcycle))
  end subroutine mg_fas_vcycle