!*================================================================================================*! !| |! !| /$$$$$$$ /$$ /$$ /$$ /$$ |! !| | $$__ $$|__/ | $$ /$ | $$| $$ |! !| | $$ \ $$ /$$ /$$$$$$ | $$ /$$$| $$| $$$$$$$ /$$$$$$ /$$$$$$ /$$$$$$ |! !| | $$$$$$$ | $$ /$$__ $$ | $$/$$ $$ $$| $$__ $$ /$$__ $$ /$$__ $$ /$$__ $$ |! !| | $$__ $$| $$| $$ \ $$ | $$$$_ $$$$| $$ \ $$| $$ \ $$| $$ \ $$| $$ \ $$ |! !| | $$ \ $$| $$| $$ | $$ | $$$/ \ $$$| $$ | $$| $$ | $$| $$ | $$| $$ | $$ |! !| | $$$$$$$/| $$| $$$$$$$ | $$/ \ $$| $$ | $$| $$$$$$/| $$$$$$/| $$$$$$$/ |! !| |_______/ |__/ \____ $$ |__/ \__/|__/ |__/ \______/ \______/ | $$____/ |! !| /$$ \ $$ | $$ |! !| | $$$$$$/ | $$ |! !| \______/ |__/ |! !| |! !| DESCRIPTION: |! !| ------------ |! !| |! !| This file defines a FORTRAN api for the Big Whoop compression library. |! !| |! !| -------------------------------------------------------------------------------------------- |! !| Copyright (c) 2023, High Performance Computing Center - University of Stuttgart |! !| |! !| Redistribution and use in source and binary forms, with or without modification, are |! !| permitted provided that the following conditions are met: |! !| |! !| (1) Redistributions of source code must retain the above copyright notice, this list of |! !| conditions and the following disclaimer. |! !| |! !| (2) Redistributions in binary form must reproduce the above copyright notice, this list |! !| of conditions and the following disclaimer in the documentation and/or other |! !| materials provided with the distribution. |! !| |! !| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS |! !| OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF |! !| MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE |! !| COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, |! !| EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF |! !| SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |! !| HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR |! !| TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, |! !| EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |! !| |! !*================================================================================================*! module bwc_module !************************************************************************************************! !| _ _ _ ____ _ _ _ ___ ____ |! !| | |\ | | | | | | \ |___ |! !| | | \| |___ |___ |__| |__/ |___ |! !| |! !************************************************************************************************! use, intrinsic :: iso_c_binding, only: C_PTR, C_INT64_T, C_INT16_T, C_INT8_T, C_INT, C_DOUBLE IMPLICIT NONE PRIVATE !************************************************************************************************! !| ____ ____ _ _ ____ ___ ____ _ _ ___ ____ |! !| | | | |\ | [__ | |__| |\ | | [__ |! !| |___ |__| | \| ___] | | | | \| | ___] |! !| |! !************************************************************************************************! ENUM, BIND(C) enumerator :: bwc_dwt_9_7 = 0, & ! Cohen Daubechies Feauveau 9/7 Wavelet bwc_dwt_5_3 = 1, & ! LeGall 5/3 Wavelet bwc_dwt_haar = 2 ! Haar Wavelet END ENUM ENUM, BIND(C) enumerator :: bwc_prog_LRCP = 0 ! Layer / Resolution / Parameter / Packet END ENUM ENUM, BIND(C) enumerator :: bwc_qt_none = 0, & ! No quantization bwc_qt_derived = 1 ! Derived quantization acc. to JPEG2000 END ENUM ENUM, BIND(C) enumerator :: bwc_tile_sizeof = 0, & ! Tiling def. through dimension of a tile bwc_tile_numbof = 1 ! Tiling def. through number of tiles END ENUM !************************************************************************************************! !| ___ _ _ ___ _ _ ____ ____ _ _ _ _ ____ ___ _ ____ _ _ ____ |! !| |__] | | |__] | | | |___ | | |\ | | | | | | |\ | [__ |! !| | |__| |__] |___ | |___ | |__| | \| |___ | | |__| | \| ___] |! !| |! !************************************************************************************************! interface subroutine bwc_free_field(field) BIND(C, NAME="bwc_free_field") IMPORT !*-----------------------*! ! DEFINE POINTERS: ! !*-----------------------*! TYPE(C_PTR), VALUE :: field end subroutine bwc_free_field !=============================================================================================== subroutine bwc_add_param(field, name, sample, dim, precision) BIND(C, NAME="bwc_add_param") IMPORT !*-----------------------*! ! DEFINE POINTERS: ! !*-----------------------*! TYPE(C_PTR), VALUE :: field TYPE(C_PTR), VALUE :: name !*-----------------------*! ! DEFINE INT VARIABLES: ! !*-----------------------*! INTEGER(C_INT16_T) :: sample INTEGER(C_INT8_T) :: dimprecision INTEGER(C_INT8_T) :: precision end subroutine bwc_add_param !=============================================================================================== subroutine bwc_set_tiles(field, tilesX, tilesY, & tilesZ, tilesTS, instr) BIND(C, NAME="bwc_set_tiles") IMPORT !*-----------------------*! ! DEFINE POINTERS: ! !*-----------------------*! TYPE(C_PTR), VALUE :: field TYPE(C_PTR), VALUE :: instr !*-----------------------*! ! DEFINE INT VARIABLES: ! !*-----------------------*! INTEGER(C_INT64_T) :: tilesX, tilesY INTEGER(C_INT64_T) :: tilesZ, tilesTS end subroutine bwc_set_tiles !=============================================================================================== subroutine bwc_set_kernels(field, KernelX, KernelY, & KernelZ, KernelTS) BIND(C, NAME="bwc_set_kernels") IMPORT !*-----------------------*! ! DEFINE POINTERS: ! !*-----------------------*! TYPE(C_PTR), VALUE :: field !*-----------------------*! ! DEFINE INT VARIABLES: ! !*-----------------------*! INTEGER(C_INT) :: KernelX, KernelY INTEGER(C_INT) :: KernelZ, KernelTS end subroutine bwc_set_kernels !=============================================================================================== subroutine bwc_set_decomp(field, numDecompX, numDecompY, & numDecompZ, numDecompTS) BIND(C, NAME="bwc_set_decomp") IMPORT !*-----------------------*! ! DEFINE POINTERS: ! !*-----------------------*! TYPE(C_PTR), VALUE :: field !*-----------------------*! ! DEFINE INT VARIABLES: ! !*-----------------------*! INTEGER(C_INT8_T) :: numDecompX, numDecompY INTEGER(C_INT8_T) :: numDecompZ, numDecompTS end subroutine bwc_set_decomp !=============================================================================================== subroutine bwc_set_precincts(field, pX, pY, pZ, pTS) BIND(C, NAME="bwc_set_precincts") IMPORT !*-----------------------*! ! DEFINE POINTERS: ! !*-----------------------*! TYPE(C_PTR), VALUE :: field !*-----------------------*! ! DEFINE INT VARIABLES: ! !*-----------------------*! INTEGER(C_INT8_T) :: pX, pY INTEGER(C_INT8_T) :: pZ, pTS end subroutine bwc_set_precincts !=============================================================================================== subroutine bwc_set_codeblocks(field, cbX, cbY, cbZ, cbTS) BIND(C, NAME="bwc_set_codeblocks") IMPORT !*-----------------------*! ! DEFINE POINTERS: ! !*-----------------------*! TYPE(C_PTR), VALUE :: field !*-----------------------*! ! DEFINE INT VARIABLES: ! !*-----------------------*! INTEGER(C_INT8_T) :: cbX, cbY INTEGER(C_INT8_T) :: cbZ, cbTS end subroutine bwc_set_codeblocks !=============================================================================================== subroutine bwc_set_progression(field, progression) BIND(C, NAME="bwc_set_progression") IMPORT !*-----------------------*! ! DEFINE POINTERS: ! !*-----------------------*! TYPE(C_PTR), VALUE :: field !*-----------------------*! ! DEFINE INT VARIABLES: ! !*-----------------------*! INTEGER(C_INT) :: progression end subroutine bwc_set_progression !=============================================================================================== subroutine bwc_set_error_resilience(field) BIND(C, NAME="bwc_set_error_resilience") IMPORT !*-----------------------*! ! DEFINE POINTERS: ! !*-----------------------*! TYPE(C_PTR), VALUE :: field end subroutine bwc_set_error_resilience !=============================================================================================== subroutine bwc_set_quant_style(field, quantization_style) BIND(C, NAME="bwc_set_quant_style") IMPORT !*-----------------------*! ! DEFINE POINTERS: ! !*-----------------------*! TYPE(C_PTR), VALUE :: field !*-----------------------*! ! DEFINE INT VARIABLES: ! !*-----------------------*! INTEGER(C_INT) :: quantization_style end subroutine bwc_set_quant_style !=============================================================================================== subroutine bwc_set_qm(field, Qm) BIND(C, NAME="bwc_set_qm") IMPORT !*-----------------------*! ! DEFINE POINTERS: ! !*-----------------------*! TYPE(C_PTR), VALUE :: field !*-----------------------*! ! DEFINE INT VARIABLES: ! !*-----------------------*! INTEGER(C_INT8_T) :: Qm end subroutine bwc_set_qm !=============================================================================================== subroutine bwc_set_quant_step_size(field, delta) BIND(C, NAME="bwc_set_quant_step_size") IMPORT !*-----------------------*! ! DEFINE POINTERS: ! !*-----------------------*! TYPE(C_PTR), VALUE :: field !*-----------------------*! ! DEFINE REAL VARIABLES: ! !*-----------------------*! REAL(C_DOUBLE) :: delta end subroutine bwc_set_quant_step_size !=============================================================================================== #ifdef _OPENMP subroutine bwc_set_nThreads(field, nThreads) BIND(C, NAME="bwc_set_nThreads") IMPORT !*-----------------------*! ! DEFINE POINTERS: ! !*-----------------------*! TYPE(C_PTR), VALUE :: field !*-----------------------*! ! DEFINE INT VARIABLES: ! !*-----------------------*! INTEGER(C_INT8_T) :: nThreads end subroutine bwc_set_nThreads #endif !=============================================================================================== subroutine bwc_set_memory_limit(field, limit) BIND(C, NAME="bwc_set_memory_limit") IMPORT !*-----------------------*! ! DEFINE POINTERS: ! !*-----------------------*! TYPE(C_PTR), VALUE :: field TYPE(C_PTR), VALUE :: limit end subroutine bwc_set_memory_limit !=============================================================================================== function bwc_compress(field, rate_control) result(flag) BIND(C, NAME="bwc_compress") IMPORT !*-----------------------*! ! DEFINE POINTERS: ! !*-----------------------*! TYPE(C_PTR), VALUE :: field TYPE(C_PTR), VALUE :: rate_control !*-----------------------*! ! DEFINE INT VARIABLES: ! !*-----------------------*! INTEGER(C_INT8_T) :: flag end function bwc_compress !=============================================================================================== function bwc_decompress(field, layer) result(e_flag) BIND(C, NAME="bwc_decompress") IMPORT !*-----------------------*! ! DEFINE POINTERS: ! !*-----------------------*! TYPE(C_PTR), VALUE :: field !*-----------------------*! ! DEFINE INT VARIABLES: ! !*-----------------------*! INTEGER(C_INT8_T) :: layer INTEGER(C_INT8_T) :: e_flag end function bwc_decompress end interface end module bwc_module