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

54
src/modules/mesh/1DCart/moduleMesh1DCart.f90
View file

@ -230,13 +230,13 @@ MODULE moduleMesh1DCart
CLASS(meshVol1DCartSegm), 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%x)
END FUNCTION randPos1DCartSeg
@ -249,36 +249,34 @@ MODULE moduleMesh1DCart
REAL(8):: l !element length
REAL(8):: fPsi(1:2)
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)
l = 2.D0*detJ
self%volume = l
self%arNodes = fPsi*l
END SUBROUTINE areaSegm
!Computes element functions at point xii
PURE FUNCTION fPsiSegm(xi) RESULT(fPsi)
!Computes element functions at point Xi
PURE SUBROUTINE fPsiSegm(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 fPsiSegm
END SUBROUTINE fPsiSegm
!Computes element derivative shape function at Xii
!Computes element derivative shape function at Xi
PURE FUNCTION dPsiSegm(xi) RESULT(dPsi)
IMPLICIT NONE
@ -310,19 +308,19 @@ MODULE moduleMesh1DCart
CLASS(meshVol1DCartSegm), 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
INTEGER:: l
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)
Xi(1) = corSeg(l)
dPsi = self%dPsi(Xi)
detJ = self%detJac(Xi, dPsi)
invJ = self%invJac(Xi, dPsi)
localK = localK + MATMUL(RESHAPE(MATMUL(invJ,dPsi), (/ 2, 1/)), &
RESHAPE(MATMUL(invJ,dPsi), (/ 1, 2/)))* &
wSeg(l)/detJ
@ -339,17 +337,17 @@ MODULE moduleMesh1DCart
REAL(8), ALLOCATABLE:: localF(:)
REAL(8):: fPsi(1:2)
REAL(8):: detJ, f
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)
f = DOT_PRODUCT(fPsi, source)
localF = localF + f*fPsi*wSeg(l)*detJ
@ -368,7 +366,7 @@ MODULE moduleMesh1DCart
END FUNCTION insideSegm
!Gathers EF at position Xii
!Gathers EF at position Xi
PURE FUNCTION gatherEFSegm(self, xi) RESULT(EF)
IMPLICIT NONE
@ -407,7 +405,7 @@ MODULE moduleMesh1DCart
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 gatherMFSegm