Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 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 = -1_int_8
67 : TYPE(neighbor_list_task_type), POINTER :: val => NULL()
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 = -1
82 : INTEGER :: nmax = -1
83 : INTEGER :: prime = -1
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 701229 : 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 701229 : check_ok = nl_hash_table_has_data(hash_table)
112 701229 : CPASSERT(check_ok)
113 :
114 : ! check hash table size, if too small rehash in a larger table
115 701229 : IF (hash_table%obj%nelements*ENLARGE_RATIO .GE. hash_table%obj%nmax) THEN
116 1758 : 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 701229 : islot = nl_hash_table_linear_probe(hash_table, key)
121 701229 : CPASSERT(islot > 0)
122 :
123 : ! add a new task to the list of tasks with that key
124 701229 : IF (hash_table%obj%table(islot)%key == EMPTY_KEY) THEN
125 142545 : hash_table%obj%nelements = hash_table%obj%nelements + 1
126 142545 : 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 701229 : IF (ASSOCIATED(hash_table%obj%table(islot)%val)) THEN
131 558684 : 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 701229 : hash_table%obj%table(islot)%val => val
136 701229 : 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 24104 : 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 24104 : check_ok = .NOT. nl_hash_table_has_data(hash_table)
151 24104 : CPASSERT(check_ok)
152 24104 : ALLOCATE (hash_table%obj)
153 : NULLIFY (hash_table%obj%table)
154 24104 : hash_table%obj%nmax = 0
155 24104 : hash_table%obj%nelements = 0
156 24104 : hash_table%obj%prime = 2
157 24104 : my_nmax = 1
158 24104 : IF (PRESENT(nmax)) my_nmax = nmax
159 24104 : CALL nl_hash_table_init(hash_table=hash_table, nmax=my_nmax)
160 :
161 24104 : 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 136458 : 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 136458 : CPASSERT((idx .GT. 0) .AND. (idx .LE. hash_table%obj%nmax))
178 :
179 136458 : check_ok = nl_hash_table_has_data(hash_table)
180 136458 : CPASSERT(check_ok)
181 :
182 136458 : val => hash_table%obj%table(idx)%val
183 :
184 136458 : 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 1241374 : 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 1241374 : res = ASSOCIATED(hash_table%obj)
196 1241374 : 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 24104 : 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 24104 : check_ok = nl_hash_table_has_data(hash_table)
211 24104 : CPASSERT(check_ok)
212 24104 : my_nmax = hash_table%obj%nmax
213 24104 : 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 24104 : two_to_power = 1 ! = 2**0
218 77953 : DO WHILE (two_to_power .LT. my_nmax)
219 53849 : two_to_power = 2*two_to_power
220 : END DO
221 24104 : my_nmax = two_to_power
222 :
223 24104 : 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 409774 : ALLOCATE (hash_table%obj%table(my_nmax))
230 : END IF
231 24104 : hash_table%obj%nmax = my_nmax
232 24104 : hash_table%obj%prime = hash_table_matching_prime(my_nmax)
233 :
234 : ! initiate element to be "empty"
235 361566 : DO ii = 1, hash_table%obj%nmax
236 337462 : hash_table%obj%table(ii)%key = EMPTY_KEY
237 361566 : NULLIFY (hash_table%obj%table(ii)%val)
238 : END DO
239 24104 : hash_table%obj%nelements = 0
240 24104 : 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 331375 : 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 331375 : check_ok = nl_hash_table_has_data(hash_table)
256 331375 : CPASSERT(check_ok)
257 331375 : check_ok = (key .LE. hash_table%obj%nmax)
258 331375 : CPASSERT(check_ok)
259 :
260 331375 : is_null = .FALSE.
261 331375 : IF (EMPTY_KEY == hash_table%obj%table(key)%key) THEN !.OR.
262 : !NULLIFY(hash_table%obj%table(key)%val)
263 194917 : is_null = .TRUE.
264 : END IF
265 331375 : 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 1758 : 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 1758 : DIMENSION(:) :: tmp_table
280 :
281 1758 : 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 1758 : IF (PRESENT(nmax)) THEN
286 1758 : my_nmax = MAX(nmax, hash_table%obj%nelements)
287 : ELSE
288 0 : my_nmax = hash_table%obj%nmax
289 : END IF
290 11361 : ALLOCATE (tmp_table(hash_table%obj%nmax))
291 7845 : tmp_table(:) = hash_table%obj%table(:)
292 1758 : CALL nl_hash_table_release(hash_table)
293 1758 : CALL nl_hash_table_create(hash_table=hash_table, nmax=my_nmax)
294 7845 : DO ii = 1, SIZE(tmp_table)
295 7845 : 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 6087 : val=tmp_table(ii)%val)
299 : END IF
300 : END DO
301 1758 : 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 24104 : SUBROUTINE nl_hash_table_release(hash_table)
310 : TYPE(nl_hash_table_obj), INTENT(INOUT) :: hash_table
311 :
312 24104 : IF (ASSOCIATED(hash_table%obj)) THEN
313 24104 : IF (ASSOCIATED(hash_table%obj%table)) THEN
314 24104 : DEALLOCATE (hash_table%obj%table)
315 : END IF
316 24104 : DEALLOCATE (hash_table%obj)
317 : ELSE
318 0 : NULLIFY (hash_table%obj)
319 : END IF
320 24104 : 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 22346 : 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 22346 : check_ok = nl_hash_table_has_data(hash_table)
336 22346 : CPASSERT(check_ok)
337 22346 : IF (PRESENT(nelements)) nelements = hash_table%obj%nelements
338 22346 : IF (PRESENT(nmax)) nmax = hash_table%obj%nmax
339 22346 : IF (PRESENT(prime)) prime = hash_table%obj%prime
340 22346 : 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 701229 : 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 701229 : 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 895910 : DO islot = guess, hash_table%obj%nmax
362 894178 : IF ((hash_table%obj%table(islot)%key == key) .OR. &
363 1732 : (hash_table%obj%table(islot)%key == EMPTY_KEY)) RETURN
364 : END DO
365 :
366 : ! if unsuccessful, search from 1 to guess
367 1732 : DO islot = 1, guess - 1
368 1732 : 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 701229 : 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 701229 : 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 701229 : nmax_8 = INT(hash_table%obj%nmax, int_8)
390 701229 : 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 701229 : hash_8 = IAND(key*prime_8, nmax_8 - 1) + 1_int_8
394 701229 : hash = INT(hash_8)
395 701229 : END FUNCTION nl_hash_table_hash_function
396 :
397 0 : END MODULE qs_nl_hash_table_types
398 :
|
