diff --git a/benchmarks/pu-met-fast-001/geometry.xml b/benchmarks/pu-met-fast-001/geometry.xml new file mode 100644 index 0000000000..7d1e489729 --- /dev/null +++ b/benchmarks/pu-met-fast-001/geometry.xml @@ -0,0 +1,25 @@ + + + + + + + 0 + 1 + -1 + + + + sphere + 0. 0. 0. 6.3849 + vacuum + + + diff --git a/benchmarks/pu-met-fast-001/material.xml b/benchmarks/pu-met-fast-001/material.xml new file mode 100644 index 0000000000..4d5fce4cac --- /dev/null +++ b/benchmarks/pu-met-fast-001/material.xml @@ -0,0 +1,21 @@ + + + + + + + + + + + + + + diff --git a/benchmarks/pu-met-fast-001/settings.xml b/benchmarks/pu-met-fast-001/settings.xml new file mode 100644 index 0000000000..d4a1f66577 --- /dev/null +++ b/benchmarks/pu-met-fast-001/settings.xml @@ -0,0 +1,28 @@ + + + + + + + + + 3000 + 20 + 10000 + + + + + + box + -1 -1 -1 1 1 1 + + + diff --git a/benchmarks/pu-met-fast-001_old b/benchmarks/pu-met-fast-001_old deleted file mode 100644 index 6083216ce3..0000000000 --- a/benchmarks/pu-met-fast-001_old +++ /dev/null @@ -1,24 +0,0 @@ -# ==================================================================== -# Description: Bare Pu-239 Jezebel Benchmark -# Case: PU-MET-FAST-001 -# Written By: Paul Romano -# Date: 3/30/2011 -# ==================================================================== - -# cell no. universe material surfaces -cell 1 0 1 -1 - -surface 1 sph 0. 0. 0. 6.3849 -bc 1 vacuum - -source box -1 -1 -1 1 1 1 - -material 1 0.04029014 & - 94239.03c 0.037047 & - 94240.03c 0.0017512 & - 94241.03c 0.00011674 & - 31000.03c 0.0013752 - -xs_data /opt/serpent/xsdata/endfb7 -criticality 3000 20 10000 -verbosity 7 diff --git a/benchmarks/pu-met-fast-002/geometry.xml b/benchmarks/pu-met-fast-002/geometry.xml new file mode 100644 index 0000000000..6c2ceb58a9 --- /dev/null +++ b/benchmarks/pu-met-fast-002/geometry.xml @@ -0,0 +1,25 @@ + + + + + + + 0 + 1 + -1 + + + + sphere + 0. 0. 0. 6.6595 + vacuum + + + diff --git a/benchmarks/pu-met-fast-002/material.xml b/benchmarks/pu-met-fast-002/material.xml new file mode 100644 index 0000000000..779ec1eb44 --- /dev/null +++ b/benchmarks/pu-met-fast-002/material.xml @@ -0,0 +1,22 @@ + + + + + + + + + + + + + + + diff --git a/benchmarks/pu-met-fast-002/settings.xml b/benchmarks/pu-met-fast-002/settings.xml new file mode 100644 index 0000000000..abc537feca --- /dev/null +++ b/benchmarks/pu-met-fast-002/settings.xml @@ -0,0 +1,28 @@ + + + + + + + + + 3000 + 20 + 10000 + + + + + + box + -1 -1 -1 1 1 1 + + + diff --git a/benchmarks/pu-met-fast-002_old b/benchmarks/pu-met-fast-002_old deleted file mode 100644 index 778894e0ba..0000000000 --- a/benchmarks/pu-met-fast-002_old +++ /dev/null @@ -1,25 +0,0 @@ -# ==================================================================== -# Description: Bare Pu-240 Jezebel Benchmark -# Case: PU-MET-FAST-002 -# Written By: Paul Romano -# Date: 3/30/2011 -# ==================================================================== - -# cell no. universe material surfaces -cell 1 0 1 -1 - -surface 1 sph 0. 0. 0. 6.6595 -bc 1 vacuum - -source box -1 -1 -1 1 1 1 - -material 1 0.04055292 & - 94239.03c 0.029934 & - 94240.03c 0.0078754 & - 94241.03c 0.0012146 & - 94242.03c 0.00015672 & - 31000.03c 0.0013722 - -xs_data /opt/serpent/xsdata/endfb7 -criticality 3000 20 10000 -verbosity 7 diff --git a/benchmarks/pu-met-fast-005/geometry.xml b/benchmarks/pu-met-fast-005/geometry.xml new file mode 100644 index 0000000000..2b11068a42 --- /dev/null +++ b/benchmarks/pu-met-fast-005/geometry.xml @@ -0,0 +1,34 @@ + + + + + + + 0 + 1 + -1 + + + 0 + 2 + 1 -2 + + + + sphere + 0. 0. 0. 5.0419 + + + sphere + 0. 0. 0. 9.7409 + vacuum + + + diff --git a/benchmarks/pu-met-fast-005/material.xml b/benchmarks/pu-met-fast-005/material.xml new file mode 100644 index 0000000000..8c18838f1f --- /dev/null +++ b/benchmarks/pu-met-fast-005/material.xml @@ -0,0 +1,28 @@ + + + + + + + + + + + + + + + + + + + + + diff --git a/benchmarks/pu-met-fast-005/settings.xml b/benchmarks/pu-met-fast-005/settings.xml new file mode 100644 index 0000000000..366b0f5422 --- /dev/null +++ b/benchmarks/pu-met-fast-005/settings.xml @@ -0,0 +1,28 @@ + + + + + + + + + 3000 + 20 + 10000 + + + + + + box + -1 -1 -1 1 1 1 + + + diff --git a/benchmarks/pu-met-fast-005_old b/benchmarks/pu-met-fast-005_old deleted file mode 100644 index d0809a3767..0000000000 --- a/benchmarks/pu-met-fast-005_old +++ /dev/null @@ -1,32 +0,0 @@ -# ==================================================================== -# Description: Unmoderated Plutonium Metal Button Array Benchmark -# Case: PU-MET-FAST-005 -# Written By: Paul Romano -# Date: 3/30/2011 -# ==================================================================== - -# cell no. universe material surfaces -cell 1 0 1 -1 -cell 2 0 2 1 -2 - -surface 1 sph 0. 0. 0. 5.0419 -surface 2 sph 0. 0. 0. 9.7409 -bc 2 vacuum - -source box -1 -1 -1 1 1 1 - -material 1 0.04070346 & - 94239.03c 0.037291 & - 94240.03c 0.0019277 & - 94241.03c 0.00012196 & - 31000.03c 0.0013628 - -material 2 0.06605308 & - 74000.03c 0.051468 & - 28000.03c 0.0097124 & - 29000.03c 0.0040774 & - 40000.03c 0.00079528 - -xs_data /opt/serpent/xsdata/endfb7 -criticality 3000 20 10000 -verbosity 7 diff --git a/examples/basic/geometry.xml b/examples/basic/geometry.xml new file mode 100644 index 0000000000..9629cc7918 --- /dev/null +++ b/examples/basic/geometry.xml @@ -0,0 +1,41 @@ + + + + + + 0 + 37 + -2 + + + 37 + 40 + -1 + + + 37 + 41 + 1 + + + 0 + 41 + 2 -3 + + + + + z-cylinder + 0 0 7 + + + z-cylinder + 0 0 9 + + + z-cylinder + 0 0 11 + vacuum + + + diff --git a/examples/basic/material.xml b/examples/basic/material.xml new file mode 100644 index 0000000000..8070d64999 --- /dev/null +++ b/examples/basic/material.xml @@ -0,0 +1,17 @@ + + + + + + + + + + + + + + + + + diff --git a/examples/basic/settings.xml b/examples/basic/settings.xml new file mode 100644 index 0000000000..0f839a026a --- /dev/null +++ b/examples/basic/settings.xml @@ -0,0 +1,23 @@ + + + + + + + + + 15 + 5 + 10000 + + + + + + + + box + -4 -4 -4 4 4 4 + + + diff --git a/examples/basic/tallies.xml b/examples/basic/tallies.xml new file mode 100644 index 0000000000..ff2e3ecacf --- /dev/null +++ b/examples/basic/tallies.xml @@ -0,0 +1,18 @@ + + + + + + + 1 + 0.0 0.625 20.0e6 + + + + 1 2 -4 -8 + + + U-238 + + + diff --git a/examples/lattice/geometry.xml b/examples/lattice/geometry.xml new file mode 100644 index 0000000000..e5b2934595 --- /dev/null +++ b/examples/lattice/geometry.xml @@ -0,0 +1,58 @@ + + + + + 0 + 111 + 1 -2 3 -4 + + + 3 + 40 + -5 + + + 3 + 41 + 5 + + + + rectangular + 20 20 + -10.0 -10.0 + 1.0 1.0 + + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + + + + + + + + + z-cylinder + 0.0 0.0 0.4 + + + diff --git a/examples/lattice/material.xml b/examples/lattice/material.xml new file mode 100644 index 0000000000..8070d64999 --- /dev/null +++ b/examples/lattice/material.xml @@ -0,0 +1,17 @@ + + + + + + + + + + + + + + + + + diff --git a/examples/lattice/settings.xml b/examples/lattice/settings.xml new file mode 100644 index 0000000000..d48b88498b --- /dev/null +++ b/examples/lattice/settings.xml @@ -0,0 +1,23 @@ + + + + + + + + + 20 + 10 + 10000 + + + + + + + + box + -4 -4 -4 4 4 4 + + + diff --git a/src/DEPENDENCIES b/src/DEPENDENCIES index 30361bffa7..50cb4a48bc 100644 --- a/src/DEPENDENCIES +++ b/src/DEPENDENCIES @@ -58,7 +58,7 @@ initialize.o: error.o initialize.o: geometry.o initialize.o: geometry_header.o initialize.o: global.o -initialize.o: input_old.o +initialize.o: input_xml.o initialize.o: logging.o initialize.o: mcnp_random.o initialize.o: mpi_routines.o @@ -67,15 +67,16 @@ initialize.o: source.o initialize.o: string.o initialize.o: timing.o -input_old.o: constants.o -input_old.o: datatypes.o -input_old.o: datatypes_header.o -input_old.o: geometry_header.o -input_old.o: global.o -input_old.o: error.o -input_old.o: fileio.o -input_old.o: output.o -input_old.o: string.o +input_xml.o: constants.o +input_xml.o: datatypes.o +input_xml.o: error.o +input_xml.o: geometry_header.o +input_xml.o: global.o +input_xml.o: string.o +input_xml.o: xml_geometry.o +input_xml.o: xml_material.o +input_xml.o: xml_settings.o +input_xml.o: xml_tallies.o logging.o: constants.o logging.o: global.o diff --git a/src/OBJECTS b/src/OBJECTS index 9ab139b61c..e51045ecbc 100644 --- a/src/OBJECTS +++ b/src/OBJECTS @@ -13,7 +13,7 @@ geometry.o \ geometry_header.o \ global.o \ initialize.o \ -input_old.o \ +input_xml.o \ logging.o \ main.o \ material_header.o \ @@ -28,4 +28,8 @@ source.o \ source_header.o \ string.o \ tally_header.o \ -timing.o +timing.o \ +xml_geometry.o \ +xml_material.o \ +xml_settings.o \ +xml_tallies.o \ No newline at end of file diff --git a/src/constants.f90 b/src/constants.f90 index fb8860ff42..200a4b71e0 100644 --- a/src/constants.f90 +++ b/src/constants.f90 @@ -162,7 +162,7 @@ module constants ! Versioning numbers integer, parameter :: VERSION_MAJOR = 0 integer, parameter :: VERSION_MINOR = 3 - integer, parameter :: VERSION_RELEASE = 0 + integer, parameter :: VERSION_RELEASE = 1 ! Maximum number of words in a single line, length of line, and length of ! single word diff --git a/src/initialize.f90 b/src/initialize.f90 index 88084d0992..fd4185acf8 100644 --- a/src/initialize.f90 +++ b/src/initialize.f90 @@ -10,14 +10,14 @@ module initialize use geometry, only: neighbor_lists use geometry_header, only: Cell, Surface, Universe, Lattice, BASE_UNIVERSE use global - use input_old, only: read_count, read_input, bc_dict + use input_xml, only: read_input_xml, cells_in_univ_dict use logging, only: create_log use mcnp_random, only: RN_init_problem use mpi_routines, only: setup_mpi use output, only: title, echo_input, message, print_summary, & print_particle, header use source, only: init_source - use string, only: int_to_str + use string, only: int_to_str, starts_with, ends_with use timing, only: timer_start, timer_stop contains @@ -57,11 +57,16 @@ contains ! Set default values for settings call set_defaults() + ! set up dictionaries + call create_dictionaries() + ! Read input file -- make a first pass through the file to count ! cells, surfaces, etc in order to allocate arrays, then do a ! second pass to actually read values - call read_count(path_input) - call read_input(path_input) + call read_input_xml() + + ! Set up universe structures + call prepare_universes() ! Use dictionaries to redefine index pointers call adjust_indices() @@ -113,35 +118,120 @@ contains subroutine read_command_line() - integer :: argc ! number of command line arguments - logical :: file_exists ! does specified input file exist? - character(MAX_LINE_LEN) :: msg ! error message - character(7) :: readable ! is input file readable? + integer :: argc ! number of command line arguments + character(MAX_LINE_LEN) :: pwd ! present working directory + + ! Get working directory + call GET_ENVIRONMENT_VARIABLE("PWD", pwd) + ! Check number of command line arguments argc = COMMAND_ARGUMENT_COUNT() + + ! Determine directory where XML input files are if (argc > 0) then call GET_COMMAND_ARGUMENT(1, path_input) + ! Need to add working directory if the given path is a relative + ! path + if (.not. starts_with(path_input, "/")) then + path_input = trim(pwd) // "/" // trim(path_input) + end if else - msg = "No input file specified!" - call fatal_error(msg) + path_input = pwd end if - ! Check if input file exists and is readable - inquire(FILE=path_input, EXIST=file_exists, READ=readable) - if (.not. file_exists) then - msg = "Input file '" // trim(path_input) // "' does not exist!" - call fatal_error(msg) - elseif (readable(1:3) == 'NO') then - ! Need to explicitly check for a NO status -- Intel compiler looks at - ! file attributes only if the file is open on a unit. Therefore, it will - ! always return UNKNOWN - msg = "Input file '" // trim(path_input) // "' is not readable! & - &Change file permissions with chmod command." - call fatal_error(msg) + ! Add slash at end of directory if it isn't there + if (.not. ends_with(path_input, "/")) then + path_input = trim(path_input) // "/" end if + ! TODO: Check that directory exists + end subroutine read_command_line +!=============================================================================== +! CREATE_DICTIONARIES initializes the various dictionary variables. It would be +! nice to avoid this and just have a check at the beginning of +! dictionary_add_key. +!=============================================================================== + + subroutine create_dictionaries() + + ! Create cell dictionary + call dict_create(cell_dict) + call dict_create(universe_dict) + call dict_create(lattice_dict) + call dict_create(surface_dict) + call dict_create(material_dict) + call dict_create(tally_dict) + call dict_create(cells_in_univ_dict) + + end subroutine create_dictionaries + +!=============================================================================== +! PREPARE_UNIVERSES allocates the universes array and determines the cells array +! for each universe. +!=============================================================================== + + subroutine prepare_universes() + + integer :: i ! index in cells array + integer :: index ! index in universes array + integer :: count ! number of cells in a universe + integer, allocatable :: index_cell_in_univ(:) ! the index in the univ%cells + ! array for each universe + type(ListKeyValueII), pointer :: key_list => null() + type(Universe), pointer :: univ => null() + type(Cell), pointer :: c => null() + + allocate(universes(n_universes)) + + ! We also need to allocate the cell count lists for each universe. The logic + ! for this is a little more convoluted. In universe_dict, the (key,value) + ! pairs are the uid of the universe and the index in the array. In + ! ucount_dict, it's the uid of the universe and the number of cells. + + key_list => dict_keys(universe_dict) + do while (associated(key_list)) + ! find index of universe in universes array + index = key_list%data%value + univ => universes(index) + univ % uid = key_list%data%key + + ! check for lowest level universe + if (univ % uid == 0) BASE_UNIVERSE = index + + ! find cell count for this universe + count = dict_get_key(cells_in_univ_dict, key_list%data%key) + + ! allocate cell list for universe + allocate(univ % cells(count)) + univ % n_cells = count + + ! move to next universe + key_list => key_list%next + end do + + ! Also allocate a list for keeping track of where cells have been assigned + ! in each universe + + allocate(index_cell_in_univ(n_universes)) + index_cell_in_univ = 0 + + do i = 1, n_cells + c => cells(i) + + ! get pointer to corresponding universe + index = dict_get_key(universe_dict, c % universe) + univ => universes(index) + + ! increment the index for the cells array within the Universe object and + ! then store the index of the Cell object in that array + index_cell_in_univ(index) = index_cell_in_univ(index) + 1 + univ % cells(index_cell_in_univ(index)) = i + end do + + end subroutine prepare_universes + !=============================================================================== ! ADJUST_INDICES changes the values for 'surfaces' for each cell and the ! material index assigned to each to the indices in the surfaces and material @@ -152,67 +242,91 @@ contains subroutine adjust_indices() - integer :: i ! index in cells array - integer :: j ! index over surface list - integer :: index ! index in surfaces/materials array - integer :: surf_num ! user-specified surface number - integer :: bc ! boundary condition - character(MAX_LINE_LEN) :: msg ! output/error message - type(Cell), pointer :: c => null() - type(Surface), pointer :: surf => null() - type(ListKeyValueII), pointer :: key_list => null() + integer :: i ! index in cells array + integer :: j ! index over surface list + integer :: k + integer :: index ! index in surfaces/materials array + integer :: universe_num ! user-specified universe number + integer :: surf_num ! user-specified surface number + character(MAX_LINE_LEN) :: msg ! output/error message + type(Cell), pointer :: c => null() + type(Lattice), pointer :: l => null() do i = 1, n_cells - ! adjust boundary list + ! ======================================================================= + ! ADJUST SURFACE LIST FOR EACH CELL + c => cells(i) - do j = 1, c%n_surfaces - surf_num = c%surfaces(j) + do j = 1, c % n_surfaces + surf_num = c % surfaces(j) if (surf_num < OP_DIFFERENCE) then index = dict_get_key(surface_dict, abs(surf_num)) if (index == DICT_NULL) then surf_num = abs(surf_num) msg = "Could not find surface " // trim(int_to_str(surf_num)) // & - & " specified on cell " // trim(int_to_str(c%uid)) + & " specified on cell " // trim(int_to_str(c % uid)) call fatal_error(msg) end if - c%surfaces(j) = sign(index, surf_num) + c % surfaces(j) = sign(index, surf_num) end if end do - ! adjust material indices - if (c % type == CELL_NORMAL) then - index = dict_get_key(material_dict, c%material) - if (index == DICT_NULL) then - msg = "Could not find material " // trim(int_to_str(c%material)) // & - & " specified on cell " // trim(int_to_str(c%uid)) + ! ======================================================================= + ! ADJUST UNIVERSE INDEX FOR EACH CELL + + if (dict_has_key(universe_dict, c % universe)) then + c % universe = dict_get_key(universe_dict, c % universe) + else + msg = "Could not find universe " // trim(int_to_str(c % universe)) // & + " specified on cell " // trim(int_to_str(c % uid)) + call fatal_error(msg) + end if + + ! ======================================================================= + ! ADJUST MATERIAL/FILL POINTERS FOR EACH CELL + + if (c % material /= 0) then + if (dict_has_key(material_dict, c % material)) then + c % type = CELL_NORMAL + c % material = dict_get_key(material_dict, c % material) + else + msg = "Could not find material " // trim(int_to_str(c % material)) // & + " specified on cell " // trim(int_to_str(c % uid)) + call fatal_error(msg) + end if + else + universe_num = c % fill + if (dict_has_key(universe_dict, universe_num)) then + c % type = CELL_FILL + c % fill = dict_get_key(universe_dict, universe_num) + elseif (dict_has_key(lattice_dict, universe_num)) then + c % type = CELL_LATTICE + c % fill = dict_get_key(lattice_dict, universe_num) + else + msg = "Specified fill " // trim(int_to_str(c % fill)) // " on cell " // & + trim(int_to_str(c % uid)) // " is neither a universe nor a lattice." call fatal_error(msg) end if - c%material = index end if end do - ! Check to make sure boundary conditions were specified - key_list => dict_keys(bc_dict) - if (.not. associated(key_list)) then - msg = "No boundary conditions specified!" - call fatal_error(msg) - end if + ! ========================================================================== + ! ADJUST UNIVERSE INDICES FOR EACH LATTICE - ! Set boundary conditions for surfaces - do while (associated(key_list)) - ! find index of universe in universes array - surf_num = key_list%data%key - bc = key_list%data%value - - ! establish pointer to surface - index = dict_get_key(surface_dict, surf_num) - surf => surfaces(index) - - ! set boundary condition - surf % bc = bc - - ! move to next universe - key_list => key_list%next + do i = 1, n_lattices + l => lattices(i) + do j = 1, l % n_x + do k = 1, l % n_y + universe_num = l % element(j,k) + if (dict_has_key(universe_dict, universe_num)) then + l % element(j,k) = dict_get_key(universe_dict, universe_num) + else + msg = "Invalid universe number " // trim(int_to_str(universe_num)) & + // " specified on lattice " // trim(int_to_str(l % uid)) + call fatal_error(msg) + end if + end do + end do end do end subroutine adjust_indices diff --git a/src/input_old.f90 b/src/input_old.f90 deleted file mode 100644 index 2c8d210894..0000000000 --- a/src/input_old.f90 +++ /dev/null @@ -1,873 +0,0 @@ -module input_old - - use constants - use datatypes, only: dict_create, dict_add_key, dict_get_key, & - dict_has_key, dict_keys - use datatypes_header, only: DictionaryII, ListKeyValueII, ListKeyValueCI - use geometry_header, only: Cell, Surface, Universe, BASE_UNIVERSE - use fileio, only: get_next_line - use global - use error, only: fatal_error - use output, only: message - use string, only: lower_case, is_number, str_to_int, int_to_str, & - str_to_real - - implicit none - - type(DictionaryII), pointer :: & ! used to count how many cells each - & ucount_dict => null(), & ! universe contains - & bc_dict => null() ! store boundary conditions - - integer, allocatable :: index_cell_in_univ(:) - -contains - -!=============================================================================== -! READ_COUNT makes a first pass through the input file to determine how many -! cells, universes, surfaces, materials, sources, etc there are in the problem. -!=============================================================================== - - subroutine read_count(filename) - - character(*), intent(in) :: filename - - integer :: in = 7 ! unit # for input file - integer :: index ! index in universes array - integer :: ioError ! error status for file access - integer :: n ! number of words on a line - integer :: count ! number of cells in a universe - integer :: universe_num ! user-specified universe # - character(MAX_LINE_LEN) :: msg ! output/error message - character(MAX_WORD_LEN) :: words(MAX_WORDS) ! words on a line - type(ListKeyValueII), pointer :: key_list => null() - type(Universe), pointer :: univ => null() - - msg = "First pass through input file..." - call message(msg, 5) - - n_cells = 0 - n_universes = 0 - n_surfaces = 0 - n_materials = 0 - n_tallies = 0 - - call dict_create(ucount_dict) - call dict_create(universe_dict) - call dict_create(lattice_dict) - - open(FILE=filename, UNIT=in, STATUS='old', & - & ACTION='read', IOSTAT=ioError) - if (ioError /= 0) then - msg = "Error while opening file: " // filename - call fatal_error(msg) - end if - - do - call get_next_line(in, words, n, ioError) - if (ioError /= 0) exit - if (n == 0) cycle - - select case (trim(words(1))) - case ('cell') - n_cells = n_cells + 1 - - ! For cells, we also need to check if there's a new universe -- also - ! for every cell add 1 to the count of cells for the specified - ! universe - universe_num = str_to_int(words(3)) - if (.not. dict_has_key(ucount_dict, universe_num)) then - n_universes = n_universes + 1 - count = 1 - call dict_add_key(universe_dict, universe_num, n_universes) - else - count = 1 + dict_get_key(ucount_dict, universe_num) - end if - call dict_add_key(ucount_dict, universe_num, count) - - case ('surface') - n_surfaces = n_surfaces + 1 - case ('material') - n_materials = n_materials + 1 - case ('tally') - n_tallies = n_tallies + 1 - case ('lattice') - n_lattices = n_lattices + 1 - - ! For lattices, we also need to check if there's a new universe -- - ! also for every cell add 1 to the count of cells for the specified - ! universe - universe_num = str_to_int(words(2)) - call dict_add_key(lattice_dict, universe_num, n_lattices) - - end select - end do - - ! Check to make sure there are cells, surface, and materials defined for the - ! problem - if (n_cells == 0) then - msg = "No cells specified!" - close(UNIT=in) - call fatal_error(msg) - elseif (n_surfaces == 0) then - msg = "No surfaces specified!" - close(UNIT=in) - call fatal_error(msg) - elseif (n_materials == 0) then - msg = "No materials specified!" - close(UNIT=in) - call fatal_error(msg) - end if - - close(UNIT=in) - - ! Allocate arrays for cells, surfaces, etc. - allocate(cells(n_cells)) - allocate(universes(n_universes)) - allocate(lattices(n_lattices)) - allocate(surfaces(n_surfaces)) - allocate(materials(n_materials)) - allocate(tallies(n_tallies)) - - ! Also allocate a list for keeping track of where cells have been assigned - ! in each universe - allocate(index_cell_in_univ(n_universes)) - index_cell_in_univ = 0 - - ! Set up dictionaries - call dict_create(cell_dict) - call dict_create(surface_dict) - call dict_create(bc_dict) - call dict_create(material_dict) - call dict_create(tally_dict) - - ! We also need to allocate the cell count lists for each universe. The logic - ! for this is a little more convoluted. In universe_dict, the (key,value) - ! pairs are the uid of the universe and the index in the array. In - ! ucount_dict, it's the uid of the universe and the number of cells. - - key_list => dict_keys(universe_dict) - do while (associated(key_list)) - ! find index of universe in universes array - index = key_list%data%value - univ => universes(index) - univ % uid = key_list%data%key - - ! check for lowest level universe - if (univ % uid == 0) BASE_UNIVERSE = index - - ! find cell count for this universe - count = dict_get_key(ucount_dict, key_list%data%key) - - ! allocate cell list for universe - allocate(univ % cells(count)) - univ % n_cells = count - - ! move to next universe - key_list => key_list%next - end do - - end subroutine read_count - -!=============================================================================== -! READ_INPUT takes a second pass through the input file and parses all the data -! on each line, calling the appropriate subroutine for each type of data item. -!=============================================================================== - - subroutine read_input(filename) - - character(*), intent(in) :: filename - - integer :: in = 7 ! unit # for input file - integer :: ioError ! error status for file access - integer :: n ! number of words on a line - integer :: index_cell ! index in cells array - integer :: index_universe ! index in universes array - integer :: index_surface ! index in surfaces array - integer :: index_lattice ! index in lattices array - integer :: index_material ! index in materials array - integer :: index_source ! index in source array (?) - integer :: index_tally ! index in tally array - character(MAX_LINE_LEN) :: msg ! output/error message - character(MAX_WORD_LEN) :: words(MAX_WORDS) ! words on a single line - - msg = "Second pass through input file..." - call message(msg, 5) - - index_cell = 0 - index_universe = 0 - index_surface = 0 - index_lattice = 0 - index_material = 0 - index_tally = 0 - index_source = 0 - - open(FILE=filename, UNIT=in, STATUS='old', & - & ACTION='read', IOSTAT=ioError) - if (ioError /= 0) then - msg = "Error while opening file: " // filename - call fatal_error(msg) - end if - - do - call get_next_line(in, words, n, ioError) - if (ioError /= 0) exit - - ! skip comments - if (n==0 .or. words(1)(1:1) == '#') cycle - - select case (trim(words(1))) - case ('cell') - ! Read cell entry - index_cell = index_cell + 1 - call read_cell(index_cell, words, n) - - case ('surface') - ! Read surface entry - index_surface = index_surface + 1 - call read_surface(index_surface, words, n) - - case ('bc') - ! Read boundary condition entry - call read_bc(words, n) - - case ('lattice') - ! Read lattice entry - index_lattice = index_lattice + 1 - call read_lattice(index_lattice, words, n) - - case ('material') - ! Read material entry - index_material = index_material + 1 - call read_material(index_material, words, n) - - case ('tally') - ! Read tally entry - index_tally = index_tally + 1 - call read_tally(index_tally, words, n) - - case ('source') - call read_source(words, n) - - case ('criticality') - call read_criticality(words, n) - - case ('xs_data') - path_xsdata = words(2) - - case ('verbosity') - verbosity = str_to_int(words(2)) - if (verbosity == ERROR_INT) then - msg = "Invalid verbosity: " // trim(words(2)) - call fatal_error(msg) - end if - - case default - ! do nothing - end select - - end do - - ! deallocate array - deallocate(index_cell_in_univ) - - close(UNIT=in) - - end subroutine read_input - -!=============================================================================== -! READ_CELL parses the data on a cell card. -!=============================================================================== - - subroutine read_cell(index, words, n_words) - - integer, intent(in) :: index ! index in cells array - integer, intent(in) :: n_words ! number of words - character(*), intent(in) :: words(n_words) ! words on cell card entry - - integer :: i ! index for surface list in a cell - integer :: universe_num ! user-specified universe number - integer :: n_surfaces ! number of surfaces in a cell - character(MAX_LINE_LEN) :: msg ! output/error message - character(MAX_WORD_LEN) :: word ! single word - type(Cell), pointer :: c => null() - - c => cells(index) - - ! Read cell identifier - c % uid = str_to_int(words(2)) - if (c % uid == ERROR_INT) then - msg = "Invalid cell name: " // trim(words(2)) - call fatal_error(msg) - end if - call dict_add_key(cell_dict, c%uid, index) - - ! Read cell universe - universe_num = str_to_int(words(3)) - if (universe_num == ERROR_INT) then - msg = "Invalid universe: " // trim(words(3)) - call fatal_error(msg) - end if - c % universe = dict_get_key(universe_dict, universe_num) - - ! Read cell material - if (trim(words(4)) == 'fill') then - c % material = 0 - n_surfaces = n_words - 5 - - ! find universe - universe_num = str_to_int(words(5)) - if (universe_num == ERROR_INT) then - msg = "Invalid universe fill: " // trim(words(5)) - call fatal_error(msg) - end if - - ! check whether universe or lattice - if (dict_has_key(universe_dict, universe_num)) then - c % type = CELL_FILL - c % fill = dict_get_key(universe_dict, universe_num) - elseif (dict_has_key(lattice_dict, universe_num)) then - c % type = CELL_LATTICE - c % fill = dict_get_key(lattice_dict, universe_num) - end if - else - c % type = CELL_NORMAL - c % material = str_to_int(words(4)) - c % fill = 0 - if (c % material == ERROR_INT) then - msg = "Invalid material number: " // trim(words(4)) - call fatal_error(msg) - end if - n_surfaces = n_words - 4 - end if - - ! Assign number of items - c % n_surfaces = n_surfaces - - ! Read list of surfaces - allocate(c%surfaces(n_surfaces)) - do i = 1, n_surfaces - word = words(i+n_words-n_surfaces) - if (word(1:1) == '(') then - c % surfaces(i) = OP_LEFT_PAREN - elseif (word(1:1) == ')') then - c % surfaces(i) = OP_RIGHT_PAREN - elseif (word(1:1) == ':') then - c % surfaces(i) = OP_UNION - elseif (word(1:1) == '#') then - c % surfaces(i) = OP_DIFFERENCE - else - c % surfaces(i) = str_to_int(word) - end if - end do - - ! Add cell to the cell list in the corresponding universe - i = c % universe - index_cell_in_univ(i) = index_cell_in_univ(i) + 1 - universes(i) % cells(index_cell_in_univ(i)) = index - - end subroutine read_cell - -!=============================================================================== -! READ_SURFACE parses the data on a surface card. -!=============================================================================== - - subroutine read_surface(index, words, n_words) - - integer, intent(in) :: index ! index in surfaces array - integer, intent(in) :: n_words ! number of words - character(*), intent(in) :: words(n_words) ! words in surface card entry - - integer :: i ! index for surface coefficients - integer :: coeffs_reqd ! number of coefficients are required - character(MAX_LINE_LEN) :: msg ! output/error message - character(MAX_WORD_LEN) :: word ! single word - type(Surface), pointer :: surf => null() - - surf => surfaces(index) - - ! Read surface identifier - surf % uid = str_to_int(words(2)) - if (surf % uid == ERROR_INT) then - msg = "Invalid surface name: " // trim(words(2)) - call fatal_error(msg) - end if - call dict_add_key(surface_dict, surf % uid, index) - - ! Read surface type - word = words(3) - call lower_case(word) - select case (trim(word)) - case ('px') - surf % type = SURF_PX - coeffs_reqd = 1 - case ('py') - surf % type = SURF_PY - coeffs_reqd = 1 - case ('pz') - surf % type = SURF_PZ - coeffs_reqd = 1 - case ('plane') - surf % type = SURF_PLANE - coeffs_reqd = 4 - case ('cylx') - surf % type = SURF_CYL_X - coeffs_reqd = 3 - case ('cyly') - surf % type = SURF_CYL_Y - coeffs_reqd = 3 - case ('cylz') - surf % type = SURF_CYL_Z - coeffs_reqd = 3 - case ('sph') - surf % type = SURF_SPHERE - coeffs_reqd = 4 - case ('boxx') - surf % type = SURF_BOX_X - coeffs_reqd = 4 - case ('boxy') - surf % type = SURF_BOX_Y - coeffs_reqd = 4 - case ('boxz') - surf % type = SURF_BOX_Z - coeffs_reqd = 4 - case ('box') - surf % type = SURF_BOX - coeffs_reqd = 6 - case ('gq') - surf % type = SURF_GQ - coeffs_reqd = 10 - case default - msg = "Invalid surface type: " // trim(words(3)) - call fatal_error(msg) - end select - - ! Make sure there are enough coefficients for surface type - if (n_words-3 < coeffs_reqd) then - msg = "Not enough coefficients for surface: " // trim(words(2)) - call fatal_error(msg) - end if - - ! Read list of surfaces - allocate(surf%coeffs(n_words-3)) - do i = 1, n_words-3 - surf % coeffs(i) = str_to_real(words(i+3)) - end do - - end subroutine read_surface - -!=============================================================================== -! READ_BC creates a dictionary whose (key,value) pairs are the uids of surfaces -! and specified boundary conditions, respectively. This is later used in -! adjust_indices to set the surface boundary conditions. -!=============================================================================== - - subroutine read_bc(words, n_words) - - integer, intent(in) :: n_words ! number of words - character(*), intent(in) :: words(n_words) ! words in bc entry - - integer :: surface_uid ! User-specified uid of surface - integer :: bc ! Boundary condition - character(MAX_WORD_LEN) :: word ! Boundary condition (in input file) - character(MAX_LINE_LEN) :: msg ! Output/error message - - ! Read surface identifier - surface_uid = str_to_int(words(2)) - if (surface_uid == ERROR_INT) then - msg = "Invalid surface name: " // trim(words(2)) - call fatal_error(msg) - end if - - ! Read boundary condition - word = words(3) - call lower_case(word) - select case (trim(word)) - case ('transmit') - bc = BC_TRANSMIT - case ('vacuum') - bc = BC_VACUUM - case ('reflect') - bc = BC_REFLECT - case default - msg = "Invalid boundary condition: " // trim(words(3)) - call fatal_error(msg) - end select - - ! Add (uid, bc) to dictionary - call dict_add_key(bc_dict, surface_uid, bc) - - end subroutine read_bc - -!=============================================================================== -! READ_LATTICE parses the data on a lattice entry. -!=============================================================================== - - subroutine read_lattice(index, words, n_words) - - integer, intent(in) :: index ! index in lattices array - integer, intent(in) :: n_words ! number of words - character(*), intent(in) :: words(n_words) ! words in lattice entry - - integer :: universe_num ! user-specified universe number - integer :: n_x ! number of lattice cells in x direction - integer :: n_y ! number of lattice cells in y direction - integer :: i,j ! loop indices for Lattice % universes - integer :: index_word ! index in words array - character(MAX_LINE_LEN) :: msg ! output/error/message - character(MAX_WORD_LEN) :: word ! single word - type(Lattice), pointer :: lat => null() - - lat => lattices(index) - - ! Read lattice universe - universe_num = str_to_int(words(2)) - if (universe_num == ERROR_INT) then - msg = "Invalid universe: " // trim(words(2)) - call fatal_error(msg) - end if - lat % uid = universe_num - - ! Read lattice type - word = words(3) - call lower_case(word) - select case(trim(word)) - case ('rect') - lat % type = LATTICE_RECT - case ('hex') - lat % type = LATTICE_HEX - case default - msg = "Invalid lattice type: " // trim(words(3)) - call fatal_error(msg) - end select - - ! Read number of lattice cells in each direction - n_x = str_to_int(words(4)) - n_y = str_to_int(words(5)) - if (n_x == ERROR_INT) then - msg = "Invalid number of lattice cells in x-direction: " // trim(words(4)) - call fatal_error(msg) - elseif (n_y == ERROR_INT) then - msg = "Invalid number of lattice cells in y-direction: " // trim(words(5)) - call fatal_error(msg) - end if - lat % n_x = n_x - lat % n_y = n_y - - ! Read lattice origin coordinates - lat % x0 = str_to_real(words(6)) - lat % y0 = str_to_real(words(7)) - - ! Read lattice cell widths - lat % width_x = str_to_real(words(8)) - lat % width_y = str_to_real(words(9)) - - ! Make sure enough lattice positions specified - if (n_words - 9 < n_x * n_y) then - print *, n_words, n_x, n_y - msg = "Not enough lattice positions specified." - call fatal_error(msg) - end if - - ! Read lattice positions - allocate(lat % element(n_x,n_y)) - do j = 0, n_y - 1 - do i = 1, n_x - index_word = 9 + j*n_x + i - universe_num = str_to_int(words(index_word)) - if (universe_num == ERROR_INT) then - msg = "Invalid universe number: " // trim(words(index_word)) - call fatal_error(msg) - end if - lat % element(i, n_y-j) = dict_get_key(universe_dict, universe_num) - end do - end do - - end subroutine read_lattice - -!=============================================================================== -! READ_SOURCE parses the data on a source entry. -!=============================================================================== - - subroutine read_source(words, n_words) - - integer, intent(in) :: n_words ! number of words - character(*), intent(in) :: words(n_words) ! words on source entry - - integer :: i ! index in values list - integer :: values_reqd ! # of values required to specify source - character(MAX_LINE_LEN) :: msg ! output/error message - character(MAX_WORD_LEN) :: word ! single word - - ! Read source type - word = words(2) - call lower_case(word) - select case (trim(word)) - case ('box') - external_source % type = SRC_BOX - values_reqd = 6 - case default - msg = "Invalid source type: " // trim(words(2)) - call fatal_error(msg) - end select - - ! Make sure there are enough values for this source type - if (n_words-2 < values_reqd) then - msg = "Not enough values for source of type: " // trim(words(2)) - call fatal_error(msg) - end if - - ! Read values - allocate(external_source%values(n_words-2)) - do i = 1, n_words-2 - external_source % values(i) = str_to_real(words(i+2)) - end do - - end subroutine read_source - -!=============================================================================== -! READ_TALLY -!=============================================================================== - - subroutine read_tally(index, words, n_words) - - integer, intent(in) :: index ! index in materials array - integer, intent(in) :: n_words ! number of words - character(*), intent(in) :: words(n_words) ! words on material entry - - integer :: i ! index in words array - integer :: j - integer :: k - integer :: count - integer :: MT - integer :: cell_uid - integer :: r_bins, c_bins, e_bins - real(8) :: E - character(MAX_WORD_LEN) :: word - character(MAX_LINE_LEN) :: msg - type(Tally), pointer :: t => null() - - t => tallies(index) - - ! Read tally identifier - t % uid = str_to_int(words(2)) - if (t % uid == ERROR_INT) then - msg = "Invalid tally name: " // trim(words(2)) - call fatal_error(msg) - end if - call dict_add_key(tally_dict, t % uid, index) - - i = 3 - do while (i <= n_words) - word = words(i) - call lower_case(word) - - select case (trim(word)) - case ('reaction') - ! ==================================================================== - ! READ REACTION LIST - - ! Determine how many reactions are listed - do j = i+1, n_words - if (.not. is_number(words(j))) exit - end do - count = j - (i+1) - - ! Allocate space to store reactions - allocate(t % reactions(count)) - - ! Read reaction MT values - do j = 1, count - MT = str_to_int(words(i+j)) - if (MT == ERROR_INT) then - msg = "Invalid reaction MT on tally: " // int_to_str(t%uid) - call fatal_error(msg) - end if - t % reactions(j) = MT - end do - - ! Determine whether to sum reactions or individually bin - if (trim(words(i+count+1)) == 'sum') then - t % reaction_type = TALLY_SUM - r_bins = 1 - else - t % reaction_type = TALLY_BINS - r_bins = count - end if - - case ('cell') - ! ==================================================================== - ! READ CELL LIST - - ! Determine how many reactions are listed - do j = i+1, n_words - if (.not. is_number(words(j))) exit - end do - count = j - (i+1) - - ! Allocate space to store reactions - allocate(t % cells(count)) - - ! Read reaction MT values - do j = 1, count - cell_uid = str_to_int(words(i+j)) - if (cell_uid == ERROR_INT) then - msg = "Invalid cell number on tally: " // int_to_str(t%uid) - call fatal_error(msg) - end if - t % cells(j) = cell_uid - end do - - ! Determine whether to sum reactions or individually bin - if (trim(words(i+count+1)) == 'sum') then - t % cell_type = TALLY_SUM - c_bins = 1 - else - t % cell_type = TALLY_BINS - c_bins = count - end if - - case ('energy') - ! ==================================================================== - ! READ ENERGY LIST - - ! Determine how many energies are listed - do j = i+1, n_words - if (.not. is_number(words(j)(1:1))) exit - end do - count = j - (i+1) - - ! Allocate space to store energies - allocate(t % energies(count)) - - ! Read reaction MT values - do j = 1, count - E = str_to_real(words(i+j)) - if (E == ERROR_REAL) then - msg = "Invalid energy on tally: " // int_to_str(t % uid) - call fatal_error(msg) - end if - t % energies(j) = E - end do - - e_bins = count - 1 - - case ('material') - ! TODO: Add ability to read material lists - - case ('universe') - ! TODO: Add ability to read universe lists - - case ('lattice') - ! TODO: Add lattice tally ability - - end select - - ! Move index in words forward - i = i + 1 + count - - end do - - ! allocate tally scores - allocate(t % score(r_bins, c_bins, e_bins)) - - ! initialize tallies - forall (i=1:r_bins, j=1:c_bins, k=1:e_bins) - t % score(i,j,k) % n_events = 0 - t % score(i,j,k) % val = ZERO - t % score(i,j,k) % val_sq = ZERO - end forall - - end subroutine read_tally - -!=============================================================================== -! READ_MATERIAL parses a material card. Note that atom percents and densities -! are normalized in a separate routine -!=============================================================================== - - subroutine read_material(index, words, n_words) - - integer, intent(in) :: index ! index in materials array - integer, intent(in) :: n_words ! number of words - character(*), intent(in) :: words(n_words) ! words on material entry - - integer :: i ! index over nuclides - integer :: n_nuclides ! number of nuclides in material - character(MAX_LINE_LEN) :: msg ! output/error message - type(Material), pointer :: mat => null() - - ! Check for correct number of arguments - if (mod(n_words,2) == 0 .or. n_words < 5) then - msg = "Invalid number of arguments for material: " // trim(words(2)) - call fatal_error(msg) - end if - - ! Determine and set number of nuclides - n_nuclides = (n_words-3)/2 - mat => materials(index) - mat % n_nuclides = n_nuclides - - ! Read surface identifier - mat % uid = str_to_int(words(2)) - if (mat % uid == ERROR_INT) then - msg = "Invalid surface name: " // trim(words(2)) - call fatal_error(msg) - end if - call dict_add_key(material_dict, mat%uid, index) - - ! Read atom density - mat % atom_density = str_to_real(words(3)) - - ! allocate isotope and density list - allocate(mat%names(n_nuclides)) - allocate(mat%xsdata(n_nuclides)) - allocate(mat%nuclide(n_nuclides)) - allocate(mat%atom_percent(n_nuclides)) - - ! read names and percentage - do i = 1, n_nuclides - mat % names(i) = words(2*i+2) - mat % atom_percent(i) = str_to_real(words(2*i+3)) - end do - - end subroutine read_material - -!=============================================================================== -! READ_CRITICALITY parses the data on a criticality card. This card specifies -! that the problem at hand is a criticality calculation and gives the number of -! cycles, inactive cycles, and particles per cycle. -!=============================================================================== - - subroutine read_criticality(words, n_words) - - integer, intent(in) :: n_words ! number of words - character(*), intent(in) :: words(n_words) ! words on criticality card - - character(MAX_LINE_LEN) :: msg ! output/error message - - ! Set problem type to criticality - problem_type = PROB_CRITICALITY - - ! Read number of cycles - n_cycles = str_to_int(words(2)) - if (n_cycles == ERROR_INT) then - msg = "Invalid number of cycles: " // trim(words(2)) - call fatal_error(msg) - end if - - ! Read number of inactive cycles - n_inactive = str_to_int(words(3)) - if (n_inactive == ERROR_INT) then - msg = "Invalid number of inactive cycles: " // trim(words(2)) - call fatal_error(msg) - end if - - ! Read number of particles - n_particles = str_to_int(words(4)) - if (n_particles == ERROR_INT) then - msg = "Invalid number of particles: " // trim(words(2)) - call fatal_error(msg) - end if - - end subroutine read_criticality - -end module input_old diff --git a/src/input_sample b/src/input_sample deleted file mode 100644 index 575e0d7338..0000000000 --- a/src/input_sample +++ /dev/null @@ -1,27 +0,0 @@ -# test input file - -cell 1 0 fill 37 -2 -cell 100 37 40 -1 -cell 101 37 41 1 -cell 2 0 41 2 -3 - -surface 1 cylz 0 0 7 -surface 2 cylz 0 0 9 -surface 3 cylz 0 0 11 - -bc 3 vacuum - -material 40 -4.5 & - 92235.03c 1.0 - -material 41 -1.0 & - 1001.03c 2.0 & - 8016.03c 1.0 - -source box -4 -4 -4 4 4 4 - -tally 1 reaction 2 cell 2 energy limits - -xs_data /opt/serpent/xsdata/endfb7 -criticality 15 5 10000 -verbosity 7 diff --git a/src/input_xml.f90 b/src/input_xml.f90 new file mode 100644 index 0000000000..663eaf354e --- /dev/null +++ b/src/input_xml.f90 @@ -0,0 +1,475 @@ +module input_xml + + use constants + use datatypes, only: dict_create, dict_add_key, dict_has_key, & + dict_get_key + use error, only: fatal_error + use geometry_header, only: Cell, Surface, Lattice + use global + use string, only: lower_case, int_to_str + + implicit none + + type(DictionaryII), pointer :: & ! used to count how many cells each + & cells_in_univ_dict => null() ! universe contains + +contains + +!=============================================================================== +! READ_INPUT_XML calls each of the separate subroutines for reading settings, +! geometry, materials, and tallies. +!=============================================================================== + + subroutine read_input_xml() + + call read_settings_xml() + call read_geometry_xml() + call read_material_xml() + + end subroutine read_input_xml + +!=============================================================================== +! READ_SETTINGS_XML reads data from a settings.xml file and parses it, checking +! for errors and placing properly-formatted data in the right data structures +!=============================================================================== + + subroutine read_settings_xml() + + use xml_data_settings_t + + integer :: n + integer :: coeffs_reqd + character(MAX_WORD_LEN) :: type + character(MAX_LINE_LEN) :: msg + character(MAX_LINE_LEN) :: filename + + filename = trim(path_input) // "settings.xml" + call read_xml_file_settings_t(filename) + + ! Cross-section library path + path_xsdata = trim(xslibrary % path) + + ! Criticality information + if (criticality % cycles > 0) then + problem_type = PROB_CRITICALITY + n_particles = criticality % particles + n_cycles = criticality % cycles + n_inactive = criticality % inactive + end if + + ! Verbosity + verbosity = verbosity_ + + if (associated(source_ % coeffs)) then + ! Determine external source type + type = source_ % type + call lower_case(type) + select case (trim(type)) + case ('box') + external_source % type = SRC_BOX + coeffs_reqd = 6 + case default + msg = "Invalid source type: " // trim(source_ % type) + call fatal_error(msg) + end select + + ! Coefficients for external surface + n = size(source_ % coeffs) + if (n < coeffs_reqd) then + msg = "Not enough coefficients specified for external source." + print *, n, coeffs_reqd + call fatal_error(msg) + elseif (n > coeffs_reqd) then + msg = "Too many coefficients specified for external source." + call fatal_error(msg) + else + allocate(external_source % values(n)) + external_source % values = source_ % coeffs + end if + end if + + end subroutine read_settings_xml + +!=============================================================================== +! READ_GEOMETRY_XML reads data from a geometry.xml file and parses it, checking +! for errors and placing properly-formatted data in the right data structures +!=============================================================================== + + subroutine read_geometry_xml() + + use xml_data_geometry_t + + integer :: i, j, k + integer :: n + integer :: n_x, n_y + integer :: universe_num + integer :: count + integer :: coeffs_reqd + character(MAX_LINE_LEN) :: filename + character(MAX_LINE_LEN) :: msg + character(MAX_WORD_LEN) :: word + type(Cell), pointer :: c => null() + type(Surface), pointer :: s => null() + type(Lattice), pointer :: l => null() + + ! ========================================================================== + ! READ CELLS FROM GEOMETRY.XML + + filename = trim(path_input) // "geometry.xml" + call read_xml_file_geometry_t(filename) + + ! Allocate cells array + n_cells = size(cell_) + allocate(cells(n_cells)) + + n_universes = 0 + do i = 1, n_cells + c => cells(i) + + ! Copy data into cells + c % uid = cell_(i) % uid + c % universe = cell_(i) % universe + c % material = cell_(i) % material + c % fill = cell_(i) % fill + + ! Check to make sure that both material and fill haven't been + ! specified simultaneously + if (c % material /= 0 .and. c % fill /= 0) then + msg = "Cannot specify material and fill simultaneously" + call fatal_error(msg) + end if + + ! Check to make sure that surfaces were specified + if (.not. associated(cell_(i) % surfaces)) then + msg = "No surfaces specified for cell " // trim(int_to_str(c % uid)) + call fatal_error(msg) + end if + + ! Allocate array for surfaces and copy + n = size(cell_(i) % surfaces) + c % n_surfaces = n + allocate(c % surfaces(n)) + c % surfaces = cell_(i) % surfaces + + ! Add cell to dictionary + call dict_add_key(cell_dict, c % uid, i) + + ! For cells, we also need to check if there's a new universe -- + ! also for every cell add 1 to the count of cells for the + ! specified universe + universe_num = cell_(i) % universe + if (.not. dict_has_key(cells_in_univ_dict, universe_num)) then + n_universes = n_universes + 1 + count = 1 + call dict_add_key(universe_dict, universe_num, n_universes) + else + count = 1 + dict_get_key(cells_in_univ_dict, universe_num) + end if + call dict_add_key(cells_in_univ_dict, universe_num, count) + + end do + + ! ========================================================================== + ! READ SURFACES FROM GEOMETRY.XML + + ! Allocate cells array + n_surfaces = size(surface_) + allocate(surfaces(n_surfaces)) + + do i = 1, n_surfaces + s => surfaces(i) + + ! Copy data into cells + s % uid = surface_(i) % uid + + ! Copy and interpret surface type + word = surface_(i) % type + call lower_case(word) + select case(trim(word)) + case ('x-plane') + s % type = SURF_PX + coeffs_reqd = 1 + case ('y-plane') + s % type = SURF_PY + coeffs_reqd = 1 + case ('z-plane') + s % type = SURF_PZ + coeffs_reqd = 1 + case ('plane') + s % type = SURF_PLANE + coeffs_reqd = 4 + case ('x-cylinder') + s % type = SURF_CYL_X + coeffs_reqd = 3 + case ('y-cylinder') + s % type = SURF_CYL_Y + coeffs_reqd = 3 + case ('z-cylinder') + s % type = SURF_CYL_Z + coeffs_reqd = 3 + case ('sphere') + s % type = SURF_SPHERE + coeffs_reqd = 4 + case ('box-x') + s % type = SURF_BOX_X + coeffs_reqd = 4 + case ('box-y') + s % type = SURF_BOX_Y + coeffs_reqd = 4 + case ('box-z') + s % type = SURF_BOX_Z + coeffs_reqd = 4 + case ('box') + s % type = SURF_BOX + coeffs_reqd = 6 + case ('quadratic') + s % type = SURF_GQ + coeffs_reqd = 10 + case default + msg = "Invalid surface type: " // trim(surface_(i) % type) + call fatal_error(msg) + end select + + ! Check to make sure that the proper number of coefficients + ! have been specified for the given type of surface. Then copy + ! surface coordinates. + + n = size(surface_(i) % coeffs) + if (n < coeffs_reqd) then + msg = "Not enough coefficients specified for surface: " // & + trim(int_to_str(s % uid)) + print *, n, coeffs_reqd + call fatal_error(msg) + elseif (n > coeffs_reqd) then + msg = "Too many coefficients specified for surface: " // & + trim(int_to_str(s % uid)) + call fatal_error(msg) + else + allocate(s % coeffs(n)) + s % coeffs = surface_(i) % coeffs + end if + + ! Boundary conditions + word = surface_(i) % boundary + call lower_case(word) + select case (trim(word)) + case ('transmission', 'transmit', '') + s % bc = BC_TRANSMIT + case ('vacuum') + s % bc = BC_VACUUM + case ('reflective', 'reflect', 'reflecting') + s % bc = BC_REFLECT + case ('periodic') + s % bc = BC_PERIODIC + case default + msg = "Unknown boundary condition '" // trim(word) // & + "' specified on surface " // trim(int_to_str(s % uid)) + call fatal_error(msg) + end select + + ! Add surface to dictionary + call dict_add_key(surface_dict, s % uid, i) + + end do + + ! ========================================================================== + ! READ LATTICES FROM GEOMETRY.XML + + ! Allocate lattices array + n_lattices = size(lattice_) + allocate(lattices(n_lattices)) + + do i = 1, n_lattices + l => lattices(i) + + ! UID of lattice + l % uid = lattice_(i) % uid + + ! Read lattice type + word = lattice_(i) % type + call lower_case(word) + select case (trim(word)) + case ('rect', 'rectangle', 'rectangular') + l % type = LATTICE_RECT + case ('hex', 'hexagon', 'hexagonal') + l % type = LATTICE_HEX + case default + msg = "Invalid lattice type: " // trim(lattice_(i) % type) + call fatal_error(msg) + end select + + ! Read number of lattice cells in each dimension + n = size(lattice_(i) % dimension) + if (n /= 2 .and. n /= 3) then + msg = "Lattice must be two or three dimensions." + call fatal_error(msg) + end if + n_x = lattice_(i) % dimension(1) + n_y = lattice_(i) % dimension(2) + l % n_x = n_x + l % n_y = n_y + + ! Read lattice origin location + if (size(lattice_(i) % dimension) /= size(lattice_(i) % origin)) then + msg = "Number of entries on must be the same as the " // & + "number of entries on ." + call fatal_error(msg) + end if + l % x0 = lattice_(i) % origin(1) + l % y0 = lattice_(i) % origin(2) + + ! Read lattice widths + if (size(lattice_(i) % width) /= size(lattice_(i) % origin)) then + msg = "Number of entries on must be the same as the " // & + "number of entries on ." + call fatal_error(msg) + end if + l % width_x = lattice_(i) % width(1) + l % width_y = lattice_(i) % width(2) + + ! Read universes + allocate(l % element(n_x, n_y)) + do k = 0, n_y - 1 + do j = 1, n_x + l % element(j, n_y - k) = lattice_(i) % universes(j + k*n_x) + end do + end do + + ! Add lattice to dictionary + call dict_add_key(lattice_dict, l % uid, i) + + end do + + end subroutine read_geometry_xml + +!=============================================================================== +! READ_MATERIAL_XML reads data from a material.xml file and parses it, checking +! for errors and placing properly-formatted data in the right data structures +!=============================================================================== + + subroutine read_material_xml + + use xml_data_material_t + + integer :: i, j + integer :: n + real(8) :: val + character(MAX_WORD_LEN) :: units + character(MAX_WORD_LEN) :: name + character(MAX_LINE_LEN) :: filename + character(MAX_LINE_LEN) :: msg + type(Material), pointer :: m => null() + type(nuclide_xml), pointer :: nuc => null() + + filename = trim(path_input) // "material.xml" + call read_xml_file_material_t(filename) + + ! Allocate cells array + n_materials = size(material_) + allocate(materials(n_materials)) + + do i = 1, n_materials + m => materials(i) + + ! Copy material uid + m % uid = material_(i) % uid + + ! Copy density -- the default value for the units is given in the + ! material_t.xml file and doesn't need to be specified here, hence case + ! default results in an error. + val = material_(i) % density % value + units = material_(i) % density % units + call lower_case(units) + select case(trim(units)) + case ('g/cc', 'g/cm3') + m % atom_density = -val + case ('kg/m3') + m % atom_density = -0.001 * val + case ('atom/b-cm') + m % atom_density = val + case ('atom/cm3', 'atom/cc') + m % atom_density = 1.0e-24 * val + case default + msg = "Unkwown units '" // trim(material_(i) % density % units) // & + "' specified on material " // trim(int_to_str(m % uid)) + call fatal_error(msg) + end select + + ! Check to ensure material has at least one nuclide + if (.not. associated(material_(i) % nuclides)) then + msg = "No nuclides specified on material " // trim(int_to_str(m % uid)) + call fatal_error(msg) + end if + + ! allocate arrays in Material object + n = size(material_(i) % nuclides) + m % n_nuclides = n + allocate(m % names(n)) + allocate(m % nuclide(n)) + allocate(m % xsdata(n)) + allocate(m % atom_percent(n)) + + do j = 1, n + ! Combine nuclide identifier and cross section and copy into names + nuc => material_(i) % nuclides(j) + name = trim(nuc % name) // "." // trim(nuc % xs) + m % names(j) = name + + ! Check if no atom/weight percents were specified or if both atom and + ! weight percents were specified + if (nuc % ao == ZERO .and. nuc % wo == ZERO) then + msg = "No atom or weight percent specified for nuclide " // & + trim(name) + call fatal_error(msg) + elseif (nuc % ao /= ZERO .and. nuc % wo /= ZERO) then + msg = "Cannot specify both atom and weight percents for a nuclide: " & + // trim(name) + end if + + ! Copy atom/weight percents + if (nuc % ao /= ZERO) then + m % atom_percent(j) = nuc % ao + else + m % atom_percent(j) = -nuc % wo + end if + end do + + ! Add material to dictionary + call dict_add_key(material_dict, m % uid, i) + + end do + + end subroutine read_material_xml + +!=============================================================================== +! READ_TALLIES_XML reads data from a tallies.xml file and parses it, checking +! for errors and placing properly-formatted data in the right data structures +!=============================================================================== + + subroutine read_tallies_xml + + use xml_data_tallies_t + + integer :: i + character(MAX_LINE_LEN) :: filename + character(MAX_LINE_LEN) :: msg + type(Tally), pointer :: t => null() + + filename = trim(path_input) // "tallies.xml" + call read_xml_file_tallies_t(filename) + + ! Allocate cells array + n_tallies = size(tally_) + allocate(tallies(n_tallies)) + + do i = 1, n_tallies + t => tallies(i) + + ! Copy material uid + t % uid = tally_(i) % id + + end do + + end subroutine read_tallies_xml + +end module input_xml diff --git a/src/lattice_sample b/src/lattice_sample deleted file mode 100644 index 3991e768da..0000000000 --- a/src/lattice_sample +++ /dev/null @@ -1,51 +0,0 @@ -# test lattice input file - -cell 1 0 fill 111 1 -2 3 -4 -cell 100 3 40 -5 -cell 101 3 41 5 - -lattice 111 rect 20 20 -10.0 -10.0 1.0 1.0 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 & - 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 - -surface 1 px -9.9 -surface 2 px 9.9 -surface 3 py -9.9 -surface 4 py 9.9 -surface 5 cylz 0 0 0.4 - -bc 1 vacuum -bc 2 vacuum -bc 3 vacuum -bc 4 vacuum - -material 40 -4.5 & - 92235.03c 1.0 - -material 41 -1.0 & - 1001.03c 2.0 & - 8016.03c 1.0 - -source box -4 -4 -4 4 4 4 - -xs_data /opt/serpent/xsdata/endfb7 -criticality 20 10 10000 -verbosity 7 diff --git a/src/xml_geometry.f90 b/src/xml_geometry.f90 new file mode 100644 index 0000000000..285a1aa81f --- /dev/null +++ b/src/xml_geometry.f90 @@ -0,0 +1,737 @@ +module xml_data_geometry_t + use READ_XML_PRIMITIVES + use WRITE_XML_PRIMITIVES + use XMLPARSE + implicit none + integer, private :: lurep_ + logical, private :: strict_ + +type cell_xml + integer :: uid + integer :: universe + integer :: material + integer :: fill + integer, dimension(:), pointer :: surfaces => null() +end type cell_xml + +type surface_xml + integer :: uid + character(len=15) :: type + real(kind=kind(1.0d0)), dimension(:), pointer :: coeffs => null() + character(len=12) :: boundary +end type surface_xml + +type lattice_xml + integer :: uid + character(len=12) :: type + integer, dimension(:), pointer :: dimension => null() + real(kind=kind(1.0d0)), dimension(:), pointer :: origin => null() + real(kind=kind(1.0d0)), dimension(:), pointer :: width => null() + integer, dimension(:), pointer :: universes => null() +end type lattice_xml + type(cell_xml), dimension(:), pointer :: cell_ => null() + type(surface_xml), dimension(:), pointer :: surface_ => null() + type(lattice_xml), dimension(:), pointer :: lattice_ => null() +contains +subroutine read_xml_type_cell_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(inout) :: tag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(cell_xml), dimension(:), pointer :: dvar + logical, intent(inout) :: has_dvar + + integer :: newsize + type(cell_xml), dimension(:), pointer :: newvar + + newsize = size(dvar) + 1 + allocate( newvar(1:newsize) ) + newvar(1:newsize-1) = dvar + deallocate( dvar ) + dvar => newvar + + call read_xml_type_cell_xml( info, tag, endtag, attribs, noattribs, data, nodata, & + dvar(newsize), has_dvar ) +end subroutine read_xml_type_cell_xml_array + +subroutine read_xml_type_cell_xml( info, starttag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: starttag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(cell_xml), intent(inout) :: dvar + logical, intent(inout) :: has_dvar + + integer :: att_ + integer :: noatt_ + logical :: error + logical :: endtag_org + character(len=len(starttag)) :: tag + logical :: has_uid + logical :: has_universe + logical :: has_material + logical :: has_fill + logical :: has_surfaces + has_uid = .false. + has_universe = .false. + has_material = .false. + has_fill = .false. + has_surfaces = .false. + call init_xml_type_cell_xml(dvar) + has_dvar = .true. + error = .false. + att_ = 0 + noatt_ = noattribs+1 + endtag_org = endtag + do + if ( nodata /= 0 ) then + noattribs = 0 + tag = starttag + elseif ( att_ < noatt_ .and. noatt_ > 1 ) then + att_ = att_ + 1 + if ( att_ <= noatt_-1 ) then + tag = attribs(1,att_) + data(1) = attribs(2,att_) + noattribs = 0 + nodata = 1 + endtag = .false. + else + tag = starttag + noattribs = 0 + nodata = 0 + endtag = .true. + cycle + endif + else + if ( endtag_org ) then + return + else + call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) + if ( xml_error(info) ) then + write(lurep_,*) 'Error reading input file!' + error = .true. + return + endif + endif + endif + if ( endtag .and. tag == starttag ) then + exit + endif + if ( endtag .and. noattribs == 0 ) then + if ( xml_ok(info) ) then + cycle + else + exit + endif + endif + select case( tag ) + case('uid') + call read_xml_integer( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%uid, has_uid ) + case('universe') + call read_xml_integer( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%universe, has_universe ) + case('material') + call read_xml_integer( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%material, has_material ) + case('fill') + call read_xml_integer( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%fill, has_fill ) + case('surfaces') + call read_xml_integer_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%surfaces, has_surfaces ) + case ('comment', '!--') + ! Simply ignore + case default + if ( strict_ ) then + error = .true. + call xml_report_errors( info, & + 'Unknown or wrongly placed tag: ' // trim(tag)) + endif + end select + nodata = 0 + if ( .not. xml_ok(info) ) exit + end do + if ( .not. has_uid ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on uid') + endif + if ( .not. has_surfaces ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on surfaces') + endif +end subroutine read_xml_type_cell_xml +subroutine init_xml_type_cell_xml_array( dvar ) + type(cell_xml), dimension(:), pointer :: dvar + if ( associated( dvar ) ) then + deallocate( dvar ) + endif + allocate( dvar(0) ) +end subroutine init_xml_type_cell_xml_array +subroutine init_xml_type_cell_xml(dvar) + type(cell_xml) :: dvar + dvar%universe = 0 + dvar%material = 0 + dvar%fill = 0 +end subroutine init_xml_type_cell_xml +subroutine write_xml_type_cell_xml_array( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(cell_xml), dimension(:) :: dvar + integer :: i + do i = 1,size(dvar) + call write_xml_type_cell_xml( info, tag, indent, dvar(i) ) + enddo +end subroutine write_xml_type_cell_xml_array + +subroutine write_xml_type_cell_xml( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(cell_xml) :: dvar + character(len=100) :: indentation + indentation = ' ' + write(info%lun, '(4a)' ) indentation(1:min(indent,100)),& + '<',trim(tag), '>' + call write_to_xml_integer( info, 'uid', indent+3, dvar%uid) + call write_to_xml_integer( info, 'universe', indent+3, dvar%universe) + call write_to_xml_integer( info, 'material', indent+3, dvar%material) + call write_to_xml_integer( info, 'fill', indent+3, dvar%fill) + call write_to_xml_integer_array( info, 'surfaces', indent+3, dvar%surfaces) + write(info%lun,'(4a)') indentation(1:min(indent,100)), & + '' +end subroutine write_xml_type_cell_xml + +subroutine read_xml_type_surface_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(inout) :: tag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(surface_xml), dimension(:), pointer :: dvar + logical, intent(inout) :: has_dvar + + integer :: newsize + type(surface_xml), dimension(:), pointer :: newvar + + newsize = size(dvar) + 1 + allocate( newvar(1:newsize) ) + newvar(1:newsize-1) = dvar + deallocate( dvar ) + dvar => newvar + + call read_xml_type_surface_xml( info, tag, endtag, attribs, noattribs, data, nodata, & + dvar(newsize), has_dvar ) +end subroutine read_xml_type_surface_xml_array + +subroutine read_xml_type_surface_xml( info, starttag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: starttag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(surface_xml), intent(inout) :: dvar + logical, intent(inout) :: has_dvar + + integer :: att_ + integer :: noatt_ + logical :: error + logical :: endtag_org + character(len=len(starttag)) :: tag + logical :: has_uid + logical :: has_type + logical :: has_coeffs + logical :: has_boundary + has_uid = .false. + has_type = .false. + has_coeffs = .false. + has_boundary = .false. + call init_xml_type_surface_xml(dvar) + has_dvar = .true. + error = .false. + att_ = 0 + noatt_ = noattribs+1 + endtag_org = endtag + do + if ( nodata /= 0 ) then + noattribs = 0 + tag = starttag + elseif ( att_ < noatt_ .and. noatt_ > 1 ) then + att_ = att_ + 1 + if ( att_ <= noatt_-1 ) then + tag = attribs(1,att_) + data(1) = attribs(2,att_) + noattribs = 0 + nodata = 1 + endtag = .false. + else + tag = starttag + noattribs = 0 + nodata = 0 + endtag = .true. + cycle + endif + else + if ( endtag_org ) then + return + else + call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) + if ( xml_error(info) ) then + write(lurep_,*) 'Error reading input file!' + error = .true. + return + endif + endif + endif + if ( endtag .and. tag == starttag ) then + exit + endif + if ( endtag .and. noattribs == 0 ) then + if ( xml_ok(info) ) then + cycle + else + exit + endif + endif + select case( tag ) + case('uid') + call read_xml_integer( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%uid, has_uid ) + case('type') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%type, has_type ) + case('coeffs') + call read_xml_double_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%coeffs, has_coeffs ) + case('boundary') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%boundary, has_boundary ) + case ('comment', '!--') + ! Simply ignore + case default + if ( strict_ ) then + error = .true. + call xml_report_errors( info, & + 'Unknown or wrongly placed tag: ' // trim(tag)) + endif + end select + nodata = 0 + if ( .not. xml_ok(info) ) exit + end do + if ( .not. has_uid ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on uid') + endif + if ( .not. has_type ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on type') + endif + if ( .not. has_coeffs ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on coeffs') + endif +end subroutine read_xml_type_surface_xml +subroutine init_xml_type_surface_xml_array( dvar ) + type(surface_xml), dimension(:), pointer :: dvar + if ( associated( dvar ) ) then + deallocate( dvar ) + endif + allocate( dvar(0) ) +end subroutine init_xml_type_surface_xml_array +subroutine init_xml_type_surface_xml(dvar) + type(surface_xml) :: dvar + dvar%boundary = 'transmit' +end subroutine init_xml_type_surface_xml +subroutine write_xml_type_surface_xml_array( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(surface_xml), dimension(:) :: dvar + integer :: i + do i = 1,size(dvar) + call write_xml_type_surface_xml( info, tag, indent, dvar(i) ) + enddo +end subroutine write_xml_type_surface_xml_array + +subroutine write_xml_type_surface_xml( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(surface_xml) :: dvar + character(len=100) :: indentation + indentation = ' ' + write(info%lun, '(4a)' ) indentation(1:min(indent,100)),& + '<',trim(tag), '>' + call write_to_xml_integer( info, 'uid', indent+3, dvar%uid) + call write_to_xml_word( info, 'type', indent+3, dvar%type) + call write_to_xml_double_array( info, 'coeffs', indent+3, dvar%coeffs) + call write_to_xml_word( info, 'boundary', indent+3, dvar%boundary) + write(info%lun,'(4a)') indentation(1:min(indent,100)), & + '' +end subroutine write_xml_type_surface_xml + +subroutine read_xml_type_lattice_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(inout) :: tag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(lattice_xml), dimension(:), pointer :: dvar + logical, intent(inout) :: has_dvar + + integer :: newsize + type(lattice_xml), dimension(:), pointer :: newvar + + newsize = size(dvar) + 1 + allocate( newvar(1:newsize) ) + newvar(1:newsize-1) = dvar + deallocate( dvar ) + dvar => newvar + + call read_xml_type_lattice_xml( info, tag, endtag, attribs, noattribs, data, nodata, & + dvar(newsize), has_dvar ) +end subroutine read_xml_type_lattice_xml_array + +subroutine read_xml_type_lattice_xml( info, starttag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: starttag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(lattice_xml), intent(inout) :: dvar + logical, intent(inout) :: has_dvar + + integer :: att_ + integer :: noatt_ + logical :: error + logical :: endtag_org + character(len=len(starttag)) :: tag + logical :: has_uid + logical :: has_type + logical :: has_dimension + logical :: has_origin + logical :: has_width + logical :: has_universes + has_uid = .false. + has_type = .false. + has_dimension = .false. + has_origin = .false. + has_width = .false. + has_universes = .false. + call init_xml_type_lattice_xml(dvar) + has_dvar = .true. + error = .false. + att_ = 0 + noatt_ = noattribs+1 + endtag_org = endtag + do + if ( nodata /= 0 ) then + noattribs = 0 + tag = starttag + elseif ( att_ < noatt_ .and. noatt_ > 1 ) then + att_ = att_ + 1 + if ( att_ <= noatt_-1 ) then + tag = attribs(1,att_) + data(1) = attribs(2,att_) + noattribs = 0 + nodata = 1 + endtag = .false. + else + tag = starttag + noattribs = 0 + nodata = 0 + endtag = .true. + cycle + endif + else + if ( endtag_org ) then + return + else + call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) + if ( xml_error(info) ) then + write(lurep_,*) 'Error reading input file!' + error = .true. + return + endif + endif + endif + if ( endtag .and. tag == starttag ) then + exit + endif + if ( endtag .and. noattribs == 0 ) then + if ( xml_ok(info) ) then + cycle + else + exit + endif + endif + select case( tag ) + case('uid') + call read_xml_integer( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%uid, has_uid ) + case('type') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%type, has_type ) + case('dimension') + call read_xml_integer_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%dimension, has_dimension ) + case('origin') + call read_xml_double_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%origin, has_origin ) + case('width') + call read_xml_double_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%width, has_width ) + case('universes') + call read_xml_integer_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%universes, has_universes ) + case ('comment', '!--') + ! Simply ignore + case default + if ( strict_ ) then + error = .true. + call xml_report_errors( info, & + 'Unknown or wrongly placed tag: ' // trim(tag)) + endif + end select + nodata = 0 + if ( .not. xml_ok(info) ) exit + end do + if ( .not. has_uid ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on uid') + endif + if ( .not. has_type ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on type') + endif + if ( .not. has_dimension ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on dimension') + endif + if ( .not. has_origin ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on origin') + endif + if ( .not. has_width ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on width') + endif + if ( .not. has_universes ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on universes') + endif +end subroutine read_xml_type_lattice_xml +subroutine init_xml_type_lattice_xml_array( dvar ) + type(lattice_xml), dimension(:), pointer :: dvar + if ( associated( dvar ) ) then + deallocate( dvar ) + endif + allocate( dvar(0) ) +end subroutine init_xml_type_lattice_xml_array +subroutine init_xml_type_lattice_xml(dvar) + type(lattice_xml) :: dvar +end subroutine init_xml_type_lattice_xml +subroutine write_xml_type_lattice_xml_array( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(lattice_xml), dimension(:) :: dvar + integer :: i + do i = 1,size(dvar) + call write_xml_type_lattice_xml( info, tag, indent, dvar(i) ) + enddo +end subroutine write_xml_type_lattice_xml_array + +subroutine write_xml_type_lattice_xml( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(lattice_xml) :: dvar + character(len=100) :: indentation + indentation = ' ' + write(info%lun, '(4a)' ) indentation(1:min(indent,100)),& + '<',trim(tag), '>' + call write_to_xml_integer( info, 'uid', indent+3, dvar%uid) + call write_to_xml_word( info, 'type', indent+3, dvar%type) + call write_to_xml_integer_array( info, 'dimension', indent+3, dvar%dimension) + call write_to_xml_double_array( info, 'origin', indent+3, dvar%origin) + call write_to_xml_double_array( info, 'width', indent+3, dvar%width) + call write_to_xml_integer_array( info, 'universes', indent+3, dvar%universes) + write(info%lun,'(4a)') indentation(1:min(indent,100)), & + '' +end subroutine write_xml_type_lattice_xml + +subroutine read_xml_file_geometry_t(fname, lurep, errout) + character(len=*), intent(in) :: fname + integer, intent(in), optional :: lurep + logical, intent(out), optional :: errout + + type(XML_PARSE) :: info + logical :: error + character(len=80) :: tag + character(len=80) :: starttag + logical :: endtag + character(len=80), dimension(1:2,1:20) :: attribs + integer :: noattribs + character(len=200), dimension(1:100) :: data + integer :: nodata + logical :: has_cell_ + logical :: has_surface_ + logical :: has_lattice_ + has_cell_ = .false. + allocate(cell_(0)) + has_surface_ = .false. + allocate(surface_(0)) + has_lattice_ = .false. + allocate(lattice_(0)) + + call init_xml_file_geometry_t + call xml_open( info, fname, .true. ) + call xml_options( info, report_errors=.true., ignore_whitespace=.true.) + lurep_ = 0 + if ( present(lurep) ) then + lurep_ = lurep + call xml_options( info, report_lun=lurep ) + endif + do + call xml_get( info, starttag, endtag, attribs, noattribs, & + data, nodata) + if ( starttag /= '!--' ) exit + enddo + if ( starttag /= "geometry" ) then + call xml_report_errors( info, & + 'XML-file should have root element "geometry"') + error = .true. + call xml_close(info) + return + endif + strict_ = .true. + error = .false. + do + call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) + if ( xml_error(info) ) then + write(lurep_,*) 'Error reading input file!' + error = .true. + return + endif + if ( endtag .and. tag == starttag ) then + exit + endif + if ( endtag .and. noattribs == 0 ) then + if ( xml_ok(info) ) then + cycle + else + exit + endif + endif + select case( tag ) + case('cell') + call read_xml_type_cell_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + cell_, has_cell_ ) + case('surface') + call read_xml_type_surface_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + surface_, has_surface_ ) + case('lattice') + call read_xml_type_lattice_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + lattice_, has_lattice_ ) + case ('comment', '!--') + ! Simply ignore + case default + if ( strict_ ) then + error = .true. + call xml_report_errors( info, & + 'Unknown or wrongly placed tag: ' // trim(tag)) + endif + end select + nodata = 0 + if ( .not. xml_ok(info) ) exit + end do + if ( .not. has_cell_ ) then + error = .true. + call xml_report_errors(info, 'Missing data on cell_') + endif + if ( .not. has_surface_ ) then + error = .true. + call xml_report_errors(info, 'Missing data on surface_') + endif + if ( .not. has_lattice_ ) then + error = .true. + call xml_report_errors(info, 'Missing data on lattice_') + endif + if ( present(errout) ) errout = error +end subroutine + +subroutine write_xml_file_geometry_t(fname, lurep) + character(len=*), intent(in) :: fname + integer, intent(in), optional :: lurep + + type(XML_PARSE) :: info + integer :: indent = 0 + + call xml_open( info, fname, .false. ) + call xml_options( info, report_errors=.true.) + if ( present(lurep) ) then + call xml_options( info, report_errors=.true.) + endif + write(info%lun,'(a)') & + '' + call write_xml_type_cell_xml_array( info, 'cell', indent+3, cell_) + call write_xml_type_surface_xml_array( info, 'surface', indent+3, surface_) + call write_xml_type_lattice_xml_array( info, 'lattice', indent+3, lattice_) + write(info%lun,'(a)') '' + call xml_close(info) +end subroutine + +subroutine init_xml_file_geometry_t + +end subroutine + +end module diff --git a/src/xml_material.f90 b/src/xml_material.f90 new file mode 100644 index 0000000000..f86bf024f5 --- /dev/null +++ b/src/xml_material.f90 @@ -0,0 +1,822 @@ +module xml_data_material_t + use READ_XML_PRIMITIVES + use WRITE_XML_PRIMITIVES + use XMLPARSE + implicit none + integer, private :: lurep_ + logical, private :: strict_ + +type density_xml + real(kind=kind(1.0d0)) :: value + character(len=10) :: units +end type density_xml + +type nuclide_xml + character(len=10) :: name + character(len=3) :: xs + real(kind=kind(1.0d0)) :: ao + real(kind=kind(1.0d0)) :: wo +end type nuclide_xml + +type sab_xml + character(len=10) :: name + character(len=3) :: xs +end type sab_xml + +type material_xml + integer :: uid + type(density_xml) :: density + type(nuclide_xml), dimension(:), pointer :: nuclides => null() + type(sab_xml) :: sab +end type material_xml + type(material_xml), dimension(:), pointer :: material_ => null() +contains +subroutine read_xml_type_density_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(inout) :: tag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(density_xml), dimension(:), pointer :: dvar + logical, intent(inout) :: has_dvar + + integer :: newsize + type(density_xml), dimension(:), pointer :: newvar + + newsize = size(dvar) + 1 + allocate( newvar(1:newsize) ) + newvar(1:newsize-1) = dvar + deallocate( dvar ) + dvar => newvar + + call read_xml_type_density_xml( info, tag, endtag, attribs, noattribs, data, nodata, & + dvar(newsize), has_dvar ) +end subroutine read_xml_type_density_xml_array + +subroutine read_xml_type_density_xml( info, starttag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: starttag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(density_xml), intent(inout) :: dvar + logical, intent(inout) :: has_dvar + + integer :: att_ + integer :: noatt_ + logical :: error + logical :: endtag_org + character(len=len(starttag)) :: tag + logical :: has_value + logical :: has_units + has_value = .false. + has_units = .false. + call init_xml_type_density_xml(dvar) + has_dvar = .true. + error = .false. + att_ = 0 + noatt_ = noattribs+1 + endtag_org = endtag + do + if ( nodata /= 0 ) then + noattribs = 0 + tag = starttag + elseif ( att_ < noatt_ .and. noatt_ > 1 ) then + att_ = att_ + 1 + if ( att_ <= noatt_-1 ) then + tag = attribs(1,att_) + data(1) = attribs(2,att_) + noattribs = 0 + nodata = 1 + endtag = .false. + else + tag = starttag + noattribs = 0 + nodata = 0 + endtag = .true. + cycle + endif + else + if ( endtag_org ) then + return + else + call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) + if ( xml_error(info) ) then + write(lurep_,*) 'Error reading input file!' + error = .true. + return + endif + endif + endif + if ( endtag .and. tag == starttag ) then + exit + endif + if ( endtag .and. noattribs == 0 ) then + if ( xml_ok(info) ) then + cycle + else + exit + endif + endif + select case( tag ) + case('value') + call read_xml_double( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%value, has_value ) + case('units') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%units, has_units ) + case ('comment', '!--') + ! Simply ignore + case default + if ( strict_ ) then + error = .true. + call xml_report_errors( info, & + 'Unknown or wrongly placed tag: ' // trim(tag)) + endif + end select + nodata = 0 + if ( .not. xml_ok(info) ) exit + end do + if ( .not. has_value ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on value') + endif +end subroutine read_xml_type_density_xml +subroutine init_xml_type_density_xml_array( dvar ) + type(density_xml), dimension(:), pointer :: dvar + if ( associated( dvar ) ) then + deallocate( dvar ) + endif + allocate( dvar(0) ) +end subroutine init_xml_type_density_xml_array +subroutine init_xml_type_density_xml(dvar) + type(density_xml) :: dvar + dvar%units = 'atom/b-cm' +end subroutine init_xml_type_density_xml +subroutine write_xml_type_density_xml_array( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(density_xml), dimension(:) :: dvar + integer :: i + do i = 1,size(dvar) + call write_xml_type_density_xml( info, tag, indent, dvar(i) ) + enddo +end subroutine write_xml_type_density_xml_array + +subroutine write_xml_type_density_xml( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(density_xml) :: dvar + character(len=100) :: indentation + indentation = ' ' + write(info%lun, '(4a)' ) indentation(1:min(indent,100)),& + '<',trim(tag), '>' + call write_to_xml_double( info, 'value', indent+3, dvar%value) + call write_to_xml_word( info, 'units', indent+3, dvar%units) + write(info%lun,'(4a)') indentation(1:min(indent,100)), & + '' +end subroutine write_xml_type_density_xml + +subroutine read_xml_type_nuclide_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(inout) :: tag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(nuclide_xml), dimension(:), pointer :: dvar + logical, intent(inout) :: has_dvar + + integer :: newsize + type(nuclide_xml), dimension(:), pointer :: newvar + + newsize = size(dvar) + 1 + allocate( newvar(1:newsize) ) + newvar(1:newsize-1) = dvar + deallocate( dvar ) + dvar => newvar + + call read_xml_type_nuclide_xml( info, tag, endtag, attribs, noattribs, data, nodata, & + dvar(newsize), has_dvar ) +end subroutine read_xml_type_nuclide_xml_array + +subroutine read_xml_type_nuclide_xml( info, starttag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: starttag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(nuclide_xml), intent(inout) :: dvar + logical, intent(inout) :: has_dvar + + integer :: att_ + integer :: noatt_ + logical :: error + logical :: endtag_org + character(len=len(starttag)) :: tag + logical :: has_name + logical :: has_xs + logical :: has_ao + logical :: has_wo + has_name = .false. + has_xs = .false. + has_ao = .false. + has_wo = .false. + call init_xml_type_nuclide_xml(dvar) + has_dvar = .true. + error = .false. + att_ = 0 + noatt_ = noattribs+1 + endtag_org = endtag + do + if ( nodata /= 0 ) then + noattribs = 0 + tag = starttag + elseif ( att_ < noatt_ .and. noatt_ > 1 ) then + att_ = att_ + 1 + if ( att_ <= noatt_-1 ) then + tag = attribs(1,att_) + data(1) = attribs(2,att_) + noattribs = 0 + nodata = 1 + endtag = .false. + else + tag = starttag + noattribs = 0 + nodata = 0 + endtag = .true. + cycle + endif + else + if ( endtag_org ) then + return + else + call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) + if ( xml_error(info) ) then + write(lurep_,*) 'Error reading input file!' + error = .true. + return + endif + endif + endif + if ( endtag .and. tag == starttag ) then + exit + endif + if ( endtag .and. noattribs == 0 ) then + if ( xml_ok(info) ) then + cycle + else + exit + endif + endif + select case( tag ) + case('name') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%name, has_name ) + case('xs') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%xs, has_xs ) + case('ao') + call read_xml_double( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%ao, has_ao ) + case('wo') + call read_xml_double( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%wo, has_wo ) + case ('comment', '!--') + ! Simply ignore + case default + if ( strict_ ) then + error = .true. + call xml_report_errors( info, & + 'Unknown or wrongly placed tag: ' // trim(tag)) + endif + end select + nodata = 0 + if ( .not. xml_ok(info) ) exit + end do + if ( .not. has_name ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on name') + endif + if ( .not. has_xs ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on xs') + endif +end subroutine read_xml_type_nuclide_xml +subroutine init_xml_type_nuclide_xml_array( dvar ) + type(nuclide_xml), dimension(:), pointer :: dvar + if ( associated( dvar ) ) then + deallocate( dvar ) + endif + allocate( dvar(0) ) +end subroutine init_xml_type_nuclide_xml_array +subroutine init_xml_type_nuclide_xml(dvar) + type(nuclide_xml) :: dvar + dvar%ao = 0.0 + dvar%wo = 0.0 +end subroutine init_xml_type_nuclide_xml +subroutine write_xml_type_nuclide_xml_array( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(nuclide_xml), dimension(:) :: dvar + integer :: i + do i = 1,size(dvar) + call write_xml_type_nuclide_xml( info, tag, indent, dvar(i) ) + enddo +end subroutine write_xml_type_nuclide_xml_array + +subroutine write_xml_type_nuclide_xml( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(nuclide_xml) :: dvar + character(len=100) :: indentation + indentation = ' ' + write(info%lun, '(4a)' ) indentation(1:min(indent,100)),& + '<',trim(tag), '>' + call write_to_xml_word( info, 'name', indent+3, dvar%name) + call write_to_xml_word( info, 'xs', indent+3, dvar%xs) + call write_to_xml_double( info, 'ao', indent+3, dvar%ao) + call write_to_xml_double( info, 'wo', indent+3, dvar%wo) + write(info%lun,'(4a)') indentation(1:min(indent,100)), & + '' +end subroutine write_xml_type_nuclide_xml + +subroutine read_xml_type_sab_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(inout) :: tag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(sab_xml), dimension(:), pointer :: dvar + logical, intent(inout) :: has_dvar + + integer :: newsize + type(sab_xml), dimension(:), pointer :: newvar + + newsize = size(dvar) + 1 + allocate( newvar(1:newsize) ) + newvar(1:newsize-1) = dvar + deallocate( dvar ) + dvar => newvar + + call read_xml_type_sab_xml( info, tag, endtag, attribs, noattribs, data, nodata, & + dvar(newsize), has_dvar ) +end subroutine read_xml_type_sab_xml_array + +subroutine read_xml_type_sab_xml( info, starttag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: starttag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(sab_xml), intent(inout) :: dvar + logical, intent(inout) :: has_dvar + + integer :: att_ + integer :: noatt_ + logical :: error + logical :: endtag_org + character(len=len(starttag)) :: tag + logical :: has_name + logical :: has_xs + has_name = .false. + has_xs = .false. + call init_xml_type_sab_xml(dvar) + has_dvar = .true. + error = .false. + att_ = 0 + noatt_ = noattribs+1 + endtag_org = endtag + do + if ( nodata /= 0 ) then + noattribs = 0 + tag = starttag + elseif ( att_ < noatt_ .and. noatt_ > 1 ) then + att_ = att_ + 1 + if ( att_ <= noatt_-1 ) then + tag = attribs(1,att_) + data(1) = attribs(2,att_) + noattribs = 0 + nodata = 1 + endtag = .false. + else + tag = starttag + noattribs = 0 + nodata = 0 + endtag = .true. + cycle + endif + else + if ( endtag_org ) then + return + else + call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) + if ( xml_error(info) ) then + write(lurep_,*) 'Error reading input file!' + error = .true. + return + endif + endif + endif + if ( endtag .and. tag == starttag ) then + exit + endif + if ( endtag .and. noattribs == 0 ) then + if ( xml_ok(info) ) then + cycle + else + exit + endif + endif + select case( tag ) + case('name') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%name, has_name ) + case('xs') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%xs, has_xs ) + case ('comment', '!--') + ! Simply ignore + case default + if ( strict_ ) then + error = .true. + call xml_report_errors( info, & + 'Unknown or wrongly placed tag: ' // trim(tag)) + endif + end select + nodata = 0 + if ( .not. xml_ok(info) ) exit + end do + if ( .not. has_name ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on name') + endif + if ( .not. has_xs ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on xs') + endif +end subroutine read_xml_type_sab_xml +subroutine init_xml_type_sab_xml_array( dvar ) + type(sab_xml), dimension(:), pointer :: dvar + if ( associated( dvar ) ) then + deallocate( dvar ) + endif + allocate( dvar(0) ) +end subroutine init_xml_type_sab_xml_array +subroutine init_xml_type_sab_xml(dvar) + type(sab_xml) :: dvar +end subroutine init_xml_type_sab_xml +subroutine write_xml_type_sab_xml_array( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(sab_xml), dimension(:) :: dvar + integer :: i + do i = 1,size(dvar) + call write_xml_type_sab_xml( info, tag, indent, dvar(i) ) + enddo +end subroutine write_xml_type_sab_xml_array + +subroutine write_xml_type_sab_xml( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(sab_xml) :: dvar + character(len=100) :: indentation + indentation = ' ' + write(info%lun, '(4a)' ) indentation(1:min(indent,100)),& + '<',trim(tag), '>' + call write_to_xml_word( info, 'name', indent+3, dvar%name) + call write_to_xml_word( info, 'xs', indent+3, dvar%xs) + write(info%lun,'(4a)') indentation(1:min(indent,100)), & + '' +end subroutine write_xml_type_sab_xml + +subroutine read_xml_type_material_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(inout) :: tag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(material_xml), dimension(:), pointer :: dvar + logical, intent(inout) :: has_dvar + + integer :: newsize + type(material_xml), dimension(:), pointer :: newvar + + newsize = size(dvar) + 1 + allocate( newvar(1:newsize) ) + newvar(1:newsize-1) = dvar + deallocate( dvar ) + dvar => newvar + + call read_xml_type_material_xml( info, tag, endtag, attribs, noattribs, data, nodata, & + dvar(newsize), has_dvar ) +end subroutine read_xml_type_material_xml_array + +subroutine read_xml_type_material_xml( info, starttag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: starttag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(material_xml), intent(inout) :: dvar + logical, intent(inout) :: has_dvar + + integer :: att_ + integer :: noatt_ + logical :: error + logical :: endtag_org + character(len=len(starttag)) :: tag + logical :: has_uid + logical :: has_density + logical :: has_nuclides + logical :: has_sab + has_uid = .false. + has_density = .false. + has_nuclides = .false. + allocate(dvar%nuclides(0)) + has_sab = .false. + call init_xml_type_material_xml(dvar) + has_dvar = .true. + error = .false. + att_ = 0 + noatt_ = noattribs+1 + endtag_org = endtag + do + if ( nodata /= 0 ) then + noattribs = 0 + tag = starttag + elseif ( att_ < noatt_ .and. noatt_ > 1 ) then + att_ = att_ + 1 + if ( att_ <= noatt_-1 ) then + tag = attribs(1,att_) + data(1) = attribs(2,att_) + noattribs = 0 + nodata = 1 + endtag = .false. + else + tag = starttag + noattribs = 0 + nodata = 0 + endtag = .true. + cycle + endif + else + if ( endtag_org ) then + return + else + call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) + if ( xml_error(info) ) then + write(lurep_,*) 'Error reading input file!' + error = .true. + return + endif + endif + endif + if ( endtag .and. tag == starttag ) then + exit + endif + if ( endtag .and. noattribs == 0 ) then + if ( xml_ok(info) ) then + cycle + else + exit + endif + endif + select case( tag ) + case('uid') + call read_xml_integer( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%uid, has_uid ) + case('density') + call read_xml_type_density_xml( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%density, has_density ) + case('nuclide') + call read_xml_type_nuclide_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%nuclides, has_nuclides ) + case('sab') + call read_xml_type_sab_xml( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%sab, has_sab ) + case ('comment', '!--') + ! Simply ignore + case default + if ( strict_ ) then + error = .true. + call xml_report_errors( info, & + 'Unknown or wrongly placed tag: ' // trim(tag)) + endif + end select + nodata = 0 + if ( .not. xml_ok(info) ) exit + end do + if ( .not. has_uid ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on uid') + endif + if ( .not. has_density ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on density') + endif + if ( .not. has_nuclides ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on nuclides') + endif + if ( .not. has_sab ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on sab') + endif +end subroutine read_xml_type_material_xml +subroutine init_xml_type_material_xml_array( dvar ) + type(material_xml), dimension(:), pointer :: dvar + if ( associated( dvar ) ) then + deallocate( dvar ) + endif + allocate( dvar(0) ) +end subroutine init_xml_type_material_xml_array +subroutine init_xml_type_material_xml(dvar) + type(material_xml) :: dvar +end subroutine init_xml_type_material_xml +subroutine write_xml_type_material_xml_array( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(material_xml), dimension(:) :: dvar + integer :: i + do i = 1,size(dvar) + call write_xml_type_material_xml( info, tag, indent, dvar(i) ) + enddo +end subroutine write_xml_type_material_xml_array + +subroutine write_xml_type_material_xml( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(material_xml) :: dvar + character(len=100) :: indentation + indentation = ' ' + write(info%lun, '(4a)' ) indentation(1:min(indent,100)),& + '<',trim(tag), '>' + call write_to_xml_integer( info, 'uid', indent+3, dvar%uid) + call write_xml_type_density_xml( info, 'density', indent+3, dvar%density) + call write_xml_type_nuclide_xml_array( info, 'nuclide', indent+3, dvar%nuclides) + call write_xml_type_sab_xml( info, 'sab', indent+3, dvar%sab) + write(info%lun,'(4a)') indentation(1:min(indent,100)), & + '' +end subroutine write_xml_type_material_xml + +subroutine read_xml_file_material_t(fname, lurep, errout) + character(len=*), intent(in) :: fname + integer, intent(in), optional :: lurep + logical, intent(out), optional :: errout + + type(XML_PARSE) :: info + logical :: error + character(len=80) :: tag + character(len=80) :: starttag + logical :: endtag + character(len=80), dimension(1:2,1:20) :: attribs + integer :: noattribs + character(len=200), dimension(1:100) :: data + integer :: nodata + logical :: has_material_ + has_material_ = .false. + allocate(material_(0)) + + call init_xml_file_material_t + call xml_open( info, fname, .true. ) + call xml_options( info, report_errors=.true., ignore_whitespace=.true.) + lurep_ = 0 + if ( present(lurep) ) then + lurep_ = lurep + call xml_options( info, report_lun=lurep ) + endif + do + call xml_get( info, starttag, endtag, attribs, noattribs, & + data, nodata) + if ( starttag /= '!--' ) exit + enddo + if ( starttag /= "materials" ) then + call xml_report_errors( info, & + 'XML-file should have root element "materials"') + error = .true. + call xml_close(info) + return + endif + strict_ = .false. + error = .false. + do + call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) + if ( xml_error(info) ) then + write(lurep_,*) 'Error reading input file!' + error = .true. + return + endif + if ( endtag .and. tag == starttag ) then + exit + endif + if ( endtag .and. noattribs == 0 ) then + if ( xml_ok(info) ) then + cycle + else + exit + endif + endif + select case( tag ) + case('material') + call read_xml_type_material_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + material_, has_material_ ) + case ('comment', '!--') + ! Simply ignore + case default + if ( strict_ ) then + error = .true. + call xml_report_errors( info, & + 'Unknown or wrongly placed tag: ' // trim(tag)) + endif + end select + nodata = 0 + if ( .not. xml_ok(info) ) exit + end do + if ( .not. has_material_ ) then + error = .true. + call xml_report_errors(info, 'Missing data on material_') + endif + if ( present(errout) ) errout = error +end subroutine + +subroutine write_xml_file_material_t(fname, lurep) + character(len=*), intent(in) :: fname + integer, intent(in), optional :: lurep + + type(XML_PARSE) :: info + integer :: indent = 0 + + call xml_open( info, fname, .false. ) + call xml_options( info, report_errors=.true.) + if ( present(lurep) ) then + call xml_options( info, report_errors=.true.) + endif + write(info%lun,'(a)') & + '' + call write_xml_type_material_xml_array( info, 'material', indent+3, material_) + write(info%lun,'(a)') '' + call xml_close(info) +end subroutine + +subroutine init_xml_file_material_t + +end subroutine + +end module diff --git a/src/xml_settings.f90 b/src/xml_settings.f90 new file mode 100644 index 0000000000..243936be53 --- /dev/null +++ b/src/xml_settings.f90 @@ -0,0 +1,650 @@ +module xml_data_settings_t + use READ_XML_PRIMITIVES + use WRITE_XML_PRIMITIVES + use XMLPARSE + implicit none + integer, private :: lurep_ + logical, private :: strict_ + +type xslibrary_xml + character(len=250) :: path +end type xslibrary_xml + +type criticality_xml + integer :: cycles + integer :: inactive + integer :: particles +end type criticality_xml + +type source_xml + character(len=10) :: type + real(kind=kind(1.0d0)), dimension(:), pointer :: coeffs => null() +end type source_xml + type(xslibrary_xml) :: xslibrary + type(criticality_xml) :: criticality + integer :: verbosity_ + type(source_xml) :: source_ +contains +subroutine read_xml_type_xslibrary_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(inout) :: tag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(xslibrary_xml), dimension(:), pointer :: dvar + logical, intent(inout) :: has_dvar + + integer :: newsize + type(xslibrary_xml), dimension(:), pointer :: newvar + + newsize = size(dvar) + 1 + allocate( newvar(1:newsize) ) + newvar(1:newsize-1) = dvar + deallocate( dvar ) + dvar => newvar + + call read_xml_type_xslibrary_xml( info, tag, endtag, attribs, noattribs, data, nodata, & + dvar(newsize), has_dvar ) +end subroutine read_xml_type_xslibrary_xml_array + +subroutine read_xml_type_xslibrary_xml( info, starttag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: starttag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(xslibrary_xml), intent(inout) :: dvar + logical, intent(inout) :: has_dvar + + integer :: att_ + integer :: noatt_ + logical :: error + logical :: endtag_org + character(len=len(starttag)) :: tag + logical :: has_path + has_path = .false. + call init_xml_type_xslibrary_xml(dvar) + has_dvar = .true. + error = .false. + att_ = 0 + noatt_ = noattribs+1 + endtag_org = endtag + do + if ( nodata /= 0 ) then + noattribs = 0 + tag = starttag + elseif ( att_ < noatt_ .and. noatt_ > 1 ) then + att_ = att_ + 1 + if ( att_ <= noatt_-1 ) then + tag = attribs(1,att_) + data(1) = attribs(2,att_) + noattribs = 0 + nodata = 1 + endtag = .false. + else + tag = starttag + noattribs = 0 + nodata = 0 + endtag = .true. + cycle + endif + else + if ( endtag_org ) then + return + else + call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) + if ( xml_error(info) ) then + write(lurep_,*) 'Error reading input file!' + error = .true. + return + endif + endif + endif + if ( endtag .and. tag == starttag ) then + exit + endif + if ( endtag .and. noattribs == 0 ) then + if ( xml_ok(info) ) then + cycle + else + exit + endif + endif + select case( tag ) + case('path') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%path, has_path ) + case ('comment', '!--') + ! Simply ignore + case default + if ( strict_ ) then + error = .true. + call xml_report_errors( info, & + 'Unknown or wrongly placed tag: ' // trim(tag)) + endif + end select + nodata = 0 + if ( .not. xml_ok(info) ) exit + end do + if ( .not. has_path ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on path') + endif +end subroutine read_xml_type_xslibrary_xml +subroutine init_xml_type_xslibrary_xml_array( dvar ) + type(xslibrary_xml), dimension(:), pointer :: dvar + if ( associated( dvar ) ) then + deallocate( dvar ) + endif + allocate( dvar(0) ) +end subroutine init_xml_type_xslibrary_xml_array +subroutine init_xml_type_xslibrary_xml(dvar) + type(xslibrary_xml) :: dvar +end subroutine init_xml_type_xslibrary_xml +subroutine write_xml_type_xslibrary_xml_array( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(xslibrary_xml), dimension(:) :: dvar + integer :: i + do i = 1,size(dvar) + call write_xml_type_xslibrary_xml( info, tag, indent, dvar(i) ) + enddo +end subroutine write_xml_type_xslibrary_xml_array + +subroutine write_xml_type_xslibrary_xml( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(xslibrary_xml) :: dvar + character(len=100) :: indentation + indentation = ' ' + write(info%lun, '(4a)' ) indentation(1:min(indent,100)),& + '<',trim(tag), '>' + call write_to_xml_word( info, 'path', indent+3, dvar%path) + write(info%lun,'(4a)') indentation(1:min(indent,100)), & + '' +end subroutine write_xml_type_xslibrary_xml + +subroutine read_xml_type_criticality_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(inout) :: tag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(criticality_xml), dimension(:), pointer :: dvar + logical, intent(inout) :: has_dvar + + integer :: newsize + type(criticality_xml), dimension(:), pointer :: newvar + + newsize = size(dvar) + 1 + allocate( newvar(1:newsize) ) + newvar(1:newsize-1) = dvar + deallocate( dvar ) + dvar => newvar + + call read_xml_type_criticality_xml( info, tag, endtag, attribs, noattribs, data, nodata, & + dvar(newsize), has_dvar ) +end subroutine read_xml_type_criticality_xml_array + +subroutine read_xml_type_criticality_xml( info, starttag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: starttag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(criticality_xml), intent(inout) :: dvar + logical, intent(inout) :: has_dvar + + integer :: att_ + integer :: noatt_ + logical :: error + logical :: endtag_org + character(len=len(starttag)) :: tag + logical :: has_cycles + logical :: has_inactive + logical :: has_particles + has_cycles = .false. + has_inactive = .false. + has_particles = .false. + call init_xml_type_criticality_xml(dvar) + has_dvar = .true. + error = .false. + att_ = 0 + noatt_ = noattribs+1 + endtag_org = endtag + do + if ( nodata /= 0 ) then + noattribs = 0 + tag = starttag + elseif ( att_ < noatt_ .and. noatt_ > 1 ) then + att_ = att_ + 1 + if ( att_ <= noatt_-1 ) then + tag = attribs(1,att_) + data(1) = attribs(2,att_) + noattribs = 0 + nodata = 1 + endtag = .false. + else + tag = starttag + noattribs = 0 + nodata = 0 + endtag = .true. + cycle + endif + else + if ( endtag_org ) then + return + else + call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) + if ( xml_error(info) ) then + write(lurep_,*) 'Error reading input file!' + error = .true. + return + endif + endif + endif + if ( endtag .and. tag == starttag ) then + exit + endif + if ( endtag .and. noattribs == 0 ) then + if ( xml_ok(info) ) then + cycle + else + exit + endif + endif + select case( tag ) + case('cycles') + call read_xml_integer( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%cycles, has_cycles ) + case('inactive') + call read_xml_integer( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%inactive, has_inactive ) + case('particles') + call read_xml_integer( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%particles, has_particles ) + case ('comment', '!--') + ! Simply ignore + case default + if ( strict_ ) then + error = .true. + call xml_report_errors( info, & + 'Unknown or wrongly placed tag: ' // trim(tag)) + endif + end select + nodata = 0 + if ( .not. xml_ok(info) ) exit + end do + if ( .not. has_cycles ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on cycles') + endif + if ( .not. has_inactive ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on inactive') + endif + if ( .not. has_particles ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on particles') + endif +end subroutine read_xml_type_criticality_xml +subroutine init_xml_type_criticality_xml_array( dvar ) + type(criticality_xml), dimension(:), pointer :: dvar + if ( associated( dvar ) ) then + deallocate( dvar ) + endif + allocate( dvar(0) ) +end subroutine init_xml_type_criticality_xml_array +subroutine init_xml_type_criticality_xml(dvar) + type(criticality_xml) :: dvar +end subroutine init_xml_type_criticality_xml +subroutine write_xml_type_criticality_xml_array( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(criticality_xml), dimension(:) :: dvar + integer :: i + do i = 1,size(dvar) + call write_xml_type_criticality_xml( info, tag, indent, dvar(i) ) + enddo +end subroutine write_xml_type_criticality_xml_array + +subroutine write_xml_type_criticality_xml( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(criticality_xml) :: dvar + character(len=100) :: indentation + indentation = ' ' + write(info%lun, '(4a)' ) indentation(1:min(indent,100)),& + '<',trim(tag), '>' + call write_to_xml_integer( info, 'cycles', indent+3, dvar%cycles) + call write_to_xml_integer( info, 'inactive', indent+3, dvar%inactive) + call write_to_xml_integer( info, 'particles', indent+3, dvar%particles) + write(info%lun,'(4a)') indentation(1:min(indent,100)), & + '' +end subroutine write_xml_type_criticality_xml + +subroutine read_xml_type_source_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(inout) :: tag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(source_xml), dimension(:), pointer :: dvar + logical, intent(inout) :: has_dvar + + integer :: newsize + type(source_xml), dimension(:), pointer :: newvar + + newsize = size(dvar) + 1 + allocate( newvar(1:newsize) ) + newvar(1:newsize-1) = dvar + deallocate( dvar ) + dvar => newvar + + call read_xml_type_source_xml( info, tag, endtag, attribs, noattribs, data, nodata, & + dvar(newsize), has_dvar ) +end subroutine read_xml_type_source_xml_array + +subroutine read_xml_type_source_xml( info, starttag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: starttag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(source_xml), intent(inout) :: dvar + logical, intent(inout) :: has_dvar + + integer :: att_ + integer :: noatt_ + logical :: error + logical :: endtag_org + character(len=len(starttag)) :: tag + logical :: has_type + logical :: has_coeffs + has_type = .false. + has_coeffs = .false. + call init_xml_type_source_xml(dvar) + has_dvar = .true. + error = .false. + att_ = 0 + noatt_ = noattribs+1 + endtag_org = endtag + do + if ( nodata /= 0 ) then + noattribs = 0 + tag = starttag + elseif ( att_ < noatt_ .and. noatt_ > 1 ) then + att_ = att_ + 1 + if ( att_ <= noatt_-1 ) then + tag = attribs(1,att_) + data(1) = attribs(2,att_) + noattribs = 0 + nodata = 1 + endtag = .false. + else + tag = starttag + noattribs = 0 + nodata = 0 + endtag = .true. + cycle + endif + else + if ( endtag_org ) then + return + else + call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) + if ( xml_error(info) ) then + write(lurep_,*) 'Error reading input file!' + error = .true. + return + endif + endif + endif + if ( endtag .and. tag == starttag ) then + exit + endif + if ( endtag .and. noattribs == 0 ) then + if ( xml_ok(info) ) then + cycle + else + exit + endif + endif + select case( tag ) + case('type') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%type, has_type ) + case('coeffs') + call read_xml_double_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%coeffs, has_coeffs ) + case ('comment', '!--') + ! Simply ignore + case default + if ( strict_ ) then + error = .true. + call xml_report_errors( info, & + 'Unknown or wrongly placed tag: ' // trim(tag)) + endif + end select + nodata = 0 + if ( .not. xml_ok(info) ) exit + end do + if ( .not. has_type ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on type') + endif + if ( .not. has_coeffs ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on coeffs') + endif +end subroutine read_xml_type_source_xml +subroutine init_xml_type_source_xml_array( dvar ) + type(source_xml), dimension(:), pointer :: dvar + if ( associated( dvar ) ) then + deallocate( dvar ) + endif + allocate( dvar(0) ) +end subroutine init_xml_type_source_xml_array +subroutine init_xml_type_source_xml(dvar) + type(source_xml) :: dvar +end subroutine init_xml_type_source_xml +subroutine write_xml_type_source_xml_array( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(source_xml), dimension(:) :: dvar + integer :: i + do i = 1,size(dvar) + call write_xml_type_source_xml( info, tag, indent, dvar(i) ) + enddo +end subroutine write_xml_type_source_xml_array + +subroutine write_xml_type_source_xml( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(source_xml) :: dvar + character(len=100) :: indentation + indentation = ' ' + write(info%lun, '(4a)' ) indentation(1:min(indent,100)),& + '<',trim(tag), '>' + call write_to_xml_word( info, 'type', indent+3, dvar%type) + call write_to_xml_double_array( info, 'coeffs', indent+3, dvar%coeffs) + write(info%lun,'(4a)') indentation(1:min(indent,100)), & + '' +end subroutine write_xml_type_source_xml + +subroutine read_xml_file_settings_t(fname, lurep, errout) + character(len=*), intent(in) :: fname + integer, intent(in), optional :: lurep + logical, intent(out), optional :: errout + + type(XML_PARSE) :: info + logical :: error + character(len=80) :: tag + character(len=80) :: starttag + logical :: endtag + character(len=80), dimension(1:2,1:20) :: attribs + integer :: noattribs + character(len=200), dimension(1:100) :: data + integer :: nodata + logical :: has_xslibrary + logical :: has_criticality + logical :: has_verbosity_ + logical :: has_source_ + has_xslibrary = .false. + has_criticality = .false. + has_verbosity_ = .false. + has_source_ = .false. + + call init_xml_file_settings_t + call xml_open( info, fname, .true. ) + call xml_options( info, report_errors=.true., ignore_whitespace=.true.) + lurep_ = 0 + if ( present(lurep) ) then + lurep_ = lurep + call xml_options( info, report_lun=lurep ) + endif + do + call xml_get( info, starttag, endtag, attribs, noattribs, & + data, nodata) + if ( starttag /= '!--' ) exit + enddo + if ( starttag /= "settings" ) then + call xml_report_errors( info, & + 'XML-file should have root element "settings"') + error = .true. + call xml_close(info) + return + endif + strict_ = .false. + error = .false. + do + call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) + if ( xml_error(info) ) then + write(lurep_,*) 'Error reading input file!' + error = .true. + return + endif + if ( endtag .and. tag == starttag ) then + exit + endif + if ( endtag .and. noattribs == 0 ) then + if ( xml_ok(info) ) then + cycle + else + exit + endif + endif + select case( tag ) + case('xslibrary') + call read_xml_type_xslibrary_xml( & + info, tag, endtag, attribs, noattribs, data, nodata, & + xslibrary, has_xslibrary ) + case('criticality') + call read_xml_type_criticality_xml( & + info, tag, endtag, attribs, noattribs, data, nodata, & + criticality, has_criticality ) + case('verbosity') + call read_xml_integer( & + info, tag, endtag, attribs, noattribs, data, nodata, & + verbosity_, has_verbosity_ ) + case('source') + call read_xml_type_source_xml( & + info, tag, endtag, attribs, noattribs, data, nodata, & + source_, has_source_ ) + case ('comment', '!--') + ! Simply ignore + case default + if ( strict_ ) then + error = .true. + call xml_report_errors( info, & + 'Unknown or wrongly placed tag: ' // trim(tag)) + endif + end select + nodata = 0 + if ( .not. xml_ok(info) ) exit + end do + if ( .not. has_xslibrary ) then + error = .true. + call xml_report_errors(info, 'Missing data on xslibrary') + endif + if ( .not. has_criticality ) then + error = .true. + call xml_report_errors(info, 'Missing data on criticality') + endif + if ( .not. has_verbosity_ ) then + error = .true. + call xml_report_errors(info, 'Missing data on verbosity_') + endif + if ( .not. has_source_ ) then + error = .true. + call xml_report_errors(info, 'Missing data on source_') + endif + if ( present(errout) ) errout = error +end subroutine + +subroutine write_xml_file_settings_t(fname, lurep) + character(len=*), intent(in) :: fname + integer, intent(in), optional :: lurep + + type(XML_PARSE) :: info + integer :: indent = 0 + + call xml_open( info, fname, .false. ) + call xml_options( info, report_errors=.true.) + if ( present(lurep) ) then + call xml_options( info, report_errors=.true.) + endif + write(info%lun,'(a)') & + '' + call write_xml_type_xslibrary_xml( info, 'xslibrary', indent+3, xslibrary) + call write_xml_type_criticality_xml( info, 'criticality', indent+3, criticality) + call write_to_xml_integer( info, 'verbosity', indent+3, verbosity_) + call write_xml_type_source_xml( info, 'source', indent+3, source_) + write(info%lun,'(a)') '' + call xml_close(info) +end subroutine + +subroutine init_xml_file_settings_t + +end subroutine + +end module diff --git a/src/xml_tallies.f90 b/src/xml_tallies.f90 new file mode 100644 index 0000000000..dc4e56ee8b --- /dev/null +++ b/src/xml_tallies.f90 @@ -0,0 +1,532 @@ +module xml_data_tallies_t + use READ_XML_PRIMITIVES + use WRITE_XML_PRIMITIVES + use XMLPARSE + implicit none + integer, private :: lurep_ + logical, private :: strict_ + +type filter_xml + character(len=250) :: region + character(len=250) :: bornin + character(len=250) :: energy + character(len=250) :: energyout + character(len=250) :: material + character(len=250) :: surface + character(len=250) :: mesh +end type filter_xml + +type tally_xml + integer :: id + type(filter_xml) :: filters + character(len=250) :: reactions + character(len=250) :: nuclides +end type tally_xml + type(tally_xml), dimension(:), pointer :: tally_ => null() +contains +subroutine read_xml_type_filter_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(inout) :: tag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(filter_xml), dimension(:), pointer :: dvar + logical, intent(inout) :: has_dvar + + integer :: newsize + type(filter_xml), dimension(:), pointer :: newvar + + newsize = size(dvar) + 1 + allocate( newvar(1:newsize) ) + newvar(1:newsize-1) = dvar + deallocate( dvar ) + dvar => newvar + + call read_xml_type_filter_xml( info, tag, endtag, attribs, noattribs, data, nodata, & + dvar(newsize), has_dvar ) +end subroutine read_xml_type_filter_xml_array + +subroutine read_xml_type_filter_xml( info, starttag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: starttag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(filter_xml), intent(inout) :: dvar + logical, intent(inout) :: has_dvar + + integer :: att_ + integer :: noatt_ + logical :: error + logical :: endtag_org + character(len=len(starttag)) :: tag + logical :: has_region + logical :: has_bornin + logical :: has_energy + logical :: has_energyout + logical :: has_material + logical :: has_surface + logical :: has_mesh + has_region = .false. + has_bornin = .false. + has_energy = .false. + has_energyout = .false. + has_material = .false. + has_surface = .false. + has_mesh = .false. + call init_xml_type_filter_xml(dvar) + has_dvar = .true. + error = .false. + att_ = 0 + noatt_ = noattribs+1 + endtag_org = endtag + do + if ( nodata /= 0 ) then + noattribs = 0 + tag = starttag + elseif ( att_ < noatt_ .and. noatt_ > 1 ) then + att_ = att_ + 1 + if ( att_ <= noatt_-1 ) then + tag = attribs(1,att_) + data(1) = attribs(2,att_) + noattribs = 0 + nodata = 1 + endtag = .false. + else + tag = starttag + noattribs = 0 + nodata = 0 + endtag = .true. + cycle + endif + else + if ( endtag_org ) then + return + else + call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) + if ( xml_error(info) ) then + write(lurep_,*) 'Error reading input file!' + error = .true. + return + endif + endif + endif + if ( endtag .and. tag == starttag ) then + exit + endif + if ( endtag .and. noattribs == 0 ) then + if ( xml_ok(info) ) then + cycle + else + exit + endif + endif + select case( tag ) + case('region') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%region, has_region ) + case('bornin') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%bornin, has_bornin ) + case('energy') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%energy, has_energy ) + case('energyout') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%energyout, has_energyout ) + case('material') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%material, has_material ) + case('surface') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%surface, has_surface ) + case('mesh') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%mesh, has_mesh ) + case ('comment', '!--') + ! Simply ignore + case default + if ( strict_ ) then + error = .true. + call xml_report_errors( info, & + 'Unknown or wrongly placed tag: ' // trim(tag)) + endif + end select + nodata = 0 + if ( .not. xml_ok(info) ) exit + end do + if ( .not. has_region ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on region') + endif + if ( .not. has_bornin ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on bornin') + endif + if ( .not. has_energy ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on energy') + endif + if ( .not. has_energyout ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on energyout') + endif + if ( .not. has_material ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on material') + endif + if ( .not. has_surface ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on surface') + endif + if ( .not. has_mesh ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on mesh') + endif +end subroutine read_xml_type_filter_xml +subroutine init_xml_type_filter_xml_array( dvar ) + type(filter_xml), dimension(:), pointer :: dvar + if ( associated( dvar ) ) then + deallocate( dvar ) + endif + allocate( dvar(0) ) +end subroutine init_xml_type_filter_xml_array +subroutine init_xml_type_filter_xml(dvar) + type(filter_xml) :: dvar +end subroutine init_xml_type_filter_xml +subroutine write_xml_type_filter_xml_array( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(filter_xml), dimension(:) :: dvar + integer :: i + do i = 1,size(dvar) + call write_xml_type_filter_xml( info, tag, indent, dvar(i) ) + enddo +end subroutine write_xml_type_filter_xml_array + +subroutine write_xml_type_filter_xml( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(filter_xml) :: dvar + character(len=100) :: indentation + indentation = ' ' + write(info%lun, '(4a)' ) indentation(1:min(indent,100)),& + '<',trim(tag), '>' + call write_to_xml_word( info, 'region', indent+3, dvar%region) + call write_to_xml_word( info, 'bornin', indent+3, dvar%bornin) + call write_to_xml_word( info, 'energy', indent+3, dvar%energy) + call write_to_xml_word( info, 'energyout', indent+3, dvar%energyout) + call write_to_xml_word( info, 'material', indent+3, dvar%material) + call write_to_xml_word( info, 'surface', indent+3, dvar%surface) + call write_to_xml_word( info, 'mesh', indent+3, dvar%mesh) + write(info%lun,'(4a)') indentation(1:min(indent,100)), & + '' +end subroutine write_xml_type_filter_xml + +subroutine read_xml_type_tally_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(inout) :: tag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(tally_xml), dimension(:), pointer :: dvar + logical, intent(inout) :: has_dvar + + integer :: newsize + type(tally_xml), dimension(:), pointer :: newvar + + newsize = size(dvar) + 1 + allocate( newvar(1:newsize) ) + newvar(1:newsize-1) = dvar + deallocate( dvar ) + dvar => newvar + + call read_xml_type_tally_xml( info, tag, endtag, attribs, noattribs, data, nodata, & + dvar(newsize), has_dvar ) +end subroutine read_xml_type_tally_xml_array + +subroutine read_xml_type_tally_xml( info, starttag, endtag, attribs, noattribs, data, nodata, & + dvar, has_dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: starttag + logical, intent(inout) :: endtag + character(len=*), dimension(:,:), intent(inout) :: attribs + integer, intent(inout) :: noattribs + character(len=*), dimension(:), intent(inout) :: data + integer, intent(inout) :: nodata + type(tally_xml), intent(inout) :: dvar + logical, intent(inout) :: has_dvar + + integer :: att_ + integer :: noatt_ + logical :: error + logical :: endtag_org + character(len=len(starttag)) :: tag + logical :: has_id + logical :: has_filters + logical :: has_reactions + logical :: has_nuclides + has_id = .false. + has_filters = .false. + has_reactions = .false. + has_nuclides = .false. + call init_xml_type_tally_xml(dvar) + has_dvar = .true. + error = .false. + att_ = 0 + noatt_ = noattribs+1 + endtag_org = endtag + do + if ( nodata /= 0 ) then + noattribs = 0 + tag = starttag + elseif ( att_ < noatt_ .and. noatt_ > 1 ) then + att_ = att_ + 1 + if ( att_ <= noatt_-1 ) then + tag = attribs(1,att_) + data(1) = attribs(2,att_) + noattribs = 0 + nodata = 1 + endtag = .false. + else + tag = starttag + noattribs = 0 + nodata = 0 + endtag = .true. + cycle + endif + else + if ( endtag_org ) then + return + else + call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) + if ( xml_error(info) ) then + write(lurep_,*) 'Error reading input file!' + error = .true. + return + endif + endif + endif + if ( endtag .and. tag == starttag ) then + exit + endif + if ( endtag .and. noattribs == 0 ) then + if ( xml_ok(info) ) then + cycle + else + exit + endif + endif + select case( tag ) + case('id') + call read_xml_integer( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%id, has_id ) + case('filters') + call read_xml_type_filter_xml( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%filters, has_filters ) + case('reactions') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%reactions, has_reactions ) + case('nuclides') + call read_xml_word( & + info, tag, endtag, attribs, noattribs, data, nodata, & + dvar%nuclides, has_nuclides ) + case ('comment', '!--') + ! Simply ignore + case default + if ( strict_ ) then + error = .true. + call xml_report_errors( info, & + 'Unknown or wrongly placed tag: ' // trim(tag)) + endif + end select + nodata = 0 + if ( .not. xml_ok(info) ) exit + end do + if ( .not. has_id ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on id') + endif + if ( .not. has_filters ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on filters') + endif + if ( .not. has_reactions ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on reactions') + endif + if ( .not. has_nuclides ) then + has_dvar = .false. + call xml_report_errors(info, 'Missing data on nuclides') + endif +end subroutine read_xml_type_tally_xml +subroutine init_xml_type_tally_xml_array( dvar ) + type(tally_xml), dimension(:), pointer :: dvar + if ( associated( dvar ) ) then + deallocate( dvar ) + endif + allocate( dvar(0) ) +end subroutine init_xml_type_tally_xml_array +subroutine init_xml_type_tally_xml(dvar) + type(tally_xml) :: dvar +end subroutine init_xml_type_tally_xml +subroutine write_xml_type_tally_xml_array( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(tally_xml), dimension(:) :: dvar + integer :: i + do i = 1,size(dvar) + call write_xml_type_tally_xml( info, tag, indent, dvar(i) ) + enddo +end subroutine write_xml_type_tally_xml_array + +subroutine write_xml_type_tally_xml( & + info, tag, indent, dvar ) + type(XML_PARSE) :: info + character(len=*), intent(in) :: tag + integer :: indent + type(tally_xml) :: dvar + character(len=100) :: indentation + indentation = ' ' + write(info%lun, '(4a)' ) indentation(1:min(indent,100)),& + '<',trim(tag), '>' + call write_to_xml_integer( info, 'id', indent+3, dvar%id) + call write_xml_type_filter_xml( info, 'filters', indent+3, dvar%filters) + call write_to_xml_word( info, 'reactions', indent+3, dvar%reactions) + call write_to_xml_word( info, 'nuclides', indent+3, dvar%nuclides) + write(info%lun,'(4a)') indentation(1:min(indent,100)), & + '' +end subroutine write_xml_type_tally_xml + +subroutine read_xml_file_tallies_t(fname, lurep, errout) + character(len=*), intent(in) :: fname + integer, intent(in), optional :: lurep + logical, intent(out), optional :: errout + + type(XML_PARSE) :: info + logical :: error + character(len=80) :: tag + character(len=80) :: starttag + logical :: endtag + character(len=80), dimension(1:2,1:20) :: attribs + integer :: noattribs + character(len=200), dimension(1:100) :: data + integer :: nodata + logical :: has_tally_ + has_tally_ = .false. + allocate(tally_(0)) + + call init_xml_file_tallies_t + call xml_open( info, fname, .true. ) + call xml_options( info, report_errors=.true., ignore_whitespace=.true.) + lurep_ = 0 + if ( present(lurep) ) then + lurep_ = lurep + call xml_options( info, report_lun=lurep ) + endif + do + call xml_get( info, starttag, endtag, attribs, noattribs, & + data, nodata) + if ( starttag /= '!--' ) exit + enddo + if ( starttag /= "tallies" ) then + call xml_report_errors( info, & + 'XML-file should have root element "tallies"') + error = .true. + call xml_close(info) + return + endif + strict_ = .false. + error = .false. + do + call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) + if ( xml_error(info) ) then + write(lurep_,*) 'Error reading input file!' + error = .true. + return + endif + if ( endtag .and. tag == starttag ) then + exit + endif + if ( endtag .and. noattribs == 0 ) then + if ( xml_ok(info) ) then + cycle + else + exit + endif + endif + select case( tag ) + case('tally') + call read_xml_type_tally_xml_array( & + info, tag, endtag, attribs, noattribs, data, nodata, & + tally_, has_tally_ ) + case ('comment', '!--') + ! Simply ignore + case default + if ( strict_ ) then + error = .true. + call xml_report_errors( info, & + 'Unknown or wrongly placed tag: ' // trim(tag)) + endif + end select + nodata = 0 + if ( .not. xml_ok(info) ) exit + end do + if ( .not. has_tally_ ) then + error = .true. + call xml_report_errors(info, 'Missing data on tally_') + endif + if ( present(errout) ) errout = error +end subroutine + +subroutine write_xml_file_tallies_t(fname, lurep) + character(len=*), intent(in) :: fname + integer, intent(in), optional :: lurep + + type(XML_PARSE) :: info + integer :: indent = 0 + + call xml_open( info, fname, .false. ) + call xml_options( info, report_errors=.true.) + if ( present(lurep) ) then + call xml_options( info, report_errors=.true.) + endif + write(info%lun,'(a)') & + '' + call write_xml_type_tally_xml_array( info, 'tally', indent+3, tally_) + write(info%lun,'(a)') '' + call xml_close(info) +end subroutine + +subroutine init_xml_file_tallies_t + +end subroutine + +end module