42 use,
intrinsic :: iso_c_binding, only : c_ptr, c_associated
48 logical :: valid = .false.
49 logical :: skip = .false.
50 class(*),
allocatable :: key
51 class(*),
allocatable :: data
56 integer,
private :: size
57 integer,
private :: entries
71 class(*),
intent(in) :: k
157 integer,
private :: n
239 class(
htable_t),
intent(inout) :: this
240 integer,
value :: size
241 class(*),
target,
intent(in) :: key
242 class(*),
target,
intent(in),
optional :: data
243 class(*),
pointer :: dp
249 if (
size .lt. 4)
then
253 size = ishft(1, ceiling(log(dble(size)) /
neko_m_ln2))
255 allocate(this%t(0:size))
256 this%t(:)%valid = .false.
261 if (
present(data))
then
266 allocate(this%t(i)%key, source=key)
267 allocate(this%t(i)%data, source=dp)
273 class(
htable_t),
intent(inout) :: this
276 if (
allocated(this%t))
then
278 deallocate(this%t(i)%key)
279 deallocate(this%t(i)%data)
291 class(
htable_t),
intent(inout) :: this
293 if (
allocated(this%t))
then
294 this%t(:)%valid = .false.
306 entries = this%entries
319 class(
htable_t),
intent(inout) :: this
320 class(*),
intent(inout) :: key
321 class(*),
intent(inout) :: data
326 i = log(1.0/this%size)/log(0.6)
330 index = this%hash(key, c**2)
331 if (index .lt. 0)
then
335 if ((.not. this%t(index)%valid) .or. &
339 if (.not. this%t(index)%valid)
then
340 this%entries = this%entries + 1
342 this%t(index)%valid = .true.
343 this%t(index)%skip = .false.
353 type is (
integer(
i8))
355 type is (double precision)
369 call htable_init(tmp, ishft(this%size, 1), key, data)
371 do i = 0, this%size - 1
372 if (this%t(i)%valid)
then
373 call htable_set(tmp, this%t(i)%key, this%t(i)%data)
377 call move_alloc(tmp%t, this%t)
385 class(
htable_t),
intent(inout) :: this
386 class(*),
intent(inout) :: key
387 class(*),
intent(inout) :: data
389 integer :: index, i, c
392 i = log(1.0/this%size)/log(0.6)
395 index = this%hash(key, c**2)
396 if (index .lt. 0)
then
400 if (.not. this%t(index)%valid .and. &
401 .not. this%t(index)%skip)
then
404 else if ((this%t(index)%valid) .and. &
418 class(
htable_t),
intent(inout) :: this
419 class(*),
intent(inout) :: key
420 integer :: index, i, c
423 i = log(1.0/this%size)/log(0.6)
426 index = this%hash(key, c**2)
427 if (index .lt. 0)
then
431 if ((this%t(index)%valid) .and. &
433 this%t(index)%valid = .false.
434 this%t(index)%skip = .true.
435 this%entries = this%entries - 1
445 class(
htable_t),
target,
intent(inout) :: this
446 integer,
intent(in) :: idx
447 class(*),
intent(in) :: data
448 class(*),
pointer :: hdp
450 hdp => this%t(idx)%data
457 type is (
integer(i8))
459 type is (
integer(i8))
462 type is (double precision)
464 type is (double precision)
492 integer,
intent(in) :: idx
493 class(*),
intent(inout) :: data
495 select type (hdp=>this%t(idx)%data)
501 type is (
integer(i8))
503 type is (
integer(i8))
506 type is (double precision)
508 type is (double precision)
536 integer,
intent(in) :: idx
537 class(*),
intent(in) :: key
541 select type (kp=>this%t(idx)%key)
547 type is (
integer(
i8))
549 type is (
integer(
i8))
552 type is (double precision)
554 type is (double precision)
572 res = c_associated(kp%ptr, key%ptr)
579 class(
htable_t),
target,
intent(inout) :: this
580 integer,
intent(in) :: idx
581 class(*),
intent(in) :: key
582 class(*),
pointer :: kp
584 kp => this%t(idx)%key
591 type is (
integer(i8))
593 type is (
integer(i8))
596 type is (double precision)
598 type is (double precision)
629 do while ((.not. this%t%t(this%n)%valid) .and. (this%n .lt. this%t%size))
633 valid = (this%n .lt. this%t%size)
634 if (.not. valid) this%n = -1
650 class(*),
intent(inout) :: data
651 class(*),
pointer :: hdp
653 hdp => this%t%t(this%n)%data
660 type is (
integer(i8))
662 type is (
integer(i8))
665 type is (double precision)
667 type is (double precision)
699 integer,
value :: size
700 class(*),
intent(inout),
optional :: data
703 if (
present(data))
then
714 integer,
intent(inout) :: key
715 class(*),
intent(inout) :: data
724 integer,
intent(inout) :: key
725 class(*),
intent(inout) :: data
735 class(*),
intent(in) :: k
738 integer(kind=i8) :: tmp
739 integer(kind=i8),
parameter :: m1 = int(z
'7ed55d15',
i8)
740 integer(kind=i8),
parameter :: m2 = int(z
'c761c23c',
i8)
741 integer(kind=i8),
parameter :: m3 = int(z
'165667b1',
i8)
742 integer(kind=i8),
parameter :: m4 = int(z
'd3a2646c',
i8)
743 integer(kind=i8),
parameter :: m5 = int(z
'fd7046c5',
i8)
744 integer(kind=i8),
parameter :: m6 = int(z
'b55a4f09',
i8)
749 tmp = (k + m1) + ishft(k, 12)
750 tmp = ieor(ieor(tmp, m2), ishft(tmp, -19))
751 tmp = (tmp + m3) + ishft(tmp, 5)
752 tmp = ieor((tmp + m4), ishft(tmp, 9))
753 tmp = (tmp + m5) + ishft(tmp, 3)
754 tmp = ieor(ieor(tmp, m6), ishft(tmp, -16))
755 tmp = modulo(tmp + int(c,
i8), int(this%size,
i8))
765 integer,
intent(inout) :: key
790 integer,
pointer :: value
792 select type (hdp => this%t%t(this%n)%data)
796 call neko_error(
'Key and data of different kind (i4)')
804 integer,
pointer :: key
806 select type (kp => this%t%t(this%n)%key)
821 integer,
value :: size
822 class(*),
intent(inout),
optional :: data
823 integer(kind=i8) :: key
825 if (
present(data))
then
836 integer(kind=i8),
intent(inout) :: key
837 class(*),
intent(inout) :: data
846 integer(kind=i8),
intent(inout) :: key
847 class(*),
intent(inout) :: data
857 class(*),
intent(in) :: k
860 integer(kind=i8) :: tmp
861 integer(kind=i8),
parameter :: m1 = int(z
'7ed55d15',
i8)
862 integer(kind=i8),
parameter :: m2 = int(z
'c761c23c',
i8)
863 integer(kind=i8),
parameter :: m3 = int(z
'165667b1',
i8)
864 integer(kind=i8),
parameter :: m4 = int(z
'd3a2646c',
i8)
865 integer(kind=i8),
parameter :: m5 = int(z
'fd7046c5',
i8)
866 integer(kind=i8),
parameter :: m6 = int(z
'b55a4f09',
i8)
869 type is (
integer(
i8))
870 tmp = (k + m1) + ishft(k, 12)
871 tmp = ieor(ieor(tmp, m2), ishft(tmp, -19))
872 tmp = (tmp + m3) + ishft(tmp, 5)
873 tmp = ieor((tmp + m4), ishft(tmp, 9))
874 tmp = (tmp + m5) + ishft(tmp, 3)
875 tmp = ieor(ieor(tmp, m6), ishft(tmp, -16))
876 hash = int(modulo(tmp, int(this%size,
i8)),
i4)
878 hash = int(modulo((k * 2654435761_i8) + int(c,
i8), &
879 int(this%size,
i8)),
i4)
888 integer(kind=i8),
intent(inout) :: key
913 integer(kind=i8),
pointer :: value
916 select type (hdp => this%t%t(this%n)%data)
917 type is (
integer(
i8))
920 call neko_error(
'Key and data of different kind (i8)')
928 integer(kind=i8),
pointer :: key
933 select type(hti => this)
935 select type (kp => hti%t%t(this%n)%key)
936 type is (
integer(
i8))
954 integer,
value :: size
955 class(*),
intent(inout),
optional :: data
958 if (
present(data))
then
969 real(kind=
dp),
intent(inout) :: key
970 class(*),
intent(inout) :: data
979 real(kind=
dp),
intent(inout) :: key
980 class(*),
intent(inout) :: data
990 class(*),
intent(in) :: k
994 type is (double precision)
995 hash = modulo(floor((2d0 * abs(fraction(k)) - 1d0) * 2**16) + c, this%size)
1004 real(kind=
dp),
intent(inout) :: key
1030 real(kind=
dp),
pointer ::
value
1032 select type (hdp => this%t%t(this%n)%data)
1033 type is (double precision)
1036 call neko_error(
'Key and data of different kind (r8)')
1044 real(kind=
dp),
pointer :: key
1046 select type (kp => this%t%t(this%n)%key)
1047 type is (double precision)
1061 integer,
value :: size
1062 class(*),
intent(inout),
optional :: data
1065 if (
present(data))
then
1076 type(
point_t),
intent(inout) :: key
1077 class(*),
intent(inout) :: data
1086 type(
point_t),
intent(inout) :: key
1087 class(*),
intent(inout) :: data
1097 class(*),
intent(in) :: k
1100 integer(kind=i8) :: hash2, tmp, mult
1101 integer(kind=i8),
parameter :: m1 = int(z
'7ed55d15',
i8)
1102 integer(kind=i8),
parameter :: m2 = int(z
'c761c23c',
i8)
1103 integer(kind=i8),
parameter :: m3 = int(z
'165667b1',
i8)
1104 integer(kind=i8),
parameter :: m4 = int(z
'd3a2646c',
i8)
1105 integer(kind=i8),
parameter :: m5 = int(z
'fd7046c5',
i8)
1106 integer(kind=i8),
parameter :: m6 = int(z
'b55a4f09',
i8)
1111 hash2 = int(z
'345678')
1113 tmp = transfer(k%x(i), tmp)
1114 tmp = (tmp + m1) + ishft(tmp, 12)
1115 tmp = ieor(ieor(tmp, m2), ishft(tmp, -19))
1116 tmp = (tmp + m3) + ishft(tmp, 5)
1117 tmp = ieor((tmp + m4), ishft(tmp, 9))
1118 tmp = (tmp + m5) + ishft(tmp, 3)
1119 tmp = ieor(ieor(tmp, m6), ishft(tmp, -16))
1120 hash2 = ieor(hash2, tmp) * mult
1121 mult = mult + 82520 + 8
1123 hash2 = hash2 + 97531
1124 hash2 = modulo(hash2 + int(c,
i8), int(this%size,
i8))
1125 hash = int(hash2,
i4)
1135 type(
point_t),
intent(inout) :: key
1161 type(
point_t),
pointer :: value
1163 select type (hdp => this%t%t(this%n)%data)
1167 call neko_error(
'Key and data of different kind (pt)')
1177 select type (kp => this%t%t(this%n)%key)
1192 integer,
value :: size
1193 class(*),
intent(inout),
optional :: data
1196 if (
present(data))
then
1208 class(*),
intent(inout) :: data
1218 class(*),
intent(inout) :: data
1228 class(*),
intent(in) :: k
1231 integer(kind=i8) :: tmp, hash2, mult
1232 integer(kind=i8),
parameter :: m1 = int(z
'7ed55d15',
i8)
1233 integer(kind=i8),
parameter :: m2 = int(z
'c761c23c',
i8)
1234 integer(kind=i8),
parameter :: m3 = int(z
'165667b1',
i8)
1235 integer(kind=i8),
parameter :: m4 = int(z
'd3a2646c',
i8)
1236 integer(kind=i8),
parameter :: m5 = int(z
'fd7046c5',
i8)
1237 integer(kind=i8),
parameter :: m6 = int(z
'b55a4f09',
i8)
1241 mult = int(1000003,
i8)
1242 hash2 = int(z
'345678',
i8)
1244 tmp = int(k%x(i),
i8)
1245 tmp = (tmp + m1) + ishft(tmp, 12)
1246 tmp = ieor(ieor(tmp, m2), ishft(tmp, -19))
1247 tmp = (tmp + m3) + ishft(tmp, 5)
1248 tmp = ieor((tmp + m4), ishft(tmp, 9))
1249 tmp = (tmp + m5) + ishft(tmp, 3)
1250 tmp = ieor(ieor(tmp, m6), ishft(tmp, -16))
1251 hash2 = ieor(hash2, tmp) * mult
1252 mult = mult + 82520_i8 + 4_i8
1254 hash2 = hash2 + 97531_i8
1255 hash2 = modulo(hash2 + int(c,
i8), int(this%size,
i8))
1256 hash = int(hash2,
i4)
1292 select type (hdp => this%t%t(this%n)%data)
1296 call neko_error(
'Key and data of different kind (i4t2)')
1306 select type (kp => this%t%t(this%n)%key)
1321 integer,
value :: size
1322 class(*),
intent(inout),
optional :: data
1325 if (
present(data))
then
1337 class(*),
intent(inout) :: data
1347 class(*),
intent(inout) :: data
1357 class(*),
intent(in) :: k
1360 integer(kind=i8) :: tmp, hash2, mult
1361 integer(kind=i8),
parameter :: m1 = int(z
'7ed55d15',
i8)
1362 integer(kind=i8),
parameter :: m2 = int(z
'c761c23c',
i8)
1363 integer(kind=i8),
parameter :: m3 = int(z
'165667b1',
i8)
1364 integer(kind=i8),
parameter :: m4 = int(z
'd3a2646c',
i8)
1365 integer(kind=i8),
parameter :: m5 = int(z
'fd7046c5',
i8)
1366 integer(kind=i8),
parameter :: m6 = int(z
'b55a4f09',
i8)
1370 mult = int(1000003,
i8)
1371 hash2 = int(z
'345678',
i8)
1373 tmp = int(k%x(i),
i8)
1374 tmp = (tmp + m1) + ishft(tmp, 12)
1375 tmp = ieor(ieor(tmp, m2), ishft(tmp, -19))
1376 tmp = (tmp + m3) + ishft(tmp, 5)
1377 tmp = ieor((tmp + m4), ishft(tmp, 9))
1378 tmp = (tmp + m5) + ishft(tmp, 3)
1379 tmp = ieor(ieor(tmp, m6), ishft(tmp, -16))
1380 hash2 = ieor(hash2, tmp) * mult
1381 mult = mult + 82520_i8 + 8_i8
1383 hash2 = hash2 + 97531_i8
1384 hash2 = modulo(hash2 + int(c,
i8), int(this%size,
i8))
1385 hash = int(hash2,
i4)
1421 select type (hdp => this%t%t(this%n)%data)
1425 call neko_error(
'Key and data of different kind (i4t4)')
1438 select type(hti => this)
1440 select type (kp => hti%t%t(this%n)%key)
1447 call neko_error(
'Corrupt htable iter. (i4t4)')
1458 integer,
value :: size
1459 class(*),
intent(inout),
optional :: data
1462 if (
present(data))
then
1473 type(
h_cptr_t),
intent(inout) :: key
1474 class(*),
intent(inout) :: data
1483 type(
h_cptr_t),
intent(inout) :: key
1484 class(*),
intent(inout) :: data
1494 class(*),
intent(in) :: k
1497 integer(kind=i8) :: k_int
1501 k_int = transfer(k%ptr, k_int)
1502 hash = int(modulo(k_int * 2654435761_i8 + int(c,
i8),&
1503 int(this%size,
i8)),
i4)
1512 type(
h_cptr_t),
intent(inout) :: key
1537 class(*),
pointer :: hdp
1540 hdp => this%t%t(this%n)%data
1545 call neko_error(
'Key and data of different kind (cptr)')
1553 class(*),
pointer :: kp
1556 kp => this%t%t(this%n)%key
Implements a hash table ADT.
subroutine htable_i4t4_init(this, size, data)
Initialize an integer 4-tuple hash table.
subroutine htable_iter_r8_init(this, t)
Initialize a double precision based hash table iterator.
subroutine htable_clear(this)
Clear all entries in a hash table.
subroutine htable_pt_init(this, size, data)
Initialize a point based hash table.
type(tuple_i4_t) function, pointer htable_iter_i4t2_key(this)
Return the current key of integer based 2-tuple hash table iterator.
subroutine htable_iter_i8_free(this)
Destroy an integer*8 based hash table iterator.
subroutine htable_i4_set(this, key, data)
Insert an integer into the hash table.
type(tuple4_i4_t) function, pointer htable_iter_i4t4_value(this)
Return the current value of integer based 4-tuple hash table iterator.
integer function, pointer htable_iter_i4_value(this)
Return the current value of the integer based hash table iterator.
subroutine htable_r8_init(this, size, data)
Initialize a double precision based hash table.
integer(kind=i8) function, pointer htable_iter_i8_key(this)
Return the current key of the integer*8 based hash table iterator.
type(point_t) function, pointer htable_iter_pt_key(this)
Return the current key of the point based hash table iterator.
pure integer function htable_r8_hash(this, k, c)
Hash function for a double precision based hash table.
subroutine htable_cptr_init(this, size, data)
Initialize a C pointer based hash table.
pure integer function htable_i4_hash(this, k, c)
Hash function for an integer based hash table.
subroutine htable_iter_cptr_free(this)
Destroy a C pointer based hash table iterator.
subroutine htable_iter_pt_free(this)
Destroy a point based hash table iterator.
subroutine htable_i4t4_set(this, key, data)
Insert an integer 4-tuple into the hash table.
subroutine htable_i8_init(this, size, data)
Initialize an integer*8 based hash table.
subroutine htable_pt_remove(this, key)
Remove a point with key key from the hash table.
subroutine htable_cptr_remove(this, key)
Remove a C pointer with key key from the hash table.
subroutine htable_free(this)
Destroy a hash table.
subroutine htable_iter_data(this, data)
Return the data at the current iterator position.
pure integer function htable_size(this)
Return total size of htable.
subroutine htable_get_data(this, idx, data)
Return data at idx in value.
integer function htable_r8_get(this, key, data)
Retrive a double precision float with key key from the hash table.
pure integer function htable_i8_hash(this, k, c)
Hash function for an integer*8 based hash table.
subroutine htable_i4t4_remove(this, key)
Remove an integer 4-tuple with key key from the hash table.
integer function htable_get(this, key, data)
Retrieve data associated with key into the hash table.
integer function htable_i8_get(this, key, data)
Retrive an integer*8 with key key from the hash table.
integer function htable_pt_get(this, key, data)
Retrive a point with key key from the hash table.
subroutine htable_remove(this, key)
Remove a key from the hash table.
subroutine htable_set_data(this, idx, data)
Set data at idx to value.
real(kind=dp) function, pointer htable_iter_r8_key(this)
Return the current key of the double precision based hash table iterator.
subroutine htable_iter_pt_init(this, t)
Initialize a point based hash table iterator.
integer function htable_i4_get(this, key, data)
Retrive an integer with key key from the hash table.
type(h_cptr_t) function, pointer htable_iter_cptr_value(this)
Return the current value of C pointer based hash table iterator.
type(tuple_i4_t) function, pointer htable_iter_i4t2_value(this)
Return the current value of integer based 2-tuple hash table iterator.
logical function htable_iter_next(this)
Advance the iterator to the next valid table entry.
integer function htable_cptr_get(this, key, data)
Retrive a C pointer with key key from the hash table.
subroutine htable_i8_set(this, key, data)
Insert an integer*8 into the hash table.
subroutine htable_r8_remove(this, key)
Remove a double precision key key from the hash table.
subroutine htable_iter_i4t2_free(this)
Destroy an integer 2-tuple based hash table iterator.
subroutine htable_r8_set(this, key, data)
Insert a double precision key (with data) into the hash table.
type(point_t) function, pointer htable_iter_pt_value(this)
Return the current value of the point based hash table iterator.
integer function htable_i4t4_get(this, key, data)
Retrive an integer 4-tuple with key key from the hash table.
subroutine htable_i4t2_set(this, key, data)
Insert an integer 2-tuple into the hash table.
pure integer function htable_num_entries(this)
Return number of entries in the table.
type(tuple4_i4_t) function, pointer htable_iter_i4t4_key(this)
Return the current key of integer based 4-tuple hash table iterator.
recursive subroutine htable_set(this, key, data)
Insert tuple (key, value) into the hash table.
pure logical function htable_eq_key(this, idx, key)
Compare key at idx to key.
subroutine htable_i4t2_remove(this, key)
Remove an integer 2-tuple with key key from the hash table.
subroutine htable_set_key(this, idx, key)
Set key at idx to key.
subroutine htable_iter_i8_init(this, t)
Initialize an integer*8 based hash table iterator.
pure integer function htable_i4t4_hash(this, k, c)
Hash function for an integer 4-tuple hash table.
pure integer function htable_pt_hash(this, k, c)
Hash function for a point based hash table.
integer function, pointer htable_iter_i4_key(this)
Return the current key of the integer based hash table iterator.
subroutine htable_iter_i4_init(this, t)
Initialize an integer based hash table iterator.
subroutine htable_init(this, size, key, data)
Initialize a hash table of type data.
subroutine htable_i4t2_init(this, size, data)
Initialize an integer 2-tuple hash table.
subroutine htable_cptr_set(this, key, data)
Insert a C pointer into the hash table.
subroutine htable_iter_i4t4_free(this)
Destroy an integer 4-tuple based hash table iterator.
subroutine htable_i4_remove(this, key)
Remove an integer with key key from the hash table.
subroutine htable_iter_cptr_init(this, t)
Initialize a C pointer based hash table iterator.
integer(kind=i8) function, pointer htable_iter_i8_value(this)
Return the current value of the integer*8 based hash table iterator.
integer function htable_i4t2_get(this, key, data)
Retrive an integer 2-tuple with key key from the hash table.
subroutine htable_iter_i4t4_init(this, t)
Initialize an integer 4-tuple based hash table iterator.
subroutine htable_i8_remove(this, key)
Remove an integer*8 with key key from the hash table.
subroutine htable_i4_init(this, size, data)
Initialize an integer based hash table.
pure integer function htable_cptr_hash(this, k, c)
Hash function for an integer 4-tuple hash table.
subroutine htable_pt_set(this, key, data)
Insert a point key (with data) into the hash table.
subroutine htable_iter_reset(this)
Reset an iterator.
subroutine htable_iter_i4_free(this)
Destroy an integer based hash table iterator.
type(h_cptr_t) function, pointer htable_iter_cptr_key(this)
Return the current key of a C pointer based hash table iterator.
subroutine htable_iter_r8_free(this)
Destroy a double precision based hash table iterator.
pure integer function htable_i4t2_hash(this, k, c)
Hash function for an integer 2-tuple hash table.
subroutine htable_iter_i4t2_init(this, t)
Initialize an integer 2-tuple based hash table iterator.
real(kind=dp) function, pointer htable_iter_r8_value(this)
Return the current value of the double precision based hash table iterator.
real(kind=rp), parameter, public neko_m_ln2
integer, parameter, public i8
integer, parameter, public i4
integer, parameter, public dp
Hash table entry, tuple (key, data)
C pointer based hash table.
Integer based hash table.
Integer 2-tuple based hash table.
Integer 4-tuple based hash table.
Integer*8 based hash table.
Iterator for a C pointer based hash table.
Iterator for an integer based hash table.
Iterator for an integer based 2-tuple hash table.
Iterator for an integer based 4-tuple hash table.
Iterator for an integer*8 based hash table.
Iterator for a point based hash table.
Iterator for a double precision based hash table.
Base type for a hash table iterator.
Double precision based hash table.
Base type for a hash table.
A point in with coordinates .
Base type for an n-tuple.