mirror of
https://github.com/openmc-dev/openmc.git
synced 2026-07-28 22:26:08 -04:00
Merge pull request #316 from paulromano/case-insensitive
Make nuclide/element names case insensitive in input
This commit is contained in:
Bryan Herman
commit
6f00f155c5
5 changed files with 93 additions and 96 deletions
10
src/ace.F90
10
src/ace.F90
|
|
@ -11,7 +11,7 @@ module ace
|
|||
use material_header, only: Material
|
||||
use output, only: write_message
|
||||
use set_header, only: SetChar
|
||||
use string, only: to_str
|
||||
use string, only: to_str, to_lower
|
||||
|
||||
implicit none
|
||||
|
||||
|
|
@ -68,8 +68,8 @@ contains
|
|||
name = mat % names(j)
|
||||
|
||||
if (.not. already_read % contains(name)) then
|
||||
i_listing = xs_listing_dict % get_key(name)
|
||||
i_nuclide = nuclide_dict % get_key(name)
|
||||
i_listing = xs_listing_dict % get_key(to_lower(name))
|
||||
i_nuclide = nuclide_dict % get_key(to_lower(name))
|
||||
name = xs_listings(i_listing) % name
|
||||
alias = xs_listings(i_listing) % alias
|
||||
|
||||
|
|
@ -116,8 +116,8 @@ contains
|
|||
name = mat % sab_names(k)
|
||||
|
||||
if (.not. already_read % contains(name)) then
|
||||
i_listing = xs_listing_dict % get_key(name)
|
||||
i_sab = sab_dict % get_key(name)
|
||||
i_listing = xs_listing_dict % get_key(to_lower(name))
|
||||
i_sab = sab_dict % get_key(to_lower(name))
|
||||
|
||||
! Read the ACE table into the appropriate entry on the sab_tables
|
||||
! array
|
||||
|
|
|
|||
|
|
@ -62,7 +62,7 @@ contains
|
|||
use error, only: fatal_error, warning
|
||||
use global
|
||||
use output, only: write_message
|
||||
use string, only: lower_case
|
||||
use string, only: to_lower
|
||||
use xml_interface
|
||||
use, intrinsic :: ISO_FORTRAN_ENV
|
||||
|
||||
|
|
@ -151,7 +151,7 @@ contains
|
|||
! Set feedback logical
|
||||
if (check_for_node(doc, "feedback")) then
|
||||
call get_node_value(doc, "feedback", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') &
|
||||
cmfd_feedback = .true.
|
||||
end if
|
||||
|
|
@ -159,7 +159,7 @@ contains
|
|||
! Set downscatter logical
|
||||
if (check_for_node(doc, "downscatter")) then
|
||||
call get_node_value(doc, "downscatter", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') &
|
||||
cmfd_downscatter = .true.
|
||||
end if
|
||||
|
|
@ -171,19 +171,19 @@ contains
|
|||
! Set monitoring
|
||||
if (check_for_node(doc, "snes_monitor")) then
|
||||
call get_node_value(doc, "snes_monitor", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') &
|
||||
cmfd_snes_monitor = .true.
|
||||
end if
|
||||
if (check_for_node(doc, "ksp_monitor")) then
|
||||
call get_node_value(doc, "ksp_monitor", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') &
|
||||
cmfd_ksp_monitor = .true.
|
||||
end if
|
||||
if (check_for_node(doc, "power_monitor")) then
|
||||
call get_node_value(doc, "power_monitor", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') &
|
||||
cmfd_power_monitor = .true.
|
||||
end if
|
||||
|
|
@ -191,7 +191,7 @@ contains
|
|||
! Output logicals
|
||||
if (check_for_node(doc, "write_matrices")) then
|
||||
call get_node_value(doc, "write_matrices", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') &
|
||||
cmfd_write_matrices = .true.
|
||||
end if
|
||||
|
|
@ -199,7 +199,7 @@ contains
|
|||
! Run an adjoint calc
|
||||
if (check_for_node(doc, "run_adjoint")) then
|
||||
call get_node_value(doc, "run_adjoint", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') &
|
||||
cmfd_run_adjoint = .true.
|
||||
end if
|
||||
|
|
@ -211,7 +211,7 @@ contains
|
|||
! Tally during inactive batches
|
||||
if (check_for_node(doc, "inactive")) then
|
||||
call get_node_value(doc, "inactive", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'false' .or. trim(temp_str) == '0') &
|
||||
cmfd_tally_on = .false.
|
||||
end if
|
||||
|
|
@ -249,7 +249,7 @@ contains
|
|||
call get_node_value(doc, "atoli", cmfd_atoli)
|
||||
if (check_for_node(doc, "rtoli")) &
|
||||
call get_node_value(doc, "rtoli", cmfd_rtoli)
|
||||
|
||||
|
||||
! Create tally objects
|
||||
call create_cmfd_tally(doc)
|
||||
|
||||
|
|
@ -419,7 +419,7 @@ contains
|
|||
! Set reset property
|
||||
if (check_for_node(doc, "reset")) then
|
||||
call get_node_value(doc, "reset", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') &
|
||||
t % reset = .true.
|
||||
end if
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ module input_xml
|
|||
use output, only: write_message
|
||||
use plot_header
|
||||
use random_lcg, only: prn
|
||||
use string, only: lower_case, to_str, str_to_int, str_to_real, &
|
||||
use string, only: to_lower, to_str, str_to_int, str_to_real, &
|
||||
starts_with, ends_with
|
||||
use tally_header, only: TallyObject, TallyFilter
|
||||
use tally_initialize, only: add_tallies
|
||||
|
|
@ -290,8 +290,7 @@ contains
|
|||
type = ''
|
||||
if (check_for_node(node_dist, "type")) &
|
||||
call get_node_value(node_dist, "type", type)
|
||||
call lower_case(type)
|
||||
select case (trim(type))
|
||||
select case (to_lower(type))
|
||||
case ('box')
|
||||
external_source % type_space = SRC_SPACE_BOX
|
||||
coeffs_reqd = 6
|
||||
|
|
@ -343,8 +342,7 @@ contains
|
|||
type = ''
|
||||
if (check_for_node(node_dist, "type")) &
|
||||
call get_node_value(node_dist, "type", type)
|
||||
call lower_case(type)
|
||||
select case (trim(type))
|
||||
select case (to_lower(type))
|
||||
case ('isotropic')
|
||||
external_source % type_angle = SRC_ANGLE_ISOTROPIC
|
||||
coeffs_reqd = 0
|
||||
|
|
@ -395,8 +393,7 @@ contains
|
|||
type = ''
|
||||
if (check_for_node(node_dist, "type")) &
|
||||
call get_node_value(node_dist, "type", type)
|
||||
call lower_case(type)
|
||||
select case (trim(type))
|
||||
select case (to_lower(type))
|
||||
case ('monoenergetic')
|
||||
external_source % type_energy = SRC_ENERGY_MONO
|
||||
coeffs_reqd = 1
|
||||
|
|
@ -446,7 +443,7 @@ contains
|
|||
! Survival biasing
|
||||
if (check_for_node(doc, "survival_biasing")) then
|
||||
call get_node_value(doc, "survival_biasing", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') &
|
||||
survival_biasing = .true.
|
||||
end if
|
||||
|
|
@ -454,7 +451,7 @@ contains
|
|||
! Probability tables
|
||||
if (check_for_node(doc, "ptables")) then
|
||||
call get_node_value(doc, "ptables", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'false' .or. trim(temp_str) == '0') &
|
||||
urr_ptables_on = .false.
|
||||
end if
|
||||
|
|
@ -685,19 +682,19 @@ contains
|
|||
! Check if the user has specified to write binary source file
|
||||
if (check_for_node(node_sp, "separate")) then
|
||||
call get_node_value(node_sp, "separate", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. &
|
||||
trim(temp_str) == '1') source_separate = .true.
|
||||
end if
|
||||
if (check_for_node(node_sp, "write")) then
|
||||
call get_node_value(node_sp, "write", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'false' .or. &
|
||||
trim(temp_str) == '0') source_write = .false.
|
||||
end if
|
||||
if (check_for_node(node_sp, "overwrite_latest")) then
|
||||
call get_node_value(node_sp, "overwrite_latest", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. &
|
||||
trim(temp_str) == '1') then
|
||||
source_latest = .true.
|
||||
|
|
@ -732,7 +729,7 @@ contains
|
|||
! batch
|
||||
if (check_for_node(doc, "no_reduce")) then
|
||||
call get_node_value(doc, "no_reduce", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') &
|
||||
reduce_tallies = .false.
|
||||
end if
|
||||
|
|
@ -741,7 +738,7 @@ contains
|
|||
! uncertainties rather than standard deviations
|
||||
if (check_for_node(doc, "confidence_intervals")) then
|
||||
call get_node_value(doc, "confidence_intervals", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. &
|
||||
trim(temp_str) == '1') confidence_intervals = .true.
|
||||
end if
|
||||
|
|
@ -755,7 +752,7 @@ contains
|
|||
! Check for summary option
|
||||
if (check_for_node(node_output, "summary")) then
|
||||
call get_node_value(node_output, "summary", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. &
|
||||
trim(temp_str) == '1') output_summary = .true.
|
||||
end if
|
||||
|
|
@ -763,7 +760,7 @@ contains
|
|||
! Check for cross sections option
|
||||
if (check_for_node(node_output, "cross_sections")) then
|
||||
call get_node_value(node_output, "cross_sections", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. &
|
||||
trim(temp_str) == '1') output_xs = .true.
|
||||
end if
|
||||
|
|
@ -771,7 +768,7 @@ contains
|
|||
! Check for ASCII tallies output option
|
||||
if (check_for_node(node_output, "tallies")) then
|
||||
call get_node_value(node_output, "tallies", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'false' .or. &
|
||||
trim(temp_str) == '0') output_tallies = .false.
|
||||
end if
|
||||
|
|
@ -780,7 +777,7 @@ contains
|
|||
! Check for cmfd run
|
||||
if (check_for_node(doc, "run_cmfd")) then
|
||||
call get_node_value(doc, "run_cmfd", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') then
|
||||
cmfd_run = .true.
|
||||
end if
|
||||
|
|
@ -790,7 +787,7 @@ contains
|
|||
if (check_for_node(doc, "resonance_scattering")) then
|
||||
call get_node_ptr(doc, "resonance_scattering", node_res_scat)
|
||||
call get_node_list(node_res_scat, "scatterer", node_scat_list)
|
||||
|
||||
|
||||
! check that a nuclide is specified
|
||||
if (get_list_size(node_scat_list) >= 1) then
|
||||
treat_res_scat = .true.
|
||||
|
|
@ -800,7 +797,7 @@ contains
|
|||
allocate(nuclides_0K(n_res_scatterers_total))
|
||||
do i = 1, n_res_scatterers_total
|
||||
call get_list_item(node_scat_list, i, node_scatterer)
|
||||
|
||||
|
||||
! check to make sure a nuclide is specified
|
||||
if (.not. check_for_node(node_scatterer, "nuclide")) then
|
||||
message = "No nuclide specified for scatterer " // trim(to_str(i)) &
|
||||
|
|
@ -809,12 +806,12 @@ contains
|
|||
end if
|
||||
call get_node_value(node_scatterer, "nuclide", &
|
||||
nuclides_0K(i) % nuclide)
|
||||
|
||||
|
||||
if (check_for_node(node_scatterer, "method")) then
|
||||
call get_node_value(node_scatterer, "method", &
|
||||
nuclides_0K(i) % scheme)
|
||||
end if
|
||||
|
||||
|
||||
! check to make sure xs name for which method is applied is given
|
||||
if (.not. check_for_node(node_scatterer, "xs_label")) then
|
||||
message = "Must specify the temperature dependent name of " // '' &
|
||||
|
|
@ -823,7 +820,7 @@ contains
|
|||
end if
|
||||
call get_node_value(node_scatterer, "xs_label", &
|
||||
nuclides_0K(i) % name)
|
||||
|
||||
|
||||
! check to make sure 0K xs name for which method is applied is given
|
||||
if (.not. check_for_node(node_scatterer, "xs_label_0K")) then
|
||||
message = "Must specify the 0K name of " // '' &
|
||||
|
|
@ -832,7 +829,7 @@ contains
|
|||
end if
|
||||
call get_node_value(node_scatterer, "xs_label_0K", &
|
||||
nuclides_0K(i) % name_0K)
|
||||
|
||||
|
||||
if (check_for_node(node_scatterer, "E_min")) then
|
||||
call get_node_value(node_scatterer, "E_min", &
|
||||
nuclides_0K(i) % E_min)
|
||||
|
|
@ -848,7 +845,7 @@ contains
|
|||
call get_node_value(node_scatterer, "E_max", &
|
||||
nuclides_0K(i) % E_max)
|
||||
end if
|
||||
|
||||
|
||||
! check that E_max is not less than E_min
|
||||
if (nuclides_0K(i) % E_max < nuclides_0K(i) % E_min) then
|
||||
message = "Lower resonance scattering energy bound exceeds upper"
|
||||
|
|
@ -856,8 +853,7 @@ contains
|
|||
end if
|
||||
|
||||
nuclides_0K(i) % nuclide = trim(nuclides_0K(i) % nuclide)
|
||||
nuclides_0K(i) % scheme = trim(nuclides_0K(i) % scheme)
|
||||
call lower_case(nuclides_0K(i) % scheme)
|
||||
nuclides_0K(i) % scheme = to_lower(trim(nuclides_0K(i) % scheme))
|
||||
nuclides_0K(i) % name = trim(nuclides_0K(i) % name)
|
||||
nuclides_0K(i) % name_0K = trim(nuclides_0K(i) % name_0K)
|
||||
end do
|
||||
|
|
@ -871,8 +867,7 @@ contains
|
|||
! Natural element expansion option
|
||||
if (check_for_node(doc, "natural_elements")) then
|
||||
call get_node_value(doc, "natural_elements", temp_str)
|
||||
call lower_case(temp_str)
|
||||
select case (temp_str)
|
||||
select case (to_lower(temp_str))
|
||||
case ('endf/b-vii.0')
|
||||
default_expand = ENDF_BVII0
|
||||
case ('endf/b-vii.1')
|
||||
|
|
@ -1005,8 +1000,7 @@ contains
|
|||
word = ''
|
||||
if (check_for_node(node_cell, "material")) &
|
||||
call get_node_value(node_cell, "material", word)
|
||||
call lower_case(word)
|
||||
select case(word)
|
||||
select case(to_lower(word))
|
||||
case ('void')
|
||||
c % material = MATERIAL_VOID
|
||||
|
||||
|
|
@ -1175,8 +1169,7 @@ contains
|
|||
word = ''
|
||||
if (check_for_node(node_surf, "type")) &
|
||||
call get_node_value(node_surf, "type", word)
|
||||
call lower_case(word)
|
||||
select case(trim(word))
|
||||
select case(to_lower(word))
|
||||
case ('x-plane')
|
||||
s % type = SURF_PX
|
||||
coeffs_reqd = 1
|
||||
|
|
@ -1237,8 +1230,7 @@ contains
|
|||
word = ''
|
||||
if (check_for_node(node_surf, "boundary")) &
|
||||
call get_node_value(node_surf, "boundary", word)
|
||||
call lower_case(word)
|
||||
select case (trim(word))
|
||||
select case (to_lower(word))
|
||||
case ('transmission', 'transmit', '')
|
||||
s % bc = BC_TRANSMIT
|
||||
case ('vacuum')
|
||||
|
|
@ -1300,8 +1292,7 @@ contains
|
|||
word = ''
|
||||
if (check_for_node(node_lat, "type")) &
|
||||
call get_node_value(node_lat, "type", word)
|
||||
call lower_case(word)
|
||||
select case (trim(word))
|
||||
select case (to_lower(word))
|
||||
case ('rect', 'rectangle', 'rectangular')
|
||||
lat % type = LATTICE_RECT
|
||||
case ('hex', 'hexagon', 'hexagonal')
|
||||
|
|
@ -1532,8 +1523,7 @@ contains
|
|||
end if
|
||||
|
||||
! Adjust material density based on specified units
|
||||
call lower_case(units)
|
||||
select case(trim(units))
|
||||
select case(to_lower(units))
|
||||
case ('g/cc', 'g/cm3')
|
||||
mat % density = -val
|
||||
case ('kg/m3')
|
||||
|
|
@ -1688,7 +1678,7 @@ contains
|
|||
ALL_NUCLIDES: do j = 1, mat % n_nuclides
|
||||
! Check that this nuclide is listed in the cross_sections.xml file
|
||||
name = trim(list_names % get_item(j))
|
||||
if (.not. xs_listing_dict % has_key(name)) then
|
||||
if (.not. xs_listing_dict % has_key(to_lower(name))) then
|
||||
message = "Could not find nuclide " // trim(name) // &
|
||||
" in cross_sections.xml file!"
|
||||
call fatal_error()
|
||||
|
|
@ -1703,20 +1693,20 @@ contains
|
|||
end if
|
||||
|
||||
! Find xs_listing and set the name/alias according to the listing
|
||||
index_list = xs_listing_dict % get_key(name)
|
||||
index_list = xs_listing_dict % get_key(to_lower(name))
|
||||
name = xs_listings(index_list) % name
|
||||
alias = xs_listings(index_list) % alias
|
||||
|
||||
! If this nuclide hasn't been encountered yet, we need to add its name
|
||||
! and alias to the nuclide_dict
|
||||
if (.not. nuclide_dict % has_key(name)) then
|
||||
if (.not. nuclide_dict % has_key(to_lower(name))) then
|
||||
index_nuclide = index_nuclide + 1
|
||||
mat % nuclide(j) = index_nuclide
|
||||
|
||||
call nuclide_dict % add_key(name, index_nuclide)
|
||||
call nuclide_dict % add_key(alias, index_nuclide)
|
||||
call nuclide_dict % add_key(to_lower(name), index_nuclide)
|
||||
call nuclide_dict % add_key(to_lower(alias), index_nuclide)
|
||||
else
|
||||
mat % nuclide(j) = nuclide_dict % get_key(name)
|
||||
mat % nuclide(j) = nuclide_dict % get_key(to_lower(name))
|
||||
end if
|
||||
|
||||
! Copy name and atom/weight percent
|
||||
|
|
@ -1775,7 +1765,7 @@ contains
|
|||
mat % sab_names(j) = name
|
||||
|
||||
! Check that this nuclide is listed in the cross_sections.xml file
|
||||
if (.not. xs_listing_dict % has_key(name)) then
|
||||
if (.not. xs_listing_dict % has_key(to_lower(name))) then
|
||||
message = "Could not find S(a,b) table " // trim(name) // &
|
||||
" in cross_sections.xml file!"
|
||||
call fatal_error()
|
||||
|
|
@ -1783,17 +1773,17 @@ contains
|
|||
|
||||
! Find index in xs_listing and set the name and alias according to the
|
||||
! listing
|
||||
index_list = xs_listing_dict % get_key(name)
|
||||
index_list = xs_listing_dict % get_key(to_lower(name))
|
||||
name = xs_listings(index_list) % name
|
||||
|
||||
! If this S(a,b) table hasn't been encountered yet, we need to add its
|
||||
! name and alias to the sab_dict
|
||||
if (.not. sab_dict % has_key(name)) then
|
||||
if (.not. sab_dict % has_key(to_lower(name))) then
|
||||
index_sab = index_sab + 1
|
||||
mat % i_sab_tables(j) = index_sab
|
||||
call sab_dict % add_key(name, index_sab)
|
||||
call sab_dict % add_key(to_lower(name), index_sab)
|
||||
else
|
||||
mat % i_sab_tables(j) = sab_dict % get_key(name)
|
||||
mat % i_sab_tables(j) = sab_dict % get_key(to_lower(name))
|
||||
end if
|
||||
end do
|
||||
end if
|
||||
|
|
@ -1904,7 +1894,7 @@ contains
|
|||
! Check for <assume_separate> setting
|
||||
if (check_for_node(doc, "assume_separate")) then
|
||||
call get_node_value(doc, "assume_separate", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
if (trim(temp_str) == 'true' .or. trim(temp_str) == '1') &
|
||||
assume_separate = .true.
|
||||
end if
|
||||
|
|
@ -1937,8 +1927,7 @@ contains
|
|||
temp_str = ''
|
||||
if (check_for_node(node_mesh, "type")) &
|
||||
call get_node_value(node_mesh, "type", temp_str)
|
||||
call lower_case(temp_str)
|
||||
select case (trim(temp_str))
|
||||
select case (to_lower(temp_str))
|
||||
case ('rect', 'rectangle', 'rectangular')
|
||||
m % type = LATTICE_RECT
|
||||
case ('hex', 'hexagon', 'hexagonal')
|
||||
|
|
@ -2118,7 +2107,7 @@ contains
|
|||
temp_str = ''
|
||||
if (check_for_node(node_filt, "type")) &
|
||||
call get_node_value(node_filt, "type", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
|
||||
! Determine number of bins
|
||||
if (check_for_node(node_filt, "bins")) then
|
||||
|
|
@ -2346,14 +2335,14 @@ contains
|
|||
end if
|
||||
|
||||
! Check to make sure nuclide specified is in problem
|
||||
if (.not. nuclide_dict % has_key(word)) then
|
||||
if (.not. nuclide_dict % has_key(to_lower(word))) then
|
||||
message = "The nuclide " // trim(word) // " from tally " // &
|
||||
trim(to_str(t % id)) // " is not present in any material."
|
||||
call fatal_error()
|
||||
end if
|
||||
|
||||
! Set bin to index in nuclides array
|
||||
t % nuclide_bins(j) = nuclide_dict % get_key(word)
|
||||
t % nuclide_bins(j) = nuclide_dict % get_key(to_lower(word))
|
||||
end do
|
||||
|
||||
! Set number of nuclide bins
|
||||
|
|
@ -2384,7 +2373,7 @@ contains
|
|||
! (i.e., scatter-p#, flux-y#)
|
||||
n_new = 0
|
||||
do j = 1, n_words
|
||||
call lower_case(sarray(j))
|
||||
sarray(j) = to_lower(sarray(j))
|
||||
! Find if scores(j) is of the form 'moment-p' or 'moment-y' present in
|
||||
! MOMENT_STRS(:)
|
||||
! If so, check the order, store if OK, then reset the number to 'n'
|
||||
|
|
@ -2826,7 +2815,7 @@ contains
|
|||
temp_str = 'slice'
|
||||
if (check_for_node(node_plot, "type")) &
|
||||
call get_node_value(node_plot, "type", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
select case (trim(temp_str))
|
||||
case ("slice")
|
||||
pl % type = PLOT_TYPE_SLICE
|
||||
|
|
@ -2893,7 +2882,7 @@ contains
|
|||
temp_str = 'xy'
|
||||
if (check_for_node(node_plot, "basis")) &
|
||||
call get_node_value(node_plot, "basis", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
select case (trim(temp_str))
|
||||
case ("xy")
|
||||
pl % basis = PLOT_BASIS_XY
|
||||
|
|
@ -2940,7 +2929,7 @@ contains
|
|||
temp_str = "cell"
|
||||
if (check_for_node(node_plot, "color")) &
|
||||
call get_node_value(node_plot, "color", temp_str)
|
||||
call lower_case(temp_str)
|
||||
temp_str = to_lower(temp_str)
|
||||
select case (trim(temp_str))
|
||||
case ("cell")
|
||||
|
||||
|
|
@ -3263,9 +3252,9 @@ contains
|
|||
end if
|
||||
|
||||
! create dictionary entry for both name and alias
|
||||
call xs_listing_dict % add_key(listing % name, i)
|
||||
call xs_listing_dict % add_key(to_lower(listing % name), i)
|
||||
if (check_for_node(node_ace, "alias")) then
|
||||
call xs_listing_dict % add_key(listing % alias, i)
|
||||
call xs_listing_dict % add_key(to_lower(listing % alias), i)
|
||||
end if
|
||||
end do
|
||||
|
||||
|
|
@ -3303,9 +3292,8 @@ contains
|
|||
character(2) :: element_name
|
||||
|
||||
element_name = name(1:2)
|
||||
call lower_case(element_name)
|
||||
|
||||
select case (element_name)
|
||||
select case (to_lower(element_name))
|
||||
case ('h')
|
||||
call list_names % append('1001.' // xs)
|
||||
call list_density % append(density * 0.999885_8)
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ module output
|
|||
use mesh, only: mesh_indices_to_bin, bin_to_mesh_indices
|
||||
use particle_header, only: LocalCoord, Particle
|
||||
use plot_header
|
||||
use string, only: upper_case, to_str
|
||||
use string, only: to_upper, to_str
|
||||
use tally_header, only: TallyObject
|
||||
|
||||
implicit none
|
||||
|
|
@ -130,8 +130,7 @@ contains
|
|||
if (mod(len_trim(msg),2) == 0) m = m + 1
|
||||
|
||||
! convert line to upper case
|
||||
line = msg
|
||||
call upper_case(line)
|
||||
line = to_upper(msg)
|
||||
|
||||
! print header based on level
|
||||
select case (header_level)
|
||||
|
|
|
|||
|
|
@ -152,37 +152,47 @@ contains
|
|||
! LOWER_CASE converts a string to all lower case characters
|
||||
!===============================================================================
|
||||
|
||||
elemental subroutine lower_case(word)
|
||||
elemental function to_lower(word) result(word_lower)
|
||||
|
||||
character(*), intent(inout) :: word
|
||||
character(*), intent(in) :: word
|
||||
character(len=len(word)) :: word_lower
|
||||
|
||||
integer :: i
|
||||
integer :: ic
|
||||
|
||||
do i = 1, len(word)
|
||||
ic = ichar(word(i:i))
|
||||
if (ic >= 65 .and. ic <= 90) word(i:i) = char(ic+32)
|
||||
if (ic >= 65 .and. ic <= 90) then
|
||||
word_lower(i:i) = char(ic+32)
|
||||
else
|
||||
word_lower(i:i) = word(i:i)
|
||||
end if
|
||||
end do
|
||||
|
||||
end subroutine lower_case
|
||||
end function to_lower
|
||||
|
||||
!===============================================================================
|
||||
! UPPER_CASE converts a string to all upper case characters
|
||||
!===============================================================================
|
||||
|
||||
elemental subroutine upper_case(word)
|
||||
elemental function to_upper(word) result(word_upper)
|
||||
|
||||
character(*), intent(inout) :: word
|
||||
character(*), intent(in) :: word
|
||||
character(len=len(word)) :: word_upper
|
||||
|
||||
integer :: i
|
||||
integer :: ic
|
||||
|
||||
do i = 1, len(word)
|
||||
ic = ichar(word(i:i))
|
||||
if (ic >= 97 .and. ic <= 122) word(i:i) = char(ic-32)
|
||||
if (ic >= 97 .and. ic <= 122) then
|
||||
word_upper(i:i) = char(ic-32)
|
||||
else
|
||||
word_upper(i:i) = word(i:i)
|
||||
end if
|
||||
end do
|
||||
|
||||
end subroutine upper_case
|
||||
end function to_upper
|
||||
|
||||
!===============================================================================
|
||||
! ZERO_PADDED returns a string of the input integer padded with zeros to the
|
||||
|
|
@ -317,7 +327,7 @@ end function zero_padded
|
|||
! the loop automatically exits when n_digits = 10.
|
||||
n_digits = n_digits + 1
|
||||
end do
|
||||
|
||||
|
||||
end function count_digits
|
||||
|
||||
!===============================================================================
|
||||
|
|
@ -349,21 +359,21 @@ end function zero_padded
|
|||
end function int8_to_str
|
||||
|
||||
!===============================================================================
|
||||
! STR_TO_INT converts a string to an integer.
|
||||
! STR_TO_INT converts a string to an integer.
|
||||
!===============================================================================
|
||||
|
||||
function str_to_int(str) result(num)
|
||||
|
||||
character(*), intent(in) :: str
|
||||
integer(8) :: num
|
||||
|
||||
|
||||
character(5) :: fmt
|
||||
integer :: w
|
||||
integer :: ioError
|
||||
|
||||
! Determine width of string
|
||||
w = len_trim(str)
|
||||
|
||||
|
||||
! Create format specifier for reading string
|
||||
write(UNIT=fmt, FMT='("(I",I2,")")') w
|
||||
|
||||
|
|
@ -404,7 +414,7 @@ end function zero_padded
|
|||
|
||||
integer :: decimal ! number of places after decimal
|
||||
integer :: width ! total field width
|
||||
real(8) :: num2 ! absolute value of number
|
||||
real(8) :: num2 ! absolute value of number
|
||||
character(9) :: fmt ! format specifier for writing number
|
||||
|
||||
! set default field width
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue