170 lines
4.8 KiB
Fortran
170 lines
4.8 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
|
||
|
|
||
|
! module variables are not implicit by default
|
||
|
!
|
||
|
implicit none
|
||
|
|
||
|
! compression parameters
|
||
|
!
|
||
|
integer, save :: compression_format = 0
|
||
|
integer, save :: compression_level = 0
|
||
|
|
||
|
! supported compression formats
|
||
|
!
|
||
|
integer, parameter :: compression_none = 0
|
||
|
|
||
|
! 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;
|
||
|
! success - returns the compression format set;
|
||
|
!
|
||
|
!===============================================================================
|
||
|
!
|
||
|
subroutine set_compression(cformat, clevel, suffix, success)
|
||
|
|
||
|
implicit none
|
||
|
|
||
|
! subroutine arguments
|
||
|
!
|
||
|
character(len=*) , intent(in) :: cformat
|
||
|
integer , intent(in) :: clevel
|
||
|
character(len=8) , intent(out) :: suffix
|
||
|
logical , intent(out) :: success
|
||
|
|
||
|
!-------------------------------------------------------------------------------
|
||
|
!
|
||
|
success = .false.
|
||
|
select case(trim(adjustl(cformat)))
|
||
|
case default
|
||
|
compression_format = compression_none
|
||
|
compression_level = 0
|
||
|
suffix = ""
|
||
|
success = .true.
|
||
|
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
|
||
|
|
||
|
! local variables
|
||
|
!
|
||
|
integer(kind=8) :: bsize
|
||
|
|
||
|
!-------------------------------------------------------------------------------
|
||
|
!
|
||
|
bsize = min(size(input), size(output))
|
||
|
select case(compression_format)
|
||
|
case default
|
||
|
output(1:bsize) = input(1:bsize)
|
||
|
end select
|
||
|
|
||
|
!-------------------------------------------------------------------------------
|
||
|
!
|
||
|
end subroutine compress
|
||
|
|
||
|
!===============================================================================
|
||
|
!
|
||
|
end module compression
|