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