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