diffusion_solve Subroutine

public subroutine diffusion_solve(mg, dt, diffusion_coeff, order, max_res)

Solve a diffusion equation implicitly, assuming a constant diffusion coefficient. The solution at time t should be stored in mg_iphi, which is on output replaced by the solution at time t+dt.

Arguments

Type IntentOptional Attributes Name
type(mg_t), intent(inout) :: mg
real(kind=dp), intent(in) :: dt
real(kind=dp), intent(in) :: diffusion_coeff
integer, intent(in) :: order
real(kind=dp), intent(in) :: max_res

Calls

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

Source Code

  subroutine diffusion_solve(mg, dt, diffusion_coeff, order, max_res)

    type(mg_t), intent(inout) :: mg
    real(dp), intent(in)      :: dt
    real(dp), intent(in)      :: diffusion_coeff
    integer, intent(in)       :: order
    real(dp), intent(in)      :: max_res
    integer, parameter        :: max_its = 10
    integer                   :: n
    real(dp)                  :: res

    mg%operator_type = mg_helmholtz
    call mg_set_methods(mg)

    select case (order)
    case (1)
       call helmholtz_set_lambda(1/(dt * diffusion_coeff))
       call set_rhs(mg, -1/(dt * diffusion_coeff), 0.0_dp)
    case (2)
       call helmholtz_set_lambda(0.0d0)
       call mg_apply_op(mg, mg_irhs)
       call helmholtz_set_lambda(2/(dt * diffusion_coeff))
       call set_rhs(mg, -2/(dt * diffusion_coeff), -1.0_dp)
    case default
       error stop "diffusion_solve: order should be 1 or 2"
    end select

    ! Start with an FMG cycle
    call mg_fas_fmg(mg, .true., max_res=res)

    ! Add V-cycles if necessary
    do n = 1, max_its
       if (res <= max_res) exit
       call mg_fas_vcycle(mg, max_res=res)
    end do

    if (n == max_its + 1) then
       if (mg%my_rank == 0) print *,&
           "Did you specify boundary conditions correctly?"
       error stop "diffusion_solve: no convergence"
    end if
  end subroutine diffusion_solve