Neko  0.9.99
A portable framework for high-order spectral element flow simulations
hip_math.f90
Go to the documentation of this file.
1 ! Copyright (c) 2024, 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 !
33 module hip_math
34  use num_types, only: rp, c_rp
35  implicit none
36  public
37 
38  interface
39  subroutine hip_copy(a_d, b_d, n) &
40  bind(c, name = 'hip_copy')
41  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
42  type(c_ptr), value :: a_d, b_d
43  integer(c_int) :: n
44  end subroutine hip_copy
45 
46  subroutine hip_masked_copy(a_d, b_d, mask_d, n, m) &
47  bind(c, name = 'hip_masked_copy')
48  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
49  type(c_ptr), value :: a_d, b_d, mask_d
50  integer(c_int) :: n, m
51  end subroutine hip_masked_copy
52 
53  subroutine hip_masked_red_copy(a_d, b_d, mask_d, n, m) &
54  bind(c, name = 'hip_masked_red_copy')
55  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
56  type(c_ptr), value :: a_d, b_d, mask_d
57  integer(c_int) :: n, m
58  end subroutine hip_masked_red_copy
59 
60  subroutine hip_cfill_mask(a_d, c, size, mask_d, mask_size) &
61  bind(c, name = 'hip_cfill_mask')
62  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
63  import c_rp
64  type(c_ptr), value :: a_d
65  real(c_rp) :: c
66  integer(c_int) :: size
67  type(c_ptr), value :: mask_d
68  integer(c_int) :: mask_size
69  end subroutine hip_cfill_mask
70 
71  subroutine hip_cmult(a_d, c, n) &
72  bind(c, name = 'hip_cmult')
73  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
74  import c_rp
75  type(c_ptr), value :: a_d
76  real(c_rp) :: c
77  integer(c_int) :: n
78  end subroutine hip_cmult
79 
80  subroutine hip_cmult2(a_d, b_d, c, n) &
81  bind(c, name = 'hip_cmult2')
82  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
83  import c_rp
84  type(c_ptr), value :: a_d, b_d
85  real(c_rp) :: c
86  integer(c_int) :: n
87  end subroutine hip_cmult2
88 
89  subroutine hip_cadd(a_d, c, n) &
90  bind(c, name = 'hip_cadd')
91  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
92  import c_rp
93  type(c_ptr), value :: a_d
94  real(c_rp) :: c
95  integer(c_int) :: n
96  end subroutine hip_cadd
97 
98  subroutine hip_cadd2(a_d, b_d, c, n) &
99  bind(c, name = 'hip_cadd2')
100  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
101  import c_rp
102  type(c_ptr), value :: a_d
103  type(c_ptr), value :: b_d
104  real(c_rp) :: c
105  integer(c_int) :: n
106  end subroutine hip_cadd2
107 
108  subroutine hip_cfill(a_d, c, n) &
109  bind(c, name = 'hip_cfill')
110  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
111  import c_rp
112  type(c_ptr), value :: a_d
113  real(c_rp) :: c
114  integer(c_int) :: n
115  end subroutine hip_cfill
116 
117  subroutine hip_rzero(a_d, n) &
118  bind(c, name = 'hip_rzero')
119  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
120  type(c_ptr), value :: a_d
121  integer(c_int) :: n
122  end subroutine hip_rzero
123 
124  subroutine hip_add2(a_d, b_d, n) &
125  bind(c, name = 'hip_add2')
126  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
127  import c_rp
128 
129  type(c_ptr), value :: a_d, b_d
130  integer(c_int) :: n
131  end subroutine hip_add2
132 
133  subroutine hip_add4(a_d, b_d, c_d, d_d, n) &
134  bind(c, name = 'hip_add4')
135  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
136  import c_rp
137 
138  type(c_ptr), value :: a_d, b_d, c_d, d_d
139  integer(c_int) :: n
140  end subroutine hip_add4
141 
142  subroutine hip_add2s1(a_d, b_d, c1, n) &
143  bind(c, name = 'hip_add2s1')
144  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
145  import c_rp
146 
147  type(c_ptr), value :: a_d, b_d
148  real(c_rp) :: c1
149  integer(c_int) :: n
150  end subroutine hip_add2s1
151 
152  subroutine hip_add2s2(a_d, b_d, c1, n) &
153  bind(c, name = 'hip_add2s2')
154  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
155  import c_rp
156 
157  type(c_ptr), value :: a_d, b_d
158  real(c_rp) :: c1
159  integer(c_int) :: n
160  end subroutine hip_add2s2
161 
162  subroutine hip_add2s2_many(y_d, x_d_d, a_d, j, n) &
163  bind(c, name = 'hip_add2s2_many')
164  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
165  import c_rp
166 
167  type(c_ptr), value :: y_d, x_d_d, a_d
168  integer(c_int) :: j, n
169  end subroutine hip_add2s2_many
170 
171  subroutine hip_addsqr2s2(a_d, b_d, c1, n) &
172  bind(c, name = 'hip_addsqr2s2')
173  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
174  import c_rp
175 
176  type(c_ptr), value :: a_d, b_d
177  real(c_rp) :: c1
178  integer(c_int) :: n
179  end subroutine hip_addsqr2s2
180 
181  subroutine hip_add3s2(a_d, b_d, c_d, c1, c2, n) &
182  bind(c, name = 'hip_add3s2')
183  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
184  import c_rp
185 
186  type(c_ptr), value :: a_d, b_d, c_d
187  real(c_rp) :: c1, c2
188  integer(c_int) :: n
189  end subroutine hip_add3s2
190 
191  subroutine hip_invcol1(a_d, n) &
192  bind(c, name = 'hip_invcol1')
193  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
194 
195  type(c_ptr), value :: a_d
196  integer(c_int) :: n
197  end subroutine hip_invcol1
198 
199  subroutine hip_invcol2(a_d, b_d, n) &
200  bind(c, name = 'hip_invcol2')
201  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
202 
203  type(c_ptr), value :: a_d, b_d
204  integer(c_int) :: n
205  end subroutine hip_invcol2
206 
207  subroutine hip_col2(a_d, b_d, n) &
208  bind(c, name = 'hip_col2')
209  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
210 
211  type(c_ptr), value :: a_d, b_d
212  integer(c_int) :: n
213  end subroutine hip_col2
214 
215  subroutine hip_col3(a_d, b_d, c_d, n) &
216  bind(c, name = 'hip_col3')
217  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
218 
219  type(c_ptr), value :: a_d, b_d, c_d
220  integer(c_int) :: n
221  end subroutine hip_col3
222 
223  subroutine hip_subcol3(a_d, b_d, c_d, n) &
224  bind(c, name = 'hip_subcol3')
225  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
226 
227  type(c_ptr), value :: a_d, b_d, c_d
228  integer(c_int) :: n
229  end subroutine hip_subcol3
230 
231  subroutine hip_sub2(a_d, b_d, n) &
232  bind(c, name = 'hip_sub2')
233  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
234 
235  type(c_ptr), value :: a_d, b_d
236  integer(c_int) :: n
237  end subroutine hip_sub2
238 
239  subroutine hip_sub3(a_d, b_d, c_d, n) &
240  bind(c, name = 'hip_sub3')
241  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
242 
243  type(c_ptr), value :: a_d, b_d, c_d
244  integer(c_int) :: n
245  end subroutine hip_sub3
246 
247  subroutine hip_add3(a_d, b_d, c_d, n) &
248  bind(c, name = 'hip_add3')
249  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
250 
251  type(c_ptr), value :: a_d, b_d, c_d
252  integer(c_int) :: n
253  end subroutine hip_add3
254 
255  subroutine hip_addcol3(a_d, b_d, c_d, n) &
256  bind(c, name = 'hip_addcol3')
257  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
258 
259  type(c_ptr), value :: a_d, b_d, c_d
260  integer(c_int) :: n
261  end subroutine hip_addcol3
262 
263  subroutine hip_addcol4(a_d, b_d, c_d, d_d, n) &
264  bind(c, name = 'hip_addcol4')
265  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
266 
267  type(c_ptr), value :: a_d, b_d, c_d, d_d
268  integer(c_int) :: n
269  end subroutine hip_addcol4
270 
271  subroutine hip_vdot3(dot_d, u1_d, u2_d, u3_d, v1_d, v2_d, v3_d, n) &
272  bind(c, name = 'hip_vdot3')
273  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
274 
275  type(c_ptr), value :: dot_d, u1_d, u2_d, u3_d, v1_d, v2_d, v3_d
276  integer(c_int) :: n
277  end subroutine hip_vdot3
278 
279  subroutine hip_vcross(u1_d, u2_d, u3_d, v1_d, v2_d, v3_d, &
280  w1_d, w2_d, w3_d, n) &
281  bind(c, name = 'hip_vcross')
282  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
283 
284  type(c_ptr), value :: u1_d, u2_d, u3_d
285  type(c_ptr), value :: v1_d, v2_d, v3_d
286  type(c_ptr), value :: w1_d, w2_d, w3_d
287  integer(c_int) :: n
288  end subroutine hip_vcross
289 
290  real(c_rp) function hip_vlsc3(u_d, v_d, w_d, n) &
291  bind(c, name = 'hip_vlsc3')
292  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
293  import c_rp
294 
295  type(c_ptr), value :: u_d, v_d, w_d
296  integer(c_int) :: n
297  end function hip_vlsc3
298 
299  real(c_rp) function hip_glsc3(a_d, b_d, c_d, n) &
300  bind(c, name = 'hip_glsc3')
301  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
302  import c_rp
303 
304  type(c_ptr), value :: a_d, b_d, c_d
305  integer(c_int) :: n
306  end function hip_glsc3
307 
308  subroutine hip_glsc3_many(h, w_d, v_d_d, mult_d, j, n) &
309  bind(c, name = 'hip_glsc3_many')
310  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
311  import c_rp
312 
313  type(c_ptr), value :: w_d, v_d_d, mult_d
314  integer(c_int) :: j, n
315  real(c_rp) :: h(j)
316  end subroutine hip_glsc3_many
317 
318  real(c_rp) function hip_glsc2(a_d, b_d, n) &
319  bind(c, name = 'hip_glsc2')
320  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
321  import c_rp
322 
323  type(c_ptr), value :: a_d, b_d
324  integer(c_int) :: n
325  end function hip_glsc2
326 
327  real(c_rp) function hip_glsum(a_d, n) &
328  bind(c, name = 'hip_glsum')
329  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
330  import c_rp
331 
332  type(c_ptr), value :: a_d
333  integer(c_int) :: n
334  end function hip_glsum
335 
336  subroutine hip_absval(a_d, n) &
337  bind(c, name = 'hip_absval')
338  use, intrinsic :: iso_c_binding, only: c_ptr, c_int
339  import c_rp
340 
341  type(c_ptr), value :: a_d
342  integer(c_int) :: n
343  end subroutine hip_absval
344  end interface
345 
346 end module hip_math
integer, parameter, public c_rp
Definition: num_types.f90:13
integer, parameter, public rp
Global precision used in computations.
Definition: num_types.f90:12