stdlib_hash_32bit_nm.fypp 源文件

!!------------------------------------------------------------------------------
!! `NM_HASH32` and `NM_HASH32X` are translations to Fortran 2008 and signed
!! two's complement arithmetic of the `nmhash32` and `nmhash32x` scalar
!! algorithms of James Z. M. Gao, copyright 2021. James Z. M. Gao's original
!! C++ code, `nmhash.h`, is available at the URL:
!! https://github.com/gzm55/hash-garage/blob/a8913138bdb3b7539c202edee30a7f0794bbd835/nmhash.h
!! under the BSD 2-Clause License:
!! https://github.com/gzm55/hash-garage/blob/a8913138bdb3b7539c202edee30a7f0794bbd835/LICENSE
!! The algorithms come in multiple versions, depending on whether the
!! vectorized instructions SSE2 or AVX2 are available. As neither instruction
!! is available in portable Fortran 2008, the algorithms that do not use these
!! instructions are used.
!!
!! The BSD 2-Clause license is as follows:
!!
!! BSD 2-Clause License
!!
!! Copyright (c) 2021, water hash algorithm. James Z.M. Gao
!! All rights reserved.
!!
!! 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.
!!------------------------------------------------------------------------------

#! Integer kinds to be considered during templating
#:set INT_KINDS = ["int16", "int32", "int64"]

submodule(stdlib_hash_32bit) stdlib_hash_32bit_nm

    implicit none

! Primes from XXH
    integer(int32), parameter :: nmh_prime32_1 = int( Z'9E3779B1', int32 )
    integer(int32), parameter :: nmh_prime32_2 = int( Z'85EBCA77', int32 )
    integer(int32), parameter :: nmh_prime32_3 = int( Z'C2B2AE3D', int32 )
    integer(int32), parameter :: nmh_prime32_4 = int( Z'27D4EB2F', int32 )

    integer(int32), parameter :: nmh_m1 = int(z'F0D9649B', int32 )
    integer(int32), parameter :: nmh_m2 = int(z'29A7935D', int32 )
    integer(int32), parameter :: nmh_m3 = int(z'55D35831', int32 )

    integer(int32), parameter :: nmh_m1_v(0:31) = nmh_m1
    integer(int32), parameter :: nmh_m2_v(0:31) = nmh_m2
    integer(int32), parameter :: nmh_m3_v(0:31) = nmh_m3

    logical, parameter :: nmh_short32_without_seed2=.false.
    logical, parameter :: nmh_short32_with_seed2=.true.

    integer, parameter :: init_size = 32

! Pseudorandom secrets taken directly from FARSH.
    integer(int32), parameter :: nmh_acc_init(0:init_size-1) = [ &
        int( z'B8FE6C39', int32 ), int( z'23A44BBE', int32 ), &
        int( z'7C01812C', int32 ), int( z'F721AD1C', int32 ), &
        int( z'DED46DE9', int32 ), int( z'839097DB', int32 ), &
        int( z'7240A4A4', int32 ), int( z'B7B3671F', int32 ), &
        int( z'CB79E64E', int32 ), int( z'CCC0E578', int32 ), &
        int( z'825AD07D', int32 ), int( z'CCFF7221', int32 ), &
        int( z'B8084674', int32 ), int( z'F743248E', int32 ), &
        int( z'E03590E6', int32 ), int( z'813A264C', int32 ), &

        int( z'3C2852BB', int32 ), int( z'91C300CB', int32 ), &
        int( z'88D0658B', int32 ), int( z'1B532EA3', int32 ), &
        int( z'71644897', int32 ), int( z'A20DF94E', int32 ), &
        int( z'3819EF46', int32 ), int( z'A9DEACD8', int32 ), &
        int( z'A8FA763F', int32 ), int( z'E39C343F', int32 ), &
        int( z'F9DCBBC7', int32 ), int( z'C70B4F1D', int32 ), &
        int( z'8A51E04B', int32 ), int( z'CDB45931', int32 ), &
        int( z'C89F7EC9', int32 ), int( z'D9787364', int32 ) ]

