Neko  0.9.99
A portable framework for high-order spectral element flow simulations
uset.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 !
35 module uset
36  use utils, only : neko_error
37  use num_types, only : i8, dp
38  use htable, only : htable_i4_t, htable_iter_i4_t, &
41  implicit none
42  private
43 
45  type, private, abstract :: uset_t
46  contains
47  procedure(uset_init), pass(this), deferred :: init
48  procedure(uset_free), pass(this), deferred :: free
49  procedure(uset_size), pass(this), deferred :: size
50  procedure(uset_clear), pass(this), deferred :: clear
51  procedure(uset_element), pass(this), deferred :: element
52  procedure(uset_add), pass(this), deferred :: add
53  procedure(uset_remove), pass(this), deferred :: remove
54  end type uset_t
55 
57  type, extends(uset_t), public :: uset_i4_t
58  type(htable_i4_t) :: t
59  type(htable_iter_i4_t) :: it
60  contains
61  procedure, pass(this) :: init => uset_i4_init
62  procedure, pass(this) :: free => uset_i4_free
63  procedure, pass(this) :: size => uset_i4_size
64  procedure, pass(this) :: clear => uset_i4_clear
65  procedure, pass(this) :: element => uset_i4_element
66  procedure, pass(this) :: add => uset_i4_add
67  procedure, pass(this) :: remove => uset_i4_remove
68  procedure, pass(this) :: iter_init => uset_i4_iter_init
69  procedure, pass(this) :: iter_next => uset_i4_iter_next
70  procedure, pass(this) :: iter_value => uset_i4_iter_value
71  end type uset_i4_t
72 
74  type, extends(uset_t), public :: uset_i8_t
75  type(htable_i8_t) :: t
76  type(htable_iter_i8_t) :: it
77  contains
78  procedure, pass(this) :: init => uset_i8_init
79  procedure, pass(this) :: free => uset_i8_free
80  procedure, pass(this) :: size => uset_i8_size
81  procedure, pass(this) :: clear => uset_i8_clear
82  procedure, pass(this) :: element => uset_i8_element
83  procedure, pass(this) :: add => uset_i8_add
84  procedure, pass(this) :: remove => uset_i8_remove
85  procedure, pass(this) :: iter_init => uset_i8_iter_init
86  procedure, pass(this) :: iter_next => uset_i8_iter_next
87  procedure, pass(this) :: iter_value => uset_i8_iter_value
88  end type uset_i8_t
89 
91  type, extends(uset_t), public :: uset_r8_t
92  type(htable_r8_t) :: t
93  type(htable_iter_r8_t) :: it
94  contains
95  procedure, pass(this) :: init => uset_r8_init
96  procedure, pass(this) :: free => uset_r8_free
97  procedure, pass(this) :: size => uset_r8_size
98  procedure, pass(this) :: clear => uset_r8_clear
99  procedure, pass(this) :: element => uset_r8_element
100  procedure, pass(this) :: add => uset_r8_add
101  procedure, pass(this) :: remove => uset_r8_remove
102  procedure, pass(this) :: iter_init => uset_r8_iter_init
103  procedure, pass(this) :: iter_next => uset_r8_iter_next
104  procedure, pass(this) :: iter_value => uset_r8_iter_value
105  end type uset_r8_t
106 
108  abstract interface
109  subroutine uset_init(this, n)
110  import uset_t
111  class(uset_t), intent(inout) :: this
112  integer, optional :: n
113  end subroutine uset_init
114  end interface
115 
117  abstract interface
118  subroutine uset_free(this)
119  import uset_t
120  class(uset_t), intent(inout) :: this
121  end subroutine uset_free
122  end interface
123 
125  abstract interface
126  pure function uset_size(this) result(entries)
127  import uset_t
128  class(uset_t), intent(in) :: this
129  integer :: entries
130  end function uset_size
131  end interface
132 
134  abstract interface
135  subroutine uset_clear(this)
136  import uset_t
137  class(uset_t), intent(inout) :: this
138  end subroutine uset_clear
139  end interface
140 
142  abstract interface
143  function uset_element(this, key) result(res)
144  import uset_t
145  class(uset_t), intent(inout) :: this
146  class(*), intent(inout) :: key
147  logical :: res
148  end function uset_element
149  end interface
150 
152  abstract interface
153  subroutine uset_add(this, key)
154  import uset_t
155  class(uset_t), intent(inout) :: this
156  class(*), intent(inout) :: key
157  end subroutine uset_add
158  end interface
159 
161  abstract interface
162  subroutine uset_remove(this, key)
163  import uset_t
164  class(uset_t), intent(inout) :: this
165  class(*), intent(inout) :: key
166  end subroutine uset_remove
167  end interface
168 
169 contains
170 
172  subroutine uset_i4_init(this, n)
173  class(uset_i4_t), intent(inout) :: this
174  integer, optional :: n
175 
176  if (present(n)) then
177  call this%t%init(n)
178  else
179  call this%t%init(64)
180  end if
181  end subroutine uset_i4_init
182 
184  subroutine uset_i4_free(this)
185  class(uset_i4_t), intent(inout) :: this
186 
187  nullify(this%it%t)
188  call this%t%free()
189 
190  end subroutine uset_i4_free
191 
193  pure function uset_i4_size(this) result(entries)
194  class(uset_i4_t), intent(in) :: this
195  integer :: entries
196 
197  entries = this%t%num_entries()
198 
199  end function uset_i4_size
200 
202  subroutine uset_i4_clear(this)
203  class(uset_i4_t), intent(inout) :: this
204 
205  call this%t%clear()
206  end subroutine uset_i4_clear
207 
209  function uset_i4_element(this, key) result(res)
210  class(uset_i4_t), intent(inout) :: this
211  class(*), intent(inout) :: key
212  integer :: data
213  logical :: res
214 
215  select type(key)
216  type is (integer)
217  res = (this%t%get(key, data) .eq. 0)
218  class default
219  res = .false.
220  end select
221  end function uset_i4_element
222 
224  subroutine uset_i4_add(this, key)
225  class(uset_i4_t), intent(inout) :: this
226  class(*), intent(inout) :: key
227  integer :: data
228 
229  select type(key)
230  type is (integer)
231  data = key
232  call this%t%set(key, data)
233  class default
234  call neko_error("Invalid key")
235  end select
236  end subroutine uset_i4_add
237 
239  subroutine uset_i4_remove(this, key)
240  class(uset_i4_t), intent(inout) :: this
241  class(*), intent(inout) :: key
242 
243  select type(key)
244  type is (integer)
245  call this%t%remove(key)
246  class default
247  call neko_error("Invalid key")
248  end select
249  end subroutine uset_i4_remove
250 
252  subroutine uset_i4_iter_init(this)
253  class(uset_i4_t), target, intent(inout) :: this
254  call this%it%init(this%t)
255  end subroutine uset_i4_iter_init
256 
258  function uset_i4_iter_next(this) result(valid)
259  class(uset_i4_t), intent(inout) :: this
260  logical :: valid
261  valid = this%it%next()
262  end function uset_i4_iter_next
263 
265  function uset_i4_iter_value(this) result(value)
266  class(uset_i4_t), target, intent(inout) :: this
267  integer, pointer :: value
268  value => this%it%value()
269  end function uset_i4_iter_value
270 
272  subroutine uset_i8_init(this, n)
273  class(uset_i8_t), intent(inout) :: this
274  integer, optional :: n
275 
276  if (present(n)) then
277  call this%t%init(n)
278  else
279  call this%t%init(64)
280  end if
281  end subroutine uset_i8_init
282 
284  subroutine uset_i8_free(this)
285  class(uset_i8_t), intent(inout) :: this
286 
287  nullify(this%it%t)
288  call this%t%free()
289 
290  end subroutine uset_i8_free
291 
293  pure function uset_i8_size(this) result(entries)
294  class(uset_i8_t), intent(in) :: this
295  integer :: entries
296 
297  entries = this%t%num_entries()
298 
299  end function uset_i8_size
300 
302  subroutine uset_i8_clear(this)
303  class(uset_i8_t), intent(inout) :: this
304 
305  call this%t%clear()
306  end subroutine uset_i8_clear
307 
309  function uset_i8_element(this, key) result(res)
310  class(uset_i8_t), intent(inout) :: this
311  class(*), intent(inout) :: key
312  integer(kind=i8) :: data
313  logical :: res
314 
315  select type(key)
316  type is (integer(i8))
317  res = (this%t%get(key, data) .eq. 0)
318  class default
319  res = .false.
320  end select
321  end function uset_i8_element
322 
324  subroutine uset_i8_add(this, key)
325  class(uset_i8_t), intent(inout) :: this
326  class(*), intent(inout) :: key
327  integer(kind=i8) :: data
328 
329  select type(key)
330  type is (integer(i8))
331  data = key
332  call this%t%set(key, data)
333  class default
334  call neko_error("Invalid key")
335  end select
336  end subroutine uset_i8_add
337 
339  subroutine uset_i8_remove(this, key)
340  class(uset_i8_t), intent(inout) :: this
341  class(*), intent(inout) :: key
342 
343  select type(key)
344  type is (integer(i8))
345  call this%t%remove(key)
346  class default
347  call neko_error("Invalid key")
348  end select
349  end subroutine uset_i8_remove
350 
352  subroutine uset_i8_iter_init(this)
353  class(uset_i8_t), target, intent(inout) :: this
354  call this%it%init(this%t)
355  end subroutine uset_i8_iter_init
356 
358  function uset_i8_iter_next(this) result(valid)
359  class(uset_i8_t), intent(inout) :: this
360  logical :: valid
361  valid = this%it%next()
362  end function uset_i8_iter_next
363 
365  function uset_i8_iter_value(this) result(value)
366  class(uset_i8_t), target, intent(inout) :: this
367  integer(kind=i8), pointer :: value
368 
369  ! We should not need this extra select block, and it works great
370  ! without it for GNU, Intel and NEC, but breaks horribly on Cray
371  ! (>11.0.x) when using high opt. levels.
372  select type(hp => this)
373  type is (uset_i8_t)
374  value => hp%it%value()
375  class default
376  call neko_error('Invalid uset htable iter (i8)')
377  end select
378  end function uset_i8_iter_value
379 
381  subroutine uset_r8_init(this, n)
382  class(uset_r8_t), intent(inout) :: this
383  integer, optional :: n
384 
385  if (present(n)) then
386  call this%t%init(n)
387  else
388  call this%t%init(64)
389  end if
390  end subroutine uset_r8_init
391 
393  subroutine uset_r8_free(this)
394  class(uset_r8_t), intent(inout) :: this
395 
396  call this%t%free()
397 
398  end subroutine uset_r8_free
399 
401  pure function uset_r8_size(this) result(entries)
402  class(uset_r8_t), intent(in) :: this
403  integer :: entries
404 
405  entries = this%t%num_entries()
406 
407  end function uset_r8_size
408 
410  subroutine uset_r8_clear(this)
411  class(uset_r8_t), intent(inout) :: this
412 
413  call this%t%clear()
414  end subroutine uset_r8_clear
415 
417  function uset_r8_element(this, key) result(res)
418  class(uset_r8_t), intent(inout) :: this
419  class(*), intent(inout) :: key
420  logical :: res
421  real(kind=dp) :: data
422 
423  select type(key)
424  type is (double precision)
425  res = (this%t%get(key, data) .eq. 0)
426  class default
427  res = .false.
428  end select
429 
430  end function uset_r8_element
431 
433  subroutine uset_r8_add(this, key)
434  class(uset_r8_t), intent(inout) :: this
435  class(*), intent(inout) :: key
436  real(kind=dp) :: data
437 
438  select type(key)
439  type is (double precision)
440  data = key
441  call this%t%set(key, data)
442  class default
443  call neko_error("Invalid key")
444  end select
445  end subroutine uset_r8_add
446 
448  subroutine uset_r8_remove(this, key)
449  class(uset_r8_t), intent(inout) :: this
450  class(*), intent(inout) :: key
451 
452  select type(key)
453  type is (double precision)
454  call this%t%remove(key)
455  class default
456  call neko_error("Invalid key")
457  end select
458  end subroutine uset_r8_remove
459 
461  subroutine uset_r8_iter_init(this)
462  class(uset_r8_t), target, intent(inout) :: this
463  call this%it%init(this%t)
464  end subroutine uset_r8_iter_init
465 
467  function uset_r8_iter_next(this) result(valid)
468  class(uset_r8_t), intent(inout) :: this
469  logical :: valid
470  valid = this%it%next()
471  end function uset_r8_iter_next
472 
474  function uset_r8_iter_value(this) result(value)
475  class(uset_r8_t), target, intent(inout) :: this
476  real(kind=dp), pointer :: value
477  value => this%it%value()
478  end function uset_r8_iter_value
479 
480 
481 end module uset
Inteface for adding key to an unorderd set.
Definition: uset.f90:153
Interface for clearing an unordered set.
Definition: uset.f90:135
Interface for checking if key is an element of an unordered set.
Definition: uset.f90:143
Interface for destroying an unordered set.
Definition: uset.f90:118
Interface for initializing an unordered set.
Definition: uset.f90:109
Inteface for removing key in an unorderd set.
Definition: uset.f90:162
Interface for getting the cardinality of an unordered set.
Definition: uset.f90:126
Implements a hash table ADT.
Definition: htable.f90:36
integer, parameter, public i8
Definition: num_types.f90:7
integer, parameter, public dp
Definition: num_types.f90:9
Implements an unordered set ADT.
Definition: uset.f90:35
subroutine uset_r8_clear(this)
Clear a double precision based unordered set.
Definition: uset.f90:411
subroutine uset_i4_iter_init(this)
Initialise an integer based set iterator.
Definition: uset.f90:253
subroutine uset_i4_add(this, key)
Add an integer key to the set.
Definition: uset.f90:225
subroutine uset_i8_clear(this)
Clear an integer*8 based unordered set.
Definition: uset.f90:303
subroutine uset_r8_remove(this, key)
Remove a double precision key from the set.
Definition: uset.f90:449
subroutine uset_r8_add(this, key)
Add a double precision key to the set.
Definition: uset.f90:434
logical function uset_i8_element(this, key)
Check if an integer*8 key is an element of the set.
Definition: uset.f90:310
subroutine uset_i8_add(this, key)
Add an integer*8 key to the set.
Definition: uset.f90:325
subroutine uset_i8_iter_init(this)
Initialise an integer based set iterator*8.
Definition: uset.f90:353
logical function uset_i8_iter_next(this)
Advance an integer*8 based set iterator.
Definition: uset.f90:359
integer function, pointer uset_i4_iter_value(this)
Return the current value of an integer based set iterator.
Definition: uset.f90:266
subroutine uset_i4_clear(this)
Clear an integer based unordered set.
Definition: uset.f90:203
integer(kind=i8) function, pointer uset_i8_iter_value(this)
Return the current value of an integer*8 based set iterator.
Definition: uset.f90:366
subroutine uset_r8_init(this, n)
Initialize an empty double precision based unordered set.
Definition: uset.f90:382
real(kind=dp) function, pointer uset_r8_iter_value(this)
Return the current value of a double precision based set iterator.
Definition: uset.f90:475
subroutine uset_i8_init(this, n)
Initialize an empty integer*8 based unordered set.
Definition: uset.f90:273
subroutine uset_i8_remove(this, key)
Remove an integer*8 key from the set.
Definition: uset.f90:340
subroutine uset_r8_iter_init(this)
Initialise a double precision based set iterator.
Definition: uset.f90:462
logical function uset_i4_element(this, key)
Check if an integer key is an element of the set.
Definition: uset.f90:210
subroutine uset_i4_init(this, n)
Initialize an empty integer based unordered set.
Definition: uset.f90:173
logical function uset_r8_iter_next(this)
Advance a double precision based set iterator.
Definition: uset.f90:468
pure integer function uset_i4_size(this)
Return the cardinality of an integer based unordered set.
Definition: uset.f90:194
logical function uset_i4_iter_next(this)
Advance an integer based set iterator.
Definition: uset.f90:259
pure integer function uset_i8_size(this)
Return the cardinality of an integer*8 based unordered set.
Definition: uset.f90:294
subroutine uset_i4_remove(this, key)
Remove an integer key from the set.
Definition: uset.f90:240
subroutine uset_i8_free(this)
Destroy an integer*8 based unordered set.
Definition: uset.f90:285
subroutine uset_r8_free(this)
Destroy a double precision based unordered set.
Definition: uset.f90:394
subroutine uset_i4_free(this)
Destroy an integer based unordered set.
Definition: uset.f90:185
pure integer function uset_r8_size(this)
Return the cardinality of a double precision based unordered set.
Definition: uset.f90:402
logical function uset_r8_element(this, key)
Check if a double precision key is an element of the set.
Definition: uset.f90:418
Utilities.
Definition: utils.f90:35
Integer based hash table.
Definition: htable.f90:82
Integer*8 based hash table.
Definition: htable.f90:92
Iterator for an integer based hash table.
Definition: htable.f90:166
Iterator for an integer*8 based hash table.
Definition: htable.f90:175
Iterator for a double precision based hash table.
Definition: htable.f90:184
Double precision based hash table.
Definition: htable.f90:102
Integer based unordered set.
Definition: uset.f90:57
Integer*8 based unordered set.
Definition: uset.f90:74
Double precision unordered set.
Definition: uset.f90:91
Base type for an unordered set.
Definition: uset.f90:45