! MIT License ! ! Copyright (c) 2010-present David A. Kopriva and other contributors: AUTHORS.md ! ! Permission is hereby granted, free of charge, to any person obtaining a copy ! of this software and associated documentation files (the "Software"), to deal ! in the Software without restriction, including without limitation the rights ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ! copies of the Software, and to permit persons to whom the Software is ! furnished to do so, subject to the following conditions: ! ! The above copyright notice and this permission notice shall be included in all ! copies or substantial portions of the Software. ! ! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ! SOFTWARE. ! ! FTObjectLibrary contains code that, to the best of our knowledge, has been released as ! public domain software: ! * `b3hs_hash_key_jenkins`: originally by Rich Townsend, ! https://groups.google.com/forum/#!topic/comp.lang.fortran/RWoHZFt39ng, 2005 ! ! --- End License ! !//////////////////////////////////////////////////////////////////////// ! ! hash ! Created: January 28, 2013 12:39 PM ! By: David Kopriva ! ! Code by Rich Townsend, 2005 ! See: https://groups.google.com/forum/#!topic/comp.lang.fortran/RWoHZFt39ng ! !//////////////////////////////////////////////////////////////////////// ! MODULE HashModule CONTAINS function b3hs_hash_key_jenkins (key, range) result (code) INTEGER, PARAMETER :: KIND_I32 = SELECTED_INT_KIND(10) character(*), intent(in) :: key integer, intent(in) :: range integer :: code integer :: len_key integer(KIND_I32) :: a integer(KIND_I32) :: b integer(KIND_I32) :: c INTEGER :: c_i integer :: k ! Hash the key into a code, using the algorithm ! described by Bob Jenkins at: ! http://burtleburtle.net/bob/hash/doobs.html ! ! Note that range should be a power of 2, and ! that the 32-bit algorithm is used len_key = LEN_TRIM(key) a = -1640531527_KIND_I32 ! 0x9E3779B9 b = a c = 305419896_KIND_I32 ! 0x12345678 k = 1 char_loop : do if(len_key < 12) exit char_loop ! Pack the key into 32 bits a = a + ICHAR(key(k+0:k+0)) + ISHFT(ICHAR(key(k+1:k+1)), 8) + & & ISHFT(ICHAR(key(k+2:k+2)), 16) + ISHFT(ICHAR(key(k+3:k+3)), 24) b = b + ICHAR(key(k+4:k+4)) + ISHFT(ICHAR(key(k+5:k+5)), 8) + & & ISHFT(ICHAR(key(k+6:k+6)), 16) + ISHFT(ICHAR(key(k+7:k+7)), 24) c = c + ICHAR(key(k+8:k+8)) + ISHFT(ICHAR(key(k+9:k+9)), 8) + & & ISHFT(ICHAR(key(k+10:k+10)), 16) + ISHFT(ICHAR(key(k+11:k+11)), 24) ! Mix it up call b3hs_hash_key_jenkins_mix_() k = k + 12 len_key = len_key - 12 end do char_loop c = c + len_key ! Process remaining bits select case(len_key) case(11) c = c + ISHFT(ICHAR(key(k+10:k+10)), 24) + ISHFT(ICHAR(key(k+9:k+9)), 16) + & & ISHFT(ICHAR(key(k+8:k+8)), 8) b = b + ISHFT(ICHAR(key(k+7:k+7)), 24) + ISHFT(ICHAR(key(k+6:k+6)), 16) + & & ISHFT(ICHAR(key(k+5:k+5)), 8) + ICHAR(key(k+4:k+4)) a = a + ISHFT(ICHAR(key(k+3:k+3)), 24) + ISHFT(ICHAR(key(k+2:k+2)), 16) + & & ISHFT(ICHAR(key(k+1:k+1)), 8) + ICHAR(key(k:k)) case(10) c = c + ISHFT(ICHAR(key(k+9:k+9)), 16) + ISHFT(ICHAR(key(k+8:k+8)), 8) b = b + ISHFT(ICHAR(key(k+7:k+7)), 24) + ISHFT(ICHAR(key(k+6:k+6)), 16) + & & ISHFT(ICHAR(key(k+5:k+5)), 8) + ICHAR(key(k+4:k+4)) a = a + ISHFT(ICHAR(key(k+3:k+3)), 24) + ISHFT(ICHAR(key(k+2:k+2)), 16) + & & ISHFT(ICHAR(key(k+1:k+1)), 8) + ICHAR(key(k:k)) case(9) c = c + ISHFT(ICHAR(key(k+8:k+8)), 8) b = b + ISHFT(ICHAR(key(k+7:k+7)), 24) + ISHFT(ICHAR(key(k+6:k+6)), 16) + & & ISHFT(ICHAR(key(k+5:k+5)), 8) + ICHAR(key(k+4:k+4)) a = a + ISHFT(ICHAR(key(k+3:k+3)), 24) + ISHFT(ICHAR(key(k+2:k+2)), 16) + & & ISHFT(ICHAR(key(k+1:k+1)), 8) + ICHAR(key(k:k)) case(8) b = b + ISHFT(ICHAR(key(k+7:k+7)), 24) + ISHFT(ICHAR(key(k+6:k+6)), 16) + & & ISHFT(ICHAR(key(k+5:k+5)), 8) + ICHAR(key(k+4:k+4)) a = a + ISHFT(ICHAR(key(k+3:k+3)), 24) + ISHFT(ICHAR(key(k+2:k+2)), 16) + & & ISHFT(ICHAR(key(k+1:k+1)), 8) + ICHAR(key(k:k)) case(7) b = b + ISHFT(ICHAR(key(k+6:k+6)), 16) + ISHFT(ICHAR(key(k+5:k+5)), 8) + & & ICHAR(key(k+4:k+4)) a = a + ISHFT(ICHAR(key(k+3:k+3)), 24) + ISHFT(ICHAR(key(k+2:k+2)), 16) + & & ISHFT(ICHAR(key(k+1:k+1)), 8) + ICHAR(key(k:k)) case(6) b = b + ISHFT(ICHAR(key(k+5:k+5)), 8) + ICHAR(key(k+4:k+4)) a = a + ISHFT(ICHAR(key(k+3:k+3)), 24) + ISHFT(ICHAR(key(k+2:k+2)), 16) + & & ISHFT(ICHAR(key(k+1:k+1)), 8) + ICHAR(key(k:k)) case(5) b = b + ICHAR(key(k+4:k+4)) a = a + ISHFT(ICHAR(key(k+3:k+3)), 24) + ISHFT(ICHAR(key(k+2:k+2)), 16) + & & ISHFT(ICHAR(key(k+1:k+1)), 8) + ICHAR(key(k:k)) case(4) a = a + ISHFT(ICHAR(key(k+3:k+3)), 24) + ISHFT(ICHAR(key(k+2:k+2)), 16) + & & ISHFT(ICHAR(key(k+1:k+1)), 8) + ICHAR(key(k:k)) case(3) a = a + ISHFT(ICHAR(key(k+2:k+2)), 16) + ISHFT(ICHAR(key(k+1:k+1)), 8) + & & ICHAR(key(k:k)) case(2) a = a + ISHFT(ICHAR(key(k+1:k+1)), 8) + ICHAR(key(k:k)) case(1) a = a + ICHAR(key(k:k)) end select call b3hs_hash_key_jenkins_mix_() c_i = INT(c) code = IAND(c_i, RANGE - 1) + 1 ! Finish return contains subroutine b3hs_hash_key_jenkins_mix_ ! Mix a, b and c a = IEOR(a - b - c, ISHFT(c, -13)) b = IEOR(b - c - a, ISHFT(a, 8)) c = IEOR(c - a - b, ISHFT(b, -13)) a = IEOR(a - b - c, ISHFT(c, -12)) b = IEOR(b - c - a, ISHFT(a, 16)) c = IEOR(c - a - b, ISHFT(b, -5)) a = IEOR(a - b - c, ISHFT(c, -3)) b = IEOR(b - c - a, ISHFT(a, 10)) c = IEOR(c - a - b, ISHFT(b, -15)) ! Finish return end subroutine b3hs_hash_key_jenkins_mix_ end function b3hs_hash_key_jenkins END MODULE HashModule