Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 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 5088839 : 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 5088839 : int_val = value + shifts(nbits - 1)
83 :
84 5088839 : IF (cache%element_counter /= CACHE_SIZE) THEN
85 5085241 : cache%data(cache%element_counter) = int_val
86 5085241 : cache%element_counter = cache%element_counter + 1
87 : ELSE
88 3598 : cache%data(CACHE_SIZE) = int_val
89 : CALL hfx_compress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage, &
90 3598 : max_val_memory)
91 3598 : cache%element_counter = 1
92 : END IF
93 5088839 : 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 1977471 : 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 1977471 : start_idx = container%element_counter
121 1977471 : increment_counter = (nbits*CACHE_SIZE + 63)/64
122 1977471 : end_idx = start_idx + increment_counter - 1
123 1977471 : IF (end_idx < CACHE_SIZE) THEN
124 1791914 : CALL ints2bits_specific(nbits, CACHE_SIZE, container%current%data(start_idx), full_array(1))
125 1791914 : 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 185557 : tmp_elements = CACHE_SIZE - start_idx + 1
129 185557 : tmp_nints = (tmp_elements*64)/nbits
130 185557 : CALL ints2bits_specific(nbits, tmp_nints, container%current%data(start_idx), full_array(1))
131 185557 : IF (use_disk_storage) THEN
132 : !! write to file
133 4840 : WRITE (container%unit) container%current%data
134 4840 : !$OMP ATOMIC
135 : memory_usage = memory_usage + 1
136 4840 : container%file_counter = container%file_counter + 1
137 : ELSE
138 : !! Allocate new list entry
139 185415642 : ALLOCATE (container%current%next)
140 180717 : !$OMP ATOMIC
141 : memory_usage = memory_usage + 1
142 180717 : container%current%next%next => NULL()
143 180717 : container%current => container%current%next
144 180717 : IF (PRESENT(max_val_memory)) max_val_memory = max_val_memory + 1
145 : END IF
146 : !! compress remaining ints
147 185557 : CALL ints2bits_specific(nbits, CACHE_SIZE - tmp_nints, container%current%data(1), full_array(tmp_nints + 1))
148 185557 : container%element_counter = 1 + (nbits*(CACHE_SIZE - tmp_nints) + 63)/64
149 : END IF
150 :
151 1977471 : 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 71642973 : 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 71642973 : IF (cache%element_counter /= CACHE_SIZE) THEN
176 71588848 : value = cache%data(cache%element_counter)
177 71588848 : cache%element_counter = cache%element_counter + 1
178 : ELSE
179 54125 : value = cache%data(CACHE_SIZE)
180 54125 : CALL hfx_decompress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
181 54125 : cache%element_counter = 1
182 : END IF
183 :
184 71642973 : value = value - shifts(nbits - 1)
185 :
186 71642973 : 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 9194386 : 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 9194386 : CPASSERT(ASSOCIATED(container%current))
211 :
212 9194386 : start_idx = container%element_counter
213 9194386 : increment_counter = (nbits*CACHE_SIZE + 63)/64
214 9194386 : end_idx = start_idx + increment_counter - 1
215 9194386 : IF (end_idx < CACHE_SIZE) THEN
216 8072671 : CALL bits2ints_specific(nbits, CACHE_SIZE, container%current%data(start_idx), full_array(1))
217 8072671 : 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 1121715 : tmp_elements = CACHE_SIZE - start_idx + 1
221 1121715 : tmp_nints = (tmp_elements*64)/nbits
222 1121715 : CALL bits2ints_specific(nbits, tmp_nints, container%current%data(start_idx), full_array(1))
223 1121715 : 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 : ! We still need to ask for it to read the data correctly, so we mark it as used
229 38672 : READ (container%unit, IOSTAT=stat) container%current%data
230 : MARK_USED(stat)
231 38672 : memory_usage = memory_usage + 1
232 38672 : container%file_counter = container%file_counter + 1
233 : ELSE
234 1083043 : container%current => container%current%next
235 1083043 : memory_usage = memory_usage + 1
236 : END IF
237 : !! decompress remaining ints
238 1121715 : CALL bits2ints_specific(nbits, CACHE_SIZE - tmp_nints, container%current%data(1), full_array(tmp_nints + 1))
239 1121715 : container%element_counter = 1 + (nbits*(CACHE_SIZE - tmp_nints) + 63)/64
240 : END IF
241 9194386 : END SUBROUTINE hfx_decompress_cache
242 :
243 : ! **************************************************************************************************
244 : !> \brief - This routine resets the containers list pointer to the first element and
245 : !> moves the element counters of container and cache to the beginning
246 : !> \param cache cache from which we get the value
247 : !> \param container container that contains the compressed elements
248 : !> \param memory_usage ...
249 : !> \param do_disk_storage ...
250 : !> \par History
251 : !> 10.2007 created [Manuel Guidon]
252 : !> \author Manuel Guidon
253 : ! **************************************************************************************************
254 8405075 : SUBROUTINE hfx_reset_cache_and_container(cache, container, memory_usage, do_disk_storage)
255 : TYPE(hfx_cache_type) :: cache
256 : TYPE(hfx_container_type) :: container
257 : INTEGER :: memory_usage
258 : LOGICAL :: do_disk_storage
259 :
260 8405075 : cache%element_counter = 1
261 8405075 : container%current => container%first
262 8405075 : container%element_counter = 1
263 8405075 : memory_usage = 1
264 8405075 : container%file_counter = 1
265 8405075 : IF (do_disk_storage) THEN
266 3510 : CALL close_file(container%unit)
267 : CALL open_file(file_name=container%filename, file_status="OLD", file_form="UNFORMATTED", file_action="READ", &
268 3510 : unit_number=container%unit)
269 3510 : READ (container%unit) container%current%data
270 : END IF
271 8405075 : END SUBROUTINE hfx_reset_cache_and_container
272 :
273 : ! **************************************************************************************************
274 : !> \brief - This routine decompresses the first bunch of data in a container and
275 : !> copies them into a cache
276 : !> \param nbits number of bits with which the data has been stored
277 : !> \param cache array where we want to decompress the data
278 : !> \param container container that contains the compressed elements
279 : !> \param memory_usage ...
280 : !> \param use_disk_storage ...
281 : !> \par History
282 : !> 10.2007 created [Manuel Guidon]
283 : !> \author Manuel Guidon
284 : ! **************************************************************************************************
285 6787101 : SUBROUTINE hfx_decompress_first_cache(nbits, cache, container, memory_usage, use_disk_storage)
286 : INTEGER :: nbits
287 : TYPE(hfx_cache_type) :: cache
288 : TYPE(hfx_container_type) :: container
289 : INTEGER :: memory_usage
290 : LOGICAL :: use_disk_storage
291 :
292 6787101 : CALL hfx_decompress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
293 6787101 : cache%element_counter = 1
294 6787101 : END SUBROUTINE hfx_decompress_first_cache
295 :
296 : ! **************************************************************************************************
297 : !> \brief - This routine compresses the last probably not yet compressed cache into
298 : !> a container
299 : !> \param nbits number of bits with which the data has been stored
300 : !> \param cache array where we want to decompress the data
301 : !> \param container container that contains the compressed elements
302 : !> \param memory_usage ...
303 : !> \param use_disk_storage ...
304 : !> \par History
305 : !> 10.2007 created [Manuel Guidon]
306 : !> \author Manuel Guidon
307 : ! **************************************************************************************************
308 1617974 : SUBROUTINE hfx_flush_last_cache(nbits, cache, container, memory_usage, use_disk_storage)
309 : INTEGER :: nbits
310 : TYPE(hfx_cache_type) :: cache
311 : TYPE(hfx_container_type) :: container
312 : INTEGER :: memory_usage
313 : LOGICAL :: use_disk_storage
314 :
315 1617974 : CALL hfx_compress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
316 :
317 : !!If we store to file, we have to make sure, that the last container is also written to disk
318 1617974 : IF (use_disk_storage) THEN
319 390 : IF (container%element_counter /= 1) THEN
320 382 : WRITE (container%unit) container%current%data
321 382 : memory_usage = memory_usage + 1
322 382 : container%file_counter = container%file_counter + 1
323 : END IF
324 : END IF
325 1617974 : END SUBROUTINE hfx_flush_last_cache
326 :
327 : ! **************************************************************************************************
328 : !> \brief - This routine adds an a few real values to a cache. If the cache is full
329 : !> a compression routine is invoked and the cache is cleared
330 : !> \param values values to be added to the cache
331 : !> \param nints ...
332 : !> \param nbits number of bits to be stored
333 : !> \param cache cache to which we want to add
334 : !> \param container container that contains the compressed elements
335 : !> \param eps_schwarz ...
336 : !> \param pmax_entry ...
337 : !> \param memory_usage ...
338 : !> \param use_disk_storage ...
339 : !> \par History
340 : !> 10.2007 created [Manuel Guidon]
341 : !> \author Manuel Guidon
342 : ! **************************************************************************************************
343 5050948 : SUBROUTINE hfx_add_mult_cache_elements(values, nints, nbits, cache, container, eps_schwarz, pmax_entry, memory_usage, &
344 : use_disk_storage)
345 : REAL(dp) :: values(*)
346 : INTEGER, INTENT(IN) :: nints, nbits
347 : TYPE(hfx_cache_type) :: cache
348 : TYPE(hfx_container_type) :: container
349 : REAL(dp), INTENT(IN) :: eps_schwarz, pmax_entry
350 : INTEGER :: memory_usage
351 : LOGICAL :: use_disk_storage
352 :
353 : INTEGER :: end_idx, i, start_idx, tmp_elements
354 : INTEGER(int_8) :: shift, tmp
355 : REAL(dp) :: eps_schwarz_inv, factor
356 :
357 5050948 : eps_schwarz_inv = 1.0_dp/eps_schwarz
358 5050948 : factor = eps_schwarz/pmax_entry
359 :
360 5050948 : shift = shifts(nbits - 1)
361 :
362 5050948 : start_idx = cache%element_counter
363 5050948 : end_idx = start_idx + nints - 1
364 5050948 : IF (end_idx < CACHE_SIZE) THEN
365 208129044 : DO i = 1, nints
366 203433995 : values(i) = values(i)*pmax_entry
367 208129044 : IF (ABS(values(i)) > eps_schwarz) THEN
368 109357406 : tmp = NINT(values(i)*eps_schwarz_inv, KIND=int_8)
369 109357406 : cache%data(i + start_idx - 1) = tmp + shift
370 109357406 : values(i) = tmp*factor
371 : ELSE
372 94076589 : values(i) = 0.0_dp
373 94076589 : cache%data(i + start_idx - 1) = shift
374 : END IF
375 : END DO
376 4695049 : cache%element_counter = end_idx + 1
377 : ELSE
378 355899 : tmp_elements = CACHE_SIZE - start_idx + 1
379 113960024 : DO i = 1, tmp_elements
380 113604125 : values(i) = values(i)*pmax_entry
381 113960024 : IF (ABS(values(i)) > eps_schwarz) THEN
382 52938195 : tmp = NINT(values(i)*eps_schwarz_inv, KIND=int_8)
383 52938195 : cache%data(i + start_idx - 1) = tmp + shift
384 52938195 : values(i) = tmp*factor
385 : ELSE
386 60665930 : values(i) = 0.0_dp
387 60665930 : cache%data(i + start_idx - 1) = shift
388 : END IF
389 : END DO
390 355899 : CALL hfx_compress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
391 88324704 : DO i = tmp_elements + 1, nints
392 87968805 : values(i) = values(i)*pmax_entry
393 88324704 : IF (ABS(values(i)) > eps_schwarz) THEN
394 42586347 : tmp = NINT(values(i)*eps_schwarz_inv, KIND=int_8)
395 42586347 : cache%data(i - tmp_elements) = tmp + shift
396 42586347 : values(i) = tmp*factor
397 : ELSE
398 45382458 : values(i) = 0.0_dp
399 45382458 : cache%data(i - tmp_elements) = shift
400 : END IF
401 : END DO
402 355899 : cache%element_counter = nints - tmp_elements + 1
403 : END IF
404 5050948 : END SUBROUTINE hfx_add_mult_cache_elements
405 :
406 : ! **************************************************************************************************
407 : !> \brief - This routine returns a bunch real values from a cache. If the cache is empty
408 : !> a decompression routine is invoked and the cache is refilled with decompressed
409 : !> values from a container
410 : !> \param values value to be retained from the cache
411 : !> \param nints number of values to be retained
412 : !> \param nbits number of bits with which the value has been compressed
413 : !> \param cache cache from which we get the value
414 : !> \param container container that contains the compressed elements
415 : !> \param eps_schwarz threshold for storage
416 : !> \param pmax_entry multiplication factor for values
417 : !> \param memory_usage ...
418 : !> \param use_disk_storage ...
419 : !> \par History
420 : !> 10.2007 created [Manuel Guidon]
421 : !> \author Manuel Guidon
422 : ! **************************************************************************************************
423 71964577 : SUBROUTINE hfx_get_mult_cache_elements(values, nints, nbits, cache, container, eps_schwarz, pmax_entry, memory_usage, &
424 : use_disk_storage)
425 : REAL(dp) :: values(*)
426 : INTEGER, INTENT(IN) :: nints, nbits
427 : TYPE(hfx_cache_type) :: cache
428 : TYPE(hfx_container_type) :: container
429 : REAL(dp), INTENT(IN) :: eps_schwarz, pmax_entry
430 : INTEGER :: memory_usage
431 : LOGICAL :: use_disk_storage
432 :
433 : INTEGER :: end_idx, i, start_idx, tmp_elements
434 : INTEGER(int_8) :: shift
435 : REAL(dp) :: factor
436 :
437 71964577 : factor = eps_schwarz/pmax_entry
438 :
439 71964577 : shift = shifts(nbits - 1)
440 :
441 71964577 : start_idx = cache%element_counter
442 71964577 : end_idx = start_idx + nints - 1
443 :
444 71964577 : IF (end_idx < CACHE_SIZE) THEN
445 1723781886 : DO i = 1, nints
446 1723781886 : values(i) = factor*REAL(cache%data(i + start_idx - 1) - shift, dp)
447 : END DO
448 69611417 : cache%element_counter = end_idx + 1
449 : ELSE
450 2353160 : tmp_elements = CACHE_SIZE - start_idx + 1
451 601527598 : DO i = 1, tmp_elements
452 601527598 : values(i) = factor*REAL(cache%data(i + start_idx - 1) - shift, dp)
453 : END DO
454 2353160 : CALL hfx_decompress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
455 432252105 : DO i = tmp_elements + 1, nints
456 432252105 : values(i) = factor*REAL(cache%data(i - tmp_elements) - shift, dp)
457 : END DO
458 2353160 : cache%element_counter = nints - tmp_elements + 1
459 : END IF
460 71964577 : END SUBROUTINE hfx_get_mult_cache_elements
461 :
462 : END MODULE hfx_compression_methods
463 :
|
