Lines Matching +full:- +full:e
1 C Copyright (c) 2017-2026, Lawrence Livermore National Security, LLC and other CEED contributors
2 C All Rights Reserved. See the top-level COPYRIGHT and NOTICE files for details.
4 C SPDX-License-Identifier: (BSD-2-Clause)
10 C_TESTARGS(name="BP1") -c {ceed_resource} -e bp1 -n 1 -b 4 -test
11 C_TESTARGS(name="BP3") -c {ceed_resource} -e bp3 -n 1 -b 4 -test
13 C-----------------------------------------------------------------------
44 g11 = (a22*a33-a23*a32)
45 g12 = (a13*a32-a33*a12)
46 g13 = (a12*a23-a22*a13)
48 g21 = (a23*a31-a21*a33)
49 g22 = (a11*a33-a31*a13)
50 g23 = (a13*a21-a23*a11)
52 g31 = (a21*a32-a22*a31)
53 g32 = (a12*a31-a32*a11)
54 g33 = (a11*a22-a21*a12)
70 C-----------------------------------------------------------------------
89 C-----------------------------------------------------------------------
130 g11 = (a22*a33-a23*a32)
131 g12 = (a13*a32-a33*a12)
132 g13 = (a12*a23-a22*a13)
134 g21 = (a23*a31-a21*a33)
135 g22 = (a11*a33-a31*a13)
136 g23 = (a13*a21-a23*a11)
138 g31 = (a21*a32-a22*a31)
139 g32 = (a12*a31-a32*a11)
140 g33 = (a11*a22-a21*a12)
169 C-----------------------------------------------------------------------
193 C-----------------------------------------------------------------------
201 integer e,i,L
208 do e=1,lelt
217 C-----------------------------------------------------------------------
218 subroutine dist_fld_h1(e)
220 C Input: Output: e
224 real*8 e(1)
233 e(i) = dsqrt(x*x+y*y+z*z)
236 call dsavg(e) ! This is requisite for random fields
240 C-----------------------------------------------------------------------
241 subroutine sin_fld_h1(e)
243 C Input: Output: e
247 real*8 e(1)
265 e(i) = dsin(pi*(c(1)+k(1)*x))
271 call dsavg(e) ! This is requisite for random fields
275 C-----------------------------------------------------------------------
280 integer e,f,eg
281 C e = gllel(eg)
288 C-----------------------------------------------------------------------
297 integer e,f,eg
298 C e = gllel(eg)
306 C-----------------------------------------------------------------------
311 integer e,f,eg
312 e = gllel(eg)
318 C-----------------------------------------------------------------------
324 integer e,f,eg
333 C-----------------------------------------------------------------------
338 integer e,f,eg
347 C-----------------------------------------------------------------------
354 C-----------------------------------------------------------------------
369 C-----------------------------------------------------------------------
376 C-----------------------------------------------------------------------
391 C-----------------------------------------------------------------------
393 C Compute Linfty norm of (x-y)
402 diff=abs(x(i)-y(i))
415 glrdif = -dmx ! Negative indicates something strange
420 C-----------------------------------------------------------------------
439 c-----------------------------------------------------------------------
462 C-----------------------------------------------------------------------
465 C (Gauss-Legendre Lobatto mesh).
469 parameter (lg=3+3*(ldim-2),lzq=lx1+1,lxyd=lzq**ldim)
480 integer e
500 nxqm1 = lzq-1
502 do e=1,nelt
503 call intp_rstd (tmp,xm1(1,1,1,e),lx1,lzq,if3d,0) ! 0-->Fwd interpolation
506 call intp_rstd (tmp,ym1(1,1,1,e),lx1,lzq,if3d,0)
509 call intp_rstd (tmp,zm1(1,1,1,e),lx1,lzq,if3d,0)
525 g11 = (a22*a33-a23*a32)
526 g12 = (a13*a32-a33*a12)
527 g13 = (a12*a23-a22*a13)
529 g21 = (a23*a31-a21*a33)
530 g22 = (a11*a33-a31*a13)
531 g23 = (a13*a21-a23*a11)
533 g31 = (a21*a32-a22*a31)
534 g32 = (a12*a31-a32*a11)
535 g33 = (a11*a22-a21*a12)
539 bmq(i,e) = w3mq(i,1,1)*jacmq
542 gf(1,i,e) = scale*(g11*g11+g12*g12+g13*g13) ! Grr
543 gf(2,i,e) = scale*(g11*g21+g12*g22+g13*g23) ! Grs
544 gf(3,i,e) = scale*(g11*g31+g12*g32+g13*g33) ! Grt
545 gf(4,i,e) = scale*(g21*g21+g22*g22+g23*g23) ! Gss
546 gf(5,i,e) = scale*(g21*g31+g22*g32+g23*g33) ! Gst
547 gf(6,i,e) = scale*(g31*g31+g32*g32+g33*g33) ! Gtt
554 C-----------------------------------------------------------------------
561 parameter (lxyz=lx1*ly1*lz1,lg=3+3*(ldim-2))
564 integer e
582 do 1000 e=1,nel
584 call rzero(d(1,1,1,e),nxyz)
590 d(ix,iy,iz,e) = d(ix,iy,iz,e)
591 $ + gf(1,iq,iy,iz,e) * dxm1(iq,ix)**2
592 $ + gf(2,ix,iq,iz,e) * dxm1(iq,iy)**2
593 $ + gf(3,ix,iy,iq,e) * dxm1(iq,iz)**2
600 do i2=1,ly1,ly1-1
601 do i1=1,lx1,lx1-1
602 d(1,i1,i2,e) = d(1,i1,i2,e)
603 $ + gf(4,1,i1,i2,e) * dxtm1(1,1)*dytm1(i1,i1)
604 $ + gf(5,1,i1,i2,e) * dxtm1(1,1)*dztm1(i2,i2)
605 d(lx1,i1,i2,e) = d(lx1,i1,i2,e)
606 $ + gf(4,lx1,i1,i2,e) * dxtm1(lx1,lx1)*dytm1(i1,i1)
607 $ + gf(5,lx1,i1,i2,e) * dxtm1(lx1,lx1)*dztm1(i2,i2)
608 d(i1,1,i2,e) = d(i1,1,i2,e)
609 $ + gf(4,i1,1,i2,e) * dytm1(1,1)*dxtm1(i1,i1)
610 $ + gf(6,i1,1,i2,e) * dytm1(1,1)*dztm1(i2,i2)
611 d(i1,ly1,i2,e) = d(i1,ly1,i2,e)
612 $ + gf(4,i1,ly1,i2,e) * dytm1(ly1,ly1)*dxtm1(i1,i1)
613 $ + gf(6,i1,ly1,i2,e) * dytm1(ly1,ly1)*dztm1(i2,i2)
614 d(i1,i2,1,e) = d(i1,i2,1,e)
615 $ + gf(5,i1,i2,1,e) * dztm1(1,1)*dxtm1(i1,i1)
616 $ + gf(6,i1,i2,1,e) * dztm1(1,1)*dytm1(i2,i2)
617 d(i1,i2,lz1,e) = d(i1,i2,lz1,e)
618 $ + gf(5,i1,i2,lz1,e) * dztm1(lz1,lz1)*dxtm1(i1,i1)
619 $ + gf(6,i1,i2,lz1,e) * dztm1(lz1,lz1)*dytm1(i2,i2)
626 d(i,1,1,e)=d(i,1,1,e)*h1(i,e)+h2(i,e)*bm1(i,1,1,e)
634 do 1200 e=1,nel
635 if (ifrzer(e)) call mxm(ym1(1,1,1,e),lx1,datm1,ly1,ysm1,1)
640 if (ym1(i,j,1,e).ne.0.) then
641 term1 = bm1(i,j,1,e)/ym1(i,j,1,e)**2
642 if (ifrzer(e)) then
644 $ *jacm1(i,1,1,e)/ysm1(i)
648 d(i,j,1,e) = d(i,j,1,e) + h1(k,e)*(term1+term2)
662 C-----------------------------------------------------------------------
676 C-----------------------------------------------------------------------
695 C-----------------------------------------------------------------------
705 parameter (lx=lx1*ly1*lz1,lg=3+3*(ldim-2),lq=lzq**ldim)
740 do j=0,nelt-1
767 tol = 1e-10
886 telaps = (tstop-tstart)
895 if (dabs(er1)>5e-3) then
900 nx = nx1-1
905 dofps = nnode/telaps ! DOF/sec - scalar form
921 telaps = (tstop-tstart)
930 if (dabs(er1)>1e-5) then
935 nx = nx1-1
940 dofps = nnode/telaps ! DOF/sec - scalar form
956 telaps = (tstop-tstart)
965 if (dabs(er1)>1e-5) then
970 nx = nx1-1
975 dofps = nnode/telaps ! DOF/sec - scalar form
1004 C-----------------------------------------------------------------------
1014 parameter (lx=lx1*ly1*lz1,lg=3+3*(ldim-2),lq=lzq**ldim)
1050 do j=0,nelt-1
1084 tol = 1e-10
1208 telaps = (tstop-tstart)
1217 if (dabs(er1)>1e-3) then
1222 nx = nx1-1
1227 dofps = nnode/telaps ! DOF/sec - scalar form
1243 telaps = (tstop-tstart)
1252 if (dabs(er1)>1e-9) then
1257 nx = nx1-1
1262 dofps = nnode/telaps ! DOF/sec - scalar form
1278 telaps = (tstop-tstart)
1287 if (dabs(er1)>1e-9) then
1292 nx = nx1-1
1297 dofps = nnode/telaps ! DOF/sec - scalar form
1326 C-----------------------------------------------------------------------
1339 C INPUT: rhs1 - rhs
1340 C h1 - exact solution
1357 nx = nx1-1 ! Polynomial order (just for i/o)
1362 call setprecn_bp3(dpc,h1,h2) ! Set up diagional pre-conidtioner
1364 call setprecn_bp1(dpc,h1,h2) ! Set up diagional pre-conidtioner
1371 s=rmult(i) ! -1
1389 r1(i)=r1(i)-alph(1)*ap1(i)
1424 iter = iter-1
1435 C-----------------------------------------------------------------------
1446 parameter (lx=lx1*ly1*lz1,lg=3+3*(ldim-2))
1455 integer i,e
1472 do e=1,nelt
1474 pap(1)=pap(1)+ap1(i,e)*p1(i,e)
1480 C-----------------------------------------------------------------------
1482 C Local matrix-vector for solution of BP3 (stiffness matrix)
1487 parameter (lxyz=lx1*ly1*lz1,lg=3+3*(ldim-2))
1495 call intp_rstd (ju,u,lx1,nxq,if3d,0) ! 0 --> Fwd interpolation
1499 call intp_rstd (w,ju,lx1,nxq,if3d,1) ! 1 --> ju-->u
1503 C-----------------------------------------------------------------------
1510 parameter (lx=lx1*ly1*lz1,lg=3+3*(ldim-2))
1522 integer e
1529 do e=1,nelt
1531 call ax_e_bp1(ap1(1,e),p1(1,e),gf(1,1,e),h1(1,e),h2(k,1)
1532 $ ,bm1(1,1,1,e),ur,us,ut)
1534 pap(1)=pap(1)+ap1(i,e)*p1(i,e)
1542 C-----------------------------------------------------------------------
1544 C Local matrix-vector for solution of BP3 (stiffness matrix)
1557 n = lzq-1
1559 call intp_rstd (wk,u,lx1,lzq,if3d,0) ! 0 --> Fwd interpolation
1572 call intp_rstd (w,wk,lx1,lzq,if3d,1) ! 1 --> ju-->u
1576 C-----------------------------------------------------------------------
1584 parameter (lx=lx1*ly1*lz1,lg=3+3*(ldim-2),lq=lzq**ldim)
1595 integer e
1599 do e=1,nelt
1601 call ax_e_bp3(ap1(1,e),p1(1,e),gf(1,1,e),ur,us,ut,wk)
1603 pap(1)=pap(1)+p1(i,e)*ap1(i,e)
1610 C-----------------------------------------------------------------------
1639 C-----------------------------------------------------------------------
1658 C-----------------------------------------------------------------------
1672 C-----------------------------------------------------------------------
1689 C-----------------------------------------------------------------------