diff --git a/sources/xml.F90 b/sources/xml.F90 index 432e856..490521e 100644 --- a/sources/xml.F90 +++ b/sources/xml.F90 @@ -47,6 +47,13 @@ module XML ! 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 @@ -81,8 +88,8 @@ module XML ! -------------- ! public :: XMLNode, XMLAttribute - public :: XMLParseFile, XMLFreeTree, XMLSaveFile - public :: XMLGetElementValue, XMLGetAttributeValue + public :: XMLParseFile, XMLInitTree, XMLFreeTree, XMLSaveTree + public :: XMLAddElement, XMLGetElementValue, XMLGetAttributeValue public :: XMLHasAttribute contains @@ -184,6 +191,48 @@ contains ! 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: @@ -234,7 +283,7 @@ contains !=============================================================================== ! -! subroutine XMLSaveFile: +! subroutine XMLSaveTree: ! ---------------------- ! ! Description: @@ -248,7 +297,7 @@ contains ! !=============================================================================== ! - subroutine XMLSaveFile(root_ptr, filename) + subroutine XMLSaveTree(root_ptr, filename) implicit none @@ -260,13 +309,13 @@ contains !------------------------------------------------------------------------------- ! open(newunit=io, file=filename) - write (io,"(a)") "" + write (io,"(a)") '' call XMLSaveNode(io, 1, root_ptr) close(io) !------------------------------------------------------------------------------- ! - end subroutine XMLSaveFile + end subroutine XMLSaveTree !=== PRIVATE SUBROUTINES AND FUNCTIONS === @@ -797,6 +846,297 @@ contains ! 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: