gkowal/amun-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

IO: Add subroutine to read binary XML files.

Browse Source 
This subroutine is also responsible for detection if binary data are
compressed and encoded, and respectively decompress and decode them.

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2023-08-11 19:29:08 -03:00
parent 2a634faba4
commit 64966c3eb3
1 changed files with 162 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

162
sources/io.F90
View File

@ -2903,6 +2903,168 @@ module io
!
!===============================================================================
!
! subroutine READ_BINARY_XML:
! --------------------------
!
! This subroutine serves the purpose of reading binary data from
! a specified data path and array name, while also performing integrity
! checks using hash functions and processing associated XML metadata.
!
! Arguments:
!
! data_path - The file path indicating the location of the stored data.
! array_name - The name of the target array for data reading.
! array_ptr - A pointer intended to hold the read data from the array.
! array_bytes - The allocated size in bytes for the array.
! xml_ptr - A pointer referring to an XML tree containing
! associated metadata.
! status - A flag conveying the status of the subroutine.
!
!===============================================================================
!
subroutine read_binary_xml(data_path, array_name, array_ptr, array_bytes, &
xml_ptr, status)
use compression , only : get_compressor_id, decompress
use compression , only : get_encoder_id, decode
use hash , only : hash_info, check_digest, digest_integer
use helpers , only : print_message
use iso_c_binding, only : c_loc, c_ptr, c_f_pointer
use XML , only : XMLNode, XMLGetElementValue, &
XMLHasAttribute, XMLGetAttributeValue
implicit none
character(len=*) , intent(in ) :: data_path, array_name
type(c_ptr) , intent(in ) :: array_ptr
integer(kind=8) , intent(in ) :: array_bytes
type(XMLNode), pointer, intent(in ) :: xml_ptr
integer , intent( out) :: status
character(len=*), parameter :: loc = "IO::read_binary_xml()"
logical :: test
character(len=256) :: str
character(len=:), allocatable :: file_path, compressor, encoder
integer :: io, item_size
integer :: digest_type, digest_length
integer :: compressor_id, encoder_id
integer(kind=8) :: hash, usize, csize, dsize
integer(kind=1), dimension(:), pointer :: array
integer(kind=1), dimension(:), allocatable, target :: buffer
!-------------------------------------------------------------------------------
!
status = 0
call XMLGetElementValue(xml_ptr, 'BinaryFiles', array_name, str)
file_path = trim(data_path) // trim(str)
inquire(file=file_path, exist=test)
if (.not. test) then
call print_message(loc, "The file '" // trim(file_path) // &
"' does not exist.")
status = 121
return
end if
call XMLGetAttributeValue(xml_ptr, 'BinaryFiles', array_name, 'size', usize)
if (usize /= array_bytes) then
call print_message(loc, "Array size mismatch. The size of the array '" &
// trim(array_name) // "' in memory " // &
"does not match the stored array size.")
status = 1
return
end if
call c_f_pointer(array_ptr, array, [ array_bytes ])
test = XMLHasAttribute(xml_ptr, 'BinaryFiles', array_name, &
'compression_format')
if (test) then
call XMLGetAttributeValue(xml_ptr, 'BinaryFiles', array_name, &
'compression_format', str)
compressor = trim(str)
test = compressor /= 'none'
end if
if (test) then
compressor_id = get_compressor_id(compressor)
call XMLGetAttributeValue(xml_ptr, 'BinaryFiles', array_name, &
'compressed_size', csize)
allocate(buffer(csize))
open(newunit=io, file=file_path, access='stream')
read(io) buffer
close(io)
call XMLGetAttributeValue(xml_ptr, 'BinaryFiles', array_name, &
'digest_type', str)
call hash_info(trim(str), digest_type, digest_length)
call XMLGetAttributeValue(xml_ptr, 'BinaryFiles', array_name, &
'compressed_digest', str)
call digest_integer(trim(str), hash)
call check_digest(loc, file_path, c_loc(buffer), csize, hash, digest_type)
call decompress(compressor_id, c_loc(buffer), csize, array_ptr, usize, status)
if (status /= 0) then
call print_message(loc, "Array size mismatch. The size of the array '" &
// trim(array_name) // "' in memory " // &
"does not match the decompressed array size.")
status = 1
return
end if
deallocate(buffer)
test = XMLHasAttribute(xml_ptr, 'BinaryFiles', array_name, 'data_encoder')
if (test) then
call XMLGetAttributeValue(xml_ptr, 'BinaryFiles', array_name, &
'data_encoder', str)
encoder = trim(str)
test = encoder /= 'none'
end if
if (test) then
encoder_id = get_encoder_id(encoder)
call XMLGetAttributeValue(xml_ptr, 'BinaryFiles', array_name, &
'data_type', str)
select case(str)
case('float64', 'int64')
item_size = 8
case('float32', 'int32')
item_size = 4
case default
item_size = 1
end select
allocate(buffer(usize))
buffer = array
call decode(encoder_id, item_size, array_bytes, c_loc(buffer), array)
deallocate(buffer)
end if
else
open(newunit=io, file=file_path, access='stream')
read(io) array
close(io)
end if
call XMLGetAttributeValue(xml_ptr, 'BinaryFiles', array_name, &
'digest_type', str)
call hash_info(trim(str), digest_type, digest_length)
call XMLGetAttributeValue(xml_ptr, 'BinaryFiles', array_name, &
'digest', str)
call digest_integer(trim(str), hash)
call check_digest(loc, file_path, array_ptr, array_bytes, hash, digest_type)
end subroutine read_binary_xml
!
!===============================================================================
!
! subroutine WRITE_BINARY_XML:
! ---------------------------
!