mirror of
https://github.com/openmc-dev/openmc.git
synced 2026-07-28 22:26:08 -04:00
Merged branch xml into master.
This commit is contained in:
Paul Romano
parent
b451da7b44
commit
865c3a4eb7
31 changed files with 3848 additions and 1109 deletions
25
benchmarks/pu-met-fast-001/geometry.xml
Normal file
25
benchmarks/pu-met-fast-001/geometry.xml
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
<?xml version="1.0"?>
|
||||
<geometry>
|
||||
|
||||
<!--
|
||||
==========================================
|
||||
Description: Bare Pu-239 Jezebel Benchmark
|
||||
Case: PU-MET-FAST-001
|
||||
Written By: Paul Romano
|
||||
Date: 9/1/2011
|
||||
==========================================
|
||||
-->
|
||||
|
||||
<cell uid="1">
|
||||
<universe>0</universe>
|
||||
<material>1</material>
|
||||
<surfaces>-1</surfaces>
|
||||
</cell>
|
||||
|
||||
<surface uid="1">
|
||||
<type>sphere</type>
|
||||
<coeffs>0. 0. 0. 6.3849</coeffs>
|
||||
<boundary>vacuum</boundary>
|
||||
</surface>
|
||||
|
||||
</geometry>
|
||||
21
benchmarks/pu-met-fast-001/material.xml
Normal file
21
benchmarks/pu-met-fast-001/material.xml
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
<?xml version="1.0"?>
|
||||
<materials>
|
||||
|
||||
<!--
|
||||
==========================================
|
||||
Description: Bare Pu-239 Jezebel Benchmark
|
||||
Case: PU-MET-FAST-001
|
||||
Written By: Paul Romano
|
||||
Date: 9/1/2011
|
||||
==========================================
|
||||
-->
|
||||
|
||||
<material uid="1">
|
||||
<density value="0.04029014" units="atom/b-cm" />
|
||||
<nuclide name="Pu-239" xs="03c" ao="0.037047" />
|
||||
<nuclide name="Pu-240" xs="03c" ao="0.0017512" />
|
||||
<nuclide name="Pu-241" xs="03c" ao="0.00011674" />
|
||||
<nuclide name="Ga-nat" xs="03c" ao="0.0013752" />
|
||||
</material>
|
||||
|
||||
</materials>
|
||||
28
benchmarks/pu-met-fast-001/settings.xml
Normal file
28
benchmarks/pu-met-fast-001/settings.xml
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
<?xml version="1.0"?>
|
||||
<settings>
|
||||
|
||||
<!--
|
||||
==========================================
|
||||
Description: Bare Pu-239 Jezebel Benchmark
|
||||
Case: PU-MET-FAST-001
|
||||
Written By: Paul Romano
|
||||
Date: 9/1/2011
|
||||
==========================================
|
||||
-->
|
||||
|
||||
<xslibrary path="/opt/serpent/xsdata/endfb7" />
|
||||
|
||||
<criticality>
|
||||
<cycles>3000</cycles>
|
||||
<inactive>20</inactive>
|
||||
<particles>10000</particles>
|
||||
</criticality>
|
||||
|
||||
<verbosity value="7" />
|
||||
|
||||
<source>
|
||||
<type>box</type>
|
||||
<coeffs>-1 -1 -1 1 1 1</coeffs>
|
||||
</source>
|
||||
|
||||
</settings>
|
||||
|
|
@ -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
|
||||
25
benchmarks/pu-met-fast-002/geometry.xml
Normal file
25
benchmarks/pu-met-fast-002/geometry.xml
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
<?xml version="1.0"?>
|
||||
<geometry>
|
||||
|
||||
<!--
|
||||
==========================================
|
||||
Description: Bare Pu-240 Jezebel Benchmark
|
||||
Case: PU-MET-FAST-002
|
||||
Written By: Paul Romano
|
||||
Date: 9/1/2011
|
||||
==========================================
|
||||
-->
|
||||
|
||||
<cell uid="1">
|
||||
<universe>0</universe>
|
||||
<material>1</material>
|
||||
<surfaces>-1</surfaces>
|
||||
</cell>
|
||||
|
||||
<surface uid="1">
|
||||
<type>sphere</type>
|
||||
<coeffs>0. 0. 0. 6.6595</coeffs>
|
||||
<boundary>vacuum</boundary>
|
||||
</surface>
|
||||
|
||||
</geometry>
|
||||
22
benchmarks/pu-met-fast-002/material.xml
Normal file
22
benchmarks/pu-met-fast-002/material.xml
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
<?xml version="1.0"?>
|
||||
<materials>
|
||||
|
||||
<!--
|
||||
==========================================
|
||||
Description: Bare Pu-240 Jezebel Benchmark
|
||||
Case: PU-MET-FAST-002
|
||||
Written By: Paul Romano
|
||||
Date: 9/1/2011
|
||||
==========================================
|
||||
-->
|
||||
|
||||
<material uid="1">
|
||||
<density value="0.04055292" units="atom/b-cm" />
|
||||
<nuclide name="Pu-239" xs="03c" ao="0.029934" />
|
||||
<nuclide name="Pu-240" xs="03c" ao="0.0078754" />
|
||||
<nuclide name="Pu-241" xs="03c" ao="0.0012146" />
|
||||
<nuclide name="Pu-242" xs="03c" ao="0.00015672" />
|
||||
<nuclide name="Ga-nat" xs="03c" ao="0.0013722" />
|
||||
</material>
|
||||
|
||||
</materials>
|
||||
28
benchmarks/pu-met-fast-002/settings.xml
Normal file
28
benchmarks/pu-met-fast-002/settings.xml
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
<?xml version="1.0"?>
|
||||
<settings>
|
||||
|
||||
<!--
|
||||
==========================================
|
||||
Description: Bare Pu-240 Jezebel Benchmark
|
||||
Case: PU-MET-FAST-002
|
||||
Written By: Paul Romano
|
||||
Date: 9/1/2011
|
||||
==========================================
|
||||
-->
|
||||
|
||||
<xslibrary path="/opt/serpent/xsdata/endfb7" />
|
||||
|
||||
<criticality>
|
||||
<cycles>3000</cycles>
|
||||
<inactive>20</inactive>
|
||||
<particles>10000</particles>
|
||||
</criticality>
|
||||
|
||||
<verbosity value="7" />
|
||||
|
||||
<source>
|
||||
<type>box</type>
|
||||
<coeffs>-1 -1 -1 1 1 1</coeffs>
|
||||
</source>
|
||||
|
||||
</settings>
|
||||
|
|
@ -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
|
||||
34
benchmarks/pu-met-fast-005/geometry.xml
Normal file
34
benchmarks/pu-met-fast-005/geometry.xml
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
<?xml version="1.0"?>
|
||||
<geometry>
|
||||
|
||||
<!--
|
||||
===============================================================
|
||||
Description: Unmoderated Plutonium Metal Button Array Benchmark
|
||||
Case: PU-MET-FAST-005
|
||||
Written By: Paul Romano
|
||||
Date: 9/1/2011
|
||||
===============================================================
|
||||
-->
|
||||
|
||||
<cell uid="1">
|
||||
<universe>0</universe>
|
||||
<material>1</material>
|
||||
<surfaces>-1</surfaces>
|
||||
</cell>
|
||||
<cell uid="2">
|
||||
<universe>0</universe>
|
||||
<material>2</material>
|
||||
<surfaces>1 -2</surfaces>
|
||||
</cell>
|
||||
|
||||
<surface uid="1">
|
||||
<type>sphere</type>
|
||||
<coeffs>0. 0. 0. 5.0419</coeffs>
|
||||
</surface>
|
||||
<surface uid="2">
|
||||
<type>sphere</type>
|
||||
<coeffs>0. 0. 0. 9.7409</coeffs>
|
||||
<boundary>vacuum</boundary>
|
||||
</surface>
|
||||
|
||||
</geometry>
|
||||
28
benchmarks/pu-met-fast-005/material.xml
Normal file
28
benchmarks/pu-met-fast-005/material.xml
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
<?xml version="1.0"?>
|
||||
<materials>
|
||||
|
||||
<!--
|
||||
===============================================================
|
||||
Description: Unmoderated Plutonium Metal Button Array Benchmark
|
||||
Case: PU-MET-FAST-005
|
||||
Written By: Paul Romano
|
||||
Date: 9/1/2011
|
||||
===============================================================
|
||||
-->
|
||||
|
||||
<material uid="1">
|
||||
<density value="0.04070346" units="atom/b-cm" />
|
||||
<nuclide name="Pu-239" xs="03c" ao="0.037291" />
|
||||
<nuclide name="Pu-240" xs="03c" ao="0.0019277" />
|
||||
<nuclide name="Pu-241" xs="03c" ao="0.00012196" />
|
||||
<nuclide name="Ga-nat" xs="03c" ao="0.0013628" />
|
||||
</material>
|
||||
<material uid="2">
|
||||
<density value="0.06605308" units="atom/b-cm" />
|
||||
<nuclide name="74000" xs="03c" ao="0.051468" />
|
||||
<nuclide name="28000" xs="03c" ao="0.0097124" />
|
||||
<nuclide name="29000" xs="03c" ao="0.0040774" />
|
||||
<nuclide name="40000" xs="03c" ao="0.00079528" />
|
||||
</material>
|
||||
|
||||
</materials>
|
||||
28
benchmarks/pu-met-fast-005/settings.xml
Normal file
28
benchmarks/pu-met-fast-005/settings.xml
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
<?xml version="1.0"?>
|
||||
<settings>
|
||||
|
||||
<!--
|
||||
===============================================================
|
||||
Description: Unmoderated Plutonium Metal Button Array Benchmark
|
||||
Case: PU-MET-FAST-005
|
||||
Written By: Paul Romano
|
||||
Date: 9/1/2011
|
||||
===============================================================
|
||||
-->
|
||||
|
||||
<xslibrary path="/opt/serpent/xsdata/endfb7" />
|
||||
|
||||
<criticality>
|
||||
<cycles>3000</cycles>
|
||||
<inactive>20</inactive>
|
||||
<particles>10000</particles>
|
||||
</criticality>
|
||||
|
||||
<verbosity value="7" />
|
||||
|
||||
<source>
|
||||
<type>box</type>
|
||||
<coeffs>-1 -1 -1 1 1 1</coeffs>
|
||||
</source>
|
||||
|
||||
</settings>
|
||||
|
|
@ -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
|
||||
41
examples/basic/geometry.xml
Normal file
41
examples/basic/geometry.xml
Normal file
|
|
@ -0,0 +1,41 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<geometry>
|
||||
|
||||
<!-- Definition of Cells -->
|
||||
<cell uid="1">
|
||||
<universe>0</universe>
|
||||
<fill>37</fill>
|
||||
<surfaces>-2</surfaces>
|
||||
</cell>
|
||||
<cell uid="100">
|
||||
<universe>37</universe>
|
||||
<material>40</material>
|
||||
<surfaces>-1</surfaces>
|
||||
</cell>
|
||||
<cell uid="101">
|
||||
<universe>37</universe>
|
||||
<material>41</material>
|
||||
<surfaces>1</surfaces>
|
||||
</cell>
|
||||
<cell uid="2">
|
||||
<universe>0</universe>
|
||||
<material>41</material>
|
||||
<surfaces>2 -3</surfaces>
|
||||
</cell>
|
||||
|
||||
<!-- Defition of Surfaces -->
|
||||
<surface uid="1">
|
||||
<type>z-cylinder</type>
|
||||
<coeffs>0 0 7</coeffs>
|
||||
</surface>
|
||||
<surface uid="2">
|
||||
<type>z-cylinder</type>
|
||||
<coeffs>0 0 9</coeffs>
|
||||
</surface>
|
||||
<surface uid="3">
|
||||
<type>z-cylinder</type>
|
||||
<coeffs>0 0 11</coeffs>
|
||||
<boundary>vacuum</boundary>
|
||||
</surface>
|
||||
|
||||
</geometry>
|
||||
17
examples/basic/material.xml
Normal file
17
examples/basic/material.xml
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
<?xml version="1.0"?>
|
||||
<materials>
|
||||
|
||||
<!-- Definition of materials -->
|
||||
<material uid="40">
|
||||
<density value="4.5" units="g/cc" />
|
||||
<nuclide name="U-235" xs="03c" ao="1.0" />
|
||||
</material>
|
||||
|
||||
<material uid="41">
|
||||
<density value="1.0" units="g/cc" />
|
||||
<nuclide name="H-1" xs="03c" ao="2.0" />
|
||||
<nuclide name="O-16" xs="03c" ao="1.0" />
|
||||
<sab uid="H-H2O" xs="10t" />
|
||||
</material>
|
||||
|
||||
</materials>
|
||||
23
examples/basic/settings.xml
Normal file
23
examples/basic/settings.xml
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<settings>
|
||||
|
||||
<!-- Path for cross section library -->
|
||||
<xslibrary path="/opt/serpent/xsdata/endfb7" />
|
||||
|
||||
<!-- Parameters for criticality calculation -->
|
||||
<criticality>
|
||||
<cycles>15</cycles>
|
||||
<inactive>5</inactive>
|
||||
<particles>10000</particles>
|
||||
</criticality>
|
||||
|
||||
<!-- How verbose output should be -->
|
||||
<verbosity value="7" />
|
||||
|
||||
<!-- Starting source -->
|
||||
<source>
|
||||
<type>box</type>
|
||||
<coeffs>-4 -4 -4 4 4 4</coeffs>
|
||||
</source>
|
||||
|
||||
</settings>
|
||||
18
examples/basic/tallies.xml
Normal file
18
examples/basic/tallies.xml
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
<?xml version="1.0"?>
|
||||
<tallies>
|
||||
|
||||
<tally id="1">
|
||||
<!-- this is where you specify filters -->
|
||||
<filters>
|
||||
<region>1</region>
|
||||
<energy>0.0 0.625 20.0e6</energy>
|
||||
</filters>
|
||||
|
||||
<!-- which reactions to score -->
|
||||
<reactions>1 2 -4 -8</reactions>
|
||||
|
||||
<!-- which nuclides to score -->
|
||||
<nuclides>U-238</nuclides>
|
||||
</tally>
|
||||
|
||||
</tallies>
|
||||
58
examples/lattice/geometry.xml
Normal file
58
examples/lattice/geometry.xml
Normal file
|
|
@ -0,0 +1,58 @@
|
|||
<?xml version="1.0"?>
|
||||
<geometry>
|
||||
|
||||
<cell uid="1">
|
||||
<universe>0</universe>
|
||||
<fill>111</fill>
|
||||
<surfaces>1 -2 3 -4</surfaces>
|
||||
</cell>
|
||||
<cell uid="100">
|
||||
<universe>3</universe>
|
||||
<material>40</material>
|
||||
<surfaces>-5</surfaces>
|
||||
</cell>
|
||||
<cell uid="101">
|
||||
<universe>3</universe>
|
||||
<material>41</material>
|
||||
<surfaces>5</surfaces>
|
||||
</cell>
|
||||
|
||||
<lattice uid="111">
|
||||
<type>rectangular</type>
|
||||
<dimension>20 20</dimension>
|
||||
<origin>-10.0 -10.0</origin>
|
||||
<width>1.0 1.0</width>
|
||||
<universes>
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
|
||||
</universes>
|
||||
</lattice>
|
||||
|
||||
<surface uid="1" type="x-plane" coeffs="-9.9" boundary="vacuum" />
|
||||
<surface uid="2" type="x-plane" coeffs="9.9" boundary="vacuum" />
|
||||
<surface uid="3" type="y-plane" coeffs="-9.9" boundary="vacuum" />
|
||||
<surface uid="4" type="y-plane" coeffs="9.9" boundary="vacuum" />
|
||||
<surface uid="5">
|
||||
<type>z-cylinder</type>
|
||||
<coeffs>0.0 0.0 0.4</coeffs>
|
||||
</surface>
|
||||
|
||||
</geometry>
|
||||
17
examples/lattice/material.xml
Normal file
17
examples/lattice/material.xml
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
<?xml version="1.0"?>
|
||||
<materials>
|
||||
|
||||
<!-- Definition of materials -->
|
||||
<material uid="40">
|
||||
<density value="4.5" units="g/cc" />
|
||||
<nuclide name="U-235" xs="03c" ao="1.0" />
|
||||
</material>
|
||||
|
||||
<material uid="41">
|
||||
<density value="1.0" units="g/cc" />
|
||||
<nuclide name="H-1" xs="03c" ao="2.0" />
|
||||
<nuclide name="O-16" xs="03c" ao="1.0" />
|
||||
<sab uid="H-H2O" xs="10t" />
|
||||
</material>
|
||||
|
||||
</materials>
|
||||
23
examples/lattice/settings.xml
Normal file
23
examples/lattice/settings.xml
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<settings>
|
||||
|
||||
<!-- Path for cross section library -->
|
||||
<xslibrary path="/opt/serpent/xsdata/endfb7" />
|
||||
|
||||
<!-- Parameters for criticality calculation -->
|
||||
<criticality>
|
||||
<cycles>20</cycles>
|
||||
<inactive>10</inactive>
|
||||
<particles>10000</particles>
|
||||
</criticality>
|
||||
|
||||
<!-- How verbose output should be -->
|
||||
<verbosity value="7" />
|
||||
|
||||
<!-- Starting source -->
|
||||
<source>
|
||||
<type>box</type>
|
||||
<coeffs>-4 -4 -4 4 4 4</coeffs>
|
||||
</source>
|
||||
|
||||
</settings>
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
475
src/input_xml.f90
Normal file
475
src/input_xml.f90
Normal file
|
|
@ -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 <origin> must be the same as the " // &
|
||||
"number of entries on <dimension>."
|
||||
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 <width> must be the same as the " // &
|
||||
"number of entries on <origin>."
|
||||
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
|
||||
|
|
@ -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
|
||||
737
src/xml_geometry.f90
Normal file
737
src/xml_geometry.f90
Normal file
|
|
@ -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)), &
|
||||
'</' //trim(tag) // '>'
|
||||
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)), &
|
||||
'</' //trim(tag) // '>'
|
||||
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)), &
|
||||
'</' //trim(tag) // '>'
|
||||
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)') &
|
||||
'<geometry>'
|
||||
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)') '</geometry>'
|
||||
call xml_close(info)
|
||||
end subroutine
|
||||
|
||||
subroutine init_xml_file_geometry_t
|
||||
|
||||
end subroutine
|
||||
|
||||
end module
|
||||
822
src/xml_material.f90
Normal file
822
src/xml_material.f90
Normal file
|
|
@ -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)), &
|
||||
'</' //trim(tag) // '>'
|
||||
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)), &
|
||||
'</' //trim(tag) // '>'
|
||||
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)), &
|
||||
'</' //trim(tag) // '>'
|
||||
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)), &
|
||||
'</' //trim(tag) // '>'
|
||||
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)') &
|
||||
'<materials>'
|
||||
call write_xml_type_material_xml_array( info, 'material', indent+3, material_)
|
||||
write(info%lun,'(a)') '</materials>'
|
||||
call xml_close(info)
|
||||
end subroutine
|
||||
|
||||
subroutine init_xml_file_material_t
|
||||
|
||||
end subroutine
|
||||
|
||||
end module
|
||||
650
src/xml_settings.f90
Normal file
650
src/xml_settings.f90
Normal file
|
|
@ -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)), &
|
||||
'</' //trim(tag) // '>'
|
||||
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)), &
|
||||
'</' //trim(tag) // '>'
|
||||
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)), &
|
||||
'</' //trim(tag) // '>'
|
||||
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)') &
|
||||
'<settings>'
|
||||
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)') '</settings>'
|
||||
call xml_close(info)
|
||||
end subroutine
|
||||
|
||||
subroutine init_xml_file_settings_t
|
||||
|
||||
end subroutine
|
||||
|
||||
end module
|
||||
532
src/xml_tallies.f90
Normal file
532
src/xml_tallies.f90
Normal file
|
|
@ -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)), &
|
||||
'</' //trim(tag) // '>'
|
||||
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)), &
|
||||
'</' //trim(tag) // '>'
|
||||
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)') &
|
||||
'<tallies>'
|
||||
call write_xml_type_tally_xml_array( info, 'tally', indent+3, tally_)
|
||||
write(info%lun,'(a)') '</tallies>'
|
||||
call xml_close(info)
|
||||
end subroutine
|
||||
|
||||
subroutine init_xml_file_tallies_t
|
||||
|
||||
end subroutine
|
||||
|
||||
end module
|
||||
Loading…
Add table
Add a link
Reference in a new issue