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

IO: Store data type and dimensions for XML-binary format.

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2021-12-02 10:43:03 -03:00
parent ce1f6cee4a
commit 5792fe60a0
1 changed files with 48 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
sources/io.F90
View File

@ -2148,40 +2148,50 @@ module io
write(fname,"(a,'.bin')") "metablock_fields" write(fname,"(a,'.bin')") "metablock_fields"
bytes = size(fields, kind=8) * kind(fields) bytes = size(fields, kind=8) * kind(fields)
call write_binary_xml(dname, fname, c_loc(fields), bytes, dtype, digest) call write_binary_xml(dname, fname, c_loc(fields), bytes, dtype, digest)
call write_attribute_xml(lun, "fields", fname, bytes, dtype, digest) call write_attribute_xml(lun, "fields", fname, 'int32', &
shape(fields), bytes, dtype, digest)
write(fname,"(a,'.bin')") "metablock_children" write(fname,"(a,'.bin')") "metablock_children"
bytes = size(children, kind=8) * kind(children) bytes = size(children, kind=8) * kind(children)
call write_binary_xml(dname, fname, c_loc(children), bytes, dtype, digest) call write_binary_xml(dname, fname, c_loc(children), &
call write_attribute_xml(lun, "children", fname, bytes, dtype, digest) bytes, dtype, digest)
call write_attribute_xml(lun, "children", fname, 'int32', &
shape(children), bytes, dtype, digest)
#if NDIMS == 3 #if NDIMS == 3
write(fname,"(a,'.bin')") "metablock_faces" write(fname,"(a,'.bin')") "metablock_faces"
bytes = size(faces, kind=8) * kind(faces) bytes = size(faces, kind=8) * kind(faces)
call write_binary_xml(dname, fname, c_loc(faces), bytes, dtype, digest) call write_binary_xml(dname, fname, c_loc(faces), bytes, dtype, digest)
call write_attribute_xml(lun, "faces", fname, bytes, dtype, digest) call write_attribute_xml(lun, "faces", fname, 'int32', &
shape(faces), bytes, dtype, digest)
#endif /* NDIMS == 3 */ #endif /* NDIMS == 3 */
write(fname,"(a,'.bin')") "metablock_edges" write(fname,"(a,'.bin')") "metablock_edges"
bytes = size(edges, kind=8) * kind(edges) bytes = size(edges, kind=8) * kind(edges)
call write_binary_xml(dname, fname, c_loc(edges), bytes, dtype, digest) call write_binary_xml(dname, fname, c_loc(edges), bytes, dtype, digest)
call write_attribute_xml(lun, "edges", fname, bytes, dtype, digest) call write_attribute_xml(lun, "edges", fname, 'int32', &
shape(edges), bytes, dtype, digest)
write(fname,"(a,'.bin')") "metablock_corners" write(fname,"(a,'.bin')") "metablock_corners"
bytes = size(corners, kind=8) * kind(corners) bytes = size(corners, kind=8) * kind(corners)
call write_binary_xml(dname, fname, c_loc(corners), bytes, dtype, digest) call write_binary_xml(dname, fname, c_loc(corners), &
call write_attribute_xml(lun, "corners", fname, bytes, dtype, digest) bytes, dtype, digest)
call write_attribute_xml(lun, "corners", fname, 'int32', &
shape(corners), bytes, dtype, digest)
write(fname,"(a,'.bin')") "metablock_bounds" write(fname,"(a,'.bin')") "metablock_bounds"
bytes = size(bounds, kind=8) * kind(bounds) bytes = size(bounds, kind=8) * kind(bounds)
call write_binary_xml(dname, fname, c_loc(bounds), bytes, dtype, digest) call write_binary_xml(dname, fname, c_loc(bounds), bytes, dtype, digest)
call write_attribute_xml(lun, "bounds", fname, bytes, dtype, digest) call write_attribute_xml(lun, "bounds", fname, 'float64', &
shape(bounds), bytes, dtype, digest)
if (nmodes > 0) then if (nmodes > 0) then
write(fname,"(a,'.bin')") "forcing_coefficients" write(fname,"(a,'.bin')") "forcing_coefficients"
bytes = size(fcoefs, kind=8) * kind(fcoefs) bytes = size(fcoefs, kind=8) * kind(fcoefs)
call write_binary_xml(dname, fname, c_loc(fcoefs), bytes, dtype, digest) call write_binary_xml(dname, fname, c_loc(fcoefs), &
call write_attribute_xml(lun, "forcing", fname, bytes, dtype, digest) bytes, dtype, digest)
call write_attribute_xml(lun, "forcing", fname, 'complex64', &
shape(fcoefs), bytes, dtype, digest)
end if end if
#if NDIMS == 3 #if NDIMS == 3
@ -2246,14 +2256,14 @@ module io
call write_binary_xml(dname, fname, c_loc(pdata%q), & call write_binary_xml(dname, fname, c_loc(pdata%q), &
bytes, dtype, digest) bytes, dtype, digest)
call write_attribute_xml(lun, "prim" // trim(aname), fname, & call write_attribute_xml(lun, "prim" // trim(aname), fname, &
bytes, dtype, digest) 'float64', shape(pdata%q), bytes, dtype, digest)
write(fname,"('datablock_cons_',i6.6,a,'.bin')") nproc, trim(aname) write(fname,"('datablock_cons_',i6.6,a,'.bin')") nproc, trim(aname)
bytes = size(pdata%uu, kind=8) * kind(pdata%uu) bytes = size(pdata%uu, kind=8) * kind(pdata%uu)
call write_binary_xml(dname, fname, c_loc(pdata%uu), & call write_binary_xml(dname, fname, c_loc(pdata%uu), &
bytes, dtype, digest) bytes, dtype, digest)
call write_attribute_xml(lun, "cons" // trim(aname), fname, & call write_attribute_xml(lun, "cons" // trim(aname), fname, &
bytes, dtype, digest) 'float64', shape(pdata%uu), bytes, dtype, digest)
pdata => pdata%next pdata => pdata%next
@ -2262,7 +2272,8 @@ module io
write(fname,"(a,'_',a,'_',i6.6,'.bin')") "datablock", "ids", nproc write(fname,"(a,'_',a,'_',i6.6,'.bin')") "datablock", "ids", nproc
bytes = size(ids, kind=8) * kind(ids) bytes = size(ids, kind=8) * kind(ids)
call write_binary_xml(dname, fname, c_loc(ids), bytes, dtype, digest) call write_binary_xml(dname, fname, c_loc(ids), bytes, dtype, digest)
call write_attribute_xml(lun, "ids", fname, bytes, dtype, digest) call write_attribute_xml(lun, "ids", fname, 'int32', &
shape(ids), bytes, dtype, digest)
if (allocated(ids)) deallocate(ids) if (allocated(ids)) deallocate(ids)
@ -2283,7 +2294,8 @@ module io
write(fname,"(a,'_',a,'_',i6.6,'.bin')") "random", "seeds", nproc write(fname,"(a,'_',a,'_',i6.6,'.bin')") "random", "seeds", nproc
bytes = size(seeds, kind=8) * kind(seeds) bytes = size(seeds, kind=8) * kind(seeds)
call write_binary_xml(dname, fname, c_loc(seeds), bytes, dtype, digest) call write_binary_xml(dname, fname, c_loc(seeds), bytes, dtype, digest)
call write_attribute_xml(lun, "seeds", fname, bytes, dtype, digest) call write_attribute_xml(lun, "seeds", fname, 'int64', &
shape(seeds), bytes, dtype, digest)
if (allocated(seeds)) deallocate(seeds) if (allocated(seeds)) deallocate(seeds)
@ -2491,15 +2503,15 @@ module io
dbytes = size(fields, kind=8) * kind(fields) dbytes = size(fields, kind=8) * kind(fields)
call write_binary_xml(dname, fname, c_loc(fields), & call write_binary_xml(dname, fname, c_loc(fields), &
dbytes, hash_type, ddigest, cbytes, cdigest) dbytes, hash_type, ddigest, cbytes, cdigest)
call write_attribute_xml(lun, "fields", fname, & call write_attribute_xml(lun, "fields", fname, 'int32', &
dbytes, hash_type, ddigest, cbytes, cdigest) shape(fields), dbytes, hash_type, ddigest, cbytes, cdigest)
write(fname,"(a,'.bin')") "metablock_bounds" write(fname,"(a,'.bin')") "metablock_bounds"
dbytes = size(bounds, kind=8) * kind(bounds) dbytes = size(bounds, kind=8) * kind(bounds)
call write_binary_xml(dname, fname, c_loc(bounds), & call write_binary_xml(dname, fname, c_loc(bounds), &
dbytes, hash_type, ddigest, cbytes, cdigest) dbytes, hash_type, ddigest, cbytes, cdigest)
call write_attribute_xml(lun, "bounds", fname, & call write_attribute_xml(lun, "bounds", fname, 'float64', &
dbytes, hash_type, ddigest, cbytes, cdigest) shape(bounds), dbytes, hash_type, ddigest, cbytes, cdigest)
if (allocated(fields)) deallocate(fields) if (allocated(fields)) deallocate(fields)
if (allocated(bounds)) deallocate(bounds) if (allocated(bounds)) deallocate(bounds)
@ -2558,7 +2570,7 @@ module io
dbytes = size(ids, kind=8) * kind(ids) dbytes = size(ids, kind=8) * kind(ids)
call write_binary_xml(dname, fname, c_loc(ids), & call write_binary_xml(dname, fname, c_loc(ids), &
dbytes, hash_type, ddigest, cbytes, cdigest) dbytes, hash_type, ddigest, cbytes, cdigest)
call write_attribute_xml(lun, "ids", fname, & call write_attribute_xml(lun, "ids", fname, 'int32', shape(ids), &
dbytes, hash_type, ddigest, cbytes, cdigest) dbytes, hash_type, ddigest, cbytes, cdigest)
dbytes = size(array, kind=8) * kind(array) dbytes = size(array, kind=8) * kind(array)
@ -2578,8 +2590,8 @@ module io
trim(pvars(p)), nproc trim(pvars(p)), nproc
call write_binary_xml(dname, fname, c_loc(array), & call write_binary_xml(dname, fname, c_loc(array), &
dbytes, hash_type, ddigest, cbytes, cdigest) dbytes, hash_type, ddigest, cbytes, cdigest)
call write_attribute_xml(lun, pvars(p), fname, & call write_attribute_xml(lun, pvars(p), fname, 'float64', &
dbytes, hash_type, ddigest, cbytes, cdigest) shape(array), dbytes, hash_type, ddigest, cbytes, cdigest)
end do end do
if (allocated(ids)) deallocate(ids) if (allocated(ids)) deallocate(ids)
@ -2743,6 +2755,8 @@ module io
! lun - the file handler to write to; ! lun - the file handler to write to;
! aname - the file attribute name; ! aname - the file attribute name;
! filename - the file name; ! filename - the file name;
! data_type - the data type of the input data;
! data_shape - the shape of the input data;
! digest_string - the digest type string; ! digest_string - the digest type string;
! data_bytes - the file size in bytes; ! data_bytes - the file size in bytes;
! data_digest - the digest of the file content; ! data_digest - the digest of the file content;
@ -2751,8 +2765,9 @@ module io
! !
!=============================================================================== !===============================================================================
! !
subroutine write_attribute_xml_file(lun, aname, filename, data_bytes, & subroutine write_attribute_xml_file(lun, aname, filename, &
digest_type, data_digest, & data_type, data_shape, &
data_bytes, digest_type, data_digest, &
compressed_bytes, compressed_digest) compressed_bytes, compressed_digest)
use compression, only : compression_suffix use compression, only : compression_suffix
@ -2761,20 +2776,28 @@ module io
implicit none implicit none
integer , intent(in) :: lun integer , intent(in) :: lun
character(len=*) , intent(in) :: aname, filename character(len=*) , intent(in) :: aname, filename, data_type
integer , intent(in) :: digest_type integer , intent(in) :: digest_type
integer, dimension(:) , intent(in) :: data_shape
integer(kind=8) , intent(in) :: data_bytes, data_digest integer(kind=8) , intent(in) :: data_bytes, data_digest
integer(kind=8) , optional, intent(in) :: compressed_bytes integer(kind=8) , optional, intent(in) :: compressed_bytes
integer(kind=8) , optional, intent(in) :: compressed_digest integer(kind=8) , optional, intent(in) :: compressed_digest
character(len=256) :: fname character(len=256) :: fname
character(len=1024) :: string character(len=1024) :: string
character(len=32) :: str character(len=128) :: str
integer :: n
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
fname = filename fname = filename
string = '<Attribute type="string" name="' // trim(adjustl(aname)) // '"' string = '<Attribute type="string" name="' // trim(adjustl(aname)) // '"'
string = trim(string) // ' data_type="' // trim(adjustl(data_type)) // '"'
str = ""
do n = 1, size(data_shape)
write(str,"(a,1x,i0)") trim(str), data_shape(n)
end do
string = trim(string) // ' dimensions="' // trim(adjustl(str)) // '"'
write(str,"(1i0)") data_bytes write(str,"(1i0)") data_bytes
string = trim(string) // ' size="' // trim(adjustl(str)) // '"' string = trim(string) // ' size="' // trim(adjustl(str)) // '"'
str = hash_name(digest_type) str = hash_name(digest_type)