contains

    pure function nmh_readle32( p ) result( v )
        integer(int32) :: v
        integer(int8), intent(in) :: p(:)

        if ( little_endian ) then
            v = transfer( p(1:4), 0_int32 )
        else
            v = transfer( [ p(4), p(3), p(2), p(1) ], 0_int32 )
        end if

    end function nmh_readle32

    pure function nmh_readle16( p ) result( v )
        integer(int16) :: v
        integer(int8), intent(in) :: p(:)

        if ( little_endian ) then
            v = transfer( p(1:2), 0_int16 )
        else
            v = transfer( [ p(2), p(1) ], 0_int16 )
        end if

    end function nmh_readle16

    pure function nmhash32_0to8( x, seed ) result( vx32 )
        integer(int32), intent(in) :: x
        integer(int32), intent(in) :: seed
        integer(int32) :: vx32
        ! base mixer: [-6 -12 776bf593 -19 11 3fb39c65 -15 -9 e9139917 -11 16]
        ! = 0.027071104091278835
        integer(int32), parameter :: m1 = int(z'776BF593', int32)
        integer(int32), parameter :: m2 = int(z'3FB39C65', int32)
        integer(int32), parameter :: m3 = int(z'E9139917', int32)

        integer(int16) :: vx16(2)

        vx32 = x
        vx32 = ieor( vx32, ieor( ishft( vx32, -12 ), ishft( vx32, -6 ) ) )
        vx16 = transfer( vx32, 0_int16, 2 )
        vx16 = vx16 * transfer( m1, 0_int16, 2 )
        vx32 = transfer( vx16, 0_int32 )
        vx32 = ieor( vx32, ieor( ishft( vx32, 11 ), ishft( vx32, -19 ) ) )
        vx16 = transfer( vx32, 0_int16, 2 )
        vx16 = vx16 * transfer( m2, 0_int16, 2 )
        vx32 = transfer( vx16, 0_int32 )
        vx32 = ieor( vx32, seed )
        vx32 = ieor( vx32, ieor( ishft( vx32, -15 ), ishft( vx32, -9 ) ) )
        vx16 = transfer( vx32, 0_int16, 2 )
        vx16 = vx16 * transfer( m3, 0_int16, 2 )
        vx32 = transfer( vx16, 0_int32 )
        vx32 = ieor( vx32, ieor( ishft(vx32, 16), ishft(vx32, -11) ) )

    end function nmhash32_0to8

    pure function nmhash32_9to255( p, seed, full_avalanche ) result( result )
        integer(int8), intent(in)  :: p(0:)
        integer(int32), intent(in) :: seed
        logical, intent(in)        :: full_avalanche
        integer(int32) :: result

        integer(int32) :: xu32(0:3), yu32(0:3)
        integer(int16) :: xu16(0:1)
