JGonzalez/fpakc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fPsi no longer allocates memory

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

68
src/modules/mesh/1DRad/moduleMesh1DRad.f90
View file

@ -232,13 +232,13 @@ MODULE moduleMesh1DRad
CLASS(meshVol1DRadSegm), INTENT(in):: self
REAL(8):: r(1:3)
REAL(8):: xii(1:3)
REAL(8):: Xi(1:3)
REAL(8), ALLOCATABLE:: fPsi(:)
xii(1) = random(-1.D0, 1.D0)
xii(2:3) = 0.D0
Xi(1) = random(-1.D0, 1.D0)
Xi(2:3) = 0.D0
fPsi = self%fPsi(xii)
CALL self%fPsi(Xi, fPsi)
r(1) = DOT_PRODUCT(fPsi, self%r)
END FUNCTION randPos1DRadSeg
@ -249,47 +249,47 @@ MODULE moduleMesh1DRad
CLASS(meshVol1DRadSegm), INTENT(inout):: self
REAL(8):: l !element length
REAL(8):: fPsi(1:2)
REAL(8):: fPsi(1:2), fPsi_node(1:2)
REAL(8):: r
REAL(8):: detJ
REAL(8):: Xii(1:3)
REAL(8):: Xi(1:3)
self%volume = 0.D0
self%arNodes = 0.D0
!1 point Gauss integral
Xii = 0.D0
fPsi = self%fPsi(Xii)
detJ = self%detJac(Xii)
Xi = 0.D0
CALL self%fPsi(Xi, fPsi)
detJ = self%detJac(Xi)
!Computes total volume of the cell
r = DOT_PRODUCT(fPsi, self%r)
l = 2.D0*detJ
self%volume = r*l
!Computes volume per node
Xii = (/-5.D-1, 0.D0, 0.D0/)
r = DOT_PRODUCT(self%fPsi(Xii),self%r)
Xi = (/-5.D-1, 0.D0, 0.D0/)
CALL self%fPsi(Xi, fPsi_node)
r = DOT_PRODUCT(fPsi_node,self%r)
self%arNodes(1) = fPsi(1)*r*l
Xii = (/ 5.D-1, 0.D0, 0.D0/)
r = DOT_PRODUCT(self%fPsi(Xii),self%r)
Xi = (/ 5.D-1, 0.D0, 0.D0/)
CALL self%fPsi(Xi, fPsi_node)
r = DOT_PRODUCT(fPsi_node,self%r)
self%arNodes(2) = fPsi(2)*r*l
END SUBROUTINE areaRad
!Computes element functions at point xii
PURE FUNCTION fPsiRad(xi) RESULT(fPsi)
!Computes element functions at point Xi
PURE SUBROUTINE fPsiRad(xi, fPsi)
IMPLICIT NONE
REAL(8), INTENT(in):: xi(1:3)
REAL(8), ALLOCATABLE:: fPsi(:)
ALLOCATE(fPsi(1:2))
REAL(8), INTENT(out):: fPsi(:)
fPsi(1) = 1.D0 - xi(1)
fPsi(2) = 1.D0 + xi(1)
fPsi = fPsi * 5.D-1
END FUNCTION fPsiRad
END SUBROUTINE fPsiRad
!Computes element derivative shape function at Xii
!Computes element derivative shape function at Xi
PURE FUNCTION dPsiRad(xi) RESULT(dPsi)
IMPLICIT NONE
@ -322,7 +322,7 @@ MODULE moduleMesh1DRad
CLASS(meshVol1DRadSegm), INTENT(in):: self
REAL(8), ALLOCATABLE:: localK(:,:)
REAL(8):: Xii(1:3)
REAL(8):: Xi(1:3)
REAL(8):: dPsi(1:1, 1:2)
REAL(8):: invJ(1), detJ
REAL(8):: r, fPsi(1:2)
@ -330,13 +330,13 @@ MODULE moduleMesh1DRad
ALLOCATE(localK(1:2, 1:2))
localK = 0.D0
Xii = 0.D0
Xi = 0.D0
DO l = 1, 3
xii(1) = corSeg(l)
dPsi = self%dPsi(Xii)
detJ = self%detJac(Xii, dPsi)
invJ = self%invJac(Xii, dPsi)
fPsi = self%fPsi(Xii)
Xi(1) = corSeg(l)
dPsi = self%dPsi(Xi)
detJ = self%detJac(Xi, dPsi)
invJ = self%invJac(Xi, dPsi)
CALL self%fPsi(Xi, fPsi)
r = DOT_PRODUCT(fPsi, self%r)
localK = localK + MATMUL(RESHAPE(MATMUL(invJ,dPsi), (/ 2, 1/)), &
RESHAPE(MATMUL(invJ,dPsi), (/ 1, 2/)))* &
@ -357,17 +357,17 @@ MODULE moduleMesh1DRad
REAL(8), ALLOCATABLE:: localF(:)
REAL(8):: fPsi(1:2)
REAL(8):: detJ, f, r
REAL(8):: Xii(1:3)
REAL(8):: Xi(1:3)
INTEGER:: l
ALLOCATE(localF(1:2))
localF = 0.D0
Xii = 0.D0
Xi = 0.D0
DO l = 1, 3
xii(1) = corSeg(l)
detJ = self%detJac(Xii)
fPsi = self%fPsi(Xii)
Xi(1) = corSeg(l)
detJ = self%detJac(Xi)
CALL self%fPsi(Xi, fPsi)
r = DOT_PRODUCT(fPsi, self%r)
f = DOT_PRODUCT(fPsi, source)
localF = localF + f*fPsi*r*wSeg(l)*detJ
@ -387,7 +387,7 @@ MODULE moduleMesh1DRad
END FUNCTION insideRad
!Gathers EF at position Xii
!Gathers EF at position Xi
PURE FUNCTION gatherEFRad(self, xi) RESULT(EF)
IMPLICIT NONE
@ -426,7 +426,7 @@ MODULE moduleMesh1DRad
MF_Nodes(1:2,3) = (/ self%n1%emData%B(3), &
self%n2%emData%B(3) /)
fPsi = self%fPsi(xi)
CALL self%fPsi(xi, fPsi)
MF = MATMUL(fPsi, MF_Nodes)
END FUNCTION gatherMFRad