Neko  0.9.99
A portable framework for high-order spectral element flow simulations
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 !
34 submodule(opr_sx) sx_dudxyz
35  use math, only : addcol3, col2
36  implicit none
37 
38 contains
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 
936 end submodule sx_dudxyz
math
Definition: math.f90:60
math::addcol3
subroutine, public addcol3(a, b, c, n)
Returns .
Definition: math.f90:801
math::col2
subroutine, public col2(a, b, n)
Vector multiplication .
Definition: math.f90:729
opr_sx
Operators SX-Aurora backend.
Definition: opr_sx.f90:2