!       Due to an issue with Intel OneAPI ifort 2021 (see  
!       https://community.intel.com/t5/Intel-Fortran-Compiler/Intrinsic-transfer-with-a-provided-size-un-expected-behavior/m-p/1343313#M158733
!       ), it is not possible to define the following variables as a parameter.
!        integer(int16), parameter :: &
!            nmh_m1_16(0:1) = transfer( nmh_m1, 0_int16, 2 ),  &
!            nmh_m2_16(0:1) = transfer( nmh_m2, 0_int16, 2 ),  &
!            nmh_m3_16(0:1) = transfer( nmh_m3, 0_int16, 2 )
        integer(int16) :: nmh_m1_16(0:1), nmh_m2_16(0:1), nmh_m3_16(0:1)
        integer(int32) :: s1
        integer(int64) :: length
        integer(int32) :: length32(0:1)
        integer(int64) :: i, j, r

        nmh_m1_16(0:1) = transfer( nmh_m1, 0_int16, 2 )
        nmh_m2_16(0:1) = transfer( nmh_m2, 0_int16, 2 )
        nmh_m3_16(0:1) = transfer( nmh_m3, 0_int16, 2 )

        ! base mixer: [f0d9649b  5 -13 29a7935d -9 11 55d35831 -20 -10 ] =
        ! 0.93495901789135362

        result = 0
        length = size( p, kind=int64 )
        length32 = transfer(length, 0_int32, 2)
        if (little_endian) then
            s1 = seed + length32(0)
        else
            s1 = seed + length32(1)
        end if
        xu32(0) = nmh_prime32_1
        xu32(1) = nmh_prime32_2
        xu32(2) = nmh_prime32_3
        xu32(3) = nmh_prime32_4
        yu32(:) = s1

        if (full_avalanche) then
            ! 33 to 255 bytes
            r = (length - 1 ) /32
            do i=0, r-1
                do j=0, 3
                    xu32(j) = ieor( xu32(j), nmh_readle32( p(i*32 + j*4: ) ) )
                    yu32(j) = ieor( yu32(j), &
                                    nmh_readle32( p(i*32 + j*4 + 16: ) ) )
                    xu32(j) = xu32(j) + yu32(j)
                    xu16 = transfer( xu32(j), 0_int16, 2 )
                    xu16 = xu16 * nmh_m1_16
                    xu32(j) = transfer( xu16, 0_int32 )
                    xu32(j) = ieor( xu32(j), &
                                    ieor( ishft(xu32(j), 5), &
                                          ishft(xu32(j), -13)) )
                    xu16 = transfer( xu32(j), 0_int16, 2 )
                    xu16 = xu16 * nmh_m2_16
                    xu32(j) = transfer( xu16, 0_int32 )
                    xu32(j) = ieor( xu32(j), yu32(j) )
                    xu32(j) = ieor( xu32(j), &
                                    ieor( ishft(xu32(j), 11), &
                                          ishft(xu32(j), -9) ) )
                    xu16 = transfer( xu32(j), 0_int16, 2 )
                    xu16 = xu16 * nmh_m3_16
                    xu32(j) = transfer( xu16, 0_int32 )
                    xu32(j) = ieor( xu32(j), &
                                    ieor( ishft(xu32(j),-10), &
                                          ishft(xu32(j), -20) ) )
                end do
            end do
            do j=0, 3
                xu32(j) = ieor( xu32(j), &
                                nmh_readle32( p(length - 32 + j*4: ) ) )
                yu32(j) = ieor( yu32(j), &
                                nmh_readle32( p(length - 16 + j*4: ) ) )
            end do
        else
            ! 9 to 32 bytes
            xu32(0) = ieor(xu32(0), nmh_readle32(p(0:)))
            xu32(1) = ieor(xu32(1), nmh_readle32(p(ishft(ishft(length,-4),3):)))
            xu32(2) = ieor(xu32(2), nmh_readle32(p(length-8:)))
            xu32(3) = ieor(xu32(3), &
                           nmh_readle32(p(length-8-ishft(ishft(length,-4),3):)))
            yu32(0) = ieor(yu32(0), nmh_readle32(p(4:)))
            yu32(1) = ieor(yu32(1), &
                      nmh_readle32(p(ishft(ishft(length,-4),3)+4:)))
            yu32(2) = ieor(yu32(2), nmh_readle32(p(length-8+4:)))
            yu32(3) = ieor(yu32(3), &
                           nmh_readle32(p(length - 8 - &
                                        ishft(ishft(length,-4),3)+4:)))
        end if
        do j=0, 3
            xu32(j) = xu32(j) + yu32(j)
            yu32(j) = ieor( yu32(j), ieor(ishft(yu32(j), 17), &
                                          ishft(yu32(j), -6) ) )
            xu16 = transfer( xu32(j), 0_int16, 2 )
            xu16 = xu16 * nmh_m1_16
            xu32(j) = transfer( xu16, 0_int32 )
            xu32(j) = ieor( xu32(j), ieor(ishft(xu32(j), 5), &
                                          ishft(xu32(j), -13) ) )
            xu16 = transfer( xu32(j), 0_int16, 2 )
            xu16 = xu16 * nmh_m2_16
            xu32(j) = transfer( xu16, 0_int32 )
            xu32(j) = ieor( xu32(j), yu32(j) )
            xu32(j) = ieor( xu32(j), ieor(ishft(xu32(j), 11), &
                                          ishft(xu32(j), -9) ) )
            xu16 = transfer( xu32(j), 0_int16, 2 )
            xu16 = xu16 * nmh_m3_16
            xu32(j) = transfer( xu16, 0_int32 )
            xu32(j) = ieor( xu32(j), ieor(ishft(xu32(j), -10), &
                                          ishft(xu32(j), -20) ) )
        end do
        xu32(0) = ieor( xu32(0), nmh_prime32_1 )
        xu32(1) = ieor( xu32(1), nmh_prime32_2 )
        xu32(2) = ieor( xu32(2), nmh_prime32_3 )
        xu32(3) = ieor( xu32(3), nmh_prime32_4 )
        do j=1, 3
            xu32(0) = xu32(0) + xu32(j)
        end do
        xu32(0) = ieor(xu32(0), s1 + ishft(s1, -5) )
        xu16 = transfer( xu32(0), 0_int16, 2 )
        xu16 = xu16 * nmh_m3_16
        xu32(0) = transfer( xu16, 0_int32 )
        xu32(0) = ieor(xu32(0), &
                       ieor(ishft(xu32(0), -10), ishft(xu32(0), -20) ) )
        result = xu32(0)

    end function nmhash32_9to255

    pure function nmhash32_9to32( p, seed ) result( result )
        integer(int8), intent(in)  :: p(0:)
        integer(int32), intent(in) :: seed
        integer(int32) :: result

        result = nmhash32_9to255( p, seed, .false. )

    end function nmhash32_9to32

    pure function nmhash32_33to255( p, seed ) result( result )
        integer(int8), intent(in)  :: p(0:)
        integer(int32), intent(in) :: seed
        integer(int32) :: result

        result = nmhash32_9to255( p, seed, .true. )

    end function nmhash32_33to255

    pure subroutine nmhash32_long_round( accx, accy, p )
        integer(int32), intent(inout) :: accx(0:)
        integer(int32), intent(inout) :: accy(0:)
        integer(int8), intent(in)     :: p(0:)

        integer(int64), parameter :: nbgroups = init_size
        integer(int64) :: i
        integer(int16) :: dummy1(0:1)
        integer(int16) :: dummy2(0:1)

        do i = 0, nbgroups-1
            accx(i) = ieor( accx(i), nmh_readle32( p(i*4:) ) )
            accy(i) = ieor( accy(i), nmh_readle32( p(i*4+nbgroups*4:) ) )
            accx(i) = accx(i) + accy(i)
            accy(i) = ieor( accy(i), ishft(accx(i),  -1) )
            dummy1 = transfer( accx(i), 0_int16, 2 )
            dummy2 = transfer( nmh_m1_v(i), 0_int16, 2 )
            dummy1 = dummy1 * dummy2
            accx(i) = transfer( dummy1, 0_int32 )
            accx(i) = ieor( accx(i), ieor( ishft(accx(i), 5), &
                                           ishft(accx(i),-13) ) )
            dummy1 = transfer( accx(i), 0_int16, 2 )
            dummy2 = transfer( nmh_m2_v(i), 0_int16, 2 )
            dummy1 = dummy1 * dummy2
            accx(i) = transfer( dummy1, 0_int32 )
            accx(i) = ieor( accx(i), accy(i) )
            accx(i) = ieor( accx(i), ieor( ishft(accx(i), 11), &
                                           ishft(accx(i),-9) ) )
            dummy1 = transfer( accx(i), 0_int16, 2 )
            dummy2 = transfer( nmh_m3_v(i), 0_int16, 2 )
            dummy1 = dummy1 * dummy2
            accx(i) = transfer( dummy1, 0_int32 )
            accx(i) = ieor( accx(i), ieor( ishft(accx(i),-10), &
                                           ishft(accx(i),-20) ) )
        end do

    end subroutine nmhash32_long_round

    pure function nmhash32_long( p, seed ) result( sum )
        integer(int32) :: sum
        integer(int8), intent(in) :: p(0:)
        integer(int32), intent(in) :: seed

        integer(int32) :: accx(0:size(nmh_acc_init)-1)
        integer(int32) :: accy(0:size(nmh_acc_init)-1)
        integer(int64) :: nbrounds
        integer(int64) :: len
        integer(int32) :: len32(0:1)
        integer(int64) :: i

        len  = size( p, kind=int64 )
        nbrounds = (len-1) / ( 4*size(accx, kind=int64) * 2 )
        sum = 0

