Small improvement for 2DCyl

Nothing important, but overhead in dPsi has been reduced.
This commit is contained in:
Jorge Gonzalez 2023-01-05 18:47:33 +01:00
commit 26bd73597d
2 changed files with 153 additions and 249 deletions

View file

@ -65,14 +65,13 @@ MODULE moduleMesh2DCart
!Connectivity to adjacent elements
CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL(), e3 => NULL(), e4 => NULL()
REAL(8):: arNodes(1:4) = 0.D0
CONTAINS
PROCEDURE, PASS:: init => initCellQuad2DCart
PROCEDURE, PASS:: randPos => randPosCellQuad
PROCEDURE, PASS:: area => areaQuad
PROCEDURE, PASS:: fPsi => fPsiQuad
PROCEDURE, PASS:: dPsi => dPsiQuad
PROCEDURE, NOPASS, PRIVATE:: dPsiXi1 => dPsiQuadXi1
PROCEDURE, NOPASS, PRIVATE:: dPsiXi2 => dPsiQuadXi2
PROCEDURE, PASS:: fPsi => fPsiQuad
PROCEDURE, PASS:: dPsi => dPsiQuad
PROCEDURE, PASS, PRIVATE:: partialDer => partialDerQuad
PROCEDURE, PASS:: elemK => elemKQuad
PROCEDURE, PASS:: elemF => elemFQuad
@ -99,11 +98,9 @@ MODULE moduleMesh2DCart
PROCEDURE, PASS:: init => initCellTria2DCart
PROCEDURE, PASS:: randPos => randPosCellTria
PROCEDURE, PASS:: area => areaTria
PROCEDURE, PASS:: fPsi => fPsiTria
PROCEDURE, PASS:: dPsi => dPsiTria
PROCEDURE, NOPASS:: dPsiXi1 => dPsiTriaXi1
PROCEDURE, NOPASS:: dPsiXi2 => dPsiTriaXi2
PROCEDURE, PASS:: partialDer => partialDerTria
PROCEDURE, PASS:: fPsi => fPsiTria
PROCEDURE, PASS:: dPsi => dPsiTria
PROCEDURE, PASS, PRIVATE:: partialDer => partialDerTria
PROCEDURE, PASS:: elemK => elemKTria
PROCEDURE, PASS:: elemF => elemFTria
PROCEDURE, PASS:: gatherElectricField => gatherEFTria
@ -196,28 +193,6 @@ MODULE moduleMesh2DCart
END SUBROUTINE initEdge2DCart
!Random position in quadrilateral volume
FUNCTION randPosCellQuad(self) RESULT(r)
USE moduleRandom
IMPLICIT NONE
CLASS(meshCell2DCartQuad), INTENT(in):: self
REAL(8):: r(1:3)
REAL(8):: Xi(1:3)
REAL(8):: fPsi(1:4)
Xi(1) = random(-1.D0, 1.D0)
Xi(2) = random(-1.D0, 1.D0)
Xi(3) = 0.D0
fPsi = self%fPsi(Xi)
r(1) = DOT_PRODUCT(fPsi, self%x)
r(2) = DOT_PRODUCT(fPsi, self%y)
r(3) = 0.D0
END FUNCTION randposCellQuad
!Get nodes from edge
PURE FUNCTION getNodes2DCart(self) RESULT(n)
IMPLICIT NONE
@ -225,6 +200,7 @@ MODULE moduleMesh2DCart
CLASS(meshEdge2DCart), INTENT(in):: self
INTEGER, ALLOCATABLE:: n(:)
ALLOCATE(n(1:2))
n = (/self%n1%n, self%n2%n /)
END FUNCTION getNodes2DCart
@ -354,41 +330,21 @@ MODULE moduleMesh2DCart
dPsi = 0.D0
dPsi(1,:) = dPsiQuadXi1(Xi(2))
dPsi(2,:) = dPsiQuadXi2(Xi(1))
dPsi(1,:) = (/ -(1.D0 - Xi(2)), &
(1.D0 - Xi(2)), &
(1.D0 + Xi(2)), &
-(1.D0 + Xi(2)) /)
dPsi(2,:) = (/ -(1.D0 - Xi(1)), &
-(1.D0 + Xi(1)), &
(1.D0 + Xi(1)), &
(1.D0 - Xi(1)) /)
dPsi = dPsi * 0.25D0
END FUNCTION dPsiQuad
!Derivative element function (Xi1)
PURE FUNCTION dPsiQuadXi1(Xi2) RESULT(dPsiXi1)
IMPLICIT NONE
REAL(8),INTENT(in):: Xi2
REAL(8):: dPsiXi1(1:4)
dPsiXi1(1) = -(1.D0-Xi2)
dPsiXi1(2) = (1.D0-Xi2)
dPsiXi1(3) = (1.D0+Xi2)
dPsiXi1(4) = -(1.D0+Xi2)
dPsiXi1 = dPsiXi1*0.25D0
END FUNCTION dPsiQuadXi1
!Derivative element function (Xi2)
PURE FUNCTION dPsiQuadXi2(Xi1) RESULT(dPsiXi2)
IMPLICIT NONE
REAL(8),INTENT(in):: Xi1
REAL(8):: dPsiXi2(1:4)
dPsiXi2(1) = -(1.D0-Xi1)
dPsiXi2(2) = -(1.D0+Xi1)
dPsiXi2(3) = (1.D0+Xi1)
dPsiXi2(4) = (1.D0-Xi1)
dPsiXi2 = dPsiXi2*0.25D0
END FUNCTION dPsiQuadXi2
!Partial derivative in global coordinates
PURE SUBROUTINE partialDerQuad(self, dPsi, dx, dy)
IMPLICIT NONE
@ -396,13 +352,35 @@ MODULE moduleMesh2DCart
REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes)
REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy
dx(1) = DOT_PRODUCT(dPsi(1,:),self%x)
dx(2) = DOT_PRODUCT(dPsi(2,:),self%x)
dy(1) = DOT_PRODUCT(dPsi(1,:),self%y)
dy(2) = DOT_PRODUCT(dPsi(2,:),self%y)
dx = (/ DOT_PRODUCT(dPsi(1,1:4),self%x(1:4)), &
DOT_PRODUCT(dPsi(2,1:4),self%x(1:4)) /)
dy = (/ DOT_PRODUCT(dPsi(1,1:4),self%y(1:4)), &
DOT_PRODUCT(dPsi(2,1:4),self%y(1:4)) /)
END SUBROUTINE partialDerQuad
!Random position in quadrilateral volume
FUNCTION randPosCellQuad(self) RESULT(r)
USE moduleRandom
IMPLICIT NONE
CLASS(meshCell2DCartQuad), INTENT(in):: self
REAL(8):: r(1:3)
REAL(8):: Xi(1:3)
REAL(8):: fPsi(1:4)
Xi(1) = random(-1.D0, 1.D0)
Xi(2) = random(-1.D0, 1.D0)
Xi(3) = 0.D0
fPsi = self%fPsi(Xi)
r(1) = DOT_PRODUCT(fPsi, self%x)
r(2) = DOT_PRODUCT(fPsi, self%y)
r(3) = 0.D0
END FUNCTION randPosCellQuad
!Computes element local stiffness matrix
PURE FUNCTION elemKQuad(self) RESULT(localK)
IMPLICIT NONE
@ -419,14 +397,15 @@ MODULE moduleMesh2DCart
!Start 2D Gauss Quad Integral
DO l=1, 3
Xi(2) = corQuad(l)
dPsi(1,:) = self%dPsiXi1(Xi(2))
DO m = 1, 3
Xi(1) = corQuad(m)
dPsi(2,:) = self%dPsiXi2(Xi(1))
fPsi = self%fPsi(Xi)
detJ = self%detJac(Xi,dPsi)
invJ = self%invJac(Xi,dPsi)
localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*wQuad(l)*wQuad(m)/detJ
Xi(1) = corQuad(m)
fPsi = self%fPsi(Xi)
dPsi = self%dPsi(Xi)
detJ = self%detJac(Xi,dPsi)
invJ = self%invJac(Xi,dPsi)
localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)), &
MATMUL(invJ,dPsi))* &
wQuad(l)*wQuad(m)/detJ
END DO
END DO
@ -533,24 +512,25 @@ MODULE moduleMesh2DCart
CLASS(meshCell2DCartQuad), INTENT(in):: self
REAL(8), INTENT(in):: r(1:3)
REAL(8):: Xi(1:3)
REAL(8):: XiO(1:3), detJ, invJ(1:2,1:2), f(1:2)
REAL(8):: XiO(1:3), detJ, invJ(1:3,1:3), f(1:3)
REAL(8):: dPsi(1:3,1:4), fPsi(1:4)
REAL(8):: conv
!Iterative newton method to transform coordinates
conv=1.D0
XiO=0.D0
conv = 1.D0
XiO = 0.D0
DO WHILE(conv>1.D-3)
DO WHILE(conv > 1.D-3)
dPsi = self%dPsi(XiO)
invJ = self%invJac(XiO, dPsi)
fPsi = self%fPsi(XiO)
f(1) = DOT_PRODUCT(fPsi,self%x)-r(1)
f(2) = DOT_PRODUCT(fPsi,self%y)-r(2)
detJ = self%detJac(XiO,dPsi)
Xi(1:2)=XiO(1:2) - MATMUL(invJ, f)/detJ
conv=MAXVAL(DABS(Xi-XiO),1)
XiO=Xi
f = (/ DOT_PRODUCT(fPsi,self%x), &
DOT_PRODUCT(fPsi,self%y), &
0.D0 /)
f = f - r
Xi = XiO - MATMUL(invJ, f)/detJ
conv = MAXVAL(DABS(Xi-XiO),1)
XiO = Xi
END DO
@ -644,7 +624,7 @@ MODULE moduleMesh2DCart
r(2) = DOT_PRODUCT(fPsi, self%y)
r(3) = 0.D0
END FUNCTION randposCellTria
END FUNCTION randPosCellTria
!Calculates area for triangular element
PURE SUBROUTINE areaTria(self)
@ -690,37 +670,11 @@ MODULE moduleMesh2DCart
dPsi = 0.D0
dPsi(1,:) = dPsiTriaXi1(Xi(2))
dPsi(2,:) = dPsiTriaXi2(Xi(1))
dPsi(1,:) = (/ -1.D0, 1.D0, 0.D0 /)
dPsi(2,:) = (/ -1.D0, 0.D0, 1.D0 /)
END FUNCTION dPsiTria
!Derivative element function (Xi1)
PURE FUNCTION dPsiTriaXi1(Xi2) RESULT(dPsiXi1)
IMPLICIT NONE
REAL(8), INTENT(in):: Xi2
REAL(8):: dPsiXi1(1:3)
dPsiXi1(1) = -1.D0
dPsiXi1(2) = 1.D0
dPsiXi1(3) = 0.D0
END FUNCTION dPsiTriaXi1
!Derivative element function (Xi1)
PURE FUNCTION dPsiTriaXi2(Xi1) RESULT(dPsiXi2)
IMPLICIT NONE
REAL(8), INTENT(in):: Xi1
REAL(8):: dPsiXi2(1:3)
dPsiXi2(1) = -1.D0
dPsiXi2(2) = 0.D0
dPsiXi2(3) = 1.D0
END FUNCTION dPsiTriaXi2
PURE SUBROUTINE partialDerTria(self, dPsi, dx, dy)
IMPLICIT NONE
@ -728,10 +682,10 @@ MODULE moduleMesh2DCart
REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes)
REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy
dx(1) = DOT_PRODUCT(dPsi(1,:),self%x)
dx(2) = DOT_PRODUCT(dPsi(2,:),self%x)
dy(1) = DOT_PRODUCT(dPsi(1,:),self%y)
dy(2) = DOT_PRODUCT(dPsi(2,:),self%y)
dx = (/ DOT_PRODUCT(dPsi(1,:),self%x), &
DOT_PRODUCT(dPsi(2,:),self%x) /)
dy = (/ DOT_PRODUCT(dPsi(1,:),self%y), &
DOT_PRODUCT(dPsi(2,:),self%y) /)
END SUBROUTINE partialDerTria
@ -755,7 +709,7 @@ MODULE moduleMesh2DCart
dPsi = self%dPsi(Xi)
detJ = self%detJac(Xi,dPsi)
invJ = self%invJac(Xi,dPsi)
fPsi = self%fPsi(Xi)
fPsi = self%fPsi(Xi)
localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*wTria(l)/detJ
END DO
@ -781,7 +735,7 @@ MODULE moduleMesh2DCart
Xi(1) = Xi1Tria(l)
Xi(2) = Xi2Tria(l)
detJ = self%detJac(Xi)
fPsi = self%fPsi(Xi)
fPsi = self%fPsi(Xi)
f = DOT_PRODUCT(fPsi,source)
localF = localF + f*fPsi*wTria(l)*detJ
@ -902,8 +856,8 @@ MODULE moduleMesh2DCart
CLASS(meshCell2DCart), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3)
REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes)
REAL(8):: dPsi(1:3,1:self%nNodes)
REAL(8):: dJ
REAL(8):: dPsi(1:3,1:self%nNodes)
REAL(8):: dx(1:2), dy(1:2)
IF(PRESENT(dPsi_in)) THEN
@ -915,6 +869,7 @@ MODULE moduleMesh2DCart
END IF
CALL self%partialDer(dPsi, dx, dy)
dJ = dx(1)*dy(2)-dx(2)*dy(1)
END FUNCTION detJ2DCart
@ -926,9 +881,9 @@ MODULE moduleMesh2DCart
CLASS(meshCell2DCart), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3)
REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes)
REAL(8):: invJ(1:3,1:3)
REAL(8):: dPsi(1:3,1:self%nNodes)
REAL(8):: dx(1:2), dy(1:2)
REAL(8):: invJ(1:3,1:3)
IF(PRESENT(dPsi_in)) THEN
dPsi=dPsi_in
@ -1351,7 +1306,7 @@ MODULE moduleMesh2DCart
!Revers the normal to point inside the domain
elemB%normal = - elemB%normal
END IF
END IF