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