!  Init
        do i=0_int64, size(nmh_acc_init, kind=int64)-1
            accx(i) = nmh_acc_init(i)
            accy(i) = seed
        end do

        ! init
        do i=0_int64, nbrounds-1
            call nmhash32_long_round( accx, accy, &
                                      p(i*8*size(accx, kind=int64):) )
        end do
        call nmhash32_long_round( accx, accy, &
                                  p(len-8*size(accx, kind=int64):) )

        ! merge acc
        do i=0, size( accx, kind=int64 )-1
            accx(i) = ieor( accx(i), nmh_acc_init(i) )
            sum = sum + accx(i)
        end do

        len32 = transfer(len, 0_int32, 2)
        if ( little_endian ) then
            sum = sum + len32(1)
            sum = ieor(sum, len32(0))
        else
            sum = sum + len32(0)
            sum = ieor(sum, len32(1))
        end if

    end function nmhash32_long

    pure function nmhash32_avalanche32( x ) result( u32 )
        integer(int32) :: u32
        integer(int32), intent(in) :: x

        integer(int16) :: u16(0:1)
        integer(int32), parameter:: m1 = int(z'CCE5196D', int32)
        integer(int32), parameter:: m2 = int(z'464BE229', int32)
!       Due to an issue with Intel OneAPI ifort 2021 (see  
!       https://community.intel.com/t5/Intel-Fortran-Compiler/Intrinsic-transfer-with-a-provided-size-un-expected-behavior/m-p/1343313#M158733
!       ), it is not possible to define the following variables as a parameter.
        !integer(int16), parameter:: m1_16(0:1) = transfer(m1, 0_int16, 2)
        !integer(int16), parameter:: m2_16(0:1) = transfer(m2, 0_int16, 2)
        integer(int16) :: m1_16(0:1), m2_16(0:1)
        ! [-21 -8 cce5196d 12 -7 464be229 -21 -8] = 3.2267098842182733

        m1_16(0:1) = transfer(m1, 0_int16, 2)
        m2_16(0:1) = transfer(m2, 0_int16, 2)

        u32 = x
        u32 = ieor( u32, ieor( ishft( u32, -8 ), ishft( u32, -21 ) ) )
        u16 = transfer( u32, 0_int16, 2 )
        u16(0) = u16(0) * m1_16(0)
        u16(1) = u16(1) * m1_16(1)
        u32 = transfer( u16, 0_int32 )
        u32 = ieor( u32, ieor( ishft( u32, 12 ), ishft( u32, -7 ) ) )
        u16 = transfer( u32, 0_int16, 2 )
        u16(0) = u16(0) * m2_16(0)
        u16(1) = u16(1) * m2_16(1)
        u32 = transfer( u16, 0_int32 )
        u32 = ieor( u32, ieor( ishft( u32, -8 ), ishft( u32, -21 ) ) )

    end function nmhash32_avalanche32

    pure module function int8_nmhash32( key, seed ) result( hash )
