!=============================================================================== ! ! 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 ! ! 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 . ! !=============================================================================== ! ! 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, '') 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, '') - 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)") '' 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:), '') & + 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:), '') 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, ' 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), "" 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)') "" 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