1547 lines
47 KiB
Fortran
1547 lines
47 KiB
Fortran
!===============================================================================
|
|
!
|
|
! This file is a component of the AMUN source code, a robust and versatile
|
|
! framework for conducting numerical simulations in fluid approximation
|
|
! on uniform and non-uniform (adaptive) meshes. AMUN is designed for
|
|
! magnetohydrodynamic (classical and relativistic) plasma modeling studies
|
|
! of astrophysical phenomena.
|
|
!
|
|
! Copyright (C) 2023-2024 Grzegorz Kowal <grzegorz@amuncode.org>
|
|
!
|
|
! This program is free software: you can redistribute it and/or modify
|
|
! it under the terms of the GNU General Public License as published by
|
|
! the Free Software Foundation, either version 3 of the License, or
|
|
! (at your option) any later version.
|
|
!
|
|
! This program is distributed in the hope that it will be useful,
|
|
! but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
! GNU General Public License for more details.
|
|
!
|
|
! You should have received a copy of the GNU General Public License
|
|
! along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
!
|
|
!===============================================================================
|
|
!
|
|
! Name: XML
|
|
!
|
|
! Description:
|
|
!
|
|
! The XML module offers a user-friendly interface for parsing, creating,
|
|
! manipulating, and saving XML data in Fortran 2003. It introduces two
|
|
! primary data structures, XMLNode and XMLAttribute, which effectively
|
|
! represent XML elements and attributes. Within this module, you can easily
|
|
! initialize XML nodes and attributes, append child nodes and attributes
|
|
! to a parent node, parse XML files to construct an XML tree, retrieve
|
|
! values of elements and attributes, print the XML tree, and seamlessly
|
|
! save XML data back to a file.
|
|
!
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
module XML
|
|
|
|
implicit none
|
|
|
|
private
|
|
|
|
! Module interfaces
|
|
! -----------------
|
|
!
|
|
interface XMLAddElement
|
|
module procedure XMLAddElementString
|
|
module procedure XMLAddElementInteger
|
|
module procedure XMLAddElementDouble
|
|
module procedure XMLAddElementFile
|
|
end interface
|
|
|
|
interface XMLGetElementValue
|
|
module procedure XMLGetElementValueInteger
|
|
module procedure XMLGetElementValueDouble
|
|
module procedure XMLGetElementValueString
|
|
end interface
|
|
|
|
interface XMLGetAttributeValue
|
|
module procedure XMLGetAttributeValueInteger
|
|
module procedure XMLGetAttributeValueLong
|
|
module procedure XMLGetAttributeValueDouble
|
|
module procedure XMLGetAttributeValueString
|
|
end interface
|
|
|
|
! Module structures
|
|
! -----------------
|
|
!
|
|
type XMLNode
|
|
character(len=:), allocatable :: name
|
|
character(len=:), allocatable :: value
|
|
type(XMLAttribute), pointer :: attributes
|
|
type(XMLNode) , pointer :: children
|
|
type(XMLNode) , pointer :: next
|
|
end type XMLNode
|
|
|
|
type XMLAttribute
|
|
character(len=:), allocatable :: name
|
|
character(len=:), allocatable :: value
|
|
type(XMLAttribute), pointer :: next
|
|
end type XMLAttribute
|
|
|
|
! Public members
|
|
! --------------
|
|
!
|
|
public :: XMLNode, XMLAttribute
|
|
public :: XMLParseFile, XMLInitTree, XMLFreeTree, XMLSaveTree
|
|
public :: XMLAddElement, XMLGetElementValue, XMLGetAttributeValue
|
|
public :: XMLHasAttribute
|
|
|
|
contains
|
|
|
|
!=== PUBLIC SUBROUTINES AND FUNCTIONS ===
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLParseFile:
|
|
! -----------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Parses an XML file and builds an XML tree, returning a pointer to its root.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! filename - Input filename of the XML file to parse;
|
|
! root_ptr - Pointer to the root node of the XML tree;
|
|
! status - a flag indicating the status of the subroutine;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLParseFile(filename, root_ptr, status)
|
|
|
|
use helpers, only : print_message
|
|
|
|
implicit none
|
|
|
|
character(len=*) , intent(in ) :: filename
|
|
type(XMLNode), pointer, intent( out) :: root_ptr
|
|
integer , intent( out) :: status
|
|
|
|
character(len=*), parameter :: loc = "XML::XMLParseFile()"
|
|
|
|
integer :: io, filesize, ibeg, iend
|
|
|
|
character(:), allocatable :: content
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
status = 0
|
|
|
|
inquire (file=filename, size=filesize)
|
|
|
|
allocate(character(filesize) :: content)
|
|
|
|
open (newunit=io, file=filename, access='stream', action='read')
|
|
read (io) content
|
|
close (io)
|
|
|
|
ibeg = index(content, '<?xml')
|
|
if (ibeg <= 0) then
|
|
call print_message(loc, "File '" // trim(filename) // &
|
|
"' does not seem to be an XML file!")
|
|
deallocate(content)
|
|
status = -1
|
|
return
|
|
end if
|
|
|
|
ibeg = index(content, '<AMUNFile')
|
|
if (ibeg <= 0) then
|
|
call print_message(loc, "File '" // trim(filename) // &
|
|
"' does not seem to be an AMUN-XML file!")
|
|
deallocate(content)
|
|
status = -1
|
|
return
|
|
end if
|
|
|
|
iend = index(content(ibeg:), '>')
|
|
if (iend <= 0) then
|
|
call print_message(loc, "File '" // trim(filename) // &
|
|
"' seems to be corrupted!")
|
|
deallocate(content)
|
|
status = -1
|
|
return
|
|
end if
|
|
iend = iend + ibeg - 1
|
|
|
|
call XMLNodeInit(root_ptr, "AMUNFile")
|
|
|
|
call XMLIterateAttributes(trim(content(ibeg:iend)), root_ptr)
|
|
|
|
ibeg = iend + 1
|
|
iend = index(content, '</AMUNFile>') - 1
|
|
if (iend <= 0) then
|
|
call print_message(loc, "File '" // trim(filename) // &
|
|
"' seems to be corrupted!")
|
|
deallocate(content)
|
|
status = -1
|
|
return
|
|
end if
|
|
|
|
call XMLIterateSections(trim(adjustl(content(ibeg:iend))), root_ptr)
|
|
|
|
deallocate(content)
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLParseFile
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLTreeInit:
|
|
! ----------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Initializes a new XML Tree.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! node_ptr - Pointer to the XMLNode to be initialized;
|
|
! node_name - Name for the XMLNode;
|
|
! node_value - Optional value for the XMLNode;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLInitTree(root_ptr, version)
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(inout) :: root_ptr
|
|
character(len=*) , intent(in ), optional :: version
|
|
|
|
type(XMLAttribute), pointer :: attr_ptr
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
call XMLNodeInit(root_ptr, "AMUNFile")
|
|
if (present(version)) then
|
|
call XMLAttributeInit(attr_ptr, "version", trim(version))
|
|
else
|
|
call XMLAttributeInit(attr_ptr, "version", "1.0")
|
|
end if
|
|
call XMLAddAttribute(root_ptr, attr_ptr)
|
|
call XMLAttributeInit(attr_ptr, "byte_order", "LittleEndian")
|
|
call XMLAddAttribute(root_ptr, attr_ptr)
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLInitTree
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLFreeTree:
|
|
! ----------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Recursively frees the memory allocated for an XML tree.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! node_ptr - Pointer to the node of the XML tree to free;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
recursive subroutine XMLFreeTree(node_ptr)
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(inout) :: node_ptr
|
|
|
|
type(XMLNode) , pointer :: child_ptr
|
|
type(XMLAttribute), pointer :: attr_ptr
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
attr_ptr => node_ptr%attributes
|
|
do while (associated(attr_ptr))
|
|
node_ptr%attributes => attr_ptr%next
|
|
deallocate(attr_ptr%name, attr_ptr%value)
|
|
deallocate(attr_ptr)
|
|
attr_ptr => node_ptr%attributes
|
|
end do
|
|
|
|
child_ptr => node_ptr%children
|
|
do while (associated(child_ptr))
|
|
node_ptr%children => child_ptr%next
|
|
call XMLFreeTree(child_ptr)
|
|
child_ptr => node_ptr%children
|
|
end do
|
|
|
|
deallocate(node_ptr%name, node_ptr%value)
|
|
deallocate(node_ptr)
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLFreeTree
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLSaveTree:
|
|
! ----------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Saves an XML tree to a file.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! root_ptr - The XML root to save.
|
|
! filename - The file name to write to.
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLSaveTree(root_ptr, filename)
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(in) :: root_ptr
|
|
character(len=*) , intent(in) :: filename
|
|
|
|
integer :: io
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
open (newunit=io, file=filename)
|
|
write (io,"(a)") '<?xml version="1.0" encoding="utf-8"?>'
|
|
call XMLSaveNode(io, 1, root_ptr)
|
|
close (io)
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLSaveTree
|
|
|
|
!=== PRIVATE SUBROUTINES AND FUNCTIONS ===
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLNodeInit:
|
|
! ----------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Initializes an XMLNode with the specified name and optional value.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! node_ptr - Pointer to the XMLNode to be initialized;
|
|
! node_name - Name for the XMLNode;
|
|
! node_value - Optional value for the XMLNode;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLNodeInit(node_ptr, node_name, node_value)
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(inout) :: node_ptr
|
|
character(len=*) , intent(in ) :: node_name
|
|
character(len=*) , intent(in ), optional :: node_value
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
allocate(node_ptr)
|
|
|
|
node_ptr%name = node_name
|
|
if (present(node_value)) then
|
|
node_ptr%value = node_value
|
|
else
|
|
node_ptr%value = ""
|
|
end if
|
|
|
|
nullify(node_ptr%attributes)
|
|
nullify(node_ptr%children)
|
|
nullify(node_ptr%next)
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLNodeInit
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLAttributeInit:
|
|
! ---------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Initializes an XMLAttribute with the specified name and optional value.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! attr_ptr - Pointer to the XMLAttribute to be initialized;
|
|
! attr_name - Name for the XMLAttribute;
|
|
! attr_value - Optional value for the XMLAttribute;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLAttributeInit(attr_ptr, attr_name, attr_value)
|
|
|
|
implicit none
|
|
|
|
type(XMLAttribute), pointer, intent(inout) :: attr_ptr
|
|
character(len=*) , intent(in ) :: attr_name
|
|
character(len=*) , intent(in ), optional :: attr_value
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
allocate(attr_ptr)
|
|
|
|
attr_ptr%name = attr_name
|
|
if (present(attr_value)) then
|
|
attr_ptr%value = attr_value
|
|
else
|
|
attr_ptr%value = ""
|
|
end if
|
|
|
|
nullify(attr_ptr%next)
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLAttributeInit
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLIterateSections:
|
|
! -----------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Iterates through XML sections in content and builds an XML tree.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! content - Input XML content string;
|
|
! node_ptr - Pointer to the current XML node being built;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLIterateSections(content, node_ptr)
|
|
|
|
implicit none
|
|
|
|
character(len=*) , intent(in ) :: content
|
|
type(XMLNode), pointer, intent(inout) :: node_ptr
|
|
|
|
type(XMLNode) , pointer :: child_ptr
|
|
character(len=:), allocatable :: tag
|
|
integer :: ibeg, iend, icur
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
icur = 1
|
|
|
|
do while (icur > 0 .and. icur < len(content))
|
|
|
|
ibeg = index(content(icur:), '<') + icur - 1
|
|
iend = index(content(icur:), '>') + icur - 1
|
|
|
|
tag = trim(adjustl(content(ibeg + 1 : iend - 1)))
|
|
|
|
call XMLNodeInit(child_ptr, trim(tag))
|
|
call XMLAddChild(node_ptr, child_ptr)
|
|
|
|
icur = iend + 1
|
|
iend = index(content(icur:), '</' // trim(tag) // '>') &
|
|
+ icur + len(trim(tag)) + 1
|
|
|
|
call XMLIterateElements(content(ibeg:iend), child_ptr)
|
|
|
|
icur = iend + 1
|
|
|
|
end do
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLIterateSections
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLIterateElements:
|
|
! -----------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Iterates through XML elements in content and builds an XML tree.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! content - Input XML content string;
|
|
! node_ptr - Pointer to the current XML node being built;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLIterateElements(content, node_ptr)
|
|
|
|
implicit none
|
|
|
|
character(len=*) , intent(in ) :: content
|
|
type(XMLNode), pointer, intent(inout) :: node_ptr
|
|
|
|
type(XMLNode) , pointer :: child_ptr
|
|
character(len=:), allocatable :: element, name
|
|
integer :: icur, ibeg, iend
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
icur = 1
|
|
|
|
do while (icur > 0 .and. icur < len(content))
|
|
|
|
ibeg = index(content(icur:), '<Attribute')
|
|
iend = index(content(icur:), '</Attribute>')
|
|
|
|
if (ibeg > 0 .and. iend > 0) then
|
|
|
|
ibeg = ibeg + icur - 1
|
|
iend = iend + icur + 10
|
|
|
|
element = trim(adjustl(content(ibeg:iend)))
|
|
|
|
icur = iend + 1
|
|
|
|
ibeg = index(element, 'name=') + 6
|
|
iend = index(element(ibeg:), '"') + ibeg - 2
|
|
|
|
name = trim(element(ibeg:iend))
|
|
|
|
ibeg = index(element, '>') + 1
|
|
iend = index(element, '</') - 1
|
|
|
|
call XMLNodeInit(child_ptr, name, element(ibeg:iend))
|
|
call XMLAddChild(node_ptr, child_ptr)
|
|
|
|
call XMLIterateAttributes(trim(element), child_ptr)
|
|
|
|
deallocate(name, element)
|
|
|
|
else
|
|
icur = -1
|
|
end if
|
|
|
|
end do
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLIterateElements
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLIterateAttributes:
|
|
! -------------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Iterates through attributes in XML content and add them to a node.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! content - Input XML content string;
|
|
! node_ptr - Pointer to the current XML node being built;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLIterateAttributes(content, node_ptr)
|
|
|
|
implicit none
|
|
|
|
character(len=*) , intent(in ) :: content
|
|
type(XMLNode), pointer, intent(inout) :: node_ptr
|
|
|
|
type(XMLAttribute), pointer :: attr_ptr
|
|
integer :: icur, ieql, ibeg, iend
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
icur = index(content, ' ')
|
|
|
|
do while (icur > 0 .and. icur < len(content))
|
|
|
|
ieql = index(content(icur:), '=')
|
|
|
|
if (ieql > 0) then
|
|
ieql = ieql + icur - 1
|
|
ibeg = index(content(ieql + 1:), '"') + ieql
|
|
iend = index(content(ibeg + 1:), '"') + ibeg
|
|
|
|
if (.not. trim(adjustl(content(icur:ieql - 1))) == 'name') then
|
|
call XMLAttributeInit(attr_ptr, trim(adjustl(content(icur : ieql - 1))), &
|
|
trim(adjustl(content(ibeg + 1 : iend - 1))))
|
|
call XMLAddAttribute(node_ptr, attr_ptr)
|
|
end if
|
|
|
|
icur = iend + 1
|
|
|
|
else
|
|
icur = -1
|
|
end if
|
|
|
|
end do
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLIterateAttributes
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLAddChild:
|
|
! ----------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Adds a child node to a parent node in an XML tree.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! node_ptr - Pointer to the parent XML node;
|
|
! child_ptr - Pointer to the child XML node to be added;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLAddChild(node_ptr, child_ptr)
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(inout) :: node_ptr
|
|
type(XMLNode), pointer, intent(in ) :: child_ptr
|
|
|
|
type(XMLNode), pointer :: last_ptr
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
if (associated(node_ptr%children)) then
|
|
last_ptr => node_ptr%children
|
|
|
|
do while (associated(last_ptr%next))
|
|
last_ptr => last_ptr%next
|
|
end do
|
|
|
|
last_ptr%next => child_ptr
|
|
else
|
|
node_ptr%children => child_ptr
|
|
end if
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLAddChild
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLAddAttribute:
|
|
! --------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Adds an XMLAttribute to an XMLNode.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! node_ptr - Pointer to the parent XML node;
|
|
! attr_ptr - Pointer to the XML attribute that will be added;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLAddAttribute(node_ptr, attr_ptr)
|
|
|
|
implicit none
|
|
|
|
type(XMLNode) , pointer, intent(inout) :: node_ptr
|
|
type(XMLAttribute), pointer, intent(in ) :: attr_ptr
|
|
|
|
type(XMLAttribute), pointer :: last_ptr
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
if (associated(node_ptr%attributes)) then
|
|
last_ptr => node_ptr%attributes
|
|
|
|
do while (associated(last_ptr%next))
|
|
last_ptr => last_ptr%next
|
|
end do
|
|
|
|
last_ptr%next => attr_ptr
|
|
else
|
|
node_ptr%attributes => attr_ptr
|
|
end if
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLAddAttribute
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLSaveNode:
|
|
! ----------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Saves an XML node to a file.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! io - The file unit to write to;
|
|
! level - The level of the node in the hierarchy;
|
|
! node_ptr - The XML node to save;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
recursive subroutine XMLSaveNode(io, level, node_ptr)
|
|
|
|
implicit none
|
|
|
|
integer , intent(in) :: io, level
|
|
type(XMLNode), pointer, intent(in) :: node_ptr
|
|
|
|
character(len=:), allocatable :: node_name
|
|
type(XMLAttribute), pointer :: attr_ptr
|
|
type(XMLNode) , pointer :: child_ptr
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
if (level > 2) then
|
|
node_name = 'Attribute'
|
|
else
|
|
node_name = trim(node_ptr%name)
|
|
end if
|
|
|
|
write (io, '(A)', advance='no') "<" // node_name
|
|
|
|
if (level > 2) then
|
|
write (io,"(1x,a,'=',a)", advance='no') &
|
|
'name', '"' // trim(node_ptr%name) // '"'
|
|
end if
|
|
|
|
attr_ptr => node_ptr%attributes
|
|
do while (associated(attr_ptr))
|
|
write (io,"(1x,a,'=',a)", advance='no') trim(attr_ptr%name), &
|
|
'"' // trim(attr_ptr%value) // '"'
|
|
attr_ptr => attr_ptr%next
|
|
end do
|
|
|
|
if (level > 2) then
|
|
write (io,'(a,a,a)') ">", trim(node_ptr%value), "</" // node_name // ">"
|
|
else
|
|
write (io,'(a)') ">"
|
|
|
|
child_ptr => node_ptr%children
|
|
do while(associated(child_ptr))
|
|
call XMLSaveNode(io, level+1, child_ptr)
|
|
child_ptr => child_ptr%next
|
|
end do
|
|
|
|
write (io,'(a)') "</" // node_name // ">"
|
|
end if
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLSaveNode
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLFindElement:
|
|
! -------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Finds an XML element within a specific section of the XML tree.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! root_ptr - The root node of the XML tree;
|
|
! section_name - The section of the XML document where the element is located;
|
|
! element_name - The name of the XML element;
|
|
! node_ptr - Pointer to store the found XML node;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLFindElement(root_ptr, section_name, element_name, node_ptr)
|
|
|
|
use helpers, only : print_message
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(in ) :: root_ptr
|
|
character(len=*) , intent(in ) :: section_name, element_name
|
|
type(XMLNode), pointer, intent( out) :: node_ptr
|
|
|
|
character(len=*), parameter :: loc = "XML::XMLFindElement()"
|
|
|
|
type(XMLNode), pointer :: child_ptr
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
child_ptr => root_ptr%children
|
|
|
|
do while (associated(child_ptr))
|
|
if (trim(child_ptr%name) == trim(section_name)) then
|
|
node_ptr => child_ptr%children
|
|
|
|
do while (associated(node_ptr))
|
|
if (trim(node_ptr%name) == trim(element_name)) return
|
|
|
|
node_ptr => node_ptr%next
|
|
end do
|
|
end if
|
|
|
|
child_ptr => child_ptr%next
|
|
end do
|
|
|
|
call print_message(loc, "Element '" // trim(element_name) // &
|
|
"' in section '" // trim(section_name) // &
|
|
"' not found!")
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLFindElement
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLGetAttribute:
|
|
! --------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Gets the attribute of an XML node by its name.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! node_ptr - Pointer to the XML node to search for the attribute;
|
|
! attr_name - Input string for the attribute name;
|
|
! attr_ptr - Pointer to store the found XML attribute;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLGetAttribute(node_ptr, attr_name, attr_ptr)
|
|
|
|
use helpers, only : print_message
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer , intent(in ) :: node_ptr
|
|
character(len=*) , intent(in ) :: attr_name
|
|
type(XMLAttribute), pointer, intent( out) :: attr_ptr
|
|
|
|
character(len=*), parameter :: loc = "XML::XMLGetAttribute()"
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
attr_ptr => node_ptr%attributes
|
|
|
|
do while (associated(attr_ptr))
|
|
if (trim(attr_ptr%name) == trim(attr_name)) return
|
|
|
|
attr_ptr => attr_ptr%next
|
|
end do
|
|
|
|
call print_message(loc, "Attribute '" // trim(attr_name) // &
|
|
"' not found in the node '" // &
|
|
trim(node_ptr%name) // "'!")
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLGetAttribute
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLAddElementString:
|
|
! ------------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! This subroutine adds a new element to the specified section of a XML tree.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! root_ptr - The root node of the XML tree;
|
|
! section_name - The section of the XML document where the element is located;
|
|
! element_name - The name of the XML element;
|
|
! element_value - The value of the element;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLAddElementString(root_ptr, section_name, &
|
|
element_name, element_value)
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(inout) :: root_ptr
|
|
character(len=*) , intent(in ) :: section_name, element_name
|
|
character(len=*) , intent(in ) :: element_value
|
|
|
|
type(XMLNode) , pointer :: node_ptr, elem_ptr
|
|
type(XMLAttribute), pointer :: attr_ptr
|
|
|
|
logical :: found
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
found = .false.
|
|
node_ptr => root_ptr%children
|
|
do while (associated(node_ptr) .and. .not. found)
|
|
if (trim(node_ptr%name) == trim(section_name)) then
|
|
found = .true.
|
|
else
|
|
node_ptr => node_ptr%next
|
|
end if
|
|
end do
|
|
|
|
if (.not. found) then
|
|
call XMLNodeInit(node_ptr, section_name)
|
|
call XMLAddChild(root_ptr, node_ptr)
|
|
end if
|
|
|
|
call XMLNodeInit(elem_ptr, element_name, element_value)
|
|
call XMLAttributeInit(attr_ptr, "type", "string")
|
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
|
call XMLAddChild(node_ptr, elem_ptr)
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLAddElementString
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLAddElementInteger:
|
|
! -------------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! This subroutine adds a new element to the specified section of a XML tree.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! root_ptr - The root node of the XML tree;
|
|
! section_name - The section of the XML document where the element is located;
|
|
! element_name - The name of the XML element;
|
|
! element_value - The value of the element;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLAddElementInteger(root_ptr, section_name, &
|
|
element_name, element_value)
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(inout) :: root_ptr
|
|
character(len=*) , intent(in ) :: section_name, element_name
|
|
integer(kind=4) , intent(in ) :: element_value
|
|
|
|
type(XMLNode) , pointer :: node_ptr, elem_ptr
|
|
type(XMLAttribute), pointer :: attr_ptr
|
|
|
|
logical :: found
|
|
character(len=64) :: str
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
found = .false.
|
|
node_ptr => root_ptr%children
|
|
do while (associated(node_ptr) .and. .not. found)
|
|
if (trim(node_ptr%name) == trim(section_name)) then
|
|
found = .true.
|
|
else
|
|
node_ptr => node_ptr%next
|
|
end if
|
|
end do
|
|
|
|
if (.not. found) then
|
|
call XMLNodeInit(node_ptr, section_name)
|
|
call XMLAddChild(root_ptr, node_ptr)
|
|
end if
|
|
|
|
write (str,"(i0)") element_value
|
|
call XMLNodeInit(elem_ptr, element_name, trim(adjustl(str)))
|
|
call XMLAttributeInit(attr_ptr, "type", "integer")
|
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
|
call XMLAddChild(node_ptr, elem_ptr)
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLAddElementInteger
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLAddElementDouble:
|
|
! -------------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! This subroutine adds a new element to the specified section of a XML tree.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! root_ptr - The root node of the XML tree;
|
|
! section_name - The section of the XML document where the element is located;
|
|
! element_name - The name of the XML element;
|
|
! element_value - The value of the element;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLAddElementDouble(root_ptr, section_name, &
|
|
element_name, element_value)
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(inout) :: root_ptr
|
|
character(len=*) , intent(in ) :: section_name, element_name
|
|
real(kind=8) , intent(in ) :: element_value
|
|
|
|
type(XMLNode) , pointer :: node_ptr, elem_ptr
|
|
type(XMLAttribute), pointer :: attr_ptr
|
|
|
|
logical :: found
|
|
character(len=64) :: str
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
found = .false.
|
|
node_ptr => root_ptr%children
|
|
do while (associated(node_ptr) .and. .not. found)
|
|
if (trim(node_ptr%name) == trim(section_name)) then
|
|
found = .true.
|
|
else
|
|
node_ptr => node_ptr%next
|
|
end if
|
|
end do
|
|
|
|
if (.not. found) then
|
|
call XMLNodeInit(node_ptr, section_name)
|
|
call XMLAddChild(root_ptr, node_ptr)
|
|
end if
|
|
|
|
write (str,"(1es32.20)") element_value
|
|
call XMLNodeInit(elem_ptr, element_name, trim(adjustl(str)))
|
|
call XMLAttributeInit(attr_ptr, "type", "double")
|
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
|
call XMLAddChild(node_ptr, elem_ptr)
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLAddElementDouble
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLAddElementFile:
|
|
! ----------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! This subroutine is designed to add an XML element to an XML tree structure,
|
|
! with various attributes.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! root_ptr - A pointer to the root node of the XML tree;
|
|
! section_name - The name of the section or parent element under which
|
|
! the new XML element should be added;
|
|
! element_name - The name of the XML element to be added;
|
|
! element_value - The value associated with the XML element;
|
|
! element_dtype - The data type of the associated array;
|
|
! element_size - The size in bytes of an array stored in an associated
|
|
! binary file;
|
|
! element_dims - The shape or dimensions of the array stored in
|
|
! an associated binary file;
|
|
! element_digest - This argument is a string that specifies the type of
|
|
! digest used for the array data to ensure its integrity;
|
|
! element_hash - The digest or hash value of the uncompressed array data
|
|
! stored in the associated binary file;
|
|
! compressor - A string specifying the compression format used.
|
|
! compressed_size - The size of the compressed array.
|
|
! compressed_hash - The digest/hash value of the compressed array.
|
|
! encoder - A string specifying the data encoding format used.
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLAddElementFile(root_ptr, section_name, element_name, &
|
|
element_value, element_dtype, element_size, &
|
|
element_dims, element_digest, element_hash, &
|
|
compressor, compressed_size, compressed_hash, &
|
|
encoder)
|
|
|
|
implicit none
|
|
|
|
type(XMLNode) , pointer , intent(inout) :: root_ptr
|
|
character(len=*) , intent(in ) :: section_name, element_name
|
|
character(len=*) , intent(in ) :: element_value, element_dtype
|
|
integer(kind=8) , intent(in ) :: element_size
|
|
integer, dimension(:) , intent(in ) :: element_dims
|
|
character(len=*) , intent(in ) :: element_digest, element_hash
|
|
integer(kind=8) , optional, intent(in ) :: compressed_size
|
|
character(len=*), optional, intent(in ) :: compressor, compressed_hash, &
|
|
encoder
|
|
|
|
type(XMLNode) , pointer :: node_ptr, elem_ptr
|
|
type(XMLAttribute), pointer :: attr_ptr
|
|
|
|
logical :: found
|
|
character(len=64) :: str
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
found = .false.
|
|
node_ptr => root_ptr%children
|
|
do while (associated(node_ptr) .and. .not. found)
|
|
if (trim(node_ptr%name) == trim(section_name)) then
|
|
found = .true.
|
|
else
|
|
node_ptr => node_ptr%next
|
|
end if
|
|
end do
|
|
|
|
if (.not. found) then
|
|
call XMLNodeInit(node_ptr, section_name)
|
|
call XMLAddChild(root_ptr, node_ptr)
|
|
end if
|
|
|
|
call XMLNodeInit(elem_ptr, element_name, element_value)
|
|
call XMLAttributeInit(attr_ptr, "type", "string")
|
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
|
call XMLAttributeInit(attr_ptr, "data_type", element_dtype)
|
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
|
write (str,"(i0)") element_size
|
|
call XMLAttributeInit(attr_ptr, "size", trim(adjustl(str)))
|
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
|
write (str,"(8(i0,1x))") element_dims
|
|
call XMLAttributeInit(attr_ptr, "dimensions", trim(adjustl(str)))
|
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
|
call XMLAttributeInit(attr_ptr, "digest_type", trim(element_digest))
|
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
|
call XMLAttributeInit(attr_ptr, "digest", trim(element_hash))
|
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
|
if (present(compressor)) then
|
|
call XMLAttributeInit(attr_ptr, "compression_format", trim(compressor))
|
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
|
if (present(compressed_size)) then
|
|
write (str,"(i0)") compressed_size
|
|
call XMLAttributeInit(attr_ptr, "compressed_size", trim(adjustl(str)))
|
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
|
end if
|
|
if (present(compressed_hash)) then
|
|
call XMLAttributeInit(attr_ptr, "compressed_digest", &
|
|
trim(compressed_hash))
|
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
|
end if
|
|
end if
|
|
if (present(encoder)) then
|
|
call XMLAttributeInit(attr_ptr, "data_encoder", trim(encoder))
|
|
call XMLAddAttribute(elem_ptr, attr_ptr)
|
|
end if
|
|
call XMLAddChild(node_ptr, elem_ptr)
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLAddElementFile
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLGetElementValueDouble:
|
|
! -----------------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Reads an XML node value and returns it as a double precision number.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! root_ptr - The root node of the XML tree;
|
|
! section_name - The section of the XML document where the element is located;
|
|
! element_name - The name of the XML element;
|
|
! element_value - The value of the element;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLGetElementValueDouble(root_ptr, section_name, &
|
|
element_name, element_value)
|
|
|
|
use helpers, only : print_message
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(in ) :: root_ptr
|
|
character(len=*) , intent(in ) :: section_name, element_name
|
|
real(kind=8) , intent(inout) :: element_value
|
|
|
|
character(len=*), parameter :: loc = "XML::XMLGetElementValueDouble()"
|
|
|
|
type(XMLNode) , pointer :: node_ptr
|
|
type(XMLAttribute), pointer :: attr_ptr
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
call XMLFindElement(root_ptr, section_name, element_name, node_ptr)
|
|
|
|
if (associated(node_ptr)) then
|
|
call XMLGetAttribute(node_ptr, 'type', attr_ptr)
|
|
|
|
if (associated(attr_ptr)) then
|
|
if (trim(attr_ptr%value) == 'double') then
|
|
read (node_ptr%value,*) element_value
|
|
else
|
|
call print_message(loc, "The value of element '" // &
|
|
trim(element_name) // &
|
|
"' is not a double precision number!")
|
|
end if
|
|
end if
|
|
end if
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLGetElementValueDouble
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLGetElementValueInteger:
|
|
! ------------------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Reads an XML node value and returns it as an integer.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! root_ptr - The root node of the XML tree;
|
|
! section_name - The section of the XML document where the element is located;
|
|
! element_name - The name of the XML element;
|
|
! element_value - The value of the element;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLGetElementValueInteger(root_ptr, section_name, &
|
|
element_name, element_value)
|
|
|
|
use helpers, only : print_message
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(in ) :: root_ptr
|
|
character(len=*) , intent(in ) :: section_name, element_name
|
|
integer , intent(inout) :: element_value
|
|
|
|
character(len=*), parameter :: loc = "XML::XMLGetElementValueInteger()"
|
|
|
|
type(XMLNode) , pointer :: node_ptr
|
|
type(XMLAttribute), pointer :: attr_ptr
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
call XMLFindElement(root_ptr, section_name, element_name, node_ptr)
|
|
|
|
if (associated(node_ptr)) then
|
|
call XMLGetAttribute(node_ptr, 'type', attr_ptr)
|
|
|
|
if (associated(attr_ptr)) then
|
|
if (trim(attr_ptr%value) == 'integer') then
|
|
read (node_ptr%value,*) element_value
|
|
else
|
|
call print_message(loc, "The value of element '" // &
|
|
trim(element_name) // "' is not an integer!")
|
|
end if
|
|
end if
|
|
end if
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLGetElementValueInteger
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLGetElementValueString:
|
|
! ------------------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Reads an XML node value and returns it as a string.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! root_ptr - The root node of the XML tree;
|
|
! section_name - The section of the XML document where the element is located;
|
|
! element_name - The name of the XML element;
|
|
! element_value - The value of the element;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLGetElementValueString(root_ptr, section_name, &
|
|
element_name, element_value)
|
|
|
|
use helpers, only : print_message
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(in ) :: root_ptr
|
|
character(len=*) , intent(in ) :: section_name, element_name
|
|
character(len=*) , intent(inout) :: element_value
|
|
|
|
character(len=*), parameter :: loc = "XML::XMLGetElementValueString()"
|
|
|
|
type(XMLNode) , pointer :: node_ptr
|
|
type(XMLAttribute), pointer :: attr_ptr
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
call XMLFindElement(root_ptr, section_name, element_name, node_ptr)
|
|
|
|
if (associated(node_ptr)) then
|
|
call XMLGetAttribute(node_ptr, 'type', attr_ptr)
|
|
|
|
if (associated(attr_ptr)) then
|
|
if (trim(attr_ptr%value) == 'string') then
|
|
read (node_ptr%value,*) element_value
|
|
else
|
|
call print_message(loc, "The value of element '" // &
|
|
trim(element_name) // "' is not a string!")
|
|
end if
|
|
end if
|
|
end if
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLGetElementValueString
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLHasAttribute:
|
|
! --------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Verifies whether the XML element contains an attribute specified by its name.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! root_ptr - The root node of the XML tree;
|
|
! section_name - The section of the XML document where the element
|
|
! is located;
|
|
! element_name - The name of the XML element;
|
|
! attribute_name - The name of the attribute whose value is to be retrieved;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
logical function XMLHasAttribute(root_ptr, section_name, element_name, &
|
|
attribute_name) result(ret)
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(in) :: root_ptr
|
|
character(len=*) , intent(in) :: section_name, element_name, &
|
|
attribute_name
|
|
|
|
type(XMLNode) , pointer :: node_ptr
|
|
type(XMLAttribute), pointer :: attr_ptr
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
ret = .false.
|
|
|
|
call XMLFindElement(root_ptr, section_name, element_name, node_ptr)
|
|
|
|
if (associated(node_ptr)) then
|
|
attr_ptr => node_ptr%attributes
|
|
do while (associated(attr_ptr))
|
|
if (trim(attr_ptr%name) == trim(attribute_name)) then
|
|
ret = .true.
|
|
return
|
|
end if
|
|
attr_ptr => attr_ptr%next
|
|
end do
|
|
end if
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end function XMLHasAttribute
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLGetAttributeValueDouble:
|
|
! -------------------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Retrieves a double precision attribute value from an XML element.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! root_ptr - The root node of the XML tree;
|
|
! section_name - The section of the XML document where the element
|
|
! is located;
|
|
! element_name - The name of the XML element;
|
|
! attribute_name - The name of the attribute whose value is to be retrieved;
|
|
! attribute_value - The value of the attribute;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLGetAttributeValueDouble(root_ptr, section_name, element_name, &
|
|
attribute_name, attribute_value)
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(in ) :: root_ptr
|
|
character(len=*) , intent(in ) :: section_name, element_name, &
|
|
attribute_name
|
|
real(kind=8) , intent(inout) :: attribute_value
|
|
|
|
type(XMLNode) , pointer :: node_ptr
|
|
type(XMLAttribute), pointer :: attr_ptr
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
call XMLFindElement(root_ptr, section_name, element_name, node_ptr)
|
|
|
|
if (associated(node_ptr)) then
|
|
call XMLGetAttribute(node_ptr, trim(attribute_name), attr_ptr)
|
|
|
|
if (associated(attr_ptr)) read (attr_ptr%value, *) attribute_value
|
|
end if
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLGetAttributeValueDouble
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLGetAttributeValueInteger:
|
|
! --------------------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Retrieves an integer attribute value from an XML element.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! root_ptr - The root node of the XML tree;
|
|
! section_name - The section of the XML document where the element
|
|
! is located;
|
|
! element_name - The name of the XML element;
|
|
! attribute_name - The name of the attribute whose value is to be retrieved;
|
|
! attribute_value - The value of the attribute;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLGetAttributeValueInteger(root_ptr, section_name, element_name, &
|
|
attribute_name, attribute_value)
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(in ) :: root_ptr
|
|
character(len=*) , intent(in ) :: section_name, element_name, &
|
|
attribute_name
|
|
integer , intent(inout) :: attribute_value
|
|
|
|
type(XMLNode) , pointer :: node_ptr
|
|
type(XMLAttribute), pointer :: attr_ptr
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
call XMLFindElement(root_ptr, section_name, element_name, node_ptr)
|
|
|
|
if (associated(node_ptr)) then
|
|
call XMLGetAttribute(node_ptr, trim(attribute_name), attr_ptr)
|
|
|
|
if (associated(attr_ptr)) read (attr_ptr%value, *) attribute_value
|
|
end if
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLGetAttributeValueInteger
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLGetAttributeValueLong:
|
|
! -----------------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Retrieves a long integer attribute value from an XML element.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! root_ptr - The root node of the XML tree;
|
|
! section_name - The section of the XML document where the element
|
|
! is located;
|
|
! element_name - The name of the XML element;
|
|
! attribute_name - The name of the attribute whose value is to be retrieved;
|
|
! attribute_value - The value of the attribute;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLGetAttributeValueLong(root_ptr, section_name, element_name, &
|
|
attribute_name, attribute_value)
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(in ) :: root_ptr
|
|
character(len=*) , intent(in ) :: section_name, element_name, &
|
|
attribute_name
|
|
integer(kind=8) , intent(inout) :: attribute_value
|
|
|
|
type(XMLNode) , pointer :: node_ptr
|
|
type(XMLAttribute), pointer :: attr_ptr
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
call XMLFindElement(root_ptr, section_name, element_name, node_ptr)
|
|
|
|
if (associated(node_ptr)) then
|
|
call XMLGetAttribute(node_ptr, trim(attribute_name), attr_ptr)
|
|
|
|
if (associated(attr_ptr)) read (attr_ptr%value, *) attribute_value
|
|
end if
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLGetAttributeValueLong
|
|
|
|
!===============================================================================
|
|
!
|
|
! subroutine XMLGetAttributeValueString:
|
|
! -------------------------------------
|
|
!
|
|
! Description:
|
|
!
|
|
! Retrieves a string attribute value from an XML element.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! root_ptr - The root node of the XML tree;
|
|
! section_name - The section of the XML document where the element
|
|
! is located;
|
|
! element_name - The name of the XML element;
|
|
! attribute_name - The name of the attribute whose value is to be retrieved;
|
|
! attribute_value - The value of the attribute;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine XMLGetAttributeValueString(root_ptr, section_name, element_name, &
|
|
attribute_name, attribute_value)
|
|
|
|
implicit none
|
|
|
|
type(XMLNode), pointer, intent(in ) :: root_ptr
|
|
character(len=*) , intent(in ) :: section_name, element_name, &
|
|
attribute_name
|
|
character(len=*) , intent(inout) :: attribute_value
|
|
|
|
type(XMLNode) , pointer :: node_ptr
|
|
type(XMLAttribute), pointer :: attr_ptr
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
call XMLFindElement(root_ptr, section_name, element_name, node_ptr)
|
|
|
|
if (associated(node_ptr)) then
|
|
call XMLGetAttribute(node_ptr, trim(attribute_name), attr_ptr)
|
|
|
|
if (associated(attr_ptr)) read (attr_ptr%value, *) attribute_value
|
|
end if
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine XMLGetAttributeValueString
|
|
|
|
end module XML
|