Neko  0.9.99
A portable framework for high-order spectral element flow simulations
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 !
36 module htable
37  use num_types
38  use utils
39  use point, only : point_t
40  use tuple, only : tuple_i4_t, tuple4_i4_t, tuple_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 
235 contains
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  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)
374  end if
375  end do
376  this%size = tmp%size
377  call move_alloc(tmp%t, this%t)
378 
379  call htable_set(this, key, data)
380 
381  end subroutine htable_set
382 
384  function htable_get(this, key, data) result(rcode)
385  class(htable_t), intent(inout) :: this
386  class(*), intent(inout) :: key
387  class(*), intent(inout) :: data
388  integer :: rcode
389  integer :: index, i, c
390 
391  c = 0
392  i = log(1.0/this%size)/log(0.6)
393 
394  do while (i .ge. 0)
395  index = this%hash(key, c**2)
396  if (index .lt. 0) then
397  call neko_error("Invalid hash generated")
398  end if
399 
400  if (.not. this%t(index)%valid .and. &
401  .not. this%t(index)%skip) then
402  rcode = 1
403  return
404  else if ((this%t(index)%valid) .and. &
405  htable_eq_key(this, index, key)) then
406  call htable_get_data(this, index, data)
407  rcode = 0
408  return
409  end if
410  i = i - 1
411  c = c + 1
412  end do
413  rcode = 1
414  end function htable_get
415 
417  subroutine htable_remove(this, key)
418  class(htable_t), intent(inout) :: this
419  class(*), intent(inout) :: key
420  integer :: index, i, c
421 
422  c = 0
423  i = log(1.0/this%size)/log(0.6)
424 
425  do while (i .ge. 0)
426  index = this%hash(key, c**2)
427  if (index .lt. 0) then
428  call neko_error("Invalid hash generated")
429  end if
430 
431  if ((this%t(index)%valid) .and. &
432  htable_eq_key(this, index, key)) then
433  this%t(index)%valid = .false.
434  this%t(index)%skip = .true.
435  this%entries = this%entries - 1
436  return
437  end if
438  i = i - 1
439  c = c + 1
440  end do
441  end subroutine htable_remove
442 
444  subroutine htable_set_data(this, idx, data)
445  class(htable_t), target, intent(inout) :: this
446  integer, intent(in) :: idx
447  class(*), intent(in) :: data
448  class(*), pointer :: hdp
449 
450  hdp => this%t(idx)%data
451  select type (data)
452  type is (integer)
453  select type(hdp)
454  type is (integer)
455  hdp = data
456  end select
457  type is (integer(i8))
458  select type(hdp)
459  type is (integer(i8))
460  hdp = data
461  end select
462  type is (double precision)
463  select type(hdp)
464  type is (double precision)
465  hdp = data
466  end select
467  type is (point_t)
468  select type(hdp)
469  type is (point_t)
470  hdp = data
471  end select
472  class is (tuple_t)
473  select type(hdp)
474  type is (tuple_i4_t)
475  hdp = data
476  type is (tuple4_i4_t)
477  hdp = data
478  end select
479  type is (h_cptr_t)
480  select type(hdp)
481  type is (h_cptr_t)
482  hdp = data
483  end select
484  class default
485  call neko_error('Invalid htable data (set)')
486  end select
487  end subroutine htable_set_data
488 
490  subroutine htable_get_data(this, idx, data)
491  class(htable_t), intent(in) :: this
492  integer, intent(in) :: idx
493  class(*), intent(inout) :: data
494 
495  select type (hdp=>this%t(idx)%data)
496  type is (integer)
497  select type(data)
498  type is (integer)
499  data = hdp
500  end select
501  type is (integer(i8))
502  select type(data)
503  type is (integer(i8))
504  data = hdp
505  end select
506  type is (double precision)
507  select type(data)
508  type is (double precision)
509  data = hdp
510  end select
511  type is (point_t)
512  select type(data)
513  type is (point_t)
514  data = hdp
515  end select
516  class is (tuple_t)
517  select type(data)
518  type is (tuple_i4_t)
519  data = hdp
520  type is (tuple4_i4_t)
521  data = hdp
522  end select
523  type is (h_cptr_t)
524  select type (data)
525  type is (h_cptr_t)
526  data = hdp
527  end select
528  class default
529  call neko_error('Invalid htable data (get)')
530  end select
531  end subroutine htable_get_data
532 
534  pure function htable_eq_key(this, idx, key) result(res)
535  class(htable_t), intent(in) :: this
536  integer, intent(in) :: idx
537  class(*), intent(in) :: key
538  logical :: res
539 
540  res = .true.
541  select type (kp=>this%t(idx)%key)
542  type is (integer)
543  select type(key)
544  type is (integer)
545  res = (kp .eq. key)
546  end select
547  type is (integer(i8))
548  select type(key)
549  type is (integer(i8))
550  res = (kp .eq. key)
551  end select
552  type is (double precision)
553  select type(key)
554  type is (double precision)
555  res = (kp .eq. key)
556  end select
557  type is (point_t)
558  select type (key)
559  type is (point_t)
560  res = (kp .eq. key)
561  end select
562  class is (tuple_t)
563  select type (key)
564  type is (tuple_i4_t)
565  res = (key .eq. kp)
566  type is (tuple4_i4_t)
567  res = (key .eq. kp)
568  end select
569  type is (h_cptr_t)
570  select type (key)
571  type is (h_cptr_t)
572  res = c_associated(kp%ptr, key%ptr)
573  end select
574  end select
575  end function htable_eq_key
576 
578  subroutine htable_set_key(this, idx, key)
579  class(htable_t), target, intent(inout) :: this
580  integer, intent(in) :: idx
581  class(*), intent(in) :: key
582  class(*), pointer :: kp
583 
584  kp => this%t(idx)%key
585  select type(key)
586  type is (integer)
587  select type(kp)
588  type is (integer)
589  kp = key
590  end select
591  type is (integer(i8))
592  select type(kp)
593  type is (integer(i8))
594  kp = key
595  end select
596  type is (double precision)
597  select type(kp)
598  type is (double precision)
599  kp = key
600  end select
601  type is (point_t)
602  select type (kp)
603  type is (point_t)
604  kp = key
605  end select
606  class is (tuple_t)
607  select type(kp)
608  type is (tuple_i4_t)
609  kp = key
610  type is (tuple4_i4_t)
611  kp = key
612  end select
613  type is (h_cptr_t)
614  select type(kp)
615  type is (h_cptr_t)
616  kp = key
617  end select
618  class default
619  call neko_error('Invalid htable key (set)')
620  end select
621  end subroutine htable_set_key
622 
624  function htable_iter_next(this) result(valid)
625  class(htable_iter_t), intent(inout) :: this
626  logical :: valid
627 
628  this%n = this%n + 1
629  do while ((.not. this%t%t(this%n)%valid) .and. (this%n .lt. this%t%size))
630  this%n = this%n + 1
631  end do
632 
633  valid = (this%n .lt. this%t%size)
634  if (.not. valid) this%n = -1
635 
636  end function htable_iter_next
637 
639  subroutine htable_iter_reset(this)
640  class(htable_iter_t), intent(inout) :: this
641  this%n = -1
642  end subroutine htable_iter_reset
643 
648  subroutine htable_iter_data(this, data)
649  class(htable_iter_t), target, intent(inout) :: this
650  class(*), intent(inout) :: data
651  class(*), pointer :: hdp
652 
653  hdp => this%t%t(this%n)%data
654  select type(hdp)
655  type is (integer)
656  select type (data)
657  type is (integer)
658  data = hdp
659  end select
660  type is (integer(i8))
661  select type (data)
662  type is (integer(i8))
663  data = hdp
664  end select
665  type is (double precision)
666  select type(data)
667  type is (double precision)
668  data = hdp
669  end select
670  type is (point_t)
671  select type (data)
672  type is (point_t)
673  data = hdp
674  end select
675  class is (tuple_t)
676  select type (data)
677  type is (tuple_i4_t)
678  data = hdp
679  type is (tuple4_i4_t)
680  data = hdp
681  end select
682  type is (h_cptr_t)
683  select type (data)
684  type is (h_cptr_t)
685  data = hdp
686  end select
687  class default
688  call neko_error('Invalid htable data (iter)')
689  end select
690 
691  end subroutine htable_iter_data
692 
693  !
694  ! Integer based implementation
695  !
697  subroutine htable_i4_init(this, size, data)
698  class(htable_i4_t), intent(inout) :: this
699  integer, value :: size
700  class(*), intent(inout), optional :: data
701  integer :: key
702 
703  if (present(data)) then
704  call htable_init(this, size, key, data)
705  else
706  call htable_init(this, size, key)
707  end if
708 
709  end subroutine htable_i4_init
710 
712  subroutine htable_i4_set(this, key, data)
713  class(htable_i4_t), intent(inout) :: this
714  integer, intent(inout) :: key
715  class(*), intent(inout) :: data
716 
717  call htable_set(this, key, data)
718 
719  end subroutine htable_i4_set
720 
722  function htable_i4_get(this, key, data) result(rcode)
723  class(htable_i4_t), intent(inout) :: this
724  integer, intent(inout) :: key
725  class(*), intent(inout) :: data
726  integer :: rcode
727 
728  rcode = htable_get(this, key, data)
729 
730  end function htable_i4_get
731 
733  pure function htable_i4_hash(this, k, c) result(hash)
734  class(htable_i4_t), intent(in) :: this
735  class(*), intent(in) :: k
736  integer, value :: c
737  integer :: hash
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)
745 
746  select type(k)
747  type is (integer)
748  tmp = int(k, 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))
756  hash = int(tmp, i4)
757  class default
758  hash = -1
759  end select
760  end function htable_i4_hash
761 
763  subroutine htable_i4_remove(this, key)
764  class(htable_i4_t), intent(inout) :: this
765  integer, intent(inout) :: key
766 
767  call htable_remove(this, key)
768 
769  end subroutine htable_i4_remove
770 
772  subroutine htable_iter_i4_init(this, t)
773  class(htable_iter_i4_t), intent(inout) :: this
774  type(htable_i4_t), target, intent(inout) :: t
775 
776  this%t => t
777  this%n = -1
778 
779  end subroutine htable_iter_i4_init
780 
782  subroutine htable_iter_i4_free(this)
783  type(htable_iter_i4_t), intent(inout) :: this
784  nullify(this%t)
785  end subroutine htable_iter_i4_free
786 
788  function htable_iter_i4_value(this) result(value)
789  class(htable_iter_i4_t), target, intent(inout) :: this
790  integer, pointer :: value
791 
792  select type (hdp => this%t%t(this%n)%data)
793  type is (integer)
794  value => hdp
795  class default
796  call neko_error('Key and data of different kind (i4)')
797  end select
798 
799  end function htable_iter_i4_value
800 
802  function htable_iter_i4_key(this) result(key)
803  class(htable_iter_i4_t), target, intent(inout) :: this
804  integer, pointer :: key
805 
806  select type (kp => this%t%t(this%n)%key)
807  type is (integer)
808  key => kp
809  class default
810  call neko_error('Invalid key (i4)')
811  end select
812 
813  end function htable_iter_i4_key
814 
815  !
816  ! Integer*8 based implementation
817  !
819  subroutine htable_i8_init(this, size, data)
820  class(htable_i8_t), intent(inout) :: this
821  integer, value :: size
822  class(*), intent(inout), optional :: data
823  integer(kind=i8) :: key
824 
825  if (present(data)) then
826  call htable_init(this, size, key, data)
827  else
828  call htable_init(this, size, key)
829  end if
830 
831  end subroutine htable_i8_init
832 
834  subroutine htable_i8_set(this, key, data)
835  class(htable_i8_t), intent(inout) :: this
836  integer(kind=i8), intent(inout) :: key
837  class(*), intent(inout) :: data
838 
839  call htable_set(this, key, data)
840 
841  end subroutine htable_i8_set
842 
844  function htable_i8_get(this, key, data) result(rcode)
845  class(htable_i8_t), intent(inout) :: this
846  integer(kind=i8), intent(inout) :: key
847  class(*), intent(inout) :: data
848  integer :: rcode
849 
850  rcode = htable_get(this, key, data)
851 
852  end function htable_i8_get
853 
855  pure function htable_i8_hash(this, k, c) result(hash)
856  class(htable_i8_t), intent(in) :: this
857  class(*), intent(in) :: k
858  integer, value :: c
859  integer :: hash
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)
867 
868  select type(k)
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)
880  class default
881  hash = -1
882  end select
883  end function htable_i8_hash
884 
886  subroutine htable_i8_remove(this, key)
887  class(htable_i8_t), intent(inout) :: this
888  integer(kind=i8), intent(inout) :: key
889 
890  call htable_remove(this, key)
891 
892  end subroutine htable_i8_remove
893 
895  subroutine htable_iter_i8_init(this, t)
896  class(htable_iter_i8_t), intent(inout) :: this
897  type(htable_i8_t), target, intent(inout) :: t
898 
899  this%t => t
900  this%n = -1
901 
902  end subroutine htable_iter_i8_init
903 
905  subroutine htable_iter_i8_free(this)
906  type(htable_iter_i8_t), intent(inout) :: this
907  nullify(this%t)
908  end subroutine htable_iter_i8_free
909 
911  function htable_iter_i8_value(this) result(value)
912  class(htable_iter_i8_t), target, intent(inout) :: this
913  integer(kind=i8), pointer :: value
914 
915 
916  select type (hdp => this%t%t(this%n)%data)
917  type is (integer(i8))
918  value => hdp
919  class default
920  call neko_error('Key and data of different kind (i8)')
921  end select
922 
923  end function htable_iter_i8_value
924 
926  function htable_iter_i8_key(this) result(key)
927  class(htable_iter_i8_t), target, intent(inout) :: this
928  integer(kind=i8), pointer :: key
929 
930  ! We should not need this extra select block, and it works great
931  ! without it for GNU, Intel and NEC, but breaks horribly on Cray
932  ! (>11.0.x) when using high opt. levels.
933  select type(hti => this)
934  type is(htable_iter_i8_t)
935  select type (kp => hti%t%t(this%n)%key)
936  type is (integer(i8))
937  key => kp
938  class default
939  call neko_error('Invalid key (i8)')
940  end select
941  class default
942  call neko_error('Corrupt htable iter. (i8)')
943  end select
944 
945  end function htable_iter_i8_key
946 
947 
948  !
949  ! Double precision based implementation
950  !
952  subroutine htable_r8_init(this, size, data)
953  class(htable_r8_t), intent(inout) :: this
954  integer, value :: size
955  class(*), intent(inout), optional :: data
956  real(kind=dp) :: key
957 
958  if (present(data)) then
959  call htable_init(this, size, key, data)
960  else
961  call htable_init(this, size, key)
962  end if
963 
964  end subroutine htable_r8_init
965 
967  subroutine htable_r8_set(this, key, data)
968  class(htable_r8_t), intent(inout) :: this
969  real(kind=dp), intent(inout) :: key
970  class(*), intent(inout) :: data
971 
972  call htable_set(this, key, data)
973 
974  end subroutine htable_r8_set
975 
977  function htable_r8_get(this, key, data) result(rcode)
978  class(htable_r8_t), intent(inout) :: this
979  real(kind=dp), intent(inout) :: key
980  class(*), intent(inout) :: data
981  integer :: rcode
982 
983  rcode = htable_get(this, key, data)
984 
985  end function htable_r8_get
986 
988  pure function htable_r8_hash(this, k, c) result(hash)
989  class(htable_r8_t), intent(in) :: this
990  class(*), intent(in) :: k
991  integer, value :: c
992  integer :: hash
993  select type(k)
994  type is (double precision)
995  hash = modulo(floor((2d0 * abs(fraction(k)) - 1d0) * 2**16) + c, this%size)
996  class default
997  hash = -1
998  end select
999  end function htable_r8_hash
1000 
1002  subroutine htable_r8_remove(this, key)
1003  class(htable_r8_t), intent(inout) :: this
1004  real(kind=dp), intent(inout) :: key
1005 
1006  call htable_remove(this, key)
1007 
1008  end subroutine htable_r8_remove
1009 
1010 
1012  subroutine htable_iter_r8_init(this, t)
1013  class(htable_iter_r8_t), intent(inout) :: this
1014  type(htable_r8_t), target, intent(inout) :: t
1015 
1016  this%t => t
1017  this%n = -1
1018 
1019  end subroutine htable_iter_r8_init
1020 
1022  subroutine htable_iter_r8_free(this)
1023  type(htable_iter_r8_t), intent(inout) :: this
1024  nullify(this%t)
1025  end subroutine htable_iter_r8_free
1026 
1028  function htable_iter_r8_value(this) result(value)
1029  class(htable_iter_r8_t), target, intent(inout) :: this
1030  real(kind=dp), pointer :: value
1031 
1032  select type (hdp => this%t%t(this%n)%data)
1033  type is (double precision)
1034  value => hdp
1035  class default
1036  call neko_error('Key and data of different kind (r8)')
1037  end select
1038 
1039  end function htable_iter_r8_value
1040 
1042  function htable_iter_r8_key(this) result(key)
1043  class(htable_iter_r8_t), target, intent(inout) :: this
1044  real(kind=dp), pointer :: key
1045 
1046  select type (kp => this%t%t(this%n)%key)
1047  type is (double precision)
1048  key => kp
1049  class default
1050  call neko_error('Invalid key (r8)')
1051  end select
1052 
1053  end function htable_iter_r8_key
1054 
1055  !
1056  ! Point based implementation
1057  !
1059  subroutine htable_pt_init(this, size, data)
1060  class(htable_pt_t), intent(inout) :: this
1061  integer, value :: size
1062  class(*), intent(inout), optional :: data
1063  type(point_t) :: key
1064 
1065  if (present(data)) then
1066  call htable_init(this, size, key, data)
1067  else
1068  call htable_init(this, size, key)
1069  end if
1070 
1071  end subroutine htable_pt_init
1072 
1074  subroutine htable_pt_set(this, key, data)
1075  class(htable_pt_t), intent(inout) :: this
1076  type(point_t), intent(inout) :: key
1077  class(*), intent(inout) :: data
1078 
1079  call htable_set(this, key, data)
1080 
1081  end subroutine htable_pt_set
1082 
1084  function htable_pt_get(this, key, data) result(rcode)
1085  class(htable_pt_t), intent(inout) :: this
1086  type(point_t), intent(inout) :: key
1087  class(*), intent(inout) :: data
1088  integer :: rcode
1089 
1090  rcode = htable_get(this, key, data)
1091 
1092  end function htable_pt_get
1093 
1095  pure function htable_pt_hash(this, k, c) result(hash)
1096  class(htable_pt_t), intent(in) :: this
1097  class(*), intent(in) :: k
1098  integer, value :: c
1099  integer :: hash, i
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)
1107 
1108  select type(k)
1109  type is (point_t)
1110  mult = 1000003
1111  hash2 = int(z'345678')
1112  do i = 1, 3
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
1122  end do
1123  hash2 = hash2 + 97531
1124  hash2 = modulo(hash2 + int(c, i8), int(this%size,i8))
1125  hash = int(hash2, i4)
1126  class default
1127  hash = -1
1128  end select
1129 
1130  end function htable_pt_hash
1131 
1133  subroutine htable_pt_remove(this, key)
1134  class(htable_pt_t), intent(inout) :: this
1135  type(point_t), intent(inout) :: key
1136 
1137  call htable_remove(this, key)
1138 
1139  end subroutine htable_pt_remove
1140 
1141 
1143  subroutine htable_iter_pt_init(this, t)
1144  class(htable_iter_pt_t), intent(inout) :: this
1145  type(htable_pt_t), target, intent(inout) :: t
1146 
1147  this%t => t
1148  this%n = -1
1149 
1150  end subroutine htable_iter_pt_init
1151 
1153  subroutine htable_iter_pt_free(this)
1154  type(htable_iter_pt_t), intent(inout) :: this
1155  nullify(this%t)
1156  end subroutine htable_iter_pt_free
1157 
1159  function htable_iter_pt_value(this) result(value)
1160  class(htable_iter_pt_t), target, intent(inout) :: this
1161  type(point_t), pointer :: value
1162 
1163  select type (hdp => this%t%t(this%n)%data)
1164  type is (point_t)
1165  value => hdp
1166  class default
1167  call neko_error('Key and data of different kind (pt)')
1168  end select
1169 
1170  end function htable_iter_pt_value
1171 
1173  function htable_iter_pt_key(this) result(key)
1174  class(htable_iter_pt_t), target, intent(inout) :: this
1175  type(point_t), pointer :: key
1176 
1177  select type (kp => this%t%t(this%n)%key)
1178  type is (point_t)
1179  key => kp
1180  class default
1181  call neko_error('Invalid key (pt)')
1182  end select
1183 
1184  end function htable_iter_pt_key
1185 
1186  !
1187  ! Integer 2-tuple based implementation
1188  !
1190  subroutine htable_i4t2_init(this, size, data)
1191  class(htable_i4t2_t), intent(inout) :: this
1192  integer, value :: size
1193  class(*), intent(inout), optional :: data
1194  type(tuple_i4_t) :: key
1195 
1196  if (present(data)) then
1197  call htable_init(this, size, key, data)
1198  else
1199  call htable_init(this, size, key)
1200  end if
1201 
1202  end subroutine htable_i4t2_init
1203 
1205  subroutine htable_i4t2_set(this, key, data)
1206  class(htable_i4t2_t), intent(inout) :: this
1207  type(tuple_i4_t), intent(inout) :: key
1208  class(*), intent(inout) :: data
1209 
1210  call htable_set(this, key, data)
1211 
1212  end subroutine htable_i4t2_set
1213 
1215  function htable_i4t2_get(this, key, data) result(rcode)
1216  class(htable_i4t2_t), intent(inout) :: this
1217  type(tuple_i4_t), intent(inout) :: key
1218  class(*), intent(inout) :: data
1219  integer :: rcode
1220 
1221  rcode = htable_get(this, key, data)
1222 
1223  end function htable_i4t2_get
1224 
1226  pure function htable_i4t2_hash(this, k, c) result(hash)
1227  class(htable_i4t2_t), intent(in) :: this
1228  class(*), intent(in) :: k
1229  integer, value :: c
1230  integer :: i, hash
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)
1238 
1239  select type(k)
1240  type is (tuple_i4_t)
1241  mult = int(1000003, i8)
1242  hash2 = int(z'345678', i8)
1243  do i = 1, 2
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
1253  end do
1254  hash2 = hash2 + 97531_i8
1255  hash2 = modulo(hash2 + int(c, i8), int(this%size, i8))
1256  hash = int(hash2, i4)
1257  class default
1258  hash = -1
1259  end select
1260  end function htable_i4t2_hash
1261 
1263  subroutine htable_i4t2_remove(this, key)
1264  class(htable_i4t2_t), intent(inout) :: this
1265  type(tuple_i4_t), intent(inout) :: key
1266 
1267  call htable_remove(this, key)
1268 
1269  end subroutine htable_i4t2_remove
1270 
1272  subroutine htable_iter_i4t2_init(this, t)
1273  class(htable_iter_i4t2_t), intent(inout) :: this
1274  type(htable_i4t2_t), target, intent(inout) :: t
1275 
1276  this%t => t
1277  this%n = -1
1278 
1279  end subroutine htable_iter_i4t2_init
1280 
1282  subroutine htable_iter_i4t2_free(this)
1283  type(htable_iter_i4t2_t), intent(inout) :: this
1284  nullify(this%t)
1285  end subroutine htable_iter_i4t2_free
1286 
1288  function htable_iter_i4t2_value(this) result(value)
1289  class(htable_iter_i4t2_t), intent(inout) :: this
1290  type(tuple_i4_t), pointer :: value
1291 
1292  select type (hdp => this%t%t(this%n)%data)
1293  type is (tuple_i4_t)
1294  value => hdp
1295  class default
1296  call neko_error('Key and data of different kind (i4t2)')
1297  end select
1298 
1299  end function htable_iter_i4t2_value
1300 
1302  function htable_iter_i4t2_key(this) result(key)
1303  class(htable_iter_i4t2_t), intent(inout) :: this
1304  type(tuple_i4_t), pointer :: key
1305 
1306  select type (kp => this%t%t(this%n)%key)
1307  type is (tuple_i4_t)
1308  key => kp
1309  class default
1310  call neko_error('Invalid key (i4t2)')
1311  end select
1312 
1313  end function htable_iter_i4t2_key
1314 
1315  !
1316  ! Integer 4-tuple based implementation
1317  !
1319  subroutine htable_i4t4_init(this, size, data)
1320  class(htable_i4t4_t), intent(inout) :: this
1321  integer, value :: size
1322  class(*), intent(inout), optional :: data
1323  type(tuple4_i4_t) :: key
1324 
1325  if (present(data)) then
1326  call htable_init(this, size, key, data)
1327  else
1328  call htable_init(this, size, key)
1329  end if
1330 
1331  end subroutine htable_i4t4_init
1332 
1334  subroutine htable_i4t4_set(this, key, data)
1335  class(htable_i4t4_t), intent(inout) :: this
1336  type(tuple4_i4_t), intent(inout) :: key
1337  class(*), intent(inout) :: data
1338 
1339  call htable_set(this, key, data)
1340 
1341  end subroutine htable_i4t4_set
1342 
1344  function htable_i4t4_get(this, key, data) result(rcode)
1345  class(htable_i4t4_t), intent(inout) :: this
1346  type(tuple4_i4_t), intent(inout) :: key
1347  class(*), intent(inout) :: data
1348  integer :: rcode
1349 
1350  rcode = htable_get(this, key, data)
1351 
1352  end function htable_i4t4_get
1353 
1355  pure function htable_i4t4_hash(this, k, c) result(hash)
1356  class(htable_i4t4_t), intent(in) :: this
1357  class(*), intent(in) :: k
1358  integer, value :: c
1359  integer :: i, hash
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)
1367 
1368  select type(k)
1369  type is (tuple4_i4_t)
1370  mult = int(1000003, i8)
1371  hash2 = int(z'345678', i8)
1372  do i = 1, 4
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
1382  end do
1383  hash2 = hash2 + 97531_i8
1384  hash2 = modulo(hash2 + int(c, i8), int(this%size, i8))
1385  hash = int(hash2, i4)
1386  class default
1387  hash = -1
1388  end select
1389  end function htable_i4t4_hash
1390 
1392  subroutine htable_i4t4_remove(this, key)
1393  class(htable_i4t4_t), intent(inout) :: this
1394  type(tuple4_i4_t), intent(inout) :: key
1395 
1396  call htable_remove(this, key)
1397 
1398  end subroutine htable_i4t4_remove
1399 
1401  subroutine htable_iter_i4t4_init(this, t)
1402  class(htable_iter_i4t4_t), intent(inout) :: this
1403  type(htable_i4t4_t), target, intent(inout) :: t
1404 
1405  this%t => t
1406  this%n = -1
1407 
1408  end subroutine htable_iter_i4t4_init
1409 
1411  subroutine htable_iter_i4t4_free(this)
1412  type(htable_iter_i4t4_t), intent(inout) :: this
1413  nullify(this%t)
1414  end subroutine htable_iter_i4t4_free
1415 
1417  function htable_iter_i4t4_value(this) result(value)
1418  class(htable_iter_i4t4_t), target, intent(inout) :: this
1419  type(tuple4_i4_t), pointer :: value
1420 
1421  select type (hdp => this%t%t(this%n)%data)
1422  type is (tuple4_i4_t)
1423  value => hdp
1424  class default
1425  call neko_error('Key and data of different kind (i4t4)')
1426  end select
1427 
1428  end function htable_iter_i4t4_value
1429 
1431  function htable_iter_i4t4_key(this) result(key)
1432  class(htable_iter_i4t4_t), target, intent(inout) :: this
1433  type(tuple4_i4_t), pointer :: key
1434 
1435  ! We should not need this extra select block, and it works great
1436  ! without it for GNU, Intel and NEC, but breaks horribly on Cray
1437  ! (>11.0.x) when using high opt. levels.
1438  select type(hti => this)
1439  type is(htable_iter_i4t4_t)
1440  select type (kp => hti%t%t(this%n)%key)
1441  type is (tuple4_i4_t)
1442  key => kp
1443  class default
1444  call neko_error('Invalid key (i4t4)')
1445  end select
1446  class default
1447  call neko_error('Corrupt htable iter. (i4t4)')
1448  end select
1449 
1450  end function htable_iter_i4t4_key
1451 
1452  !
1453  ! C pointer based implementation
1454  !
1456  subroutine htable_cptr_init(this, size, data)
1457  class(htable_cptr_t), intent(inout) :: this
1458  integer, value :: size
1459  class(*), intent(inout), optional :: data
1460  type(h_cptr_t) :: key
1461 
1462  if (present(data)) then
1463  call htable_init(this, size, key, data)
1464  else
1465  call htable_init(this, size, key)
1466  end if
1467 
1468  end subroutine htable_cptr_init
1469 
1471  subroutine htable_cptr_set(this, key, data)
1472  class(htable_cptr_t), target, intent(inout) :: this
1473  type(h_cptr_t), intent(inout) :: key
1474  class(*), intent(inout) :: data
1475 
1476  call htable_set(this, key, data)
1477 
1478  end subroutine htable_cptr_set
1479 
1481  function htable_cptr_get(this, key, data) result(rcode)
1482  class(htable_cptr_t), target, intent(inout) :: this
1483  type(h_cptr_t), intent(inout) :: key
1484  class(*), intent(inout) :: data
1485  integer :: rcode
1486 
1487  rcode = htable_get(this, key, data)
1488 
1489  end function htable_cptr_get
1490 
1492  pure function htable_cptr_hash(this, k, c) result(hash)
1493  class(htable_cptr_t), intent(in) :: this
1494  class(*), intent(in) :: k
1495  integer, value :: c
1496  integer :: hash
1497  integer(kind=i8) :: k_int
1498 
1499  select type(k)
1500  type is (h_cptr_t)
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)
1504  class default
1505  hash = -1
1506  end select
1507  end function htable_cptr_hash
1508 
1510  subroutine htable_cptr_remove(this, key)
1511  class(htable_cptr_t), target, intent(inout) :: this
1512  type(h_cptr_t), intent(inout) :: key
1513 
1514  call htable_remove(this, key)
1515 
1516  end subroutine htable_cptr_remove
1517 
1519  subroutine htable_iter_cptr_init(this, t)
1520  class(htable_iter_cptr_t), intent(inout) :: this
1521  type(htable_cptr_t), target, intent(inout) :: t
1522 
1523  this%t => t
1524  this%n = -1
1525 
1526  end subroutine htable_iter_cptr_init
1527 
1529  subroutine htable_iter_cptr_free(this)
1530  type(htable_iter_cptr_t), intent(inout) :: this
1531  nullify(this%t)
1532  end subroutine htable_iter_cptr_free
1533 
1535  function htable_iter_cptr_value(this) result(value)
1536  class(htable_iter_cptr_t), target, intent(inout) :: this
1537  class(*), pointer :: hdp
1538  type(h_cptr_t), pointer :: value
1539 
1540  hdp => this%t%t(this%n)%data
1541  select type (hdp)
1542  type is (h_cptr_t)
1543  value => hdp
1544  class default
1545  call neko_error('Key and data of different kind (cptr)')
1546  end select
1547 
1548  end function htable_iter_cptr_value
1549 
1551  function htable_iter_cptr_key(this) result(key)
1552  class(htable_iter_cptr_t), target, intent(inout) :: this
1553  class(*), pointer :: kp
1554  type(h_cptr_t), pointer :: key
1555 
1556  kp => this%t%t(this%n)%key
1557  select type (kp)
1558  type is (h_cptr_t)
1559  key => kp
1560  class default
1561  call neko_error('Invalid key (cptr)')
1562  end select
1563 
1564  end function htable_iter_cptr_key
1565 
1566 end 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:1320
subroutine htable_iter_r8_init(this, t)
Initialize a double precision based hash table iterator.
Definition: htable.f90:1013
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:1060
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:1303
subroutine htable_iter_i8_free(this)
Destroy an integer*8 based hash table iterator.
Definition: htable.f90:906
subroutine htable_i4_set(this, key, data)
Insert an integer into the hash table.
Definition: htable.f90:713
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:1418
integer function, pointer htable_iter_i4_value(this)
Return the current value of the integer based hash table iterator.
Definition: htable.f90:789
subroutine htable_r8_init(this, size, data)
Initialize a double precision based hash table.
Definition: htable.f90:953
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:927
type(point_t) function, pointer htable_iter_pt_key(this)
Return the current key of the point based hash table iterator.
Definition: htable.f90:1174
pure integer function htable_r8_hash(this, k, c)
Hash function for a double precision based hash table.
Definition: htable.f90:989
subroutine htable_cptr_init(this, size, data)
Initialize a C pointer based hash table.
Definition: htable.f90:1457
pure integer function htable_i4_hash(this, k, c)
Hash function for an integer based hash table.
Definition: htable.f90:734
subroutine htable_iter_cptr_free(this)
Destroy a C pointer based hash table iterator.
Definition: htable.f90:1530
subroutine htable_iter_pt_free(this)
Destroy a point based hash table iterator.
Definition: htable.f90:1154
subroutine htable_i4t4_set(this, key, data)
Insert an integer 4-tuple into the hash table.
Definition: htable.f90:1335
subroutine htable_i8_init(this, size, data)
Initialize an integer*8 based hash table.
Definition: htable.f90:820
subroutine htable_pt_remove(this, key)
Remove a point with key key from the hash table.
Definition: htable.f90:1134
subroutine htable_cptr_remove(this, key)
Remove a C pointer with key key from the hash table.
Definition: htable.f90:1511
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:649
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:491
integer function htable_r8_get(this, key, data)
Retrive a double precision float with key key from the hash table.
Definition: htable.f90:978
pure integer function htable_i8_hash(this, k, c)
Hash function for an integer*8 based hash table.
Definition: htable.f90:856
subroutine htable_i4t4_remove(this, key)
Remove an integer 4-tuple with key key from the hash table.
Definition: htable.f90:1393
integer function htable_get(this, key, data)
Retrieve data associated with key into the hash table.
Definition: htable.f90:385
integer function htable_i8_get(this, key, data)
Retrive an integer*8 with key key from the hash table.
Definition: htable.f90:845
integer function htable_pt_get(this, key, data)
Retrive a point with key key from the hash table.
Definition: htable.f90:1085
subroutine htable_remove(this, key)
Remove a key from the hash table.
Definition: htable.f90:418
subroutine htable_set_data(this, idx, data)
Set data at idx to value.
Definition: htable.f90:445
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:1043
subroutine htable_iter_pt_init(this, t)
Initialize a point based hash table iterator.
Definition: htable.f90:1144
integer function htable_i4_get(this, key, data)
Retrive an integer with key key from the hash table.
Definition: htable.f90:723
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:1536
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:1289
logical function htable_iter_next(this)
Advance the iterator to the next valid table entry.
Definition: htable.f90:625
integer function htable_cptr_get(this, key, data)
Retrive a C pointer with key key from the hash table.
Definition: htable.f90:1482
subroutine htable_i8_set(this, key, data)
Insert an integer*8 into the hash table.
Definition: htable.f90:835
subroutine htable_r8_remove(this, key)
Remove a double precision key key from the hash table.
Definition: htable.f90:1003
subroutine htable_iter_i4t2_free(this)
Destroy an integer 2-tuple based hash table iterator.
Definition: htable.f90:1283
subroutine htable_r8_set(this, key, data)
Insert a double precision key (with data) into the hash table.
Definition: htable.f90:968
type(point_t) function, pointer htable_iter_pt_value(this)
Return the current value of the point based hash table iterator.
Definition: htable.f90:1160
integer function htable_i4t4_get(this, key, data)
Retrive an integer 4-tuple with key key from the hash table.
Definition: htable.f90:1345
subroutine htable_i4t2_set(this, key, data)
Insert an integer 2-tuple into the hash table.
Definition: htable.f90:1206
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:1432
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:535
subroutine htable_i4t2_remove(this, key)
Remove an integer 2-tuple with key key from the hash table.
Definition: htable.f90:1264
subroutine htable_set_key(this, idx, key)
Set key at idx to key.
Definition: htable.f90:579
subroutine htable_iter_i8_init(this, t)
Initialize an integer*8 based hash table iterator.
Definition: htable.f90:896
pure integer function htable_i4t4_hash(this, k, c)
Hash function for an integer 4-tuple hash table.
Definition: htable.f90:1356
pure integer function htable_pt_hash(this, k, c)
Hash function for a point based hash table.
Definition: htable.f90:1096
integer function, pointer htable_iter_i4_key(this)
Return the current key of the integer based hash table iterator.
Definition: htable.f90:803
subroutine htable_iter_i4_init(this, t)
Initialize an integer based hash table iterator.
Definition: htable.f90:773
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:1191
subroutine htable_cptr_set(this, key, data)
Insert a C pointer into the hash table.
Definition: htable.f90:1472
subroutine htable_iter_i4t4_free(this)
Destroy an integer 4-tuple based hash table iterator.
Definition: htable.f90:1412
subroutine htable_i4_remove(this, key)
Remove an integer with key key from the hash table.
Definition: htable.f90:764
subroutine htable_iter_cptr_init(this, t)
Initialize a C pointer based hash table iterator.
Definition: htable.f90:1520
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:912
integer function htable_i4t2_get(this, key, data)
Retrive an integer 2-tuple with key key from the hash table.
Definition: htable.f90:1216
subroutine htable_iter_i4t4_init(this, t)
Initialize an integer 4-tuple based hash table iterator.
Definition: htable.f90:1402
subroutine htable_i8_remove(this, key)
Remove an integer*8 with key key from the hash table.
Definition: htable.f90:887
subroutine htable_i4_init(this, size, data)
Initialize an integer based hash table.
Definition: htable.f90:698
pure integer function htable_cptr_hash(this, k, c)
Hash function for an integer 4-tuple hash table.
Definition: htable.f90:1493
subroutine htable_pt_set(this, key, data)
Insert a point key (with data) into the hash table.
Definition: htable.f90:1075
subroutine htable_iter_reset(this)
Reset an iterator.
Definition: htable.f90:640
subroutine htable_iter_i4_free(this)
Destroy an integer based hash table iterator.
Definition: htable.f90:783
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:1552
subroutine htable_iter_r8_free(this)
Destroy a double precision based hash table iterator.
Definition: htable.f90:1023
pure integer function htable_i4t2_hash(this, k, c)
Hash function for an integer 2-tuple hash table.
Definition: htable.f90:1227
subroutine htable_iter_i4t2_init(this, t)
Initialize an integer 2-tuple based hash table iterator.
Definition: htable.f90:1273
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:1029
Definition: math.f90:60
real(kind=rp), parameter, public neko_m_ln2
Definition: math.f90:73
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