DOES NOT COMPILE: Break

Small break of changing functions.
Still some geometries to change.
This commit is contained in:
Jorge Gonzalez 2023-01-06 12:16:54 +01:00
commit ba272de4e3
3 changed files with 589 additions and 680 deletions

View file

@ -11,6 +11,7 @@ MODULE moduleMesh3DCart
!Element coordinates
REAL(8):: x, y, z
CONTAINS
!meshNode DEFERRED PROCEDURES
PROCEDURE, PASS:: init => initNode3DCart
PROCEDURE, PASS:: getCoordinates => getCoord3DCart
@ -23,36 +24,18 @@ MODULE moduleMesh3DCart
!Connectivity to nodes
CLASS(meshNode), POINTER:: n1 => NULL(), n2 => NULL(), n3 => NULL()
CONTAINS
!meshEdge DEFERRED PROCEDURES
PROCEDURE, PASS:: init => initEdge3DCartTria
PROCEDURE, PASS:: getNodes => getNodes3DCartTria
PROCEDURE, PASS:: intersection => intersection3DCartTria
PROCEDURE, PASS:: randPos => randPosEdgeTria
!PARTICULAR PROCEDURES
PROCEDURE, NOPASS:: fPsi => fPsiEdgeTria
END TYPE meshEdge3DCartTria
TYPE, PUBLIC, ABSTRACT, EXTENDS(meshCell):: meshCell3DCart
CONTAINS
PROCEDURE, PASS:: detJac => detJ3DCart
PROCEDURE, PASS:: invJac => invJ3DCart
PROCEDURE(partialDer_interface), DEFERRED, PASS:: partialDer
END TYPE meshCell3DCart
ABSTRACT INTERFACE
PURE SUBROUTINE partialDer_interface(self, nNodes, dPsi, dx, dy, dz)
IMPORT meshCell3DCart
CLASS(meshCell3DCart), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8), INTENT(in):: dPsi(1:3,1:nNodes)
REAL(8), INTENT(out), DIMENSION(1:3):: dx, dy, dz
END SUBROUTINE partialDer_interface
END INTERFACE
!Tetrahedron volume element
TYPE, PUBLIC, EXTENDS(meshCell3DCart):: meshCell3DCartTetra
TYPE, PUBLIC, EXTENDS(meshCell):: meshCell3DCartTetra
!Element Coordinates
REAL(8):: x(1:4) = 0.D0, y(1:4) = 0.D0, z(1:4) = 0.D0
!Connectivity to nodes
@ -60,22 +43,24 @@ MODULE moduleMesh3DCart
!Connectivity to adjacent elements
CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL(), e3 => NULL(), e4 => NULL()
CONTAINS
PROCEDURE, PASS:: init => initCellTetra
PROCEDURE, PASS:: randPos => randPosCellTetra
PROCEDURE, PASS:: calcCell => volumeTetra
PROCEDURE, PASS:: fPsi => fPsiTetra
PROCEDURE, PASS:: dPsi => dPsiTetra
PROCEDURE, NOPASS, PRIVATE:: dPsiXi1 => dPsiTetraXi1
PROCEDURE, NOPASS, PRIVATE:: dPsiXi2 => dPsiTetraXi2
PROCEDURE, PASS:: partialDer => partialDerTetra
PROCEDURE, PASS:: elemK => elemKTetra
PROCEDURE, PASS:: elemF => elemFTetra
PROCEDURE, PASS:: gatherElectricField => gatherEFTetra
PROCEDURE, PASS:: gatherMagneticField => gatherMFTetra
PROCEDURE, NOPASS:: inside => insideTetra
PROCEDURE, PASS:: getNodes => getNodesTetra
PROCEDURE, PASS:: phy2log => phy2logTetra
PROCEDURE, PASS:: nextElement => nextElementTetra
!meshCell DEFERRED PROCEDURES
PROCEDURE, PASS:: init => initCellTetra
PROCEDURE, PASS:: getNodes => getNodesTetra
PROCEDURE, PASS:: randPos => randPosCellTetra
PROCEDURE, NOPASS:: fPsi => fPsiTetra
PROCEDURE, NOPASS:: dPsi => dPsiTetra
PROCEDURE, PASS:: partialDer => partialDerTetra
PROCEDURE, NOPASS:: detJac => detJ3DCart
PROCEDURE, NOPASS:: invJac => invJ3DCart
PROCEDURE, PASS:: gatherElectricField => gatherEFTetra
PROCEDURE, PASS:: gatherMagneticField => gatherMFTetra
PROCEDURE, PASS:: elemK => elemKTetra
PROCEDURE, PASS:: elemF => elemFTetra
PROCEDURE, NOPASS:: inside => insideTetra
PROCEDURE, PASS:: phy2log => phy2logTetra
PROCEDURE, PASS:: neighbourElement => neighbourElementTetra
!PARTICULAR PROCEDURES
PROCEDURE, PASS:: calcVol => volumeTetra
END TYPE meshCell3DCartTetra
@ -227,13 +212,11 @@ MODULE moduleMesh3DCart
IMPLICIT NONE
REAL(8), INTENT(in):: Xi(1:3)
REAL(8), ALLOCATABLE:: fPsi(:)
ALLOCATE(fPsi(1:3))
REAL(8):: fPsi(1:3)
fPsi(1) = 1.D0 - Xi(1) - Xi(2)
fPsi(2) = Xi(1)
fPsi(3) = Xi(2)
fPsi(3) = Xi(2)
END FUNCTION fPsiEdgeTria
@ -268,7 +251,7 @@ MODULE moduleMesh3DCart
self%z = (/r1(3), r2(3), r3(3), r4(3)/)
!Computes the element volume
CALL self%calcCell()
CALL self%calcVol()
!Assign proportional volume to each node
Xi = (/0.25D0, 0.25D0, 0.25D0/)
@ -286,6 +269,17 @@ MODULE moduleMesh3DCart
END SUBROUTINE initCellTetra
PURE FUNCTION getNodesTetra(self, nNodes) RESULT(n)
IMPLICIT NONE
CLASS(meshCell3DCartTetra), 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 getNodesTetra
!Random position in volume tetrahedron
FUNCTION randPosCellTetra(self) RESULT(r)
USE moduleRandom
@ -308,24 +302,10 @@ MODULE moduleMesh3DCart
END FUNCTION randPosCellTetra
!Computes the element volume
PURE SUBROUTINE volumeTetra(self)
IMPLICIT NONE
CLASS(meshCell3DCartTetra), INTENT(inout):: self
REAL(8):: Xi(1:3)
self%volume = 0.D0
Xi = (/0.25D0, 0.25D0, 0.25D0/)
self%volume = self%detJac(Xi, 4)
END SUBROUTINE volumeTetra
!Computes element functions in point Xi
PURE FUNCTION fPsiTetra(self, Xi, nNodes) RESULT(fPsi)
PURE FUNCTION fPsiTetra(Xi, nNodes) RESULT(fPsi)
IMPLICIT NONE
CLASS(meshCell3DCartTetra), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3)
INTEGER, INTENT(in):: nNodes
REAL(8):: fPsi(1:nNodes)
@ -338,127 +318,45 @@ MODULE moduleMesh3DCart
END FUNCTION fPsiTetra
!Derivative element function at coordinates Xi
PURE FUNCTION dPsiTetra(self, Xi, nNodes) RESULT(dPsi)
PURE FUNCTION dPsiTetra(Xi, nNodes) RESULT(dPsi)
IMPLICIT NONE
CLASS(meshCell3DCartTetra), 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,:) = dPsiTetraXi1(Xi(2), Xi(3))
dPsi(2,:) = dPsiTetraXi2(Xi(1), Xi(3))
dPsi(3,:) = dPsiTetraXi3(Xi(1), Xi(2))
dPsi(1,1:4) = (/ -1.D0, 1.D0, 0.D0, 0.D0 /)
dPsi(2,1:4) = (/ -1.D0, 0.D0, 1.D0, 0.D0 /)
dPsi(3,1:4) = (/ -1.D0, 0.D0, 0.D0, 1.D0 /)
END FUNCTION dPsiTetra
!Derivative element function respect to Xi1
PURE FUNCTION dPsiTetraXi1(Xi2, Xi3) RESULT(dPsiXi1)
IMPLICIT NONE
REAL(8), INTENT(in):: Xi2, Xi3
REAL(8):: dPsiXi1(1:4)
dPsiXi1(1) = -1.D0
dPsiXi1(2) = 1.D0
dPsiXi1(3) = 0.D0
dPsiXi1(4) = 0.D0
END FUNCTION dPsiTetraXi1
!Derivative element function respect to Xi2
PURE FUNCTION dPsiTetraXi2(Xi1, Xi3) RESULT(dPsiXi2)
IMPLICIT NONE
REAL(8), INTENT(in):: Xi1, Xi3
REAL(8):: dPsiXi2(1:4)
dPsiXi2(1) = -1.D0
dPsiXi2(2) = 0.D0
dPsiXi2(3) = 1.D0
dPsiXi2(4) = 0.D0
END FUNCTION dPsiTetraXi2
!Derivative element function respect to Xi3
PURE FUNCTION dPsiTetraXi3(Xi1, Xi2) RESULT(dPsiXi3)
IMPLICIT NONE
REAL(8), INTENT(in):: Xi1, Xi2
REAL(8):: dPsiXi3(1:4)
dPsiXi3(1) = -1.D0
dPsiXi3(2) = 0.D0
dPsiXi3(3) = 0.D0
dPsiXi3(4) = 1.D0
END FUNCTION dPsiTetraXi3
!Computes the derivatives in global coordinates
PURE SUBROUTINE partialDerTetra(self, nNodes, dPsi, dx, dy, dz)
PURE FUNCTION partialDerTetra(self, nNodes, dPsi) RESULT(pDer)
IMPLICIT NONE
CLASS(meshCell3DCartTetra), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8), INTENT(in):: dPsi(1:3, 1:nNodes)
REAL(8), INTENT(out), DIMENSION(1:3):: dx, dy, dz
REAL(8):: pDer(1:3, 1:3)
dx(1) = DOT_PRODUCT(dPsi(1,:), self%x)
dx(2) = DOT_PRODUCT(dPsi(2,:), self%x)
dx(3) = DOT_PRODUCT(dPsi(3,:), self%x)
pDer = 0.D0
dy(1) = DOT_PRODUCT(dPsi(1,:), self%y)
dy(2) = DOT_PRODUCT(dPsi(2,:), self%y)
dy(3) = DOT_PRODUCT(dPsi(3,:), self%y)
pDer(1, 1:3) = (/ DOT_PRODUCT(dPsi(1,1:4), self%x(1:4)), &
DOT_PRODUCT(dPsi(2,1:4), self%x(1:4)), &
DOT_PRODUCT(dPsi(3,1:4), self%x(1:4)) /)
dz(1) = DOT_PRODUCT(dPsi(1,:), self%z)
dz(2) = DOT_PRODUCT(dPsi(2,:), self%z)
dz(3) = DOT_PRODUCT(dPsi(3,:), self%z)
pDer(2, 1:3) = (/ DOT_PRODUCT(dPsi(1,1:4), self%y(1:4)), &
DOT_PRODUCT(dPsi(2,1:4), self%y(1:4)), &
DOT_PRODUCT(dPsi(3,1:4), self%y(1:4)) /)
END SUBROUTINE partialDerTetra
pDer(3, 1:3) = (/ DOT_PRODUCT(dPsi(1,1:4), self%z(1:4)), &
DOT_PRODUCT(dPsi(2,1:4), self%z(1:4)), &
DOT_PRODUCT(dPsi(3,1:4), self%z(1:4)) /)
PURE FUNCTION elemKTetra(self, nNodes) RESULT(localK)
IMPLICIT NONE
CLASS(meshCell3DCartTetra), 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
localK = 0.D0
Xi = 0.D0
!TODO: One point Gauss integral. Upgrade when possible
Xi = (/ 0.25D0, 0.25D0, 0.25D0 /)
dPsi = self%dPsi(Xi, 4)
detJ = self%detJac(Xi, 4, dPsi)
invJ = self%invJac(Xi, 4, dPsi)
fPsi = self%fPsi(Xi, 4)
localK = MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*1.D0/detJ
END FUNCTION elemKTetra
PURE FUNCTION elemFTetra(self, nNodes, source) RESULT(localF)
IMPLICIT NONE
CLASS(meshCell3DCartTetra), INTENT(in):: self
INTEGER, INTENT(in):: nNodes
REAL(8), INTENT(in):: source(1:nNodes)
REAL(8):: localF(1:nNodes)
REAL(8):: fPsi(1:4), dPsi(1:3, 1:4)
REAL(8):: Xi(1:3)
REAL(8):: detJ, f
localF = 0.D0
Xi = 0.D0
Xi = (/ 0.25D0, 0.25D0, 0.25D0 /)
dPsi = self%dPsi(Xi, 4)
detJ = self%detJac(Xi, 4, dPsi)
fPsi = self%fPsi(Xi, 4)
f = DOT_PRODUCT(fPsi, source)
localF = f*fPsi*1.D0*detJ
END FUNCTION elemFTetra
END FUNCTION partialDerTetra
PURE FUNCTION gatherEFTetra(self, Xi) RESULT(array)
IMPLICIT NONE
@ -502,6 +400,54 @@ MODULE moduleMesh3DCart
END FUNCTION gatherMFTetra
PURE FUNCTION elemKTetra(self, nNodes) RESULT(localK)
IMPLICIT NONE
CLASS(meshCell3DCartTetra), 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):: pDer(1:3, 1:3)
REAL(8):: invJ(1:3,1:3), detJ
localK = 0.D0
Xi = 0.D0
!TODO: One point Gauss integral. Upgrade when possible
Xi = (/ 0.25D0, 0.25D0, 0.25D0 /)
dPsi = self%dPsi(Xi, 4)
pDer = self%partialDer(4, dPsi)
detJ = self%detJac(pDer)
invJ = self%invJac(pDer)
fPsi = self%fPsi(Xi, 4)
localK = MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*1.D0/detJ
END FUNCTION elemKTetra
PURE FUNCTION elemFTetra(self, nNodes, source) RESULT(localF)
IMPLICIT NONE
CLASS(meshCell3DCartTetra), 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), dPsi(1:3, 1:4)
REAL(8):: pDer(1:3, 1:3)
REAL(8):: detJ, f
localF = 0.D0
Xi = 0.D0
Xi = (/ 0.25D0, 0.25D0, 0.25D0 /)
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 = f*fPsi*1.D0*detJ
END FUNCTION elemFTetra
PURE FUNCTION insideTetra(Xi) RESULT(ins)
IMPLICIT NONE
@ -515,121 +461,101 @@ MODULE moduleMesh3DCart
END FUNCTION insideTetra
PURE FUNCTION getNodesTetra(self, nNodes) RESULT(n)
IMPLICIT NONE
CLASS(meshCell3DCartTetra), 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 getNodesTetra
PURE FUNCTION phy2logTetra(self,r) RESULT(Xi)
IMPLICIT NONE
CLASS(meshCell3DCartTetra), INTENT(in):: self
REAL(8), INTENT(in):: r(1:3)
REAL(8):: Xi(1:3)
REAL(8):: dPsi(1:3, 1:4)
REAL(8):: pDer(1:3, 1:3)
REAL(8):: invJ(1:3, 1:3), detJ
REAL(8):: deltaR(1:3)
REAL(8):: dPsi(1:3, 1:4)
Xi = 0.D0
deltaR = (/r(1) - self%x(1), r(2) - self%y(1), r(3) - self%z(1) /)
dPsi = self%dPsi(Xi, 4)
invJ = self%invJac(Xi, 4, dPsi)
detJ = self%detJac(Xi, 4, dPsi)
pDer = self%partialDer(4, dPsi)
invJ = self%invJac(pDer)
detJ = self%detJac(pDer)
Xi = MATMUL(invJ, deltaR)/detJ
END FUNCTION phy2logTetra
SUBROUTINE nextElementTetra(self, Xi, nextElement)
SUBROUTINE neighbourElementTetra(self, Xi, neighbourElement)
IMPLICIT NONE
CLASS(meshCell3DCartTetra), 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
!TODO: Review when connectivity
XiArray = (/ Xi(3), 1.D0 - Xi(1) - Xi(2) - Xi(3), 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
CASE (4)
nextElement => self%e4
neighbourElement => self%e4
END SELECT
END SUBROUTINE nextElementTetra
END SUBROUTINE neighbourElementTetra
!Computes the element volume
PURE SUBROUTINE volumeTetra(self)
IMPLICIT NONE
CLASS(meshCell3DCartTetra), INTENT(inout):: self
REAL(8):: Xi(1:3)
REAL(8):: dPsi(1:3, 1:4)
REAL(8):: pDer(1:3, 1:3)
self%volume = 0.D0
Xi = (/0.25D0, 0.25D0, 0.25D0/)
dPsi = self%dPsi(Xi, 4)
pDer = self%partialDer(4, dPsi)
self%volume = self%detJac(pDer)
END SUBROUTINE volumeTetra
!COMMON FUNCTIONS FOR CARTESIAN VOLUME ELEMENTS IN 3D
!Computes element Jacobian determinant
PURE FUNCTION detJ3DCart(self, Xi, nNodes, dPsi_in) RESULT(dJ)
PURE FUNCTION detJ3DCart(pDer) RESULT(dJ)
IMPLICIT NONE
CLASS(meshCell3DCart), 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:3), dy(1:3), dz(1:3)
IF (PRESENT(dPsi_in)) THEN
dPsi = dPsi_in
ELSE
dPsi = self%dPsi(Xi, 4)
END IF
CALL self%partialDer(nNodes, dPsi, dx, dy, dz)
dJ = dx(1)*(dy(2)*dz(3) - dy(3)*dz(2)) &
- dx(2)*(dy(1)*dz(3) - dy(3)*dz(1)) &
+ dx(3)*(dy(1)*dz(2) - dy(2)*dz(1))
dJ = pDer(1,1)*(pDer(2,2)*pDer(3,3) - pDer(2,3)*pDer(3,2)) &
- pDer(1,2)*(pDer(2,1)*pDer(3,3) - pDer(2,3)*pDer(3,1)) &
+ pDer(1,3)*(pDer(2,1)*pDer(3,2) - pDer(2,2)*pDer(3,1))
END FUNCTION detJ3DCart
PURE FUNCTION invJ3DCart(self, Xi, nNodes, dPsi_in) RESULT(invJ)
PURE FUNCTION invJ3DCart(pDer) RESULT(invJ)
IMPLICIT NONE
CLASS(meshCell3DCart), 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), DIMENSION(1:3):: dx, dy, dz
REAL(8), INTENT(in):: pDer(1:3, 1:3)
REAL(8):: invJ(1:3,1:3)
IF(PRESENT(dPsi_in)) THEN
dPsi=dPsi_in
invJ(1,1:3) = (/ (pDer(2,2)*pDer(3,3) - pDer(2,3)*pDer(3,2)), &
-(pDer(2,1)*pDer(3,3) - pDer(2,3)*pDer(3,1)), &
(pDer(2,1)*pDer(3,2) - pDer(2,2)*pDer(3,1)) /)
ELSE
dPsi = self%dPsi(Xi, 4)
invJ(2,1:3) = (/ -(pDer(1,2)*pDer(3,3) - pDer(1,3)*pDer(3,2)), &
(pDer(1,1)*pDer(3,3) - pDer(1,3)*pDer(3,1)), &
-(pDer(1,1)*pDer(3,2) - pDer(1,2)*pDer(3,1)) /)
END IF
CALL self%partialDer(nNodes, dPsi, dx, dy, dz)
invJ(1,1) = (dy(2)*dz(3) - dy(3)*dz(2))
invJ(1,2) = -(dy(1)*dz(3) - dy(3)*dz(1))
invJ(1,3) = (dy(1)*dz(2) - dy(2)*dz(1))
invJ(2,1) = -(dx(2)*dz(3) - dx(3)*dz(2))
invJ(2,2) = (dx(1)*dz(3) - dx(3)*dz(1))
invJ(2,3) = -(dx(1)*dz(2) - dx(2)*dz(1))
invJ(3,1) = (dx(2)*dy(3) - dx(3)*dy(2))
invJ(3,2) = -(dx(1)*dy(3) - dx(3)*dy(1))
invJ(3,3) = (dx(1)*dy(2) - dx(2)*dy(1))
invJ(3,1:3) = (/ (pDer(1,2)*pDer(2,3) - pDer(1,3)*pDer(2,2)), &
-(pDer(1,1)*pDer(2,3) - pDer(1,3)*pDer(2,1)), &
(pDer(1,1)*pDer(2,2) - pDer(1,2)*pDer(2,1)) /)
invJ = TRANSPOSE(invJ)