!! NMHASH32 hash function for rank 1 array keys of kind INT8
        integer(int32) :: hash
        integer(int8), intent(in) :: key(0:)
        integer(int32), intent(in) :: seed
        integer(int64) :: len
        integer(int32) :: u32
        integer(int16) :: u16(0:1)
        integer(int32) :: x, y
        integer(int32) :: new_seed

        len = size( key, kind=int64 )
        if ( len <= 32 ) then
            if ( len > 8 ) then
                hash = nmhash32_9to32( key, seed )
                return
            else if ( len > 4 ) then
                x = nmh_readle32(key)
                y = ieor( nmh_readle32(key(len-4:)), nmh_prime32_4 + 2 + seed )
                x = x + y
                x = ieor( x, ishft(x, len + 7 ) )
                hash = nmhash32_0to8( x, ishftc(y, 5) )
                return
            else
                select case(len)
                case(0)
                    new_seed = seed + nmh_prime32_2
                    u32 = 0
                case(1)
                    new_seed = seed + nmh_prime32_2 + ishft(1_int32, 24) + &
                               2_int32
                    if ( little_endian ) then
                        u32 = transfer( [key(0), 0_int8, 0_int8, 0_int8], &
                                        0_int32 )
                    else
                        u32 = transfer( [0_int8, 0_int8, 0_int8, key(0)], &
                                        0_int32 )
                    end if
                case(2)
                    new_seed = seed + nmh_prime32_2 + ishft(2_int32, 24) + &
                               4_int32
                    if (little_endian) then
                        u32 = transfer( [nmh_readle16(key), 0_int16], 0_int32 )
                    else
                        u32 = transfer( [0_int16, nmh_readle16(key)], 0_int32 )
                    end if
                case(3)
                    new_seed = seed + nmh_prime32_2 + ishft(3_int32, 24) + &
                               6_int32
                    if ( little_endian ) then
                        u16(1) = transfer( [key(2), 0_int8], 0_int16 )
                        u16(0) = nmh_readle16( key )
                    else
                        u16(0) = transfer( [0_int8, key(2)], 0_int16 )
                        u16(1) = nmh_readle16( key )
                    end if
                    u32 = transfer( u16, 0_int32 )
                case(4)
                    new_seed = seed + nmh_prime32_3
                    u32 = nmh_readle32(key)
                case default
                    hash = 0
                    return
                end select
                hash = nmhash32_0to8(u32+new_seed, ishftc(new_seed, 5) )
                return
            end if
        else if ( len < 256_int64 ) then
            hash = nmhash32_33to255( key, seed )
            return
        else
            hash = nmhash32_avalanche32( nmhash32_long(key, seed ))
            return
        end if

    end function int8_nmhash32

    pure function nmhash32x_0to4( x, seed ) result( hash )
        integer(int32), intent(in) :: x
        integer(int32), intent(in) :: seed
        integer(int32) :: hash

        ! [bdab1ea9 18 a7896a1b 12 83796a2d 16] = 0.092922873297662509

        hash = x
        hash = ieor( hash, seed )
        hash = hash * int(z'BDAB1EA9', int32)
        hash = hash + ishftc(seed, 31)
        hash = ieor( hash, ishft(hash, -18) )
        hash = hash * int(z'A7896A1B', int32)
        hash = ieor( hash, ishft(hash, -12) )
        hash = hash * int(z'83796A2D', int32)
        hash = ieor( hash, ishft(hash, -16) )

    end function nmhash32x_0to4

    pure function nmhash32x_5to8( p, seed ) result( x )
        integer(int8), intent(in) :: p(0:)
        integer(int32), intent(in) :: seed
        integer(int32) :: x

        integer(int64) :: len
        integer(int32) :: y

        ! 5 to 9 bytes
        ! mixer: [11049a7d 23 bcccdc7b 12 065e9dad 12] = 0.16577596555667246

        len = size(p, kind=int64)
        x = ieor( nmh_readle32(p), nmh_prime32_3 )
        y = ieor( nmh_readle32(p(len-4:)), seed )
        x  = x + y
        x = ieor( x, ishft(x, -len) )
        x = x * int(z'11049A7D', int32)
        x = ieor( x, ishft(x, -23) )
        x = x * int(z'BCCCDC7B', int32)
        x = ieor( x, ishftc(y, 3) )
        x = ieor( x, ishft(x, -12) )
        x = x * int(z'065E9DAD', int32)
        x = ieor( x, ishft(x, -12) )

    end function nmhash32x_5to8

    pure function nmhash32x_9to255( p, seed ) result( x )
        integer(int8), intent(in) :: p(0:)
        integer(int32), intent(in) :: seed
        integer(int32) :: x

        integer(int64) :: len
        integer(int32) :: len32(0:1), len_base
        integer(int32) :: y
        integer(int32) :: a, b
        integer(int64) :: i, r

        ! - at least 9 bytes
        ! - base mixer: [11049a7d 23 bcccdc7b 12 065e9dad 12] = 0.16577596555667246
        ! - tail mixer: [16 a52fb2cd 15 551e4d49 16] = 0.17162579707098322

        len = size(p, kind=int64)
        len32 = transfer(len, 0_int32, 2)
        if (little_endian) then
            len_base = len32(0)
        else
            len_base = len32(1)
        end if
        x = nmh_prime32_3
        y = seed
        a = nmh_prime32_4
        b = seed
        r = (len - 1)/16

        do i=0, r-1
            x = ieor(x, nmh_readle32( p(i*16 + 0:) ) )
            y = ieor(y, nmh_readle32( p(i*16 + 4:) ) )
            x = ieor(x, y)
            x = x * int(z'11049A7D', int32)
            x = ieor(x, ishft(x, -23) )
            x = x * int(z'BCCCDC7B', int32)
            y = ishftc(y, 4)
            x = ieor(x, y)
            x = ieor(x, ishft(x, -12) )
            x = x * int(z'065E9DAD', int32)
            x = ieor(x, ishft(x, -12) )

            a = ieor(a, nmh_readle32(p(i*16 + 8:)))
            b = ieor(b, nmh_readle32(p(i*16 + 12:)))
            a = ieor(a, b)
            a = a * int(z'11049A7D', int32)
            a = ieor(a, ishft(a, -23) )
            a = a * int(z'BCCCDC7B', int32)
            b = ishftc(b, 3)
            a = ieor(a, b)
            a = ieor(a, ishft(a, -12) )
            a = a * int(z'065E9DAD', int32)
            a = ieor(a, ishft(a, -12) )
        end do

        if ( iand(len_base-1_int32, 8_int32) /= 0 ) then
            if ( iand(len_base-1_int32, 4_int32) /= 0 ) then
                a = ieor( a, nmh_readle32( p(r*16 + 0:) ) )
                b = ieor( b, nmh_readle32( p(r*16 + 4:) ) )
                a = ieor(a, b)
                a = a * int(z'11049A7D', int32)
                a = ieor(a, ishft(a, -23) )
                a = a * int(z'BCCCDC7B', int32)
                a = ieor(a, ishftc(b, 4))
                a = ieor(a, ishft(a, -12))
                a = a * int(z'065E9DAD', int32)
            else
                a = ieor( a, nmh_readle32( p(r*16:) ) + b )
                a = ieor( a, ishft(a, -16) )
                a = a * int(z'A52FB2CD', int32)
                a = ieor( a, ishft(a, -15) )
                a = a * int(z'551E4D49', int32)
            end if
            x = ieor( x, nmh_readle32( p(len - 8:) ) )
            y = ieor( y, nmh_readle32( p(len - 4:) ) )
            x = ieor( x, y )
            x = x * int(z'11049A7D', int32)
            x = ieor( x, ishft(x, -23) )
            x = x * int(z'BCCCDC7B', int32);
            x = ieor( x, ishftc(y, 3) )
            x = ieor( x, ishft(x, -12) )
            x = x * int(z'065E9DAD', int32)
        else
            if ( iand(len_base-1_int32, 4_int32) /= 0) then
                a = ieor(a, nmh_readle32(p( r * 16:) ) + b )
                a = ieor( a, ishft(a,-16) )
                a = a * int(z'A52FB2CD', int32)
                a = ieor( a, ishft(a,-15) )
                a = a * int(z'551E4D49', int32)
            end if
            x = ieor( x, nmh_readle32(p( len - 4:) ) + y )
            x = ieor( x, ishft(x,-16) )
            x = x * int(z'A52FB2CD', int32)
            x = ieor( x, ishft(x,-15) )
            x = x * int(z'551E4D49', int32)
        end if

        x = ieor(x, len_base )
        x = ieor(x, ishftc(a, 27)) ! rotate one lane to pass Diff test
        x = ieor(x, ishft(x,-14))
        x = x * int(z'141CC535', int32 )

    end function nmhash32x_9to255

    pure function nmhash32x_avalanche32( x ) result(hash)
        integer(int32) :: hash
        integer(int32), intent(in) :: x
