accumulate_charge_ledger Subroutine

public subroutine accumulate_charge_ledger(cumulative, batch)

連続する batch ledger を、初期 stock と最終 stock を保って累積する。

Arguments

Type IntentOptional Attributes Name
type(charge_ledger_type), intent(inout) :: cumulative
type(charge_ledger_type), intent(in) :: batch

Calls

proc~~accumulate_charge_ledger~~CallsGraph proc~accumulate_charge_ledger accumulate_charge_ledger none~init~2 charge_ledger_type%init proc~accumulate_charge_ledger->none~init~2 proc~checked_accumulate_charge checked_accumulate_charge proc~accumulate_charge_ledger->proc~checked_accumulate_charge none~reset charge_ledger_type%reset none~init~2->none~reset

Source Code

  subroutine accumulate_charge_ledger(cumulative, batch)
    type(charge_ledger_type), intent(inout) :: cumulative
    type(charge_ledger_type), intent(in) :: batch
    type(charge_ledger_type) :: candidate
    logical :: first_batch, absorbed_fixed_active, emission_fixed_active
    integer(i32) :: species_idx

    if (batch%nspecies < 1_i32 .or. .not. allocated(batch%injected_from_remote)) then
      error stop 'cannot accumulate an uninitialized charge ledger.'
    end if
    first_batch = .not. allocated(cumulative%injected_from_remote) .or. cumulative%batch_count == 0_i32
    candidate = cumulative
    if (.not. allocated(candidate%injected_from_remote)) then
      call candidate%init(batch%nspecies)
    else if (candidate%nspecies /= batch%nspecies) then
      error stop 'charge ledger species count mismatch during accumulation.'
    end if
    call validate_ledger_finite(batch, 'batch charge ledger')
    call validate_ledger_finite(candidate, 'cumulative charge ledger')
    if (first_batch) then
      candidate%surface_charge_before = batch%surface_charge_before
      candidate%local_flight_charge_before = batch%local_flight_charge_before
      candidate%unresolved_stock_before = batch%unresolved_stock_before
    end if
    candidate%surface_charge_after = batch%surface_charge_after
    candidate%local_flight_charge_after = batch%local_flight_charge_after
    candidate%unresolved_stock_after = batch%unresolved_stock_after
    candidate%batch_count = max(candidate%batch_count, batch%batch_count)
    call checked_accumulate_charge_array(candidate%injected_from_remote, batch%injected_from_remote, 'injected charge')
    call checked_accumulate_charge_array(candidate%emitted_from_surface, batch%emitted_from_surface, 'emitted charge')
    call checked_accumulate_charge_array(candidate%absorbed_on_surface, batch%absorbed_on_surface, 'absorbed charge')
    call checked_accumulate_charge_array(candidate%escaped_to_infinity, batch%escaped_to_infinity, 'escaped charge')
    call checked_accumulate_charge_array(candidate%discarded_unresolved, batch%discarded_unresolved, 'discarded charge')
    call checked_accumulate_charge_array( &
      candidate%neutral_return_correction, batch%neutral_return_correction, 'neutral-return correction' &
      )
    call checked_accumulate_charge_array( &
      candidate%fixed_absorbed_target_charge, batch%fixed_absorbed_target_charge, 'fixed absorbed target charge' &
      )
    call checked_accumulate_charge_array( &
      candidate%fixed_emission_target_charge, batch%fixed_emission_target_charge, 'fixed emission target charge' &
      )
    call checked_accumulate_charge_array( &
      candidate%fixed_escape_target_charge, batch%fixed_escape_target_charge, 'fixed escape target charge' &
      )
    call checked_accumulate_charge_array( &
      candidate%fixed_escape_correction, batch%fixed_escape_correction, 'fixed escape correction' &
      )
    call checked_accumulate_charge_array( &
      candidate%fixed_current_correction, batch%fixed_current_correction, 'fixed current correction' &
      )
    do species_idx = 1_i32, candidate%nspecies
      absorbed_fixed_active = candidate%fixed_absorbed_target_charge(species_idx) /= 0.0_dp .or. &
                              candidate%fixed_absorbed_weight_scale(species_idx) /= 1.0_dp .or. &
                              batch%fixed_absorbed_weight_scale(species_idx) /= 1.0_dp
      emission_fixed_active = candidate%fixed_emission_target_charge(species_idx) /= 0.0_dp .or. &
                              candidate%fixed_emission_weight_scale(species_idx) /= 1.0_dp .or. &
                              batch%fixed_emission_weight_scale(species_idx) /= 1.0_dp
      candidate%fixed_absorbed_weight_scale(species_idx) = 1.0_dp
      candidate%fixed_emission_weight_scale(species_idx) = 1.0_dp
      if (absorbed_fixed_active) then
        if (candidate%absorbed_on_surface(species_idx) /= 0.0_dp) then
          candidate%fixed_absorbed_weight_scale(species_idx) = checked_charge_ratio( &
                                                               candidate%fixed_absorbed_target_charge(species_idx), &
                                                               candidate%absorbed_on_surface(species_idx), &
                                                               'cumulative fixed absorbed weight scale' &
                                                               )
        end if
      end if
      if (emission_fixed_active) then
        if (candidate%emitted_from_surface(species_idx) /= 0.0_dp) then
          candidate%fixed_emission_weight_scale(species_idx) = checked_charge_ratio( &
                                                               -candidate%fixed_emission_target_charge(species_idx), &
                                                               candidate%emitted_from_surface(species_idx), &
                                                               'cumulative fixed emission weight scale' &
                                                               )
        end if
      end if
    end do
    candidate%neutral_return_weight_scale = 1.0_dp
    candidate%neutral_return_unresolved_fraction = 0.0_dp
    do species_idx = 1_i32, candidate%nspecies
      if (candidate%neutral_return_correction(species_idx) == 0.0_dp) cycle
      if (candidate%emitted_from_surface(species_idx) >= 0.0_dp .or. &
          candidate%absorbed_on_surface(species_idx) >= 0.0_dp) then
        ! The correction and charge channels are authoritative.  These two
        ! ratios are derived diagnostics, so keep their neutral defaults when
        ! a cumulative history does not satisfy the electron-sign convention.
        cycle
      end if
      candidate%neutral_return_weight_scale(species_idx) = checked_charge_ratio( &
                                                           candidate%emitted_from_surface(species_idx), &
                                                           candidate%absorbed_on_surface(species_idx), &
                                                           'cumulative neutral-return weight scale' &
                                                           )
      candidate%neutral_return_unresolved_fraction(species_idx) = checked_charge_ratio( &
                                                                  candidate%discarded_unresolved(species_idx), &
                                                                  candidate%emitted_from_surface(species_idx), &
                                                                  'cumulative neutral-return unresolved fraction' &
                                                                  )
    end do
    call checked_accumulate_count_array(candidate%injected_count, batch%injected_count, 'injected count')
    call checked_accumulate_count_array(candidate%emitted_count, batch%emitted_count, 'emitted count')
    call checked_accumulate_count_array(candidate%absorbed_count, batch%absorbed_count, 'absorbed count')
    call checked_accumulate_count_array(candidate%escaped_count, batch%escaped_count, 'escaped count')
    call checked_accumulate_count_array( &
      candidate%discarded_unresolved_count, batch%discarded_unresolved_count, 'discarded unresolved count' &
      )
    cumulative = candidate
  end subroutine accumulate_charge_ledger