mirror of
https://github.com/openmc-dev/openmc.git
synced 2026-07-28 22:26:08 -04:00
xml-fortran source files and templates added to main directory.
This commit is contained in:
Paul Romano
parent
b0e517bf4b
commit
97569a9267
21 changed files with 3842 additions and 3150 deletions
|
|
@ -84,10 +84,10 @@ input_xml.o: mesh_header.o
|
|||
input_xml.o: output.o
|
||||
input_xml.o: string.o
|
||||
input_xml.o: tally_header.o
|
||||
input_xml.o: xml_geometry.o
|
||||
input_xml.o: xml_materials.o
|
||||
input_xml.o: xml_settings.o
|
||||
input_xml.o: xml_tallies.o
|
||||
input_xml.o: xml-fortran/templates/geometry_t.o
|
||||
input_xml.o: xml-fortran/templates/materials_t.o
|
||||
input_xml.o: xml-fortran/templates/settings_t.o
|
||||
input_xml.o: xml-fortran/templates/tallies_t.o
|
||||
|
||||
interpolation.o: constants.o
|
||||
interpolation.o: error.o
|
||||
|
|
|
|||
22
src/Makefile
22
src/Makefile
|
|
@ -1,5 +1,10 @@
|
|||
program = openmc
|
||||
|
||||
templates = $(wildcard xml-fortran/templates/*.o)
|
||||
xml_fort = xml-fortran/xmlparse.o \
|
||||
xml-fortran/read_xml_primitives.o \
|
||||
xml-fortran/write_xml_primitives.o
|
||||
|
||||
#===============================================================================
|
||||
# Object Files
|
||||
#===============================================================================
|
||||
|
|
@ -26,16 +31,16 @@ USE_COARRAY = no
|
|||
|
||||
ifeq ($(COMPILER),intel)
|
||||
F90 = ifort
|
||||
F90FLAGS = -I../lib/intel -fpp -warn
|
||||
LDFLAGS = -L../lib/intel -lxmlparse
|
||||
F90FLAGS = -Ixml-fortran -Ixml-fortran/templates -fpp -warn
|
||||
LDFLAGS =
|
||||
endif
|
||||
|
||||
# GNU Fortran compiler options
|
||||
|
||||
ifeq ($(COMPILER),gfortran)
|
||||
F90 = gfortran
|
||||
F90FLAGS = -I../lib/gfortran -cpp -Wall
|
||||
LDFLAGS = -L../lib/gfortran -lxmlparse
|
||||
F90FLAGS = -cpp -Wall
|
||||
LDFLAGS =
|
||||
endif
|
||||
|
||||
# Set compiler flags for debugging
|
||||
|
|
@ -93,9 +98,12 @@ endif
|
|||
# Targets
|
||||
#===============================================================================
|
||||
|
||||
all: $(program)
|
||||
all: xml-fortran $(program)
|
||||
xml-fortran:
|
||||
cd xml-fortran; make
|
||||
cd xml-fortran/templates; make
|
||||
$(program): $(objects)
|
||||
$(F90) $(objects) -o $@ $(LDFLAGS)
|
||||
$(F90) $(objects) $(templates) $(xml_fort) -o $@ $(LDFLAGS)
|
||||
clean:
|
||||
@rm -f *.o *.mod $(program)
|
||||
neat:
|
||||
|
|
@ -106,7 +114,7 @@ neat:
|
|||
#===============================================================================
|
||||
|
||||
.SUFFIXES: .f90 .o
|
||||
.PHONY: all clean neat
|
||||
.PHONY: all clean neat xml-fortran
|
||||
|
||||
%.o: %.f90
|
||||
$(F90) $(F90FLAGS) -c $<
|
||||
|
|
|
|||
|
|
@ -32,8 +32,4 @@ source_header.o \
|
|||
string.o \
|
||||
tally.o \
|
||||
tally_header.o \
|
||||
timing.o \
|
||||
xml_geometry.o \
|
||||
xml_materials.o \
|
||||
xml_settings.o \
|
||||
xml_tallies.o
|
||||
timing.o
|
||||
72
src/xml-fortran/Makefile
Normal file
72
src/xml-fortran/Makefile
Normal file
|
|
@ -0,0 +1,72 @@
|
|||
reader = xmlreader
|
||||
xml_fortran_source = $(wildcard *.f90)
|
||||
xml_fortran_objects = $(xml_fortran_source:.f90=.o)
|
||||
|
||||
#===============================================================================
|
||||
# User Options
|
||||
#===============================================================================
|
||||
|
||||
COMPILER = intel
|
||||
DEBUG = no
|
||||
|
||||
#===============================================================================
|
||||
# Compiler Options
|
||||
#===============================================================================
|
||||
|
||||
# Intel Fortran compiler options
|
||||
|
||||
ifeq ($(COMPILER),intel)
|
||||
F90 = ifort
|
||||
F90FLAGS += -fpp
|
||||
endif
|
||||
|
||||
# GNU Fortran compiler options
|
||||
|
||||
ifeq ($(COMPILER),gfortran)
|
||||
F90 = gfortran
|
||||
F90FLAGS += -cpp -Wall
|
||||
endif
|
||||
|
||||
# Set compiler flags for debugging
|
||||
|
||||
ifeq ($(DEBUG),yes)
|
||||
F90FLAGS += -g
|
||||
LDFLAGS += -g
|
||||
ifeq ($(COMPILER),intel)
|
||||
F90FLAGS += -traceback -ftrapuv -fp-stack-check -check all
|
||||
endif
|
||||
ifeq ($(COMPILER),gfortran)
|
||||
F90FLAGS += -pedantic -std=f2008 -fbacktrace -fbounds-check \
|
||||
-ffpe-trap=invalid,zero,overflow,underflow
|
||||
endif
|
||||
endif
|
||||
|
||||
#===============================================================================
|
||||
# Targets
|
||||
#===============================================================================
|
||||
|
||||
all: $(reader)
|
||||
$(reader): $(xml_fortran_objects)
|
||||
$(F90) $(xml_fortran_objects) -o $@ $(LDFLAGS)
|
||||
clean:
|
||||
@rm -f *.o *.mod $(reader)
|
||||
neat:
|
||||
@rm -f *.o *.mod
|
||||
|
||||
#===============================================================================
|
||||
# Rules
|
||||
#===============================================================================
|
||||
|
||||
.SUFFIXES: .f90 .o
|
||||
.PHONY: all clean neat
|
||||
|
||||
%.o: %.f90
|
||||
$(F90) $(F90FLAGS) -c $<
|
||||
|
||||
#===============================================================================
|
||||
# Dependencies
|
||||
#===============================================================================
|
||||
|
||||
read_xml_primitives.o: xmlparse.o
|
||||
write_xml_primitives.o: xmlparse.o
|
||||
xmlreader.o: xmlparse.o
|
||||
79
src/xml-fortran/read_from_buffer.inc
Normal file
79
src/xml-fortran/read_from_buffer.inc
Normal file
|
|
@ -0,0 +1,79 @@
|
|||
! Part of XML-Fortran library:
|
||||
!
|
||||
! $Id: read_from_buffer.inc,v 1.2 2006/03/26 19:05:48 arjenmarkus Exp $
|
||||
!
|
||||
character(len=*), intent(in) :: buffer
|
||||
integer, intent(inout) :: ierror
|
||||
|
||||
integer :: n
|
||||
integer :: i
|
||||
integer :: step
|
||||
integer :: ierr
|
||||
!
|
||||
! First allocate an array that is surely large enough
|
||||
! Note:
|
||||
! This is not completely failsafe: with list-directed
|
||||
! input you can also use repeat counts (10000*1.0 for
|
||||
! instance).
|
||||
!
|
||||
allocate( work(len(buffer)/2+1) )
|
||||
|
||||
!
|
||||
! NOTE:
|
||||
! This is not portable!!
|
||||
!
|
||||
! read( buffer, *, iostat = ierror ) (work(n), n=1,size(work))
|
||||
!
|
||||
! So, use a different strategy: a binary search
|
||||
! First: establish that we have at least one item to read
|
||||
! Second: do the binary search
|
||||
!
|
||||
! read( buffer, *, iostat = ierr ) work(1)
|
||||
! if ( ierr /= 0 ) then
|
||||
! n = 0
|
||||
! else
|
||||
n = 1
|
||||
do while ( n <= size(work) )
|
||||
n = 2 * n
|
||||
enddo
|
||||
n = n / 2
|
||||
step = n / 2
|
||||
! step = n / 2
|
||||
|
||||
do while ( step > 0 )
|
||||
read( buffer, *, iostat = ierr ) (work(i), i = 1,n)
|
||||
if ( ierr /= 0 ) then
|
||||
ierror = ierr ! Store the error code for later use
|
||||
n = n - step
|
||||
else
|
||||
n = n + step
|
||||
endif
|
||||
step = step / 2
|
||||
enddo
|
||||
! endif
|
||||
|
||||
!
|
||||
! Then allocate an array of the actual size needed
|
||||
! and copy the data
|
||||
!
|
||||
!
|
||||
if ( associated( var ) ) then
|
||||
deallocate( var )
|
||||
endif
|
||||
!
|
||||
! One complication: we may have one too many
|
||||
! (consequence of the binary search)
|
||||
!
|
||||
read( buffer, *, iostat = ierr ) (work(i), i = 1,n)
|
||||
if ( ierr < 0 ) then
|
||||
n = n - 1
|
||||
endif
|
||||
|
||||
allocate( var(n) )
|
||||
var(1:n) = work(1:n)
|
||||
deallocate( work )
|
||||
|
||||
if ( ierror .lt. 0 ) then
|
||||
ierror = 0
|
||||
endif
|
||||
|
||||
54
src/xml-fortran/read_xml_array.inc
Normal file
54
src/xml-fortran/read_xml_array.inc
Normal file
|
|
@ -0,0 +1,54 @@
|
|||
! Part of XML-Fortran library:
|
||||
!
|
||||
! $Id: read_xml_array.inc,v 1.3 2007/02/26 20:33:38 arjenmarkus Exp $
|
||||
!
|
||||
type(XML_PARSE), intent(inout) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
logical, intent(inout) :: endtag
|
||||
character(len=*), dimension(:,:), intent(in) :: attribs
|
||||
integer, intent(in) :: noattribs
|
||||
character(len=*), dimension(:), intent(in) :: data
|
||||
integer, intent(in) :: nodata
|
||||
logical, intent(inout) :: has_var
|
||||
|
||||
character(len=len(attribs(1,1))) :: buffer
|
||||
integer :: idx
|
||||
integer :: ierr
|
||||
|
||||
!
|
||||
! The big trick:
|
||||
! A string long enough to hold all data strings
|
||||
!
|
||||
character(len=nodata*(len(data(1))+1)) :: bufferd
|
||||
integer :: start
|
||||
|
||||
!
|
||||
! The value can be stored in an attribute values="..." or in
|
||||
! the data
|
||||
!
|
||||
has_var = .false.
|
||||
idx = xml_find_attrib( attribs, noattribs, 'values', buffer )
|
||||
if ( idx .gt. 0 ) then
|
||||
call read_from_buffer( buffer, var, ierr )
|
||||
if ( buffer .ne. ' ' ) then
|
||||
has_var = .true.
|
||||
endif
|
||||
else
|
||||
bufferd = ' '
|
||||
start = 1
|
||||
do idx = 1,nodata
|
||||
if ( data(idx) .ne. ' ' ) then
|
||||
bufferd(start:) = data(idx)
|
||||
start = start + len(data(idx)) + 1
|
||||
endif
|
||||
enddo
|
||||
call read_from_buffer( bufferd, var, ierr )
|
||||
if ( bufferd .ne. ' ' ) then
|
||||
has_var = .true.
|
||||
endif
|
||||
endif
|
||||
|
||||
if ( ierr .ne. 0 ) then
|
||||
write(*,*) 'Error reading variable - tag = ', trim(tag)
|
||||
has_var = .false.
|
||||
endif
|
||||
527
src/xml-fortran/read_xml_primitives.f90
Normal file
527
src/xml-fortran/read_xml_primitives.f90
Normal file
|
|
@ -0,0 +1,527 @@
|
|||
! read_xml_prims.f90 - Read routines for primitive data
|
||||
!
|
||||
! $Id: read_xml_prims.f90,v 1.7 2007/12/07 10:38:41 arjenmarkus Exp $
|
||||
!
|
||||
! Arjen Markus
|
||||
!
|
||||
! General information:
|
||||
! This module is part of the XML-Fortran library. Its
|
||||
! purpose is to help read individual items from an XML
|
||||
! file into the variables that have been connected to
|
||||
! the various tags. It is used by the code generated
|
||||
! by the make_xml_reader program.
|
||||
!
|
||||
! Because the routines differ mostly by the type of the
|
||||
! output variable, the body is included, to prevent
|
||||
! too much repeated blocks of code with all the maintenance
|
||||
! issues that causes.
|
||||
!
|
||||
module read_xml_primitives
|
||||
use xmlparse
|
||||
implicit none
|
||||
|
||||
private :: read_from_buffer
|
||||
private :: read_from_buffer_integers
|
||||
private :: read_from_buffer_reals
|
||||
private :: read_from_buffer_doubles
|
||||
private :: read_from_buffer_logicals
|
||||
private :: read_from_buffer_words
|
||||
|
||||
interface read_from_buffer
|
||||
module procedure read_from_buffer_integers
|
||||
module procedure read_from_buffer_reals
|
||||
module procedure read_from_buffer_doubles
|
||||
module procedure read_from_buffer_logicals
|
||||
module procedure read_from_buffer_words
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
! skip_until_endtag --
|
||||
! Routine to read the XML file until the end tag is encountered
|
||||
!
|
||||
! Arguments:
|
||||
! info The XML file data structure
|
||||
! tag The tag in question
|
||||
! attribs Array of attributes and their values
|
||||
! data Array of strings, representing the data
|
||||
! error Has an error occurred?
|
||||
!
|
||||
subroutine skip_until_endtag( info, tag, attribs, data, error )
|
||||
type(XML_PARSE), intent(inout) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
character(len=*), dimension(:,:), intent(inout) :: attribs
|
||||
character(len=*), dimension(:), intent(inout) :: data
|
||||
logical, intent(out) :: error
|
||||
|
||||
integer :: noattribs
|
||||
integer :: nodata
|
||||
integer :: ierr
|
||||
logical :: endtag
|
||||
character(len=len(tag)) :: newtag
|
||||
|
||||
error = .true.
|
||||
do
|
||||
call xml_get( info, newtag, endtag, attribs, noattribs, &
|
||||
data, nodata )
|
||||
if ( xml_error(info) ) then
|
||||
error = .true.
|
||||
exit
|
||||
endif
|
||||
if ( endtag .and. newtag == tag ) then
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
end subroutine skip_until_endtag
|
||||
|
||||
! read_xml_integer --
|
||||
! Routine to read a single integer from the parsed data
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question (error message only)
|
||||
! endtag End tag found? (Dummy argument, actually)
|
||||
! attribs Array of attributes and their values
|
||||
! noattribs Number of attributes found
|
||||
! data Array of strings, representing the data
|
||||
! nodata Number of data strings
|
||||
! var Variable to be filled
|
||||
! has_var Has the variable been set?
|
||||
!
|
||||
subroutine read_xml_integer( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var, has_var )
|
||||
integer, intent(inout) :: var
|
||||
|
||||
include 'read_xml_scalar.inc'
|
||||
|
||||
end subroutine read_xml_integer
|
||||
|
||||
! read_xml_line --
|
||||
! Routine to read a single line of text from the parsed data
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question (error message only)
|
||||
! endtag End tag found? (Dummy argument, actually)
|
||||
! attribs Array of attributes and their values
|
||||
! noattribs Number of attributes found
|
||||
! data Array of strings, representing the data
|
||||
! nodata Number of data strings
|
||||
! var Variable to be filled
|
||||
! has_var Has the variable been set?
|
||||
!
|
||||
subroutine read_xml_line( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var, has_var )
|
||||
type(XML_PARSE), intent(inout) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
logical, intent(inout) :: endtag
|
||||
character(len=*), dimension(:,:), intent(in) :: attribs
|
||||
integer, intent(in) :: noattribs
|
||||
character(len=*), dimension(:), intent(in) :: data
|
||||
integer, intent(in) :: nodata
|
||||
character(len=*), intent(inout) :: var
|
||||
logical, intent(inout) :: has_var
|
||||
|
||||
character(len=len(attribs(1,1))) :: buffer
|
||||
integer :: idx
|
||||
integer :: ierr
|
||||
|
||||
!
|
||||
! The value can be stored in an attribute value="..." or in
|
||||
! the data
|
||||
!
|
||||
has_var = .false.
|
||||
idx = xml_find_attrib( attribs, noattribs, 'value', buffer )
|
||||
if ( idx > 0 ) then
|
||||
var = buffer
|
||||
has_var = .true.
|
||||
else
|
||||
do idx = 1,nodata
|
||||
if ( data(idx) /= ' ' ) then
|
||||
var = data(idx)
|
||||
has_var = .true.
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
end subroutine read_xml_line
|
||||
|
||||
! read_xml_real, ... --
|
||||
! See read_xml_integer for an explanation
|
||||
!
|
||||
subroutine read_xml_real( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var, has_var )
|
||||
real, intent(inout) :: var
|
||||
|
||||
include 'read_xml_scalar.inc'
|
||||
|
||||
end subroutine read_xml_real
|
||||
|
||||
subroutine read_xml_double( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var, has_var )
|
||||
real(kind=kind(1.0d00)), intent(inout) :: var
|
||||
|
||||
include 'read_xml_scalar.inc'
|
||||
|
||||
end subroutine read_xml_double
|
||||
|
||||
subroutine read_xml_logical( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var, has_var )
|
||||
logical, intent(inout) :: var
|
||||
|
||||
include 'read_xml_scalar.inc'
|
||||
|
||||
end subroutine read_xml_logical
|
||||
|
||||
subroutine read_xml_word( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var, has_var )
|
||||
character(len=*), intent(inout) :: var
|
||||
|
||||
include 'read_xml_word.inc'
|
||||
|
||||
end subroutine read_xml_word
|
||||
|
||||
! read_xml_integer_array --
|
||||
! Routine to read a one-dimensional integer array from the parsed
|
||||
! ata
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question (error message only)
|
||||
! endtag End tag found? (Dummy argument, actually)
|
||||
! attribs Array of attributes and their values
|
||||
! noattribs Number of attributes found
|
||||
! data Array of strings, representing the data
|
||||
! nodata Number of data strings
|
||||
! var Variable to be filled
|
||||
! has_var Has the variable been set?
|
||||
!
|
||||
subroutine read_xml_integer_array( info, tag, endtag, attribs, noattribs, data, &
|
||||
nodata, var, has_var )
|
||||
integer, dimension(:), pointer :: var
|
||||
|
||||
include 'read_xml_array.inc'
|
||||
|
||||
end subroutine read_xml_integer_array
|
||||
|
||||
! read_xml_line_array --
|
||||
! Routine to read an array of lines of text from the parsed data
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question (error message only)
|
||||
! attribs Array of attributes and their values
|
||||
! noattribs Number of attributes found
|
||||
! data Array of strings, representing the data
|
||||
! nodata Number of data strings
|
||||
! var Variable to be filled
|
||||
! has_var Has the variable been set?
|
||||
!
|
||||
subroutine read_xml_line_array( info, tag, endtag, attribs, noattribs, data, &
|
||||
nodata, var, has_var )
|
||||
type(XML_PARSE), intent(inout) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
logical, intent(inout) :: endtag
|
||||
character(len=*), dimension(:,:), intent(in) :: attribs
|
||||
integer, intent(in) :: noattribs
|
||||
character(len=*), dimension(:), intent(in) :: data
|
||||
integer, intent(in) :: nodata
|
||||
character(len=*), dimension(:), pointer :: var
|
||||
logical, intent(inout) :: has_var
|
||||
|
||||
character(len=len(attribs(1,1))) :: buffer
|
||||
integer :: idx
|
||||
integer :: idxv
|
||||
integer :: ierr
|
||||
logical :: started
|
||||
|
||||
!
|
||||
! The value can be stored in an attribute values="..." or in
|
||||
! the data
|
||||
!
|
||||
has_var = .false.
|
||||
idx = xml_find_attrib( attribs, noattribs, 'values', buffer )
|
||||
if ( idx > 0 ) then
|
||||
allocate( var(1:1) )
|
||||
var(1) = buffer
|
||||
if ( buffer /= ' ' ) then
|
||||
has_var = .true.
|
||||
endif
|
||||
else
|
||||
idxv = 0
|
||||
started = .false.
|
||||
do idx = 1,nodata
|
||||
if ( data(idx) /= ' ' .or. started ) then
|
||||
if ( .not. started ) then
|
||||
allocate( var(1:nodata-idx+1) )
|
||||
started = .true.
|
||||
endif
|
||||
idxv = idxv + 1
|
||||
var(idxv) = data(idx)
|
||||
endif
|
||||
enddo
|
||||
if ( started ) then
|
||||
has_var = .true.
|
||||
endif
|
||||
endif
|
||||
end subroutine read_xml_line_array
|
||||
|
||||
! read_xml_real_array, ... --
|
||||
! See read_xml_integer_array for an explanation
|
||||
!
|
||||
subroutine read_xml_real_array( info, tag, endtag, attribs, noattribs, data, &
|
||||
nodata, var, has_var )
|
||||
real, dimension(:), pointer :: var
|
||||
|
||||
include 'read_xml_array.inc'
|
||||
|
||||
end subroutine read_xml_real_array
|
||||
|
||||
subroutine read_xml_double_array( info, tag, endtag, attribs, noattribs, data, &
|
||||
nodata, var, has_var )
|
||||
real(kind=kind(1.0d00)), dimension(:), pointer :: var
|
||||
|
||||
include 'read_xml_array.inc'
|
||||
|
||||
end subroutine read_xml_double_array
|
||||
|
||||
subroutine read_xml_logical_array( info, tag, endtag, attribs, noattribs, data, &
|
||||
nodata, var, has_var )
|
||||
logical, dimension(:), pointer :: var
|
||||
|
||||
include 'read_xml_array.inc'
|
||||
|
||||
end subroutine read_xml_logical_array
|
||||
|
||||
subroutine read_xml_word_array( info, tag, endtag, attribs, noattribs, data, &
|
||||
nodata, var, has_var )
|
||||
character(len=*), dimension(:), pointer :: var
|
||||
|
||||
include 'read_xml_array.inc'
|
||||
|
||||
end subroutine read_xml_word_array
|
||||
|
||||
! read_from_buffer_integers --
|
||||
! Routine to read all integers from a long string
|
||||
!
|
||||
! Arguments:
|
||||
! buffer String containing the data
|
||||
! var Variable to be filled
|
||||
! ierror Error flag
|
||||
!
|
||||
subroutine read_from_buffer_integers( buffer, var, ierror )
|
||||
integer, dimension(:), pointer :: var
|
||||
integer, dimension(:), pointer :: work
|
||||
|
||||
include 'read_from_buffer.inc'
|
||||
|
||||
end subroutine read_from_buffer_integers
|
||||
|
||||
! read_xml_from_buffer_reals, ... -
|
||||
! See read_xml_from_buffer_integers for an explanation
|
||||
!
|
||||
subroutine read_from_buffer_reals( buffer, var, ierror )
|
||||
real, dimension(:), pointer :: var
|
||||
real, dimension(:), pointer :: work
|
||||
|
||||
include 'read_from_buffer.inc'
|
||||
|
||||
end subroutine read_from_buffer_reals
|
||||
|
||||
subroutine read_from_buffer_doubles( buffer, var, ierror )
|
||||
real(kind=kind(1.0d00)), dimension(:), pointer :: var
|
||||
real(kind=kind(1.0d00)), dimension(:), pointer :: work
|
||||
|
||||
include 'read_from_buffer.inc'
|
||||
|
||||
end subroutine read_from_buffer_doubles
|
||||
|
||||
subroutine read_from_buffer_logicals( buffer, var, ierror )
|
||||
logical, dimension(:), pointer :: var
|
||||
logical, dimension(:), pointer :: work
|
||||
|
||||
include 'read_from_buffer.inc'
|
||||
|
||||
end subroutine read_from_buffer_logicals
|
||||
|
||||
subroutine read_from_buffer_words( buffer, var, ierror )
|
||||
character(len=*), dimension(:), pointer :: var
|
||||
character(len=len(var)), dimension(:), pointer :: work
|
||||
|
||||
include 'read_from_buffer.inc'
|
||||
|
||||
end subroutine read_from_buffer_words
|
||||
|
||||
! read_xml_word_1dim, ... -
|
||||
! Read an array of "words" (or ...) but from different elements
|
||||
!
|
||||
subroutine read_xml_integer_1dim( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var, has_var )
|
||||
type(XML_PARSE), intent(inout) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
logical, intent(inout) :: endtag
|
||||
character(len=*), dimension(:,:), intent(in) :: attribs
|
||||
integer, intent(in) :: noattribs
|
||||
character(len=*), dimension(:), intent(in) :: data
|
||||
integer, intent(in) :: nodata
|
||||
integer, dimension(:), pointer :: var
|
||||
logical, intent(inout) :: has_var
|
||||
|
||||
integer,dimension(:), pointer :: newvar
|
||||
character(len=len(attribs(1,1))) :: buffer
|
||||
integer :: newsize
|
||||
integer :: ierr
|
||||
|
||||
newsize = size(var) + 1
|
||||
allocate( newvar(1:newsize) )
|
||||
newvar(1:newsize-1) = var
|
||||
deallocate( var )
|
||||
var => newvar
|
||||
|
||||
call read_xml_integer( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var(newsize), has_var )
|
||||
|
||||
end subroutine read_xml_integer_1dim
|
||||
|
||||
subroutine read_xml_real_1dim( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var, has_var )
|
||||
type(XML_PARSE), intent(inout) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
logical, intent(inout) :: endtag
|
||||
character(len=*), dimension(:,:), intent(in) :: attribs
|
||||
integer, intent(in) :: noattribs
|
||||
character(len=*), dimension(:), intent(in) :: data
|
||||
integer, intent(in) :: nodata
|
||||
real, dimension(:), pointer :: var
|
||||
logical, intent(inout) :: has_var
|
||||
|
||||
real, dimension(:), pointer :: newvar
|
||||
character(len=len(attribs(1,1))) :: buffer
|
||||
integer :: newsize
|
||||
integer :: ierr
|
||||
|
||||
newsize = size(var) + 1
|
||||
allocate( newvar(1:newsize) )
|
||||
newvar(1:newsize-1) = var
|
||||
deallocate( var )
|
||||
var => newvar
|
||||
|
||||
call read_xml_real( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var(newsize), has_var )
|
||||
|
||||
end subroutine read_xml_real_1dim
|
||||
|
||||
subroutine read_xml_double_1dim( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var, has_var )
|
||||
type(XML_PARSE), intent(inout) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
logical, intent(inout) :: endtag
|
||||
character(len=*), dimension(:,:), intent(in) :: attribs
|
||||
integer, intent(in) :: noattribs
|
||||
character(len=*), dimension(:), intent(in) :: data
|
||||
integer, intent(in) :: nodata
|
||||
real(kind=kind(1.0d00)), dimension(:), pointer:: var
|
||||
logical, intent(inout) :: has_var
|
||||
|
||||
real(kind=kind(1.0d00)), dimension(:), pointer:: newvar
|
||||
character(len=len(attribs(1,1))) :: buffer
|
||||
integer :: newsize
|
||||
integer :: ierr
|
||||
|
||||
newsize = size(var) + 1
|
||||
allocate( newvar(1:newsize) )
|
||||
newvar(1:newsize-1) = var
|
||||
deallocate( var )
|
||||
var => newvar
|
||||
|
||||
call read_xml_double( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var(newsize), has_var )
|
||||
|
||||
end subroutine read_xml_double_1dim
|
||||
|
||||
subroutine read_xml_logical_1dim( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var, has_var )
|
||||
type(XML_PARSE), intent(inout) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
logical, intent(inout) :: endtag
|
||||
character(len=*), dimension(:,:), intent(in) :: attribs
|
||||
integer, intent(in) :: noattribs
|
||||
character(len=*), dimension(:), intent(in) :: data
|
||||
integer, intent(in) :: nodata
|
||||
logical, dimension(:), pointer :: var
|
||||
logical, intent(inout) :: has_var
|
||||
|
||||
logical, dimension(:), pointer :: newvar
|
||||
character(len=len(attribs(1,1))) :: buffer
|
||||
integer :: newsize
|
||||
integer :: ierr
|
||||
|
||||
newsize = size(var) + 1
|
||||
allocate( newvar(1:newsize) )
|
||||
newvar(1:newsize-1) = var
|
||||
deallocate( var )
|
||||
var => newvar
|
||||
|
||||
call read_xml_logical( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var(newsize), has_var )
|
||||
|
||||
end subroutine read_xml_logical_1dim
|
||||
|
||||
subroutine read_xml_word_1dim( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var, has_var )
|
||||
type(XML_PARSE), intent(inout) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
logical, intent(inout) :: endtag
|
||||
character(len=*), dimension(:,:), intent(in) :: attribs
|
||||
integer, intent(in) :: noattribs
|
||||
character(len=*), dimension(:), intent(in) :: data
|
||||
integer, intent(in) :: nodata
|
||||
character(len=*), dimension(:), pointer :: var
|
||||
logical, intent(inout) :: has_var
|
||||
|
||||
character(len=len(var)),dimension(:), pointer :: newvar
|
||||
character(len=len(attribs(1,1))) :: buffer
|
||||
integer :: newsize
|
||||
integer :: ierr
|
||||
|
||||
newsize = size(var) + 1
|
||||
allocate( newvar(1:newsize) )
|
||||
newvar(1:newsize-1) = var
|
||||
deallocate( var )
|
||||
var => newvar
|
||||
|
||||
call read_xml_word( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var(newsize), has_var )
|
||||
|
||||
end subroutine read_xml_word_1dim
|
||||
|
||||
subroutine read_xml_line_1dim( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var, has_var )
|
||||
type(XML_PARSE), intent(inout) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
logical, intent(inout) :: endtag
|
||||
character(len=*), dimension(:,:), intent(in) :: attribs
|
||||
integer, intent(in) :: noattribs
|
||||
character(len=*), dimension(:), intent(in) :: data
|
||||
integer, intent(in) :: nodata
|
||||
character(len=*), dimension(:), pointer :: var
|
||||
logical, intent(inout) :: has_var
|
||||
|
||||
character(len=len(var)),dimension(:), pointer :: newvar
|
||||
character(len=len(attribs(1,1))) :: buffer
|
||||
integer :: newsize
|
||||
integer :: ierr
|
||||
|
||||
newsize = size(var) + 1
|
||||
allocate( newvar(1:newsize) )
|
||||
newvar(1:newsize-1) = var
|
||||
deallocate( var )
|
||||
var => newvar
|
||||
|
||||
call read_xml_line( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
var(newsize), has_var )
|
||||
|
||||
end subroutine read_xml_line_1dim
|
||||
|
||||
|
||||
end module read_xml_primitives
|
||||
40
src/xml-fortran/read_xml_scalar.inc
Normal file
40
src/xml-fortran/read_xml_scalar.inc
Normal file
|
|
@ -0,0 +1,40 @@
|
|||
! Part of XML-Fortran library:
|
||||
!
|
||||
! $Id: read_xml_scalar.inc,v 1.3 2007/02/26 20:33:38 arjenmarkus Exp $
|
||||
!
|
||||
type(XML_PARSE), intent(inout) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
logical, intent(inout) :: endtag
|
||||
character(len=*), dimension(:,:), intent(in) :: attribs
|
||||
integer, intent(in) :: noattribs
|
||||
character(len=*), dimension(:), intent(in) :: data
|
||||
integer, intent(in) :: nodata
|
||||
logical, intent(inout) :: has_var
|
||||
|
||||
character(len=len(attribs(1,1))) :: buffer
|
||||
integer :: idx
|
||||
integer :: ierr
|
||||
|
||||
!
|
||||
! The value can be stored in an attribute value="..." or in
|
||||
! the data
|
||||
!
|
||||
has_var = .false.
|
||||
idx = xml_find_attrib( attribs, noattribs, 'value', buffer )
|
||||
if ( idx .gt. 0 ) then
|
||||
read( buffer, *, iostat=ierr ) var
|
||||
has_var = .true.
|
||||
else
|
||||
do idx = 1,nodata
|
||||
if ( data(idx) .ne. ' ' ) then
|
||||
read( data(idx), *, iostat=ierr ) var
|
||||
has_var = .true.
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
|
||||
if ( ierr .ne. 0 ) then
|
||||
write(*,*) 'Error reading variable - tag = ', trim(tag)
|
||||
has_var = .false.
|
||||
endif
|
||||
38
src/xml-fortran/read_xml_word.inc
Normal file
38
src/xml-fortran/read_xml_word.inc
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
! Part of XML-Fortran library:
|
||||
!
|
||||
type(XML_PARSE), intent(inout) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
logical, intent(inout) :: endtag
|
||||
character(len=*), dimension(:,:), intent(in) :: attribs
|
||||
integer, intent(in) :: noattribs
|
||||
character(len=*), dimension(:), intent(in) :: data
|
||||
integer, intent(in) :: nodata
|
||||
logical, intent(inout) :: has_var
|
||||
|
||||
character(len=len(attribs(1,1))) :: buffer
|
||||
integer :: idx
|
||||
integer :: ierr
|
||||
|
||||
!
|
||||
! The value can be stored in an attribute value="..." or in
|
||||
! the data
|
||||
!
|
||||
has_var = .false.
|
||||
idx = xml_find_attrib( attribs, noattribs, 'value', buffer )
|
||||
if ( idx .gt. 0 ) then
|
||||
read( buffer, *, iostat=ierr ) var
|
||||
has_var = .true.
|
||||
else
|
||||
do idx = 1,nodata
|
||||
if ( data(idx) .ne. ' ' ) then
|
||||
read( data(idx), '(A)', iostat=ierr ) var
|
||||
has_var = .true.
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
|
||||
if ( ierr .ne. 0 ) then
|
||||
write(*,*) 'Error reading variable - tag = ', trim(tag)
|
||||
has_var = .false.
|
||||
endif
|
||||
69
src/xml-fortran/templates/Makefile
Normal file
69
src/xml-fortran/templates/Makefile
Normal file
|
|
@ -0,0 +1,69 @@
|
|||
templates = $(wildcard *.xml)
|
||||
objects = $(templates:.xml=.o)
|
||||
|
||||
#===============================================================================
|
||||
# User Options
|
||||
#===============================================================================
|
||||
|
||||
COMPILER = intel
|
||||
DEBUG = no
|
||||
|
||||
#===============================================================================
|
||||
# Compiler Options
|
||||
#===============================================================================
|
||||
|
||||
# Set compiler defaults
|
||||
|
||||
F90 = gfortran
|
||||
F90FLAGS = -I..
|
||||
LDFLAGS =
|
||||
|
||||
# Intel Fortran compiler options
|
||||
|
||||
ifeq ($(COMPILER),intel)
|
||||
F90 = ifort
|
||||
F90FLAGS += -fpp
|
||||
endif
|
||||
|
||||
# GNU Fortran compiler options
|
||||
|
||||
ifeq ($(COMPILER),gfortran)
|
||||
F90 = gfortran
|
||||
F90FLAGS += -cpp -Wall
|
||||
endif
|
||||
|
||||
# Set compiler flags for debugging
|
||||
|
||||
ifeq ($(DEBUG),yes)
|
||||
F90FLAGS += -g
|
||||
LDFLAGS += -g
|
||||
ifeq ($(COMPILER),intel)
|
||||
F90FLAGS += -traceback -ftrapuv -fp-stack-check -check all
|
||||
endif
|
||||
ifeq ($(COMPILER),gfortran)
|
||||
F90FLAGS += -pedantic -std=f2008 -fbacktrace -fbounds-check \
|
||||
-ffpe-trap=invalid,zero,overflow,underflow
|
||||
endif
|
||||
endif
|
||||
|
||||
#===============================================================================
|
||||
# Targets
|
||||
#===============================================================================
|
||||
|
||||
all: $(objects)
|
||||
clean:
|
||||
@rm -f *.o *.mod *.out *.f90
|
||||
|
||||
#===============================================================================
|
||||
# Rules
|
||||
#===============================================================================
|
||||
|
||||
.SUFFIXES: .f90 .o .xml
|
||||
.PHONY: all clean
|
||||
.PRECIOUS: %.f90
|
||||
|
||||
%.f90: %.xml
|
||||
../xmlreader $(basename $@)
|
||||
|
||||
%.o: %.f90
|
||||
$(F90) $(F90FLAGS) -c $(basename $@).f90
|
||||
36
src/xml-fortran/templates/geometry_t.xml
Normal file
36
src/xml-fortran/templates/geometry_t.xml
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
<?xml version="1.0"?>
|
||||
<template>
|
||||
|
||||
<!-- This is the template for reading geometry in OpenMC -->
|
||||
|
||||
<options rootname="geometry" />
|
||||
|
||||
<typedef name="cell_xml">
|
||||
<component name="uid" type="integer" />
|
||||
<component name="universe" type="integer" default="0" />
|
||||
<component name="material" type="integer" default="0" />
|
||||
<component name="fill" type="integer" default="0" />
|
||||
<component name="surfaces" type="integer-array" />
|
||||
</typedef>
|
||||
|
||||
<typedef name="surface_xml">
|
||||
<component name="uid" type="integer" />
|
||||
<component name="type" type="word" length="15" />
|
||||
<component name="coeffs" type="double-array" />
|
||||
<component name="boundary" type="word" length="12" default="'transmit'" />
|
||||
</typedef>
|
||||
|
||||
<typedef name="lattice_xml">
|
||||
<component name="uid" type="integer" />
|
||||
<component name="type" type="word" length="12" />
|
||||
<component name="dimension" type="integer-array" />
|
||||
<component name="origin" type="double-array" />
|
||||
<component name="width" type="double-array" />
|
||||
<component name="universes" type="integer-array" />
|
||||
</typedef>
|
||||
|
||||
<variable name="cell_" tag="cell" type="cell_xml" dimension="1" />
|
||||
<variable name="surface_" tag="surface" type="surface_xml" dimension="1" />
|
||||
<variable name="lattice_" tag="lattice" type="lattice_xml" dimension="1" />
|
||||
|
||||
</template>
|
||||
42
src/xml-fortran/templates/materials_t.xml
Normal file
42
src/xml-fortran/templates/materials_t.xml
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
<?xml version="1.0"?>
|
||||
<template>
|
||||
|
||||
<!-- This is the template for reading materials in OpenMC -->
|
||||
|
||||
<options rootname="materials" />
|
||||
|
||||
<!-- Type for specifying density of a material -->
|
||||
|
||||
<typedef name="density_xml">
|
||||
<component name="value" type="double" />
|
||||
<component name="units" type="word" length="10" default="'atom/b-cm'" />
|
||||
</typedef>
|
||||
|
||||
<!-- Type for specifying a nuclide -->
|
||||
|
||||
<typedef name="nuclide_xml">
|
||||
<component name="name" type="word" length="10" />
|
||||
<component name="xs" type="word" length="3" />
|
||||
<component name="ao" type="double" default="0.0" />
|
||||
<component name="wo" type="double" default="0.0" />
|
||||
</typedef>
|
||||
|
||||
<!-- Type for specifying S(a,b) data -->
|
||||
|
||||
<typedef name="sab_xml">
|
||||
<component name="name" type="word" length="10" />
|
||||
<component name="xs" type="word" length="3" />
|
||||
</typedef>
|
||||
|
||||
<!-- Type for specifying a material -->
|
||||
|
||||
<typedef name="material_xml">
|
||||
<component name="uid" type="integer" />
|
||||
<component name="density" type="density_xml" />
|
||||
<component name="nuclides" tag="nuclide" type="nuclide_xml" dimension="1" />
|
||||
<component name="sab" type="sab_xml" />
|
||||
</typedef>
|
||||
|
||||
<variable name="material_" tag="material" type="material_xml" dimension="1" />
|
||||
|
||||
</template>
|
||||
33
src/xml-fortran/templates/settings_t.xml
Normal file
33
src/xml-fortran/templates/settings_t.xml
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
<?xml version="1.0"?>
|
||||
<template>
|
||||
|
||||
<options rootname="settings" />
|
||||
|
||||
<typedef name="xslibrary_xml">
|
||||
<component name="path" type="word" length="250" />
|
||||
</typedef>
|
||||
|
||||
<typedef name="criticality_xml">
|
||||
<component name="cycles" type="integer" />
|
||||
<component name="inactive" type="integer" />
|
||||
<component name="particles" type="integer" />
|
||||
</typedef>
|
||||
|
||||
<typedef name="source_xml">
|
||||
<component name="type" type="word" length="10" />
|
||||
<component name="coeffs" type="double-array" />
|
||||
</typedef>
|
||||
|
||||
<typedef name="cutoff_xml">
|
||||
<component name="weight" type="double" default="0.25" />
|
||||
<component name="weight_avg" type="double" default="1.0" />
|
||||
</typedef>
|
||||
|
||||
<variable name="xslibrary" type="xslibrary_xml" />
|
||||
<variable name="criticality" type="criticality_xml" />
|
||||
<variable name="verbosity_" tag="verbosity" type="integer" />
|
||||
<variable name="source_" tag="source" type="source_xml" />
|
||||
<variable name="survival_" tag="survival_biasing" type="word" length="3" dimension="1" />
|
||||
<variable name="cutoff_" tag="cutoff" type="cutoff_xml" />
|
||||
|
||||
</template>
|
||||
36
src/xml-fortran/templates/tallies_t.xml
Normal file
36
src/xml-fortran/templates/tallies_t.xml
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
<?xml version="1.0"?>
|
||||
<template>
|
||||
|
||||
<options rootname="tallies" />
|
||||
|
||||
<typedef name="mesh_xml">
|
||||
<component name="id" type="integer" />
|
||||
<component name="type" type="word" length="12" />
|
||||
<component name="dimension" type="integer-array" />
|
||||
<component name="origin" type="double-array" />
|
||||
<component name="width" type="double-array" />
|
||||
</typedef>
|
||||
|
||||
<typedef name="filter_xml">
|
||||
<component name="cell" type="word" length="250" default="''" />
|
||||
<component name="surface" type="word" length="250" default="''" />
|
||||
<component name="universe" type="word" length="250" default="''" />
|
||||
<component name="material" type="word" length="250" default="''" />
|
||||
<component name="mesh" type="integer" default="0" />
|
||||
<component name="cellborn" type="word" length="250" default="''" />
|
||||
<component name="energy" type="word" length="250" default="''" />
|
||||
<component name="energyout" type="word" length="250" default="''" />
|
||||
</typedef>
|
||||
|
||||
<typedef name="tally_xml">
|
||||
<component name="id" type="integer" />
|
||||
<component name="filters" type="filter_xml" />
|
||||
<component name="macros" type="word" length="250" default="''" />
|
||||
<component name="reactions" type="word" length="250" default="''" />
|
||||
<component name="nuclides" type="word" length="250" default="''" />
|
||||
</typedef>
|
||||
|
||||
<variable name="mesh_" tag="mesh" type="mesh_xml" dimension="1" />
|
||||
<variable name="tally_" tag="tally" type="tally_xml" dimension="1" />
|
||||
|
||||
</template>
|
||||
489
src/xml-fortran/write_xml_primitives.f90
Normal file
489
src/xml-fortran/write_xml_primitives.f90
Normal file
|
|
@ -0,0 +1,489 @@
|
|||
! write_xml_prims.f90 - Write routines for primitive data
|
||||
!
|
||||
! $Id: write_xml_prims.f90,v 1.2 2007/12/27 05:13:59 arjenmarkus Exp $
|
||||
!
|
||||
! Arjen Markus
|
||||
!
|
||||
! General information:
|
||||
! This module is part of the XML-Fortran library. Its
|
||||
! purpose is to write individual items to an XML
|
||||
! file using the right tag. It is used by the code generated
|
||||
! by the make_xml_reader program.
|
||||
!
|
||||
module write_xml_primitives
|
||||
use xmlparse
|
||||
implicit none
|
||||
|
||||
! interface write_to_xml
|
||||
! module procedure write_to_xml_integers
|
||||
! module procedure write_to_xml_reals
|
||||
! module procedure write_to_xml_doubles
|
||||
! module procedure write_to_xml_logicals
|
||||
! module procedure write_to_xml_words
|
||||
! end interface
|
||||
interface write_to_xml_word
|
||||
module procedure write_to_xml_string
|
||||
end interface
|
||||
interface write_to_xml_line
|
||||
module procedure write_to_xml_string
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
! write_to_xml_integer --
|
||||
! Routine to write a single integer to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! value Value to be written
|
||||
!
|
||||
subroutine write_to_xml_integer( info, tag, indent, value )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
integer, intent(in) :: value
|
||||
|
||||
character(len=100) :: indentation
|
||||
|
||||
indentation = ' '
|
||||
write( info%lun, '(4a,i0,3a)' ) indentation(1:min(indent,100)), &
|
||||
'<', trim(tag), '>', value, '</', trim(tag), '>'
|
||||
|
||||
end subroutine write_to_xml_integer
|
||||
|
||||
! write_to_xml_integer_1dim --
|
||||
! Routine to write an array of integers to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! values Values to be written
|
||||
!
|
||||
subroutine write_to_xml_integer_1dim( info, tag, indent, values )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
integer, dimension(:), intent(in) :: values
|
||||
|
||||
integer :: i
|
||||
|
||||
do i = 1,size(values)
|
||||
call write_to_xml_integer( info, tag, indent, values(i) )
|
||||
enddo
|
||||
|
||||
end subroutine write_to_xml_integer_1dim
|
||||
|
||||
! write_to_xml_real --
|
||||
! Routine to write a single real value (single precision) to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! value Value to be written
|
||||
!
|
||||
subroutine write_to_xml_real( info, tag, indent, value )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
real, intent(in) :: value
|
||||
|
||||
character(len=100) :: indentation
|
||||
character(len=12) :: buffer
|
||||
|
||||
indentation = ' '
|
||||
write( buffer, '(1pg12.4)' ) value
|
||||
write( info%lun, '(8a)' ) indentation(1:min(indent,100)), &
|
||||
'<', trim(tag), '>', trim(adjustl(buffer)), '</', trim(tag), '>'
|
||||
|
||||
end subroutine write_to_xml_real
|
||||
|
||||
! write_to_xml_real_1dim --
|
||||
! Routine to write an array of reals to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! values Values to be written
|
||||
!
|
||||
subroutine write_to_xml_real_1dim( info, tag, indent, values )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
real, dimension(:), intent(in) :: values
|
||||
|
||||
integer :: i
|
||||
|
||||
do i = 1,size(values)
|
||||
call write_to_xml_real( info, tag, indent, values(i) )
|
||||
enddo
|
||||
|
||||
end subroutine write_to_xml_real_1dim
|
||||
|
||||
! write_to_xml_double --
|
||||
! Routine to write one real value (double precision) to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! value Value to be written
|
||||
!
|
||||
subroutine write_to_xml_double( info, tag, indent, value )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
real(kind=kind(1.0d0)), intent(in) :: value
|
||||
|
||||
character(len=100) :: indentation
|
||||
character(len=16) :: buffer
|
||||
|
||||
indentation = ' '
|
||||
write( buffer, '(1pg16.7)' ) value
|
||||
write( info%lun, '(8a)' ) indentation(1:min(indent,100)), &
|
||||
'<', trim(tag), '>', trim(adjustl(buffer)), '</', trim(tag), '>'
|
||||
|
||||
end subroutine write_to_xml_double
|
||||
|
||||
! write_to_xml_double_1dim --
|
||||
! Routine to write an array of double precision reals to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! values Values to be written
|
||||
!
|
||||
subroutine write_to_xml_double_1dim( info, tag, indent, values )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
real(kind=kind(1.0d00)), dimension(:), intent(in) :: values
|
||||
|
||||
integer :: i
|
||||
|
||||
do i = 1,size(values)
|
||||
call write_to_xml_double( info, tag, indent, values(i) )
|
||||
enddo
|
||||
|
||||
end subroutine write_to_xml_double_1dim
|
||||
|
||||
! write_to_xml_string --
|
||||
! Routine to write one string to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! value Value to be written
|
||||
!
|
||||
subroutine write_to_xml_string( info, tag, indent, value )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
character(len=*), intent(in) :: value
|
||||
|
||||
character(len=100) :: indentation
|
||||
|
||||
!
|
||||
! NOTE: No guards against <, >, & and " yet!
|
||||
! NOTE: difference needed between words and lines?
|
||||
!
|
||||
indentation = ' '
|
||||
write( info%lun, '(8a)' ) indentation(1:min(indent,100)), &
|
||||
'<', trim(tag), '>', trim(value), '</', trim(tag), '>'
|
||||
|
||||
end subroutine write_to_xml_string
|
||||
|
||||
! write_to_xml_word_1dim --
|
||||
! Routine to write an array of single words to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! value Value to be written
|
||||
!
|
||||
subroutine write_to_xml_word_1dim( info, tag, indent, values )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
character(len=*), dimension(:), intent(in) :: values
|
||||
|
||||
integer :: i
|
||||
|
||||
do i = 1,size(values)
|
||||
call write_to_xml_string( info, tag, indent, values(i) )
|
||||
enddo
|
||||
end subroutine write_to_xml_word_1dim
|
||||
|
||||
! write_to_xml_string_1dim --
|
||||
! Routine to write an array of strings to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! values Values to be written
|
||||
!
|
||||
subroutine write_to_xml_string_1dim( info, tag, indent, values )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
character(len=*), dimension(:), intent(in) :: values
|
||||
|
||||
integer :: i
|
||||
|
||||
do i = 1,size(values)
|
||||
call write_to_xml_string( info, tag, indent, values(i) )
|
||||
enddo
|
||||
|
||||
end subroutine write_to_xml_string_1dim
|
||||
|
||||
! write_to_xml_logical --
|
||||
! Routine to write one logical to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! value Value to be written
|
||||
!
|
||||
subroutine write_to_xml_logical( info, tag, indent, value )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
logical, intent(in) :: value
|
||||
|
||||
character(len=100) :: indentation
|
||||
|
||||
indentation = ' '
|
||||
if ( value ) then
|
||||
write( info%lun, '(8a)' ) indentation(1:min(indent,100)), &
|
||||
'<', trim(tag), '>true</', trim(tag), '>'
|
||||
else
|
||||
write( info%lun, '(8a)' ) indentation(1:min(indent,100)), &
|
||||
'<', trim(tag), '>false</', trim(tag), '>'
|
||||
endif
|
||||
|
||||
end subroutine write_to_xml_logical
|
||||
|
||||
! write_to_xml_logical_1dim --
|
||||
! Routine to write an array of logicals to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! values Values to be written
|
||||
!
|
||||
subroutine write_to_xml_logical_1dim( info, tag, indent, values )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
logical, dimension(:), intent(in) :: values
|
||||
|
||||
integer :: i
|
||||
|
||||
do i = 1,size(values)
|
||||
call write_to_xml_logical( info, tag, indent, values(i) )
|
||||
enddo
|
||||
|
||||
end subroutine write_to_xml_logical_1dim
|
||||
|
||||
! write_to_xml_integer_array --
|
||||
! Routine to write an array of integers to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! array Values to be written
|
||||
!
|
||||
subroutine write_to_xml_integer_array( info, tag, indent, array )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
integer, dimension(:), intent(in) :: array
|
||||
|
||||
character(len=100) :: indentation
|
||||
integer :: i, i2, j
|
||||
|
||||
indentation = ' '
|
||||
|
||||
write( info%lun, '(4a)' ) indentation(1:min(indent,100)), &
|
||||
'<', trim(tag), '>'
|
||||
do i = 1,size(array),10
|
||||
i2 = min( i + 9, size(array) )
|
||||
write( info%lun, '(a,10i12)' ) indentation(1:min(indent+4,100)), &
|
||||
( array(j) ,j = i,i2 )
|
||||
enddo
|
||||
write( info%lun, '(4a)' ) indentation(1:min(indent,100)), &
|
||||
'</', trim(tag), '>'
|
||||
|
||||
end subroutine write_to_xml_integer_array
|
||||
|
||||
! write_to_xml_real_array --
|
||||
! Routine to write an array of single precision reals to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! array Values to be written
|
||||
!
|
||||
subroutine write_to_xml_real_array( info, tag, indent, array )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
real, dimension(:), intent(in) :: array
|
||||
|
||||
character(len=100) :: indentation
|
||||
integer :: i, i2, j
|
||||
|
||||
indentation = ' '
|
||||
|
||||
write( info%lun, '(4a)' ) indentation(1:min(indent,100)), &
|
||||
'<', trim(tag), '>'
|
||||
do i = 1,size(array),10
|
||||
i2 = min( i + 9, size(array) )
|
||||
write( info%lun, '(a,10g12.4)' ) indentation(1:min(indent+4,100)), &
|
||||
( array(j) ,j = i,i2 )
|
||||
enddo
|
||||
write( info%lun, '(4a)' ) indentation(1:min(indent,100)), &
|
||||
'</', trim(tag), '>'
|
||||
|
||||
end subroutine write_to_xml_real_array
|
||||
|
||||
! write_to_xml_double_array --
|
||||
! Routine to write an array of double precision reals to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! array Values to be written
|
||||
!
|
||||
subroutine write_to_xml_double_array( info, tag, indent, array )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
real(kind=kind(1.0d0)), dimension(:), intent(in) :: array
|
||||
|
||||
character(len=100) :: indentation
|
||||
integer :: i, i2, j
|
||||
|
||||
indentation = ' '
|
||||
|
||||
write( info%lun, '(4a)' ) indentation(1:min(indent,100)), &
|
||||
'<', trim(tag), '>'
|
||||
do i = 1,size(array),5
|
||||
i2 = min( i + 4, size(array) )
|
||||
write( info%lun, '(a,5g20.7)' ) indentation(1:min(indent+4,100)), &
|
||||
( array(j) ,j = i,i2 )
|
||||
enddo
|
||||
write( info%lun, '(4a)' ) indentation(1:min(indent,100)), &
|
||||
'</', trim(tag), '>'
|
||||
|
||||
end subroutine write_to_xml_double_array
|
||||
|
||||
! write_to_xml_logical_array --
|
||||
! Routine to write an array of logicals to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! array Values to be written
|
||||
!
|
||||
subroutine write_to_xml_logical_array( info, tag, indent, array )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
logical, dimension(:), intent(in) :: array
|
||||
|
||||
character(len=100) :: indentation
|
||||
integer :: i, i2, j
|
||||
|
||||
indentation = ' '
|
||||
|
||||
write( info%lun, '(4a)' ) indentation(1:min(indent,100)), &
|
||||
'<', trim(tag), '>'
|
||||
do i = 1,size(array),10
|
||||
i2 = min( i + 9, size(array) )
|
||||
write( info%lun, '(a,10a)' ) indentation(1:min(indent+4,100)), &
|
||||
( merge('true ', 'false ', array(j)) ,j = i,i2 )
|
||||
enddo
|
||||
write( info%lun, '(4a)' ) indentation(1:min(indent,100)), &
|
||||
'</', trim(tag), '>'
|
||||
|
||||
end subroutine write_to_xml_logical_array
|
||||
|
||||
! write_to_xml_word_array --
|
||||
! Routine to write an array of words to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! array Values to be written
|
||||
!
|
||||
subroutine write_to_xml_word_array( info, tag, indent, array )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
character(len=*), dimension(:), intent(in) :: array
|
||||
|
||||
character(len=100) :: indentation
|
||||
integer :: i, i2, j
|
||||
|
||||
indentation = ' '
|
||||
|
||||
write( info%lun, '(4a)' ) indentation(1:min(indent,100)), &
|
||||
'<', trim(tag), '>'
|
||||
do i = 1,size(array),10
|
||||
i2 = min( i + 9, size(array) )
|
||||
write( info%lun, '(a,20a)' ) indentation(1:min(indent+4,100)), &
|
||||
( trim(array(j)) , ' ' ,j = i,i2 )
|
||||
enddo
|
||||
write( info%lun, '(4a)' ) indentation(1:min(indent,100)), &
|
||||
'</', trim(tag), '>'
|
||||
|
||||
end subroutine write_to_xml_word_array
|
||||
|
||||
! write_to_xml_line_array --
|
||||
! Routine to write an array of lines to the XML file
|
||||
!
|
||||
! Arguments:
|
||||
! info XML parser structure
|
||||
! tag The tag in question
|
||||
! indent Number of spaces for indentation
|
||||
! array Values to be written
|
||||
!
|
||||
subroutine write_to_xml_line_array( info, tag, indent, array )
|
||||
type(XML_PARSE), intent(in) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer, intent(in) :: indent
|
||||
logical, dimension(:), intent(in) :: array
|
||||
|
||||
character(len=100) :: indentation
|
||||
integer :: i, i2, j
|
||||
|
||||
indentation = ' '
|
||||
|
||||
write( info%lun, '(4a)' ) indentation(1:min(indent,100)), &
|
||||
'<', trim(tag), '>'
|
||||
do i = 1,size(array)
|
||||
write( info%lun, '(a)' ) indentation(1:min(indent+4,100)), &
|
||||
array(i)
|
||||
enddo
|
||||
write( info%lun, '(4a)' ) indentation(1:min(indent,100)), &
|
||||
'</', trim(tag), '>'
|
||||
|
||||
end subroutine write_to_xml_line_array
|
||||
|
||||
end module write_xml_primitives
|
||||
1068
src/xml-fortran/xmlparse.f90
Normal file
1068
src/xml-fortran/xmlparse.f90
Normal file
File diff suppressed because it is too large
Load diff
1239
src/xml-fortran/xmlreader.f90
Normal file
1239
src/xml-fortran/xmlreader.f90
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -1,737 +0,0 @@
|
|||
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=.false., 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_ = .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('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
|
||||
|
|
@ -1,822 +0,0 @@
|
|||
module xml_data_materials_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_materials_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_materials_t
|
||||
call xml_open( info, fname, .true. )
|
||||
call xml_options( info, report_errors=.false., 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_materials_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_materials_t
|
||||
|
||||
end subroutine
|
||||
|
||||
end module
|
||||
|
|
@ -1,836 +0,0 @@
|
|||
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 cutoff_xml
|
||||
real(kind=kind(1.0d0)) :: weight
|
||||
real(kind=kind(1.0d0)) :: weight_avg
|
||||
end type cutoff_xml
|
||||
type(xslibrary_xml) :: xslibrary
|
||||
type(criticality_xml) :: criticality
|
||||
integer :: verbosity_
|
||||
type(source_xml) :: source_
|
||||
character(len=3), dimension(:), pointer :: survival_ => null()
|
||||
type(cutoff_xml) :: cutoff_
|
||||
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_type_cutoff_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(cutoff_xml), dimension(:), pointer :: dvar
|
||||
logical, intent(inout) :: has_dvar
|
||||
|
||||
integer :: newsize
|
||||
type(cutoff_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_cutoff_xml( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
dvar(newsize), has_dvar )
|
||||
end subroutine read_xml_type_cutoff_xml_array
|
||||
|
||||
subroutine read_xml_type_cutoff_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(cutoff_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_weight
|
||||
logical :: has_weight_avg
|
||||
has_weight = .false.
|
||||
has_weight_avg = .false.
|
||||
call init_xml_type_cutoff_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('weight')
|
||||
call read_xml_double( &
|
||||
info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
dvar%weight, has_weight )
|
||||
case('weight_avg')
|
||||
call read_xml_double( &
|
||||
info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
dvar%weight_avg, has_weight_avg )
|
||||
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
|
||||
end subroutine read_xml_type_cutoff_xml
|
||||
subroutine init_xml_type_cutoff_xml_array( dvar )
|
||||
type(cutoff_xml), dimension(:), pointer :: dvar
|
||||
if ( associated( dvar ) ) then
|
||||
deallocate( dvar )
|
||||
endif
|
||||
allocate( dvar(0) )
|
||||
end subroutine init_xml_type_cutoff_xml_array
|
||||
subroutine init_xml_type_cutoff_xml(dvar)
|
||||
type(cutoff_xml) :: dvar
|
||||
dvar%weight = 0.25
|
||||
dvar%weight_avg = 1.0
|
||||
end subroutine init_xml_type_cutoff_xml
|
||||
subroutine write_xml_type_cutoff_xml_array( &
|
||||
info, tag, indent, dvar )
|
||||
type(XML_PARSE) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer :: indent
|
||||
type(cutoff_xml), dimension(:) :: dvar
|
||||
integer :: i
|
||||
do i = 1,size(dvar)
|
||||
call write_xml_type_cutoff_xml( info, tag, indent, dvar(i) )
|
||||
enddo
|
||||
end subroutine write_xml_type_cutoff_xml_array
|
||||
|
||||
subroutine write_xml_type_cutoff_xml( &
|
||||
info, tag, indent, dvar )
|
||||
type(XML_PARSE) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer :: indent
|
||||
type(cutoff_xml) :: dvar
|
||||
character(len=100) :: indentation
|
||||
indentation = ' '
|
||||
write(info%lun, '(4a)' ) indentation(1:min(indent,100)),&
|
||||
'<',trim(tag), '>'
|
||||
call write_to_xml_double( info, 'weight', indent+3, dvar%weight)
|
||||
call write_to_xml_double( info, 'weight_avg', indent+3, dvar%weight_avg)
|
||||
write(info%lun,'(4a)') indentation(1:min(indent,100)), &
|
||||
'</' //trim(tag) // '>'
|
||||
end subroutine write_xml_type_cutoff_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_
|
||||
logical :: has_survival_
|
||||
logical :: has_cutoff_
|
||||
has_xslibrary = .false.
|
||||
has_criticality = .false.
|
||||
has_verbosity_ = .false.
|
||||
has_source_ = .false.
|
||||
has_survival_ = .false.
|
||||
allocate(survival_(0))
|
||||
has_cutoff_ = .false.
|
||||
|
||||
call init_xml_file_settings_t
|
||||
call xml_open( info, fname, .true. )
|
||||
call xml_options( info, report_errors=.false., 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('survival_biasing')
|
||||
call read_xml_word_1dim( &
|
||||
info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
survival_, has_survival_ )
|
||||
case('cutoff')
|
||||
call read_xml_type_cutoff_xml( &
|
||||
info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
cutoff_, has_cutoff_ )
|
||||
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 ( .not. has_survival_ ) then
|
||||
error = .true.
|
||||
call xml_report_errors(info, 'Missing data on survival_')
|
||||
endif
|
||||
if ( .not. has_cutoff_ ) then
|
||||
error = .true.
|
||||
call xml_report_errors(info, 'Missing data on cutoff_')
|
||||
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_)
|
||||
call write_to_xml_word_1dim( info, 'survival_biasing', indent+3, survival_)
|
||||
call write_xml_type_cutoff_xml( info, 'cutoff', indent+3, cutoff_)
|
||||
write(info%lun,'(a)') '</settings>'
|
||||
call xml_close(info)
|
||||
end subroutine
|
||||
|
||||
subroutine init_xml_file_settings_t
|
||||
|
||||
end subroutine
|
||||
|
||||
end module
|
||||
|
|
@ -1,739 +0,0 @@
|
|||
module xml_data_tallies_t
|
||||
use READ_XML_PRIMITIVES
|
||||
use WRITE_XML_PRIMITIVES
|
||||
use XMLPARSE
|
||||
implicit none
|
||||
integer, private :: lurep_
|
||||
logical, private :: strict_
|
||||
|
||||
type mesh_xml
|
||||
integer :: id
|
||||
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()
|
||||
end type mesh_xml
|
||||
|
||||
type filter_xml
|
||||
character(len=250) :: cell
|
||||
character(len=250) :: surface
|
||||
character(len=250) :: universe
|
||||
character(len=250) :: material
|
||||
integer :: mesh
|
||||
character(len=250) :: cellborn
|
||||
character(len=250) :: energy
|
||||
character(len=250) :: energyout
|
||||
end type filter_xml
|
||||
|
||||
type tally_xml
|
||||
integer :: id
|
||||
type(filter_xml) :: filters
|
||||
character(len=250) :: macros
|
||||
character(len=250) :: reactions
|
||||
character(len=250) :: nuclides
|
||||
end type tally_xml
|
||||
type(mesh_xml), dimension(:), pointer :: mesh_ => null()
|
||||
type(tally_xml), dimension(:), pointer :: tally_ => null()
|
||||
contains
|
||||
subroutine read_xml_type_mesh_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(mesh_xml), dimension(:), pointer :: dvar
|
||||
logical, intent(inout) :: has_dvar
|
||||
|
||||
integer :: newsize
|
||||
type(mesh_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_mesh_xml( info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
dvar(newsize), has_dvar )
|
||||
end subroutine read_xml_type_mesh_xml_array
|
||||
|
||||
subroutine read_xml_type_mesh_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(mesh_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_type
|
||||
logical :: has_dimension
|
||||
logical :: has_origin
|
||||
logical :: has_width
|
||||
has_id = .false.
|
||||
has_type = .false.
|
||||
has_dimension = .false.
|
||||
has_origin = .false.
|
||||
has_width = .false.
|
||||
call init_xml_type_mesh_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('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 ('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_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
|
||||
end subroutine read_xml_type_mesh_xml
|
||||
subroutine init_xml_type_mesh_xml_array( dvar )
|
||||
type(mesh_xml), dimension(:), pointer :: dvar
|
||||
if ( associated( dvar ) ) then
|
||||
deallocate( dvar )
|
||||
endif
|
||||
allocate( dvar(0) )
|
||||
end subroutine init_xml_type_mesh_xml_array
|
||||
subroutine init_xml_type_mesh_xml(dvar)
|
||||
type(mesh_xml) :: dvar
|
||||
end subroutine init_xml_type_mesh_xml
|
||||
subroutine write_xml_type_mesh_xml_array( &
|
||||
info, tag, indent, dvar )
|
||||
type(XML_PARSE) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer :: indent
|
||||
type(mesh_xml), dimension(:) :: dvar
|
||||
integer :: i
|
||||
do i = 1,size(dvar)
|
||||
call write_xml_type_mesh_xml( info, tag, indent, dvar(i) )
|
||||
enddo
|
||||
end subroutine write_xml_type_mesh_xml_array
|
||||
|
||||
subroutine write_xml_type_mesh_xml( &
|
||||
info, tag, indent, dvar )
|
||||
type(XML_PARSE) :: info
|
||||
character(len=*), intent(in) :: tag
|
||||
integer :: indent
|
||||
type(mesh_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_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)
|
||||
write(info%lun,'(4a)') indentation(1:min(indent,100)), &
|
||||
'</' //trim(tag) // '>'
|
||||
end subroutine write_xml_type_mesh_xml
|
||||
|
||||
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_cell
|
||||
logical :: has_surface
|
||||
logical :: has_universe
|
||||
logical :: has_material
|
||||
logical :: has_mesh
|
||||
logical :: has_cellborn
|
||||
logical :: has_energy
|
||||
logical :: has_energyout
|
||||
has_cell = .false.
|
||||
has_surface = .false.
|
||||
has_universe = .false.
|
||||
has_material = .false.
|
||||
has_mesh = .false.
|
||||
has_cellborn = .false.
|
||||
has_energy = .false.
|
||||
has_energyout = .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('cell')
|
||||
call read_xml_word( &
|
||||
info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
dvar%cell, has_cell )
|
||||
case('surface')
|
||||
call read_xml_word( &
|
||||
info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
dvar%surface, has_surface )
|
||||
case('universe')
|
||||
call read_xml_word( &
|
||||
info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
dvar%universe, has_universe )
|
||||
case('material')
|
||||
call read_xml_word( &
|
||||
info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
dvar%material, has_material )
|
||||
case('mesh')
|
||||
call read_xml_integer( &
|
||||
info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
dvar%mesh, has_mesh )
|
||||
case('cellborn')
|
||||
call read_xml_word( &
|
||||
info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
dvar%cellborn, has_cellborn )
|
||||
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 ('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
|
||||
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
|
||||
dvar%cell = ''
|
||||
dvar%surface = ''
|
||||
dvar%universe = ''
|
||||
dvar%material = ''
|
||||
dvar%mesh = 0
|
||||
dvar%cellborn = ''
|
||||
dvar%energy = ''
|
||||
dvar%energyout = ''
|
||||
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, 'cell', indent+3, dvar%cell)
|
||||
call write_to_xml_word( info, 'surface', indent+3, dvar%surface)
|
||||
call write_to_xml_word( info, 'universe', indent+3, dvar%universe)
|
||||
call write_to_xml_word( info, 'material', indent+3, dvar%material)
|
||||
call write_to_xml_integer( info, 'mesh', indent+3, dvar%mesh)
|
||||
call write_to_xml_word( info, 'cellborn', indent+3, dvar%cellborn)
|
||||
call write_to_xml_word( info, 'energy', indent+3, dvar%energy)
|
||||
call write_to_xml_word( info, 'energyout', indent+3, dvar%energyout)
|
||||
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_macros
|
||||
logical :: has_reactions
|
||||
logical :: has_nuclides
|
||||
has_id = .false.
|
||||
has_filters = .false.
|
||||
has_macros = .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('macros')
|
||||
call read_xml_word( &
|
||||
info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
dvar%macros, has_macros )
|
||||
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
|
||||
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
|
||||
dvar%macros = ''
|
||||
dvar%reactions = ''
|
||||
dvar%nuclides = ''
|
||||
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, 'macros', indent+3, dvar%macros)
|
||||
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_mesh_
|
||||
logical :: has_tally_
|
||||
has_mesh_ = .false.
|
||||
allocate(mesh_(0))
|
||||
has_tally_ = .false.
|
||||
allocate(tally_(0))
|
||||
|
||||
call init_xml_file_tallies_t
|
||||
call xml_open( info, fname, .true. )
|
||||
call xml_options( info, report_errors=.false., 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('mesh')
|
||||
call read_xml_type_mesh_xml_array( &
|
||||
info, tag, endtag, attribs, noattribs, data, nodata, &
|
||||
mesh_, has_mesh_ )
|
||||
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_mesh_ ) then
|
||||
error = .true.
|
||||
call xml_report_errors(info, 'Missing data on mesh_')
|
||||
endif
|
||||
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_mesh_xml_array( info, 'mesh', indent+3, mesh_)
|
||||
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