From 5792fe60a0afa3eb065ebdafb0d14d9fdace887f Mon Sep 17 00:00:00 2001 From: Grzegorz Kowal Date: Thu, 2 Dec 2021 10:43:03 -0300 Subject: [PATCH] IO: Store data type and dimensions for XML-binary format. Signed-off-by: Grzegorz Kowal --- sources/io.F90 | 73 +++++++++++++++++++++++++++++++++----------------- 1 file changed, 48 insertions(+), 25 deletions(-) diff --git a/sources/io.F90 b/sources/io.F90 index 1f53308..07f2233 100644 --- a/sources/io.F90 +++ b/sources/io.F90 @@ -2148,40 +2148,50 @@ module io write(fname,"(a,'.bin')") "metablock_fields" bytes = size(fields, kind=8) * kind(fields) 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" bytes = size(children, kind=8) * kind(children) - call write_binary_xml(dname, fname, c_loc(children), bytes, dtype, digest) - call write_attribute_xml(lun, "children", fname, bytes, dtype, digest) + call write_binary_xml(dname, fname, c_loc(children), & + bytes, dtype, digest) + call write_attribute_xml(lun, "children", fname, 'int32', & + shape(children), bytes, dtype, digest) #if NDIMS == 3 write(fname,"(a,'.bin')") "metablock_faces" bytes = size(faces, kind=8) * kind(faces) 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 */ write(fname,"(a,'.bin')") "metablock_edges" bytes = size(edges, kind=8) * kind(edges) 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" bytes = size(corners, kind=8) * kind(corners) - call write_binary_xml(dname, fname, c_loc(corners), bytes, dtype, digest) - call write_attribute_xml(lun, "corners", fname, bytes, dtype, digest) + call write_binary_xml(dname, fname, c_loc(corners), & + bytes, dtype, digest) + call write_attribute_xml(lun, "corners", fname, 'int32', & + shape(corners), bytes, dtype, digest) write(fname,"(a,'.bin')") "metablock_bounds" bytes = size(bounds, kind=8) * kind(bounds) 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 write(fname,"(a,'.bin')") "forcing_coefficients" bytes = size(fcoefs, kind=8) * kind(fcoefs) - call write_binary_xml(dname, fname, c_loc(fcoefs), bytes, dtype, digest) - call write_attribute_xml(lun, "forcing", fname, bytes, dtype, digest) + call write_binary_xml(dname, fname, c_loc(fcoefs), & + bytes, dtype, digest) + call write_attribute_xml(lun, "forcing", fname, 'complex64', & + shape(fcoefs), bytes, dtype, digest) end if #if NDIMS == 3 @@ -2246,14 +2256,14 @@ module io call write_binary_xml(dname, fname, c_loc(pdata%q), & bytes, dtype, digest) 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) bytes = size(pdata%uu, kind=8) * kind(pdata%uu) call write_binary_xml(dname, fname, c_loc(pdata%uu), & bytes, dtype, digest) call write_attribute_xml(lun, "cons" // trim(aname), fname, & - bytes, dtype, digest) + 'float64', shape(pdata%uu), bytes, dtype, digest) pdata => pdata%next @@ -2262,7 +2272,8 @@ module io write(fname,"(a,'_',a,'_',i6.6,'.bin')") "datablock", "ids", nproc bytes = size(ids, kind=8) * kind(ids) 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) @@ -2283,7 +2294,8 @@ module io write(fname,"(a,'_',a,'_',i6.6,'.bin')") "random", "seeds", nproc bytes = size(seeds, kind=8) * kind(seeds) 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) @@ -2491,15 +2503,15 @@ module io dbytes = size(fields, kind=8) * kind(fields) call write_binary_xml(dname, fname, c_loc(fields), & dbytes, hash_type, ddigest, cbytes, cdigest) - call write_attribute_xml(lun, "fields", fname, & - dbytes, hash_type, ddigest, cbytes, cdigest) + call write_attribute_xml(lun, "fields", fname, 'int32', & + shape(fields), dbytes, hash_type, ddigest, cbytes, cdigest) write(fname,"(a,'.bin')") "metablock_bounds" dbytes = size(bounds, kind=8) * kind(bounds) call write_binary_xml(dname, fname, c_loc(bounds), & dbytes, hash_type, ddigest, cbytes, cdigest) - call write_attribute_xml(lun, "bounds", fname, & - dbytes, hash_type, ddigest, cbytes, cdigest) + call write_attribute_xml(lun, "bounds", fname, 'float64', & + shape(bounds), dbytes, hash_type, ddigest, cbytes, cdigest) if (allocated(fields)) deallocate(fields) if (allocated(bounds)) deallocate(bounds) @@ -2558,7 +2570,7 @@ module io dbytes = size(ids, kind=8) * kind(ids) call write_binary_xml(dname, fname, c_loc(ids), & 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 = size(array, kind=8) * kind(array) @@ -2578,8 +2590,8 @@ module io trim(pvars(p)), nproc call write_binary_xml(dname, fname, c_loc(array), & dbytes, hash_type, ddigest, cbytes, cdigest) - call write_attribute_xml(lun, pvars(p), fname, & - dbytes, hash_type, ddigest, cbytes, cdigest) + call write_attribute_xml(lun, pvars(p), fname, 'float64', & + shape(array), dbytes, hash_type, ddigest, cbytes, cdigest) end do if (allocated(ids)) deallocate(ids) @@ -2743,6 +2755,8 @@ module io ! lun - the file handler to write to; ! aname - the file attribute 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; ! data_bytes - the file size in bytes; ! data_digest - the digest of the file content; @@ -2751,8 +2765,9 @@ module io ! !=============================================================================== ! - subroutine write_attribute_xml_file(lun, aname, filename, data_bytes, & - digest_type, data_digest, & + subroutine write_attribute_xml_file(lun, aname, filename, & + data_type, data_shape, & + data_bytes, digest_type, data_digest, & compressed_bytes, compressed_digest) use compression, only : compression_suffix @@ -2761,20 +2776,28 @@ module io implicit none integer , intent(in) :: lun - character(len=*) , intent(in) :: aname, filename + character(len=*) , intent(in) :: aname, filename, data_type integer , intent(in) :: digest_type + integer, dimension(:) , intent(in) :: data_shape integer(kind=8) , intent(in) :: data_bytes, data_digest integer(kind=8) , optional, intent(in) :: compressed_bytes integer(kind=8) , optional, intent(in) :: compressed_digest character(len=256) :: fname character(len=1024) :: string - character(len=32) :: str + character(len=128) :: str + integer :: n !------------------------------------------------------------------------------- ! fname = filename string = '