diff --git a/openmc/capi/tally.py b/openmc/capi/tally.py index 611f1ce879..f2498ed90b 100644 --- a/openmc/capi/tally.py +++ b/openmc/capi/tally.py @@ -14,6 +14,9 @@ __all__ = ['TallyView', 'tallies'] _dll.openmc_get_tally.argtypes = [c_int32, POINTER(c_int32)] _dll.openmc_get_tally.restype = c_int _dll.openmc_get_tally.errcheck = _error_handler +_dll.openmc_extend_tallies.argtypes = [c_int32, POINTER(c_int32), POINTER(c_int32)] +_dll.openmc_extend_tallies.restype = c_int +_dll.openmc_extend_tallies.errcheck = _error_handler _dll.openmc_tally_get_id.argtypes = [c_int32, POINTER(c_int32)] _dll.openmc_tally_get_id.restype = c_int _dll.openmc_tally_get_id.errcheck = _error_handler diff --git a/src/api.F90 b/src/api.F90 index 50d702b311..04b6cd3910 100644 --- a/src/api.F90 +++ b/src/api.F90 @@ -17,7 +17,9 @@ module openmc_api use particle_header, only: Particle use plot, only: openmc_plot_geometry use random_lcg, only: seed, initialize_prng + use tally_header use simulation, only: openmc_run + use string, only: to_f_string use volume_calc, only: openmc_calculate_volumes implicit none @@ -360,28 +362,6 @@ contains end if end function openmc_get_nuclide -!=============================================================================== -! OPENMC_GET_TALLY returns the index in the tallies array of a tally -! with a given ID -!=============================================================================== - - function openmc_get_tally(id, index) result(err) bind(C) - integer(C_INT32_T), value :: id - integer(C_INT32_T), intent(out) :: index - integer(C_INT) :: err - - if (allocated(tallies)) then - if (tally_dict % has_key(id)) then - index = tally_dict % get_key(id) - err = 0 - else - err = E_TALLY_INVALID_ID - end if - else - err = E_TALLY_NOT_ALLOCATED - end if - end function openmc_get_tally - !=============================================================================== ! OPENMC_HARD_RESET reset tallies and timers as well as the pseudorandom ! generator state @@ -726,148 +706,4 @@ contains end subroutine openmc_reset -!=============================================================================== -! OPENMC_TALLY_GET_ID returns the ID of a tally -!=============================================================================== - - function openmc_tally_get_id(index, id) result(err) bind(C) - integer(C_INT32_T), value :: index - integer(C_INT32_T), intent(out) :: id - integer(C_INT) :: err - - if (index >= 1 .and. index <= size(tallies)) then - id = tallies(index) % id - err = 0 - else - err = E_OUT_OF_BOUNDS - end if - end function openmc_tally_get_id - -!=============================================================================== -! OPENMC_TALLY_NUCLIDES returns the list of nuclides assigned to a tally -!=============================================================================== - - function openmc_tally_get_nuclides(index, nuclides, n) result(err) bind(C) - integer(C_INT32_T), value :: index - type(C_PTR), intent(out) :: nuclides - integer(C_INT), intent(out) :: n - integer(C_INT) :: err - - err = E_UNASSIGNED - if (index >= 1 .and. index <= size(tallies)) then - associate (t => tallies(index)) - if (allocated(t % nuclide_bins)) then - nuclides = C_LOC(t % nuclide_bins(1)) - n = size(t % nuclide_bins) - err = 0 - end if - end associate - else - err = E_OUT_OF_BOUNDS - end if - end function openmc_tally_get_nuclides - -!=============================================================================== -! OPENMC_TALLY_RESULTS returns a pointer to a tally results array along with its -! shape. This allows a user to obtain in-memory tally results from Python -! directly. -!=============================================================================== - - function openmc_tally_results(index, ptr, shape_) result(err) bind(C) - integer(C_INT32_T), intent(in), value :: index - type(C_PTR), intent(out) :: ptr - integer(C_INT), intent(out) :: shape_(3) - integer(C_INT) :: err - - 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 - else - err = E_OUT_OF_BOUNDS - end if - end function openmc_tally_results - -!=============================================================================== -! OPENMC_TALLY_SET_NUCLIDES sets the nuclides in the tally which results should -! be scored for -!=============================================================================== - - function openmc_tally_set_nuclides(index, n, nuclides) result(err) bind(C) - integer(C_INT32_T), value :: index - integer(C_INT), value :: n - type(C_PTR), intent(in) :: nuclides(n) - integer(C_INT) :: err - - integer :: i - character(C_CHAR), pointer :: string(:) - character(len=:, kind=C_CHAR), allocatable :: nuclide_ - - err = E_UNASSIGNED - if (index >= 1 .and. index <= size(tallies)) then - associate (t => tallies(index)) - if (allocated(t % nuclide_bins)) deallocate(t % nuclide_bins) - allocate(t % nuclide_bins(n)) - t % n_nuclide_bins = n - - do i = 1, n - ! Convert C string to Fortran string - call c_f_pointer(nuclides(i), string, [10]) - nuclide_ = to_lower(to_f_string(string)) - - select case (nuclide_) - case ('total') - t % nuclide_bins(i) = -1 - case default - if (nuclide_dict % has_key(nuclide_)) then - t % nuclide_bins(i) = nuclide_dict % get_key(nuclide_) - else - err = E_NUCLIDE_NOT_LOADED - return - end if - end select - end do - - ! Recalculate total number of scoring bins - t % total_score_bins = t % n_score_bins * t % n_nuclide_bins - - ! (Re)allocate results array - if (allocated(t % results)) deallocate(t % results) - allocate(t % results(3, t % total_score_bins, t % total_filter_bins)) - t % results(:,:,:) = ZERO - - err = 0 - end associate - else - err = E_OUT_OF_BOUNDS - end if - end function openmc_tally_set_nuclides - -!=============================================================================== -! TO_F_STRING takes a null-terminated array of C chars and turns it into a -! deferred-length character string. Yay Fortran 2003! -!=============================================================================== - - function to_f_string(c_string) result(f_string) - character(kind=C_CHAR), intent(in) :: c_string(*) - character(:), allocatable :: f_string - - integer :: i, n - - ! Determine length of original string - n = 0 - do while (c_string(n + 1) /= C_NULL_CHAR) - n = n + 1 - end do - - ! Copy C string character by character - allocate(character(len=n) :: f_string) - do i = 1, n - f_string(i:i) = c_string(i) - end do - end function to_f_string - end module openmc_api diff --git a/src/cmfd_input.F90 b/src/cmfd_input.F90 index 2a9f1da306..e7e2569961 100644 --- a/src/cmfd_input.F90 +++ b/src/cmfd_input.F90 @@ -1,5 +1,7 @@ module cmfd_input + use, intrinsic :: ISO_C_BINDING + use global implicit none @@ -251,10 +253,10 @@ contains use mesh_header, only: RegularMesh use string use tally, only: setup_active_cmfdtallies - use tally_header, only: TallyObject + use tally_header, only: TallyObject, openmc_extend_tallies use tally_filter_header use tally_filter - use tally_initialize, only: add_tallies + use tally_initialize use xml_interface type(XMLNode), intent(in) :: root ! XML root element @@ -264,6 +266,8 @@ contains integer :: n ! size of arrays in mesh specification integer :: ng ! number of energy groups (default 1) integer :: n_filter ! number of filters + integer :: i_start, i_end + integer(C_INT) :: err integer :: i_filt ! index in filters array integer :: iarray3(3) ! temp integer array real(8) :: rarray3(3) ! temp double array @@ -462,7 +466,9 @@ contains end select ! Allocate tallies - call add_tallies("cmfd", n_cmfd_tallies) + i_cmfd_tallies = n_tallies + err = openmc_extend_tallies(n_cmfd_tallies, i_start, i_end) + cmfd_tallies => tallies(i_start:i_end) ! Begin loop around tallies do i = 1, n_cmfd_tallies diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 5927b92635..6a2d6ded3d 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -1,5 +1,7 @@ module input_xml + use, intrinsic :: ISO_C_BINDING + use algorithm, only: find use cmfd_input, only: configure_cmfd use constants @@ -27,10 +29,9 @@ 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 + use tally_header, only: TallyObject, openmc_extend_tallies use tally_filter_header, only: TallyFilterContainer use tally_filter - use tally_initialize, only: add_tallies use xml_interface implicit none @@ -2650,6 +2651,8 @@ contains integer :: n_user_trig ! number of user-specified tally triggers integer :: trig_ind ! index of triggers array for each tally integer :: user_trig_ind ! index of user-specified triggers for each tally + integer :: i_start, i_end + integer(C_INT) :: err real(8) :: threshold ! trigger convergence threshold integer :: n_order ! moment order requested integer :: n_order_pos ! oosition of Scattering order in score name string @@ -2743,9 +2746,11 @@ contains if (master) call warning("No tallies present in tallies.xml file!") end if - ! Allocate tally array + ! Allocate user tallies if (n_user_tallies > 0 .and. run_mode /= MODE_PLOTTING) then - call add_tallies("user", n_user_tallies) + i_user_tallies = n_tallies + err = openmc_extend_tallies(n_user_tallies, i_start, i_end) + user_tallies => tallies(i_start:i_end) end if ! Check for setting diff --git a/src/string.F90 b/src/string.F90 index efb0dd982c..2a69eec982 100644 --- a/src/string.F90 +++ b/src/string.F90 @@ -514,4 +514,28 @@ contains if (inword) n = n + 1 end function word_count +!=============================================================================== +! TO_F_STRING takes a null-terminated array of C chars and turns it into a +! deferred-length character string. Yay Fortran 2003! +!=============================================================================== + + function to_f_string(c_string) result(f_string) + character(kind=C_CHAR), intent(in) :: c_string(*) + character(:), allocatable :: f_string + + integer :: i, n + + ! Determine length of original string + n = 0 + do while (c_string(n + 1) /= C_NULL_CHAR) + n = n + 1 + end do + + ! Copy C string character by character + allocate(character(len=n) :: f_string) + do i = 1, n + f_string(i:i) = c_string(i) + end do + end function to_f_string + end module string diff --git a/src/tallies/tally_header.F90 b/src/tallies/tally_header.F90 index 2f712c5f85..28069affe2 100644 --- a/src/tallies/tally_header.F90 +++ b/src/tallies/tally_header.F90 @@ -4,8 +4,11 @@ module tally_header use hdf5 - use constants, only: NONE, N_FILTER_TYPES + use constants, only: NONE, N_FILTER_TYPES, ZERO + use error use dict_header, only: DictIntInt + use nuclide_header, only: nuclide_dict + use string, only: to_lower, to_f_string use tally_filter_header, only: TallyFilterContainer use trigger_header, only: TriggerObject @@ -103,7 +106,6 @@ module tally_header ! Dictionary that maps user IDs to indices in 'tallies' type(DictIntInt) :: tally_dict - contains subroutine write_results_hdf5(this, group_id) @@ -173,4 +175,168 @@ contains call h5sclose_f(dspace, hdf5_err) end subroutine read_results_hdf5 +!=============================================================================== +! C API FUNCTIONS +!=============================================================================== + + function openmc_extend_tallies(n, index_start, index_end) result(err) bind(C) + ! Extend the tallies array by n elements + integer(C_INT32_T), value, intent(in) :: n + integer(C_INT32_T), intent(out) :: index_start + integer(C_INT32_T), intent(out) :: index_end + integer(C_INT) :: err + + type(TallyObject), allocatable :: temp(:) ! temporary tallies array + + if (n_tallies == 0) then + ! Allocate tallies array + allocate(tallies(n)) + else + ! Allocate tallies array with increased size + allocate(temp(n_tallies + n)) + + ! Copy original tallies to temporary array + temp(1:n_tallies) = tallies + + ! Move allocation from temporary array + call move_alloc(FROM=temp, TO=tallies) + end if + + ! Return indices in tallies array + index_start = n_tallies + 1 + index_end = n_tallies + n + n_tallies = index_end + + err = 0 + end function openmc_extend_tallies + + + function openmc_get_tally(id, index) result(err) bind(C) + ! Returns the index in the tallies array of a tally with a given ID + integer(C_INT32_T), value :: id + integer(C_INT32_T), intent(out) :: index + integer(C_INT) :: err + + if (allocated(tallies)) then + if (tally_dict % has_key(id)) then + index = tally_dict % get_key(id) + err = 0 + else + err = E_TALLY_INVALID_ID + end if + else + err = E_TALLY_NOT_ALLOCATED + end if + end function openmc_get_tally + + + function openmc_tally_get_id(index, id) result(err) bind(C) + ! Return the ID of a tally + integer(C_INT32_T), value :: index + integer(C_INT32_T), intent(out) :: id + integer(C_INT) :: err + + if (index >= 1 .and. index <= size(tallies)) then + id = tallies(index) % id + err = 0 + else + err = E_OUT_OF_BOUNDS + end if + end function openmc_tally_get_id + + + function openmc_tally_get_nuclides(index, nuclides, n) result(err) bind(C) + ! Return the list of nuclides assigned to a tally + integer(C_INT32_T), value :: index + type(C_PTR), intent(out) :: nuclides + integer(C_INT), intent(out) :: n + integer(C_INT) :: err + + err = E_UNASSIGNED + if (index >= 1 .and. index <= size(tallies)) then + associate (t => tallies(index)) + if (allocated(t % nuclide_bins)) then + nuclides = C_LOC(t % nuclide_bins(1)) + n = size(t % nuclide_bins) + err = 0 + end if + end associate + else + err = E_OUT_OF_BOUNDS + end if + end function openmc_tally_get_nuclides + + + function openmc_tally_results(index, ptr, shape_) result(err) bind(C) + ! Returns a pointer to a tally results array along with its shape. This + ! allows a user to obtain in-memory tally results from Python directly. + integer(C_INT32_T), intent(in), value :: index + type(C_PTR), intent(out) :: ptr + integer(C_INT), intent(out) :: shape_(3) + integer(C_INT) :: err + + 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 + else + err = E_OUT_OF_BOUNDS + end if + end function openmc_tally_results + + + function openmc_tally_set_nuclides(index, n, nuclides) result(err) bind(C) + ! Sets the nuclides in the tally which results should be scored for + integer(C_INT32_T), value :: index + integer(C_INT), value :: n + type(C_PTR), intent(in) :: nuclides(n) + integer(C_INT) :: err + + integer :: i + character(C_CHAR), pointer :: string(:) + character(len=:, kind=C_CHAR), allocatable :: nuclide_ + + err = E_UNASSIGNED + if (index >= 1 .and. index <= size(tallies)) then + associate (t => tallies(index)) + if (allocated(t % nuclide_bins)) deallocate(t % nuclide_bins) + allocate(t % nuclide_bins(n)) + t % n_nuclide_bins = n + + do i = 1, n + ! Convert C string to Fortran string + call c_f_pointer(nuclides(i), string, [10]) + nuclide_ = to_lower(to_f_string(string)) + + select case (nuclide_) + case ('total') + t % nuclide_bins(i) = -1 + case default + if (nuclide_dict % has_key(nuclide_)) then + t % nuclide_bins(i) = nuclide_dict % get_key(nuclide_) + else + err = E_NUCLIDE_NOT_LOADED + return + end if + end select + end do + + ! Recalculate total number of scoring bins + t % total_score_bins = t % n_score_bins * t % n_nuclide_bins + + ! (Re)allocate results array + if (allocated(t % results)) deallocate(t % results) + allocate(t % results(3, t % total_score_bins, t % total_filter_bins)) + t % results(:,:,:) = ZERO + + err = 0 + end associate + else + err = E_OUT_OF_BOUNDS + end if + end function openmc_tally_set_nuclides + end module tally_header diff --git a/src/tallies/tally_initialize.F90 b/src/tallies/tally_initialize.F90 index 84ef435345..637476b0cd 100644 --- a/src/tallies/tally_initialize.F90 +++ b/src/tallies/tally_initialize.F90 @@ -7,7 +7,6 @@ module tally_initialize implicit none private public :: configure_tallies - public :: add_tallies contains @@ -69,54 +68,4 @@ contains end subroutine setup_tally_arrays -!=============================================================================== -! ADD_TALLIES extends the tallies array with a new group of tallies and assigns -! pointers to each group. This is called once for user tallies, once for CMFD -! tallies, etc. -!=============================================================================== - - subroutine add_tallies(tally_group, n) - - character(*), intent(in) :: tally_group ! name of tally group - integer, intent(in) :: n ! number of tallies to add - - type(TallyObject), allocatable :: temp(:) ! temporary tallies array - - if (n_tallies == 0) then - ! Allocate tallies array - allocate(tallies(n)) - else - ! Allocate tallies array with increased size - allocate(temp(n_tallies + n)) - - ! Copy original tallies to temporary array - temp(1:n_tallies) = tallies - - ! Move allocation from temporary array - call move_alloc(FROM=temp, TO=tallies) - - end if - - ! Set index for ths tally group - select case(tally_group) - case ("user") - i_user_tallies = n_tallies - case ("cmfd") - i_cmfd_tallies = n_tallies - end select - - ! Set n_tallies - n_tallies = size(tallies) - - ! Reassign pointers for each group -- after the call to move_alloc, any - ! pointers that were associated with tallies before become unassociated - if (i_user_tallies >= 0) then - user_tallies => tallies(i_user_tallies+1 : i_user_tallies+n_user_tallies) - end if - if (i_cmfd_tallies >= 0) then - cmfd_tallies => tallies(i_cmfd_tallies+1 : i_cmfd_tallies+n_cmfd_tallies) - end if - - end subroutine add_tallies - end module tally_initialize