gkowal/amun-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
amun-code/sources/xml.F90
Grzegorz Kowal 2a634faba4 XML: New module to handle XML files. 
This module offers a user-friendly interface for parsing XML data and
retrieving elements and attributes.

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
2023-08-11 19:26:51 -03:00

1207 lines
36 KiB
Fortran
Raw Blame History

!===============================================================================
!
! 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 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 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, XMLFreeTree, XMLSaveFile
public :: 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')
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 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 XMLSaveFile:
! ----------------------
!
! Description:
!
! Saves an XML tree to a file.
!
! Arguments:
!
! root_ptr - The XML root to save.
! filename - The file name to write to.
!
!===============================================================================
!
subroutine XMLSaveFile(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 XMLSaveFile
!=== 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 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
Reference in New Issue View Git Blame Copy Permalink