23#include "./base/base_uses.f90"
32#define CACHE_SIZE 1024
34 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'hfx_compression_methods'
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/)
72 INTEGER(int_8) :: value
76 INTEGER :: memory_usage
77 LOGICAL :: use_disk_storage
78 INTEGER(int_8),
OPTIONAL :: max_val_memory
80 INTEGER(int_8) :: int_val
82 int_val =
value + shifts(nbits - 1)
84 IF (cache%element_counter /= cache_size)
THEN
85 cache%data(cache%element_counter) = int_val
86 cache%element_counter = cache%element_counter + 1
88 cache%data(cache_size) = int_val
89 CALL hfx_compress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage, &
91 cache%element_counter = 1
108 SUBROUTINE hfx_compress_cache(full_array, container, nbits, memory_usage, use_disk_storage, &
110 INTEGER(int_8) :: full_array(*)
112 INTEGER,
INTENT(IN) :: nbits
113 INTEGER :: memory_usage
114 LOGICAL :: use_disk_storage
115 INTEGER(int_8),
OPTIONAL :: max_val_memory
117 INTEGER :: end_idx, increment_counter, start_idx, &
118 tmp_elements, tmp_nints
120 start_idx = container%element_counter
121 increment_counter = (nbits*cache_size + 63)/64
122 end_idx = start_idx + increment_counter - 1
123 IF (end_idx < cache_size)
THEN
124 CALL ints2bits_specific(nbits, cache_size, container%current%data(start_idx), full_array(1))
125 container%element_counter = container%element_counter + increment_counter
128 tmp_elements = cache_size - start_idx + 1
129 tmp_nints = (tmp_elements*64)/nbits
130 CALL ints2bits_specific(nbits, tmp_nints, container%current%data(start_idx), full_array(1))
131 IF (use_disk_storage)
THEN
133 WRITE (container%unit) container%current%data
135 memory_usage = memory_usage + 1
136 container%file_counter = container%file_counter + 1
139 ALLOCATE (container%current%next)
141 memory_usage = memory_usage + 1
142 container%current%next%next => null()
143 container%current => container%current%next
144 IF (
PRESENT(max_val_memory)) max_val_memory = max_val_memory + 1
147 CALL ints2bits_specific(nbits, cache_size - tmp_nints, container%current%data(1), full_array(tmp_nints + 1))
148 container%element_counter = 1 + (nbits*(cache_size - tmp_nints) + 63)/64
151 END SUBROUTINE hfx_compress_cache
168 INTEGER(int_8) :: value
172 INTEGER :: memory_usage
173 LOGICAL :: use_disk_storage
175 IF (cache%element_counter /= cache_size)
THEN
176 value = cache%data(cache%element_counter)
177 cache%element_counter = cache%element_counter + 1
179 value = cache%data(cache_size)
180 CALL hfx_decompress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
181 cache%element_counter = 1
184 value =
value - shifts(nbits - 1)
200 SUBROUTINE hfx_decompress_cache(full_array, container, nbits, memory_usage, use_disk_storage)
201 INTEGER(int_8) :: full_array(*)
203 INTEGER,
INTENT(IN) :: nbits
204 INTEGER :: memory_usage
205 LOGICAL :: use_disk_storage
207 INTEGER :: end_idx, increment_counter, start_idx, &
208 stat, tmp_elements, tmp_nints
210 start_idx = container%element_counter
211 increment_counter = (nbits*cache_size + 63)/64
212 end_idx = start_idx + increment_counter - 1
213 IF (end_idx < cache_size)
THEN
214 CALL bits2ints_specific(nbits, cache_size, container%current%data(start_idx), full_array(1))
215 container%element_counter = container%element_counter + increment_counter
218 tmp_elements = cache_size - start_idx + 1
219 tmp_nints = (tmp_elements*64)/nbits
220 CALL bits2ints_specific(nbits, tmp_nints, container%current%data(start_idx), full_array(1))
221 IF (use_disk_storage)
THEN
226 READ (container%unit, iostat=stat) container%current%data
227 memory_usage = memory_usage + 1
228 container%file_counter = container%file_counter + 1
230 container%current => container%current%next
231 memory_usage = memory_usage + 1
234 CALL bits2ints_specific(nbits, cache_size - tmp_nints, container%current%data(1), full_array(tmp_nints + 1))
235 container%element_counter = 1 + (nbits*(cache_size - tmp_nints) + 63)/64
237 END SUBROUTINE hfx_decompress_cache
253 INTEGER :: memory_usage
254 LOGICAL :: do_disk_storage
256 cache%element_counter = 1
257 container%current => container%first
258 container%element_counter = 1
260 container%file_counter = 1
261 IF (do_disk_storage)
THEN
263 CALL open_file(file_name=container%filename, file_status=
"OLD", file_form=
"UNFORMATTED", file_action=
"READ", &
264 unit_number=container%unit)
265 READ (container%unit) container%current%data
285 INTEGER :: memory_usage
286 LOGICAL :: use_disk_storage
288 CALL hfx_decompress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
289 cache%element_counter = 1
308 INTEGER :: memory_usage
309 LOGICAL :: use_disk_storage
311 CALL hfx_compress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
314 IF (use_disk_storage)
THEN
315 IF (container%element_counter /= 1)
THEN
316 WRITE (container%unit) container%current%data
317 memory_usage = memory_usage + 1
318 container%file_counter = container%file_counter + 1
341 REAL(
dp) :: values(*)
342 INTEGER,
INTENT(IN) :: nints, nbits
345 REAL(
dp),
INTENT(IN) :: eps_schwarz, pmax_entry
346 INTEGER :: memory_usage
347 LOGICAL :: use_disk_storage
349 INTEGER :: end_idx, i, start_idx, tmp_elements
350 INTEGER(int_8) :: shift, tmp
351 REAL(
dp) :: eps_schwarz_inv, factor
353 eps_schwarz_inv = 1.0_dp/eps_schwarz
354 factor = eps_schwarz/pmax_entry
356 shift = shifts(nbits - 1)
358 start_idx = cache%element_counter
359 end_idx = start_idx + nints - 1
360 IF (end_idx < cache_size)
THEN
362 values(i) = values(i)*pmax_entry
363 IF (abs(values(i)) > eps_schwarz)
THEN
364 tmp = nint(values(i)*eps_schwarz_inv, kind=
int_8)
365 cache%data(i + start_idx - 1) = tmp + shift
366 values(i) = tmp*factor
369 cache%data(i + start_idx - 1) = shift
372 cache%element_counter = end_idx + 1
374 tmp_elements = cache_size - start_idx + 1
375 DO i = 1, tmp_elements
376 values(i) = values(i)*pmax_entry
377 IF (abs(values(i)) > eps_schwarz)
THEN
378 tmp = nint(values(i)*eps_schwarz_inv, kind=
int_8)
379 cache%data(i + start_idx - 1) = tmp + shift
380 values(i) = tmp*factor
383 cache%data(i + start_idx - 1) = shift
386 CALL hfx_compress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
387 DO i = tmp_elements + 1, nints
388 values(i) = values(i)*pmax_entry
389 IF (abs(values(i)) > eps_schwarz)
THEN
390 tmp = nint(values(i)*eps_schwarz_inv, kind=
int_8)
391 cache%data(i - tmp_elements) = tmp + shift
392 values(i) = tmp*factor
395 cache%data(i - tmp_elements) = shift
398 cache%element_counter = nints - tmp_elements + 1
421 REAL(
dp) :: values(*)
422 INTEGER,
INTENT(IN) :: nints, nbits
425 REAL(
dp),
INTENT(IN) :: eps_schwarz, pmax_entry
426 INTEGER :: memory_usage
427 LOGICAL :: use_disk_storage
429 INTEGER :: end_idx, i, start_idx, tmp_elements
430 INTEGER(int_8) :: shift
433 factor = eps_schwarz/pmax_entry
435 shift = shifts(nbits - 1)
437 start_idx = cache%element_counter
438 end_idx = start_idx + nints - 1
440 IF (end_idx < cache_size)
THEN
442 values(i) = factor*real(cache%data(i + start_idx - 1) - shift,
dp)
444 cache%element_counter = end_idx + 1
446 tmp_elements = cache_size - start_idx + 1
447 DO i = 1, tmp_elements
448 values(i) = factor*real(cache%data(i + start_idx - 1) - shift,
dp)
450 CALL hfx_decompress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage)
451 DO i = tmp_elements + 1, nints
452 values(i) = factor*real(cache%data(i - tmp_elements) - shift,
dp)
454 cache%element_counter = nints - tmp_elements + 1
Utility routines to open and close files. Tracking of preconnections.
subroutine, public open_file(file_name, file_status, file_form, file_action, file_position, file_pad, unit_number, debug, skip_get_unit_number, file_access)
Opens the requested file using a free unit number.
subroutine, public close_file(unit_number, file_status, keep_preconnection)
Close an open file given by its logical unit number. Optionally, keep the file and unit preconnected.
Contains routines for data compression. PLEASE DO NOT MODIFY.
subroutine, public bits2ints_specific(nbits, ndata, packed_data, full_data)
...
subroutine, public ints2bits_specific(nbits, ndata, packed_data, full_data)
...
routines and types for Hartree-Fock-Exchange
subroutine, public hfx_add_single_cache_element(value, nbits, cache, container, memory_usage, use_disk_storage, max_val_memory)
This routine adds an int_8 value to a cache. If the cache is full a compression routine is invoked an...
subroutine, public hfx_get_mult_cache_elements(values, nints, nbits, cache, container, eps_schwarz, pmax_entry, memory_usage, use_disk_storage)
This routine returns a bunch real values from a cache. If the cache is empty a decompression routine ...
subroutine, public hfx_flush_last_cache(nbits, cache, container, memory_usage, use_disk_storage)
This routine compresses the last probably not yet compressed cache into a container
subroutine, public hfx_get_single_cache_element(value, nbits, cache, container, memory_usage, use_disk_storage)
This routine returns an int_8 value from a cache. If the cache is empty a decompression routine is in...
subroutine, public hfx_decompress_first_cache(nbits, cache, container, memory_usage, use_disk_storage)
This routine decompresses the first bunch of data in a container and copies them into a cache
subroutine, public hfx_add_mult_cache_elements(values, nints, nbits, cache, container, eps_schwarz, pmax_entry, memory_usage, use_disk_storage)
This routine adds an a few real values to a cache. If the cache is full a compression routine is invo...
subroutine, public hfx_reset_cache_and_container(cache, container, memory_usage, do_disk_storage)
This routine resets the containers list pointer to the first element and moves the element counters o...
Types and set/get functions for HFX.
Defines the basic variable types.
integer, parameter, public int_8
integer, parameter, public dp