300 lines
15 KiB
Fortran
300 lines
15 KiB
Fortran
|
!*================================================================================================*!
|
||
|
|
!| |!
|
||
|
|
!| /$$$$$$$ /$$ /$$ /$$ /$$ |!
|
||
|
|
!| | $$__ $$|__/ | $$ /$ | $$| $$ |!
|
||
|
|
!| | $$ \ $$ /$$ /$$$$$$ | $$ /$$$| $$| $$$$$$$ /$$$$$$ /$$$$$$ /$$$$$$ |!
|
||
|
|
!| | $$$$$$$ | $$ /$$__ $$ | $$/$$ $$ $$| $$__ $$ /$$__ $$ /$$__ $$ /$$__ $$ |!
|
||
|
|
!| | $$__ $$| $$| $$ \ $$ | $$$$_ $$$$| $$ \ $$| $$ \ $$| $$ \ $$| $$ \ $$ |!
|
||
|
|
!| | $$ \ $$| $$| $$ | $$ | $$$/ \ $$$| $$ | $$| $$ | $$| $$ | $$| $$ | $$ |!
|
||
|
|
!| | $$$$$$$/| $$| $$$$$$$ | $$/ \ $$| $$ | $$| $$$$$$/| $$$$$$/| $$$$$$$/ |!
|
||
|
|
!| |_______/ |__/ \____ $$ |__/ \__/|__/ |__/ \______/ \______/ | $$____/ |!
|
||
|
|
!| /$$ \ $$ | $$ |!
|
||
|
|
!| | $$$$$$/ | $$ |!
|
||
|
|
!| \______/ |__/ |!
|
||
|
|
!| |!
|
||
|
|
!| 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
|