mg_fas_fmg Subroutine

public subroutine mg_fas_fmg(mg, have_guess, max_res)

Perform FAS-FMG cycle (full approximation scheme, full multigrid).

Arguments

Type IntentOptional Attributes Name
type(mg_t), intent(inout) :: mg
logical, intent(in) :: have_guess

If false, start from phi = 0

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

Store max(abs(residual))


Calls

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

Called by

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

Source Code

  subroutine mg_fas_fmg(mg, have_guess, max_res)
    type(mg_t), intent(inout)       :: mg
    logical, intent(in)             :: have_guess
    !< If false, start from phi = 0
    real(dp), intent(out), optional :: max_res
    !< Store max(abs(residual))
    integer                         :: lvl, i, id

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

    call mg_timer_start(mg%timers(timer_total_fmg))

    if (.not. have_guess) then
       do lvl = mg%highest_lvl, mg%lowest_lvl, -1
          do i = 1, size(mg%lvls(lvl)%my_ids)
             id = mg%lvls(lvl)%my_ids(i)
             mg%boxes(id)%cc(:, mg_iphi) = 0.0_dp
          end do
       end do
    end if

    ! Ensure ghost cells are filled correctly
    call mg_fill_ghost_cells_lvl(mg, mg%highest_lvl, mg_iphi)

    do lvl = mg%highest_lvl,  mg%lowest_lvl+1, -1
       ! Set rhs on coarse grid and restrict phi
       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

    if (mg%subtract_mean) then
       ! For fully periodic solutions, the mean source term has to be zero
       call subtract_mean(mg, mg_irhs, .false.)
    end if

    do lvl = mg%lowest_lvl, mg%highest_lvl
       ! Store phi_old
       do i = 1, size(mg%lvls(lvl)%my_ids)
          id = mg%lvls(lvl)%my_ids(i)
          mg%boxes(id)%cc(:, mg_iold) = mg%boxes(id)%cc(:, mg_iphi)
       end do

       if (lvl > mg%lowest_lvl) then
          ! 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)
          call mg_timer_end(mg%timers(timer_correct))

          ! Update ghost cells
          call mg_fill_ghost_cells_lvl(mg, lvl, mg_iphi)
       end if

       ! Perform V-cycle, possibly set residual on last iteration
       if (lvl == mg%highest_lvl) then
          call mg_fas_vcycle(mg, lvl, max_res, standalone=.false.)
       else
          call mg_fas_vcycle(mg, lvl, standalone=.false.)
       end if
    end do

    call mg_timer_end(mg%timers(timer_total_fmg))
  end subroutine mg_fas_fmg