! Mixer with 2 mul from skeeto/hash-prospector:
! [15 d168aaad 15 af723597 15] = 0.15983776156606694

        hash = x
        hash = ieor( hash, ishft( hash, -15 ) )
        hash = hash * int( z'D168AAAD', int32 )
        hash = ieor( hash, ishft( hash, -15 ) )
        hash = hash * int( z'AF723597', int32 )
        hash = ieor( hash, ishft( hash, -15 ) )

    end function nmhash32x_avalanche32

    pure module function int8_nmhash32x( key, seed ) result(hash)
!! NMHASH32x hash function for rank 1 array keys of kind INT8
        integer(int32) :: hash
        integer(int8), intent(in) :: key(0:)
        integer(int32), intent(in) :: seed

        integer(int64) :: len
        integer(int32) :: seed2
        integer(int32) :: u32
        integer(int16) :: u16(0:1)

        len = size( key, kind=int64 )
        if ( len <= 8 ) then
            if ( len > 4 ) then
                hash = nmhash32x_5to8( key, seed )
                return
            else ! 0 to 4 bytes
                select case (len)
                case(0)
                    seed2 = seed + nmh_prime32_2
                    u32 = 0
                case(1)
                    seed2 = seed + nmh_prime32_2 + ishft(1_int32, 24) + &
                        ishft(1_int32, 1)
                    if (little_endian) then
                        u32 = transfer( [key(0), 0_int8, 0_int8, 0_int8], &
                                        0_int32 )
                    else
                        u32 = transfer( [0_int8, 0_int8, 0_int8, key(0)], &
                                        0_int32 )
                    end if
                case(2)
                    seed2 = seed + nmh_prime32_2 + ishft(2_int32, 24) + &
                        ishft(2_int32, 1)
                    if (little_endian) then
                        u32 = transfer( [nmh_readle16(key), 0_int16], 0_int32 )
                    else
                        u32 = transfer( [0_int16, nmh_readle16(key)], 0_int32 )
                    end if
                case(3)
                    seed2 = seed + nmh_prime32_2 + ishft(3_int32, 24) + &
                        ishft(3_int32, 1)
                    if (little_endian ) then
                        u16(1) = transfer( [ key(2), 0_int8 ], 0_int16 )
                        u16(0) = nmh_readle16(key)
                    else
                        u16(0) = transfer( [ 0_int8, key(2) ], 0_int16 )
                        u16(1) = nmh_readle16(key)
                    end if
                    u32 = transfer( u16, 0_int32 )
                case(4)
                    seed2 = seed + nmh_prime32_1
                    u32 = nmh_readle32(key)
                case default
                    hash = 0
                    return
                end select
                hash = nmhash32x_0to4(u32, seed2)
                return
            end if
        end if
        if (len < 256) then
            hash = nmhash32x_9to255(key, seed)
            return
        end if
        hash = nmhash32x_avalanche32(nmhash32_long(key, seed))

    end function int8_nmhash32x

