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)
53 if(.not. ldim .eq. 3)
then
55 call tnsr2d_el_sx(e(1,ie), nl, r(1,ie), nl, s(1,2,1,ie), s(1,1,2,ie))
57 r(i,ie) = d(i,ie) * e(i,ie)
59 call tnsr2d_el_sx(e(1,ie), nl, r(1,ie), nl, s(1,1,1,ie), s(1,2,2,ie))
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
114 tmp = tmp + s(i,k,2,1,ie) * r(k + n * (j - 1), ie)
125 ii = l + n * (j - 1) + nn * (i - 1)
128 tmp = tmp + wrk(l + n * (k - 1) + nn * (i - 1), ie) &
140 jj = i + nn * (j - 1)
143 tmp = tmp + wrk2(i + nn * (k - 1), ie) * s(k, j, 1, 3, ie)
151 r(i,1) = d(i,1) * e(i,1)
160 tmp = tmp + s(i,k,1,1,ie) * r(k + n * (j - 1), ie)
171 ii = l + n * (j - 1) + nn * (i - 1)
174 tmp = tmp + wrk(l + n * (k - 1) + nn * (i - 1), ie) &
186 jj = i + nn * (j - 1)
189 tmp = tmp + wrk2(i + nn * (k - 1), ie) * s(k, j, 2, 3, ie)
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
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)
236 ii = l + n * (j - 1) + nn * (i - 1)
237 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
239 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
241 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
243 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
245 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
247 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
249 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
251 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
253 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
255 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
257 + wrk(l + n * (11 - 1) + nn * (i - 1), ie) &
259 + wrk(l + n * (12 - 1) + nn * (i - 1), ie) &
261 + wrk(l + n * (13 - 1) + nn * (i - 1), ie) &
263 + wrk(l + n * (14 - 1) + nn * (i - 1), ie) &
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)
293 r(i,1) = d(i,1) * e(i,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)
322 ii = l + n * (j - 1) + nn * (i - 1)
323 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
325 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
327 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
329 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
331 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
333 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
335 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
337 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
339 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
341 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
343 + wrk(l + n * (11 - 1) + nn * (i - 1), ie) &
345 + wrk(l + n * (12 - 1) + nn * (i - 1), ie) &
347 + wrk(l + n * (13 - 1) + nn * (i - 1), ie) &
349 + wrk(l + n * (14 - 1) + nn * (i - 1), ie) &
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)
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
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)
418 ii = l + n * (j - 1) + nn * (i - 1)
419 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
421 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
423 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
425 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
427 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
429 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
431 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
433 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
435 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
437 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
439 + wrk(l + n * (11 - 1) + nn * (i - 1), ie) &
441 + wrk(l + n * (12 - 1) + nn * (i - 1), ie) &
443 + wrk(l + n * (13 - 1) + nn * (i - 1), ie) &
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)
472 r(i,1) = d(i,1) * e(i,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)
500 ii = l + n * (j - 1) + nn * (i - 1)
501 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
503 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
505 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
507 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
509 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
511 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
513 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
515 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
517 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
519 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
521 + wrk(l + n * (11 - 1) + nn * (i - 1), ie) &
523 + wrk(l + n * (12 - 1) + nn * (i - 1), ie) &
525 + wrk(l + n * (13 - 1) + nn * (i - 1), ie) &
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)
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
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)
592 ii = l + n * (j - 1) + nn * (i - 1)
593 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
595 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
597 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
599 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
601 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
603 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
605 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
607 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
609 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
611 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
613 + wrk(l + n * (11 - 1) + nn * (i - 1), ie) &
615 + wrk(l + n * (12 - 1) + nn * (i - 1), ie) &
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)
643 r(i,1) = d(i,1) * e(i,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)
670 ii = l + n * (j - 1) + nn * (i - 1)
671 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
673 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
675 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
677 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
679 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
681 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
683 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
685 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
687 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
689 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
691 + wrk(l + n * (11 - 1) + nn * (i - 1), ie) &
693 + wrk(l + n * (12 - 1) + nn * (i - 1), ie) &
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)
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
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)
758 ii = l + n * (j - 1) + nn * (i - 1)
759 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
761 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
763 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
765 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
767 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
769 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
771 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
773 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
775 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
777 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
779 + wrk(l + n * (11 - 1) + nn * (i - 1), ie) &
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)
806 r(i,1) = d(i,1) * e(i,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)
832 ii = l + n * (j - 1) + nn * (i - 1)
833 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
835 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
837 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
839 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
841 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
843 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
845 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
847 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
849 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
851 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
853 + wrk(l + n * (11 - 1) + nn * (i - 1), ie) &
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)
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
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)
916 ii = l + n * (j - 1) + nn * (i - 1)
917 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
919 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
921 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
923 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
925 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
927 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
929 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
931 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
933 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
935 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
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)
961 r(i,1) = d(i,1) * e(i,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)
986 ii = l + n * (j - 1) + nn * (i - 1)
987 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
989 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
991 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
993 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
995 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
997 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
999 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
1001 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
1003 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
1005 + wrk(l + n * (10 - 1) + nn * (i - 1), ie) &
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)
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
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)
1066 ii = l + n * (j - 1) + nn * (i - 1)
1067 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1069 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1071 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1073 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1075 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1077 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
1079 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
1081 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
1083 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
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)
1107 do i = 1, nnn * nelv
1108 r(i,1) = d(i,1) * e(i,1)
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)
1132 ii = l + n * (j - 1) + nn * (i - 1)
1133 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1135 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1137 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1139 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1141 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1143 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
1145 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
1147 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
1149 + wrk(l + n * (9 - 1) + nn * (i - 1), ie) &
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)
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
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)
1208 ii = l + n * (j - 1) + nn * (i - 1)
1209 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1211 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1213 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1215 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1217 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1219 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
1221 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
1223 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
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)
1246 do i = 1, nnn * nelv
1247 r(i,1) = d(i,1) * e(i,1)
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)
1270 ii = l + n * (j - 1) + nn * (i - 1)
1271 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1273 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1275 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1277 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1279 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1281 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
1283 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
1285 + wrk(l + n * (8 - 1) + nn * (i - 1), ie) &
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)
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
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)
1342 ii = l + n * (j - 1) + nn * (i - 1)
1343 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1345 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1347 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1349 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1351 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1353 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
1355 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
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)
1377 do i = 1, nnn * nelv
1378 r(i,1) = d(i,1) * e(i,1)
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)
1400 ii = l + n * (j - 1) + nn * (i - 1)
1401 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1403 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1405 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1407 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1409 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1411 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
1413 + wrk(l + n * (7 - 1) + nn * (i - 1), ie) &
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)
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
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)
1468 ii = l + n * (j - 1) + nn * (i - 1)
1469 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1471 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1473 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1475 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1477 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1479 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
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)
1500 do i = 1, nnn * nelv
1501 r(i,1) = d(i,1) * e(i,1)
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)
1522 ii = l + n * (j - 1) + nn * (i - 1)
1523 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1525 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1527 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1529 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1531 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
1533 + wrk(l + n * (6 - 1) + nn * (i - 1), ie) &
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)
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
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)
1586 ii = l + n * (j - 1) + nn * (i - 1)
1587 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1589 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1591 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1593 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1595 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
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)
1615 do i = 1, nnn * nelv
1616 r(i,1) = d(i,1) * e(i,1)
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)
1636 ii = l + n * (j - 1) + nn * (i - 1)
1637 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1639 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1641 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1643 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
1645 + wrk(l + n * (5 - 1) + nn * (i - 1), ie) &
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)
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
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)
1696 ii = l + n * (j - 1) + nn * (i - 1)
1697 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1699 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1701 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1703 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
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)
1722 do i = 1, nnn * nelv
1723 r(i,1) = d(i,1) * e(i,1)
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)
1742 ii = l + n * (j - 1) + nn * (i - 1)
1743 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1745 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1747 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
1749 + wrk(l + n * (4 - 1) + nn * (i - 1), ie) &
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)
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
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)
1798 ii = l + n * (j - 1) + nn * (i - 1)
1799 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1801 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1803 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
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)
1821 do i = 1, nnn * nelv
1822 r(i,1) = d(i,1) * e(i,1)
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)
1840 ii = l + n * (j - 1) + nn * (i - 1)
1841 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1843 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
1845 + wrk(l + n * (3 - 1) + nn * (i - 1), ie) &
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)
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
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)
1892 ii = l + n * (j - 1) + nn * (i - 1)
1893 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1895 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
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)
1912 do i = 1, nnn * nelv
1913 r(i,1) = d(i,1) * e(i,1)
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)
1930 ii = l + n * (j - 1) + nn * (i - 1)
1931 wrk2(ii,ie) = wrk(l + n * (1 - 1) + nn * (i - 1), ie) &
1933 + wrk(l + n * (2 - 1) + nn * (i - 1), ie) &
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)
Fast Diagonalization SX-Aurora backend.
subroutine fdm_do_fast_sx_nl11(e, r, s, d, nelv)
subroutine fdm_do_fast_sx_nl9(e, r, s, d, nelv)
subroutine fdm_do_fast_sx_nl8(e, r, s, d, nelv)
subroutine fdm_do_fast_sx_nl4(e, r, s, d, nelv)
subroutine fdm_do_fast_sx_nl10(e, r, s, d, nelv)
subroutine fdm_do_fast_sx_nl6(e, r, s, d, nelv)
subroutine, public fdm_do_fast_sx(e, r, s, d, nl, ldim, nelv)
subroutine fdm_do_fast_sx_nl2(e, r, s, d, nelv)
subroutine fdm_do_fast_sx_nl13(e, r, s, d, nelv)
subroutine fdm_do_fast_sx_nl14(e, r, s, d, nelv)
subroutine fdm_do_fast_sx_nl12(e, r, s, d, nelv)
subroutine fdm_do_fast_sx_nl(e, r, s, d, nelv, n)
subroutine fdm_do_fast_sx_nl3(e, r, s, d, nelv)
subroutine fdm_do_fast_sx_nl5(e, r, s, d, nelv)
subroutine fdm_do_fast_sx_nl7(e, r, s, d, nelv)
integer, parameter, public rp
Global precision used in computations.
Tensor operations SX-Aurora backend.
subroutine, public tnsr2d_el_sx(v, nv, u, nu, A, Bt)