Neko 0.9.99
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
sx_dudxyz.f90
Go to the documentation of this file.
1! Copyright (c) 2021, 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_sx) sx_dudxyz
35 use math, only : addcol3, col2
36 implicit none
37
38contains
39
40 module subroutine opr_sx_dudxyz(du, u, dr, ds, dt, coef)
41 type(coef_t), intent(in), target :: coef
42 real(kind=rp), intent(inout), &
43 dimension(coef%Xh%lx, coef%Xh%ly, coef%Xh%lz, coef%msh%nelv) :: du
44 real(kind=rp), intent(in), &
45 dimension(coef%Xh%lx, coef%Xh%ly, coef%Xh%lz, coef%msh%nelv) :: &
46 u, dr, ds, dt
47
48 associate(xh => coef%Xh, msh => coef%msh, dof => coef%dof)
49 select case (coef%Xh%lx)
50 case (14)
51 call sx_dudxyz_lx14(du, u, dr, ds, dt, xh%dx, xh%dy, xh%dz, &
52 coef%jacinv, msh%nelv, dof%size())
53 case (13)
54 call sx_dudxyz_lx13(du, u, dr, ds, dt, xh%dx, xh%dy, xh%dz, &
55 coef%jacinv, msh%nelv, dof%size())
56 case (12)
57 call sx_dudxyz_lx12(du, u, dr, ds, dt, xh%dx, xh%dy, xh%dz, &
58 coef%jacinv, msh%nelv, dof%size())
59 case (11)
60 call sx_dudxyz_lx11(du, u, dr, ds, dt, xh%dx, xh%dy, xh%dz, &
61 coef%jacinv, msh%nelv, dof%size())
62 case (10)
63 call sx_dudxyz_lx10(du, u, dr, ds, dt, xh%dx, xh%dy, xh%dz, &
64 coef%jacinv, msh%nelv, dof%size())
65 case (9)
66 call sx_dudxyz_lx9(du, u, dr, ds, dt, xh%dx, xh%dy, xh%dz, &
67 coef%jacinv, msh%nelv, dof%size())
68 case (8)
69 call sx_dudxyz_lx8(du, u, dr, ds, dt, xh%dx, xh%dy, xh%dz, &
70 coef%jacinv, msh%nelv, dof%size())
71 case (7)
72 call sx_dudxyz_lx7(du, u, dr, ds, dt, xh%dx, xh%dy, xh%dz, &
73 coef%jacinv, msh%nelv, dof%size())
74 case (6)
75 call sx_dudxyz_lx6(du, u, dr, ds, dt, xh%dx, xh%dy, xh%dz, &
76 coef%jacinv, msh%nelv, dof%size())
77 case (5)
78 call sx_dudxyz_lx5(du, u, dr, ds, dt, xh%dx, xh%dy, xh%dz, &
79 coef%jacinv, msh%nelv, dof%size())
80 case (4)
81 call sx_dudxyz_lx4(du, u, dr, ds, dt, xh%dx, xh%dy, xh%dz, &
82 coef%jacinv, msh%nelv, dof%size())
83 case (3)
84 call sx_dudxyz_lx3(du, u, dr, ds, dt, xh%dx, xh%dy, xh%dz, &
85 coef%jacinv, msh%nelv, dof%size())
86 case (2)
87 call sx_dudxyz_lx2(du, u, dr, ds, dt, xh%dx, xh%dy, xh%dz, &
88 coef%jacinv, msh%nelv, dof%size())
89 case default
90 call sx_dudxyz_lx(du, u, dr, ds, dt, xh%dx, xh%dy, xh%dz, &
91 coef%jacinv, msh%nelv, dof%size(), xh%lx)
92 end select
93 end associate
94
95 end subroutine opr_sx_dudxyz
96
97 subroutine sx_dudxyz_lx(du, u, dr, ds, dt, dx, dy, dz, jacinv, nel, nd, lx)
98 integer, intent(in) :: nel, nd, lx
99 real(kind=rp), dimension(lx, lx, lx, nel), intent(inout) :: du
100 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: u, dr, ds, dt
101 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: jacinv
102 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
103 real(kind=rp), dimension(lx, lx, lx, nel) :: drst
104 integer :: e, k
105 integer :: i, j, jj, kk
106 real(kind=rp) :: wr, ws, wt
107
108 do i = 1, lx
109 do jj = 1, lx*lx*nel
110 wr = 0d0
111 do kk = 1, lx
112 wr = wr + dx(i, kk) * u(kk, jj,1,1)
113 end do
114 du(i, jj,1,1) = wr
115 end do
116 end do
117
118 call col2 (du, dr, nd)
119
120 do k = 1, lx
121 do i = 1, lx
122 do j = 1, lx
123 do e = 1, nel
124 ws = 0d0
125 !NEC$ unroll_completely
126 do kk = 1, lx
127 ws = ws + dy(j, kk) * u(i, kk,k,e)
128 end do
129 drst(i,j,k,e) = ws
130 end do
131 end do
132 end do
133 end do
134
135 call addcol3(du, drst, ds, nd)
136
137 do j = 1, lx
138 do i = 1, lx
139 do k = 1, lx
140 do e = 1, nel
141 wt = 0d0
142 !NEC$ unroll_completely
143 do kk = 1, lx
144 wt = wt + dz(k, kk) * u(i,j, kk,e)
145 end do
146 drst(i,j,k,e) = wt
147 end do
148 end do
149 end do
150 end do
151
152 call addcol3(du, drst, dt, nd)
153 call col2 (du, jacinv, nd)
154 end subroutine sx_dudxyz_lx
155
156 subroutine sx_dudxyz_lx14(du, u, dr, ds, dt, dx, dy, dz, jacinv, nel, nd)
157 integer, parameter :: lx = 14
158 integer, intent(in) :: nel, nd
159 real(kind=rp), dimension(lx, lx, lx, nel), intent(inout) :: du
160 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: u, dr, ds, dt
161 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: jacinv
162 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
163 real(kind=rp), dimension(lx, lx, lx, nel) :: drst
164 integer :: e, k
165 integer :: i, j, jj, kk
166 real(kind=rp) :: wr, ws, wt
167
168 do i = 1, lx
169 do jj = 1, lx*lx*nel
170 wr = 0d0
171 do kk = 1, lx
172 wr = wr + dx(i, kk) * u(kk, jj,1,1)
173 end do
174 du(i, jj,1,1) = wr
175 end do
176 end do
177
178 call col2 (du, dr, nd)
179
180 do k = 1, lx
181 do i = 1, lx
182 do j = 1, lx
183 do e = 1, nel
184 ws = 0d0
185 !NEC$ unroll_completely
186 do kk = 1, lx
187 ws = ws + dy(j, kk) * u(i, kk,k,e)
188 end do
189 drst(i,j,k,e) = ws
190 end do
191 end do
192 end do
193 end do
194
195 call addcol3(du, drst, ds, nd)
196
197 do j = 1, lx
198 do i = 1, lx
199 do k = 1, lx
200 do e = 1, nel
201 wt = 0d0
202 !NEC$ unroll_completely
203 do kk = 1, lx
204 wt = wt + dz(k, kk) * u(i,j, kk,e)
205 end do
206 drst(i,j,k,e) = wt
207 end do
208 end do
209 end do
210 end do
211
212 call addcol3(du, drst, dt, nd)
213 call col2 (du, jacinv, nd)
214 end subroutine sx_dudxyz_lx14
215
216 subroutine sx_dudxyz_lx13(du, u, dr, ds, dt, dx, dy, dz, jacinv, nel, nd)
217 integer, parameter :: lx = 13
218 integer, intent(in) :: nel, nd
219 real(kind=rp), dimension(lx, lx, lx, nel), intent(inout) :: du
220 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: u, dr, ds, dt
221 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: jacinv
222 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
223 real(kind=rp), dimension(lx, lx, lx, nel) :: drst
224 integer :: e, k
225 integer :: i, j, jj, kk
226 real(kind=rp) :: wr, ws, wt
227
228 do i = 1, lx
229 do jj = 1, lx*lx*nel
230 wr = 0d0
231 do kk = 1, lx
232 wr = wr + dx(i, kk) * u(kk, jj,1,1)
233 end do
234 du(i, jj,1,1) = wr
235 end do
236 end do
237
238 call col2 (du, dr, nd)
239
240 do k = 1, lx
241 do i = 1, lx
242 do j = 1, lx
243 do e = 1, nel
244 ws = 0d0
245 !NEC$ unroll_completely
246 do kk = 1, lx
247 ws = ws + dy(j, kk) * u(i, kk,k,e)
248 end do
249 drst(i,j,k,e) = ws
250 end do
251 end do
252 end do
253 end do
254
255 call addcol3(du, drst, ds, nd)
256
257 do j = 1, lx
258 do i = 1, lx
259 do k = 1, lx
260 do e = 1, nel
261 wt = 0d0
262 !NEC$ unroll_completely
263 do kk = 1, lx
264 wt = wt + dz(k, kk) * u(i,j, kk,e)
265 end do
266 drst(i,j,k,e) = wt
267 end do
268 end do
269 end do
270 end do
271
272 call addcol3(du, drst, dt, nd)
273 call col2 (du, jacinv, nd)
274 end subroutine sx_dudxyz_lx13
275
276 subroutine sx_dudxyz_lx12(du, u, dr, ds, dt, dx, dy, dz, jacinv, nel, nd)
277 integer, parameter :: lx = 12
278 integer, intent(in) :: nel, nd
279 real(kind=rp), dimension(lx, lx, lx, nel), intent(inout) :: du
280 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: u, dr, ds, dt
281 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: jacinv
282 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
283 real(kind=rp), dimension(lx, lx, lx, nel) :: drst
284 integer :: e, k
285 integer :: i, j, jj, kk
286 real(kind=rp) :: wr, ws, wt
287
288 do i = 1, lx
289 do jj = 1, lx*lx*nel
290 wr = 0d0
291 do kk = 1, lx
292 wr = wr + dx(i, kk) * u(kk, jj,1,1)
293 end do
294 du(i, jj,1,1) = wr
295 end do
296 end do
297
298 call col2 (du, dr, nd)
299
300 do k = 1, lx
301 do i = 1, lx
302 do j = 1, lx
303 do e = 1, nel
304 ws = 0d0
305 !NEC$ unroll_completely
306 do kk = 1, lx
307 ws = ws + dy(j, kk) * u(i, kk,k,e)
308 end do
309 drst(i,j,k,e) = ws
310 end do
311 end do
312 end do
313 end do
314
315 call addcol3(du, drst, ds, nd)
316
317 do j = 1, lx
318 do i = 1, lx
319 do k = 1, lx
320 do e = 1, nel
321 wt = 0d0
322 !NEC$ unroll_completely
323 do kk = 1, lx
324 wt = wt + dz(k, kk) * u(i,j, kk,e)
325 end do
326 drst(i,j,k,e) = wt
327 end do
328 end do
329 end do
330 end do
331
332 call addcol3(du, drst, dt, nd)
333 call col2 (du, jacinv, nd)
334 end subroutine sx_dudxyz_lx12
335
336 subroutine sx_dudxyz_lx11(du, u, dr, ds, dt, dx, dy, dz, jacinv, nel, nd)
337 integer, parameter :: lx = 11
338 integer, intent(in) :: nel, nd
339 real(kind=rp), dimension(lx, lx, lx, nel), intent(inout) :: du
340 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: u, dr, ds, dt
341 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: jacinv
342 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
343 real(kind=rp), dimension(lx, lx, lx, nel) :: drst
344 integer :: e, k
345 integer :: i, j, jj, kk
346 real(kind=rp) :: wr, ws, wt
347
348 do i = 1, lx
349 do jj = 1, lx*lx*nel
350 wr = 0d0
351 do kk = 1, lx
352 wr = wr + dx(i, kk) * u(kk, jj,1,1)
353 end do
354 du(i, jj,1,1) = wr
355 end do
356 end do
357
358 call col2 (du, dr, nd)
359
360 do k = 1, lx
361 do i = 1, lx
362 do j = 1, lx
363 do e = 1, nel
364 ws = 0d0
365 !NEC$ unroll_completely
366 do kk = 1, lx
367 ws = ws + dy(j, kk) * u(i, kk,k,e)
368 end do
369 drst(i,j,k,e) = ws
370 end do
371 end do
372 end do
373 end do
374
375 call addcol3(du, drst, ds, nd)
376
377 do j = 1, lx
378 do i = 1, lx
379 do k = 1, lx
380 do e = 1, nel
381 wt = 0d0
382 !NEC$ unroll_completely
383 do kk = 1, lx
384 wt = wt + dz(k, kk) * u(i,j, kk,e)
385 end do
386 drst(i,j,k,e) = wt
387 end do
388 end do
389 end do
390 end do
391
392 call addcol3(du, drst, dt, nd)
393 call col2 (du, jacinv, nd)
394 end subroutine sx_dudxyz_lx11
395
396 subroutine sx_dudxyz_lx10(du, u, dr, ds, dt, dx, dy, dz, jacinv, nel, nd)
397 integer, parameter :: lx = 10
398 integer, intent(in) :: nel, nd
399 real(kind=rp), dimension(lx, lx, lx, nel), intent(inout) :: du
400 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: u, dr, ds, dt
401 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: jacinv
402 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
403 real(kind=rp), dimension(lx, lx, lx, nel) :: drst
404 integer :: e, k
405 integer :: i, j, jj, kk
406 real(kind=rp) :: wr, ws, wt
407
408 do i = 1, lx
409 do jj = 1, lx*lx*nel
410 wr = 0d0
411 do kk = 1, lx
412 wr = wr + dx(i, kk) * u(kk, jj,1,1)
413 end do
414 du(i, jj,1,1) = wr
415 end do
416 end do
417
418 call col2 (du, dr, nd)
419
420 do k = 1, lx
421 do i = 1, lx
422 do j = 1, lx
423 do e = 1, nel
424 ws = 0d0
425 !NEC$ unroll_completely
426 do kk = 1, lx
427 ws = ws + dy(j, kk) * u(i, kk,k,e)
428 end do
429 drst(i,j,k,e) = ws
430 end do
431 end do
432 end do
433 end do
434
435 call addcol3(du, drst, ds, nd)
436
437 do j = 1, lx
438 do i = 1, lx
439 do k = 1, lx
440 do e = 1, nel
441 wt = 0d0
442 !NEC$ unroll_completely
443 do kk = 1, lx
444 wt = wt + dz(k, kk) * u(i,j, kk,e)
445 end do
446 drst(i,j,k,e) = wt
447 end do
448 end do
449 end do
450 end do
451
452 call addcol3(du, drst, dt, nd)
453 call col2 (du, jacinv, nd)
454 end subroutine sx_dudxyz_lx10
455
456 subroutine sx_dudxyz_lx9(du, u, dr, ds, dt, dx, dy, dz, jacinv, nel, nd)
457 integer, parameter :: lx = 9
458 integer, intent(in) :: nel, nd
459 real(kind=rp), dimension(lx, lx, lx, nel), intent(inout) :: du
460 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: u, dr, ds, dt
461 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: jacinv
462 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
463 real(kind=rp), dimension(lx, lx, lx, nel) :: drst
464 integer :: e, k
465 integer :: i, j, jj, kk
466 real(kind=rp) :: wr, ws, wt
467
468 do i = 1, lx
469 do jj = 1, lx*lx*nel
470 wr = 0d0
471 do kk = 1, lx
472 wr = wr + dx(i, kk) * u(kk, jj,1,1)
473 end do
474 du(i, jj,1,1) = wr
475 end do
476 end do
477
478 call col2 (du, dr, nd)
479
480 do k = 1, lx
481 do i = 1, lx
482 do j = 1, lx
483 do e = 1, nel
484 ws = 0d0
485 !NEC$ unroll_completely
486 do kk = 1, lx
487 ws = ws + dy(j, kk) * u(i, kk,k,e)
488 end do
489 drst(i,j,k,e) = ws
490 end do
491 end do
492 end do
493 end do
494
495 call addcol3(du, drst, ds, nd)
496
497 do j = 1, lx
498 do i = 1, lx
499 do k = 1, lx
500 do e = 1, nel
501 wt = 0d0
502 !NEC$ unroll_completely
503 do kk = 1, lx
504 wt = wt + dz(k, kk) * u(i,j, kk,e)
505 end do
506 drst(i,j,k,e) = wt
507 end do
508 end do
509 end do
510 end do
511
512 call addcol3(du, drst, dt, nd)
513 call col2 (du, jacinv, nd)
514 end subroutine sx_dudxyz_lx9
515
516 subroutine sx_dudxyz_lx8(du, u, dr, ds, dt, dx, dy, dz, jacinv, nel, nd)
517 integer, parameter :: lx = 8
518 integer, intent(in) :: nel, nd
519 real(kind=rp), dimension(lx, lx, lx, nel), intent(inout) :: du
520 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: u, dr, ds, dt
521 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: jacinv
522 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
523 real(kind=rp), dimension(lx, lx, lx, nel) :: drst
524 integer :: e, k
525 integer :: i, j, jj, kk
526 real(kind=rp) :: wr, ws, wt
527
528 do i = 1, lx
529 do jj = 1, lx*lx*nel
530 wr = 0d0
531 do kk = 1, lx
532 wr = wr + dx(i, kk) * u(kk, jj,1,1)
533 end do
534 du(i, jj,1,1) = wr
535 end do
536 end do
537
538 call col2 (du, dr, nd)
539
540 do k = 1, lx
541 do i = 1, lx
542 do j = 1, lx
543 do e = 1, nel
544 ws = 0d0
545 !NEC$ unroll_completely
546 do kk = 1, lx
547 ws = ws + dy(j, kk) * u(i, kk,k,e)
548 end do
549 drst(i,j,k,e) = ws
550 end do
551 end do
552 end do
553 end do
554
555 call addcol3(du, drst, ds, nd)
556
557 do j = 1, lx
558 do i = 1, lx
559 do k = 1, lx
560 do e = 1, nel
561 wt = 0d0
562 !NEC$ unroll_completely
563 do kk = 1, lx
564 wt = wt + dz(k, kk) * u(i,j, kk,e)
565 end do
566 drst(i,j,k,e) = wt
567 end do
568 end do
569 end do
570 end do
571
572 call addcol3(du, drst, dt, nd)
573 call col2 (du, jacinv, nd)
574 end subroutine sx_dudxyz_lx8
575
576 subroutine sx_dudxyz_lx7(du, u, dr, ds, dt, dx, dy, dz, jacinv, nel, nd)
577 integer, parameter :: lx = 7
578 integer, intent(in) :: nel, nd
579 real(kind=rp), dimension(lx, lx, lx, nel), intent(inout) :: du
580 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: u, dr, ds, dt
581 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: jacinv
582 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
583 real(kind=rp), dimension(lx, lx, lx, nel) :: drst
584 integer :: e, k
585 integer :: i, j, jj, kk
586 real(kind=rp) :: wr, ws, wt
587
588 do i = 1, lx
589 do jj = 1, lx*lx*nel
590 wr = 0d0
591 do kk = 1, lx
592 wr = wr + dx(i, kk) * u(kk, jj,1,1)
593 end do
594 du(i, jj,1,1) = wr
595 end do
596 end do
597
598 call col2 (du, dr, nd)
599
600 do k = 1, lx
601 do i = 1, lx
602 do j = 1, lx
603 do e = 1, nel
604 ws = 0d0
605 !NEC$ unroll_completely
606 do kk = 1, lx
607 ws = ws + dy(j, kk) * u(i, kk,k,e)
608 end do
609 drst(i,j,k,e) = ws
610 end do
611 end do
612 end do
613 end do
614
615 call addcol3(du, drst, ds, nd)
616
617 do j = 1, lx
618 do i = 1, lx
619 do k = 1, lx
620 do e = 1, nel
621 wt = 0d0
622 !NEC$ unroll_completely
623 do kk = 1, lx
624 wt = wt + dz(k, kk) * u(i,j, kk,e)
625 end do
626 drst(i,j,k,e) = wt
627 end do
628 end do
629 end do
630 end do
631
632 call addcol3(du, drst, dt, nd)
633 call col2 (du, jacinv, nd)
634 end subroutine sx_dudxyz_lx7
635
636 subroutine sx_dudxyz_lx6(du, u, dr, ds, dt, dx, dy, dz, jacinv, nel, nd)
637 integer, parameter :: lx = 6
638 integer, intent(in) :: nel, nd
639 real(kind=rp), dimension(lx, lx, lx, nel), intent(inout) :: du
640 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: u, dr, ds, dt
641 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: jacinv
642 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
643 real(kind=rp), dimension(lx, lx, lx, nel) :: drst
644 integer :: e, k
645 integer :: i, j, jj, kk
646 real(kind=rp) :: wr, ws, wt
647
648 do i = 1, lx
649 do jj = 1, lx*lx*nel
650 wr = 0d0
651 do kk = 1, lx
652 wr = wr + dx(i, kk) * u(kk, jj,1,1)
653 end do
654 du(i, jj,1,1) = wr
655 end do
656 end do
657
658 call col2 (du, dr, nd)
659
660 do k = 1, lx
661 do i = 1, lx
662 do j = 1, lx
663 do e = 1, nel
664 ws = 0d0
665 !NEC$ unroll_completely
666 do kk = 1, lx
667 ws = ws + dy(j, kk) * u(i, kk,k,e)
668 end do
669 drst(i,j,k,e) = ws
670 end do
671 end do
672 end do
673 end do
674
675 call addcol3(du, drst, ds, nd)
676
677 do j = 1, lx
678 do i = 1, lx
679 do k = 1, lx
680 do e = 1, nel
681 wt = 0d0
682 !NEC$ unroll_completely
683 do kk = 1, lx
684 wt = wt + dz(k, kk) * u(i,j, kk,e)
685 end do
686 drst(i,j,k,e) = wt
687 end do
688 end do
689 end do
690 end do
691
692 call addcol3(du, drst, dt, nd)
693 call col2 (du, jacinv, nd)
694 end subroutine sx_dudxyz_lx6
695
696 subroutine sx_dudxyz_lx5(du, u, dr, ds, dt, dx, dy, dz, jacinv, nel, nd)
697 integer, parameter :: lx = 5
698 integer, intent(in) :: nel, nd
699 real(kind=rp), dimension(lx, lx, lx, nel), intent(inout) :: du
700 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: u, dr, ds, dt
701 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: jacinv
702 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
703 real(kind=rp), dimension(lx, lx, lx, nel) :: drst
704 integer :: e, k
705 integer :: i, j, jj, kk
706 real(kind=rp) :: wr, ws, wt
707
708 do i = 1, lx
709 do jj = 1, lx*lx*nel
710 wr = 0d0
711 do kk = 1, lx
712 wr = wr + dx(i, kk) * u(kk, jj,1,1)
713 end do
714 du(i, jj,1,1) = wr
715 end do
716 end do
717
718 call col2 (du, dr, nd)
719
720 do k = 1, lx
721 do i = 1, lx
722 do j = 1, lx
723 do e = 1, nel
724 ws = 0d0
725 !NEC$ unroll_completely
726 do kk = 1, lx
727 ws = ws + dy(j, kk) * u(i, kk,k,e)
728 end do
729 drst(i,j,k,e) = ws
730 end do
731 end do
732 end do
733 end do
734
735 call addcol3(du, drst, ds, nd)
736
737 do j = 1, lx
738 do i = 1, lx
739 do k = 1, lx
740 do e = 1, nel
741 wt = 0d0
742 !NEC$ unroll_completely
743 do kk = 1, lx
744 wt = wt + dz(k, kk) * u(i,j, kk,e)
745 end do
746 drst(i,j,k,e) = wt
747 end do
748 end do
749 end do
750 end do
751
752 call addcol3(du, drst, dt, nd)
753 call col2 (du, jacinv, nd)
754 end subroutine sx_dudxyz_lx5
755
756 subroutine sx_dudxyz_lx4(du, u, dr, ds, dt, dx, dy, dz, jacinv, nel, nd)
757 integer, parameter :: lx = 4
758 integer, intent(in) :: nel, nd
759 real(kind=rp), dimension(lx, lx, lx, nel), intent(inout) :: du
760 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: u, dr, ds, dt
761 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: jacinv
762 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
763 real(kind=rp), dimension(lx, lx, lx, nel) :: drst
764 integer :: e, k
765 integer :: i, j, jj, kk
766 real(kind=rp) :: wr, ws, wt
767
768 do i = 1, lx
769 do jj = 1, lx*lx*nel
770 wr = 0d0
771 do kk = 1, lx
772 wr = wr + dx(i, kk) * u(kk, jj,1,1)
773 end do
774 du(i, jj,1,1) = wr
775 end do
776 end do
777
778 call col2 (du, dr, nd)
779
780 do k = 1, lx
781 do i = 1, lx
782 do j = 1, lx
783 do e = 1, nel
784 ws = 0d0
785 !NEC$ unroll_completely
786 do kk = 1, lx
787 ws = ws + dy(j, kk) * u(i, kk,k,e)
788 end do
789 drst(i,j,k,e) = ws
790 end do
791 end do
792 end do
793 end do
794
795 call addcol3(du, drst, ds, nd)
796
797 do j = 1, lx
798 do i = 1, lx
799 do k = 1, lx
800 do e = 1, nel
801 wt = 0d0
802 !NEC$ unroll_completely
803 do kk = 1, lx
804 wt = wt + dz(k, kk) * u(i,j, kk,e)
805 end do
806 drst(i,j,k,e) = wt
807 end do
808 end do
809 end do
810 end do
811
812 call addcol3(du, drst, dt, nd)
813 call col2 (du, jacinv, nd)
814 end subroutine sx_dudxyz_lx4
815
816 subroutine sx_dudxyz_lx3(du, u, dr, ds, dt, dx, dy, dz, jacinv, nel, nd)
817 integer, parameter :: lx = 3
818 integer, intent(in) :: nel, nd
819 real(kind=rp), dimension(lx, lx, lx, nel), intent(inout) :: du
820 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: u, dr, ds, dt
821 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: jacinv
822 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
823 real(kind=rp), dimension(lx, lx, lx, nel) :: drst
824 integer :: e, k
825 integer :: i, j, jj, kk
826 real(kind=rp) :: wr, ws, wt
827
828 do i = 1, lx
829 do jj = 1, lx*lx*nel
830 wr = 0d0
831 do kk = 1, lx
832 wr = wr + dx(i, kk) * u(kk, jj,1,1)
833 end do
834 du(i, jj,1,1) = wr
835 end do
836 end do
837
838 call col2 (du, dr, nd)
839
840 do k = 1, lx
841 do i = 1, lx
842 do j = 1, lx
843 do e = 1, nel
844 ws = 0d0
845 !NEC$ unroll_completely
846 do kk = 1, lx
847 ws = ws + dy(j, kk) * u(i, kk,k,e)
848 end do
849 drst(i,j,k,e) = ws
850 end do
851 end do
852 end do
853 end do
854
855 call addcol3(du, drst, ds, nd)
856
857 do j = 1, lx
858 do i = 1, lx
859 do k = 1, lx
860 do e = 1, nel
861 wt = 0d0
862 !NEC$ unroll_completely
863 do kk = 1, lx
864 wt = wt + dz(k, kk) * u(i,j, kk,e)
865 end do
866 drst(i,j,k,e) = wt
867 end do
868 end do
869 end do
870 end do
871
872 call addcol3(du, drst, dt, nd)
873 call col2 (du, jacinv, nd)
874 end subroutine sx_dudxyz_lx3
875
876 subroutine sx_dudxyz_lx2(du, u, dr, ds, dt, dx, dy, dz, jacinv, nel, nd)
877 integer, parameter :: lx = 2
878 integer, intent(in) :: nel, nd
879 real(kind=rp), dimension(lx, lx, lx, nel), intent(inout) :: du
880 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: u, dr, ds, dt
881 real(kind=rp), dimension(lx, lx, lx, nel), intent(in) :: jacinv
882 real(kind=rp), dimension(lx, lx), intent(in) :: dx, dy, dz
883 real(kind=rp), dimension(lx, lx, lx, nel) :: drst
884 integer :: e, k
885 integer :: i, j, jj, kk
886 real(kind=rp) :: wr, ws, wt
887
888 do i = 1, lx
889 do jj = 1, lx*lx*nel
890 wr = 0d0
891 do kk = 1, lx
892 wr = wr + dx(i, kk) * u(kk, jj,1,1)
893 end do
894 du(i, jj,1,1) = wr
895 end do
896 end do
897
898 call col2 (du, dr, nd)
899
900 do k = 1, lx
901 do i = 1, lx
902 do j = 1, lx
903 do e = 1, nel
904 ws = 0d0
905 !NEC$ unroll_completely
906 do kk = 1, lx
907 ws = ws + dy(j, kk) * u(i, kk,k,e)
908 end do
909 drst(i,j,k,e) = ws
910 end do
911 end do
912 end do
913 end do
914
915 call addcol3(du, drst, ds, nd)
916
917 do j = 1, lx
918 do i = 1, lx
919 do k = 1, lx
920 do e = 1, nel
921 wt = 0d0
922 !NEC$ unroll_completely
923 do kk = 1, lx
924 wt = wt + dz(k, kk) * u(i,j, kk,e)
925 end do
926 drst(i,j,k,e) = wt
927 end do
928 end do
929 end do
930 end do
931
932 call addcol3(du, drst, dt, nd)
933 call col2 (du, jacinv, nd)
934 end subroutine sx_dudxyz_lx2
935
936end submodule sx_dudxyz
math
Definition math.f90:60
math::addcol3
subroutine, public addcol3(a, b, c, n)
Returns .
Definition math.f90:800
math::col2
subroutine, public col2(a, b, n)
Vector multiplication .
Definition math.f90:728
opr_sx
Operators SX-Aurora backend.
Definition opr_sx.f90:2