fPsi no longer allocates memory

I noticed that phy2logquad had a lot of overhead. Trying to reducing it
by simplifying calls to fPsi, dPsi and such.

The function for fPsi has been made so no memory is allocated and works
under the assumption that the input array has the right size (1:numNodes)
This commit is contained in:
Jorge Gonzalez 2023-01-01 12:12:06 +01:00
commit 0db76083ec
8 changed files with 408 additions and 409 deletions

View file

@ -310,49 +310,52 @@ MODULE moduleMesh2DCyl
CLASS(meshVol2DCylQuad), INTENT(inout):: self
REAL(8):: r, xi(1:3)
REAL(8):: detJ
REAL(8):: fPsi(1:4)
REAL(8):: fPsi(1:4), fPsi_node(1:4)
self%volume = 0.D0
self%arNodes = 0.D0
!2D 1 point Gauss Quad Integral
xi = 0.D0
detJ = self%detJac(xi)*PI8 !4*2*pi
fPsi = self%fPsi(xi)
CALL self%fPsi(xi, fPsi)
!Computes total volume of the cell
r = DOT_PRODUCT(fPsi,self%r)
self%volume = r*detJ
!Computes volume per node
xi = (/-5.D-1, -5.D-1, 0.D0/)
r = DOT_PRODUCT(self%fPsi(xi),self%r)
CALL self%fPsi(xi, fPsi_node)
r = DOT_PRODUCT(fPsi_node,self%r)
self%arNodes(1) = fPsi(1)*r*detJ
xi = (/ 5.D-1, -5.D-1, 0.D0/)
r = DOT_PRODUCT(self%fPsi(xi),self%r)
CALL self%fPsi(xi, fPsi_node)
r = DOT_PRODUCT(fPsi_node,self%r)
self%arNodes(2) = fPsi(2)*r*detJ
xi = (/ 5.D-1, 5.D-1, 0.D0/)
r = DOT_PRODUCT(self%fPsi(xi),self%r)
CALL self%fPsi(xi, fPsi_node)
r = DOT_PRODUCT(fPsi_node,self%r)
self%arNodes(3) = fPsi(3)*r*detJ
xi = (/-5.D-1, 5.D-1, 0.D0/)
r = DOT_PRODUCT(self%fPsi(xi),self%r)
CALL self%fPsi(xi, fPsi_node)
r = DOT_PRODUCT(fPsi_node,self%r)
self%arNodes(4) = fPsi(4)*r*detJ
END SUBROUTINE areaQuad
!Computes element functions in point xi
PURE FUNCTION fPsiQuad(xi) RESULT(fPsi)
PURE SUBROUTINE fPsiQuad(xi, fPsi)
IMPLICIT NONE
REAL(8),INTENT(in):: xi(1:3)
REAL(8), ALLOCATABLE:: fPsi(:)
REAL(8), INTENT(in):: xi(1:3)
REAL(8), INTENT(out):: fPsi(:)
ALLOCATE(fPsi(1:4))
fPsi(1) = (1.D0-xi(1)) * (1.D0-xi(2))
fPsi(2) = (1.D0+xi(1)) * (1.D0-xi(2))
fPsi(3) = (1.D0+xi(1)) * (1.D0+xi(2))
fPsi(4) = (1.D0-xi(1)) * (1.D0+xi(2))
fPsi(1) = (1.D0-xi(1))*(1.D0-xi(2))
fPsi(2) = (1.D0+xi(1))*(1.D0-xi(2))
fPsi(3) = (1.D0+xi(1))*(1.D0+xi(2))
fPsi(4) = (1.D0-xi(1))*(1.D0+xi(2))
fPsi = fPsi*0.25D0
END FUNCTION fPsiQuad
END SUBROUTINE fPsiQuad
!Derivative element function at coordinates xi
PURE FUNCTION dPsiQuad(xi) RESULT(dPsi)
@ -375,10 +378,11 @@ MODULE moduleMesh2DCyl
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(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
@ -390,11 +394,12 @@ MODULE moduleMesh2DCyl
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
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
@ -427,7 +432,7 @@ MODULE moduleMesh2DCyl
xii(2) = random(-1.D0, 1.D0)
xii(3) = 0.D0
fPsi = self%fPsi(xii)
CALL self%fPsi(xii, fPsi)
r(1) = DOT_PRODUCT(fPsi, self%z)
r(2) = DOT_PRODUCT(fPsi, self%r)
@ -457,7 +462,7 @@ MODULE moduleMesh2DCyl
DO m = 1, 3
xi(1) = corQuad(m)
dPsi(2,:) = self%dPsiXi2(xi(1))
fPsi = self%fPsi(xi)
CALL self%fPsi(xi, fPsi)
detJ = self%detJac(xi,dPsi)
invJ = self%invJac(xi,dPsi)
r = DOT_PRODUCT(fPsi,self%r)
@ -492,7 +497,7 @@ MODULE moduleMesh2DCyl
DO m = 1, 3
xi(2) = corQuad(m)
detJ = self%detJac(xi)
fPsi = self%fPsi(xi)
CALL self%fPsi(xi, fPsi)
r = DOT_PRODUCT(fPsi,self%r)
f = DOT_PRODUCT(fPsi,source)
localF = localF + r*f*fPsi*wQuad(l)*wQuad(m)*detJ
@ -564,7 +569,7 @@ MODULE moduleMesh2DCyl
self%n3%emData%B(3), &
self%n4%emData%B(3) /)
fPsi = self%fPsi(xi)
CALL self%fPsi(xi, fPsi)
MF = MATMUL(fPsi(:), MF_Nodes)
END FUNCTION gatherMFQuad
@ -582,30 +587,30 @@ MODULE moduleMesh2DCyl
END FUNCTION getNodesQuad
!Transforms physical coordinates to element coordinates
PURE FUNCTION phy2logQuad(self,r) RESULT(xN)
PURE FUNCTION phy2logQuad(self,r) RESULT(XiN)
IMPLICIT NONE
CLASS(meshVol2DCylQuad), INTENT(in):: self
REAL(8), INTENT(in):: r(1:3)
REAL(8):: xN(1:3)
REAL(8):: xO(1:3), detJ, invJ(1:2,1:2), f(1:2)
REAL(8):: XiN(1:3)
REAL(8):: XiO(1:3), detJ, invJ(1:2,1:2), f(1:2)
REAL(8):: dPsi(1:2,1:4), fPsi(1:4)
REAL(8):: conv
!Iterative newton method to transform coordinates
conv=1.D0
xO=0.D0
XiO=0.D0
DO WHILE(conv>1.D-4)
dPsi = self%dPsi(xO)
invJ = self%invJac(xO, dPsi)
fPsi = self%fPsi(xO)
f(1) = DOT_PRODUCT(fPsi,self%z)-r(1)
f(2) = DOT_PRODUCT(fPsi,self%r)-r(2)
detJ = self%detJac(xO,dPsi)
xN(1:2)=xO(1:2) - MATMUL(invJ, f)/detJ
conv=MAXVAL(DABS(xN-xO),1)
xO=xN
DO WHILE(conv>1.D-3)
CALL self%fPsi(XiO, fPsi)
f = (/ DOT_PRODUCT(fPsi,self%z)-r(1), &
DOT_PRODUCT(fPsi,self%r)-r(2) /)
dPsi = self%dPsi(XiO)
invJ = self%invJac(XiO, dPsi)
detJ = self%detJac(XiO,dPsi)
XiN(1:2)=XiO(1:2) - MATMUL(invJ, f)/detJ
conv=MAXVAL(DABS(XiN-XiO),1)
XiO=XiN
END DO
@ -690,7 +695,7 @@ MODULE moduleMesh2DCyl
xii(2) = random( 0.D0, 1.D0 - xii(1))
xii(3) = 0.D0
fPsi = self%fPsi(xii)
CALL self%fPsi(xii, fPsi)
r(1) = DOT_PRODUCT(fPsi, self%z)
r(2) = DOT_PRODUCT(fPsi, self%r)
@ -713,7 +718,7 @@ MODULE moduleMesh2DCyl
!2D 1 point Gauss Quad Integral
xi = (/1.D0/3.D0, 1.D0/3.D0, 0.D0 /)
detJ = self%detJac(xi)*PI !2PI*1/2
fPsi = self%fPsi(xi)
CALL self%fPsi(xi, fPsi)
!Computes total volume of the cell
r = DOT_PRODUCT(fPsi,self%r)
self%volume = r*detJ
@ -723,19 +728,17 @@ MODULE moduleMesh2DCyl
END SUBROUTINE areaTria
!Shape functions for triangular element
PURE FUNCTION fPsiTria(xi) RESULT(fPsi)
PURE SUBROUTINE fPsiTria(xi, fPsi)
IMPLICIT NONE
REAL(8), INTENT(in):: xi(1:3)
REAL(8), ALLOCATABLE:: fPsi(:)
ALLOCATE(fPsi(1:3))
REAL(8), INTENT(out):: fPsi(:)
fPsi(1) = 1.D0 - xi(1) - xi(2)
fPsi(2) = xi(1)
fPsi(3) = xi(2)
END FUNCTION fPsiTria
END SUBROUTINE fPsiTria
!Derivative element function at coordinates xi
PURE FUNCTION dPsiTria(xi) RESULT(dPsi)
@ -813,7 +816,7 @@ MODULE moduleMesh2DCyl
dPsi = self%dPsi(xi)
detJ = self%detJac(xi,dPsi)
invJ = self%invJac(xi,dPsi)
fPsi = self%fPsi(xi)
CALL self%fPsi(xi, fPsi)
r = DOT_PRODUCT(fPsi,self%r)
localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*r*wTria(l)/detJ
@ -843,7 +846,7 @@ MODULE moduleMesh2DCyl
xi(1) = xi1Tria(l)
xi(2) = xi2Tria(l)
detJ = self%detJac(xi)
fPsi = self%fPsi(xi)
CALL self%fPsi(xi, fPsi)
r = DOT_PRODUCT(fPsi,self%r)
f = DOT_PRODUCT(fPsi,source)
localF = localF + r*f*fPsi*wTria(l)*detJ
@ -910,7 +913,7 @@ MODULE moduleMesh2DCyl
self%n2%emData%B(3), &
self%n3%emData%B(3) /)
fPsi = self%fPsi(xi)
CALL self%fPsi(xi, fPsi)
MF = MATMUL(fPsi, MF_Nodes)
END FUNCTION gatherMFTria