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