!!******************************************************************************
!!
!!  This file is part of the AMUN source code, a program to perform
!!  Newtonian or relativistic magnetohydrodynamical simulations on uniform or
!!  adaptive mesh.
!!
!!  Copyright (C) 2020-2023 Grzegorz Kowal <grzegorz@amuncode.org>
!!
!!  This program is free software: you can redistribute it and/or modify
!!  it under the terms of the GNU General Public License as published by
!!  the Free Software Foundation, either version 3 of the License, or
!!  (at your option) any later version.
!!
!!  This program is distributed in the hope that it will be useful,
!!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!!  GNU General Public License for more details.
!!
!!  You should have received a copy of the GNU General Public License
!!  along with this program.  If not, see <http://www.gnu.org/licenses/>.
!!
!!******************************************************************************
!!
!! module: COMPRESSION
!!
!!  This module provides compression for the XML-binary format.
!!
!!******************************************************************************
!
module compression

  use iso_c_binding
  use iso_fortran_env

  implicit none

! interfaces to compression algorithms
!
#ifdef ZSTD
  interface

    integer(c_size_t) function zstd_bound(srcSize) &
                               bind(C, name="ZSTD_compressBound")
      use iso_c_binding, only: c_size_t
      implicit none
      integer(c_size_t), value :: srcSize
    end function zstd_bound

    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
      type(c_ptr)      , value :: src, dst
      integer(c_size_t), value :: srcSize, dstCapacity
      integer(c_int)   , value :: level
    end function zstd_compress

    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
      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(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(c_size_t), value :: srcSize
      type(c_ptr)      , value :: preferencesPtr
    end function lz4_bound

    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(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_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_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_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_unkn      = -1
    enumerator :: encoder_none      =  0
    enumerator :: encoder_shuffle
    enumerator :: encoder_bytedelta
  end enum

  private

  public :: check_compressor, is_compressor_on
  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

!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
  contains
!
!===============================================================================
!!
!!***  PUBLIC SUBROUTINES  ****************************************************
!!
!===============================================================================
!
!===============================================================================
!
! subroutine CHECK_COMPRESSOR:
! ---------------------------
!
!   Subroutine sets the compressor ID and the compression level based on
!   the compressor name.
!
!   Arguments:
!
!     compressor_name   - the compressor name;
!     compressor_id     - the compressor ID;
!     compression_level - the compression level;
!
!===============================================================================
!
  subroutine check_compressor(compressor_name, compressor_id, &
                                               compression_level)

    implicit none

    character(len=*) , intent(in   ) :: compressor_name
    integer          , intent(  out) :: compressor_id
    integer          , intent(inout) :: compression_level

!-------------------------------------------------------------------------------
!
    select case(trim(adjustl(compressor_name)))
#ifdef ZSTD
    case("zstd", "ZSTD", "zst", "ZST", "zstandard", "Zstandard")
      compressor_id = compressor_zstd
      if (compression_level < -19 .or. &
          compression_level >  19) compression_level = 3
#endif /* ZSTD */
#ifdef LZ4
    case("lz4", "LZ4", "lz4hc", "LZ4HC")
      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")
      compressor_id = compressor_lzma
      if (compression_level <   0 .or. &
          compression_level >   9) compression_level = 6
#endif /* LZMA */
    case default
      compressor_id = compressor_none
    end select

!-------------------------------------------------------------------------------
!
  end subroutine check_compressor
!
!===============================================================================
!
! function IS_COMPRESSOR_ON:
! -------------------------
!
!   The function determines if any compression is used.
!
!   Arguments:
!
!     compressor_id - the compressor ID;
!
!===============================================================================
!
  logical function is_compressor_on(compressor_id)

    implicit none

    integer, intent(in) :: compressor_id

!-------------------------------------------------------------------------------
!
    is_compressor_on = compressor_id /= compressor_none
    return

!-------------------------------------------------------------------------------
!
  end function is_compressor_on
!
!===============================================================================
!
! 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:
! ----------------------------
!
!   Function returns the name of the compressor.
!
!   Arguments:
!
!     compressor_id - the compressor ID;
!
!===============================================================================
!
  character(len=4) function get_compressor_name(compressor_id)

    implicit none

    integer, intent(in) :: compressor_id

!-------------------------------------------------------------------------------
!
    select case(compressor_id)
    case(compressor_zstd)
      get_compressor_name = 'zstd'
    case(compressor_lz4)
      get_compressor_name = 'lz4'
    case(compressor_lzma)
      get_compressor_name = 'lzma'
    case default
      get_compressor_name = 'none'
    end select
    return

!-------------------------------------------------------------------------------
!
  end function get_compressor_name
!
!===============================================================================
!
! function GET_COMPRESSED_FILE_SUFFIX:
! -----------------------------------
!
!   Function returns the filename suffix for the compressor.
!
!   Arguments:
!
!     compressor_id - the compressor ID;
!
!===============================================================================
!
  character(len=4) function get_compressed_file_suffix(compressor_id)

    implicit none

    integer, intent(in) :: compressor_id

!-------------------------------------------------------------------------------
!
    select case(compressor_id)
    case(compressor_zstd)
      get_compressed_file_suffix = '.zst'
    case(compressor_lz4)
      get_compressed_file_suffix = '.lz4'
    case(compressor_lzma)
      get_compressed_file_suffix = '.xz'
    case default
      get_compressed_file_suffix = ''
    end select
    return

!-------------------------------------------------------------------------------
!
  end function get_compressed_file_suffix
!
!===============================================================================
!
! function COMPRESSION_BOUND:
! --------------------------
!
!   Function returns the minimum size of the buffer required to compress data.
!
!   Arguments:
!
!     compressor_id      - the compressor ID;
!     level              - the compression level;
!     uncompressed_bytes - the length of the uncompressed sequence of bytes;
!
!===============================================================================
!
  integer(c_size_t) function compression_bound(compressor_id, level, &
                                               uncompressed_bytes)

    implicit none

    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(uncompressed_bytes)
#endif /* ZSTD */
#ifdef LZ4
    case(compressor_lz4)
      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 = uncompressed_bytes
    end select

    return

!-------------------------------------------------------------------------------
!
  end function compression_bound
!
!===============================================================================
!
! subroutine COMPRESS:
! -------------------
!
!   Subroutine compresses the input buffer.
!
!   Arguments:
!
!     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, level, input, ilen, buffer, clen)

    implicit none

    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

    integer(c_size_t), target :: bytes
    integer(c_int)            :: ret

!-------------------------------------------------------------------------------
!
    select case(compressor_id)
#ifdef ZSTD
    case(compressor_zstd)
      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%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)
      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
        write(error_unit,"(a,i0,a)") "LZMA: Unknown error (", ret, ")."
        clen = 0_8
      end if
