diff --git a/src/api.F90 b/src/api.F90 index 359e67e546..77b259fa4e 100644 --- a/src/api.F90 +++ b/src/api.F90 @@ -67,6 +67,7 @@ module openmc_api public :: openmc_tally_set_filters public :: openmc_tally_set_nuclides public :: openmc_tally_set_scores + public :: openmc_tally_set_type contains @@ -672,11 +673,13 @@ contains if (allocated(tallies)) then do i = 1, size(tallies) - tallies(i) % active = .false. - tallies(i) % n_realizations = 0 - if (allocated(tallies(i) % results)) then - tallies(i) % results(:, :, :) = ZERO - end if + associate (t => tallies(i) % obj) + t % active = .false. + t % n_realizations = 0 + if (allocated(t % results)) then + t % results(:, :, :) = ZERO + end if + end associate end do end if diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index d1db7c509d..3a6e965acc 100644 --- a/src/cmfd_data.F90 +++ b/src/cmfd_data.F90 @@ -58,7 +58,6 @@ contains use error, only: fatal_error use mesh_header, only: RegularMesh, meshes use string, only: to_str - use tally_header, only: TallyObject use tally_filter_header, only: filters, filter_matches integer :: nx ! number of mesh cells in x direction @@ -82,7 +81,6 @@ contains integer :: stride_surf ! stride for surface filter logical :: energy_filters! energy filters present real(8) :: flux ! temp variable for flux - type(TallyObject), pointer :: t ! pointer for tally object type(RegularMesh), pointer :: m ! pointer for mesh object ! Extract spatial and energy indices from object @@ -96,8 +94,10 @@ contains cmfd % openmc_src = ZERO ! Associate tallies and mesh - t => cmfd_tallies(1) - i_filt = t % filter(t % find_filter(FILTER_MESH)) + associate (t => cmfd_tallies(1) % obj) + i_filt = t % filter(t % find_filter(FILTER_MESH)) + end associate + select type(filt => filters(i_filt) % obj) type is (MeshFilter) m => meshes(filt % mesh) @@ -114,7 +114,7 @@ contains TAL: do ital = 1, size(cmfd_tallies) ! Associate tallies and mesh - t => cmfd_tallies(ital) + associate (t => cmfd_tallies(ital) % obj) i_filt = t % filter(t % find_filter(FILTER_MESH)) select type(filt => filters(i_filt) % obj) type is (MeshFilter) @@ -316,13 +316,13 @@ contains end do ZLOOP + end associate end do TAL ! Normalize openmc source distribution cmfd % openmc_src = cmfd % openmc_src/sum(cmfd % openmc_src)*cmfd%norm ! Nullify all pointers - if (associated(t)) nullify(t) if (associated(m)) nullify(m) end subroutine compute_xs diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index 2edc8b08f3..803ae82479 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -366,8 +366,8 @@ contains ! Reset CMFD tallies do i = 1, size(cmfd_tallies) - cmfd_tallies(i) % n_realizations = 0 - cmfd_tallies(i) % results(:,:,:) = ZERO + cmfd_tallies(i) % obj % n_realizations = 0 + cmfd_tallies(i) % obj % results(:,:,:) = ZERO end do end subroutine cmfd_tally_reset diff --git a/src/cmfd_header.F90 b/src/cmfd_header.F90 index 1d1056f4de..887edc5599 100644 --- a/src/cmfd_header.F90 +++ b/src/cmfd_header.F90 @@ -3,7 +3,7 @@ module cmfd_header use constants, only: CMFD_NOACCEL, ZERO, ONE use mesh_header, only: RegularMesh use set_header, only: SetInt - use tally_header, only: TallyObject + use tally_header, only: TallyContainer use timer_header, only: Timer implicit none @@ -98,7 +98,7 @@ module cmfd_header type(RegularMesh), public, pointer :: cmfd_mesh => null() ! Pointers for different tallies - type(TallyObject), public, pointer :: cmfd_tallies(:) => null() + type(TallyContainer), public, pointer :: cmfd_tallies(:) => null() ! Timing objects type(Timer), public :: time_cmfd ! timer for whole cmfd calculation diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 769abf1236..e8701fe6db 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -251,7 +251,7 @@ contains use error, only: fatal_error, warning use mesh_header, only: RegularMesh, openmc_extend_meshes use string - use tally_header, only: TallyObject, openmc_extend_tallies + use tally_header, only: openmc_extend_tallies, openmc_tally_set_type use tally_filter_header use tally_filter use xml_interface @@ -271,7 +271,6 @@ contains integer :: iarray3(3) ! temp integer array real(8) :: rarray3(3) ! temp double array real(C_DOUBLE), allocatable :: energies(:) - type(TallyObject), pointer :: t type(RegularMesh), pointer :: m type(XMLNode) :: node_mesh @@ -448,9 +447,11 @@ contains ! Begin loop around tallies do i = 1, size(cmfd_tallies) + ! Allocate tally + err = openmc_tally_set_type(i_start + i - 1, C_CHAR_'generic' // C_NULL_CHAR) ! Point t to tally variable - t => cmfd_tallies(i) + associate (t => cmfd_tallies(i) % obj) ! Set reset property if (check_for_node(root, "reset")) then @@ -584,6 +585,8 @@ contains ! Make CMFD tallies active from the start t % active = .true. + + end associate end do end subroutine create_cmfd_tally diff --git a/src/initialize.F90 b/src/initialize.F90 index 42db8c7774..387343577f 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -695,8 +695,8 @@ contains ! We need distribcell if any tallies have distribcell filters. do i = 1, n_tallies - do j = 1, size(tallies(i) % filter) - select type(filt => filters(tallies(i) % filter(j)) % obj) + do j = 1, size(tallies(i) % obj % filter) + select type(filt => filters(tallies(i) % obj % filter(j)) % obj) type is (DistribcellFilter) distribcell_active = .true. end select @@ -722,8 +722,8 @@ contains ! Set the number of bins in all distribcell filters. do i = 1, n_tallies - do j = 1, size(tallies(i) % filter) - select type(filt => filters(tallies(i) % filter(j)) % obj) + do j = 1, size(tallies(i) % obj % filter) + select type(filt => filters(tallies(i) % obj % filter(j)) % obj) type is (DistribcellFilter) ! Set the number of bins to the number of instances of the cell. filt % n_bins = cells(filt % cell) % instances @@ -787,8 +787,8 @@ contains ! List all cells referenced in distribcell filters. do i = 1, n_tallies - do j = 1, size(tallies(i) % filter) - select type(filt => filters(tallies(i) % filter(j)) % obj) + do j = 1, size(tallies(i) % obj % filter) + select type(filt => filters(tallies(i) % obj % filter(j)) % obj) type is (DistribcellFilter) call cell_list % add(filt % cell) end select diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 15ee43f1b9..84e05aa7fb 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -30,7 +30,7 @@ module input_xml use string, only: to_lower, to_str, str_to_int, str_to_real, & starts_with, ends_with, tokenize, split_string, & zero_padded - use tally_header, only: TallyObject, openmc_extend_tallies + use tally_header, only: openmc_extend_tallies, openmc_tally_set_type use tally_filter_header, only: TallyFilterContainer use tally_filter use xml_interface @@ -2674,7 +2674,6 @@ contains character(MAX_WORD_LEN), allocatable :: sarray(:) type(DictCharInt) :: trigger_scores type(ElemKeyValueCI), pointer :: pair_list - type(TallyObject), pointer :: t type(TallyFilterContainer), pointer :: f type(RegularMesh), pointer :: m type(XMLDocument) :: doc @@ -3333,8 +3332,12 @@ contains end if READ_TALLIES: do i = 1, n + ! Allocate tally + err = openmc_tally_set_type(i_start + i - 1, & + C_CHAR_'generic' // C_NULL_CHAR) + ! Get pointer to tally - t => tallies(i_start + i - 1) + associate (t => tallies(i_start + i - 1) % obj) ! Get pointer to tally xml node node_tal = node_tal_list(i) @@ -4288,6 +4291,7 @@ contains ! Add tally to dictionary call tally_dict % add_key(t % id, i) + end associate end do READ_TALLIES ! Close XML document diff --git a/src/output.F90 b/src/output.F90 index ec47070efa..215942bfe6 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -730,8 +730,7 @@ contains character(36) :: score_names(N_SCORE_TYPES) ! names of scoring function character(36) :: score_name ! names of scoring function ! to be applied at write-time - type(TallyObject), pointer :: t - type(TallyfilterMatch), allocatable :: matches(:) + type(TallyFilterMatch), allocatable :: matches(:) ! Skip if there are no tallies if (n_tallies == 0) return @@ -779,7 +778,7 @@ contains end if TALLY_LOOP: do i = 1, n_tallies - t => tallies(i) + associate (t => tallies(i) % obj) nr = t % n_realizations if (confidence_intervals) then @@ -980,6 +979,7 @@ contains end do print_bin + end associate end do TALLY_LOOP close(UNIT=unit_tally) diff --git a/src/simulation.F90 b/src/simulation.F90 index 8e977bbdc3..9c8fb67bbc 100644 --- a/src/simulation.F90 +++ b/src/simulation.F90 @@ -175,7 +175,7 @@ contains call time_active % start() do i = 1, n_tallies - tallies(i) % active = .true. + tallies(i) % obj % active = .true. end do end if @@ -426,8 +426,8 @@ contains ! Broadcast tally results so that each process has access to results if (allocated(tallies)) then do i = 1, size(tallies) - n = size(tallies(i) % results) - call MPI_BCAST(tallies(i) % results, n, MPI_DOUBLE, 0, & + n = size(tallies(i) % obj % results) + call MPI_BCAST(tallies(i) % obj % results, n, MPI_DOUBLE, 0, & mpi_intracomm, mpi_err) end do end if diff --git a/src/state_point.F90 b/src/state_point.F90 index ea6104bce5..29356beef0 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -26,7 +26,6 @@ module state_point use output, only: write_message, time_stamp use random_lcg, only: seed use string, only: to_str, count_digits, zero_padded - use tally_header, only: TallyObject implicit none @@ -51,7 +50,6 @@ contains real(C_DOUBLE) :: k_combined(2) character(MAX_WORD_LEN), allocatable :: str_array(:) character(MAX_FILE_LEN) :: filename - type(TallyObject), pointer :: tally ! Set filename for state point filename = trim(path_output) // 'statepoint.' // & @@ -227,7 +225,7 @@ contains ! Write array of tally IDs allocate(id_array(n_tallies)) do i = 1, n_tallies - id_array(i) = tallies(i) % id + id_array(i) = tallies(i) % obj % id end do call write_attribute(tallies_group, "ids", id_array) deallocate(id_array) @@ -236,7 +234,7 @@ contains TALLY_METADATA: do i = 1, n_tallies ! Get pointer to tally - tally => tallies(i) + associate (tally => tallies(i) % obj) tally_group = create_group(tallies_group, "tally " // & trim(to_str(tally % id))) @@ -341,6 +339,7 @@ contains deallocate(str_array) call close_group(tally_group) + end associate end do TALLY_METADATA end if @@ -372,14 +371,13 @@ contains ! Write all tally results TALLY_RESULTS: do i = 1, n_tallies - ! Set point to current tally - tally => tallies(i) - - ! Write sum and sum_sq for each bin - tally_group = open_group(tallies_group, "tally " & - // to_str(tally % id)) - call tally % write_results_hdf5(tally_group) - call close_group(tally_group) + associate (tally => tallies(i) % obj) + ! Write sum and sum_sq for each bin + tally_group = open_group(tallies_group, "tally " & + // to_str(tally % id)) + call tally % write_results_hdf5(tally_group) + call close_group(tally_group) + end associate end do TALLY_RESULTS call close_group(tallies_group) @@ -552,7 +550,7 @@ contains ! Write all tally results TALLY_RESULTS: do i = 1, n_tallies - associate (t => tallies(i)) + associate (t => tallies(i) % obj) ! Determine size of tally results array m = size(t % results, 2) n = size(t % results, 3) @@ -761,7 +759,7 @@ contains tallies_group = open_group(file_id, "tallies") TALLY_RESULTS: do i = 1, n_tallies - associate (t => tallies(i)) + associate (t => tallies(i) % obj) ! Read sum, sum_sq, and N for each bin tally_group = open_group(tallies_group, "tally " // & trim(to_str(t % id))) diff --git a/src/tallies/tally.F90 b/src/tallies/tally.F90 index fd8ae6d3c9..c97ff01e1b 100644 --- a/src/tallies/tally.F90 +++ b/src/tallies/tally.F90 @@ -2158,22 +2158,18 @@ contains ! the user requests all. !=============================================================================== - subroutine score_all_nuclides(p, i_tally, flux, filter_index) + subroutine score_all_nuclides(p, t, flux, filter_index) type(Particle), intent(in) :: p - integer, intent(in) :: i_tally + type(TallyObject), intent(inout) :: t real(8), intent(in) :: flux integer, intent(in) :: filter_index integer :: i ! loop index for nuclides in material integer :: i_nuclide ! index in nuclides array real(8) :: atom_density ! atom density of single nuclide in atom/b-cm - type(TallyObject), pointer :: t type(Material), pointer :: mat - ! Get pointer to tally - t => tallies(i_tally) - ! Get pointer to current material. We need this in order to determine what ! nuclides are in the material mat => materials(p % material) @@ -2225,7 +2221,6 @@ contains integer :: i_nuclide ! index in nuclides array real(8) :: filter_weight ! combined weight of all filters logical :: finished ! found all valid bin combinations - type(TallyObject), pointer :: t ! A loop over all tallies is necessary because we need to simultaneously ! determine different filter bins for the same tally in order to score to it @@ -2233,7 +2228,7 @@ contains TALLY_LOOP: do i = 1, active_analog_tallies % size() ! Get index of tally and pointer to tally i_tally = active_analog_tallies % data(i) - t => tallies(i_tally) + associate (t => tallies(i_tally) % obj) ! Find all valid bins in each filter if they have not already been found ! for a previous tally. @@ -2349,6 +2344,7 @@ contains if (assume_separate) exit TALLY_LOOP + end associate end do TALLY_LOOP ! Reset filter matches flag @@ -2370,7 +2366,6 @@ contains real(8) :: filter_weight ! combined weight of all filters real(8) :: atom_density logical :: finished ! found all valid bin combinations - type(TallyObject), pointer :: t type(Material), pointer :: mat ! A loop over all tallies is necessary because we need to simultaneously @@ -2379,7 +2374,7 @@ contains TALLY_LOOP: do i = 1, active_analog_tallies % size() ! Get index of tally and pointer to tally i_tally = active_analog_tallies % data(i) - t => tallies(i_tally) + associate (t => tallies(i_tally) % obj) ! Get pointer to current material. We need this in order to determine what ! nuclides are in the material @@ -2487,6 +2482,7 @@ contains if (assume_separate) exit TALLY_LOOP + end associate end do TALLY_LOOP ! Reset filter matches flag @@ -2746,7 +2742,6 @@ contains real(8) :: atom_density ! atom density of single nuclide in atom/b-cm real(8) :: filter_weight ! combined weight of all filters logical :: finished ! found all valid bin combinations - type(TallyObject), pointer :: t type(Material), pointer :: mat ! Determine track-length estimate of flux @@ -2758,7 +2753,7 @@ contains TALLY_LOOP: do i = 1, active_tracklength_tallies % size() ! Get index of tally and pointer to tally i_tally = active_tracklength_tallies % data(i) - t => tallies(i_tally) + associate (t => tallies(i_tally) % obj) ! Find all valid bins in each filter if they have not already been found ! for a previous tally. @@ -2803,8 +2798,7 @@ contains if (t % all_nuclides) then if (p % material /= MATERIAL_VOID) then - call score_all_nuclides(p, i_tally, flux * filter_weight, & - filter_index) + call score_all_nuclides(p, t, flux * filter_weight, filter_index) end if else @@ -2875,6 +2869,7 @@ contains if (assume_separate) exit TALLY_LOOP + end associate end do TALLY_LOOP ! Reset filter matches flag @@ -2907,7 +2902,6 @@ contains ! in atom/b-cm real(8) :: filter_weight ! combined weight of all filters logical :: finished ! found all valid bin combinations - type(TallyObject), pointer :: t type(Material), pointer :: mat ! Determine collision estimate of flux @@ -2924,7 +2918,7 @@ contains TALLY_LOOP: do i = 1, active_collision_tallies % size() ! Get index of tally and pointer to tally i_tally = active_collision_tallies % data(i) - t => tallies(i_tally) + associate (t => tallies(i_tally) % obj) ! Find all valid bins in each filter if they have not already been found ! for a previous tally. @@ -2969,8 +2963,7 @@ contains if (t % all_nuclides) then if (p % material /= MATERIAL_VOID) then - call score_all_nuclides(p, i_tally, flux * filter_weight, & - filter_index) + call score_all_nuclides(p, t, flux * filter_weight, filter_index) end if else @@ -3041,6 +3034,7 @@ contains if (assume_separate) exit TALLY_LOOP + end associate end do TALLY_LOOP ! Reset filter matches flag @@ -3078,7 +3072,7 @@ contains TALLY_LOOP: do i = 1, active_surface_tallies % size() ! Get index of tally and pointer to tally i_tally = active_surface_tallies % data(i) - associate (t => tallies(i_tally)) + associate (t => tallies(i_tally) % obj) ! Find all valid bins in each filter if they have not already been found ! for a previous tally. @@ -3211,7 +3205,6 @@ contains logical :: end_in_mesh ! particle's ending xyz in mesh? logical :: cross_surface ! whether the particle crosses a surface logical :: energy_filter ! energy filter present - type(TallyObject), pointer :: t type(RegularMesh), pointer :: m TALLY_LOOP: do i = 1, active_current_tallies % size() @@ -3221,7 +3214,7 @@ contains ! Get pointer to tally i_tally = active_current_tallies % data(i) - t => tallies(i_tally) + associate (t => tallies(i_tally) % obj) ! Check for energy filter energy_filter = (t % find_filter(FILTER_ENERGYIN) > 0) @@ -3457,6 +3450,7 @@ contains xyz0 = xyz0 + distance * uvw end do + end associate end do TALLY_LOOP end subroutine score_surface_current @@ -4262,7 +4256,7 @@ contains if (master .or. (.not. reduce_tallies)) then ! Accumulate results for each tally do i = 1, active_tallies % size() - call accumulate_tally(tallies(active_tallies % data(i))) + call accumulate_tally(tallies(active_tallies % data(i)) % obj) end do if (run_mode == MODE_EIGENVALUE) then @@ -4400,25 +4394,27 @@ contains call active_current_tallies % clear() do i = 1, n_tallies - if (tallies(i) % active) then - ! Add tally to active tallies - call active_tallies % push_back(i) + associate (t => tallies(i) % obj) + if (t % 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 (tallies(i) % type == TALLY_VOLUME) then - if (tallies(i) % estimator == ESTIMATOR_ANALOG) then - call active_analog_tallies % push_back(i) - elseif (tallies(i) % estimator == ESTIMATOR_TRACKLENGTH) then - call active_tracklength_tallies % push_back(i) - elseif (tallies(i) % estimator == ESTIMATOR_COLLISION) then - call active_collision_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 + call active_analog_tallies % push_back(i) + elseif (t % estimator == ESTIMATOR_TRACKLENGTH) then + call active_tracklength_tallies % push_back(i) + elseif (t % estimator == ESTIMATOR_COLLISION) then + call active_collision_tallies % push_back(i) + end if + elseif (t % type == TALLY_MESH_CURRENT) then + call active_current_tallies % push_back(i) + elseif (t % type == TALLY_SURFACE) then + call active_surface_tallies % push_back(i) end if - elseif (tallies(i) % type == TALLY_MESH_CURRENT) then - call active_current_tallies % push_back(i) - elseif (tallies(i) % type == TALLY_SURFACE) then - call active_surface_tallies % push_back(i) end if - end if + end associate end do end subroutine setup_active_tallies diff --git a/src/tallies/tally_filter.F90 b/src/tallies/tally_filter.F90 index 2642874a27..d48939f8a6 100644 --- a/src/tallies/tally_filter.F90 +++ b/src/tallies/tally_filter.F90 @@ -1144,6 +1144,7 @@ contains character(:), allocatable :: type_ + ! Convert C string to Fortran string type_ = to_f_string(type) err = 0 diff --git a/src/tallies/tally_header.F90 b/src/tallies/tally_header.F90 index e9654f6094..fcb1660d61 100644 --- a/src/tallies/tally_header.F90 +++ b/src/tallies/tally_header.F90 @@ -25,6 +25,7 @@ module tally_header public :: openmc_tally_set_filters public :: openmc_tally_set_nuclides public :: openmc_tally_set_scores + public :: openmc_tally_set_type !=============================================================================== ! TALLYDERIVATIVE describes a first-order derivative that can be applied to @@ -111,9 +112,13 @@ module tally_header procedure :: allocate_results => tally_allocate_results end type TallyObject + type, public :: TallyContainer + class(TallyObject), allocatable :: obj + end type TallyContainer + integer(C_INT32_T), public, bind(C) :: n_tallies = 0 ! # of tallies - type(TallyObject), public, allocatable, target :: tallies(:) + type(TallyContainer), public, allocatable, target :: tallies(:) type(TallyDerivative), public, allocatable :: tally_derivs(:) !$omp threadprivate(tally_derivs) @@ -254,7 +259,7 @@ contains global_tallies(:,:) = ZERO do i = 1, n_tallies - call tallies(i) % allocate_results() + call tallies(i) % obj % allocate_results() end do end subroutine configure_tallies @@ -270,7 +275,8 @@ contains integer(C_INT32_T), optional, intent(out) :: index_end integer(C_INT) :: err - type(TallyObject), allocatable :: temp(:) ! temporary tallies array + integer :: i + type(TallyContainer), allocatable :: temp(:) ! temporary tallies array if (n_tallies == 0) then ! Allocate tallies array @@ -279,8 +285,10 @@ contains ! Allocate tallies array with increased size allocate(temp(n_tallies + n)) - ! Copy original tallies to temporary array - temp(1:n_tallies) = tallies + ! Move original tallies to temporary array + do i = 1, n_tallies + call move_alloc(tallies(i) % obj, temp(i) % obj) + end do ! Move allocation from temporary array call move_alloc(FROM=temp, TO=tallies) @@ -321,7 +329,7 @@ contains integer(C_INT) :: err if (index >= 1 .and. index <= size(tallies)) then - id = tallies(index) % id + id = tallies(index) % obj % id err = 0 else err = E_OUT_OF_BOUNDS @@ -338,7 +346,7 @@ contains err = E_UNASSIGNED if (index >= 1 .and. index <= size(tallies)) then - associate (t => tallies(index)) + associate (t => tallies(index) % obj) if (allocated(t % filter)) then filter_indices = C_LOC(t % filter(1)) n = size(t % filter) @@ -360,7 +368,7 @@ contains err = E_UNASSIGNED if (index >= 1 .and. index <= size(tallies)) then - associate (t => tallies(index)) + associate (t => tallies(index) % obj) if (allocated(t % nuclide_bins)) then nuclides = C_LOC(t % nuclide_bins(1)) n = size(t % nuclide_bins) @@ -383,11 +391,13 @@ contains err = E_UNASSIGNED if (index >= 1 .and. index <= size(tallies)) then - if (allocated(tallies(index) % results)) then - ptr = C_LOC(tallies(index) % results(1,1,1)) - shape_(:) = shape(tallies(index) % results) - err = 0 - end if + associate (t => tallies(index) % obj) + if (allocated(t % results)) then + ptr = C_LOC(t % results(1,1,1)) + shape_(:) = shape(t % results) + err = 0 + end if + end associate else err = E_OUT_OF_BOUNDS end if @@ -408,7 +418,7 @@ contains err = 0 if (index >= 1 .and. index <= n_tallies) then - associate (t => tallies(index)) + associate (t => tallies(index) % obj) t % find_filter(:) = 0 do i = 1, n @@ -497,7 +507,7 @@ contains err = E_UNASSIGNED if (index >= 1 .and. index <= size(tallies)) then - associate (t => tallies(index)) + associate (t => tallies(index) % obj) if (allocated(t % nuclide_bins)) deallocate(t % nuclide_bins) allocate(t % nuclide_bins(n)) t % n_nuclide_bins = n @@ -542,7 +552,7 @@ contains err = E_UNASSIGNED if (index >= 1 .and. index <= size(tallies)) then - associate (t => tallies(index)) + associate (t => tallies(index) % obj) if (allocated(t % score_bins)) deallocate(t % score_bins) allocate(t % score_bins(n)) t % n_user_score_bins = n @@ -691,4 +701,32 @@ contains end function openmc_tally_set_scores + function openmc_tally_set_type(index, type) result(err) bind(C) + ! Set the type of the tally + integer(C_INT32_T), value, intent(in) :: index + character(kind=C_CHAR), intent(in) :: type(*) + integer(C_INT) :: err + + character(:), allocatable :: type_ + + ! Convert C string to Fortran string + type_ = to_f_string(type) + + err = 0 + if (index >= 1 .and. index <= n_tallies) then + if (allocated(tallies(index) % obj)) then + err = E_ALREADY_ALLOCATED + else + select case (type_) + case ('generic') + allocate(TallyObject :: tallies(index) % obj) + case default + err = E_UNASSIGNED + end select + end if + else + err = E_OUT_OF_BOUNDS + end if + end function openmc_tally_set_type + end module tally_header diff --git a/src/tallies/trigger.F90 b/src/tallies/trigger.F90 index 29c2ecedd6..643e6fae4b 100644 --- a/src/tallies/trigger.F90 +++ b/src/tallies/trigger.F90 @@ -109,8 +109,6 @@ contains real(8) :: rel_err = ZERO ! trigger relative error real(8) :: ratio ! ratio of the uncertainty/trigger threshold real(C_DOUBLE) :: k_combined(2) - type(TallyObject), pointer :: t ! tally pointer - type(TriggerObject), pointer :: trigger ! tally trigger ! Initialize tally trigger maximum uncertainty ratio to zero max_ratio = 0 @@ -151,7 +149,7 @@ contains ! Compute uncertainties for all tallies, scores with triggers TALLY_LOOP: do i = 1, n_tallies - t => tallies(i) + associate (t => tallies(i) % obj) ! Cycle through if only one batch has been simumlate if (t % n_realizations == 1) then @@ -159,7 +157,7 @@ contains end if TRIGGER_LOOP: do s = 1, t % n_triggers - trigger => t % triggers(s) + associate (trigger => t % triggers(s)) ! Initialize trigger uncertainties to zero trigger % std_dev = ZERO @@ -279,7 +277,9 @@ contains if (size(t % filter) == 0) exit FILTER_LOOP end do FILTER_LOOP end if + end associate end do TRIGGER_LOOP + end associate end do TALLY_LOOP end if end subroutine check_tally_triggers @@ -291,6 +291,8 @@ contains !=============================================================================== subroutine compute_tally_current(t, trigger) + type(TallyObject), intent(in) :: t ! mesh current tally + type(TriggerObject), intent(inout) :: trigger ! mesh current tally trigger integer :: i ! mesh index integer :: j ! loop index for tally filters @@ -306,8 +308,6 @@ contains logical :: print_ebin ! should incoming energy bin be displayed? real(8) :: rel_err = ZERO ! temporary relative error of result real(8) :: std_dev = ZERO ! temporary standard deviration of result - type(TallyObject), pointer :: t ! mesh current tally - type(TriggerObject) :: trigger ! mesh current tally trigger type(RegularMesh), pointer :: m ! surface current mesh ! Get pointer to mesh