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~2~~CallsGraph proc~diffusion_solve~2 diffusion_solve proc~helmholtz_set_lambda~2 helmholtz_set_lambda proc~diffusion_solve~2->proc~helmholtz_set_lambda~2 proc~mg_apply_op~2 mg_apply_op proc~diffusion_solve~2->proc~mg_apply_op~2 proc~mg_fas_fmg~2 mg_fas_fmg proc~diffusion_solve~2->proc~mg_fas_fmg~2 proc~mg_fas_vcycle~2 mg_fas_vcycle proc~diffusion_solve~2->proc~mg_fas_vcycle~2 proc~mg_set_methods~2 mg_set_methods proc~diffusion_solve~2->proc~mg_set_methods~2 proc~set_rhs~2 set_rhs proc~diffusion_solve~2->proc~set_rhs~2 proc~mg_fas_fmg~2->proc~mg_fas_vcycle~2 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_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 mpi_allreduce mpi_allreduce proc~mg_fas_vcycle~2->mpi_allreduce proc~mg_fas_vcycle~2->proc~check_methods~2 proc~mg_fas_vcycle~2->proc~correct_children~2 proc~max_residual_lvl~2 max_residual_lvl proc~mg_fas_vcycle~2->proc~max_residual_lvl~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~smooth_boxes~2 smooth_boxes proc~mg_fas_vcycle~2->proc~smooth_boxes~2 proc~mg_fas_vcycle~2->proc~subtract_mean~2 proc~mg_fas_vcycle~2->proc~update_coarse~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~check_methods~2->proc~mg_set_methods~2 proc~mg_prolong~2 mg_prolong proc~correct_children~2->proc~mg_prolong~2 proc~residual_box~2 residual_box proc~max_residual_lvl~2->proc~residual_box~2 proc~mg_add_timer~2 mg_add_timer proc~mg_add_timers~2->proc~mg_add_timer~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~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 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~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~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~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 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

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