diff --git a/CMakeLists.txt b/CMakeLists.txt index 4ee5a1e..c28c75a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -26,6 +26,7 @@ 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(-assume byterecl) endif() if(CMAKE_Fortran_COMPILER_ID MATCHES "PGI") diff --git a/sources/compression.F90 b/sources/compression.F90 index e029741..1981f0f 100644 --- a/sources/compression.F90 +++ b/sources/compression.F90 @@ -259,10 +259,11 @@ 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 +272,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 +289,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..bba455f 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 @@ -1470,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), & @@ -1495,7 +1511,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 +1523,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 +1534,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 +1546,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 +1557,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 +1568,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 +1671,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 +1747,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 +1758,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,9 +1790,9 @@ 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', & + open(newunit = lun, file = fname, form = 'unformatted', & access = 'direct', recl = bytes) read(lun, rec = 1) seeds close(lun) @@ -1834,7 +1850,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 +1960,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 +1971,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 +2005,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) @@ -2215,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), & @@ -3020,16 +3036,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 +3056,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 +3075,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 +3100,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