crp/OpenMC
1
0
Fork 0
mirror of https://github.com/openmc-dev/openmc.git synced 2026-07-27 21:55:41 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions 5

Remove unused Fortran code/data

Browse source
This commit is contained in:
Paul Romano 2019-02-05 23:52:09 -06:00
parent ab0b9eb0bc
commit a99b732592
19 changed files with 8 additions and 650 deletions
Download patch file Download diff file Expand all files Collapse all files

1
CMakeLists.txt
View file

@ -311,7 +311,6 @@ add_library(libopenmc SHARED
src/dict_header.F90
src/eigenvalue.F90
src/endf.F90
src/endf_header.F90
src/error.F90
src/geometry.F90
src/geometry_header.F90

14
include/openmc/output.h
View file

@ -13,65 +13,51 @@ namespace openmc {
//! \brief Display the main title banner as well as information about the
//! program developers, version, and date/time which the problem was run.
void title();
//! Display a header block.
//
//! \param msg The main text of the header
//! \param level The lowest verbosity level at which this header is printed
void header(const char* msg, int level);
//! Retrieve a time stamp.
//
//! \return current time stamp (format: "yyyy-mm-dd hh:mm:ss")
std::string time_stamp();
//! Display the attributes of a particle.
extern "C" void print_particle(Particle* p);
//! Display plot information.
void print_plot();
//! Display information regarding cell overlap checking.
void print_overlap_check();
//! Display information about command line usage of OpenMC
void print_usage();
//! Display current version and copright/license information
void print_version();
//! Display header listing what physical values will displayed
void print_columns();
//! Display information about a generation of neutrons
void print_generation();
//! \brief Display last batch's tallied value of the neutron multiplication
//! factor as well as the average value if we're in active batches
void print_batch_keff();
//! Display time elapsed for various stages of a run
void print_runtime();
//! Display results for global tallies including k-effective estimators
void print_results();
//! Calculate the mean and standard deviation for a tally result
std::pair<double, double> mean_stdev(const double* x, int n);
} // namespace openmc

5
include/openmc/settings.h
View file

@ -25,12 +25,12 @@ namespace settings {
// Boolean flags
extern "C" bool assume_separate; //!< assume tallies are spatially separate?
extern "C" bool check_overlaps; //!< check overlaps in geometry?
extern "C" bool cmfd_run; //!< use CMFD?
extern "C" bool confidence_intervals; //!< use confidence intervals for results?
extern "C" bool create_fission_neutrons; //!< create fission neutrons (fixed source)?
extern "C" bool dagmc; //!< indicator of DAGMC geometry
extern "C" bool entropy_on; //!< calculate Shannon entropy?
extern "C" bool legendre_to_tabular; //!< convert Legendre distributions to tabular?
extern "C" bool output_summary; //!< write summary.h5?
extern bool output_summary; //!< write summary.h5?
extern "C" bool output_tallies; //!< write tallies.out?
extern "C" bool particle_restart_run; //!< particle restart run?
extern "C" bool photon_transport; //!< photon transport turned on?
@ -49,7 +49,6 @@ extern bool ufs_on; //!< uniform fission site method on?
extern bool urr_ptables_on; //!< use unresolved resonance prob. tables?
extern "C" bool write_all_tracks; //!< write track files for every particle?
extern "C" bool write_initial_source; //!< write out initial source file?
extern "C" bool dagmc; //!< indicator of DAGMC geometry
// Paths to various files
extern std::string path_cross_sections; //!< path to cross_sections.xml

134
src/algorithm.F90
View file

@ -5,12 +5,6 @@ module algorithm
implicit none
integer, parameter :: MAX_ITERATION = 64
interface binary_search
module procedure binary_search_real, binary_search_int4, binary_search_int8
end interface binary_search
interface sort
module procedure sort_int, sort_real, sort_vector_int, sort_vector_real
end interface sort
@ -21,134 +15,6 @@ module algorithm
contains
!===============================================================================
! BINARY_SEARCH performs a binary search of an array to find where a specific
! value lies in the array. This is used extensively for energy grid searching
!===============================================================================
pure function binary_search_real(array, n, val) result(array_index)
integer, intent(in) :: n
real(8), intent(in) :: array(n)
real(8), intent(in) :: val
integer :: array_index
integer :: L
integer :: R
integer :: n_iteration
L = 1
R = n
if (val < array(L) .or. val > array(R)) then
array_index = -1
return
end if
n_iteration = 0
do while (R - L > 1)
! Find values at midpoint
array_index = L + (R - L)/2
if (val >= array(array_index)) then
L = array_index
else
R = array_index
end if
! check for large number of iterations
n_iteration = n_iteration + 1
if (n_iteration == MAX_ITERATION) then
array_index = -2
return
end if
end do
array_index = L
end function binary_search_real
pure function binary_search_int4(array, n, val) result(array_index)
integer, intent(in) :: n
integer, intent(in) :: array(n)
integer, intent(in) :: val
integer :: array_index
integer :: L
integer :: R
integer :: n_iteration
L = 1
R = n
if (val < array(L) .or. val > array(R)) then
array_index = -1
return
end if
n_iteration = 0
do while (R - L > 1)
! Find values at midpoint
array_index = L + (R - L)/2
if (val >= array(array_index)) then
L = array_index
else
R = array_index
end if
! check for large number of iterations
n_iteration = n_iteration + 1
if (n_iteration == MAX_ITERATION) then
array_index = -2
return
end if
end do
array_index = L
end function binary_search_int4
pure function binary_search_int8(array, n, val) result(array_index)
integer, intent(in) :: n
integer(8), intent(in) :: array(n)
integer(8), intent(in) :: val
integer :: array_index
integer :: L
integer :: R
integer :: n_iteration
L = 1
R = n
if (val < array(L) .or. val > array(R)) then
array_index = -1
return
end if
n_iteration = 0
do while (R - L > 1)
! Find values at midpoint
array_index = L + (R - L)/2
if (val >= array(array_index)) then
L = array_index
else
R = array_index
end if
! check for large number of iterations
n_iteration = n_iteration + 1
if (n_iteration == MAX_ITERATION) then
array_index = -2
return
end if
end do
array_index = L
end function binary_search_int8
!===============================================================================
! SORT sorts an array in place using an insertion sort.
!===============================================================================

51
src/constants.F90
View file

@ -14,20 +14,9 @@ module constants
integer, parameter :: &
VERSION(3) = [VERSION_MAJOR, VERSION_MINOR, VERSION_RELEASE]
! HDF5 data format
integer, parameter :: HDF5_VERSION(2) = [2, 0]
! WMP data format
integer, parameter :: WMP_VERSION(2) = [1, 1]
! Version numbers for binary files
integer, parameter :: VERSION_STATEPOINT(2) = [17, 0]
integer, parameter :: VERSION_PARTICLE_RESTART(2) = [2, 0]
integer, parameter :: VERSION_TRACK(2) = [2, 0]
integer, parameter :: VERSION_SUMMARY(2) = [6, 0]
integer, parameter :: VERSION_VOLUME(2) = [1, 0]
integer, parameter :: VERSION_VOXEL(2) = [1, 0]
integer, parameter :: VERSION_MGXS_LIBRARY(2) = [1, 0]
! ============================================================================
! ADJUSTABLE PARAMETERS
@ -41,21 +30,14 @@ module constants
! Used for surface current tallies
real(8), parameter :: TINY_BIT = 1e-8_8
! User for precision in geometry
real(C_DOUBLE), bind(C, name='FP_PRECISION') :: FP_PRECISION = 1e-14_8
real(C_DOUBLE), bind(C, name='FP_REL_PRECISION') :: FP_REL_PRECISION = 1e-5_8
real(C_DOUBLE), bind(C, name='FP_COINCIDENT') :: FP_COINCIDENT = 1e-12_8
! Maximum number of collisions/crossings
integer, parameter :: MAX_EVENTS = 1000000
integer, parameter :: MAX_SAMPLE = 100000
! Maximum number of secondary particles created
integer, parameter :: MAX_SECONDARY = 1000
! Maximum number of words in a single line, length of line, and length of
! single word
integer, parameter :: MAX_WORDS = 500
integer, parameter :: MAX_LINE_LEN = 250
integer, parameter :: MAX_WORD_LEN = 150
integer, parameter :: MAX_FILE_LEN = 255
@ -70,9 +52,7 @@ module constants
PI = 3.1415926535898_8, & ! pi
MASS_NEUTRON = 1.00866491588_8, & ! mass of a neutron in amu
MASS_NEUTRON_EV = 939.5654133e6_8, & ! mass of a neutron in eV/c^2
AMU = 1.660539040e-27_8, & ! 1 amu in kg
C_LIGHT = 2.99792458e8_8, & ! speed of light in m/s
N_AVOGADRO = 0.6022140857_8, & ! Avogadro's number in 10^24/mol
K_BOLTZMANN = 8.6173303e-5_8, & ! Boltzmann constant in eV/K
INFINITY = huge(0.0_8), & ! positive infinity
ZERO = 0.0_8, &
@ -112,14 +92,6 @@ module constants
! ============================================================================
! CROSS SECTION RELATED CONSTANTS
! Interpolation flag
integer, parameter :: &
HISTOGRAM = 1, & ! y is constant in x
LINEAR_LINEAR = 2, & ! y is linear in x
LINEAR_LOG = 3, & ! y is linear in ln(x)
LOG_LINEAR = 4, & ! ln(y) is linear in x
LOG_LOG = 5 ! ln(y) is linear in ln(x)
! Particle type
integer, parameter :: &
NEUTRON = 0, &
@ -127,17 +99,6 @@ module constants
ELECTRON = 2, &
POSITRON = 3
! Angular distribution type
integer, parameter :: &
ANGLE_ISOTROPIC = 1, & ! Isotropic angular distribution (CE)
ANGLE_32_EQUI = 2, & ! 32 equiprobable bins (CE)
ANGLE_TABULAR = 3, & ! Tabular angular distribution (CE or MG)
ANGLE_LEGENDRE = 4, & ! Legendre angular distribution (MG)
ANGLE_HISTOGRAM = 5 ! Histogram angular distribution (MG)
! Number of mu bins to use when converting Legendres to tabular type
integer, parameter :: DEFAULT_NMU = 33
! Reaction types
integer, parameter :: &
TOTAL_XS = 1, ELASTIC = 2, N_NONELASTIC = 3, N_LEVEL = 4, MISC = 5, &
@ -173,24 +134,12 @@ module constants
MGXS_ISOTROPIC = 1, & ! Isotropically Weighted Data
MGXS_ANGLE = 2 ! Data by Angular Bins
! Flag to denote this was a macroscopic data object
real(8), parameter :: &
MACROSCOPIC_AWR = -TWO
! Secondary particle emission type
integer, parameter :: &
EMISSION_PROMPT = 1, & ! Prompt emission of secondary particle
EMISSION_DELAYED = 2, & ! Delayed emission of secondary particle
EMISSION_TOTAL = 3 ! Yield represents total emission (prompt + delayed)
! Library types
integer, parameter :: &
LIBRARY_NEUTRON = 1, &
LIBRARY_THERMAL = 2, &
LIBRARY_PHOTON = 3, &
LIBRARY_MULTIGROUP = 4, &
LIBRARY_WMP = 5
! Maximum number of partial fission reactions
integer, parameter :: PARTIAL_FISSION_MAX = 4

191
src/endf_header.F90
View file

@ -1,191 +0,0 @@
module endf_header
use algorithm, only: binary_search
use constants, only: ZERO, HISTOGRAM, LINEAR_LINEAR, LINEAR_LOG, &
LOG_LINEAR, LOG_LOG
use hdf5_interface
implicit none
type, abstract :: Function1D
contains
procedure(function1d_evaluate_), deferred :: evaluate
procedure(function1d_from_hdf5_), deferred :: from_hdf5
end type Function1D
abstract interface
pure function function1d_evaluate_(this, x) result(y)
import Function1D
class(Function1D), intent(in) :: this
real(8), intent(in) :: x
real(8) :: y
end function function1d_evaluate_
subroutine function1d_from_hdf5_(this, dset_id)
import Function1D, HID_T
class(Function1D), intent(inout) :: this
integer(HID_T), intent(in) :: dset_id
end subroutine function1d_from_hdf5_
end interface
!===============================================================================
! POLYNOMIAL represents a one-dimensional function expressed as a polynomial
!===============================================================================
type, extends(Function1D) :: Polynomial
real(8), allocatable :: coef(:) ! coefficients
contains
procedure :: from_hdf5 => polynomial_from_hdf5
procedure :: evaluate => polynomial_evaluate
end type Polynomial
!===============================================================================
! TABULATED1D represents a one-dimensional interpolable function
!===============================================================================
type, extends(Function1D) :: Tabulated1D
integer :: n_regions = 0 ! # of interpolation regions
integer, allocatable :: nbt(:) ! values separating interpolation regions
integer, allocatable :: int(:) ! interpolation scheme
integer :: n_pairs ! # of pairs of (x,y) values
real(8), allocatable :: x(:) ! values of abscissa
real(8), allocatable :: y(:) ! values of ordinate
contains
procedure :: from_hdf5 => tabulated1d_from_hdf5
procedure :: evaluate => tabulated1d_evaluate
end type Tabulated1D
contains
!===============================================================================
! Polynomial implementation
!===============================================================================
subroutine polynomial_from_hdf5(this, dset_id)
class(Polynomial), intent(inout) :: this
integer(HID_T), intent(in) :: dset_id
integer(HSIZE_T) :: dims(1)
call get_shape(dset_id, dims)
allocate(this % coef(dims(1)))
call read_dataset(this % coef, dset_id)
end subroutine polynomial_from_hdf5
pure function polynomial_evaluate(this, x) result(y)
class(Polynomial), intent(in) :: this
real(8), intent(in) :: x
real(8) :: y
integer :: i
! Use Horner's rule to evaluate polynomial. Note that coefficients are
! ordered in increasing powers of x.
y = ZERO
do i = size(this % coef), 1, -1
y = y*x + this % coef(i)
end do
end function polynomial_evaluate
!===============================================================================
! Tabulated1D implementation
!===============================================================================
subroutine tabulated1d_from_hdf5(this, dset_id)
class(Tabulated1D), intent(inout) :: this
integer(HID_T), intent(in) :: dset_id
real(8), allocatable :: xy(:,:)
integer(HSIZE_T) :: dims(2)
call read_attribute(this % nbt, dset_id, 'breakpoints')
call read_attribute(this % int, dset_id, 'interpolation')
this % n_regions = size(this % nbt)
call get_shape(dset_id, dims)
this % n_pairs = int(dims(1), 4)
allocate(this % x(this % n_pairs))
allocate(this % y(this % n_pairs))
allocate(xy(dims(1), dims(2)))
call read_dataset(xy, dset_id)
this % x(:) = xy(:,1)
this % y(:) = xy(:,2)
end subroutine tabulated1d_from_hdf5
pure function tabulated1d_evaluate(this, x) result(y)
class(Tabulated1D), intent(in) :: this
real(8), intent(in) :: x ! x value to find y at
real(8) :: y ! y(x)
integer :: i ! bin in which to interpolate
integer :: j ! index for interpolation region
integer :: n_regions ! number of interpolation regions
integer :: n_pairs ! number of tabulated values
integer :: interp ! ENDF interpolation scheme
real(8) :: r ! interpolation factor
real(8) :: x0, x1 ! bounding x values
real(8) :: y0, y1 ! bounding y values
! determine number of interpolation regions and pairs
n_regions = this % n_regions
n_pairs = this % n_pairs
! find which bin the abscissa is in -- if the abscissa is outside the
! tabulated range, the first or last point is chosen, i.e. no interpolation
! is done outside the energy range
if (x < this % x(1)) then
y = this % y(1)
return
elseif (x > this % x(n_pairs)) then
y = this % y(n_pairs)
return
else
i = binary_search(this % x, n_pairs, x)
end if
! determine interpolation scheme
if (n_regions == 0) then
interp = LINEAR_LINEAR
elseif (n_regions == 1) then
interp = this % int(1)
elseif (n_regions > 1) then
do j = 1, n_regions
if (i < this % nbt(j)) then
interp = this % int(j)
exit
end if
end do
end if
! handle special case of histogram interpolation
if (interp == HISTOGRAM) then
y = this % y(i)
return
end if
! determine bounding values
x0 = this % x(i)
x1 = this % x(i + 1)
y0 = this % y(i)
y1 = this % y(i + 1)
! determine interpolation factor and interpolated value
select case (interp)
case (LINEAR_LINEAR)
r = (x - x0)/(x1 - x0)
y = y0 + r*(y1 - y0)
case (LINEAR_LOG)
r = log(x/x0)/log(x1/x0)
y = y0 + r*(y1 - y0)
case (LOG_LINEAR)
r = (x - x0)/(x1 - x0)
y = y0*exp(r*log(y1/y0))
case (LOG_LOG)
r = log(x/x0)/log(x1/x0)
y = y0*exp(r*log(y1/y0))
end select
end function tabulated1d_evaluate
end module endf_header

4
src/geometry_header.F90
View file

@ -2,12 +2,8 @@ module geometry_header
use, intrinsic :: ISO_C_BINDING
use algorithm, only: find
use constants, only: K_BOLTZMANN, MATERIAL_VOID
use dict_header, only: DictIntInt
use nuclide_header
use stl_vector, only: VectorReal
use string, only: to_lower
implicit none

16
src/initialize.F90
View file

@ -20,14 +20,6 @@ module initialize
import C_PTR
type(C_PTR) :: ptr
end function
function path_statepoint_c() result(ptr) bind(C)
import C_PTR
type(C_PTR) :: ptr
end function
function path_sourcepoint_c() result(ptr) bind(C)
import C_PTR
type(C_PTR) :: ptr
end function
end interface
contains
@ -55,14 +47,6 @@ contains
else
path_input = ''
end if
if (.not. is_null(path_statepoint_c())) then
call c_f_pointer(path_statepoint_c(), string, [255])
path_state_point = to_f_string(string)
end if
if (.not. is_null(path_sourcepoint_c())) then
call c_f_pointer(path_sourcepoint_c(), string, [255])
path_source_point = to_f_string(string)
end if
if (.not. is_null(path_particle_restart_c())) then
call c_f_pointer(path_particle_restart_c(), string, [255])
path_particle_restart = to_f_string(string)

5
src/input_xml.F90
View file

@ -22,9 +22,8 @@ module input_xml
use surface_header
use settings
use stl_vector, only: VectorInt, VectorReal, VectorChar
use string, only: to_lower, to_str, str_to_int, str_to_real, &
starts_with, ends_with, split_string, &
zero_padded, to_c_string
use string, only: to_lower, to_str, str_to_int, &
starts_with, ends_with, to_c_string
use tally
use tally_header, only: openmc_extend_tallies
use tally_derivative_header

47
src/math.F90
View file

@ -5,9 +5,6 @@ module math
implicit none
private
public :: t_percentile
public :: calc_pn
public :: calc_rn
public :: rotate_angle
interface
@ -18,50 +15,6 @@ module math
integer(C_INT), value, intent(in) :: df
real(C_DOUBLE) :: t
end function t_percentile
pure subroutine calc_pn(n, x, pnx) bind(C, name='calc_pn_c')
use ISO_C_BINDING
implicit none
integer(C_INT), value, intent(in) :: n
real(C_DOUBLE), value, intent(in) :: x
real(C_DOUBLE), intent(out) :: pnx(n + 1)
end subroutine calc_pn
pure subroutine calc_rn(n, uvw, rn) bind(C, name='calc_rn_c')
use ISO_C_BINDING
implicit none
integer(C_INT), value, intent(in) :: n
real(C_DOUBLE), intent(in) :: uvw(3)
real(C_DOUBLE), intent(out) :: rn(2 * n + 1)
end subroutine calc_rn
subroutine rotate_angle_c_intfc(uvw, mu, phi) bind(C, name='rotate_angle_c')
use ISO_C_BINDING
implicit none
real(C_DOUBLE), intent(inout) :: uvw(3)
real(C_DOUBLE), value, intent(in) :: mu
real(C_DOUBLE), optional, intent(in) :: phi
end subroutine rotate_angle_c_intfc
end interface
contains
!===============================================================================
! ROTATE_ANGLE rotates direction cosines through a polar angle whose cosine is
! mu and through an azimuthal angle sampled uniformly. Note that this is done
! with direct sampling rather than rejection as is done in MCNP and SERPENT.
!===============================================================================
function rotate_angle(uvw0, mu, phi) result(uvw)
real(C_DOUBLE), intent(in) :: uvw0(3) ! directional cosine
real(C_DOUBLE), intent(in) :: mu ! cosine of angle in lab or CM
real(C_DOUBLE), intent(in), optional :: phi ! azimuthal angle
real(C_DOUBLE) :: uvw(3) ! rotated directional cosine
uvw = uvw0
call rotate_angle_c_intfc(uvw, mu, phi)
end function rotate_angle
end module math

3
src/nuclide_header.F90
View file

@ -3,10 +3,9 @@ module nuclide_header
use, intrinsic :: ISO_FORTRAN_ENV
use, intrinsic :: ISO_C_BINDING
use algorithm, only: sort, find, binary_search
use algorithm, only: sort, find
use constants
use endf, only: is_fission, is_disappearance
use endf_header, only: Function1D, Polynomial, Tabulated1D
use error
use hdf5_interface
use message_passing

1
src/output.F90
View file

@ -22,7 +22,6 @@ module output
use tally_filter
use tally_filter_mesh, only: MeshFilter
use tally_filter_header, only: TallyFilterMatch
use timer_header
implicit none

25
src/random_lcg.F90
View file

@ -11,41 +11,16 @@ module random_lcg
real(C_DOUBLE) :: pseudo_rn
end function prn
function future_prn(n) result(pseudo_rn) bind(C)
use ISO_C_BINDING
implicit none
integer(C_INT64_T), value :: n
real(C_DOUBLE) :: pseudo_rn
end function future_prn
subroutine set_particle_seed(id) bind(C)
use ISO_C_BINDING
implicit none
integer(C_INT64_T), value :: id
end subroutine set_particle_seed
subroutine advance_prn_seed(n) bind(C)
use ISO_C_BINDING
implicit none
integer(C_INT64_T), value :: n
end subroutine advance_prn_seed
subroutine prn_set_stream(n) bind(C)
use ISO_C_BINDING
implicit none
integer(C_INT), value :: n
end subroutine prn_set_stream
function openmc_get_seed() result(seed) bind(C)
use ISO_C_BINDING
implicit none
integer(C_INT64_T) :: seed
end function openmc_get_seed
subroutine openmc_set_seed(new_seed) bind(C)
use ISO_C_BINDING
implicit none
integer(C_INT64_T), value :: new_seed
end subroutine openmc_set_seed
end interface
end module random_lcg

5
src/settings.F90
View file

@ -88,14 +88,9 @@ module settings
character(MAX_FILE_LEN) :: path_input ! Path to input file
character(MAX_FILE_LEN) :: path_cross_sections = '' ! Path to cross_sections.xml
character(MAX_FILE_LEN) :: path_state_point ! Path to binary state point
character(MAX_FILE_LEN) :: path_source_point ! Path to binary source point
character(MAX_FILE_LEN) :: path_particle_restart ! Path to particle restart
character(MAX_FILE_LEN) :: path_output = '' ! Path to output directory
! Various output options
logical(C_BOOL), bind(C) :: output_summary
! No reduction at end of batch
logical(C_BOOL), bind(C) :: reduce_tallies

3
src/settings.cpp
View file

@ -38,9 +38,9 @@ namespace settings {
// Default values for boolean flags
bool assume_separate {false};
bool check_overlaps {false};
bool cmfd_run {false};
bool confidence_intervals {false};
bool create_fission_neutrons {true};
bool dagmc {false};
bool entropy_on {false};
bool legendre_to_tabular {true};
bool output_summary {true};
@ -62,7 +62,6 @@ bool ufs_on {false};
bool urr_ptables_on {true};
bool write_all_tracks {false};
bool write_initial_source {false};
bool dagmc {false};
std::string path_cross_sections;
std::string path_input;

3
src/state_point.F90
View file

@ -22,11 +22,10 @@ module state_point
use nuclide_header, only: nuclides
use settings
use simulation_header
use string, only: to_str, zero_padded
use string, only: to_str
use tally_header
use tally_filter_header
use tally_derivative_header, only: tally_derivs
use timer_header
implicit none

94
src/string.F90
View file

@ -2,7 +2,7 @@ module string
use, intrinsic :: ISO_C_BINDING
use constants, only: MAX_WORDS, MAX_LINE_LEN, ERROR_INT, ERROR_REAL
use constants, only: ERROR_INT, ERROR_REAL
use error, only: fatal_error, warning
use stl_vector, only: VectorInt
@ -14,81 +14,6 @@ module string
contains
!===============================================================================
! SPLIT_STRING takes a sentence and splits it into separate words much like the
! Python string.split() method.
!
! Arguments:
! string = input line
! words = array of words
! n = total number of words
!===============================================================================
subroutine split_string(string, words, n)
character(*), intent(in) :: string
character(*), intent(out) :: words(MAX_WORDS)
integer, intent(out) :: n
character(1) :: chr ! current character
integer :: i ! current index
integer :: i_start ! starting index of word
integer :: i_end ! ending index of word
i_start = 0
i_end = 0
n = 0
do i = 1, len_trim(string)
chr = string(i:i)
! Note that ACHAR(9) is a horizontal tab
if ((i_start == 0) .and. (chr /= ' ') .and. (chr /= achar(9))) then
i_start = i
end if
if (i_start > 0) then
if ((chr == ' ') .or. (chr == achar(9))) i_end = i - 1
if (i == len_trim(string)) i_end = i
if (i_end > 0) then
n = n + 1
if (i_end - i_start + 1 > len(words(n))) then
call warning("The word '" // string(i_start:i_end) &
// "' is longer than the space allocated for it.")
end if
words(n) = string(i_start:i_end)
! reset indices
i_start = 0
i_end = 0
end if
end if
end do
end subroutine split_string
!===============================================================================
! CONCATENATE takes an array of words and concatenates them together in one
! string with a single space between words
!
! Arguments:
! words = array of words
! n_words = total number of words
! string = concatenated string
!===============================================================================
pure function concatenate(words, n_words) result(string)
integer, intent(in) :: n_words
character(*), intent(in) :: words(n_words)
character(MAX_LINE_LEN) :: string
integer :: i ! index
string = words(1)
if (n_words == 1) return
do i = 2, n_words
string = trim(string) // ' ' // words(i)
end do
end function concatenate
!===============================================================================
! TO_LOWER converts a string to all lower case characters
!===============================================================================
@ -300,23 +225,6 @@ contains
end function str_to_int
!===============================================================================
! STR_TO_REAL converts an arbitrary string to a real(8)
!===============================================================================
pure function str_to_real(string) result(num)
character(*), intent(in) :: string
real(8) :: num
integer :: ioError
! Read string
read(UNIT=string, FMT=*, IOSTAT=ioError) num
if (ioError > 0) num = ERROR_REAL
end function str_to_real
!===============================================================================
! REAL_TO_STR converts a real(8) to a string based on how large the value is and
! how many significant digits are desired. By default, six significants digits

2
src/tallies/tally.F90
View file

@ -2,14 +2,12 @@ module tally
use, intrinsic :: ISO_C_BINDING
use algorithm, only: binary_search
use bank_header
use constants
use dict_header, only: EMPTY
use error, only: fatal_error
use geometry_header
use material_header
use math, only: t_percentile
use message_passing
use mgxs_interface
use nuclide_header

54
src/timer_header.F90
View file

@ -4,57 +4,6 @@ module timer_header
use constants, only: ZERO
implicit none
interface
function time_active_elapsed() result(t) bind(C)
import C_DOUBLE
real(C_DOUBLE) :: t
end function
function time_bank_elapsed() result(t) bind(C)
import C_DOUBLE
real(C_DOUBLE) :: t
end function
function time_bank_sample_elapsed() result(t) bind(C)
import C_DOUBLE
real(C_DOUBLE) :: t
end function
function time_bank_sendrecv_elapsed() result(t) bind(C)
import C_DOUBLE
real(C_DOUBLE) :: t
end function
function time_finalize_elapsed() result(t) bind(C)
import C_DOUBLE
real(C_DOUBLE) :: t
end function
function time_inactive_elapsed() result(t) bind(C)
import C_DOUBLE
real(C_DOUBLE) :: t
end function
function time_initialize_elapsed() result(t) bind(C)
import C_DOUBLE
real(C_DOUBLE) :: t
end function
function time_read_xs_elapsed() result(t) bind(C)
import C_DOUBLE
real(C_DOUBLE) :: t
end function
function time_tallies_elapsed() result(t) bind(C)
import C_DOUBLE
real(C_DOUBLE) :: t
end function
function time_total_elapsed() result(t) bind(C)
import C_DOUBLE
real(C_DOUBLE) :: t
end function
function time_transport_elapsed() result(t) bind(C)
import C_DOUBLE
real(C_DOUBLE) :: t
end function
subroutine reset_timers() bind(C)
end subroutine
end interface
!===============================================================================
! TIMER represents a timer that can be started and stopped to measure how long
! different routines run. The intrinsic routine system_clock is used to measure
@ -73,9 +22,6 @@ module timer_header
procedure :: reset => timer_reset
end type Timer
! ============================================================================
! TIMING VARIABLES
contains
!===============================================================================