Neko 1.99.1
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
convect_scalar.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!
34submodule(opr_cpu) cpu_convect_scalar
35 use math, only : col2
36 implicit none
37
38contains
39
40 module subroutine opr_cpu_convect_scalar(du, u, cr, cs, ct, xh_gll, xh_gl, &
41 coef_gll, coef_gl, gll_to_gl)
42 type(space_t), intent(in) :: Xh_GL
43 type(space_t), intent(in) :: Xh_GLL
44 type(coef_t), intent(in) :: coef_GLL
45 type(coef_t), intent(in) :: coef_GL
46 type(interpolator_t), intent(inout) :: GLL_to_GL
47 real(kind=rp), intent(inout) :: &
48 du(xh_gll%lx, xh_gll%ly, xh_gll%lz, coef_gl%msh%nelv)
49 real(kind=rp), intent(inout) :: &
50 u(xh_gl%lx, xh_gl%lx, xh_gl%lx, coef_gl%msh%nelv)
51 real(kind=rp), intent(inout) :: cr(xh_gl%lxyz, coef_gl%msh%nelv)
52 real(kind=rp), intent(inout) :: cs(xh_gl%lxyz, coef_gl%msh%nelv)
53 real(kind=rp), intent(inout) :: ct(xh_gl%lxyz, coef_gl%msh%nelv)
54 associate(dx => xh_gl%dx, dy => xh_gl%dy, dz => xh_gl%dz, &
55 lx => xh_gl%lx, nelv => coef_gl%msh%nelv)
56
57 select case (lx)
58 case (18)
59 call cpu_convect_scalar_lx18(du, u, cr, cs, ct, dx, dy, dz, &
60 xh_gll, coef_gll, gll_to_gl, nelv)
61 case (17)
62 call cpu_convect_scalar_lx17(du, u, cr, cs, ct, dx, dy, dz, &
63 xh_gll, coef_gll, gll_to_gl, nelv)
64 case (16)
65 call cpu_convect_scalar_lx16(du, u, cr, cs, ct, dx, dy, dz, &
66 xh_gll, coef_gll, gll_to_gl, nelv)
67 case (15)
68 call cpu_convect_scalar_lx15(du, u, cr, cs, ct, dx, dy, dz, &
69 xh_gll, coef_gll, gll_to_gl, nelv)
70 case (14)
71 call cpu_convect_scalar_lx14(du, u, cr, cs, ct, dx, dy, dz, &
72 xh_gll, coef_gll, gll_to_gl, nelv)
73 case (13)
74 call cpu_convect_scalar_lx13(du, u, cr, cs, ct, dx, dy, dz, &
75 xh_gll, coef_gll, gll_to_gl, nelv)
76 case (12)
77 call cpu_convect_scalar_lx12(du, u, cr, cs, ct, dx, dy, dz, &
78 xh_gll, coef_gll, gll_to_gl, nelv)
79 case (11)
80 call cpu_convect_scalar_lx11(du, u, cr, cs, ct, dx, dy, dz, &
81 xh_gll, coef_gll, gll_to_gl, nelv)
82 case (10)
83 call cpu_convect_scalar_lx10(du, u, cr, cs, ct, dx, dy, dz, &
84 xh_gll, coef_gll, gll_to_gl, nelv)
85 case (9)
86 call cpu_convect_scalar_lx9(du, u, cr, cs, ct, dx, dy, dz, &
87 xh_gll, coef_gll, gll_to_gl, nelv)
88 case (8)
89 call cpu_convect_scalar_lx8(du, u, cr, cs, ct, dx, dy, dz, &
90 xh_gll, coef_gll, gll_to_gl, nelv)
91 case (7)
92 call cpu_convect_scalar_lx7(du, u, cr, cs, ct, dx, dy, dz, &
93 xh_gll, coef_gll, gll_to_gl, nelv)
94 case (6)
95 call cpu_convect_scalar_lx6(du, u, cr, cs, ct, dx, dy, dz, &
96 xh_gll, coef_gll, gll_to_gl, nelv)
97 case (5)
98 call cpu_convect_scalar_lx5(du, u, cr, cs, ct, dx, dy, dz, &
99 xh_gll, coef_gll, gll_to_gl, nelv)
100 case (4)
101 call cpu_convect_scalar_lx4(du, u, cr, cs, ct, dx, dy, dz, &
102 xh_gll, coef_gll, gll_to_gl, nelv)
103 case (3)
104 call cpu_convect_scalar_lx3(du, u, cr, cs, ct, dx, dy, dz, &
105 xh_gll, coef_gll, gll_to_gl, nelv)
106 case (2)
107 call cpu_convect_scalar_lx2(du, u, cr, cs, ct, dx, dy, dz, &
108 xh_gll, coef_gll, gll_to_gl, nelv)
109 case default
110 call cpu_convect_scalar_lx(du, u, cr, cs, ct, dx, dy, dz, &
111 xh_gll, coef_gll, gll_to_gl, nelv, lx)
112 end select
113 end associate
114
115 end subroutine opr_cpu_convect_scalar
116
117 subroutine cpu_convect_scalar_lx(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
118 coef_GLL, GLL_to_GL, nelv, lx)
119 integer, intent(in) :: nelv, lx
120 type(space_t), intent(in) :: Xh_GLL
121 type(coef_t), intent(in) :: coef_GLL
122 type(interpolator_t), intent(inout) :: GLL_to_GL
123 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
124 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
125 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
126 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
127 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
128 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
129 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
130 real(kind=rp) :: ud(lx*lx*lx)
131 real(kind=rp) :: tmp
132 integer :: e, i, j, k, l, idx, n_GLL
133
134 n_gll = nelv * xh_gll%lxyz
135
136 do e = 1, nelv
137 do j = 1, lx * lx
138 do i = 1, lx
139 tmp = 0.0_rp
140 do k = 1, lx
141 tmp = tmp + dx(i,k) * u(k,j,1,e)
142 end do
143 ur(i,j,1) = tmp
144 end do
145 end do
146
147 do k = 1, lx
148 do j = 1, lx
149 do i = 1, lx
150 tmp = 0.0_rp
151 do l = 1, lx
152 tmp = tmp + dy(j,l) * u(i,l,k,e)
153 end do
154 us(i,j,k) = tmp
155 end do
156 end do
157 end do
158
159 do k = 1, lx
160 do i = 1, lx*lx
161 tmp = 0.0_rp
162 do l = 1, lx
163 tmp = tmp + dz(k,l) * u(i,1,l,e)
164 end do
165 ut(i,1,k) = tmp
166 end do
167 end do
168
169 do i = 1, lx * lx * lx
170 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
171 + ct(i,e) * ut(i,1,1)
172 end do
173 idx = (e-1) * xh_gll%lxyz+1
174 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
175 end do
176 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
177 call col2(du, coef_gll%Binv, n_gll)
178
179 end subroutine cpu_convect_scalar_lx
180
181 subroutine cpu_convect_scalar_lx18(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
182 coef_GLL, GLL_to_GL, nelv)
183 integer, parameter :: lx = 18
184 integer, intent(in) :: nelv
185 type(space_t), intent(in) :: Xh_GLL
186 type(coef_t), intent(in) :: coef_GLL
187 type(interpolator_t), intent(inout) :: GLL_to_GL
188 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
189 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
190 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
191 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
192 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
193 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
194 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
195 real(kind=rp) :: ud(lx*lx*lx)
196 real(kind=rp) :: tmp
197 integer :: e, i, j, k, l, idx, n_GLL
198
199 n_gll = nelv * xh_gll%lxyz
200
201 do e = 1, nelv
202 do j = 1, lx * lx
203 do i = 1, lx
204 tmp = 0.0_rp
205 do k = 1, lx
206 tmp = tmp + dx(i,k) * u(k,j,1,e)
207 end do
208 ur(i,j,1) = tmp
209 end do
210 end do
211
212 do k = 1, lx
213 do j = 1, lx
214 do i = 1, lx
215 tmp = 0.0_rp
216 do l = 1, lx
217 tmp = tmp + dy(j,l) * u(i,l,k,e)
218 end do
219 us(i,j,k) = tmp
220 end do
221 end do
222 end do
223
224 do k = 1, lx
225 do i = 1, lx*lx
226 tmp = 0.0_rp
227 do l = 1, lx
228 tmp = tmp + dz(k,l) * u(i,1,l,e)
229 end do
230 ut(i,1,k) = tmp
231 end do
232 end do
233
234 do i = 1, lx * lx * lx
235 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
236 + ct(i,e) * ut(i,1,1)
237 end do
238 idx = (e-1) * xh_gll%lxyz+1
239 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
240 end do
241 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
242 call col2(du, coef_gll%Binv, n_gll)
243
244 end subroutine cpu_convect_scalar_lx18
245
246 subroutine cpu_convect_scalar_lx17(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
247 coef_GLL, GLL_to_GL, nelv)
248 integer, parameter :: lx = 17
249 integer, intent(in) :: nelv
250 type(space_t), intent(in) :: Xh_GLL
251 type(coef_t), intent(in) :: coef_GLL
252 type(interpolator_t), intent(inout) :: GLL_to_GL
253 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
254 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
255 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
256 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
257 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
258 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
259 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
260 real(kind=rp) :: ud(lx*lx*lx)
261 real(kind=rp) :: tmp
262 integer :: e, i, j, k, l, idx, n_GLL
263
264 n_gll = nelv * xh_gll%lxyz
265
266 do e = 1, nelv
267 do j = 1, lx * lx
268 do i = 1, lx
269 tmp = 0.0_rp
270 do k = 1, lx
271 tmp = tmp + dx(i,k) * u(k,j,1,e)
272 end do
273 ur(i,j,1) = tmp
274 end do
275 end do
276
277 do k = 1, lx
278 do j = 1, lx
279 do i = 1, lx
280 tmp = 0.0_rp
281 do l = 1, lx
282 tmp = tmp + dy(j,l) * u(i,l,k,e)
283 end do
284 us(i,j,k) = tmp
285 end do
286 end do
287 end do
288
289 do k = 1, lx
290 do i = 1, lx*lx
291 tmp = 0.0_rp
292 do l = 1, lx
293 tmp = tmp + dz(k,l) * u(i,1,l,e)
294 end do
295 ut(i,1,k) = tmp
296 end do
297 end do
298
299 do i = 1, lx * lx * lx
300 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
301 + ct(i,e) * ut(i,1,1)
302 end do
303 idx = (e-1) * xh_gll%lxyz+1
304 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
305 end do
306 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
307 call col2(du, coef_gll%Binv, n_gll)
308
309 end subroutine cpu_convect_scalar_lx17
310
311 subroutine cpu_convect_scalar_lx16(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
312 coef_GLL, GLL_to_GL, nelv)
313 integer, parameter :: lx = 16
314 integer, intent(in) :: nelv
315 type(space_t), intent(in) :: Xh_GLL
316 type(coef_t), intent(in) :: coef_GLL
317 type(interpolator_t), intent(inout) :: GLL_to_GL
318 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
319 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
320 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
321 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
322 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
323 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
324 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
325 real(kind=rp) :: ud(lx*lx*lx)
326 real(kind=rp) :: tmp
327 integer :: e, i, j, k, l, idx, n_GLL
328
329 n_gll = nelv * xh_gll%lxyz
330
331 do e = 1, nelv
332 do j = 1, lx * lx
333 do i = 1, lx
334 tmp = 0.0_rp
335 do k = 1, lx
336 tmp = tmp + dx(i,k) * u(k,j,1,e)
337 end do
338 ur(i,j,1) = tmp
339 end do
340 end do
341
342 do k = 1, lx
343 do j = 1, lx
344 do i = 1, lx
345 tmp = 0.0_rp
346 do l = 1, lx
347 tmp = tmp + dy(j,l) * u(i,l,k,e)
348 end do
349 us(i,j,k) = tmp
350 end do
351 end do
352 end do
353
354 do k = 1, lx
355 do i = 1, lx*lx
356 tmp = 0.0_rp
357 do l = 1, lx
358 tmp = tmp + dz(k,l) * u(i,1,l,e)
359 end do
360 ut(i,1,k) = tmp
361 end do
362 end do
363
364 do i = 1, lx * lx * lx
365 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
366 + ct(i,e) * ut(i,1,1)
367 end do
368 idx = (e-1) * xh_gll%lxyz+1
369 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
370 end do
371 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
372 call col2(du, coef_gll%Binv, n_gll)
373
374 end subroutine cpu_convect_scalar_lx16
375
376 subroutine cpu_convect_scalar_lx15(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
377 coef_GLL, GLL_to_GL, nelv)
378 integer, parameter :: lx = 15
379 integer, intent(in) :: nelv
380 type(space_t), intent(in) :: Xh_GLL
381 type(coef_t), intent(in) :: coef_GLL
382 type(interpolator_t), intent(inout) :: GLL_to_GL
383 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
384 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
385 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
386 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
387 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
388 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
389 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
390 real(kind=rp) :: ud(lx*lx*lx)
391 real(kind=rp) :: tmp
392 integer :: e, i, j, k, l, idx, n_GLL
393
394 n_gll = nelv * xh_gll%lxyz
395
396 do e = 1, nelv
397 do j = 1, lx * lx
398 do i = 1, lx
399 tmp = 0.0_rp
400 do k = 1, lx
401 tmp = tmp + dx(i,k) * u(k,j,1,e)
402 end do
403 ur(i,j,1) = tmp
404 end do
405 end do
406
407 do k = 1, lx
408 do j = 1, lx
409 do i = 1, lx
410 tmp = 0.0_rp
411 do l = 1, lx
412 tmp = tmp + dy(j,l) * u(i,l,k,e)
413 end do
414 us(i,j,k) = tmp
415 end do
416 end do
417 end do
418
419 do k = 1, lx
420 do i = 1, lx*lx
421 tmp = 0.0_rp
422 do l = 1, lx
423 tmp = tmp + dz(k,l) * u(i,1,l,e)
424 end do
425 ut(i,1,k) = tmp
426 end do
427 end do
428
429 do i = 1, lx * lx * lx
430 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
431 + ct(i,e) * ut(i,1,1)
432 end do
433 idx = (e-1) * xh_gll%lxyz+1
434 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
435 end do
436 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
437 call col2(du, coef_gll%Binv, n_gll)
438
439 end subroutine cpu_convect_scalar_lx15
440
441 subroutine cpu_convect_scalar_lx14(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
442 coef_GLL, GLL_to_GL, nelv)
443 integer, parameter :: lx = 14
444 integer, intent(in) :: nelv
445 type(space_t), intent(in) :: Xh_GLL
446 type(coef_t), intent(in) :: coef_GLL
447 type(interpolator_t), intent(inout) :: GLL_to_GL
448 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
449 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
450 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
451 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
452 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
453 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
454 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
455 real(kind=rp) :: ud(lx*lx*lx)
456 real(kind=rp) :: tmp
457 integer :: e, i, j, k, l, idx, n_GLL
458
459 n_gll = nelv * xh_gll%lxyz
460
461 do e = 1, nelv
462 do j = 1, lx * lx
463 do i = 1, lx
464 tmp = 0.0_rp
465 do k = 1, lx
466 tmp = tmp + dx(i,k) * u(k,j,1,e)
467 end do
468 ur(i,j,1) = tmp
469 end do
470 end do
471
472 do k = 1, lx
473 do j = 1, lx
474 do i = 1, lx
475 tmp = 0.0_rp
476 do l = 1, lx
477 tmp = tmp + dy(j,l) * u(i,l,k,e)
478 end do
479 us(i,j,k) = tmp
480 end do
481 end do
482 end do
483
484 do k = 1, lx
485 do i = 1, lx*lx
486 tmp = 0.0_rp
487 do l = 1, lx
488 tmp = tmp + dz(k,l) * u(i,1,l,e)
489 end do
490 ut(i,1,k) = tmp
491 end do
492 end do
493
494 do i = 1, lx * lx * lx
495 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
496 + ct(i,e) * ut(i,1,1)
497 end do
498 idx = (e-1) * xh_gll%lxyz+1
499 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
500 end do
501 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
502 call col2(du, coef_gll%Binv, n_gll)
503
504 end subroutine cpu_convect_scalar_lx14
505
506 subroutine cpu_convect_scalar_lx13(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
507 coef_GLL, GLL_to_GL, nelv)
508 integer, parameter :: lx = 13
509 integer, intent(in) :: nelv
510 type(space_t), intent(in) :: Xh_GLL
511 type(coef_t), intent(in) :: coef_GLL
512 type(interpolator_t), intent(inout) :: GLL_to_GL
513 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
514 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
515 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
516 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
517 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
518 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
519 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
520 real(kind=rp) :: ud(lx*lx*lx)
521 real(kind=rp) :: tmp
522 integer :: e, i, j, k, l, idx, n_GLL
523
524 n_gll = nelv * xh_gll%lxyz
525
526 do e = 1, nelv
527 do j = 1, lx * lx
528 do i = 1, lx
529 tmp = 0.0_rp
530 do k = 1, lx
531 tmp = tmp + dx(i,k) * u(k,j,1,e)
532 end do
533 ur(i,j,1) = tmp
534 end do
535 end do
536
537 do k = 1, lx
538 do j = 1, lx
539 do i = 1, lx
540 tmp = 0.0_rp
541 do l = 1, lx
542 tmp = tmp + dy(j,l) * u(i,l,k,e)
543 end do
544 us(i,j,k) = tmp
545 end do
546 end do
547 end do
548
549 do k = 1, lx
550 do i = 1, lx*lx
551 tmp = 0.0_rp
552 do l = 1, lx
553 tmp = tmp + dz(k,l) * u(i,1,l,e)
554 end do
555 ut(i,1,k) = tmp
556 end do
557 end do
558
559 do i = 1, lx * lx * lx
560 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
561 + ct(i,e) * ut(i,1,1)
562 end do
563 idx = (e-1) * xh_gll%lxyz+1
564 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
565 end do
566 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
567 call col2(du, coef_gll%Binv, n_gll)
568
569 end subroutine cpu_convect_scalar_lx13
570
571 subroutine cpu_convect_scalar_lx12(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
572 coef_GLL, GLL_to_GL, nelv)
573 integer, parameter :: lx = 12
574 integer, intent(in) :: nelv
575 type(space_t), intent(in) :: Xh_GLL
576 type(coef_t), intent(in) :: coef_GLL
577 type(interpolator_t), intent(inout) :: GLL_to_GL
578 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
579 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
580 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
581 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
582 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
583 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
584 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
585 real(kind=rp) :: ud(lx*lx*lx)
586 real(kind=rp) :: tmp
587 integer :: e, i, j, k, l, idx, n_GLL
588
589 n_gll = nelv * xh_gll%lxyz
590
591 do e = 1, nelv
592 do j = 1, lx * lx
593 do i = 1, lx
594 tmp = 0.0_rp
595 do k = 1, lx
596 tmp = tmp + dx(i,k) * u(k,j,1,e)
597 end do
598 ur(i,j,1) = tmp
599 end do
600 end do
601
602 do k = 1, lx
603 do j = 1, lx
604 do i = 1, lx
605 tmp = 0.0_rp
606 do l = 1, lx
607 tmp = tmp + dy(j,l) * u(i,l,k,e)
608 end do
609 us(i,j,k) = tmp
610 end do
611 end do
612 end do
613
614 do k = 1, lx
615 do i = 1, lx*lx
616 tmp = 0.0_rp
617 do l = 1, lx
618 tmp = tmp + dz(k,l) * u(i,1,l,e)
619 end do
620 ut(i,1,k) = tmp
621 end do
622 end do
623
624 do i = 1, lx * lx * lx
625 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
626 + ct(i,e) * ut(i,1,1)
627 end do
628 idx = (e-1) * xh_gll%lxyz+1
629 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
630 end do
631 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
632 call col2(du, coef_gll%Binv, n_gll)
633
634 end subroutine cpu_convect_scalar_lx12
635
636 subroutine cpu_convect_scalar_lx11(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
637 coef_GLL, GLL_to_GL, nelv)
638 integer, parameter :: lx = 11
639 integer, intent(in) :: nelv
640 type(space_t), intent(in) :: Xh_GLL
641 type(coef_t), intent(in) :: coef_GLL
642 type(interpolator_t), intent(inout) :: GLL_to_GL
643 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
644 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
645 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
646 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
647 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
648 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
649 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
650 real(kind=rp) :: ud(lx*lx*lx)
651 real(kind=rp) :: tmp
652 integer :: e, i, j, k, l, idx, n_GLL
653
654 n_gll = nelv * xh_gll%lxyz
655
656 do e = 1, nelv
657 do j = 1, lx * lx
658 do i = 1, lx
659 tmp = 0.0_rp
660 do k = 1, lx
661 tmp = tmp + dx(i,k) * u(k,j,1,e)
662 end do
663 ur(i,j,1) = tmp
664 end do
665 end do
666
667 do k = 1, lx
668 do j = 1, lx
669 do i = 1, lx
670 tmp = 0.0_rp
671 do l = 1, lx
672 tmp = tmp + dy(j,l) * u(i,l,k,e)
673 end do
674 us(i,j,k) = tmp
675 end do
676 end do
677 end do
678
679 do k = 1, lx
680 do i = 1, lx*lx
681 tmp = 0.0_rp
682 do l = 1, lx
683 tmp = tmp + dz(k,l) * u(i,1,l,e)
684 end do
685 ut(i,1,k) = tmp
686 end do
687 end do
688
689 do i = 1, lx * lx * lx
690 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
691 + ct(i,e) * ut(i,1,1)
692 end do
693 idx = (e-1) * xh_gll%lxyz+1
694 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
695 end do
696 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
697 call col2(du, coef_gll%Binv, n_gll)
698
699 end subroutine cpu_convect_scalar_lx11
700
701 subroutine cpu_convect_scalar_lx10(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
702 coef_GLL, GLL_to_GL, nelv)
703 integer, parameter :: lx = 10
704 integer, intent(in) :: nelv
705 type(space_t), intent(in) :: Xh_GLL
706 type(coef_t), intent(in) :: coef_GLL
707 type(interpolator_t), intent(inout) :: GLL_to_GL
708 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
709 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
710 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
711 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
712 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
713 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
714 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
715 real(kind=rp) :: ud(lx*lx*lx)
716 real(kind=rp) :: tmp
717 integer :: e, i, j, k, l, idx, n_GLL
718
719 n_gll = nelv * xh_gll%lxyz
720
721 do e = 1, nelv
722 do j = 1, lx * lx
723 do i = 1, lx
724 tmp = 0.0_rp
725 do k = 1, lx
726 tmp = tmp + dx(i,k) * u(k,j,1,e)
727 end do
728 ur(i,j,1) = tmp
729 end do
730 end do
731
732 do k = 1, lx
733 do j = 1, lx
734 do i = 1, lx
735 tmp = 0.0_rp
736 do l = 1, lx
737 tmp = tmp + dy(j,l) * u(i,l,k,e)
738 end do
739 us(i,j,k) = tmp
740 end do
741 end do
742 end do
743
744 do k = 1, lx
745 do i = 1, lx*lx
746 tmp = 0.0_rp
747 do l = 1, lx
748 tmp = tmp + dz(k,l) * u(i,1,l,e)
749 end do
750 ut(i,1,k) = tmp
751 end do
752 end do
753
754 do i = 1, lx * lx * lx
755 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
756 + ct(i,e) * ut(i,1,1)
757 end do
758 idx = (e-1) * xh_gll%lxyz+1
759 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
760 end do
761 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
762 call col2(du, coef_gll%Binv, n_gll)
763
764 end subroutine cpu_convect_scalar_lx10
765
766 subroutine cpu_convect_scalar_lx9(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
767 coef_GLL, GLL_to_GL, nelv)
768 integer, parameter :: lx = 9
769 integer, intent(in) :: nelv
770 type(space_t), intent(in) :: Xh_GLL
771 type(coef_t), intent(in) :: coef_GLL
772 type(interpolator_t), intent(inout) :: GLL_to_GL
773 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
774 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
775 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
776 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
777 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
778 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
779 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
780 real(kind=rp) :: ud(lx*lx*lx)
781 real(kind=rp) :: tmp
782 integer :: e, i, j, k, l, idx, n_GLL
783
784 n_gll = nelv * xh_gll%lxyz
785
786 do e = 1, nelv
787 do j = 1, lx * lx
788 do i = 1, lx
789 tmp = 0.0_rp
790 do k = 1, lx
791 tmp = tmp + dx(i,k) * u(k,j,1,e)
792 end do
793 ur(i,j,1) = tmp
794 end do
795 end do
796
797 do k = 1, lx
798 do j = 1, lx
799 do i = 1, lx
800 tmp = 0.0_rp
801 do l = 1, lx
802 tmp = tmp + dy(j,l) * u(i,l,k,e)
803 end do
804 us(i,j,k) = tmp
805 end do
806 end do
807 end do
808
809 do k = 1, lx
810 do i = 1, lx*lx
811 tmp = 0.0_rp
812 do l = 1, lx
813 tmp = tmp + dz(k,l) * u(i,1,l,e)
814 end do
815 ut(i,1,k) = tmp
816 end do
817 end do
818
819 do i = 1, lx * lx * lx
820 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
821 + ct(i,e) * ut(i,1,1)
822 end do
823 idx = (e-1) * xh_gll%lxyz+1
824 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
825 end do
826 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
827 call col2(du, coef_gll%Binv, n_gll)
828
829 end subroutine cpu_convect_scalar_lx9
830
831 subroutine cpu_convect_scalar_lx8(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
832 coef_GLL, GLL_to_GL, nelv)
833 integer, parameter :: lx = 8
834 integer, intent(in) :: nelv
835 type(space_t), intent(in) :: Xh_GLL
836 type(coef_t), intent(in) :: coef_GLL
837 type(interpolator_t), intent(inout) :: GLL_to_GL
838 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
839 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
840 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
841 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
842 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
843 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
844 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
845 real(kind=rp) :: ud(lx*lx*lx)
846 real(kind=rp) :: tmp
847 integer :: e, i, j, k, l, idx, n_GLL
848
849 n_gll = nelv * xh_gll%lxyz
850
851 do e = 1, nelv
852 do j = 1, lx * lx
853 do i = 1, lx
854 tmp = 0.0_rp
855 do k = 1, lx
856 tmp = tmp + dx(i,k) * u(k,j,1,e)
857 end do
858 ur(i,j,1) = tmp
859 end do
860 end do
861
862 do k = 1, lx
863 do j = 1, lx
864 do i = 1, lx
865 tmp = 0.0_rp
866 do l = 1, lx
867 tmp = tmp + dy(j,l) * u(i,l,k,e)
868 end do
869 us(i,j,k) = tmp
870 end do
871 end do
872 end do
873
874 do k = 1, lx
875 do i = 1, lx*lx
876 tmp = 0.0_rp
877 do l = 1, lx
878 tmp = tmp + dz(k,l) * u(i,1,l,e)
879 end do
880 ut(i,1,k) = tmp
881 end do
882 end do
883
884 do i = 1, lx * lx * lx
885 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
886 + ct(i,e) * ut(i,1,1)
887 end do
888 idx = (e-1) * xh_gll%lxyz+1
889 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
890 end do
891 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
892 call col2(du, coef_gll%Binv, n_gll)
893
894 end subroutine cpu_convect_scalar_lx8
895
896 subroutine cpu_convect_scalar_lx7(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
897 coef_GLL, GLL_to_GL, nelv)
898 integer, parameter :: lx = 7
899 integer, intent(in) :: nelv
900 type(space_t), intent(in) :: Xh_GLL
901 type(coef_t), intent(in) :: coef_GLL
902 type(interpolator_t), intent(inout) :: GLL_to_GL
903 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
904 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
905 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
906 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
907 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
908 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
909 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
910 real(kind=rp) :: ud(lx*lx*lx)
911 real(kind=rp) :: tmp
912 integer :: e, i, j, k, l, idx, n_GLL
913
914 n_gll = nelv * xh_gll%lxyz
915
916 do e = 1, nelv
917 do j = 1, lx * lx
918 do i = 1, lx
919 tmp = 0.0_rp
920 do k = 1, lx
921 tmp = tmp + dx(i,k) * u(k,j,1,e)
922 end do
923 ur(i,j,1) = tmp
924 end do
925 end do
926
927 do k = 1, lx
928 do j = 1, lx
929 do i = 1, lx
930 tmp = 0.0_rp
931 do l = 1, lx
932 tmp = tmp + dy(j,l) * u(i,l,k,e)
933 end do
934 us(i,j,k) = tmp
935 end do
936 end do
937 end do
938
939 do k = 1, lx
940 do i = 1, lx*lx
941 tmp = 0.0_rp
942 do l = 1, lx
943 tmp = tmp + dz(k,l) * u(i,1,l,e)
944 end do
945 ut(i,1,k) = tmp
946 end do
947 end do
948
949 do i = 1, lx * lx * lx
950 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
951 + ct(i,e) * ut(i,1,1)
952 end do
953 idx = (e-1) * xh_gll%lxyz+1
954 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
955 end do
956 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
957 call col2(du, coef_gll%Binv, n_gll)
958
959 end subroutine cpu_convect_scalar_lx7
960
961 subroutine cpu_convect_scalar_lx6(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
962 coef_GLL, GLL_to_GL, nelv)
963 integer, parameter :: lx = 6
964 integer, intent(in) :: nelv
965 type(space_t), intent(in) :: Xh_GLL
966 type(coef_t), intent(in) :: coef_GLL
967 type(interpolator_t), intent(inout) :: GLL_to_GL
968 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
969 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
970 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
971 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
972 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
973 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
974 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
975 real(kind=rp) :: ud(lx*lx*lx)
976 real(kind=rp) :: tmp
977 integer :: e, i, j, k, l, idx, n_GLL
978
979 n_gll = nelv * xh_gll%lxyz
980
981 do e = 1, nelv
982 do j = 1, lx * lx
983 do i = 1, lx
984 tmp = 0.0_rp
985 do k = 1, lx
986 tmp = tmp + dx(i,k) * u(k,j,1,e)
987 end do
988 ur(i,j,1) = tmp
989 end do
990 end do
991
992 do k = 1, lx
993 do j = 1, lx
994 do i = 1, lx
995 tmp = 0.0_rp
996 do l = 1, lx
997 tmp = tmp + dy(j,l) * u(i,l,k,e)
998 end do
999 us(i,j,k) = tmp
1000 end do
1001 end do
1002 end do
1003
1004 do k = 1, lx
1005 do i = 1, lx*lx
1006 tmp = 0.0_rp
1007 do l = 1, lx
1008 tmp = tmp + dz(k,l) * u(i,1,l,e)
1009 end do
1010 ut(i,1,k) = tmp
1011 end do
1012 end do
1013
1014 do i = 1, lx * lx * lx
1015 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
1016 + ct(i,e) * ut(i,1,1)
1017 end do
1018 idx = (e-1) * xh_gll%lxyz+1
1019 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
1020 end do
1021 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
1022 call col2(du, coef_gll%Binv, n_gll)
1023
1024 end subroutine cpu_convect_scalar_lx6
1025
1026 subroutine cpu_convect_scalar_lx5(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
1027 coef_GLL, GLL_to_GL, nelv)
1028 integer, parameter :: lx = 5
1029 integer, intent(in) :: nelv
1030 type(space_t), intent(in) :: Xh_GLL
1031 type(coef_t), intent(in) :: coef_GLL
1032 type(interpolator_t), intent(inout) :: GLL_to_GL
1033 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
1034 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
1035 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
1036 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
1037 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
1038 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
1039 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
1040 real(kind=rp) :: ud(lx*lx*lx)
1041 real(kind=rp) :: tmp
1042 integer :: e, i, j, k, l, idx, n_GLL
1043
1044 n_gll = nelv * xh_gll%lxyz
1045
1046 do e = 1, nelv
1047 do j = 1, lx * lx
1048 do i = 1, lx
1049 tmp = 0.0_rp
1050 do k = 1, lx
1051 tmp = tmp + dx(i,k) * u(k,j,1,e)
1052 end do
1053 ur(i,j,1) = tmp
1054 end do
1055 end do
1056
1057 do k = 1, lx
1058 do j = 1, lx
1059 do i = 1, lx
1060 tmp = 0.0_rp
1061 do l = 1, lx
1062 tmp = tmp + dy(j,l) * u(i,l,k,e)
1063 end do
1064 us(i,j,k) = tmp
1065 end do
1066 end do
1067 end do
1068
1069 do k = 1, lx
1070 do i = 1, lx*lx
1071 tmp = 0.0_rp
1072 do l = 1, lx
1073 tmp = tmp + dz(k,l) * u(i,1,l,e)
1074 end do
1075 ut(i,1,k) = tmp
1076 end do
1077 end do
1078
1079 do i = 1, lx * lx * lx
1080 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
1081 + ct(i,e) * ut(i,1,1)
1082 end do
1083 idx = (e-1) * xh_gll%lxyz+1
1084 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
1085 end do
1086 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
1087 call col2(du, coef_gll%Binv, n_gll)
1088
1089 end subroutine cpu_convect_scalar_lx5
1090
1091 subroutine cpu_convect_scalar_lx4(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
1092 coef_GLL, GLL_to_GL, nelv)
1093 integer, parameter :: lx = 4
1094 integer, intent(in) :: nelv
1095 type(space_t), intent(in) :: Xh_GLL
1096 type(coef_t), intent(in) :: coef_GLL
1097 type(interpolator_t), intent(inout) :: GLL_to_GL
1098 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
1099 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
1100 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
1101 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
1102 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
1103 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
1104 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
1105 real(kind=rp) :: ud(lx*lx*lx)
1106 real(kind=rp) :: tmp
1107 integer :: e, i, j, k, l, idx, n_GLL
1108
1109 n_gll = nelv * xh_gll%lxyz
1110
1111 do e = 1, nelv
1112 do j = 1, lx * lx
1113 do i = 1, lx
1114 tmp = 0.0_rp
1115 do k = 1, lx
1116 tmp = tmp + dx(i,k) * u(k,j,1,e)
1117 end do
1118 ur(i,j,1) = tmp
1119 end do
1120 end do
1121
1122 do k = 1, lx
1123 do j = 1, lx
1124 do i = 1, lx
1125 tmp = 0.0_rp
1126 do l = 1, lx
1127 tmp = tmp + dy(j,l) * u(i,l,k,e)
1128 end do
1129 us(i,j,k) = tmp
1130 end do
1131 end do
1132 end do
1133
1134 do k = 1, lx
1135 do i = 1, lx*lx
1136 tmp = 0.0_rp
1137 do l = 1, lx
1138 tmp = tmp + dz(k,l) * u(i,1,l,e)
1139 end do
1140 ut(i,1,k) = tmp
1141 end do
1142 end do
1143
1144 do i = 1, lx * lx * lx
1145 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
1146 + ct(i,e) * ut(i,1,1)
1147 end do
1148 idx = (e-1) * xh_gll%lxyz+1
1149 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
1150 end do
1151 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
1152 call col2(du, coef_gll%Binv, n_gll)
1153
1154 end subroutine cpu_convect_scalar_lx4
1155
1156 subroutine cpu_convect_scalar_lx3(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
1157 coef_GLL, GLL_to_GL, nelv)
1158 integer, parameter :: lx = 3
1159 integer, intent(in) :: nelv
1160 type(space_t), intent(in) :: Xh_GLL
1161 type(coef_t), intent(in) :: coef_GLL
1162 type(interpolator_t), intent(inout) :: GLL_to_GL
1163 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
1164 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
1165 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
1166 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
1167 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
1168 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
1169 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
1170 real(kind=rp) :: ud(lx*lx*lx)
1171 real(kind=rp) :: tmp
1172 integer :: e, i, j, k, l, idx, n_GLL
1173
1174 n_gll = nelv * xh_gll%lxyz
1175
1176 do e = 1, nelv
1177 do j = 1, lx * lx
1178 do i = 1, lx
1179 tmp = 0.0_rp
1180 do k = 1, lx
1181 tmp = tmp + dx(i,k) * u(k,j,1,e)
1182 end do
1183 ur(i,j,1) = tmp
1184 end do
1185 end do
1186
1187 do k = 1, lx
1188 do j = 1, lx
1189 do i = 1, lx
1190 tmp = 0.0_rp
1191 do l = 1, lx
1192 tmp = tmp + dy(j,l) * u(i,l,k,e)
1193 end do
1194 us(i,j,k) = tmp
1195 end do
1196 end do
1197 end do
1198
1199 do k = 1, lx
1200 do i = 1, lx*lx
1201 tmp = 0.0_rp
1202 do l = 1, lx
1203 tmp = tmp + dz(k,l) * u(i,1,l,e)
1204 end do
1205 ut(i,1,k) = tmp
1206 end do
1207 end do
1208
1209 do i = 1, lx * lx * lx
1210 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
1211 + ct(i,e) * ut(i,1,1)
1212 end do
1213 idx = (e-1) * xh_gll%lxyz+1
1214 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
1215 end do
1216 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
1217 call col2(du, coef_gll%Binv, n_gll)
1218
1219 end subroutine cpu_convect_scalar_lx3
1220
1221 subroutine cpu_convect_scalar_lx2(du, u, cr, cs, ct, dx, dy, dz, Xh_GLL, &
1222 coef_GLL, GLL_to_GL, nelv)
1223 integer, parameter :: lx = 2
1224 integer, intent(in) :: nelv
1225 type(space_t), intent(in) :: Xh_GLL
1226 type(coef_t), intent(in) :: coef_GLL
1227 type(interpolator_t), intent(inout) :: GLL_to_GL
1228 real(kind=rp), intent(inout) :: du(xh_gll%lx, xh_gll%lx, xh_gll%lx, nelv)
1229 real(kind=rp), intent(in) :: u(lx, lx, lx, nelv)
1230 real(kind=rp), intent(in) :: cr(lx*lx*lx, nelv)
1231 real(kind=rp), intent(in) :: cs(lx*lx*lx, nelv)
1232 real(kind=rp), intent(in) :: ct(lx*lx*lx, nelv)
1233 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
1234 real(kind=rp), dimension(lx, lx, lx) :: ur, us, ut
1235 real(kind=rp) :: ud(lx*lx*lx)
1236 real(kind=rp) :: tmp
1237 integer :: e, i, j, k, l, idx, n_GLL
1238
1239 n_gll = nelv * xh_gll%lxyz
1240
1241 do e = 1, nelv
1242 do j = 1, lx * lx
1243 do i = 1, lx
1244 tmp = 0.0_rp
1245 do k = 1, lx
1246 tmp = tmp + dx(i,k) * u(k,j,1,e)
1247 end do
1248 ur(i,j,1) = tmp
1249 end do
1250 end do
1251
1252 do k = 1, lx
1253 do j = 1, lx
1254 do i = 1, lx
1255 tmp = 0.0_rp
1256 do l = 1, lx
1257 tmp = tmp + dy(j,l) * u(i,l,k,e)
1258 end do
1259 us(i,j,k) = tmp
1260 end do
1261 end do
1262 end do
1263
1264 do k = 1, lx
1265 do i = 1, lx*lx
1266 tmp = 0.0_rp
1267 do l = 1, lx
1268 tmp = tmp + dz(k,l) * u(i,1,l,e)
1269 end do
1270 ut(i,1,k) = tmp
1271 end do
1272 end do
1273
1274 do i = 1, lx * lx * lx
1275 ud(i) = cr(i,e) * ur(i,1,1) + cs(i,e) * us(i,1,1) &
1276 + ct(i,e) * ut(i,1,1)
1277 end do
1278 idx = (e-1) * xh_gll%lxyz+1
1279 call gll_to_gl%map(du(idx,1,1,1), ud, 1, xh_gll)
1280 end do
1281 call coef_gll%gs_h%op(du, n_gll, gs_op_add)
1282 call col2(du, coef_gll%Binv, n_gll)
1283
1284 end subroutine cpu_convect_scalar_lx2
1285
1286end submodule cpu_convect_scalar
math
Definition math.f90:60
math::col2
subroutine, public col2(a, b, n)
Vector multiplication .
Definition math.f90:854
opr_cpu
Operators CPU backend.
Definition opr_cpu.f90:34