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

Merge branch 'master' into reconnection

Browse Source
This commit is contained in:
Grzegorz Kowal 2020-08-24 22:17:06 -03:00
commit 0ac6a0d0d7
3 changed files with 69 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
CMakeLists.txt
View File

@ -26,6 +26,7 @@ endif()
if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") 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: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("$<$<CONFIG:DEBUG>:-O>")
add_compile_options(-assume byterecl)
endif() endif()
if(CMAKE_Fortran_COMPILER_ID MATCHES "PGI") if(CMAKE_Fortran_COMPILER_ID MATCHES "PGI")

25
sources/compression.F90
View File

@ -259,10 +259,11 @@ module compression
select case(compression_format) select case(compression_format)
#ifdef ZSTD #ifdef ZSTD
case(compression_zstd) case(compression_zstd)
allocate(buffer(zstd_bound(sizeof(input)))) allocate(buffer(zstd_bound(size(input, kind=8))))
csize = zstd_compress(c_loc(buffer), sizeof(buffer), & csize = zstd_compress(c_loc(buffer), size(buffer, kind=8), &
c_loc(input), sizeof(input), compression_level) c_loc(input), size(input, kind=8), &
if (csize > 0 .and. csize <= sizeof(output)) then compression_level)
if (csize > 0 .and. csize <= size(output, kind=8)) then
output(1:csize) = buffer(1:csize) output(1:csize) = buffer(1:csize)
else else
csize = -1 csize = -1
@ -271,12 +272,12 @@ module compression
#endif /* ZSTD */ #endif /* ZSTD */
#ifdef LZ4 #ifdef LZ4
case(compression_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 prefs(9) = compression_level
allocate(buffer(lz4_bound(sizeof(input), c_loc(prefs)))) allocate(buffer(lz4_bound(size(input, kind=8), c_loc(prefs))))
csize = lz4_compress(c_loc(buffer), sizeof(buffer), & csize = lz4_compress(c_loc(buffer), size(buffer, kind=8), &
c_loc(input), sizeof(input), c_loc(prefs)) c_loc(input), size(input, kind=8), c_loc(prefs))
if (csize > 0 .and. csize <= sizeof(output)) then if (csize > 0 .and. csize <= size(output, kind=8)) then
output(1:csize) = buffer(1:csize) output(1:csize) = buffer(1:csize)
else else
csize = -1 csize = -1
@ -288,9 +289,9 @@ module compression
csize = 0 csize = 0
allocate(buffer(size(input))) allocate(buffer(size(input)))
ret = lzma_compress(compression_level, 4, c_null_ptr, & ret = lzma_compress(compression_level, 4, c_null_ptr, &
c_loc(input), sizeof(input), & c_loc(input), size(input, kind=8), &
c_loc(buffer), c_loc(csize), sizeof(buffer)) c_loc(buffer), c_loc(csize), size(buffer, kind=8))
if (ret == 0 .and. csize <= sizeof(output)) then if (ret == 0 .and. csize <= size(output, kind=8)) then
output(1:csize) = buffer(1:csize) output(1:csize) = buffer(1:csize)
else else
csize = -1 csize = -1

92
sources/io.F90
View File

@ -1001,7 +1001,11 @@ module io
! !
write(dname, "(a,'restart-',i5.5)") trim(respath), nrest 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) inquire(file = dname, exist = test)
#endif /* __INTEL_COMPILER */
if (.not. test) then if (.not. test) then
write(error_unit,"('[',a,']: ',a)") trim(loc), & write(error_unit,"('[',a,']: ',a)") trim(loc), &
trim(dname) // " does not exists!" trim(dname) // " does not exists!"
@ -1090,7 +1094,11 @@ module io
! !
write(dname, "(a,'restart-',i5.5)") trim(respath), nrest 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) inquire(file = dname, exist = test)
#endif /* __INTEL_COMPILER */
if (.not. test) then if (.not. test) then
write(error_unit,"('[',a,']: ',a)") trim(loc), & write(error_unit,"('[',a,']: ',a)") trim(loc), &
trim(dname) // " does not exists!" trim(dname) // " does not exists!"
@ -1180,7 +1188,11 @@ module io
! !
write(dname, "(a,'restart-',i5.5)") trim(respath), nrest 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) inquire(file = dname, exist = test)
#endif /* __INTEL_COMPILER */
if (.not. test) then if (.not. test) then
write(error_unit,"('[',a,']: ',a)") trim(loc), & write(error_unit,"('[',a,']: ',a)") trim(loc), &
trim(dname) // " does not exists!" trim(dname) // " does not exists!"
@ -1321,7 +1333,11 @@ module io
! !
write(dname, "(a,'restart-',i5.5)") trim(respath), nrest 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) inquire(file = dname, exist = test)
#endif /* __INTEL_COMPILER */
if (.not. test) then if (.not. test) then
write(*,*) trim(dname) // " does not exists!" write(*,*) trim(dname) // " does not exists!"
status = 121 status = 121
@ -1470,7 +1486,7 @@ module io
! prepare and store metablocks ! 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 #if NDIMS == 3
faces(nm,NDIMS,ns,ns,ns), & faces(nm,NDIMS,ns,ns,ns), &
edges(nm,NDIMS,ns,ns,ns), corners(nm,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 ! 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) write(fname,"(a,'metablock_fields.bin')") trim(dname)
open(newunit = lun, file = fname, form = 'unformatted', & open(newunit = lun, file = fname, form = 'unformatted', &
access = 'direct', recl = bytes) access = 'direct', recl = bytes)
@ -1507,7 +1523,7 @@ module io
, "'" // trim(fname) // "' seems to be corrupted!" , "'" // trim(fname) // "' seems to be corrupted!"
end if end if
write(fname,"(a,'metablock_children.bin')") trim(dname) 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', & open(newunit = lun, file = fname, form = 'unformatted', &
access = 'direct', recl = bytes) access = 'direct', recl = bytes)
read(lun, rec = 1) children read(lun, rec = 1) children
@ -1518,7 +1534,7 @@ module io
, "'" // trim(fname) // "' seems to be corrupted!" , "'" // trim(fname) // "' seems to be corrupted!"
end if end if
#if NDIMS == 3 #if NDIMS == 3
bytes = sizeof(faces) bytes = size(transfer(faces, [ 0_1 ]), kind=8)
write(fname,"(a,'metablock_faces.bin')") trim(dname) write(fname,"(a,'metablock_faces.bin')") trim(dname)
open(newunit = lun, file = fname, form = 'unformatted', & open(newunit = lun, file = fname, form = 'unformatted', &
access = 'direct', recl = bytes) access = 'direct', recl = bytes)
@ -1530,7 +1546,7 @@ module io
, "'" // trim(fname) // "' seems to be corrupted!" , "'" // trim(fname) // "' seems to be corrupted!"
end if end if
#endif /* NDIMS == 3 */ #endif /* NDIMS == 3 */
bytes = sizeof(edges) bytes = size(transfer(edges, [ 0_1 ]), kind=8)
write(fname,"(a,'metablock_edges.bin')") trim(dname) write(fname,"(a,'metablock_edges.bin')") trim(dname)
open(newunit = lun, file = fname, form = 'unformatted', & open(newunit = lun, file = fname, form = 'unformatted', &
access = 'direct', recl = bytes) access = 'direct', recl = bytes)
@ -1541,7 +1557,7 @@ module io
write(error_unit,"('[',a,']: ',a)") trim(loc) & write(error_unit,"('[',a,']: ',a)") trim(loc) &
, "'" // trim(fname) // "' seems to be corrupted!" , "'" // trim(fname) // "' seems to be corrupted!"
end if end if
bytes = sizeof(corners) bytes = size(transfer(corners, [ 0_1 ]), kind=8)
write(fname,"(a,'metablock_corners.bin')") trim(dname) write(fname,"(a,'metablock_corners.bin')") trim(dname)
open(newunit = lun, file = fname, form = 'unformatted', & open(newunit = lun, file = fname, form = 'unformatted', &
access = 'direct', recl = bytes) access = 'direct', recl = bytes)
@ -1552,7 +1568,7 @@ module io
write(error_unit,"('[',a,']: ',a)") trim(loc) & write(error_unit,"('[',a,']: ',a)") trim(loc) &
, "'" // trim(fname) // "' seems to be corrupted!" , "'" // trim(fname) // "' seems to be corrupted!"
end if end if
bytes = sizeof(bounds) bytes = size(transfer(bounds, [ 0_1 ]), kind=8)
write(fname,"(a,'metablock_bounds.bin')") trim(dname) write(fname,"(a,'metablock_bounds.bin')") trim(dname)
open(newunit = lun, file = fname, form = 'unformatted', & open(newunit = lun, file = fname, form = 'unformatted', &
access = 'direct', recl = bytes) access = 'direct', recl = bytes)
@ -1655,7 +1671,7 @@ module io
! !
if (lnmodes == nmodes) then if (lnmodes == nmodes) then
if (lnmodes > 0) then if (lnmodes > 0) then
bytes = sizeof(fcoefs) bytes = size(transfer(fcoefs, [ 0_1 ]), kind=8)
write(fname,"(a,'forcing_coefficients.bin')") trim(dname) write(fname,"(a,'forcing_coefficients.bin')") trim(dname)
open(newunit = lun, file = fname, form = 'unformatted', & open(newunit = lun, file = fname, form = 'unformatted', &
access = 'direct', recl = bytes) access = 'direct', recl = bytes)
@ -1731,7 +1747,7 @@ module io
if (status == 0) then if (status == 0) then
bytes = sizeof(ids) bytes = size(transfer(ids, [ 0_1 ]), kind=8)
write(fname, fmt) trim(dname), "datablock_ids", nproc, "bin" write(fname, fmt) trim(dname), "datablock_ids", nproc, "bin"
open(newunit = lun, file = fname, form = 'unformatted', & open(newunit = lun, file = fname, form = 'unformatted', &
access = 'direct' , recl = bytes) access = 'direct' , recl = bytes)
@ -1742,7 +1758,7 @@ module io
write(error_unit,"('[',a,']: ',a)") trim(loc) & write(error_unit,"('[',a,']: ',a)") trim(loc) &
, "'" // trim(fname) // "' seems to be corrupted!" , "'" // trim(fname) // "' seems to be corrupted!"
end if end if
bytes = sizeof(arrays) bytes = size(transfer(arrays, [ 0_1 ]), kind=8)
write(fname, fmt) trim(dname), "datablock_arrays", nproc, "bin" write(fname, fmt) trim(dname), "datablock_arrays", nproc, "bin"
open(newunit = lun, file = fname, form = 'unformatted', & open(newunit = lun, file = fname, form = 'unformatted', &
access = 'direct' , recl = bytes) access = 'direct' , recl = bytes)
@ -1774,9 +1790,9 @@ module io
if (status == 0) then if (status == 0) then
bytes = sizeof(seeds) bytes = size(transfer(seeds, [ 0_1 ]), kind=8)
write(fname, fmt) trim(dname), "random_seeds", nproc, "bin" 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) access = 'direct', recl = bytes)
read(lun, rec = 1) seeds read(lun, rec = 1) seeds
close(lun) close(lun)
@ -1834,7 +1850,7 @@ module io
if (status == 0) then if (status == 0) then
bytes = sizeof(seeds) bytes = size(transfer(seeds, [ 0_1 ]), kind=8)
write(fname, fmt) trim(dname), "random_seeds", 0, "bin" write(fname, fmt) trim(dname), "random_seeds", 0, "bin"
open(newunit = lun, file = fname, form = 'unformatted', & open(newunit = lun, file = fname, form = 'unformatted', &
access = 'direct', recl = bytes) access = 'direct', recl = bytes)
@ -1944,7 +1960,7 @@ module io
if (status == 0) then if (status == 0) then
bytes = sizeof(ids) bytes = size(transfer(ids, [ 0_1 ]), kind=8)
write(fname, fmt) trim(dname), "datablock_ids", n, "bin" write(fname, fmt) trim(dname), "datablock_ids", n, "bin"
open(newunit = lun, file = fname, form = 'unformatted', & open(newunit = lun, file = fname, form = 'unformatted', &
access = 'direct' , recl = bytes) access = 'direct' , recl = bytes)
@ -1955,7 +1971,7 @@ module io
write(error_unit,"('[',a,']: ',a)") trim(loc) & write(error_unit,"('[',a,']: ',a)") trim(loc) &
, "'" // trim(fname) // "' seems to be corrupted!" , "'" // trim(fname) // "' seems to be corrupted!"
end if end if
bytes = sizeof(arrays) bytes = size(transfer(arrays, [ 0_1 ]), kind=8)
write(fname, fmt) trim(dname), "datablock_arrays", n, "bin" write(fname, fmt) trim(dname), "datablock_arrays", n, "bin"
open(newunit = lun, file = fname, form = 'unformatted', & open(newunit = lun, file = fname, form = 'unformatted', &
access = 'direct' , recl = bytes) access = 'direct' , recl = bytes)
@ -1989,7 +2005,7 @@ module io
if (status == 0) then if (status == 0) then
bytes = sizeof(seeds) bytes = size(transfer(seeds, [ 0_1 ]), kind=8)
write(fname, fmt) trim(dname), "random_seeds", nproc, "bin" write(fname, fmt) trim(dname), "random_seeds", nproc, "bin"
open(newunit = lun, file = fname, form = 'unformatted', & open(newunit = lun, file = fname, form = 'unformatted', &
access = 'direct', recl = bytes) access = 'direct', recl = bytes)
@ -2215,7 +2231,7 @@ module io
! prepare and store metablocks ! 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 #if NDIMS == 3
faces(nm,NDIMS,ns,ns,ns), & faces(nm,NDIMS,ns,ns,ns), &
edges(nm,NDIMS,ns,ns,ns), corners(nm,ns,ns,ns), & edges(nm,NDIMS,ns,ns,ns), corners(nm,ns,ns,ns), &
@ -3020,16 +3036,16 @@ module io
! !
! Arguments: ! Arguments:
! !
! path, name - the path and name where the data are written to; ! path, name - the path and name where the array should be written to;
! data - the array of bytes to be written; ! array - the array of bytes to be written;
! data_bytes - the size of the data in bytes; ! array_bytes - the size of the array in bytes;
! data_digest - the digest of the written data; ! array_digest - the digest of the input array;
! compressed_bytes - the size of the data in bytes; ! compressed_bytes - the size of the compressed array in bytes;
! compressed_digest - the digest of the written data; ! 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) compressed_bytes, compressed_digest)
use compression, only : get_compression, compress use compression, only : get_compression, compress
@ -3040,16 +3056,16 @@ module io
! input and output arguments ! input and output arguments
! !
character(len=*) , intent(in) :: path, name character(len=*) , intent(in) :: path, name
integer(kind=1), dimension(:), intent(in) :: data integer(kind=1), dimension(:), intent(in) :: array
integer(kind=8), optional , intent(out) :: data_bytes, compressed_bytes integer(kind=8), optional , intent(out) :: array_bytes, compressed_bytes
integer(kind=8), optional , intent(out) :: data_digest, compressed_digest integer(kind=8), optional , intent(out) :: array_digest, compressed_digest
! local variables ! local variables
! !
character(len=512) :: fname character(len=512) :: fname
integer :: lun = 123 integer :: lun = 123
logical :: written logical :: written
integer :: l, status integer :: l, reclen, status
! compression buffer ! compression buffer
! !
@ -3059,19 +3075,20 @@ module io
! !
status = 0 status = 0
written = .false. written = .false.
data_bytes = size(data) array_bytes = size(array, kind=8)
if (present(data_digest)) data_digest = xxh64(data) if (present(array_digest)) array_digest = xxh64(array)
write(fname,"(a,'/',a)") trim(path), trim(name) 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 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 if (status == 0) then
call compress(data, buffer, compressed_bytes) call compress(array, buffer, compressed_bytes)
if (compressed_bytes > 0) then if (compressed_bytes > 0) then
inquire(iolength = reclen) buffer(1:compressed_bytes)
open(newunit = lun, file = fname, form = 'unformatted', & open(newunit = lun, file = fname, form = 'unformatted', &
access = 'direct', recl = compressed_bytes, & access = 'direct', recl = reclen, &
status = 'replace') status = 'replace')
write(lun, rec = 1) buffer(1:compressed_bytes) write(lun, rec = 1) buffer(1:compressed_bytes)
close(lun) close(lun)
@ -3083,14 +3100,15 @@ module io
end if end if
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 if (.not. written) then
l = index(fname, '.bin') + 3 l = index(fname, '.bin') + 3
inquire(iolength = reclen) array
open(newunit = lun, file = fname(:l), form = 'unformatted', & open(newunit = lun, file = fname(:l), form = 'unformatted', &
access = 'direct', recl = data_bytes, & access = 'direct', recl = reclen, &
status = 'replace') status = 'replace')
write(lun, rec = 1) data write(lun, rec = 1) array
close(lun) close(lun)
end if end if