#endif /* LZMA */
    case default
      clen = 0_8
    end select

!-------------------------------------------------------------------------------
!
  end subroutine compress
!
!===============================================================================
!
! 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:
! ------------------------
!
!   Subroutine sets the encoder ID based on the encoder name.
!
!   Arguments:
!
!     encoder_name   - the data encoder name;
!     encoder_id     - the data encoder id;
!
!===============================================================================
!
  subroutine check_encoder(encoder_name, encoder_id)

    implicit none

    character(len=*) , intent(in   ) :: encoder_name
    integer          , intent(  out) :: encoder_id

!-------------------------------------------------------------------------------
!
    select case(trim(adjustl(encoder_name)))
    case('shuffle', 'SHUFFLE')
      encoder_id = encoder_shuffle
    case('bytedelta', 'BYTEDELTA')
      encoder_id = encoder_bytedelta
    case default
      encoder_id = encoder_none
    end select

!-------------------------------------------------------------------------------
!
  end subroutine check_encoder
!
!===============================================================================
!
! 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:
! -------------------------
!
!   Function returns the name of the data encoder.
!
!   Arguments:
!
!     encoder_id - the data encoder ID;
!
!===============================================================================
!
  character(len=16) function get_encoder_name(encoder_id)

    implicit none

    integer, intent(in) :: encoder_id

!-------------------------------------------------------------------------------
!
    select case(encoder_id)
    case(encoder_shuffle)
      get_encoder_name = 'shuffle'
    case(encoder_bytedelta)
      get_encoder_name = 'bytedelta'
    case default
      get_encoder_name = 'none'
    end select
    return

!-------------------------------------------------------------------------------
!
  end function get_encoder_name
!
!===============================================================================
!
! function IS_ENCODER_ON:
! ----------------------
!
!   The function determines if any data encoding is used.
!
!   Arguments:
!
!     encoder_id - the data encoder ID;
!
!===============================================================================
!
  logical function is_encoder_on(encoder_id)

    implicit none

    integer, intent(in) :: encoder_id

!-------------------------------------------------------------------------------
!
    is_encoder_on = encoder_id /= encoder_none
    return

!-------------------------------------------------------------------------------
!
  end function is_encoder_on
!
!===============================================================================
!
! subroutine ENCODE:
! -----------------
!
!   Subroutine encodes the input buffer for better data compression.
!
!   Arguments:
!
!     encoder_id - the data encoder ID;
!     item_size  - the size of each item in bytes;
!     bytes      - the length of the input data;
!     input_ptr  - the pointer to the input data;
!     output     - the output where the encoded data are written;
!
!===============================================================================
!
  subroutine encode(encoder_id, item_size, bytes, input_ptr, output)

    use iso_c_binding, only : c_ptr, c_f_pointer

    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

    integer(kind=1), dimension(:), pointer :: input

    integer(kind=8) :: i, j, m, n, item_count

!-------------------------------------------------------------------------------
!
    call c_f_pointer(input_ptr, input, [ bytes ])

    select case(encoder_id)
    case(encoder_shuffle)
      item_count = bytes / item_size

      i = 1
      j = item_count
      do m = 1, item_size
        output(i:j) = input(m:bytes:item_size)

        i = j + 1
        j = j + item_count
      end do

    case(encoder_bytedelta)
      item_count = bytes / item_size

      i = 1
      j = item_count
      do m = 1, item_size
        output(i:j) = input(m:bytes:item_size)

        do n = j, i + 1, -1
          output(n) = output(n) - output(n-1)
        end do

        i = j + 1
        j = j + item_count
      end do

    case default
      output(:) = input(:)
    end select

!-------------------------------------------------------------------------------
!
  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

!===============================================================================
!
end module compression