append_particles Subroutine

public subroutine append_particles(pcls, x, v, q, m, w, species_id, source_element)

既存 SoA の末尾へ粒子群を追加し、既存の alive 状態を保持する。

Arguments

Type IntentOptional Attributes Name
type(particles_soa), intent(inout) :: pcls
real(kind=dp), intent(in) :: x(:,:)
real(kind=dp), intent(in) :: v(:,:)
real(kind=dp), intent(in) :: q(:)
real(kind=dp), intent(in) :: m(:)
real(kind=dp), intent(in) :: w(:)
integer(kind=i32), intent(in) :: species_id(:)
integer(kind=i32), intent(in), optional :: source_element(:)

Source Code

  subroutine append_particles(pcls, x, v, q, m, w, species_id, source_element)
    type(particles_soa), intent(inout) :: pcls
    real(dp), intent(in) :: x(:, :), v(:, :), q(:), m(:), w(:)
    integer(i32), intent(in) :: species_id(:)
    integer(i32), intent(in), optional :: source_element(:)
    real(dp), allocatable :: grown_x(:, :), grown_v(:, :), grown_q(:), grown_m(:), grown_w(:)
    integer(i32), allocatable :: grown_species_id(:), grown_source_element(:)
    logical, allocatable :: grown_alive(:)
    integer(i32) :: old_count, added_count, new_count

    old_count = pcls%n
    added_count = int(size(q), i32)
    if (size(x, 1) /= 3 .or. size(v, 1) /= 3) error stop 'particle append first dimension must be 3'
    if (size(x, 2) /= added_count .or. size(v, 2) /= added_count .or. &
        size(m) /= added_count .or. size(w) /= added_count .or. size(species_id) /= added_count) then
      error stop 'particle append size mismatch'
    end if
    if (present(source_element)) then
      if (size(source_element) /= added_count) error stop 'particle append source_element size mismatch'
    end if
    if (added_count == 0_i32) return
    if (old_count < 0_i32 .or. old_count > huge(0_i32) - added_count) then
      error stop 'particle append count overflow'
    end if
    if (old_count > 0_i32) then
      if (.not. allocated(pcls%x) .or. .not. allocated(pcls%v) .or. .not. allocated(pcls%q) .or. &
          .not. allocated(pcls%m) .or. .not. allocated(pcls%w) .or. .not. allocated(pcls%species_id) .or. &
          .not. allocated(pcls%source_element) .or. .not. allocated(pcls%alive)) then
        error stop 'particle append requires a complete existing SoA'
      end if
    end if

    new_count = old_count + added_count
    allocate (grown_x(3, new_count), grown_v(3, new_count), grown_q(new_count), grown_m(new_count), &
              grown_w(new_count), grown_species_id(new_count), grown_source_element(new_count), grown_alive(new_count))
    if (old_count > 0_i32) then
      grown_x(:, :old_count) = pcls%x
      grown_v(:, :old_count) = pcls%v
      grown_q(:old_count) = pcls%q
      grown_m(:old_count) = pcls%m
      grown_w(:old_count) = pcls%w
      grown_species_id(:old_count) = pcls%species_id
      grown_source_element(:old_count) = pcls%source_element
      grown_alive(:old_count) = pcls%alive
    end if
    grown_x(:, old_count + 1:new_count) = x
    grown_v(:, old_count + 1:new_count) = v
    grown_q(old_count + 1:new_count) = q
    grown_m(old_count + 1:new_count) = m
    grown_w(old_count + 1:new_count) = w
    grown_species_id(old_count + 1:new_count) = species_id
    if (present(source_element)) then
      grown_source_element(old_count + 1:new_count) = source_element
    else
      grown_source_element(old_count + 1:new_count) = -1_i32
    end if
    grown_alive(old_count + 1:new_count) = .true.

    call move_alloc(grown_x, pcls%x)
    call move_alloc(grown_v, pcls%v)
    call move_alloc(grown_q, pcls%q)
    call move_alloc(grown_m, pcls%m)
    call move_alloc(grown_w, pcls%w)
    call move_alloc(grown_species_id, pcls%species_id)
    call move_alloc(grown_source_element, pcls%source_element)
    call move_alloc(grown_alive, pcls%alive)
    pcls%n = new_count
  end subroutine append_particles