Neko 1.99.1
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
fdm_sx.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!
34module fdm_sx
35 use num_types
36 use tensor_sx
37 implicit none
38 private
39
40 public :: fdm_do_fast_sx
41
42contains
43
44 subroutine fdm_do_fast_sx(e, r, s, d, nl, ldim, nelv)
45 integer, intent(in) :: nl, nelv, ldim
46 real(kind=rp), intent(inout) :: e(nl**ldim, nelv)
47 real(kind=rp), intent(inout) :: r(nl**ldim, nelv)
48 real(kind=rp), intent(inout) :: s(nl*nl,2,ldim, nelv)
49 real(kind=rp), intent(inout) :: d(nl**ldim, nelv)
50 integer :: ie, nn, i
51
52 nn = nl**ldim
53 if(.not. ldim .eq. 3) then
54 do ie = 1, nelv
55 call tnsr2d_el_sx(e(1,ie), nl, r(1,ie), nl, s(1,2,1,ie), s(1,1,2,ie))
56 do i = 1, nn
57 r(i,ie) = d(i,ie) * e(i,ie)
58 end do
59 call tnsr2d_el_sx(e(1,ie), nl, r(1,ie), nl, s(1,1,1,ie), s(1,2,2,ie))
60 end do
61 else
62 select case (nl)
63 case (14)
64 call fdm_do_fast_sx_nl14(e, r, s, d, nelv)
65 case (13)
66 call fdm_do_fast_sx_nl13(e, r, s, d, nelv)
67 case (12)
68 call fdm_do_fast_sx_nl12(e, r, s, d, nelv)
69 case (11)
70 call fdm_do_fast_sx_nl11(e, r, s, d, nelv)
71 case (10)
72 call fdm_do_fast_sx_nl10(e, r, s, d, nelv)
73 case (9)
74 call fdm_do_fast_sx_nl9(e, r, s, d, nelv)
75 case (8)
76 call fdm_do_fast_sx_nl8(e, r, s, d, nelv)
77 case (7)
78 call fdm_do_fast_sx_nl7(e, r, s, d, nelv)
79 case (6)
80 call fdm_do_fast_sx_nl6(e, r, s, d, nelv)
81 case (5)
82 call fdm_do_fast_sx_nl5(e, r, s, d, nelv)
83 case (4)
84 call fdm_do_fast_sx_nl4(e, r, s, d, nelv)
85 case (3)
86 call fdm_do_fast_sx_nl3(e, r, s, d, nelv)
87 case (2)
88 call fdm_do_fast_sx_nl2(e, r, s, d, nelv)
89 case default
90 call fdm_do_fast_sx_nl(e, r, s, d, nelv, nl)
91 end select
92 end if
93 end subroutine fdm_do_fast_sx
94
95 subroutine fdm_do_fast_sx_nl(e, r, s, d, nelv, n)
96 integer, intent(in) :: nelv, n
97 real(kind=rp), intent(inout) :: e(n**3, nelv)
98 real(kind=rp), intent(inout) :: r(n**3, nelv)
99 real(kind=rp), intent(inout) :: s(n,n,2,3, nelv)
100 real(kind=rp), intent(inout) :: d(n**3, nelv)
101 real(kind=rp) :: wrk(n**3, nelv), wrk2(n**3, nelv), tmp
102 integer :: ie, i, j, k, l, ii, jj, nn, nnn
103
104 nn = n**2
105 nnn = n**3
106
107
108 do j = 1, nn
109 do i = 1, n
110 do ie = 1, nelv
111 ii = i + n * (j - 1)
112 tmp = 0.0_rp
113 do k = 1, n
114 tmp = tmp + s(i,k,2,1,ie) * r(k + n * (j - 1), ie)
115 end do
116 wrk(ii, ie) = tmp
117 end do
118 end do
119 end do
120
121 do i = 1, n
122 do j = 1, n
123 do l = 1, n
124 do ie = 1, nelv
125 ii = l + n * (j - 1) + nn * (i - 1)
126 tmp = 0.0_rp
127 do k = 1, n
128 tmp = tmp + wrk(l + n * (k - 1) + nn * (i - 1), ie) &
129 * s(k,j,1,2,ie)
130 end do
131 wrk2(ii,ie) = tmp
132 end do
133 end do
134 end do
135 end do
136
137 do j = 1, n
138 do i = 1, nn
139 do ie = 1, nelv
140 jj = i + nn * (j - 1)
141 tmp = 0.0_rp
142 do k = 1, n
143 tmp = tmp + wrk2(i + nn * (k - 1), ie) * s(k, j, 1, 3, ie)
144 end do
145 e(jj,ie) = tmp
146 end do
147 end do
148 end do
149
150 do i = 1, nnn * nelv
151 r(i,1) = d(i,1) * e(i,1)
152 end do
153
154 do j = 1, nn
155 do i = 1, n
156 do ie = 1, nelv
157 ii = i + n * (j - 1)
158 tmp = 0.0_rp
159 do k = 1, n
160 tmp = tmp + s(i,k,1,1,ie) * r(k + n * (j - 1), ie)
161 end do
162 wrk(ii, ie) = tmp
163 end do
164 end do
165 end do
166
167 do i = 1, n
168 do j = 1, n
169 do l = 1, n
170 do ie = 1, nelv
171 ii = l + n * (j - 1) + nn * (i - 1)
172 tmp = 0.0_rp
173 do k = 1, n
174 tmp = tmp + wrk(l + n * (k - 1) + nn * (i - 1), ie) &
175 * s(k,j,2,2,ie)
176 end do
177 wrk2(ii,ie) = tmp
178 end do
179 end do
180 end do
181 end do
182
183 do j = 1, n
184 do i = 1, nn
185 do ie = 1, nelv
186 jj = i + nn * (j - 1)
187 tmp = 0.0_rp
188 do k = 1, n
189 tmp = tmp + wrk2(i + nn * (k - 1), ie) * s(k, j, 2, 3, ie)
190 end do
191 e(jj,ie) = tmp
192 end do
193 end do
194 end do
195
196 end subroutine fdm_do_fast_sx_nl
197
198 subroutine fdm_do_fast_sx_nl14(e, r, s, d, nelv)
199 integer, parameter :: n = 14
200 integer, parameter :: nn = n**2
201 integer, parameter :: nnn = n**3
202 integer, intent(in) :: nelv
203 real(kind=rp), intent(inout) :: e(n**3, nelv)
204 real(kind=rp), intent(inout) :: r(n**3, nelv)
205 real(kind=rp), intent(inout) :: s(n,n,2,3, nelv)
206 real(kind=rp), intent(inout) :: d(n**3, nelv)
207 real(kind=rp) :: wrk(n**3, nelv), wrk2(n**3, nelv)
208 integer :: ie, i, j, l, ii, jj
209
210 do j = 1, nn
211 do i = 1, n
212 do ie = 1, nelv
213 ii = i + n * (j - 1)
214 wrk(ii, ie) = s(i,1,2,1,ie) * r(1 + n * (j - 1), ie) &
215 + s(i,2,2,1,ie) * r(2 + n * (j - 1), ie) &
216 + s(i,3,2,1,ie) * r(3 + n * (j - 1), ie) &
217 + s(i,4,2,1,ie) * r(4 + n * (j - 1), ie) &
218 + s(i,5,2,1,ie) * r(5 + n * (j - 1), ie) &
219 + s(i,6,2,1,ie) * r(6 + n * (j - 1), ie) &
220 + s(i,7,2,1,ie) * r(7 + n * (j - 1), ie) &
221 + s(i,8,2,1,ie) * r(8 + n * (j - 1), ie) &
222 + s(i,9,2,1,ie) * r(9 + n * (j - 1), ie) &
223 + s(i,10,2,1,ie) * r(10 + n * (j - 1), ie) &
224 + s(i,11,2,1,ie) * r(11 + n * (j - 1), ie) &
225 + s(i,12,2,1,ie) * r(12 + n * (j - 1), ie) &
226 + s(i,13,2,1,ie) * r(13 + n * (j - 1), ie) &
227 + s(i,14,2,1,ie) * r(14 + n * (j - 1), ie)
228 end do
229 end do
230 end do
231
232 do i = 1, n
233 do j = 1, n
234 do l = 1, n
235 do ie = 1, nelv
236 ii = l + n * (j - 1) + nn * (i - 1)
237 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
238 * s(1,j,1,2,ie) &
239 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
240 * s(2,j,1,2,ie) &
241 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
242 * s(3,j,1,2,ie) &
243 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
244 * s(4,j,1,2,ie) &
245 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
246 * s(5,j,1,2,ie) &
247 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
248 * s(6,j,1,2,ie) &
249 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
250 * s(7,j,1,2,ie) &
251 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
252 * s(8,j,1,2,ie) &
253 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
254 * s(9,j,1,2,ie) &
255 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
256 * s(10,j,1,2,ie) &
257 + wrk(l + n * (11 - 1) + nn * (i - 1), ie) &
258 * s(11,j,1,2,ie) &
259 + wrk(l + n * (12 - 1) + nn * (i - 1), ie) &
260 * s(12,j,1,2,ie) &
261 + wrk(l + n * (13 - 1) + nn * (i - 1), ie) &
262 * s(13,j,1,2,ie) &
263 + wrk(l + n * (14 - 1) + nn * (i - 1), ie) &
264 * s(14,j,1,2,ie)
265 end do
266 end do
267 end do
268 end do
269
270 do j = 1, n
271 do i = 1, nn
272 do ie = 1, nelv
273 jj = i + nn * (j - 1)
274 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 1, 3, ie) &
275 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 1, 3, ie) &
276 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 1, 3, ie) &
277 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 1, 3, ie) &
278 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 1, 3, ie) &
279 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 1, 3, ie) &
280 + wrk2(i + nn * (7 - 1), ie) * s(7, j, 1, 3, ie) &
281 + wrk2(i + nn * (8 - 1), ie) * s(8, j, 1, 3, ie) &
282 + wrk2(i + nn * (9 - 1), ie) * s(9, j, 1, 3, ie) &
283 + wrk2(i + nn * (10 - 1), ie) * s(10, j, 1, 3, ie) &
284 + wrk2(i + nn * (11 - 1), ie) * s(11, j, 1, 3, ie) &
285 + wrk2(i + nn * (12 - 1), ie) * s(12, j, 1, 3, ie) &
286 + wrk2(i + nn * (13 - 1), ie) * s(13, j, 1, 3, ie) &
287 + wrk2(i + nn * (14 - 1), ie) * s(14, j, 1, 3, ie)
288 end do
289 end do
290 end do
291
292 do i = 1, nnn * nelv
293 r(i,1) = d(i,1) * e(i,1)
294 end do
295
296 do j = 1, nn
297 do i = 1, n
298 do ie = 1, nelv
299 ii = i + n * (j - 1)
300 wrk(ii, ie) = s(i,1,1,1,ie) * r(1 + n * (j - 1), ie) &
301 + s(i,2,1,1,ie) * r(2 + n * (j - 1), ie) &
302 + s(i,3,1,1,ie) * r(3 + n * (j - 1), ie) &
303 + s(i,4,1,1,ie) * r(4 + n * (j - 1), ie) &
304 + s(i,5,1,1,ie) * r(5 + n * (j - 1), ie) &
305 + s(i,6,1,1,ie) * r(6 + n * (j - 1), ie) &
306 + s(i,7,1,1,ie) * r(7 + n * (j - 1), ie) &
307 + s(i,8,1,1,ie) * r(8 + n * (j - 1), ie) &
308 + s(i,9,1,1,ie) * r(9 + n * (j - 1), ie) &
309 + s(i,10,1,1,ie) * r(10 + n * (j - 1), ie) &
310 + s(i,11,1,1,ie) * r(11 + n * (j - 1), ie) &
311 + s(i,12,1,1,ie) * r(12 + n * (j - 1), ie) &
312 + s(i,13,1,1,ie) * r(13 + n * (j - 1), ie) &
313 + s(i,14,1,1,ie) * r(14 + n * (j - 1), ie)
314 end do
315 end do
316 end do
317
318 do i = 1, n
319 do j = 1, n
320 do l = 1, n
321 do ie = 1, nelv
322 ii = l + n * (j - 1) + nn * (i - 1)
323 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
324 * s(1,j,2,2,ie) &
325 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
326 * s(2,j,2,2,ie) &
327 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
328 * s(3,j,2,2,ie) &
329 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
330 * s(4,j,2,2,ie) &
331 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
332 * s(5,j,2,2,ie) &
333 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
334 * s(6,j,2,2,ie) &
335 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
336 * s(7,j,2,2,ie) &
337 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
338 * s(8,j,2,2,ie) &
339 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
340 * s(9,j,2,2,ie) &
341 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
342 * s(10,j,2,2,ie) &
343 + wrk(l + n * (11 - 1) + nn * (i - 1), ie) &
344 * s(11,j,2,2,ie) &
345 + wrk(l + n * (12 - 1) + nn * (i - 1), ie) &
346 * s(12,j,2,2,ie) &
347 + wrk(l + n * (13 - 1) + nn * (i - 1), ie) &
348 * s(13,j,2,2,ie) &
349 + wrk(l + n * (14 - 1) + nn * (i - 1), ie) &
350 * s(14,j,2,2,ie)
351 end do
352 end do
353 end do
354 end do
355
356 do j = 1, n
357 do i = 1, nn
358 do ie = 1, nelv
359 jj = i + nn * (j - 1)
360 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 2, 3, ie) &
361 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 2, 3, ie) &
362 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 2, 3, ie) &
363 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 2, 3, ie) &
364 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 2, 3, ie) &
365 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 2, 3, ie) &
366 + wrk2(i + nn * (7 - 1), ie) * s(7, j, 2, 3, ie) &
367 + wrk2(i + nn * (8 - 1), ie) * s(8, j, 2, 3, ie) &
368 + wrk2(i + nn * (9 - 1), ie) * s(9, j, 2, 3, ie) &
369 + wrk2(i + nn * (10 - 1), ie) * s(10, j, 2, 3, ie) &
370 + wrk2(i + nn * (11 - 1), ie) * s(11, j, 2, 3, ie) &
371 + wrk2(i + nn * (12 - 1), ie) * s(12, j, 2, 3, ie) &
372 + wrk2(i + nn * (13 - 1), ie) * s(13, j, 2, 3, ie) &
373 + wrk2(i + nn * (14 - 1), ie) * s(14, j, 2, 3, ie)
374 end do
375 end do
376 end do
377
378
379 end subroutine fdm_do_fast_sx_nl14
380
381 subroutine fdm_do_fast_sx_nl13(e, r, s, d, nelv)
382 integer, parameter :: n = 13
383 integer, parameter :: nn = n**2
384 integer, parameter :: nnn = n**3
385 integer, intent(in) :: nelv
386 real(kind=rp), intent(inout) :: e(n**3, nelv)
387 real(kind=rp), intent(inout) :: r(n**3, nelv)
388 real(kind=rp), intent(inout) :: s(n,n,2,3, nelv)
389 real(kind=rp), intent(inout) :: d(n**3, nelv)
390 real(kind=rp) :: wrk(n**3, nelv), wrk2(n**3, nelv)
391 integer :: ie, i, j, l, ii, jj
392
393 do j = 1, nn
394 do i = 1, n
395 do ie = 1, nelv
396 ii = i + n * (j - 1)
397 wrk(ii, ie) = s(i,1,2,1,ie) * r(1 + n * (j - 1), ie) &
398 + s(i,2,2,1,ie) * r(2 + n * (j - 1), ie) &
399 + s(i,3,2,1,ie) * r(3 + n * (j - 1), ie) &
400 + s(i,4,2,1,ie) * r(4 + n * (j - 1), ie) &
401 + s(i,5,2,1,ie) * r(5 + n * (j - 1), ie) &
402 + s(i,6,2,1,ie) * r(6 + n * (j - 1), ie) &
403 + s(i,7,2,1,ie) * r(7 + n * (j - 1), ie) &
404 + s(i,8,2,1,ie) * r(8 + n * (j - 1), ie) &
405 + s(i,9,2,1,ie) * r(9 + n * (j - 1), ie) &
406 + s(i,10,2,1,ie) * r(10 + n * (j - 1), ie) &
407 + s(i,11,2,1,ie) * r(11 + n * (j - 1), ie) &
408 + s(i,12,2,1,ie) * r(12 + n * (j - 1), ie) &
409 + s(i,13,2,1,ie) * r(13 + n * (j - 1), ie)
410 end do
411 end do
412 end do
413
414 do i = 1, n
415 do j = 1, n
416 do l = 1, n
417 do ie = 1, nelv
418 ii = l + n * (j - 1) + nn * (i - 1)
419 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
420 * s(1,j,1,2,ie) &
421 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
422 * s(2,j,1,2,ie) &
423 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
424 * s(3,j,1,2,ie) &
425 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
426 * s(4,j,1,2,ie) &
427 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
428 * s(5,j,1,2,ie) &
429 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
430 * s(6,j,1,2,ie) &
431 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
432 * s(7,j,1,2,ie) &
433 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
434 * s(8,j,1,2,ie) &
435 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
436 * s(9,j,1,2,ie) &
437 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
438 * s(10,j,1,2,ie) &
439 + wrk(l + n * (11 - 1) + nn * (i - 1), ie) &
440 * s(11,j,1,2,ie) &
441 + wrk(l + n * (12 - 1) + nn * (i - 1), ie) &
442 * s(12,j,1,2,ie) &
443 + wrk(l + n * (13 - 1) + nn * (i - 1), ie) &
444 * s(13,j,1,2,ie)
445 end do
446 end do
447 end do
448 end do
449
450 do j = 1, n
451 do i = 1, nn
452 do ie = 1, nelv
453 jj = i + nn * (j - 1)
454 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 1, 3, ie) &
455 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 1, 3, ie) &
456 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 1, 3, ie) &
457 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 1, 3, ie) &
458 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 1, 3, ie) &
459 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 1, 3, ie) &
460 + wrk2(i + nn * (7 - 1), ie) * s(7, j, 1, 3, ie) &
461 + wrk2(i + nn * (8 - 1), ie) * s(8, j, 1, 3, ie) &
462 + wrk2(i + nn * (9 - 1), ie) * s(9, j, 1, 3, ie) &
463 + wrk2(i + nn * (10 - 1), ie) * s(10, j, 1, 3, ie) &
464 + wrk2(i + nn * (11 - 1), ie) * s(11, j, 1, 3, ie) &
465 + wrk2(i + nn * (12 - 1), ie) * s(12, j, 1, 3, ie) &
466 + wrk2(i + nn * (13 - 1), ie) * s(13, j, 1, 3, ie)
467 end do
468 end do
469 end do
470
471 do i = 1, nnn * nelv
472 r(i,1) = d(i,1) * e(i,1)
473 end do
474
475 do j = 1, nn
476 do i = 1, n
477 do ie = 1, nelv
478 ii = i + n * (j - 1)
479 wrk(ii, ie) = s(i,1,1,1,ie) * r(1 + n * (j - 1), ie) &
480 + s(i,2,1,1,ie) * r(2 + n * (j - 1), ie) &
481 + s(i,3,1,1,ie) * r(3 + n * (j - 1), ie) &
482 + s(i,4,1,1,ie) * r(4 + n * (j - 1), ie) &
483 + s(i,5,1,1,ie) * r(5 + n * (j - 1), ie) &
484 + s(i,6,1,1,ie) * r(6 + n * (j - 1), ie) &
485 + s(i,7,1,1,ie) * r(7 + n * (j - 1), ie) &
486 + s(i,8,1,1,ie) * r(8 + n * (j - 1), ie) &
487 + s(i,9,1,1,ie) * r(9 + n * (j - 1), ie) &
488 + s(i,10,1,1,ie) * r(10 + n * (j - 1), ie) &
489 + s(i,11,1,1,ie) * r(11 + n * (j - 1), ie) &
490 + s(i,12,1,1,ie) * r(12 + n * (j - 1), ie) &
491 + s(i,13,1,1,ie) * r(13 + n * (j - 1), ie)
492 end do
493 end do
494 end do
495
496 do i = 1, n
497 do j = 1, n
498 do l = 1, n
499 do ie = 1, nelv
500 ii = l + n * (j - 1) + nn * (i - 1)
501 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
502 * s(1,j,2,2,ie) &
503 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
504 * s(2,j,2,2,ie) &
505 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
506 * s(3,j,2,2,ie) &
507 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
508 * s(4,j,2,2,ie) &
509 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
510 * s(5,j,2,2,ie) &
511 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
512 * s(6,j,2,2,ie) &
513 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
514 * s(7,j,2,2,ie) &
515 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
516 * s(8,j,2,2,ie) &
517 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
518 * s(9,j,2,2,ie) &
519 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
520 * s(10,j,2,2,ie) &
521 + wrk(l + n * (11 - 1) + nn * (i - 1), ie) &
522 * s(11,j,2,2,ie) &
523 + wrk(l + n * (12 - 1) + nn * (i - 1), ie) &
524 * s(12,j,2,2,ie) &
525 + wrk(l + n * (13 - 1) + nn * (i - 1), ie) &
526 * s(13,j,2,2,ie)
527 end do
528 end do
529 end do
530 end do
531
532 do j = 1, n
533 do i = 1, nn
534 do ie = 1, nelv
535 jj = i + nn * (j - 1)
536 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 2, 3, ie) &
537 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 2, 3, ie) &
538 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 2, 3, ie) &
539 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 2, 3, ie) &
540 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 2, 3, ie) &
541 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 2, 3, ie) &
542 + wrk2(i + nn * (7 - 1), ie) * s(7, j, 2, 3, ie) &
543 + wrk2(i + nn * (8 - 1), ie) * s(8, j, 2, 3, ie) &
544 + wrk2(i + nn * (9 - 1), ie) * s(9, j, 2, 3, ie) &
545 + wrk2(i + nn * (10 - 1), ie) * s(10, j, 2, 3, ie) &
546 + wrk2(i + nn * (11 - 1), ie) * s(11, j, 2, 3, ie) &
547 + wrk2(i + nn * (12 - 1), ie) * s(12, j, 2, 3, ie) &
548 + wrk2(i + nn * (13 - 1), ie) * s(13, j, 2, 3, ie)
549 end do
550 end do
551 end do
552
553
554 end subroutine fdm_do_fast_sx_nl13
555
556 subroutine fdm_do_fast_sx_nl12(e, r, s, d, nelv)
557 integer, parameter :: n = 12
558 integer, parameter :: nn = n**2
559 integer, parameter :: nnn = n**3
560 integer, intent(in) :: nelv
561 real(kind=rp), intent(inout) :: e(n**3, nelv)
562 real(kind=rp), intent(inout) :: r(n**3, nelv)
563 real(kind=rp), intent(inout) :: s(n,n,2,3, nelv)
564 real(kind=rp), intent(inout) :: d(n**3, nelv)
565 real(kind=rp) :: wrk(n**3, nelv), wrk2(n**3, nelv)
566 integer :: ie, i, j, l, ii, jj
567
568 do j = 1, nn
569 do i = 1, n
570 do ie = 1, nelv
571 ii = i + n * (j - 1)
572 wrk(ii, ie) = s(i,1,2,1,ie) * r(1 + n * (j - 1), ie) &
573 + s(i,2,2,1,ie) * r(2 + n * (j - 1), ie) &
574 + s(i,3,2,1,ie) * r(3 + n * (j - 1), ie) &
575 + s(i,4,2,1,ie) * r(4 + n * (j - 1), ie) &
576 + s(i,5,2,1,ie) * r(5 + n * (j - 1), ie) &
577 + s(i,6,2,1,ie) * r(6 + n * (j - 1), ie) &
578 + s(i,7,2,1,ie) * r(7 + n * (j - 1), ie) &
579 + s(i,8,2,1,ie) * r(8 + n * (j - 1), ie) &
580 + s(i,9,2,1,ie) * r(9 + n * (j - 1), ie) &
581 + s(i,10,2,1,ie) * r(10 + n * (j - 1), ie) &
582 + s(i,11,2,1,ie) * r(11 + n * (j - 1), ie) &
583 + s(i,12,2,1,ie) * r(12 + n * (j - 1), ie)
584 end do
585 end do
586 end do
587
588 do i = 1, n
589 do j = 1, n
590 do l = 1, n
591 do ie = 1, nelv
592 ii = l + n * (j - 1) + nn * (i - 1)
593 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
594 * s(1,j,1,2,ie) &
595 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
596 * s(2,j,1,2,ie) &
597 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
598 * s(3,j,1,2,ie) &
599 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
600 * s(4,j,1,2,ie) &
601 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
602 * s(5,j,1,2,ie) &
603 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
604 * s(6,j,1,2,ie) &
605 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
606 * s(7,j,1,2,ie) &
607 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
608 * s(8,j,1,2,ie) &
609 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
610 * s(9,j,1,2,ie) &
611 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
612 * s(10,j,1,2,ie) &
613 + wrk(l + n * (11 - 1) + nn * (i - 1), ie) &
614 * s(11,j,1,2,ie) &
615 + wrk(l + n * (12 - 1) + nn * (i - 1), ie) &
616 * s(12,j,1,2,ie)
617 end do
618 end do
619 end do
620 end do
621
622 do j = 1, n
623 do i = 1, nn
624 do ie = 1, nelv
625 jj = i + nn * (j - 1)
626 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 1, 3, ie) &
627 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 1, 3, ie) &
628 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 1, 3, ie) &
629 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 1, 3, ie) &
630 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 1, 3, ie) &
631 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 1, 3, ie) &
632 + wrk2(i + nn * (7 - 1), ie) * s(7, j, 1, 3, ie) &
633 + wrk2(i + nn * (8 - 1), ie) * s(8, j, 1, 3, ie) &
634 + wrk2(i + nn * (9 - 1), ie) * s(9, j, 1, 3, ie) &
635 + wrk2(i + nn * (10 - 1), ie) * s(10, j, 1, 3, ie) &
636 + wrk2(i + nn * (11 - 1), ie) * s(11, j, 1, 3, ie) &
637 + wrk2(i + nn * (12 - 1), ie) * s(12, j, 1, 3, ie)
638 end do
639 end do
640 end do
641
642 do i = 1, nnn * nelv
643 r(i,1) = d(i,1) * e(i,1)
644 end do
645
646 do j = 1, nn
647 do i = 1, n
648 do ie = 1, nelv
649 ii = i + n * (j - 1)
650 wrk(ii, ie) = s(i,1,1,1,ie) * r(1 + n * (j - 1), ie) &
651 + s(i,2,1,1,ie) * r(2 + n * (j - 1), ie) &
652 + s(i,3,1,1,ie) * r(3 + n * (j - 1), ie) &
653 + s(i,4,1,1,ie) * r(4 + n * (j - 1), ie) &
654 + s(i,5,1,1,ie) * r(5 + n * (j - 1), ie) &
655 + s(i,6,1,1,ie) * r(6 + n * (j - 1), ie) &
656 + s(i,7,1,1,ie) * r(7 + n * (j - 1), ie) &
657 + s(i,8,1,1,ie) * r(8 + n * (j - 1), ie) &
658 + s(i,9,1,1,ie) * r(9 + n * (j - 1), ie) &
659 + s(i,10,1,1,ie) * r(10 + n * (j - 1), ie) &
660 + s(i,11,1,1,ie) * r(11 + n * (j - 1), ie) &
661 + s(i,12,1,1,ie) * r(12 + n * (j - 1), ie)
662 end do
663 end do
664 end do
665
666 do i = 1, n
667 do j = 1, n
668 do l = 1, n
669 do ie = 1, nelv
670 ii = l + n * (j - 1) + nn * (i - 1)
671 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
672 * s(1,j,2,2,ie) &
673 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
674 * s(2,j,2,2,ie) &
675 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
676 * s(3,j,2,2,ie) &
677 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
678 * s(4,j,2,2,ie) &
679 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
680 * s(5,j,2,2,ie) &
681 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
682 * s(6,j,2,2,ie) &
683 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
684 * s(7,j,2,2,ie) &
685 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
686 * s(8,j,2,2,ie) &
687 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
688 * s(9,j,2,2,ie) &
689 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
690 * s(10,j,2,2,ie) &
691 + wrk(l + n * (11 - 1) + nn * (i - 1), ie) &
692 * s(11,j,2,2,ie) &
693 + wrk(l + n * (12 - 1) + nn * (i - 1), ie) &
694 * s(12,j,2,2,ie)
695 end do
696 end do
697 end do
698 end do
699
700 do j = 1, n
701 do i = 1, nn
702 do ie = 1, nelv
703 jj = i + nn * (j - 1)
704 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 2, 3, ie) &
705 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 2, 3, ie) &
706 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 2, 3, ie) &
707 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 2, 3, ie) &
708 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 2, 3, ie) &
709 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 2, 3, ie) &
710 + wrk2(i + nn * (7 - 1), ie) * s(7, j, 2, 3, ie) &
711 + wrk2(i + nn * (8 - 1), ie) * s(8, j, 2, 3, ie) &
712 + wrk2(i + nn * (9 - 1), ie) * s(9, j, 2, 3, ie) &
713 + wrk2(i + nn * (10 - 1), ie) * s(10, j, 2, 3, ie) &
714 + wrk2(i + nn * (11 - 1), ie) * s(11, j, 2, 3, ie) &
715 + wrk2(i + nn * (12 - 1), ie) * s(12, j, 2, 3, ie)
716 end do
717 end do
718 end do
719
720
721 end subroutine fdm_do_fast_sx_nl12
722
723 subroutine fdm_do_fast_sx_nl11(e, r, s, d, nelv)
724 integer, parameter :: n = 11
725 integer, parameter :: nn = n**2
726 integer, parameter :: nnn = n**3
727 integer, intent(in) :: nelv
728 real(kind=rp), intent(inout) :: e(n**3, nelv)
729 real(kind=rp), intent(inout) :: r(n**3, nelv)
730 real(kind=rp), intent(inout) :: s(n,n,2,3, nelv)
731 real(kind=rp), intent(inout) :: d(n**3, nelv)
732 real(kind=rp) :: wrk(n**3, nelv), wrk2(n**3, nelv)
733 integer :: ie, i, j, l, ii, jj
734
735 do j = 1, nn
736 do i = 1, n
737 do ie = 1, nelv
738 ii = i + n * (j - 1)
739 wrk(ii, ie) = s(i,1,2,1,ie) * r(1 + n * (j - 1), ie) &
740 + s(i,2,2,1,ie) * r(2 + n * (j - 1), ie) &
741 + s(i,3,2,1,ie) * r(3 + n * (j - 1), ie) &
742 + s(i,4,2,1,ie) * r(4 + n * (j - 1), ie) &
743 + s(i,5,2,1,ie) * r(5 + n * (j - 1), ie) &
744 + s(i,6,2,1,ie) * r(6 + n * (j - 1), ie) &
745 + s(i,7,2,1,ie) * r(7 + n * (j - 1), ie) &
746 + s(i,8,2,1,ie) * r(8 + n * (j - 1), ie) &
747 + s(i,9,2,1,ie) * r(9 + n * (j - 1), ie) &
748 + s(i,10,2,1,ie) * r(10 + n * (j - 1), ie) &
749 + s(i,11,2,1,ie) * r(11 + n * (j - 1), ie)
750 end do
751 end do
752 end do
753
754 do i = 1, n
755 do j = 1, n
756 do l = 1, n
757 do ie = 1, nelv
758 ii = l + n * (j - 1) + nn * (i - 1)
759 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
760 * s(1,j,1,2,ie) &
761 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
762 * s(2,j,1,2,ie) &
763 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
764 * s(3,j,1,2,ie) &
765 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
766 * s(4,j,1,2,ie) &
767 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
768 * s(5,j,1,2,ie) &
769 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
770 * s(6,j,1,2,ie) &
771 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
772 * s(7,j,1,2,ie) &
773 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
774 * s(8,j,1,2,ie) &
775 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
776 * s(9,j,1,2,ie) &
777 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
778 * s(10,j,1,2,ie) &
779 + wrk(l + n * (11 - 1) + nn * (i - 1), ie) &
780 * s(11,j,1,2,ie)
781 end do
782 end do
783 end do
784 end do
785
786 do j = 1, n
787 do i = 1, nn
788 do ie = 1, nelv
789 jj = i + nn * (j - 1)
790 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 1, 3, ie) &
791 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 1, 3, ie) &
792 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 1, 3, ie) &
793 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 1, 3, ie) &
794 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 1, 3, ie) &
795 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 1, 3, ie) &
796 + wrk2(i + nn * (7 - 1), ie) * s(7, j, 1, 3, ie) &
797 + wrk2(i + nn * (8 - 1), ie) * s(8, j, 1, 3, ie) &
798 + wrk2(i + nn * (9 - 1), ie) * s(9, j, 1, 3, ie) &
799 + wrk2(i + nn * (10 - 1), ie) * s(10, j, 1, 3, ie) &
800 + wrk2(i + nn * (11 - 1), ie) * s(11, j, 1, 3, ie)
801 end do
802 end do
803 end do
804
805 do i = 1, nnn * nelv
806 r(i,1) = d(i,1) * e(i,1)
807 end do
808
809 do j = 1, nn
810 do i = 1, n
811 do ie = 1, nelv
812 ii = i + n * (j - 1)
813 wrk(ii, ie) = s(i,1,1,1,ie) * r(1 + n * (j - 1), ie) &
814 + s(i,2,1,1,ie) * r(2 + n * (j - 1), ie) &
815 + s(i,3,1,1,ie) * r(3 + n * (j - 1), ie) &
816 + s(i,4,1,1,ie) * r(4 + n * (j - 1), ie) &
817 + s(i,5,1,1,ie) * r(5 + n * (j - 1), ie) &
818 + s(i,6,1,1,ie) * r(6 + n * (j - 1), ie) &
819 + s(i,7,1,1,ie) * r(7 + n * (j - 1), ie) &
820 + s(i,8,1,1,ie) * r(8 + n * (j - 1), ie) &
821 + s(i,9,1,1,ie) * r(9 + n * (j - 1), ie) &
822 + s(i,10,1,1,ie) * r(10 + n * (j - 1), ie) &
823 + s(i,11,1,1,ie) * r(11 + n * (j - 1), ie)
824 end do
825 end do
826 end do
827
828 do i = 1, n
829 do j = 1, n
830 do l = 1, n
831 do ie = 1, nelv
832 ii = l + n * (j - 1) + nn * (i - 1)
833 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
834 * s(1,j,2,2,ie) &
835 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
836 * s(2,j,2,2,ie) &
837 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
838 * s(3,j,2,2,ie) &
839 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
840 * s(4,j,2,2,ie) &
841 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
842 * s(5,j,2,2,ie) &
843 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
844 * s(6,j,2,2,ie) &
845 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
846 * s(7,j,2,2,ie) &
847 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
848 * s(8,j,2,2,ie) &
849 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
850 * s(9,j,2,2,ie) &
851 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
852 * s(10,j,2,2,ie) &
853 + wrk(l + n * (11 - 1) + nn * (i - 1), ie) &
854 * s(11,j,2,2,ie)
855 end do
856 end do
857 end do
858 end do
859
860 do j = 1, n
861 do i = 1, nn
862 do ie = 1, nelv
863 jj = i + nn * (j - 1)
864 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 2, 3, ie) &
865 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 2, 3, ie) &
866 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 2, 3, ie) &
867 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 2, 3, ie) &
868 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 2, 3, ie) &
869 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 2, 3, ie) &
870 + wrk2(i + nn * (7 - 1), ie) * s(7, j, 2, 3, ie) &
871 + wrk2(i + nn * (8 - 1), ie) * s(8, j, 2, 3, ie) &
872 + wrk2(i + nn * (9 - 1), ie) * s(9, j, 2, 3, ie) &
873 + wrk2(i + nn * (10 - 1), ie) * s(10, j, 2, 3, ie) &
874 + wrk2(i + nn * (11 - 1), ie) * s(11, j, 2, 3, ie)
875 end do
876 end do
877 end do
878
879
880 end subroutine fdm_do_fast_sx_nl11
881
882 subroutine fdm_do_fast_sx_nl10(e, r, s, d, nelv)
883 integer, parameter :: n = 10
884 integer, parameter :: nn = n**2
885 integer, parameter :: nnn = n**3
886 integer, intent(in) :: nelv
887 real(kind=rp), intent(inout) :: e(n**3, nelv)
888 real(kind=rp), intent(inout) :: r(n**3, nelv)
889 real(kind=rp), intent(inout) :: s(n,n,2,3, nelv)
890 real(kind=rp), intent(inout) :: d(n**3, nelv)
891 real(kind=rp) :: wrk(n**3, nelv), wrk2(n**3, nelv)
892 integer :: ie, i, j, l, ii, jj
893
894 do j = 1, nn
895 do i = 1, n
896 do ie = 1, nelv
897 ii = i + n * (j - 1)
898 wrk(ii, ie) = s(i,1,2,1,ie) * r(1 + n * (j - 1), ie) &
899 + s(i,2,2,1,ie) * r(2 + n * (j - 1), ie) &
900 + s(i,3,2,1,ie) * r(3 + n * (j - 1), ie) &
901 + s(i,4,2,1,ie) * r(4 + n * (j - 1), ie) &
902 + s(i,5,2,1,ie) * r(5 + n * (j - 1), ie) &
903 + s(i,6,2,1,ie) * r(6 + n * (j - 1), ie) &
904 + s(i,7,2,1,ie) * r(7 + n * (j - 1), ie) &
905 + s(i,8,2,1,ie) * r(8 + n * (j - 1), ie) &
906 + s(i,9,2,1,ie) * r(9 + n * (j - 1), ie) &
907 + s(i,10,2,1,ie) * r(10 + n * (j - 1), ie)
908 end do
909 end do
910 end do
911
912 do i = 1, n
913 do j = 1, n
914 do l = 1, n
915 do ie = 1, nelv
916 ii = l + n * (j - 1) + nn * (i - 1)
917 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
918 * s(1,j,1,2,ie) &
919 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
920 * s(2,j,1,2,ie) &
921 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
922 * s(3,j,1,2,ie) &
923 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
924 * s(4,j,1,2,ie) &
925 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
926 * s(5,j,1,2,ie) &
927 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
928 * s(6,j,1,2,ie) &
929 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
930 * s(7,j,1,2,ie) &
931 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
932 * s(8,j,1,2,ie) &
933 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
934 * s(9,j,1,2,ie) &
935 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
936 * s(10,j,1,2,ie)
937 end do
938 end do
939 end do
940 end do
941
942 do j = 1, n
943 do i = 1, nn
944 do ie = 1, nelv
945 jj = i + nn * (j - 1)
946 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 1, 3, ie) &
947 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 1, 3, ie) &
948 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 1, 3, ie) &
949 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 1, 3, ie) &
950 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 1, 3, ie) &
951 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 1, 3, ie) &
952 + wrk2(i + nn * (7 - 1), ie) * s(7, j, 1, 3, ie) &
953 + wrk2(i + nn * (8 - 1), ie) * s(8, j, 1, 3, ie) &
954 + wrk2(i + nn * (9 - 1), ie) * s(9, j, 1, 3, ie) &
955 + wrk2(i + nn * (10 - 1), ie) * s(10, j, 1, 3, ie)
956 end do
957 end do
958 end do
959
960 do i = 1, nnn * nelv
961 r(i,1) = d(i,1) * e(i,1)
962 end do
963
964 do j = 1, nn
965 do i = 1, n
966 do ie = 1, nelv
967 ii = i + n * (j - 1)
968 wrk(ii, ie) = s(i,1,1,1,ie) * r(1 + n * (j - 1), ie) &
969 + s(i,2,1,1,ie) * r(2 + n * (j - 1), ie) &
970 + s(i,3,1,1,ie) * r(3 + n * (j - 1), ie) &
971 + s(i,4,1,1,ie) * r(4 + n * (j - 1), ie) &
972 + s(i,5,1,1,ie) * r(5 + n * (j - 1), ie) &
973 + s(i,6,1,1,ie) * r(6 + n * (j - 1), ie) &
974 + s(i,7,1,1,ie) * r(7 + n * (j - 1), ie) &
975 + s(i,8,1,1,ie) * r(8 + n * (j - 1), ie) &
976 + s(i,9,1,1,ie) * r(9 + n * (j - 1), ie) &
977 + s(i,10,1,1,ie) * r(10 + n * (j - 1), ie)
978 end do
979 end do
980 end do
981
982 do i = 1, n
983 do j = 1, n
984 do l = 1, n
985 do ie = 1, nelv
986 ii = l + n * (j - 1) + nn * (i - 1)
987 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
988 * s(1,j,2,2,ie) &
989 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
990 * s(2,j,2,2,ie) &
991 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
992 * s(3,j,2,2,ie) &
993 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
994 * s(4,j,2,2,ie) &
995 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
996 * s(5,j,2,2,ie) &
997 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
998 * s(6,j,2,2,ie) &
999 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
1000 * s(7,j,2,2,ie) &
1001 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
1002 * s(8,j,2,2,ie) &
1003 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
1004 * s(9,j,2,2,ie) &
1005 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
1006 * s(10,j,2,2,ie)
1007 end do
1008 end do
1009 end do
1010 end do
1011
1012 do j = 1, n
1013 do i = 1, nn
1014 do ie = 1, nelv
1015 jj = i + nn * (j - 1)
1016 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 2, 3, ie) &
1017 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 2, 3, ie) &
1018 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 2, 3, ie) &
1019 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 2, 3, ie) &
1020 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 2, 3, ie) &
1021 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 2, 3, ie) &
1022 + wrk2(i + nn * (7 - 1), ie) * s(7, j, 2, 3, ie) &
1023 + wrk2(i + nn * (8 - 1), ie) * s(8, j, 2, 3, ie) &
1024 + wrk2(i + nn * (9 - 1), ie) * s(9, j, 2, 3, ie) &
1025 + wrk2(i + nn * (10 - 1), ie) * s(10, j, 2, 3, ie)
1026 end do
1027 end do
1028 end do
1029
1030
1031 end subroutine fdm_do_fast_sx_nl10
1032
1033 subroutine fdm_do_fast_sx_nl9(e, r, s, d, nelv)
1034 integer, parameter :: n = 9
1035 integer, parameter :: nn = n**2
1036 integer, parameter :: nnn = n**3
1037 integer, intent(in) :: nelv
1038 real(kind=rp), intent(inout) :: e(n**3, nelv)
1039 real(kind=rp), intent(inout) :: r(n**3, nelv)
1040 real(kind=rp), intent(inout) :: s(n,n,2,3, nelv)
1041 real(kind=rp), intent(inout) :: d(n**3, nelv)
1042 real(kind=rp) :: wrk(n**3, nelv), wrk2(n**3, nelv)
1043 integer :: ie, i, j, l, ii, jj
1044
1045 do j = 1, nn
1046 do i = 1, n
1047 do ie = 1, nelv
1048 ii = i + n * (j - 1)
1049 wrk(ii, ie) = s(i,1,2,1,ie) * r(1 + n * (j - 1), ie) &
1050 + s(i,2,2,1,ie) * r(2 + n * (j - 1), ie) &
1051 + s(i,3,2,1,ie) * r(3 + n * (j - 1), ie) &
1052 + s(i,4,2,1,ie) * r(4 + n * (j - 1), ie) &
1053 + s(i,5,2,1,ie) * r(5 + n * (j - 1), ie) &
1054 + s(i,6,2,1,ie) * r(6 + n * (j - 1), ie) &
1055 + s(i,7,2,1,ie) * r(7 + n * (j - 1), ie) &
1056 + s(i,8,2,1,ie) * r(8 + n * (j - 1), ie) &
1057 + s(i,9,2,1,ie) * r(9 + n * (j - 1), ie)
1058 end do
1059 end do
1060 end do
1061
1062 do i = 1, n
1063 do j = 1, n
1064 do l = 1, n
1065 do ie = 1, nelv
1066 ii = l + n * (j - 1) + nn * (i - 1)
1067 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1068 * s(1,j,1,2,ie) &
1069 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1070 * s(2,j,1,2,ie) &
1071 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1072 * s(3,j,1,2,ie) &
1073 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1074 * s(4,j,1,2,ie) &
1075 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1076 * s(5,j,1,2,ie) &
1077 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
1078 * s(6,j,1,2,ie) &
1079 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
1080 * s(7,j,1,2,ie) &
1081 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
1082 * s(8,j,1,2,ie) &
1083 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
1084 * s(9,j,1,2,ie)
1085 end do
1086 end do
1087 end do
1088 end do
1089
1090 do j = 1, n
1091 do i = 1, nn
1092 do ie = 1, nelv
1093 jj = i + nn * (j - 1)
1094 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 1, 3, ie) &
1095 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 1, 3, ie) &
1096 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 1, 3, ie) &
1097 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 1, 3, ie) &
1098 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 1, 3, ie) &
1099 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 1, 3, ie) &
1100 + wrk2(i + nn * (7 - 1), ie) * s(7, j, 1, 3, ie) &
1101 + wrk2(i + nn * (8 - 1), ie) * s(8, j, 1, 3, ie) &
1102 + wrk2(i + nn * (9 - 1), ie) * s(9, j, 1, 3, ie)
1103 end do
1104 end do
1105 end do
1106
1107 do i = 1, nnn * nelv
1108 r(i,1) = d(i,1) * e(i,1)
1109 end do
1110
1111 do j = 1, nn
1112 do i = 1, n
1113 do ie = 1, nelv
1114 ii = i + n * (j - 1)
1115 wrk(ii, ie) = s(i,1,1,1,ie) * r(1 + n * (j - 1), ie) &
1116 + s(i,2,1,1,ie) * r(2 + n * (j - 1), ie) &
1117 + s(i,3,1,1,ie) * r(3 + n * (j - 1), ie) &
1118 + s(i,4,1,1,ie) * r(4 + n * (j - 1), ie) &
1119 + s(i,5,1,1,ie) * r(5 + n * (j - 1), ie) &
1120 + s(i,6,1,1,ie) * r(6 + n * (j - 1), ie) &
1121 + s(i,7,1,1,ie) * r(7 + n * (j - 1), ie) &
1122 + s(i,8,1,1,ie) * r(8 + n * (j - 1), ie) &
1123 + s(i,9,1,1,ie) * r(9 + n * (j - 1), ie)
1124 end do
1125 end do
1126 end do
1127
1128 do i = 1, n
1129 do j = 1, n
1130 do l = 1, n
1131 do ie = 1, nelv
1132 ii = l + n * (j - 1) + nn * (i - 1)
1133 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1134 * s(1,j,2,2,ie) &
1135 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1136 * s(2,j,2,2,ie) &
1137 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1138 * s(3,j,2,2,ie) &
1139 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1140 * s(4,j,2,2,ie) &
1141 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1142 * s(5,j,2,2,ie) &
1143 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
1144 * s(6,j,2,2,ie) &
1145 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
1146 * s(7,j,2,2,ie) &
1147 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
1148 * s(8,j,2,2,ie) &
1149 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
1150 * s(9,j,2,2,ie)
1151 end do
1152 end do
1153 end do
1154 end do
1155
1156 do j = 1, n
1157 do i = 1, nn
1158 do ie = 1, nelv
1159 jj = i + nn * (j - 1)
1160 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 2, 3, ie) &
1161 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 2, 3, ie) &
1162 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 2, 3, ie) &
1163 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 2, 3, ie) &
1164 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 2, 3, ie) &
1165 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 2, 3, ie) &
1166 + wrk2(i + nn * (7 - 1), ie) * s(7, j, 2, 3, ie) &
1167 + wrk2(i + nn * (8 - 1), ie) * s(8, j, 2, 3, ie) &
1168 + wrk2(i + nn * (9 - 1), ie) * s(9, j, 2, 3, ie)
1169 end do
1170 end do
1171 end do
1172
1173
1174 end subroutine fdm_do_fast_sx_nl9
1175
1176 subroutine fdm_do_fast_sx_nl8(e, r, s, d, nelv)
1177 integer, parameter :: n = 8
1178 integer, parameter :: nn = n**2
1179 integer, parameter :: nnn = n**3
1180 integer, intent(in) :: nelv
1181 real(kind=rp), intent(inout) :: e(n**3, nelv)
1182 real(kind=rp), intent(inout) :: r(n**3, nelv)
1183 real(kind=rp), intent(inout) :: s(n,n,2,3, nelv)
1184 real(kind=rp), intent(inout) :: d(n**3, nelv)
1185 real(kind=rp) :: wrk(n**3, nelv), wrk2(n**3, nelv)
1186 integer :: ie, i, j, l, ii, jj
1187
1188 do j = 1, nn
1189 do i = 1, n
1190 do ie = 1, nelv
1191 ii = i + n * (j - 1)
1192 wrk(ii, ie) = s(i,1,2,1,ie) * r(1 + n * (j - 1), ie) &
1193 + s(i,2,2,1,ie) * r(2 + n * (j - 1), ie) &
1194 + s(i,3,2,1,ie) * r(3 + n * (j - 1), ie) &
1195 + s(i,4,2,1,ie) * r(4 + n * (j - 1), ie) &
1196 + s(i,5,2,1,ie) * r(5 + n * (j - 1), ie) &
1197 + s(i,6,2,1,ie) * r(6 + n * (j - 1), ie) &
1198 + s(i,7,2,1,ie) * r(7 + n * (j - 1), ie) &
1199 + s(i,8,2,1,ie) * r(8 + n * (j - 1), ie)
1200 end do
1201 end do
1202 end do
1203
1204 do i = 1, n
1205 do j = 1, n
1206 do l = 1, n
1207 do ie = 1, nelv
1208 ii = l + n * (j - 1) + nn * (i - 1)
1209 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1210 * s(1,j,1,2,ie) &
1211 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1212 * s(2,j,1,2,ie) &
1213 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1214 * s(3,j,1,2,ie) &
1215 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1216 * s(4,j,1,2,ie) &
1217 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1218 * s(5,j,1,2,ie) &
1219 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
1220 * s(6,j,1,2,ie) &
1221 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
1222 * s(7,j,1,2,ie) &
1223 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
1224 * s(8,j,1,2,ie)
1225 end do
1226 end do
1227 end do
1228 end do
1229
1230 do j = 1, n
1231 do i = 1, nn
1232 do ie = 1, nelv
1233 jj = i + nn * (j - 1)
1234 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 1, 3, ie) &
1235 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 1, 3, ie) &
1236 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 1, 3, ie) &
1237 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 1, 3, ie) &
1238 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 1, 3, ie) &
1239 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 1, 3, ie) &
1240 + wrk2(i + nn * (7 - 1), ie) * s(7, j, 1, 3, ie) &
1241 + wrk2(i + nn * (8 - 1), ie) * s(8, j, 1, 3, ie)
1242 end do
1243 end do
1244 end do
1245
1246 do i = 1, nnn * nelv
1247 r(i,1) = d(i,1) * e(i,1)
1248 end do
1249
1250 do j = 1, nn
1251 do i = 1, n
1252 do ie = 1, nelv
1253 ii = i + n * (j - 1)
1254 wrk(ii, ie) = s(i,1,1,1,ie) * r(1 + n * (j - 1), ie) &
1255 + s(i,2,1,1,ie) * r(2 + n * (j - 1), ie) &
1256 + s(i,3,1,1,ie) * r(3 + n * (j - 1), ie) &
1257 + s(i,4,1,1,ie) * r(4 + n * (j - 1), ie) &
1258 + s(i,5,1,1,ie) * r(5 + n * (j - 1), ie) &
1259 + s(i,6,1,1,ie) * r(6 + n * (j - 1), ie) &
1260 + s(i,7,1,1,ie) * r(7 + n * (j - 1), ie) &
1261 + s(i,8,1,1,ie) * r(8 + n * (j - 1), ie)
1262 end do
1263 end do
1264 end do
1265
1266 do i = 1, n
1267 do j = 1, n
1268 do l = 1, n
1269 do ie = 1, nelv
1270 ii = l + n * (j - 1) + nn * (i - 1)
1271 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1272 * s(1,j,2,2,ie) &
1273 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1274 * s(2,j,2,2,ie) &
1275 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1276 * s(3,j,2,2,ie) &
1277 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1278 * s(4,j,2,2,ie) &
1279 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1280 * s(5,j,2,2,ie) &
1281 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
1282 * s(6,j,2,2,ie) &
1283 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
1284 * s(7,j,2,2,ie) &
1285 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
1286 * s(8,j,2,2,ie)
1287 end do
1288 end do
1289 end do
1290 end do
1291
1292 do j = 1, n
1293 do i = 1, nn
1294 do ie = 1, nelv
1295 jj = i + nn * (j - 1)
1296 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 2, 3, ie) &
1297 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 2, 3, ie) &
1298 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 2, 3, ie) &
1299 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 2, 3, ie) &
1300 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 2, 3, ie) &
1301 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 2, 3, ie) &
1302 + wrk2(i + nn * (7 - 1), ie) * s(7, j, 2, 3, ie) &
1303 + wrk2(i + nn * (8 - 1), ie) * s(8, j, 2, 3, ie)
1304 end do
1305 end do
1306 end do
1307
1308
1309 end subroutine fdm_do_fast_sx_nl8
1310
1311 subroutine fdm_do_fast_sx_nl7(e, r, s, d, nelv)
1312 integer, parameter :: n = 7
1313 integer, parameter :: nn = n**2
1314 integer, parameter :: nnn = n**3
1315 integer, intent(in) :: nelv
1316 real(kind=rp), intent(inout) :: e(n**3, nelv)
1317 real(kind=rp), intent(inout) :: r(n**3, nelv)
1318 real(kind=rp), intent(inout) :: s(n,n,2,3, nelv)
1319 real(kind=rp), intent(inout) :: d(n**3, nelv)
1320 real(kind=rp) :: wrk(n**3, nelv), wrk2(n**3, nelv)
1321 integer :: ie, i, j, l, ii, jj
1322
1323 do j = 1, nn
1324 do i = 1, n
1325 do ie = 1, nelv
1326 ii = i + n * (j - 1)
1327 wrk(ii, ie) = s(i,1,2,1,ie) * r(1 + n * (j - 1), ie) &
1328 + s(i,2,2,1,ie) * r(2 + n * (j - 1), ie) &
1329 + s(i,3,2,1,ie) * r(3 + n * (j - 1), ie) &
1330 + s(i,4,2,1,ie) * r(4 + n * (j - 1), ie) &
1331 + s(i,5,2,1,ie) * r(5 + n * (j - 1), ie) &
1332 + s(i,6,2,1,ie) * r(6 + n * (j - 1), ie) &
1333 + s(i,7,2,1,ie) * r(7 + n * (j - 1), ie)
1334 end do
1335 end do
1336 end do
1337
1338 do i = 1, n
1339 do j = 1, n
1340 do l = 1, n
1341 do ie = 1, nelv
1342 ii = l + n * (j - 1) + nn * (i - 1)
1343 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1344 * s(1,j,1,2,ie) &
1345 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1346 * s(2,j,1,2,ie) &
1347 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1348 * s(3,j,1,2,ie) &
1349 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1350 * s(4,j,1,2,ie) &
1351 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1352 * s(5,j,1,2,ie) &
1353 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
1354 * s(6,j,1,2,ie) &
1355 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
1356 * s(7,j,1,2,ie)
1357 end do
1358 end do
1359 end do
1360 end do
1361
1362 do j = 1, n
1363 do i = 1, nn
1364 do ie = 1, nelv
1365 jj = i + nn * (j - 1)
1366 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 1, 3, ie) &
1367 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 1, 3, ie) &
1368 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 1, 3, ie) &
1369 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 1, 3, ie) &
1370 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 1, 3, ie) &
1371 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 1, 3, ie) &
1372 + wrk2(i + nn * (7 - 1), ie) * s(7, j, 1, 3, ie)
1373 end do
1374 end do
1375 end do
1376
1377 do i = 1, nnn * nelv
1378 r(i,1) = d(i,1) * e(i,1)
1379 end do
1380
1381 do j = 1, nn
1382 do i = 1, n
1383 do ie = 1, nelv
1384 ii = i + n * (j - 1)
1385 wrk(ii, ie) = s(i,1,1,1,ie) * r(1 + n * (j - 1), ie) &
1386 + s(i,2,1,1,ie) * r(2 + n * (j - 1), ie) &
1387 + s(i,3,1,1,ie) * r(3 + n * (j - 1), ie) &
1388 + s(i,4,1,1,ie) * r(4 + n * (j - 1), ie) &
1389 + s(i,5,1,1,ie) * r(5 + n * (j - 1), ie) &
1390 + s(i,6,1,1,ie) * r(6 + n * (j - 1), ie) &
1391 + s(i,7,1,1,ie) * r(7 + n * (j - 1), ie)
1392 end do
1393 end do
1394 end do
1395
1396 do i = 1, n
1397 do j = 1, n
1398 do l = 1, n
1399 do ie = 1, nelv
1400 ii = l + n * (j - 1) + nn * (i - 1)
1401 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1402 * s(1,j,2,2,ie) &
1403 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1404 * s(2,j,2,2,ie) &
1405 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1406 * s(3,j,2,2,ie) &
1407 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1408 * s(4,j,2,2,ie) &
1409 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1410 * s(5,j,2,2,ie) &
1411 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
1412 * s(6,j,2,2,ie) &
1413 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
1414 * s(7,j,2,2,ie)
1415 end do
1416 end do
1417 end do
1418 end do
1419
1420 do j = 1, n
1421 do i = 1, nn
1422 do ie = 1, nelv
1423 jj = i + nn * (j - 1)
1424 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 2, 3, ie) &
1425 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 2, 3, ie) &
1426 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 2, 3, ie) &
1427 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 2, 3, ie) &
1428 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 2, 3, ie) &
1429 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 2, 3, ie) &
1430 + wrk2(i + nn * (7 - 1), ie) * s(7, j, 2, 3, ie)
1431 end do
1432 end do
1433 end do
1434
1435
1436 end subroutine fdm_do_fast_sx_nl7
1437
1438 subroutine fdm_do_fast_sx_nl6(e, r, s, d, nelv)
1439 integer, parameter :: n = 6
1440 integer, parameter :: nn = n**2
1441 integer, parameter :: nnn = n**3
1442 integer, intent(in) :: nelv
1443 real(kind=rp), intent(inout) :: e(n**3, nelv)
1444 real(kind=rp), intent(inout) :: r(n**3, nelv)
1445 real(kind=rp), intent(inout) :: s(n,n,2,3, nelv)
1446 real(kind=rp), intent(inout) :: d(n**3, nelv)
1447 real(kind=rp) :: wrk(n**3, nelv), wrk2(n**3, nelv)
1448 integer :: ie, i, j, l, ii, jj
1449
1450 do j = 1, nn
1451 do i = 1, n
1452 do ie = 1, nelv
1453 ii = i + n * (j - 1)
1454 wrk(ii, ie) = s(i,1,2,1,ie) * r(1 + n * (j - 1), ie) &
1455 + s(i,2,2,1,ie) * r(2 + n * (j - 1), ie) &
1456 + s(i,3,2,1,ie) * r(3 + n * (j - 1), ie) &
1457 + s(i,4,2,1,ie) * r(4 + n * (j - 1), ie) &
1458 + s(i,5,2,1,ie) * r(5 + n * (j - 1), ie) &
1459 + s(i,6,2,1,ie) * r(6 + n * (j - 1), ie)
1460 end do
1461 end do
1462 end do
1463
1464 do i = 1, n
1465 do j = 1, n
1466 do l = 1, n
1467 do ie = 1, nelv
1468 ii = l + n * (j - 1) + nn * (i - 1)
1469 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1470 * s(1,j,1,2,ie) &
1471 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1472 * s(2,j,1,2,ie) &
1473 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1474 * s(3,j,1,2,ie) &
1475 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1476 * s(4,j,1,2,ie) &
1477 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1478 * s(5,j,1,2,ie) &
1479 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
1480 * s(6,j,1,2,ie)
1481 end do
1482 end do
1483 end do
1484 end do
1485
1486 do j = 1, n
1487 do i = 1, nn
1488 do ie = 1, nelv
1489 jj = i + nn * (j - 1)
1490 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 1, 3, ie) &
1491 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 1, 3, ie) &
1492 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 1, 3, ie) &
1493 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 1, 3, ie) &
1494 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 1, 3, ie) &
1495 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 1, 3, ie)
1496 end do
1497 end do
1498 end do
1499
1500 do i = 1, nnn * nelv
1501 r(i,1) = d(i,1) * e(i,1)
1502 end do
1503
1504 do j = 1, nn
1505 do i = 1, n
1506 do ie = 1, nelv
1507 ii = i + n * (j - 1)
1508 wrk(ii, ie) = s(i,1,1,1,ie) * r(1 + n * (j - 1), ie) &
1509 + s(i,2,1,1,ie) * r(2 + n * (j - 1), ie) &
1510 + s(i,3,1,1,ie) * r(3 + n * (j - 1), ie) &
1511 + s(i,4,1,1,ie) * r(4 + n * (j - 1), ie) &
1512 + s(i,5,1,1,ie) * r(5 + n * (j - 1), ie) &
1513 + s(i,6,1,1,ie) * r(6 + n * (j - 1), ie)
1514 end do
1515 end do
1516 end do
1517
1518 do i = 1, n
1519 do j = 1, n
1520 do l = 1, n
1521 do ie = 1, nelv
1522 ii = l + n * (j - 1) + nn * (i - 1)
1523 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1524 * s(1,j,2,2,ie) &
1525 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1526 * s(2,j,2,2,ie) &
1527 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1528 * s(3,j,2,2,ie) &
1529 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1530 * s(4,j,2,2,ie) &
1531 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1532 * s(5,j,2,2,ie) &
1533 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
1534 * s(6,j,2,2,ie)
1535 end do
1536 end do
1537 end do
1538 end do
1539
1540 do j = 1, n
1541 do i = 1, nn
1542 do ie = 1, nelv
1543 jj = i + nn * (j - 1)
1544 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 2, 3, ie) &
1545 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 2, 3, ie) &
1546 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 2, 3, ie) &
1547 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 2, 3, ie) &
1548 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 2, 3, ie) &
1549 + wrk2(i + nn * (6 - 1), ie) * s(6, j, 2, 3, ie)
1550 end do
1551 end do
1552 end do
1553
1554
1555 end subroutine fdm_do_fast_sx_nl6
1556
1557 subroutine fdm_do_fast_sx_nl5(e, r, s, d, nelv)
1558 integer, parameter :: n = 5
1559 integer, parameter :: nn = n**2
1560 integer, parameter :: nnn = n**3
1561 integer, intent(in) :: nelv
1562 real(kind=rp), intent(inout) :: e(n**3, nelv)
1563 real(kind=rp), intent(inout) :: r(n**3, nelv)
1564 real(kind=rp), intent(inout) :: s(n,n,2,3, nelv)
1565 real(kind=rp), intent(inout) :: d(n**3, nelv)
1566 real(kind=rp) :: wrk(n**3, nelv), wrk2(n**3, nelv)
1567 integer :: ie, i, j, l, ii, jj
1568
1569 do j = 1, nn
1570 do i = 1, n
1571 do ie = 1, nelv
1572 ii = i + n * (j - 1)
1573 wrk(ii, ie) = s(i,1,2,1,ie) * r(1 + n * (j - 1), ie) &
1574 + s(i,2,2,1,ie) * r(2 + n * (j - 1), ie) &
1575 + s(i,3,2,1,ie) * r(3 + n * (j - 1), ie) &
1576 + s(i,4,2,1,ie) * r(4 + n * (j - 1), ie) &
1577 + s(i,5,2,1,ie) * r(5 + n * (j - 1), ie)
1578 end do
1579 end do
1580 end do
1581
1582 do i = 1, n
1583 do j = 1, n
1584 do l = 1, n
1585 do ie = 1, nelv
1586 ii = l + n * (j - 1) + nn * (i - 1)
1587 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1588 * s(1,j,1,2,ie) &
1589 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1590 * s(2,j,1,2,ie) &
1591 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1592 * s(3,j,1,2,ie) &
1593 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1594 * s(4,j,1,2,ie) &
1595 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1596 * s(5,j,1,2,ie)
1597 end do
1598 end do
1599 end do
1600 end do
1601
1602 do j = 1, n
1603 do i = 1, nn
1604 do ie = 1, nelv
1605 jj = i + nn * (j - 1)
1606 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 1, 3, ie) &
1607 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 1, 3, ie) &
1608 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 1, 3, ie) &
1609 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 1, 3, ie) &
1610 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 1, 3, ie)
1611 end do
1612 end do
1613 end do
1614
1615 do i = 1, nnn * nelv
1616 r(i,1) = d(i,1) * e(i,1)
1617 end do
1618
1619 do j = 1, nn
1620 do i = 1, n
1621 do ie = 1, nelv
1622 ii = i + n * (j - 1)
1623 wrk(ii, ie) = s(i,1,1,1,ie) * r(1 + n * (j - 1), ie) &
1624 + s(i,2,1,1,ie) * r(2 + n * (j - 1), ie) &
1625 + s(i,3,1,1,ie) * r(3 + n * (j - 1), ie) &
1626 + s(i,4,1,1,ie) * r(4 + n * (j - 1), ie) &
1627 + s(i,5,1,1,ie) * r(5 + n * (j - 1), ie)
1628 end do
1629 end do
1630 end do
1631
1632 do i = 1, n
1633 do j = 1, n
1634 do l = 1, n
1635 do ie = 1, nelv
1636 ii = l + n * (j - 1) + nn * (i - 1)
1637 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1638 * s(1,j,2,2,ie) &
1639 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1640 * s(2,j,2,2,ie) &
1641 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1642 * s(3,j,2,2,ie) &
1643 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1644 * s(4,j,2,2,ie) &
1645 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1646 * s(5,j,2,2,ie)
1647 end do
1648 end do
1649 end do
1650 end do
1651
1652 do j = 1, n
1653 do i = 1, nn
1654 do ie = 1, nelv
1655 jj = i + nn * (j - 1)
1656 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 2, 3, ie) &
1657 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 2, 3, ie) &
1658 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 2, 3, ie) &
1659 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 2, 3, ie) &
1660 + wrk2(i + nn * (5 - 1), ie) * s(5, j, 2, 3, ie)
1661 end do
1662 end do
1663 end do
1664
1665
1666 end subroutine fdm_do_fast_sx_nl5
1667
1668 subroutine fdm_do_fast_sx_nl4(e, r, s, d, nelv)
1669 integer, parameter :: n = 4
1670 integer, parameter :: nn = n**2
1671 integer, parameter :: nnn = n**3
1672 integer, intent(in) :: nelv
1673 real(kind=rp), intent(inout) :: e(n**3, nelv)
1674 real(kind=rp), intent(inout) :: r(n**3, nelv)
1675 real(kind=rp), intent(inout) :: s(n,n,2,3, nelv)
1676 real(kind=rp), intent(inout) :: d(n**3, nelv)
1677 real(kind=rp) :: wrk(n**3, nelv), wrk2(n**3, nelv)
1678 integer :: ie, i, j, l, ii, jj
1679
1680 do j = 1, nn
1681 do i = 1, n
1682 do ie = 1, nelv
1683 ii = i + n * (j - 1)
1684 wrk(ii, ie) = s(i,1,2,1,ie) * r(1 + n * (j - 1), ie) &
1685 + s(i,2,2,1,ie) * r(2 + n * (j - 1), ie) &
1686 + s(i,3,2,1,ie) * r(3 + n * (j - 1), ie) &
1687 + s(i,4,2,1,ie) * r(4 + n * (j - 1), ie)
1688 end do
1689 end do
1690 end do
1691
1692 do i = 1, n
1693 do j = 1, n
1694 do l = 1, n
1695 do ie = 1, nelv
1696 ii = l + n * (j - 1) + nn * (i - 1)
1697 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1698 * s(1,j,1,2,ie) &
1699 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1700 * s(2,j,1,2,ie) &
1701 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1702 * s(3,j,1,2,ie) &
1703 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1704 * s(4,j,1,2,ie)
1705 end do
1706 end do
1707 end do
1708 end do
1709
1710 do j = 1, n
1711 do i = 1, nn
1712 do ie = 1, nelv
1713 jj = i + nn * (j - 1)
1714 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 1, 3, ie) &
1715 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 1, 3, ie) &
1716 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 1, 3, ie) &
1717 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 1, 3, ie)
1718 end do
1719 end do
1720 end do
1721
1722 do i = 1, nnn * nelv
1723 r(i,1) = d(i,1) * e(i,1)
1724 end do
1725
1726 do j = 1, nn
1727 do i = 1, n
1728 do ie = 1, nelv
1729 ii = i + n * (j - 1)
1730 wrk(ii, ie) = s(i,1,1,1,ie) * r(1 + n * (j - 1), ie) &
1731 + s(i,2,1,1,ie) * r(2 + n * (j - 1), ie) &
1732 + s(i,3,1,1,ie) * r(3 + n * (j - 1), ie) &
1733 + s(i,4,1,1,ie) * r(4 + n * (j - 1), ie)
1734 end do
1735 end do
1736 end do
1737
1738 do i = 1, n
1739 do j = 1, n
1740 do l = 1, n
1741 do ie = 1, nelv
1742 ii = l + n * (j - 1) + nn * (i - 1)
1743 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1744 * s(1,j,2,2,ie) &
1745 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1746 * s(2,j,2,2,ie) &
1747 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1748 * s(3,j,2,2,ie) &
1749 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1750 * s(4,j,2,2,ie)
1751 end do
1752 end do
1753 end do
1754 end do
1755
1756 do j = 1, n
1757 do i = 1, nn
1758 do ie = 1, nelv
1759 jj = i + nn * (j - 1)
1760 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 2, 3, ie) &
1761 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 2, 3, ie) &
1762 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 2, 3, ie) &
1763 + wrk2(i + nn * (4 - 1), ie) * s(4, j, 2, 3, ie)
1764 end do
1765 end do
1766 end do
1767
1768
1769 end subroutine fdm_do_fast_sx_nl4
1770
1771 subroutine fdm_do_fast_sx_nl3(e, r, s, d, nelv)
1772 integer, parameter :: n = 3
1773 integer, parameter :: nn = n**2
1774 integer, parameter :: nnn = n**3
1775 integer, intent(in) :: nelv
1776 real(kind=rp), intent(inout) :: e(n**3, nelv)
1777 real(kind=rp), intent(inout) :: r(n**3, nelv)
1778 real(kind=rp), intent(inout) :: s(n,n,2,3, nelv)
1779 real(kind=rp), intent(inout) :: d(n**3, nelv)
1780 real(kind=rp) :: wrk(n**3, nelv), wrk2(n**3, nelv)
1781 integer :: ie, i, j, l, ii, jj
1782
1783 do j = 1, nn
1784 do i = 1, n
1785 do ie = 1, nelv
1786 ii = i + n * (j - 1)
1787 wrk(ii, ie) = s(i,1,2,1,ie) * r(1 + n * (j - 1), ie) &
1788 + s(i,2,2,1,ie) * r(2 + n * (j - 1), ie) &
1789 + s(i,3,2,1,ie) * r(3 + n * (j - 1), ie)
1790 end do
1791 end do
1792 end do
1793
1794 do i = 1, n
1795 do j = 1, n
1796 do l = 1, n
1797 do ie = 1, nelv
1798 ii = l + n * (j - 1) + nn * (i - 1)
1799 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1800 * s(1,j,1,2,ie) &
1801 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1802 * s(2,j,1,2,ie) &
1803 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1804 * s(3,j,1,2,ie)
1805 end do
1806 end do
1807 end do
1808 end do
1809
1810 do j = 1, n
1811 do i = 1, nn
1812 do ie = 1, nelv
1813 jj = i + nn * (j - 1)
1814 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 1, 3, ie) &
1815 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 1, 3, ie) &
1816 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 1, 3, ie)
1817 end do
1818 end do
1819 end do
1820
1821 do i = 1, nnn * nelv
1822 r(i,1) = d(i,1) * e(i,1)
1823 end do
1824
1825 do j = 1, nn
1826 do i = 1, n
1827 do ie = 1, nelv
1828 ii = i + n * (j - 1)
1829 wrk(ii, ie) = s(i,1,1,1,ie) * r(1 + n * (j - 1), ie) &
1830 + s(i,2,1,1,ie) * r(2 + n * (j - 1), ie) &
1831 + s(i,3,1,1,ie) * r(3 + n * (j - 1), ie)
1832 end do
1833 end do
1834 end do
1835
1836 do i = 1, n
1837 do j = 1, n
1838 do l = 1, n
1839 do ie = 1, nelv
1840 ii = l + n * (j - 1) + nn * (i - 1)
1841 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1842 * s(1,j,2,2,ie) &
1843 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1844 * s(2,j,2,2,ie) &
1845 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1846 * s(3,j,2,2,ie)
1847 end do
1848 end do
1849 end do
1850 end do
1851
1852 do j = 1, n
1853 do i = 1, nn
1854 do ie = 1, nelv
1855 jj = i + nn * (j - 1)
1856 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 2, 3, ie) &
1857 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 2, 3, ie) &
1858 + wrk2(i + nn * (3 - 1), ie) * s(3, j, 2, 3, ie)
1859 end do
1860 end do
1861 end do
1862
1863
1864 end subroutine fdm_do_fast_sx_nl3
1865
1866 subroutine fdm_do_fast_sx_nl2(e, r, s, d, nelv)
1867 integer, parameter :: n = 2
1868 integer, parameter :: nn = n**2
1869 integer, parameter :: nnn = n**3
1870 integer, intent(in) :: nelv
1871 real(kind=rp), intent(inout) :: e(n**3, nelv)
1872 real(kind=rp), intent(inout) :: r(n**3, nelv)
1873 real(kind=rp), intent(inout) :: s(n,n,2,3, nelv)
1874 real(kind=rp), intent(inout) :: d(n**3, nelv)
1875 real(kind=rp) :: wrk(n**3, nelv), wrk2(n**3, nelv)
1876 integer :: ie, i, j, l, ii, jj
1877
1878 do j = 1, nn
1879 do i = 1, n
1880 do ie = 1, nelv
1881 ii = i + n * (j - 1)
1882 wrk(ii, ie) = s(i,1,2,1,ie) * r(1 + n * (j - 1), ie) &
1883 + s(i,2,2,1,ie) * r(2 + n * (j - 1), ie)
1884 end do
1885 end do
1886 end do
1887
1888 do i = 1, n
1889 do j = 1, n
1890 do l = 1, n
1891 do ie = 1, nelv
1892 ii = l + n * (j - 1) + nn * (i - 1)
1893 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1894 * s(1,j,1,2,ie) &
1895 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1896 * s(2,j,1,2,ie)
1897 end do
1898 end do
1899 end do
1900 end do
1901
1902 do j = 1, n
1903 do i = 1, nn
1904 do ie = 1, nelv
1905 jj = i + nn * (j - 1)
1906 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 1, 3, ie) &
1907 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 1, 3, ie)
1908 end do
1909 end do
1910 end do
1911
1912 do i = 1, nnn * nelv
1913 r(i,1) = d(i,1) * e(i,1)
1914 end do
1915
1916 do j = 1, nn
1917 do i = 1, n
1918 do ie = 1, nelv
1919 ii = i + n * (j - 1)
1920 wrk(ii, ie) = s(i,1,1,1,ie) * r(1 + n * (j - 1), ie) &
1921 + s(i,2,1,1,ie) * r(2 + n * (j - 1), ie)
1922 end do
1923 end do
1924 end do
1925
1926 do i = 1, n
1927 do j = 1, n
1928 do l = 1, n
1929 do ie = 1, nelv
1930 ii = l + n * (j - 1) + nn * (i - 1)
1931 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1932 * s(1,j,2,2,ie) &
1933 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1934 * s(2,j,2,2,ie)
1935 end do
1936 end do
1937 end do
1938 end do
1939
1940 do j = 1, n
1941 do i = 1, nn
1942 do ie = 1, nelv
1943 jj = i + nn * (j - 1)
1944 e(jj,ie) = wrk2(i + nn * (1 - 1), ie) * s(1, j, 2, 3, ie) &
1945 + wrk2(i + nn * (2 - 1), ie) * s(2, j, 2, 3, ie)
1946 end do
1947 end do
1948 end do
1949
1950
1951 end subroutine fdm_do_fast_sx_nl2
1952
1953end module fdm_sx
fdm_sx
Fast Diagonalization SX-Aurora backend.
Definition fdm_sx.f90:34
fdm_sx::fdm_do_fast_sx_nl11
subroutine fdm_do_fast_sx_nl11(e, r, s, d, nelv)
Definition fdm_sx.f90:724
fdm_sx::fdm_do_fast_sx_nl9
subroutine fdm_do_fast_sx_nl9(e, r, s, d, nelv)
Definition fdm_sx.f90:1034
fdm_sx::fdm_do_fast_sx_nl8
subroutine fdm_do_fast_sx_nl8(e, r, s, d, nelv)
Definition fdm_sx.f90:1177
fdm_sx::fdm_do_fast_sx_nl4
subroutine fdm_do_fast_sx_nl4(e, r, s, d, nelv)
Definition fdm_sx.f90:1669
fdm_sx::fdm_do_fast_sx_nl10
subroutine fdm_do_fast_sx_nl10(e, r, s, d, nelv)
Definition fdm_sx.f90:883
fdm_sx::fdm_do_fast_sx_nl6
subroutine fdm_do_fast_sx_nl6(e, r, s, d, nelv)
Definition fdm_sx.f90:1439
fdm_sx::fdm_do_fast_sx
subroutine, public fdm_do_fast_sx(e, r, s, d, nl, ldim, nelv)
Definition fdm_sx.f90:45
fdm_sx::fdm_do_fast_sx_nl2
subroutine fdm_do_fast_sx_nl2(e, r, s, d, nelv)
Definition fdm_sx.f90:1867
fdm_sx::fdm_do_fast_sx_nl13
subroutine fdm_do_fast_sx_nl13(e, r, s, d, nelv)
Definition fdm_sx.f90:382
fdm_sx::fdm_do_fast_sx_nl14
subroutine fdm_do_fast_sx_nl14(e, r, s, d, nelv)
Definition fdm_sx.f90:199
fdm_sx::fdm_do_fast_sx_nl12
subroutine fdm_do_fast_sx_nl12(e, r, s, d, nelv)
Definition fdm_sx.f90:557
fdm_sx::fdm_do_fast_sx_nl
subroutine fdm_do_fast_sx_nl(e, r, s, d, nelv, n)
Definition fdm_sx.f90:96
fdm_sx::fdm_do_fast_sx_nl3
subroutine fdm_do_fast_sx_nl3(e, r, s, d, nelv)
Definition fdm_sx.f90:1772
fdm_sx::fdm_do_fast_sx_nl5
subroutine fdm_do_fast_sx_nl5(e, r, s, d, nelv)
Definition fdm_sx.f90:1558
fdm_sx::fdm_do_fast_sx_nl7
subroutine fdm_do_fast_sx_nl7(e, r, s, d, nelv)
Definition fdm_sx.f90:1312
num_types
Definition num_types.f90:1
num_types::rp
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
tensor_sx
Tensor operations SX-Aurora backend.
Definition tensor_sx.f90:2
tensor_sx::tnsr2d_el_sx
subroutine, public tnsr2d_el_sx(v, nv, u, nu, a, bt)
Definition tensor_sx.f90:13