連続する batch ledger を、初期 stock と最終 stock を保って累積する。
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(charge_ledger_type), | intent(inout) | :: | cumulative | |||
| type(charge_ledger_type), | intent(in) | :: | batch |
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