Loading [MathJax]/extensions/tex2jax.js
Neko 0.9.99
A portable framework for high-order spectral element flow simulations
All Classes Namespaces Files Functions Variables Typedefs Enumerator Macros Pages
htable.f90
Go to the documentation of this file.
1! Copyright (c) 2019-2023, The Neko Authors
2! All rights reserved.
3!
4! Redistribution and use in source and binary forms, with or without
5! modification, are permitted provided that the following conditions
6! are met:
7!
8! * Redistributions of source code must retain the above copyright
9! notice, this list of conditions and the following disclaimer.
10!
11! * Redistributions in binary form must reproduce the above
12! copyright notice, this list of conditions and the following
13! disclaimer in the documentation and/or other materials provided
14! with the distribution.
15!
16! * Neither the name of the authors nor the names of its
17! contributors may be used to endorse or promote products derived
18! from this software without specific prior written permission.
19!
20! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24! COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25! INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26! BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30! ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31! POSSIBILITY OF SUCH DAMAGE.
32!
36module htable
37 use num_types
38 use utils
39 use point, only : point_t
41 use math, only : neko_m_ln2
42 use, intrinsic :: iso_c_binding, only : c_ptr, c_associated
43 implicit none
44 private
45
47 type :: h_tuple_t
48 logical :: valid = .false.
49 logical :: skip = .false.
50 class(*), allocatable :: key
51 class(*), allocatable :: data
52 end type h_tuple_t
53
55 type, public, abstract :: htable_t
56 integer, private :: size
57 integer, private :: entries
58 type(h_tuple_t), private, allocatable :: t(:)
59 contains
60 procedure(htable_hash), pass(this), deferred :: hash
61 procedure, public, pass(this) :: clear => htable_clear
62 procedure, public, pass(this) :: free => htable_free
63 procedure, public, pass(this) :: num_entries => htable_num_entries
64 procedure, public, pass(this) :: get_size => htable_size
65 end type htable_t
66
67 abstract interface
68 pure function htable_hash(this, k, c) result(hash)
69 import htable_t
70 class(htable_t), intent(in) :: this
71 class(*), intent(in) :: k
72 integer, value :: c
73 integer :: hash
74 end function htable_hash
75 end interface
76
77 !
78 ! Implementations
79 !
80
82 type, public, extends(htable_t) :: htable_i4_t
83 contains
84 procedure, pass(this) :: init => htable_i4_init
85 procedure, pass(this) :: set => htable_i4_set
86 procedure, pass(this) :: get => htable_i4_get
87 procedure, pass(this) :: hash => htable_i4_hash
88 procedure, pass(this) :: remove => htable_i4_remove
89 end type htable_i4_t
90
92 type, public, extends(htable_t) :: htable_i8_t
93 contains
94 procedure, pass(this) :: init => htable_i8_init
95 procedure, pass(this) :: set => htable_i8_set
96 procedure, pass(this) :: get => htable_i8_get
97 procedure, pass(this) :: hash => htable_i8_hash
98 procedure, pass(this) :: remove => htable_i8_remove
99 end type htable_i8_t
100
102 type, public, extends(htable_t) :: htable_r8_t
103 contains
104 procedure, pass(this) :: init => htable_r8_init
105 procedure, pass(this) :: set => htable_r8_set
106 procedure, pass(this) :: get => htable_r8_get
107 procedure, pass(this) :: hash => htable_r8_hash
108 procedure, pass(this) :: remove => htable_r8_remove
109 end type htable_r8_t
110
112 type, public, extends(htable_t) :: htable_pt_t
113 contains
114 procedure, pass(this) :: init => htable_pt_init
115 procedure, pass(this) :: set => htable_pt_set
116 procedure, pass(this) :: get => htable_pt_get
117 procedure, pass(this) :: hash => htable_pt_hash
118 procedure, pass(this) :: remove => htable_pt_remove
119 end type htable_pt_t
120
122 type, public, extends(htable_t) :: htable_i4t2_t
123 contains
124 procedure, pass(this) :: init => htable_i4t2_init
125 procedure, pass(this) :: set => htable_i4t2_set
126 procedure, pass(this) :: get => htable_i4t2_get
127 procedure, pass(this) :: hash => htable_i4t2_hash
128 procedure, pass(this) :: remove => htable_i4t2_remove
129 end type htable_i4t2_t
130
132 type, public, extends(htable_t) :: htable_i4t4_t
133 contains
134 procedure, pass(this) :: init => htable_i4t4_init
135 procedure, pass(this) :: set => htable_i4t4_set
136 procedure, pass(this) :: get => htable_i4t4_get
137 procedure, pass(this) :: hash => htable_i4t4_hash
138 procedure, pass(this) :: remove => htable_i4t4_remove
139 end type htable_i4t4_t
140
142 type, public, extends(htable_t) :: htable_cptr_t
143 contains
144 procedure, pass(this) :: init => htable_cptr_init
145 procedure, pass(this) :: set => htable_cptr_set
146 procedure, pass(this) :: get => htable_cptr_get
147 procedure, pass(this) :: hash => htable_cptr_hash
148 procedure, pass(this) :: remove => htable_cptr_remove
149 end type htable_cptr_t
150
151 !
152 ! Iterators
153 !
154
156 type, public, abstract :: htable_iter_t
157 integer, private :: n
158 class(htable_t), pointer :: t
159 contains
160 procedure, public, pass(this) :: next => htable_iter_next
161 procedure, public, pass(this) :: reset => htable_iter_reset
162 procedure, public, pass(this) :: data => htable_iter_data
163 end type htable_iter_t
164
166 type, public, extends(htable_iter_t) :: htable_iter_i4_t
167 contains
168 procedure, pass(this) :: init => htable_iter_i4_init
169 procedure, pass(this) :: value => htable_iter_i4_value
170 procedure, pass(this) :: key => htable_iter_i4_key
172 end type htable_iter_i4_t
173
175 type, public, extends(htable_iter_t) :: htable_iter_i8_t
176 contains
177 procedure, pass(this) :: init => htable_iter_i8_init
178 procedure, pass(this) :: value => htable_iter_i8_value
179 procedure, pass(this) :: key => htable_iter_i8_key
181 end type htable_iter_i8_t
182
184 type, public, extends(htable_iter_t) :: htable_iter_r8_t
185 contains
186 procedure, pass(this) :: init => htable_iter_r8_init
187 procedure, pass(this) :: value => htable_iter_r8_value
188 procedure, pass(this) :: key => htable_iter_r8_key
190 end type htable_iter_r8_t
191
193 type, public, extends(htable_iter_t) :: htable_iter_pt_t
194 contains
195 procedure, pass(this) :: init => htable_iter_pt_init
196 procedure, pass(this) :: value => htable_iter_pt_value
197 procedure, pass(this) :: key => htable_iter_pt_key
199 end type htable_iter_pt_t
200
202 type, public, extends(htable_iter_t) :: htable_iter_i4t2_t
203 contains
204 procedure, pass(this) :: init => htable_iter_i4t2_init
205 procedure, pass(this) :: value => htable_iter_i4t2_value
206 procedure, pass(this) :: key => htable_iter_i4t2_key
208 end type htable_iter_i4t2_t
209
211 type, public, extends(htable_iter_t) :: htable_iter_i4t4_t
212 contains
213 procedure, pass(this) :: init => htable_iter_i4t4_init
214 procedure, pass(this) :: value => htable_iter_i4t4_value
215 procedure, pass(this) :: key => htable_iter_i4t4_key
217 end type htable_iter_i4t4_t
218
220 type, public, extends(htable_iter_t) :: htable_iter_cptr_t
221 contains
222 procedure, pass(this) :: init => htable_iter_cptr_init
223 procedure, pass(this) :: value => htable_iter_cptr_value
224 procedure, pass(this) :: key => htable_iter_cptr_key
226 end type htable_iter_cptr_t
227
228 !
229 ! Type wrappers
230 !
231 type, public :: h_cptr_t
232 type(c_ptr) :: ptr
233 end type h_cptr_t
234
235contains
236
238 subroutine htable_init(this, size, key, data)
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
244 integer :: i
245
246
247 call htable_free(this)
248
249 if (size .lt. 4) then
250 size = 4
251 end if
252
253 size = ishft(1, ceiling(log(dble(size)) / neko_m_ln2))
254
255 allocate(this%t(0:size))
256 this%t(:)%valid = .false.
257 this%size = size
258 this%entries = 0
259
260 dp => key
261 if (present(data)) then
262 dp => data
263 end if
264
265 do i = 0, size
266 allocate(this%t(i)%key, source=key)
267 allocate(this%t(i)%data, source=dp)
268 end do
269 end subroutine htable_init
270
272 subroutine htable_free(this)
273 class(htable_t), intent(inout) :: this
274 integer i
275
276 if (allocated(this%t)) then
277 do i = 0, this%size
278 deallocate(this%t(i)%key)
279 deallocate(this%t(i)%data)
280 end do
281 deallocate(this%t)
282 end if
283
284 this%size = 0
285 this%entries = 0
286
287 end subroutine htable_free
288
290 subroutine htable_clear(this)
291 class(htable_t), intent(inout) :: this
292
293 if (allocated(this%t)) then
294 this%t(:)%valid = .false.
295 this%entries = 0
296 else
297 call neko_error("Hash table not allocated")
298 end if
299
300 end subroutine htable_clear
301
303 pure function htable_num_entries(this) result(entries)
304 class(htable_t), intent(in) :: this
305 integer :: entries
306 entries = this%entries
307 end function htable_num_entries
308
310 pure function htable_size(this) result(size)
311 class(htable_t), intent(in) :: this
312 integer :: size
313 size = this%size
314 end function htable_size
315
316
318 recursive subroutine htable_set(this, key, data)
319 class(htable_t), intent(inout) :: this
320 class(*), intent(inout) :: key
321 class(*), intent(inout) :: data
322 class(htable_t), allocatable :: tmp
323 integer index, i, c
324
325 c = 0
326 i = log(1.0/this%size)/log(0.6)
327 index = 0
328
329 do while (i .ge. 0)
330 index = this%hash(key, c**2)
331 if (index .lt. 0) then
332 call neko_error("Invalid hash generated")
333 end if
335 if ((.not. this%t(index)%valid) .or. &
336 htable_eq_key(this, index, key)) then
337 call htable_set_key(this, index, key)
338 call htable_set_data(this, index, data)
339 if (.not. this%t(index)%valid) then
340 this%entries = this%entries + 1
341 end if
342 this%t(index)%valid = .true.
343 this%t(index)%skip = .false.
344 return
345 end if
346 i = i - 1
347 c = c + 1
348 end do
349
350 select type(key)
351 type is (integer)
352 allocate(htable_i4_t::tmp)
353 type is (integer(i8))
354 allocate(htable_i8_t::tmp)
355 type is (double precision)
356 allocate(htable_r8_t::tmp)
357 type is (point_t)
358 allocate(htable_pt_t::tmp)
359 type is (tuple_i4_t)
360 allocate(htable_i4t2_t::tmp)
361 type is (tuple4_i4_t)
362 allocate(htable_i4t4_t::tmp)
363 type is (h_cptr_t)
364 allocate(htable_cptr_t::tmp)
365 class default
366 call neko_error('Invalid htable key')
367 end select
368
369 call htable_init(tmp, ishft(this%size, 1), key, data)
370
371 !
372 ! When rebuilding the table we used the following loop:
373 !
374 ! do i = 0, this%size - 1
375 ! if (this%t(i)%valid) then
376 ! call htable_set(tmp, this%t(i)%key, this%t(i)%data)
377 ! end if
378 ! end do
379 !
380 ! However, CCE 18.x (and probably other llvm based compilers)
381 ! segfault faults unless the data variable is enclosed in a
382 ! select type block
383 !
384
385 do i = 0, this%size - 1
386 if (this%t(i)%valid) then
387 select type (datap => this%t(i)%data)
388 type is (integer)
389 call htable_set(tmp, this%t(i)%key, datap)
390 type is (integer(i8))
391 call htable_set(tmp, this%t(i)%key, datap)
392 type is (double precision)
393 call htable_set(tmp, this%t(i)%key, datap)
394 type is (point_t)
395 call htable_set(tmp, this%t(i)%key, datap)
396 class is (tuple_t)
397 select type(tuplep => datap)
398 type is (tuple_i4_t)
399 call htable_set(tmp, this%t(i)%key, tuplep)
400 type is (tuple4_i4_t)
401 call htable_set(tmp, this%t(i)%key, tuplep)
402 end select
403 type is (h_cptr_t)
404 call htable_set(tmp, this%t(i)%key, datap)
405 class default
406 call neko_error('Invalid htable data')
407 end select
408 end if
409 end do
410
411 this%size = tmp%size
412 call move_alloc(tmp%t, this%t)
413
414 call htable_set(this, key, data)
415
416 end subroutine htable_set
417
419 function htable_get(this, key, data) result(rcode)
420 class(htable_t), intent(inout) :: this
421 class(*), intent(inout) :: key
422 class(*), intent(inout) :: data
423 integer :: rcode
424 integer :: index, i, c
425
426 c = 0
427 i = log(1.0/this%size)/log(0.6)
428
429 do while (i .ge. 0)
430 index = this%hash(key, c**2)
431 if (index .lt. 0) then
432 call neko_error("Invalid hash generated")
433 end if
434
435 if (.not. this%t(index)%valid .and. &
436 .not. this%t(index)%skip) then
437 rcode = 1
438 return
439 else if ((this%t(index)%valid) .and. &
440 htable_eq_key(this, index, key)) then
441 call htable_get_data(this, index, data)
442 rcode = 0
443 return
444 end if
445 i = i - 1
446 c = c + 1
447 end do
448 rcode = 1
449 end function htable_get
450
452 subroutine htable_remove(this, key)
453 class(htable_t), intent(inout) :: this
454 class(*), intent(inout) :: key
455 integer :: index, i, c
456
457 c = 0
458 i = log(1.0/this%size)/log(0.6)
459
460 do while (i .ge. 0)
461 index = this%hash(key, c**2)
462 if (index .lt. 0) then
463 call neko_error("Invalid hash generated")
464 end if
465
466 if ((this%t(index)%valid) .and. &
467 htable_eq_key(this, index, key)) then
468 this%t(index)%valid = .false.
469 this%t(index)%skip = .true.
470 this%entries = this%entries - 1
471 return
472 end if
473 i = i - 1
474 c = c + 1
475 end do
476 end subroutine htable_remove
477
479 subroutine htable_set_data(this, idx, data)
480 class(htable_t), target, intent(inout) :: this
481 integer, intent(in) :: idx
482 class(*), intent(in) :: data
483 class(*), pointer :: hdp
484
485 hdp => this%t(idx)%data
486 select type (data)
487 type is (integer)
488 select type(hdp)
489 type is (integer)
490 hdp = data
491 end select
492 type is (integer(i8))
493 select type(hdp)
494 type is (integer(i8))
495 hdp = data
496 end select
497 type is (double precision)
498 select type(hdp)
499 type is (double precision)
500 hdp = data
501 end select
502 type is (point_t)
503 select type(hdp)
504 type is (point_t)
505 hdp = data
506 end select
507 class is (tuple_t)
508 select type(hdp)
509 type is (tuple_i4_t)
510 hdp = data
511 type is (tuple4_i4_t)
512 hdp = data
513 end select
514 type is (h_cptr_t)
515 select type(hdp)
516 type is (h_cptr_t)
517 hdp = data
518 end select
519 class default
520 call neko_error('Invalid htable data (set)')
521 end select
522 end subroutine htable_set_data
523
525 subroutine htable_get_data(this, idx, data)
526 class(htable_t), intent(in) :: this
527 integer, intent(in) :: idx
528 class(*), intent(inout) :: data
529
530 select type (hdp=>this%t(idx)%data)
531 type is (integer)
532 select type(data)
533 type is (integer)
534 data = hdp
535 end select
536 type is (integer(i8))
537 select type(data)
538 type is (integer(i8))
539 data = hdp
540 end select
541 type is (double precision)
542 select type(data)
543 type is (double precision)
544 data = hdp
545 end select
546 type is (point_t)
547 select type(data)
548 type is (point_t)
549 data = hdp
550 end select
551 class is (tuple_t)
552 select type(data)
553 type is (tuple_i4_t)
554 data = hdp
555 type is (tuple4_i4_t)
556 data = hdp
557 end select
558 type is (h_cptr_t)
559 select type (data)
560 type is (h_cptr_t)
561 data = hdp
562 end select
563 class default
564 call neko_error('Invalid htable data (get)')
565 end select
566 end subroutine htable_get_data
567
569 pure function htable_eq_key(this, idx, key) result(res)
570 class(htable_t), intent(in) :: this
571 integer, intent(in) :: idx
572 class(*), intent(in) :: key
573 logical :: res
574
575 res = .true.
576 select type (kp=>this%t(idx)%key)
577 type is (integer)
578 select type(key)
579 type is (integer)
580 res = (kp .eq. key)
581 end select
582 type is (integer(i8))
583 select type(key)
584 type is (integer(i8))
585 res = (kp .eq. key)
586 end select
587 type is (double precision)
588 select type(key)
589 type is (double precision)
590 res = abs(kp - key) .lt. epsilon(1.0_dp)
591 end select
592 type is (point_t)
593 select type (key)
594 type is (point_t)
595 res = (kp .eq. key)
596 end select
597 class is (tuple_t)
598 select type (key)
599 type is (tuple_i4_t)
600 res = (key .eq. kp)
601 type is (tuple4_i4_t)
602 res = (key .eq. kp)
603 end select
604 type is (h_cptr_t)
605 select type (key)
606 type is (h_cptr_t)
607 res = c_associated(kp%ptr, key%ptr)
608 end select
609 end select
610 end function htable_eq_key
611
613 subroutine htable_set_key(this, idx, key)
614 class(htable_t), target, intent(inout) :: this
615 integer, intent(in) :: idx
616 class(*), intent(in) :: key
617 class(*), pointer :: kp
618
619 kp => this%t(idx)%key
620 select type(key)
621 type is (integer)
622 select type(kp)
623 type is (integer)
624 kp = key
625 end select
626 type is (integer(i8))
627 select type(kp)
628 type is (integer(i8))
629 kp = key
630 end select
631 type is (double precision)
632 select type(kp)
633 type is (double precision)
634 kp = key
635 end select
636 type is (point_t)
637 select type (kp)
638 type is (point_t)
639 kp = key
640 end select
641 class is (tuple_t)
642 select type(kp)
643 type is (tuple_i4_t)
644 kp = key
645 type is (tuple4_i4_t)
646 kp = key
647 end select
648 type is (h_cptr_t)
649 select type(kp)
650 type is (h_cptr_t)
651 kp = key
652 end select
653 class default
654 call neko_error('Invalid htable key (set)')
655 end select
656 end subroutine htable_set_key
657
659 function htable_iter_next(this) result(valid)
660 class(htable_iter_t), intent(inout) :: this
661 logical :: valid
662
663 this%n = this%n + 1
664 do while ((.not. this%t%t(this%n)%valid) .and. (this%n .lt. this%t%size))
665 this%n = this%n + 1
666 end do
667
668 valid = (this%n .lt. this%t%size)
669 if (.not. valid) this%n = -1
670
671 end function htable_iter_next
672
674 subroutine htable_iter_reset(this)
675 class(htable_iter_t), intent(inout) :: this
676 this%n = -1
677 end subroutine htable_iter_reset
678
683 subroutine htable_iter_data(this, data)
684 class(htable_iter_t), target, intent(inout) :: this
685 class(*), intent(inout) :: data
686 class(*), pointer :: hdp
687
688 hdp => this%t%t(this%n)%data
689 select type(hdp)
690 type is (integer)
691 select type (data)
692 type is (integer)
693 data = hdp
694 end select
695 type is (integer(i8))
696 select type (data)
697 type is (integer(i8))
698 data = hdp
699 end select
700 type is (double precision)
701 select type(data)
702 type is (double precision)
703 data = hdp
704 end select
705 type is (point_t)
706 select type (data)
707 type is (point_t)
708 data = hdp
709 end select
710 class is (tuple_t)
711 select type (data)
712 type is (tuple_i4_t)
713 data = hdp
714 type is (tuple4_i4_t)
715 data = hdp
716 end select
717 type is (h_cptr_t)
718 select type (data)
719 type is (h_cptr_t)
720 data = hdp
721 end select
722 class default
723 call neko_error('Invalid htable data (iter)')
724 end select
725
726 end subroutine htable_iter_data
727
728 !
729 ! Integer based implementation
730 !
732 subroutine htable_i4_init(this, size, data)
733 class(htable_i4_t), intent(inout) :: this
734 integer, value :: size
735 class(*), intent(inout), optional :: data
736 integer :: key
737
738 if (present(data)) then
739 call htable_init(this, size, key, data)
740 else
741 call htable_init(this, size, key)
742 end if
743
744 end subroutine htable_i4_init
745
747 subroutine htable_i4_set(this, key, data)
748 class(htable_i4_t), intent(inout) :: this
749 integer, intent(inout) :: key
750 class(*), intent(inout) :: data
751
752 call htable_set(this, key, data)
753
754 end subroutine htable_i4_set
755
757 function htable_i4_get(this, key, data) result(rcode)
758 class(htable_i4_t), intent(inout) :: this
759 integer, intent(inout) :: key
760 class(*), intent(inout) :: data
761 integer :: rcode
762
763 rcode = htable_get(this, key, data)
764
765 end function htable_i4_get
766
768 pure function htable_i4_hash(this, k, c) result(hash)
769 class(htable_i4_t), intent(in) :: this
770 class(*), intent(in) :: k
771 integer, value :: c
772 integer :: hash
773 integer(kind=i8) :: tmp
774 integer(kind=i8), parameter :: m1 = int(z'7ed55d15', i8)
775 integer(kind=i8), parameter :: m2 = int(z'c761c23c', i8)
776 integer(kind=i8), parameter :: m3 = int(z'165667b1', i8)
777 integer(kind=i8), parameter :: m4 = int(z'd3a2646c', i8)
778 integer(kind=i8), parameter :: m5 = int(z'fd7046c5', i8)
779 integer(kind=i8), parameter :: m6 = int(z'b55a4f09', i8)
780
781 select type(k)
782 type is (integer)
783 tmp = int(k, i8)
784 tmp = (k + m1) + ishft(k, 12)
785 tmp = ieor(ieor(tmp, m2), ishft(tmp, -19))
786 tmp = (tmp + m3) + ishft(tmp, 5)
787 tmp = ieor((tmp + m4), ishft(tmp, 9))
788 tmp = (tmp + m5) + ishft(tmp, 3)
789 tmp = ieor(ieor(tmp, m6), ishft(tmp, -16))
790 tmp = modulo(tmp + int(c, i8), int(this%size, i8))
791 hash = int(tmp, i4)
792 class default
793 hash = -1
794 end select
795 end function htable_i4_hash
796
798 subroutine htable_i4_remove(this, key)
799 class(htable_i4_t), intent(inout) :: this
800 integer, intent(inout) :: key
801
802 call htable_remove(this, key)
803
804 end subroutine htable_i4_remove
805
807 subroutine htable_iter_i4_init(this, t)
808 class(htable_iter_i4_t), intent(inout) :: this
809 type(htable_i4_t), target, intent(inout) :: t
810
811 this%t => t
812 this%n = -1
813
814 end subroutine htable_iter_i4_init
815
817 subroutine htable_iter_i4_free(this)
818 type(htable_iter_i4_t), intent(inout) :: this
819 nullify(this%t)
820 end subroutine htable_iter_i4_free
821
823 function htable_iter_i4_value(this) result(value)
824 class(htable_iter_i4_t), target, intent(inout) :: this
825 integer, pointer :: value
826
827 select type (hdp => this%t%t(this%n)%data)
828 type is (integer)
829 value => hdp
830 class default
831 call neko_error('Key and data of different kind (i4)')
832 end select
833
834 end function htable_iter_i4_value
835
837 function htable_iter_i4_key(this) result(key)
838 class(htable_iter_i4_t), target, intent(inout) :: this
839 integer, pointer :: key
840
841 select type (kp => this%t%t(this%n)%key)
842 type is (integer)
843 key => kp
844 class default
845 call neko_error('Invalid key (i4)')
846 end select
847
848 end function htable_iter_i4_key
849
850 !
851 ! Integer*8 based implementation
852 !
854 subroutine htable_i8_init(this, size, data)
855 class(htable_i8_t), intent(inout) :: this
856 integer, value :: size
857 class(*), intent(inout), optional :: data
858 integer(kind=i8) :: key
859
860 if (present(data)) then
861 call htable_init(this, size, key, data)
862 else
863 call htable_init(this, size, key)
864 end if
865
866 end subroutine htable_i8_init
867
869 subroutine htable_i8_set(this, key, data)
870 class(htable_i8_t), intent(inout) :: this
871 integer(kind=i8), intent(inout) :: key
872 class(*), intent(inout) :: data
873
874 call htable_set(this, key, data)
875
876 end subroutine htable_i8_set
877
879 function htable_i8_get(this, key, data) result(rcode)
880 class(htable_i8_t), intent(inout) :: this
881 integer(kind=i8), intent(inout) :: key
882 class(*), intent(inout) :: data
883 integer :: rcode
884
885 rcode = htable_get(this, key, data)
886
887 end function htable_i8_get
888
890 pure function htable_i8_hash(this, k, c) result(hash)
891 class(htable_i8_t), intent(in) :: this
892 class(*), intent(in) :: k
893 integer, value :: c
894 integer :: hash
895 integer(kind=i8) :: tmp
896 integer(kind=i8), parameter :: m1 = int(z'7ed55d15', i8)
897 integer(kind=i8), parameter :: m2 = int(z'c761c23c', i8)
898 integer(kind=i8), parameter :: m3 = int(z'165667b1', i8)
899 integer(kind=i8), parameter :: m4 = int(z'd3a2646c', i8)
900 integer(kind=i8), parameter :: m5 = int(z'fd7046c5', i8)
901 integer(kind=i8), parameter :: m6 = int(z'b55a4f09', i8)
902
903 select type(k)
904 type is (integer(i8))
905 tmp = (k + m1) + ishft(k, 12)
906 tmp = ieor(ieor(tmp, m2), ishft(tmp, -19))
907 tmp = (tmp + m3) + ishft(tmp, 5)
908 tmp = ieor((tmp + m4), ishft(tmp, 9))
909 tmp = (tmp + m5) + ishft(tmp, 3)
910 tmp = ieor(ieor(tmp, m6), ishft(tmp, -16))
911 hash = int(modulo(tmp, int(this%size, i8)), i4)
913 hash = int(modulo((k * 2654435761_i8) + int(c, i8), &
914 int(this%size, i8)), i4)
915 class default
916 hash = -1
917 end select
918 end function htable_i8_hash
919
921 subroutine htable_i8_remove(this, key)
922 class(htable_i8_t), intent(inout) :: this
923 integer(kind=i8), intent(inout) :: key
924
925 call htable_remove(this, key)
926
927 end subroutine htable_i8_remove
928
930 subroutine htable_iter_i8_init(this, t)
931 class(htable_iter_i8_t), intent(inout) :: this
932 type(htable_i8_t), target, intent(inout) :: t
933
934 this%t => t
935 this%n = -1
936
937 end subroutine htable_iter_i8_init
938
940 subroutine htable_iter_i8_free(this)
941 type(htable_iter_i8_t), intent(inout) :: this
942 nullify(this%t)
943 end subroutine htable_iter_i8_free
944
946 function htable_iter_i8_value(this) result(value)
947 class(htable_iter_i8_t), target, intent(inout) :: this
948 integer(kind=i8), pointer :: value
949
950
951 select type (hdp => this%t%t(this%n)%data)
952 type is (integer(i8))
953 value => hdp
954 class default
955 call neko_error('Key and data of different kind (i8)')
956 end select
957
958 end function htable_iter_i8_value
959
961 function htable_iter_i8_key(this) result(key)
962 class(htable_iter_i8_t), target, intent(inout) :: this
963 integer(kind=i8), pointer :: key
964
965 ! We should not need this extra select block, and it works great
966 ! without it for GNU, Intel and NEC, but breaks horribly on Cray
967 ! (>11.0.x) when using high opt. levels.
968 select type(hti => this)
969 type is(htable_iter_i8_t)
970 select type (kp => hti%t%t(this%n)%key)
971 type is (integer(i8))
972 key => kp
973 class default
974 call neko_error('Invalid key (i8)')
975 end select
976 class default
977 call neko_error('Corrupt htable iter. (i8)')
978 end select
979
980 end function htable_iter_i8_key
981
982
983 !
984 ! Double precision based implementation
985 !
987 subroutine htable_r8_init(this, size, data)
988 class(htable_r8_t), intent(inout) :: this
989 integer, value :: size
990 class(*), intent(inout), optional :: data
991 real(kind=dp) :: key
992
993 if (present(data)) then
994 call htable_init(this, size, key, data)
995 else
996 call htable_init(this, size, key)
997 end if
998
999 end subroutine htable_r8_init
1000
1002 subroutine htable_r8_set(this, key, data)
1003 class(htable_r8_t), intent(inout) :: this
1004 real(kind=dp), intent(inout) :: key
1005 class(*), intent(inout) :: data
1006
1007 call htable_set(this, key, data)
1008
1009 end subroutine htable_r8_set
1010
1012 function htable_r8_get(this, key, data) result(rcode)
1013 class(htable_r8_t), intent(inout) :: this
1014 real(kind=dp), intent(inout) :: key
1015 class(*), intent(inout) :: data
1016 integer :: rcode
1017
1018 rcode = htable_get(this, key, data)
1019
1020 end function htable_r8_get
1021
1023 pure function htable_r8_hash(this, k, c) result(hash)
1024 class(htable_r8_t), intent(in) :: this
1025 class(*), intent(in) :: k
1026 integer, value :: c
1027 integer :: hash
1028 select type(k)
1029 type is (double precision)
1030 hash = modulo(floor((2d0 * abs(fraction(k)) - 1d0) * 2**16) + c, this%size)
1031 class default
1032 hash = -1
1033 end select
1034 end function htable_r8_hash
1035
1037 subroutine htable_r8_remove(this, key)
1038 class(htable_r8_t), intent(inout) :: this
1039 real(kind=dp), intent(inout) :: key
1040
1041 call htable_remove(this, key)
1042
1043 end subroutine htable_r8_remove
1044
1045
1047 subroutine htable_iter_r8_init(this, t)
1048 class(htable_iter_r8_t), intent(inout) :: this
1049 type(htable_r8_t), target, intent(inout) :: t
1050
1051 this%t => t
1052 this%n = -1
1053
1054 end subroutine htable_iter_r8_init
1055
1057 subroutine htable_iter_r8_free(this)
1058 type(htable_iter_r8_t), intent(inout) :: this
1059 nullify(this%t)
1060 end subroutine htable_iter_r8_free
1061
1063 function htable_iter_r8_value(this) result(value)
1064 class(htable_iter_r8_t), target, intent(inout) :: this
1065 real(kind=dp), pointer :: value
1066
1067 select type (hdp => this%t%t(this%n)%data)
1068 type is (double precision)
1069 value => hdp
1070 class default
1071 call neko_error('Key and data of different kind (r8)')
1072 end select
1073
1074 end function htable_iter_r8_value
1075
1077 function htable_iter_r8_key(this) result(key)
1078 class(htable_iter_r8_t), target, intent(inout) :: this
1079 real(kind=dp), pointer :: key
1080
1081 select type (kp => this%t%t(this%n)%key)
1082 type is (double precision)
1083 key => kp
1084 class default
1085 call neko_error('Invalid key (r8)')
1086 end select
1087
1088 end function htable_iter_r8_key
1089
1090 !
1091 ! Point based implementation
1092 !
1094 subroutine htable_pt_init(this, size, data)
1095 class(htable_pt_t), intent(inout) :: this
1096 integer, value :: size
1097 class(*), intent(inout), optional :: data
1098 type(point_t) :: key
1099
1100 if (present(data)) then
1101 call htable_init(this, size, key, data)
1102 else
1103 call htable_init(this, size, key)
1104 end if
1105
1106 end subroutine htable_pt_init
1107
1109 subroutine htable_pt_set(this, key, data)
1110 class(htable_pt_t), intent(inout) :: this
1111 type(point_t), intent(inout) :: key
1112 class(*), intent(inout) :: data
1113
1114 call htable_set(this, key, data)
1115
1116 end subroutine htable_pt_set
1117
1119 function htable_pt_get(this, key, data) result(rcode)
1120 class(htable_pt_t), intent(inout) :: this
1121 type(point_t), intent(inout) :: key
1122 class(*), intent(inout) :: data
1123 integer :: rcode
1124
1125 rcode = htable_get(this, key, data)
1126
1127 end function htable_pt_get
1128
1130 pure function htable_pt_hash(this, k, c) result(hash)
1131 class(htable_pt_t), intent(in) :: this
1132 class(*), intent(in) :: k
1133 integer, value :: c
1134 integer :: hash, i
1135 integer(kind=i8) :: hash2, tmp, mult
1136 integer(kind=i8), parameter :: m1 = int(z'7ed55d15', i8)
1137 integer(kind=i8), parameter :: m2 = int(z'c761c23c', i8)
1138 integer(kind=i8), parameter :: m3 = int(z'165667b1', i8)
1139 integer(kind=i8), parameter :: m4 = int(z'd3a2646c', i8)
1140 integer(kind=i8), parameter :: m5 = int(z'fd7046c5', i8)
1141 integer(kind=i8), parameter :: m6 = int(z'b55a4f09', i8)
1142
1143 select type(k)
1144 type is (point_t)
1145 mult = 1000003
1146 hash2 = int(z'345678')
1147 do i = 1, 3
1148 tmp = transfer(k%x(i), tmp)
1149 tmp = (tmp + m1) + ishft(tmp, 12)
1150 tmp = ieor(ieor(tmp, m2), ishft(tmp, -19))
1151 tmp = (tmp + m3) + ishft(tmp, 5)
1152 tmp = ieor((tmp + m4), ishft(tmp, 9))
1153 tmp = (tmp + m5) + ishft(tmp, 3)
1154 tmp = ieor(ieor(tmp, m6), ishft(tmp, -16))
1155 hash2 = ieor(hash2, tmp) * mult
1156 mult = mult + 82520 + 8
1157 end do
1158 hash2 = hash2 + 97531
1159 hash2 = modulo(hash2 + int(c, i8), int(this%size,i8))
1160 hash = int(hash2, i4)
1161 class default
1162 hash = -1
1163 end select
1164
1165 end function htable_pt_hash
1166
1168 subroutine htable_pt_remove(this, key)
1169 class(htable_pt_t), intent(inout) :: this
1170 type(point_t), intent(inout) :: key
1171
1172 call htable_remove(this, key)
1173
1174 end subroutine htable_pt_remove
1175
1176
1178 subroutine htable_iter_pt_init(this, t)
1179 class(htable_iter_pt_t), intent(inout) :: this
1180 type(htable_pt_t), target, intent(inout) :: t
1181
1182 this%t => t
1183 this%n = -1
1184
1185 end subroutine htable_iter_pt_init
1186
1188 subroutine htable_iter_pt_free(this)
1189 type(htable_iter_pt_t), intent(inout) :: this
1190 nullify(this%t)
1191 end subroutine htable_iter_pt_free
1192
1194 function htable_iter_pt_value(this) result(value)
1195 class(htable_iter_pt_t), target, intent(inout) :: this
1196 type(point_t), pointer :: value
1197
1198 select type (hdp => this%t%t(this%n)%data)
1199 type is (point_t)
1200 value => hdp
1201 class default
1202 call neko_error('Key and data of different kind (pt)')
1203 end select
1204
1205 end function htable_iter_pt_value
1206
1208 function htable_iter_pt_key(this) result(key)
1209 class(htable_iter_pt_t), target, intent(inout) :: this
1210 type(point_t), pointer :: key
1211
1212 select type (kp => this%t%t(this%n)%key)
1213 type is (point_t)
1214 key => kp
1215 class default
1216 call neko_error('Invalid key (pt)')
1217 end select
1218
1219 end function htable_iter_pt_key
1220
1221 !
1222 ! Integer 2-tuple based implementation
1223 !
1225 subroutine htable_i4t2_init(this, size, data)
1226 class(htable_i4t2_t), intent(inout) :: this
1227 integer, value :: size
1228 class(*), intent(inout), optional :: data
1229 type(tuple_i4_t) :: key
1230
1231 if (present(data)) then
1232 call htable_init(this, size, key, data)
1233 else
1234 call htable_init(this, size, key)
1235 end if
1236
1237 end subroutine htable_i4t2_init
1238
1240 subroutine htable_i4t2_set(this, key, data)
1241 class(htable_i4t2_t), intent(inout) :: this
1242 type(tuple_i4_t), intent(inout) :: key
1243 class(*), intent(inout) :: data
1244
1245 call htable_set(this, key, data)
1246
1247 end subroutine htable_i4t2_set
1248
1250 function htable_i4t2_get(this, key, data) result(rcode)
1251 class(htable_i4t2_t), intent(inout) :: this
1252 type(tuple_i4_t), intent(inout) :: key
1253 class(*), intent(inout) :: data
1254 integer :: rcode
1255
1256 rcode = htable_get(this, key, data)
1257
1258 end function htable_i4t2_get
1259
1261 pure function htable_i4t2_hash(this, k, c) result(hash)
1262 class(htable_i4t2_t), intent(in) :: this
1263 class(*), intent(in) :: k
1264 integer, value :: c
1265 integer :: i, hash
1266 integer(kind=i8) :: tmp, hash2, mult
1267 integer(kind=i8), parameter :: m1 = int(z'7ed55d15', i8)
1268 integer(kind=i8), parameter :: m2 = int(z'c761c23c', i8)
1269 integer(kind=i8), parameter :: m3 = int(z'165667b1', i8)
1270 integer(kind=i8), parameter :: m4 = int(z'd3a2646c', i8)
1271 integer(kind=i8), parameter :: m5 = int(z'fd7046c5', i8)
1272 integer(kind=i8), parameter :: m6 = int(z'b55a4f09', i8)
1273
1274 select type(k)
1275 type is (tuple_i4_t)
1276 mult = int(1000003, i8)
1277 hash2 = int(z'345678', i8)
1278 do i = 1, 2
1279 tmp = int(k%x(i), i8)
1280 tmp = (tmp + m1) + ishft(tmp, 12)
1281 tmp = ieor(ieor(tmp, m2), ishft(tmp, -19))
1282 tmp = (tmp + m3) + ishft(tmp, 5)
1283 tmp = ieor((tmp + m4), ishft(tmp, 9))
1284 tmp = (tmp + m5) + ishft(tmp, 3)
1285 tmp = ieor(ieor(tmp, m6), ishft(tmp, -16))
1286 hash2 = ieor(hash2, tmp) * mult
1287 mult = mult + 82520_i8 + 4_i8
1288 end do
1289 hash2 = hash2 + 97531_i8
1290 hash2 = modulo(hash2 + int(c, i8), int(this%size, i8))
1291 hash = int(hash2, i4)
1292 class default
1293 hash = -1
1294 end select
1295 end function htable_i4t2_hash
1296
1298 subroutine htable_i4t2_remove(this, key)
1299 class(htable_i4t2_t), intent(inout) :: this
1300 type(tuple_i4_t), intent(inout) :: key
1301
1302 call htable_remove(this, key)
1303
1304 end subroutine htable_i4t2_remove
1305
1307 subroutine htable_iter_i4t2_init(this, t)
1308 class(htable_iter_i4t2_t), intent(inout) :: this
1309 type(htable_i4t2_t), target, intent(inout) :: t
1310
1311 this%t => t
1312 this%n = -1
1313
1314 end subroutine htable_iter_i4t2_init
1315
1317 subroutine htable_iter_i4t2_free(this)
1318 type(htable_iter_i4t2_t), intent(inout) :: this
1319 nullify(this%t)
1320 end subroutine htable_iter_i4t2_free
1321
1323 function htable_iter_i4t2_value(this) result(value)
1324 class(htable_iter_i4t2_t), intent(inout) :: this
1325 type(tuple_i4_t), pointer :: value
1326
1327 select type (hdp => this%t%t(this%n)%data)
1328 type is (tuple_i4_t)
1329 value => hdp
1330 class default
1331 call neko_error('Key and data of different kind (i4t2)')
1332 end select
1333
1334 end function htable_iter_i4t2_value
1335
1337 function htable_iter_i4t2_key(this) result(key)
1338 class(htable_iter_i4t2_t), intent(inout) :: this
1339 type(tuple_i4_t), pointer :: key
1340
1341 select type (kp => this%t%t(this%n)%key)
1342 type is (tuple_i4_t)
1343 key => kp
1344 class default
1345 call neko_error('Invalid key (i4t2)')
1346 end select
1347
1348 end function htable_iter_i4t2_key
1349
1350 !
1351 ! Integer 4-tuple based implementation
1352 !
1354 subroutine htable_i4t4_init(this, size, data)
1355 class(htable_i4t4_t), intent(inout) :: this
1356 integer, value :: size
1357 class(*), intent(inout), optional :: data
1358 type(tuple4_i4_t) :: key
1359
1360 if (present(data)) then
1361 call htable_init(this, size, key, data)
1362 else
1363 call htable_init(this, size, key)
1364 end if
1365
1366 end subroutine htable_i4t4_init
1367
1369 subroutine htable_i4t4_set(this, key, data)
1370 class(htable_i4t4_t), intent(inout) :: this
1371 type(tuple4_i4_t), intent(inout) :: key
1372 class(*), intent(inout) :: data
1373
1374 call htable_set(this, key, data)
1375
1376 end subroutine htable_i4t4_set
1377
1379 function htable_i4t4_get(this, key, data) result(rcode)
1380 class(htable_i4t4_t), intent(inout) :: this
1381 type(tuple4_i4_t), intent(inout) :: key
1382 class(*), intent(inout) :: data
1383 integer :: rcode
1384
1385 rcode = htable_get(this, key, data)
1386
1387 end function htable_i4t4_get
1388
1390 pure function htable_i4t4_hash(this, k, c) result(hash)
1391 class(htable_i4t4_t), intent(in) :: this
1392 class(*), intent(in) :: k
1393 integer, value :: c
1394 integer :: i, hash
1395 integer(kind=i8) :: tmp, hash2, mult
1396 integer(kind=i8), parameter :: m1 = int(z'7ed55d15', i8)
1397 integer(kind=i8), parameter :: m2 = int(z'c761c23c', i8)
1398 integer(kind=i8), parameter :: m3 = int(z'165667b1', i8)
1399 integer(kind=i8), parameter :: m4 = int(z'd3a2646c', i8)
1400 integer(kind=i8), parameter :: m5 = int(z'fd7046c5', i8)
1401 integer(kind=i8), parameter :: m6 = int(z'b55a4f09', i8)
1402
1403 select type(k)
1404 type is (tuple4_i4_t)
1405 mult = int(1000003, i8)
1406 hash2 = int(z'345678', i8)
1407 do i = 1, 4
1408 tmp = int(k%x(i), i8)
1409 tmp = (tmp + m1) + ishft(tmp, 12)
1410 tmp = ieor(ieor(tmp, m2), ishft(tmp, -19))
1411 tmp = (tmp + m3) + ishft(tmp, 5)
1412 tmp = ieor((tmp + m4), ishft(tmp, 9))
1413 tmp = (tmp + m5) + ishft(tmp, 3)
1414 tmp = ieor(ieor(tmp, m6), ishft(tmp, -16))
1415 hash2 = ieor(hash2, tmp) * mult
1416 mult = mult + 82520_i8 + 8_i8
1417 end do
1418 hash2 = hash2 + 97531_i8
1419 hash2 = modulo(hash2 + int(c, i8), int(this%size, i8))
1420 hash = int(hash2, i4)
1421 class default
1422 hash = -1
1423 end select
1424 end function htable_i4t4_hash
1425
1427 subroutine htable_i4t4_remove(this, key)
1428 class(htable_i4t4_t), intent(inout) :: this
1429 type(tuple4_i4_t), intent(inout) :: key
1430
1431 call htable_remove(this, key)
1432
1433 end subroutine htable_i4t4_remove
1434
1436 subroutine htable_iter_i4t4_init(this, t)
1437 class(htable_iter_i4t4_t), intent(inout) :: this
1438 type(htable_i4t4_t), target, intent(inout) :: t
1439
1440 this%t => t
1441 this%n = -1
1442
1443 end subroutine htable_iter_i4t4_init
1444
1446 subroutine htable_iter_i4t4_free(this)
1447 type(htable_iter_i4t4_t), intent(inout) :: this
1448 nullify(this%t)
1449 end subroutine htable_iter_i4t4_free
1450
1452 function htable_iter_i4t4_value(this) result(value)
1453 class(htable_iter_i4t4_t), target, intent(inout) :: this
1454 type(tuple4_i4_t), pointer :: value
1455
1456 select type (hdp => this%t%t(this%n)%data)
1457 type is (tuple4_i4_t)
1458 value => hdp
1459 class default
1460 call neko_error('Key and data of different kind (i4t4)')
1461 end select
1462
1463 end function htable_iter_i4t4_value
1464
1466 function htable_iter_i4t4_key(this) result(key)
1467 class(htable_iter_i4t4_t), target, intent(inout) :: this
1468 type(tuple4_i4_t), pointer :: key
1469
1470 ! We should not need this extra select block, and it works great
1471 ! without it for GNU, Intel and NEC, but breaks horribly on Cray
1472 ! (>11.0.x) when using high opt. levels.
1473 select type(hti => this)
1474 type is(htable_iter_i4t4_t)
1475 select type (kp => hti%t%t(this%n)%key)
1476 type is (tuple4_i4_t)
1477 key => kp
1478 class default
1479 call neko_error('Invalid key (i4t4)')
1480 end select
1481 class default
1482 call neko_error('Corrupt htable iter. (i4t4)')
1483 end select
1484
1485 end function htable_iter_i4t4_key
1486
1487 !
1488 ! C pointer based implementation
1489 !
1491 subroutine htable_cptr_init(this, size, data)
1492 class(htable_cptr_t), intent(inout) :: this
1493 integer, value :: size
1494 class(*), intent(inout), optional :: data
1495 type(h_cptr_t) :: key
1496
1497 if (present(data)) then
1498 call htable_init(this, size, key, data)
1499 else
1500 call htable_init(this, size, key)
1501 end if
1502
1503 end subroutine htable_cptr_init
1504
1506 subroutine htable_cptr_set(this, key, data)
1507 class(htable_cptr_t), target, intent(inout) :: this
1508 type(h_cptr_t), intent(inout) :: key
1509 class(*), intent(inout) :: data
1510
1511 call htable_set(this, key, data)
1512
1513 end subroutine htable_cptr_set
1514
1516 function htable_cptr_get(this, key, data) result(rcode)
1517 class(htable_cptr_t), target, intent(inout) :: this
1518 type(h_cptr_t), intent(inout) :: key
1519 class(*), intent(inout) :: data
1520 integer :: rcode
1521
1522 rcode = htable_get(this, key, data)
1523
1524 end function htable_cptr_get
1525
1527 pure function htable_cptr_hash(this, k, c) result(hash)
1528 class(htable_cptr_t), intent(in) :: this
1529 class(*), intent(in) :: k
1530 integer, value :: c
1531 integer :: hash
1532 integer(kind=i8) :: k_int
1533
1534 select type(k)
1535 type is (h_cptr_t)
1536 k_int = transfer(k%ptr, k_int)
1537 hash = int(modulo(k_int * 2654435761_i8 + int(c, i8),&
1538 int(this%size, i8)), i4)
1539 class default
1540 hash = -1
1541 end select
1542 end function htable_cptr_hash
1543
1545 subroutine htable_cptr_remove(this, key)
1546 class(htable_cptr_t), target, intent(inout) :: this
1547 type(h_cptr_t), intent(inout) :: key
1548
1549 call htable_remove(this, key)
1550
1551 end subroutine htable_cptr_remove
1552
1554 subroutine htable_iter_cptr_init(this, t)
1555 class(htable_iter_cptr_t), intent(inout) :: this
1556 type(htable_cptr_t), target, intent(inout) :: t
1557
1558 this%t => t
1559 this%n = -1
1560
1561 end subroutine htable_iter_cptr_init
1562
1564 subroutine htable_iter_cptr_free(this)
1565 type(htable_iter_cptr_t), intent(inout) :: this
1566 nullify(this%t)
1567 end subroutine htable_iter_cptr_free
1568
1570 function htable_iter_cptr_value(this) result(value)
1571 class(htable_iter_cptr_t), target, intent(inout) :: this
1572 class(*), pointer :: hdp
1573 type(h_cptr_t), pointer :: value
1574
1575 hdp => this%t%t(this%n)%data
1576 select type (hdp)
1577 type is (h_cptr_t)
1578 value => hdp
1579 class default
1580 call neko_error('Key and data of different kind (cptr)')
1581 end select
1582
1583 end function htable_iter_cptr_value
1584
1586 function htable_iter_cptr_key(this) result(key)
1587 class(htable_iter_cptr_t), target, intent(inout) :: this
1588 class(*), pointer :: kp
1589 type(h_cptr_t), pointer :: key
1590
1591 kp => this%t%t(this%n)%key
1592 select type (kp)
1593 type is (h_cptr_t)
1594 key => kp
1595 class default
1596 call neko_error('Invalid key (cptr)')
1597 end select
1598
1599 end function htable_iter_cptr_key
1600
1601end module htable
Implements a hash table ADT.
Definition htable.f90:36
subroutine htable_i4t4_init(this, size, data)
Initialize an integer 4-tuple hash table.
Definition htable.f90:1355
subroutine htable_iter_r8_init(this, t)
Initialize a double precision based hash table iterator.
Definition htable.f90:1048
subroutine htable_clear(this)
Clear all entries in a hash table.
Definition htable.f90:291
subroutine htable_pt_init(this, size, data)
Initialize a point based hash table.
Definition htable.f90:1095
type(tuple_i4_t) function, pointer htable_iter_i4t2_key(this)
Return the current key of integer based 2-tuple hash table iterator.
Definition htable.f90:1338
subroutine htable_iter_i8_free(this)
Destroy an integer*8 based hash table iterator.
Definition htable.f90:941
subroutine htable_i4_set(this, key, data)
Insert an integer into the hash table.
Definition htable.f90:748
type(tuple4_i4_t) function, pointer htable_iter_i4t4_value(this)
Return the current value of integer based 4-tuple hash table iterator.
Definition htable.f90:1453
integer function, pointer htable_iter_i4_value(this)
Return the current value of the integer based hash table iterator.
Definition htable.f90:824
subroutine htable_r8_init(this, size, data)
Initialize a double precision based hash table.
Definition htable.f90:988
integer(kind=i8) function, pointer htable_iter_i8_key(this)
Return the current key of the integer*8 based hash table iterator.
Definition htable.f90:962
type(point_t) function, pointer htable_iter_pt_key(this)
Return the current key of the point based hash table iterator.
Definition htable.f90:1209
pure integer function htable_r8_hash(this, k, c)
Hash function for a double precision based hash table.
Definition htable.f90:1024
subroutine htable_cptr_init(this, size, data)
Initialize a C pointer based hash table.
Definition htable.f90:1492
pure integer function htable_i4_hash(this, k, c)
Hash function for an integer based hash table.
Definition htable.f90:769
subroutine htable_iter_cptr_free(this)
Destroy a C pointer based hash table iterator.
Definition htable.f90:1565
subroutine htable_iter_pt_free(this)
Destroy a point based hash table iterator.
Definition htable.f90:1189
subroutine htable_i4t4_set(this, key, data)
Insert an integer 4-tuple into the hash table.
Definition htable.f90:1370
subroutine htable_i8_init(this, size, data)
Initialize an integer*8 based hash table.
Definition htable.f90:855
subroutine htable_pt_remove(this, key)
Remove a point with key key from the hash table.
Definition htable.f90:1169
subroutine htable_cptr_remove(this, key)
Remove a C pointer with key key from the hash table.
Definition htable.f90:1546
subroutine htable_free(this)
Destroy a hash table.
Definition htable.f90:273
subroutine htable_iter_data(this, data)
Return the data at the current iterator position.
Definition htable.f90:684
pure integer function htable_size(this)
Return total size of htable.
Definition htable.f90:311
subroutine htable_get_data(this, idx, data)
Return data at idx in value.
Definition htable.f90:526
integer function htable_r8_get(this, key, data)
Retrive a double precision float with key key from the hash table.
Definition htable.f90:1013
pure integer function htable_i8_hash(this, k, c)
Hash function for an integer*8 based hash table.
Definition htable.f90:891
subroutine htable_i4t4_remove(this, key)
Remove an integer 4-tuple with key key from the hash table.
Definition htable.f90:1428
integer function htable_get(this, key, data)
Retrieve data associated with key into the hash table.
Definition htable.f90:420
integer function htable_i8_get(this, key, data)
Retrive an integer*8 with key key from the hash table.
Definition htable.f90:880
integer function htable_pt_get(this, key, data)
Retrive a point with key key from the hash table.
Definition htable.f90:1120
subroutine htable_remove(this, key)
Remove a key from the hash table.
Definition htable.f90:453
subroutine htable_set_data(this, idx, data)
Set data at idx to value.
Definition htable.f90:480
real(kind=dp) function, pointer htable_iter_r8_key(this)
Return the current key of the double precision based hash table iterator.
Definition htable.f90:1078
subroutine htable_iter_pt_init(this, t)
Initialize a point based hash table iterator.
Definition htable.f90:1179
integer function htable_i4_get(this, key, data)
Retrive an integer with key key from the hash table.
Definition htable.f90:758
type(h_cptr_t) function, pointer htable_iter_cptr_value(this)
Return the current value of C pointer based hash table iterator.
Definition htable.f90:1571
type(tuple_i4_t) function, pointer htable_iter_i4t2_value(this)
Return the current value of integer based 2-tuple hash table iterator.
Definition htable.f90:1324
logical function htable_iter_next(this)
Advance the iterator to the next valid table entry.
Definition htable.f90:660
integer function htable_cptr_get(this, key, data)
Retrive a C pointer with key key from the hash table.
Definition htable.f90:1517
subroutine htable_i8_set(this, key, data)
Insert an integer*8 into the hash table.
Definition htable.f90:870
subroutine htable_r8_remove(this, key)
Remove a double precision key key from the hash table.
Definition htable.f90:1038
subroutine htable_iter_i4t2_free(this)
Destroy an integer 2-tuple based hash table iterator.
Definition htable.f90:1318
subroutine htable_r8_set(this, key, data)
Insert a double precision key (with data) into the hash table.
Definition htable.f90:1003
type(point_t) function, pointer htable_iter_pt_value(this)
Return the current value of the point based hash table iterator.
Definition htable.f90:1195
integer function htable_i4t4_get(this, key, data)
Retrive an integer 4-tuple with key key from the hash table.
Definition htable.f90:1380
subroutine htable_i4t2_set(this, key, data)
Insert an integer 2-tuple into the hash table.
Definition htable.f90:1241
pure integer function htable_num_entries(this)
Return number of entries in the table.
Definition htable.f90:304
type(tuple4_i4_t) function, pointer htable_iter_i4t4_key(this)
Return the current key of integer based 4-tuple hash table iterator.
Definition htable.f90:1467
recursive subroutine htable_set(this, key, data)
Insert tuple (key, value) into the hash table.
Definition htable.f90:319
pure logical function htable_eq_key(this, idx, key)
Compare key at idx to key.
Definition htable.f90:570
subroutine htable_i4t2_remove(this, key)
Remove an integer 2-tuple with key key from the hash table.
Definition htable.f90:1299
subroutine htable_set_key(this, idx, key)
Set key at idx to key.
Definition htable.f90:614
subroutine htable_iter_i8_init(this, t)
Initialize an integer*8 based hash table iterator.
Definition htable.f90:931
pure integer function htable_i4t4_hash(this, k, c)
Hash function for an integer 4-tuple hash table.
Definition htable.f90:1391
pure integer function htable_pt_hash(this, k, c)
Hash function for a point based hash table.
Definition htable.f90:1131
integer function, pointer htable_iter_i4_key(this)
Return the current key of the integer based hash table iterator.
Definition htable.f90:838
subroutine htable_iter_i4_init(this, t)
Initialize an integer based hash table iterator.
Definition htable.f90:808
subroutine htable_init(this, size, key, data)
Initialize a hash table of type data.
Definition htable.f90:239
subroutine htable_i4t2_init(this, size, data)
Initialize an integer 2-tuple hash table.
Definition htable.f90:1226
subroutine htable_cptr_set(this, key, data)
Insert a C pointer into the hash table.
Definition htable.f90:1507
subroutine htable_iter_i4t4_free(this)
Destroy an integer 4-tuple based hash table iterator.
Definition htable.f90:1447
subroutine htable_i4_remove(this, key)
Remove an integer with key key from the hash table.
Definition htable.f90:799
subroutine htable_iter_cptr_init(this, t)
Initialize a C pointer based hash table iterator.
Definition htable.f90:1555
integer(kind=i8) function, pointer htable_iter_i8_value(this)
Return the current value of the integer*8 based hash table iterator.
Definition htable.f90:947
integer function htable_i4t2_get(this, key, data)
Retrive an integer 2-tuple with key key from the hash table.
Definition htable.f90:1251
subroutine htable_iter_i4t4_init(this, t)
Initialize an integer 4-tuple based hash table iterator.
Definition htable.f90:1437
subroutine htable_i8_remove(this, key)
Remove an integer*8 with key key from the hash table.
Definition htable.f90:922
subroutine htable_i4_init(this, size, data)
Initialize an integer based hash table.
Definition htable.f90:733
pure integer function htable_cptr_hash(this, k, c)
Hash function for an integer 4-tuple hash table.
Definition htable.f90:1528
subroutine htable_pt_set(this, key, data)
Insert a point key (with data) into the hash table.
Definition htable.f90:1110
subroutine htable_iter_reset(this)
Reset an iterator.
Definition htable.f90:675
subroutine htable_iter_i4_free(this)
Destroy an integer based hash table iterator.
Definition htable.f90:818
type(h_cptr_t) function, pointer htable_iter_cptr_key(this)
Return the current key of a C pointer based hash table iterator.
Definition htable.f90:1587
subroutine htable_iter_r8_free(this)
Destroy a double precision based hash table iterator.
Definition htable.f90:1058
pure integer function htable_i4t2_hash(this, k, c)
Hash function for an integer 2-tuple hash table.
Definition htable.f90:1262
subroutine htable_iter_i4t2_init(this, t)
Initialize an integer 2-tuple based hash table iterator.
Definition htable.f90:1308
real(kind=dp) function, pointer htable_iter_r8_value(this)
Return the current value of the double precision based hash table iterator.
Definition htable.f90:1064
Definition math.f90:60
real(kind=rp), parameter, public neko_m_ln2
Definition math.f90:72
integer, parameter, public i8
Definition num_types.f90:7
integer, parameter, public i4
Definition num_types.f90:6
integer, parameter, public dp
Definition num_types.f90:9
Implements a point.
Definition point.f90:35
Implements a n-tuple.
Definition tuple.f90:34
Utilities.
Definition utils.f90:35
Hash table entry, tuple (key, data)
Definition htable.f90:47
C pointer based hash table.
Definition htable.f90:142
Integer based hash table.
Definition htable.f90:82
Integer 2-tuple based hash table.
Definition htable.f90:122
Integer 4-tuple based hash table.
Definition htable.f90:132
Integer*8 based hash table.
Definition htable.f90:92
Iterator for a C pointer based hash table.
Definition htable.f90:220
Iterator for an integer based hash table.
Definition htable.f90:166
Iterator for an integer based 2-tuple hash table.
Definition htable.f90:202
Iterator for an integer based 4-tuple hash table.
Definition htable.f90:211
Iterator for an integer*8 based hash table.
Definition htable.f90:175
Iterator for a point based hash table.
Definition htable.f90:193
Iterator for a double precision based hash table.
Definition htable.f90:184
Base type for a hash table iterator.
Definition htable.f90:156
Point based hash table.
Definition htable.f90:112
Double precision based hash table.
Definition htable.f90:102
Base type for a hash table.
Definition htable.f90:55
A point in with coordinates .
Definition point.f90:43
Integer based 4-tuple.
Definition tuple.f90:69
Integer based 2-tuple.
Definition tuple.f90:51
Base type for an n-tuple.
Definition tuple.f90:41