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 routines and types for Hartree-Fock-Exchange
10 : !> \par History
11 : !> 11.2006 created [Manuel Guidon]
12 : !> \author Manuel Guidon
13 : ! **************************************************************************************************
14 : MODULE hfx_compression_methods
15 : USE cp_files, ONLY: close_file,&
16 : open_file
17 : USE hfx_compression_core_methods, ONLY: bits2ints_specific,&
18 : ints2bits_specific
19 : USE hfx_types, ONLY: hfx_cache_type,&
20 : hfx_container_type
21 : USE kinds, ONLY: dp,&
22 : int_8
23 : #include "./base/base_uses.f90"
24 :
25 : IMPLICIT NONE
26 : PRIVATE
27 : PUBLIC :: hfx_add_single_cache_element, hfx_get_single_cache_element, &
28 : hfx_reset_cache_and_container, hfx_decompress_first_cache, &
29 : hfx_flush_last_cache, hfx_add_mult_cache_elements, &
30 : hfx_get_mult_cache_elements
31 :
32 : #define CACHE_SIZE 1024
33 :
34 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'hfx_compression_methods'
35 :
36 : INTEGER(kind=int_8), PARAMETER :: ugly_duck = ISHFT(1_int_8, 63)
37 : INTEGER(int_8), PARAMETER :: shifts(0:63) = &
38 : [1_int_8, 2_int_8, 4_int_8, 8_int_8, 16_int_8, 32_int_8, 64_int_8, 128_int_8, 256_int_8, &
39 : 512_int_8, 1024_int_8, 2048_int_8, 4096_int_8, 8192_int_8, 16384_int_8, 32768_int_8, &
40 : 65536_int_8, 131072_int_8, 262144_int_8, 524288_int_8, 1048576_int_8, 2097152_int_8, &
41 : 4194304_int_8, 8388608_int_8, 16777216_int_8, 33554432_int_8, 67108864_int_8, &
42 : 134217728_int_8, 268435456_int_8, 536870912_int_8, 1073741824_int_8, 2147483648_int_8, &
43 : 4294967296_int_8, 8589934592_int_8, 17179869184_int_8, 34359738368_int_8, 68719476736_int_8, &
44 : 137438953472_int_8, 274877906944_int_8, 549755813888_int_8, 1099511627776_int_8, 2199023255552_int_8, &
45 : 4398046511104_int_8, 8796093022208_int_8, 17592186044416_int_8, 35184372088832_int_8, 70368744177664_int_8, &
46 : 140737488355328_int_8, 281474976710656_int_8, 562949953421312_int_8, 1125899906842624_int_8, &
47 : 2251799813685248_int_8, 4503599627370496_int_8, 9007199254740992_int_8, 18014398509481984_int_8, &
48 : 36028797018963968_int_8, 72057594037927936_int_8, 144115188075855872_int_8, 288230376151711744_int_8, &
49 : 576460752303423488_int_8, 1152921504606846976_int_8, 2305843009213693952_int_8, &
50 : 4611686018427387904_int_8, ugly_duck]
51 :
52 : !***
53 :
54 : CONTAINS
55 :
56 : ! **************************************************************************************************
57 : !> \brief - This routine adds an int_8 value to a cache. If the cache is full
58 : !> a compression routine is invoked and the cache is cleared
59 : !> \param value value to be added to the cache
60 : !> \param nbits number of bits to be stored
61 : !> \param cache cache to which we want to add
62 : !> \param container container that contains the compressed elements
63 : !> \param memory_usage ...
64 : !> \param use_disk_storage ...
65 : !> \param max_val_memory ...
66 : !> \par History
67 : !> 10.2007 created [Manuel Guidon]
68 : !> \author Manuel Guidon
69 : ! **************************************************************************************************
70 4820190 : SUBROUTINE hfx_add_single_cache_element(value, nbits, cache, container, memory_usage, use_disk_storage, &
71 : max_val_memory)
72 : INTEGER(int_8) :: value
73 : INTEGER :: nbits
74 : TYPE(hfx_cache_type) :: cache
75 : TYPE(hfx_container_type) :: container
76 : INTEGER :: memory_usage
77 : LOGICAL :: use_disk_storage
78 : INTEGER(int_8), OPTIONAL :: max_val_memory
79 :
80 : INTEGER(int_8) :: int_val
81 :
82 4820190 : int_val = value + shifts(nbits - 1)
83 :
84 4820190 : IF (cache%element_counter /= CACHE_SIZE) THEN
85 4816742 : cache%data(cache%element_counter) = int_val
86 4816742 : cache%element_counter = cache%element_counter + 1
87 : ELSE
88 3448 : cache%data(CACHE_SIZE) = int_val
89 : CALL hfx_compress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage, &
90 3448 : max_val_memory)
91 3448 : cache%element_counter = 1
92 : END IF
93 4820190 : END SUBROUTINE hfx_add_single_cache_element
94 :
95 : ! **************************************************************************************************
96 : !> \brief - This routine compresses a full cache and stores its values
97 : !> in a container. If necessary, a new list entry is allocated
98 : !> \param full_array values from the cache
99 : !> \param container linked list, that stores the compressed values
100 : !> \param nbits number of bits to be stored
101 : !> \param memory_usage ...
102 : !> \param use_disk_storage ...
103 : !> \param max_val_memory ...
104 : !> \par History
105 : !> 10.2007 created [Manuel Guidon]
106 : !> \author Manuel Guidon
107 : ! **************************************************************************************************
108 1938898 : SUBROUTINE hfx_compress_cache(full_array, container, nbits, memory_usage, use_disk_storage, &
109 : max_val_memory)
110 : INTEGER(int_8) :: full_array(*)
111 : TYPE(hfx_container_type) :: container
112 : INTEGER, INTENT(IN) :: nbits
113 : INTEGER :: memory_usage
114 : LOGICAL :: use_disk_storage
115 : INTEGER(int_8), OPTIONAL :: max_val_memory
116 :
117 : INTEGER :: end_idx, increment_counter, start_idx, &
118 : tmp_elements, tmp_nints
119 :
120 1938898 : start_idx = container%element_counter
121 1938898 : increment_counter = (nbits*CACHE_SIZE + 63)/64
122 1938898 : end_idx = start_idx + increment_counter - 1
123 1938898 : IF (end_idx < CACHE_SIZE) THEN
124 1757914 : CALL ints2bits_specific(nbits, CACHE_SIZE, container%current%data(start_idx), full_array(1))
125 1757914 : container%element_counter = container%element_counter + increment_counter
126 : ELSE
127 : !! We have to fill the container first with the remaining number of bits
128 180984 : tmp_elements = CACHE_SIZE - start_idx + 1
129 180984 : tmp_nints = (tmp_elements*64)/nbits
130 180984 : CALL ints2bits_specific(nbits, tmp_nints, container%current%data(start_idx), full_array(1))
131 180984 : IF (use_disk_storage) THEN
132 : !! write to file
133 4850 : WRITE (container%unit) container%current%data
134 4850 : !$OMP ATOMIC
135 : memory_usage = memory_usage + 1
136 4850 : container%file_counter = container%file_counter + 1
137 : ELSE
138 : !! Allocate new list entry
139 180713484 : ALLOCATE (container%current%next)
140 176134 : !$OMP ATOMIC
141 : memory_usage = memory_usage + 1
142 176134 : container%current%next%next => NULL()
143 176134 : container%current => container%current%next
144 176134 : IF (PRESENT(max_val_memory)) max_val_memory = max_val_memory + 1
145 : END IF
146 : !! compress remaining ints
147 180984 : CALL ints2bits_specific(nbits, CACHE_SIZE - tmp_nints, container%current%data(1), full_array(tmp_nints + 1))
148 180984 : container%element_counter = 1 + (nbits*(CACHE_SIZE - tmp_nints) + 63)/64
149 : END IF
150 :
151 1938898 : END SUBROUTINE hfx_compress_cache
152 :
153 : ! **************************************************************************************************
154 : !> \brief - This routine returns an int_8 value from a cache. If the cache is empty
155 : !> a decompression routine is invoked and the cache is refilled with decompressed
156 : !> values from a container
157 : !> \param value value to be retained from the cache
158 : !> \param nbits number of bits with which the value has been compressed
159 : !> \param cache cache from which we get the value
160 : !> \param container container that contains the compressed elements
161 : !> \param memory_usage ...
162 : !> \param use_disk_storage ...
163 : !> \par History
164 : !> 10.2007 created [Manuel Guidon]
165 : !> \author Manuel Guidon
166 : ! **************************************************************************************************
167 65126707 : SUBROUTINE hfx_get_single_cache_element(value, nbits, cache, container, memory_usage, use_disk_storage)
168 : INTEGER(int_8) :: value
169 : INTEGER :: nbits
170 : TYPE(hfx_cache_type) :: cache
171 : TYPE(hfx_container_type) :: container
172 : INTEGER :: memory_usage
173 : LOGICAL :: use_disk_storage
174 :
175 65126707 : IF (cache%element_counter /= CACHE_SIZE) THEN
176 65077359 : value = cache%data(cache%element_counter)
177 65077359 : cache%element_counter = cache%element_counter + 1
178 : ELSE
179 49348 : value = cache%data(CACHE_SIZE)
180 49348 : CALL hfx_decompress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
181 49348 : cache%element_counter = 1
182 : END IF
183 :
184 65126707 : value = value - shifts(nbits - 1)
185 :
186 65126707 : END SUBROUTINE hfx_get_single_cache_element
187 :
188 : ! **************************************************************************************************
189 : !> \brief - This routine decompresses data from a container in order to fill
190 : !> a cache.
191 : !> \param full_array values to be retained from container
192 : !> \param container linked list, that stores the compressed values
193 : !> \param nbits number of bits with which the values have been stored
194 : !> \param memory_usage ...
195 : !> \param use_disk_storage ...
196 : !> \par History
197 : !> 10.2007 created [Manuel Guidon]
198 : !> \author Manuel Guidon
199 : ! **************************************************************************************************
200 8625606 : SUBROUTINE hfx_decompress_cache(full_array, container, nbits, memory_usage, use_disk_storage)
201 : INTEGER(int_8) :: full_array(*)
202 : TYPE(hfx_container_type) :: container
203 : INTEGER, INTENT(IN) :: nbits
204 : INTEGER :: memory_usage
205 : LOGICAL :: use_disk_storage
206 :
207 : INTEGER :: end_idx, increment_counter, start_idx, &
208 : stat, tmp_elements, tmp_nints
209 :
210 8625606 : CPASSERT(ASSOCIATED(container%current))
211 :
212 8625606 : start_idx = container%element_counter
213 8625606 : increment_counter = (nbits*CACHE_SIZE + 63)/64
214 8625606 : end_idx = start_idx + increment_counter - 1
215 8625606 : IF (end_idx < CACHE_SIZE) THEN
216 7596751 : CALL bits2ints_specific(nbits, CACHE_SIZE, container%current%data(start_idx), full_array(1))
217 7596751 : container%element_counter = container%element_counter + increment_counter
218 : ELSE
219 : !! We have to fill the container first with the remaining number of bits
220 1028855 : tmp_elements = CACHE_SIZE - start_idx + 1
221 1028855 : tmp_nints = (tmp_elements*64)/nbits
222 1028855 : CALL bits2ints_specific(nbits, tmp_nints, container%current%data(start_idx), full_array(1))
223 1028855 : IF (use_disk_storage) THEN
224 : !! it could happen, that we are at the end of a file and we try to read
225 : !! This happens in case a container has fully been filled in the compression step
226 : !! but no other was needed for the current bit size
227 : !! Therefore we can safely igonore an eof error
228 38720 : READ (container%unit, IOSTAT=stat) container%current%data
229 38720 : memory_usage = memory_usage + 1
230 38720 : container%file_counter = container%file_counter + 1
231 : ELSE
232 990135 : container%current => container%current%next
233 990135 : memory_usage = memory_usage + 1
234 : END IF
235 : !! decompress remaining ints
236 1028855 : CALL bits2ints_specific(nbits, CACHE_SIZE - tmp_nints, container%current%data(1), full_array(tmp_nints + 1))
237 1028855 : container%element_counter = 1 + (nbits*(CACHE_SIZE - tmp_nints) + 63)/64
238 : END IF
239 8625606 : END SUBROUTINE hfx_decompress_cache
240 :
241 : ! **************************************************************************************************
242 : !> \brief - This routine resets the containers list pointer to the first element and
243 : !> moves the element counters of container and cache to the beginning
244 : !> \param cache cache from which we get the value
245 : !> \param container container that contains the compressed elements
246 : !> \param memory_usage ...
247 : !> \param do_disk_storage ...
248 : !> \par History
249 : !> 10.2007 created [Manuel Guidon]
250 : !> \author Manuel Guidon
251 : ! **************************************************************************************************
252 7988165 : SUBROUTINE hfx_reset_cache_and_container(cache, container, memory_usage, do_disk_storage)
253 : TYPE(hfx_cache_type) :: cache
254 : TYPE(hfx_container_type) :: container
255 : INTEGER :: memory_usage
256 : LOGICAL :: do_disk_storage
257 :
258 7988165 : cache%element_counter = 1
259 7988165 : container%current => container%first
260 7988165 : container%element_counter = 1
261 7988165 : memory_usage = 1
262 7988165 : container%file_counter = 1
263 7988165 : IF (do_disk_storage) THEN
264 3510 : CALL close_file(container%unit)
265 : CALL open_file(file_name=container%filename, file_status="OLD", file_form="UNFORMATTED", file_action="READ", &
266 3510 : unit_number=container%unit)
267 3510 : READ (container%unit) container%current%data
268 : END IF
269 7988165 : END SUBROUTINE hfx_reset_cache_and_container
270 :
271 : ! **************************************************************************************************
272 : !> \brief - This routine decompresses the first bunch of data in a container and
273 : !> copies them into a cache
274 : !> \param nbits number of bits with which the data has been stored
275 : !> \param cache array where we want to decompress the data
276 : !> \param container container that contains the compressed elements
277 : !> \param memory_usage ...
278 : !> \param use_disk_storage ...
279 : !> \par History
280 : !> 10.2007 created [Manuel Guidon]
281 : !> \author Manuel Guidon
282 : ! **************************************************************************************************
283 6400091 : SUBROUTINE hfx_decompress_first_cache(nbits, cache, container, memory_usage, use_disk_storage)
284 : INTEGER :: nbits
285 : TYPE(hfx_cache_type) :: cache
286 : TYPE(hfx_container_type) :: container
287 : INTEGER :: memory_usage
288 : LOGICAL :: use_disk_storage
289 :
290 6400091 : CALL hfx_decompress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
291 6400091 : cache%element_counter = 1
292 6400091 : END SUBROUTINE hfx_decompress_first_cache
293 :
294 : ! **************************************************************************************************
295 : !> \brief - This routine compresses the last probably not yet compressed cache into
296 : !> a container
297 : !> \param nbits number of bits with which the data has been stored
298 : !> \param cache array where we want to decompress the data
299 : !> \param container container that contains the compressed elements
300 : !> \param memory_usage ...
301 : !> \param use_disk_storage ...
302 : !> \par History
303 : !> 10.2007 created [Manuel Guidon]
304 : !> \author Manuel Guidon
305 : ! **************************************************************************************************
306 1588074 : SUBROUTINE hfx_flush_last_cache(nbits, cache, container, memory_usage, use_disk_storage)
307 : INTEGER :: nbits
308 : TYPE(hfx_cache_type) :: cache
309 : TYPE(hfx_container_type) :: container
310 : INTEGER :: memory_usage
311 : LOGICAL :: use_disk_storage
312 :
313 1588074 : CALL hfx_compress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
314 :
315 : !!If we store to file, we have to make sure, that the last container is also written to disk
316 1588074 : IF (use_disk_storage) THEN
317 390 : IF (container%element_counter /= 1) THEN
318 382 : WRITE (container%unit) container%current%data
319 382 : memory_usage = memory_usage + 1
320 382 : container%file_counter = container%file_counter + 1
321 : END IF
322 : END IF
323 1588074 : END SUBROUTINE hfx_flush_last_cache
324 :
325 : ! **************************************************************************************************
326 : !> \brief - This routine adds an a few real values to a cache. If the cache is full
327 : !> a compression routine is invoked and the cache is cleared
328 : !> \param values values to be added to the cache
329 : !> \param nints ...
330 : !> \param nbits number of bits to be stored
331 : !> \param cache cache to which we want to add
332 : !> \param container container that contains the compressed elements
333 : !> \param eps_schwarz ...
334 : !> \param pmax_entry ...
335 : !> \param memory_usage ...
336 : !> \param use_disk_storage ...
337 : !> \par History
338 : !> 10.2007 created [Manuel Guidon]
339 : !> \author Manuel Guidon
340 : ! **************************************************************************************************
341 4780788 : SUBROUTINE hfx_add_mult_cache_elements(values, nints, nbits, cache, container, eps_schwarz, pmax_entry, memory_usage, &
342 : use_disk_storage)
343 : REAL(dp) :: values(*)
344 : INTEGER, INTENT(IN) :: nints, nbits
345 : TYPE(hfx_cache_type) :: cache
346 : TYPE(hfx_container_type) :: container
347 : REAL(dp), INTENT(IN) :: eps_schwarz, pmax_entry
348 : INTEGER :: memory_usage
349 : LOGICAL :: use_disk_storage
350 :
351 : INTEGER :: end_idx, i, start_idx, tmp_elements
352 : INTEGER(int_8) :: shift, tmp
353 : REAL(dp) :: eps_schwarz_inv, factor
354 :
355 4780788 : eps_schwarz_inv = 1.0_dp/eps_schwarz
356 4780788 : factor = eps_schwarz/pmax_entry
357 :
358 4780788 : shift = shifts(nbits - 1)
359 :
360 4780788 : start_idx = cache%element_counter
361 4780788 : end_idx = start_idx + nints - 1
362 4780788 : IF (end_idx < CACHE_SIZE) THEN
363 201544198 : DO i = 1, nints
364 197110786 : values(i) = values(i)*pmax_entry
365 201544198 : IF (ABS(values(i)) > eps_schwarz) THEN
366 107417198 : tmp = NINT(values(i)*eps_schwarz_inv, KIND=int_8)
367 107417198 : cache%data(i + start_idx - 1) = tmp + shift
368 107417198 : values(i) = tmp*factor
369 : ELSE
370 89693588 : values(i) = 0.0_dp
371 89693588 : cache%data(i + start_idx - 1) = shift
372 : END IF
373 : END DO
374 4433412 : cache%element_counter = end_idx + 1
375 : ELSE
376 347376 : tmp_elements = CACHE_SIZE - start_idx + 1
377 111828870 : DO i = 1, tmp_elements
378 111481494 : values(i) = values(i)*pmax_entry
379 111828870 : IF (ABS(values(i)) > eps_schwarz) THEN
380 52349282 : tmp = NINT(values(i)*eps_schwarz_inv, KIND=int_8)
381 52349282 : cache%data(i + start_idx - 1) = tmp + shift
382 52349282 : values(i) = tmp*factor
383 : ELSE
384 59132212 : values(i) = 0.0_dp
385 59132212 : cache%data(i + start_idx - 1) = shift
386 : END IF
387 : END DO
388 347376 : CALL hfx_compress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
389 86879629 : DO i = tmp_elements + 1, nints
390 86532253 : values(i) = values(i)*pmax_entry
391 86879629 : IF (ABS(values(i)) > eps_schwarz) THEN
392 42156434 : tmp = NINT(values(i)*eps_schwarz_inv, KIND=int_8)
393 42156434 : cache%data(i - tmp_elements) = tmp + shift
394 42156434 : values(i) = tmp*factor
395 : ELSE
396 44375819 : values(i) = 0.0_dp
397 44375819 : cache%data(i - tmp_elements) = shift
398 : END IF
399 : END DO
400 347376 : cache%element_counter = nints - tmp_elements + 1
401 : END IF
402 4780788 : END SUBROUTINE hfx_add_mult_cache_elements
403 :
404 : ! **************************************************************************************************
405 : !> \brief - This routine returns a bunch real values from a cache. If the cache is empty
406 : !> a decompression routine is invoked and the cache is refilled with decompressed
407 : !> values from a container
408 : !> \param values value to be retained from the cache
409 : !> \param nints number of values to be retained
410 : !> \param nbits number of bits with which the value has been compressed
411 : !> \param cache cache from which we get the value
412 : !> \param container container that contains the compressed elements
413 : !> \param eps_schwarz threshold for storage
414 : !> \param pmax_entry multiplication factor for values
415 : !> \param memory_usage ...
416 : !> \param use_disk_storage ...
417 : !> \par History
418 : !> 10.2007 created [Manuel Guidon]
419 : !> \author Manuel Guidon
420 : ! **************************************************************************************************
421 65403307 : SUBROUTINE hfx_get_mult_cache_elements(values, nints, nbits, cache, container, eps_schwarz, pmax_entry, memory_usage, &
422 : use_disk_storage)
423 : REAL(dp) :: values(*)
424 : INTEGER, INTENT(IN) :: nints, nbits
425 : TYPE(hfx_cache_type) :: cache
426 : TYPE(hfx_container_type) :: container
427 : REAL(dp), INTENT(IN) :: eps_schwarz, pmax_entry
428 : INTEGER :: memory_usage
429 : LOGICAL :: use_disk_storage
430 :
431 : INTEGER :: end_idx, i, start_idx, tmp_elements
432 : INTEGER(int_8) :: shift
433 : REAL(dp) :: factor
434 :
435 65403307 : factor = eps_schwarz/pmax_entry
436 :
437 65403307 : shift = shifts(nbits - 1)
438 :
439 65403307 : start_idx = cache%element_counter
440 65403307 : end_idx = start_idx + nints - 1
441 :
442 65403307 : IF (end_idx < CACHE_SIZE) THEN
443 1605287608 : DO i = 1, nints
444 1605287608 : values(i) = factor*REAL(cache%data(i + start_idx - 1) - shift, dp)
445 : END DO
446 63227140 : cache%element_counter = end_idx + 1
447 : ELSE
448 2176167 : tmp_elements = CACHE_SIZE - start_idx + 1
449 548320526 : DO i = 1, tmp_elements
450 548320526 : values(i) = factor*REAL(cache%data(i + start_idx - 1) - shift, dp)
451 : END DO
452 2176167 : CALL hfx_decompress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
453 394356382 : DO i = tmp_elements + 1, nints
454 394356382 : values(i) = factor*REAL(cache%data(i - tmp_elements) - shift, dp)
455 : END DO
456 2176167 : cache%element_counter = nints - tmp_elements + 1
457 : END IF
458 65403307 : END SUBROUTINE hfx_get_mult_cache_elements
459 :
460 : END MODULE hfx_compression_methods
461 :
|
