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

Merge branch 'master' into flux-tubes

Browse Source
This commit is contained in:
Grzegorz Kowal 2023-08-14 17:32:01 -03:00
commit bb2d821df6
4 changed files with 2845 additions and 1062 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
build/mkdeps.sh
View File

@ -14,7 +14,7 @@
#
files=`ls $1/*.F90`
for src in $files; do
deps=`awk '/^\s*[Uu][Ss][Ee] / {gsub ( "[:,]","" ) ; print $2}' $src | sort | uniq`
deps=`awk '/^\s*[Uu][Ss][Ee] / {gsub ( "[:,]","" ) ; print tolower($2)}' $src | sort | uniq`
fname=`basename $src .F90`
output="$2/${fname}.o: $src"
for dep in $deps; do

663
sources/compression.F90
View File

@ -29,6 +29,9 @@
!
module compression
use iso_c_binding
use iso_fortran_env
implicit none
! interfaces to compression algorithms
@ -40,95 +43,196 @@ module compression
bind(C, name="ZSTD_compressBound")
use iso_c_binding, only: c_size_t
implicit none
integer(kind=c_size_t), value :: srcSize
integer(c_size_t), value :: srcSize
end function zstd_bound
integer(c_size_t) function zstd_compress(dst, dstCapacity, &
integer(c_int) function zstd_iserror(code) &
bind(C, name="ZSTD_isError")
use iso_c_binding, only: c_int, c_size_t
implicit none
integer(c_size_t), value :: code
end function zstd_iserror
integer(c_size_t) function zstd_compress(dst, dstCapacity, &
src, srcSize, level) &
bind(C, name="ZSTD_compress")
use iso_c_binding, only: c_size_t, c_int, c_ptr
implicit none
integer(kind=c_size_t), value :: srcSize, dstCapacity
type(c_ptr) , value :: src, dst
integer(kind=c_int) , value :: level
type(c_ptr) , value :: src, dst
integer(c_size_t), value :: srcSize, dstCapacity
integer(c_int) , value :: level
end function zstd_compress
integer(kind=c_int) function zstd_iserror(code) bind(C, name="ZSTD_isError")
use iso_c_binding, only: c_int, c_size_t
integer(c_size_t) function zstd_decompress(dst, dstCapacity, &
src, compressedSize) &
bind(C, name="ZSTD_decompress")
use iso_c_binding, only: c_size_t, c_int, c_ptr
implicit none
integer(kind=c_size_t), value :: code
end function zstd_iserror
type(c_ptr) , value :: src, dst
integer(c_size_t), value :: dstCapacity, compressedSize
end function zstd_decompress
end interface
#endif /* ZSTD */
#ifdef LZ4
interface
integer(kind=c_size_t) function lz4_bound(srcSize, prefsPtr) &
bind(C, name="LZ4F_compressFrameBound")
integer(c_size_t) function lz4_bound(srcSize, preferencesPtr) &
bind(C, name="LZ4F_compressFrameBound")
use iso_c_binding, only: c_size_t, c_ptr
implicit none
integer(kind=c_size_t), value :: srcSize
type(c_ptr) , value :: prefsPtr
integer(c_size_t), value :: srcSize
type(c_ptr) , value :: preferencesPtr
end function lz4_bound
integer(kind=c_size_t) function lz4_compress(dst, dstCapacity, &
src, srcSize, prefsPtr) &
bind(C, name="LZ4F_compressFrame")
use iso_c_binding, only: c_size_t, c_ptr
implicit none
integer(kind=c_size_t), value :: dstCapacity, srcSize
type(c_ptr) , value :: src, dst, prefsPtr
end function lz4_compress
integer(kind=c_int) function lz4_iserror(code) bind(C, name="LZ4F_isError")
integer(c_int) function lz4_iserror(code) &
bind(C, name="LZ4F_isError")
use iso_c_binding, only: c_int, c_size_t
implicit none
integer(kind=c_size_t), value :: code
integer(c_size_t), value :: code
end function lz4_iserror
integer(c_size_t) function lz4_createDecompressionCtx(dctxPtr, version) &
bind(C, name="LZ4F_createDecompressionContext")
use iso_c_binding, only: c_size_t, c_int, c_ptr
type(c_ptr) , value :: dctxPtr
integer(c_int), value :: version
end function lz4_createDecompressionCtx
integer(c_size_t) function lz4_freeDecompressionCtx(dctxPtr) &
bind(C, name="LZ4F_freeDecompressionContext")
use iso_c_binding, only: c_size_t, c_ptr
type(c_ptr) , value :: dctxPtr
end function lz4_freeDecompressionCtx
integer(c_size_t) function lz4_compress(dstBuffer, dstCapacity, &
srcBuffer, srcSize, &
preferencesPtr) &
bind(C, name="LZ4F_compressFrame")
use iso_c_binding, only: c_size_t, c_ptr
implicit none
integer(c_size_t), value :: dstCapacity, srcSize
type(c_ptr) , value :: dstBuffer, srcBuffer
type(c_ptr) , value :: preferencesPtr
end function lz4_compress
integer(c_size_t) function lz4_decompress(dctxPtr, dst, dstSizePtr, &
src, srcSizePtr, dOptPtr) &
bind(C, name="LZ4F_decompress")
use iso_c_binding, only: c_size_t, c_ptr
implicit none
type(c_ptr), value :: dctxPtr, dst, dstSizePtr, src, srcSizePtr, dOptPtr
end function lz4_decompress
end interface
#endif /* LZ4 */
#ifdef LZMA
interface
integer(c_int) function lzma_compress(preset, check, allocator, &
src, srcSize, &
dst, dstPos, dstCapacity) &
bind(C, name="lzma_easy_buffer_encode")
use iso_c_binding, only: c_int, c_size_t, c_ptr
integer(c_size_t) function lzma_bound(uncompressed_size) &
bind(C, name="lzma_stream_buffer_bound")
use iso_c_binding, only : c_size_t
implicit none
integer(c_int) , value :: preset, check
integer(kind=c_size_t), value :: srcSize, dstCapacity
type(c_ptr) , value :: allocator, src, dst, dstPos
integer(c_size_t), value :: uncompressed_size
end function lzma_bound
integer(c_int) function lzma_compress(preset, check, allocator, &
in, in_size, out, out_pos, out_size) &
bind(C, name="lzma_easy_buffer_encode")
use iso_c_binding, only: c_int, c_int32_t, c_size_t, c_ptr
implicit none
type(c_ptr) , value :: allocator, in, out, out_pos
integer(c_int32_t), value :: preset
integer(c_int) , value :: check
integer(c_size_t) , value :: in_size, out_size
end function lzma_compress
integer(c_int) function lzma_decompress(memlimit, flags, allocator, &
input, inputpos, inputsize, &
output, outputpos, outputsize) &
bind(C, name="lzma_stream_buffer_decode")
use iso_c_binding, only: c_int, c_int32_t, c_size_t, c_ptr
implicit none
type(c_ptr) , value :: memlimit, allocator
type(c_ptr) , value :: input, output, inputpos, outputpos
integer(c_int32_t), value :: flags
integer(c_size_t) , value :: inputsize, outputsize
end function lzma_decompress
end interface
#endif /* LZMA */
#ifdef LZ4
type LZ4F_frameInfo_t
integer(c_int) :: blockSizeID, blockMode, contentChecksumFlag, frameType
integer(c_size_t) :: contentSize
integer(c_int) :: dictID, blockChecksumFlag
end type
type LZ4F_preferences_t
type(LZ4F_frameInfo_t) :: frameInfo
integer(c_int) :: compressionLevel, autoFlush, favorDecSpeed, reserved(3)
end type
type LZ4F_decompressOptions_t
integer(c_int) :: stableDst, skipChecksums, reserved(2)
end type
#endif /* LZ4 */
#ifdef LZMA
enum, bind(c)
enumerator :: LZMA_OK = 0
enumerator :: LZMA_STREAM_END
enumerator :: LZMA_NO_CHECK
enumerator :: LZMA_UNSUPPORTED_CHECK
enumerator :: LZMA_GET_CHECK
enumerator :: LZMA_MEM_ERROR
enumerator :: LZMA_MEMLIMIT_ERROR
enumerator :: LZMA_FORMAT_ERROR
enumerator :: LZMA_OPTIONS_ERROR
enumerator :: LZMA_DATA_ERROR
enumerator :: LZMA_BUF_ERROR
enumerator :: LZMA_PROG_ERROR
end enum
enum, bind(c)
enumerator :: LZMA_CHECK_NONE = 0
enumerator :: LZMA_CHECK_CRC32
enumerator :: LZMA_CHECK_CRC64 = 4
enumerator :: LZMA_CHECK_SHA256 = 10
end enum
#endif /* LZMA */
#ifdef LZ4
type(LZ4F_preferences_t), target :: prefs
#endif /* LZ4 */
! supported compressors
!
enum, bind(c)
enumerator compressor_none
enumerator compressor_zstd
enumerator compressor_lz4
enumerator compressor_lzma
enumerator :: compressor_unkn = -1
enumerator :: compressor_none = 0
enumerator :: compressor_zstd
enumerator :: compressor_lz4
enumerator :: compressor_lzma
end enum
! supported data encoders
!
enum, bind(c)
enumerator encoder_none
enumerator encoder_shuffle
enumerator encoder_bytedelta
enumerator :: encoder_unkn = -1
enumerator :: encoder_none = 0
enumerator :: encoder_shuffle
enumerator :: encoder_bytedelta
end enum
private
public :: check_compressor, is_compressor_on
public :: get_compressor_name, get_compressed_file_suffix
public :: compression_bound, compress
public :: check_encoder, is_encoder_on, get_encoder_name, encode
public :: get_compressor_id, get_compressor_name, get_compressed_file_suffix
public :: compression_bound, compress, decompress
public :: check_encoder, is_encoder_on
public :: get_encoder_id, get_encoder_name, encode, decode
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
@ -179,6 +283,19 @@ module compression
compressor_id = compressor_lz4
if (compression_level < -12 .or. &
compression_level > 12) compression_level = 0
prefs%frameInfo%blockSizeID = 0
prefs%frameInfo%blockMode = 0
prefs%frameInfo%contentChecksumFlag = 1
prefs%frameInfo%frameType = 0
prefs%frameInfo%contentSize = 0
prefs%frameInfo%dictID = 0
prefs%frameInfo%blockChecksumFlag = 0
prefs%compressionLevel = compression_level
prefs%autoFlush = 1
prefs%favorDecSpeed = 1
prefs%reserved = 0
#endif /* LZ4 */
#ifdef LZMA
case("lzma", "LZMA", "xz", "XZ")
@ -224,6 +341,58 @@ module compression
!
!===============================================================================
!
! function GET_COMPRESSOR_ID:
! --------------------------
!
! Function returns the compressor ID based on its name.
!
! Arguments:
!
! compressor - the compressor name;
!
!===============================================================================
!
integer function get_compressor_id(compressor) result(compressor_id)
use helpers, only : print_message
implicit none
character(len=*), intent(in) :: compressor
character(len=*), parameter :: loc = "COMPRESSION::get_compressor_id()"
!-------------------------------------------------------------------------------
!
select case(trim(adjustl(compressor)))
#ifdef ZSTD
case("zstd", "ZSTD", "zst", "ZST", "zstandard", "Zstandard")
compressor_id = compressor_zstd
#endif /* ZSTD */
#ifdef LZ4
case("lz4", "LZ4", "lz4hc", "LZ4HC")
compressor_id = compressor_lz4
#endif /* LZ4 */
#ifdef LZMA
case("lzma", "LZMA", "xz", "XZ")
compressor_id = compressor_lzma
#endif /* LZMA */
case("none")
compressor_id = compressor_none
case default
compressor_id = compressor_unkn
call print_message(loc, "Unsupported compressor '" // &
trim(compressor) // "'.")
end select
return
!-------------------------------------------------------------------------------
!
end function get_compressor_id
!
!===============================================================================
!
! function GET_COMPRESSOR_NAME:
! ----------------------------
!
@ -301,47 +470,44 @@ module compression
! function COMPRESSION_BOUND:
! --------------------------
!
! Function returns the minimum buffer size required to perform
! the compression.
! Function returns the minimum size of the buffer required to compress data.
!
! Arguments:
!
! compressor_id - the compressor ID;
! compression_level - the compression level;
! ilen - the length of the sequence of bytes to compress;
! compressor_id - the compressor ID;
! level - the compression level;
! uncompressed_bytes - the length of the uncompressed sequence of bytes;
!
!===============================================================================
!
integer(kind=8) function compression_bound(compressor_id, &
compression_level, ilen)
use iso_c_binding, only: c_loc
integer(c_size_t) function compression_bound(compressor_id, level, &
uncompressed_bytes)
implicit none
integer , intent(in) :: compressor_id, compression_level
integer(kind=8), intent(in) :: ilen
#ifdef LZ4
integer, dimension(14), target :: prefs = [5, 0, 1, 0, 0, 0, 0, 0, &
0, 0, 0, 0, 0, 0]
#endif /* LZ4 */
integer , intent(in) :: compressor_id, level
integer(c_size_t), intent(in) :: uncompressed_bytes
!-------------------------------------------------------------------------------
!
select case(compressor_id)
#ifdef ZSTD
case(compressor_zstd)
compression_bound = zstd_bound(ilen)
compression_bound = zstd_bound(uncompressed_bytes)
#endif /* ZSTD */
#ifdef LZ4
case(compressor_lz4)
prefs(5:6) = transfer(ilen, [ 0_4 ])
prefs(9) = compression_level
compression_bound = lz4_bound(ilen, c_loc(prefs))
prefs%frameInfo%contentSize = uncompressed_bytes
prefs%compressionLevel = level
compression_bound = lz4_bound(uncompressed_bytes, c_loc(prefs))
#endif /* LZ4 */
#ifdef LZMA
case(compressor_lzma)
compression_bound = lzma_bound(uncompressed_bytes)
#endif /* LZMA */
case default
compression_bound = ilen
compression_bound = uncompressed_bytes
end select
return
@ -359,70 +525,89 @@ module compression
!
! Arguments:
!
! compressor_id - the compressor ID;
! compression_level - the compression level;
! input - the pointer to the input sequence of bytes;
! ilen - the length of input;
! buffer - the buffer where the compression is done;
! clen - the length of buffer in bytes; once the compression
! was successful, it returns the length of
! the compressed stream;
! compressor_id - the compressor ID;
! level - the compression level;
! input - the pointer to the input sequence of bytes;
! ilen - the length of input;
! buffer - the buffer where the compression is done;
! clen - the length of buffer in bytes; once the compression was
! successful, it returns the length of the compressed stream;
!
!===============================================================================
!
subroutine compress(compressor_id, compression_level, &
input, ilen, buffer, clen)
use iso_c_binding, only : c_int, c_loc, c_ptr
#ifdef LZ4
use iso_c_binding, only : c_null_ptr
#endif /* LZ4 */
subroutine compress(compressor_id, level, input, ilen, buffer, clen)
implicit none
integer , intent(in) :: compressor_id, compression_level
integer , intent(in) :: compressor_id, level
type(c_ptr) , intent(in) :: input
integer(kind=8), intent(in) :: ilen
type(c_ptr) , intent(inout) :: buffer
integer(kind=8), intent(inout) :: clen
#ifdef LZ4
integer, dimension(14), target :: prefs = [5, 0, 1, 0, 0, 0, 0, 0, &
0, 0, 0, 0, 0, 0]
#endif /* LZ4 */
#ifdef LZMA
integer(kind=8), target :: lsize
integer :: ret
#endif /* LZMA */
integer(c_size_t), target :: bytes
integer(c_int) :: ret
!-------------------------------------------------------------------------------
!
select case(compressor_id)
#ifdef ZSTD
case(compressor_zstd)
clen = zstd_compress(buffer, clen, input, ilen, compression_level)
if (zstd_iserror(clen) /= 0) clen = 0
bytes = zstd_compress(buffer, clen, input, ilen, level)
ret = zstd_iserror(bytes)
if (ret == 0) then
clen = bytes
else
write(error_unit,"(a,i0,a)") "ZSTD: Unknown error (", ret, ")."
clen = 0_8
end if
#endif /* ZSTD */
#ifdef LZ4
case(compressor_lz4)
prefs(5:6) = transfer(ilen, [ 0_4 ])
prefs(9) = compression_level
clen = lz4_compress(buffer, clen, input, ilen, c_loc(prefs))
if (lz4_iserror(clen) /= 0) clen = 0
prefs%frameInfo%contentSize = ilen
prefs%compressionLevel = level
bytes = lz4_compress(buffer, clen, input, ilen, c_loc(prefs))
ret = lz4_iserror(bytes)
if (ret == 0) then
clen = bytes
else
write(error_unit,"(a,i0,a)") "LZ4: Unknown error (", ret, ")."
clen = 0_8
end if
#endif /* LZ4 */
#ifdef LZMA
case(compressor_lzma)
lsize = 0
ret = lzma_compress(compression_level, 4, c_null_ptr, &
input, ilen, buffer, c_loc(lsize), clen)
if (ret > 0) then
clen = 0
bytes = 0_8
ret = lzma_compress(level, LZMA_CHECK_CRC64, c_null_ptr, &
input, ilen, buffer, c_loc(bytes), clen)
if (ret == LZMA_OK) then
clen = bytes
else if (ret == LZMA_UNSUPPORTED_CHECK) then
write(error_unit,"(a)") "LZMA: Cannot calculate the integrity check."
clen = 0_8
else if (ret == LZMA_MEM_ERROR) then
write(error_unit,"(a)") "LZMA: Cannot allocate memory."
clen = 0_8
else if (ret == LZMA_OPTIONS_ERROR) then
write(error_unit,"(a)") "LZMA: Invalid or unsupported options."
clen = 0_8
else if (ret == LZMA_DATA_ERROR) then
write(error_unit,"(a)") "LZMA: Data is corrupt."
clen = 0_8
else if (ret == LZMA_BUF_ERROR) then
write(error_unit,"(a)") "LZMA: Not enough output buffer space."
clen = 0_8
else if (ret == LZMA_PROG_ERROR) then
write(error_unit,"(a)") "LZMA: Programming error."
clen = 0_8
else
clen = lsize
write(error_unit,"(a,i0,a)") "LZMA: Unknown error (", ret, ")."
clen = 0_8
end if
#endif /* LZMA */
case default
clen = 0
clen = 0_8
end select
!-------------------------------------------------------------------------------
@ -431,6 +616,154 @@ module compression
!
!===============================================================================
!
! subroutine DECOMPRESS:
! ---------------------
!
! This subroutine is responsible for decompressing the input buffer using
! the specified compression method.
!
! Arguments:
!
! compressor_id - an identifier for the compression algorithm to be used;
! input_ptr - a pointer to the start of the input compressed
! byte sequence.
! input_bytes - the length of the input compressed sequence;
! output_ptr - the destination where the decompressed data
! will be written;
! output_bytes - the length of the output buffer in bytes;
! status - a flag indicating the status of the subroutine;
!
!===============================================================================
!
subroutine decompress(compressor_id, input_ptr, input_bytes, &
output_ptr, output_bytes, status)
use helpers, only : print_message
implicit none
integer , intent(in ) :: compressor_id
type(c_ptr) , intent(in ) :: input_ptr
integer(kind=8), intent(in ) :: input_bytes
type(c_ptr) , intent(in ) :: output_ptr
integer(kind=8), intent(in ) :: output_bytes
integer , intent( out) :: status
character(len=*) , parameter :: loc = "COMPRESSION::decompress()"
#ifdef LZMA
integer(c_size_t), parameter :: MiB = 1048576
#endif /* LZMA */
integer(c_size_t) , target :: dbytes
#if defined LZ4 || defined LZMA
integer(c_size_t) , target :: ibytes
#endif /* LZ4 || LZMA */
#ifdef LZ4
type(LZ4F_decompressOptions_t), target :: dOpt
type(c_ptr) , target :: dctxPtr
integer(c_size_t) , target :: res
#endif /* LZ4 */
#ifdef LZMA
integer(c_size_t) , target :: memlim
integer(c_int) :: ret
#endif /* LZMA */
!-------------------------------------------------------------------------------
!
status = 0
select case(compressor_id)
#ifdef ZSTD
case(compressor_zstd)
dbytes = zstd_decompress(output_ptr, output_bytes, input_ptr, input_bytes)
if (zstd_iserror(dbytes) /= 0) then
call print_message(loc, "ZSTD decompression failure.")
status = -1
end if
#endif /* ZSTD */
#ifdef LZ4
case(compressor_lz4)
res = lz4_createDecompressionCtx(c_loc(dctxPtr), 100)
if (lz4_iserror(res) == 0) then
dOpt%stableDst = 0
dOpt%skipChecksums = 0
dOpt%reserved = 0
ibytes = input_bytes
dbytes = output_bytes
res = lz4_decompress(dctxPtr, output_ptr, c_loc(dbytes), &
input_ptr, c_loc(ibytes), c_loc(dOpt))
if (lz4_iserror(res) /= 0) then
call print_message(loc, "LZ4 decompression failure.")
status = -1
end if
res = lz4_freeDecompressionCtx(dctxPtr)
if (lz4_iserror(res) /= 0) &
call print_message(loc, "Unable to free LZ4 decompression context.")
else
call print_message(loc, "Unable to create LZ4 decompression context.")
status = -1
end if
#endif /* LZ4 */
#ifdef LZMA
case(compressor_lzma)
memlim = 16 * MiB
ibytes = 0
dbytes = 0
ret = lzma_decompress(c_loc(memlim), 0, c_null_ptr, &
input_ptr, c_loc(ibytes), input_bytes, &
output_ptr, c_loc(dbytes), output_bytes)
if (ret == LZMA_MEMLIMIT_ERROR) then
call print_message(loc, "LZMA memory usage limit was reached.")
write(error_unit,"(a,i0,a)") "The minimum memory limit increased to ", &
memlim / MiB, " MiB."
ibytes = 0
dbytes = 0
ret = lzma_decompress(c_loc(memlim), 0, c_null_ptr, &
input_ptr, c_loc(ibytes), input_bytes, &
output_ptr, c_loc(dbytes), output_bytes)
end if
if (ret /= LZMA_OK) then
select case(ret)
case(LZMA_NO_CHECK)
call print_message(loc, "LZMA input stream has no integrity check.")
case(LZMA_UNSUPPORTED_CHECK)
call print_message(loc, "LZMA cannot calculate the integrity check.")
case(LZMA_MEM_ERROR)
call print_message(loc, "LZMA cannot allocate memory.")
case(LZMA_MEMLIMIT_ERROR)
call print_message(loc, "LZMA memory usage limit was reached.")
case(LZMA_FORMAT_ERROR)
call print_message(loc, "LZMA file format not recognized.")
case(LZMA_OPTIONS_ERROR)
call print_message(loc, "Invalid or unsupported LZMA options.")
case(LZMA_DATA_ERROR)
call print_message(loc, "LZMA data is corrupt.")
case(LZMA_BUF_ERROR)
call print_message(loc, "LZMA output buffer was too small.")
case(LZMA_PROG_ERROR)
call print_message(loc, "LZMA programming error.")
case default
call print_message(loc, "Unknown LZMA error.")
end select
status = -1
end if
#endif /* LZMA */
case default
call print_message(loc, "Unsupported decompression format.")
status = -1
end select
!-------------------------------------------------------------------------------
!
end subroutine decompress
!
!===============================================================================
!
! subroutine CHECK_ENCODER:
! ------------------------
!
@ -467,6 +800,49 @@ module compression
!
!===============================================================================
!
! function GET_ENCODER_ID:
! -----------------------
!
! Function returns the encoder ID.
!
! Arguments:
!
! encoder - the encoder name;
!
!===============================================================================
!
integer function get_encoder_id(encoder) result(encoder_id)
use helpers, only : print_message
implicit none
character(len=*), intent(in) :: encoder
character(len=*), parameter :: loc = "COMPRESSION::get_encoder_id()"
!-------------------------------------------------------------------------------
!
select case(trim(adjustl(encoder)))
case('shuffle', 'SHUFFLE')
encoder_id = encoder_shuffle
case('bytedelta', 'BYTEDELTA')
encoder_id = encoder_bytedelta
case("none")
encoder_id = encoder_none
case default
encoder_id = encoder_unkn
call print_message(loc, "Unsupported encoder '" // trim(encoder) // "'.")
end select
return
!-------------------------------------------------------------------------------
!
end function get_encoder_id
!
!===============================================================================
!
! function GET_ENCODER_NAME:
! -------------------------
!
@ -601,6 +977,93 @@ module compression
!-------------------------------------------------------------------------------
!
end subroutine encode
!
!===============================================================================
!
! subroutine DECODE:
! -----------------
!
! This subroutine is responsible for decoding the input buffer using
! the specified data encoder.
!
! Arguments:
!
! encoder_id - an identifier for the data encoder to be used;
! item_size - the size of an individual data item in bytes;
! bytes - the total size of the input data in bytes;
! input_ptr - a pointer to the start of the input data;
! output - the destination where the decoded data will be written;
!
!===============================================================================
!
subroutine decode(encoder_id, item_size, bytes, input_ptr, output)
use helpers, only : print_message
implicit none
integer , intent(in ) :: encoder_id
integer(kind=4) , intent(in ) :: item_size
integer(kind=8) , intent(in ) :: bytes
type(c_ptr) , intent(in ) :: input_ptr
integer(kind=1), dimension(bytes), intent(inout) :: output
character(len=*), parameter :: loc = "COMPRESSION::decode()"
integer(kind=1), dimension(:), pointer :: input
integer(kind=1), dimension(:), allocatable :: buffer
integer(kind=8) :: i, j, m, n, item_count
!-------------------------------------------------------------------------------
!
call c_f_pointer(input_ptr, input, [ bytes ])
select case(encoder_id)
case(encoder_none)
output(:) = input(:)
case(encoder_shuffle)
item_count = bytes / item_size
i = 1
j = item_count
do m = 1, item_size
output(m:bytes:item_size) = input(i:j)
i = j + 1
j = j + item_count
end do
case(encoder_bytedelta)
item_count = bytes / item_size
allocate(buffer(bytes))
i = 1
j = item_count
do m = 1, item_size
buffer(i) = input(i)
do n = i + 1, j
buffer(n) = input(n) + buffer(n-1)
end do
output(m:bytes:item_size) = buffer(i:j)
i = j + 1
j = j + item_count
end do
deallocate(buffer)
case default
call print_message(loc, "Unsupported encoder.")
end select
!-------------------------------------------------------------------------------
!
end subroutine decode
!===============================================================================
!

1696
sources/io.F90
View File

File diff suppressed because it is too large Load Diff

1546
sources/xml.F90 Normal file
View File

File diff suppressed because it is too large Load Diff