beach_kernel_build Function

public function beach_kernel_build(handle, nsrc, v0_ptr, v1_ptr, v2_ptr, theta, leaf_max, order, use_periodic2, periodic_axes_ptr, periodic_len_ptr, image_layers, far_correction, ewald_alpha, ewald_layers, box_min_ptr, box_max_ptr) result(status) bind(C, name='beach_kernel_build'))

Arguments

Type IntentOptional Attributes Name
type(c_ptr), value :: handle
integer(kind=c_int), value :: nsrc
type(c_ptr), value :: v0_ptr
type(c_ptr), value :: v1_ptr
type(c_ptr), value :: v2_ptr
real(kind=c_double), value :: theta
integer(kind=c_int), value :: leaf_max
integer(kind=c_int), value :: order
integer(kind=c_int), value :: use_periodic2
type(c_ptr), value :: periodic_axes_ptr
type(c_ptr), value :: periodic_len_ptr
integer(kind=c_int), value :: image_layers
integer(kind=c_int), value :: far_correction
real(kind=c_double), value :: ewald_alpha
integer(kind=c_int), value :: ewald_layers
type(c_ptr), value :: box_min_ptr
type(c_ptr), value :: box_max_ptr

Return Value integer(kind=c_int)


Calls

proc~~beach_kernel_build~~CallsGraph proc~beach_kernel_build beach_kernel_build interface~build_panel_plan build_panel_plan proc~beach_kernel_build->interface~build_panel_plan interface~destroy_plan destroy_plan proc~beach_kernel_build->interface~destroy_plan interface~destroy_state destroy_state proc~beach_kernel_build->interface~destroy_state proc~init_panel_geometry init_panel_geometry proc~beach_kernel_build->proc~init_panel_geometry

Source Code

  integer(c_int) function beach_kernel_build( &
    handle, nsrc, v0_ptr, v1_ptr, v2_ptr, theta, leaf_max, order, use_periodic2, periodic_axes_ptr, &
    periodic_len_ptr, image_layers, far_correction, ewald_alpha, ewald_layers, box_min_ptr, box_max_ptr &
    ) bind(C, name='beach_kernel_build') result(status)
    type(c_ptr), value :: handle, v0_ptr, v1_ptr, v2_ptr
    integer(c_int), value :: nsrc, leaf_max, order, use_periodic2, image_layers, far_correction, ewald_layers
    real(c_double), value :: theta, ewald_alpha
    type(c_ptr), value :: periodic_axes_ptr, periodic_len_ptr, box_min_ptr, box_max_ptr
    type(field_kernel_handle), pointer :: kernel
    real(c_double), pointer :: v0(:, :), v1(:, :), v2(:, :)
    integer(c_int), pointer :: periodic_axes(:)
    real(c_double), pointer :: periodic_len(:), box_min(:), box_max(:)
    type(fmm_options_type) :: options
    type(panel_geometry_type) :: panel_geometry
    integer(i32) :: panel_status
    integer :: idx

    status = get_kernel(handle, kernel)
    if (status /= beach_kernel_ok) return
    if (nsrc <= 0_c_int .or. .not. c_associated(v0_ptr) .or. .not. c_associated(v1_ptr) .or. &
        .not. c_associated(v2_ptr) .or. .not. ieee_is_finite(theta) .or. theta <= 0.0_c_double .or. &
        leaf_max <= 0_c_int .or. order < 1_c_int .or. far_correction == 2_c_int) then
      status = beach_kernel_invalid_argument
      return
    end if

    call c_f_pointer(v0_ptr, v0, [3, int(nsrc)])
    call c_f_pointer(v1_ptr, v1, [3, int(nsrc)])
    call c_f_pointer(v2_ptr, v2, [3, int(nsrc)])
    do idx = 1, int(nsrc)
      call init_panel_geometry( &
        real(v0(:, idx), dp), real(v1(:, idx), dp), real(v2(:, idx), dp), panel_geometry, panel_status &
        )
      if (panel_status /= panel_geometry_ok) then
        status = beach_kernel_invalid_argument
        return
      end if
    end do
    options%theta = real(theta, dp)
    options%leaf_max = int(leaf_max, i32)
    options%order = int(order, i32)
    options%softening = 0.0_dp
    options%periodic_cache_dir = kernel%periodic_cache_dir
    options%periodic_generation_tolerance = kernel%periodic_generation_tolerance

    if (c_associated(box_min_ptr) .neqv. c_associated(box_max_ptr)) then
      status = beach_kernel_invalid_argument
      return
    end if
    if (c_associated(box_min_ptr)) then
      call c_f_pointer(box_min_ptr, box_min, [3])
      call c_f_pointer(box_max_ptr, box_max, [3])
      if (.not. all(ieee_is_finite(box_min)) .or. .not. all(ieee_is_finite(box_max)) .or. &
          any(box_max <= box_min)) then
        status = beach_kernel_invalid_argument
        return
      end if
      options%target_box_min = real(box_min, dp)
      options%target_box_max = real(box_max, dp)
    end if

    if (use_periodic2 /= 0_c_int) then
      if (.not. c_associated(periodic_axes_ptr) .or. .not. c_associated(periodic_len_ptr) .or. &
          .not. c_associated(box_min_ptr) .or. .not. c_associated(box_max_ptr) .or. &
          image_layers < 0_c_int .or. ewald_layers < 0_c_int .or. .not. ieee_is_finite(ewald_alpha) .or. &
          ewald_alpha < 0.0_c_double) then
        status = beach_kernel_invalid_argument
        return
      end if
      call c_f_pointer(periodic_axes_ptr, periodic_axes, [2])
      call c_f_pointer(periodic_len_ptr, periodic_len, [2])
      if (any(periodic_axes < 1_c_int) .or. any(periodic_axes > 3_c_int) .or. &
          periodic_axes(1) == periodic_axes(2) .or. .not. all(ieee_is_finite(periodic_len)) .or. &
          any(periodic_len <= 0.0_c_double) .or. .not. all(ieee_is_finite(box_min)) .or. &
          .not. all(ieee_is_finite(box_max)) .or. any(box_max <= box_min)) then
        status = beach_kernel_invalid_argument
        return
      end if
      options%use_periodic2 = .true.
      options%periodic_axes = int(periodic_axes, i32)
      options%periodic_len = real(periodic_len, dp)
      options%periodic_image_layers = int(image_layers, i32)
      options%periodic_ewald_alpha = real(ewald_alpha, dp)
      options%periodic_ewald_layers = int(ewald_layers, i32)
      select case (far_correction)
      case (0_c_int, 1_c_int)
        options%periodic_far_correction = 'none'
      case (3_c_int)
        if (order < 1_c_int .or. image_layers < 1_c_int .or. ewald_layers < 1_c_int) then
          status = beach_kernel_invalid_argument
          return
        end if
        options%periodic_far_correction = 'cached_kneq0'
      case default
        status = beach_kernel_invalid_argument
        return
      end select
    end if

    if (kernel%charged) call destroy_state(kernel%state)
    if (kernel%built) call destroy_plan(kernel%plan)
    call build_panel_plan(kernel%plan, real(v0, dp), real(v1, dp), real(v2, dp), options)
    kernel%built = .true.
    kernel%charged = .false.
    status = beach_kernel_ok
  end function beach_kernel_build