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             : 
       8             : ! **************************************************************************************************
       9             : !> \brief A simple hash table of integer keys, using hash function:
      10             : !>          H(k) = (k*p) mod n + 1
      11             : !>        where:
      12             : !>          k = key
      13             : !>          p = a prime number >= n
      14             : !>          n = size of the hash table
      15             : !>         And collision resolvation is done by open addressing with linear
      16             : !>         probing.
      17             : !>
      18             : !>         The table consists of an array of (key,val) pairs, and
      19             : !>         there are no intermediate buckets. For every new entry (k,v):
      20             : !>         We first look up slot H(k), and if it already contains an entry,
      21             : !>         then move to the next empty slot using a predefined linear probing
      22             : !>         sequence (e.g. iterate from slots H(k) to n, and then 1 to H(k)-1).
      23             : !>         When we look up, we use the same probing sequence.
      24             : !>
      25             : !>         Derived from  qs_fb_hash_table_types.F  (Mark Tucker, Jun 2016)
      26             : ! **************************************************************************************************
      27             : MODULE qs_nl_hash_table_types
      28             : 
      29             :    USE kinds,                           ONLY: int_8
      30             :    USE qs_hash_table_functions,         ONLY: hash_table_matching_prime
      31             :    USE qs_neighbor_list_types,          ONLY: neighbor_list_task_type
      32             : #include "./base/base_uses.f90"
      33             : 
      34             :    IMPLICIT NONE
      35             : 
      36             :    PRIVATE
      37             : 
      38             : ! public types
      39             :    PUBLIC :: nl_hash_table_obj
      40             : 
      41             : ! public methods
      42             :    PUBLIC :: nl_hash_table_create, & !create new table
      43             :              nl_hash_table_release, & !destroy existing table
      44             :              nl_hash_table_add, & !add a new entry to the table
      45             :              nl_hash_table_get_from_index, & !return the value from the specified index of the table
      46             :              nl_hash_table_is_null, &
      47             :              nl_hash_table_status
      48             : 
      49             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_nl_hash_table_types'
      50             : 
      51             : ! key value indicating an empty slot
      52             :    INTEGER(KIND=int_8), PARAMETER, PRIVATE :: EMPTY_KEY = -1_int_8
      53             : ! Parameters related to automatic resizing of the hash_table:
      54             : ! Resize by EXPAND_FACTOR if total no. slots / no. of filled slots < ENLARGE_RATIO
      55             :    INTEGER, PARAMETER, PRIVATE :: ENLARGE_RATIO = 1
      56             :    INTEGER, PARAMETER, PRIVATE :: REDUCE_RATIO = 3
      57             :    INTEGER, PARAMETER, PRIVATE :: EXPAND_FACTOR = 2
      58             :    INTEGER, PARAMETER, PRIVATE :: SHRINK_FACTOR = 2
      59             : 
      60             : ! **************************************************************************************************
      61             : !> \brief hash table entry data type
      62             : !> \param key       : key of the entry
      63             : !> \param val       : value of the entry
      64             : ! **************************************************************************************************
      65             :    TYPE nl_hash_table_element
      66             :       INTEGER(KIND=int_8) :: key
      67             :       TYPE(neighbor_list_task_type), POINTER :: val
      68             :    END TYPE nl_hash_table_element
      69             : 
      70             : ! **************************************************************************************************
      71             : !> \brief data defining a hash table using open addressing for collision
      72             : !>        resolvation. Uses simple entry structure to be memory efficient
      73             : !>        as well as small overhead
      74             : !> \param table     : hash table data area
      75             : !> \param nelements : number of non-empty slots in table
      76             : !> \param nmax      : max number of slots in table
      77             : !> \param prime     : prime number used in the hash function
      78             : ! **************************************************************************************************
      79             :    TYPE nl_hash_table_data
      80             :       TYPE(nl_hash_table_element), DIMENSION(:), POINTER :: table => NULL()
      81             :       INTEGER :: nelements
      82             :       INTEGER :: nmax
      83             :       INTEGER :: prime
      84             :    END TYPE nl_hash_table_data
      85             : 
      86             : ! **************************************************************************************************
      87             : !> \brief the object container which allows for the creation of an array
      88             : !>        of pointers to nl_hash_table objects
      89             : !> \param obj : pointer to the nl_hash_table object
      90             : ! **************************************************************************************************
      91             :    TYPE nl_hash_table_obj
      92             :       TYPE(nl_hash_table_data), POINTER, PRIVATE :: obj => NULL()
      93             :    END TYPE nl_hash_table_obj
      94             : 
      95             : CONTAINS
      96             : 
      97             : ! **************************************************************************************************
      98             : !> \brief Add element to a hash table, auto resize if necessary
      99             : !> \param hash_table : the nl_hash_table object
     100             : !> \param key        : key of the element
     101             : !> \param val        : value of the element
     102             : ! **************************************************************************************************
     103      670152 :    RECURSIVE SUBROUTINE nl_hash_table_add(hash_table, key, val)
     104             :       TYPE(nl_hash_table_obj), INTENT(INOUT)             :: hash_table
     105             :       INTEGER(KIND=int_8), INTENT(IN)                    :: key
     106             :       TYPE(neighbor_list_task_type), INTENT(IN), POINTER :: val
     107             : 
     108             :       INTEGER                                            :: islot
     109             :       LOGICAL                                            :: check_ok
     110             : 
     111      670152 :       check_ok = nl_hash_table_has_data(hash_table)
     112      670152 :       CPASSERT(check_ok)
     113             : 
     114             :       ! check hash table size, if too small rehash in a larger table
     115      670152 :       IF (hash_table%obj%nelements*ENLARGE_RATIO .GE. hash_table%obj%nmax) THEN
     116        1677 :          CALL nl_hash_table_rehash(hash_table=hash_table, nmax=hash_table%obj%nmax*EXPAND_FACTOR)
     117             :       END IF
     118             : 
     119             :       ! find the right slot for the given key
     120      670152 :       islot = nl_hash_table_linear_probe(hash_table, key)
     121      670152 :       CPASSERT(islot > 0)
     122             : 
     123             :       ! add a new task to the list of tasks with that key
     124      670152 :       IF (hash_table%obj%table(islot)%key == EMPTY_KEY) THEN
     125      136896 :          hash_table%obj%nelements = hash_table%obj%nelements + 1
     126      136896 :          hash_table%obj%table(islot)%key = key
     127             :       END IF
     128             : 
     129             :       ! If a task exists, we make our new task point to that i.e. adding it to the beginning of the list
     130      670152 :       IF (ASSOCIATED(hash_table%obj%table(islot)%val)) THEN
     131      533256 :          val%next => hash_table%obj%table(islot)%val
     132             :       END IF
     133             : 
     134             :       ! store the (maybe new) first item in the list in the hash table
     135      670152 :       hash_table%obj%table(islot)%val => val
     136      670152 :    END SUBROUTINE nl_hash_table_add
     137             : 
     138             : ! **************************************************************************************************
     139             : !> \brief Creates and initialises an empty nl_hash_table object
     140             : !> \param hash_table : the nl_hash_table object, its content must be NULL and cannot be UNDEFINED
     141             : !> \param nmax       : total size of the table, optional. If absent default size is 1.
     142             : ! **************************************************************************************************
     143       22861 :    SUBROUTINE nl_hash_table_create(hash_table, nmax)
     144             :       TYPE(nl_hash_table_obj), INTENT(INOUT)             :: hash_table
     145             :       INTEGER, INTENT(IN), OPTIONAL                      :: nmax
     146             : 
     147             :       INTEGER                                            :: my_nmax
     148             :       LOGICAL                                            :: check_ok
     149             : 
     150       22861 :       check_ok = .NOT. nl_hash_table_has_data(hash_table)
     151       22861 :       CPASSERT(check_ok)
     152       22861 :       ALLOCATE (hash_table%obj)
     153             :       NULLIFY (hash_table%obj%table)
     154       22861 :       hash_table%obj%nmax = 0
     155       22861 :       hash_table%obj%nelements = 0
     156       22861 :       hash_table%obj%prime = 2
     157       22861 :       my_nmax = 1
     158       22861 :       IF (PRESENT(nmax)) my_nmax = nmax
     159       22861 :       CALL nl_hash_table_init(hash_table=hash_table, nmax=my_nmax)
     160             : 
     161       22861 :    END SUBROUTINE nl_hash_table_create
     162             : 
     163             : ! **************************************************************************************************
     164             : !> \brief Retrieve value from a hash table given a specified index
     165             : !> \param hash_table : the nl_hash_table object
     166             : !> \param idx        : the index to retrieve the data for
     167             : !> \param val        : output value, might be unassociated if there is no data with that index
     168             : ! **************************************************************************************************
     169      130971 :    SUBROUTINE nl_hash_table_get_from_index(hash_table, idx, val)
     170             :       TYPE(nl_hash_table_obj), INTENT(IN)                :: hash_table
     171             :       INTEGER, INTENT(IN)                                :: idx
     172             :       TYPE(neighbor_list_task_type), INTENT(OUT), &
     173             :          POINTER                                         :: val
     174             : 
     175             :       LOGICAL                                            :: check_ok
     176             : 
     177      130971 :       CPASSERT((idx .GT. 0) .AND. (idx .LE. hash_table%obj%nmax))
     178             : 
     179      130971 :       check_ok = nl_hash_table_has_data(hash_table)
     180      130971 :       CPASSERT(check_ok)
     181             : 
     182      130971 :       val => hash_table%obj%table(idx)%val
     183             : 
     184      130971 :    END SUBROUTINE nl_hash_table_get_from_index
     185             : 
     186             : ! **************************************************************************************************
     187             : !> \brief check if the object has data associated to it
     188             : !> \param hash_table : the nl_hash_table object in question
     189             : !> \return : true if hash_table%obj is associated, false otherwise
     190             : ! **************************************************************************************************
     191     1189025 :    PURE FUNCTION nl_hash_table_has_data(hash_table) RESULT(res)
     192             :       TYPE(nl_hash_table_obj), INTENT(IN)                :: hash_table
     193             :       LOGICAL                                            :: res
     194             : 
     195     1189025 :       res = ASSOCIATED(hash_table%obj)
     196     1189025 :    END FUNCTION nl_hash_table_has_data
     197             : 
     198             : ! **************************************************************************************************
     199             : !> \brief Initialises a nl_hash_table object
     200             : !> \param hash_table : the nl_hash_table object, its content must be NULL and cannot be UNDEFINED
     201             : !> \param nmax       : new size of the table, optional. If absent use the old size
     202             : ! **************************************************************************************************
     203       22861 :    SUBROUTINE nl_hash_table_init(hash_table, nmax)
     204             :       TYPE(nl_hash_table_obj), INTENT(INOUT)             :: hash_table
     205             :       INTEGER, INTENT(IN), OPTIONAL                      :: nmax
     206             : 
     207             :       INTEGER                                            :: ii, my_nmax, two_to_power
     208             :       LOGICAL                                            :: check_ok
     209             : 
     210       22861 :       check_ok = nl_hash_table_has_data(hash_table)
     211       22861 :       CPASSERT(check_ok)
     212       22861 :       my_nmax = hash_table%obj%nmax
     213       22861 :       IF (PRESENT(nmax)) my_nmax = nmax
     214             : 
     215             :       ! table length should always be power of 2. Find the least
     216             :       ! power that is greater or equal to my_nmax
     217       22861 :       two_to_power = 1 ! = 2**0
     218       73782 :       DO WHILE (two_to_power .LT. my_nmax)
     219       50921 :          two_to_power = 2*two_to_power
     220             :       END DO
     221       22861 :       my_nmax = two_to_power
     222             : 
     223       22861 :       IF (ASSOCIATED(hash_table%obj%table)) THEN
     224           0 :          IF (SIZE(hash_table%obj%table) .NE. my_nmax) THEN
     225           0 :             DEALLOCATE (hash_table%obj%table)
     226           0 :             ALLOCATE (hash_table%obj%table(my_nmax))
     227             :          END IF
     228             :       ELSE
     229       68583 :          ALLOCATE (hash_table%obj%table(my_nmax))
     230             :       END IF
     231       22861 :       hash_table%obj%nmax = my_nmax
     232       22861 :       hash_table%obj%prime = hash_table_matching_prime(my_nmax)
     233             : 
     234             :       ! initiate element to be "empty"
     235      348105 :       DO ii = 1, hash_table%obj%nmax
     236      325244 :          hash_table%obj%table(ii)%key = EMPTY_KEY
     237      348105 :          NULLIFY (hash_table%obj%table(ii)%val)
     238             :       END DO
     239       22861 :       hash_table%obj%nelements = 0
     240       22861 :    END SUBROUTINE nl_hash_table_init
     241             : 
     242             : ! **************************************************************************************************
     243             : !> \brief Initialises a nl_hash_table object
     244             : !> \param hash_table : the nl_hash_table object, its content must be NULL and cannot be UNDEFINED
     245             : !> \param key ...
     246             : !> \param is_null ...
     247             : ! **************************************************************************************************
     248      319319 :    SUBROUTINE nl_hash_table_is_null(hash_table, key, is_null)
     249             :       TYPE(nl_hash_table_obj), INTENT(IN)                :: hash_table
     250             :       INTEGER, INTENT(IN)                                :: key
     251             :       LOGICAL, INTENT(OUT)                               :: is_null
     252             : 
     253             :       LOGICAL                                            :: check_ok
     254             : 
     255      319319 :       check_ok = nl_hash_table_has_data(hash_table)
     256      319319 :       CPASSERT(check_ok)
     257      319319 :       check_ok = (key .LE. hash_table%obj%nmax)
     258      319319 :       CPASSERT(check_ok)
     259             : 
     260      319319 :       is_null = .FALSE.
     261      319319 :       IF (EMPTY_KEY == hash_table%obj%table(key)%key) THEN !.OR.
     262             :          !NULLIFY(hash_table%obj%table(key)%val)
     263      188348 :          is_null = .TRUE.
     264             :       END IF
     265      319319 :    END SUBROUTINE nl_hash_table_is_null
     266             : 
     267             : ! **************************************************************************************************
     268             : !> \brief Rehash table. If nmax is present, then also change the table size
     269             : !>        to MAX(nmax, number_of_non_empty_elements).
     270             : !> \param hash_table      : the nl_hash_table object
     271             : !> \param nmax [OPTIONAL] : maximum size of the rehashed table
     272             : ! **************************************************************************************************
     273        1677 :    RECURSIVE SUBROUTINE nl_hash_table_rehash(hash_table, nmax)
     274             :       TYPE(nl_hash_table_obj), INTENT(INOUT)             :: hash_table
     275             :       INTEGER, INTENT(IN), OPTIONAL                      :: nmax
     276             : 
     277             :       INTEGER                                            :: ii, my_nmax
     278             :       TYPE(nl_hash_table_element), ALLOCATABLE, &
     279        1677 :          DIMENSION(:)                                    :: tmp_table
     280             : 
     281        1677 :       IF (.NOT. nl_hash_table_has_data(hash_table)) THEN
     282           0 :          CALL nl_hash_table_create(hash_table, nmax)
     283             :          RETURN
     284             :       END IF
     285        1677 :       IF (PRESENT(nmax)) THEN
     286        1677 :          my_nmax = MAX(nmax, hash_table%obj%nelements)
     287             :       ELSE
     288           0 :          my_nmax = hash_table%obj%nmax
     289             :       END IF
     290        5031 :       ALLOCATE (tmp_table(hash_table%obj%nmax))
     291        7602 :       tmp_table(:) = hash_table%obj%table(:)
     292        1677 :       CALL nl_hash_table_release(hash_table)
     293        1677 :       CALL nl_hash_table_create(hash_table=hash_table, nmax=my_nmax)
     294        7602 :       DO ii = 1, SIZE(tmp_table)
     295        7602 :          IF (tmp_table(ii)%key .NE. EMPTY_KEY) THEN
     296             :             CALL nl_hash_table_add(hash_table=hash_table, &
     297             :                                    key=tmp_table(ii)%key, &
     298        5925 :                                    val=tmp_table(ii)%val)
     299             :          END IF
     300             :       END DO
     301        1677 :       DEALLOCATE (tmp_table)
     302             :    END SUBROUTINE nl_hash_table_rehash
     303             : 
     304             : ! **************************************************************************************************
     305             : !> \brief releases the hash table.  Note that deallocating tasks stored in the table
     306             : !>        is the responsibility of the caller
     307             : !> \param hash_table : the nl_hash_table object in question
     308             : ! **************************************************************************************************
     309       22861 :    SUBROUTINE nl_hash_table_release(hash_table)
     310             :       TYPE(nl_hash_table_obj), INTENT(INOUT)             :: hash_table
     311             : 
     312       22861 :       IF (ASSOCIATED(hash_table%obj)) THEN
     313       22861 :          IF (ASSOCIATED(hash_table%obj%table)) THEN
     314       22861 :             DEALLOCATE (hash_table%obj%table)
     315             :          END IF
     316       22861 :          DEALLOCATE (hash_table%obj)
     317             :       ELSE
     318           0 :          NULLIFY (hash_table%obj)
     319             :       END IF
     320       22861 :    END SUBROUTINE nl_hash_table_release
     321             : 
     322             : ! **************************************************************************************************
     323             : !> \brief outputs the current information about the table
     324             : !> \param hash_table : the nl_hash_table object in question
     325             : !> \param nelements  : number of non-empty slots in the table
     326             : !> \param nmax       : maximum number of slots in the table
     327             : !> \param prime      : the prime used in the hash function
     328             : ! **************************************************************************************************
     329       21184 :    SUBROUTINE nl_hash_table_status(hash_table, nelements, nmax, prime)
     330             :       TYPE(nl_hash_table_obj), INTENT(INOUT)             :: hash_table
     331             :       INTEGER, INTENT(OUT), OPTIONAL                     :: nelements, nmax, prime
     332             : 
     333             :       LOGICAL                                            :: check_ok
     334             : 
     335       21184 :       check_ok = nl_hash_table_has_data(hash_table)
     336       21184 :       CPASSERT(check_ok)
     337       21184 :       IF (PRESENT(nelements)) nelements = hash_table%obj%nelements
     338       21184 :       IF (PRESENT(nmax)) nmax = hash_table%obj%nmax
     339       21184 :       IF (PRESENT(prime)) prime = hash_table%obj%prime
     340       21184 :    END SUBROUTINE nl_hash_table_status
     341             : 
     342             : ! **************************************************************************************************
     343             : !> \brief Linear probing algorithm for the hash table
     344             : !> \param hash_table : the nl_hash_table object
     345             : !> \param key        : key to locate
     346             : !> \return : slot location in the table correspond to key, 0 if key not found
     347             : ! **************************************************************************************************
     348      670152 :    PURE FUNCTION nl_hash_table_linear_probe(hash_table, key) RESULT(islot)
     349             :       TYPE(nl_hash_table_obj), INTENT(IN)                :: hash_table
     350             :       INTEGER(KIND=int_8), INTENT(IN)                    :: key
     351             :       INTEGER                                            :: islot
     352             : 
     353             :       INTEGER                                            :: guess
     354             : 
     355             :       ! first guess is mapped by the hash_function
     356      670152 :       guess = nl_hash_table_hash_function(hash_table, key)
     357             : 
     358             :       ! then search for key and stop at first empty slot from guess to
     359             :       ! nmax.  using the same linear probe for adding and retrieving
     360             :       ! makes all non-empty keys being put before the first empty slot.
     361      862842 :       DO islot = guess, hash_table%obj%nmax
     362      861254 :          IF ((hash_table%obj%table(islot)%key == key) .OR. &
     363        1588 :              (hash_table%obj%table(islot)%key == EMPTY_KEY)) RETURN
     364             :       END DO
     365             : 
     366             :       ! if unsuccessful, search from 1 to guess
     367        1588 :       DO islot = 1, guess - 1
     368        1588 :          IF ((hash_table%obj%table(islot)%key == key) .OR. &
     369           0 :              (hash_table%obj%table(islot)%key == EMPTY_KEY)) RETURN
     370             :       END DO
     371             : 
     372             :       ! if not found and table is full set islot to 0
     373      670152 :       islot = 0
     374             :    END FUNCTION nl_hash_table_linear_probe
     375             : 
     376             : ! **************************************************************************************************
     377             : !> \brief Hash function
     378             : !> \param hash_table : the nl_hash_table object
     379             : !> \param key        : key to locate
     380             : !> \return : slot location in the table correspond to key, 0 if key not found
     381             : ! **************************************************************************************************
     382      670152 :    PURE FUNCTION nl_hash_table_hash_function(hash_table, key) RESULT(hash)
     383             :       TYPE(nl_hash_table_obj), INTENT(IN)                :: hash_table
     384             :       INTEGER(KIND=int_8), INTENT(IN)                    :: key
     385             :       INTEGER                                            :: hash
     386             : 
     387             :       INTEGER(KIND=int_8)                                :: hash_8, nmax_8, prime_8
     388             : 
     389      670152 :       nmax_8 = INT(hash_table%obj%nmax, int_8)
     390      670152 :       prime_8 = INT(hash_table%obj%prime, int_8)
     391             : 
     392             :       ! IAND with nmax-1 is equivalent to MOD nmax if nmax is alway a power of 2.
     393      670152 :       hash_8 = IAND(key*prime_8, nmax_8 - 1) + 1_int_8
     394      670152 :       hash = INT(hash_8)
     395      670152 :    END FUNCTION nl_hash_table_hash_function
     396             : 
     397           0 : END MODULE qs_nl_hash_table_types
     398             :