stdlib_hash_64bit Module



Variables

Type Visibility Attributes Name Initial
integer, public, parameter :: bits_char = character_storage_size
integer, public, parameter :: bits_int16 = bit_size(0_int16)
integer, public, parameter :: bits_int32 = bit_size(0_int32)
integer, public, parameter :: bits_int64 = bit_size(0_int64)
integer, public, parameter :: bits_int8 = bit_size(0_int8)
integer, public, parameter :: bytes_char = bits_char/bits_int8
integer, public, parameter :: bytes_int16 = bits_int16/bits_int8
integer, public, parameter :: bytes_int32 = bits_int32/bits_int8
integer, public, parameter :: bytes_int64 = bits_int64/bits_int8
integer, public, parameter :: bytes_int8 = bits_int8/bits_int8
integer, public, parameter :: int_hash = int64

The number of bits in the output hash

logical, public, parameter :: little_endian = (1==transfer([1_int8, 0_int8], 0_int16))

Interfaces

public interface fnv_1_hash

FNV_1 interfaces (Specification)

  • private elemental module function character_fnv_1(key) result(hash_code)

    FNV_1 hash function for character strings

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: key

    Return Value integer(kind=int_hash)

  • private pure module function int16_fnv_1(key) result(hash_code)

    FNV_1 hash function for rank 1 arrays of kind int16

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int16), intent(in) :: key(:)

    Return Value integer(kind=int_hash)

  • private pure module function int32_fnv_1(key) result(hash_code)

    FNV_1 hash function for rank 1 arrays of kind int32

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int32), intent(in) :: key(:)

    Return Value integer(kind=int_hash)

  • private pure module function int64_fnv_1(key) result(hash_code)

    FNV_1 hash function for rank 1 arrays of kind int64

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int64), intent(in) :: key(:)

    Return Value integer(kind=int_hash)

  • private pure module function int8_fnv_1(key) result(hash_code)

    FNV_1 hash function for rank 1 arrays of kind int8

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int8), intent(in) :: key(:)

    Return Value integer(kind=int_hash)

public interface fnv_1a_hash

FNV_1A interfaces (Specification)

  • private elemental module function character_fnv_1a(key) result(hash_code)

    FNV_1A hash function for character strings

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: key

    Return Value integer(kind=int_hash)

  • private pure module function int16_fnv_1a(key) result(hash_code)

    FNV_1A hash function for rank 1 arrays of kind int16

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int16), intent(in) :: key(:)

    Return Value integer(kind=int_hash)

  • private pure module function int32_fnv_1a(key) result(hash_code)

    FNV_1A hash function for rank 1 arrays of kind int32

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int32), intent(in) :: key(:)

    Return Value integer(kind=int_hash)

  • private pure module function int64_fnv_1a(key) result(hash_code)

    FNV_1A hash function for rank 1 arrays of kind int64

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int64), intent(in) :: key(:)

    Return Value integer(kind=int_hash)

  • private pure module function int8_fnv_1a(key) result(hash_code)

    FNV_1A hash function for rank 1 arrays of kind int8

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int8), intent(in) :: key(:)

    Return Value integer(kind=int_hash)

interface

  • public module subroutine new_pengy_hash_seed(seed)

    Random seed generator for MIR_HASH_STRICT

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int32), intent(inout) :: seed

interface

  • public module subroutine new_spooky_hash_seed(seed)

    Random seed generator for SPOOKY_HASH

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int64), intent(inout) :: seed(2)

public interface pengy_hash

PENGY_HASH interfaces (Specification)

  • private elemental module function character_pengy_hash(key, seed) result(hash_code)

    MIR HASH STRICT function for character strings

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: key
    integer(kind=int32), intent(in) :: seed

    Return Value integer(kind=int64)

  • private pure module function int16_pengy_hash(key, seed) result(hash_code)

    PENGY_HASH hash function for rank 1 array keys of kind int16

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int16), intent(in) :: key(:)
    integer(kind=int32), intent(in) :: seed

    Return Value integer(kind=int64)

  • private pure module function int32_pengy_hash(key, seed) result(hash_code)

    PENGY_HASH hash function for rank 1 array keys of kind int32

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int32), intent(in) :: key(:)
    integer(kind=int32), intent(in) :: seed

    Return Value integer(kind=int64)

  • private pure module function int64_pengy_hash(key, seed) result(hash_code)

    PENGY_HASH hash function for rank 1 array keys of kind int64

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int64), intent(in) :: key(:)
    integer(kind=int32), intent(in) :: seed

    Return Value integer(kind=int64)

  • private pure module function int8_pengy_hash(key, seed) result(hash_code)

    PENGY_HASH hash function for rank 1 array keys of kind int8

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int8), intent(in) :: key(:)
    integer(kind=int32), intent(in) :: seed

    Return Value integer(kind=int64)

interface

  • public module subroutine spookyHash_128(key, hash_inout)

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int8), intent(in), target :: key(0:)
    integer(kind=int_hash), intent(inout) :: hash_inout(2)

public interface spooky_hash

SPOOKY_HASH interfaces (Specification)

  • private module function character_spooky_hash(key, seed) result(hash_code)

    SPOOKY hash function for character strings

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: key
    integer(kind=int_hash), intent(in) :: seed(2)

    Return Value integer(kind=int_hash), (2)

  • private module function int16_spooky_hash(key, seed) result(hash_code)

    SPOOKY HASH function for rank 1 arrays of kind int16

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int16), intent(in) :: key(0:)
    integer(kind=int_hash), intent(in) :: seed(2)

    Return Value integer(kind=int_hash), (2)

  • private module function int32_spooky_hash(key, seed) result(hash_code)

    SPOOKY HASH function for rank 1 arrays of kind int32

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int32), intent(in) :: key(0:)
    integer(kind=int_hash), intent(in) :: seed(2)

    Return Value integer(kind=int_hash), (2)

  • private module function int64_spooky_hash(key, seed) result(hash_code)

    SPOOKY HASH function for rank 1 arrays of kind int64

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int64), intent(in) :: key(0:)
    integer(kind=int_hash), intent(in) :: seed(2)

    Return Value integer(kind=int_hash), (2)

  • private module function int8_spooky_hash(key, seed) result(hash_code)

    SPOOKY HASH function for rank 1 arrays of kind int8

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int8), intent(in) :: key(0:)
    integer(kind=int_hash), intent(in) :: seed(2)

    Return Value integer(kind=int_hash), (2)


Functions

public elemental function fibonacci_hash(key, nbits) result(sample)

License
Creative Commons License
Version
experimental

Maps the 64 bit integer key to an unsigned integer value with only nbits bits where nbits is less than 64 (Specification)

Arguments

Type IntentOptional Attributes Name
integer(kind=int64), intent(in) :: key
integer, intent(in) :: nbits

Return Value integer(kind=int64)

public elemental function universal_mult_hash(key, seed, nbits) result(sample)

License
Creative Commons License
Version
experimental

Uses the "random" odd 64 bit integer seed to map the 64 bit integer key to an unsigned integer value with only nbits bits where nbits is less than 64. (Specification)

Arguments

Type IntentOptional Attributes Name
integer(kind=int64), intent(in) :: key
integer(kind=int64), intent(in) :: seed
integer, intent(in) :: nbits

Return Value integer(kind=int64)


Subroutines

public subroutine odd_random_integer(harvest)

License
Creative Commons License
Version
experimental

Returns a 64 bit pseudo random integer, harvest, distributed uniformly over the odd integers of the 64 bit kind. (Specification)

Arguments

Type IntentOptional Attributes Name
integer(kind=int64), intent(out) :: harvest