#:for k1 in INT_KINDS
    pure module function ${k1}$_nmhash32( key, seed ) result(hash_code)
!! NMHASH32 hash function for rank 1 array keys of kind ${k1}$
        integer(${k1}$), intent(in) :: key(:)
        integer(int32), intent(in)  :: seed
        integer(int32)           :: hash_code

        hash_code = int8_nmhash32( transfer( key, 0_int8, &
                     bytes_${k1}$*size(key, kind=int64) ), seed)

    end function ${k1}$_nmhash32

#:endfor

    elemental module function character_nmhash32( key, seed ) result(hash_code)
!! NMHASH32 hash function for default character keys
        character(*), intent(in)   :: key
        integer(int32), intent(in) :: seed
        integer(int32)             :: hash_code

        hash_code = int8_nmhash32( transfer( key, 0_int8, &
                     bytes_char*len(key, kind=int64) ), seed)

    end function character_nmhash32

#:for k1 in INT_KINDS
    pure module function ${k1}$_nmhash32x( key, seed ) result(hash_code)
!! NMHASH32X hash function for rank 1 array keys of kind ${k1}$
        integer(${k1}$), intent(in) :: key(:)
        integer(int32), intent(in)  :: seed
        integer(int32)           :: hash_code

        hash_code = int8_nmhash32x( transfer( key, 0_int8, &
                     bytes_${k1}$*size(key, kind=int64) ), seed)

    end function ${k1}$_nmhash32x

