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 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 4498753 : 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 4498753 : int_val = value + shifts(nbits - 1)
83 :
84 4498753 : IF (cache%element_counter /= CACHE_SIZE) THEN
85 4495453 : cache%data(cache%element_counter) = int_val
86 4495453 : cache%element_counter = cache%element_counter + 1
87 : ELSE
88 3300 : cache%data(CACHE_SIZE) = int_val
89 : CALL hfx_compress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage, &
90 3300 : max_val_memory)
91 3300 : cache%element_counter = 1
92 : END IF
93 4498753 : 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 1763993 : 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 1763993 : start_idx = container%element_counter
121 1763993 : increment_counter = (nbits*CACHE_SIZE + 63)/64
122 1763993 : end_idx = start_idx + increment_counter - 1
123 1763993 : IF (end_idx < CACHE_SIZE) THEN
124 1626068 : CALL ints2bits_specific(nbits, CACHE_SIZE, container%current%data(start_idx), full_array(1))
125 1626068 : 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 137925 : tmp_elements = CACHE_SIZE - start_idx + 1
129 137925 : tmp_nints = (tmp_elements*64)/nbits
130 137925 : CALL ints2bits_specific(nbits, tmp_nints, container%current%data(start_idx), full_array(1))
131 137925 : 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 136534950 : ALLOCATE (container%current%next)
140 133075 : !$OMP ATOMIC
141 : memory_usage = memory_usage + 1
142 133075 : container%current%next%next => NULL()
143 133075 : container%current => container%current%next
144 133075 : IF (PRESENT(max_val_memory)) max_val_memory = max_val_memory + 1
145 : END IF
146 : !! compress remaining ints
147 137925 : CALL ints2bits_specific(nbits, CACHE_SIZE - tmp_nints, container%current%data(1), full_array(tmp_nints + 1))
148 137925 : container%element_counter = 1 + (nbits*(CACHE_SIZE - tmp_nints) + 63)/64
149 : END IF
150 :
151 1763993 : 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 59779773 : 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 59779773 : IF (cache%element_counter /= CACHE_SIZE) THEN
176 59735379 : value = cache%data(cache%element_counter)
177 59735379 : cache%element_counter = cache%element_counter + 1
178 : ELSE
179 44394 : value = cache%data(CACHE_SIZE)
180 44394 : CALL hfx_decompress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
181 44394 : cache%element_counter = 1
182 : END IF
183 :
184 59779773 : value = value - shifts(nbits - 1)
185 :
186 59779773 : 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 7992773 : 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 7992773 : start_idx = container%element_counter
211 7992773 : increment_counter = (nbits*CACHE_SIZE + 63)/64
212 7992773 : end_idx = start_idx + increment_counter - 1
213 7992773 : IF (end_idx < CACHE_SIZE) THEN
214 7097934 : CALL bits2ints_specific(nbits, CACHE_SIZE, container%current%data(start_idx), full_array(1))
215 7097934 : container%element_counter = container%element_counter + increment_counter
216 : ELSE
217 : !! We have to fill the container first with the remaining number of bits
218 894839 : tmp_elements = CACHE_SIZE - start_idx + 1
219 894839 : tmp_nints = (tmp_elements*64)/nbits
220 894839 : CALL bits2ints_specific(nbits, tmp_nints, container%current%data(start_idx), full_array(1))
221 894839 : IF (use_disk_storage) THEN
222 : !! it could happen, that we are at the end of a file and we try to read
223 : !! This happens in case a container has fully been filled in the compression step
224 : !! but no other was needed for the current bit size
225 : !! Therefore we can safely igonore an eof error
226 19360 : READ (container%unit, IOSTAT=stat) container%current%data
227 19360 : memory_usage = memory_usage + 1
228 19360 : container%file_counter = container%file_counter + 1
229 : ELSE
230 875479 : container%current => container%current%next
231 875479 : memory_usage = memory_usage + 1
232 : END IF
233 : !! decompress remaining ints
234 894839 : CALL bits2ints_specific(nbits, CACHE_SIZE - tmp_nints, container%current%data(1), full_array(tmp_nints + 1))
235 894839 : container%element_counter = 1 + (nbits*(CACHE_SIZE - tmp_nints) + 63)/64
236 : END IF
237 7992773 : END SUBROUTINE hfx_decompress_cache
238 :
239 : ! **************************************************************************************************
240 : !> \brief - This routine resets the containers list pointer to the first element and
241 : !> moves the element counters of container and cache to the beginning
242 : !> \param cache cache from which we get the value
243 : !> \param container container that contains the compressed elements
244 : !> \param memory_usage ...
245 : !> \param do_disk_storage ...
246 : !> \par History
247 : !> 10.2007 created [Manuel Guidon]
248 : !> \author Manuel Guidon
249 : ! **************************************************************************************************
250 7586465 : SUBROUTINE hfx_reset_cache_and_container(cache, container, memory_usage, do_disk_storage)
251 : TYPE(hfx_cache_type) :: cache
252 : TYPE(hfx_container_type) :: container
253 : INTEGER :: memory_usage
254 : LOGICAL :: do_disk_storage
255 :
256 7586465 : cache%element_counter = 1
257 7586465 : container%current => container%first
258 7586465 : container%element_counter = 1
259 7586465 : memory_usage = 1
260 7586465 : container%file_counter = 1
261 7586465 : IF (do_disk_storage) THEN
262 1950 : CALL close_file(container%unit)
263 : CALL open_file(file_name=container%filename, file_status="OLD", file_form="UNFORMATTED", file_action="READ", &
264 1950 : unit_number=container%unit)
265 1950 : READ (container%unit) container%current%data
266 : END IF
267 7586465 : END SUBROUTINE hfx_reset_cache_and_container
268 :
269 : ! **************************************************************************************************
270 : !> \brief - This routine decompresses the first bunch of data in a container and
271 : !> copies them into a cache
272 : !> \param nbits number of bits with which the data has been stored
273 : !> \param cache array where we want to decompress the data
274 : !> \param container container that contains the compressed elements
275 : !> \param memory_usage ...
276 : !> \param use_disk_storage ...
277 : !> \par History
278 : !> 10.2007 created [Manuel Guidon]
279 : !> \author Manuel Guidon
280 : ! **************************************************************************************************
281 6090821 : SUBROUTINE hfx_decompress_first_cache(nbits, cache, container, memory_usage, use_disk_storage)
282 : INTEGER :: nbits
283 : TYPE(hfx_cache_type) :: cache
284 : TYPE(hfx_container_type) :: container
285 : INTEGER :: memory_usage
286 : LOGICAL :: use_disk_storage
287 :
288 6090821 : CALL hfx_decompress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
289 6090821 : cache%element_counter = 1
290 6090821 : END SUBROUTINE hfx_decompress_first_cache
291 :
292 : ! **************************************************************************************************
293 : !> \brief - This routine compresses the last probably not yet compressed cache into
294 : !> a container
295 : !> \param nbits number of bits with which the data has been stored
296 : !> \param cache array where we want to decompress the data
297 : !> \param container container that contains the compressed elements
298 : !> \param memory_usage ...
299 : !> \param use_disk_storage ...
300 : !> \par History
301 : !> 10.2007 created [Manuel Guidon]
302 : !> \author Manuel Guidon
303 : ! **************************************************************************************************
304 1495644 : SUBROUTINE hfx_flush_last_cache(nbits, cache, container, memory_usage, use_disk_storage)
305 : INTEGER :: nbits
306 : TYPE(hfx_cache_type) :: cache
307 : TYPE(hfx_container_type) :: container
308 : INTEGER :: memory_usage
309 : LOGICAL :: use_disk_storage
310 :
311 1495644 : CALL hfx_compress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
312 :
313 : !!If we store to file, we have to make sure, that the last container is also written to disk
314 1495644 : IF (use_disk_storage) THEN
315 390 : IF (container%element_counter /= 1) THEN
316 382 : WRITE (container%unit) container%current%data
317 382 : memory_usage = memory_usage + 1
318 382 : container%file_counter = container%file_counter + 1
319 : END IF
320 : END IF
321 1495644 : END SUBROUTINE hfx_flush_last_cache
322 :
323 : ! **************************************************************************************************
324 : !> \brief - This routine adds an a few real values to a cache. If the cache is full
325 : !> a compression routine is invoked and the cache is cleared
326 : !> \param values values to be added to the cache
327 : !> \param nints ...
328 : !> \param nbits number of bits to be stored
329 : !> \param cache cache to which we want to add
330 : !> \param container container that contains the compressed elements
331 : !> \param eps_schwarz ...
332 : !> \param pmax_entry ...
333 : !> \param memory_usage ...
334 : !> \param use_disk_storage ...
335 : !> \par History
336 : !> 10.2007 created [Manuel Guidon]
337 : !> \author Manuel Guidon
338 : ! **************************************************************************************************
339 4418051 : SUBROUTINE hfx_add_mult_cache_elements(values, nints, nbits, cache, container, eps_schwarz, pmax_entry, memory_usage, &
340 : use_disk_storage)
341 : REAL(dp) :: values(*)
342 : INTEGER, INTENT(IN) :: nints, nbits
343 : TYPE(hfx_cache_type) :: cache
344 : TYPE(hfx_container_type) :: container
345 : REAL(dp), INTENT(IN) :: eps_schwarz, pmax_entry
346 : INTEGER :: memory_usage
347 : LOGICAL :: use_disk_storage
348 :
349 : INTEGER :: end_idx, i, start_idx, tmp_elements
350 : INTEGER(int_8) :: shift, tmp
351 : REAL(dp) :: eps_schwarz_inv, factor
352 :
353 4418051 : eps_schwarz_inv = 1.0_dp/eps_schwarz
354 4418051 : factor = eps_schwarz/pmax_entry
355 :
356 4418051 : shift = shifts(nbits - 1)
357 :
358 4418051 : start_idx = cache%element_counter
359 4418051 : end_idx = start_idx + nints - 1
360 4418051 : IF (end_idx < CACHE_SIZE) THEN
361 170211516 : DO i = 1, nints
362 166058514 : values(i) = values(i)*pmax_entry
363 170211516 : IF (ABS(values(i)) > eps_schwarz) THEN
364 87457807 : tmp = NINT(values(i)*eps_schwarz_inv, KIND=int_8)
365 87457807 : cache%data(i + start_idx - 1) = tmp + shift
366 87457807 : values(i) = tmp*factor
367 : ELSE
368 78600707 : values(i) = 0.0_dp
369 78600707 : cache%data(i + start_idx - 1) = shift
370 : END IF
371 : END DO
372 4153002 : cache%element_counter = end_idx + 1
373 : ELSE
374 265049 : tmp_elements = CACHE_SIZE - start_idx + 1
375 82218199 : DO i = 1, tmp_elements
376 81953150 : values(i) = values(i)*pmax_entry
377 82218199 : IF (ABS(values(i)) > eps_schwarz) THEN
378 35199290 : tmp = NINT(values(i)*eps_schwarz_inv, KIND=int_8)
379 35199290 : cache%data(i + start_idx - 1) = tmp + shift
380 35199290 : values(i) = tmp*factor
381 : ELSE
382 46753860 : values(i) = 0.0_dp
383 46753860 : cache%data(i + start_idx - 1) = shift
384 : END IF
385 : END DO
386 265049 : CALL hfx_compress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
387 58299680 : DO i = tmp_elements + 1, nints
388 58034631 : values(i) = values(i)*pmax_entry
389 58299680 : IF (ABS(values(i)) > eps_schwarz) THEN
390 25234440 : tmp = NINT(values(i)*eps_schwarz_inv, KIND=int_8)
391 25234440 : cache%data(i - tmp_elements) = tmp + shift
392 25234440 : values(i) = tmp*factor
393 : ELSE
394 32800191 : values(i) = 0.0_dp
395 32800191 : cache%data(i - tmp_elements) = shift
396 : END IF
397 : END DO
398 265049 : cache%element_counter = nints - tmp_elements + 1
399 : END IF
400 4418051 : END SUBROUTINE hfx_add_mult_cache_elements
401 :
402 : ! **************************************************************************************************
403 : !> \brief - This routine returns a bunch real values from a cache. If the cache is empty
404 : !> a decompression routine is invoked and the cache is refilled with decompressed
405 : !> values from a container
406 : !> \param values value to be retained from the cache
407 : !> \param nints number of values to be retained
408 : !> \param nbits number of bits with which the value has been compressed
409 : !> \param cache cache from which we get the value
410 : !> \param container container that contains the compressed elements
411 : !> \param eps_schwarz threshold for storage
412 : !> \param pmax_entry multiplication factor for values
413 : !> \param memory_usage ...
414 : !> \param use_disk_storage ...
415 : !> \par History
416 : !> 10.2007 created [Manuel Guidon]
417 : !> \author Manuel Guidon
418 : ! **************************************************************************************************
419 59975368 : SUBROUTINE hfx_get_mult_cache_elements(values, nints, nbits, cache, container, eps_schwarz, pmax_entry, memory_usage, &
420 : use_disk_storage)
421 : REAL(dp) :: values(*)
422 : INTEGER, INTENT(IN) :: nints, nbits
423 : TYPE(hfx_cache_type) :: cache
424 : TYPE(hfx_container_type) :: container
425 : REAL(dp), INTENT(IN) :: eps_schwarz, pmax_entry
426 : INTEGER :: memory_usage
427 : LOGICAL :: use_disk_storage
428 :
429 : INTEGER :: end_idx, i, start_idx, tmp_elements
430 : INTEGER(int_8) :: shift
431 : REAL(dp) :: factor
432 :
433 59975368 : factor = eps_schwarz/pmax_entry
434 :
435 59975368 : shift = shifts(nbits - 1)
436 :
437 59975368 : start_idx = cache%element_counter
438 59975368 : end_idx = start_idx + nints - 1
439 :
440 59975368 : IF (end_idx < CACHE_SIZE) THEN
441 1401239261 : DO i = 1, nints
442 1401239261 : values(i) = factor*REAL(cache%data(i + start_idx - 1) - shift, dp)
443 : END DO
444 58117810 : cache%element_counter = end_idx + 1
445 : ELSE
446 1857558 : tmp_elements = CACHE_SIZE - start_idx + 1
447 474868965 : DO i = 1, tmp_elements
448 474868965 : values(i) = factor*REAL(cache%data(i + start_idx - 1) - shift, dp)
449 : END DO
450 1857558 : CALL hfx_decompress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
451 326552549 : DO i = tmp_elements + 1, nints
452 326552549 : values(i) = factor*REAL(cache%data(i - tmp_elements) - shift, dp)
453 : END DO
454 1857558 : cache%element_counter = nints - tmp_elements + 1
455 : END IF
456 59975368 : END SUBROUTINE hfx_get_mult_cache_elements
457 :
458 : END MODULE hfx_compression_methods
459 :
|
