Merge branch 'master' into reconnection
This commit is contained in:
commit
0ac6a0d0d7
@ -26,6 +26,7 @@ endif()
|
||||
if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel")
|
||||
add_compile_options("$<$<CONFIG:RELEASE>:-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("$<$<CONFIG:DEBUG>:-O>")
|
||||
add_compile_options(-assume byterecl)
|
||||
endif()
|
||||
|
||||
if(CMAKE_Fortran_COMPILER_ID MATCHES "PGI")
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user