#:endfor

    elemental module function character_nmhash32x( key, seed ) result(hash_code)
!! NMHASH32X hash function for default character keys
        character(*), intent(in)   :: key
        integer(int32), intent(in) :: seed
        integer(int32)             :: hash_code

        hash_code = int8_nmhash32x( transfer( key, 0_int8, &
                     bytes_char*len(key, kind=int64) ), seed)

    end function character_nmhash32x

    module subroutine new_nmhash32_seed( seed )
! Random SEED generator for NMHASH32
        integer(int32), intent(inout) :: seed

        integer(int32) :: old_seed
        real(dp) :: sample

        old_seed = seed
        find_seed:do
            call random_number( sample )
            seed = int( floor( sample * 2_int64**32, int64 ) - 2_int64**31, &
                int32 )
            if ( seed /= old_seed ) return
        end do find_seed

    end subroutine new_nmhash32_seed

    module subroutine new_nmhash32x_seed( seed )
! Random SEED generator for NMHASH32X
         integer(int32), intent(inout) :: seed

        integer(int32) :: old_seed
        real(dp) :: sample

        old_seed = seed
        find_seed:do
            call random_number( sample )
            seed = int( floor( sample * 2_int64**32, int64 ) - 2_int64**31, &
                int32 )
            if ( seed /= old_seed ) return
        end do find_seed

    end subroutine new_nmhash32x_seed

end submodule stdlib_hash_32bit_nm