190 lines
5.6 KiB
Fortran
190 lines
5.6 KiB
Fortran
!!******************************************************************************
|
|
!!
|
|
!! 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 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, only: c_int, c_loc
|
|
|
|
! module variables are not implicit by default
|
|
!
|
|
implicit none
|
|
|
|
! interfaces to compression algorithms
|
|
!
|
|
#ifdef ZSTD
|
|
interface
|
|
integer(c_int) function zstd_compress(obuf, osize, ibuf, isize, lev) &
|
|
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 :: osize, isize
|
|
type(c_ptr), value :: obuf, ibuf
|
|
integer(kind=c_int), value :: lev
|
|
end function zstd_compress
|
|
end interface
|
|
#endif /* ZSTD */
|
|
|
|
! compression parameters
|
|
!
|
|
integer, save :: compression_format = 0
|
|
integer, save :: compression_level = 0
|
|
|
|
! supported compression formats
|
|
!
|
|
integer, parameter :: compression_none = 0, compression_zstd = 1
|
|
|
|
! by default everything is private
|
|
!
|
|
private
|
|
|
|
! declare public subroutines
|
|
!
|
|
public :: set_compression, get_compression, compress
|
|
|
|
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
!
|
|
contains
|
|
!
|
|
!===============================================================================
|
|
!!
|
|
!!*** PUBLIC SUBROUTINES ****************************************************
|
|
!!
|
|
!===============================================================================
|
|
!
|
|
!===============================================================================
|
|
!
|
|
! subroutine SET_COMPRESSION:
|
|
! --------------------------
|
|
!
|
|
! Subroutine sets the compression format and level.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! cformat - the compression format string;
|
|
! clevel - the compression level;
|
|
! suffix - the compressed file suffix;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine set_compression(cformat, clevel, suffix)
|
|
|
|
implicit none
|
|
|
|
! subroutine arguments
|
|
!
|
|
character(len=*) , intent(in) :: cformat
|
|
integer , intent(in) :: clevel
|
|
character(len=8) , intent(out) :: suffix
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
select case(trim(adjustl(cformat)))
|
|
#ifdef ZSTD
|
|
case("zstd", "ZSTD", "zst", "ZST", "Zstandard")
|
|
compression_format = compression_zstd
|
|
compression_level = max(0, min(19, clevel))
|
|
suffix = ".zst"
|
|
#endif /* ZSTD */
|
|
case default
|
|
compression_format = compression_none
|
|
compression_level = clevel
|
|
suffix = ""
|
|
end select
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine set_compression
|
|
!
|
|
!===============================================================================
|
|
!
|
|
! function GET_COMPRESSION:
|
|
! ------------------------
|
|
!
|
|
! Function returns the compression format index.
|
|
!
|
|
!
|
|
!===============================================================================
|
|
!
|
|
integer function get_compression()
|
|
|
|
implicit none
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
get_compression = compression_format
|
|
return
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end function get_compression
|
|
!
|
|
!===============================================================================
|
|
!
|
|
! subroutine COMPRESS:
|
|
! -------------------
|
|
!
|
|
! Subroutine compressed input buffer using ZSTD compression.
|
|
!
|
|
! Arguments:
|
|
!
|
|
! input - the input sequence of bytes;
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine compress(input, output, csize)
|
|
|
|
implicit none
|
|
|
|
! subroutine arguments
|
|
!
|
|
integer(kind=1), dimension(:), target, intent(in) :: input
|
|
integer(kind=1), dimension(:), target, intent(out) :: output
|
|
integer(kind=8) , intent(out) :: csize
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
csize = min(size(input), size(output))
|
|
select case(compression_format)
|
|
#ifdef ZSTD
|
|
case(compression_zstd)
|
|
csize = zstd_compress(c_loc(output), sizeof(output), &
|
|
c_loc(input), sizeof(input), compression_level)
|
|
#endif /* ZSTD */
|
|
case default
|
|
output(1:csize) = input(1:csize)
|
|
end select
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine compress
|
|
|
|
!===============================================================================
|
|
!
|
|
end module compression
|