Line data    Source code

       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : MODULE routine_map
       8             :    USE kinds, ONLY: default_string_length, int_4, int_8
       9             : #include "../base/base_uses.f90"
      10             : 
      11             :    IMPLICIT NONE
      12             :    PRIVATE
      13             : 
      14             :    #:include 'hash_map.fypp'
      15             : 
      16  3851684560 :    #:call hash_map(prefix='routine_map', &
      17             :       key_type='CHARACTER(LEN=default_string_length)', &
      18             :       value_type='INTEGER(kind=int_4)', &
      19             :       key_default_init=' = ""', &
      20             :       value_default_init=' = 0_int_4')
      21             :    #:endcall hash_map
      22             : 
      23             : ! **************************************************************************************************
      24             : ! This is joaat_hash from string_table.F
      25             : !
      26             : !> \brief generates the hash of a given string
      27             : !> \param key a string of any length
      28             : !> \return ...
      29             : !> \par History
      30             : !>       09.2006 created [Joost VandeVondele]
      31             : !>       12.2012 copied and adopted [ole]
      32             : !> \note
      33             : !>       http://en.wikipedia.org/wiki/Hash_table
      34             : !>       http://www.burtleburtle.net/bob/hash/doobs.html
      35             : ! **************************************************************************************************
      36  3089741084 :    PURE FUNCTION routine_map_hash_function(key) RESULT(hash)
      37             :       CHARACTER(LEN=*), INTENT(IN)                       :: key
      38             :       INTEGER(KIND=int_8)                                :: hash
      39             : 
      40             :       INTEGER(KIND=int_8), PARAMETER                     :: b32 = 2_int_8**32 - 1_int_8
      41             : 
      42             :       INTEGER                                            :: i
      43             : 
      44  3089741084 :       hash = 0_int_8
      45 >25026*10^7 :       DO i = 1, LEN(key)
      46 >24717*10^7 :          hash = IAND(hash + ICHAR(key(i:i)), b32)
      47 >24717*10^7 :          hash = IAND(hash + IAND(ISHFT(hash, 10), b32), b32)
      48 >25026*10^7 :          hash = IAND(IEOR(hash, IAND(ISHFT(hash, -6), b32)), b32)
      49             :       END DO
      50  3089741084 :       hash = IAND(hash + IAND(ISHFT(hash, 3), b32), b32)
      51  3089741084 :       hash = IAND(IEOR(hash, IAND(ISHFT(hash, -11), b32)), b32)
      52  3089741084 :       hash = IAND(hash + IAND(ISHFT(hash, 15), b32), b32)
      53  3089741084 :    END FUNCTION routine_map_hash_function
      54             : 
      55             : ! **************************************************************************************************
      56             : !> \brief ...
      57             : !> \param key ...
      58             : !> \return ...
      59             : ! **************************************************************************************************
      60  3082267671 :    PURE FUNCTION routine_map_keys_equal(key1, key2) RESULT(res)
      61             :       CHARACTER(LEN=*), INTENT(IN)                      :: key1, key2
      62             :       LOGICAL                                            :: res
      63             : 
      64  3082267671 :       res = (key1 == key2)
      65  3082267671 :    END FUNCTION routine_map_keys_equal
      66             : 
      67           0 : END MODULE routine_map