diff --git a/include/openmc/tallies/tally.h b/include/openmc/tallies/tally.h index e67ebb7843..4b0514fd6a 100644 --- a/include/openmc/tallies/tally.h +++ b/include/openmc/tallies/tally.h @@ -30,6 +30,11 @@ public: int32_t n_filter_bins() const {return n_filter_bins_;} + //! Event type that contributes to this tally + int estimator_ {ESTIMATOR_TRACKLENGTH}; + + bool active_ {false}; + // We need to have quick access to some filters. The following gives indices // for various filters that could be in the tally or C_NONE if they are not // present. @@ -58,6 +63,13 @@ extern "C" double total_weight; namespace model { extern std::vector> tallies; + + extern std::vector active_analog_tallies; + extern std::vector active_tracklength_tallies; + extern std::vector active_meshsurf_tallies; + extern std::vector active_collision_tallies; + extern std::vector active_tallies; + extern std::vector active_surface_tallies; } // Threadprivate variables diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 88c38f9d40..454956b46e 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -1174,19 +1174,19 @@ contains do j = 1, t % n_filters() select type (filt => filters(t % filter(j)) % obj) type is (EnergyoutFilter) - t % estimator = ESTIMATOR_ANALOG + call t % set_estimator(ESTIMATOR_ANALOG) type is (LegendreFilter) - t % estimator = ESTIMATOR_ANALOG + call t % set_estimator(ESTIMATOR_ANALOG) type is (SphericalHarmonicsFilter) if (filt % cosine() == COSINE_SCATTER) then - t % estimator = ESTIMATOR_ANALOG + call t % set_estimator(ESTIMATOR_ANALOG) end if type is (SpatialLegendreFilter) - t % estimator = ESTIMATOR_COLLISION + call t % set_estimator(ESTIMATOR_COLLISION) type is (ZernikeFilter) - t % estimator = ESTIMATOR_COLLISION + call t % set_estimator(ESTIMATOR_COLLISION) type is (ZernikeRadialFilter) - t % estimator = ESTIMATOR_COLLISION + call t % set_estimator(ESTIMATOR_COLLISION) end select end do @@ -1312,7 +1312,7 @@ contains t % score_bins(j) = SCORE_SCATTER if (has_energyout .or. has_legendre) then ! Set tally estimator to analog - t % estimator = ESTIMATOR_ANALOG + call t % set_estimator(ESTIMATOR_ANALOG) end if case ('nu-scatter') @@ -1322,11 +1322,11 @@ contains ! (MG mode has all data available without a collision being ! necessary) if (run_CE) then - t % estimator = ESTIMATOR_ANALOG + call t % set_estimator(ESTIMATOR_ANALOG) else if (has_energyout .or. has_legendre) then ! Set tally estimator to analog - t % estimator = ESTIMATOR_ANALOG + call t % set_estimator(ESTIMATOR_ANALOG) end if end if @@ -1358,7 +1358,7 @@ contains t % score_bins(j) = SCORE_NU_FISSION if (has_energyout) then ! Set tally estimator to analog - t % estimator = ESTIMATOR_ANALOG + call t % set_estimator(ESTIMATOR_ANALOG) end if case ('decay-rate') t % score_bins(j) = SCORE_DECAY_RATE @@ -1366,13 +1366,13 @@ contains t % score_bins(j) = SCORE_DELAYED_NU_FISSION if (has_energyout) then ! Set tally estimator to analog - t % estimator = ESTIMATOR_ANALOG + call t % set_estimator(ESTIMATOR_ANALOG) end if case ('prompt-nu-fission') t % score_bins(j) = SCORE_PROMPT_NU_FISSION if (has_energyout) then ! Set tally estimator to analog - t % estimator = ESTIMATOR_ANALOG + call t % set_estimator(ESTIMATOR_ANALOG) end if case ('kappa-fission') t % score_bins(j) = SCORE_KAPPA_FISSION @@ -1563,7 +1563,7 @@ contains type is (ParticleFilter) do l = 1, filt % n_bins if (filt % particles(l) == ELECTRON .or. filt % particles(l) == POSITRON) then - t % estimator = ESTIMATOR_ANALOG + call t % set_estimator(ESTIMATOR_ANALOG) end if end do end select @@ -1598,8 +1598,8 @@ contains call t % set_deriv(j) ! Only analog or collision estimators are supported for differential ! tallies. - if (t % estimator == ESTIMATOR_TRACKLENGTH) then - t % estimator = ESTIMATOR_COLLISION + if (t % estimator() == ESTIMATOR_TRACKLENGTH) then + call t % set_estimator(ESTIMATOR_COLLISION) end if ! We found the derivative we were looking for; exit the do loop. exit @@ -1807,29 +1807,29 @@ contains call get_node_value(node_tal, "estimator", temp_str) select case(trim(temp_str)) case ('analog') - t % estimator = ESTIMATOR_ANALOG + call t % set_estimator(ESTIMATOR_ANALOG) case ('tracklength', 'track-length', 'pathlength', 'path-length') ! If the estimator was set to an analog estimator, this means the ! tally needs post-collision information - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then call fatal_error("Cannot use track-length estimator for tally " & // to_str(t % id)) end if ! Set estimator to track-length estimator - t % estimator = ESTIMATOR_TRACKLENGTH + call t % set_estimator(ESTIMATOR_TRACKLENGTH) case ('collision') ! If the estimator was set to an analog estimator, this means the ! tally needs post-collision information - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then call fatal_error("Cannot use collision estimator for tally " & // to_str(t % id)) end if ! Set estimator to collision estimator - t % estimator = ESTIMATOR_COLLISION + call t % set_estimator(ESTIMATOR_COLLISION) case default call fatal_error("Invalid estimator '" // trim(temp_str) & diff --git a/src/state_point.F90 b/src/state_point.F90 index 5dd98b3ea4..4fbc097954 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -254,7 +254,7 @@ contains ! Write the name for this tally call write_dataset(tally_group, "name", tally % name) - select case(tally % estimator) + select case(tally % estimator()) case (ESTIMATOR_ANALOG) call write_dataset(tally_group, "estimator", "analog") case (ESTIMATOR_TRACKLENGTH) diff --git a/src/tallies/tally.F90 b/src/tallies/tally.F90 index 57593cb3a8..8420c02cf2 100644 --- a/src/tallies/tally.F90 +++ b/src/tallies/tally.F90 @@ -125,7 +125,7 @@ contains case (SCORE_FLUX) - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then ! All events score to a flux bin. We actually use a collision ! estimator in place of an analog one since there is no way to count ! 'events' exactly for the flux @@ -150,7 +150,7 @@ contains case (SCORE_TOTAL) - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then ! All events will score to the total reaction rate. We can just ! use the weight of the particle entering the collision as the ! score @@ -172,7 +172,7 @@ contains case (SCORE_INVERSE_VELOCITY) - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then ! All events score to an inverse velocity bin. We actually use a ! collision estimator in place of an analog one since there is no way ! to count 'events' exactly for the inverse velocity @@ -197,7 +197,7 @@ contains case (SCORE_SCATTER) - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then ! Skip any event where the particle didn't scatter if (p % event /= EVENT_SCATTER) cycle SCORE_LOOP ! Since only scattering events make it here, again we can use @@ -239,7 +239,7 @@ contains case (SCORE_ABSORPTION) - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then if (survival_biasing) then ! No absorption events actually occur if survival biasing is on -- ! just use weight absorbed in survival biasing @@ -265,7 +265,7 @@ contains if (material_xs % absorption == ZERO) cycle SCORE_LOOP - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then if (survival_biasing) then ! No fission events occur if survival biasing is on -- need to ! calculate fraction of absorptions that would have resulted in @@ -299,7 +299,7 @@ contains if (material_xs % absorption == ZERO) cycle SCORE_LOOP - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then if (survival_biasing .or. p % fission) then if (t % energyout_filter() > 0) then ! Normally, we only need to make contributions to one scoring @@ -345,7 +345,7 @@ contains if (material_xs % absorption == ZERO) cycle SCORE_LOOP - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then if (survival_biasing .or. p % fission) then if (t % energyout_filter() > 0) then ! Normally, we only need to make contributions to one scoring @@ -413,7 +413,7 @@ contains ! Set the delayedgroup filter index and the number of delayed group bins dg_filter = t % delayedgroup_filter() - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then if (survival_biasing .or. p % fission) then if (t % energyout_filter() > 0) then ! Normally, we only need to make contributions to one scoring @@ -607,7 +607,7 @@ contains ! Set the delayedgroup filter index dg_filter = t % delayedgroup_filter() - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then if (survival_biasing) then ! No fission events occur if survival biasing is on -- need to ! calculate fraction of absorptions that would have resulted in @@ -890,7 +890,7 @@ contains score = ZERO - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then if (survival_biasing) then ! No fission events occur if survival biasing is on -- need to ! calculate fraction of absorptions that would have resulted in @@ -955,7 +955,7 @@ contains score = ONE case (ELASTIC) - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then ! Check if event MT matches if (p % event_MT /= ELASTIC) cycle SCORE_LOOP score = p % last_wgt * flux @@ -991,7 +991,7 @@ contains score = ZERO - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then if (survival_biasing) then ! No fission events occur if survival biasing is on -- need to ! calculate fraction of absorptions that would have resulted in @@ -1063,7 +1063,7 @@ contains end if case (N_2N, N_3N, N_4N, N_GAMMA, N_P, N_A) - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then ! Check if event MT matches if (p % event_MT /= score_bin) cycle SCORE_LOOP score = p % last_wgt * flux @@ -1102,7 +1102,7 @@ contains end if case default - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then ! Any other score is assumed to be a MT number. Thus, we just need ! to check if it matches the MT number of the event if (p % event_MT /= score_bin) cycle SCORE_LOOP @@ -1228,8 +1228,8 @@ contains ! to tally with. ! Set the direction and group to use with get_xs - if (t % estimator == ESTIMATOR_ANALOG .or. & - t % estimator == ESTIMATOR_COLLISION) then + if (t % estimator() == ESTIMATOR_ANALOG .or. & + t % estimator() == ESTIMATOR_COLLISION) then if (survival_biasing) then @@ -1289,7 +1289,7 @@ contains case (SCORE_FLUX) - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then ! All events score to a flux bin. We actually use a collision ! estimator in place of an analog one since there is no way to count ! 'events' exactly for the flux @@ -1310,7 +1310,7 @@ contains case (SCORE_TOTAL) - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then ! All events will score to the total reaction rate. We can just ! use the weight of the particle entering the collision as the ! score @@ -1339,8 +1339,8 @@ contains case (SCORE_INVERSE_VELOCITY) - if (t % estimator == ESTIMATOR_ANALOG .or. & - t % estimator == ESTIMATOR_COLLISION) then + if (t % estimator() == ESTIMATOR_ANALOG .or. & + t % estimator() == ESTIMATOR_COLLISION) then ! All events score to an inverse velocity bin. We actually use a ! collision estimator in place of an analog one since there is no way ! to count 'events' exactly for the inverse velocity @@ -1375,7 +1375,7 @@ contains case (SCORE_SCATTER) - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then ! Skip any event where the particle didn't scatter if (p % event /= EVENT_SCATTER) then cycle SCORE_LOOP @@ -1413,7 +1413,7 @@ contains case (SCORE_NU_SCATTER) - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then ! Skip any event where the particle didn't scatter if (p % event /= EVENT_SCATTER) then cycle SCORE_LOOP @@ -1448,7 +1448,7 @@ contains case (SCORE_ABSORPTION) - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then if (survival_biasing) then ! No absorption events actually occur if survival biasing is on -- ! just use weight absorbed in survival biasing @@ -1477,7 +1477,7 @@ contains case (SCORE_FISSION) - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then if (survival_biasing) then ! No fission events occur if survival biasing is on -- need to ! calculate fraction of absorptions that would have resulted in @@ -1512,7 +1512,7 @@ contains case (SCORE_NU_FISSION) - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then if (survival_biasing .or. p % fission) then if (t % energyout_filter() > 0) then ! Normally, we only need to make contributions to one scoring @@ -1566,7 +1566,7 @@ contains case (SCORE_PROMPT_NU_FISSION) - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then if (survival_biasing .or. p % fission) then if (t % energyout_filter() > 0) then ! Normally, we only need to make contributions to one scoring @@ -1624,7 +1624,7 @@ contains ! Set the delayedgroup filter index and the number of delayed group bins dg_filter = t % delayedgroup_filter() - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then if (survival_biasing .or. p % fission) then if (t % energyout_filter() > 0) then ! Normally, we only need to make contributions to one scoring @@ -1767,7 +1767,7 @@ contains ! Set the delayedgroup filter index and the number of delayed group bins dg_filter = t % delayedgroup_filter() - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then if (survival_biasing) then ! No fission events occur if survival biasing is on -- need to ! calculate fraction of absorptions that would have resulted in @@ -1944,7 +1944,7 @@ contains case (SCORE_KAPPA_FISSION) - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then if (survival_biasing) then ! No fission events occur if survival biasing is on -- need to ! calculate fraction of absorptions that would have resulted in @@ -2078,7 +2078,7 @@ contains if (.not. filter_matches(i_filt) % bins_present) then call filter_matches(i_filt) % bins_clear() call filter_matches(i_filt) % weights_clear() - call filters(i_filt) % obj % get_all_bins(p, t % estimator, & + call filters(i_filt) % obj % get_all_bins(p, t % estimator(), & filter_matches(i_filt)) filter_matches(i_filt) % bins_present = .true. end if @@ -2224,7 +2224,7 @@ contains if (.not. filter_matches(i_filt) % bins_present) then call filter_matches(i_filt) % bins_clear() call filter_matches(i_filt) % weights_clear() - call filters(i_filt) % obj % get_all_bins(p, t % estimator, & + call filters(i_filt) % obj % get_all_bins(p, t % estimator(), & filter_matches(i_filt)) filter_matches(i_filt) % bins_present = .true. end if @@ -2589,7 +2589,7 @@ contains if (.not. filter_matches(i_filt) % bins_present) then call filter_matches(i_filt) % bins_clear() call filter_matches(i_filt) % weights_clear() - call filters(i_filt) % obj % get_all_bins(p, t % estimator, & + call filters(i_filt) % obj % get_all_bins(p, t % estimator(), & filter_matches(i_filt)) filter_matches(i_filt) % bins_present = .true. end if @@ -2746,7 +2746,7 @@ contains if (.not. filter_matches(i_filt) % bins_present) then call filter_matches(i_filt) % bins_clear() call filter_matches(i_filt) % weights_clear() - call filters(i_filt) % obj % get_all_bins(p, t % estimator, & + call filters(i_filt) % obj % get_all_bins(p, t % estimator(), & filter_matches(i_filt)) filter_matches(i_filt) % bins_present = .true. end if @@ -2892,7 +2892,7 @@ contains if (.not. filter_matches(i_filt) % bins_present) then call filter_matches(i_filt) % bins_clear() call filter_matches(i_filt) % weights_clear() - call filters(i_filt) % obj % get_all_bins(p, t % estimator, & + call filters(i_filt) % obj % get_all_bins(p, t % estimator(), & filter_matches(i_filt)) filter_matches(i_filt) % bins_present = .true. end if @@ -3026,7 +3026,7 @@ contains ! (1 / c) * (d_c / d_rho) = 1 / rho case (DIFF_DENSITY) - select case (t % estimator) + select case (t % estimator()) case (ESTIMATOR_ANALOG) @@ -3089,7 +3089,7 @@ contains ! where i is the perturbed nuclide. case (DIFF_NUCLIDE_DENSITY) - select case (t % estimator) + select case (t % estimator()) case (ESTIMATOR_ANALOG) @@ -3226,7 +3226,7 @@ contains ! resonance range and requires multipole data. case (DIFF_TEMPERATURE) - select case (t % estimator) + select case (t % estimator()) case (ESTIMATOR_ANALOG) @@ -3786,7 +3786,9 @@ contains subroutine setup_active_tallies() bind(C) - integer :: i ! loop counter + integer :: i + integer(C_INT) :: err + logical(C_BOOL) :: active call active_tallies % clear() call active_analog_tallies % clear() @@ -3797,17 +3799,18 @@ contains do i = 1, n_tallies associate (t => tallies(i) % obj) - if (t % active) then + err = openmc_tally_get_active(i, active) + if (active) then ! Add tally to active tallies call active_tallies % push_back(i) ! Check what type of tally this is and add it to the appropriate list if (t % type == TALLY_VOLUME) then - if (t % estimator == ESTIMATOR_ANALOG) then + if (t % estimator() == ESTIMATOR_ANALOG) then call active_analog_tallies % push_back(i) - elseif (t % estimator == ESTIMATOR_TRACKLENGTH) then + elseif (t % estimator() == ESTIMATOR_TRACKLENGTH) then call active_tracklength_tallies % push_back(i) - elseif (t % estimator == ESTIMATOR_COLLISION) then + elseif (t % estimator() == ESTIMATOR_COLLISION) then call active_collision_tallies % push_back(i) end if elseif (t % type == TALLY_MESH_SURFACE) then diff --git a/src/tallies/tally.cpp b/src/tallies/tally.cpp index 169e886d6e..cbc7b92f00 100644 --- a/src/tallies/tally.cpp +++ b/src/tallies/tally.cpp @@ -26,6 +26,13 @@ namespace openmc { namespace model { std::vector> tallies; + + std::vector active_analog_tallies; + std::vector active_tracklength_tallies; + std::vector active_meshsurf_tallies; + std::vector active_collision_tallies; + std::vector active_tallies; + std::vector active_surface_tallies; } double global_tally_absorption; @@ -188,6 +195,28 @@ free_memory_tally_c() // C-API functions //============================================================================== +extern "C" int +openmc_tally_get_active(int32_t index, bool* active) +{ + if (index < 1 || index > model::tallies.size()) { + set_errmsg("Index in tallies array is out of bounds."); + return OPENMC_E_OUT_OF_BOUNDS; + } + //TODO: off-by-one + *active = model::tallies[index-1]->active_; +} + +extern "C" int +openmc_tally_set_active(int32_t index, bool active) +{ + if (index < 1 || index > model::tallies.size()) { + set_errmsg("Index in tallies array is out of bounds."); + return OPENMC_E_OUT_OF_BOUNDS; + } + //TODO: off-by-one + model::tallies[index-1]->active_ = active; +} + extern "C" int openmc_tally_get_filters(int32_t index, const int32_t** indices, int* n) { @@ -196,6 +225,7 @@ openmc_tally_get_filters(int32_t index, const int32_t** indices, int* n) return OPENMC_E_OUT_OF_BOUNDS; } + //TODO: off-by-one *indices = model::tallies[index-1]->filters().data(); *n = model::tallies[index-1]->filters().size(); return 0; @@ -236,6 +266,10 @@ extern "C" { model::tallies.push_back(std::make_unique()); } + int tally_get_estimator_c(Tally* tally) {return tally->estimator_;} + + void tally_set_estimator_c(Tally* tally, int e) {tally->estimator_ = e;} + void tally_set_filters_c(Tally* tally, int n, int32_t filter_indices[]) {tally->set_filters(filter_indices, n);} diff --git a/src/tallies/tally_header.F90 b/src/tallies/tally_header.F90 index f4300789e1..aa929e8c44 100644 --- a/src/tallies/tally_header.F90 +++ b/src/tallies/tally_header.F90 @@ -47,7 +47,21 @@ module tally_header integer(C_INT), value, intent(in) :: n integer(C_INT32_T), intent(in) :: filter_indices(n) integer(C_INT) :: err - end function openmc_tally_set_filters + end function + + function openmc_tally_set_active(index, active) result(err) bind(C) + import C_INT32_T, C_BOOL, C_INT + integer(C_INT32_T), value, intent(in) :: index + logical(C_BOOL), value, intent(in) :: active + integer(C_INT) :: err + end function + + function openmc_tally_get_active(index, active) result(err) bind(C) + import C_INT32_T, C_BOOL, C_INT + integer(C_INT32_T), value :: index + logical(C_BOOL), intent(out) :: active + integer(C_INT) :: err + end function end interface !=============================================================================== @@ -64,9 +78,9 @@ module tally_header integer :: id ! user-defined identifier character(len=104) :: name = "" ! user-defined name integer :: type = TALLY_VOLUME ! volume, surface current - integer :: estimator = ESTIMATOR_TRACKLENGTH ! collision, track-length + !integer :: estimator = ESTIMATOR_TRACKLENGTH ! collision, track-length real(8) :: volume ! volume of region - logical :: active = .false. + !logical :: active = .false. logical :: depletion_rx = .false. ! has depletion reactions, e.g. (n,2n) ! Individual nuclides to tally @@ -98,6 +112,8 @@ module tally_header procedure :: allocate_results => tally_allocate_results procedure :: read_results_hdf5 => tally_read_results_hdf5 procedure :: write_results_hdf5 => tally_write_results_hdf5 + procedure :: estimator => tally_get_estimator + procedure :: set_estimator => tally_set_estimator procedure :: n_filters => tally_get_n_filters procedure :: filter => tally_get_filter procedure :: stride => tally_get_stride @@ -282,6 +298,32 @@ contains end subroutine tally_allocate_results + function tally_get_estimator(this) result(e) + class(TallyObject) :: this + integer(C_INT) :: e + interface + function tally_get_estimator_c(tally) result(e) bind(C) + import C_PTR, C_INT + type(C_PTR), value :: tally + integer(C_INT) :: e + end function + end interface + e = tally_get_estimator_c(this % ptr) + end function + + subroutine tally_set_estimator(this, e) + class(TallyObject) :: this + integer(C_INT) :: e + interface + subroutine tally_set_estimator_c(tally, e) bind(C) + import C_PTR, C_INT + type(C_PTR), value :: tally + integer(C_INT), value :: e + end subroutine + end interface + call tally_set_estimator_c(this % ptr, e) + end subroutine + function tally_get_n_filters(this) result(n) class(TallyObject) :: this integer(C_INT) :: n @@ -561,22 +603,6 @@ contains end function openmc_global_tallies - function openmc_tally_get_active(index, active) result(err) bind(C) - ! Return whether a tally is active - integer(C_INT32_T), value :: index - logical(C_BOOL), intent(out) :: active - integer(C_INT) :: err - - if (index >= 1 .and. index <= size(tallies)) then - active = tallies(index) % obj % active - err = 0 - else - err = E_OUT_OF_BOUNDS - call set_errmsg('Index in tallies array is out of bounds.') - end if - end function openmc_tally_get_active - - function openmc_tally_get_estimator(index, estimator) result(err) bind(C) ! Return the type of estimator of a tally integer(C_INT32_T), value :: index @@ -584,7 +610,7 @@ contains integer(C_INT) :: err if (index >= 1 .and. index <= size(tallies)) then - estimator = tallies(index) % obj % estimator + estimator = tallies(index) % obj % estimator() err = 0 else err = E_OUT_OF_BOUNDS @@ -755,11 +781,11 @@ contains if (index >= 1 .and. index <= size(tallies)) then select case (estimator_) case ('analog') - tallies(index) % obj % estimator = ESTIMATOR_ANALOG + call tallies(index) % obj % set_estimator(ESTIMATOR_ANALOG) case ('tracklength') - tallies(index) % obj % estimator = ESTIMATOR_TRACKLENGTH + call tallies(index) % obj % set_estimator(ESTIMATOR_TRACKLENGTH) case ('collision') - tallies(index) % obj % estimator = ESTIMATOR_COLLISION + call tallies(index) % obj % set_estimator(ESTIMATOR_COLLISION) case default err = E_INVALID_ARGUMENT call set_errmsg("Unknown tally estimator: " // trim(estimator_)) @@ -771,27 +797,6 @@ contains end function openmc_tally_set_estimator - function openmc_tally_set_active(index, active) result(err) bind(C) - ! Set the ID of a tally - integer(C_INT32_T), value, intent(in) :: index - logical(C_BOOL), value, intent(in) :: active - integer(C_INT) :: err - - if (index >= 1 .and. index <= n_tallies) then - if (allocated(tallies(index) % obj)) then - tallies(index) % obj % active = active - err = 0 - else - err = E_ALLOCATE - call set_errmsg("Tally type has not been set yet.") - end if - else - err = E_OUT_OF_BOUNDS - call set_errmsg('Index in tallies array is out of bounds.') - end if - end function openmc_tally_set_active - - function openmc_tally_set_id(index, id) result(err) bind(C) ! Set the ID of a tally integer(C_INT32_T), value, intent(in) :: index