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

@ -19,7 +19,8 @@ MODULE moduleMesh2DCart
!Element coordinates
REAL(8):: x = 0.D0, y = 0.D0
CONTAINS
PROCEDURE, PASS:: init => initNode2DCart
!meshNode DEFERRED PROCEDURES
PROCEDURE, PASS:: init => initNode2DCart
PROCEDURE, PASS:: getCoordinates => getCoord2DCart
END TYPE meshNode2DCart
@ -30,35 +31,16 @@ MODULE moduleMesh2DCart
!Connectivity to nodes
CLASS(meshNode), POINTER:: n1 => NULL(), n2 => NULL()
CONTAINS
PROCEDURE, PASS:: init => initEdge2DCart
PROCEDURE, PASS:: getNodes => getNodes2DCart
!meshEdge DEFERRED PROCEDURES
PROCEDURE, PASS:: init => initEdge2DCart
PROCEDURE, PASS:: getNodes => getNodes2DCart
PROCEDURE, PASS:: intersection => intersection2DCartEdge
PROCEDURE, PASS:: randPos => randPosEdge
PROCEDURE, PASS:: randPos => randPosEdge
END TYPE meshEdge2DCart
TYPE, PUBLIC, ABSTRACT, EXTENDS(meshCell):: meshCell2DCart
CONTAINS
PROCEDURE, PASS:: detJac => detJ2DCart
PROCEDURE, PASS:: invJac => invJ2DCart
PROCEDURE(partialDer_interface), DEFERRED, PASS, PRIVATE:: partialDer
END TYPE meshCell2DCart
ABSTRACT INTERFACE
PURE SUBROUTINE partialDer_interface(self, nNodes, dPsi, dx, dy)
IMPORT meshCell2DCart
CLASS(meshCell2DCart), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8), INTENT(in):: dPsi(1:3,1:nNodes)
REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy
END SUBROUTINE partialDer_interface
END INTERFACE
!Quadrilateral volume element
TYPE, PUBLIC, EXTENDS(meshCell2DCart):: meshCell2DCartQuad
TYPE, PUBLIC, EXTENDS(meshCell):: meshCell2DCartQuad
!Element coordinates
REAL(8):: x(1:4) = 0.D0, y(1:4) = 0.D0
!Connectivity to nodes
@ -68,25 +50,29 @@ MODULE moduleMesh2DCart
REAL(8):: arNodes(1:4) = 0.D0
CONTAINS
PROCEDURE, PASS:: init => initCellQuad2DCart
PROCEDURE, PASS:: randPos => randPosCellQuad
PROCEDURE, PASS:: area => areaQuad
PROCEDURE, PASS:: fPsi => fPsiQuad
PROCEDURE, PASS:: dPsi => dPsiQuad
PROCEDURE, PASS, PRIVATE:: partialDer => partialDerQuad
PROCEDURE, PASS:: elemK => elemKQuad
PROCEDURE, PASS:: elemF => elemFQuad
PROCEDURE, PASS:: gatherElectricField => gatherEFQuad
PROCEDURE, PASS:: gatherMagneticField => gatherMFQuad
PROCEDURE, NOPASS:: inside => insideQuad
PROCEDURE, PASS:: getNodes => getNodesQuad
PROCEDURE, PASS:: phy2log => phy2logQuad
PROCEDURE, PASS:: nextElement => nextElementQuad
!meshCell DEFERRED PROCEDURES
PROCEDURE, PASS:: init => initCellQuad2DCart
PROCEDURE, PASS:: getNodes => getNodesQuad
PROCEDURE, PASS:: randPos => randPosCellQuad
PROCEDURE, NOPASS:: fPsi => fPsiQuad
PROCEDURE, NOPASS:: dPsi => dPsiQuad
PROCEDURE, PASS:: partialDer => partialDerQuad
PROCEDURE, NOPASS:: detJac => detJ2DCart
PROCEDURE, NOPASS:: invJac => invJ2DCart
PROCEDURE, PASS:: gatherElectricField => gatherEFQuad
PROCEDURE, PASS:: gatherMagneticField => gatherMFQuad
PROCEDURE, PASS:: elemK => elemKQuad
PROCEDURE, PASS:: elemF => elemFQuad
PROCEDURE, NOPASS:: inside => insideQuad
PROCEDURE, PASS:: phy2log => phy2logQuad
PROCEDURE, PASS:: neighbourElement => neighbourElementQuad
!PARTICLUAR PROCEDURES
PROCEDURE, PASS, PRIVATE:: area => areaQuad
END TYPE meshCell2DCartQuad
!Triangular volume element
TYPE, PUBLIC, EXTENDS(meshCell2DCart):: meshCell2DCartTria
TYPE, PUBLIC, EXTENDS(meshCell):: meshCell2DCartTria
!Element coordinates
REAL(8):: x(1:3) = 0.D0, y(1:3) = 0.D0
!Connectivity to nodes
@ -96,20 +82,24 @@ MODULE moduleMesh2DCart
REAL(8):: arNodes(1:3) = 0.D0
CONTAINS
PROCEDURE, PASS:: init => initCellTria2DCart
PROCEDURE, PASS:: randPos => randPosCellTria
PROCEDURE, PASS:: area => areaTria
PROCEDURE, PASS:: fPsi => fPsiTria
PROCEDURE, PASS:: dPsi => dPsiTria
PROCEDURE, PASS, PRIVATE:: partialDer => partialDerTria
PROCEDURE, PASS:: elemK => elemKTria
PROCEDURE, PASS:: elemF => elemFTria
PROCEDURE, PASS:: gatherElectricField => gatherEFTria
PROCEDURE, PASS:: gatherMagneticField => gatherMFTria
PROCEDURE, NOPASS:: inside => insideTria
PROCEDURE, PASS:: getNodes => getNodesTria
PROCEDURE, PASS:: phy2log => phy2logTria
PROCEDURE, PASS:: nextElement => nextElementTria
!meshCell DEFERRED PROCEDURES
PROCEDURE, PASS:: init => initCellTria2DCart
PROCEDURE, PASS:: getNodes => getNodesTria
PROCEDURE, PASS:: randPos => randPosCellTria
PROCEDURE, NOPASS:: fPsi => fPsiTria
PROCEDURE, NOPASS:: dPsi => dPsiTria
PROCEDURE, PASS:: partialDer => partialDerTria
PROCEDURE, NOPASS:: detJac => detJ2DCart
PROCEDURE, NOPASS:: invJac => invJ2DCart
PROCEDURE, PASS:: gatherElectricField => gatherEFTria
PROCEDURE, PASS:: gatherMagneticField => gatherMFTria
PROCEDURE, PASS:: elemK => elemKTria
PROCEDURE, PASS:: elemF => elemFTria
PROCEDURE, NOPASS:: inside => insideTria
PROCEDURE, PASS:: phy2log => phy2logTria
PROCEDURE, PASS:: neighbourElement => neighbourElementTria
!PARTICULAR PROCEDURES
PROCEDURE, PASS, PRIVATE:: area => areaTria
END TYPE meshCell2DCartTria
@ -175,6 +165,7 @@ MODULE moduleMesh2DCart
r2 = self%n2%getCoordinates()
self%x = (/r1(1), r2(1)/)
self%y = (/r1(2), r2(2)/)
self%weight = 1.D0
!Normal vector
self%normal = (/ -(self%y(2)-self%y(1)), &
self%x(2)-self%x(1) , &
@ -290,84 +281,17 @@ MODULE moduleMesh2DCart
END SUBROUTINE initCellQuad2DCart
!Computes element area
PURE SUBROUTINE areaQuad(self)
IMPLICIT NONE
CLASS(meshCell2DCartQuad), INTENT(inout):: self
REAL(8):: Xi(1:3)
REAL(8):: detJ
REAL(8):: fPsi(1:4)
self%volume = 0.D0
self%arNodes = 0.D0
!2D 1 point Gauss Quad Integral
Xi = 0.D0
detJ = self%detJac(Xi, 4)*4.D0 !4
fPsi = self%fPsi(Xi, 4)
self%volume = detJ
self%arNodes = fPsi*detJ
END SUBROUTINE areaQuad
!Computes element functions in point Xi
PURE FUNCTION fPsiQuad(self, Xi, nNodes) RESULT(fPsi)
IMPLICIT NONE
CLASS(meshCell2DCartQuad), 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)) * (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
!Derivative element function at coordinates Xi
PURE FUNCTION dPsiQuad(self, Xi, nNodes) RESULT(dPsi)
IMPLICIT NONE
CLASS(meshCell2DCartQuad), 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.D0 - Xi(2)), &
(1.D0 - Xi(2)), &
(1.D0 + Xi(2)), &
-(1.D0 + Xi(2)) /)
dPsi(2,:) = (/ -(1.D0 - Xi(1)), &
-(1.D0 + Xi(1)), &
(1.D0 + Xi(1)), &
(1.D0 - Xi(1)) /)
dPsi = dPsi * 0.25D0
END FUNCTION dPsiQuad
!Partial derivative in global coordinates
PURE SUBROUTINE partialDerQuad(self, nNodes, dPsi, dx, dy)
!Get nodes from quadrilateral element
PURE FUNCTION getNodesQuad(self, nNodes) RESULT(n)
IMPLICIT NONE
CLASS(meshCell2DCartQuad), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8), INTENT(in):: dPsi(1:3,1:nNodes)
REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy
INTEGER:: n(1:nNodes)
dx = (/ DOT_PRODUCT(dPsi(1,1:4),self%x(1:4)), &
DOT_PRODUCT(dPsi(2,1:4),self%x(1:4)) /)
dy = (/ DOT_PRODUCT(dPsi(1,1:4),self%y(1:4)), &
DOT_PRODUCT(dPsi(2,1:4),self%y(1:4)) /)
n = (/ self%n1%n, self%n2%n, self%n3%n, self%n4%n /)
END SUBROUTINE partialDerQuad
END FUNCTION getNodesQuad
!Random position in quadrilateral volume
FUNCTION randPosCellQuad(self) RESULT(r)
@ -379,78 +303,77 @@ MODULE moduleMesh2DCart
REAL(8):: Xi(1:3)
REAL(8):: fPsi(1:4)
Xi = 0.D0
Xi(1) = random(-1.D0, 1.D0)
Xi(2) = random(-1.D0, 1.D0)
Xi(3) = 0.D0
fPsi = self%fPsi(Xi, 4)
r = 0.D0
r(1) = DOT_PRODUCT(fPsi, self%x)
r(2) = DOT_PRODUCT(fPsi, self%y)
r(3) = 0.D0
END FUNCTION randPosCellQuad
!Computes element local stiffness matrix
PURE FUNCTION elemKQuad(self, nNodes) RESULT(localK)
!Computes element functions in point Xi
PURE FUNCTION fPsiQuad(Xi, nNodes) RESULT(fPsi)
IMPLICIT NONE
REAL(8), INTENT(in):: Xi(1:3)
INTEGER, INTENT(in):: nNodes
REAL(8):: fPsi(1:nNodes)
fPsi = (/ (1.D0-Xi(1)) * (1.D0-Xi(2)), &
(1.D0+Xi(1)) * (1.D0-Xi(2)), &
(1.D0+Xi(1)) * (1.D0+Xi(2)), &
(1.D0-Xi(1)) * (1.D0+Xi(2)) /)
fPsi = fPsi * 0.25D0
END FUNCTION fPsiQuad
!Derivative element function at coordinates Xi
PURE FUNCTION dPsiQuad(Xi, nNodes) RESULT(dPsi)
IMPLICIT NONE
REAL(8), INTENT(in):: Xi(1:3)
INTEGER, INTENT(in):: nNodes
REAL(8):: dPsi(1:3,1:nNodes)
dPsi = 0.D0
dPsi(1, 1:4) = (/ -(1.D0 - Xi(2)), &
(1.D0 - Xi(2)), &
(1.D0 + Xi(2)), &
-(1.D0 + Xi(2)) /)
dPsi(2, 1:4) = (/ -(1.D0 - Xi(1)), &
-(1.D0 + Xi(1)), &
(1.D0 + Xi(1)), &
(1.D0 - Xi(1)) /)
dPsi = dPsi * 0.25D0
END FUNCTION dPsiQuad
!Partial derivative in global coordinates
PURE FUNCTION partialDerQuad(self, nNodes, dPsi) RESULT(pDer)
IMPLICIT NONE
CLASS(meshCell2DCartQuad), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8):: localK(1:nNodes,1:nNodes)
REAL(8):: Xi(1:3)
REAL(8):: fPsi(1:4), dPsi(1:3,1:4)
REAL(8):: invJ(1:3,1:3), detJ
INTEGER:: l, m
REAL(8), INTENT(in):: dPsi(1:3,1:nNodes)
REAL(8):: pDer(1:3, 1:3)
localK=0.D0
Xi=0.D0
!Start 2D Gauss Quad Integral
DO l=1, 3
Xi(2) = corQuad(l)
DO m = 1, 3
Xi(1) = corQuad(m)
fPsi = self%fPsi(Xi, 4)
dPsi = self%dPsi(Xi, 4)
detJ = self%detJac(Xi, 4, dPsi)
invJ = self%invJac(Xi, 4, dPsi)
localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)), &
MATMUL(invJ,dPsi))* &
wQuad(l)*wQuad(m)/detJ
pDer = 0.D0
END DO
END DO
pDer(1, 1:2) = (/ DOT_PRODUCT(dPsi(1,1:4),self%x(1:4)), &
DOT_PRODUCT(dPsi(2,1:4),self%x(1:4)) /)
pDer(2, 1:2) = (/ DOT_PRODUCT(dPsi(1,1:4),self%y(1:4)), &
DOT_PRODUCT(dPsi(2,1:4),self%y(1:4)) /)
pDer(3,3) = 1.D0
END FUNCTION elemKQuad
!Computes the local source vector for a force f
PURE FUNCTION elemFQuad(self, nNodes, source) RESULT(localF)
IMPLICIT NONE
CLASS(meshCell2DCartQuad), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8), INTENT(in):: source(1:nNodes)
REAL(8):: localF(1:nNodes)
REAL(8):: Xi(1:3)
REAL(8):: fPsi(1:4)
REAL(8):: detJ, f
INTEGER:: l, m
localF = 0.D0
Xi = 0.D0
DO l=1, 3
Xi(1) = corQuad(l)
DO m = 1, 3
Xi(2) = corQuad(m)
detJ = self%detJac(Xi, 4)
fPsi = self%fPsi(Xi, 4)
f = DOT_PRODUCT(fPsi,source)
localF = localF + f*fPsi*wQuad(l)*wQuad(m)*detJ
END DO
END DO
END FUNCTION elemFQuad
END FUNCTION partialDerQuad
PURE FUNCTION gatherEFQuad(self, Xi) RESULT(array)
IMPLICIT NONE
@ -494,6 +417,75 @@ MODULE moduleMesh2DCart
END FUNCTION gatherMFQuad
!Computes element local stiffness matrix
PURE FUNCTION elemKQuad(self, nNodes) RESULT(localK)
IMPLICIT NONE
CLASS(meshCell2DCartQuad), 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:4)
REAL(8):: pDer(1:3, 1:3)
REAL(8):: r
REAL(8):: invJ(1:3,1:3), detJ
INTEGER:: l, m
localK = 0.D0
Xi = 0.D0
!Start 2D Gauss Quad Integral
DO l = 1, 3
Xi(2) = corQuad(l)
DO m = 1, 3
Xi(1) = corQuad(m)
dPsi = self%dPsi(Xi, 4)
pDer = self%partialDer(4, dPsi)
detJ = self%detJac(pDer)
invJ = self%invJac(pDer)
localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)), &
MATMUL(invJ,dPsi))* &
wQuad(l)*wQuad(m)/detJ
END DO
END DO
END FUNCTION elemKQuad
!Computes the local source vector for a force f
PURE FUNCTION elemFQuad(self, nNodes, source) RESULT(localF)
IMPLICIT NONE
CLASS(meshCell2DCartQuad), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8), INTENT(in):: source(1:nNodes)
REAL(8):: localF(1:nNodes)
REAL(8):: Xi(1:3)
REAL(8):: fPsi(1:4)
REAL(8):: dPsi(1:3, 1:4)
REAL(8):: pDer(1:3, 1:3)
REAL(8):: detJ, f
INTEGER:: l, m
localF = 0.D0
Xi = 0.D0
DO l = 1, 3
Xi(1) = corQuad(l)
DO m = 1, 3
Xi(2) = corQuad(m)
dPsi = self%dPsi(Xi, 4)
pDer = self%partialDer(4, dPsi)
detJ = self%detJac(pDer)
fPsi = self%fPsi(Xi, 4)
f = DOT_PRODUCT(fPsi,source)
localF = localF + f*fPsi*wQuad(l)*wQuad(m)*detJ
END DO
END DO
END FUNCTION elemFQuad
!Checks if a particle is inside a quad element
PURE FUNCTION insideQuad(Xi) RESULT(ins)
IMPLICIT NONE
@ -506,18 +498,6 @@ MODULE moduleMesh2DCart
END FUNCTION insideQuad
!Gets nodes from quadrilateral element
PURE FUNCTION getNodesQuad(self, nNodes) RESULT(n)
IMPLICIT NONE
CLASS(meshCell2DCartQuad), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
INTEGER:: n(1:nNodes)
n = (/self%n1%n, self%n2%n, self%n3%n, self%n4%n /)
END FUNCTION getNodesQuad
!Transforms physical coordinates to element coordinates
PURE FUNCTION phy2logQuad(self,r) RESULT(Xi)
IMPLICIT NONE
@ -527,6 +507,7 @@ MODULE moduleMesh2DCart
REAL(8):: Xi(1:3)
REAL(8):: XiO(1:3), detJ, invJ(1:3,1:3), f(1:3)
REAL(8):: dPsi(1:3,1:4), fPsi(1:4)
REAL(8):: pDer(1:3, 1:3)
REAL(8):: conv
!Iterative newton method to transform coordinates
@ -535,7 +516,9 @@ MODULE moduleMesh2DCart
DO WHILE(conv > 1.D-2)
dPsi = self%dPsi(XiO, 4)
invJ = self%invJac(XiO, 4, dPsi)
pDer = self%partialDer(4, dPsi)
detJ = self%detJac(pDer)
invJ = self%invJac(pDer)
fPsi = self%fPsi(XiO, 4)
f = (/ DOT_PRODUCT(fPsi,self%x), &
DOT_PRODUCT(fPsi,self%y), &
@ -550,31 +533,56 @@ MODULE moduleMesh2DCart
END FUNCTION phy2logQuad
!Gets the next element for a logical position Xi
SUBROUTINE nextElementQuad(self, Xi, nextElement)
SUBROUTINE neighbourElementQuad(self, Xi, neighbourElement)
IMPLICIT NONE
CLASS(meshCell2DCartQuad), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3)
CLASS(meshElement), POINTER, INTENT(out):: nextElement
CLASS(meshElement), POINTER, INTENT(out):: neighbourElement
REAL(8):: XiArray(1:4)
INTEGER:: nextInt
XiArray = (/ -Xi(2), Xi(1), Xi(2), -Xi(1) /)
nextInt = MAXLOC(XiArray,1)
!Selects the higher value of directions and searches in that direction
NULLIFY(nextElement)
NULLIFY(neighbourElement)
SELECT CASE (nextInt)
CASE (1)
nextElement => self%e1
neighbourElement => self%e1
CASE (2)
nextElement => self%e2
neighbourElement => self%e2
CASE (3)
nextElement => self%e3
neighbourElement => self%e3
CASE (4)
nextElement => self%e4
neighbourElement => self%e4
END SELECT
END SUBROUTINE nextElementQuad
END SUBROUTINE neighbourElementQuad
!Computes element area
PURE SUBROUTINE areaQuad(self)
IMPLICIT NONE
CLASS(meshCell2DCartQuad), INTENT(inout):: self
REAL(8):: Xi(1:3)
REAL(8):: detJ
REAL(8):: fPsi(1:4)
REAL(8):: dPsi(1:3, 1:4), pDer(1:3, 1:3)
self%volume = 0.D0
self%arNodes = 0.D0
!2D 1 point Gauss Quad Integral
Xi = 0.D0
dPsi = self%dPsi(Xi, 4)
pDer = self%partialDer(4, dPsi)
detJ = self%detJac(pDer)
fPsi = self%fPsi(Xi, 4)
!Computes total volume of the cell
self%volume = detJ
!Computes volume per node
self%arNodes = fPsi*detJ
END SUBROUTINE areaQuad
!TRIA ELEMENT
!Init tria element
@ -617,6 +625,18 @@ MODULE moduleMesh2DCart
END SUBROUTINE initCellTria2DCart
!Gets node indexes from triangular element
PURE FUNCTION getNodesTria(self, nNodes) RESULT(n)
IMPLICIT NONE
CLASS(meshCell2DCartTria), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
INTEGER:: n(1:nNodes)
n = (/self%n1%n, self%n2%n, self%n3%n /)
END FUNCTION getNodesTria
!Random position in quadrilateral volume
FUNCTION randPosCellTria(self) RESULT(r)
USE moduleRandom
@ -639,31 +659,10 @@ MODULE moduleMesh2DCart
END FUNCTION randPosCellTria
!Calculates area for triangular element
PURE SUBROUTINE areaTria(self)
IMPLICIT NONE
CLASS(meshCell2DCartTria), INTENT(inout):: self
REAL(8):: Xi(1:3)
REAL(8):: detJ
REAL(8):: fPsi(1:3)
self%volume = 0.D0
self%arNodes = 0.D0
!2D 1 point Gauss Quad Integral
Xi = (/1.D0/3.D0, 1.D0/3.D0, 0.D0 /)
detJ = self%detJac(Xi, 4)/2.D0
fPsi = self%fPsi(Xi, 4)
self%volume = detJ
self%arNodes = fPsi*detJ
END SUBROUTINE areaTria
!Shape functions for triangular element
PURE FUNCTION fPsiTria(self, Xi, nNodes) RESULT(fPsi)
PURE FUNCTION fPsiTria(Xi, nNodes) RESULT(fPsi)
IMPLICIT NONE
CLASS(meshCell2DCartTria), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3)
INTEGER, INTENT(in):: nNodes
REAL(8):: fPsi(1:nNodes)
@ -675,10 +674,9 @@ MODULE moduleMesh2DCart
END FUNCTION fPsiTria
!Derivative element function at coordinates Xi
PURE FUNCTION dPsiTria(self, Xi, nNodes) RESULT(dPsi)
PURE FUNCTION dPsiTria(Xi, nNodes) RESULT(dPsi)
IMPLICIT NONE
CLASS(meshCell2DCartTria), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3)
INTEGER, INTENT(in):: nNodes
REAL(8):: dPsi(1:3,1:nNodes)
@ -690,76 +688,22 @@ MODULE moduleMesh2DCart
END FUNCTION dPsiTria
PURE SUBROUTINE partialDerTria(self, nNodes, dPsi, dx, dy)
PURE FUNCTION partialDerTria(self, nNodes, dPsi) RESULT(pDer)
IMPLICIT NONE
CLASS(meshCell2DCartTria), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8), INTENT(in):: dPsi(1:3,1:nNodes)
REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy
REAL(8):: pDer(1:3, 1:3)
dx = (/ DOT_PRODUCT(dPsi(1,:),self%x), &
DOT_PRODUCT(dPsi(2,:),self%x) /)
dy = (/ DOT_PRODUCT(dPsi(1,:),self%y), &
DOT_PRODUCT(dPsi(2,:),self%y) /)
pDer = 0.D0
END SUBROUTINE partialDerTria
pDer(1, 1:2) = (/ DOT_PRODUCT(dPsi(1,1:3),self%x(1:3)), &
DOT_PRODUCT(dPsi(2,1:3),self%x(1:3)) /)
pDer(2, 1:2) = (/ DOT_PRODUCT(dPsi(1,1:3),self%y(1:3)), &
DOT_PRODUCT(dPsi(2,1:3),self%y(1:3)) /)
!Computes element local stiffness matrix
PURE FUNCTION elemKTria(self, nNodes) RESULT(localK)
IMPLICIT NONE
CLASS(meshCell2DCartTria), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8):: localK(1:nNodes,1:nNodes)
REAL(8):: Xi(1:3)
REAL(8):: fPsi(1:3), dPsi(1:3,1:3)
REAL(8):: invJ(1:3,1:3), detJ
INTEGER:: l
localK=0.D0
Xi=0.D0
!Start 2D Gauss Quad Integral
DO l=1, 4
Xi(1) = Xi1Tria(l)
Xi(2) = Xi2Tria(l)
dPsi = self%dPsi(Xi, 3)
detJ = self%detJac(Xi, 3, dPsi)
invJ = self%invJac(Xi, 3, dPsi)
fPsi = self%fPsi(Xi, 3)
localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*wTria(l)/detJ
END DO
END FUNCTION elemKTria
!Computes element local source vector
PURE FUNCTION elemFTria(self, nNodes, source) RESULT(localF)
IMPLICIT NONE
CLASS(meshCell2DCartTria), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8), INTENT(in):: source(1:nNodes)
REAL(8):: localF(1:nNodes)
REAL(8):: fPsi(1:3)
REAL(8):: Xi(1:3)
REAL(8):: detJ, f
INTEGER:: l
localF = 0.D0
Xi = 0.D0
!Start 2D Gauss Quad Integral
DO l=1, 4
Xi(1) = Xi1Tria(l)
Xi(2) = Xi2Tria(l)
detJ = self%detJac(Xi, 3)
fPsi = self%fPsi(Xi, 3)
f = DOT_PRODUCT(fPsi,source)
localF = localF + f*fPsi*wTria(l)*detJ
END DO
END FUNCTION elemFTria
END FUNCTION partialDerTria
PURE FUNCTION gatherEFTria(self, Xi) RESULT(array)
IMPLICIT NONE
@ -799,6 +743,66 @@ MODULE moduleMesh2DCart
END FUNCTION gatherMFTria
!Computes element local stiffness matrix
PURE FUNCTION elemKTria(self, nNodes) RESULT(localK)
IMPLICIT NONE
CLASS(meshCell2DCartTria), 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:3)
REAL(8):: pDer(1:3, 1:3)
REAL(8):: invJ(1:3,1:3), detJ
INTEGER:: l
localK=0.D0
Xi=0.D0
!Start 2D Gauss Quad Integral
DO l=1, 4
Xi(1) = Xi1Tria(l)
Xi(2) = Xi2Tria(l)
dPsi = self%dPsi(Xi, 3)
pDer = self%partialDer(3, dPsi)
detJ = self%detJac(pDer)
invJ = self%invJac(pDer)
localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*wTria(l)/detJ
END DO
END FUNCTION elemKTria
!Computes element local source vector
PURE FUNCTION elemFTria(self, nNodes, source) RESULT(localF)
IMPLICIT NONE
CLASS(meshCell2DCartTria), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8), INTENT(in):: source(1:nNodes)
REAL(8):: localF(1:nNodes)
REAL(8):: fPsi(1:3)
REAL(8):: dPsi(1:3, 1:3), pDer(1:3, 1:3)
REAL(8):: Xi(1:3)
REAL(8):: detJ, f
INTEGER:: l
localF = 0.D0
Xi = 0.D0
!Start 2D Gauss Quad Integral
DO l=1, 4
Xi(1) = Xi1Tria(l)
Xi(2) = Xi2Tria(l)
dPsi = self%dPsi(Xi, 3)
pDer = self%partialDer(3, dPsi)
detJ = self%detJac(pDer)
fPsi = self%fPsi(Xi, 3)
f = DOT_PRODUCT(fPsi,source)
localF = localF + f*fPsi*wTria(l)*detJ
END DO
END FUNCTION elemFTria
PURE FUNCTION insideTria(Xi) RESULT(ins)
IMPLICIT NONE
@ -811,18 +815,6 @@ MODULE moduleMesh2DCart
END FUNCTION insideTria
!Gets node indexes from triangular element
PURE FUNCTION getNodesTria(self, nNodes) RESULT(n)
IMPLICIT NONE
CLASS(meshCell2DCartTria), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
INTEGER:: n(1:nNodes)
n = (/self%n1%n, self%n2%n, self%n3%n /)
END FUNCTION getNodesTria
!Transforms physical coordinates to element coordinates
PURE FUNCTION phy2logTria(self,r) RESULT(Xi)
IMPLICIT NONE
@ -830,96 +822,94 @@ MODULE moduleMesh2DCart
CLASS(meshCell2DCartTria), INTENT(in):: self
REAL(8), INTENT(in):: r(1:3)
REAL(8):: Xi(1:3)
REAL(8):: invJ(1:3,1:3), detJ
REAL(8):: deltaR(1:3)
REAL(8):: dPsi(1:3,1:3)
REAL(8):: dPsi(1:3, 1:3)
REAL(8):: pDer(1:3, 1:3)
REAL(8):: invJ(1:3, 1:3), detJ
!Direct method to convert coordinates
Xi = 0.D0
deltaR = (/ r(1) - self%x(1), r(2) - self%y(1), 0.D0 /)
dPsi = self%dPsi(Xi, 3)
invJ = self%invJac(Xi, 3, dPsi)
detJ = self%detJac(Xi, 3, dPsi)
pDer = self%partialDer(3, dPsi)
invJ = self%invJac(pDer)
detJ = self%detJac(pDer)
Xi = MATMUL(invJ,deltaR)/detJ
END FUNCTION phy2logTria
SUBROUTINE nextElementTria(self, Xi, nextElement)
SUBROUTINE neighbourElementTria(self, Xi, neighbourElement)
IMPLICIT NONE
CLASS(meshCell2DCartTria), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3)
CLASS(meshElement), POINTER, INTENT(out):: nextElement
CLASS(meshElement), POINTER, INTENT(out):: neighbourElement
REAL(8):: XiArray(1:3)
INTEGER:: nextInt
XiArray = (/ Xi(2), 1.D0-Xi(1)-Xi(2), Xi(1) /)
nextInt = MINLOC(XiArray,1)
NULLIFY(nextElement)
NULLIFY(neighbourElement)
SELECT CASE (nextInt)
CASE (1)
nextElement => self%e1
neighbourElement => self%e1
CASE (2)
nextElement => self%e2
neighbourElement => self%e2
CASE (3)
nextElement => self%e3
neighbourElement => self%e3
END SELECT
END SUBROUTINE nextElementTria
END SUBROUTINE neighbourElementTria
!Calculates area for triangular element
PURE SUBROUTINE areaTria(self)
IMPLICIT NONE
CLASS(meshCell2DCartTria), INTENT(inout):: self
REAL(8):: Xi(1:3)
REAL(8):: dPsi(1:3, 1:3), pDer(1:3, 1:3)
REAL(8):: detJ
REAL(8):: fPsi(1:3)
self%volume = 0.D0
self%arNodes = 0.D0
!2D 1 point Gauss Quad Integral
Xi = (/ 1.D0/3.D0, 1.D0/3.D0, 0.D0 /)
dPsi = self%dPsi(Xi, 3)
pDer = self%partialDer(3, dPsi)
detJ = self%detJac(pDer)
fPsi = self%fPsi(Xi, 4)
!Computes total volume of the cell
self%volume = detJ
!Computes volume per node
self%arNodes = fPsi*detJ
END SUBROUTINE areaTria
!COMMON FUNCTIONS FOR CARTESIAN VOLUME ELEMENTS IN 2D
!Computes element Jacobian determinant
PURE FUNCTION detJ2DCart(self, Xi, nNodes, dPsi_in) RESULT(dJ)
PURE FUNCTION detJ2DCart(pDer) RESULT(dJ)
IMPLICIT NONE
CLASS(meshCell2DCart), 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):: dJ
REAL(8):: dPsi(1:3,1:nNodes)
REAL(8):: dx(1:2), dy(1:2)
IF(PRESENT(dPsi_in)) THEN
dPsi = dPsi_in
ELSE
dPsi = self%dPsi(Xi, 4)
END IF
CALL self%partialDer(nNodes, dPsi, dx, dy)
dJ = dx(1)*dy(2)-dx(2)*dy(1)
dJ = pDer(1,1)*pDer(2,2)-pDer(1,2)*pDer(2,1)
END FUNCTION detJ2DCart
!Computes element Jacobian inverse matrix (without determinant)
PURE FUNCTION invJ2DCart(self, Xi, nNodes, dPsi_in) RESULT(invJ)
PURE FUNCTION invJ2DCart(pDer) RESULT(invJ)
IMPLICIT NONE
CLASS(meshCell2DCart), 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:2), dy(1:2)
IF(PRESENT(dPsi_in)) THEN
dPsi=dPsi_in
ELSE
dPsi = self%dPsi(Xi, 4)
END IF
invJ = 0.D0
CALL self%partialDer(nNodes, dPsi, dx, dy)
invJ(1,1:2) = (/ dy(2), -dx(2) /)
invJ(2,1:2) = (/ -dy(1), dx(1) /)
invJ(1, 1:2) = (/ pDer(2,2), -pDer(1,2) /)
invJ(2, 1:2) = (/ -pDer(2,1), pDer(1,1) /)
invJ(3, 3) = 1.D0
END FUNCTION invJ2DCart