From 945e627199f3726645dac120c2f088e55431c73c Mon Sep 17 00:00:00 2001 From: Grzegorz Kowal Date: Sat, 22 Aug 2020 20:29:43 -0300 Subject: [PATCH 1/8] COMPRESSION, IO: Replace sizeof() with size() and transfer(). Signed-off-by: Grzegorz Kowal --- sources/compression.F90 | 24 ++++++++++++------------ sources/io.F90 | 28 ++++++++++++++-------------- 2 files changed, 26 insertions(+), 26 deletions(-) diff --git a/sources/compression.F90 b/sources/compression.F90 index e029741..e93d185 100644 --- a/sources/compression.F90 +++ b/sources/compression.F90 @@ -259,10 +259,10 @@ module compression select case(compression_format) #ifdef ZSTD case(compression_zstd) - allocate(buffer(zstd_bound(sizeof(input)))) - csize = zstd_compress(c_loc(buffer), sizeof(buffer), & - c_loc(input), sizeof(input), compression_level) - if (csize > 0 .and. csize <= sizeof(output)) then + allocate(buffer(zstd_bound(size(input, kind=8)))) + csize = zstd_compress(c_loc(buffer), size(buffer, kind=8), & + c_loc(input), size(input, kind=8), compression_level) + if (csize > 0 .and. csize <= size(output, kind=8)) then output(1:csize) = buffer(1:csize) else csize = -1 @@ -271,12 +271,12 @@ module compression #endif /* ZSTD */ #ifdef LZ4 case(compression_lz4) - prefs(5:6) = transfer(sizeof(input), [ 0_4 ]) + prefs(5:6) = transfer(size(input, kind=8), [ 0_4 ]) prefs(9) = compression_level - allocate(buffer(lz4_bound(sizeof(input), c_loc(prefs)))) - csize = lz4_compress(c_loc(buffer), sizeof(buffer), & - c_loc(input), sizeof(input), c_loc(prefs)) - if (csize > 0 .and. csize <= sizeof(output)) then + allocate(buffer(lz4_bound(size(input, kind=8), c_loc(prefs)))) + csize = lz4_compress(c_loc(buffer), size(buffer, kind=8), & + c_loc(input), size(input, kind=8), c_loc(prefs)) + if (csize > 0 .and. csize <= size(output, kind=8)) then output(1:csize) = buffer(1:csize) else csize = -1 @@ -288,9 +288,9 @@ module compression csize = 0 allocate(buffer(size(input))) ret = lzma_compress(compression_level, 4, c_null_ptr, & - c_loc(input), sizeof(input), & - c_loc(buffer), c_loc(csize), sizeof(buffer)) - if (ret == 0 .and. csize <= sizeof(output)) then + c_loc(input), size(input, kind=8), & + c_loc(buffer), c_loc(csize), size(buffer, kind=8)) + if (ret == 0 .and. csize <= size(output, kind=8)) then output(1:csize) = buffer(1:csize) else csize = -1 diff --git a/sources/io.F90 b/sources/io.F90 index 25bbd57..dee2421 100644 --- a/sources/io.F90 +++ b/sources/io.F90 @@ -1495,7 +1495,7 @@ module io ! read metablocks from binary files and check hashes ! - bytes = sizeof(fields) + bytes = size(transfer(fields, [ 0_1 ]), kind=8) write(fname,"(a,'metablock_fields.bin')") trim(dname) open(newunit = lun, file = fname, form = 'unformatted', & access = 'direct', recl = bytes) @@ -1507,7 +1507,7 @@ module io , "'" // trim(fname) // "' seems to be corrupted!" end if write(fname,"(a,'metablock_children.bin')") trim(dname) - bytes = sizeof(children) + bytes = size(transfer(children, [ 0_1 ]), kind=8) open(newunit = lun, file = fname, form = 'unformatted', & access = 'direct', recl = bytes) read(lun, rec = 1) children @@ -1518,7 +1518,7 @@ module io , "'" // trim(fname) // "' seems to be corrupted!" end if #if NDIMS == 3 - bytes = sizeof(faces) + bytes = size(transfer(faces, [ 0_1 ]), kind=8) write(fname,"(a,'metablock_faces.bin')") trim(dname) open(newunit = lun, file = fname, form = 'unformatted', & access = 'direct', recl = bytes) @@ -1530,7 +1530,7 @@ module io , "'" // trim(fname) // "' seems to be corrupted!" end if #endif /* NDIMS == 3 */ - bytes = sizeof(edges) + bytes = size(transfer(edges, [ 0_1 ]), kind=8) write(fname,"(a,'metablock_edges.bin')") trim(dname) open(newunit = lun, file = fname, form = 'unformatted', & access = 'direct', recl = bytes) @@ -1541,7 +1541,7 @@ module io write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if - bytes = sizeof(corners) + bytes = size(transfer(corners, [ 0_1 ]), kind=8) write(fname,"(a,'metablock_corners.bin')") trim(dname) open(newunit = lun, file = fname, form = 'unformatted', & access = 'direct', recl = bytes) @@ -1552,7 +1552,7 @@ module io write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if - bytes = sizeof(bounds) + bytes = size(transfer(bounds, [ 0_1 ]), kind=8) write(fname,"(a,'metablock_bounds.bin')") trim(dname) open(newunit = lun, file = fname, form = 'unformatted', & access = 'direct', recl = bytes) @@ -1655,7 +1655,7 @@ module io ! if (lnmodes == nmodes) then if (lnmodes > 0) then - bytes = sizeof(fcoefs) + bytes = size(transfer(fcoefs, [ 0_1 ]), kind=8) write(fname,"(a,'forcing_coefficients.bin')") trim(dname) open(newunit = lun, file = fname, form = 'unformatted', & access = 'direct', recl = bytes) @@ -1731,7 +1731,7 @@ module io if (status == 0) then - bytes = sizeof(ids) + bytes = size(transfer(ids, [ 0_1 ]), kind=8) write(fname, fmt) trim(dname), "datablock_ids", nproc, "bin" open(newunit = lun, file = fname, form = 'unformatted', & access = 'direct' , recl = bytes) @@ -1742,7 +1742,7 @@ module io write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if - bytes = sizeof(arrays) + bytes = size(transfer(arrays, [ 0_1 ]), kind=8) write(fname, fmt) trim(dname), "datablock_arrays", nproc, "bin" open(newunit = lun, file = fname, form = 'unformatted', & access = 'direct' , recl = bytes) @@ -1774,7 +1774,7 @@ module io if (status == 0) then - bytes = sizeof(seeds) + bytes = size(transfer(seeds, [ 0_1 ]), kind=8) write(fname, fmt) trim(dname), "random_seeds", nproc, "bin" open(unit = lun, file = fname, form = 'unformatted', & access = 'direct', recl = bytes) @@ -1834,7 +1834,7 @@ module io if (status == 0) then - bytes = sizeof(seeds) + bytes = size(transfer(seeds, [ 0_1 ]), kind=8) write(fname, fmt) trim(dname), "random_seeds", 0, "bin" open(newunit = lun, file = fname, form = 'unformatted', & access = 'direct', recl = bytes) @@ -1944,7 +1944,7 @@ module io if (status == 0) then - bytes = sizeof(ids) + bytes = size(transfer(ids, [ 0_1 ]), kind=8) write(fname, fmt) trim(dname), "datablock_ids", n, "bin" open(newunit = lun, file = fname, form = 'unformatted', & access = 'direct' , recl = bytes) @@ -1955,7 +1955,7 @@ module io write(error_unit,"('[',a,']: ',a)") trim(loc) & , "'" // trim(fname) // "' seems to be corrupted!" end if - bytes = sizeof(arrays) + bytes = size(transfer(arrays, [ 0_1 ]), kind=8) write(fname, fmt) trim(dname), "datablock_arrays", n, "bin" open(newunit = lun, file = fname, form = 'unformatted', & access = 'direct' , recl = bytes) @@ -1989,7 +1989,7 @@ module io if (status == 0) then - bytes = sizeof(seeds) + bytes = size(transfer(seeds, [ 0_1 ]), kind=8) write(fname, fmt) trim(dname), "random_seeds", nproc, "bin" open(newunit = lun, file = fname, form = 'unformatted', & access = 'direct', recl = bytes) From f0a7edb6ea42aad4722dc0d3398207f87c3dc4cd Mon Sep 17 00:00:00 2001 From: Grzegorz Kowal Date: Sun, 23 Aug 2020 19:44:49 -0300 Subject: [PATCH 2/8] IO: Detect record length in write_binary_xml(). Signed-off-by: Grzegorz Kowal --- sources/io.F90 | 42 ++++++++++++++++++++++-------------------- 1 file changed, 22 insertions(+), 20 deletions(-) diff --git a/sources/io.F90 b/sources/io.F90 index dee2421..e5ade56 100644 --- a/sources/io.F90 +++ b/sources/io.F90 @@ -3020,16 +3020,16 @@ module io ! ! Arguments: ! -! path, name - the path and name where the data are written to; -! data - the array of bytes to be written; -! data_bytes - the size of the data in bytes; -! data_digest - the digest of the written data; -! compressed_bytes - the size of the data in bytes; -! compressed_digest - the digest of the written data; +! path, name - the path and name where the array should be written to; +! array - the array of bytes to be written; +! array_bytes - the size of the array in bytes; +! array_digest - the digest of the input array; +! compressed_bytes - the size of the compressed array in bytes; +! compressed_digest - the digest of the compressed array; ! !=============================================================================== ! - subroutine write_binary_xml(path, name, data, data_bytes, data_digest, & + subroutine write_binary_xml(path, name, array, array_bytes, array_digest, & compressed_bytes, compressed_digest) use compression, only : get_compression, compress @@ -3040,16 +3040,16 @@ module io ! input and output arguments ! character(len=*) , intent(in) :: path, name - integer(kind=1), dimension(:), intent(in) :: data - integer(kind=8), optional , intent(out) :: data_bytes, compressed_bytes - integer(kind=8), optional , intent(out) :: data_digest, compressed_digest + integer(kind=1), dimension(:), intent(in) :: array + integer(kind=8), optional , intent(out) :: array_bytes, compressed_bytes + integer(kind=8), optional , intent(out) :: array_digest, compressed_digest ! local variables ! character(len=512) :: fname integer :: lun = 123 logical :: written - integer :: l, status + integer :: l, reclen, status ! compression buffer ! @@ -3059,19 +3059,20 @@ module io ! status = 0 written = .false. - data_bytes = size(data) - if (present(data_digest)) data_digest = xxh64(data) + array_bytes = size(array, kind=8) + if (present(array_digest)) array_digest = xxh64(array) write(fname,"(a,'/',a)") trim(path), trim(name) -! try to compress data and write them to disk +! try to compress array and write it ! if (present(compressed_bytes) .and. get_compression() > 0) then - allocate(buffer(data_bytes), stat = status) + allocate(buffer(array_bytes), stat = status) if (status == 0) then - call compress(data, buffer, compressed_bytes) + call compress(array, buffer, compressed_bytes) if (compressed_bytes > 0) then + inquire(iolength = reclen) buffer(1:compressed_bytes) open(newunit = lun, file = fname, form = 'unformatted', & - access = 'direct', recl = compressed_bytes, & + access = 'direct', recl = reclen, & status = 'replace') write(lun, rec = 1) buffer(1:compressed_bytes) close(lun) @@ -3083,14 +3084,15 @@ module io end if end if -! something did not go well or no compression is used, so save uncompressed data +! compression failed of no compression is used, so writhe the uncompressed array ! if (.not. written) then l = index(fname, '.bin') + 3 + inquire(iolength = reclen) array open(newunit = lun, file = fname(:l), form = 'unformatted', & - access = 'direct', recl = data_bytes, & + access = 'direct', recl = reclen, & status = 'replace') - write(lun, rec = 1) data + write(lun, rec = 1) array close(lun) end if From 35c8217bfa33fb9af41ba883eb1d6bd830a9959b Mon Sep 17 00:00:00 2001 From: Grzegorz Kowal Date: Sun, 23 Aug 2020 20:09:42 -0300 Subject: [PATCH 3/8] CMakeList: Assume byte record size for Intel compilers. Signed-off-by: Grzegorz Kowal --- CMakeLists.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 4ee5a1e..23c6ff3 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -24,8 +24,8 @@ if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") endif() if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") - add_compile_options("$<$:-xHost;-fp-model=source;-heap-arrays;-ip;-unroll-aggressive;-simd;-qopt-prefetch;-use-intel-optimized-headers;-finline-limit=1000;-fno-omit-frame-pointer>") - add_compile_options("$<$:-O>") + add_compile_options("$<$:-xHost;-fp-model=source;-heap-arrays;-ip;-unroll-aggressive;-simd;-qopt-prefetch;-use-intel-optimized-headers;-finline-limit=1000;-fno-omit-frame-pointer;-assume byterecl>") + add_compile_options("$<$:-O;-assume byterecl>") endif() if(CMAKE_Fortran_COMPILER_ID MATCHES "PGI") From ff5ad1842428e6c08bbb7b101cb060a9ab308f52 Mon Sep 17 00:00:00 2001 From: Grzegorz Kowal Date: Sun, 23 Aug 2020 20:23:04 -0300 Subject: [PATCH 4/8] CMake: Fix Intel compiler options. Signed-off-by: Grzegorz Kowal --- CMakeLists.txt | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 23c6ff3..c28c75a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -24,8 +24,9 @@ if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") endif() if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") - add_compile_options("$<$:-xHost;-fp-model=source;-heap-arrays;-ip;-unroll-aggressive;-simd;-qopt-prefetch;-use-intel-optimized-headers;-finline-limit=1000;-fno-omit-frame-pointer;-assume byterecl>") - add_compile_options("$<$:-O;-assume byterecl>") + add_compile_options("$<$:-xHost;-fp-model=source;-heap-arrays;-ip;-unroll-aggressive;-simd;-qopt-prefetch;-use-intel-optimized-headers;-finline-limit=1000;-fno-omit-frame-pointer>") + add_compile_options("$<$:-O>") + add_compile_options(-assume byterecl) endif() if(CMAKE_Fortran_COMPILER_ID MATCHES "PGI") From 30c012d01a4f4403691c1826fb434863509b2223 Mon Sep 17 00:00:00 2001 From: Grzegorz Kowal Date: Mon, 24 Aug 2020 19:29:21 -0300 Subject: [PATCH 5/8] IO: Add more Intel dependent inquire statements. Signed-off-by: Grzegorz Kowal --- sources/io.F90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/sources/io.F90 b/sources/io.F90 index e5ade56..e51cfec 100644 --- a/sources/io.F90 +++ b/sources/io.F90 @@ -1001,7 +1001,11 @@ module io ! write(dname, "(a,'restart-',i5.5)") trim(respath), nrest +#ifdef __INTEL_COMPILER + inquire(directory = dname, exist = test) +#else /* __INTEL_COMPILER */ inquire(file = dname, exist = test) +#endif /* __INTEL_COMPILER */ if (.not. test) then write(error_unit,"('[',a,']: ',a)") trim(loc), & trim(dname) // " does not exists!" @@ -1090,7 +1094,11 @@ module io ! write(dname, "(a,'restart-',i5.5)") trim(respath), nrest +#ifdef __INTEL_COMPILER + inquire(directory = dname, exist = test) +#else /* __INTEL_COMPILER */ inquire(file = dname, exist = test) +#endif /* __INTEL_COMPILER */ if (.not. test) then write(error_unit,"('[',a,']: ',a)") trim(loc), & trim(dname) // " does not exists!" @@ -1180,7 +1188,11 @@ module io ! write(dname, "(a,'restart-',i5.5)") trim(respath), nrest +#ifdef __INTEL_COMPILER + inquire(directory = dname, exist = test) +#else /* __INTEL_COMPILER */ inquire(file = dname, exist = test) +#endif /* __INTEL_COMPILER */ if (.not. test) then write(error_unit,"('[',a,']: ',a)") trim(loc), & trim(dname) // " does not exists!" @@ -1321,7 +1333,11 @@ module io ! write(dname, "(a,'restart-',i5.5)") trim(respath), nrest +#ifdef __INTEL_COMPILER + inquire(directory = dname, exist = test) +#else /* __INTEL_COMPILER */ inquire(file = dname, exist = test) +#endif /* __INTEL_COMPILER */ if (.not. test) then write(*,*) trim(dname) // " does not exists!" status = 121 From 38fb24f9d6b0c8846ac9a48271d6490590b51ff7 Mon Sep 17 00:00:00 2001 From: Grzegorz Kowal Date: Mon, 24 Aug 2020 20:43:23 -0300 Subject: [PATCH 6/8] IO: Always write all three dimensions of bounds(:,:,:). Signed-off-by: Grzegorz Kowal --- sources/io.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sources/io.F90 b/sources/io.F90 index e51cfec..ae97d54 100644 --- a/sources/io.F90 +++ b/sources/io.F90 @@ -1486,7 +1486,7 @@ module io ! prepare and store metablocks ! - allocate(barray(nx), fields(nm,14), children(nm,nc), bounds(nm,NDIMS,2), & + allocate(barray(nx), fields(nm,14), children(nm,nc), bounds(nm,3,2), & #if NDIMS == 3 faces(nm,NDIMS,ns,ns,ns), & edges(nm,NDIMS,ns,ns,ns), corners(nm,ns,ns,ns), & @@ -2231,7 +2231,7 @@ module io ! prepare and store metablocks ! - allocate(fields(nm,14), children(nm,nc), bounds(nm,NDIMS,2), & + allocate(fields(nm,14), children(nm,nc), bounds(nm,3,2), & #if NDIMS == 3 faces(nm,NDIMS,ns,ns,ns), & edges(nm,NDIMS,ns,ns,ns), corners(nm,ns,ns,ns), & From 1cac584c468fed9cad7b732c5e4c7a3689e00b1a Mon Sep 17 00:00:00 2001 From: Grzegorz Kowal Date: Mon, 24 Aug 2020 22:06:42 -0300 Subject: [PATCH 7/8] IO: Use newunit instead of unit in read_restart_snapshot_xml(). Signed-off-by: Grzegorz Kowal --- sources/io.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sources/io.F90 b/sources/io.F90 index ae97d54..bba455f 100644 --- a/sources/io.F90 +++ b/sources/io.F90 @@ -1792,7 +1792,7 @@ module io bytes = size(transfer(seeds, [ 0_1 ]), kind=8) write(fname, fmt) trim(dname), "random_seeds", nproc, "bin" - open(unit = lun, file = fname, form = 'unformatted', & + open(newunit = lun, file = fname, form = 'unformatted', & access = 'direct', recl = bytes) read(lun, rec = 1) seeds close(lun) From e23f97bbd614366730dbf5be20d0e64ec60e5d15 Mon Sep 17 00:00:00 2001 From: Grzegorz Kowal Date: Mon, 24 Aug 2020 22:15:54 -0300 Subject: [PATCH 8/8] COMPRESSION: Remove long lines. Signed-off-by: Grzegorz Kowal --- sources/compression.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/sources/compression.F90 b/sources/compression.F90 index e93d185..1981f0f 100644 --- a/sources/compression.F90 +++ b/sources/compression.F90 @@ -260,8 +260,9 @@ module compression #ifdef ZSTD case(compression_zstd) allocate(buffer(zstd_bound(size(input, kind=8)))) - csize = zstd_compress(c_loc(buffer), size(buffer, kind=8), & - c_loc(input), size(input, kind=8), compression_level) + csize = zstd_compress(c_loc(buffer), size(buffer, kind=8), & + c_loc(input), size(input, kind=8), & + compression_level) if (csize > 0 .and. csize <= size(output, kind=8)) then output(1:csize) = buffer(1:csize) else @@ -274,7 +275,7 @@ module compression prefs(5:6) = transfer(size(input, kind=8), [ 0_4 ]) prefs(9) = compression_level allocate(buffer(lz4_bound(size(input, kind=8), c_loc(prefs)))) - csize = lz4_compress(c_loc(buffer), size(buffer, kind=8), & + csize = lz4_compress(c_loc(buffer), size(buffer, kind=8), & c_loc(input), size(input, kind=8), c_loc(prefs)) if (csize > 0 .and. csize <= size(output, kind=8)) then output(1:csize) = buffer(1:csize) @@ -288,7 +289,7 @@ module compression csize = 0 allocate(buffer(size(input))) ret = lzma_compress(compression_level, 4, c_null_ptr, & - c_loc(input), size(input, kind=8), & + c_loc(input), size(input, kind=8), & c_loc(buffer), c_loc(csize), size(buffer, kind=8)) if (ret == 0 .and. csize <= size(output, kind=8)) then output(1:csize) = buffer(1:csize)