solve_matching_implicit_zero_mode Subroutine

  subroutine solve_matching_implicit_zero_mode( &
    provider, mpi, displacement_before, displacement_seed, duration, displacement_bounded, &
    displacement_min, displacement_max, &
    displacement_scale, search_direction, feedback_reference, electron_charge, ion_charge, photoelectron_active, &
    photoelectron_charge, root_before, root_after, displacement_after, response_after &
    )
    type(matching_plane_response_provider_type), intent(inout) :: provider
    type(mpi_context), intent(in) :: mpi
    logical, intent(in) :: displacement_bounded
    real(dp), intent(in) :: displacement_before, displacement_seed, duration
    real(dp), intent(in) :: displacement_min, displacement_max, displacement_scale
    integer(i32), intent(in) :: search_direction
    real(dp), intent(in) :: feedback_reference(4)
    real(dp), intent(in) :: electron_charge, ion_charge, photoelectron_charge
    logical, intent(in) :: photoelectron_active
    type(matching_plane_zhao_root_seed_type), intent(in) :: root_before
    type(matching_plane_zhao_root_seed_type), intent(out) :: root_after
    real(dp), intent(out) :: displacement_after, response_after(6)

    real(dp) :: result_packet(7)
    integer(i32) :: status, status_packet(1)
    character(len=512) :: message

    displacement_after = 0.0_dp
    response_after = 0.0_dp
    root_after = matching_plane_zhao_root_seed_type()
    result_packet = 0.0_dp
    status = matching_plane_provider_ok
    message = ''
    if (mpi_is_root(mpi)) then
      call solve_matching_implicit_zero_mode_local( &
        provider, displacement_before, displacement_seed, duration, displacement_bounded, &
        displacement_min, displacement_max, &
        displacement_scale, search_direction, feedback_reference, electron_charge, ion_charge, photoelectron_active, &
        photoelectron_charge, root_before, root_after, displacement_after, response_after, status, message &
        )
      if (status == matching_plane_provider_ok .and. len_trim(message) > 0) then
        write (error_unit, '(a)') trim(message)
        flush (error_unit)
      end if
      if (status == matching_plane_provider_ok) result_packet = [displacement_after, response_after]
    end if
    status_packet = [status]
    call mpi_bcast_i32_array(mpi, status_packet, 0_i32)
    status = status_packet(1)
    if (status /= matching_plane_provider_ok) then
      if (mpi_is_root(mpi)) then
        write (error_unit, '(a)') trim(message)
        flush (error_unit)
      end if
      error stop 128
    end if
    call mpi_bcast_real_dp_array(mpi, result_packet, 0_i32)
    displacement_after = result_packet(1)
    response_after = result_packet(2:7)
  end subroutine solve_matching_implicit_zero_mode