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

@ -8,13 +8,14 @@ MODULE moduleMesh1DRad
IMPLICIT NONE
REAL(8), PARAMETER:: corSeg(1:3) = (/ -DSQRT(3.D0/5.D0), 0.D0, DSQRT(3.D0/5.D0) /)
REAL(8), PARAMETER:: wSeg(1:3) = (/ 5.D0/9.D0 , 8.D0/9.D0, 5.D0/9.D0 /)
REAL(8), PARAMETER:: wSeg(1:3) = (/ 5.D0/9.D0 , 8.D0/9.D0, 5.D0/9.D0 /)
TYPE, PUBLIC, EXTENDS(meshNode):: meshNode1DRad
!Element coordinates
REAL(8):: r = 0.D0
CONTAINS
PROCEDURE, PASS:: init => initNode1DRad
!meshNode DEFERRED PROCEDURES
PROCEDURE, PASS:: init => initNode1DRad
PROCEDURE, PASS:: getCoordinates => getCoord1DRad
END TYPE meshNode1DRad
@ -25,6 +26,7 @@ MODULE moduleMesh1DRad
!Connectivity to nodes
CLASS(meshNode), POINTER:: n1 => NULL()
CONTAINS
!meshEdge DEFERRED PROCEDURES
PROCEDURE, PASS:: init => initEdge1DRad
PROCEDURE, PASS:: getNodes => getNodes1DRad
PROCEDURE, PASS:: intersection => intersection1DRad
@ -32,28 +34,7 @@ MODULE moduleMesh1DRad
END TYPE meshEdge1DRad
TYPE, PUBLIC, ABSTRACT, EXTENDS(meshCell):: meshCell1DRad
CONTAINS
PROCEDURE, PASS:: detJac => detJ1DRad
PROCEDURE, PASS:: invJac => invJ1DRad
PROCEDURE(partialDer_interface), DEFERRED, PASS:: partialDer
END TYPE meshCell1DRad
ABSTRACT INTERFACE
PURE SUBROUTINE partialDer_interface(self, nNodes, dPsi, dx)
IMPORT meshCell1DRad
CLASS(meshCell1DRad), 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(meshCell1DRad):: meshCell1DRadSegm
TYPE, PUBLIC, EXTENDS(meshCell):: meshCell1DRadSegm
!Element coordinates
REAL(8):: r(1:2)
!Connectivity to nodes
@ -62,20 +43,24 @@ MODULE moduleMesh1DRad
CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL()
REAL(8):: arNodes(1:2)
CONTAINS
PROCEDURE, PASS:: init => initCell1DRadSegm
PROCEDURE, PASS:: randPos => randPos1DRadSeg
PROCEDURE, PASS:: area => areaRad
PROCEDURE, PASS:: fPsi => fPsiRad
PROCEDURE, PASS:: dPsi => dPsiRad
PROCEDURE, PASS:: partialDer => partialDerRad
PROCEDURE, PASS:: elemK => elemKRad
PROCEDURE, PASS:: elemF => elemFRad
PROCEDURE, PASS:: gatherElectricField => gatherEFRad
PROCEDURE, PASS:: gatherMagneticField => gatherMFRad
PROCEDURE, NOPASS:: inside => insideRad
PROCEDURE, PASS:: getNodes => getNodesRad
PROCEDURE, PASS:: phy2log => phy2logRad
PROCEDURE, PASS:: nextElement => nextElementRad
!meshCell DEFERRED PROCEDURES
PROCEDURE, PASS:: init => initCell1DRadSegm
PROCEDURE, PASS:: getNodes => getNodesSegm
PROCEDURE, PASS:: randPos => randPos1DRadSegm
PROCEDURE, NOPASS:: fPsi => fPsiSegm
PROCEDURE, NOPASS:: dPsi => dPsiSegm
PROCEDURE, PASS:: partialDer => partialDerSegm
PROCEDURE, NOPASS:: detJac => detJ1DRad
PROCEDURE, NOPASS:: invJac => invJ1DRad
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 meshCell1DRadSegm
@ -139,7 +124,6 @@ MODULE moduleMesh1DRad
self%r = r1(1)
self%normal = (/ 1.D0, 0.D0, 0.D0 /)
self%normal = self%normal/NORM2(self%normal)
!Boundary index
self%boundary => boundary(bt)
@ -221,8 +205,20 @@ MODULE moduleMesh1DRad
END SUBROUTINE initCell1DRadSegm
!Calculates a random position in 1D volume
FUNCTION randPos1DRadSeg(self) RESULT(r)
!Get nodes from 1D volume
PURE FUNCTION getNodesSegm(self, nNodes) RESULT(n)
IMPLICIT NONE
CLASS(meshCell1DRadSegm), 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 randPos1DRadSegm(self) RESULT(r)
USE moduleRandom
IMPLICIT NONE
@ -231,152 +227,63 @@ MODULE moduleMesh1DRad
REAL(8):: Xi(1:3)
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%r)
END FUNCTION randPos1DRadSeg
!Computes element area
PURE SUBROUTINE areaRad(self)
IMPLICIT NONE
CLASS(meshCell1DRadSegm), INTENT(inout):: self
REAL(8):: l !element length
REAL(8):: fPsi(1:2), fPsi_node(1:2)
REAL(8):: r
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)
!Computes total volume of the cell
r = DOT_PRODUCT(fPsi, self%r)
l = 2.D0*detJ
self%volume = r*l
!Computes volume per node
Xi = (/-5.D-1, 0.D0, 0.D0/)
r = self%gatherF(Xi, 2, self%r)
self%arNodes(1) = fPsi(1)*r*l
Xi = (/ 5.D-1, 0.D0, 0.D0/)
r = self%gatherF(Xi, 2, self%r)
self%arNodes(2) = fPsi(2)*r*l
END SUBROUTINE areaRad
END FUNCTION randPos1DRadSegm
!Computes element functions at point Xi
PURE FUNCTION fPsiRad(self, Xi, nNodes) RESULT(fPsi)
PURE FUNCTION fPsiSegm(Xi, nNodes) RESULT(fPsi)
IMPLICIT NONE
CLASS(meshCell1DRadSegm), 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 fPsiRad
END FUNCTION fPsiSegm
!Computes element derivative shape function at Xi
PURE FUNCTION dPsiRad(self, Xi, nNodes) RESULT(dPsi)
!Derivative element function at coordinates Xi
PURE FUNCTION dPsiSegm(Xi, nNodes) RESULT(dPsi)
IMPLICIT NONE
CLASS(meshCell1DRadSegm), 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 dPsiRad
END FUNCTION dPsiSegm
!Computes partial derivatives of coordinates
PURE SUBROUTINE partialDerRad(self, nNodes, dPsi, dx)
!Partial derivative in global coordinates
PURE FUNCTION partialDerSegm(self, nNodes, dPsi) RESULT(pDer)
IMPLICIT NONE
CLASS(meshCell1DRadSegm), 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%r)
pDer = 0.D0
END SUBROUTINE partialDerRad
pDer(1,1) = DOT_PRODUCT(dPsi(1,1:2), self%r(1:2))
pDer(2,2) = 1.D0
pDer(3,3) = 1.D0
!Computes local stiffness matrix
PURE FUNCTION elemKRad(self, nNodes) RESULT(localK)
USE moduleConstParam, ONLY: PI2
IMPLICIT NONE
END FUNCTION partialDerSegm
CLASS(meshCell1DRadSegm), 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
REAL(8):: r, fPsi(1:2)
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)
fPsi = self%fPsi(Xi, 2)
r = DOT_PRODUCT(fPsi, self%r)
localK = localK + MATMUL(RESHAPE(MATMUL(invJ,dPsi), (/ 2, 1/)), &
RESHAPE(MATMUL(invJ,dPsi), (/ 1, 2/)))* &
r*wSeg(l)/detJ
END DO
localK = localK*PI2
END FUNCTION elemKRad
PURE FUNCTION elemFRad(self, nNodes, source) RESULT(localF)
USE moduleConstParam, ONLY: PI2
IMPLICIT NONE
CLASS(meshCell1DRadSegm), 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, r
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)
r = DOT_PRODUCT(fPsi, self%r)
f = DOT_PRODUCT(fPsi, source)
localF = localF + f*fPsi*r*wSeg(l)*detJ
END DO
END FUNCTION elemFRad
PURE FUNCTION gatherEFRad(self, Xi) RESULT(array)
PURE FUNCTION gatherEFSegm(self, Xi) RESULT(array)
IMPLICIT NONE
CLASS(meshCell1DRadSegm), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3)
@ -388,9 +295,9 @@ MODULE moduleMesh1DRad
array = -self%gatherDF(Xi, 2, phi)
END FUNCTION gatherEFRad
END FUNCTION gatherEFSegm
PURE FUNCTION gatherMFRad(self, Xi) RESULT(array)
PURE FUNCTION gatherMFSegm(self, Xi) RESULT(array)
IMPLICIT NONE
CLASS(meshCell1DRadSegm), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3)
@ -408,9 +315,79 @@ MODULE moduleMesh1DRad
array = self%gatherF(Xi, 2, B)
END FUNCTION gatherMFRad
END FUNCTION gatherMFSegm
PURE FUNCTION insideRad(Xi) RESULT(ins)
!Computes element local stiffness matrix
PURE FUNCTION elemKSegm(self, nNodes) RESULT(localK)
USE moduleConstParam, ONLY: PI2
IMPLICIT NONE
CLASS(meshCell1DRadSegm), 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):: r
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)
r = self%gatherF(Xi, 4, self%r)
localK = localK + MATMUL(RESHAPE(MATMUL(invJ,dPsi), (/ 2, 1/)), &
RESHAPE(MATMUL(invJ,dPsi), (/ 1, 2/)))* &
r*wSeg(l)/detJ
END DO
localK = localK*PI2
END FUNCTION elemKSegm
!Computes the local source vector for a force f
PURE FUNCTION elemFSegm(self, nNodes, source) RESULT(localF)
USE moduleConstParam, ONLY: PI2
IMPLICIT NONE
CLASS(meshCell1DRadSegm), 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
REAL(8):: r
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)
r = DOT_PRODUCT(fPsi, self%r)
f = DOT_PRODUCT(fPsi, source)
localF = localF + r*f*fPsi*wSeg(l)*detJ
END DO
localF = localF*PI2
END FUNCTION elemFSegm
PURE FUNCTION insideSegm(Xi) RESULT(ins)
IMPLICIT NONE
REAL(8), INTENT(in):: Xi(1:3)
@ -419,102 +396,97 @@ MODULE moduleMesh1DRad
ins = Xi(1) >=-1.D0 .AND. &
Xi(1) <= 1.D0
END FUNCTION insideRad
END FUNCTION insideSegm
!Get nodes from 1D volume
PURE FUNCTION getNodesRad(self, nNodes) RESULT(n)
IMPLICIT NONE
CLASS(meshCell1DRadSegm), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
INTEGER:: n(1:nNodes)
n = (/ self%n1%n, self%n2%n /)
END FUNCTION getNodesRad
PURE FUNCTION phy2logRad(self, r) RESULT(xN)
PURE FUNCTION phy2logSegm(self, r) RESULT(Xi)
IMPLICIT NONE
CLASS(meshCell1DRadSegm), 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%r(1))/(self%r(2) - self%r(1)) - 1.D0
Xi = 0.D0
END FUNCTION phy2logRad
Xi(1) = 2.D0*(r(1) - self%r(1))/(self%r(2) - self%r(1)) - 1.D0
!Get next element for a logical position Xi
SUBROUTINE nextElementRad(self, Xi, nextElement)
END FUNCTION phy2logSegm
!Get the next element for a logical position Xi
SUBROUTINE neighbourElementSegm(self, Xi, neighbourElement)
IMPLICIT NONE
CLASS(meshCell1DRadSegm), 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 nextElementRad
END SUBROUTINE neighbourElementSegm
!COMMON FUNCTIONS FOR 1D VOLUME ELEMENTS
!Computes the element Jacobian determinant
PURE FUNCTION detJ1DRad(self, Xi, nNodes, dPsi_in) RESULT(dJ)
!Computes element area
PURE SUBROUTINE areaSegm(self)
USE moduleConstParam, ONLY: PI
IMPLICIT NONE
CLASS(meshCell1DRad), 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(meshCell1DRadSegm), 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)
REAL(8):: r
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
r = DOT_PRODUCT(fPsi, self%r)
self%volume = r*detJ*2.D0*PI !2PI
!Computes volume per node
Xi = (/-5.D-1, 0.D0, 0.D0/)
r = self%gatherF(Xi, 2, self%r)
self%arNodes(1) = fPsi(1)*self%volume
Xi = (/ 5.D-1, 0.D0, 0.D0/)
r = self%gatherF(Xi, 2, self%r)
self%arNodes(2) = fPsi(2)*self%volume
END SUBROUTINE areaSegm
!COMMON FUNCTIONS FOR 1D VOLUME ELEMENTS
!Computes element Jacobian determinant
PURE FUNCTION detJ1DRad(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(nNodes, dPsi, dx)
dJ = dx(1)
dJ = pDer(1, 1)
END FUNCTION detJ1DRad
!Computes the invers Jacobian
PURE FUNCTION invJ1DRad(self, Xi, nNodes, dPsi_in) RESULT(invJ)
!Computes element Jacobian inverse matrix (without determinant)
PURE FUNCTION invJ1DRad(pDer) RESULT(invJ)
IMPLICIT NONE
CLASS(meshCell1DRad), 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)
REAL(8):: dx(1)
REAL(8), INTENT(in):: pDer(1:3, 1:3)
REAL(8):: invJ(1:3,1:3)
IF (PRESENT(dPsi_in)) THEN
dPsi = dPsi_in
ELSE
dPsi = self%dPsi(Xi, 2)
END IF
invJ = 0.D0
CALL self%partialDer(nNodes, 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 invJ1DRad