Small improvement

Very small improvement in performance.

Still, partialDer takes too long to compute.
Trying to find ways to improve it.
This commit is contained in:
Jorge Gonzalez 2023-01-06 15:18:04 +01:00
commit 7b7a5c45ca
6 changed files with 788 additions and 837 deletions

View file

@ -14,7 +14,8 @@ MODULE moduleMesh1DCart
!Element coordinates
REAL(8):: x = 0.D0
CONTAINS
PROCEDURE, PASS:: init => initNode1DCart
!meshNode DEFERRED PROCEDURES
PROCEDURE, PASS:: init => initNode1DCart
PROCEDURE, PASS:: getCoordinates => getCoord1DCart
END TYPE meshNode1DCart
@ -25,6 +26,7 @@ MODULE moduleMesh1DCart
!Connectivity to nodes
CLASS(meshNode), POINTER:: n1 => NULL()
CONTAINS
!meshEdge DEFERRED PROCEDURES
PROCEDURE, PASS:: init => initEdge1DCart
PROCEDURE, PASS:: getNodes => getNodes1DCart
PROCEDURE, PASS:: intersection => intersection1DCart
@ -32,27 +34,7 @@ MODULE moduleMesh1DCart
END TYPE meshEdge1DCart
TYPE, PUBLIC, ABSTRACT, EXTENDS(meshCell):: meshCell1DCart
CONTAINS
PROCEDURE, PASS:: detJac => detJ1DCart
PROCEDURE, PASS:: invJac => invJ1DCart
PROCEDURE(partialDer_interface), DEFERRED, PASS:: partialDer
END TYPE meshCell1DCart
ABSTRACT INTERFACE
PURE SUBROUTINE partialDer_interface(self, nNodes, dPsi, dx)
IMPORT meshCell1DCart
CLASS(meshCell1DCart), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8), INTENT(in):: dPsi(1:3,1:nNodes)
REAL(8), INTENT(out), DIMENSION(1):: dx
END SUBROUTINE partialDer_interface
END INTERFACE
TYPE, PUBLIC, EXTENDS(meshCell1DCart):: meshCell1DCartSegm
TYPE, PUBLIC, EXTENDS(meshCell):: meshCell1DCartSegm
!Element coordinates
REAL(8):: x(1:2)
!Connectivity to nodes
@ -61,20 +43,24 @@ MODULE moduleMesh1DCart
CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL()
REAL(8):: arNodes(1:2)
CONTAINS
PROCEDURE, PASS:: init => initCell1DCartSegm
PROCEDURE, PASS:: randPos => randPos1DCartSegm
PROCEDURE, PASS:: area => areaSegm
PROCEDURE, PASS:: fPsi => fPsiSegm
PROCEDURE, PASS:: dPsi => dPsiSegm
PROCEDURE, PASS:: partialDer => partialDerSegm
PROCEDURE, PASS:: elemK => elemKSegm
PROCEDURE, PASS:: elemF => elemFSegm
PROCEDURE, PASS:: gatherElectricField => gatherEFSegm
PROCEDURE, PASS:: gatherMagneticField => gatherMFSegm
PROCEDURE, NOPASS:: inside => insideSegm
PROCEDURE, PASS:: getNodes => getNodesSegm
PROCEDURE, PASS:: phy2log => phy2logSegm
PROCEDURE, PASS:: nextElement => nextElementSegm
!meshCell DEFERRED PROCEDURES
PROCEDURE, PASS:: init => initCell1DCartSegm
PROCEDURE, PASS:: getNodes => getNodesSegm
PROCEDURE, PASS:: randPos => randPos1DCartSegm
PROCEDURE, NOPASS:: fPsi => fPsiSegm
PROCEDURE, NOPASS:: dPsi => dPsiSegm
PROCEDURE, PASS:: partialDer => partialDerSegm
PROCEDURE, NOPASS:: detJac => detJ1DCart
PROCEDURE, NOPASS:: invJac => invJ1DCart
PROCEDURE, PASS:: gatherElectricField => gatherEFSegm
PROCEDURE, PASS:: gatherMagneticField => gatherMFSegm
PROCEDURE, PASS:: elemK => elemKSegm
PROCEDURE, PASS:: elemF => elemFSegm
PROCEDURE, NOPASS:: inside => insideSegm
PROCEDURE, PASS:: phy2log => phy2logSegm
PROCEDURE, PASS:: neighbourElement => neighbourElementSegm
!PARTICLUAR PROCEDURES
PROCEDURE, PASS, PRIVATE:: area => areaSegm
END TYPE meshCell1DCartSegm
@ -219,7 +205,19 @@ MODULE moduleMesh1DCart
END SUBROUTINE initCell1DCartSegm
!Calculates a random position in 1D volume
!Get nodes from 1D volume
PURE FUNCTION getNodesSegm(self, nNodes) RESULT(n)
IMPLICIT NONE
CLASS(meshCell1DCartSegm), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
INTEGER:: n(1:nNodes)
n = (/ self%n1%n, self%n2%n /)
END FUNCTION getNodesSegm
!Random position in 1D volume
FUNCTION randPos1DCartSegm(self) RESULT(r)
USE moduleRandom
IMPLICIT NONE
@ -227,135 +225,63 @@ MODULE moduleMesh1DCart
CLASS(meshCell1DCartSegm), INTENT(in):: self
REAL(8):: r(1:3)
REAL(8):: Xi(1:3)
REAL(8), ALLOCATABLE:: fPsi(:)
REAL(8):: fPsi(1:2)
Xi(1) = random(-1.D0, 1.D0)
Xi(2:3) = 0.D0
Xi = 0.D0
Xi(1) = random(-1.D0, 1.D0)
fPsi = self%fPsi(Xi, 2)
r = 0.D0
r(1) = DOT_PRODUCT(fPsi, self%x)
END FUNCTION randPos1DCartSegm
!Computes element area
PURE SUBROUTINE areaSegm(self)
IMPLICIT NONE
CLASS(meshCell1DCartSegm), INTENT(inout):: self
REAL(8):: l !element length
REAL(8):: fPsi(1:2)
REAL(8):: detJ
REAL(8):: Xi(1:3)
self%volume = 0.D0
self%arNodes = 0.D0
!1 point Gauss integral
Xi = 0.D0
fPsi = self%fPsi(Xi, 2)
detJ = self%detJac(Xi, 2)
l = 2.D0*detJ
self%volume = l
self%arNodes = fPsi*l
END SUBROUTINE areaSegm
!Computes element functions at point Xi
PURE FUNCTION fPsiSegm(self, Xi, nNodes) RESULT(fPsi)
PURE FUNCTION fPsiSegm(Xi, nNodes) RESULT(fPsi)
IMPLICIT NONE
CLASS(meshCell1DCartSegm), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3)
INTEGER, INTENT(in):: nNodes
REAL(8):: fPsi(1:nNodes)
fPsi(1) = 1.D0 - Xi(1)
fPsi(2) = 1.D0 + Xi(1)
fPsi = (/ 1.D0 - Xi(1), &
1.D0 + Xi(1) /)
fPsi = fPsi * 5.D-1
fPsi = fPsi * 0.50D0
END FUNCTION fPsiSegm
!Computes element derivative shape function at Xi
PURE FUNCTION dPsiSegm(self, Xi, nNodes) RESULT(dPsi)
!Derivative element function at coordinates Xi
PURE FUNCTION dPsiSegm(Xi, nNodes) RESULT(dPsi)
IMPLICIT NONE
CLASS(meshCell1DCartSegm), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3)
INTEGER, INTENT(in):: nNodes
REAL(8):: dPsi(1:3,1:nNodes)
dPsi = 0.D0
dPsi(1, 1) = -5.D-1
dPsi(1, 2) = 5.D-1
dPsi(1, 1:2) = (/ -5.D-1, 5.D-1 /)
END FUNCTION dPsiSegm
!Computes partial derivatives of coordinates
PURE SUBROUTINE partialDerSegm(self, nNodes, dPsi, dx)
!Partial derivative in global coordinates
PURE FUNCTION partialDerSegm(self, nNodes, dPsi) RESULT(pDer)
IMPLICIT NONE
CLASS(meshCell1DCartSegm), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8), INTENT(in):: dPsi(1:3,1:nNodes)
REAL(8), INTENT(out), DIMENSION(1):: dx
REAL(8):: pDer(1:3, 1:3)
dx(1) = DOT_PRODUCT(dPsi(1,:), self%x)
pDer = 0.D0
END SUBROUTINE partialDerSegm
pDer(1,1) = DOT_PRODUCT(dPsi(1,1:2), self%x(1:2))
pDer(2,2) = 1.D0
pDer(3,3) = 1.D0
!Computes local stiffness matrix
PURE FUNCTION elemKSegm(self, nNodes) RESULT(localK)
IMPLICIT NONE
CLASS(meshCell1DCartSegm), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8):: localK(1:nNodes,1:nNodes)
REAL(8):: Xi(1:3)
REAL(8):: dPsi(1:3, 1:2)
REAL(8):: invJ(1:3,1:3), detJ
INTEGER:: l
localK = 0.D0
Xi = 0.D0
DO l = 1, 3
Xi(1) = corSeg(l)
dPsi = self%dPsi(Xi, 2)
detJ = self%detJac(Xi, 2, dPsi)
invJ = self%invJac(Xi, 2, dPsi)
localK = localK + MATMUL(RESHAPE(MATMUL(invJ,dPsi), (/ 2, 1/)), &
RESHAPE(MATMUL(invJ,dPsi), (/ 1, 2/)))* &
wSeg(l)/detJ
END DO
END FUNCTION elemKSegm
PURE FUNCTION elemFSegm(self, nNodes, source) RESULT(localF)
IMPLICIT NONE
CLASS(meshCell1DCartSegm), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8), INTENT(in):: source(1:nNodes)
REAL(8):: localF(1:nNodes)
REAL(8):: fPsi(1:2)
REAL(8):: detJ, f
REAL(8):: Xi(1:3)
INTEGER:: l
localF = 0.D0
Xi = 0.D0
DO l = 1, 3
Xi(1) = corSeg(l)
detJ = self%detJac(Xi, 2)
fPsi = self%fPsi(Xi, 2)
f = DOT_PRODUCT(fPsi, source)
localF = localF + f*fPsi*wSeg(l)*detJ
END DO
END FUNCTION elemFSegm
END FUNCTION partialDerSegm
PURE FUNCTION gatherEFSegm(self, Xi) RESULT(array)
IMPLICIT NONE
@ -391,6 +317,68 @@ MODULE moduleMesh1DCart
END FUNCTION gatherMFSegm
!Computes element local stiffness matrix
PURE FUNCTION elemKSegm(self, nNodes) RESULT(localK)
IMPLICIT NONE
CLASS(meshCell1DCartSegm), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8):: localK(1:nNodes,1:nNodes)
REAL(8):: Xi(1:3)
REAL(8):: dPsi(1:3, 1:2)
REAL(8):: pDer(1:3, 1:3)
REAL(8):: invJ(1:3,1:3), detJ
INTEGER:: l
localK = 0.D0
Xi = 0.D0
!Start 1D Gauss Quad Integral
DO l = 1, 3
Xi(1) = corSeg(l)
dPsi = self%dPsi(Xi, 2)
pDer = self%partialDer(2, dPsi)
detJ = self%detJac(pDer)
invJ = self%invJac(pDer)
localK = localK + MATMUL(RESHAPE(MATMUL(invJ,dPsi), (/ 2, 1/)), &
RESHAPE(MATMUL(invJ,dPsi), (/ 1, 2/)))* &
wSeg(l)/detJ
END DO
END FUNCTION elemKSegm
!Computes the local source vector for a force f
PURE FUNCTION elemFSegm(self, nNodes, source) RESULT(localF)
IMPLICIT NONE
CLASS(meshCell1DCartSegm), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8), INTENT(in):: source(1:nNodes)
REAL(8):: localF(1:nNodes)
REAL(8):: fPsi(1:2)
REAL(8):: dPsi(1:3, 1:2), pDer(1:3, 1:3)
REAL(8):: Xi(1:3)
REAL(8):: detJ, f
INTEGER:: l
localF = 0.D0
Xi = 0.D0
!Start 1D Gauss Quad Integral
DO l = 1, 3
Xi(1) = corSeg(l)
dPsi = self%dPsi(Xi, 2)
pDer = self%partialDer(2, dPsi)
detJ = self%detJac(pDer)
fPsi = self%fPsi(Xi, 2)
f = DOT_PRODUCT(fPsi, source)
localF = localF + f*fPsi*wSeg(l)*detJ
END DO
END FUNCTION elemFSegm
PURE FUNCTION insideSegm(Xi) RESULT(ins)
IMPLICIT NONE
@ -402,101 +390,87 @@ MODULE moduleMesh1DCart
END FUNCTION insideSegm
!Get nodes from 1D volume
PURE FUNCTION getNodesSegm(self, nNodes) RESULT(n)
IMPLICIT NONE
CLASS(meshCell1DCartSegm), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
INTEGER:: n(1:nNodes)
n = (/ self%n1%n, self%n2%n /)
END FUNCTION getNodesSegm
PURE FUNCTION phy2logSegm(self, r) RESULT(xN)
PURE FUNCTION phy2logSegm(self, r) RESULT(Xi)
IMPLICIT NONE
CLASS(meshCell1DCartSegm), INTENT(in):: self
REAL(8), INTENT(in):: r(1:3)
REAL(8):: xN(1:3)
REAL(8):: Xi(1:3)
xN = 0.D0
xN(1) = 2.D0*(r(1) - self%x(1))/(self%x(2) - self%x(1)) - 1.D0
Xi = 0.D0
Xi(1) = 2.D0*(r(1) - self%x(1))/(self%x(2) - self%x(1)) - 1.D0
END FUNCTION phy2logSegm
!Get next element for a logical position Xi
SUBROUTINE nextElementSegm(self, Xi, nextElement)
!Get the next element for a logical position Xi
SUBROUTINE neighbourElementSegm(self, Xi, neighbourElement)
IMPLICIT NONE
CLASS(meshCell1DCartSegm), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3)
CLASS(meshElement), POINTER, INTENT(out):: nextElement
CLASS(meshElement), POINTER, INTENT(out):: neighbourElement
NULLIFY(nextElement)
NULLIFY(neighbourElement)
IF (Xi(1) < -1.D0) THEN
nextElement => self%e2
neighbourElement => self%e2
ELSEIF (Xi(1) > 1.D0) THEN
nextElement => self%e1
neighbourElement => self%e1
END IF
END SUBROUTINE nextElementSegm
END SUBROUTINE neighbourElementSegm
!COMMON FUNCTIONS FOR 1D VOLUME ELEMENTS
!Calculates a random position in 1D volume
!Computes the element Jacobian determinant
PURE FUNCTION detJ1DCart(self, Xi, nNodes, dPsi_in) RESULT(dJ)
!Computes element area
PURE SUBROUTINE areaSegm(self)
IMPLICIT NONE
CLASS(meshCell1DCart), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3)
INTEGER, INTENT(in):: nNodes
REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:nNodes)
REAL(8):: dPsi(1:3,1:nNodes)
CLASS(meshCell1DCartSegm), INTENT(inout):: self
REAL(8):: Xi(1:3)
REAL(8):: dPsi(1:3, 1:2), pDer(1:3, 1:3)
REAL(8):: detJ
REAL(8):: fPsi(1:2)
self%volume = 0.D0
self%arNodes = 0.D0
!1D 1 point Gauss Quad Integral
Xi = 0.D0
dPsi = self%dPsi(Xi, 2)
pDer = self%partialDer(2, dPsi)
detJ = self%detJac(pDer)
fPsi = self%fPsi(Xi, 2)
!Computes total volume of the cell
self%volume = detJ*2.D0
!Computes volume per node
self%arNodes = fPsi*self%volume
END SUBROUTINE areaSegm
!COMMON FUNCTIONS FOR 1D VOLUME ELEMENTS
!Computes element Jacobian determinant
PURE FUNCTION detJ1DCart(pDer) RESULT(dJ)
IMPLICIT NONE
REAL(8), INTENT(in):: pDer(1:3, 1:3)
REAL(8):: dJ
REAL(8):: dx(1)
IF (PRESENT(dPsi_in)) THEN
dPsi = dPsi_in
ELSE
dPsi = self%dPsi(Xi, 2)
END IF
CALL self%partialDer(2, dPsi, dx)
dJ = dx(1)
dJ = pDer(1, 1)
END FUNCTION detJ1DCart
!Computes the invers Jacobian
PURE FUNCTION invJ1DCart(self, Xi, nNodes, dPsi_in) RESULT(invJ)
!Computes element Jacobian inverse matrix (without determinant)
PURE FUNCTION invJ1DCart(pDer) RESULT(invJ)
IMPLICIT NONE
CLASS(meshCell1DCart), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3)
INTEGER, INTENT(in):: nNodes
REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:nNodes)
REAL(8), INTENT(in):: pDer(1:3, 1:3)
REAL(8):: invJ(1:3,1:3)
REAL(8):: dPsi(1:3,1:nNodes)
REAL(8):: dx(1)
IF (PRESENT(dPsi_in)) THEN
dPsi = dPsi_in
ELSE
dPsi = self%dPsi(Xi, 2)
END IF
invJ = 0.D0
CALL self%partialDer(2, dPsi, dx)
invJ(1,1) = 1.D0/dx(1)
invJ(1, 1) = 1.D0/pDer(1, 1)
invJ(2, 2) = 1.D0
invJ(3, 3) = 1.D0
END FUNCTION invJ1DCart