diff --git a/src/output.F90 b/src/output.F90 index f956c44f2..10ce6614e 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -683,13 +683,13 @@ 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(TallyFilterMatch), allocatable :: matches(:) + integer, allocatable :: filter_bins(:) character(MAX_WORD_LEN) :: temp_name ! Skip if there are no tallies if (n_tallies == 0) return - allocate(matches(n_filters)) + allocate(filter_bins(n_filters)) ! Initialize names for scores score_names(abs(SCORE_FLUX)) = "Flux" @@ -773,8 +773,7 @@ contains ! Initialize bins, filter level, and indentation do h = 1, size(t % filter) - call matches(t % filter(h)) % bins_clear() - call matches(t % filter(h)) % bins_push_back(0) + filter_bins(t % filter(h)) = 0 end do j = 1 indent = 0 @@ -785,18 +784,17 @@ contains if (size(t % filter) == 0) exit find_bin ! Increment bin combination - call matches(t % filter(j)) % bins_set_data(1, & - matches(t % filter(j)) % bins_data(1) + 1) + filter_bins(t % filter(j)) = filter_bins(t % filter(j)) + 1 ! ================================================================= ! REACHED END OF BINS FOR THIS FILTER, MOVE TO NEXT FILTER - if (matches(t % filter(j)) % bins_data(1) > & + if (filter_bins(t % filter(j)) > & filters(t % filter(j)) % obj % n_bins) then ! If this is the first filter, then exit if (j == 1) exit print_bin - call matches(t % filter(j)) % bins_set_data(1, 0) + filter_bins(t % filter(j)) = 0 j = j - 1 indent = indent - 2 @@ -810,7 +808,7 @@ contains ! Print current filter information write(UNIT=unit_tally, FMT='(1X,2A)') repeat(" ", indent), & trim(filters(t % filter(j)) % obj % & - text_label(matches(t % filter(j)) % bins_data(1))) + text_label(filter_bins(t % filter(j)))) indent = indent + 2 j = j + 1 end if @@ -821,7 +819,7 @@ contains if (size(t % filter) > 0) then write(UNIT=unit_tally, FMT='(1X,2A)') repeat(" ", indent), & trim(filters(t % filter(j)) % obj % & - text_label(matches(t % filter(j)) % bins_data(1))) + text_label(filter_bins(t % filter(j)))) end if ! Determine scoring index for this bin combination -- note that unlike @@ -830,8 +828,8 @@ contains filter_index = 1 do h = 1, size(t % filter) - filter_index = filter_index + (max(matches(t % filter(h)) & - % bins_data(1),1) - 1) * t % stride(h) + filter_index = filter_index & + + (max(filter_bins(t % filter(h)) ,1) - 1) * t % stride(h) end do ! Write results for this filter bin combination diff --git a/src/simulation.F90 b/src/simulation.F90 index 9fa2b290d..9be64ed5d 100644 --- a/src/simulation.F90 +++ b/src/simulation.F90 @@ -455,12 +455,6 @@ contains ! Allocate array for microscopic cross section cache allocate(micro_xs(n_nuclides)) allocate(micro_photon_xs(n_elements)) - - ! Allocate array for matching filter bins - allocate(filter_matches(n_filters)) - do i = 1, n_filters - filter_matches(i) % ptr = filter_match_pointer(i - 1) - end do !$omp end parallel ! Reset global variables -- this is done before loading state point (as that @@ -503,6 +497,14 @@ contains call openmc_simulation_init_c() +!$omp parallel + ! Allocate array for matching filter bins + allocate(filter_matches(n_filters)) + do i = 1, n_filters + filter_matches(i) % ptr = filter_match_pointer(i - 1) + end do +!$omp end parallel + ! Set flag indicating initialization is done simulation_initialized = .true. diff --git a/src/tallies/tally_filter.cpp b/src/tallies/tally_filter.cpp index dcd499c10..42589a579 100644 --- a/src/tallies/tally_filter.cpp +++ b/src/tallies/tally_filter.cpp @@ -16,6 +16,38 @@ std::vector filter_matches; extern "C" { TallyFilterMatch* filter_match_pointer(int indx) {return &filter_matches[indx];} + + void + filter_match_bins_push_back(TallyFilterMatch* match, int val) + {match->bins.push_back(val);} + + void + filter_match_weights_push_back(TallyFilterMatch* match, double val) + {match->weights.push_back(val);} + + void + filter_match_bins_clear(TallyFilterMatch* match) + {match->bins.clear();} + + void + filter_match_weights_clear(TallyFilterMatch* match) + {match->weights.clear();} + + int + filter_match_bins_size(TallyFilterMatch* match) + {return match->bins.size();} + + int + filter_match_bins_data(TallyFilterMatch* match, int indx) + {return match->bins.at(indx-1);} + + double + filter_match_weights_data(TallyFilterMatch* match, int indx) + {return match->weights.at(indx-1);} + + void + filter_match_bins_set_data(TallyFilterMatch* match, int indx, int val) + {match->bins.at(indx-1) = val;} } } // namespace openmc diff --git a/src/tallies/tally_filter_header.F90 b/src/tallies/tally_filter_header.F90 index 38de7a5ad..5f37b33ce 100644 --- a/src/tallies/tally_filter_header.F90 +++ b/src/tallies/tally_filter_header.F90 @@ -39,8 +39,6 @@ module tally_filter_header ! Index of the bin and weight being used in the current filter combination integer :: i_bin - type(VectorInt) :: bins_ - type(VectorReal) :: weights_ ! Indicates whether all valid bins for this filter have been found logical :: bins_present = .false. @@ -156,50 +154,107 @@ contains subroutine bins_push_back(this, val) class(TallyFilterMatch), intent(inout) :: this integer, intent(in) :: val - call this % bins_ % push_back(val) + interface + subroutine filter_match_bins_push_back(ptr, val) bind(C) + import C_PTR, C_INT + type(C_PTR), value :: ptr + integer(C_INT), intent(in), value :: val + end subroutine + end interface + call filter_match_bins_push_back(this % ptr, val) end subroutine bins_push_back subroutine weights_push_back(this, val) class(TallyFilterMatch), intent(inout) :: this real(8), intent(in) :: val - call this % weights_ % push_back(val) + interface + subroutine filter_match_weights_push_back(ptr, val) bind(C) + import C_PTR, C_DOUBLE + type(C_PTR), value :: ptr + real(C_DOUBLE), intent(in), value :: val + end subroutine + end interface + call filter_match_weights_push_back(this % ptr, val) end subroutine weights_push_back subroutine bins_clear(this) class(TallyFilterMatch), intent(inout) :: this - call this % bins_ % clear() + interface + subroutine filter_match_bins_clear(ptr) bind(C) + import C_PTR + type(C_PTR), value :: ptr + end subroutine + end interface + call filter_match_bins_clear(this % ptr) end subroutine bins_clear subroutine weights_clear(this) class(TallyFilterMatch), intent(inout) :: this - call this % weights_ % clear() + interface + subroutine filter_match_weights_clear(ptr) bind(C) + import C_PTR + type(C_PTR), value :: ptr + end subroutine + end interface + call filter_match_weights_clear(this % ptr) end subroutine weights_clear function bins_size(this) result(len) class(TallyFilterMatch), intent(inout) :: this integer :: len - len = this % bins_ % size() + interface + function filter_match_bins_size(ptr) bind(C) result(len) + import C_PTR, C_INT + type(C_PTR), value :: ptr + integer(C_INT) :: len + end function + end interface + len = filter_match_bins_size(this % ptr) end function bins_size function bins_data(this, indx) result(val) class(TallyFilterMatch), intent(inout) :: this integer, intent(in) :: indx integer :: val - val = this % bins_ % data(indx) + interface + function filter_match_bins_data(ptr, indx) bind(C) result(val) + import C_PTR, C_INT + type(C_PTR), value :: ptr + integer(C_INT), intent(in), value :: indx + integer(C_INT) :: val + end function + end interface + val = filter_match_bins_data(this % ptr, indx) end function bins_data function weights_data(this, indx) result(val) class(TallyFilterMatch), intent(inout) :: this integer, intent(in) :: indx real(8) :: val - val = this % weights_ % data(indx) + interface + function filter_match_weights_data(ptr, indx) bind(C) result(val) + import C_PTR, C_INT, C_DOUBLE + type(C_PTR), value :: ptr + integer(C_INT), intent(in), value :: indx + real(C_DOUBLE) :: val + end function + end interface + val = filter_match_weights_data(this % ptr, indx) end function weights_data subroutine bins_set_data(this, indx, val) class(TallyFilterMatch), intent(inout) :: this integer, intent(in) :: indx integer, intent(in) :: val - this % bins_ % data(indx) = val + interface + subroutine filter_match_bins_set_data(ptr, indx, val) bind(C) + import C_PTR, C_INT + type(C_PTR), value :: ptr + integer(C_INT), value, intent(in) :: indx + integer(C_INT), value, intent(in) :: val + end subroutine + end interface + call filter_match_bins_set_data(this % ptr, indx, val) end subroutine bins_set_data !===============================================================================