Neko  0.9.99
A portable framework for high-order spectral element flow simulations
tuple.f90
Go to the documentation of this file.
1 ! Copyright (c) 2020-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 !
34 module tuple
35  use math, only : abscmp
36  use num_types, only : dp
37  implicit none
38  private
39 
41  type, public, abstract :: tuple_t
42  contains
43  procedure(tuple_assign_tuple), pass(this), deferred :: assign_tuple
44  procedure(tuple_assign_vector), pass(this), deferred :: assign_vector
45  procedure(tuple_equal), pass(this) , deferred :: equal
46  generic :: operator(.eq.) => equal
47  generic :: assignment(=) => assign_tuple, assign_vector
48  end type tuple_t
49 
51  type, extends(tuple_t), public :: tuple_i4_t
52  integer :: x(2) = (/0, 0/)
53  contains
54  procedure, pass(this) :: assign_tuple => tuple_i4_assign_tuple
55  procedure, pass(this) :: assign_vector => tuple_i4_assign_vector
56  procedure, pass(this) :: equal => tuple_i4_equal
57  end type tuple_i4_t
58 
60  type, extends(tuple_t), public :: tuple3_i4_t
61  integer :: x(3) = (/0, 0, 0/)
62  contains
63  procedure, pass(this) :: assign_tuple => tuple3_i4_assign_tuple
64  procedure, pass(this) :: assign_vector => tuple3_i4_assign_vector
65  procedure, pass(this) :: equal => tuple3_i4_equal
66  end type tuple3_i4_t
67 
69  type, extends(tuple_t), public :: tuple4_i4_t
70  integer :: x(4) = (/0, 0, 0, 0/)
71  contains
72  procedure, pass(this) :: assign_tuple => tuple4_i4_assign_tuple
73  procedure, pass(this) :: assign_vector => tuple4_i4_assign_vector
74  procedure, pass(this) :: equal => tuple4_i4_equal
75  end type tuple4_i4_t
76 
78  type, extends(tuple_t), public :: tuple_r8_t
79  real(kind=dp) :: x(2) = (/0d0, 0d0/)
80  contains
81  procedure, pass(this) :: assign_tuple => tuple_r8_assign_tuple
82  procedure, pass(this) :: assign_vector => tuple_r8_assign_vector
83  procedure, pass(this) :: equal => tuple_r8_equal
84  end type tuple_r8_t
85 
87  type, extends(tuple_t), public :: tuple_i4r8_t
88  integer :: x
89  real(kind=dp) :: y
90  contains
91  procedure, pass(this) :: assign_tuple => tuple_i4r8_assign_tuple
92  procedure, pass(this) :: assign_vector => tuple_i4r8_assign_vector
93  procedure, pass(this) :: equal => tuple_i4r8_equal
94  end type tuple_i4r8_t
95 
97  type, extends(tuple_t), public :: tuple_2i4r8_t
98  integer :: x, y
99  real(kind=dp) :: z
100  contains
101  procedure, pass(this) :: assign_tuple => tuple_2i4r8_assign_tuple
102  procedure, pass(this) :: assign_vector => tuple_2i4r8_assign_vector
103  procedure, pass(this) :: equal => tuple_2i4r8_equal
104  end type tuple_2i4r8_t
105 
107  abstract interface
108  subroutine tuple_assign_tuple(this, other)
109  import :: tuple_t
110  class(tuple_t), intent(inout) :: this
111  class(tuple_t), intent(in) :: other
112  end subroutine tuple_assign_tuple
113  end interface
114 
116  abstract interface
117  subroutine tuple_assign_vector(this, x)
118  import :: tuple_t
119  class(tuple_t), intent(inout) :: this
120  class(*), dimension(:), intent(in) :: x
121  end subroutine tuple_assign_vector
122  end interface
123 
125  abstract interface
126  pure function tuple_equal(this, other) result(res)
127  import :: tuple_t
128  class(tuple_t), intent(in) :: this
129  class(tuple_t), intent(in) :: other
130  logical :: res
131  end function tuple_equal
132  end interface
133 
134 contains
135 
137  subroutine tuple_i4_assign_tuple(this, other)
138  class(tuple_i4_t), intent(inout) :: this
139  class(tuple_t), intent(in) :: other
140 
141  select type(other)
142  type is (tuple_i4_t)
143  this%x = other%x
144  end select
145  end subroutine tuple_i4_assign_tuple
146 
148  subroutine tuple_i4_assign_vector(this, x)
149  class(tuple_i4_t), intent(inout) :: this
150  class(*), dimension(:), intent(in) :: x
151 
152  select type(x)
153  type is (integer)
154  this%x = x
155  end select
156  end subroutine tuple_i4_assign_vector
157 
159  pure function tuple_i4_equal(this, other) result(res)
160  class(tuple_i4_t), intent(in) :: this
161  class(tuple_t), intent(in) :: other
162  logical :: res
163 
164  res = .false.
165  select type(other)
166  type is(tuple_i4_t)
167  res = all(this%x .eq. other%x)
168  end select
169  end function tuple_i4_equal
170 
172  subroutine tuple3_i4_assign_tuple(this, other)
173  class(tuple3_i4_t), intent(inout) :: this
174  class(tuple_t), intent(in) :: other
175 
176  select type(other)
177  type is(tuple3_i4_t)
178  this%x = other%x
179  end select
180  end subroutine tuple3_i4_assign_tuple
181 
183  subroutine tuple3_i4_assign_vector(this, x)
184  class(tuple3_i4_t), intent(inout) :: this
185  class(*), dimension(:), intent(in) :: x
186 
187  select type(x)
188  type is (integer)
189  this%x = x
190  end select
191  end subroutine tuple3_i4_assign_vector
192 
194  pure function tuple3_i4_equal(this, other) result(res)
195  class(tuple3_i4_t), intent(in) :: this
196  class(tuple_t), intent(in) :: other
197  logical :: res
198 
199  res = .false.
200  select type(other)
201  type is(tuple3_i4_t)
202  res = all(this%x .eq. other%x)
203  end select
204  end function tuple3_i4_equal
205 
207  subroutine tuple4_i4_assign_tuple(this, other)
208  class(tuple4_i4_t), intent(inout) :: this
209  class(tuple_t), intent(in) :: other
210 
211  select type(other)
212  type is(tuple4_i4_t)
213  this%x = other%x
214  end select
215  end subroutine tuple4_i4_assign_tuple
216 
218  subroutine tuple4_i4_assign_vector(this, x)
219  class(tuple4_i4_t), intent(inout) :: this
220  class(*), dimension(:), intent(in) :: x
221 
222  select type(x)
223  type is (integer)
224  this%x = x
225  end select
226  end subroutine tuple4_i4_assign_vector
227 
229  pure function tuple4_i4_equal(this, other) result(res)
230  class(tuple4_i4_t), intent(in) :: this
231  class(tuple_t), intent(in) :: other
232  logical :: res
233 
234  res = .false.
235  select type(other)
236  type is(tuple4_i4_t)
237  res = all(this%x .eq. other%x)
238  end select
239  end function tuple4_i4_equal
240 
242  subroutine tuple_r8_assign_tuple(this, other)
243  class(tuple_r8_t), intent(inout) :: this
244  class(tuple_t), intent(in) :: other
245 
246  select type(other)
247  type is(tuple_r8_t)
248  this%x = other%x
249  end select
250  end subroutine tuple_r8_assign_tuple
251 
253  subroutine tuple_r8_assign_vector(this, x)
254  class(tuple_r8_t), intent(inout) :: this
255  class(*), dimension(:), intent(in) :: x
256 
257  select type(x)
258  type is (double precision)
259  this%x = x
260  end select
261  end subroutine tuple_r8_assign_vector
262 
264  pure function tuple_r8_equal(this, other) result(res)
265  class(tuple_r8_t), intent(in) :: this
266  class(tuple_t), intent(in) :: other
267  logical :: res
268 
269  res = .false.
270  select type(other)
271  type is(tuple_r8_t)
272  if (abscmp(this%x(1), other%x(1)) .and. &
273  abscmp(this%x(2), other%x(2))) then
274  res = .true.
275  end if
276  end select
277  end function tuple_r8_equal
278 
280  subroutine tuple_i4r8_assign_tuple(this, other)
281  class(tuple_i4r8_t), intent(inout) :: this
282  class(tuple_t), intent(in) :: other
283 
284  select type(other)
285  type is(tuple_i4r8_t)
286  this%x = other%x
287  this%y = other%y
288  end select
289  end subroutine tuple_i4r8_assign_tuple
290 
292  subroutine tuple_i4r8_assign_vector(this, x)
293  class(tuple_i4r8_t), intent(inout) :: this
294  class(*), dimension(:), intent(in) :: x
295 
296  select type(x)
297  type is (integer)
298  this%x = x(1)
299  this%y = dble(x(2))
300  type is (double precision)
301  this%x = int(x(1))
302  this%y = x(2)
303  end select
304 
305  end subroutine tuple_i4r8_assign_vector
306 
308  pure function tuple_i4r8_equal(this, other) result(res)
309  class(tuple_i4r8_t), intent(in) :: this
310  class(tuple_t), intent(in) :: other
311  logical :: res
312 
313  res = .false.
314  select type(other)
315  type is(tuple_i4r8_t)
316  if ((this%x .eq. other%x) .and. &
317  abscmp(this%y, other%y)) then
318  res = .true.
319  end if
320  end select
321  end function tuple_i4r8_equal
322 
324  subroutine tuple_2i4r8_assign_tuple(this, other)
325  class(tuple_2i4r8_t), intent(inout) :: this
326  class(tuple_t), intent(in) :: other
327 
328  select type(other)
329  type is(tuple_2i4r8_t)
330  this%x = other%x
331  this%y = other%y
332  this%z = other%z
333  end select
334  end subroutine tuple_2i4r8_assign_tuple
335 
337  subroutine tuple_2i4r8_assign_vector(this, x)
338  class(tuple_2i4r8_t), intent(inout) :: this
339  class(*), dimension(:), intent(in) :: x
340 
341  select type(x)
342  type is (integer)
343  this%x = x(1)
344  this%y = x(2)
345  this%z = dble(x(3))
346  type is (double precision)
347  this%x = int(x(1))
348  this%y = int(x(2))
349  this%z = x(3)
350  end select
351 
352  end subroutine tuple_2i4r8_assign_vector
353 
355  pure function tuple_2i4r8_equal(this, other) result(res)
356  class(tuple_2i4r8_t), intent(in) :: this
357  class(tuple_t), intent(in) :: other
358  logical :: res
359 
360  res = .false.
361  select type(other)
362  type is(tuple_2i4r8_t)
363  if ((this%x .eq. other%x) .and. &
364  (this%y .eq. other%y) .and. &
365  abscmp(this%z, other%z)) then
366  res = .true.
367  end if
368  end select
369  end function tuple_2i4r8_equal
370 
371 end module tuple
Abstract intf. for assigning a tuple to a tuple.
Definition: tuple.f90:108
Abstract intf. for assigning a vector to a n-tuple.
Definition: tuple.f90:117
Abstract intf. for tuple comparison.
Definition: tuple.f90:126
Definition: math.f90:60
integer, parameter, public dp
Definition: num_types.f90:9
Implements a n-tuple.
Definition: tuple.f90:34
subroutine tuple3_i4_assign_tuple(this, other)
Assign an integer 3-tuple to a tuple.
Definition: tuple.f90:173
pure logical function tuple_r8_equal(this, other)
Check if two double precision tuples are equal.
Definition: tuple.f90:265
subroutine tuple4_i4_assign_tuple(this, other)
Assign an integer 4-tuple to a tuple.
Definition: tuple.f90:208
subroutine tuple_i4r8_assign_vector(this, x)
Assign a mixed intreger-double precision vector to a tuple.
Definition: tuple.f90:293
pure logical function tuple4_i4_equal(this, other)
Check if two integer based tuples are equal.
Definition: tuple.f90:230
subroutine tuple_i4_assign_tuple(this, other)
Assign an integer 2-tuple to a tuple.
Definition: tuple.f90:138
subroutine tuple_r8_assign_tuple(this, other)
Assign a double precision 2-tuple to a tuple.
Definition: tuple.f90:243
pure logical function tuple_i4r8_equal(this, other)
Check if two mixed integer-double precision tuples are equal.
Definition: tuple.f90:309
subroutine tuple_r8_assign_vector(this, x)
Assign a double precision vector to a tuple.
Definition: tuple.f90:254
subroutine tuple_i4_assign_vector(this, x)
Assign an integer vector to a tuple.
Definition: tuple.f90:149
subroutine tuple_i4r8_assign_tuple(this, other)
Assign a mixed integer-double precision 2-tuple to a tuple.
Definition: tuple.f90:281
subroutine tuple4_i4_assign_vector(this, x)
Assign an integer vector to a tuple.
Definition: tuple.f90:219
pure logical function tuple_i4_equal(this, other)
Check if two integer based tuples are equal.
Definition: tuple.f90:160
pure logical function tuple_2i4r8_equal(this, other)
Check if two mixed integer-double precision tuples are equal.
Definition: tuple.f90:356
pure logical function tuple3_i4_equal(this, other)
Check if two integer based tuples are equal.
Definition: tuple.f90:195
subroutine tuple_2i4r8_assign_vector(this, x)
Assign a mixed intreger-double precision vector to a tuple.
Definition: tuple.f90:338
subroutine tuple3_i4_assign_vector(this, x)
Assign an integer vector to a tuple.
Definition: tuple.f90:184
subroutine tuple_2i4r8_assign_tuple(this, other)
Assign a mixed integer-double precision 3-tuple to a tuple.
Definition: tuple.f90:325
Integer based 3-tuple.
Definition: tuple.f90:60
Integer based 4-tuple.
Definition: tuple.f90:69
Mixed integer ( ) double precision ( ) 3-tuple.
Definition: tuple.f90:97
Integer based 2-tuple.
Definition: tuple.f90:51
Mixed integer ( ) double precision ( ) 2-tuple .
Definition: tuple.f90:87
Double precision based 2-tuple.
Definition: tuple.f90:78
Base type for an n-tuple.
Definition: tuple.f90:41