From 0db76083ec1b9c49592818ed9b5c493644b51714 Mon Sep 17 00:00:00 2001 From: JGonzalez Date: Sun, 1 Jan 2023 12:12:06 +0100 Subject: [PATCH 01/13] fPsi no longer allocates memory 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) --- src/modules/init/moduleInput.f90 | 6 +- src/modules/mesh/0D/moduleMesh0D.f90 | 7 +- src/modules/mesh/1DCart/moduleMesh1DCart.f90 | 54 ++-- src/modules/mesh/1DRad/moduleMesh1DRad.f90 | 68 ++-- src/modules/mesh/2DCart/moduleMesh2DCart.f90 | 323 +++++++++---------- src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 | 107 +++--- src/modules/mesh/3DCart/moduleMesh3DCart.f90 | 237 +++++++------- src/modules/mesh/moduleMesh.f90 | 15 +- 8 files changed, 408 insertions(+), 409 deletions(-) diff --git a/src/modules/init/moduleInput.f90 b/src/modules/init/moduleInput.f90 index ac40c3b..aaf4b08 100644 --- a/src/modules/init/moduleInput.f90 +++ b/src/modules/init/moduleInput.f90 @@ -361,14 +361,14 @@ MODULE moduleInput !Density at centroid of cell nodes = mesh%vols(e)%obj%getNodes() nNodes = SIZE(nodes) - fPsi = mesh%vols(e)%obj%fPsi((/0.D0, 0.D0, 0.D0/)) + ALLOCATE(fPsi(1:nNodes)) + CALL mesh%vols(e)%obj%fPsi((/0.D0, 0.D0, 0.D0/), fPsi) ALLOCATE(source(1:nNodes)) DO j = 1, nNodes source(j) = density(nodes(j)) END DO densityCen = DOT_PRODUCT(fPsi, source) - DEALLOCATE(fPsi) !Calculate number of particles nNewPart = INT(densityCen * (mesh%vols(e)%obj%volume*Vol_ref) / species(sp)%obj%weight) @@ -380,7 +380,7 @@ MODULE moduleInput partNew%r = mesh%vols(e)%obj%randPos() partNew%xi = mesh%vols(e)%obj%phy2log(partNew%r) !Get mean velocity at particle position - fPsi = mesh%vols(e)%obj%fPsi(partNew%xi) + CALL mesh%vols(e)%obj%fPsi(partNew%xi, fPsi) DO j = 1, nNodes source(j) = velocity(nodes(j), 1) diff --git a/src/modules/mesh/0D/moduleMesh0D.f90 b/src/modules/mesh/0D/moduleMesh0D.f90 index 8e8072d..0a14520 100644 --- a/src/modules/mesh/0D/moduleMesh0D.f90 +++ b/src/modules/mesh/0D/moduleMesh0D.f90 @@ -106,14 +106,13 @@ MODULE moduleMesh0D END FUNCTION randPos0D - PURE FUNCTION fPsi0D(xi) RESULT(fPsi) + PURE SUBROUTINE fPsi0D(xi, fPsi) REAL(8), INTENT(in):: xi(1:3) - REAL(8), ALLOCATABLE:: fPsi(:) + REAL(8), INTENT(out):: fPsi(:) - ALLOCATE(fPsi(1:1)) fPsi = 1.D0 - END FUNCTION fPsi0D + END SUBROUTINE fPsi0D PURE FUNCTION gatherEF0D(self, xi) RESULT(EF) IMPLICIT NONE diff --git a/src/modules/mesh/1DCart/moduleMesh1DCart.f90 b/src/modules/mesh/1DCart/moduleMesh1DCart.f90 index 0a846d9..3380cf0 100644 --- a/src/modules/mesh/1DCart/moduleMesh1DCart.f90 +++ b/src/modules/mesh/1DCart/moduleMesh1DCart.f90 @@ -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 diff --git a/src/modules/mesh/1DRad/moduleMesh1DRad.f90 b/src/modules/mesh/1DRad/moduleMesh1DRad.f90 index b8edfdd..7b09e5b 100644 --- a/src/modules/mesh/1DRad/moduleMesh1DRad.f90 +++ b/src/modules/mesh/1DRad/moduleMesh1DRad.f90 @@ -232,13 +232,13 @@ MODULE moduleMesh1DRad CLASS(meshVol1DRadSegm), 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%r) END FUNCTION randPos1DRadSeg @@ -249,47 +249,47 @@ MODULE moduleMesh1DRad CLASS(meshVol1DRadSegm), INTENT(inout):: self REAL(8):: l !element length - REAL(8):: fPsi(1:2) + REAL(8):: fPsi(1:2), fPsi_node(1:2) REAL(8):: r 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) !Computes total volume of the cell r = DOT_PRODUCT(fPsi, self%r) l = 2.D0*detJ self%volume = r*l !Computes volume per node - Xii = (/-5.D-1, 0.D0, 0.D0/) - r = DOT_PRODUCT(self%fPsi(Xii),self%r) + Xi = (/-5.D-1, 0.D0, 0.D0/) + CALL self%fPsi(Xi, fPsi_node) + r = DOT_PRODUCT(fPsi_node,self%r) self%arNodes(1) = fPsi(1)*r*l - Xii = (/ 5.D-1, 0.D0, 0.D0/) - r = DOT_PRODUCT(self%fPsi(Xii),self%r) + Xi = (/ 5.D-1, 0.D0, 0.D0/) + CALL self%fPsi(Xi, fPsi_node) + r = DOT_PRODUCT(fPsi_node,self%r) self%arNodes(2) = fPsi(2)*r*l END SUBROUTINE areaRad - !Computes element functions at point xii - PURE FUNCTION fPsiRad(xi) RESULT(fPsi) + !Computes element functions at point Xi + PURE SUBROUTINE fPsiRad(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 fPsiRad + END SUBROUTINE fPsiRad - !Computes element derivative shape function at Xii + !Computes element derivative shape function at Xi PURE FUNCTION dPsiRad(xi) RESULT(dPsi) IMPLICIT NONE @@ -322,7 +322,7 @@ MODULE moduleMesh1DRad CLASS(meshVol1DRadSegm), 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 REAL(8):: r, fPsi(1:2) @@ -330,13 +330,13 @@ MODULE moduleMesh1DRad 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) - fPsi = self%fPsi(Xii) + Xi(1) = corSeg(l) + dPsi = self%dPsi(Xi) + detJ = self%detJac(Xi, dPsi) + invJ = self%invJac(Xi, dPsi) + CALL self%fPsi(Xi, fPsi) r = DOT_PRODUCT(fPsi, self%r) localK = localK + MATMUL(RESHAPE(MATMUL(invJ,dPsi), (/ 2, 1/)), & RESHAPE(MATMUL(invJ,dPsi), (/ 1, 2/)))* & @@ -357,17 +357,17 @@ MODULE moduleMesh1DRad REAL(8), ALLOCATABLE:: localF(:) REAL(8):: fPsi(1:2) REAL(8):: detJ, f, r - 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) r = DOT_PRODUCT(fPsi, self%r) f = DOT_PRODUCT(fPsi, source) localF = localF + f*fPsi*r*wSeg(l)*detJ @@ -387,7 +387,7 @@ MODULE moduleMesh1DRad END FUNCTION insideRad - !Gathers EF at position Xii + !Gathers EF at position Xi PURE FUNCTION gatherEFRad(self, xi) RESULT(EF) IMPLICIT NONE @@ -426,7 +426,7 @@ MODULE moduleMesh1DRad 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 gatherMFRad diff --git a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 index d01c0e4..c57cecc 100644 --- a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 +++ b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 @@ -11,8 +11,8 @@ MODULE moduleMesh2DCart REAL(8), PARAMETER:: corQuad(1:3) = (/ -DSQRT(3.D0/5.D0), 0.D0, DSQRT(3.D0/5.D0) /) REAL(8), PARAMETER:: wQuad(1:3) = (/ 5.D0/9.D0, 8.D0/9.D0, 5.D0/9.D0 /) - REAL(8), PARAMETER:: xi1Tria(1:4) = (/ 1.D0/3.D0, 1.D0/5.D0, 3.D0/5.D0, 1.D0/5.D0 /) - REAL(8), PARAMETER:: xi2Tria(1:4) = (/ 1.D0/3.D0, 1.D0/5.D0, 1.D0/5.D0, 3.D0/5.D0 /) + REAL(8), PARAMETER:: Xi1Tria(1:4) = (/ 1.D0/3.D0, 1.D0/5.D0, 3.D0/5.D0, 1.D0/5.D0 /) + REAL(8), PARAMETER:: Xi2Tria(1:4) = (/ 1.D0/3.D0, 1.D0/5.D0, 1.D0/5.D0, 3.D0/5.D0 /) REAL(8), PARAMETER:: wTria(1:4) = (/ -27.D0/96.D0, 25.D0/96.D0, 25.D0/96.D0, 25.D0/96.D0 /) TYPE, PUBLIC, EXTENDS(meshNode):: meshNode2DCart @@ -47,8 +47,8 @@ MODULE moduleMesh2DCart END TYPE meshVol2DCart ABSTRACT INTERFACE - PURE FUNCTION dPsi_interface(xi) RESULT(dPsi) - REAL(8), INTENT(in):: xi(1:3) + PURE FUNCTION dPsi_interface(Xi) RESULT(dPsi) + REAL(8), INTENT(in):: Xi(1:3) REAL(8), ALLOCATABLE:: dPsi(:,:) END FUNCTION dPsi_interface @@ -210,14 +210,14 @@ MODULE moduleMesh2DCart CLASS(meshVol2DCartQuad), 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) = random(-1.D0, 1.D0) - xii(3) = 0.D0 + Xi(1) = random(-1.D0, 1.D0) + Xi(2) = random(-1.D0, 1.D0) + Xi(3) = 0.D0 - fPsi = self%fPsi(xii) + CALL self%fPsi(Xi, fPsi) r(1) = DOT_PRODUCT(fPsi, self%x) r(2) = DOT_PRODUCT(fPsi, self%y) @@ -319,78 +319,77 @@ MODULE moduleMesh2DCart IMPLICIT NONE CLASS(meshVol2DCartQuad), INTENT(inout):: self - REAL(8):: xi(1:3) + 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.D0 !4 - fPsi = self%fPsi(xi) + Xi = 0.D0 + detJ = self%detJac(Xi)*4.D0 !4 + CALL self%fPsi(Xi, fPsi) self%volume = detJ self%arNodes = fPsi*detJ END SUBROUTINE areaQuad - !Computes element functions in point xi - PURE FUNCTION fPsiQuad(xi) RESULT(fPsi) + !Computes element functions in point Xi + PURE SUBROUTINE fPsiQuad(Xi, fPsi) IMPLICIT NONE - REAL(8),INTENT(in):: xi(1:3) - REAL(8), ALLOCATABLE:: fPsi(:) + REAL(8), INTENT(in):: Xi(1:3) + REAL(8), INTENT(out):: fPsi(:) - ALLOCATE(fPsi(1:4)) + 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(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 + END SUBROUTINE fPsiQuad - !Derivative element function at coordinates xi - PURE FUNCTION dPsiQuad(xi) RESULT(dPsi) + !Derivative element function at coordinates Xi + PURE FUNCTION dPsiQuad(Xi) RESULT(dPsi) IMPLICIT NONE - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8), ALLOCATABLE:: dPsi(:,:) ALLOCATE(dPsi(1:2,1:4)) - dPsi(1,:) = dPsiQuadXi1(xi(2)) - dPsi(2,:) = dPsiQuadXi2(xi(1)) + dPsi(1,:) = dPsiQuadXi1(Xi(2)) + dPsi(2,:) = dPsiQuadXi2(Xi(1)) END FUNCTION dPsiQuad - !Derivative element function (xi1) - PURE FUNCTION dPsiQuadXi1(xi2) RESULT(dPsiXi1) + !Derivative element function (Xi1) + PURE FUNCTION dPsiQuadXi1(Xi2) RESULT(dPsiXi1) IMPLICIT NONE - REAL(8),INTENT(in):: xi2 + REAL(8),INTENT(in):: Xi2 REAL(8):: dPsiXi1(1:4) - dPsiXi1(1) = -(1.D0-xi2) - dPsiXi1(2) = (1.D0-xi2) - dPsiXi1(3) = (1.D0+xi2) - dPsiXi1(4) = -(1.D0+xi2) + dPsiXi1(1) = -(1.D0-Xi2) + dPsiXi1(2) = (1.D0-Xi2) + dPsiXi1(3) = (1.D0+Xi2) + dPsiXi1(4) = -(1.D0+Xi2) dPsiXi1 = dPsiXi1*0.25D0 END FUNCTION dPsiQuadXi1 - !Derivative element function (xi2) - PURE FUNCTION dPsiQuadXi2(xi1) RESULT(dPsiXi2) + !Derivative element function (Xi2) + PURE FUNCTION dPsiQuadXi2(Xi1) RESULT(dPsiXi2) IMPLICIT NONE - REAL(8),INTENT(in):: xi1 + REAL(8),INTENT(in):: Xi1 REAL(8):: dPsiXi2(1:4) - dPsiXi2(1) = -(1.D0-xi1) - dPsiXi2(2) = -(1.D0+xi1) - dPsiXi2(3) = (1.D0+xi1) - dPsiXi2(4) = (1.D0-xi1) + dPsiXi2(1) = -(1.D0-Xi1) + dPsiXi2(2) = -(1.D0+Xi1) + dPsiXi2(3) = (1.D0+Xi1) + dPsiXi2(4) = (1.D0-Xi1) dPsiXi2 = dPsiXi2*0.25D0 END FUNCTION dPsiQuadXi2 @@ -415,24 +414,24 @@ MODULE moduleMesh2DCart CLASS(meshVol2DCartQuad), INTENT(in):: self REAL(8), ALLOCATABLE:: localK(:,:) - REAL(8):: xi(1:3) + REAL(8):: Xi(1:3) REAL(8):: fPsi(1:4), dPsi(1:2,1:4) REAL(8):: invJ(1:2,1:2), detJ INTEGER:: l, m ALLOCATE(localK(1:4, 1:4)) localK=0.D0 - xi=0.D0 + Xi=0.D0 !Start 2D Gauss Quad Integral DO l=1, 3 - xi(2) = corQuad(l) - dPsi(1,:) = self%dPsiXi1(xi(2)) + Xi(2) = corQuad(l) + dPsi(1,:) = self%dPsiXi1(Xi(2)) DO m = 1, 3 - xi(1) = corQuad(m) - dPsi(2,:) = self%dPsiXi2(xi(1)) - fPsi = self%fPsi(xi) - detJ = self%detJac(xi,dPsi) - invJ = self%invJac(xi,dPsi) + Xi(1) = corQuad(m) + dPsi(2,:) = self%dPsiXi2(Xi(1)) + CALL self%fPsi(Xi, fPsi) + detJ = self%detJac(Xi,dPsi) + invJ = self%invJac(Xi,dPsi) localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*wQuad(l)*wQuad(m)/detJ END DO @@ -447,20 +446,20 @@ MODULE moduleMesh2DCart CLASS(meshVol2DCartQuad), INTENT(in):: self REAL(8), INTENT(in):: source(1:) REAL(8), ALLOCATABLE:: localF(:) - REAL(8):: xi(1:3) + REAL(8):: Xi(1:3) REAL(8):: fPsi(1:4) REAL(8):: detJ, f INTEGER:: l, m ALLOCATE(localF(1:4)) localF = 0.D0 - xi = 0.D0 + Xi = 0.D0 DO l=1, 3 - xi(1) = corQuad(l) + Xi(1) = corQuad(l) DO m = 1, 3 - xi(2) = corQuad(m) - detJ = self%detJac(xi) - fPsi = self%fPsi(xi) + Xi(2) = corQuad(m) + detJ = self%detJac(Xi) + CALL self%fPsi(Xi, fPsi) f = DOT_PRODUCT(fPsi,source) localF = localF + f*fPsi*wQuad(l)*wQuad(m)*detJ @@ -470,23 +469,23 @@ MODULE moduleMesh2DCart END FUNCTION elemFQuad !Checks if a particle is inside a quad element - PURE FUNCTION insideQuad(xi) RESULT(ins) + PURE FUNCTION insideQuad(Xi) RESULT(ins) IMPLICIT NONE - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) LOGICAL:: ins - ins = (xi(1) >= -1.D0 .AND. xi(1) <= 1.D0) .AND. & - (xi(2) >= -1.D0 .AND. xi(2) <= 1.D0) + ins = (Xi(1) >= -1.D0 .AND. Xi(1) <= 1.D0) .AND. & + (Xi(2) >= -1.D0 .AND. Xi(2) <= 1.D0) END FUNCTION insideQuad - !Gathers the electric field at position xi - PURE FUNCTION gatherEFQuad(self,xi) RESULT(EF) + !Gathers the electric field at position Xi + PURE FUNCTION gatherEFQuad(self,Xi) RESULT(EF) IMPLICIT NONE CLASS(meshVol2DCartQuad), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8):: dPsi(1:2,1:4) REAL(8):: dPsiR(1:2,1:4)!Derivative of shpae functions in global coordinates REAL(8):: invJ(1:2,1:2), detJ @@ -498,9 +497,9 @@ MODULE moduleMesh2DCart self%n3%emData%phi, & self%n4%emData%phi /) - dPsi = self%dPsi(xi) - detJ = self%detJac(xi,dPsi) - invJ = self%invJac(xi,dPsi) + dPsi = self%dPsi(Xi) + detJ = self%detJac(Xi,dPsi) + invJ = self%invJac(Xi,dPsi) dPsiR = MATMUL(invJ, dPsi)/detJ EF(1) = -DOT_PRODUCT(dPsiR(1,:), phi) EF(2) = -DOT_PRODUCT(dPsiR(2,:), phi) @@ -508,11 +507,11 @@ MODULE moduleMesh2DCart END FUNCTION gatherEFQuad - PURE FUNCTION gatherMFQuad(self,xi) RESULT(MF) + PURE FUNCTION gatherMFQuad(self,Xi) RESULT(MF) IMPLICIT NONE CLASS(meshVol2DCartQuad), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8):: fPsi(1:4) REAL(8):: MF_Nodes(1:4,1:3) REAL(8):: MF(1:3) @@ -530,7 +529,7 @@ MODULE moduleMesh2DCart self%n3%emData%B(3), & self%n4%emData%B(3) /) - fPsi = self%fPsi(xi) + CALL self%fPsi(Xi, fPsi) MF = MATMUL(fPsi(:), MF_Nodes) END FUNCTION gatherMFQuad @@ -548,47 +547,47 @@ MODULE moduleMesh2DCart END FUNCTION getNodesQuad !Transforms physical coordinates to element coordinates - PURE FUNCTION phy2logQuad(self,r) RESULT(xN) + PURE FUNCTION phy2logQuad(self,r) RESULT(XiN) IMPLICIT NONE CLASS(meshVol2DCartQuad), INTENT(in):: self REAL(8), INTENT(in):: r(1:3) - REAL(8):: xN(1:3) - REAL(8):: xO(1:3), detJ, invJ(1:2,1:2), f(1:2) + REAL(8):: XiN(1:3) + REAL(8):: XiO(1:3), detJ, invJ(1:2,1:2), f(1:2) REAL(8):: dPsi(1:2,1:4), fPsi(1:4) REAL(8):: conv !Iterative newton method to transform coordinates conv=1.D0 - xO=0.D0 + XiO=0.D0 DO WHILE(conv>1.D-4) - dPsi = self%dPsi(xO) - invJ = self%invJac(xO, dPsi) - fPsi = self%fPsi(xO) + dPsi = self%dPsi(XiO) + invJ = self%invJac(XiO, dPsi) + CALL self%fPsi(XiO, fPsi) f(1) = DOT_PRODUCT(fPsi,self%x)-r(1) f(2) = DOT_PRODUCT(fPsi,self%y)-r(2) - detJ = self%detJac(xO,dPsi) - xN(1:2)=xO(1:2) - MATMUL(invJ, f)/detJ - conv=MAXVAL(DABS(xN-xO),1) - xO=xN + detJ = self%detJac(XiO,dPsi) + XiN(1:2)=XiO(1:2) - MATMUL(invJ, f)/detJ + conv=MAXVAL(DABS(XiN-XiO),1) + XiO=XiN END DO END FUNCTION phy2logQuad - !Gets the next element for a logical position xi - SUBROUTINE nextElementQuad(self, xi, nextElement) + !Gets the next element for a logical position Xi + SUBROUTINE nextElementQuad(self, Xi, nextElement) IMPLICIT NONE CLASS(meshVol2DCartQuad), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) CLASS(meshElement), POINTER, INTENT(out):: nextElement - REAL(8):: xiArray(1:4) + REAL(8):: XiArray(1:4) INTEGER:: nextInt - xiArray = (/ -xi(2), xi(1), xi(2), -xi(1) /) - nextInt = MAXLOC(xiArray,1) + 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) SELECT CASE (nextInt) @@ -649,14 +648,14 @@ MODULE moduleMesh2DCart CLASS(meshVol2DCartTria), INTENT(in):: self REAL(8):: r(1:3) - REAL(8):: xii(1:3) - REAL(8), ALLOCATABLE:: fPsi(:) + REAL(8):: Xi(1:3) + REAL(8):: fPsi(1:3) - xii(1) = random( 0.D0, 1.D0) - xii(2) = random( 0.D0, 1.D0 - xii(1)) - xii(3) = 0.D0 + Xi(1) = random( 0.D0, 1.D0) + Xi(2) = random( 0.D0, 1.D0 - Xi(1)) + Xi(3) = 0.D0 - fPsi = self%fPsi(xii) + CALL self%fPsi(Xi, fPsi) r(1) = DOT_PRODUCT(fPsi, self%x) r(2) = DOT_PRODUCT(fPsi, self%y) @@ -669,55 +668,53 @@ MODULE moduleMesh2DCart IMPLICIT NONE CLASS(meshVol2DCartTria), INTENT(inout):: self - REAL(8):: xi(1:3) + 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)/2.D0 - fPsi = self%fPsi(xi) + Xi = (/1.D0/3.D0, 1.D0/3.D0, 0.D0 /) + detJ = self%detJac(Xi)/2.D0 + CALL self%fPsi(Xi, fPsi) self%volume = detJ self%arNodes = fPsi*detJ END SUBROUTINE areaTria !Shape functions for triangular element - PURE FUNCTION fPsiTria(xi) RESULT(fPsi) + PURE SUBROUTINE fPsiTria(Xi, fPsi) IMPLICIT NONE - REAL(8), INTENT(in):: xi(1:3) - REAL(8), ALLOCATABLE:: fPsi(:) + REAL(8), INTENT(in):: Xi(1:3) + REAL(8), INTENT(out):: fPsi(:) - ALLOCATE(fPsi(1:3)) + fPsi(1) = 1.D0 - Xi(1) - Xi(2) + fPsi(2) = Xi(1) + fPsi(3) = Xi(2) - fPsi(1) = 1.D0 - xi(1) - xi(2) - fPsi(2) = xi(1) - fPsi(3) = xi(2) + END SUBROUTINE fPsiTria - END FUNCTION fPsiTria - - !Derivative element function at coordinates xi - PURE FUNCTION dPsiTria(xi) RESULT(dPsi) + !Derivative element function at coordinates Xi + PURE FUNCTION dPsiTria(Xi) RESULT(dPsi) IMPLICIT NONE - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8), ALLOCATABLE:: dPsi(:,:) ALLOCATE(dPsi(1:2,1:3)) - dPsi(1,:) = dPsiTriaXi1(xi(2)) - dPsi(2,:) = dPsiTriaXi2(xi(1)) + dPsi(1,:) = dPsiTriaXi1(Xi(2)) + dPsi(2,:) = dPsiTriaXi2(Xi(1)) END FUNCTION dPsiTria - !Derivative element function (xi1) - PURE FUNCTION dPsiTriaXi1(xi2) RESULT(dPsiXi1) + !Derivative element function (Xi1) + PURE FUNCTION dPsiTriaXi1(Xi2) RESULT(dPsiXi1) IMPLICIT NONE - REAL(8), INTENT(in):: xi2 + REAL(8), INTENT(in):: Xi2 REAL(8):: dPsiXi1(1:3) dPsiXi1(1) = -1.D0 @@ -726,11 +723,11 @@ MODULE moduleMesh2DCart END FUNCTION dPsiTriaXi1 - !Derivative element function (xi1) - PURE FUNCTION dPsiTriaXi2(xi1) RESULT(dPsiXi2) + !Derivative element function (Xi1) + PURE FUNCTION dPsiTriaXi2(Xi1) RESULT(dPsiXi2) IMPLICIT NONE - REAL(8), INTENT(in):: xi1 + REAL(8), INTENT(in):: Xi1 REAL(8):: dPsiXi2(1:3) dPsiXi2(1) = -1.D0 @@ -759,22 +756,22 @@ MODULE moduleMesh2DCart CLASS(meshVol2DCartTria), INTENT(in):: self REAL(8), ALLOCATABLE:: localK(:,:) - REAL(8):: xi(1:3) + REAL(8):: Xi(1:3) REAL(8):: fPsi(1:3), dPsi(1:2,1:3) REAL(8):: invJ(1:2,1:2), detJ INTEGER:: l ALLOCATE(localK(1:4, 1:4)) localK=0.D0 - xi=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) - detJ = self%detJac(xi,dPsi) - invJ = self%invJac(xi,dPsi) - fPsi = self%fPsi(xi) + Xi(1) = Xi1Tria(l) + Xi(2) = Xi2Tria(l) + dPsi = self%dPsi(Xi) + detJ = self%detJac(Xi,dPsi) + invJ = self%invJac(Xi,dPsi) + CALL self%fPsi(Xi, fPsi) localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*wTria(l)/detJ END DO @@ -789,19 +786,19 @@ MODULE moduleMesh2DCart REAL(8), INTENT(in):: source(1:) REAL(8), ALLOCATABLE:: localF(:) REAL(8):: fPsi(1:3) - REAL(8):: xi(1:3) + REAL(8):: Xi(1:3) REAL(8):: detJ, f INTEGER:: l ALLOCATE(localF(1:3)) localF = 0.D0 - xi = 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) - fPsi = self%fPsi(xi) + Xi(1) = Xi1Tria(l) + Xi(2) = Xi2Tria(l) + detJ = self%detJac(Xi) + CALL self%fPsi(Xi, fPsi) f = DOT_PRODUCT(fPsi,source) localF = localF + f*fPsi*wTria(l)*detJ @@ -809,24 +806,24 @@ MODULE moduleMesh2DCart END FUNCTION elemFTria - PURE FUNCTION insideTria(xi) RESULT(ins) + PURE FUNCTION insideTria(Xi) RESULT(ins) IMPLICIT NONE - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) LOGICAL:: ins - ins = xi(1) >= 0.D0 .AND. & - xi(2) >= 0.D0 .AND. & - 1.D0 - xi(1) - xi(2) >= 0.D0 + ins = Xi(1) >= 0.D0 .AND. & + Xi(2) >= 0.D0 .AND. & + 1.D0 - Xi(1) - Xi(2) >= 0.D0 END FUNCTION insideTria - !Gathers the electric field at position xi - PURE FUNCTION gatherEFTria(self,xi) RESULT(EF) + !Gathers the electric field at position Xi + PURE FUNCTION gatherEFTria(self,Xi) RESULT(EF) IMPLICIT NONE CLASS(meshVol2DCartTria), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8):: dPsi(1:2,1:3) REAL(8):: dPsiR(1:2,1:3)!Derivative of shpae functions in global coordinates REAL(8):: invJ(1:2,1:2), detJ @@ -837,9 +834,9 @@ MODULE moduleMesh2DCart self%n2%emData%phi, & self%n3%emData%phi /) - dPsi = self%dPsi(xi) - detJ = self%detJac(xi,dPsi) - invJ = self%invJac(xi,dPsi) + dPsi = self%dPsi(Xi) + detJ = self%detJac(Xi,dPsi) + invJ = self%invJac(Xi,dPsi) dPsiR = MATMUL(invJ, dPsi)/detJ EF(1) = -DOT_PRODUCT(dPsiR(1,:), phi) EF(2) = -DOT_PRODUCT(dPsiR(2,:), phi) @@ -847,11 +844,11 @@ MODULE moduleMesh2DCart END FUNCTION gatherEFTria - PURE FUNCTION gatherMFTria(self,xi) RESULT(MF) + PURE FUNCTION gatherMFTria(self,Xi) RESULT(MF) IMPLICIT NONE CLASS(meshVol2DCartTria), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8):: fPsi(1:3) REAL(8):: MF_Nodes(1:3,1:3) REAL(8):: MF(1:3) @@ -866,7 +863,7 @@ MODULE moduleMesh2DCart self%n2%emData%B(3), & self%n3%emData%B(3) /) - fPsi = self%fPsi(xi) + CALL self%fPsi(Xi, fPsi) MF = MATMUL(fPsi, MF_Nodes) END FUNCTION gatherMFTria @@ -884,37 +881,37 @@ MODULE moduleMesh2DCart END FUNCTION getNodesTria !Transforms physical coordinates to element coordinates - PURE FUNCTION phy2logTria(self,r) RESULT(xi) + PURE FUNCTION phy2logTria(self,r) RESULT(Xi) IMPLICIT NONE CLASS(meshVol2DCartTria), INTENT(in):: self REAL(8), INTENT(in):: r(1:3) - REAL(8):: xi(1:3) + REAL(8):: Xi(1:3) REAL(8):: invJ(1:2,1:2), detJ REAL(8):: deltaR(1:2) REAL(8):: dPsi(1:2,1:3) !Direct method to convert coordinates - xi = 0.D0 !Irrelevant, required for input + Xi = 0.D0 !Irrelevant, required for input deltaR = (/ r(1) - self%x(1), r(2) - self%y(1) /) - dPsi = self%dPsi(xi) - invJ = self%invJac(xi, dPsi) - detJ = self%detJac(xi, dPsi) - xi(1:2) = MATMUL(invJ,deltaR)/detJ + dPsi = self%dPsi(Xi) + invJ = self%invJac(Xi, dPsi) + detJ = self%detJac(Xi, dPsi) + Xi(1:2) = MATMUL(invJ,deltaR)/detJ END FUNCTION phy2logTria - SUBROUTINE nextElementTria(self, xi, nextElement) + SUBROUTINE nextElementTria(self, Xi, nextElement) IMPLICIT NONE CLASS(meshVol2DCartTria), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) CLASS(meshElement), POINTER, INTENT(out):: nextElement - REAL(8):: xiArray(1:3) + REAL(8):: XiArray(1:3) INTEGER:: nextInt - xiArray = (/ xi(2), 1.D0-xi(1)-xi(2), xi(1) /) - nextInt = MINLOC(xiArray,1) + XiArray = (/ Xi(2), 1.D0-Xi(1)-Xi(2), Xi(1) /) + nextInt = MINLOC(XiArray,1) NULLIFY(nextElement) SELECT CASE (nextInt) CASE (1) @@ -929,11 +926,11 @@ MODULE moduleMesh2DCart !COMMON FUNCTIONS FOR CARTESIAN VOLUME ELEMENTS IN 2D !Computes element Jacobian determinant - PURE FUNCTION detJ2DCart(self, xi, dPsi_in) RESULT(dJ) + PURE FUNCTION detJ2DCart(self, Xi, dPsi_in) RESULT(dJ) IMPLICIT NONE CLASS(meshVol2DCart), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:,1:) REAL(8), ALLOCATABLE:: dPsi(:,:) REAL(8):: dJ @@ -943,7 +940,7 @@ MODULE moduleMesh2DCart dPsi = dPsi_in ELSE - dPsi = self%dPsi(xi) + dPsi = self%dPsi(Xi) END IF @@ -953,11 +950,11 @@ MODULE moduleMesh2DCart END FUNCTION detJ2DCart !Computes element Jacobian inverse matrix (without determinant) - PURE FUNCTION invJ2DCart(self,xi,dPsi_in) RESULT(invJ) + PURE FUNCTION invJ2DCart(self,Xi,dPsi_in) RESULT(invJ) IMPLICIT NONE CLASS(meshVol2DCart), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:,1:) REAL(8), ALLOCATABLE:: dPsi(:,:) REAL(8):: dx(1:2), dy(1:2) @@ -967,7 +964,7 @@ MODULE moduleMesh2DCart dPsi=dPsi_in ELSE - dPsi = self%dPsi(xi) + dPsi = self%dPsi(Xi) END IF diff --git a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 index c576c71..2869cb3 100644 --- a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 +++ b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 @@ -310,49 +310,52 @@ MODULE moduleMesh2DCyl CLASS(meshVol2DCylQuad), INTENT(inout):: self REAL(8):: r, xi(1:3) REAL(8):: detJ - REAL(8):: fPsi(1:4) + REAL(8):: fPsi(1:4), fPsi_node(1:4) self%volume = 0.D0 self%arNodes = 0.D0 !2D 1 point Gauss Quad Integral xi = 0.D0 detJ = self%detJac(xi)*PI8 !4*2*pi - fPsi = self%fPsi(xi) + CALL self%fPsi(xi, fPsi) !Computes total volume of the cell r = DOT_PRODUCT(fPsi,self%r) self%volume = r*detJ !Computes volume per node xi = (/-5.D-1, -5.D-1, 0.D0/) - r = DOT_PRODUCT(self%fPsi(xi),self%r) + CALL self%fPsi(xi, fPsi_node) + r = DOT_PRODUCT(fPsi_node,self%r) self%arNodes(1) = fPsi(1)*r*detJ xi = (/ 5.D-1, -5.D-1, 0.D0/) - r = DOT_PRODUCT(self%fPsi(xi),self%r) + CALL self%fPsi(xi, fPsi_node) + r = DOT_PRODUCT(fPsi_node,self%r) self%arNodes(2) = fPsi(2)*r*detJ xi = (/ 5.D-1, 5.D-1, 0.D0/) - r = DOT_PRODUCT(self%fPsi(xi),self%r) + CALL self%fPsi(xi, fPsi_node) + r = DOT_PRODUCT(fPsi_node,self%r) self%arNodes(3) = fPsi(3)*r*detJ xi = (/-5.D-1, 5.D-1, 0.D0/) - r = DOT_PRODUCT(self%fPsi(xi),self%r) + CALL self%fPsi(xi, fPsi_node) + r = DOT_PRODUCT(fPsi_node,self%r) self%arNodes(4) = fPsi(4)*r*detJ END SUBROUTINE areaQuad !Computes element functions in point xi - PURE FUNCTION fPsiQuad(xi) RESULT(fPsi) + PURE SUBROUTINE fPsiQuad(xi, fPsi) IMPLICIT NONE - REAL(8),INTENT(in):: xi(1:3) - REAL(8), ALLOCATABLE:: fPsi(:) + REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(out):: fPsi(:) - ALLOCATE(fPsi(1:4)) + 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(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 + END SUBROUTINE fPsiQuad !Derivative element function at coordinates xi PURE FUNCTION dPsiQuad(xi) RESULT(dPsi) @@ -375,10 +378,11 @@ MODULE moduleMesh2DCyl REAL(8),INTENT(in):: xi2 REAL(8):: dPsiXi1(1:4) - dPsiXi1(1) = -(1.D0-xi2) - dPsiXi1(2) = (1.D0-xi2) - dPsiXi1(3) = (1.D0+xi2) - dPsiXi1(4) = -(1.D0+xi2) + dPsiXi1(1) = -(1.D0 - xi2) + dPsiXi1(2) = (1.D0 - xi2) + dPsiXi1(3) = (1.D0 + xi2) + dPsiXi1(4) = -(1.D0 + xi2) + dPsiXi1 = dPsiXi1*0.25D0 END FUNCTION dPsiQuadXi1 @@ -390,11 +394,12 @@ MODULE moduleMesh2DCyl REAL(8),INTENT(in):: xi1 REAL(8):: dPsiXi2(1:4) - dPsiXi2(1) = -(1.D0-xi1) - dPsiXi2(2) = -(1.D0+xi1) - dPsiXi2(3) = (1.D0+xi1) - dPsiXi2(4) = (1.D0-xi1) - dPsiXi2 = dPsiXi2*0.25D0 + dPsiXi2(1) = -(1.D0 - xi1) + dPsiXi2(2) = -(1.D0 + xi1) + dPsiXi2(3) = (1.D0 + xi1) + dPsiXi2(4) = (1.D0 - xi1) + + dPsiXi2 = dPsiXi2 * 0.25D0 END FUNCTION dPsiQuadXi2 @@ -427,7 +432,7 @@ MODULE moduleMesh2DCyl xii(2) = random(-1.D0, 1.D0) xii(3) = 0.D0 - fPsi = self%fPsi(xii) + CALL self%fPsi(xii, fPsi) r(1) = DOT_PRODUCT(fPsi, self%z) r(2) = DOT_PRODUCT(fPsi, self%r) @@ -457,7 +462,7 @@ MODULE moduleMesh2DCyl DO m = 1, 3 xi(1) = corQuad(m) dPsi(2,:) = self%dPsiXi2(xi(1)) - fPsi = self%fPsi(xi) + CALL self%fPsi(xi, fPsi) detJ = self%detJac(xi,dPsi) invJ = self%invJac(xi,dPsi) r = DOT_PRODUCT(fPsi,self%r) @@ -492,7 +497,7 @@ MODULE moduleMesh2DCyl DO m = 1, 3 xi(2) = corQuad(m) detJ = self%detJac(xi) - fPsi = self%fPsi(xi) + CALL self%fPsi(xi, fPsi) r = DOT_PRODUCT(fPsi,self%r) f = DOT_PRODUCT(fPsi,source) localF = localF + r*f*fPsi*wQuad(l)*wQuad(m)*detJ @@ -564,7 +569,7 @@ MODULE moduleMesh2DCyl self%n3%emData%B(3), & self%n4%emData%B(3) /) - fPsi = self%fPsi(xi) + CALL self%fPsi(xi, fPsi) MF = MATMUL(fPsi(:), MF_Nodes) END FUNCTION gatherMFQuad @@ -582,30 +587,30 @@ MODULE moduleMesh2DCyl END FUNCTION getNodesQuad !Transforms physical coordinates to element coordinates - PURE FUNCTION phy2logQuad(self,r) RESULT(xN) + PURE FUNCTION phy2logQuad(self,r) RESULT(XiN) IMPLICIT NONE CLASS(meshVol2DCylQuad), INTENT(in):: self REAL(8), INTENT(in):: r(1:3) - REAL(8):: xN(1:3) - REAL(8):: xO(1:3), detJ, invJ(1:2,1:2), f(1:2) + REAL(8):: XiN(1:3) + REAL(8):: XiO(1:3), detJ, invJ(1:2,1:2), f(1:2) REAL(8):: dPsi(1:2,1:4), fPsi(1:4) REAL(8):: conv !Iterative newton method to transform coordinates conv=1.D0 - xO=0.D0 + XiO=0.D0 - DO WHILE(conv>1.D-4) - dPsi = self%dPsi(xO) - invJ = self%invJac(xO, dPsi) - fPsi = self%fPsi(xO) - f(1) = DOT_PRODUCT(fPsi,self%z)-r(1) - f(2) = DOT_PRODUCT(fPsi,self%r)-r(2) - detJ = self%detJac(xO,dPsi) - xN(1:2)=xO(1:2) - MATMUL(invJ, f)/detJ - conv=MAXVAL(DABS(xN-xO),1) - xO=xN + DO WHILE(conv>1.D-3) + CALL self%fPsi(XiO, fPsi) + f = (/ DOT_PRODUCT(fPsi,self%z)-r(1), & + DOT_PRODUCT(fPsi,self%r)-r(2) /) + dPsi = self%dPsi(XiO) + invJ = self%invJac(XiO, dPsi) + detJ = self%detJac(XiO,dPsi) + XiN(1:2)=XiO(1:2) - MATMUL(invJ, f)/detJ + conv=MAXVAL(DABS(XiN-XiO),1) + XiO=XiN END DO @@ -690,7 +695,7 @@ MODULE moduleMesh2DCyl xii(2) = random( 0.D0, 1.D0 - xii(1)) xii(3) = 0.D0 - fPsi = self%fPsi(xii) + CALL self%fPsi(xii, fPsi) r(1) = DOT_PRODUCT(fPsi, self%z) r(2) = DOT_PRODUCT(fPsi, self%r) @@ -713,7 +718,7 @@ MODULE moduleMesh2DCyl !2D 1 point Gauss Quad Integral xi = (/1.D0/3.D0, 1.D0/3.D0, 0.D0 /) detJ = self%detJac(xi)*PI !2PI*1/2 - fPsi = self%fPsi(xi) + CALL self%fPsi(xi, fPsi) !Computes total volume of the cell r = DOT_PRODUCT(fPsi,self%r) self%volume = r*detJ @@ -723,19 +728,17 @@ MODULE moduleMesh2DCyl END SUBROUTINE areaTria !Shape functions for triangular element - PURE FUNCTION fPsiTria(xi) RESULT(fPsi) + PURE SUBROUTINE fPsiTria(xi, fPsi) IMPLICIT NONE REAL(8), INTENT(in):: xi(1:3) - REAL(8), ALLOCATABLE:: fPsi(:) - - ALLOCATE(fPsi(1:3)) + REAL(8), INTENT(out):: fPsi(:) fPsi(1) = 1.D0 - xi(1) - xi(2) fPsi(2) = xi(1) fPsi(3) = xi(2) - END FUNCTION fPsiTria + END SUBROUTINE fPsiTria !Derivative element function at coordinates xi PURE FUNCTION dPsiTria(xi) RESULT(dPsi) @@ -813,7 +816,7 @@ MODULE moduleMesh2DCyl dPsi = self%dPsi(xi) detJ = self%detJac(xi,dPsi) invJ = self%invJac(xi,dPsi) - fPsi = self%fPsi(xi) + CALL self%fPsi(xi, fPsi) r = DOT_PRODUCT(fPsi,self%r) localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*r*wTria(l)/detJ @@ -843,7 +846,7 @@ MODULE moduleMesh2DCyl xi(1) = xi1Tria(l) xi(2) = xi2Tria(l) detJ = self%detJac(xi) - fPsi = self%fPsi(xi) + CALL self%fPsi(xi, fPsi) r = DOT_PRODUCT(fPsi,self%r) f = DOT_PRODUCT(fPsi,source) localF = localF + r*f*fPsi*wTria(l)*detJ @@ -910,7 +913,7 @@ MODULE moduleMesh2DCyl self%n2%emData%B(3), & self%n3%emData%B(3) /) - fPsi = self%fPsi(xi) + CALL self%fPsi(xi, fPsi) MF = MATMUL(fPsi, MF_Nodes) END FUNCTION gatherMFTria diff --git a/src/modules/mesh/3DCart/moduleMesh3DCart.f90 b/src/modules/mesh/3DCart/moduleMesh3DCart.f90 index 0add18a..4b29c16 100644 --- a/src/modules/mesh/3DCart/moduleMesh3DCart.f90 +++ b/src/modules/mesh/3DCart/moduleMesh3DCart.f90 @@ -41,8 +41,8 @@ MODULE moduleMesh3DCart END TYPE meshVol3DCart ABSTRACT INTERFACE - PURE FUNCTION dPsi_interface(xii) RESULT(dPsi) - REAL(8), INTENT(in):: xii(1:3) + PURE FUNCTION dPsi_interface(Xi) RESULT(dPsi) + REAL(8), INTENT(in):: Xi(1:3) REAL(8), ALLOCATABLE:: dPsi(:,:) END FUNCTION dPsi_interface @@ -71,8 +71,8 @@ MODULE moduleMesh3DCart PROCEDURE, PASS:: calcVol => volumeTetra PROCEDURE, NOPASS:: fPsi => fPsiTetra PROCEDURE, NOPASS:: dPsi => dPsiTetra - PROCEDURE, NOPASS:: dPsiXi1 => dPsiTetraXii1 - PROCEDURE, NOPASS:: dPsiXi2 => dPsiTetraXii2 + PROCEDURE, NOPASS:: dPsiXi1 => dPsiTetraXi1 + PROCEDURE, NOPASS:: dPsiXi2 => dPsiTetraXi2 PROCEDURE, PASS:: partialDer => partialDerTetra PROCEDURE, PASS:: elemK => elemKTetra PROCEDURE, PASS:: elemF => elemFTetra @@ -213,14 +213,14 @@ MODULE moduleMesh3DCart CLASS(meshEdge3DCartTria), INTENT(in):: self REAL(8):: r(1:3) - REAL(8):: xii(1:3) + REAL(8):: Xi(1:3) REAL(8):: fPsi(1:3) - xii(1) = random( 0.D0, 1.D0) - xii(2) = random( 0.D0, 1.D0 - xii(1)) - xii(3) = 0.D0 + Xi(1) = random( 0.D0, 1.D0) + Xi(2) = random( 0.D0, 1.D0 - Xi(1)) + Xi(3) = 0.D0 - fPsi = self%fPsi(xii) + fPsi = self%fPsi(Xi) r = (/DOT_PRODUCT(fPsi, self%x), & DOT_PRODUCT(fPsi, self%y), & DOT_PRODUCT(fPsi, self%z)/) @@ -228,17 +228,17 @@ MODULE moduleMesh3DCart END FUNCTION randPosEdgeTria !Shape functions for triangular surface - PURE FUNCTION fPsiEdgeTria(xii) RESULT(fPsi) + PURE FUNCTION fPsiEdgeTria(Xi) RESULT(fPsi) IMPLICIT NONE - REAL(8), INTENT(in):: xii(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8), ALLOCATABLE:: fPsi(:) ALLOCATE(fPsi(1:3)) - fPsi(1) = 1.D0 - xii(1) - xii(2) - fPsi(2) = xii(1) - fPsi(3) = xii(2) + fPsi(1) = 1.D0 - Xi(1) - Xi(2) + fPsi(2) = Xi(1) + fPsi(3) = Xi(2) END FUNCTION fPsiEdgeTria @@ -254,6 +254,7 @@ MODULE moduleMesh3DCart INTEGER, INTENT(in):: p(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) REAL(8), DIMENSION(1:3):: r1, r2, r3, r4 !Positions of each node + REAL(8):: Xi(1:3), fPsi(1:4) REAL(8):: volNodes(1:4) !Volume of each node self%n = n @@ -274,8 +275,9 @@ MODULE moduleMesh3DCart CALL self%calcVol() !Assign proportional volume to each node - !TODO: Review this to apply to all elements in the future - volNodes = self%fPsi((/0.25D0, 0.25D0, 0.25D0/))*self%volume + Xi = (/0.25D0, 0.25D0, 0.25D0/) + CALL self%fPsi(Xi, fPsi) + volNodes = fPsi*self%volume self%n1%v = self%n1%v + volNodes(1) self%n2%v = self%n2%v + volNodes(2) self%n3%v = self%n3%v + volNodes(3) @@ -295,19 +297,18 @@ MODULE moduleMesh3DCart CLASS(meshVol3DCartTetra), INTENT(in):: self REAL(8):: r(1:3) - REAL(8):: xii(1:3) - REAL(8), ALLOCATABLE:: fPsi(:) + REAL(8):: Xi(1:3) + REAL(8):: fPsi(1:4) - xii(1) = random( 0.D0, 1.D0) - xii(2) = random( 0.D0, 1.D0 - xii(1)) - xii(3) = random( 0.D0, 1.D0 - xii(1) - xii(2)) + Xi(1) = random( 0.D0, 1.D0) + Xi(2) = random( 0.D0, 1.D0 - Xi(1)) + Xi(3) = random( 0.D0, 1.D0 - Xi(1) - Xi(2)) - ALLOCATE(fPsi(1:4)) - fPsi = self%fPsi(xii) + CALL self%fPsi(Xi, fPsi) - r(1) = DOT_PRODUCT(fPsi, self%x) - r(2) = DOT_PRODUCT(fPsi, self%y) - r(3) = DOT_PRODUCT(fPsi, self%z) + r = (/ DOT_PRODUCT(fPsi, self%x), & + DOT_PRODUCT(fPsi, self%y), & + DOT_PRODUCT(fPsi, self%z) /) END FUNCTION randPosVolTetra @@ -316,83 +317,81 @@ MODULE moduleMesh3DCart IMPLICIT NONE CLASS(meshVol3DCartTetra), INTENT(inout):: self - REAL(8):: xii(1:3) + REAL(8):: Xi(1:3) self%volume = 0.D0 - xii = (/0.25D0, 0.25D0, 0.25D0/) - self%volume = self%detJac(xii) + Xi = (/0.25D0, 0.25D0, 0.25D0/) + self%volume = self%detJac(Xi) END SUBROUTINE volumeTetra - !Computes element functions in point xii - PURE FUNCTION fPsiTetra(xi) RESULT(fPsi) + !Computes element functions in point Xi + PURE SUBROUTINE fPsiTetra(Xi, fPsi) IMPLICIT NONE - REAL(8), INTENT(in):: xi(1:3) - REAL(8), ALLOCATABLE:: fPsi(:) + REAL(8), INTENT(in):: Xi(1:3) + REAL(8), INTENT(out):: fPsi(:) - ALLOCATE(fPsi(1:4)) + fPsi(1) = 1.D0 - Xi(1) - Xi(2) - Xi(3) + fPsi(2) = Xi(1) + fPsi(3) = Xi(2) + fPsi(4) = Xi(3) - fPsi(1) = 1.D0 - xi(1) - xi(2) - xi(3) - fPsi(2) = xi(1) - fPsi(3) = xi(2) - fPsi(4) = xi(3) + END SUBROUTINE fPsiTetra - END FUNCTION fPsiTetra - - !Derivative element function at coordinates xii - PURE FUNCTION dPsiTetra(xii) RESULT(dPsi) + !Derivative element function at coordinates Xi + PURE FUNCTION dPsiTetra(Xi) RESULT(dPsi) IMPLICIT NONE - REAL(8), INTENT(in):: xii(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8), ALLOCATABLE:: dPsi(:,:) ALLOCATE(dPsi(1:3,1:4)) - dPsi(1,:) = dPsiTetraXii1(xii(2), xii(3)) - dPsi(2,:) = dPsiTetraXii2(xii(1), xii(3)) - dPsi(3,:) = dPsiTetraXii3(xii(1), xii(2)) + dPsi(1,:) = dPsiTetraXi1(Xi(2), Xi(3)) + dPsi(2,:) = dPsiTetraXi2(Xi(1), Xi(3)) + dPsi(3,:) = dPsiTetraXi3(Xi(1), Xi(2)) END FUNCTION dPsiTetra - !Derivative element function respect to xii1 - PURE FUNCTION dPsiTetraXii1(xii2, xii3) RESULT(dPsiXii1) + !Derivative element function respect to Xi1 + PURE FUNCTION dPsiTetraXi1(Xi2, Xi3) RESULT(dPsiXi1) IMPLICIT NONE - REAL(8), INTENT(in):: xii2, xii3 - REAL(8):: dPsiXii1(1:4) + REAL(8), INTENT(in):: Xi2, Xi3 + REAL(8):: dPsiXi1(1:4) - dPsiXii1(1) = -1.D0 - dPsiXii1(2) = 1.D0 - dPsiXii1(3) = 0.D0 - dPsiXii1(4) = 0.D0 + dPsiXi1(1) = -1.D0 + dPsiXi1(2) = 1.D0 + dPsiXi1(3) = 0.D0 + dPsiXi1(4) = 0.D0 - END FUNCTION dPsiTetraXii1 + END FUNCTION dPsiTetraXi1 - !Derivative element function respect to xii2 - PURE FUNCTION dPsiTetraXii2(xii1, xii3) RESULT(dPsiXii2) + !Derivative element function respect to Xi2 + PURE FUNCTION dPsiTetraXi2(Xi1, Xi3) RESULT(dPsiXi2) IMPLICIT NONE - REAL(8), INTENT(in):: xii1, xii3 - REAL(8):: dPsiXii2(1:4) + REAL(8), INTENT(in):: Xi1, Xi3 + REAL(8):: dPsiXi2(1:4) - dPsiXii2(1) = -1.D0 - dPsiXii2(2) = 0.D0 - dPsiXii2(3) = 1.D0 - dPsiXii2(4) = 0.D0 + dPsiXi2(1) = -1.D0 + dPsiXi2(2) = 0.D0 + dPsiXi2(3) = 1.D0 + dPsiXi2(4) = 0.D0 - END FUNCTION dPsiTetraXii2 + END FUNCTION dPsiTetraXi2 - !Derivative element function respect to xii3 - PURE FUNCTION dPsiTetraXii3(xii1, xii2) RESULT(dPsiXii3) + !Derivative element function respect to Xi3 + PURE FUNCTION dPsiTetraXi3(Xi1, Xi2) RESULT(dPsiXi3) IMPLICIT NONE - REAL(8), INTENT(in):: xii1, xii2 - REAL(8):: dPsiXii3(1:4) + REAL(8), INTENT(in):: Xi1, Xi2 + REAL(8):: dPsiXi3(1:4) - dPsiXii3(1) = -1.D0 - dPsiXii3(2) = 0.D0 - dPsiXii3(3) = 0.D0 - dPsiXii3(4) = 1.D0 + dPsiXi3(1) = -1.D0 + dPsiXi3(2) = 0.D0 + dPsiXi3(3) = 0.D0 + dPsiXi3(4) = 1.D0 - END FUNCTION dPsiTetraXii3 + END FUNCTION dPsiTetraXi3 !Computes the derivatives in global coordinates PURE SUBROUTINE partialDerTetra(self, dPsi, dx, dy, dz) @@ -421,19 +420,19 @@ MODULE moduleMesh3DCart CLASS(meshVol3DCartTetra), INTENT(in):: self REAL(8), ALLOCATABLE:: localK(:,:) - REAL(8):: xii(1:3) + REAL(8):: Xi(1:3) REAL(8):: fPsi(1:4), dPsi(1:3, 1:4) REAL(8):: invJ(1:3,1:3), detJ ALLOCATE(localK(1:4,1:4)) localK = 0.D0 - xii = 0.D0 + Xi = 0.D0 !TODO: One point Gauss integral. Upgrade when possible - xii = (/ 0.25D0, 0.25D0, 0.25D0 /) - dPsi = self%dPsi(xii) - detJ = self%detJac(xii, dPsi) - invJ = self%invJac(xii, dPsi) - fPsi = self%fPsi(xii) + Xi = (/ 0.25D0, 0.25D0, 0.25D0 /) + dPsi = self%dPsi(Xi) + detJ = self%detJac(Xi, dPsi) + invJ = self%invJac(Xi, dPsi) + CALL self%fPsi(Xi, fPsi) localK = MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*1.D0/detJ END FUNCTION elemKTetra @@ -445,40 +444,40 @@ MODULE moduleMesh3DCart REAL(8), INTENT(in):: source(1:) REAL(8), ALLOCATABLE:: localF(:) REAL(8):: fPsi(1:4), dPsi(1:3, 1:4) - REAL(8):: xii(1:3) + REAL(8):: Xi(1:3) REAL(8):: detJ, f ALLOCATE(localF(1:4)) + localF = 0.D0 - xii = 0.D0 - !TODO: One point Gauss integral. Upgrade when possible - xii = (/ 0.25D0, 0.25D0, 0.25D0 /) - dPsi = self%dPsi(xii) - detJ = self%detJac(xii, dPsi) - fPsi = self%fPsi(xii) + Xi = 0.D0 + Xi = (/ 0.25D0, 0.25D0, 0.25D0 /) + dPsi = self%dPsi(Xi) + detJ = self%detJac(Xi, dPsi) + CALL self%fPsi(Xi, fPsi) f = DOT_PRODUCT(fPsi, source) localF = f*fPsi*1.D0*detJ END FUNCTION elemFTetra - PURE FUNCTION insideTetra(xi) RESULT(ins) + PURE FUNCTION insideTetra(Xi) RESULT(ins) IMPLICIT NONE - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) LOGICAL:: ins - ins = xi(1) >= 0.D0 .AND. & - xi(2) >= 0.D0 .AND. & - xi(3) >= 0.D0 .AND. & - 1.D0 - xi(1) - xi(2) - xi(3) >= 0.D0 + ins = Xi(1) >= 0.D0 .AND. & + Xi(2) >= 0.D0 .AND. & + Xi(3) >= 0.D0 .AND. & + 1.D0 - Xi(1) - Xi(2) - Xi(3) >= 0.D0 END FUNCTION insideTetra - PURE FUNCTION gatherEFTetra(self, xi) RESULT(EF) + PURE FUNCTION gatherEFTetra(self, Xi) RESULT(EF) IMPLICIT NONE CLASS(meshVol3DCartTetra), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8):: dPsi(1:3, 1:4) REAL(8):: dPsiR(1:3, 1:4) REAL(8):: invJ(1:3, 1:3), detJ @@ -490,9 +489,9 @@ MODULE moduleMesh3DCart self%n3%emData%phi, & self%n4%emData%phi /) - dPsi = self%dPsi(xi) - detJ = self%detJac(xi, dPsi) - invJ = self%invJac(xi, dPsi) + dPsi = self%dPsi(Xi) + detJ = self%detJac(Xi, dPsi) + invJ = self%invJac(Xi, dPsi) dPsiR = MATMUL(invJ, dPsi)/detJ EF(1) = -DOT_PRODUCT(dPsiR(1,:), phi) EF(2) = -DOT_PRODUCT(dPsiR(2,:), phi) @@ -500,11 +499,11 @@ MODULE moduleMesh3DCart END FUNCTION gatherEFTetra - PURE FUNCTION gatherMFTetra(self, xi) RESULT(MF) + PURE FUNCTION gatherMFTetra(self, Xi) RESULT(MF) IMPLICIT NONE CLASS(meshVol3DCartTetra), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8):: fPsi(1:4) REAL(8):: MF_Nodes(1:4,1:3) REAL(8):: MF(1:3) @@ -522,7 +521,7 @@ MODULE moduleMesh3DCart self%n3%emData%B(3), & self%n4%emData%B(3) /) - fPsi = self%fPsi(xi) + CALL self%fPsi(Xi, fPsi) MF = MATMUL(fPsi, MF_Nodes) END FUNCTION gatherMFTetra @@ -538,37 +537,37 @@ MODULE moduleMesh3DCart END FUNCTION getNodesTetra - PURE FUNCTION phy2logTetra(self,r) RESULT(xi) + PURE FUNCTION phy2logTetra(self,r) RESULT(Xi) IMPLICIT NONE CLASS(meshVol3DCartTetra), INTENT(in):: self REAL(8), INTENT(in):: r(1:3) - REAL(8):: xi(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:4) - xi = 0.D0 + Xi = 0.D0 deltaR = (/r(1) - self%x(1), r(2) - self%y(1), r(3) - self%z(1) /) - dPsi = self%dPsi(xi) - invJ = self%invJac(xi, dPsi) - detJ = self%detJac(xi, dPsi) - xi = MATMUL(invJ, deltaR)/detJ + dPsi = self%dPsi(Xi) + invJ = self%invJac(Xi, dPsi) + detJ = self%detJac(Xi, dPsi) + Xi = MATMUL(invJ, deltaR)/detJ END FUNCTION phy2logTetra - SUBROUTINE nextElementTetra(self, xi, nextElement) + SUBROUTINE nextElementTetra(self, Xi, nextElement) IMPLICIT NONE CLASS(meshVol3DCartTetra), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) CLASS(meshElement), POINTER, INTENT(out):: nextElement - REAL(8):: xiArray(1:4) + 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) + XiArray = (/ Xi(3), 1.D0 - Xi(1) - Xi(2) - Xi(3), Xi(2), Xi(1) /) + nextInt = MINLOC(XiArray, 1) NULLIFY(nextElement) SELECT CASE(nextInt) CASE (1) @@ -585,11 +584,11 @@ MODULE moduleMesh3DCart !COMMON FUNCTIONS FOR CARTESIAN VOLUME ELEMENTS IN 3D !Computes element Jacobian determinant - PURE FUNCTION detJ3DCart(self, xi, dPsi_in) RESULT(dJ) + PURE FUNCTION detJ3DCart(self, Xi, dPsi_in) RESULT(dJ) IMPLICIT NONE CLASS(meshVol3DCart), INTENT(in)::self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:, 1:) REAL(8):: dJ REAL(8), ALLOCATABLE:: dPsi(:,:) @@ -599,7 +598,7 @@ MODULE moduleMesh3DCart dPsi = dPsi_in ELSE - dPsi = self%dPsi(xi) + dPsi = self%dPsi(Xi) END IF @@ -610,11 +609,11 @@ MODULE moduleMesh3DCart END FUNCTION detJ3DCart - PURE FUNCTION invJ3DCart(self,xi,dPsi_in) RESULT(invJ) + PURE FUNCTION invJ3DCart(self,Xi,dPsi_in) RESULT(invJ) IMPLICIT NONE CLASS(meshVol3DCart), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:,1:) REAL(8), ALLOCATABLE:: dPsi(:,:) REAL(8), DIMENSION(1:3):: dx, dy, dz @@ -624,7 +623,7 @@ MODULE moduleMesh3DCart dPsi=dPsi_in ELSE - dPsi = self%dPsi(xi) + dPsi = self%dPsi(Xi) END IF diff --git a/src/modules/mesh/moduleMesh.f90 b/src/modules/mesh/moduleMesh.f90 index 05c4b85..11e8bc7 100644 --- a/src/modules/mesh/moduleMesh.f90 +++ b/src/modules/mesh/moduleMesh.f90 @@ -211,11 +211,11 @@ MODULE moduleMesh END FUNCTION getNodesVol_interface - PURE FUNCTION fPsi_interface(xi) RESULT(fPsi) + PURE SUBROUTINE fPsi_interface(xi, fPsi) REAL(8), INTENT(in):: xi(1:3) - REAL(8), ALLOCATABLE:: fPsi(:) + REAL(8), INTENT(out):: fPsi(:) - END FUNCTION fPsi_interface + END SUBROUTINE fPsi_interface PURE FUNCTION elemK_interface(self) RESULT(localK) IMPORT:: meshVol @@ -496,11 +496,14 @@ MODULE moduleMesh INTEGER:: i, nNodes CLASS(meshNode), POINTER:: node - fPsi = self%fPsi(part%xi) - tensorS = outerProduct(part%v, part%v) - sp = part%species%n volNodes = self%getNodes() nNodes = SIZE(volNodes) + ALLOCATE(fPsi(1:nNodes)) + CALL self%fPsi(part%xi, fPsi) + + tensorS = outerProduct(part%v, part%v) + + sp = part%species%n DO i = 1, nNodes node => mesh%nodes(volNodes(i))%obj From 2486ef63162bc102e0da11fa1461de0289ba0e85 Mon Sep 17 00:00:00 2001 From: JGonzalez Date: Thu, 5 Jan 2023 16:47:13 +0100 Subject: [PATCH 02/13] Reduction in pushing Reduction in 10-20% of time spend in pushing in 2DCyl thanks to rewriting fPsi and dPsi. --- src/modules/init/moduleInput.f90 | 30 +- src/modules/mesh/0D/moduleMesh0D.f90 | 133 ++-- src/modules/mesh/1DCart/moduleMesh1DCart.f90 | 223 +++--- src/modules/mesh/1DRad/moduleMesh1DRad.f90 | 223 +++--- src/modules/mesh/2DCart/moduleMesh2DCart.f90 | 491 ++++++------- src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 | 675 +++++++++--------- src/modules/mesh/3DCart/moduleMesh3DCart.f90 | 277 ++++--- .../mesh/inout/0D/moduleMeshInput0D.f90 | 8 +- .../mesh/inout/0D/moduleMeshOutput0D.f90 | 2 +- .../mesh/inout/gmsh2/moduleMeshInputGmsh2.f90 | 24 +- .../inout/gmsh2/moduleMeshOutputGmsh2.f90 | 16 +- src/modules/mesh/moduleMesh.f90 | 362 ++++++---- src/modules/mesh/moduleMeshBoundary.f90 | 4 +- src/modules/moduleCollisions.f90 | 1 - src/modules/moduleInject.f90 | 4 +- .../solver/electromagnetic/moduleEM.f90 | 40 +- src/modules/solver/moduleSolver.f90 | 30 +- src/modules/solver/pusher/modulePusher.f90 | 26 +- 18 files changed, 1289 insertions(+), 1280 deletions(-) diff --git a/src/modules/init/moduleInput.f90 b/src/modules/init/moduleInput.f90 index aaf4b08..3ff9e5b 100644 --- a/src/modules/init/moduleInput.f90 +++ b/src/modules/init/moduleInput.f90 @@ -337,7 +337,7 @@ MODULE moduleInput !Mean velocity and temperature at particle position REAL(8):: velocityXi(1:3), temperatureXi INTEGER:: nNewPart = 0.D0 - CLASS(meshVol), POINTER:: vol + CLASS(meshCell), POINTER:: vol TYPE(particle), POINTER:: partNew REAL(8):: vTh TYPE(lNode), POINTER:: partCurr, partNext @@ -356,13 +356,13 @@ MODULE moduleInput filename = path // spFile CALL mesh%readInitial(sp, filename, density, velocity, temperature) !For each volume in the node, create corresponding particles - DO e = 1, mesh%numVols + DO e = 1, mesh%numCells !Scale variables !Density at centroid of cell - nodes = mesh%vols(e)%obj%getNodes() - nNodes = SIZE(nodes) + nodes = mesh%cells(e)%obj%getNodes() + nNodes = mesh%cells(e)%obj%nNodes ALLOCATE(fPsi(1:nNodes)) - CALL mesh%vols(e)%obj%fPsi((/0.D0, 0.D0, 0.D0/), fPsi) + fPsi = mesh%cells(e)%obj%fPsi((/0.D0, 0.D0, 0.D0/)) ALLOCATE(source(1:nNodes)) DO j = 1, nNodes source(j) = density(nodes(j)) @@ -371,16 +371,16 @@ MODULE moduleInput densityCen = DOT_PRODUCT(fPsi, source) !Calculate number of particles - nNewPart = INT(densityCen * (mesh%vols(e)%obj%volume*Vol_ref) / species(sp)%obj%weight) + nNewPart = INT(densityCen * (mesh%cells(e)%obj%volume*Vol_ref) / species(sp)%obj%weight) !Allocate new particles DO p = 1, nNewPart ALLOCATE(partNew) partNew%species => species(sp)%obj - partNew%r = mesh%vols(e)%obj%randPos() - partNew%xi = mesh%vols(e)%obj%phy2log(partNew%r) + partNew%r = mesh%cells(e)%obj%randPos() + partNew%xi = mesh%cells(e)%obj%phy2log(partNew%r) !Get mean velocity at particle position - CALL mesh%vols(e)%obj%fPsi(partNew%xi, fPsi) + fPsi = mesh%cells(e)%obj%fPsi(partNew%xi) DO j = 1, nNodes source(j) = velocity(nodes(j), 1) @@ -426,7 +426,7 @@ MODULE moduleInput CALL partInitial%add(partNew) !Assign particle to list in volume - vol => meshforMCC%vols(partNew%volColl)%obj + vol => meshforMCC%cells(partNew%volColl)%obj CALL OMP_SET_LOCK(vol%lock) CALL vol%listPart_in(sp)%add(partNew) vol%totalWeight(sp) = vol%totalWeight(sp) + partNew%weight @@ -643,7 +643,7 @@ MODULE moduleInput REAL(8):: energyThreshold, energyBinding CHARACTER(:), ALLOCATABLE:: electron INTEGER:: e - CLASS(meshVol), POINTER:: vol + CLASS(meshCell), POINTER:: vol !Firstly, checks if the object 'interactions' exists CALL config%info('interactions', found) @@ -739,8 +739,8 @@ MODULE moduleInput END DO !Init the required arrays in each volume to account for MCC. - DO e = 1, meshForMCC%numVols - vol => meshForMCC%vols(e)%obj + DO e = 1, meshForMCC%numCells + vol => meshForMCC%cells(e)%obj !Allocate Maximum cross section per collision pair and assign the initial collision rate ALLOCATE(vol%sigmaVrelMax(1:nCollPairs)) @@ -930,8 +930,8 @@ MODULE moduleInput CALL config%get(object // '.volume', volume, found) !Rescale the volumne IF (found) THEN - mesh%vols(1)%obj%volume = mesh%vols(1)%obj%volume*volume / Vol_ref - mesh%nodes(1)%obj%v = mesh%vols(1)%obj%volume + mesh%cells(1)%obj%volume = mesh%cells(1)%obj%volume*volume / Vol_ref + mesh%nodes(1)%obj%v = mesh%cells(1)%obj%volume END IF diff --git a/src/modules/mesh/0D/moduleMesh0D.f90 b/src/modules/mesh/0D/moduleMesh0D.f90 index 0a14520..a57f244 100644 --- a/src/modules/mesh/0D/moduleMesh0D.f90 +++ b/src/modules/mesh/0D/moduleMesh0D.f90 @@ -11,22 +11,25 @@ MODULE moduleMesh0D END TYPE meshNode0D - TYPE, PUBLIC, EXTENDS(meshVol):: meshVol0D + TYPE, PUBLIC, EXTENDS(meshCell):: meshCell0D CLASS(meshNode), POINTER:: n1 CONTAINS - PROCEDURE, PASS:: init => initVol0D + PROCEDURE, PASS:: init => initCell0D PROCEDURE, PASS:: getNodes => getNodes0D PROCEDURE, PASS:: randPos => randPos0D - PROCEDURE, NOPASS:: fPsi => fPsi0D - PROCEDURE, PASS:: gatherEF => gatherEF0D - PROCEDURE, PASS:: gatherMF => gatherMF0D + PROCEDURE, PASS:: fPsi => fPsi0D + PROCEDURE, PASS:: dPsi => dPsi0D + PROCEDURE, PASS:: detJac => detJ0D + PROCEDURE, PASS:: invJac => invJ0D PROCEDURE, PASS:: elemK => elemK0D PROCEDURE, PASS:: elemF => elemF0D + PROCEDURE, PASS:: gatherElectricField => gatherEF0D + PROCEDURE, PASS:: gatherMagneticField => gatherMF0D PROCEDURE, PASS:: phy2log => phy2log0D PROCEDURE, NOPASS:: inside => inside0D PROCEDURE, PASS:: nextElement => nextElement0D - END TYPE meshVol0D + END TYPE meshCell0D CONTAINS !NODE FUNCTIONS @@ -61,18 +64,20 @@ MODULE moduleMesh0D !VOLUME FUNCTIONS !Inits dummy 0D volume - SUBROUTINE initVol0D(self, n, p, nodes) + SUBROUTINE initCell0D(self, n, p, nodes) USE moduleRefParam USE moduleSpecies IMPLICIT NONE - CLASS(meshVol0D), INTENT(out):: self + CLASS(meshCell0D), INTENT(out):: self INTEGER, INTENT(in):: n INTEGER, INTENT(in):: p(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) self%n = n + self%nNodes = SIZE(p) + self%n1 => nodes(p(1))%obj self%volume = 1.D0 self%n1%v = 1.D0 @@ -82,15 +87,13 @@ MODULE moduleMesh0D ALLOCATE(self%listPart_in(1:nSpecies)) ALLOCATE(self%totalWeight(1:nSpecies)) - END SUBROUTINE initVol0D + END SUBROUTINE initCell0D PURE FUNCTION getNodes0D(self) RESULT(n) IMPLICIT NONE - CLASS(meshVol0D), INTENT(in):: self - INTEGER, ALLOCATABLE:: n(:) - - ALLOCATE(n(1:1)) + CLASS(meshCell0D), INTENT(in):: self + INTEGER:: n(1:self%nNodes) n = self%n1%n @@ -99,50 +102,65 @@ MODULE moduleMesh0D FUNCTION randPos0D(self) RESULT(r) IMPLICIT NONE - CLASS(meshVol0D), INTENT(in):: self + CLASS(meshCell0D), INTENT(in):: self REAL(8):: r(1:3) r = 0.D0 END FUNCTION randPos0D - PURE SUBROUTINE fPsi0D(xi, fPsi) - REAL(8), INTENT(in):: xi(1:3) - REAL(8), INTENT(out):: fPsi(:) + PURE FUNCTION fPsi0D(self, Xi) RESULT(fPsi) + IMPLICIT NONE + + CLASS(meshCell0D), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: fPsi(1:self%nNodes) fPsi = 1.D0 - END SUBROUTINE fPsi0D + END FUNCTION fPsi0D - PURE FUNCTION gatherEF0D(self, xi) RESULT(EF) + PURE FUNCTION dPsi0D(self, Xi) RESULT(dPsi) IMPLICIT NONE - CLASS(meshVol0D), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8):: EF(1:3) + CLASS(meshCell0D), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: dPsi(1:3,1:self%nNodes) - EF = 0.D0 + dPsi = 0.D0 - END FUNCTION gatherEF0D + END FUNCTION dPsi0D - PURE FUNCTION gatherMF0D(self, xi) RESULT(MF) + PURE FUNCTION detJ0D(self, Xi, dPsi_in) RESULT(dJ) IMPLICIT NONE - CLASS(meshVol0D), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8):: MF(1:3) + CLASS(meshCell0D), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + REAL(8):: dJ - MF = 0.D0 + dJ = 0.D0 - END FUNCTION gatherMF0D + END FUNCTION detJ0D + + PURE FUNCTION invJ0D(self, Xi, dPsi_in) RESULT(invJ) + IMPLICIT NONE + + CLASS(meshCell0D), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + REAL(8):: invJ(1:3,1:3) + + invJ = 0.D0 + + END FUNCTION invJ0D PURE FUNCTION elemK0D(self) RESULT(localK) IMPLICIT NONE - CLASS(meshVol0D), INTENT(in):: self - REAL(8), ALLOCATABLE:: localK(:,:) + CLASS(meshCell0D), INTENT(in):: self + REAL(8):: localK(1:self%nNodes,1:self%nNodes) - ALLOCATE(localK(1:1, 1:1)) localK = 0.D0 END FUNCTION elemK0D @@ -150,19 +168,48 @@ MODULE moduleMesh0D PURE FUNCTION elemF0D(self, source) RESULT(localF) IMPLICIT NONE - CLASS(meshVol0D), INTENT(in):: self - REAL(8), INTENT(in):: source(1:) - REAL(8), ALLOCATABLE:: localF(:) + CLASS(meshCell0D), INTENT(in):: self + REAL(8), INTENT(in):: source(1:self%nNodes) + REAL(8):: localF(1:self%nNodes) - ALLOCATE(localF(1:1)) localF = 0.D0 END FUNCTION elemF0D + PURE FUNCTION gatherEF0D(self, Xi) RESULT(array) + IMPLICIT NONE + CLASS(meshCell0D), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) + REAL(8):: phi(1:1) + + phi = (/ self%n1%emData%phi /) + + array = -self%gatherDF(Xi, phi) + + END FUNCTION gatherEF0D + + PURE FUNCTION gatherMF0D(self, Xi) RESULT(array) + IMPLICIT NONE + CLASS(meshCell0D), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) + REAL(8):: B(1:1,1:3) + + B(:,1) = (/ self%n1%emData%B(1) /) + + B(:,2) = (/ self%n1%emData%B(2) /) + + B(:,3) = (/ self%n1%emData%B(3) /) + + array = self%gatherF(Xi, 3, B) + + END FUNCTION gatherMF0D + PURE FUNCTION phy2log0D(self,r) RESULT(xN) IMPLICIT NONE - CLASS(meshVol0D), INTENT(in):: self + CLASS(meshCell0D), INTENT(in):: self REAL(8), INTENT(in):: r(1:3) REAL(8):: xN(1:3) @@ -170,21 +217,21 @@ MODULE moduleMesh0D END FUNCTION phy2log0D - PURE FUNCTION inside0D(xi) RESULT(ins) + PURE FUNCTION inside0D(Xi) RESULT(ins) IMPLICIT NONE - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) LOGICAL:: ins ins = .TRUE. END FUNCTION inside0D - SUBROUTINE nextElement0D(self, xi, nextElement) + SUBROUTINE nextElement0D(self, Xi, nextElement) IMPLICIT NONE - CLASS(meshVol0D), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + CLASS(meshCell0D), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) CLASS(meshElement), POINTER, INTENT(out):: nextElement nextElement => NULL() diff --git a/src/modules/mesh/1DCart/moduleMesh1DCart.f90 b/src/modules/mesh/1DCart/moduleMesh1DCart.f90 index 3380cf0..0f46ba5 100644 --- a/src/modules/mesh/1DCart/moduleMesh1DCart.f90 +++ b/src/modules/mesh/1DCart/moduleMesh1DCart.f90 @@ -8,7 +8,7 @@ MODULE moduleMesh1DCart 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):: meshNode1DCart !Element coordinates @@ -32,33 +32,26 @@ MODULE moduleMesh1DCart END TYPE meshEdge1DCart - TYPE, PUBLIC, ABSTRACT, EXTENDS(meshVol):: meshVol1DCart + TYPE, PUBLIC, ABSTRACT, EXTENDS(meshCell):: meshCell1DCart CONTAINS PROCEDURE, PASS:: detJac => detJ1DCart PROCEDURE, PASS:: invJac => invJ1DCart - PROCEDURE(dPsi_interface), DEFERRED, NOPASS:: dPsi PROCEDURE(partialDer_interface), DEFERRED, PASS:: partialDer - END TYPE meshVol1DCart + END TYPE meshCell1DCart ABSTRACT INTERFACE - PURE FUNCTION dPsi_interface(xi) RESULT(dPsi) - REAL(8), INTENT(in):: xi(1:3) - REAL(8), ALLOCATABLE:: dPsi(:,:) - - END FUNCTION dPsi_interface - PURE SUBROUTINE partialDer_interface(self, dPsi, dx) - IMPORT meshVol1DCart - CLASS(meshVol1DCart), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:,1:) + IMPORT meshCell1DCart + CLASS(meshCell1DCart), INTENT(in):: self + REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) REAL(8), INTENT(out), DIMENSION(1):: dx END SUBROUTINE partialDer_interface END INTERFACE - TYPE, PUBLIC, EXTENDS(meshVol1DCart):: meshVol1DCartSegm + TYPE, PUBLIC, EXTENDS(meshCell1DCart):: meshCell1DCartSegm !Element coordinates REAL(8):: x(1:2) !Connectivity to nodes @@ -67,22 +60,22 @@ MODULE moduleMesh1DCart CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL() REAL(8):: arNodes(1:2) CONTAINS - PROCEDURE, PASS:: init => initVol1DCartSegm - PROCEDURE, PASS:: randPos => randPos1DCartSeg + PROCEDURE, PASS:: init => initCell1DCartSegm + PROCEDURE, PASS:: randPos => randPos1DCartSegm PROCEDURE, PASS:: area => areaSegm - PROCEDURE, NOPASS:: fPsi => fPsiSegm - PROCEDURE, NOPASS:: dPsi => dPsiSegm + 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:: gatherEF => gatherEFSegm - PROCEDURE, PASS:: gatherMF => gatherMFSegm PROCEDURE, PASS:: getNodes => getNodesSegm PROCEDURE, PASS:: phy2log => phy2logSegm PROCEDURE, PASS:: nextElement => nextElementSegm - END TYPE meshVol1DCartSegm + END TYPE meshCell1DCartSegm CONTAINS !NODE FUNCTIONS @@ -193,17 +186,18 @@ MODULE moduleMesh1DCart !VOLUME FUNCTIONS !SEGMENT FUNCTIONS !Init segment element - SUBROUTINE initVol1DCartSegm(self, n, p, nodes) + SUBROUTINE initCell1DCartSegm(self, n, p, nodes) USE moduleRefParam IMPLICIT NONE - CLASS(meshVol1DCartSegm), INTENT(out):: self + CLASS(meshCell1DCartSegm), INTENT(out):: self INTEGER, INTENT(in):: n INTEGER, INTENT(in):: p(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) REAL(8), DIMENSION(1:3):: r1, r2 self%n = n + self%nNodes = SIZE(p) self%n1 => nodes(p(1))%obj self%n2 => nodes(p(2))%obj !Get element coordinates @@ -221,14 +215,14 @@ MODULE moduleMesh1DCart ALLOCATE(self%listPart_in(1:nSpecies)) ALLOCATE(self%totalWeight(1:nSpecies)) - END SUBROUTINE initVol1DCartSegm + END SUBROUTINE initCell1DCartSegm !Calculates a random position in 1D volume - FUNCTION randPos1DCartSeg(self) RESULT(r) + FUNCTION randPos1DCartSegm(self) RESULT(r) USE moduleRandom IMPLICIT NONE - CLASS(meshVol1DCartSegm), INTENT(in):: self + CLASS(meshCell1DCartSegm), INTENT(in):: self REAL(8):: r(1:3) REAL(8):: Xi(1:3) REAL(8), ALLOCATABLE:: fPsi(:) @@ -236,16 +230,16 @@ MODULE moduleMesh1DCart Xi(1) = random(-1.D0, 1.D0) Xi(2:3) = 0.D0 - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) r(1) = DOT_PRODUCT(fPsi, self%x) - END FUNCTION randPos1DCartSeg + END FUNCTION randPos1DCartSegm !Computes element area PURE SUBROUTINE areaSegm(self) IMPLICIT NONE - CLASS(meshVol1DCartSegm), INTENT(inout):: self + CLASS(meshCell1DCartSegm), INTENT(inout):: self REAL(8):: l !element length REAL(8):: fPsi(1:2) REAL(8):: detJ @@ -255,7 +249,7 @@ MODULE moduleMesh1DCart self%arNodes = 0.D0 !1 point Gauss integral Xi = 0.D0 - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) detJ = self%detJac(Xi) l = 2.D0*detJ self%volume = l @@ -264,26 +258,29 @@ MODULE moduleMesh1DCart END SUBROUTINE areaSegm !Computes element functions at point Xi - PURE SUBROUTINE fPsiSegm(xi, fPsi) + PURE FUNCTION fPsiSegm(self, xi) RESULT(fPsi) IMPLICIT NONE + CLASS(meshCell1DCartSegm), INTENT(in):: self REAL(8), INTENT(in):: xi(1:3) - REAL(8), INTENT(out):: fPsi(:) + REAL(8):: fPsi(1:self%nNodes) fPsi(1) = 1.D0 - xi(1) fPsi(2) = 1.D0 + xi(1) + fPsi = fPsi * 5.D-1 - END SUBROUTINE fPsiSegm + END FUNCTION fPsiSegm !Computes element derivative shape function at Xi - PURE FUNCTION dPsiSegm(xi) RESULT(dPsi) + PURE FUNCTION dPsiSegm(self, xi) RESULT(dPsi) IMPLICIT NONE + CLASS(meshCell1DCartSegm), INTENT(in):: self REAL(8), INTENT(in):: xi(1:3) - REAL(8), ALLOCATABLE:: dPsi(:,:) + REAL(8):: dPsi(1:3,1:self%nNodes) - ALLOCATE(dPsi(1:1, 1:2)) + dPsi = 0.D0 dPsi(1, 1) = -5.D-1 dPsi(1, 2) = 5.D-1 @@ -294,8 +291,8 @@ MODULE moduleMesh1DCart PURE SUBROUTINE partialDerSegm(self, dPsi, dx) IMPLICIT NONE - CLASS(meshVol1DCartSegm), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:,1:) + CLASS(meshCell1DCartSegm), INTENT(in):: self + REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) REAL(8), INTENT(out), DIMENSION(1):: dx dx(1) = DOT_PRODUCT(dPsi(1,:), self%x) @@ -306,14 +303,13 @@ MODULE moduleMesh1DCart PURE FUNCTION elemKSegm(self) RESULT(localK) IMPLICIT NONE - CLASS(meshVol1DCartSegm), INTENT(in):: self - REAL(8), ALLOCATABLE:: localK(:,:) + CLASS(meshCell1DCartSegm), INTENT(in):: self + REAL(8):: localK(1:self%nNodes,1:self%nNodes) REAL(8):: Xi(1:3) - REAL(8):: dPsi(1:1, 1:2) - REAL(8):: invJ(1), detJ + REAL(8):: dPsi(1:3, 1:2) + REAL(8):: invJ(1:3,1:3), detJ INTEGER:: l - ALLOCATE(localK(1:2,1:2)) localK = 0.D0 Xi = 0.D0 DO l = 1, 3 @@ -332,22 +328,21 @@ MODULE moduleMesh1DCart PURE FUNCTION elemFSegm(self, source) RESULT(localF) IMPLICIT NONE - CLASS(meshVol1DCartSegm), INTENT(in):: self - REAL(8), INTENT(in):: source(1:) - REAL(8), ALLOCATABLE:: localF(:) + CLASS(meshCell1DCartSegm), INTENT(in):: self + REAL(8), INTENT(in):: source(1:self%nNodes) + REAL(8):: localF(1:self%nNodes) REAL(8):: fPsi(1:2) REAL(8):: detJ, f REAL(8):: Xi(1:3) INTEGER:: l - ALLOCATE(localF(1:2)) localF = 0.D0 Xi = 0.D0 DO l = 1, 3 Xi(1) = corSeg(l) detJ = self%detJac(Xi) - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) f = DOT_PRODUCT(fPsi, source) localF = localF + f*fPsi*wSeg(l)*detJ @@ -355,6 +350,40 @@ MODULE moduleMesh1DCart END FUNCTION elemFSegm + PURE FUNCTION gatherEFSegm(self, Xi) RESULT(array) + IMPLICIT NONE + CLASS(meshCell1DCartSegm), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) + REAL(8):: phi(1:2) + + phi = (/ self%n1%emData%phi, & + self%n2%emData%phi /) + + array = -self%gatherDF(Xi, phi) + + END FUNCTION gatherEFSegm + + PURE FUNCTION gatherMFSegm(self, Xi) RESULT(array) + IMPLICIT NONE + CLASS(meshCell1DCartSegm), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) + REAL(8):: B(1:2,1:3) + + B(:,1) = (/ self%n1%emData%B(1), & + self%n2%emData%B(1) /) + + B(:,2) = (/ self%n1%emData%B(2), & + self%n2%emData%B(2) /) + + B(:,3) = (/ self%n1%emData%B(3), & + self%n2%emData%B(3) /) + + array = self%gatherF(Xi, 3, B) + + END FUNCTION gatherMFSegm + PURE FUNCTION insideSegm(xi) RESULT(ins) IMPLICIT NONE @@ -366,58 +395,13 @@ MODULE moduleMesh1DCart END FUNCTION insideSegm - !Gathers EF at position Xi - PURE FUNCTION gatherEFSegm(self, xi) RESULT(EF) - IMPLICIT NONE - - CLASS(meshVol1DCartSegm), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8):: dPsi(1, 1:2) - REAL(8):: phi(1:2) - REAL(8):: EF(1:3) - REAL(8):: invJ - - phi = (/ self%n1%emData%phi, & - self%n2%emData%phi /) - - dPsi = self%dPsi(xi) - invJ = self%invJac(xi, dPsi) - EF(1) = -DOT_PRODUCT(dPsi(1, :), phi)*invJ - EF(2) = 0.D0 - EF(3) = 0.D0 - - END FUNCTION gatherEFSegm - - PURE FUNCTION gatherMFSegm(self, xi) RESULT(MF) - IMPLICIT NONE - - CLASS(meshVol1DCartSegm), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8):: fPsi(1:2) - REAL(8):: MF_Nodes(1:2, 1:3) - REAL(8):: MF(1:3) - REAL(8):: invJ - - MF_Nodes(1:2,1) = (/ self%n1%emData%B(1), & - self%n2%emData%B(1) /) - MF_Nodes(1:2,2) = (/ self%n1%emData%B(2), & - self%n2%emData%B(2) /) - MF_Nodes(1:2,3) = (/ self%n1%emData%B(3), & - self%n2%emData%B(3) /) - - CALL self%fPsi(xi, fPsi) - MF = MATMUL(fPsi, MF_Nodes) - - END FUNCTION gatherMFSegm - !Get nodes from 1D volume PURE FUNCTION getNodesSegm(self) RESULT(n) IMPLICIT NONE - CLASS(meshVol1DCartSegm), INTENT(in):: self - INTEGER, ALLOCATABLE:: n(:) + CLASS(meshCell1DCartSegm), INTENT(in):: self + INTEGER:: n(1:self%nNodes) - ALLOCATE(n(1:2)) n = (/ self%n1%n, self%n2%n /) END FUNCTION getNodesSegm @@ -425,7 +409,7 @@ MODULE moduleMesh1DCart PURE FUNCTION phy2logSegm(self, r) RESULT(xN) IMPLICIT NONE - CLASS(meshVol1DCartSegm), INTENT(in):: self + CLASS(meshCell1DCartSegm), INTENT(in):: self REAL(8), INTENT(in):: r(1:3) REAL(8):: xN(1:3) @@ -438,7 +422,7 @@ MODULE moduleMesh1DCart SUBROUTINE nextElementSegm(self, xi, nextElement) IMPLICIT NONE - CLASS(meshVol1DCartSegm), INTENT(in):: self + CLASS(meshCell1DCartSegm), INTENT(in):: self REAL(8), INTENT(in):: xi(1:3) CLASS(meshElement), POINTER, INTENT(out):: nextElement @@ -459,10 +443,10 @@ MODULE moduleMesh1DCart PURE FUNCTION detJ1DCart(self, xi, dPsi_in) RESULT(dJ) IMPLICIT NONE - CLASS(meshVol1DCart), INTENT(in):: self + CLASS(meshCell1DCart), INTENT(in):: self REAL(8), INTENT(in):: xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:,1:) - REAL(8), ALLOCATABLE:: dPsi(:,:) + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + REAL(8):: dPsi(1:3,1:self%nNodes) REAL(8):: dJ REAL(8):: dx(1) @@ -483,12 +467,12 @@ MODULE moduleMesh1DCart PURE FUNCTION invJ1DCart(self, xi, dPsi_in) RESULT(invJ) IMPLICIT NONE - CLASS(meshVol1DCart), INTENT(in):: self + CLASS(meshCell1DCart), INTENT(in):: self REAL(8), INTENT(in):: xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:,1:) - REAL(8), ALLOCATABLE:: dPsi(:,:) + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + REAL(8):: invJ(1:3,1:3) + REAL(8):: dPsi(1:3,1:self%nNodes) REAL(8):: dx(1) - REAL(8):: invJ IF (PRESENT(dPsi_in)) THEN dPsi = dPsi_in @@ -498,8 +482,11 @@ MODULE moduleMesh1DCart END IF + invJ = 0.D0 + CALL self%partialDer(dPsi, dx) - invJ = 1.D0/dx(1) + + invJ(1,1) = 1.D0/dx(1) END FUNCTION invJ1DCart @@ -509,11 +496,11 @@ MODULE moduleMesh1DCart CLASS(meshGeneric), INTENT(inout):: self INTEGER:: e, et - DO e = 1, self%numVols + DO e = 1, self%numCells !Connect Vol-Vol - DO et = 1, self%numVols + DO et = 1, self%numCells IF (e /= et) THEN - CALL connectVolVol(self%vols(e)%obj, self%vols(et)%obj) + CALL connectVolVol(self%cells(e)%obj, self%cells(et)%obj) END IF @@ -523,7 +510,7 @@ MODULE moduleMesh1DCart TYPE IS(meshParticles) !Connect Vol-Edge DO et = 1, self%numEdges - CALL connectVolEdge(self%vols(e)%obj, self%edges(et)%obj) + CALL connectVolEdge(self%cells(e)%obj, self%edges(et)%obj) END DO @@ -536,13 +523,13 @@ MODULE moduleMesh1DCart SUBROUTINE connectVolVol(elemA, elemB) IMPLICIT NONE - CLASS(meshVol), INTENT(inout):: elemA - CLASS(meshVol), INTENT(inout):: elemB + CLASS(meshCell), INTENT(inout):: elemA + CLASS(meshCell), INTENT(inout):: elemB SELECT TYPE(elemA) - TYPE IS(meshVol1DCartSegm) + TYPE IS(meshCell1DCartSegm) SELECT TYPE(elemB) - TYPE IS(meshVol1DCartSegm) + TYPE IS(meshCell1DCartSegm) CALL connectSegmSegm(elemA, elemB) END SELECT @@ -554,8 +541,8 @@ MODULE moduleMesh1DCart SUBROUTINE connectSegmSegm(elemA, elemB) IMPLICIT NONE - CLASS(meshVol1DCartSegm), INTENT(inout), TARGET:: elemA - CLASS(meshVol1DCartSegm), INTENT(inout), TARGET:: elemB + CLASS(meshCell1DCartSegm), INTENT(inout), TARGET:: elemA + CLASS(meshCell1DCartSegm), INTENT(inout), TARGET:: elemB IF (.NOT. ASSOCIATED(elemA%e1) .AND. & elemA%n2%n == elemB%n1%n) THEN @@ -577,11 +564,11 @@ MODULE moduleMesh1DCart SUBROUTINE connectVolEdge(elemA, elemB) IMPLICIT NONE - CLASS(meshVol), INTENT(inout):: elemA + CLASS(meshCell), INTENT(inout):: elemA CLASS(meshEdge), INTENT(inout):: elemB SELECT TYPE(elemA) - TYPE IS (meshVol1DCartSegm) + TYPE IS (meshCell1DCartSegm) SELECT TYPE(elemB) CLASS IS(meshEdge1DCart) CALL connectSegmEdge(elemA, elemB) @@ -595,7 +582,7 @@ MODULE moduleMesh1DCart SUBROUTINE connectSegmEdge(elemA, elemB) IMPLICIT NONE - CLASS(meshVol1DCartSegm), INTENT(inout), TARGET:: elemA + CLASS(meshCell1DCartSegm), INTENT(inout), TARGET:: elemA CLASS(meshEdge1DCart), INTENT(inout), TARGET:: elemB IF (.NOT. ASSOCIATED(elemA%e1) .AND. & diff --git a/src/modules/mesh/1DRad/moduleMesh1DRad.f90 b/src/modules/mesh/1DRad/moduleMesh1DRad.f90 index 7b09e5b..8ebac17 100644 --- a/src/modules/mesh/1DRad/moduleMesh1DRad.f90 +++ b/src/modules/mesh/1DRad/moduleMesh1DRad.f90 @@ -32,34 +32,27 @@ MODULE moduleMesh1DRad END TYPE meshEdge1DRad - TYPE, PUBLIC, ABSTRACT, EXTENDS(meshVol):: meshVol1DRad + TYPE, PUBLIC, ABSTRACT, EXTENDS(meshCell):: meshCell1DRad CONTAINS PROCEDURE, PASS:: detJac => detJ1DRad PROCEDURE, PASS:: invJac => invJ1DRad - PROCEDURE(dPsi_interface), DEFERRED, NOPASS:: dPsi PROCEDURE(partialDer_interface), DEFERRED, PASS:: partialDer - END TYPE meshVol1DRad + END TYPE meshCell1DRad ABSTRACT INTERFACE - PURE FUNCTION dPsi_interface(xi) RESULT(dPsi) - REAL(8), INTENT(in):: xi(1:3) - REAL(8), ALLOCATABLE:: dPsi(:,:) - - END FUNCTION dPsi_interface - PURE SUBROUTINE partialDer_interface(self, dPsi, dx) - IMPORT meshVol1DRad + IMPORT meshCell1DRad - CLASS(meshVol1DRad), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:,1:) + CLASS(meshCell1DRad), INTENT(in):: self + REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) REAL(8), INTENT(out), DIMENSION(1):: dx END SUBROUTINE partialDer_interface END INTERFACE - TYPE, PUBLIC, EXTENDS(meshVol1DRad):: meshVol1DRadSegm + TYPE, PUBLIC, EXTENDS(meshCell1DRad):: meshCell1DRadSegm !Element coordinates REAL(8):: r(1:2) !Connectivity to nodes @@ -68,22 +61,22 @@ MODULE moduleMesh1DRad CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL() REAL(8):: arNodes(1:2) CONTAINS - PROCEDURE, PASS:: init => initVol1DRadSegm + PROCEDURE, PASS:: init => initCell1DRadSegm PROCEDURE, PASS:: randPos => randPos1DRadSeg PROCEDURE, PASS:: area => areaRad - PROCEDURE, NOPASS:: fPsi => fPsiRad - PROCEDURE, NOPASS:: dPsi => dPsiRad + 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:: gatherEF => gatherEFRad - PROCEDURE, PASS:: gatherMF => gatherMFRad PROCEDURE, PASS:: getNodes => getNodesRad PROCEDURE, PASS:: phy2log => phy2logRad PROCEDURE, PASS:: nextElement => nextElementRad - END TYPE meshVol1DRadSegm + END TYPE meshCell1DRadSegm CONTAINS !NODE FUNCTIONS @@ -195,17 +188,18 @@ MODULE moduleMesh1DRad !VOLUME FUNCTIONS !SEGMENT FUNCTIONS !Init segment element - SUBROUTINE initVol1DRadSegm(self, n, p, nodes) + SUBROUTINE initCell1DRadSegm(self, n, p, nodes) USE moduleRefParam IMPLICIT NONE - CLASS(meshVol1DRadSegm), INTENT(out):: self + CLASS(meshCell1DRadSegm), INTENT(out):: self INTEGER, INTENT(in):: n INTEGER, INTENT(in):: p(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) REAL(8), DIMENSION(1:3):: r1, r2 self%n = n + self%nNodes = SIZE(p) self%n1 => nodes(p(1))%obj self%n2 => nodes(p(2))%obj !Get element coordinates @@ -223,22 +217,22 @@ MODULE moduleMesh1DRad ALLOCATE(self%listPart_in(1:nSpecies)) ALLOCATE(self%totalWeight(1:nSpecies)) - END SUBROUTINE initVol1DRadSegm + END SUBROUTINE initCell1DRadSegm !Calculates a random position in 1D volume FUNCTION randPos1DRadSeg(self) RESULT(r) USE moduleRandom IMPLICIT NONE - CLASS(meshVol1DRadSegm), INTENT(in):: self + CLASS(meshCell1DRadSegm), 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 - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) r(1) = DOT_PRODUCT(fPsi, self%r) END FUNCTION randPos1DRadSeg @@ -247,7 +241,7 @@ MODULE moduleMesh1DRad PURE SUBROUTINE areaRad(self) IMPLICIT NONE - CLASS(meshVol1DRadSegm), INTENT(inout):: self + CLASS(meshCell1DRadSegm), INTENT(inout):: self REAL(8):: l !element length REAL(8):: fPsi(1:2), fPsi_node(1:2) REAL(8):: r @@ -258,7 +252,7 @@ MODULE moduleMesh1DRad self%arNodes = 0.D0 !1 point Gauss integral Xi = 0.D0 - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) detJ = self%detJac(Xi) !Computes total volume of the cell r = DOT_PRODUCT(fPsi, self%r) @@ -266,37 +260,40 @@ MODULE moduleMesh1DRad self%volume = r*l !Computes volume per node Xi = (/-5.D-1, 0.D0, 0.D0/) - CALL self%fPsi(Xi, fPsi_node) + fPsi_node = self%fPsi(Xi) r = DOT_PRODUCT(fPsi_node,self%r) self%arNodes(1) = fPsi(1)*r*l Xi = (/ 5.D-1, 0.D0, 0.D0/) - CALL self%fPsi(Xi, fPsi_node) + fPsi_node = self%fPsi(Xi) r = DOT_PRODUCT(fPsi_node,self%r) self%arNodes(2) = fPsi(2)*r*l END SUBROUTINE areaRad !Computes element functions at point Xi - PURE SUBROUTINE fPsiRad(xi, fPsi) + PURE FUNCTION fPsiRad(self, xi) RESULT(fPsi) IMPLICIT NONE + CLASS(meshCell1DRadSegm), INTENT(in):: self REAL(8), INTENT(in):: xi(1:3) - REAL(8), INTENT(out):: fPsi(:) + REAL(8):: fPsi(1:self%nNodes) fPsi(1) = 1.D0 - xi(1) fPsi(2) = 1.D0 + xi(1) + fPsi = fPsi * 5.D-1 - END SUBROUTINE fPsiRad + END FUNCTION fPsiRad !Computes element derivative shape function at Xi - PURE FUNCTION dPsiRad(xi) RESULT(dPsi) + PURE FUNCTION dPsiRad(self, xi) RESULT(dPsi) IMPLICIT NONE + CLASS(meshCell1DRadSegm), INTENT(in):: self REAL(8), INTENT(in):: xi(1:3) - REAL(8), ALLOCATABLE:: dPsi(:,:) + REAL(8):: dPsi(1:3,1:self%nNodes) - ALLOCATE(dPsi(1:1, 1:2)) + dPsi = 0.D0 dPsi(1, 1) = -5.D-1 dPsi(1, 2) = 5.D-1 @@ -307,8 +304,8 @@ MODULE moduleMesh1DRad PURE SUBROUTINE partialDerRad(self, dPsi, dx) IMPLICIT NONE - CLASS(meshVol1DRadSegm), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:,1:) + CLASS(meshCell1DRadSegm), INTENT(in):: self + REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) REAL(8), INTENT(out), DIMENSION(1):: dx dx(1) = DOT_PRODUCT(dPsi(1,:), self%r) @@ -320,15 +317,14 @@ MODULE moduleMesh1DRad USE moduleConstParam, ONLY: PI2 IMPLICIT NONE - CLASS(meshVol1DRadSegm), INTENT(in):: self - REAL(8), ALLOCATABLE:: localK(:,:) + CLASS(meshCell1DRadSegm), INTENT(in):: self + REAL(8):: localK(1:self%nNodes,1:self%nNodes) REAL(8):: Xi(1:3) - REAL(8):: dPsi(1:1, 1:2) - REAL(8):: invJ(1), detJ + REAL(8):: dPsi(1:3, 1:2) + REAL(8):: invJ(1:3,1:3), detJ REAL(8):: r, fPsi(1:2) INTEGER:: l - ALLOCATE(localK(1:2, 1:2)) localK = 0.D0 Xi = 0.D0 DO l = 1, 3 @@ -336,7 +332,7 @@ MODULE moduleMesh1DRad dPsi = self%dPsi(Xi) detJ = self%detJac(Xi, dPsi) invJ = self%invJac(Xi, dPsi) - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) r = DOT_PRODUCT(fPsi, self%r) localK = localK + MATMUL(RESHAPE(MATMUL(invJ,dPsi), (/ 2, 1/)), & RESHAPE(MATMUL(invJ,dPsi), (/ 1, 2/)))* & @@ -352,22 +348,21 @@ MODULE moduleMesh1DRad USE moduleConstParam, ONLY: PI2 IMPLICIT NONE - CLASS(meshVol1DRadSegm), INTENT(in):: self - REAL(8), INTENT(in):: source(1:) - REAL(8), ALLOCATABLE:: localF(:) + CLASS(meshCell1DRadSegm), INTENT(in):: self + REAL(8), INTENT(in):: source(1:self%nNodes) + REAL(8):: localF(1:self%nNodes) REAL(8):: fPsi(1:2) REAL(8):: detJ, f, r REAL(8):: Xi(1:3) INTEGER:: l - ALLOCATE(localF(1:2)) localF = 0.D0 Xi = 0.D0 DO l = 1, 3 Xi(1) = corSeg(l) detJ = self%detJac(Xi) - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) r = DOT_PRODUCT(fPsi, self%r) f = DOT_PRODUCT(fPsi, source) localF = localF + f*fPsi*r*wSeg(l)*detJ @@ -376,6 +371,40 @@ MODULE moduleMesh1DRad END FUNCTION elemFRad + PURE FUNCTION gatherEFRad(self, Xi) RESULT(array) + IMPLICIT NONE + CLASS(meshCell1DRadSegm), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) + REAL(8):: phi(1:2) + + phi = (/ self%n1%emData%phi, & + self%n2%emData%phi /) + + array = -self%gatherDF(Xi, phi) + + END FUNCTION gatherEFRad + + PURE FUNCTION gatherMFRad(self, Xi) RESULT(array) + IMPLICIT NONE + CLASS(meshCell1DRadSegm), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) + REAL(8):: B(1:2,1:3) + + B(:,1) = (/ self%n1%emData%B(1), & + self%n2%emData%B(1) /) + + B(:,2) = (/ self%n1%emData%B(2), & + self%n2%emData%B(2) /) + + B(:,3) = (/ self%n1%emData%B(3), & + self%n2%emData%B(3) /) + + array = self%gatherF(Xi, 3, B) + + END FUNCTION gatherMFRad + PURE FUNCTION insideRad(xi) RESULT(ins) IMPLICIT NONE @@ -387,58 +416,13 @@ MODULE moduleMesh1DRad END FUNCTION insideRad - !Gathers EF at position Xi - PURE FUNCTION gatherEFRad(self, xi) RESULT(EF) - IMPLICIT NONE - - CLASS(meshVol1DRadSegm), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8):: dPsi(1, 1:2) - REAL(8):: phi(1:2) - REAL(8):: EF(1:3) - REAL(8):: invJ - - phi = (/ self%n1%emData%phi, & - self%n2%emData%phi /) - - dPsi = self%dPsi(xi) - invJ = self%invJac(xi, dPsi) - EF(1) = -DOT_PRODUCT(dPsi(1, :), phi)*invJ - EF(2) = 0.D0 - EF(3) = 0.D0 - - END FUNCTION gatherEFRad - - PURE FUNCTION gatherMFRad(self, xi) RESULT(MF) - IMPLICIT NONE - - CLASS(meshVol1DRadSegm), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8):: fPsi(1:2) - REAL(8):: MF_Nodes(1:2, 1:3) - REAL(8):: MF(1:3) - REAL(8):: invJ - - MF_Nodes(1:2,1) = (/ self%n1%emData%B(1), & - self%n2%emData%B(1) /) - MF_Nodes(1:2,2) = (/ self%n1%emData%B(2), & - self%n2%emData%B(2) /) - MF_Nodes(1:2,3) = (/ self%n1%emData%B(3), & - self%n2%emData%B(3) /) - - CALL self%fPsi(xi, fPsi) - MF = MATMUL(fPsi, MF_Nodes) - - END FUNCTION gatherMFRad - !Get nodes from 1D volume PURE FUNCTION getNodesRad(self) RESULT(n) IMPLICIT NONE - CLASS(meshVol1DRadSegm), INTENT(in):: self - INTEGER, ALLOCATABLE:: n(:) + CLASS(meshCell1DRadSegm), INTENT(in):: self + INTEGER:: n(1:self%nNodes) - ALLOCATE(n(1:2)) n = (/ self%n1%n, self%n2%n /) END FUNCTION getNodesRad @@ -446,7 +430,7 @@ MODULE moduleMesh1DRad PURE FUNCTION phy2logRad(self, r) RESULT(xN) IMPLICIT NONE - CLASS(meshVol1DRadSegm), INTENT(in):: self + CLASS(meshCell1DRadSegm), INTENT(in):: self REAL(8), INTENT(in):: r(1:3) REAL(8):: xN(1:3) @@ -459,7 +443,7 @@ MODULE moduleMesh1DRad SUBROUTINE nextElementRad(self, xi, nextElement) IMPLICIT NONE - CLASS(meshVol1DRadSegm), INTENT(in):: self + CLASS(meshCell1DRadSegm), INTENT(in):: self REAL(8), INTENT(in):: xi(1:3) CLASS(meshElement), POINTER, INTENT(out):: nextElement @@ -479,10 +463,10 @@ MODULE moduleMesh1DRad PURE FUNCTION detJ1DRad(self, xi, dPsi_in) RESULT(dJ) IMPLICIT NONE - CLASS(meshVol1DRad), INTENT(in):: self + CLASS(meshCell1DRad), INTENT(in):: self REAL(8), INTENT(in):: xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:,1:) - REAL(8), ALLOCATABLE:: dPsi(:,:) + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + REAL(8):: dPsi(1:3,1:self%nNodes) REAL(8):: dJ REAL(8):: dx(1) @@ -503,12 +487,12 @@ MODULE moduleMesh1DRad PURE FUNCTION invJ1DRad(self, xi, dPsi_in) RESULT(invJ) IMPLICIT NONE - CLASS(meshVol1DRad), INTENT(in):: self + CLASS(meshCell1DRad), INTENT(in):: self REAL(8), INTENT(in):: xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:,1:) - REAL(8), ALLOCATABLE:: dPsi(:,:) + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + REAL(8):: dPsi(1:3,1:self%nNodes) REAL(8):: dx(1) - REAL(8):: invJ + REAL(8):: invJ(1:3,1:3) IF (PRESENT(dPsi_in)) THEN dPsi = dPsi_in @@ -518,8 +502,11 @@ MODULE moduleMesh1DRad END IF + invJ = 0.D0 + CALL self%partialDer(dPsi, dx) - invJ = 1.D0/dx(1) + + invJ(1,1) = 1.D0/dx(1) END FUNCTION invJ1DRad @@ -529,11 +516,11 @@ MODULE moduleMesh1DRad CLASS(meshGeneric), INTENT(inout):: self INTEGER:: e, et - DO e = 1, self%numVols + DO e = 1, self%numCells !Connect Vol-Vol - DO et = 1, self%numVols + DO et = 1, self%numCells IF (e /= et) THEN - CALL connectVolVol(self%vols(e)%obj, self%vols(et)%obj) + CALL connectVolVol(self%cells(e)%obj, self%cells(et)%obj) END IF @@ -543,7 +530,7 @@ MODULE moduleMesh1DRad TYPE IS(meshParticles) !Connect Vol-Edge DO et = 1, self%numEdges - CALL connectVolEdge(self%vols(e)%obj, self%edges(et)%obj) + CALL connectVolEdge(self%cells(e)%obj, self%edges(et)%obj) END DO @@ -556,13 +543,13 @@ MODULE moduleMesh1DRad SUBROUTINE connectVolVol(elemA, elemB) IMPLICIT NONE - CLASS(meshVol), INTENT(inout):: elemA - CLASS(meshVol), INTENT(inout):: elemB + CLASS(meshCell), INTENT(inout):: elemA + CLASS(meshCell), INTENT(inout):: elemB SELECT TYPE(elemA) - TYPE IS(meshVol1DRadSegm) + TYPE IS(meshCell1DRadSegm) SELECT TYPE(elemB) - TYPE IS(meshVol1DRadSegm) + TYPE IS(meshCell1DRadSegm) CALL connectSegmSegm(elemA, elemB) END SELECT @@ -574,8 +561,8 @@ MODULE moduleMesh1DRad SUBROUTINE connectSegmSegm(elemA, elemB) IMPLICIT NONE - CLASS(meshVol1DRadSegm), INTENT(inout), TARGET:: elemA - CLASS(meshVol1DRadSegm), INTENT(inout), TARGET:: elemB + CLASS(meshCell1DRadSegm), INTENT(inout), TARGET:: elemA + CLASS(meshCell1DRadSegm), INTENT(inout), TARGET:: elemB IF (.NOT. ASSOCIATED(elemA%e1) .AND. & elemA%n2%n == elemB%n1%n) THEN @@ -597,11 +584,11 @@ MODULE moduleMesh1DRad SUBROUTINE connectVolEdge(elemA, elemB) IMPLICIT NONE - CLASS(meshVol), INTENT(inout):: elemA + CLASS(meshCell), INTENT(inout):: elemA CLASS(meshEdge), INTENT(inout):: elemB SELECT TYPE(elemA) - TYPE IS (meshVol1DRadSegm) + TYPE IS (meshCell1DRadSegm) SELECT TYPE(elemB) CLASS IS(meshEdge1DRad) CALL connectSegmEdge(elemA, elemB) @@ -615,7 +602,7 @@ MODULE moduleMesh1DRad SUBROUTINE connectSegmEdge(elemA, elemB) IMPLICIT NONE - CLASS(meshVol1DRadSegm), INTENT(inout), TARGET:: elemA + CLASS(meshCell1DRadSegm), INTENT(inout), TARGET:: elemA CLASS(meshEdge1DRad), INTENT(inout), TARGET:: elemB IF (.NOT. ASSOCIATED(elemA%e1) .AND. & diff --git a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 index c57cecc..13c5901 100644 --- a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 +++ b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 @@ -37,26 +37,19 @@ MODULE moduleMesh2DCart END TYPE meshEdge2DCart - TYPE, PUBLIC, ABSTRACT, EXTENDS(meshVol):: meshVol2DCart + TYPE, PUBLIC, ABSTRACT, EXTENDS(meshCell):: meshCell2DCart CONTAINS PROCEDURE, PASS:: detJac => detJ2DCart PROCEDURE, PASS:: invJac => invJ2DCart - PROCEDURE(dPsi_interface), DEFERRED, NOPASS:: dPsi - PROCEDURE(partialDer_interface), DEFERRED, PASS:: partialDer + PROCEDURE(partialDer_interface), DEFERRED, PASS, PRIVATE:: partialDer - END TYPE meshVol2DCart + END TYPE meshCell2DCart ABSTRACT INTERFACE - PURE FUNCTION dPsi_interface(Xi) RESULT(dPsi) - REAL(8), INTENT(in):: Xi(1:3) - REAL(8), ALLOCATABLE:: dPsi(:,:) - - END FUNCTION dPsi_interface - PURE SUBROUTINE partialDer_interface(self, dPsi, dx, dy) - IMPORT meshVol2DCart - CLASS(meshVol2DCart), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:,1:) + IMPORT meshCell2DCart + CLASS(meshCell2DCart), INTENT(in):: self + REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy END SUBROUTINE partialDer_interface @@ -64,7 +57,7 @@ MODULE moduleMesh2DCart END INTERFACE !Quadrilateral volume element - TYPE, PUBLIC, EXTENDS(meshVol2DCart):: meshVol2DCartQuad + TYPE, PUBLIC, EXTENDS(meshCell2DCart):: meshCell2DCartQuad !Element coordinates REAL(8):: x(1:4) = 0.D0, y(1:4) = 0.D0 !Connectivity to nodes @@ -73,27 +66,27 @@ MODULE moduleMesh2DCart CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL(), e3 => NULL(), e4 => NULL() REAL(8):: arNodes(1:4) = 0.D0 CONTAINS - PROCEDURE, PASS:: init => initVolQuad2DCart - PROCEDURE, PASS:: randPos => randPosVolQuad + PROCEDURE, PASS:: init => initCellQuad2DCart + PROCEDURE, PASS:: randPos => randPosCellQuad PROCEDURE, PASS:: area => areaQuad - PROCEDURE, NOPASS:: fPsi => fPsiQuad - PROCEDURE, NOPASS:: dPsi => dPsiQuad - PROCEDURE, NOPASS:: dPsiXi1 => dPsiQuadXi1 - PROCEDURE, NOPASS:: dPsiXi2 => dPsiQuadXi2 - PROCEDURE, PASS:: partialDer => partialDerQuad + PROCEDURE, PASS:: fPsi => fPsiQuad + PROCEDURE, PASS:: dPsi => dPsiQuad + PROCEDURE, NOPASS, PRIVATE:: dPsiXi1 => dPsiQuadXi1 + PROCEDURE, NOPASS, PRIVATE:: dPsiXi2 => dPsiQuadXi2 + 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:: gatherEF => gatherEFQuad - PROCEDURE, PASS:: gatherMF => gatherMFQuad PROCEDURE, PASS:: getNodes => getNodesQuad PROCEDURE, PASS:: phy2log => phy2logQuad PROCEDURE, PASS:: nextElement => nextElementQuad - END TYPE meshVol2DCartQuad + END TYPE meshCell2DCartQuad !Triangular volume element - TYPE, PUBLIC, EXTENDS(meshVol2DCart):: meshVol2DCartTria + TYPE, PUBLIC, EXTENDS(meshCell2DCart):: meshCell2DCartTria !Element coordinates REAL(8):: x(1:3) = 0.D0, y(1:3) = 0.D0 !Connectivity to nodes @@ -103,24 +96,24 @@ MODULE moduleMesh2DCart REAL(8):: arNodes(1:3) = 0.D0 CONTAINS - PROCEDURE, PASS:: init => initVolTria2DCart - PROCEDURE, PASS:: randPos => randPosVolTria + PROCEDURE, PASS:: init => initCellTria2DCart + PROCEDURE, PASS:: randPos => randPosCellTria PROCEDURE, PASS:: area => areaTria - PROCEDURE, NOPASS:: fPsi => fPsiTria - PROCEDURE, NOPASS:: dPsi => dPsiTria + PROCEDURE, PASS:: fPsi => fPsiTria + PROCEDURE, PASS:: dPsi => dPsiTria PROCEDURE, NOPASS:: dPsiXi1 => dPsiTriaXi1 PROCEDURE, NOPASS:: dPsiXi2 => dPsiTriaXi2 PROCEDURE, PASS:: partialDer => partialDerTria PROCEDURE, PASS:: elemK => elemKTria PROCEDURE, PASS:: elemF => elemFTria + PROCEDURE, PASS:: gatherElectricField => gatherEFTria + PROCEDURE, PASS:: gatherMagneticField => gatherMFTria PROCEDURE, NOPASS:: inside => insideTria - PROCEDURE, PASS:: gatherEF => gatherEFTria - PROCEDURE, PASS:: gatherMF => gatherMFTria PROCEDURE, PASS:: getNodes => getNodesTria PROCEDURE, PASS:: phy2log => phy2logTria PROCEDURE, PASS:: nextElement => nextElementTria - END TYPE meshVol2DCartTria + END TYPE meshCell2DCartTria CONTAINS !NODE FUNCTIONS @@ -204,26 +197,26 @@ MODULE moduleMesh2DCart END SUBROUTINE initEdge2DCart !Random position in quadrilateral volume - FUNCTION randPosVolQuad(self) RESULT(r) + FUNCTION randPosCellQuad(self) RESULT(r) USE moduleRandom IMPLICIT NONE - CLASS(meshVol2DCartQuad), INTENT(in):: self + CLASS(meshCell2DCartQuad), INTENT(in):: self REAL(8):: r(1:3) REAL(8):: Xi(1:3) - REAL(8), ALLOCATABLE:: fPsi(:) + REAL(8):: fPsi(1:4) Xi(1) = random(-1.D0, 1.D0) Xi(2) = random(-1.D0, 1.D0) Xi(3) = 0.D0 - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) r(1) = DOT_PRODUCT(fPsi, self%x) r(2) = DOT_PRODUCT(fPsi, self%y) r(3) = 0.D0 - END FUNCTION randposVolQuad + END FUNCTION randposCellQuad !Get nodes from edge PURE FUNCTION getNodes2DCart(self) RESULT(n) @@ -232,7 +225,6 @@ MODULE moduleMesh2DCart CLASS(meshEdge2DCart), INTENT(in):: self INTEGER, ALLOCATABLE:: n(:) - ALLOCATE(n(1:2)) n = (/self%n1%n, self%n2%n /) END FUNCTION getNodes2DCart @@ -277,17 +269,18 @@ MODULE moduleMesh2DCart !VOLUME FUNCTIONS !QUAD FUNCTIONS !Inits quadrilateral element - SUBROUTINE initVolQuad2DCart(self, n, p, nodes) + SUBROUTINE initCellQuad2DCart(self, n, p, nodes) USE moduleRefParam IMPLICIT NONE - CLASS(meshVol2DCartQuad), INTENT(out):: self + CLASS(meshCell2DCartQuad), INTENT(out):: self INTEGER, INTENT(in):: n INTEGER, INTENT(in):: p(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) REAL(8), DIMENSION(1:3):: r1, r2, r3, r4 self%n = n + self%nNodes = SIZE(p) self%n1 => nodes(p(1))%obj self%n2 => nodes(p(2))%obj self%n3 => nodes(p(3))%obj @@ -312,13 +305,13 @@ MODULE moduleMesh2DCart ALLOCATE(self%listPart_in(1:nSpecies)) ALLOCATE(self%totalWeight(1:nSpecies)) - END SUBROUTINE initVolQuad2DCart + END SUBROUTINE initCellQuad2DCart !Computes element area PURE SUBROUTINE areaQuad(self) IMPLICIT NONE - CLASS(meshVol2DCartQuad), INTENT(inout):: self + CLASS(meshCell2DCartQuad), INTENT(inout):: self REAL(8):: Xi(1:3) REAL(8):: detJ REAL(8):: fPsi(1:4) @@ -328,18 +321,19 @@ MODULE moduleMesh2DCart !2D 1 point Gauss Quad Integral Xi = 0.D0 detJ = self%detJac(Xi)*4.D0 !4 - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) self%volume = detJ self%arNodes = fPsi*detJ END SUBROUTINE areaQuad !Computes element functions in point Xi - PURE SUBROUTINE fPsiQuad(Xi, fPsi) + PURE FUNCTION fPsiQuad(self, Xi) RESULT(fPsi) IMPLICIT NONE + CLASS(meshCell2DCartQuad), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(out):: fPsi(:) + REAL(8):: fPsi(1:self%nNodes) fPsi(1) = (1.D0-Xi(1)) * (1.D0-Xi(2)) fPsi(2) = (1.D0+Xi(1)) * (1.D0-Xi(2)) @@ -348,16 +342,17 @@ MODULE moduleMesh2DCart fPsi = fPsi*0.25D0 - END SUBROUTINE fPsiQuad + END FUNCTION fPsiQuad !Derivative element function at coordinates Xi - PURE FUNCTION dPsiQuad(Xi) RESULT(dPsi) + PURE FUNCTION dPsiQuad(self, Xi) RESULT(dPsi) IMPLICIT NONE + CLASS(meshCell2DCartQuad), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), ALLOCATABLE:: dPsi(:,:) + REAL(8):: dPsi(1:3,1:self%nNodes) - ALLOCATE(dPsi(1:2,1:4)) + dPsi = 0.D0 dPsi(1,:) = dPsiQuadXi1(Xi(2)) dPsi(2,:) = dPsiQuadXi2(Xi(1)) @@ -397,8 +392,8 @@ MODULE moduleMesh2DCart PURE SUBROUTINE partialDerQuad(self, dPsi, dx, dy) IMPLICIT NONE - CLASS(meshVol2DCartQuad), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:,1:) + CLASS(meshCell2DCartQuad), INTENT(in):: self + REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy dx(1) = DOT_PRODUCT(dPsi(1,:),self%x) @@ -412,14 +407,13 @@ MODULE moduleMesh2DCart PURE FUNCTION elemKQuad(self) RESULT(localK) IMPLICIT NONE - CLASS(meshVol2DCartQuad), INTENT(in):: self - REAL(8), ALLOCATABLE:: localK(:,:) + CLASS(meshCell2DCartQuad), INTENT(in):: self + REAL(8):: localK(1:self%nNodes,1:self%nNodes) REAL(8):: Xi(1:3) - REAL(8):: fPsi(1:4), dPsi(1:2,1:4) - REAL(8):: invJ(1:2,1:2), detJ + REAL(8):: fPsi(1:4), dPsi(1:3,1:4) + REAL(8):: invJ(1:3,1:3), detJ INTEGER:: l, m - ALLOCATE(localK(1:4, 1:4)) localK=0.D0 Xi=0.D0 !Start 2D Gauss Quad Integral @@ -429,7 +423,7 @@ MODULE moduleMesh2DCart DO m = 1, 3 Xi(1) = corQuad(m) dPsi(2,:) = self%dPsiXi2(Xi(1)) - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) detJ = self%detJac(Xi,dPsi) invJ = self%invJac(Xi,dPsi) localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*wQuad(l)*wQuad(m)/detJ @@ -443,15 +437,14 @@ MODULE moduleMesh2DCart PURE FUNCTION elemFQuad(self, source) RESULT(localF) IMPLICIT NONE - CLASS(meshVol2DCartQuad), INTENT(in):: self - REAL(8), INTENT(in):: source(1:) - REAL(8), ALLOCATABLE:: localF(:) + CLASS(meshCell2DCartQuad), INTENT(in):: self + REAL(8), INTENT(in):: source(1:self%nNodes) + REAL(8):: localF(1:self%nNodes) REAL(8):: Xi(1:3) REAL(8):: fPsi(1:4) REAL(8):: detJ, f INTEGER:: l, m - ALLOCATE(localF(1:4)) localF = 0.D0 Xi = 0.D0 DO l=1, 3 @@ -459,7 +452,7 @@ MODULE moduleMesh2DCart DO m = 1, 3 Xi(2) = corQuad(m) detJ = self%detJac(Xi) - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) f = DOT_PRODUCT(fPsi,source) localF = localF + f*fPsi*wQuad(l)*wQuad(m)*detJ @@ -468,6 +461,48 @@ MODULE moduleMesh2DCart END FUNCTION elemFQuad + PURE FUNCTION gatherEFQuad(self, Xi) RESULT(array) + IMPLICIT NONE + CLASS(meshCell2DCartQuad), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) + REAL(8):: phi(1:4) + + phi = (/ self%n1%emData%phi, & + self%n2%emData%phi, & + self%n3%emData%phi, & + self%n4%emData%phi /) + + array = -self%gatherDF(Xi, phi) + + END FUNCTION gatherEFQuad + + PURE FUNCTION gatherMFQuad(self, Xi) RESULT(array) + IMPLICIT NONE + CLASS(meshCell2DCartQuad), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) + REAL(8):: B(1:4,1:3) + + B(:,1) = (/ self%n1%emData%B(1), & + self%n2%emData%B(1), & + self%n3%emData%B(1), & + self%n4%emData%B(1) /) + + B(:,2) = (/ self%n1%emData%B(2), & + self%n2%emData%B(2), & + self%n3%emData%B(2), & + self%n4%emData%B(2) /) + + B(:,3) = (/ self%n1%emData%B(3), & + self%n2%emData%B(3), & + self%n3%emData%B(3), & + self%n4%emData%B(3) /) + + array = self%gatherF(Xi, 3, B) + + END FUNCTION gatherMFQuad + !Checks if a particle is inside a quad element PURE FUNCTION insideQuad(Xi) RESULT(ins) IMPLICIT NONE @@ -480,97 +515,42 @@ MODULE moduleMesh2DCart END FUNCTION insideQuad - !Gathers the electric field at position Xi - PURE FUNCTION gatherEFQuad(self,Xi) RESULT(EF) - IMPLICIT NONE - - CLASS(meshVol2DCartQuad), INTENT(in):: self - REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: dPsi(1:2,1:4) - REAL(8):: dPsiR(1:2,1:4)!Derivative of shpae functions in global coordinates - REAL(8):: invJ(1:2,1:2), detJ - REAL(8):: phi(1:4) - REAL(8):: EF(1:3) - - phi = (/self%n1%emData%phi, & - self%n2%emData%phi, & - self%n3%emData%phi, & - self%n4%emData%phi /) - - dPsi = self%dPsi(Xi) - detJ = self%detJac(Xi,dPsi) - invJ = self%invJac(Xi,dPsi) - dPsiR = MATMUL(invJ, dPsi)/detJ - EF(1) = -DOT_PRODUCT(dPsiR(1,:), phi) - EF(2) = -DOT_PRODUCT(dPsiR(2,:), phi) - EF(3) = 0.D0 - - END FUNCTION gatherEFQuad - - PURE FUNCTION gatherMFQuad(self,Xi) RESULT(MF) - IMPLICIT NONE - - CLASS(meshVol2DCartQuad), INTENT(in):: self - REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: fPsi(1:4) - REAL(8):: MF_Nodes(1:4,1:3) - REAL(8):: MF(1:3) - - MF_Nodes(1:4,1) = (/self%n1%emData%B(1), & - self%n2%emData%B(1), & - self%n3%emData%B(1), & - self%n4%emData%B(1) /) - MF_Nodes(1:4,2) = (/self%n1%emData%B(2), & - self%n2%emData%B(2), & - self%n3%emData%B(2), & - self%n4%emData%B(2) /) - MF_Nodes(1:4,3) = (/self%n1%emData%B(3), & - self%n2%emData%B(3), & - self%n3%emData%B(3), & - self%n4%emData%B(3) /) - - CALL self%fPsi(Xi, fPsi) - MF = MATMUL(fPsi(:), MF_Nodes) - - END FUNCTION gatherMFQuad - !Gets nodes from quadrilateral element PURE FUNCTION getNodesQuad(self) RESULT(n) IMPLICIT NONE - CLASS(meshVol2DCartQuad), INTENT(in):: self - INTEGER, ALLOCATABLE:: n(:) + CLASS(meshCell2DCartQuad), INTENT(in):: self + INTEGER:: n(1:self%nNodes) - ALLOCATE(n(1:4)) 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(XiN) + PURE FUNCTION phy2logQuad(self,r) RESULT(Xi) IMPLICIT NONE - CLASS(meshVol2DCartQuad), INTENT(in):: self + CLASS(meshCell2DCartQuad), INTENT(in):: self REAL(8), INTENT(in):: r(1:3) - REAL(8):: XiN(1:3) + REAL(8):: Xi(1:3) REAL(8):: XiO(1:3), detJ, invJ(1:2,1:2), f(1:2) - REAL(8):: dPsi(1:2,1:4), fPsi(1:4) + REAL(8):: dPsi(1:3,1:4), fPsi(1:4) REAL(8):: conv !Iterative newton method to transform coordinates conv=1.D0 XiO=0.D0 - DO WHILE(conv>1.D-4) + DO WHILE(conv>1.D-3) dPsi = self%dPsi(XiO) invJ = self%invJac(XiO, dPsi) - CALL self%fPsi(XiO, fPsi) + fPsi = self%fPsi(XiO) f(1) = DOT_PRODUCT(fPsi,self%x)-r(1) f(2) = DOT_PRODUCT(fPsi,self%y)-r(2) detJ = self%detJac(XiO,dPsi) - XiN(1:2)=XiO(1:2) - MATMUL(invJ, f)/detJ - conv=MAXVAL(DABS(XiN-XiO),1) - XiO=XiN + Xi(1:2)=XiO(1:2) - MATMUL(invJ, f)/detJ + conv=MAXVAL(DABS(Xi-XiO),1) + XiO=Xi END DO @@ -580,7 +560,7 @@ MODULE moduleMesh2DCart SUBROUTINE nextElementQuad(self, Xi, nextElement) IMPLICIT NONE - CLASS(meshVol2DCartQuad), INTENT(in):: self + CLASS(meshCell2DCartQuad), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) CLASS(meshElement), POINTER, INTENT(out):: nextElement REAL(8):: XiArray(1:4) @@ -605,11 +585,11 @@ MODULE moduleMesh2DCart !TRIA ELEMENT !Init tria element - SUBROUTINE initVolTria2DCart(self, n, p, nodes) + SUBROUTINE initCellTria2DCart(self, n, p, nodes) USE moduleRefParam IMPLICIT NONE - CLASS(meshVol2DCartTria), INTENT(out):: self + CLASS(meshCell2DCartTria), INTENT(out):: self INTEGER, INTENT(in):: n INTEGER, INTENT(in):: p(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) @@ -618,6 +598,9 @@ MODULE moduleMesh2DCart !Assign node index self%n = n + !Assign number of nodes of cell + self%nNodes = SIZE(p) + !Assign nodes to element self%n1 => nodes(p(1))%obj self%n2 => nodes(p(2))%obj @@ -639,14 +622,14 @@ MODULE moduleMesh2DCart ALLOCATE(self%listPart_in(1:nSpecies)) ALLOCATE(self%totalWeight(1:nSpecies)) - END SUBROUTINE initVolTria2DCart + END SUBROUTINE initCellTria2DCart !Random position in quadrilateral volume - FUNCTION randPosVolTria(self) RESULT(r) + FUNCTION randPosCellTria(self) RESULT(r) USE moduleRandom IMPLICIT NONE - CLASS(meshVol2DCartTria), INTENT(in):: self + CLASS(meshCell2DCartTria), INTENT(in):: self REAL(8):: r(1:3) REAL(8):: Xi(1:3) REAL(8):: fPsi(1:3) @@ -655,19 +638,19 @@ MODULE moduleMesh2DCart Xi(2) = random( 0.D0, 1.D0 - Xi(1)) Xi(3) = 0.D0 - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) r(1) = DOT_PRODUCT(fPsi, self%x) r(2) = DOT_PRODUCT(fPsi, self%y) r(3) = 0.D0 - END FUNCTION randposVolTria + END FUNCTION randposCellTria !Calculates area for triangular element PURE SUBROUTINE areaTria(self) IMPLICIT NONE - CLASS(meshVol2DCartTria), INTENT(inout):: self + CLASS(meshCell2DCartTria), INTENT(inout):: self REAL(8):: Xi(1:3) REAL(8):: detJ REAL(8):: fPsi(1:3) @@ -677,33 +660,35 @@ MODULE moduleMesh2DCart !2D 1 point Gauss Quad Integral Xi = (/1.D0/3.D0, 1.D0/3.D0, 0.D0 /) detJ = self%detJac(Xi)/2.D0 - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) self%volume = detJ self%arNodes = fPsi*detJ END SUBROUTINE areaTria !Shape functions for triangular element - PURE SUBROUTINE fPsiTria(Xi, fPsi) + PURE FUNCTION fPsiTria(self, Xi) RESULT(fPsi) IMPLICIT NONE + CLASS(meshCell2DCartTria), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(out):: fPsi(:) + REAL(8):: fPsi(1:self%nNodes) fPsi(1) = 1.D0 - Xi(1) - Xi(2) fPsi(2) = Xi(1) fPsi(3) = Xi(2) - END SUBROUTINE fPsiTria + END FUNCTION fPsiTria !Derivative element function at coordinates Xi - PURE FUNCTION dPsiTria(Xi) RESULT(dPsi) + PURE FUNCTION dPsiTria(self, Xi) RESULT(dPsi) IMPLICIT NONE + CLASS(meshCell2DCartTria), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), ALLOCATABLE:: dPsi(:,:) + REAL(8):: dPsi(1:3,1:self%nNodes) - ALLOCATE(dPsi(1:2,1:3)) + dPsi = 0.D0 dPsi(1,:) = dPsiTriaXi1(Xi(2)) dPsi(2,:) = dPsiTriaXi2(Xi(1)) @@ -739,8 +724,8 @@ MODULE moduleMesh2DCart PURE SUBROUTINE partialDerTria(self, dPsi, dx, dy) IMPLICIT NONE - CLASS(meshVol2DCartTria), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:,1:) + CLASS(meshCell2DCartTria), INTENT(in):: self + REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy dx(1) = DOT_PRODUCT(dPsi(1,:),self%x) @@ -754,14 +739,13 @@ MODULE moduleMesh2DCart PURE FUNCTION elemKTria(self) RESULT(localK) IMPLICIT NONE - CLASS(meshVol2DCartTria), INTENT(in):: self - REAL(8), ALLOCATABLE:: localK(:,:) + CLASS(meshCell2DCartTria), INTENT(in):: self + REAL(8):: localK(1:self%nNodes,1:self%nNodes) REAL(8):: Xi(1:3) - REAL(8):: fPsi(1:3), dPsi(1:2,1:3) - REAL(8):: invJ(1:2,1:2), detJ + REAL(8):: fPsi(1:3), dPsi(1:3,1:3) + REAL(8):: invJ(1:3,1:3), detJ INTEGER:: l - ALLOCATE(localK(1:4, 1:4)) localK=0.D0 Xi=0.D0 !Start 2D Gauss Quad Integral @@ -771,7 +755,7 @@ MODULE moduleMesh2DCart dPsi = self%dPsi(Xi) detJ = self%detJac(Xi,dPsi) invJ = self%invJac(Xi,dPsi) - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*wTria(l)/detJ END DO @@ -782,15 +766,14 @@ MODULE moduleMesh2DCart PURE FUNCTION elemFTria(self, source) RESULT(localF) IMPLICIT NONE - CLASS(meshVol2DCartTria), INTENT(in):: self - REAL(8), INTENT(in):: source(1:) - REAL(8), ALLOCATABLE:: localF(:) + CLASS(meshCell2DCartTria), INTENT(in):: self + REAL(8), INTENT(in):: source(1:self%nNodes) + REAL(8):: localF(1:self%nNodes) REAL(8):: fPsi(1:3) REAL(8):: Xi(1:3) REAL(8):: detJ, f INTEGER:: l - ALLOCATE(localF(1:3)) localF = 0.D0 Xi = 0.D0 !Start 2D Gauss Quad Integral @@ -798,7 +781,7 @@ MODULE moduleMesh2DCart Xi(1) = Xi1Tria(l) Xi(2) = Xi2Tria(l) detJ = self%detJac(Xi) - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) f = DOT_PRODUCT(fPsi,source) localF = localF + f*fPsi*wTria(l)*detJ @@ -806,6 +789,44 @@ MODULE moduleMesh2DCart END FUNCTION elemFTria + PURE FUNCTION gatherEFTria(self, Xi) RESULT(array) + IMPLICIT NONE + CLASS(meshCell2DCartTria), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) + REAL(8):: phi(1:3) + + phi = (/ self%n1%emData%phi, & + self%n2%emData%phi, & + self%n3%emData%phi /) + + array = -self%gatherDF(Xi, phi) + + END FUNCTION gatherEFTria + + PURE FUNCTION gatherMFTria(self, Xi) RESULT(array) + IMPLICIT NONE + CLASS(meshCell2DCartTria), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) + REAL(8):: B(1:3,1:3) + + B(:,1) = (/ self%n1%emData%B(1), & + self%n2%emData%B(1), & + self%n3%emData%B(1) /) + + B(:,2) = (/ self%n1%emData%B(2), & + self%n2%emData%B(2), & + self%n3%emData%B(2) /) + + B(:,3) = (/ self%n1%emData%B(3), & + self%n2%emData%B(3), & + self%n3%emData%B(3) /) + + array = self%gatherF(Xi, 3, B) + + END FUNCTION gatherMFTria + PURE FUNCTION insideTria(Xi) RESULT(ins) IMPLICIT NONE @@ -818,64 +839,13 @@ MODULE moduleMesh2DCart END FUNCTION insideTria - !Gathers the electric field at position Xi - PURE FUNCTION gatherEFTria(self,Xi) RESULT(EF) - IMPLICIT NONE - - CLASS(meshVol2DCartTria), INTENT(in):: self - REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: dPsi(1:2,1:3) - REAL(8):: dPsiR(1:2,1:3)!Derivative of shpae functions in global coordinates - REAL(8):: invJ(1:2,1:2), detJ - REAL(8):: phi(1:3) - REAL(8):: EF(1:3) - - phi = (/self%n1%emData%phi, & - self%n2%emData%phi, & - self%n3%emData%phi /) - - dPsi = self%dPsi(Xi) - detJ = self%detJac(Xi,dPsi) - invJ = self%invJac(Xi,dPsi) - dPsiR = MATMUL(invJ, dPsi)/detJ - EF(1) = -DOT_PRODUCT(dPsiR(1,:), phi) - EF(2) = -DOT_PRODUCT(dPsiR(2,:), phi) - EF(3) = 0.D0 - - END FUNCTION gatherEFTria - - PURE FUNCTION gatherMFTria(self,Xi) RESULT(MF) - IMPLICIT NONE - - CLASS(meshVol2DCartTria), INTENT(in):: self - REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: fPsi(1:3) - REAL(8):: MF_Nodes(1:3,1:3) - REAL(8):: MF(1:3) - - MF_Nodes(1:3,1) = (/self%n1%emData%B(1), & - self%n2%emData%B(1), & - self%n3%emData%B(1) /) - MF_Nodes(1:3,2) = (/self%n1%emData%B(2), & - self%n2%emData%B(2), & - self%n3%emData%B(2) /) - MF_Nodes(1:3,3) = (/self%n1%emData%B(3), & - self%n2%emData%B(3), & - self%n3%emData%B(3) /) - - CALL self%fPsi(Xi, fPsi) - MF = MATMUL(fPsi, MF_Nodes) - - END FUNCTION gatherMFTria - !Gets node indexes from triangular element PURE FUNCTION getNodesTria(self) RESULT(n) IMPLICIT NONE - CLASS(meshVol2DCartTria), INTENT(in):: self - INTEGER, ALLOCATABLE:: n(:) + CLASS(meshCell2DCartTria), INTENT(in):: self + INTEGER:: n(1:self%nNodes) - ALLOCATE(n(1:3)) n = (/self%n1%n, self%n2%n, self%n3%n /) END FUNCTION getNodesTria @@ -884,27 +854,27 @@ MODULE moduleMesh2DCart PURE FUNCTION phy2logTria(self,r) RESULT(Xi) IMPLICIT NONE - CLASS(meshVol2DCartTria), INTENT(in):: self + CLASS(meshCell2DCartTria), INTENT(in):: self REAL(8), INTENT(in):: r(1:3) REAL(8):: Xi(1:3) - REAL(8):: invJ(1:2,1:2), detJ - REAL(8):: deltaR(1:2) - REAL(8):: dPsi(1:2,1:3) + REAL(8):: invJ(1:3,1:3), detJ + REAL(8):: deltaR(1:3) + REAL(8):: dPsi(1:3,1:3) !Direct method to convert coordinates - Xi = 0.D0 !Irrelevant, required for input - deltaR = (/ r(1) - self%x(1), r(2) - self%y(1) /) - dPsi = self%dPsi(Xi) - invJ = self%invJac(Xi, dPsi) - detJ = self%detJac(Xi, dPsi) - Xi(1:2) = MATMUL(invJ,deltaR)/detJ + Xi = 0.D0 + deltaR = (/ r(1) - self%x(1), r(2) - self%y(1), 0.D0 /) + dPsi = self%dPsi(Xi) + invJ = self%invJac(Xi, dPsi) + detJ = self%detJac(Xi, dPsi) + Xi = MATMUL(invJ,deltaR)/detJ END FUNCTION phy2logTria SUBROUTINE nextElementTria(self, Xi, nextElement) IMPLICIT NONE - CLASS(meshVol2DCartTria), INTENT(in):: self + CLASS(meshCell2DCartTria), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) CLASS(meshElement), POINTER, INTENT(out):: nextElement REAL(8):: XiArray(1:3) @@ -929,10 +899,10 @@ MODULE moduleMesh2DCart PURE FUNCTION detJ2DCart(self, Xi, dPsi_in) RESULT(dJ) IMPLICIT NONE - CLASS(meshVol2DCart), INTENT(in):: self + CLASS(meshCell2DCart), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:,1:) - REAL(8), ALLOCATABLE:: dPsi(:,:) + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + REAL(8):: dPsi(1:3,1:self%nNodes) REAL(8):: dJ REAL(8):: dx(1:2), dy(1:2) @@ -953,12 +923,12 @@ MODULE moduleMesh2DCart PURE FUNCTION invJ2DCart(self,Xi,dPsi_in) RESULT(invJ) IMPLICIT NONE - CLASS(meshVol2DCart), INTENT(in):: self + CLASS(meshCell2DCart), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:,1:) - REAL(8), ALLOCATABLE:: dPsi(:,:) + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + REAL(8):: dPsi(1:3,1:self%nNodes) REAL(8):: dx(1:2), dy(1:2) - REAL(8):: invJ(1:2,1:2) + REAL(8):: invJ(1:3,1:3) IF(PRESENT(dPsi_in)) THEN dPsi=dPsi_in @@ -968,9 +938,12 @@ MODULE moduleMesh2DCart END IF + invJ = 0.D0 + CALL self%partialDer(dPsi, dx, dy) - invJ(1,:) = (/ dy(2), -dx(2) /) - invJ(2,:) = (/ -dy(1), dx(1) /) + + invJ(1,1:2) = (/ dy(2), -dx(2) /) + invJ(2,1:2) = (/ -dy(1), dx(1) /) END FUNCTION invJ2DCart @@ -980,11 +953,11 @@ MODULE moduleMesh2DCart CLASS(meshGeneric), INTENT(inout):: self INTEGER:: e, et - DO e = 1, self%numVols - !Connect Vol-Vol - DO et = 1, self%numVols + DO e = 1, self%numCells + !Connect Cell-Cell + DO et = 1, self%numCells IF (e /= et) THEN - CALL connectVolVol(self%vols(e)%obj, self%vols(et)%obj) + CALL connectCellCell(self%cells(e)%obj, self%cells(et)%obj) END IF @@ -992,9 +965,9 @@ MODULE moduleMesh2DCart SELECT TYPE(self) TYPE IS(meshParticles) - !Connect Vol-Edge + !Connect Cell-Edge DO et = 1, self%numEdges - CALL connectVolEdge(self%vols(e)%obj, self%edges(et)%obj) + CALL connectCellEdge(self%cells(e)%obj, self%edges(et)%obj) END DO @@ -1005,34 +978,34 @@ MODULE moduleMesh2DCart END SUBROUTINE connectMesh2DCart !Selects type of elements to build connection - SUBROUTINE connectVolVol(elemA, elemB) + SUBROUTINE connectCellCell(elemA, elemB) IMPLICIT NONE - CLASS(meshVol), INTENT(inout):: elemA - CLASS(meshVol), INTENT(inout):: elemB + CLASS(meshCell), INTENT(inout):: elemA + CLASS(meshCell), INTENT(inout):: elemB SELECT TYPE(elemA) - TYPE IS(meshVol2DCartQuad) + TYPE IS(meshCell2DCartQuad) !Element A is a quadrilateral SELECT TYPE(elemB) - TYPE IS(meshVol2DCartQuad) + TYPE IS(meshCell2DCartQuad) !Element B is a quadrilateral CALL connectQuadQuad(elemA, elemB) - TYPE IS(meshVol2DCartTria) + TYPE IS(meshCell2DCartTria) !Element B is a triangle CALL connectQuadTria(elemA, elemB) END SELECT - TYPE IS(meshVol2DCartTria) + TYPE IS(meshCell2DCartTria) !Element A is a Triangle SELECT TYPE(elemB) - TYPE IS(meshVol2DCartQuad) + TYPE IS(meshCell2DCartQuad) !Element B is a quadrilateral CALL connectQuadTria(elemB, elemA) - TYPE IS(meshVol2DCartTria) + TYPE IS(meshCell2DCartTria) !Element B is a triangle CALL connectTriaTria(elemA, elemB) @@ -1040,22 +1013,22 @@ MODULE moduleMesh2DCart END SELECT - END SUBROUTINE connectVolVol + END SUBROUTINE connectCellCell - SUBROUTINE connectVolEdge(elemA, elemB) + SUBROUTINE connectCellEdge(elemA, elemB) IMPLICIT NONE - CLASS(meshVol), INTENT(inout):: elemA + CLASS(meshCell), INTENT(inout):: elemA CLASS(meshEdge), INTENT(inout):: elemB SELECT TYPE(elemB) CLASS IS(meshEdge2DCart) SELECT TYPE(elemA) - TYPE IS(meshVol2DCartQuad) + TYPE IS(meshCell2DCartQuad) !Element A is a quadrilateral CALL connectQuadEdge(elemA, elemB) - TYPE IS(meshVol2DCartTria) + TYPE IS(meshCell2DCartTria) !Element A is a triangle CALL connectTriaEdge(elemA, elemB) @@ -1063,13 +1036,13 @@ MODULE moduleMesh2DCart END SELECT - END SUBROUTINE connectVolEdge + END SUBROUTINE connectCellEdge SUBROUTINE connectQuadQuad(elemA, elemB) IMPLICIT NONE - CLASS(meshVol2DCartQuad), INTENT(inout), TARGET:: elemA - CLASS(meshVol2DCartQuad), INTENT(inout), TARGET:: elemB + CLASS(meshCell2DCartQuad), INTENT(inout), TARGET:: elemA + CLASS(meshCell2DCartQuad), INTENT(inout), TARGET:: elemB !Check direction 1 IF (.NOT. ASSOCIATED(elemA%e1) .AND. & @@ -1112,8 +1085,8 @@ MODULE moduleMesh2DCart SUBROUTINE connectQuadTria(elemA, elemB) IMPLICIT NONE - CLASS(meshVol2DCartQuad), INTENT(inout), TARGET:: elemA - CLASS(meshVol2DCartTria), INTENT(inout), TARGET:: elemB + CLASS(meshCell2DCartQuad), INTENT(inout), TARGET:: elemA + CLASS(meshCell2DCartTria), INTENT(inout), TARGET:: elemB !Check direction 1 IF (.NOT. ASSOCIATED(elemA%e1)) THEN @@ -1204,8 +1177,8 @@ MODULE moduleMesh2DCart SUBROUTINE connectTriaTria(elemA, elemB) IMPLICIT NONE - CLASS(meshVol2DCartTria), INTENT(inout), TARGET:: elemA - CLASS(meshVol2DCartTria), INTENT(inout), TARGET:: elemB + CLASS(meshCell2DCartTria), INTENT(inout), TARGET:: elemA + CLASS(meshCell2DCartTria), INTENT(inout), TARGET:: elemB !Check direction 1 IF (.NOT. ASSOCIATED(elemA%e1)) THEN @@ -1277,7 +1250,7 @@ MODULE moduleMesh2DCart SUBROUTINE connectQuadEdge(elemA, elemB) IMPLICIT NONE - CLASS(meshVol2DCartQuad), INTENT(inout), TARGET:: elemA + CLASS(meshCell2DCartQuad), INTENT(inout), TARGET:: elemA CLASS(meshEdge2DCart), INTENT(inout), TARGET:: elemB !Check direction 1 @@ -1361,7 +1334,7 @@ MODULE moduleMesh2DCart SUBROUTINE connectTriaEdge(elemA, elemB) IMPLICIT NONE - CLASS(meshVol2DCartTria), INTENT(inout), TARGET:: elemA + CLASS(meshCell2DCartTria), INTENT(inout), TARGET:: elemA CLASS(meshEdge2DCart), INTENT(inout), TARGET:: elemB !Check direction 1 diff --git a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 index 2869cb3..9032d61 100644 --- a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 +++ b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 @@ -1,4 +1,4 @@ -!moduleMesh2DCyl: 2D axial symmetric extension of generic mesh from GMSH format. +!moduleMesh2DCyl: 2D aXial symmetric extension of generic mesh from GMSH format. ! x == z ! y == r ! z == theta (unused) @@ -11,8 +11,8 @@ MODULE moduleMesh2DCyl REAL(8), PARAMETER:: corQuad(1:3) = (/ -DSQRT(3.D0/5.D0), 0.D0, DSQRT(3.D0/5.D0) /) REAL(8), PARAMETER:: wQuad(1:3) = (/ 5.D0/9.D0, 8.D0/9.D0, 5.D0/9.D0 /) - REAL(8), PARAMETER:: xi1Tria(1:4) = (/ 1.D0/3.D0, 1.D0/5.D0, 3.D0/5.D0, 1.D0/5.D0 /) - REAL(8), PARAMETER:: xi2Tria(1:4) = (/ 1.D0/3.D0, 1.D0/5.D0, 1.D0/5.D0, 3.D0/5.D0 /) + REAL(8), PARAMETER:: Xi1Tria(1:4) = (/ 1.D0/3.D0, 1.D0/5.D0, 3.D0/5.D0, 1.D0/5.D0 /) + REAL(8), PARAMETER:: Xi2Tria(1:4) = (/ 1.D0/3.D0, 1.D0/5.D0, 1.D0/5.D0, 3.D0/5.D0 /) REAL(8), PARAMETER:: wTria(1:4) = (/ -27.D0/96.D0, 25.D0/96.D0, 25.D0/96.D0, 25.D0/96.D0 /) TYPE, PUBLIC, EXTENDS(meshNode):: meshNode2DCyl @@ -37,26 +37,19 @@ MODULE moduleMesh2DCyl END TYPE meshEdge2DCyl - TYPE, PUBLIC, ABSTRACT, EXTENDS(meshVol):: meshVol2DCyl + TYPE, PUBLIC, ABSTRACT, EXTENDS(meshCell):: meshCell2DCyl CONTAINS PROCEDURE, PASS:: detJac => detJ2DCyl PROCEDURE, PASS:: invJac => invJ2DCyl - PROCEDURE(dPsi_interface), DEFERRED, NOPASS:: dPsi - PROCEDURE(partialDer_interface), DEFERRED, PASS:: partialDer + PROCEDURE(partialDer_interface), DEFERRED, PASS, PRIVATE:: partialDer - END TYPE meshVol2DCyl + END TYPE meshCell2DCyl ABSTRACT INTERFACE - PURE FUNCTION dPsi_interface(xi) RESULT(dPsi) - REAL(8), INTENT(in):: xi(1:3) - REAL(8), ALLOCATABLE:: dPsi(:,:) - - END FUNCTION dPsi_interface - PURE SUBROUTINE partialDer_interface(self, dPsi, dz, dr) - IMPORT meshVol2DCyl - CLASS(meshVol2DCyl), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:,1:) + IMPORT meshCell2DCyl + CLASS(meshCell2DCyl), INTENT(in):: self + REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) REAL(8), INTENT(out), DIMENSION(1:2):: dz, dr END SUBROUTINE partialDer_interface @@ -64,7 +57,7 @@ MODULE moduleMesh2DCyl END INTERFACE !Quadrilateral volume element - TYPE, PUBLIC, EXTENDS(meshVol2DCyl):: meshVol2DCylQuad + TYPE, PUBLIC, EXTENDS(meshCell2DCyl):: meshCell2DCylQuad !Element coordinates REAL(8):: r(1:4) = 0.D0, z(1:4) = 0.D0 !Connectivity to nodes @@ -74,27 +67,27 @@ MODULE moduleMesh2DCyl REAL(8):: arNodes(1:4) = 0.D0 CONTAINS - PROCEDURE, PASS:: init => initVolQuad2DCyl + PROCEDURE, PASS:: init => initCellQuad2DCyl PROCEDURE, PASS:: randPos => randPosVolQuad PROCEDURE, PASS:: area => areaQuad - PROCEDURE, NOPASS:: fPsi => fPsiQuad - PROCEDURE, NOPASS:: dPsi => dPsiQuad - PROCEDURE, NOPASS:: dPsiXi1 => dPsiQuadXi1 - PROCEDURE, NOPASS:: dPsiXi2 => dPsiQuadXi2 - PROCEDURE, PASS:: partialDer => partialDerQuad + PROCEDURE, PASS:: fPsi => fPsiQuad + PROCEDURE, PASS:: dPsi => dPsiQuad + PROCEDURE, NOPASS, PRIVATE:: dPsiXi1 => dPsiQuadXi1 + PROCEDURE, NOPASS, PRIVATE:: dPsiXi2 => dPsiQuadXi2 + 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:: gatherEF => gatherEFQuad - PROCEDURE, PASS:: gatherMF => gatherMFQuad PROCEDURE, PASS:: getNodes => getNodesQuad PROCEDURE, PASS:: phy2log => phy2logQuad PROCEDURE, PASS:: nextElement => nextElementQuad - END TYPE meshVol2DCylQuad + END TYPE meshCell2DCylQuad !Triangular volume element - TYPE, PUBLIC, EXTENDS(meshVol2DCyl):: meshVol2DCylTria + TYPE, PUBLIC, EXTENDS(meshCell2DCyl):: meshCell2DCylTria !Element coordinates REAL(8):: r(1:3) = 0.D0, z(1:3) = 0.D0 !Connectivity to nodes @@ -104,24 +97,24 @@ MODULE moduleMesh2DCyl REAL(8):: arNodes(1:3) = 0.D0 CONTAINS - PROCEDURE, PASS:: init => initVolTria2DCyl + PROCEDURE, PASS:: init => initCellTria2DCyl PROCEDURE, PASS:: randPos => randPosVolTria PROCEDURE, PASS:: area => areaTria - PROCEDURE, NOPASS:: fPsi => fPsiTria - PROCEDURE, NOPASS:: dPsi => dPsiTria + PROCEDURE, PASS:: fPsi => fPsiTria + PROCEDURE, PASS:: dPsi => dPsiTria PROCEDURE, NOPASS:: dPsiXi1 => dPsiTriaXi1 PROCEDURE, NOPASS:: dPsiXi2 => dPsiTriaXi2 - PROCEDURE, PASS:: partialDer => partialDerTria + 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:: gatherEF => gatherEFTria - PROCEDURE, PASS:: gatherMF => gatherMFTria PROCEDURE, PASS:: getNodes => getNodesTria PROCEDURE, PASS:: phy2log => phy2logTria PROCEDURE, PASS:: nextElement => nextElementTria - END TYPE meshVol2DCylTria + END TYPE meshCell2DCylTria CONTAINS !NODE FUNCTIONS @@ -265,17 +258,18 @@ MODULE moduleMesh2DCyl !VOLUME FUNCTIONS !QUAD FUNCTIONS !Inits quadrilateral element - SUBROUTINE initVolQuad2DCyl(self, n, p, nodes) + SUBROUTINE initCellQuad2DCyl(self, n, p, nodes) USE moduleRefParam IMPLICIT NONE - CLASS(meshVol2DCylQuad), INTENT(out):: self + CLASS(meshCell2DCylQuad), INTENT(out):: self INTEGER, INTENT(in):: n INTEGER, INTENT(in):: p(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) REAL(8), DIMENSION(1:3):: r1, r2, r3, r4 self%n = n + self%nNodes = SIZE(p) self%n1 => nodes(p(1))%obj self%n2 => nodes(p(2))%obj self%n3 => nodes(p(3))%obj @@ -300,104 +294,106 @@ MODULE moduleMesh2DCyl ALLOCATE(self%listPart_in(1:nSpecies)) ALLOCATE(self%totalWeight(1:nSpecies)) - END SUBROUTINE initVolQuad2DCyl + END SUBROUTINE initCellQuad2DCyl !Computes element area PURE SUBROUTINE areaQuad(self) USE moduleConstParam, ONLY: PI8 IMPLICIT NONE - CLASS(meshVol2DCylQuad), INTENT(inout):: self - REAL(8):: r, xi(1:3) + CLASS(meshCell2DCylQuad), INTENT(inout):: self + REAL(8):: r, Xi(1:3) REAL(8):: detJ REAL(8):: fPsi(1:4), fPsi_node(1:4) self%volume = 0.D0 self%arNodes = 0.D0 !2D 1 point Gauss Quad Integral - xi = 0.D0 - detJ = self%detJac(xi)*PI8 !4*2*pi - CALL self%fPsi(xi, fPsi) + Xi = 0.D0 + detJ = self%detJac(Xi)*PI8 !4*2*pi + fPsi = self%fPsi(Xi) !Computes total volume of the cell r = DOT_PRODUCT(fPsi,self%r) self%volume = r*detJ !Computes volume per node - xi = (/-5.D-1, -5.D-1, 0.D0/) - CALL self%fPsi(xi, fPsi_node) + Xi = (/-5.D-1, -5.D-1, 0.D0/) + fPsi_node = self%fPsi(Xi) r = DOT_PRODUCT(fPsi_node,self%r) self%arNodes(1) = fPsi(1)*r*detJ - xi = (/ 5.D-1, -5.D-1, 0.D0/) - CALL self%fPsi(xi, fPsi_node) + Xi = (/ 5.D-1, -5.D-1, 0.D0/) + fPsi_node = self%fPsi(Xi) r = DOT_PRODUCT(fPsi_node,self%r) self%arNodes(2) = fPsi(2)*r*detJ - xi = (/ 5.D-1, 5.D-1, 0.D0/) - CALL self%fPsi(xi, fPsi_node) + Xi = (/ 5.D-1, 5.D-1, 0.D0/) + fPsi_node = self%fPsi(Xi) r = DOT_PRODUCT(fPsi_node,self%r) self%arNodes(3) = fPsi(3)*r*detJ - xi = (/-5.D-1, 5.D-1, 0.D0/) - CALL self%fPsi(xi, fPsi_node) + Xi = (/-5.D-1, 5.D-1, 0.D0/) + fPsi_node = self%fPsi(Xi) r = DOT_PRODUCT(fPsi_node,self%r) self%arNodes(4) = fPsi(4)*r*detJ END SUBROUTINE areaQuad - !Computes element functions in point xi - PURE SUBROUTINE fPsiQuad(xi, fPsi) + !Computes element functions in point Xi + PURE FUNCTION fPsiQuad(self, Xi) RESULT(fPsi) IMPLICIT NONE - REAL(8), INTENT(in):: xi(1:3) - REAL(8), INTENT(out):: fPsi(:) + CLASS(meshCell2DCylQuad), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: fPsi(1:self%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(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 SUBROUTINE fPsiQuad + END FUNCTION fPsiQuad - !Derivative element function at coordinates xi - PURE FUNCTION dPsiQuad(xi) RESULT(dPsi) + !Derivative element function at coordinates Xi + PURE FUNCTION dPsiQuad(self, Xi) RESULT(dPsi) IMPLICIT NONE - REAL(8), INTENT(in):: xi(1:3) - REAL(8), ALLOCATABLE:: dPsi(:,:) + CLASS(meshCell2DCylQuad), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: dPsi(1:3,1:self%nNodes) - ALLOCATE(dPsi(1:2,1:4)) + dPsi = 0.D0 - dPsi(1,:) = dPsiQuadXi1(xi(2)) - dPsi(2,:) = dPsiQuadXi2(xi(1)) + dPsi(1,:) = dPsiQuadXi1(Xi(2)) + dPsi(2,:) = dPsiQuadXi2(Xi(1)) END FUNCTION dPsiQuad - !Derivative element function (xi1) - PURE FUNCTION dPsiQuadXi1(xi2) RESULT(dPsiXi1) + !Derivative element function (Xi1) + PURE FUNCTION dPsiQuadXi1(Xi2) RESULT(dPsiXi1) IMPLICIT NONE - REAL(8),INTENT(in):: xi2 + REAL(8),INTENT(in):: Xi2 REAL(8):: dPsiXi1(1:4) - dPsiXi1(1) = -(1.D0 - xi2) - dPsiXi1(2) = (1.D0 - xi2) - dPsiXi1(3) = (1.D0 + xi2) - dPsiXi1(4) = -(1.D0 + xi2) + dPsiXi1(1) = -(1.D0 - Xi2) + dPsiXi1(2) = (1.D0 - Xi2) + dPsiXi1(3) = (1.D0 + Xi2) + dPsiXi1(4) = -(1.D0 + Xi2) dPsiXi1 = dPsiXi1*0.25D0 END FUNCTION dPsiQuadXi1 - !Derivative element function (xi2) - PURE FUNCTION dPsiQuadXi2(xi1) RESULT(dPsiXi2) + !Derivative element function (Xi2) + PURE FUNCTION dPsiQuadXi2(Xi1) RESULT(dPsiXi2) IMPLICIT NONE - REAL(8),INTENT(in):: xi1 + REAL(8),INTENT(in):: Xi1 REAL(8):: dPsiXi2(1:4) - dPsiXi2(1) = -(1.D0 - xi1) - dPsiXi2(2) = -(1.D0 + xi1) - dPsiXi2(3) = (1.D0 + xi1) - dPsiXi2(4) = (1.D0 - xi1) + dPsiXi2(1) = -(1.D0 - Xi1) + dPsiXi2(2) = -(1.D0 + Xi1) + dPsiXi2(3) = (1.D0 + Xi1) + dPsiXi2(4) = (1.D0 - Xi1) dPsiXi2 = dPsiXi2 * 0.25D0 @@ -407,8 +403,8 @@ MODULE moduleMesh2DCyl PURE SUBROUTINE partialDerQuad(self, dPsi, dz, dr) IMPLICIT NONE - CLASS(meshVol2DCylQuad), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:,1:) + CLASS(meshCell2DCylQuad), INTENT(in):: self + REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) REAL(8), INTENT(out), DIMENSION(1:2):: dz, dr dz(1) = DOT_PRODUCT(dPsi(1,:),self%z) @@ -423,16 +419,16 @@ MODULE moduleMesh2DCyl USE moduleRandom IMPLICIT NONE - CLASS(meshVol2DCylQuad), INTENT(in):: self + CLASS(meshCell2DCylQuad), INTENT(in):: self REAL(8):: r(1:3) - REAL(8):: xii(1:3) - REAL(8), ALLOCATABLE:: fPsi(:) + REAL(8):: Xi(1:3) + REAL(8):: fPsi(1:4) - xii(1) = random(-1.D0, 1.D0) - xii(2) = random(-1.D0, 1.D0) - xii(3) = 0.D0 + Xi(1) = random(-1.D0, 1.D0) + Xi(2) = random(-1.D0, 1.D0) + Xi(3) = 0.D0 - CALL self%fPsi(xii, fPsi) + fPsi = self%fPsi(Xi) r(1) = DOT_PRODUCT(fPsi, self%z) r(2) = DOT_PRODUCT(fPsi, self%r) @@ -445,26 +441,25 @@ MODULE moduleMesh2DCyl USE moduleConstParam, ONLY: PI2 IMPLICIT NONE - CLASS(meshVol2DCylQuad), INTENT(in):: self - REAL(8), ALLOCATABLE:: localK(:,:) - REAL(8):: r, xi(1:3) - REAL(8):: fPsi(1:4), dPsi(1:2,1:4) - REAL(8):: invJ(1:2,1:2), detJ + CLASS(meshCell2DCylQuad), INTENT(in):: self + REAL(8):: localK(1:self%nNodes,1:self%nNodes) + REAL(8):: r, Xi(1:3) + REAL(8):: fPsi(1:4), dPsi(1:3,1:4) + REAL(8):: invJ(1:3,1:3), detJ INTEGER:: l, m - ALLOCATE(localK(1:4, 1:4)) localK=0.D0 - xi=0.D0 + Xi=0.D0 !Start 2D Gauss Quad Integral DO l=1, 3 - xi(2) = corQuad(l) - dPsi(1,:) = self%dPsiXi1(xi(2)) + Xi(2) = corQuad(l) + dPsi(1,:) = self%dPsiXi1(Xi(2)) DO m = 1, 3 - xi(1) = corQuad(m) - dPsi(2,:) = self%dPsiXi2(xi(1)) - CALL self%fPsi(xi, fPsi) - detJ = self%detJac(xi,dPsi) - invJ = self%invJac(xi,dPsi) + Xi(1) = corQuad(m) + dPsi(2,:) = self%dPsiXi2(Xi(1)) + fPsi = self%fPsi(Xi) + detJ = self%detJac(Xi,dPsi) + invJ = self%invJac(Xi,dPsi) r = DOT_PRODUCT(fPsi,self%r) localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)), & MATMUL(invJ,dPsi))* & @@ -481,23 +476,22 @@ MODULE moduleMesh2DCyl USE moduleConstParam, ONLY: PI2 IMPLICIT NONE - CLASS(meshVol2DCylQuad), INTENT(in):: self - REAL(8), INTENT(in):: source(1:) - REAL(8), ALLOCATABLE:: localF(:) - REAL(8):: r, xi(1:3) + CLASS(meshCell2DCylQuad), INTENT(in):: self + REAL(8), INTENT(in):: source(1:self%nNodes) + REAL(8):: localF(1:self%nNodes) + REAL(8):: r, Xi(1:3) REAL(8):: fPsi(1:4) REAL(8):: detJ, f INTEGER:: l, m - ALLOCATE(localF(1:4)) localF = 0.D0 - xi = 0.D0 + Xi = 0.D0 DO l=1, 3 - xi(1) = corQuad(l) + Xi(1) = corQuad(l) DO m = 1, 3 - xi(2) = corQuad(m) - detJ = self%detJac(xi) - CALL self%fPsi(xi, fPsi) + Xi(2) = corQuad(m) + detJ = self%detJac(Xi) + fPsi = self%fPsi(Xi) r = DOT_PRODUCT(fPsi,self%r) f = DOT_PRODUCT(fPsi,source) localF = localF + r*f*fPsi*wQuad(l)*wQuad(m)*detJ @@ -508,93 +502,80 @@ MODULE moduleMesh2DCyl END FUNCTION elemFQuad - !Checks if a particle is inside a quad element - PURE FUNCTION insideQuad(xi) RESULT(ins) + PURE FUNCTION gatherEFQuad(self, Xi) RESULT(array) IMPLICIT NONE - - REAL(8), INTENT(in):: xi(1:3) - LOGICAL:: ins - - ins = (xi(1) >= -1.D0 .AND. xi(1) <= 1.D0) .AND. & - (xi(2) >= -1.D0 .AND. xi(2) <= 1.D0) - - END FUNCTION insideQuad - - !Gathers the electric field at position xi - PURE FUNCTION gatherEFQuad(self,xi) RESULT(EF) - IMPLICIT NONE - - CLASS(meshVol2DCylQuad), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8):: dPsi(1:2,1:4) - REAL(8):: dPsiR(1:2,1:4)!Derivative of shpae functions in global coordinates - REAL(8):: invJ(1:2,1:2), detJ + CLASS(meshCell2DCylQuad), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) REAL(8):: phi(1:4) - REAL(8):: EF(1:3) - phi = (/self%n1%emData%phi, & - self%n2%emData%phi, & - self%n3%emData%phi, & - self%n4%emData%phi /) + phi = (/ self%n1%emData%phi, & + self%n2%emData%phi, & + self%n3%emData%phi, & + self%n4%emData%phi /) - dPsi = self%dPsi(xi) - detJ = self%detJac(xi,dPsi) - invJ = self%invJac(xi,dPsi) - dPsiR = MATMUL(invJ, dPsi)/detJ - EF(1) = -DOT_PRODUCT(dPsiR(1,:), phi) - EF(2) = -DOT_PRODUCT(dPsiR(2,:), phi) - EF(3) = 0.D0 + array = -self%gatherDF(Xi, phi) END FUNCTION gatherEFQuad - PURE FUNCTION gatherMFQuad(self,xi) RESULT(MF) + PURE FUNCTION gatherMFQuad(self, Xi) RESULT(array) IMPLICIT NONE + CLASS(meshCell2DCylQuad), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) + REAL(8):: B(1:4,1:3) - CLASS(meshVol2DCylQuad), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8):: fPsi(1:4) - REAL(8):: MF_Nodes(1:4,1:3) - REAL(8):: MF(1:3) + B(:,1) = (/ self%n1%emData%B(1), & + self%n2%emData%B(1), & + self%n3%emData%B(1), & + self%n4%emData%B(1) /) - MF_Nodes(1:4,1) = (/self%n1%emData%B(1), & - self%n2%emData%B(1), & - self%n3%emData%B(1), & - self%n4%emData%B(1) /) - MF_Nodes(1:4,2) = (/self%n1%emData%B(2), & - self%n2%emData%B(2), & - self%n3%emData%B(2), & - self%n4%emData%B(2) /) - MF_Nodes(1:4,3) = (/self%n1%emData%B(3), & - self%n2%emData%B(3), & - self%n3%emData%B(3), & - self%n4%emData%B(3) /) + B(:,2) = (/ self%n1%emData%B(2), & + self%n2%emData%B(2), & + self%n3%emData%B(2), & + self%n4%emData%B(2) /) - CALL self%fPsi(xi, fPsi) - MF = MATMUL(fPsi(:), MF_Nodes) + B(:,3) = (/ self%n1%emData%B(3), & + self%n2%emData%B(3), & + self%n3%emData%B(3), & + self%n4%emData%B(3) /) + + array = self%gatherF(Xi, 3, B) END FUNCTION gatherMFQuad + !Checks if a particle is inside a quad element + PURE FUNCTION insideQuad(Xi) RESULT(ins) + IMPLICIT NONE + + REAL(8), INTENT(in):: Xi(1:3) + LOGICAL:: ins + + ins = (Xi(1) >= -1.D0 .AND. Xi(1) <= 1.D0) .AND. & + (Xi(2) >= -1.D0 .AND. Xi(2) <= 1.D0) + + END FUNCTION insideQuad + !Gets nodes from quadrilateral element PURE FUNCTION getNodesQuad(self) RESULT(n) IMPLICIT NONE - CLASS(meshVol2DCylQuad), INTENT(in):: self - INTEGER, ALLOCATABLE:: n(:) + CLASS(meshCell2DCylQuad), INTENT(in):: self + INTEGER:: n(1:self%nNodes) - ALLOCATE(n(1:4)) 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(XiN) + PURE FUNCTION phy2logQuad(self,r) RESULT(Xi) IMPLICIT NONE - CLASS(meshVol2DCylQuad), INTENT(in):: self + CLASS(meshCell2DCylQuad), INTENT(in):: self REAL(8), INTENT(in):: r(1:3) - REAL(8):: XiN(1:3) + REAL(8):: Xi(1:3) REAL(8):: XiO(1:3), detJ, invJ(1:2,1:2), f(1:2) - REAL(8):: dPsi(1:2,1:4), fPsi(1:4) + REAL(8):: dPsi(1:3,1:4), fPsi(1:4) REAL(8):: conv !Iterative newton method to transform coordinates @@ -602,32 +583,33 @@ MODULE moduleMesh2DCyl XiO=0.D0 DO WHILE(conv>1.D-3) - CALL self%fPsi(XiO, fPsi) - f = (/ DOT_PRODUCT(fPsi,self%z)-r(1), & - DOT_PRODUCT(fPsi,self%r)-r(2) /) dPsi = self%dPsi(XiO) invJ = self%invJac(XiO, dPsi) - detJ = self%detJac(XiO,dPsi) - XiN(1:2)=XiO(1:2) - MATMUL(invJ, f)/detJ - conv=MAXVAL(DABS(XiN-XiO),1) - XiO=XiN + detJ = self%detJac(XiO, dPsi) + fPsi = self%fPsi(XiO) + f = (/ DOT_PRODUCT(fPsi,self%z), & + DOT_PRODUCT(fPsi,self%r) /) + f = f - r(1:2) + Xi(1:2) = XiO(1:2) - MATMUL(invJ, f)/detJ + conv = MAXVAL(DABS(Xi-XiO),1) + XiO = Xi END DO END FUNCTION phy2logQuad - !Gets the next element for a logical position xi - SUBROUTINE nextElementQuad(self, xi, nextElement) + !Gets the next element for a logical position Xi + SUBROUTINE nextElementQuad(self, Xi, nextElement) IMPLICIT NONE - CLASS(meshVol2DCylQuad), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + CLASS(meshCell2DCylQuad), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) CLASS(meshElement), POINTER, INTENT(out):: nextElement - REAL(8):: xiArray(1:4) + REAL(8):: XiArray(1:4) INTEGER:: nextInt - xiArray = (/ -xi(2), xi(1), xi(2), -xi(1) /) - nextInt = MAXLOC(xiArray,1) + 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) SELECT CASE (nextInt) @@ -645,11 +627,11 @@ MODULE moduleMesh2DCyl !TRIA ELEMENT !Init tria element - SUBROUTINE initVolTria2DCyl(self, n, p, nodes) + SUBROUTINE initCellTria2DCyl(self, n, p, nodes) USE moduleRefParam IMPLICIT NONE - CLASS(meshVol2DCylTria), INTENT(out):: self + CLASS(meshCell2DCylTria), INTENT(out):: self INTEGER, INTENT(in):: n INTEGER, INTENT(in):: p(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) @@ -658,6 +640,9 @@ MODULE moduleMesh2DCyl !Assign node index self%n = n + !Assign nomber of nodes to cell + self%nNodes = SIZE(p) + !Assign nodes to element self%n1 => nodes(p(1))%obj self%n2 => nodes(p(2))%obj @@ -679,23 +664,23 @@ MODULE moduleMesh2DCyl ALLOCATE(self%listPart_in(1:nSpecies)) ALLOCATE(self%totalWeight(1:nSpecies)) - END SUBROUTINE initVolTria2DCyl + END SUBROUTINE initCellTria2DCyl !Random position in quadrilateral volume FUNCTION randPosVolTria(self) RESULT(r) USE moduleRandom IMPLICIT NONE - CLASS(meshVol2DCylTria), INTENT(in):: self + CLASS(meshCell2DCylTria), INTENT(in):: self REAL(8):: r(1:3) - REAL(8):: xii(1:3) - REAL(8), ALLOCATABLE:: fPsi(:) + REAL(8):: Xi(1:3) + REAL(8):: fPsi(1:3) - xii(1) = random( 0.D0, 1.D0) - xii(2) = random( 0.D0, 1.D0 - xii(1)) - xii(3) = 0.D0 + Xi(1) = random( 0.D0, 1.D0) + Xi(2) = random( 0.D0, 1.D0 - Xi(1)) + Xi(3) = 0.D0 - CALL self%fPsi(xii, fPsi) + fPsi = self%fPsi(Xi) r(1) = DOT_PRODUCT(fPsi, self%z) r(2) = DOT_PRODUCT(fPsi, self%r) @@ -708,17 +693,17 @@ MODULE moduleMesh2DCyl USE moduleConstParam, ONLY: PI IMPLICIT NONE - CLASS(meshVol2DCylTria), INTENT(inout):: self - REAL(8):: r, xi(1:3) + CLASS(meshCell2DCylTria), INTENT(inout):: self + REAL(8):: r, 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)*PI !2PI*1/2 - CALL self%fPsi(xi, fPsi) + Xi = (/1.D0/3.D0, 1.D0/3.D0, 0.D0 /) + detJ = self%detJac(Xi)*PI !2PI*1/2 + fPsi = self%fPsi(Xi) !Computes total volume of the cell r = DOT_PRODUCT(fPsi,self%r) self%volume = r*detJ @@ -728,37 +713,39 @@ MODULE moduleMesh2DCyl END SUBROUTINE areaTria !Shape functions for triangular element - PURE SUBROUTINE fPsiTria(xi, fPsi) + PURE FUNCTION fPsiTria(self, Xi) RESULT(fPsi) IMPLICIT NONE - REAL(8), INTENT(in):: xi(1:3) - REAL(8), INTENT(out):: fPsi(:) + CLASS(meshCell2DCylTria), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: fPsi(1:self%nNodes) - fPsi(1) = 1.D0 - xi(1) - xi(2) - fPsi(2) = xi(1) - fPsi(3) = xi(2) + fPsi(1) = 1.D0 - Xi(1) - Xi(2) + fPsi(2) = Xi(1) + fPsi(3) = Xi(2) - END SUBROUTINE fPsiTria + END FUNCTION fPsiTria - !Derivative element function at coordinates xi - PURE FUNCTION dPsiTria(xi) RESULT(dPsi) + !Derivative element function at coordinates Xi + PURE FUNCTION dPsiTria(self, Xi) RESULT(dPsi) IMPLICIT NONE - REAL(8), INTENT(in):: xi(1:3) - REAL(8), ALLOCATABLE:: dPsi(:,:) + CLASS(meshCell2DCylTria), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: dPsi(1:3,1:self%nNodes) - ALLOCATE(dPsi(1:2,1:3)) + dPsi = 0.D0 - dPsi(1,:) = dPsiTriaXi1(xi(2)) - dPsi(2,:) = dPsiTriaXi2(xi(1)) + dPsi(1,:) = dPsiTriaXi1(Xi(2)) + dPsi(2,:) = dPsiTriaXi2(Xi(1)) END FUNCTION dPsiTria - !Derivative element function (xi1) - PURE FUNCTION dPsiTriaXi1(xi2) RESULT(dPsiXi1) + !Derivative element function (Xi1) + PURE FUNCTION dPsiTriaXi1(Xi2) RESULT(dPsiXi1) IMPLICIT NONE - REAL(8), INTENT(in):: xi2 + REAL(8), INTENT(in):: Xi2 REAL(8):: dPsiXi1(1:3) dPsiXi1(1) = -1.D0 @@ -767,11 +754,11 @@ MODULE moduleMesh2DCyl END FUNCTION dPsiTriaXi1 - !Derivative element function (xi1) - PURE FUNCTION dPsiTriaXi2(xi1) RESULT(dPsiXi2) + !Derivative element function (Xi1) + PURE FUNCTION dPsiTriaXi2(Xi1) RESULT(dPsiXi2) IMPLICIT NONE - REAL(8), INTENT(in):: xi1 + REAL(8), INTENT(in):: Xi1 REAL(8):: dPsiXi2(1:3) dPsiXi2(1) = -1.D0 @@ -783,8 +770,8 @@ MODULE moduleMesh2DCyl PURE SUBROUTINE partialDerTria(self, dPsi, dz, dr) IMPLICIT NONE - CLASS(meshVol2DCylTria), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:,1:) + CLASS(meshCell2DCylTria), INTENT(in):: self + REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) REAL(8), INTENT(out), DIMENSION(1:2):: dz, dr dz(1) = DOT_PRODUCT(dPsi(1,:),self%z) @@ -799,24 +786,23 @@ MODULE moduleMesh2DCyl USE moduleConstParam, ONLY: PI2 IMPLICIT NONE - CLASS(meshVol2DCylTria), INTENT(in):: self - REAL(8), ALLOCATABLE:: localK(:,:) - REAL(8):: r, xi(1:3) - REAL(8):: fPsi(1:3), dPsi(1:2,1:3) - REAL(8):: invJ(1:2,1:2), detJ + CLASS(meshCell2DCylTria), INTENT(in):: self + REAL(8):: localK(1:self%nNodes,1:self%nNodes) + REAL(8):: r, Xi(1:3) + REAL(8):: fPsi(1:3), dPsi(1:3,1:3) + REAL(8):: invJ(1:3,1:3), detJ INTEGER:: l - ALLOCATE(localK(1:4, 1:4)) localK=0.D0 - xi=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) - detJ = self%detJac(xi,dPsi) - invJ = self%invJac(xi,dPsi) - CALL self%fPsi(xi, fPsi) + Xi(1) = Xi1Tria(l) + Xi(2) = Xi2Tria(l) + dPsi = self%dPsi(Xi) + detJ = self%detJac(Xi,dPsi) + invJ = self%invJac(Xi,dPsi) + fPsi = self%fPsi(Xi) r = DOT_PRODUCT(fPsi,self%r) localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*r*wTria(l)/detJ @@ -830,23 +816,22 @@ MODULE moduleMesh2DCyl USE moduleConstParam, ONLY: PI2 IMPLICIT NONE - CLASS(meshVol2DCylTria), INTENT(in):: self - REAL(8), INTENT(in):: source(1:) - REAL(8), ALLOCATABLE:: localF(:) + CLASS(meshCell2DCylTria), INTENT(in):: self + REAL(8), INTENT(in):: source(1:self%nNodes) + REAL(8):: localF(1:self%nNodes) REAL(8):: fPsi(1:3) - REAL(8):: r, xi(1:3) + REAL(8):: r, Xi(1:3) REAL(8):: detJ, f INTEGER:: l - ALLOCATE(localF(1:3)) localF = 0.D0 - xi = 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) - CALL self%fPsi(xi, fPsi) + Xi(1) = Xi1Tria(l) + Xi(2) = Xi2Tria(l) + detJ = self%detJac(Xi) + fPsi = self%fPsi(Xi) r = DOT_PRODUCT(fPsi,self%r) f = DOT_PRODUCT(fPsi,source) localF = localF + r*f*fPsi*wTria(l)*detJ @@ -856,112 +841,99 @@ MODULE moduleMesh2DCyl END FUNCTION elemFTria - PURE FUNCTION insideTria(xi) RESULT(ins) + PURE FUNCTION gatherEFTria(self, Xi) RESULT(array) IMPLICIT NONE - - REAL(8), INTENT(in):: xi(1:3) - LOGICAL:: ins - - ins = xi(1) >= 0.D0 .AND. & - xi(2) >= 0.D0 .AND. & - 1.D0 - xi(1) - xi(2) >= 0.D0 - - END FUNCTION insideTria - - !Gathers the electric field at position xi - PURE FUNCTION gatherEFTria(self,xi) RESULT(EF) - IMPLICIT NONE - - CLASS(meshVol2DCylTria), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8):: dPsi(1:2,1:3) - REAL(8):: dPsiR(1:2,1:3)!Derivative of shpae functions in global coordinates - REAL(8):: invJ(1:2,1:2), detJ + CLASS(meshCell2DCylTria), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) REAL(8):: phi(1:3) - REAL(8):: EF(1:3) - phi = (/self%n1%emData%phi, & - self%n2%emData%phi, & - self%n3%emData%phi /) + phi = (/ self%n1%emData%phi, & + self%n2%emData%phi, & + self%n3%emData%phi /) - dPsi = self%dPsi(xi) - detJ = self%detJac(xi,dPsi) - invJ = self%invJac(xi,dPsi) - dPsiR = MATMUL(invJ, dPsi)/detJ - EF(1) = -DOT_PRODUCT(dPsiR(1,:), phi) - EF(2) = -DOT_PRODUCT(dPsiR(2,:), phi) - EF(3) = 0.D0 + array = -self%gatherDF(Xi, phi) END FUNCTION gatherEFTria - PURE FUNCTION gatherMFTria(self,xi) RESULT(MF) + PURE FUNCTION gatherMFTria(self, Xi) RESULT(array) IMPLICIT NONE + CLASS(meshCell2DCylTria), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) + REAL(8):: B(1:3,1:3) - CLASS(meshVol2DCylTria), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8):: fPsi(1:3) - REAL(8):: MF_Nodes(1:3,1:3) - REAL(8):: MF(1:3) + B(:,1) = (/ self%n1%emData%B(1), & + self%n2%emData%B(1), & + self%n3%emData%B(1) /) - MF_Nodes(1:3,1) = (/self%n1%emData%B(1), & - self%n2%emData%B(1), & - self%n3%emData%B(1) /) - MF_Nodes(1:3,2) = (/self%n1%emData%B(2), & - self%n2%emData%B(2), & - self%n3%emData%B(2) /) - MF_Nodes(1:3,3) = (/self%n1%emData%B(3), & - self%n2%emData%B(3), & - self%n3%emData%B(3) /) + B(:,2) = (/ self%n1%emData%B(2), & + self%n2%emData%B(2), & + self%n3%emData%B(2) /) - CALL self%fPsi(xi, fPsi) - MF = MATMUL(fPsi, MF_Nodes) + B(:,3) = (/ self%n1%emData%B(3), & + self%n2%emData%B(3), & + self%n3%emData%B(3) /) + + array = self%gatherF(Xi, 3, B) END FUNCTION gatherMFTria + PURE FUNCTION insideTria(Xi) RESULT(ins) + IMPLICIT NONE + + REAL(8), INTENT(in):: Xi(1:3) + LOGICAL:: ins + + ins = Xi(1) >= 0.D0 .AND. & + Xi(2) >= 0.D0 .AND. & + 1.D0 - Xi(1) - Xi(2) >= 0.D0 + + END FUNCTION insideTria + !Gets node indexes from triangular element PURE FUNCTION getNodesTria(self) RESULT(n) IMPLICIT NONE - CLASS(meshVol2DCylTria), INTENT(in):: self - INTEGER, ALLOCATABLE:: n(:) + CLASS(meshCell2DCylTria), INTENT(in):: self + INTEGER:: n(1:self%nNodes) - ALLOCATE(n(1:3)) 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) + PURE FUNCTION phy2logTria(self,r) RESULT(Xi) IMPLICIT NONE - CLASS(meshVol2DCylTria), INTENT(in):: self + CLASS(meshCell2DCylTria), INTENT(in):: self REAL(8), INTENT(in):: r(1:3) - REAL(8):: xi(1:3) + REAL(8):: Xi(1:3) REAL(8):: invJ(1:2,1:2), detJ REAL(8):: deltaR(1:2) - REAL(8):: dPsi(1:2,1:3) + REAL(8):: dPsi(1:3,1:3) !Direct method to convert coordinates - xi = 0.D0 !Irrelevant, required for input + Xi = 0.D0 !Irrelevant, required for input deltaR = (/ r(1) - self%z(1), r(2) - self%r(1) /) - dPsi = self%dPsi(xi) - invJ = self%invJac(xi, dPsi) - detJ = self%detJac(xi, dPsi) - xi(1:2) = MATMUL(invJ,deltaR)/detJ + dPsi = self%dPsi(Xi) + invJ = self%invJac(Xi, dPsi) + detJ = self%detJac(Xi, dPsi) + Xi(1:2) = MATMUL(invJ,deltaR)/detJ END FUNCTION phy2logTria - SUBROUTINE nextElementTria(self, xi, nextElement) + SUBROUTINE nextElementTria(self, Xi, nextElement) IMPLICIT NONE - CLASS(meshVol2DCylTria), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + CLASS(meshCell2DCylTria), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) CLASS(meshElement), POINTER, INTENT(out):: nextElement - REAL(8):: xiArray(1:3) + REAL(8):: XiArray(1:3) INTEGER:: nextInt - xiArray = (/ xi(2), 1.D0-xi(1)-xi(2), xi(1) /) - nextInt = MINLOC(xiArray,1) + XiArray = (/ Xi(2), 1.D0-Xi(1)-Xi(2), Xi(1) /) + nextInt = MINLOC(XiArray,1) NULLIFY(nextElement) SELECT CASE (nextInt) CASE (1) @@ -976,21 +948,21 @@ MODULE moduleMesh2DCyl !COMMON FUNCTIONS FOR CYLINDRICAL VOLUME ELEMENTS !Computes element Jacobian determinant - PURE FUNCTION detJ2DCyl(self, xi, dPsi_in) RESULT(dJ) + PURE FUNCTION detJ2DCyl(self, Xi, dPsi_in) RESULT(dJ) IMPLICIT NONE - CLASS(meshVol2DCyl), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:,1:) - REAL(8), ALLOCATABLE:: dPsi(:,:) + CLASS(meshCell2DCyl), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) REAL(8):: dJ + REAL(8):: dPsi(1:3,1:self%nNodes) REAL(8):: dz(1:2), dr(1:2) IF(PRESENT(dPsi_in)) THEN dPsi = dPsi_in ELSE - dPsi = self%dPsi(xi) + dPsi = self%dPsi(Xi) END IF @@ -1000,27 +972,30 @@ MODULE moduleMesh2DCyl END FUNCTION detJ2DCyl !Computes element Jacobian inverse matrix (without determinant) - PURE FUNCTION invJ2DCyl(self,xi,dPsi_in) RESULT(invJ) + PURE FUNCTION invJ2DCyl(self,Xi,dPsi_in) RESULT(invJ) IMPLICIT NONE - CLASS(meshVol2DCyl), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:,1:) - REAL(8), ALLOCATABLE:: dPsi(:,:) + CLASS(meshCell2DCyl), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + REAL(8):: invJ(1:3,1:3) + REAL(8):: dPsi(1:3,1:self%nNodes) REAL(8):: dz(1:2), dr(1:2) - REAL(8):: invJ(1:2,1:2) IF(PRESENT(dPsi_in)) THEN dPsi=dPsi_in ELSE - dPsi = self%dPsi(xi) + dPsi = self%dPsi(Xi) END IF + invJ = 0.D0 + CALL self%partialDer(dPsi, dz, dr) - invJ(1,:) = (/ dr(2), -dz(2) /) - invJ(2,:) = (/ -dr(1), dz(1) /) + + invJ(1,1:2) = (/ dr(2), -dz(2) /) + invJ(2,1:2) = (/ -dr(1), dz(1) /) END FUNCTION invJ2DCyl @@ -1030,11 +1005,11 @@ MODULE moduleMesh2DCyl CLASS(meshGeneric), INTENT(inout):: self INTEGER:: e, et - DO e = 1, self%numVols + DO e = 1, self%numCells !Connect Vol-Vol - DO et = 1, self%numVols + DO et = 1, self%numCells IF (e /= et) THEN - CALL connectVolVol(self%vols(e)%obj, self%vols(et)%obj) + CALL connectVolVol(self%cells(e)%obj, self%cells(et)%obj) END IF @@ -1044,7 +1019,7 @@ MODULE moduleMesh2DCyl TYPE IS(meshParticles) !Connect Vol-Edge DO et = 1, self%numEdges - CALL connectVolEdge(self%vols(e)%obj, self%edges(et)%obj) + CALL connectVolEdge(self%cells(e)%obj, self%edges(et)%obj) END DO @@ -1058,31 +1033,31 @@ MODULE moduleMesh2DCyl SUBROUTINE connectVolVol(elemA, elemB) IMPLICIT NONE - CLASS(meshVol), INTENT(inout):: elemA - CLASS(meshVol), INTENT(inout):: elemB + CLASS(meshCell), INTENT(inout):: elemA + CLASS(meshCell), INTENT(inout):: elemB SELECT TYPE(elemA) - TYPE IS(meshVol2DCylQuad) + TYPE IS(meshCell2DCylQuad) !Element A is a quadrilateral SELECT TYPE(elemB) - TYPE IS(meshVol2DCylQuad) + TYPE IS(meshCell2DCylQuad) !Element B is a quadrilateral CALL connectQuadQuad(elemA, elemB) - TYPE IS(meshVol2DCylTria) + TYPE IS(meshCell2DCylTria) !Element B is a triangle CALL connectQuadTria(elemA, elemB) END SELECT - TYPE IS(meshVol2DCylTria) + TYPE IS(meshCell2DCylTria) !Element A is a Triangle SELECT TYPE(elemB) - TYPE IS(meshVol2DCylQuad) + TYPE IS(meshCell2DCylQuad) !Element B is a quadrilateral CALL connectQuadTria(elemB, elemA) - TYPE IS(meshVol2DCylTria) + TYPE IS(meshCell2DCylTria) !Element B is a triangle CALL connectTriaTria(elemA, elemB) @@ -1095,17 +1070,17 @@ MODULE moduleMesh2DCyl SUBROUTINE connectVolEdge(elemA, elemB) IMPLICIT NONE - CLASS(meshVol), INTENT(inout):: elemA + CLASS(meshCell), INTENT(inout):: elemA CLASS(meshEdge), INTENT(inout):: elemB SELECT TYPE(elemB) CLASS IS(meshEdge2DCyl) SELECT TYPE(elemA) - TYPE IS(meshVol2DCylQuad) + TYPE IS(meshCell2DCylQuad) !Element A is a quadrilateral CALL connectQuadEdge(elemA, elemB) - TYPE IS(meshVol2DCylTria) + TYPE IS(meshCell2DCylTria) !Element A is a triangle CALL connectTriaEdge(elemA, elemB) @@ -1118,8 +1093,8 @@ MODULE moduleMesh2DCyl SUBROUTINE connectQuadQuad(elemA, elemB) IMPLICIT NONE - CLASS(meshVol2DCylQuad), INTENT(inout), TARGET:: elemA - CLASS(meshVol2DCylQuad), INTENT(inout), TARGET:: elemB + CLASS(meshCell2DCylQuad), INTENT(inout), TARGET:: elemA + CLASS(meshCell2DCylQuad), INTENT(inout), TARGET:: elemB !Check direction 1 IF (.NOT. ASSOCIATED(elemA%e1) .AND. & @@ -1162,8 +1137,8 @@ MODULE moduleMesh2DCyl SUBROUTINE connectQuadTria(elemA, elemB) IMPLICIT NONE - CLASS(meshVol2DCylQuad), INTENT(inout), TARGET:: elemA - CLASS(meshVol2DCylTria), INTENT(inout), TARGET:: elemB + CLASS(meshCell2DCylQuad), INTENT(inout), TARGET:: elemA + CLASS(meshCell2DCylTria), INTENT(inout), TARGET:: elemB !Check direction 1 IF (.NOT. ASSOCIATED(elemA%e1)) THEN @@ -1254,8 +1229,8 @@ MODULE moduleMesh2DCyl SUBROUTINE connectTriaTria(elemA, elemB) IMPLICIT NONE - CLASS(meshVol2DCylTria), INTENT(inout), TARGET:: elemA - CLASS(meshVol2DCylTria), INTENT(inout), TARGET:: elemB + CLASS(meshCell2DCylTria), INTENT(inout), TARGET:: elemA + CLASS(meshCell2DCylTria), INTENT(inout), TARGET:: elemB !Check direction 1 IF (.NOT. ASSOCIATED(elemA%e1)) THEN @@ -1327,7 +1302,7 @@ MODULE moduleMesh2DCyl SUBROUTINE connectQuadEdge(elemA, elemB) IMPLICIT NONE - CLASS(meshVol2DCylQuad), INTENT(inout), TARGET:: elemA + CLASS(meshCell2DCylQuad), INTENT(inout), TARGET:: elemA CLASS(meshEdge2DCyl), INTENT(inout), TARGET:: elemB !Check direction 1 @@ -1411,7 +1386,7 @@ MODULE moduleMesh2DCyl SUBROUTINE connectTriaEdge(elemA, elemB) IMPLICIT NONE - CLASS(meshVol2DCylTria), INTENT(inout), TARGET:: elemA + CLASS(meshCell2DCylTria), INTENT(inout), TARGET:: elemA CLASS(meshEdge2DCyl), INTENT(inout), TARGET:: elemB !Check direction 1 diff --git a/src/modules/mesh/3DCart/moduleMesh3DCart.f90 b/src/modules/mesh/3DCart/moduleMesh3DCart.f90 index 4b29c16..9bd6468 100644 --- a/src/modules/mesh/3DCart/moduleMesh3DCart.f90 +++ b/src/modules/mesh/3DCart/moduleMesh3DCart.f90 @@ -31,26 +31,19 @@ MODULE moduleMesh3DCart END TYPE meshEdge3DCartTria - TYPE, PUBLIC, ABSTRACT, EXTENDS(meshVol):: meshVol3DCart + TYPE, PUBLIC, ABSTRACT, EXTENDS(meshCell):: meshCell3DCart CONTAINS PROCEDURE, PASS:: detJac => detJ3DCart PROCEDURE, PASS:: invJac => invJ3DCart - PROCEDURE(dPsi_interface), DEFERRED, NOPASS:: dPsi PROCEDURE(partialDer_interface), DEFERRED, PASS:: partialDer - END TYPE meshVol3DCart + END TYPE meshCell3DCart ABSTRACT INTERFACE - PURE FUNCTION dPsi_interface(Xi) RESULT(dPsi) - REAL(8), INTENT(in):: Xi(1:3) - REAL(8), ALLOCATABLE:: dPsi(:,:) - - END FUNCTION dPsi_interface - PURE SUBROUTINE partialDer_interface(self, dPsi, dx, dy, dz) - IMPORT meshVol3DCart - CLASS(meshVol3DCart), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:,1:) + IMPORT meshCell3DCart + CLASS(meshCell3DCart), INTENT(in):: self + REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) REAL(8), INTENT(out), DIMENSION(1:3):: dx, dy, dz END SUBROUTINE partialDer_interface @@ -58,7 +51,7 @@ MODULE moduleMesh3DCart END INTERFACE !Tetrahedron volume element - TYPE, PUBLIC, EXTENDS(meshVol3DCart):: meshVol3DCartTetra + TYPE, PUBLIC, EXTENDS(meshCell3DCart):: meshCell3DCartTetra !Element Coordinates REAL(8):: x(1:4) = 0.D0, y(1:4) = 0.D0, z(1:4) = 0.D0 !Connectivity to nodes @@ -66,24 +59,24 @@ MODULE moduleMesh3DCart !Connectivity to adjacent elements CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL(), e3 => NULL(), e4 => NULL() CONTAINS - PROCEDURE, PASS:: init => initVolTetra3DCart - PROCEDURE, PASS:: randPos => randPosVolTetra - PROCEDURE, PASS:: calcVol => volumeTetra - PROCEDURE, NOPASS:: fPsi => fPsiTetra - PROCEDURE, NOPASS:: dPsi => dPsiTetra - PROCEDURE, NOPASS:: dPsiXi1 => dPsiTetraXi1 - PROCEDURE, NOPASS:: dPsiXi2 => dPsiTetraXi2 + PROCEDURE, PASS:: init => initCellTetra3DCart + 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:: gatherEF => gatherEFTetra - PROCEDURE, PASS:: gatherMF => gatherMFTetra PROCEDURE, PASS:: getNodes => getNodesTetra PROCEDURE, PASS:: phy2log => phy2logTetra PROCEDURE, PASS:: nextElement => nextElementTetra - END TYPE meshVol3DCartTetra + END TYPE meshCell3DCartTetra CONTAINS !NODE FUNCTIONS @@ -245,19 +238,20 @@ MODULE moduleMesh3DCart !VOLUME FUNCTIONS !TETRA FUNCTIONS !Inits tetrahedron element - SUBROUTINE initVolTetra3DCart(self, n, p, nodes) + SUBROUTINE initCellTetra3DCart(self, n, p, nodes) USE moduleRefParam IMPLICIT NONE - CLASS(meshVol3DCartTetra), INTENT(out):: self + CLASS(meshCell3DCartTetra), INTENT(out):: self INTEGER, INTENT(in):: n INTEGER, INTENT(in):: p(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) REAL(8), DIMENSION(1:3):: r1, r2, r3, r4 !Positions of each node REAL(8):: Xi(1:3), fPsi(1:4) - REAL(8):: volNodes(1:4) !Volume of each node + REAL(8):: volNodes(1:4) !Cellume of each node self%n = n + self%nNodes = SIZE(p) self%n1 => nodes(p(1))%obj self%n2 => nodes(p(2))%obj self%n3 => nodes(p(3))%obj @@ -272,11 +266,11 @@ MODULE moduleMesh3DCart self%z = (/r1(3), r2(3), r3(3), r4(3)/) !Computes the element volume - CALL self%calcVol() + CALL self%calcCell() !Assign proportional volume to each node Xi = (/0.25D0, 0.25D0, 0.25D0/) - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) volNodes = fPsi*self%volume self%n1%v = self%n1%v + volNodes(1) self%n2%v = self%n2%v + volNodes(2) @@ -288,14 +282,14 @@ MODULE moduleMesh3DCart ALLOCATE(self%listPart_in(1:nSpecies)) ALLOCATE(self%totalWeight(1:nSpecies)) - END SUBROUTINE initVolTetra3DCart + END SUBROUTINE initCellTetra3DCart !Random position in volume tetrahedron - FUNCTION randPosVolTetra(self) RESULT(r) + FUNCTION randPosCellTetra(self) RESULT(r) USE moduleRandom IMPLICIT NONE - CLASS(meshVol3DCartTetra), INTENT(in):: self + CLASS(meshCell3DCartTetra), INTENT(in):: self REAL(8):: r(1:3) REAL(8):: Xi(1:3) REAL(8):: fPsi(1:4) @@ -304,19 +298,19 @@ MODULE moduleMesh3DCart Xi(2) = random( 0.D0, 1.D0 - Xi(1)) Xi(3) = random( 0.D0, 1.D0 - Xi(1) - Xi(2)) - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) r = (/ DOT_PRODUCT(fPsi, self%x), & DOT_PRODUCT(fPsi, self%y), & DOT_PRODUCT(fPsi, self%z) /) - END FUNCTION randPosVolTetra + END FUNCTION randPosCellTetra !Computes the element volume PURE SUBROUTINE volumeTetra(self) IMPLICIT NONE - CLASS(meshVol3DCartTetra), INTENT(inout):: self + CLASS(meshCell3DCartTetra), INTENT(inout):: self REAL(8):: Xi(1:3) self%volume = 0.D0 @@ -326,27 +320,29 @@ MODULE moduleMesh3DCart END SUBROUTINE volumeTetra !Computes element functions in point Xi - PURE SUBROUTINE fPsiTetra(Xi, fPsi) + PURE FUNCTION fPsiTetra(self, Xi) RESULT(fPsi) IMPLICIT NONE + CLASS(meshCell3DCartTetra), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(out):: fPsi(:) + REAL(8):: fPsi(1:self%nNodes) fPsi(1) = 1.D0 - Xi(1) - Xi(2) - Xi(3) fPsi(2) = Xi(1) fPsi(3) = Xi(2) fPsi(4) = Xi(3) - END SUBROUTINE fPsiTetra + END FUNCTION fPsiTetra !Derivative element function at coordinates Xi - PURE FUNCTION dPsiTetra(Xi) RESULT(dPsi) + PURE FUNCTION dPsiTetra(self, Xi) RESULT(dPsi) IMPLICIT NONE + CLASS(meshCell3DCartTetra), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), ALLOCATABLE:: dPsi(:,:) + REAL(8):: dPsi(1:3, 1:self%nNodes) - ALLOCATE(dPsi(1:3,1:4)) + dPsi = 0.D0 dPsi(1,:) = dPsiTetraXi1(Xi(2), Xi(3)) dPsi(2,:) = dPsiTetraXi2(Xi(1), Xi(3)) @@ -397,8 +393,8 @@ MODULE moduleMesh3DCart PURE SUBROUTINE partialDerTetra(self, dPsi, dx, dy, dz) IMPLICIT NONE - CLASS(meshVol3DCartTetra), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:, 1:) + CLASS(meshCell3DCartTetra), INTENT(in):: self + REAL(8), INTENT(in):: dPsi(1:3, 1:self%nNodes) REAL(8), INTENT(out), DIMENSION(1:3):: dx, dy, dz dx(1) = DOT_PRODUCT(dPsi(1,:), self%x) @@ -418,13 +414,12 @@ MODULE moduleMesh3DCart PURE FUNCTION elemKTetra(self) RESULT(localK) IMPLICIT NONE - CLASS(meshVol3DCartTetra), INTENT(in):: self - REAL(8), ALLOCATABLE:: localK(:,:) + CLASS(meshCell3DCartTetra), INTENT(in):: self + REAL(8):: localK(1:self%nNodes,1:self%nNodes) REAL(8):: Xi(1:3) REAL(8):: fPsi(1:4), dPsi(1:3, 1:4) REAL(8):: invJ(1:3,1:3), detJ - ALLOCATE(localK(1:4,1:4)) localK = 0.D0 Xi = 0.D0 !TODO: One point Gauss integral. Upgrade when possible @@ -432,7 +427,7 @@ MODULE moduleMesh3DCart dPsi = self%dPsi(Xi) detJ = self%detJac(Xi, dPsi) invJ = self%invJac(Xi, dPsi) - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) localK = MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*1.D0/detJ END FUNCTION elemKTetra @@ -440,26 +435,66 @@ MODULE moduleMesh3DCart PURE FUNCTION elemFTetra(self, source) RESULT(localF) IMPLICIT NONE - CLASS(meshVol3DCartTetra), INTENT(in):: self - REAL(8), INTENT(in):: source(1:) - REAL(8), ALLOCATABLE:: localF(:) + CLASS(meshCell3DCartTetra), INTENT(in):: self + REAL(8), INTENT(in):: source(1:self%nNodes) + REAL(8):: localF(1:self%nNodes) REAL(8):: fPsi(1:4), dPsi(1:3, 1:4) REAL(8):: Xi(1:3) REAL(8):: detJ, f - ALLOCATE(localF(1:4)) - localF = 0.D0 Xi = 0.D0 Xi = (/ 0.25D0, 0.25D0, 0.25D0 /) dPsi = self%dPsi(Xi) detJ = self%detJac(Xi, dPsi) - CALL self%fPsi(Xi, fPsi) + fPsi = self%fPsi(Xi) f = DOT_PRODUCT(fPsi, source) localF = f*fPsi*1.D0*detJ END FUNCTION elemFTetra + PURE FUNCTION gatherEFTetra(self, Xi) RESULT(array) + IMPLICIT NONE + CLASS(meshCell3DCartTetra), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) + REAL(8):: phi(1:4) + + phi = (/ self%n1%emData%phi, & + self%n2%emData%phi, & + self%n3%emData%phi, & + self%n4%emData%phi /) + + array = -self%gatherDF(Xi, phi) + + END FUNCTION gatherEFTetra + + PURE FUNCTION gatherMFTetra(self, Xi) RESULT(array) + IMPLICIT NONE + CLASS(meshCell3DCartTetra), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) + REAL(8):: B(1:4,1:3) + + B(:,1) = (/ self%n1%emData%B(1), & + self%n2%emData%B(1), & + self%n3%emData%B(1), & + self%n4%emData%B(1) /) + + B(:,2) = (/ self%n1%emData%B(2), & + self%n2%emData%B(2), & + self%n3%emData%B(2), & + self%n4%emData%B(2) /) + + B(:,3) = (/ self%n1%emData%B(3), & + self%n2%emData%B(3), & + self%n3%emData%B(3), & + self%n4%emData%B(3) /) + + array = self%gatherF(Xi, 3, B) + + END FUNCTION gatherMFTetra + PURE FUNCTION insideTetra(Xi) RESULT(ins) IMPLICIT NONE @@ -473,66 +508,12 @@ MODULE moduleMesh3DCart END FUNCTION insideTetra - PURE FUNCTION gatherEFTetra(self, Xi) RESULT(EF) - IMPLICIT NONE - - CLASS(meshVol3DCartTetra), INTENT(in):: self - REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: dPsi(1:3, 1:4) - REAL(8):: dPsiR(1:3, 1:4) - REAL(8):: invJ(1:3, 1:3), detJ - REAL(8):: phi(1:4) - REAL(8):: EF(1:3) - - phi = (/self%n1%emData%phi, & - self%n2%emData%phi, & - self%n3%emData%phi, & - self%n4%emData%phi /) - - dPsi = self%dPsi(Xi) - detJ = self%detJac(Xi, dPsi) - invJ = self%invJac(Xi, dPsi) - dPsiR = MATMUL(invJ, dPsi)/detJ - EF(1) = -DOT_PRODUCT(dPsiR(1,:), phi) - EF(2) = -DOT_PRODUCT(dPsiR(2,:), phi) - EF(3) = -DOT_PRODUCT(dPsiR(3,:), phi) - - END FUNCTION gatherEFTetra - - PURE FUNCTION gatherMFTetra(self, Xi) RESULT(MF) - IMPLICIT NONE - - CLASS(meshVol3DCartTetra), INTENT(in):: self - REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: fPsi(1:4) - REAL(8):: MF_Nodes(1:4,1:3) - REAL(8):: MF(1:3) - - MF_Nodes(1:4,1) = (/self%n1%emData%B(1), & - self%n2%emData%B(1), & - self%n3%emData%B(1), & - self%n4%emData%B(1) /) - MF_Nodes(1:4,2) = (/self%n1%emData%B(2), & - self%n2%emData%B(2), & - self%n3%emData%B(2), & - self%n4%emData%B(2) /) - MF_Nodes(1:4,3) = (/self%n1%emData%B(3), & - self%n2%emData%B(3), & - self%n3%emData%B(3), & - self%n4%emData%B(3) /) - - CALL self%fPsi(Xi, fPsi) - MF = MATMUL(fPsi, MF_Nodes) - - END FUNCTION gatherMFTetra - PURE FUNCTION getNodesTetra(self) RESULT(n) IMPLICIT NONE - CLASS(meshVol3DCartTetra), INTENT(in):: self - INTEGER, ALLOCATABLE:: n(:) + CLASS(meshCell3DCartTetra), INTENT(in):: self + INTEGER:: n(1:self%nnodes) - ALLOCATE(n(1:4)) n = (/self%n1%n, self%n2%n, self%n3%n, self%n4%n /) END FUNCTION getNodesTetra @@ -540,7 +521,7 @@ MODULE moduleMesh3DCart PURE FUNCTION phy2logTetra(self,r) RESULT(Xi) IMPLICIT NONE - CLASS(meshVol3DCartTetra), INTENT(in):: self + CLASS(meshCell3DCartTetra), INTENT(in):: self REAL(8), INTENT(in):: r(1:3) REAL(8):: Xi(1:3) REAL(8):: invJ(1:3, 1:3), detJ @@ -559,7 +540,7 @@ MODULE moduleMesh3DCart SUBROUTINE nextElementTetra(self, Xi, nextElement) IMPLICIT NONE - CLASS(meshVol3DCartTetra), INTENT(in):: self + CLASS(meshCell3DCartTetra), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) CLASS(meshElement), POINTER, INTENT(out):: nextElement REAL(8):: XiArray(1:4) @@ -587,11 +568,11 @@ MODULE moduleMesh3DCart PURE FUNCTION detJ3DCart(self, Xi, dPsi_in) RESULT(dJ) IMPLICIT NONE - CLASS(meshVol3DCart), INTENT(in)::self + CLASS(meshCell3DCart), INTENT(in)::self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:, 1:) + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3, 1:self%nNodes) REAL(8):: dJ - REAL(8), ALLOCATABLE:: dPsi(:,:) + REAL(8):: dPsi(1:3, 1:self%nNodes) REAL(8):: dx(1:3), dy(1:3), dz(1:3) IF (PRESENT(dPsi_in)) THEN @@ -612,10 +593,10 @@ MODULE moduleMesh3DCart PURE FUNCTION invJ3DCart(self,Xi,dPsi_in) RESULT(invJ) IMPLICIT NONE - CLASS(meshVol3DCart), INTENT(in):: self + CLASS(meshCell3DCart), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:,1:) - REAL(8), ALLOCATABLE:: dPsi(:,:) + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3, 1:self%nNodes) + REAL(8):: dPsi(1:3, 1:self%nNodes) REAL(8), DIMENSION(1:3):: dx, dy, dz REAL(8):: invJ(1:3,1:3) @@ -645,17 +626,17 @@ MODULE moduleMesh3DCart END FUNCTION invJ3DCart !Selects type of elements to build connection - SUBROUTINE connectVolVol(elemA, elemB) + SUBROUTINE connectCellCell(elemA, elemB) IMPLICIT NONE - CLASS(meshVol), INTENT(inout):: elemA - CLASS(meshVol), INTENT(inout):: elemB + CLASS(meshCell), INTENT(inout):: elemA + CLASS(meshCell), INTENT(inout):: elemB SELECT TYPE(elemA) - TYPE IS(meshVol3DCartTetra) + TYPE IS(meshCell3DCartTetra) !Element A is a tetrahedron SELECT TYPE(elemB) - TYPE IS(meshVol3DCartTetra) + TYPE IS(meshCell3DCartTetra) !Element B is a tetrahedron CALL connectTetraTetra(elemA, elemB) @@ -663,18 +644,18 @@ MODULE moduleMesh3DCart END SELECT - END SUBROUTINE connectVolVol + END SUBROUTINE connectCellCell - SUBROUTINE connectVolEdge(elemA, elemB) + SUBROUTINE connectCellEdge(elemA, elemB) IMPLICIT NONE - CLASS(meshVol), INTENT(inout):: elemA + CLASS(meshCell), INTENT(inout):: elemA CLASS(meshEdge), INTENT(inout):: elemB SELECT TYPE(elemB) CLASS IS(meshEdge3DCartTria) SELECT TYPE(elemA) - TYPE IS(meshVol3DCartTetra) + TYPE IS(meshCell3DCartTetra) !Element A is a tetrahedron CALL connectTetraEdge(elemA, elemB) @@ -682,7 +663,7 @@ MODULE moduleMesh3DCart END SELECT - END SUBROUTINE connectVolEdge + END SUBROUTINE connectCellEdge SUBROUTINE connectMesh3DCart(self) IMPLICIT NONE @@ -690,11 +671,11 @@ MODULE moduleMesh3DCart CLASS(meshGeneric), INTENT(inout):: self INTEGER:: e, et - DO e = 1, self%numVols - !Connect Vol-Vol - DO et = 1, self%numVols + DO e = 1, self%numCells + !Connect Cell-Cell + DO et = 1, self%numCells IF (e /= et) THEN - CALL connectVolVol(self%vols(e)%obj, self%vols(et)%obj) + CALL connectCellCell(self%cells(e)%obj, self%cells(et)%obj) END IF @@ -702,9 +683,9 @@ MODULE moduleMesh3DCart SELECT TYPE(self) TYPE IS(meshParticles) - !Connect Vol-Edge + !Connect Cell-Edge DO et = 1, self%numEdges - CALL connectVolEdge(self%vols(e)%obj, self%edges(et)%obj) + CALL connectCellEdge(self%cells(e)%obj, self%edges(et)%obj) END DO @@ -740,8 +721,8 @@ MODULE moduleMesh3DCart SUBROUTINE connectTetraTetra(elemA, elemB) IMPLICIT NONE - CLASS(meshVol3DCartTetra), INTENT(inout), TARGET:: elemA - CLASS(meshVol3DCartTetra), INTENT(inout), TARGET:: elemB + CLASS(meshCell3DCartTetra), INTENT(inout), TARGET:: elemA + CLASS(meshCell3DCartTetra), INTENT(inout), TARGET:: elemB !Check surface 1 IF (.NOT. ASSOCIATED(elemA%e1)) THEN @@ -869,11 +850,11 @@ MODULE moduleMesh3DCart USE moduleMath IMPLICIT NONE - CLASS(meshVol3DCartTetra), INTENT(inout), TARGET:: elemA + CLASS(meshCell3DCartTetra), INTENT(inout), TARGET:: elemA CLASS(meshEdge3DCartTria), INTENT(inout), TARGET:: elemB INTEGER:: nodesEdge(1:3) REAL(8), DIMENSION(1:3):: vec1, vec2 - REAL(8):: normVol(1:3) + REAL(8):: normCell(1:3) nodesEdge = (/ elemB%n1%n, elemB%n2%n, elemB%n3%n /) @@ -888,10 +869,10 @@ MODULE moduleMesh3DCart vec2 = (/ elemA%x(3) - elemA%x(1), & elemA%y(3) - elemA%y(1), & elemA%z(3) - elemA%z(1) /) - normVol = crossProduct(vec1, vec2) - normVol = normalize(normVol) + normCell = crossProduct(vec1, vec2) + normCell = normalize(normCell) - IF (DOT_PRODUCT(elemB%normal, normVol) == -1.D0) THEN + IF (DOT_PRODUCT(elemB%normal, normCell) == -1.D0) THEN elemA%e1 => elemB elemB%e1 => elemA @@ -921,10 +902,10 @@ MODULE moduleMesh3DCart vec2 = (/ elemA%x(4) - elemA%x(2), & elemA%y(4) - elemA%y(2), & elemA%z(4) - elemA%z(2) /) - normVol = crossProduct(vec1, vec2) - normVol = normalize(normVol) + normCell = crossProduct(vec1, vec2) + normCell = normalize(normCell) - IF (DOT_PRODUCT(elemB%normal, normVol) == -1.D0) THEN + IF (DOT_PRODUCT(elemB%normal, normCell) == -1.D0) THEN elemA%e2 => elemB elemB%e1 => elemA @@ -954,10 +935,10 @@ MODULE moduleMesh3DCart vec2 = (/ elemA%x(4) - elemA%x(1), & elemA%y(4) - elemA%y(1), & elemA%z(4) - elemA%z(1) /) - normVol = crossProduct(vec1, vec2) - normVol = normalize(normVol) + normCell = crossProduct(vec1, vec2) + normCell = normalize(normCell) - IF (DOT_PRODUCT(elemB%normal, normVol) == -1.D0) THEN + IF (DOT_PRODUCT(elemB%normal, normCell) == -1.D0) THEN elemA%e3 => elemB elemB%e1 => elemA @@ -987,10 +968,10 @@ MODULE moduleMesh3DCart vec2 = (/ elemA%x(4) - elemA%x(1), & elemA%y(4) - elemA%y(1), & elemA%z(4) - elemA%z(1) /) - normVol = crossProduct(vec1, vec2) - normVol = normalize(normVol) + normCell = crossProduct(vec1, vec2) + normCell = normalize(normCell) - IF (DOT_PRODUCT(elemB%normal, normVol) == -1.D0) THEN + IF (DOT_PRODUCT(elemB%normal, normCell) == -1.D0) THEN elemA%e4 => elemB elemB%e1 => elemA diff --git a/src/modules/mesh/inout/0D/moduleMeshInput0D.f90 b/src/modules/mesh/inout/0D/moduleMeshInput0D.f90 index 5ac0682..37dbf82 100644 --- a/src/modules/mesh/inout/0D/moduleMeshInput0D.f90 +++ b/src/modules/mesh/inout/0D/moduleMeshInput0D.f90 @@ -41,8 +41,8 @@ MODULE moduleMeshInput0D self%numNodes = 1 ALLOCATE(self%nodes(1:1)) !Allocates one volume - self%numVols = 1 - ALLOCATE(self%vols(1:1)) + self%numCells = 1 + ALLOCATE(self%cells(1:1)) !Allocates matrix K SELECT TYPE(self) TYPE IS(meshParticles) @@ -59,8 +59,8 @@ MODULE moduleMeshInput0D CALL self%nodes(1)%obj%init(1, r) !Creates the volume - ALLOCATE(meshVol0D:: self%vols(1)%obj) - CALL self%vols(1)%obj%init(1, (/ 1/), self%nodes) + ALLOCATE(meshCell0D:: self%cells(1)%obj) + CALL self%cells(1)%obj%init(1, (/ 1/), self%nodes) END SUBROUTINE read0D diff --git a/src/modules/mesh/inout/0D/moduleMeshOutput0D.f90 b/src/modules/mesh/inout/0D/moduleMeshOutput0D.f90 index 15045b1..dfe9605 100644 --- a/src/modules/mesh/inout/0D/moduleMeshOutput0D.f90 +++ b/src/modules/mesh/inout/0D/moduleMeshOutput0D.f90 @@ -57,7 +57,7 @@ MODULE moduleMeshOutput0D END IF OPEN(20, file = path // folder // '/' // fileName, position = 'append', action = 'write') - WRITE(20, "(ES20.6E3, 10I20)") REAL(t)*tauMin*ti_ref, (self%vols(1)%obj%tallyColl(k)%tally, k=1,nCollPairs) + WRITE(20, "(ES20.6E3, 10I20)") REAL(t)*tauMin*ti_ref, (self%cells(1)%obj%tallyColl(k)%tally, k=1,nCollPairs) CLOSE(20) END SUBROUTINE printColl0D diff --git a/src/modules/mesh/inout/gmsh2/moduleMeshInputGmsh2.f90 b/src/modules/mesh/inout/gmsh2/moduleMeshInputGmsh2.f90 index 7832843..aae2216 100644 --- a/src/modules/mesh/inout/gmsh2/moduleMeshInputGmsh2.f90 +++ b/src/modules/mesh/inout/gmsh2/moduleMeshInputGmsh2.f90 @@ -136,7 +136,7 @@ MODULE moduleMeshInputGmsh2 !Substract the number of edges to the total number of elements !to obtain the number of volume elements - self%numVols = TotalnumElem - self%numEdges + self%numCells = TotalnumElem - self%numEdges ALLOCATE(self%edges(1:self%numEdges)) numEdges = self%numEdges @@ -146,13 +146,13 @@ MODULE moduleMeshInputGmsh2 END DO TYPE IS(meshCollisions) - self%numVols = TotalnumElem + self%numCells = TotalnumElem numEdges = 0 END SELECT !Allocates arrays - ALLOCATE(self%vols(1:self%numVols)) + ALLOCATE(self%cells(1:self%numCells)) SELECT TYPE(self) TYPE IS(meshParticles) @@ -232,7 +232,7 @@ MODULE moduleMeshInputGmsh2 END SELECT !Read and initialize volumes - DO e = 1, self%numVols + DO e = 1, self%numCells !Reads the volume according to the geometry SELECT CASE(self%dimen) CASE(3) @@ -244,7 +244,7 @@ MODULE moduleMeshInputGmsh2 !Tetrahedron element ALLOCATE(p(1:4)) READ(10, *) n, elemType, eTemp, eTemp, eTemp, p(1:4) - ALLOCATE(meshVol3DCartTetra:: self%vols(e)%obj) + ALLOCATE(meshCell3DCartTetra:: self%cells(e)%obj) END SELECT @@ -259,13 +259,13 @@ MODULE moduleMeshInputGmsh2 !Triangular element ALLOCATE(p(1:3)) READ(10,*) n, elemType, eTemp, eTemp, eTemp, p(1:3) - ALLOCATE(meshVol2DCylTria:: self%vols(e)%obj) + ALLOCATE(meshCell2DCylTria:: self%cells(e)%obj) CASE (3) !Quadrilateral element ALLOCATE(p(1:4)) READ(10,*) n, elemType, eTemp, eTemp, eTemp, p(1:4) - ALLOCATE(meshVol2DCylQuad:: self%vols(e)%obj) + ALLOCATE(meshCell2DCylQuad:: self%cells(e)%obj) END SELECT @@ -278,13 +278,13 @@ MODULE moduleMeshInputGmsh2 !Triangular element ALLOCATE(p(1:3)) READ(10,*) n, elemType, eTemp, eTemp, eTemp, p(1:3) - ALLOCATE(meshVol2DCartTria:: self%vols(e)%obj) + ALLOCATE(meshCell2DCartTria:: self%cells(e)%obj) CASE (3) !Quadrilateral element ALLOCATE(p(1:4)) READ(10,*) n, elemType, eTemp, eTemp, eTemp, p(1:4) - ALLOCATE(meshVol2DCartQuad:: self%vols(e)%obj) + ALLOCATE(meshCell2DCartQuad:: self%cells(e)%obj) END SELECT @@ -296,19 +296,19 @@ MODULE moduleMeshInputGmsh2 ALLOCATE(p(1:2)) READ(10, *) n, elemType, eTemp, eTemp, eTemp, p(1:2) - ALLOCATE(meshVol1DRadSegm:: self%vols(e)%obj) + ALLOCATE(meshCell1DRadSegm:: self%cells(e)%obj) CASE("Cart") ALLOCATE(p(1:2)) READ(10, *) n, elemType, eTemp, eTemp, eTemp, p(1:2) - ALLOCATE(meshVol1DCartSegm:: self%vols(e)%obj) + ALLOCATE(meshCell1DCartSegm:: self%cells(e)%obj) END SELECT END SELECT - CALL self%vols(e)%obj%init(n - numEdges, p, self%nodes) + CALL self%cells(e)%obj%init(n - numEdges, p, self%nodes) DEALLOCATE(p) END DO diff --git a/src/modules/mesh/inout/gmsh2/moduleMeshOutputGmsh2.f90 b/src/modules/mesh/inout/gmsh2/moduleMeshOutputGmsh2.f90 index 7eade3e..53485f4 100644 --- a/src/modules/mesh/inout/gmsh2/moduleMeshOutputGmsh2.f90 +++ b/src/modules/mesh/inout/gmsh2/moduleMeshOutputGmsh2.f90 @@ -181,9 +181,9 @@ MODULE moduleMeshOutputGmsh2 DO c = 1, interactionMatrix(k)%amount WRITE(cString, "(I2)") c title = '"Pair ' // interactionMatrix(k)%sp_i%name // '-' // interactionMatrix(k)%sp_j%name // ' collision ' // cString - CALL writeGmsh2HeaderElementData(60, title, t, time, 1, self%numVols) - DO n=1, self%numVols - WRITE(60, "(I6,I10)") n + numEdges, self%vols(n)%obj%tallyColl(k)%tally(c) + CALL writeGmsh2HeaderElementData(60, title, t, time, 1, self%numCells) + DO n=1, self%numCells + WRITE(60, "(I6,I10)") n + numEdges, self%cells(n)%obj%tallyColl(k)%tally(c) END DO CALL writeGmsh2FooterElementData(60) @@ -211,9 +211,9 @@ MODULE moduleMeshOutputGmsh2 REAL(8):: time CHARACTER(:), ALLOCATABLE:: fileName CHARACTER (LEN=iterationDigits):: tstring - REAL(8):: xi(1:3) + REAL(8):: Xi(1:3) - xi = (/ 0.D0, 0.D0, 0.D0 /) + Xi = (/ 0.D0, 0.D0, 0.D0 /) IF (emOutput) THEN time = DBLE(t)*tauMin*ti_ref @@ -231,9 +231,9 @@ MODULE moduleMeshOutputGmsh2 END DO CALL writeGmsh2FooterNodeData(20) - CALL writeGmsh2HeaderElementData(20, 'Electric Field (V m^-1)', t, time, 3, self%numVols) - DO e=1, self%numVols - WRITE(20, *) e+self%numEdges, self%vols(e)%obj%gatherEF(xi)*EF_ref + CALL writeGmsh2HeaderElementData(20, 'Electric Field (V m^-1)', t, time, 3, self%numCells) + DO e=1, self%numCells + WRITE(20, *) e+self%numEdges, self%cells(e)%obj%gatherElectricField(Xi)*EF_ref END DO CALL writeGmsh2FooterElementData(20) diff --git a/src/modules/mesh/moduleMesh.f90 b/src/modules/mesh/moduleMesh.f90 index 11e8bc7..d0a03f4 100644 --- a/src/modules/mesh/moduleMesh.f90 +++ b/src/modules/mesh/moduleMesh.f90 @@ -66,10 +66,10 @@ MODULE moduleMesh !Parent of Edge element TYPE, PUBLIC, ABSTRACT, EXTENDS(meshElement):: meshEdge - !Connectivity to vols - CLASS(meshVol), POINTER:: e1 => NULL(), e2 => NULL() - !Connectivity to vols in meshColl - CLASS(meshVol), POINTER:: eColl => NULL() + !Connectivity to cells + CLASS(meshCell), POINTER:: e1 => NULL(), e2 => NULL() + !Connectivity to cells in meshColl + CLASS(meshCell), POINTER:: eColl => NULL() !Normal vector REAL(8):: normal(1:3) !Weight for random injection of particles @@ -146,8 +146,10 @@ MODULE moduleMesh END TYPE meshEdgeCont - !Parent of Volume element - TYPE, PUBLIC, ABSTRACT, EXTENDS(meshElement):: meshVol + !Parent of cell element + TYPE, PUBLIC, ABSTRACT, EXTENDS(meshElement):: meshCell + !Number of nodes in the cell + INTEGER:: nNodes !Maximum collision rate REAL(8), ALLOCATABLE:: sigmaVrelMax(:) !Arrays for counting number of collisions @@ -161,114 +163,152 @@ MODULE moduleMesh !Total weight of particles inside cell REAL(8), ALLOCATABLE:: totalWeight(:) CONTAINS - PROCEDURE(initVol_interface), DEFERRED, PASS:: init - PROCEDURE(getNodesVol_interface), DEFERRED, PASS:: getNodes - PROCEDURE(randPosVol_interface), DEFERRED, PASS:: randPos - PROCEDURE(fPsi_interface), DEFERRED, NOPASS:: fPsi - PROCEDURE, PASS:: scatter - PROCEDURE(gatherEF_interface), DEFERRED, PASS:: gatherEF - PROCEDURE(gatherMF_interface), DEFERRED, PASS:: gatherMF - PROCEDURE(elemK_interface), DEFERRED, PASS:: elemK - PROCEDURE(elemF_interface), DEFERRED, PASS:: elemF + !Init the cell + PROCEDURE(initCell_interface), DEFERRED, PASS:: init + !Get the index of the nodes + PROCEDURE(getNodesVol_interface), DEFERRED, PASS:: getNodes + !Calculate random position on the cell + PROCEDURE(randPosVol_interface), DEFERRED, PASS:: randPos + !Obtain functions and values of cell natural functions + PROCEDURE(fPsi_interface), DEFERRED, PASS:: fPsi + PROCEDURE(dPsi_interface), DEFERRED, PASS:: dPsi + PROCEDURE(detJac_interface), DEFERRED, PASS:: detJac + PROCEDURE(invJac_interface), DEFERRED, PASS:: invJac + !Scatter properties of particles on cell nodes + PROCEDURE, PASS:: scatter + !Gather value and spatial derivative on the nodes at position Xi + PROCEDURE, PASS, PRIVATE:: gatherF_scalar + PROCEDURE, PASS, PRIVATE:: gatherF_array + PROCEDURE, PASS, PRIVATE:: gatherDF_scalar + GENERIC:: gatherF => gatherF_scalar, gatherF_array + GENERIC:: gatherDF => gatherDF_scalar + !Procedures to get specific values in the node + PROCEDURE(gatherArray_interface), DEFERRED, PASS:: gatherElectricField + PROCEDURE(gatherArray_interface), DEFERRED, PASS:: gatherMagneticField + !Compute K and F to solve PDE on the mesh + PROCEDURE(elemK_interface), DEFERRED, PASS:: elemK + PROCEDURE(elemF_interface), DEFERRED, PASS:: elemF + !Subroutines to find in which cell a particle is located PROCEDURE, PASS:: findCell - PROCEDURE(phy2log_interface), DEFERRED, PASS:: phy2log PROCEDURE(inside_interface), DEFERRED, NOPASS:: inside PROCEDURE(nextElement_interface), DEFERRED, PASS:: nextElement + !Convert physical coordinates (r) into logical coordinates (Xi) + PROCEDURE(phy2log_interface), DEFERRED, PASS:: phy2log - END TYPE meshVol + END TYPE meshCell ABSTRACT INTERFACE - SUBROUTINE initVol_interface(self, n, p, nodes) - IMPORT:: meshVol + SUBROUTINE initCell_interface(self, n, p, nodes) + IMPORT:: meshCell IMPORT meshNodeCont - CLASS(meshVol), INTENT(out):: self + CLASS(meshCell), INTENT(out):: self INTEGER, INTENT(in):: n INTEGER, INTENT(in):: p(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) - END SUBROUTINE initVol_interface - - PURE FUNCTION gatherEF_interface(self, xi) RESULT(EF) - IMPORT:: meshVol - CLASS(meshVol), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8):: EF(1:3) - - END FUNCTION gatherEF_interface - - PURE FUNCTION gatherMF_interface(self, xi) RESULT(MF) - IMPORT:: meshVol - CLASS(meshVol), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8):: MF(1:3) - - END FUNCTION gatherMF_interface + END SUBROUTINE initCell_interface PURE FUNCTION getNodesVol_interface(self) RESULT(n) - IMPORT:: meshVol - CLASS(meshVol), INTENT(in):: self - INTEGER, ALLOCATABLE:: n(:) + IMPORT:: meshCell + CLASS(meshCell), INTENT(in):: self + INTEGER:: n(1:self%nNodes) END FUNCTION getNodesVol_interface - PURE SUBROUTINE fPsi_interface(xi, fPsi) - REAL(8), INTENT(in):: xi(1:3) - REAL(8), INTENT(out):: fPsi(:) + PURE FUNCTION fPsi_interface(self, Xi) RESULT(fPsi) + IMPORT:: meshCell + CLASS(meshCell), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: fPsi(1:self%nNodes) - END SUBROUTINE fPsi_interface + END FUNCTION fPsi_interface + + PURE FUNCTION dPsi_interface(self, Xi) RESULT(dPsi) + IMPORT:: meshCell + CLASS(meshCell), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: dPsi(1:3, 1:self%nNodes) + + END FUNCTION dPsi_interface + + PURE FUNCTION detJac_interface(self, Xi, dPsi_in) RESULT(dJ) + IMPORT:: meshCell + CLASS(meshCell), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + REAL(8):: dJ + + END FUNCTION detJac_interface + + PURE FUNCTION invJac_interface(self, Xi, dPsi_in) RESULT(invJ) + IMPORT:: meshCell + CLASS(meshCell), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + REAL(8):: invJ(1:3,1:3) + + END FUNCTION invJac_interface + + PURE FUNCTION gatherArray_interface(self, Xi) RESULT(array) + IMPORT:: meshCell + CLASS(meshCell), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8):: array(1:3) + + END FUNCTION gatherArray_interface PURE FUNCTION elemK_interface(self) RESULT(localK) - IMPORT:: meshVol - CLASS(meshVol), INTENT(in):: self - REAL(8), ALLOCATABLE:: localK(:,:) + IMPORT:: meshCell + CLASS(meshCell), INTENT(in):: self + REAL(8):: localK(1:self%nNodes,1:self%nNodes) END FUNCTION elemK_interface PURE FUNCTION elemF_interface(self, source) RESULT(localF) - IMPORT:: meshVol - CLASS(meshVol), INTENT(in):: self - REAL(8), INTENT(in):: source(1:) - REAL(8), ALLOCATABLE:: localF(:) + IMPORT:: meshCell + CLASS(meshCell), INTENT(in):: self + REAL(8), INTENT(in):: source(1:self%nNodes) + REAL(8):: localF(1:self%nNodes) END FUNCTION elemF_interface - SUBROUTINE nextElement_interface(self, xi, nextElement) - IMPORT:: meshVol, meshElement - CLASS(meshVol), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + SUBROUTINE nextElement_interface(self, Xi, nextElement) + IMPORT:: meshCell, meshElement + CLASS(meshCell), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) CLASS(meshElement), POINTER, INTENT(out):: nextElement END SUBROUTINE nextElement_interface - PURE FUNCTION phy2log_interface(self,r) RESULT(xN) - IMPORT:: meshVol - CLASS(meshVol), INTENT(in):: self + PURE FUNCTION phy2log_interface(self,r) RESULT(Xi) + IMPORT:: meshCell + CLASS(meshCell), INTENT(in):: self REAL(8), INTENT(in):: r(1:3) - REAL(8):: xN(1:3) + REAL(8):: Xi(1:3) END FUNCTION phy2log_interface - PURE FUNCTION inside_interface(xi) RESULT(ins) - IMPORT:: meshVol - REAL(8), INTENT(in):: xi(1:3) + PURE FUNCTION inside_interface(Xi) RESULT(ins) + IMPORT:: meshCell + REAL(8), INTENT(in):: Xi(1:3) LOGICAL:: ins END FUNCTION inside_interface FUNCTION randPosVol_interface(self) RESULT(r) - IMPORT:: meshVol - CLASS(meshVol), INTENT(in):: self + IMPORT:: meshCell + CLASS(meshCell), INTENT(in):: self REAL(8):: r(1:3) END FUNCTION randPosVol_interface END INTERFACE - !Containers for volumes in the mesh - TYPE:: meshVolCont - CLASS(meshVol), ALLOCATABLE:: obj + !Containers for cells in the mesh + TYPE:: meshCellCont + CLASS(meshCell), ALLOCATABLE:: obj - END TYPE meshVolCont + END TYPE meshCellCont !Generic mesh type TYPE, ABSTRACT:: meshGeneric @@ -277,11 +317,11 @@ MODULE moduleMesh !Geometry of the mesh CHARACTER(:), ALLOCATABLE:: geometry !Number of elements - INTEGER:: numNodes, numVols + INTEGER:: numNodes, numCells !Array of nodes TYPE(meshNodeCont), ALLOCATABLE:: nodes(:) - !Array of volume elements - TYPE(meshVolCont), ALLOCATABLE:: vols(:) + !Array of cell elements + TYPE(meshCellCont), ALLOCATABLE:: cells(:) PROCEDURE(readMesh_interface), POINTER, PASS:: readMesh => NULL() PROCEDURE(readInitial_interface), POINTER, NOPASS:: readInitial => NULL() PROCEDURE(connectMesh_interface), POINTER, PASS:: connectMesh => NULL() @@ -310,7 +350,7 @@ MODULE moduleMesh END SUBROUTINE readInitial_interface - !Connects volume and edges to the mesh + !Connects cell and edges to the mesh SUBROUTINE connectMesh_interface(self) IMPORT meshGeneric @@ -318,7 +358,7 @@ MODULE moduleMesh END SUBROUTINE connectMesh_interface - !Prints number of collisions in each volume + !Prints number of collisions in each cell SUBROUTINE printColl_interface(self, t) IMPORT meshGeneric @@ -416,7 +456,7 @@ MODULE moduleMesh !Pointer to mesh used for MC collisions CLASS(meshGeneric), POINTER:: meshForMCC => NULL() - !Procedure to find a volume for a particle in meshColl + !Procedure to find a cell for a particle in meshColl PROCEDURE(findCellColl_interface), POINTER:: findCellColl => NULL() ABSTRACT INTERFACE @@ -445,9 +485,9 @@ MODULE moduleMesh REAL(8), ALLOCATABLE:: localK(:,:) INTEGER:: nNodes, i, j - DO e = 1, self%numVols - n = self%vols(e)%obj%getNodes() - localK = self%vols(e)%obj%elemK() + DO e = 1, self%numCells + n = self%cells(e)%obj%getNodes() + localK = self%cells(e)%obj%elemK() nNodes = SIZE(n) DO i = 1, nNodes @@ -480,33 +520,84 @@ MODULE moduleMesh END SUBROUTINE resetOutput - !Scatters particle properties into vol nodes + !Gather the value of valNodes (scalar) at position Xi + PURE FUNCTION gatherF_scalar(self, Xi, valNodes) RESULT(f) + IMPLICIT NONE + + CLASS(meshCell), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8), INTENT(in):: valNodes(1:self%nNodes) + REAL(8):: f + REAL(8):: fPsi(1:self%nNodes) + + fPsi = self%fPsi(Xi) + f = DOT_PRODUCT(fPsi, valNodes) + + END FUNCTION gatherF_scalar + + !Gather the value of valNodes (array) at position Xi + PURE FUNCTION gatherF_array(self, Xi, n, valNodes) RESULT(f) + IMPLICIT NONE + + CLASS(meshCell), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + INTEGER, INTENT(in):: n + REAL(8), INTENT(in):: valNodes(1:self%nNodes, 1:n) + REAL(8):: f(1:n) + REAL(8):: fPsi(1:self%nNodes) + + fPsi = self%fPsi(Xi) + f = MATMUL(fPsi, valNodes) + + END FUNCTION gatherF_array + + !Gather the spatial derivative of valNodes (scalar) at position Xi + PURE FUNCTION gatherDF_scalar(self, Xi, valNodes) RESULT(df) + IMPLICIT NONE + + CLASS(meshCell), INTENT(in):: self + REAL(8), INTENT(in):: Xi(1:3) + REAL(8), INTENT(in):: valNodes(1:self%nNodes) + REAL(8):: df(1:3) + REAL(8):: dPsi(1:3, 1:self%nNodes) + REAL(8):: dPsiR(1:3, 1:self%nNodes) + REAL(8):: invJ(1:3, 1:3), detJ + + dPsi = self%dPsi(Xi) + detJ = self%detJac(Xi, dPsi) + invJ = self%invJac(Xi, dPsi) + dPsiR = MATMUL(invJ, dPsi)/detJ + df = (/ DOT_PRODUCT(dPsiR(1,:), valNodes), & + DOT_PRODUCT(dPsiR(2,:), valNodes), & + DOT_PRODUCT(dPsiR(3,:), valNodes) /) + + END FUNCTION gatherDF_scalar + + !Scatters particle properties into cell nodes SUBROUTINE scatter(self, part) USE moduleMath USE moduleSpecies USE OMP_LIB IMPLICIT NONE - CLASS(meshVol), INTENT(inout):: self + CLASS(meshCell), INTENT(inout):: self CLASS(particle), INTENT(in):: part - REAL(8), ALLOCATABLE:: fPsi(:) - INTEGER, ALLOCATABLE:: volNodes(:) + REAL(8):: fPsi(1:self%nNodes) + INTEGER:: cellNodes(1:self%nNodes) REAL(8):: tensorS(1:3, 1:3) INTEGER:: sp - INTEGER:: i, nNodes + INTEGER:: i CLASS(meshNode), POINTER:: node - volNodes = self%getNodes() - nNodes = SIZE(volNodes) - ALLOCATE(fPsi(1:nNodes)) - CALL self%fPsi(part%xi, fPsi) + cellNodes = self%getNodes() + fPsi = self%fPsi(part%Xi) tensorS = outerProduct(part%v, part%v) sp = part%species%n - DO i = 1, nNodes - node => mesh%nodes(volNodes(i))%obj + DO i = 1, self%nNodes + node => mesh%nodes(cellNodes(i))%obj CALL OMP_SET_LOCK(node%lock) node%output(sp)%den = node%output(sp)%den + part%weight*fPsi(i) node%output(sp)%mom(:) = node%output(sp)%mom(:) + part%weight*fPsi(i)*part%v(:) @@ -524,18 +615,18 @@ MODULE moduleMesh USE OMP_LIB IMPLICIT NONE - CLASS(meshVol), INTENT(inout):: self + CLASS(meshCell), INTENT(inout):: self CLASS(particle), INTENT(inout), TARGET:: part - CLASS(meshVol), OPTIONAL, INTENT(in):: oldCell - REAL(8):: xi(1:3) + CLASS(meshCell), OPTIONAL, INTENT(in):: oldCell + REAL(8):: Xi(1:3) CLASS(meshElement), POINTER:: nextElement INTEGER:: sp - xi = self%phy2log(part%r) + Xi = self%phy2log(part%r) !Checks if particle is inside 'self' cell - IF (self%inside(xi)) THEN + IF (self%inside(Xi)) THEN part%vol = self%n - part%xi = xi + part%Xi = Xi part%n_in = .TRUE. !Assign particle to listPart_in CALL OMP_SET_LOCK(self%lock) @@ -546,10 +637,10 @@ MODULE moduleMesh ELSE !If not, searches for a neighbour and repeats the process. - CALL self%nextElement(xi, nextElement) + CALL self%nextElement(Xi, nextElement) !Defines the next step SELECT TYPE(nextElement) - CLASS IS(meshVol) + CLASS IS(meshCell) !Particle moved to new cell, repeat find procedure CALL nextElement%findCell(part, self) @@ -598,31 +689,31 @@ MODULE moduleMesh TYPE(particle), INTENT(inout):: part LOGICAL:: found - CLASS(meshVol), POINTER:: vol - REAL(8), DIMENSION(1:3):: xii + CLASS(meshCell), POINTER:: cell + REAL(8), DIMENSION(1:3):: Xi CLASS(meshElement), POINTER:: nextElement INTEGER:: sp found = .FALSE. - vol => meshColl%vols(part%volColl)%obj + cell => meshColl%cells(part%volColl)%obj DO WHILE(.NOT. found) - xii = vol%phy2log(part%r) - IF (vol%inside(xii)) THEN - part%volColl = vol%n - CALL OMP_SET_LOCK(vol%lock) + Xi = cell%phy2log(part%r) + IF (cell%inside(Xi)) THEN + part%volColl = cell%n + CALL OMP_SET_LOCK(cell%lock) sp = part%species%n - CALL vol%listPart_in(sp)%add(part) - vol%totalWeight(sp) = vol%totalWeight(sp) + part%weight - CALL OMP_UNSET_LOCK(vol%lock) + CALL cell%listPart_in(sp)%add(part) + cell%totalWeight(sp) = cell%totalWeight(sp) + part%weight + CALL OMP_UNSET_LOCK(cell%lock) found = .TRUE. ELSE - CALL vol%nextElement(xii, nextElement) + CALL cell%nextElement(Xi, nextElement) SELECT TYPE(nextElement) - CLASS IS(meshVol) + CLASS IS(meshCell) !Try next element - vol => nextElement + cell => nextElement CLASS DEFAULT !Should never happend, but just in case, stops loops @@ -647,15 +738,15 @@ MODULE moduleMesh REAL(8), DIMENSION(1:3), INTENT(in):: r INTEGER:: nVol INTEGER:: e - REAL(8), DIMENSION(1:3):: xii + REAL(8), DIMENSION(1:3):: Xi !Inits RESULT nVol = 0 - DO e = 1, self%numVols - xii = self%vols(e)%obj%phy2log(r) - IF(self%vols(e)%obj%inside(xii)) THEN - nVol = self%vols(e)%obj%n + DO e = 1, self%numCells + Xi = self%cells(e)%obj%phy2log(r) + IF(self%cells(e)%obj%inside(Xi)) THEN + nVol = self%cells(e)%obj%n EXIT END IF @@ -678,7 +769,7 @@ MODULE moduleMesh CLASS(meshGeneric), INTENT(inout), TARGET:: self INTEGER, INTENT(in):: t INTEGER:: e - CLASS(meshVol), POINTER:: vol + CLASS(meshCell), POINTER:: cell INTEGER:: k, i, j INTEGER:: nPart_i, nPart_j, nPart!Number of particles inside the cell REAL(8):: pMax !Maximum probability of collision @@ -689,21 +780,22 @@ MODULE moduleMesh REAL(8):: vRel, rMass, eRel REAL(8):: sigmaVrelTotal REAL(8), ALLOCATABLE:: sigmaVrel(:), probabilityColl(:) - REAL(8):: rnd !Random number for collision + REAL(8):: rnd_real !Random number for collision + INTEGER:: rnd_int !Random number for collision IF (MOD(t, everyColl) == 0) THEN !Collisions need to be performed in this iteration !$OMP DO SCHEDULE(DYNAMIC) PRIVATE(part_i, part_j, partTemp_i, partTemp_j) - DO e=1, self%numVols + DO e=1, self%numCells - vol => self%vols(e)%obj + cell => self%cells(e)%obj !TODO: Simplify this, to many sublevels !Iterate over the number of pairs DO k = 1, nCollPairs !Reset tally of collisions IF (collOutput) THEN - vol%tallyColl(k)%tally = 0 + cell%tallyColl(k)%tally = 0 END IF @@ -713,8 +805,8 @@ MODULE moduleMesh j = interactionMatrix(k)%sp_j%n !Number of particles per species in the collision pair - nPart_i = vol%listPart_in(i)%amount - nPart_j = vol%listPart_in(j)%amount + nPart_i = cell%listPart_in(i)%amount + nPart_j = cell%listPart_in(j)%amount IF (nPart_i > 0 .AND. nPart_j > 0) THEN !Total number of particles for the collision pair @@ -724,15 +816,15 @@ MODULE moduleMesh nColl = 0 !Probability of collision for pair i-j - pMax = (vol%totalWeight(i) + vol%totalWeight(j))*vol%sigmaVrelMax(k)*tauColl/vol%volume + pMax = (cell%totalWeight(i) + cell%totalWeight(j))*cell%sigmaVrelMax(k)*tauColl/cell%volume !Number of collisions in the cell nColl = NINT(REAL(nPart)*pMax*0.5D0) !Converts the list of particles to an array for easy access IF (nColl > 0) THEN - partTemp_i = vol%listPart_in(i)%convert2Array() - partTemp_j = vol%listPart_in(j)%convert2Array() + partTemp_i = cell%listPart_in(i)%convert2Array() + partTemp_j = cell%listPart_in(j)%convert2Array() END IF @@ -740,10 +832,10 @@ MODULE moduleMesh !Select random particles part_i => NULL() part_j => NULL() - rnd = random(1, nPart_i) - part_i => partTemp_i(rnd)%part - rnd = random(1, nPart_j) - part_j => partTemp_j(rnd)%part + rnd_int = random(1, nPart_i) + part_i => partTemp_i(rnd_int)%part + rnd_int = random(1, nPart_j) + part_j => partTemp_j(rnd_int)%part !If they are the same particle, skip !TODO: Maybe try to improve this IF (ASSOCIATED(part_i, part_j)) THEN @@ -767,32 +859,32 @@ MODULE moduleMesh CALL interactionMatrix(k)%getSigmaVrel(vRel, eRel, sigmaVrelTotal, sigmaVrel) !Update maximum sigma*v_rel - IF (sigmaVrelTotal > vol%sigmaVrelMax(k)) THEN - vol%sigmaVrelMax(k) = sigmaVrelTotal + IF (sigmaVrelTotal > cell%sigmaVrelMax(k)) THEN + cell%sigmaVrelMax(k) = sigmaVrelTotal END IF ALLOCATE(probabilityColl(0:interactionMatrix(k)%amount)) probabilityColl = 0.0 DO c = 1, interactionMatrix(k)%amount - probabilityColl(c) = sigmaVrel(c)/vol%sigmaVrelMax(k) + SUM(probabilityColl(0:c-1)) + probabilityColl(c) = sigmaVrel(c)/cell%sigmaVrelMax(k) + SUM(probabilityColl(0:c-1)) END DO !Selects random number between 0 and 1 - rnd = random() + rnd_real = random() !If the random number is below the total probability of collision, collide particles - IF (rnd < sigmaVrelTotal / vol%sigmaVrelMax(k)) THEN + IF (rnd_real < sigmaVrelTotal / cell%sigmaVrelMax(k)) THEN !Loop over collisions DO c = 1, interactionMatrix(k)%amount - IF (rnd <= probabilityColl(c)) THEN + IF (rnd_real <= probabilityColl(c)) THEN CALL interactionMatrix(k)%collisions(c)%obj%collide(part_i, part_j, vRel) !If collisions are gonna be output, count the collision IF (collOutput) THEN - vol%tallyColl(k)%tally(c) = vol%tallyColl(k)%tally(c) + 1 + cell%tallyColl(k)%tally(c) = cell%tallyColl(k)%tally(c) + 1 END IF diff --git a/src/modules/mesh/moduleMeshBoundary.f90 b/src/modules/mesh/moduleMeshBoundary.f90 index 2e15c5c..cc5d78c 100644 --- a/src/modules/mesh/moduleMeshBoundary.f90 +++ b/src/modules/mesh/moduleMeshBoundary.f90 @@ -1,4 +1,4 @@ -!moduleMeshBoundary: Boundary functions +!moduleMeshBoundary: Boundary functions for the mesh edges MODULE moduleMeshBoundary USE moduleMesh @@ -159,7 +159,7 @@ MODULE moduleMeshBoundary newElectron%vol = part%vol newIon%vol = part%vol - newElectron%xi = mesh%vols(part%vol)%obj%phy2log(newElectron%r) + newElectron%xi = mesh%cells(part%vol)%obj%phy2log(newElectron%r) newIon%xi = newElectron%xi newElectron%weight = part%weight diff --git a/src/modules/moduleCollisions.f90 b/src/modules/moduleCollisions.f90 index ba1edfd..224bfbb 100644 --- a/src/modules/moduleCollisions.f90 +++ b/src/modules/moduleCollisions.f90 @@ -439,7 +439,6 @@ MODULE moduleCollisions REAL(8), INTENT(in):: vRel TYPE(particle), INTENT(inout), TARGET:: part_i, part_j TYPE(particle), POINTER:: electron => NULL(), ion => NULL() - REAL(8):: sigmaVrel REAL(8), DIMENSION(1:3):: vp_i TYPE(particle), POINTER:: remainingIon => NULL() diff --git a/src/modules/moduleInject.f90 b/src/modules/moduleInject.f90 index 6b8c7a0..050ad52 100644 --- a/src/modules/moduleInject.f90 +++ b/src/modules/moduleInject.f90 @@ -132,7 +132,7 @@ MODULE moduleInject IF (doubleMesh) THEN nVolColl = findCellBrute(meshColl, mesh%edges(e)%obj%randPos()) IF (nVolColl > 0) THEN - mesh%edges(e)%obj%eColl => meshColl%vols(nVolColl)%obj + mesh%edges(e)%obj%eColl => meshColl%cells(nVolColl)%obj ELSE CALL criticalError("No connection between edge and meshColl", "initInject") @@ -305,7 +305,7 @@ MODULE moduleInject self%v(3)%obj%randomVel() /) !Obtain natural coordinates of particle in cell - partInj(n)%xi = mesh%vols(partInj(n)%vol)%obj%phy2log(partInj(n)%r) + partInj(n)%Xi = mesh%cells(partInj(n)%vol)%obj%phy2log(partInj(n)%r) !Push new particle with the minimum time step CALL solver%pusher(sp)%pushParticle(partInj(n), tau(sp)) !Assign cell to new particle diff --git a/src/modules/solver/electromagnetic/moduleEM.f90 b/src/modules/solver/electromagnetic/moduleEM.f90 index ae73ebc..55eb618 100644 --- a/src/modules/solver/electromagnetic/moduleEM.f90 +++ b/src/modules/solver/electromagnetic/moduleEM.f90 @@ -46,40 +46,6 @@ MODULE moduleEM END SUBROUTINE - PURE FUNCTION gatherElecField(part) RESULT(elField) - USE moduleSpecies - USE moduleMesh - IMPLICIT NONE - - TYPE(particle), INTENT(in):: part - REAl(8):: xi(1:3) !Logical coordinates of particle in element - REAL(8):: elField(1:3) - - elField = 0.D0 - - xi = part%xi - - elField = mesh%vols(part%vol)%obj%gatherEF(xi) - - END FUNCTION gatherElecField - - PURE FUNCTION gatherMagnField(part) RESULT(BField) - USE moduleSpecies - USE moduleMesh - IMPLICIT NONE - - TYPE(particle), INTENT(in):: part - REAl(8):: xi(1:3) !Logical coordinates of particle in element - REAL(8):: BField(1:3) - - BField = 0.D0 - - xi = part%xi - - BField = mesh%vols(part%vol)%obj%gatherMF(xi) - - END FUNCTION gatherMagnField - !Assemble the source vector based on the charge density to solve Poisson's equation SUBROUTINE assembleSourceVector(vectorF) USE moduleMesh @@ -99,8 +65,8 @@ MODULE moduleEM !$OMP END SINGLE !$OMP DO REDUCTION(+:vectorF) - DO e = 1, mesh%numVols - nodes = mesh%vols(e)%obj%getNodes() + DO e = 1, mesh%numCells + nodes = mesh%cells(e)%obj%getNodes() nNodes = SIZE(nodes) !Calculates charge density (rho) in element nodes ALLOCATE(rho(1:nNodes)) @@ -113,7 +79,7 @@ MODULE moduleEM END DO !Calculates local F vector - localF = mesh%vols(e)%obj%elemF(rho) + localF = mesh%cells(e)%obj%elemF(rho) !Assign local F to global F DO i = 1, nNodes diff --git a/src/modules/solver/moduleSolver.f90 b/src/modules/solver/moduleSolver.f90 index 135b08f..6962075 100644 --- a/src/modules/solver/moduleSolver.f90 +++ b/src/modules/solver/moduleSolver.f90 @@ -49,8 +49,8 @@ MODULE moduleSolver IMPLICIT NONE TYPE(particle), INTENT(inout):: part - CLASS(meshVol), POINTER, INTENT(in):: volOld - CLASS(meshVol), POINTER, INTENT(inout):: volNew + CLASS(meshCell), POINTER, INTENT(in):: volOld + CLASS(meshCell), POINTER, INTENT(inout):: volNew END SUBROUTINE weightingScheme_interface @@ -314,10 +314,10 @@ MODULE moduleSolver !$OMP SECTION !Erase the list of particles inside the cell if particles have been pushed DO s = 1, nSpecies - DO e = 1, mesh%numVols + DO e = 1, mesh%numCells IF (solver%pusher(s)%pushSpecies) THEN - CALL mesh%vols(e)%obj%listPart_in(s)%erase() - mesh%vols(e)%obj%totalWeight(s) = 0.D0 + CALL mesh%cells(e)%obj%listPart_in(s)%erase() + mesh%cells(e)%obj%totalWeight(s) = 0.D0 END IF @@ -328,10 +328,10 @@ MODULE moduleSolver !$OMP SECTION !Erase the list of particles inside the cell in coll mesh DO s = 1, nSpecies - DO e = 1, meshColl%numVols + DO e = 1, meshColl%numCells IF (solver%pusher(s)%pushSpecies) THEN - CALL meshColl%vols(e)%obj%listPart_in(s)%erase() - meshColl%vols(e)%obj%totalWeight(s) = 0.D0 + CALL meshColl%cells(e)%obj%listPart_in(s)%erase() + meshColl%cells(e)%obj%totalWeight(s) = 0.D0 END IF @@ -358,7 +358,7 @@ MODULE moduleSolver !Loops over the particles to scatter them !$OMP DO DO n = 1, nPartOld - CALL mesh%vols(partOld(n)%vol)%obj%scatter(partOld(n)) + CALL mesh%cells(partOld(n)%vol)%obj%scatter(partOld(n)) END DO !$OMP END DO @@ -383,8 +383,8 @@ MODULE moduleSolver IMPLICIT NONE TYPE(particle), INTENT(inout):: part - CLASS(meshVol), POINTER, INTENT(in):: volOld - CLASS(meshVol), POINTER, INTENT(inout):: volNew + CLASS(meshCell), POINTER, INTENT(in):: volOld + CLASS(meshCell), POINTER, INTENT(inout):: volNew REAL(8):: fractionVolume, pSplit !If particle changes volume to smaller cell @@ -416,7 +416,7 @@ MODULE moduleSolver TYPE(particle), INTENT(inout):: part INTEGER, INTENT(in):: nSplit - CLASS(meshVol), INTENT(inout):: vol + CLASS(meshCell), INTENT(inout):: vol REAL(8):: newWeight TYPE(particle), POINTER:: newPart INTEGER:: p @@ -454,15 +454,15 @@ MODULE moduleSolver CLASS(solverGeneric), INTENT(in):: self TYPE(particle), INTENT(inout):: part - CLASS(meshVol), POINTER:: volOld, volNew + CLASS(meshCell), POINTER:: volOld, volNew !Assume that particle is outside the domain part%n_in = .FALSE. - volOld => mesh%vols(part%vol)%obj + volOld => mesh%cells(part%vol)%obj CALL volOld%findCell(part) CALL findCellColl(part) - volNew => mesh%vols(part%vol)%obj + volNew => mesh%cells(part%vol)%obj !Call the NA shcme IF (ASSOCIATED(self%weightingScheme)) THEN CALL self%weightingScheme(part, volOld, volNew) diff --git a/src/modules/solver/pusher/modulePusher.f90 b/src/modules/solver/pusher/modulePusher.f90 index 69fcaab..c2aa46a 100644 --- a/src/modules/solver/pusher/modulePusher.f90 +++ b/src/modules/solver/pusher/modulePusher.f90 @@ -15,7 +15,7 @@ MODULE modulePusher PURE SUBROUTINE pushCartElectrostatic(part, tauIn) USE moduleSPecies - USE moduleEM + USE moduleMesh IMPLICIT NONE TYPE(particle), INTENT(inout):: part @@ -23,7 +23,8 @@ MODULE modulePusher REAL(8):: qmEFt(1:3) !Get the electric field at particle position - qmEFt = part%species%qm*gatherElecField(part)*tauIn + qmEFT = mesh%cells(part%vol)%obj%gatherElectricField(part%Xi) + qmEFt = qmEFt*part%species%qm*tauMin !Update velocity part%v = part%v + qmEFt @@ -34,8 +35,8 @@ MODULE modulePusher END SUBROUTINE pushCartElectrostatic PURE SUBROUTINE pushCartElectromagnetic(part, tauIn) - USE moduleSPecies - USE moduleEM + USE moduleSpecies + USE moduleMesh USE moduleMath IMPLICIT NONE @@ -49,13 +50,14 @@ MODULE modulePusher tauInHalf = tauIn *0.5D0 !Half of the force o f the electric field - qmEFt = part%species%qm*gatherElecField(part)*tauInHalf + qmEFT = mesh%cells(part%vol)%obj%gatherElectricField(part%Xi) + qmEFt = qmEFt*part%species%qm*tauInHalf !Half step for electrostatic v_minus = part%v + qmEFt !Full step rotation - B = gatherMagnField(part) + B = mesh%cells(part%vol)%obj%gatherMagneticField(part%Xi) BNorm = NORM2(B) IF (BNorm > 0.D0) THEN fn = DTAN(part%species%qm * tauInHalf*BNorm) / BNorm @@ -112,7 +114,7 @@ MODULE modulePusher !Push one particle. Boris pusher for 2D Cyl Electrostatic particle PURE SUBROUTINE push2DCylElectrostatic(part, tauIn) USE moduleSpecies - USE moduleEM + USE moduleMesh IMPLICIT NONE TYPE(particle), INTENT(inout):: part @@ -124,7 +126,8 @@ MODULE modulePusher part_temp = part !Get electric field at particle position - qmEFt = part_temp%species%qm*gatherElecField(part_temp)*tauIn + qmEFT = mesh%cells(part_temp%vol)%obj%gatherElectricField(part_temp%Xi) + qmEFt = qmEFt*part_temp%species%qm*tauMin !z part_temp%v(1) = part%v(1) + qmEFt(1) part_temp%r(1) = part%r(1) + part_temp%v(1)*tauIn @@ -153,7 +156,6 @@ MODULE modulePusher !Push one particle. Boris pusher for 1D Radial Neutral particle PURE SUBROUTINE push1DRadNeutral(part, tauIn) USE moduleSpecies - USE moduleEM IMPLICIT NONE TYPE(particle), INTENT(inout):: part @@ -188,7 +190,7 @@ MODULE modulePusher !Push one particle. Boris pusher for 1D Radial Electrostatic particle PURE SUBROUTINE push1DRadElectrostatic(part, tauIn) USE moduleSpecies - USE moduleEM + USE moduleMesh IMPLICIT NONE TYPE(particle), INTENT(inout):: part @@ -200,7 +202,8 @@ MODULE modulePusher part_temp = part !Get electric field at particle position - qmEFt = part_temp%species%qm*gatherElecField(part_temp)*tauMin + qmEFT = mesh%cells(part_temp%vol)%obj%gatherElectricField(part_temp%Xi) + qmEFt = qmEFt*part_temp%species%qm*tauMin !r,theta v_p_oh_star(1) = part%v(1) + qmEFt(1) x_new = part%r(1) + v_p_oh_star(1)*tauIn @@ -226,7 +229,6 @@ MODULE modulePusher !Dummy pusher for 0D geometry PURE SUBROUTINE push0D(part, tauIn) USE moduleSpecies - USE moduleEM IMPLICIT NONE TYPE(particle), INTENT(inout):: part From 26bd73597dacfb93332a93f55f08c2cbdfea8f6e Mon Sep 17 00:00:00 2001 From: JGonzalez Date: Thu, 5 Jan 2023 18:47:33 +0100 Subject: [PATCH 03/13] Small improvement for 2DCyl Nothing important, but overhead in dPsi has been reduced. --- src/modules/mesh/2DCart/moduleMesh2DCart.f90 | 199 +++++++----------- src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 | 203 +++++++------------ 2 files changed, 153 insertions(+), 249 deletions(-) diff --git a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 index 13c5901..e7c6e6f 100644 --- a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 +++ b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 @@ -65,14 +65,13 @@ MODULE moduleMesh2DCart !Connectivity to adjacent elements CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL(), e3 => NULL(), e4 => NULL() 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, NOPASS, PRIVATE:: dPsiXi1 => dPsiQuadXi1 - PROCEDURE, NOPASS, PRIVATE:: dPsiXi2 => dPsiQuadXi2 + PROCEDURE, PASS:: fPsi => fPsiQuad + PROCEDURE, PASS:: dPsi => dPsiQuad PROCEDURE, PASS, PRIVATE:: partialDer => partialDerQuad PROCEDURE, PASS:: elemK => elemKQuad PROCEDURE, PASS:: elemF => elemFQuad @@ -99,11 +98,9 @@ MODULE moduleMesh2DCart PROCEDURE, PASS:: init => initCellTria2DCart PROCEDURE, PASS:: randPos => randPosCellTria PROCEDURE, PASS:: area => areaTria - PROCEDURE, PASS:: fPsi => fPsiTria - PROCEDURE, PASS:: dPsi => dPsiTria - PROCEDURE, NOPASS:: dPsiXi1 => dPsiTriaXi1 - PROCEDURE, NOPASS:: dPsiXi2 => dPsiTriaXi2 - PROCEDURE, PASS:: partialDer => partialDerTria + 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 @@ -196,28 +193,6 @@ MODULE moduleMesh2DCart END SUBROUTINE initEdge2DCart - !Random position in quadrilateral volume - FUNCTION randPosCellQuad(self) RESULT(r) - USE moduleRandom - IMPLICIT NONE - - CLASS(meshCell2DCartQuad), INTENT(in):: self - REAL(8):: r(1:3) - REAL(8):: Xi(1:3) - REAL(8):: fPsi(1:4) - - Xi(1) = random(-1.D0, 1.D0) - Xi(2) = random(-1.D0, 1.D0) - Xi(3) = 0.D0 - - fPsi = self%fPsi(Xi) - - r(1) = DOT_PRODUCT(fPsi, self%x) - r(2) = DOT_PRODUCT(fPsi, self%y) - r(3) = 0.D0 - - END FUNCTION randposCellQuad - !Get nodes from edge PURE FUNCTION getNodes2DCart(self) RESULT(n) IMPLICIT NONE @@ -225,6 +200,7 @@ MODULE moduleMesh2DCart CLASS(meshEdge2DCart), INTENT(in):: self INTEGER, ALLOCATABLE:: n(:) + ALLOCATE(n(1:2)) n = (/self%n1%n, self%n2%n /) END FUNCTION getNodes2DCart @@ -354,41 +330,21 @@ MODULE moduleMesh2DCart dPsi = 0.D0 - dPsi(1,:) = dPsiQuadXi1(Xi(2)) - dPsi(2,:) = dPsiQuadXi2(Xi(1)) + 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 - !Derivative element function (Xi1) - PURE FUNCTION dPsiQuadXi1(Xi2) RESULT(dPsiXi1) - IMPLICIT NONE - - REAL(8),INTENT(in):: Xi2 - REAL(8):: dPsiXi1(1:4) - - dPsiXi1(1) = -(1.D0-Xi2) - dPsiXi1(2) = (1.D0-Xi2) - dPsiXi1(3) = (1.D0+Xi2) - dPsiXi1(4) = -(1.D0+Xi2) - dPsiXi1 = dPsiXi1*0.25D0 - - END FUNCTION dPsiQuadXi1 - - !Derivative element function (Xi2) - PURE FUNCTION dPsiQuadXi2(Xi1) RESULT(dPsiXi2) - IMPLICIT NONE - - REAL(8),INTENT(in):: Xi1 - REAL(8):: dPsiXi2(1:4) - - dPsiXi2(1) = -(1.D0-Xi1) - dPsiXi2(2) = -(1.D0+Xi1) - dPsiXi2(3) = (1.D0+Xi1) - dPsiXi2(4) = (1.D0-Xi1) - dPsiXi2 = dPsiXi2*0.25D0 - - END FUNCTION dPsiQuadXi2 - + !Partial derivative in global coordinates PURE SUBROUTINE partialDerQuad(self, dPsi, dx, dy) IMPLICIT NONE @@ -396,13 +352,35 @@ MODULE moduleMesh2DCart REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy - dx(1) = DOT_PRODUCT(dPsi(1,:),self%x) - dx(2) = DOT_PRODUCT(dPsi(2,:),self%x) - dy(1) = DOT_PRODUCT(dPsi(1,:),self%y) - dy(2) = DOT_PRODUCT(dPsi(2,:),self%y) + 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)) /) END SUBROUTINE partialDerQuad + !Random position in quadrilateral volume + FUNCTION randPosCellQuad(self) RESULT(r) + USE moduleRandom + IMPLICIT NONE + + CLASS(meshCell2DCartQuad), INTENT(in):: self + REAL(8):: r(1:3) + REAL(8):: Xi(1:3) + REAL(8):: fPsi(1:4) + + Xi(1) = random(-1.D0, 1.D0) + Xi(2) = random(-1.D0, 1.D0) + Xi(3) = 0.D0 + + fPsi = self%fPsi(Xi) + + 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) RESULT(localK) IMPLICIT NONE @@ -419,14 +397,15 @@ MODULE moduleMesh2DCart !Start 2D Gauss Quad Integral DO l=1, 3 Xi(2) = corQuad(l) - dPsi(1,:) = self%dPsiXi1(Xi(2)) DO m = 1, 3 - Xi(1) = corQuad(m) - dPsi(2,:) = self%dPsiXi2(Xi(1)) - fPsi = self%fPsi(Xi) - detJ = self%detJac(Xi,dPsi) - invJ = self%invJac(Xi,dPsi) - localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*wQuad(l)*wQuad(m)/detJ + Xi(1) = corQuad(m) + fPsi = self%fPsi(Xi) + dPsi = self%dPsi(Xi) + detJ = self%detJac(Xi,dPsi) + invJ = self%invJac(Xi,dPsi) + localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)), & + MATMUL(invJ,dPsi))* & + wQuad(l)*wQuad(m)/detJ END DO END DO @@ -533,24 +512,25 @@ MODULE moduleMesh2DCart CLASS(meshCell2DCartQuad), INTENT(in):: self REAL(8), INTENT(in):: r(1:3) REAL(8):: Xi(1:3) - REAL(8):: XiO(1:3), detJ, invJ(1:2,1:2), f(1:2) + 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):: conv !Iterative newton method to transform coordinates - conv=1.D0 - XiO=0.D0 + conv = 1.D0 + XiO = 0.D0 - DO WHILE(conv>1.D-3) + DO WHILE(conv > 1.D-3) dPsi = self%dPsi(XiO) invJ = self%invJac(XiO, dPsi) fPsi = self%fPsi(XiO) - f(1) = DOT_PRODUCT(fPsi,self%x)-r(1) - f(2) = DOT_PRODUCT(fPsi,self%y)-r(2) - detJ = self%detJac(XiO,dPsi) - Xi(1:2)=XiO(1:2) - MATMUL(invJ, f)/detJ - conv=MAXVAL(DABS(Xi-XiO),1) - XiO=Xi + f = (/ DOT_PRODUCT(fPsi,self%x), & + DOT_PRODUCT(fPsi,self%y), & + 0.D0 /) + f = f - r + Xi = XiO - MATMUL(invJ, f)/detJ + conv = MAXVAL(DABS(Xi-XiO),1) + XiO = Xi END DO @@ -644,7 +624,7 @@ MODULE moduleMesh2DCart r(2) = DOT_PRODUCT(fPsi, self%y) r(3) = 0.D0 - END FUNCTION randposCellTria + END FUNCTION randPosCellTria !Calculates area for triangular element PURE SUBROUTINE areaTria(self) @@ -690,37 +670,11 @@ MODULE moduleMesh2DCart dPsi = 0.D0 - dPsi(1,:) = dPsiTriaXi1(Xi(2)) - dPsi(2,:) = dPsiTriaXi2(Xi(1)) + dPsi(1,:) = (/ -1.D0, 1.D0, 0.D0 /) + dPsi(2,:) = (/ -1.D0, 0.D0, 1.D0 /) END FUNCTION dPsiTria - !Derivative element function (Xi1) - PURE FUNCTION dPsiTriaXi1(Xi2) RESULT(dPsiXi1) - IMPLICIT NONE - - REAL(8), INTENT(in):: Xi2 - REAL(8):: dPsiXi1(1:3) - - dPsiXi1(1) = -1.D0 - dPsiXi1(2) = 1.D0 - dPsiXi1(3) = 0.D0 - - END FUNCTION dPsiTriaXi1 - - !Derivative element function (Xi1) - PURE FUNCTION dPsiTriaXi2(Xi1) RESULT(dPsiXi2) - IMPLICIT NONE - - REAL(8), INTENT(in):: Xi1 - REAL(8):: dPsiXi2(1:3) - - dPsiXi2(1) = -1.D0 - dPsiXi2(2) = 0.D0 - dPsiXi2(3) = 1.D0 - - END FUNCTION dPsiTriaXi2 - PURE SUBROUTINE partialDerTria(self, dPsi, dx, dy) IMPLICIT NONE @@ -728,10 +682,10 @@ MODULE moduleMesh2DCart REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy - dx(1) = DOT_PRODUCT(dPsi(1,:),self%x) - dx(2) = DOT_PRODUCT(dPsi(2,:),self%x) - dy(1) = DOT_PRODUCT(dPsi(1,:),self%y) - dy(2) = DOT_PRODUCT(dPsi(2,:),self%y) + 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) /) END SUBROUTINE partialDerTria @@ -755,7 +709,7 @@ MODULE moduleMesh2DCart dPsi = self%dPsi(Xi) detJ = self%detJac(Xi,dPsi) invJ = self%invJac(Xi,dPsi) - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi) localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*wTria(l)/detJ END DO @@ -781,7 +735,7 @@ MODULE moduleMesh2DCart Xi(1) = Xi1Tria(l) Xi(2) = Xi2Tria(l) detJ = self%detJac(Xi) - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi) f = DOT_PRODUCT(fPsi,source) localF = localF + f*fPsi*wTria(l)*detJ @@ -902,8 +856,8 @@ MODULE moduleMesh2DCart CLASS(meshCell2DCart), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) - REAL(8):: dPsi(1:3,1:self%nNodes) REAL(8):: dJ + REAL(8):: dPsi(1:3,1:self%nNodes) REAL(8):: dx(1:2), dy(1:2) IF(PRESENT(dPsi_in)) THEN @@ -915,6 +869,7 @@ MODULE moduleMesh2DCart END IF CALL self%partialDer(dPsi, dx, dy) + dJ = dx(1)*dy(2)-dx(2)*dy(1) END FUNCTION detJ2DCart @@ -926,9 +881,9 @@ MODULE moduleMesh2DCart CLASS(meshCell2DCart), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + REAL(8):: invJ(1:3,1:3) REAL(8):: dPsi(1:3,1:self%nNodes) REAL(8):: dx(1:2), dy(1:2) - REAL(8):: invJ(1:3,1:3) IF(PRESENT(dPsi_in)) THEN dPsi=dPsi_in @@ -1351,7 +1306,7 @@ MODULE moduleMesh2DCart !Revers the normal to point inside the domain elemB%normal = - elemB%normal - + END IF END IF diff --git a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 index 9032d61..6a47027 100644 --- a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 +++ b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 @@ -68,12 +68,10 @@ MODULE moduleMesh2DCyl CONTAINS PROCEDURE, PASS:: init => initCellQuad2DCyl - PROCEDURE, PASS:: randPos => randPosVolQuad + PROCEDURE, PASS:: randPos => randPosCellQuad PROCEDURE, PASS:: area => areaQuad PROCEDURE, PASS:: fPsi => fPsiQuad PROCEDURE, PASS:: dPsi => dPsiQuad - PROCEDURE, NOPASS, PRIVATE:: dPsiXi1 => dPsiQuadXi1 - PROCEDURE, NOPASS, PRIVATE:: dPsiXi2 => dPsiQuadXi2 PROCEDURE, PASS, PRIVATE:: partialDer => partialDerQuad PROCEDURE, PASS:: elemK => elemKQuad PROCEDURE, PASS:: elemF => elemFQuad @@ -98,12 +96,10 @@ MODULE moduleMesh2DCyl CONTAINS PROCEDURE, PASS:: init => initCellTria2DCyl - PROCEDURE, PASS:: randPos => randPosVolTria + PROCEDURE, PASS:: randPos => randPosCellTria PROCEDURE, PASS:: area => areaTria PROCEDURE, PASS:: fPsi => fPsiTria PROCEDURE, PASS:: dPsi => dPsiTria - PROCEDURE, NOPASS:: dPsiXi1 => dPsiTriaXi1 - PROCEDURE, NOPASS:: dPsiXi2 => dPsiTriaXi2 PROCEDURE, PASS, PRIVATE:: partialDer => partialDerTria PROCEDURE, PASS:: elemK => elemKTria PROCEDURE, PASS:: elemF => elemFTria @@ -183,6 +179,7 @@ MODULE moduleMesh2DCyl self%z(2)-self%z(1) , & 0.D0 /) self%normal = self%normal/NORM2(self%normal) + !Boundary index self%boundary => boundary(bt) ALLOCATE(self%fboundary(1:nSpecies)) @@ -210,7 +207,6 @@ MODULE moduleMesh2DCyl END FUNCTION getNodes2DCyl PURE FUNCTION intersection2DCylEdge(self, r0) RESULT(r) - USE moduleMath IMPLICIT NONE CLASS(meshEdge2DCyl), INTENT(in):: self @@ -317,20 +313,16 @@ MODULE moduleMesh2DCyl self%volume = r*detJ !Computes volume per node Xi = (/-5.D-1, -5.D-1, 0.D0/) - fPsi_node = self%fPsi(Xi) - r = DOT_PRODUCT(fPsi_node,self%r) + r = self%gatherF(Xi, self%r) self%arNodes(1) = fPsi(1)*r*detJ Xi = (/ 5.D-1, -5.D-1, 0.D0/) - fPsi_node = self%fPsi(Xi) - r = DOT_PRODUCT(fPsi_node,self%r) + r = self%gatherF(Xi, self%r) self%arNodes(2) = fPsi(2)*r*detJ Xi = (/ 5.D-1, 5.D-1, 0.D0/) - fPsi_node = self%fPsi(Xi) - r = DOT_PRODUCT(fPsi_node,self%r) + r = self%gatherF(Xi, self%r) self%arNodes(3) = fPsi(3)*r*detJ Xi = (/-5.D-1, 5.D-1, 0.D0/) - fPsi_node = self%fPsi(Xi) - r = DOT_PRODUCT(fPsi_node,self%r) + r = self%gatherF(Xi, self%r) self%arNodes(4) = fPsi(4)*r*detJ END SUBROUTINE areaQuad @@ -362,43 +354,20 @@ MODULE moduleMesh2DCyl dPsi = 0.D0 - dPsi(1,:) = dPsiQuadXi1(Xi(2)) - dPsi(2,:) = dPsiQuadXi2(Xi(1)) + 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 - !Derivative element function (Xi1) - PURE FUNCTION dPsiQuadXi1(Xi2) RESULT(dPsiXi1) - IMPLICIT NONE - - REAL(8),INTENT(in):: Xi2 - REAL(8):: dPsiXi1(1:4) - - dPsiXi1(1) = -(1.D0 - Xi2) - dPsiXi1(2) = (1.D0 - Xi2) - dPsiXi1(3) = (1.D0 + Xi2) - dPsiXi1(4) = -(1.D0 + Xi2) - - dPsiXi1 = dPsiXi1*0.25D0 - - END FUNCTION dPsiQuadXi1 - - !Derivative element function (Xi2) - PURE FUNCTION dPsiQuadXi2(Xi1) RESULT(dPsiXi2) - IMPLICIT NONE - - REAL(8),INTENT(in):: Xi1 - REAL(8):: dPsiXi2(1:4) - - dPsiXi2(1) = -(1.D0 - Xi1) - dPsiXi2(2) = -(1.D0 + Xi1) - dPsiXi2(3) = (1.D0 + Xi1) - dPsiXi2(4) = (1.D0 - Xi1) - - dPsiXi2 = dPsiXi2 * 0.25D0 - - END FUNCTION dPsiQuadXi2 - !Partial derivative in global coordinates PURE SUBROUTINE partialDerQuad(self, dPsi, dz, dr) IMPLICIT NONE @@ -407,15 +376,15 @@ MODULE moduleMesh2DCyl REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) REAL(8), INTENT(out), DIMENSION(1:2):: dz, dr - dz(1) = DOT_PRODUCT(dPsi(1,:),self%z) - dz(2) = DOT_PRODUCT(dPsi(2,:),self%z) - dr(1) = DOT_PRODUCT(dPsi(1,:),self%r) - dr(2) = DOT_PRODUCT(dPsi(2,:),self%r) + dz = (/ DOT_PRODUCT(dPsi(1,1:4),self%z(1:4)), & + DOT_PRODUCT(dPsi(2,1:4),self%z(1:4)) /) + dr = (/ DOT_PRODUCT(dPsi(1,1:4),self%r(1:4)), & + DOT_PRODUCT(dPsi(2,1:4),self%r(1:4)) /) END SUBROUTINE partialDerQuad !Random position in quadrilateral volume - FUNCTION randPosVolQuad(self) RESULT(r) + FUNCTION randPosCellQuad(self) RESULT(r) USE moduleRandom IMPLICIT NONE @@ -434,7 +403,7 @@ MODULE moduleMesh2DCyl r(2) = DOT_PRODUCT(fPsi, self%r) r(3) = 0.D0 - END FUNCTION randposVolQuad + END FUNCTION randPosCellQuad !Computes element local stiffness matrix PURE FUNCTION elemKQuad(self) RESULT(localK) @@ -443,8 +412,9 @@ MODULE moduleMesh2DCyl CLASS(meshCell2DCylQuad), INTENT(in):: self REAL(8):: localK(1:self%nNodes,1:self%nNodes) - REAL(8):: r, Xi(1:3) + REAL(8):: Xi(1:3) REAL(8):: fPsi(1:4), dPsi(1:3,1:4) + REAL(8):: r REAL(8):: invJ(1:3,1:3), detJ INTEGER:: l, m @@ -453,17 +423,16 @@ MODULE moduleMesh2DCyl !Start 2D Gauss Quad Integral DO l=1, 3 Xi(2) = corQuad(l) - dPsi(1,:) = self%dPsiXi1(Xi(2)) DO m = 1, 3 - Xi(1) = corQuad(m) - dPsi(2,:) = self%dPsiXi2(Xi(1)) - fPsi = self%fPsi(Xi) - detJ = self%detJac(Xi,dPsi) - invJ = self%invJac(Xi,dPsi) - r = DOT_PRODUCT(fPsi,self%r) - localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)), & - MATMUL(invJ,dPsi))* & - r*wQuad(l)*wQuad(m)/detJ + Xi(1) = corQuad(m) + fPsi = self%fPsi(Xi) + dPsi = self%dPsi(Xi) + detJ = self%detJac(Xi,dPsi) + invJ = self%invJac(Xi,dPsi) + r = DOT_PRODUCT(fPsi,self%r) + localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)), & + MATMUL(invJ,dPsi))* & + r*wQuad(l)*wQuad(m)/detJ END DO END DO @@ -479,8 +448,9 @@ MODULE moduleMesh2DCyl CLASS(meshCell2DCylQuad), INTENT(in):: self REAL(8), INTENT(in):: source(1:self%nNodes) REAL(8):: localF(1:self%nNodes) - REAL(8):: r, Xi(1:3) + REAL(8):: Xi(1:3) REAL(8):: fPsi(1:4) + REAL(8):: r REAL(8):: detJ, f INTEGER:: l, m @@ -574,23 +544,24 @@ MODULE moduleMesh2DCyl CLASS(meshCell2DCylQuad), INTENT(in):: self REAL(8), INTENT(in):: r(1:3) REAL(8):: Xi(1:3) - REAL(8):: XiO(1:3), detJ, invJ(1:2,1:2), f(1:2) + 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):: conv !Iterative newton method to transform coordinates - conv=1.D0 - XiO=0.D0 + conv = 1.D0 + XiO = 0.D0 - DO WHILE(conv>1.D-3) + DO WHILE(conv > 1.D-3) dPsi = self%dPsi(XiO) invJ = self%invJac(XiO, dPsi) detJ = self%detJac(XiO, dPsi) fPsi = self%fPsi(XiO) f = (/ DOT_PRODUCT(fPsi,self%z), & - DOT_PRODUCT(fPsi,self%r) /) - f = f - r(1:2) - Xi(1:2) = XiO(1:2) - MATMUL(invJ, f)/detJ + DOT_PRODUCT(fPsi,self%r), & + 0.D0 /) + f = f - r + Xi = XiO - MATMUL(invJ, f)/detJ conv = MAXVAL(DABS(Xi-XiO),1) XiO = Xi @@ -667,7 +638,7 @@ MODULE moduleMesh2DCyl END SUBROUTINE initCellTria2DCyl !Random position in quadrilateral volume - FUNCTION randPosVolTria(self) RESULT(r) + FUNCTION randPosCellTria(self) RESULT(r) USE moduleRandom IMPLICIT NONE @@ -686,7 +657,7 @@ MODULE moduleMesh2DCyl r(2) = DOT_PRODUCT(fPsi, self%r) r(3) = 0.D0 - END FUNCTION randposVolTria + END FUNCTION randPosCellTria !Calculates area for triangular element PURE SUBROUTINE areaTria(self) @@ -694,7 +665,8 @@ MODULE moduleMesh2DCyl IMPLICIT NONE CLASS(meshCell2DCylTria), INTENT(inout):: self - REAL(8):: r, Xi(1:3) + REAL(8):: Xi(1:3) + REAL(8):: r REAL(8):: detJ REAL(8):: fPsi(1:3) @@ -736,37 +708,11 @@ MODULE moduleMesh2DCyl dPsi = 0.D0 - dPsi(1,:) = dPsiTriaXi1(Xi(2)) - dPsi(2,:) = dPsiTriaXi2(Xi(1)) + dPsi(1,:) = (/ -1.D0, 1.D0, 0.D0 /) + dPsi(2,:) = (/ -1.D0, 0.D0, 1.D0 /) END FUNCTION dPsiTria - !Derivative element function (Xi1) - PURE FUNCTION dPsiTriaXi1(Xi2) RESULT(dPsiXi1) - IMPLICIT NONE - - REAL(8), INTENT(in):: Xi2 - REAL(8):: dPsiXi1(1:3) - - dPsiXi1(1) = -1.D0 - dPsiXi1(2) = 1.D0 - dPsiXi1(3) = 0.D0 - - END FUNCTION dPsiTriaXi1 - - !Derivative element function (Xi1) - PURE FUNCTION dPsiTriaXi2(Xi1) RESULT(dPsiXi2) - IMPLICIT NONE - - REAL(8), INTENT(in):: Xi1 - REAL(8):: dPsiXi2(1:3) - - dPsiXi2(1) = -1.D0 - dPsiXi2(2) = 0.D0 - dPsiXi2(3) = 1.D0 - - END FUNCTION dPsiTriaXi2 - PURE SUBROUTINE partialDerTria(self, dPsi, dz, dr) IMPLICIT NONE @@ -774,10 +720,10 @@ MODULE moduleMesh2DCyl REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) REAL(8), INTENT(out), DIMENSION(1:2):: dz, dr - dz(1) = DOT_PRODUCT(dPsi(1,:),self%z) - dz(2) = DOT_PRODUCT(dPsi(2,:),self%z) - dr(1) = DOT_PRODUCT(dPsi(1,:),self%r) - dr(2) = DOT_PRODUCT(dPsi(2,:),self%r) + dz = (/ DOT_PRODUCT(dPsi(1,:),self%z), & + DOT_PRODUCT(dPsi(2,:),self%z) /) + dr = (/ DOT_PRODUCT(dPsi(1,:),self%r), & + DOT_PRODUCT(dPsi(2,:),self%r) /) END SUBROUTINE partialDerTria @@ -788,7 +734,8 @@ MODULE moduleMesh2DCyl CLASS(meshCell2DCylTria), INTENT(in):: self REAL(8):: localK(1:self%nNodes,1:self%nNodes) - REAL(8):: r, Xi(1:3) + REAL(8):: Xi(1:3) + REAL(8):: r REAL(8):: fPsi(1:3), dPsi(1:3,1:3) REAL(8):: invJ(1:3,1:3), detJ INTEGER:: l @@ -820,7 +767,8 @@ MODULE moduleMesh2DCyl REAL(8), INTENT(in):: source(1:self%nNodes) REAL(8):: localF(1:self%nNodes) REAL(8):: fPsi(1:3) - REAL(8):: r, Xi(1:3) + REAL(8):: Xi(1:3) + REAL(8):: r REAL(8):: detJ, f INTEGER:: l @@ -909,17 +857,17 @@ MODULE moduleMesh2DCyl CLASS(meshCell2DCylTria), INTENT(in):: self REAL(8), INTENT(in):: r(1:3) REAL(8):: Xi(1:3) - REAL(8):: invJ(1:2,1:2), detJ - REAL(8):: deltaR(1:2) + REAL(8):: invJ(1:3,1:3), detJ + REAL(8):: deltaR(1:3) REAL(8):: dPsi(1:3,1:3) !Direct method to convert coordinates - Xi = 0.D0 !Irrelevant, required for input - deltaR = (/ r(1) - self%z(1), r(2) - self%r(1) /) - dPsi = self%dPsi(Xi) - invJ = self%invJac(Xi, dPsi) - detJ = self%detJac(Xi, dPsi) - Xi(1:2) = MATMUL(invJ,deltaR)/detJ + Xi = 0.D0 + deltaR = (/ r(1) - self%z(1), r(2) - self%r(1), 0.D0 /) + dPsi = self%dPsi(Xi) + invJ = self%invJac(Xi, dPsi) + detJ = self%detJac(Xi, dPsi) + Xi = MATMUL(invJ,deltaR)/detJ END FUNCTION phy2logTria @@ -967,6 +915,7 @@ MODULE moduleMesh2DCyl END IF CALL self%partialDer(dPsi, dz, dr) + dJ = dz(1)*dr(2)-dz(2)*dr(1) END FUNCTION detJ2DCyl @@ -1006,10 +955,10 @@ MODULE moduleMesh2DCyl INTEGER:: e, et DO e = 1, self%numCells - !Connect Vol-Vol + !Connect Cell-Cell DO et = 1, self%numCells IF (e /= et) THEN - CALL connectVolVol(self%cells(e)%obj, self%cells(et)%obj) + CALL connectCellCell(self%cells(e)%obj, self%cells(et)%obj) END IF @@ -1017,9 +966,9 @@ MODULE moduleMesh2DCyl SELECT TYPE(self) TYPE IS(meshParticles) - !Connect Vol-Edge + !Connect Cell-Edge DO et = 1, self%numEdges - CALL connectVolEdge(self%cells(e)%obj, self%edges(et)%obj) + CALL connectCellEdge(self%cells(e)%obj, self%edges(et)%obj) END DO @@ -1030,7 +979,7 @@ MODULE moduleMesh2DCyl END SUBROUTINE connectMesh2DCyl !Selects type of elements to build connection - SUBROUTINE connectVolVol(elemA, elemB) + SUBROUTINE connectCellCell(elemA, elemB) IMPLICIT NONE CLASS(meshCell), INTENT(inout):: elemA @@ -1065,9 +1014,9 @@ MODULE moduleMesh2DCyl END SELECT - END SUBROUTINE connectVolVol + END SUBROUTINE connectCellCell - SUBROUTINE connectVolEdge(elemA, elemB) + SUBROUTINE connectCellEdge(elemA, elemB) IMPLICIT NONE CLASS(meshCell), INTENT(inout):: elemA @@ -1088,7 +1037,7 @@ MODULE moduleMesh2DCyl END SELECT - END SUBROUTINE connectVolEdge + END SUBROUTINE connectCellEdge SUBROUTINE connectQuadQuad(elemA, elemB) IMPLICIT NONE From 6f24b5f1f6690e457fa6f3890b0d591a7606485a Mon Sep 17 00:00:00 2001 From: JGonzalez Date: Thu, 5 Jan 2023 20:32:45 +0100 Subject: [PATCH 04/13] Small changes before trying something big I think that creating arrays with self%nNodes takes a lot of time. I'm trying now to pass the number of nodes as argument. --- src/modules/mesh/2DCart/moduleMesh2DCart.f90 | 2 +- src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 | 2 +- src/modules/moduleList.f90 | 3 +++ 3 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 index e7c6e6f..b3f65e4 100644 --- a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 +++ b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 @@ -520,7 +520,7 @@ MODULE moduleMesh2DCart conv = 1.D0 XiO = 0.D0 - DO WHILE(conv > 1.D-3) + DO WHILE(conv > 1.D-2) dPsi = self%dPsi(XiO) invJ = self%invJac(XiO, dPsi) fPsi = self%fPsi(XiO) diff --git a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 index 6a47027..8f1ee5f 100644 --- a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 +++ b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 @@ -552,7 +552,7 @@ MODULE moduleMesh2DCyl conv = 1.D0 XiO = 0.D0 - DO WHILE(conv > 1.D-3) + DO WHILE(conv > 1.D-2) dPsi = self%dPsi(XiO) invJ = self%invJac(XiO, dPsi) detJ = self%detJac(XiO, dPsi) diff --git a/src/modules/moduleList.f90 b/src/modules/moduleList.f90 index b040c80..b1dafdc 100644 --- a/src/modules/moduleList.f90 +++ b/src/modules/moduleList.f90 @@ -92,9 +92,12 @@ MODULE moduleList DEALLOCATE(current) current => next END DO + IF (ASSOCIATED(self%head)) NULLIFY(self%head) IF (ASSOCIATED(self%tail)) NULLIFY(self%tail) + self%amount = 0 + END SUBROUTINE eraseList SUBROUTINE setLock(self) From 15d64f3e68f683d01de9c4a07cd2e5654169ab08 Mon Sep 17 00:00:00 2001 From: JGonzalez Date: Thu, 5 Jan 2023 21:22:13 +0100 Subject: [PATCH 05/13] Passing nNodes as argument It seems that this improves results as passing the size of the arrays as an argument is better than getting it from self. --- src/modules/init/moduleInput.f90 | 4 +- src/modules/mesh/0D/moduleMesh0D.f90 | 10 ++- src/modules/mesh/1DCart/moduleMesh1DCart.f90 | 56 +++++++------- src/modules/mesh/1DRad/moduleMesh1DRad.f90 | 78 ++++++++++---------- src/modules/mesh/2DCart/moduleMesh2DCart.f90 | 50 +++++++------ src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 | 58 ++++++++------- src/modules/mesh/3DCart/moduleMesh3DCart.f90 | 28 +++---- src/modules/mesh/moduleMesh.f90 | 18 +++-- 8 files changed, 159 insertions(+), 143 deletions(-) diff --git a/src/modules/init/moduleInput.f90 b/src/modules/init/moduleInput.f90 index 3ff9e5b..1a439cc 100644 --- a/src/modules/init/moduleInput.f90 +++ b/src/modules/init/moduleInput.f90 @@ -362,7 +362,7 @@ MODULE moduleInput nodes = mesh%cells(e)%obj%getNodes() nNodes = mesh%cells(e)%obj%nNodes ALLOCATE(fPsi(1:nNodes)) - fPsi = mesh%cells(e)%obj%fPsi((/0.D0, 0.D0, 0.D0/)) + fPsi = mesh%cells(e)%obj%fPsi((/0.D0, 0.D0, 0.D0/), nNodes) ALLOCATE(source(1:nNodes)) DO j = 1, nNodes source(j) = density(nodes(j)) @@ -380,7 +380,7 @@ MODULE moduleInput partNew%r = mesh%cells(e)%obj%randPos() partNew%xi = mesh%cells(e)%obj%phy2log(partNew%r) !Get mean velocity at particle position - fPsi = mesh%cells(e)%obj%fPsi(partNew%xi) + fPsi = mesh%cells(e)%obj%fPsi(partNew%xi, nNodes) DO j = 1, nNodes source(j) = velocity(nodes(j), 1) diff --git a/src/modules/mesh/0D/moduleMesh0D.f90 b/src/modules/mesh/0D/moduleMesh0D.f90 index a57f244..65b13a3 100644 --- a/src/modules/mesh/0D/moduleMesh0D.f90 +++ b/src/modules/mesh/0D/moduleMesh0D.f90 @@ -109,23 +109,25 @@ MODULE moduleMesh0D END FUNCTION randPos0D - PURE FUNCTION fPsi0D(self, Xi) RESULT(fPsi) + PURE FUNCTION fPsi0D(self, Xi, nNodes) RESULT(fPsi) IMPLICIT NONE CLASS(meshCell0D), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: fPsi(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8):: fPsi(1:nNodes) fPsi = 1.D0 END FUNCTION fPsi0D - PURE FUNCTION dPsi0D(self, Xi) RESULT(dPsi) + PURE FUNCTION dPsi0D(self, Xi, nNodes) RESULT(dPsi) IMPLICIT NONE CLASS(meshCell0D), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: dPsi(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8):: dPsi(1:3,1:nNodes) dPsi = 0.D0 diff --git a/src/modules/mesh/1DCart/moduleMesh1DCart.f90 b/src/modules/mesh/1DCart/moduleMesh1DCart.f90 index 0f46ba5..982c703 100644 --- a/src/modules/mesh/1DCart/moduleMesh1DCart.f90 +++ b/src/modules/mesh/1DCart/moduleMesh1DCart.f90 @@ -230,7 +230,7 @@ MODULE moduleMesh1DCart Xi(1) = random(-1.D0, 1.D0) Xi(2:3) = 0.D0 - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 2) r(1) = DOT_PRODUCT(fPsi, self%x) END FUNCTION randPos1DCartSegm @@ -249,7 +249,7 @@ MODULE moduleMesh1DCart self%arNodes = 0.D0 !1 point Gauss integral Xi = 0.D0 - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 2) detJ = self%detJac(Xi) l = 2.D0*detJ self%volume = l @@ -258,27 +258,29 @@ MODULE moduleMesh1DCart END SUBROUTINE areaSegm !Computes element functions at point Xi - PURE FUNCTION fPsiSegm(self, xi) RESULT(fPsi) + PURE FUNCTION fPsiSegm(self, Xi, nNodes) RESULT(fPsi) IMPLICIT NONE CLASS(meshCell1DCartSegm), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8):: fPsi(1:self%nNodes) + 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) = 1.D0 - Xi(1) + fPsi(2) = 1.D0 + Xi(1) fPsi = fPsi * 5.D-1 END FUNCTION fPsiSegm !Computes element derivative shape function at Xi - PURE FUNCTION dPsiSegm(self, xi) RESULT(dPsi) + PURE FUNCTION dPsiSegm(self, Xi, nNodes) RESULT(dPsi) IMPLICIT NONE CLASS(meshCell1DCartSegm), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8):: dPsi(1:3,1:self%nNodes) + REAL(8), INTENT(in):: Xi(1:3) + INTEGER, INTENT(in):: nNodes + REAL(8):: dPsi(1:3,1:nNodes) dPsi = 0.D0 @@ -314,7 +316,7 @@ MODULE moduleMesh1DCart Xi = 0.D0 DO l = 1, 3 Xi(1) = corSeg(l) - dPsi = self%dPsi(Xi) + dPsi = self%dPsi(Xi, 2) detJ = self%detJac(Xi, dPsi) invJ = self%invJac(Xi, dPsi) localK = localK + MATMUL(RESHAPE(MATMUL(invJ,dPsi), (/ 2, 1/)), & @@ -342,7 +344,7 @@ MODULE moduleMesh1DCart DO l = 1, 3 Xi(1) = corSeg(l) detJ = self%detJac(Xi) - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 2) f = DOT_PRODUCT(fPsi, source) localF = localF + f*fPsi*wSeg(l)*detJ @@ -384,14 +386,14 @@ MODULE moduleMesh1DCart END FUNCTION gatherMFSegm - PURE FUNCTION insideSegm(xi) RESULT(ins) + PURE FUNCTION insideSegm(Xi) RESULT(ins) IMPLICIT NONE - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) LOGICAL:: ins - ins = xi(1) >=-1.D0 .AND. & - xi(1) <= 1.D0 + ins = Xi(1) >=-1.D0 .AND. & + Xi(1) <= 1.D0 END FUNCTION insideSegm @@ -418,19 +420,19 @@ MODULE moduleMesh1DCart END FUNCTION phy2logSegm - !Get next element for a logical position xi - SUBROUTINE nextElementSegm(self, xi, nextElement) + !Get next element for a logical position Xi + SUBROUTINE nextElementSegm(self, Xi, nextElement) IMPLICIT NONE CLASS(meshCell1DCartSegm), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) CLASS(meshElement), POINTER, INTENT(out):: nextElement NULLIFY(nextElement) - IF (xi(1) < -1.D0) THEN + IF (Xi(1) < -1.D0) THEN nextElement => self%e2 - ELSEIF (xi(1) > 1.D0) THEN + ELSEIF (Xi(1) > 1.D0) THEN nextElement => self%e1 END IF @@ -440,11 +442,11 @@ MODULE moduleMesh1DCart !COMMON FUNCTIONS FOR 1D VOLUME ELEMENTS !Calculates a random position in 1D volume !Computes the element Jacobian determinant - PURE FUNCTION detJ1DCart(self, xi, dPsi_in) RESULT(dJ) + PURE FUNCTION detJ1DCart(self, Xi, dPsi_in) RESULT(dJ) IMPLICIT NONE CLASS(meshCell1DCart), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) REAL(8):: dPsi(1:3,1:self%nNodes) REAL(8):: dJ @@ -454,7 +456,7 @@ MODULE moduleMesh1DCart dPsi = dPsi_in ELSE - dPsi = self%dPsi(xi) + dPsi = self%dPsi(Xi, 2) END IF @@ -464,11 +466,11 @@ MODULE moduleMesh1DCart END FUNCTION detJ1DCart !Computes the invers Jacobian - PURE FUNCTION invJ1DCart(self, xi, dPsi_in) RESULT(invJ) + PURE FUNCTION invJ1DCart(self, Xi, dPsi_in) RESULT(invJ) IMPLICIT NONE CLASS(meshCell1DCart), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) REAL(8):: invJ(1:3,1:3) REAL(8):: dPsi(1:3,1:self%nNodes) @@ -478,7 +480,7 @@ MODULE moduleMesh1DCart dPsi = dPsi_in ELSE - dPsi = self%dPsi(xi) + dPsi = self%dPsi(Xi, 2) END IF diff --git a/src/modules/mesh/1DRad/moduleMesh1DRad.f90 b/src/modules/mesh/1DRad/moduleMesh1DRad.f90 index 8ebac17..1ce7836 100644 --- a/src/modules/mesh/1DRad/moduleMesh1DRad.f90 +++ b/src/modules/mesh/1DRad/moduleMesh1DRad.f90 @@ -232,7 +232,7 @@ MODULE moduleMesh1DRad Xi(1) = random(-1.D0, 1.D0) Xi(2:3) = 0.D0 - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 2) r(1) = DOT_PRODUCT(fPsi, self%r) END FUNCTION randPos1DRadSeg @@ -252,7 +252,7 @@ MODULE moduleMesh1DRad self%arNodes = 0.D0 !1 point Gauss integral Xi = 0.D0 - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 2) detJ = self%detJac(Xi) !Computes total volume of the cell r = DOT_PRODUCT(fPsi, self%r) @@ -260,38 +260,38 @@ MODULE moduleMesh1DRad self%volume = r*l !Computes volume per node Xi = (/-5.D-1, 0.D0, 0.D0/) - fPsi_node = self%fPsi(Xi) - r = DOT_PRODUCT(fPsi_node,self%r) + r = self%gatherF(Xi, self%r) self%arNodes(1) = fPsi(1)*r*l Xi = (/ 5.D-1, 0.D0, 0.D0/) - fPsi_node = self%fPsi(Xi) - r = DOT_PRODUCT(fPsi_node,self%r) + r = self%gatherF(Xi, self%r) self%arNodes(2) = fPsi(2)*r*l END SUBROUTINE areaRad !Computes element functions at point Xi - PURE FUNCTION fPsiRad(self, xi) RESULT(fPsi) + PURE FUNCTION fPsiRad(self, Xi, nNodes) RESULT(fPsi) IMPLICIT NONE CLASS(meshCell1DRadSegm), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8):: fPsi(1:self%nNodes) + 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) = 1.D0 - Xi(1) + fPsi(2) = 1.D0 + Xi(1) fPsi = fPsi * 5.D-1 END FUNCTION fPsiRad !Computes element derivative shape function at Xi - PURE FUNCTION dPsiRad(self, xi) RESULT(dPsi) + PURE FUNCTION dPsiRad(self, Xi, nNodes) RESULT(dPsi) IMPLICIT NONE CLASS(meshCell1DRadSegm), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) - REAL(8):: dPsi(1:3,1:self%nNodes) + REAL(8), INTENT(in):: Xi(1:3) + INTEGER, INTENT(in):: nNodes + REAL(8):: dPsi(1:3,1:nNodes) dPsi = 0.D0 @@ -328,15 +328,15 @@ MODULE moduleMesh1DRad localK = 0.D0 Xi = 0.D0 DO l = 1, 3 - Xi(1) = corSeg(l) - dPsi = self%dPsi(Xi) - detJ = self%detJac(Xi, dPsi) - invJ = self%invJac(Xi, dPsi) - fPsi = self%fPsi(Xi) - 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 + Xi(1) = corSeg(l) + dPsi = self%dPsi(Xi, 2) + detJ = self%detJac(Xi, dPsi) + invJ = self%invJac(Xi, 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 @@ -362,7 +362,7 @@ MODULE moduleMesh1DRad DO l = 1, 3 Xi(1) = corSeg(l) detJ = self%detJac(Xi) - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 2) r = DOT_PRODUCT(fPsi, self%r) f = DOT_PRODUCT(fPsi, source) localF = localF + f*fPsi*r*wSeg(l)*detJ @@ -405,14 +405,14 @@ MODULE moduleMesh1DRad END FUNCTION gatherMFRad - PURE FUNCTION insideRad(xi) RESULT(ins) + PURE FUNCTION insideRad(Xi) RESULT(ins) IMPLICIT NONE - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) LOGICAL:: ins - ins = xi(1) >=-1.D0 .AND. & - xi(1) <= 1.D0 + ins = Xi(1) >=-1.D0 .AND. & + Xi(1) <= 1.D0 END FUNCTION insideRad @@ -439,19 +439,19 @@ MODULE moduleMesh1DRad END FUNCTION phy2logRad - !Get next element for a logical position xi - SUBROUTINE nextElementRad(self, xi, nextElement) + !Get next element for a logical position Xi + SUBROUTINE nextElementRad(self, Xi, nextElement) IMPLICIT NONE CLASS(meshCell1DRadSegm), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) CLASS(meshElement), POINTER, INTENT(out):: nextElement NULLIFY(nextElement) - IF (xi(1) < -1.D0) THEN + IF (Xi(1) < -1.D0) THEN nextElement => self%e2 - ELSEIF (xi(1) > 1.D0) THEN + ELSEIF (Xi(1) > 1.D0) THEN nextElement => self%e1 END IF @@ -460,11 +460,11 @@ MODULE moduleMesh1DRad !COMMON FUNCTIONS FOR 1D VOLUME ELEMENTS !Computes the element Jacobian determinant - PURE FUNCTION detJ1DRad(self, xi, dPsi_in) RESULT(dJ) + PURE FUNCTION detJ1DRad(self, Xi, dPsi_in) RESULT(dJ) IMPLICIT NONE CLASS(meshCell1DRad), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) REAL(8):: dPsi(1:3,1:self%nNodes) REAL(8):: dJ @@ -474,7 +474,7 @@ MODULE moduleMesh1DRad dPsi = dPsi_in ELSE - dPsi = self%dPsi(xi) + dPsi = self%dPsi(Xi, 2) END IF @@ -484,11 +484,11 @@ MODULE moduleMesh1DRad END FUNCTION detJ1DRad !Computes the invers Jacobian - PURE FUNCTION invJ1DRad(self, xi, dPsi_in) RESULT(invJ) + PURE FUNCTION invJ1DRad(self, Xi, dPsi_in) RESULT(invJ) IMPLICIT NONE CLASS(meshCell1DRad), INTENT(in):: self - REAL(8), INTENT(in):: xi(1:3) + REAL(8), INTENT(in):: Xi(1:3) REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) REAL(8):: dPsi(1:3,1:self%nNodes) REAL(8):: dx(1) @@ -498,7 +498,7 @@ MODULE moduleMesh1DRad dPsi = dPsi_in ELSE - dPsi = self%dPsi(xi) + dPsi = self%dPsi(Xi, 2) END IF diff --git a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 index b3f65e4..649b8fb 100644 --- a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 +++ b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 @@ -297,19 +297,20 @@ MODULE moduleMesh2DCart !2D 1 point Gauss Quad Integral Xi = 0.D0 detJ = self%detJac(Xi)*4.D0 !4 - fPsi = self%fPsi(Xi) + 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) RESULT(fPsi) + PURE FUNCTION fPsiQuad(self, Xi, nNodes) RESULT(fPsi) IMPLICIT NONE CLASS(meshCell2DCartQuad), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: fPsi(1:self%nNodes) + 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)) @@ -321,12 +322,13 @@ MODULE moduleMesh2DCart END FUNCTION fPsiQuad !Derivative element function at coordinates Xi - PURE FUNCTION dPsiQuad(self, Xi) RESULT(dPsi) + PURE FUNCTION dPsiQuad(self, Xi, nNodes) RESULT(dPsi) IMPLICIT NONE CLASS(meshCell2DCartQuad), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: dPsi(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8):: dPsi(1:3,1:nNodes) dPsi = 0.D0 @@ -373,7 +375,7 @@ MODULE moduleMesh2DCart Xi(2) = random(-1.D0, 1.D0) Xi(3) = 0.D0 - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 4) r(1) = DOT_PRODUCT(fPsi, self%x) r(2) = DOT_PRODUCT(fPsi, self%y) @@ -399,8 +401,8 @@ MODULE moduleMesh2DCart Xi(2) = corQuad(l) DO m = 1, 3 Xi(1) = corQuad(m) - fPsi = self%fPsi(Xi) - dPsi = self%dPsi(Xi) + fPsi = self%fPsi(Xi, 4) + dPsi = self%dPsi(Xi, 4) detJ = self%detJac(Xi,dPsi) invJ = self%invJac(Xi,dPsi) localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)), & @@ -431,7 +433,7 @@ MODULE moduleMesh2DCart DO m = 1, 3 Xi(2) = corQuad(m) detJ = self%detJac(Xi) - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 4) f = DOT_PRODUCT(fPsi,source) localF = localF + f*fPsi*wQuad(l)*wQuad(m)*detJ @@ -521,9 +523,9 @@ MODULE moduleMesh2DCart XiO = 0.D0 DO WHILE(conv > 1.D-2) - dPsi = self%dPsi(XiO) + dPsi = self%dPsi(XiO, 4) invJ = self%invJac(XiO, dPsi) - fPsi = self%fPsi(XiO) + fPsi = self%fPsi(XiO, 4) f = (/ DOT_PRODUCT(fPsi,self%x), & DOT_PRODUCT(fPsi,self%y), & 0.D0 /) @@ -618,7 +620,7 @@ MODULE moduleMesh2DCart Xi(2) = random( 0.D0, 1.D0 - Xi(1)) Xi(3) = 0.D0 - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 4) r(1) = DOT_PRODUCT(fPsi, self%x) r(2) = DOT_PRODUCT(fPsi, self%y) @@ -640,19 +642,20 @@ MODULE moduleMesh2DCart !2D 1 point Gauss Quad Integral Xi = (/1.D0/3.D0, 1.D0/3.D0, 0.D0 /) detJ = self%detJac(Xi)/2.D0 - fPsi = self%fPsi(Xi) + 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) RESULT(fPsi) + PURE FUNCTION fPsiTria(self, Xi, nNodes) RESULT(fPsi) IMPLICIT NONE CLASS(meshCell2DCartTria), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: fPsi(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8):: fPsi(1:nNodes) fPsi(1) = 1.D0 - Xi(1) - Xi(2) fPsi(2) = Xi(1) @@ -661,12 +664,13 @@ MODULE moduleMesh2DCart END FUNCTION fPsiTria !Derivative element function at coordinates Xi - PURE FUNCTION dPsiTria(self, Xi) RESULT(dPsi) + PURE FUNCTION dPsiTria(self, Xi, nNodes) RESULT(dPsi) IMPLICIT NONE CLASS(meshCell2DCartTria), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: dPsi(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8):: dPsi(1:3,1:nNodes) dPsi = 0.D0 @@ -706,10 +710,10 @@ MODULE moduleMesh2DCart DO l=1, 4 Xi(1) = Xi1Tria(l) Xi(2) = Xi2Tria(l) - dPsi = self%dPsi(Xi) + dPsi = self%dPsi(Xi, 4) detJ = self%detJac(Xi,dPsi) invJ = self%invJac(Xi,dPsi) - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 4) localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*wTria(l)/detJ END DO @@ -735,7 +739,7 @@ MODULE moduleMesh2DCart Xi(1) = Xi1Tria(l) Xi(2) = Xi2Tria(l) detJ = self%detJac(Xi) - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 4) f = DOT_PRODUCT(fPsi,source) localF = localF + f*fPsi*wTria(l)*detJ @@ -818,7 +822,7 @@ MODULE moduleMesh2DCart !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) + dPsi = self%dPsi(Xi, 4) invJ = self%invJac(Xi, dPsi) detJ = self%detJac(Xi, dPsi) Xi = MATMUL(invJ,deltaR)/detJ @@ -864,7 +868,7 @@ MODULE moduleMesh2DCart dPsi = dPsi_in ELSE - dPsi = self%dPsi(Xi) + dPsi = self%dPsi(Xi, 4) END IF @@ -889,7 +893,7 @@ MODULE moduleMesh2DCart dPsi=dPsi_in ELSE - dPsi = self%dPsi(Xi) + dPsi = self%dPsi(Xi, 4) END IF diff --git a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 index 8f1ee5f..adf5d4f 100644 --- a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 +++ b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 @@ -307,7 +307,7 @@ MODULE moduleMesh2DCyl !2D 1 point Gauss Quad Integral Xi = 0.D0 detJ = self%detJac(Xi)*PI8 !4*2*pi - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 4) !Computes total volume of the cell r = DOT_PRODUCT(fPsi,self%r) self%volume = r*detJ @@ -328,29 +328,31 @@ MODULE moduleMesh2DCyl END SUBROUTINE areaQuad !Computes element functions in point Xi - PURE FUNCTION fPsiQuad(self, Xi) RESULT(fPsi) + PURE FUNCTION fPsiQuad(self, Xi, nNodes) RESULT(fPsi) IMPLICIT NONE CLASS(meshCell2DCylQuad), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: fPsi(1:self%nNodes) + 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 = (/ (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(self, Xi) RESULT(dPsi) + PURE FUNCTION dPsiQuad(self, Xi, nNodes) RESULT(dPsi) IMPLICIT NONE CLASS(meshCell2DCylQuad), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: dPsi(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8):: dPsi(1:3,1:nNodes) dPsi = 0.D0 @@ -397,7 +399,7 @@ MODULE moduleMesh2DCyl Xi(2) = random(-1.D0, 1.D0) Xi(3) = 0.D0 - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 4) r(1) = DOT_PRODUCT(fPsi, self%z) r(2) = DOT_PRODUCT(fPsi, self%r) @@ -425,8 +427,8 @@ MODULE moduleMesh2DCyl Xi(2) = corQuad(l) DO m = 1, 3 Xi(1) = corQuad(m) - fPsi = self%fPsi(Xi) - dPsi = self%dPsi(Xi) + fPsi = self%fPsi(Xi, 4) + dPsi = self%dPsi(Xi, 4) detJ = self%detJac(Xi,dPsi) invJ = self%invJac(Xi,dPsi) r = DOT_PRODUCT(fPsi,self%r) @@ -461,7 +463,7 @@ MODULE moduleMesh2DCyl DO m = 1, 3 Xi(2) = corQuad(m) detJ = self%detJac(Xi) - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 4) r = DOT_PRODUCT(fPsi,self%r) f = DOT_PRODUCT(fPsi,source) localF = localF + r*f*fPsi*wQuad(l)*wQuad(m)*detJ @@ -553,10 +555,10 @@ MODULE moduleMesh2DCyl XiO = 0.D0 DO WHILE(conv > 1.D-2) - dPsi = self%dPsi(XiO) + dPsi = self%dPsi(XiO, 4) invJ = self%invJac(XiO, dPsi) detJ = self%detJac(XiO, dPsi) - fPsi = self%fPsi(XiO) + fPsi = self%fPsi(XiO, 4) f = (/ DOT_PRODUCT(fPsi,self%z), & DOT_PRODUCT(fPsi,self%r), & 0.D0 /) @@ -651,7 +653,7 @@ MODULE moduleMesh2DCyl Xi(2) = random( 0.D0, 1.D0 - Xi(1)) Xi(3) = 0.D0 - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 4) r(1) = DOT_PRODUCT(fPsi, self%z) r(2) = DOT_PRODUCT(fPsi, self%r) @@ -675,7 +677,7 @@ MODULE moduleMesh2DCyl !2D 1 point Gauss Quad Integral Xi = (/1.D0/3.D0, 1.D0/3.D0, 0.D0 /) detJ = self%detJac(Xi)*PI !2PI*1/2 - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 4) !Computes total volume of the cell r = DOT_PRODUCT(fPsi,self%r) self%volume = r*detJ @@ -685,12 +687,13 @@ MODULE moduleMesh2DCyl END SUBROUTINE areaTria !Shape functions for triangular element - PURE FUNCTION fPsiTria(self, Xi) RESULT(fPsi) + PURE FUNCTION fPsiTria(self, Xi, nNodes) RESULT(fPsi) IMPLICIT NONE CLASS(meshCell2DCylTria), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: fPsi(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8):: fPsi(1:nNodes) fPsi(1) = 1.D0 - Xi(1) - Xi(2) fPsi(2) = Xi(1) @@ -699,12 +702,13 @@ MODULE moduleMesh2DCyl END FUNCTION fPsiTria !Derivative element function at coordinates Xi - PURE FUNCTION dPsiTria(self, Xi) RESULT(dPsi) + PURE FUNCTION dPsiTria(self, Xi, nNodes) RESULT(dPsi) IMPLICIT NONE CLASS(meshCell2DCylTria), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: dPsi(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8):: dPsi(1:3,1:nNodes) dPsi = 0.D0 @@ -746,10 +750,10 @@ MODULE moduleMesh2DCyl DO l=1, 4 Xi(1) = Xi1Tria(l) Xi(2) = Xi2Tria(l) - dPsi = self%dPsi(Xi) + dPsi = self%dPsi(Xi, 4) detJ = self%detJac(Xi,dPsi) invJ = self%invJac(Xi,dPsi) - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 4) r = DOT_PRODUCT(fPsi,self%r) localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*r*wTria(l)/detJ @@ -779,7 +783,7 @@ MODULE moduleMesh2DCyl Xi(1) = Xi1Tria(l) Xi(2) = Xi2Tria(l) detJ = self%detJac(Xi) - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 4) r = DOT_PRODUCT(fPsi,self%r) f = DOT_PRODUCT(fPsi,source) localF = localF + r*f*fPsi*wTria(l)*detJ @@ -864,7 +868,7 @@ MODULE moduleMesh2DCyl !Direct method to convert coordinates Xi = 0.D0 deltaR = (/ r(1) - self%z(1), r(2) - self%r(1), 0.D0 /) - dPsi = self%dPsi(Xi) + dPsi = self%dPsi(Xi, 4) invJ = self%invJac(Xi, dPsi) detJ = self%detJac(Xi, dPsi) Xi = MATMUL(invJ,deltaR)/detJ @@ -910,7 +914,7 @@ MODULE moduleMesh2DCyl dPsi = dPsi_in ELSE - dPsi = self%dPsi(Xi) + dPsi = self%dPsi(Xi, 4) END IF @@ -935,7 +939,7 @@ MODULE moduleMesh2DCyl dPsi=dPsi_in ELSE - dPsi = self%dPsi(Xi) + dPsi = self%dPsi(Xi, 4) END IF diff --git a/src/modules/mesh/3DCart/moduleMesh3DCart.f90 b/src/modules/mesh/3DCart/moduleMesh3DCart.f90 index 9bd6468..3018989 100644 --- a/src/modules/mesh/3DCart/moduleMesh3DCart.f90 +++ b/src/modules/mesh/3DCart/moduleMesh3DCart.f90 @@ -270,7 +270,7 @@ MODULE moduleMesh3DCart !Assign proportional volume to each node Xi = (/0.25D0, 0.25D0, 0.25D0/) - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 4) volNodes = fPsi*self%volume self%n1%v = self%n1%v + volNodes(1) self%n2%v = self%n2%v + volNodes(2) @@ -298,7 +298,7 @@ MODULE moduleMesh3DCart Xi(2) = random( 0.D0, 1.D0 - Xi(1)) Xi(3) = random( 0.D0, 1.D0 - Xi(1) - Xi(2)) - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 4) r = (/ DOT_PRODUCT(fPsi, self%x), & DOT_PRODUCT(fPsi, self%y), & @@ -320,12 +320,13 @@ MODULE moduleMesh3DCart END SUBROUTINE volumeTetra !Computes element functions in point Xi - PURE FUNCTION fPsiTetra(self, Xi) RESULT(fPsi) + PURE FUNCTION fPsiTetra(self, Xi, nNodes) RESULT(fPsi) IMPLICIT NONE CLASS(meshCell3DCartTetra), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: fPsi(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8):: fPsi(1:nNodes) fPsi(1) = 1.D0 - Xi(1) - Xi(2) - Xi(3) fPsi(2) = Xi(1) @@ -335,12 +336,13 @@ MODULE moduleMesh3DCart END FUNCTION fPsiTetra !Derivative element function at coordinates Xi - PURE FUNCTION dPsiTetra(self, Xi) RESULT(dPsi) + PURE FUNCTION dPsiTetra(self, Xi, nNodes) RESULT(dPsi) IMPLICIT NONE CLASS(meshCell3DCartTetra), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: dPsi(1:3, 1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8):: dPsi(1:3, 1:nNodes) dPsi = 0.D0 @@ -424,10 +426,10 @@ MODULE moduleMesh3DCart Xi = 0.D0 !TODO: One point Gauss integral. Upgrade when possible Xi = (/ 0.25D0, 0.25D0, 0.25D0 /) - dPsi = self%dPsi(Xi) + dPsi = self%dPsi(Xi, 4) detJ = self%detJac(Xi, dPsi) invJ = self%invJac(Xi, dPsi) - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 4) localK = MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*1.D0/detJ END FUNCTION elemKTetra @@ -445,9 +447,9 @@ MODULE moduleMesh3DCart localF = 0.D0 Xi = 0.D0 Xi = (/ 0.25D0, 0.25D0, 0.25D0 /) - dPsi = self%dPsi(Xi) + dPsi = self%dPsi(Xi, 4) detJ = self%detJac(Xi, dPsi) - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, 4) f = DOT_PRODUCT(fPsi, source) localF = f*fPsi*1.D0*detJ @@ -530,7 +532,7 @@ MODULE moduleMesh3DCart Xi = 0.D0 deltaR = (/r(1) - self%x(1), r(2) - self%y(1), r(3) - self%z(1) /) - dPsi = self%dPsi(Xi) + dPsi = self%dPsi(Xi, 4) invJ = self%invJac(Xi, dPsi) detJ = self%detJac(Xi, dPsi) Xi = MATMUL(invJ, deltaR)/detJ @@ -579,7 +581,7 @@ MODULE moduleMesh3DCart dPsi = dPsi_in ELSE - dPsi = self%dPsi(Xi) + dPsi = self%dPsi(Xi, 4) END IF @@ -604,7 +606,7 @@ MODULE moduleMesh3DCart dPsi=dPsi_in ELSE - dPsi = self%dPsi(Xi) + dPsi = self%dPsi(Xi, 4) END IF diff --git a/src/modules/mesh/moduleMesh.f90 b/src/modules/mesh/moduleMesh.f90 index d0a03f4..aeba4ba 100644 --- a/src/modules/mesh/moduleMesh.f90 +++ b/src/modules/mesh/moduleMesh.f90 @@ -215,19 +215,21 @@ MODULE moduleMesh END FUNCTION getNodesVol_interface - PURE FUNCTION fPsi_interface(self, Xi) RESULT(fPsi) + PURE FUNCTION fPsi_interface(self, Xi, nNodes) RESULT(fPsi) IMPORT:: meshCell CLASS(meshCell), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: fPsi(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8):: fPsi(1:nNodes) END FUNCTION fPsi_interface - PURE FUNCTION dPsi_interface(self, Xi) RESULT(dPsi) + PURE FUNCTION dPsi_interface(self, Xi, nNodes) RESULT(dPsi) IMPORT:: meshCell CLASS(meshCell), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8):: dPsi(1:3, 1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8):: dPsi(1:3, 1:nNodes) END FUNCTION dPsi_interface @@ -530,7 +532,7 @@ MODULE moduleMesh REAL(8):: f REAL(8):: fPsi(1:self%nNodes) - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, self%nNodes) f = DOT_PRODUCT(fPsi, valNodes) END FUNCTION gatherF_scalar @@ -546,7 +548,7 @@ MODULE moduleMesh REAL(8):: f(1:n) REAL(8):: fPsi(1:self%nNodes) - fPsi = self%fPsi(Xi) + fPsi = self%fPsi(Xi, self%nNodes) f = MATMUL(fPsi, valNodes) END FUNCTION gatherF_array @@ -563,7 +565,7 @@ MODULE moduleMesh REAL(8):: dPsiR(1:3, 1:self%nNodes) REAL(8):: invJ(1:3, 1:3), detJ - dPsi = self%dPsi(Xi) + dPsi = self%dPsi(Xi, self%nNodes) detJ = self%detJac(Xi, dPsi) invJ = self%invJac(Xi, dPsi) dPsiR = MATMUL(invJ, dPsi)/detJ @@ -590,7 +592,7 @@ MODULE moduleMesh CLASS(meshNode), POINTER:: node cellNodes = self%getNodes() - fPsi = self%fPsi(part%Xi) + fPsi = self%fPsi(part%Xi, self%nNodes) tensorS = outerProduct(part%v, part%v) From 7f6afd6a874a0a8ceaa6bf0c9417ccee64fcc797 Mon Sep 17 00:00:00 2001 From: JGonzalez Date: Thu, 5 Jan 2023 22:43:51 +0100 Subject: [PATCH 06/13] Mark_1 First thing that I am kinda happy with. Still some things to improve but at least push is good. --- src/modules/init/moduleInput.f90 | 2 +- src/modules/mesh/0D/moduleMesh0D.f90 | 31 +++-- src/modules/mesh/1DCart/moduleMesh1DCart.f90 | 64 +++++----- src/modules/mesh/1DRad/moduleMesh1DRad.f90 | 68 +++++----- src/modules/mesh/2DCart/moduleMesh2DCart.f90 | 115 +++++++++-------- src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 | 118 ++++++++++-------- src/modules/mesh/3DCart/moduleMesh3DCart.f90 | 74 ++++++----- src/modules/mesh/moduleMesh.f90 | 102 ++++++++------- src/modules/mesh/moduleMeshBoundary.f90 | 4 +- .../solver/electromagnetic/moduleEM.f90 | 12 +- src/modules/solver/moduleSolver.f90 | 4 +- 11 files changed, 336 insertions(+), 258 deletions(-) diff --git a/src/modules/init/moduleInput.f90 b/src/modules/init/moduleInput.f90 index 1a439cc..0f409fb 100644 --- a/src/modules/init/moduleInput.f90 +++ b/src/modules/init/moduleInput.f90 @@ -359,8 +359,8 @@ MODULE moduleInput DO e = 1, mesh%numCells !Scale variables !Density at centroid of cell - nodes = mesh%cells(e)%obj%getNodes() nNodes = mesh%cells(e)%obj%nNodes + nodes = mesh%cells(e)%obj%getNodes(nNodes) ALLOCATE(fPsi(1:nNodes)) fPsi = mesh%cells(e)%obj%fPsi((/0.D0, 0.D0, 0.D0/), nNodes) ALLOCATE(source(1:nNodes)) diff --git a/src/modules/mesh/0D/moduleMesh0D.f90 b/src/modules/mesh/0D/moduleMesh0D.f90 index 65b13a3..5f89f20 100644 --- a/src/modules/mesh/0D/moduleMesh0D.f90 +++ b/src/modules/mesh/0D/moduleMesh0D.f90 @@ -89,11 +89,12 @@ MODULE moduleMesh0D END SUBROUTINE initCell0D - PURE FUNCTION getNodes0D(self) RESULT(n) + PURE FUNCTION getNodes0D(self, nNodes) RESULT(n) IMPLICIT NONE CLASS(meshCell0D), INTENT(in):: self - INTEGER:: n(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + INTEGER:: n(1:nNodes) n = self%n1%n @@ -133,46 +134,50 @@ MODULE moduleMesh0D END FUNCTION dPsi0D - PURE FUNCTION detJ0D(self, Xi, dPsi_in) RESULT(dJ) + PURE FUNCTION detJ0D(self, Xi, nNodes, dPsi_in) RESULT(dJ) IMPLICIT NONE CLASS(meshCell0D), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:nNodes) REAL(8):: dJ dJ = 0.D0 END FUNCTION detJ0D - PURE FUNCTION invJ0D(self, Xi, dPsi_in) RESULT(invJ) + PURE FUNCTION invJ0D(self, Xi, nNodes, dPsi_in) RESULT(invJ) IMPLICIT NONE CLASS(meshCell0D), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:nNodes) REAL(8):: invJ(1:3,1:3) invJ = 0.D0 END FUNCTION invJ0D - PURE FUNCTION elemK0D(self) RESULT(localK) + PURE FUNCTION elemK0D(self, nNodes) RESULT(localK) IMPLICIT NONE CLASS(meshCell0D), INTENT(in):: self - REAL(8):: localK(1:self%nNodes,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8):: localK(1:nNodes,1:nNodes) localK = 0.D0 END FUNCTION elemK0D - PURE FUNCTION elemF0D(self, source) RESULT(localF) + PURE FUNCTION elemF0D(self, nNodes, source) RESULT(localF) IMPLICIT NONE CLASS(meshCell0D), INTENT(in):: self - REAL(8), INTENT(in):: source(1:self%nNodes) - REAL(8):: localF(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in):: source(1:nNodes) + REAL(8):: localF(1:nNodes) localF = 0.D0 @@ -187,7 +192,7 @@ MODULE moduleMesh0D phi = (/ self%n1%emData%phi /) - array = -self%gatherDF(Xi, phi) + array = -self%gatherDF(Xi, 1, phi) END FUNCTION gatherEF0D @@ -204,7 +209,7 @@ MODULE moduleMesh0D B(:,3) = (/ self%n1%emData%B(3) /) - array = self%gatherF(Xi, 3, B) + array = self%gatherF(Xi, 1, B) END FUNCTION gatherMF0D diff --git a/src/modules/mesh/1DCart/moduleMesh1DCart.f90 b/src/modules/mesh/1DCart/moduleMesh1DCart.f90 index 982c703..56d1b65 100644 --- a/src/modules/mesh/1DCart/moduleMesh1DCart.f90 +++ b/src/modules/mesh/1DCart/moduleMesh1DCart.f90 @@ -41,10 +41,11 @@ MODULE moduleMesh1DCart END TYPE meshCell1DCart ABSTRACT INTERFACE - PURE SUBROUTINE partialDer_interface(self, dPsi, dx) + PURE SUBROUTINE partialDer_interface(self, nNodes, dPsi, dx) IMPORT meshCell1DCart CLASS(meshCell1DCart), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in):: dPsi(1:3,1:nNodes) REAL(8), INTENT(out), DIMENSION(1):: dx END SUBROUTINE partialDer_interface @@ -129,6 +130,7 @@ MODULE moduleMesh1DCart INTEGER:: s self%n = n + self%nNodes = SIZE(p) self%n1 => mesh%nodes(p(1))%obj !Get element coordinates r1 = self%n1%getCoordinates() @@ -152,13 +154,13 @@ MODULE moduleMesh1DCart END SUBROUTINE initEdge1DCart !Get nodes from edge - PURE FUNCTION getNodes1DCart(self) RESULT(n) + PURE FUNCTION getNodes1DCart(self, nNodes) RESULT(n) IMPLICIT NONE CLASS(meshEdge1DCart), INTENT(in):: self - INTEGER, ALLOCATABLE:: n(:) + INTEGER, INTENT(in):: nNodes + INTEGER:: n(1:nNodes) - ALLOCATE(n(1)) n = (/ self%n1%n /) END FUNCTION getNodes1DCart @@ -250,7 +252,7 @@ MODULE moduleMesh1DCart !1 point Gauss integral Xi = 0.D0 fPsi = self%fPsi(Xi, 2) - detJ = self%detJac(Xi) + detJ = self%detJac(Xi, 2) l = 2.D0*detJ self%volume = l self%arNodes = fPsi*l @@ -290,11 +292,12 @@ MODULE moduleMesh1DCart END FUNCTION dPsiSegm !Computes partial derivatives of coordinates - PURE SUBROUTINE partialDerSegm(self, dPsi, dx) + PURE SUBROUTINE partialDerSegm(self, nNodes, dPsi, dx) IMPLICIT NONE CLASS(meshCell1DCartSegm), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in):: dPsi(1:3,1:nNodes) REAL(8), INTENT(out), DIMENSION(1):: dx dx(1) = DOT_PRODUCT(dPsi(1,:), self%x) @@ -302,11 +305,12 @@ MODULE moduleMesh1DCart END SUBROUTINE partialDerSegm !Computes local stiffness matrix - PURE FUNCTION elemKSegm(self) RESULT(localK) + PURE FUNCTION elemKSegm(self, nNodes) RESULT(localK) IMPLICIT NONE CLASS(meshCell1DCartSegm), INTENT(in):: self - REAL(8):: localK(1:self%nNodes,1:self%nNodes) + 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 @@ -317,8 +321,8 @@ MODULE moduleMesh1DCart DO l = 1, 3 Xi(1) = corSeg(l) dPsi = self%dPsi(Xi, 2) - detJ = self%detJac(Xi, dPsi) - invJ = self%invJac(Xi, dPsi) + 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 @@ -327,12 +331,13 @@ MODULE moduleMesh1DCart END FUNCTION elemKSegm - PURE FUNCTION elemFSegm(self, source) RESULT(localF) + PURE FUNCTION elemFSegm(self, nNodes, source) RESULT(localF) IMPLICIT NONE CLASS(meshCell1DCartSegm), INTENT(in):: self - REAL(8), INTENT(in):: source(1:self%nNodes) - REAL(8):: localF(1:self%nNodes) + 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) @@ -343,7 +348,7 @@ MODULE moduleMesh1DCart DO l = 1, 3 Xi(1) = corSeg(l) - detJ = self%detJac(Xi) + detJ = self%detJac(Xi, 2) fPsi = self%fPsi(Xi, 2) f = DOT_PRODUCT(fPsi, source) localF = localF + f*fPsi*wSeg(l)*detJ @@ -362,7 +367,7 @@ MODULE moduleMesh1DCart phi = (/ self%n1%emData%phi, & self%n2%emData%phi /) - array = -self%gatherDF(Xi, phi) + array = -self%gatherDF(Xi, 2, phi) END FUNCTION gatherEFSegm @@ -382,7 +387,7 @@ MODULE moduleMesh1DCart B(:,3) = (/ self%n1%emData%B(3), & self%n2%emData%B(3) /) - array = self%gatherF(Xi, 3, B) + array = self%gatherF(Xi, 2, B) END FUNCTION gatherMFSegm @@ -398,11 +403,12 @@ MODULE moduleMesh1DCart END FUNCTION insideSegm !Get nodes from 1D volume - PURE FUNCTION getNodesSegm(self) RESULT(n) + PURE FUNCTION getNodesSegm(self, nNodes) RESULT(n) IMPLICIT NONE CLASS(meshCell1DCartSegm), INTENT(in):: self - INTEGER:: n(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + INTEGER:: n(1:nNodes) n = (/ self%n1%n, self%n2%n /) @@ -442,13 +448,14 @@ MODULE moduleMesh1DCart !COMMON FUNCTIONS FOR 1D VOLUME ELEMENTS !Calculates a random position in 1D volume !Computes the element Jacobian determinant - PURE FUNCTION detJ1DCart(self, Xi, dPsi_in) RESULT(dJ) + PURE FUNCTION detJ1DCart(self, Xi, nNodes, dPsi_in) RESULT(dJ) IMPLICIT NONE CLASS(meshCell1DCart), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) - REAL(8):: dPsi(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:nNodes) + REAL(8):: dPsi(1:3,1:nNodes) REAL(8):: dJ REAL(8):: dx(1) @@ -460,20 +467,21 @@ MODULE moduleMesh1DCart END IF - CALL self%partialDer(dPsi, dx) + CALL self%partialDer(2, dPsi, dx) dJ = dx(1) END FUNCTION detJ1DCart !Computes the invers Jacobian - PURE FUNCTION invJ1DCart(self, Xi, dPsi_in) RESULT(invJ) + PURE FUNCTION invJ1DCart(self, Xi, nNodes, dPsi_in) RESULT(invJ) IMPLICIT NONE CLASS(meshCell1DCart), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:nNodes) REAL(8):: invJ(1:3,1:3) - REAL(8):: dPsi(1:3,1:self%nNodes) + REAL(8):: dPsi(1:3,1:nNodes) REAL(8):: dx(1) IF (PRESENT(dPsi_in)) THEN @@ -486,7 +494,7 @@ MODULE moduleMesh1DCart invJ = 0.D0 - CALL self%partialDer(dPsi, dx) + CALL self%partialDer(2, dPsi, dx) invJ(1,1) = 1.D0/dx(1) diff --git a/src/modules/mesh/1DRad/moduleMesh1DRad.f90 b/src/modules/mesh/1DRad/moduleMesh1DRad.f90 index 1ce7836..8b441be 100644 --- a/src/modules/mesh/1DRad/moduleMesh1DRad.f90 +++ b/src/modules/mesh/1DRad/moduleMesh1DRad.f90 @@ -41,11 +41,12 @@ MODULE moduleMesh1DRad END TYPE meshCell1DRad ABSTRACT INTERFACE - PURE SUBROUTINE partialDer_interface(self, dPsi, dx) + PURE SUBROUTINE partialDer_interface(self, nNodes, dPsi, dx) IMPORT meshCell1DRad CLASS(meshCell1DRad), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in):: dPsi(1:3,1:nNodes) REAL(8), INTENT(out), DIMENSION(1):: dx END SUBROUTINE partialDer_interface @@ -130,6 +131,7 @@ MODULE moduleMesh1DRad INTEGER:: s self%n = n + self%nNodes = SIZE(p) self%n1 => mesh%nodes(p(1))%obj !Get element coordinates r1 = self%n1%getCoordinates() @@ -154,13 +156,13 @@ MODULE moduleMesh1DRad END SUBROUTINE initEdge1DRad !Get nodes from edge - PURE FUNCTION getNodes1DRad(self) RESULT(n) + PURE FUNCTION getNodes1DRad(self, nNodes) RESULT(n) IMPLICIT NONE CLASS(meshEdge1DRad), INTENT(in):: self - INTEGER, ALLOCATABLE:: n(:) + INTEGER, INTENT(in):: nNodes + INTEGER:: n(1:nNodes) - ALLOCATE(n(1)) n = (/ self%n1%n /) END FUNCTION getNodes1DRad @@ -253,17 +255,17 @@ MODULE moduleMesh1DRad !1 point Gauss integral Xi = 0.D0 fPsi = self%fPsi(Xi, 2) - detJ = self%detJac(Xi) + 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, self%r) + 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, self%r) + r = self%gatherF(Xi, 2, self%r) self%arNodes(2) = fPsi(2)*r*l END SUBROUTINE areaRad @@ -301,11 +303,12 @@ MODULE moduleMesh1DRad END FUNCTION dPsiRad !Computes partial derivatives of coordinates - PURE SUBROUTINE partialDerRad(self, dPsi, dx) + PURE SUBROUTINE partialDerRad(self, nNodes, dPsi, dx) IMPLICIT NONE CLASS(meshCell1DRadSegm), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in):: dPsi(1:3,1:nNodes) REAL(8), INTENT(out), DIMENSION(1):: dx dx(1) = DOT_PRODUCT(dPsi(1,:), self%r) @@ -313,12 +316,13 @@ MODULE moduleMesh1DRad END SUBROUTINE partialDerRad !Computes local stiffness matrix - PURE FUNCTION elemKRad(self) RESULT(localK) + PURE FUNCTION elemKRad(self, nNodes) RESULT(localK) USE moduleConstParam, ONLY: PI2 IMPLICIT NONE CLASS(meshCell1DRadSegm), INTENT(in):: self - REAL(8):: localK(1:self%nNodes,1:self%nNodes) + 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 @@ -330,8 +334,8 @@ MODULE moduleMesh1DRad DO l = 1, 3 Xi(1) = corSeg(l) dPsi = self%dPsi(Xi, 2) - detJ = self%detJac(Xi, dPsi) - invJ = self%invJac(Xi, dPsi) + 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/)), & @@ -344,13 +348,14 @@ MODULE moduleMesh1DRad END FUNCTION elemKRad - PURE FUNCTION elemFRad(self, source) RESULT(localF) + PURE FUNCTION elemFRad(self, nNodes, source) RESULT(localF) USE moduleConstParam, ONLY: PI2 IMPLICIT NONE CLASS(meshCell1DRadSegm), INTENT(in):: self - REAL(8), INTENT(in):: source(1:self%nNodes) - REAL(8):: localF(1:self%nNodes) + 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) @@ -361,7 +366,7 @@ MODULE moduleMesh1DRad DO l = 1, 3 Xi(1) = corSeg(l) - detJ = self%detJac(Xi) + detJ = self%detJac(Xi, 2) fPsi = self%fPsi(Xi, 2) r = DOT_PRODUCT(fPsi, self%r) f = DOT_PRODUCT(fPsi, source) @@ -381,7 +386,7 @@ MODULE moduleMesh1DRad phi = (/ self%n1%emData%phi, & self%n2%emData%phi /) - array = -self%gatherDF(Xi, phi) + array = -self%gatherDF(Xi, 2, phi) END FUNCTION gatherEFRad @@ -401,7 +406,7 @@ MODULE moduleMesh1DRad B(:,3) = (/ self%n1%emData%B(3), & self%n2%emData%B(3) /) - array = self%gatherF(Xi, 3, B) + array = self%gatherF(Xi, 2, B) END FUNCTION gatherMFRad @@ -417,11 +422,12 @@ MODULE moduleMesh1DRad END FUNCTION insideRad !Get nodes from 1D volume - PURE FUNCTION getNodesRad(self) RESULT(n) + PURE FUNCTION getNodesRad(self, nNodes) RESULT(n) IMPLICIT NONE CLASS(meshCell1DRadSegm), INTENT(in):: self - INTEGER:: n(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + INTEGER:: n(1:nNodes) n = (/ self%n1%n, self%n2%n /) @@ -460,13 +466,14 @@ MODULE moduleMesh1DRad !COMMON FUNCTIONS FOR 1D VOLUME ELEMENTS !Computes the element Jacobian determinant - PURE FUNCTION detJ1DRad(self, Xi, dPsi_in) RESULT(dJ) + PURE FUNCTION detJ1DRad(self, Xi, nNodes, dPsi_in) RESULT(dJ) IMPLICIT NONE CLASS(meshCell1DRad), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) - REAL(8):: dPsi(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:nNodes) + REAL(8):: dPsi(1:3,1:nNodes) REAL(8):: dJ REAL(8):: dx(1) @@ -478,19 +485,20 @@ MODULE moduleMesh1DRad END IF - CALL self%partialDer(dPsi, dx) + CALL self%partialDer(nNodes, dPsi, dx) dJ = dx(1) END FUNCTION detJ1DRad !Computes the invers Jacobian - PURE FUNCTION invJ1DRad(self, Xi, dPsi_in) RESULT(invJ) + PURE FUNCTION invJ1DRad(self, Xi, nNodes, dPsi_in) RESULT(invJ) IMPLICIT NONE CLASS(meshCell1DRad), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) - REAL(8):: dPsi(1:3,1:self%nNodes) + 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):: invJ(1:3,1:3) @@ -504,7 +512,7 @@ MODULE moduleMesh1DRad invJ = 0.D0 - CALL self%partialDer(dPsi, dx) + CALL self%partialDer(nNodes, dPsi, dx) invJ(1,1) = 1.D0/dx(1) diff --git a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 index 649b8fb..2ccde7d 100644 --- a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 +++ b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 @@ -46,10 +46,11 @@ MODULE moduleMesh2DCart END TYPE meshCell2DCart ABSTRACT INTERFACE - PURE SUBROUTINE partialDer_interface(self, dPsi, dx, dy) + PURE SUBROUTINE partialDer_interface(self, nNodes, dPsi, dx, dy) IMPORT meshCell2DCart CLASS(meshCell2DCart), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) + 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 @@ -166,6 +167,7 @@ MODULE moduleMesh2DCart INTEGER:: s self%n = n + self%nNodes = SIZE(p) self%n1 => mesh%nodes(p(1))%obj self%n2 => mesh%nodes(p(2))%obj !Get element coordinates @@ -194,13 +196,13 @@ MODULE moduleMesh2DCart END SUBROUTINE initEdge2DCart !Get nodes from edge - PURE FUNCTION getNodes2DCart(self) RESULT(n) + PURE FUNCTION getNodes2DCart(self, nNodes) RESULT(n) IMPLICIT NONE CLASS(meshEdge2DCart), INTENT(in):: self - INTEGER, ALLOCATABLE:: n(:) + INTEGER, INTENT(in):: nNodes + INTEGER:: n(1:nNodes) - ALLOCATE(n(1:2)) n = (/self%n1%n, self%n2%n /) END FUNCTION getNodes2DCart @@ -255,8 +257,13 @@ MODULE moduleMesh2DCart TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) REAL(8), DIMENSION(1:3):: r1, r2, r3, r4 + !Assign node index self%n = n + + !Assign number of nodes of cell self%nNodes = SIZE(p) + + !Assign nodes to element self%n1 => nodes(p(1))%obj self%n2 => nodes(p(2))%obj self%n3 => nodes(p(3))%obj @@ -296,7 +303,7 @@ MODULE moduleMesh2DCart self%arNodes = 0.D0 !2D 1 point Gauss Quad Integral Xi = 0.D0 - detJ = self%detJac(Xi)*4.D0 !4 + detJ = self%detJac(Xi, 4)*4.D0 !4 fPsi = self%fPsi(Xi, 4) self%volume = detJ self%arNodes = fPsi*detJ @@ -347,11 +354,12 @@ MODULE moduleMesh2DCart END FUNCTION dPsiQuad !Partial derivative in global coordinates - PURE SUBROUTINE partialDerQuad(self, dPsi, dx, dy) + PURE SUBROUTINE partialDerQuad(self, nNodes, dPsi, dx, dy) IMPLICIT NONE CLASS(meshCell2DCartQuad), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in):: dPsi(1:3,1:nNodes) REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy dx = (/ DOT_PRODUCT(dPsi(1,1:4),self%x(1:4)), & @@ -384,11 +392,12 @@ MODULE moduleMesh2DCart END FUNCTION randPosCellQuad !Computes element local stiffness matrix - PURE FUNCTION elemKQuad(self) RESULT(localK) + PURE FUNCTION elemKQuad(self, nNodes) RESULT(localK) IMPLICIT NONE CLASS(meshCell2DCartQuad), INTENT(in):: self - REAL(8):: localK(1:self%nNodes,1:self%nNodes) + 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 @@ -403,8 +412,8 @@ MODULE moduleMesh2DCart Xi(1) = corQuad(m) fPsi = self%fPsi(Xi, 4) dPsi = self%dPsi(Xi, 4) - detJ = self%detJac(Xi,dPsi) - invJ = self%invJac(Xi,dPsi) + 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 @@ -415,12 +424,13 @@ MODULE moduleMesh2DCart END FUNCTION elemKQuad !Computes the local source vector for a force f - PURE FUNCTION elemFQuad(self, source) RESULT(localF) + PURE FUNCTION elemFQuad(self, nNodes, source) RESULT(localF) IMPLICIT NONE CLASS(meshCell2DCartQuad), INTENT(in):: self - REAL(8), INTENT(in):: source(1:self%nNodes) - REAL(8):: localF(1:self%nNodes) + 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 @@ -432,7 +442,7 @@ MODULE moduleMesh2DCart Xi(1) = corQuad(l) DO m = 1, 3 Xi(2) = corQuad(m) - detJ = self%detJac(Xi) + detJ = self%detJac(Xi, 4) fPsi = self%fPsi(Xi, 4) f = DOT_PRODUCT(fPsi,source) localF = localF + f*fPsi*wQuad(l)*wQuad(m)*detJ @@ -454,7 +464,7 @@ MODULE moduleMesh2DCart self%n3%emData%phi, & self%n4%emData%phi /) - array = -self%gatherDF(Xi, phi) + array = -self%gatherDF(Xi, 4, phi) END FUNCTION gatherEFQuad @@ -480,7 +490,7 @@ MODULE moduleMesh2DCart self%n3%emData%B(3), & self%n4%emData%B(3) /) - array = self%gatherF(Xi, 3, B) + array = self%gatherF(Xi, 4, B) END FUNCTION gatherMFQuad @@ -497,11 +507,12 @@ MODULE moduleMesh2DCart END FUNCTION insideQuad !Gets nodes from quadrilateral element - PURE FUNCTION getNodesQuad(self) RESULT(n) + PURE FUNCTION getNodesQuad(self, nNodes) RESULT(n) IMPLICIT NONE CLASS(meshCell2DCartQuad), INTENT(in):: self - INTEGER:: n(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + INTEGER:: n(1:nNodes) n = (/self%n1%n, self%n2%n, self%n3%n, self%n4%n /) @@ -524,7 +535,7 @@ MODULE moduleMesh2DCart DO WHILE(conv > 1.D-2) dPsi = self%dPsi(XiO, 4) - invJ = self%invJac(XiO, dPsi) + invJ = self%invJac(XiO, 4, dPsi) fPsi = self%fPsi(XiO, 4) f = (/ DOT_PRODUCT(fPsi,self%x), & DOT_PRODUCT(fPsi,self%y), & @@ -641,7 +652,7 @@ MODULE moduleMesh2DCart 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)/2.D0 + detJ = self%detJac(Xi, 4)/2.D0 fPsi = self%fPsi(Xi, 4) self%volume = detJ self%arNodes = fPsi*detJ @@ -679,11 +690,12 @@ MODULE moduleMesh2DCart END FUNCTION dPsiTria - PURE SUBROUTINE partialDerTria(self, dPsi, dx, dy) + PURE SUBROUTINE partialDerTria(self, nNodes, dPsi, dx, dy) IMPLICIT NONE CLASS(meshCell2DCartTria), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in):: dPsi(1:3,1:nNodes) REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy dx = (/ DOT_PRODUCT(dPsi(1,:),self%x), & @@ -694,11 +706,12 @@ MODULE moduleMesh2DCart END SUBROUTINE partialDerTria !Computes element local stiffness matrix - PURE FUNCTION elemKTria(self) RESULT(localK) + PURE FUNCTION elemKTria(self, nNodes) RESULT(localK) IMPLICIT NONE CLASS(meshCell2DCartTria), INTENT(in):: self - REAL(8):: localK(1:self%nNodes,1:self%nNodes) + 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 @@ -710,10 +723,10 @@ MODULE moduleMesh2DCart DO l=1, 4 Xi(1) = Xi1Tria(l) Xi(2) = Xi2Tria(l) - dPsi = self%dPsi(Xi, 4) - detJ = self%detJac(Xi,dPsi) - invJ = self%invJac(Xi,dPsi) - fPsi = self%fPsi(Xi, 4) + 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 @@ -721,12 +734,13 @@ MODULE moduleMesh2DCart END FUNCTION elemKTria !Computes element local source vector - PURE FUNCTION elemFTria(self, source) RESULT(localF) + PURE FUNCTION elemFTria(self, nNodes, source) RESULT(localF) IMPLICIT NONE CLASS(meshCell2DCartTria), INTENT(in):: self - REAL(8), INTENT(in):: source(1:self%nNodes) - REAL(8):: localF(1:self%nNodes) + 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 @@ -738,8 +752,8 @@ MODULE moduleMesh2DCart DO l=1, 4 Xi(1) = Xi1Tria(l) Xi(2) = Xi2Tria(l) - detJ = self%detJac(Xi) - fPsi = self%fPsi(Xi, 4) + detJ = self%detJac(Xi, 3) + fPsi = self%fPsi(Xi, 3) f = DOT_PRODUCT(fPsi,source) localF = localF + f*fPsi*wTria(l)*detJ @@ -758,7 +772,7 @@ MODULE moduleMesh2DCart self%n2%emData%phi, & self%n3%emData%phi /) - array = -self%gatherDF(Xi, phi) + array = -self%gatherDF(Xi, 3, phi) END FUNCTION gatherEFTria @@ -798,11 +812,12 @@ MODULE moduleMesh2DCart END FUNCTION insideTria !Gets node indexes from triangular element - PURE FUNCTION getNodesTria(self) RESULT(n) + PURE FUNCTION getNodesTria(self, nNodes) RESULT(n) IMPLICIT NONE CLASS(meshCell2DCartTria), INTENT(in):: self - INTEGER:: n(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + INTEGER:: n(1:nNodes) n = (/self%n1%n, self%n2%n, self%n3%n /) @@ -822,9 +837,9 @@ MODULE moduleMesh2DCart !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, 4) - invJ = self%invJac(Xi, dPsi) - detJ = self%detJac(Xi, dPsi) + dPsi = self%dPsi(Xi, 3) + invJ = self%invJac(Xi, 3, dPsi) + detJ = self%detJac(Xi, 3, dPsi) Xi = MATMUL(invJ,deltaR)/detJ END FUNCTION phy2logTria @@ -854,14 +869,15 @@ MODULE moduleMesh2DCart !COMMON FUNCTIONS FOR CARTESIAN VOLUME ELEMENTS IN 2D !Computes element Jacobian determinant - PURE FUNCTION detJ2DCart(self, Xi, dPsi_in) RESULT(dJ) + PURE FUNCTION detJ2DCart(self, Xi, nNodes, dPsi_in) RESULT(dJ) IMPLICIT NONE CLASS(meshCell2DCart), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:nNodes) REAL(8):: dJ - REAL(8):: dPsi(1:3,1:self%nNodes) + REAL(8):: dPsi(1:3,1:nNodes) REAL(8):: dx(1:2), dy(1:2) IF(PRESENT(dPsi_in)) THEN @@ -872,21 +888,22 @@ MODULE moduleMesh2DCart END IF - CALL self%partialDer(dPsi, dx, dy) + CALL self%partialDer(nNodes, dPsi, dx, dy) dJ = dx(1)*dy(2)-dx(2)*dy(1) END FUNCTION detJ2DCart !Computes element Jacobian inverse matrix (without determinant) - PURE FUNCTION invJ2DCart(self,Xi,dPsi_in) RESULT(invJ) + PURE FUNCTION invJ2DCart(self, Xi, nNodes, dPsi_in) RESULT(invJ) IMPLICIT NONE CLASS(meshCell2DCart), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:nNodes) REAL(8):: invJ(1:3,1:3) - REAL(8):: dPsi(1:3,1:self%nNodes) + REAL(8):: dPsi(1:3,1:nNodes) REAL(8):: dx(1:2), dy(1:2) IF(PRESENT(dPsi_in)) THEN @@ -899,7 +916,7 @@ MODULE moduleMesh2DCart invJ = 0.D0 - CALL self%partialDer(dPsi, dx, dy) + CALL self%partialDer(nNodes, dPsi, dx, dy) invJ(1,1:2) = (/ dy(2), -dx(2) /) invJ(2,1:2) = (/ -dy(1), dx(1) /) diff --git a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 index adf5d4f..d33fbbf 100644 --- a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 +++ b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 @@ -46,10 +46,11 @@ MODULE moduleMesh2DCyl END TYPE meshCell2DCyl ABSTRACT INTERFACE - PURE SUBROUTINE partialDer_interface(self, dPsi, dz, dr) + PURE SUBROUTINE partialDer_interface(self, nNodes, dPsi, dz, dr) IMPORT meshCell2DCyl CLASS(meshCell2DCyl), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in):: dPsi(1:3,1:nNodes) REAL(8), INTENT(out), DIMENSION(1:2):: dz, dr END SUBROUTINE partialDer_interface @@ -166,6 +167,7 @@ MODULE moduleMesh2DCyl INTEGER:: s self%n = n + self%nNodes = SIZE(p) self%n1 => mesh%nodes(p(1))%obj self%n2 => mesh%nodes(p(2))%obj !Get element coordinates @@ -195,13 +197,13 @@ MODULE moduleMesh2DCyl END SUBROUTINE initEdge2DCyl !Get nodes from edge - PURE FUNCTION getNodes2DCyl(self) RESULT(n) + PURE FUNCTION getNodes2DCyl(self, nNodes) RESULT(n) IMPLICIT NONE CLASS(meshEdge2DCyl), INTENT(in):: self - INTEGER, ALLOCATABLE:: n(:) + INTEGER, INTENT(in):: nNodes + INTEGER:: n(1:nNodes) - ALLOCATE(n(1:2)) n = (/self%n1%n, self%n2%n /) END FUNCTION getNodes2DCyl @@ -306,23 +308,23 @@ MODULE moduleMesh2DCyl self%arNodes = 0.D0 !2D 1 point Gauss Quad Integral Xi = 0.D0 - detJ = self%detJac(Xi)*PI8 !4*2*pi + detJ = self%detJac(Xi, 4)*PI8 !4*2*pi fPsi = self%fPsi(Xi, 4) !Computes total volume of the cell r = DOT_PRODUCT(fPsi,self%r) self%volume = r*detJ !Computes volume per node Xi = (/-5.D-1, -5.D-1, 0.D0/) - r = self%gatherF(Xi, self%r) + r = self%gatherF(Xi, 4, self%r) self%arNodes(1) = fPsi(1)*r*detJ Xi = (/ 5.D-1, -5.D-1, 0.D0/) - r = self%gatherF(Xi, self%r) + r = self%gatherF(Xi, 4, self%r) self%arNodes(2) = fPsi(2)*r*detJ Xi = (/ 5.D-1, 5.D-1, 0.D0/) - r = self%gatherF(Xi, self%r) + r = self%gatherF(Xi, 4, self%r) self%arNodes(3) = fPsi(3)*r*detJ Xi = (/-5.D-1, 5.D-1, 0.D0/) - r = self%gatherF(Xi, self%r) + r = self%gatherF(Xi, 4, self%r) self%arNodes(4) = fPsi(4)*r*detJ END SUBROUTINE areaQuad @@ -371,11 +373,12 @@ MODULE moduleMesh2DCyl END FUNCTION dPsiQuad !Partial derivative in global coordinates - PURE SUBROUTINE partialDerQuad(self, dPsi, dz, dr) + PURE SUBROUTINE partialDerQuad(self, nNodes, dPsi, dz, dr) IMPLICIT NONE CLASS(meshCell2DCylQuad), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in):: dPsi(1:3,1:nNodes) REAL(8), INTENT(out), DIMENSION(1:2):: dz, dr dz = (/ DOT_PRODUCT(dPsi(1,1:4),self%z(1:4)), & @@ -408,12 +411,13 @@ MODULE moduleMesh2DCyl END FUNCTION randPosCellQuad !Computes element local stiffness matrix - PURE FUNCTION elemKQuad(self) RESULT(localK) + PURE FUNCTION elemKQuad(self, nNodes) RESULT(localK) USE moduleConstParam, ONLY: PI2 IMPLICIT NONE CLASS(meshCell2DCylQuad), INTENT(in):: self - REAL(8):: localK(1:self%nNodes,1:self%nNodes) + 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):: r @@ -429,8 +433,8 @@ MODULE moduleMesh2DCyl Xi(1) = corQuad(m) fPsi = self%fPsi(Xi, 4) dPsi = self%dPsi(Xi, 4) - detJ = self%detJac(Xi,dPsi) - invJ = self%invJac(Xi,dPsi) + detJ = self%detJac(Xi, 4, dPsi) + invJ = self%invJac(Xi, 4, dPsi) r = DOT_PRODUCT(fPsi,self%r) localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)), & MATMUL(invJ,dPsi))* & @@ -443,13 +447,14 @@ MODULE moduleMesh2DCyl END FUNCTION elemKQuad !Computes the local source vector for a force f - PURE FUNCTION elemFQuad(self, source) RESULT(localF) + PURE FUNCTION elemFQuad(self, nNodes, source) RESULT(localF) USE moduleConstParam, ONLY: PI2 IMPLICIT NONE CLASS(meshCell2DCylQuad), INTENT(in):: self - REAL(8), INTENT(in):: source(1:self%nNodes) - REAL(8):: localF(1:self%nNodes) + 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):: r @@ -462,7 +467,7 @@ MODULE moduleMesh2DCyl Xi(1) = corQuad(l) DO m = 1, 3 Xi(2) = corQuad(m) - detJ = self%detJac(Xi) + detJ = self%detJac(Xi, 4) fPsi = self%fPsi(Xi, 4) r = DOT_PRODUCT(fPsi,self%r) f = DOT_PRODUCT(fPsi,source) @@ -486,7 +491,7 @@ MODULE moduleMesh2DCyl self%n3%emData%phi, & self%n4%emData%phi /) - array = -self%gatherDF(Xi, phi) + array = -self%gatherDF(Xi, 4, phi) END FUNCTION gatherEFQuad @@ -512,7 +517,7 @@ MODULE moduleMesh2DCyl self%n3%emData%B(3), & self%n4%emData%B(3) /) - array = self%gatherF(Xi, 3, B) + array = self%gatherF(Xi, 4, B) END FUNCTION gatherMFQuad @@ -529,11 +534,12 @@ MODULE moduleMesh2DCyl END FUNCTION insideQuad !Gets nodes from quadrilateral element - PURE FUNCTION getNodesQuad(self) RESULT(n) + PURE FUNCTION getNodesQuad(self, nNodes) RESULT(n) IMPLICIT NONE CLASS(meshCell2DCylQuad), INTENT(in):: self - INTEGER:: n(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + INTEGER:: n(1:nNodes) n = (/self%n1%n, self%n2%n, self%n3%n, self%n4%n /) @@ -556,8 +562,8 @@ MODULE moduleMesh2DCyl DO WHILE(conv > 1.D-2) dPsi = self%dPsi(XiO, 4) - invJ = self%invJac(XiO, dPsi) - detJ = self%detJac(XiO, dPsi) + invJ = self%invJac(XiO, 4, dPsi) + detJ = self%detJac(XiO, 4, dPsi) fPsi = self%fPsi(XiO, 4) f = (/ DOT_PRODUCT(fPsi,self%z), & DOT_PRODUCT(fPsi,self%r), & @@ -676,7 +682,7 @@ MODULE moduleMesh2DCyl 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)*PI !2PI*1/2 + detJ = self%detJac(Xi, 3)*PI !2PI*1/2 fPsi = self%fPsi(Xi, 4) !Computes total volume of the cell r = DOT_PRODUCT(fPsi,self%r) @@ -717,11 +723,12 @@ MODULE moduleMesh2DCyl END FUNCTION dPsiTria - PURE SUBROUTINE partialDerTria(self, dPsi, dz, dr) + PURE SUBROUTINE partialDerTria(self, nNodes, dPsi, dz, dr) IMPLICIT NONE CLASS(meshCell2DCylTria), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in):: dPsi(1:3,1:nNodes) REAL(8), INTENT(out), DIMENSION(1:2):: dz, dr dz = (/ DOT_PRODUCT(dPsi(1,:),self%z), & @@ -732,12 +739,13 @@ MODULE moduleMesh2DCyl END SUBROUTINE partialDerTria !Computes element local stiffness matrix - PURE FUNCTION elemKTria(self) RESULT(localK) + PURE FUNCTION elemKTria(self, nNodes) RESULT(localK) USE moduleConstParam, ONLY: PI2 IMPLICIT NONE CLASS(meshCell2DCylTria), INTENT(in):: self - REAL(8):: localK(1:self%nNodes,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8):: localK(1:nNodes,1:nNodes) REAL(8):: Xi(1:3) REAL(8):: r REAL(8):: fPsi(1:3), dPsi(1:3,1:3) @@ -751,8 +759,8 @@ MODULE moduleMesh2DCyl Xi(1) = Xi1Tria(l) Xi(2) = Xi2Tria(l) dPsi = self%dPsi(Xi, 4) - detJ = self%detJac(Xi,dPsi) - invJ = self%invJac(Xi,dPsi) + detJ = self%detJac(Xi, 3, dPsi) + invJ = self%invJac(Xi, 3, dPsi) fPsi = self%fPsi(Xi, 4) r = DOT_PRODUCT(fPsi,self%r) localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*r*wTria(l)/detJ @@ -763,13 +771,14 @@ MODULE moduleMesh2DCyl END FUNCTION elemKTria !Computes element local source vector - PURE FUNCTION elemFTria(self, source) RESULT(localF) + PURE FUNCTION elemFTria(self, nNodes, source) RESULT(localF) USE moduleConstParam, ONLY: PI2 IMPLICIT NONE CLASS(meshCell2DCylTria), INTENT(in):: self - REAL(8), INTENT(in):: source(1:self%nNodes) - REAL(8):: localF(1:self%nNodes) + 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):: r @@ -782,8 +791,8 @@ MODULE moduleMesh2DCyl DO l=1, 4 Xi(1) = Xi1Tria(l) Xi(2) = Xi2Tria(l) - detJ = self%detJac(Xi) - fPsi = self%fPsi(Xi, 4) + detJ = self%detJac(Xi, 3) + fPsi = self%fPsi(Xi, 3) r = DOT_PRODUCT(fPsi,self%r) f = DOT_PRODUCT(fPsi,source) localF = localF + r*f*fPsi*wTria(l)*detJ @@ -804,7 +813,7 @@ MODULE moduleMesh2DCyl self%n2%emData%phi, & self%n3%emData%phi /) - array = -self%gatherDF(Xi, phi) + array = -self%gatherDF(Xi, 4, phi) END FUNCTION gatherEFTria @@ -844,11 +853,12 @@ MODULE moduleMesh2DCyl END FUNCTION insideTria !Gets node indexes from triangular element - PURE FUNCTION getNodesTria(self) RESULT(n) + PURE FUNCTION getNodesTria(self, nNodes) RESULT(n) IMPLICIT NONE CLASS(meshCell2DCylTria), INTENT(in):: self - INTEGER:: n(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + INTEGER:: n(1:nNodes) n = (/self%n1%n, self%n2%n, self%n3%n /) @@ -868,9 +878,9 @@ MODULE moduleMesh2DCyl !Direct method to convert coordinates Xi = 0.D0 deltaR = (/ r(1) - self%z(1), r(2) - self%r(1), 0.D0 /) - dPsi = self%dPsi(Xi, 4) - invJ = self%invJac(Xi, dPsi) - detJ = self%detJac(Xi, dPsi) + dPsi = self%dPsi(Xi, 3) + invJ = self%invJac(Xi, 3, dPsi) + detJ = self%detJac(Xi, 3, dPsi) Xi = MATMUL(invJ,deltaR)/detJ END FUNCTION phy2logTria @@ -900,39 +910,41 @@ MODULE moduleMesh2DCyl !COMMON FUNCTIONS FOR CYLINDRICAL VOLUME ELEMENTS !Computes element Jacobian determinant - PURE FUNCTION detJ2DCyl(self, Xi, dPsi_in) RESULT(dJ) + PURE FUNCTION detJ2DCyl(self, Xi, nNodes, dPsi_in) RESULT(dJ) IMPLICIT NONE CLASS(meshCell2DCyl), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:nNodes) REAL(8):: dJ - REAL(8):: dPsi(1:3,1:self%nNodes) + REAL(8):: dPsi(1:3,1:nNodes) REAL(8):: dz(1:2), dr(1:2) IF(PRESENT(dPsi_in)) THEN dPsi = dPsi_in ELSE - dPsi = self%dPsi(Xi, 4) + dPsi = self%dPsi(Xi, nNodes) END IF - CALL self%partialDer(dPsi, dz, dr) + CALL self%partialDer(nNodes, dPsi, dz, dr) dJ = dz(1)*dr(2)-dz(2)*dr(1) END FUNCTION detJ2DCyl !Computes element Jacobian inverse matrix (without determinant) - PURE FUNCTION invJ2DCyl(self,Xi,dPsi_in) RESULT(invJ) + PURE FUNCTION invJ2DCyl(self, Xi, nNodes, dPsi_in) RESULT(invJ) IMPLICIT NONE CLASS(meshCell2DCyl), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:nNodes) REAL(8):: invJ(1:3,1:3) - REAL(8):: dPsi(1:3,1:self%nNodes) + REAL(8):: dPsi(1:3,1:nNodes) REAL(8):: dz(1:2), dr(1:2) IF(PRESENT(dPsi_in)) THEN @@ -945,7 +957,7 @@ MODULE moduleMesh2DCyl invJ = 0.D0 - CALL self%partialDer(dPsi, dz, dr) + CALL self%partialDer(nNodes, dPsi, dz, dr) invJ(1,1:2) = (/ dr(2), -dz(2) /) invJ(2,1:2) = (/ -dr(1), dz(1) /) diff --git a/src/modules/mesh/3DCart/moduleMesh3DCart.f90 b/src/modules/mesh/3DCart/moduleMesh3DCart.f90 index 3018989..705587a 100644 --- a/src/modules/mesh/3DCart/moduleMesh3DCart.f90 +++ b/src/modules/mesh/3DCart/moduleMesh3DCart.f90 @@ -40,10 +40,11 @@ MODULE moduleMesh3DCart END TYPE meshCell3DCart ABSTRACT INTERFACE - PURE SUBROUTINE partialDer_interface(self, dPsi, dx, dy, dz) + PURE SUBROUTINE partialDer_interface(self, nNodes, dPsi, dx, dy, dz) IMPORT meshCell3DCart CLASS(meshCell3DCart), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes) + 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 @@ -59,7 +60,7 @@ MODULE moduleMesh3DCart !Connectivity to adjacent elements CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL(), e3 => NULL(), e4 => NULL() CONTAINS - PROCEDURE, PASS:: init => initCellTetra3DCart + PROCEDURE, PASS:: init => initCellTetra PROCEDURE, PASS:: randPos => randPosCellTetra PROCEDURE, PASS:: calcCell => volumeTetra PROCEDURE, PASS:: fPsi => fPsiTetra @@ -135,6 +136,7 @@ MODULE moduleMesh3DCart INTEGER:: s self%n = n + self%nNodes = SIZE(p) self%n1 => mesh%nodes(p(1))%obj self%n2 => mesh%nodes(p(2))%obj self%n3 => mesh%nodes(p(3))%obj @@ -170,13 +172,13 @@ MODULE moduleMesh3DCart END SUBROUTINE initEdge3DCartTria !Get nodes from surface - PURE FUNCTION getNodes3DCartTria(self) RESULT(n) + PURE FUNCTION getNodes3DCartTria(self, nNodes) RESULT(n) IMPLICIT NONE CLASS(meshEdge3DCartTria), INTENT(in):: self - INTEGER, ALLOCATABLE:: n(:) + INTEGER, INTENT(in):: nNodes + INTEGER:: n(1:nNodes) - ALLOCATE(n(1:3)) n = (/self%n1%n, self%n2%n, self%n3%n/) END FUNCTION getNodes3DCartTria @@ -238,7 +240,7 @@ MODULE moduleMesh3DCart !VOLUME FUNCTIONS !TETRA FUNCTIONS !Inits tetrahedron element - SUBROUTINE initCellTetra3DCart(self, n, p, nodes) + SUBROUTINE initCellTetra(self, n, p, nodes) USE moduleRefParam IMPLICIT NONE @@ -282,7 +284,7 @@ MODULE moduleMesh3DCart ALLOCATE(self%listPart_in(1:nSpecies)) ALLOCATE(self%totalWeight(1:nSpecies)) - END SUBROUTINE initCellTetra3DCart + END SUBROUTINE initCellTetra !Random position in volume tetrahedron FUNCTION randPosCellTetra(self) RESULT(r) @@ -315,7 +317,7 @@ MODULE moduleMesh3DCart self%volume = 0.D0 Xi = (/0.25D0, 0.25D0, 0.25D0/) - self%volume = self%detJac(Xi) + self%volume = self%detJac(Xi, 4) END SUBROUTINE volumeTetra @@ -392,11 +394,12 @@ MODULE moduleMesh3DCart END FUNCTION dPsiTetraXi3 !Computes the derivatives in global coordinates - PURE SUBROUTINE partialDerTetra(self, dPsi, dx, dy, dz) + PURE SUBROUTINE partialDerTetra(self, nNodes, dPsi, dx, dy, dz) IMPLICIT NONE CLASS(meshCell3DCartTetra), INTENT(in):: self - REAL(8), INTENT(in):: dPsi(1:3, 1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in):: dPsi(1:3, 1:nNodes) REAL(8), INTENT(out), DIMENSION(1:3):: dx, dy, dz dx(1) = DOT_PRODUCT(dPsi(1,:), self%x) @@ -413,11 +416,12 @@ MODULE moduleMesh3DCart END SUBROUTINE partialDerTetra - PURE FUNCTION elemKTetra(self) RESULT(localK) + PURE FUNCTION elemKTetra(self, nNodes) RESULT(localK) IMPLICIT NONE CLASS(meshCell3DCartTetra), INTENT(in):: self - REAL(8):: localK(1:self%nNodes,1:self%nNodes) + 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 @@ -427,19 +431,20 @@ MODULE moduleMesh3DCart !TODO: One point Gauss integral. Upgrade when possible Xi = (/ 0.25D0, 0.25D0, 0.25D0 /) dPsi = self%dPsi(Xi, 4) - detJ = self%detJac(Xi, dPsi) - invJ = self%invJac(Xi, dPsi) + 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, source) RESULT(localF) + PURE FUNCTION elemFTetra(self, nNodes, source) RESULT(localF) IMPLICIT NONE CLASS(meshCell3DCartTetra), INTENT(in):: self - REAL(8), INTENT(in):: source(1:self%nNodes) - REAL(8):: localF(1:self%nNodes) + 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 @@ -448,7 +453,7 @@ MODULE moduleMesh3DCart Xi = 0.D0 Xi = (/ 0.25D0, 0.25D0, 0.25D0 /) dPsi = self%dPsi(Xi, 4) - detJ = self%detJac(Xi, dPsi) + detJ = self%detJac(Xi, 4, dPsi) fPsi = self%fPsi(Xi, 4) f = DOT_PRODUCT(fPsi, source) localF = f*fPsi*1.D0*detJ @@ -467,7 +472,7 @@ MODULE moduleMesh3DCart self%n3%emData%phi, & self%n4%emData%phi /) - array = -self%gatherDF(Xi, phi) + array = -self%gatherDF(Xi, 4, phi) END FUNCTION gatherEFTetra @@ -493,7 +498,7 @@ MODULE moduleMesh3DCart self%n3%emData%B(3), & self%n4%emData%B(3) /) - array = self%gatherF(Xi, 3, B) + array = self%gatherF(Xi, 4, B) END FUNCTION gatherMFTetra @@ -510,11 +515,12 @@ MODULE moduleMesh3DCart END FUNCTION insideTetra - PURE FUNCTION getNodesTetra(self) RESULT(n) + PURE FUNCTION getNodesTetra(self, nNodes) RESULT(n) IMPLICIT NONE CLASS(meshCell3DCartTetra), INTENT(in):: self - INTEGER:: n(1:self%nnodes) + INTEGER, INTENT(in):: nNodes + INTEGER:: n(1:nNodes) n = (/self%n1%n, self%n2%n, self%n3%n, self%n4%n /) @@ -533,8 +539,8 @@ MODULE moduleMesh3DCart 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, dPsi) - detJ = self%detJac(Xi, dPsi) + invJ = self%invJac(Xi, 4, dPsi) + detJ = self%detJac(Xi, 4, dPsi) Xi = MATMUL(invJ, deltaR)/detJ END FUNCTION phy2logTetra @@ -567,14 +573,15 @@ MODULE moduleMesh3DCart !COMMON FUNCTIONS FOR CARTESIAN VOLUME ELEMENTS IN 3D !Computes element Jacobian determinant - PURE FUNCTION detJ3DCart(self, Xi, dPsi_in) RESULT(dJ) + PURE FUNCTION detJ3DCart(self, Xi, nNodes, dPsi_in) RESULT(dJ) IMPLICIT NONE CLASS(meshCell3DCart), INTENT(in)::self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3, 1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3, 1:nNodes) REAL(8):: dJ - REAL(8):: dPsi(1:3, 1:self%nNodes) + REAL(8):: dPsi(1:3, 1:nNodes) REAL(8):: dx(1:3), dy(1:3), dz(1:3) IF (PRESENT(dPsi_in)) THEN @@ -585,20 +592,21 @@ MODULE moduleMesh3DCart END IF - CALL self%partialDer(dPsi, dx, dy, dz) + 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)) END FUNCTION detJ3DCart - PURE FUNCTION invJ3DCart(self,Xi,dPsi_in) RESULT(invJ) + PURE FUNCTION invJ3DCart(self, Xi, nNodes, dPsi_in) RESULT(invJ) IMPLICIT NONE CLASS(meshCell3DCart), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3, 1:self%nNodes) - REAL(8):: dPsi(1:3, 1:self%nNodes) + 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):: invJ(1:3,1:3) @@ -610,7 +618,7 @@ MODULE moduleMesh3DCart END IF - CALL self%partialDer(dPsi, dx, dy, dz) + 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)) diff --git a/src/modules/mesh/moduleMesh.f90 b/src/modules/mesh/moduleMesh.f90 index aeba4ba..6561850 100644 --- a/src/modules/mesh/moduleMesh.f90 +++ b/src/modules/mesh/moduleMesh.f90 @@ -66,6 +66,8 @@ MODULE moduleMesh !Parent of Edge element TYPE, PUBLIC, ABSTRACT, EXTENDS(meshElement):: meshEdge + !Nomber of nodes in the edge + INTEGER:: nNodes !Connectivity to cells CLASS(meshCell), POINTER:: e1 => NULL(), e2 => NULL() !Connectivity to cells in meshColl @@ -102,10 +104,11 @@ MODULE moduleMesh END SUBROUTINE initEdge_interface !Get nodes index from node - PURE FUNCTION getNodesEdge_interface(self) RESULT(n) + PURE FUNCTION getNodesEdge_interface(self, nNodes) RESULT(n) IMPORT:: meshEdge CLASS(meshEdge), INTENT(in):: self - INTEGER, ALLOCATABLE:: n(:) + INTEGER, INTENT(in):: nNodes + INTEGER:: n(1:nNodes) END FUNCTION getNodesEdge_interface @@ -166,7 +169,7 @@ MODULE moduleMesh !Init the cell PROCEDURE(initCell_interface), DEFERRED, PASS:: init !Get the index of the nodes - PROCEDURE(getNodesVol_interface), DEFERRED, PASS:: getNodes + PROCEDURE(getNodesCell_interface), DEFERRED, PASS:: getNodes !Calculate random position on the cell PROCEDURE(randPosVol_interface), DEFERRED, PASS:: randPos !Obtain functions and values of cell natural functions @@ -208,12 +211,13 @@ MODULE moduleMesh END SUBROUTINE initCell_interface - PURE FUNCTION getNodesVol_interface(self) RESULT(n) + PURE FUNCTION getNodesCell_interface(self, nNodes) RESULT(n) IMPORT:: meshCell CLASS(meshCell), INTENT(in):: self - INTEGER:: n(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + INTEGER:: n(1:nNodes) - END FUNCTION getNodesVol_interface + END FUNCTION getNodesCell_interface PURE FUNCTION fPsi_interface(self, Xi, nNodes) RESULT(fPsi) IMPORT:: meshCell @@ -233,20 +237,22 @@ MODULE moduleMesh END FUNCTION dPsi_interface - PURE FUNCTION detJac_interface(self, Xi, dPsi_in) RESULT(dJ) + PURE FUNCTION detJac_interface(self, Xi, nNodes, dPsi_in) RESULT(dJ) IMPORT:: meshCell CLASS(meshCell), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:nNodes) REAL(8):: dJ END FUNCTION detJac_interface - PURE FUNCTION invJac_interface(self, Xi, dPsi_in) RESULT(invJ) + PURE FUNCTION invJac_interface(self, Xi, nNodes, dPsi_in) RESULT(invJ) IMPORT:: meshCell CLASS(meshCell), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:nNodes) REAL(8):: invJ(1:3,1:3) END FUNCTION invJac_interface @@ -259,18 +265,20 @@ MODULE moduleMesh END FUNCTION gatherArray_interface - PURE FUNCTION elemK_interface(self) RESULT(localK) + PURE FUNCTION elemK_interface(self, nNodes) RESULT(localK) IMPORT:: meshCell CLASS(meshCell), INTENT(in):: self - REAL(8):: localK(1:self%nNodes,1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8):: localK(1:nNodes,1:nNodes) END FUNCTION elemK_interface - PURE FUNCTION elemF_interface(self, source) RESULT(localF) + PURE FUNCTION elemF_interface(self, nNodes, source) RESULT(localF) IMPORT:: meshCell CLASS(meshCell), INTENT(in):: self - REAL(8), INTENT(in):: source(1:self%nNodes) - REAL(8):: localF(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in):: source(1:nNodes) + REAL(8):: localF(1:nNodes) END FUNCTION elemF_interface @@ -478,19 +486,22 @@ MODULE moduleMesh CONTAINS !Constructs the global K matrix - SUBROUTINE constructGlobalK(self) + PURE SUBROUTINE constructGlobalK(self) IMPLICIT NONE CLASS(meshParticles), INTENT(inout):: self INTEGER:: e + INTEGER:: nNodes INTEGER, ALLOCATABLE:: n(:) REAL(8), ALLOCATABLE:: localK(:,:) - INTEGER:: nNodes, i, j + INTEGER:: i, j DO e = 1, self%numCells - n = self%cells(e)%obj%getNodes() - localK = self%cells(e)%obj%elemK() - nNodes = SIZE(n) + nNodes = self%cells(e)%obj%nNodes + ALLOCATE(n(1:nNodes)) + ALLOCATE(localK(1:nNodes, 1:nNodes)) + n = self%cells(e)%obj%getNodes(nNodes) + localK = self%cells(e)%obj%elemK(nNodes) DO i = 1, nNodes DO j = 1, nNodes @@ -499,6 +510,8 @@ MODULE moduleMesh END DO END DO + + DEALLOCATE(n, localK) END DO @@ -523,51 +536,53 @@ MODULE moduleMesh END SUBROUTINE resetOutput !Gather the value of valNodes (scalar) at position Xi - PURE FUNCTION gatherF_scalar(self, Xi, valNodes) RESULT(f) + PURE FUNCTION gatherF_scalar(self, Xi, nNodes, valNodes) RESULT(f) IMPLICIT NONE CLASS(meshCell), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in):: valNodes(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in):: valNodes(1:nNodes) REAL(8):: f - REAL(8):: fPsi(1:self%nNodes) + REAL(8):: fPsi(1:nNodes) - fPsi = self%fPsi(Xi, self%nNodes) + fPsi = self%fPsi(Xi, nNodes) f = DOT_PRODUCT(fPsi, valNodes) END FUNCTION gatherF_scalar !Gather the value of valNodes (array) at position Xi - PURE FUNCTION gatherF_array(self, Xi, n, valNodes) RESULT(f) + PURE FUNCTION gatherF_array(self, Xi, nNodes, valNodes) RESULT(f) IMPLICIT NONE CLASS(meshCell), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - INTEGER, INTENT(in):: n - REAL(8), INTENT(in):: valNodes(1:self%nNodes, 1:n) - REAL(8):: f(1:n) - REAL(8):: fPsi(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in):: valNodes(1:nNodes, 1:3) + REAL(8):: f(1:3) + REAL(8):: fPsi(1:nNodes) - fPsi = self%fPsi(Xi, self%nNodes) + fPsi = self%fPsi(Xi, nNodes) f = MATMUL(fPsi, valNodes) END FUNCTION gatherF_array !Gather the spatial derivative of valNodes (scalar) at position Xi - PURE FUNCTION gatherDF_scalar(self, Xi, valNodes) RESULT(df) + PURE FUNCTION gatherDF_scalar(self, Xi, nNodes, valNodes) RESULT(df) IMPLICIT NONE CLASS(meshCell), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - REAL(8), INTENT(in):: valNodes(1:self%nNodes) + INTEGER, INTENT(in):: nNodes + REAL(8), INTENT(in):: valNodes(1:nNodes) REAL(8):: df(1:3) - REAL(8):: dPsi(1:3, 1:self%nNodes) - REAL(8):: dPsiR(1:3, 1:self%nNodes) + REAL(8):: dPsi(1:3, 1:nNodes) + REAL(8):: dPsiR(1:3, 1:nNodes) REAL(8):: invJ(1:3, 1:3), detJ - dPsi = self%dPsi(Xi, self%nNodes) - detJ = self%detJac(Xi, dPsi) - invJ = self%invJac(Xi, dPsi) + dPsi = self%dPsi(Xi, nNodes) + detJ = self%detJac(Xi, nNodes, dPsi) + invJ = self%invJac(Xi, nNodes, dPsi) dPsiR = MATMUL(invJ, dPsi)/detJ df = (/ DOT_PRODUCT(dPsiR(1,:), valNodes), & DOT_PRODUCT(dPsiR(2,:), valNodes), & @@ -576,29 +591,30 @@ MODULE moduleMesh END FUNCTION gatherDF_scalar !Scatters particle properties into cell nodes - SUBROUTINE scatter(self, part) + SUBROUTINE scatter(self, nNodes, part) USE moduleMath USE moduleSpecies USE OMP_LIB IMPLICIT NONE CLASS(meshCell), INTENT(inout):: self + INTEGER, INTENT(in):: nNodes CLASS(particle), INTENT(in):: part - REAL(8):: fPsi(1:self%nNodes) - INTEGER:: cellNodes(1:self%nNodes) + REAL(8):: fPsi(1:nNodes) + INTEGER:: cellNodes(1:nNodes) REAL(8):: tensorS(1:3, 1:3) INTEGER:: sp INTEGER:: i CLASS(meshNode), POINTER:: node - cellNodes = self%getNodes() - fPsi = self%fPsi(part%Xi, self%nNodes) + cellNodes = self%getNodes(nNodes) + fPsi = self%fPsi(part%Xi, nNodes) tensorS = outerProduct(part%v, part%v) sp = part%species%n - DO i = 1, self%nNodes + DO i = 1, nNodes node => mesh%nodes(cellNodes(i))%obj CALL OMP_SET_LOCK(node%lock) node%output(sp)%den = node%output(sp)%den + part%weight*fPsi(i) diff --git a/src/modules/mesh/moduleMeshBoundary.f90 b/src/modules/mesh/moduleMeshBoundary.f90 index cc5d78c..713c091 100644 --- a/src/modules/mesh/moduleMeshBoundary.f90 +++ b/src/modules/mesh/moduleMeshBoundary.f90 @@ -55,10 +55,10 @@ MODULE moduleMeshBoundary !Scatter particle in associated volume IF (ASSOCIATED(edge%e1)) THEN - CALL edge%e1%scatter(part) + CALL edge%e1%scatter(edge%e1%nNodes, part) ELSE - CALL edge%e2%scatter(part) + CALL edge%e2%scatter(edge%e2%nNodes, part) END IF diff --git a/src/modules/solver/electromagnetic/moduleEM.f90 b/src/modules/solver/electromagnetic/moduleEM.f90 index 55eb618..bdf6b03 100644 --- a/src/modules/solver/electromagnetic/moduleEM.f90 +++ b/src/modules/solver/electromagnetic/moduleEM.f90 @@ -26,12 +26,14 @@ MODULE moduleEM CLASS(boundaryEM), INTENT(in):: self CLASS(meshEdge):: edge + INTEGER:: nNodes INTEGER, ALLOCATABLE:: nodes(:) INTEGER:: n - nodes = edge%getNodes() + nNodes = edge%nNodes + nodes = edge%getNodes(nNodes) - DO n = 1, SIZE(nodes) + DO n = 1, nNodes SELECT CASE(self%typeEM) CASE ("dirichlet") mesh%K(nodes(n), :) = 0.D0 @@ -66,8 +68,8 @@ MODULE moduleEM !$OMP DO REDUCTION(+:vectorF) DO e = 1, mesh%numCells - nodes = mesh%cells(e)%obj%getNodes() - nNodes = SIZE(nodes) + nNodes = mesh%cells(e)%obj%nNodes + nodes = mesh%cells(e)%obj%getNodes(nNodes) !Calculates charge density (rho) in element nodes ALLOCATE(rho(1:nNodes)) rho = 0.D0 @@ -79,7 +81,7 @@ MODULE moduleEM END DO !Calculates local F vector - localF = mesh%cells(e)%obj%elemF(rho) + localF = mesh%cells(e)%obj%elemF(nNodes, rho) !Assign local F to global F DO i = 1, nNodes diff --git a/src/modules/solver/moduleSolver.f90 b/src/modules/solver/moduleSolver.f90 index 6962075..02932c9 100644 --- a/src/modules/solver/moduleSolver.f90 +++ b/src/modules/solver/moduleSolver.f90 @@ -354,11 +354,13 @@ MODULE moduleSolver IMPLICIT NONE INTEGER:: n + CLASS(meshCell), POINTER:: cell !Loops over the particles to scatter them !$OMP DO DO n = 1, nPartOld - CALL mesh%cells(partOld(n)%vol)%obj%scatter(partOld(n)) + cell => mesh%cells(partOld(n)%vol)%obj + CALL cell%scatter(cell%nNodes, partOld(n)) END DO !$OMP END DO From ba272de4e3c711e0a13706283ebcf1c6ae96a464 Mon Sep 17 00:00:00 2001 From: JGonzalez Date: Fri, 6 Jan 2023 12:16:54 +0100 Subject: [PATCH 07/13] DOES NOT COMPILE: Break Small break of changing functions. Still some geometries to change. --- src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 | 747 +++++++++---------- src/modules/mesh/3DCart/moduleMesh3DCart.f90 | 370 ++++----- src/modules/mesh/moduleMesh.f90 | 152 ++-- 3 files changed, 589 insertions(+), 680 deletions(-) diff --git a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 index d33fbbf..1e8c79d 100644 --- a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 +++ b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 @@ -19,7 +19,8 @@ MODULE moduleMesh2DCyl !Element coordinates REAL(8):: r = 0.D0, z = 0.D0 CONTAINS - PROCEDURE, PASS:: init => initNode2DCyl + !meshNode DEFERRED PROCEDURES + PROCEDURE, PASS:: init => initNode2DCyl PROCEDURE, PASS:: getCoordinates => getCoord2DCyl END TYPE meshNode2DCyl @@ -30,35 +31,16 @@ MODULE moduleMesh2DCyl !Connectivity to nodes CLASS(meshNode), POINTER:: n1 => NULL(), n2 => NULL() CONTAINS - PROCEDURE, PASS:: init => initEdge2DCyl - PROCEDURE, PASS:: getNodes => getNodes2DCyl + !meshEdge DEFERRED PROCEDURES + PROCEDURE, PASS:: init => initEdge2DCyl + PROCEDURE, PASS:: getNodes => getNodes2DCyl PROCEDURE, PASS:: intersection => intersection2DCylEdge - PROCEDURE, PASS:: randPos => randPosEdge + PROCEDURE, PASS:: randPos => randPosEdge END TYPE meshEdge2DCyl - TYPE, PUBLIC, ABSTRACT, EXTENDS(meshCell):: meshCell2DCyl - CONTAINS - PROCEDURE, PASS:: detJac => detJ2DCyl - PROCEDURE, PASS:: invJac => invJ2DCyl - PROCEDURE(partialDer_interface), DEFERRED, PASS, PRIVATE:: partialDer - - END TYPE meshCell2DCyl - - ABSTRACT INTERFACE - PURE SUBROUTINE partialDer_interface(self, nNodes, dPsi, dz, dr) - IMPORT meshCell2DCyl - CLASS(meshCell2DCyl), INTENT(in):: self - INTEGER, INTENT(in):: nNodes - REAL(8), INTENT(in):: dPsi(1:3,1:nNodes) - REAL(8), INTENT(out), DIMENSION(1:2):: dz, dr - - END SUBROUTINE partialDer_interface - - END INTERFACE - !Quadrilateral volume element - TYPE, PUBLIC, EXTENDS(meshCell2DCyl):: meshCell2DCylQuad + TYPE, PUBLIC, EXTENDS(meshCell):: meshCell2DCylQuad !Element coordinates REAL(8):: r(1:4) = 0.D0, z(1:4) = 0.D0 !Connectivity to nodes @@ -68,25 +50,29 @@ MODULE moduleMesh2DCyl REAL(8):: arNodes(1:4) = 0.D0 CONTAINS - PROCEDURE, PASS:: init => initCellQuad2DCyl - 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 => initCellQuad2DCyl + PROCEDURE, PASS:: getNodes => getNodesQuad + PROCEDURE, PASS:: randPos => randPosCellQuad + PROCEDURE, NOPASS:: fPsi => fPsiQuad + PROCEDURE, NOPASS:: dPsi => dPsiQuad + PROCEDURE, PASS:: partialDer => partialDerQuad + PROCEDURE, NOPASS:: detJac => detJ2DCyl + PROCEDURE, NOPASS:: invJac => invJ2DCyl + 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:: area => areaQuad END TYPE meshCell2DCylQuad !Triangular volume element - TYPE, PUBLIC, EXTENDS(meshCell2DCyl):: meshCell2DCylTria + TYPE, PUBLIC, EXTENDS(meshCell):: meshCell2DCylTria !Element coordinates REAL(8):: r(1:3) = 0.D0, z(1:3) = 0.D0 !Connectivity to nodes @@ -96,20 +82,24 @@ MODULE moduleMesh2DCyl REAL(8):: arNodes(1:3) = 0.D0 CONTAINS - PROCEDURE, PASS:: init => initCellTria2DCyl - 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 => initCellTria2DCyl + PROCEDURE, PASS:: getNodes => getNodesTria + PROCEDURE, PASS:: randPos => randPosCellTria + PROCEDURE, NOPASS:: fPsi => fPsiTria + PROCEDURE, NOPASS:: dPsi => dPsiTria + PROCEDURE, PASS:: partialDer => partialDerTria + PROCEDURE, NOPASS:: detJac => detJ2DCyl + PROCEDURE, NOPASS:: invJac => invJ2DCyl + 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:: area => areaTria END TYPE meshCell2DCylTria @@ -294,99 +284,17 @@ MODULE moduleMesh2DCyl END SUBROUTINE initCellQuad2DCyl - !Computes element area - PURE SUBROUTINE areaQuad(self) - USE moduleConstParam, ONLY: PI8 - IMPLICIT NONE - - CLASS(meshCell2DCylQuad), INTENT(inout):: self - REAL(8):: r, Xi(1:3) - REAL(8):: detJ - REAL(8):: fPsi(1:4), fPsi_node(1:4) - - self%volume = 0.D0 - self%arNodes = 0.D0 - !2D 1 point Gauss Quad Integral - Xi = 0.D0 - detJ = self%detJac(Xi, 4)*PI8 !4*2*pi - fPsi = self%fPsi(Xi, 4) - !Computes total volume of the cell - r = DOT_PRODUCT(fPsi,self%r) - self%volume = r*detJ - !Computes volume per node - Xi = (/-5.D-1, -5.D-1, 0.D0/) - r = self%gatherF(Xi, 4, self%r) - self%arNodes(1) = fPsi(1)*r*detJ - Xi = (/ 5.D-1, -5.D-1, 0.D0/) - r = self%gatherF(Xi, 4, self%r) - self%arNodes(2) = fPsi(2)*r*detJ - Xi = (/ 5.D-1, 5.D-1, 0.D0/) - r = self%gatherF(Xi, 4, self%r) - self%arNodes(3) = fPsi(3)*r*detJ - Xi = (/-5.D-1, 5.D-1, 0.D0/) - r = self%gatherF(Xi, 4, self%r) - self%arNodes(4) = fPsi(4)*r*detJ - - END SUBROUTINE areaQuad - - !Computes element functions in point Xi - PURE FUNCTION fPsiQuad(self, Xi, nNodes) RESULT(fPsi) - IMPLICIT NONE - - CLASS(meshCell2DCylQuad), INTENT(in):: self - 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(self, Xi, nNodes) RESULT(dPsi) - IMPLICIT NONE - - CLASS(meshCell2DCylQuad), 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, dz, dr) + !Gets nodes from quadrilateral element + PURE FUNCTION getNodesQuad(self, nNodes) RESULT(n) IMPLICIT NONE CLASS(meshCell2DCylQuad), INTENT(in):: self INTEGER, INTENT(in):: nNodes - REAL(8), INTENT(in):: dPsi(1:3,1:nNodes) - REAL(8), INTENT(out), DIMENSION(1:2):: dz, dr + INTEGER:: n(1:nNodes) - dz = (/ DOT_PRODUCT(dPsi(1,1:4),self%z(1:4)), & - DOT_PRODUCT(dPsi(2,1:4),self%z(1:4)) /) - dr = (/ DOT_PRODUCT(dPsi(1,1:4),self%r(1:4)), & - DOT_PRODUCT(dPsi(2,1:4),self%r(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) @@ -410,74 +318,64 @@ MODULE moduleMesh2DCyl END FUNCTION randPosCellQuad - !Computes element local stiffness matrix - PURE FUNCTION elemKQuad(self, nNodes) RESULT(localK) - USE moduleConstParam, ONLY: PI2 + !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.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 FUNCTION partialDerQuad(self, nNodes, dPsi) RESULT(pDer) IMPLICIT NONE CLASS(meshCell2DCylQuad), 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):: r - 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) - r = DOT_PRODUCT(fPsi,self%r) - localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)), & - MATMUL(invJ,dPsi))* & - r*wQuad(l)*wQuad(m)/detJ + pDer = 0.D0 - END DO - END DO - localK = localK*PI2 + pDer(1, 1:2) = (/ DOT_PRODUCT(dPsi(1,1:4),self%z(1:4)), & + DOT_PRODUCT(dPsi(2,1:4),self%z(1:4)) /) + pDer(2, 1:2) = (/ DOT_PRODUCT(dPsi(1,1:4),self%r(1:4)), & + DOT_PRODUCT(dPsi(2,1:4),self%r(1:4)) /) - END FUNCTION elemKQuad - - !Computes the local source vector for a force f - PURE FUNCTION elemFQuad(self, nNodes, source) RESULT(localF) - USE moduleConstParam, ONLY: PI2 - IMPLICIT NONE - - CLASS(meshCell2DCylQuad), 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):: r - 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) - r = DOT_PRODUCT(fPsi,self%r) - f = DOT_PRODUCT(fPsi,source) - localF = localF + r*f*fPsi*wQuad(l)*wQuad(m)*detJ - - END DO - END DO - localF = localF*PI2 - - END FUNCTION elemFQuad + END FUNCTION partialDerQuad PURE FUNCTION gatherEFQuad(self, Xi) RESULT(array) IMPLICIT NONE @@ -521,6 +419,80 @@ MODULE moduleMesh2DCyl END FUNCTION gatherMFQuad + !Computes element local stiffness matrix + PURE FUNCTION elemKQuad(self, nNodes) RESULT(localK) + USE moduleConstParam, ONLY: PI2 + IMPLICIT NONE + + CLASS(meshCell2DCylQuad), 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):: 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) + fPsi = self%fPsi(Xi, 4) + r = DOT_PRODUCT(fPsi,self%r) + localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)), & + MATMUL(invJ,dPsi))* & + r*wQuad(l)*wQuad(m)/detJ + + END DO + END DO + localK = localK*PI2 + + END FUNCTION elemKQuad + + !Computes the local source vector for a force f + PURE FUNCTION elemFQuad(self, nNodes, source) RESULT(localF) + USE moduleConstParam, ONLY: PI2 + IMPLICIT NONE + + CLASS(meshCell2DCylQuad), 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):: r + 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) + r = DOT_PRODUCT(fPsi,self%r) + f = DOT_PRODUCT(fPsi,source) + localF = localF + r*f*fPsi*wQuad(l)*wQuad(m)*detJ + + END DO + END DO + localF = localF*PI2 + + END FUNCTION elemFQuad + !Checks if a particle is inside a quad element PURE FUNCTION insideQuad(Xi) RESULT(ins) IMPLICIT NONE @@ -533,18 +505,6 @@ MODULE moduleMesh2DCyl END FUNCTION insideQuad - !Gets nodes from quadrilateral element - PURE FUNCTION getNodesQuad(self, nNodes) RESULT(n) - IMPLICIT NONE - - CLASS(meshCell2DCylQuad), 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 @@ -554,6 +514,7 @@ MODULE moduleMesh2DCyl 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 @@ -562,8 +523,9 @@ MODULE moduleMesh2DCyl DO WHILE(conv > 1.D-2) dPsi = self%dPsi(XiO, 4) - invJ = self%invJac(XiO, 4, dPsi) - detJ = self%detJac(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%z), & DOT_PRODUCT(fPsi,self%r), & @@ -578,31 +540,69 @@ MODULE moduleMesh2DCyl 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(meshCell2DCylQuad), 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) + USE moduleConstParam, ONLY: PI8 + IMPLICIT NONE + + CLASS(meshCell2DCylQuad), INTENT(inout):: self + REAL(8):: r, 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)*PI8 !4*2*pi + fPsi = self%fPsi(Xi, 4) + !Computes total volume of the cell + r = DOT_PRODUCT(fPsi,self%r) + self%volume = r*detJ + !Computes volume per node + Xi = (/-5.D-1, -5.D-1, 0.D0/) + r = self%gatherF(Xi, 4, self%r) + self%arNodes(1) = fPsi(1)*r*detJ + Xi = (/ 5.D-1, -5.D-1, 0.D0/) + r = self%gatherF(Xi, 4, self%r) + self%arNodes(2) = fPsi(2)*r*detJ + Xi = (/ 5.D-1, 5.D-1, 0.D0/) + r = self%gatherF(Xi, 4, self%r) + self%arNodes(3) = fPsi(3)*r*detJ + Xi = (/-5.D-1, 5.D-1, 0.D0/) + r = self%gatherF(Xi, 4, self%r) + self%arNodes(4) = fPsi(4)*r*detJ + + END SUBROUTINE areaQuad !TRIA ELEMENT !Init tria element @@ -645,6 +645,18 @@ MODULE moduleMesh2DCyl END SUBROUTINE initCellTria2DCyl + !Gets node indexes from triangular element + PURE FUNCTION getNodesTria(self, nNodes) RESULT(n) + IMPLICIT NONE + + CLASS(meshCell2DCylTria), 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 @@ -667,36 +679,10 @@ MODULE moduleMesh2DCyl END FUNCTION randPosCellTria - !Calculates area for triangular element - PURE SUBROUTINE areaTria(self) - USE moduleConstParam, ONLY: PI - IMPLICIT NONE - - CLASS(meshCell2DCylTria), INTENT(inout):: self - REAL(8):: Xi(1:3) - REAL(8):: r - 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, 3)*PI !2PI*1/2 - fPsi = self%fPsi(Xi, 4) - !Computes total volume of the cell - r = DOT_PRODUCT(fPsi,self%r) - self%volume = r*detJ - !Computes volume per node - self%arNodes = fPsi*r*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(meshCell2DCylTria), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) INTEGER, INTENT(in):: nNodes REAL(8):: fPsi(1:nNodes) @@ -708,10 +694,9 @@ MODULE moduleMesh2DCyl 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(meshCell2DCylTria), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) INTEGER, INTENT(in):: nNodes REAL(8):: dPsi(1:3,1:nNodes) @@ -723,84 +708,22 @@ MODULE moduleMesh2DCyl END FUNCTION dPsiTria - PURE SUBROUTINE partialDerTria(self, nNodes, dPsi, dz, dr) + PURE FUNCTION partialDerTria(self, nNodes, dPsi) RESULT(pDer) IMPLICIT NONE CLASS(meshCell2DCylTria), INTENT(in):: self INTEGER, INTENT(in):: nNodes REAL(8), INTENT(in):: dPsi(1:3,1:nNodes) - REAL(8), INTENT(out), DIMENSION(1:2):: dz, dr + REAL(8):: pDer(1:3, 1:3) - dz = (/ DOT_PRODUCT(dPsi(1,:),self%z), & - DOT_PRODUCT(dPsi(2,:),self%z) /) - dr = (/ DOT_PRODUCT(dPsi(1,:),self%r), & - DOT_PRODUCT(dPsi(2,:),self%r) /) + pDer = 0.D0 - END SUBROUTINE partialDerTria + pDer(1, 1:2) = (/ DOT_PRODUCT(dPsi(1,1:3),self%z(1:3)), & + DOT_PRODUCT(dPsi(2,1:3),self%z(1:3)) /) + pDer(2, 1:2) = (/ DOT_PRODUCT(dPsi(1,1:3),self%r(1:3)), & + DOT_PRODUCT(dPsi(2,1:3),self%r(1:3)) /) - !Computes element local stiffness matrix - PURE FUNCTION elemKTria(self, nNodes) RESULT(localK) - USE moduleConstParam, ONLY: PI2 - IMPLICIT NONE - - CLASS(meshCell2DCylTria), INTENT(in):: self - INTEGER, INTENT(in):: nNodes - REAL(8):: localK(1:nNodes,1:nNodes) - REAL(8):: Xi(1:3) - REAL(8):: r - 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, 4) - detJ = self%detJac(Xi, 3, dPsi) - invJ = self%invJac(Xi, 3, dPsi) - fPsi = self%fPsi(Xi, 4) - r = DOT_PRODUCT(fPsi,self%r) - localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*r*wTria(l)/detJ - - END DO - localK = localK*PI2 - - END FUNCTION elemKTria - - !Computes element local source vector - PURE FUNCTION elemFTria(self, nNodes, source) RESULT(localF) - USE moduleConstParam, ONLY: PI2 - IMPLICIT NONE - - CLASS(meshCell2DCylTria), 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):: r - 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) - r = DOT_PRODUCT(fPsi,self%r) - f = DOT_PRODUCT(fPsi,source) - localF = localF + r*f*fPsi*wTria(l)*detJ - - END DO - localF = localF*PI2 - - END FUNCTION elemFTria + END FUNCTION partialDerTria PURE FUNCTION gatherEFTria(self, Xi) RESULT(array) IMPLICIT NONE @@ -840,6 +763,75 @@ MODULE moduleMesh2DCyl END FUNCTION gatherMFTria + !Computes element local stiffness matrix + PURE FUNCTION elemKTria(self, nNodes) RESULT(localK) + USE moduleConstParam, ONLY: PI2 + IMPLICIT NONE + + CLASS(meshCell2DCylTria), INTENT(in):: self + INTEGER, INTENT(in):: nNodes + REAL(8):: localK(1:nNodes,1:nNodes) + REAL(8):: Xi(1:3) + REAL(8):: r + REAL(8):: fPsi(1:3), 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) + fPsi = self%fPsi(Xi, 3) + r = DOT_PRODUCT(fPsi,self%r) + localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*r*wTria(l)/detJ + + END DO + localK = localK*PI2 + + END FUNCTION elemKTria + + !Computes element local source vector + PURE FUNCTION elemFTria(self, nNodes, source) RESULT(localF) + USE moduleConstParam, ONLY: PI2 + IMPLICIT NONE + + CLASS(meshCell2DCylTria), 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):: r + 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) + r = DOT_PRODUCT(fPsi,self%r) + f = DOT_PRODUCT(fPsi,source) + localF = localF + r*f*fPsi*wTria(l)*detJ + + END DO + localF = localF*PI2 + + END FUNCTION elemFTria + PURE FUNCTION insideTria(Xi) RESULT(ins) IMPLICIT NONE @@ -852,18 +844,6 @@ MODULE moduleMesh2DCyl END FUNCTION insideTria - !Gets node indexes from triangular element - PURE FUNCTION getNodesTria(self, nNodes) RESULT(n) - IMPLICIT NONE - - CLASS(meshCell2DCylTria), 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 @@ -871,96 +851,97 @@ MODULE moduleMesh2DCyl CLASS(meshCell2DCylTria), 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%z(1), r(2) - self%r(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(meshCell2DCylTria), 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) + USE moduleConstParam, ONLY: PI + IMPLICIT NONE + + CLASS(meshCell2DCylTria), INTENT(inout):: self + REAL(8):: Xi(1:3) + REAL(8):: r + 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)*PI !2PI*1/2 + fPsi = self%fPsi(Xi, 4) + !Computes total volume of the cell + r = DOT_PRODUCT(fPsi,self%r) + self%volume = r*detJ + !Computes volume per node + self%arNodes = fPsi*r*detJ + + END SUBROUTINE areaTria !COMMON FUNCTIONS FOR CYLINDRICAL VOLUME ELEMENTS !Computes element Jacobian determinant - PURE FUNCTION detJ2DCyl(self, Xi, nNodes, dPsi_in) RESULT(dJ) + PURE FUNCTION detJ2DCyl(pDer) RESULT(dJ) IMPLICIT NONE - CLASS(meshCell2DCyl), 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):: dz(1:2), dr(1:2) - IF(PRESENT(dPsi_in)) THEN - dPsi = dPsi_in - - ELSE - dPsi = self%dPsi(Xi, nNodes) - - END IF - - CALL self%partialDer(nNodes, dPsi, dz, dr) - - dJ = dz(1)*dr(2)-dz(2)*dr(1) + dJ = pDer(1,1)*pDer(2,2)-pDer(1,2)*pDer(2,1) END FUNCTION detJ2DCyl !Computes element Jacobian inverse matrix (without determinant) - PURE FUNCTION invJ2DCyl(self, Xi, nNodes, dPsi_in) RESULT(invJ) + PURE FUNCTION invJ2DCyl(pDer) RESULT(invJ) IMPLICIT NONE - CLASS(meshCell2DCyl), 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):: dz(1:2), dr(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, dz, dr) - - invJ(1,1:2) = (/ dr(2), -dz(2) /) - invJ(2,1:2) = (/ -dr(1), dz(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 invJ2DCyl diff --git a/src/modules/mesh/3DCart/moduleMesh3DCart.f90 b/src/modules/mesh/3DCart/moduleMesh3DCart.f90 index 705587a..a2c849d 100644 --- a/src/modules/mesh/3DCart/moduleMesh3DCart.f90 +++ b/src/modules/mesh/3DCart/moduleMesh3DCart.f90 @@ -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) diff --git a/src/modules/mesh/moduleMesh.f90 b/src/modules/mesh/moduleMesh.f90 index 6561850..97ce691 100644 --- a/src/modules/mesh/moduleMesh.f90 +++ b/src/modules/mesh/moduleMesh.f90 @@ -24,8 +24,10 @@ MODULE moduleMesh !Lock indicator for scattering INTEGER(KIND=OMP_LOCK_KIND):: lock CONTAINS + !DEFERED PROCEDURES PROCEDURE(initNode_interface), DEFERRED, PASS:: init PROCEDURE(getCoord_interface), DEFERRED, PASS:: getCoordinates + !GENERIC PROCEDURES PROCEDURE, PASS:: resetOutput END TYPE meshNode @@ -83,6 +85,7 @@ MODULE moduleMesh !Physical surface for the edge INTEGER:: physicalSurface CONTAINS + !DEFERED PROCEDURES PROCEDURE(initEdge_interface), DEFERRED, PASS:: init PROCEDURE(getNodesEdge_interface), DEFERRED, PASS:: getNodes PROCEDURE(intersectionEdge_interface), DEFERRED, PASS:: intersection @@ -166,37 +169,41 @@ MODULE moduleMesh !Total weight of particles inside cell REAL(8), ALLOCATABLE:: totalWeight(:) CONTAINS + !DEFERRED PROCEDURES !Init the cell - PROCEDURE(initCell_interface), DEFERRED, PASS:: init + PROCEDURE(initCell_interface), DEFERRED, PASS:: init !Get the index of the nodes - PROCEDURE(getNodesCell_interface), DEFERRED, PASS:: getNodes + PROCEDURE(getNodesCell_interface), DEFERRED, PASS:: getNodes !Calculate random position on the cell - PROCEDURE(randPosVol_interface), DEFERRED, PASS:: randPos + PROCEDURE(randPosCell_interface), DEFERRED, PASS:: randPos !Obtain functions and values of cell natural functions - PROCEDURE(fPsi_interface), DEFERRED, PASS:: fPsi - PROCEDURE(dPsi_interface), DEFERRED, PASS:: dPsi - PROCEDURE(detJac_interface), DEFERRED, PASS:: detJac - PROCEDURE(invJac_interface), DEFERRED, PASS:: invJac + PROCEDURE(fPsi_interface), DEFERRED, NOPASS:: fPsi + PROCEDURE(dPsi_interface), DEFERRED, NOPASS:: dPsi + PROCEDURE(partialDer_interface), DEFERRED, PASS:: partialDer + PROCEDURE(detJac_interface), DEFERRED, NOPASS:: detJac + PROCEDURE(invJac_interface), DEFERRED, NOPASS:: invJac + !Procedures to get specific values in the node + PROCEDURE(gatherArray_interface), DEFERRED, PASS:: gatherElectricField + PROCEDURE(gatherArray_interface), DEFERRED, PASS:: gatherMagneticField + !Compute K and F to solve PDE on the mesh + PROCEDURE(elemK_interface), DEFERRED, PASS:: elemK + PROCEDURE(elemF_interface), DEFERRED, PASS:: elemF + !Check if particle is inside the cell + PROCEDURE(inside_interface), DEFERRED, NOPASS:: inside + !Convert physical coordinates (r) into logical coordinates (Xi) + PROCEDURE(phy2log_interface), DEFERRED, PASS:: phy2log + !Returns the neighbour element based on particle position outside the cell + PROCEDURE(neighbourElement_interface), DEFERRED, PASS:: neighbourElement !Scatter properties of particles on cell nodes PROCEDURE, PASS:: scatter + !Subroutine to find in which cell a particle is located + PROCEDURE, PASS:: findCell !Gather value and spatial derivative on the nodes at position Xi PROCEDURE, PASS, PRIVATE:: gatherF_scalar PROCEDURE, PASS, PRIVATE:: gatherF_array PROCEDURE, PASS, PRIVATE:: gatherDF_scalar GENERIC:: gatherF => gatherF_scalar, gatherF_array GENERIC:: gatherDF => gatherDF_scalar - !Procedures to get specific values in the node - PROCEDURE(gatherArray_interface), DEFERRED, PASS:: gatherElectricField - PROCEDURE(gatherArray_interface), DEFERRED, PASS:: gatherMagneticField - !Compute K and F to solve PDE on the mesh - PROCEDURE(elemK_interface), DEFERRED, PASS:: elemK - PROCEDURE(elemF_interface), DEFERRED, PASS:: elemF - !Subroutines to find in which cell a particle is located - PROCEDURE, PASS:: findCell - PROCEDURE(inside_interface), DEFERRED, NOPASS:: inside - PROCEDURE(nextElement_interface), DEFERRED, PASS:: nextElement - !Convert physical coordinates (r) into logical coordinates (Xi) - PROCEDURE(phy2log_interface), DEFERRED, PASS:: phy2log END TYPE meshCell @@ -219,40 +226,44 @@ MODULE moduleMesh END FUNCTION getNodesCell_interface - PURE FUNCTION fPsi_interface(self, Xi, nNodes) RESULT(fPsi) + FUNCTION randPosCell_interface(self) RESULT(r) IMPORT:: meshCell CLASS(meshCell), INTENT(in):: self + REAL(8):: r(1:3) + + END FUNCTION randPosCell_interface + + PURE FUNCTION fPsi_interface(Xi, nNodes) RESULT(fPsi) REAL(8), INTENT(in):: Xi(1:3) INTEGER, INTENT(in):: nNodes REAL(8):: fPsi(1:nNodes) END FUNCTION fPsi_interface - PURE FUNCTION dPsi_interface(self, Xi, nNodes) RESULT(dPsi) - IMPORT:: meshCell - CLASS(meshCell), INTENT(in):: self + PURE FUNCTION dPsi_interface(Xi, nNodes) RESULT(dPsi) REAL(8), INTENT(in):: Xi(1:3) INTEGER, INTENT(in):: nNodes REAL(8):: dPsi(1:3, 1:nNodes) END FUNCTION dPsi_interface - PURE FUNCTION detJac_interface(self, Xi, nNodes, dPsi_in) RESULT(dJ) + PURE FUNCTION partialDer_interface(self, nNodes, dPsi) RESULT(pDer) IMPORT:: meshCell CLASS(meshCell), 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):: dPsi(1:3, 1:nNodes) + REAL(8):: pDer(1:3, 1:3) + + END FUNCTION partialDer_interface + + PURE FUNCTION detJac_interface(pDer) RESULT(dJ) + REAL(8), INTENT(in):: pDer(1:3,1:3) REAL(8):: dJ END FUNCTION detJac_interface - PURE FUNCTION invJac_interface(self, Xi, nNodes, dPsi_in) RESULT(invJ) - IMPORT:: meshCell - CLASS(meshCell), 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) + PURE FUNCTION invJac_interface(pDer) RESULT(invJ) + REAL(8), INTENT(in):: pDer(1:3,1:3) REAL(8):: invJ(1:3,1:3) END FUNCTION invJac_interface @@ -282,13 +293,12 @@ MODULE moduleMesh END FUNCTION elemF_interface - SUBROUTINE nextElement_interface(self, Xi, nextElement) - IMPORT:: meshCell, meshElement - CLASS(meshCell), INTENT(in):: self + PURE FUNCTION inside_interface(Xi) RESULT(ins) + IMPORT:: meshCell REAL(8), INTENT(in):: Xi(1:3) - CLASS(meshElement), POINTER, INTENT(out):: nextElement + LOGICAL:: ins - END SUBROUTINE nextElement_interface + END FUNCTION inside_interface PURE FUNCTION phy2log_interface(self,r) RESULT(Xi) IMPORT:: meshCell @@ -298,19 +308,13 @@ MODULE moduleMesh END FUNCTION phy2log_interface - PURE FUNCTION inside_interface(Xi) RESULT(ins) - IMPORT:: meshCell - REAL(8), INTENT(in):: Xi(1:3) - LOGICAL:: ins - - END FUNCTION inside_interface - - FUNCTION randPosVol_interface(self) RESULT(r) - IMPORT:: meshCell + SUBROUTINE neighbourElement_interface(self, Xi, neighbourElement) + IMPORT:: meshCell, meshElement CLASS(meshCell), INTENT(in):: self - REAL(8):: r(1:3) + REAL(8), INTENT(in):: Xi(1:3) + CLASS(meshElement), POINTER, INTENT(out):: neighbourElement - END FUNCTION randPosVol_interface + END SUBROUTINE neighbourElement_interface END INTERFACE @@ -332,11 +336,13 @@ MODULE moduleMesh TYPE(meshNodeCont), ALLOCATABLE:: nodes(:) !Array of cell elements TYPE(meshCellCont), ALLOCATABLE:: cells(:) + !PROCEDURES SPECIFIC OF FILE TYPE PROCEDURE(readMesh_interface), POINTER, PASS:: readMesh => NULL() PROCEDURE(readInitial_interface), POINTER, NOPASS:: readInitial => NULL() PROCEDURE(connectMesh_interface), POINTER, PASS:: connectMesh => NULL() PROCEDURE(printColl_interface), POINTER, PASS:: printColl => NULL() CONTAINS + !GENERIC PROCEDURES PROCEDURE, PASS:: doCollisions END TYPE meshGeneric @@ -345,7 +351,6 @@ MODULE moduleMesh !Reads the mesh from a file SUBROUTINE readMesh_interface(self, filename) IMPORT meshGeneric - CLASS(meshGeneric), INTENT(inout):: self CHARACTER(:), ALLOCATABLE, INTENT(in):: filename @@ -363,7 +368,6 @@ MODULE moduleMesh !Connects cell and edges to the mesh SUBROUTINE connectMesh_interface(self) IMPORT meshGeneric - CLASS(meshGeneric), INTENT(inout):: self END SUBROUTINE connectMesh_interface @@ -371,7 +375,6 @@ MODULE moduleMesh !Prints number of collisions in each cell SUBROUTINE printColl_interface(self, t) IMPORT meshGeneric - CLASS(meshGeneric), INTENT(inout):: self INTEGER, INTENT(in):: t @@ -388,28 +391,21 @@ MODULE moduleMesh REAL(8), ALLOCATABLE, DIMENSION(:,:):: K !Permutation matrix for P L U factorization INTEGER, ALLOCATABLE, DIMENSION(:,:):: IPIV + !PROCEDURES SPECIFIC OF FILE TYPE PROCEDURE(printOutput_interface), POINTER, PASS:: printOutput => NULL() PROCEDURE(printEM_interface), POINTER, PASS:: printEM => NULL() PROCEDURE(doCoulomb_interface), POINTER, PASS:: doCoulomb => NULL() PROCEDURE(printAverage_interface), POINTER, PASS:: printAverage => NULL() CONTAINS + !GENERIC PROCEDURES PROCEDURE, PASS:: constructGlobalK END TYPE meshParticles ABSTRACT INTERFACE - !Perform Coulomb Scattering - SUBROUTINE doCoulomb_interface(self) - IMPORT meshParticles - - CLASS(meshParticles), INTENT(inout):: self - - END SUBROUTINE doCoulomb_interface - !Prints Species data SUBROUTINE printOutput_interface(self, t) IMPORT meshParticles - CLASS(meshParticles), INTENT(in):: self INTEGER, INTENT(in):: t @@ -418,21 +414,25 @@ MODULE moduleMesh !Prints EM info SUBROUTINE printEM_interface(self, t) IMPORT meshParticles - CLASS(meshParticles), INTENT(in):: self INTEGER, INTENT(in):: t END SUBROUTINE printEM_interface + !Perform Coulomb Scattering + SUBROUTINE doCoulomb_interface(self) + IMPORT meshParticles + CLASS(meshParticles), INTENT(inout):: self + + END SUBROUTINE doCoulomb_interface + !Prints average values SUBROUTINE printAverage_interface(self) IMPORT meshParticles - CLASS(meshParticles), INTENT(in):: self END SUBROUTINE printAverage_interface - END INTERFACE TYPE(meshParticles), TARGET:: mesh @@ -440,6 +440,7 @@ MODULE moduleMesh !Collision (MCC) mesh TYPE, EXTENDS(meshGeneric):: meshCollisions CONTAINS + !GENERIC PROCEDURES END TYPE meshCollisions @@ -448,7 +449,6 @@ MODULE moduleMesh ABSTRACT INTERFACE SUBROUTINE readMeshColl_interface(self, filename) IMPORT meshCollisions - CLASS(meshCollisions), INTENT(inout):: self CHARACTER(:), ALLOCATABLE, INTENT(in):: filename @@ -577,12 +577,14 @@ MODULE moduleMesh REAL(8), INTENT(in):: valNodes(1:nNodes) REAL(8):: df(1:3) REAL(8):: dPsi(1:3, 1:nNodes) + REAL(8):: pDer(1:3,1:3) REAL(8):: dPsiR(1:3, 1:nNodes) REAL(8):: invJ(1:3, 1:3), detJ dPsi = self%dPsi(Xi, nNodes) - detJ = self%detJac(Xi, nNodes, dPsi) - invJ = self%invJac(Xi, nNodes, dPsi) + pDer = self%partialDer(nNodes, dPsi) + detJ = self%detJac(pDer) + invJ = self%invJac(pDer) dPsiR = MATMUL(invJ, dPsi)/detJ df = (/ DOT_PRODUCT(dPsiR(1,:), valNodes), & DOT_PRODUCT(dPsiR(2,:), valNodes), & @@ -637,7 +639,7 @@ MODULE moduleMesh CLASS(particle), INTENT(inout), TARGET:: part CLASS(meshCell), OPTIONAL, INTENT(in):: oldCell REAL(8):: Xi(1:3) - CLASS(meshElement), POINTER:: nextElement + CLASS(meshElement), POINTER:: neighbourElement INTEGER:: sp Xi = self%phy2log(part%r) @@ -655,16 +657,16 @@ MODULE moduleMesh ELSE !If not, searches for a neighbour and repeats the process. - CALL self%nextElement(Xi, nextElement) + CALL self%neighbourElement(Xi, neighbourElement) !Defines the next step - SELECT TYPE(nextElement) + SELECT TYPE(neighbourElement) CLASS IS(meshCell) !Particle moved to new cell, repeat find procedure - CALL nextElement%findCell(part, self) + CALL neighbourElement%findCell(part, self) CLASS IS (meshEdge) !Particle encountered a surface, apply boundary - CALL nextElement%fBoundary(part%species%n)%apply(nextElement,part) + CALL neighbourElement%fBoundary(part%species%n)%apply(neighbourElement,part) !If particle is still inside the domain, call findCell IF (part%n_in) THEN @@ -709,7 +711,7 @@ MODULE moduleMesh LOGICAL:: found CLASS(meshCell), POINTER:: cell REAL(8), DIMENSION(1:3):: Xi - CLASS(meshElement), POINTER:: nextElement + CLASS(meshElement), POINTER:: neighbourElement INTEGER:: sp found = .FALSE. @@ -727,11 +729,11 @@ MODULE moduleMesh found = .TRUE. ELSE - CALL cell%nextElement(Xi, nextElement) - SELECT TYPE(nextElement) + CALL cell%neighbourElement(Xi, neighbourElement) + SELECT TYPE(neighbourElement) CLASS IS(meshCell) !Try next element - cell => nextElement + cell => neighbourElement CLASS DEFAULT !Should never happend, but just in case, stops loops From 7b7a5c45caacf7ca06ce6b5644609f2041589701 Mon Sep 17 00:00:00 2001 From: JGonzalez Date: Fri, 6 Jan 2023 15:18:04 +0100 Subject: [PATCH 08/13] Small improvement Very small improvement in performance. Still, partialDer takes too long to compute. Trying to find ways to improve it. --- src/modules/mesh/0D/moduleMesh0D.f90 | 93 +-- src/modules/mesh/1DCart/moduleMesh1DCart.f90 | 356 +++++----- src/modules/mesh/1DRad/moduleMesh1DRad.f90 | 412 ++++++----- src/modules/mesh/2DCart/moduleMesh2DCart.f90 | 686 +++++++++---------- src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 | 74 +- src/modules/mesh/3DCart/moduleMesh3DCart.f90 | 4 +- 6 files changed, 788 insertions(+), 837 deletions(-) diff --git a/src/modules/mesh/0D/moduleMesh0D.f90 b/src/modules/mesh/0D/moduleMesh0D.f90 index 5f89f20..133ae8e 100644 --- a/src/modules/mesh/0D/moduleMesh0D.f90 +++ b/src/modules/mesh/0D/moduleMesh0D.f90 @@ -6,7 +6,8 @@ MODULE moduleMesh0D TYPE, PUBLIC, EXTENDS(meshNode):: meshNode0D INTEGER:: n1 CONTAINS - PROCEDURE, PASS:: init => initNode0D + !meshNode DEFERRED PROCEDURES + PROCEDURE, PASS:: init => initNode0D PROCEDURE, PASS:: getCoordinates => getCoord0D END TYPE meshNode0D @@ -14,20 +15,21 @@ MODULE moduleMesh0D TYPE, PUBLIC, EXTENDS(meshCell):: meshCell0D CLASS(meshNode), POINTER:: n1 CONTAINS - PROCEDURE, PASS:: init => initCell0D - PROCEDURE, PASS:: getNodes => getNodes0D - PROCEDURE, PASS:: randPos => randPos0D - PROCEDURE, PASS:: fPsi => fPsi0D - PROCEDURE, PASS:: dPsi => dPsi0D - PROCEDURE, PASS:: detJac => detJ0D - PROCEDURE, PASS:: invJac => invJ0D - PROCEDURE, PASS:: elemK => elemK0D - PROCEDURE, PASS:: elemF => elemF0D - PROCEDURE, PASS:: gatherElectricField => gatherEF0D - PROCEDURE, PASS:: gatherMagneticField => gatherMF0D - PROCEDURE, PASS:: phy2log => phy2log0D - PROCEDURE, NOPASS:: inside => inside0D - PROCEDURE, PASS:: nextElement => nextElement0D + PROCEDURE, PASS:: init => initCell0D + PROCEDURE, PASS:: getNodes => getNodes0D + PROCEDURE, PASS:: randPos => randPos0D + PROCEDURE, NOPASS:: fPsi => fPsi0D + PROCEDURE, NOPASS:: dPsi => dPsi0D + PROCEDURE, PASS:: partialDer => partialDer0D + PROCEDURE, NOPASS:: detJac => detJ0D + PROCEDURE, NOPASS:: invJac => invJ0D + PROCEDURE, PASS:: gatherElectricField => gatherEF0D + PROCEDURE, PASS:: gatherMagneticField => gatherMF0D + PROCEDURE, PASS:: elemK => elemK0D + PROCEDURE, PASS:: elemF => elemF0D + PROCEDURE, PASS:: phy2log => phy2log0D + PROCEDURE, NOPASS:: inside => inside0D + PROCEDURE, PASS:: neighbourElement => neighbourElement0D END TYPE meshCell0D @@ -89,6 +91,7 @@ MODULE moduleMesh0D END SUBROUTINE initCell0D + !Get the nodes of the volume PURE FUNCTION getNodes0D(self, nNodes) RESULT(n) IMPLICIT NONE @@ -100,6 +103,7 @@ MODULE moduleMesh0D END FUNCTION getNodes0D + !Calculate random position inside the volume FUNCTION randPos0D(self) RESULT(r) IMPLICIT NONE @@ -110,10 +114,9 @@ MODULE moduleMesh0D END FUNCTION randPos0D - PURE FUNCTION fPsi0D(self, Xi, nNodes) RESULT(fPsi) + PURE FUNCTION fPsi0D(Xi, nNodes) RESULT(fPsi) IMPLICIT NONE - CLASS(meshCell0D), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) INTEGER, INTENT(in):: nNodes REAL(8):: fPsi(1:nNodes) @@ -122,10 +125,9 @@ MODULE moduleMesh0D END FUNCTION fPsi0D - PURE FUNCTION dPsi0D(self, Xi, nNodes) RESULT(dPsi) + PURE FUNCTION dPsi0D(Xi, nNodes) RESULT(dPsi) IMPLICIT NONE - CLASS(meshCell0D), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) INTEGER, INTENT(in):: nNodes REAL(8):: dPsi(1:3,1:nNodes) @@ -134,31 +136,17 @@ MODULE moduleMesh0D END FUNCTION dPsi0D - PURE FUNCTION detJ0D(self, Xi, nNodes, dPsi_in) RESULT(dJ) + PURE FUNCTION partialDer0D(self, nNodes, dPsi) RESULT(pDer) IMPLICIT NONE CLASS(meshCell0D), 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):: dJ + REAL(8), INTENT(in):: dPsi(1:3,1:nNodes) + REAL(8):: pDer(1:3, 1:3) - dJ = 0.D0 + pDer = 0.D0 - END FUNCTION detJ0D - - PURE FUNCTION invJ0D(self, Xi, nNodes, dPsi_in) RESULT(invJ) - IMPLICIT NONE - - CLASS(meshCell0D), 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):: invJ(1:3,1:3) - - invJ = 0.D0 - - END FUNCTION invJ0D + END FUNCTION partialDer0D PURE FUNCTION elemK0D(self, nNodes) RESULT(localK) IMPLICIT NONE @@ -234,15 +222,36 @@ MODULE moduleMesh0D END FUNCTION inside0D - SUBROUTINE nextElement0D(self, Xi, nextElement) + SUBROUTINE neighbourElement0D(self, Xi, neighbourElement) IMPLICIT NONE CLASS(meshCell0D), INTENT(in):: self REAL(8), INTENT(in):: Xi(1:3) - CLASS(meshElement), POINTER, INTENT(out):: nextElement + CLASS(meshElement), POINTER, INTENT(out):: neighbourElement - nextElement => NULL() + neighbourElement => NULL() - END SUBROUTINE nextElement0D + END SUBROUTINE neighbourElement0D + + !COMMON FUNCTIONS + PURE FUNCTION detJ0D(pDer) RESULT(dJ) + IMPLICIT NONE + + REAL(8), INTENT(in):: pDer(1:3, 1:3) + REAL(8):: dJ + + dJ = 0.D0 + + END FUNCTION detJ0D + + PURE FUNCTION invJ0D(pDer) RESULT(invJ) + IMPLICIT NONE + + REAL(8), INTENT(in):: pDer(1:3, 1:3) + REAL(8):: invJ(1:3,1:3) + + invJ = 0.D0 + + END FUNCTION invJ0D END MODULE moduleMesh0D diff --git a/src/modules/mesh/1DCart/moduleMesh1DCart.f90 b/src/modules/mesh/1DCart/moduleMesh1DCart.f90 index 56d1b65..6a43ca1 100644 --- a/src/modules/mesh/1DCart/moduleMesh1DCart.f90 +++ b/src/modules/mesh/1DCart/moduleMesh1DCart.f90 @@ -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 diff --git a/src/modules/mesh/1DRad/moduleMesh1DRad.f90 b/src/modules/mesh/1DRad/moduleMesh1DRad.f90 index 8b441be..8230901 100644 --- a/src/modules/mesh/1DRad/moduleMesh1DRad.f90 +++ b/src/modules/mesh/1DRad/moduleMesh1DRad.f90 @@ -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 diff --git a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 index 2ccde7d..eab1266 100644 --- a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 +++ b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 @@ -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 diff --git a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 index 1e8c79d..d9a7f32 100644 --- a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 +++ b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 @@ -67,7 +67,7 @@ MODULE moduleMesh2DCyl PROCEDURE, PASS:: phy2log => phy2logQuad PROCEDURE, PASS:: neighbourElement => neighbourElementQuad !PARTICLUAR PROCEDURES - PROCEDURE, PASS:: area => areaQuad + PROCEDURE, PASS, PRIVATE:: area => areaQuad END TYPE meshCell2DCylQuad @@ -99,7 +99,7 @@ MODULE moduleMesh2DCyl PROCEDURE, PASS:: phy2log => phy2logTria PROCEDURE, PASS:: neighbourElement => neighbourElementTria !PARTICULAR PROCEDURES - PROCEDURE, PASS:: area => areaTria + PROCEDURE, PASS, PRIVATE:: area => areaTria END TYPE meshCell2DCylTria @@ -256,8 +256,13 @@ MODULE moduleMesh2DCyl TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) REAL(8), DIMENSION(1:3):: r1, r2, r3, r4 + !Assign node index self%n = n + + !Assign number of nodes of cell self%nNodes = SIZE(p) + + !Assign nodes to element self%n1 => nodes(p(1))%obj self%n2 => nodes(p(2))%obj self%n3 => nodes(p(3))%obj @@ -428,7 +433,7 @@ MODULE moduleMesh2DCyl 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):: dPsi(1:3, 1:4) REAL(8):: pDer(1:3, 1:3) REAL(8):: r REAL(8):: invJ(1:3,1:3), detJ @@ -445,8 +450,7 @@ MODULE moduleMesh2DCyl pDer = self%partialDer(4, dPsi) detJ = self%detJac(pDer) invJ = self%invJac(pDer) - fPsi = self%fPsi(Xi, 4) - r = DOT_PRODUCT(fPsi,self%r) + r = self%gatherF(Xi, 4, self%r) localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)), & MATMUL(invJ,dPsi))* & r*wQuad(l)*wQuad(m)/detJ @@ -467,7 +471,8 @@ MODULE moduleMesh2DCyl 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):: fPsi(1:4) + REAL(8):: dPsi(1:3, 1:4) REAL(8):: pDer(1:3, 1:3) REAL(8):: r REAL(8):: detJ, f @@ -483,7 +488,7 @@ MODULE moduleMesh2DCyl pDer = self%partialDer(4, dPsi) detJ = self%detJac(pDer) fPsi = self%fPsi(Xi, 4) - r = DOT_PRODUCT(fPsi,self%r) + r = DOT_PRODUCT(fPsi, self%r) f = DOT_PRODUCT(fPsi,source) localF = localF + r*f*fPsi*wQuad(l)*wQuad(m)*detJ @@ -539,7 +544,7 @@ MODULE moduleMesh2DCyl END FUNCTION phy2logQuad - !Gets the next element for a logical position Xi + !Get the next element for a logical position Xi SUBROUTINE neighbourElementQuad(self, Xi, neighbourElement) IMPLICIT NONE @@ -572,7 +577,8 @@ MODULE moduleMesh2DCyl IMPLICIT NONE CLASS(meshCell2DCylQuad), INTENT(inout):: self - REAL(8):: r, Xi(1:3) + REAL(8):: Xi(1:3) + REAL(8):: r REAL(8):: detJ REAL(8):: fPsi(1:4) REAL(8):: dPsi(1:3, 1:4), pDer(1:3, 1:3) @@ -583,24 +589,24 @@ MODULE moduleMesh2DCyl Xi = 0.D0 dPsi = self%dPsi(Xi, 4) pDer = self%partialDer(4, dPsi) - detJ = self%detJac(pDer)*PI8 !4*2*pi + detJ = self%detJac(pDer) fPsi = self%fPsi(Xi, 4) !Computes total volume of the cell r = DOT_PRODUCT(fPsi,self%r) - self%volume = r*detJ + self%volume = r*detJ*PI8 !4*2*pi !Computes volume per node Xi = (/-5.D-1, -5.D-1, 0.D0/) r = self%gatherF(Xi, 4, self%r) - self%arNodes(1) = fPsi(1)*r*detJ + self%arNodes(1) = fPsi(1)*self%volume Xi = (/ 5.D-1, -5.D-1, 0.D0/) r = self%gatherF(Xi, 4, self%r) - self%arNodes(2) = fPsi(2)*r*detJ + self%arNodes(2) = fPsi(2)*self%volume Xi = (/ 5.D-1, 5.D-1, 0.D0/) r = self%gatherF(Xi, 4, self%r) - self%arNodes(3) = fPsi(3)*r*detJ + self%arNodes(3) = fPsi(3)*self%volume Xi = (/-5.D-1, 5.D-1, 0.D0/) r = self%gatherF(Xi, 4, self%r) - self%arNodes(4) = fPsi(4)*r*detJ + self%arNodes(4) = fPsi(4)*self%volume END SUBROUTINE areaQuad @@ -619,7 +625,7 @@ MODULE moduleMesh2DCyl !Assign node index self%n = n - !Assign nomber of nodes to cell + !Assign number of nodes of cell self%nNodes = SIZE(p) !Assign nodes to element @@ -736,7 +742,7 @@ MODULE moduleMesh2DCyl self%n2%emData%phi, & self%n3%emData%phi /) - array = -self%gatherDF(Xi, 4, phi) + array = -self%gatherDF(Xi, 3, phi) END FUNCTION gatherEFTria @@ -772,8 +778,8 @@ MODULE moduleMesh2DCyl 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):: r - REAL(8):: fPsi(1:3), dPsi(1:3,1:3) REAL(8):: pDer(1:3, 1:3) REAL(8):: invJ(1:3,1:3), detJ INTEGER:: l @@ -788,8 +794,7 @@ MODULE moduleMesh2DCyl pDer = self%partialDer(3, dPsi) detJ = self%detJac(pDer) invJ = self%invJac(pDer) - fPsi = self%fPsi(Xi, 3) - r = DOT_PRODUCT(fPsi,self%r) + r = self%gatherF(Xi, 3, self%r) localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*r*wTria(l)/detJ END DO @@ -809,22 +814,23 @@ MODULE moduleMesh2DCyl REAL(8):: fPsi(1:3) REAL(8):: dPsi(1:3, 1:3), pDer(1:3, 1:3) REAL(8):: Xi(1:3) - REAL(8):: r REAL(8):: detJ, f + REAL(8):: r INTEGER:: l localF = 0.D0 - Xi = 0.D0 + + Xi = 0.D0 !Start 2D Gauss Quad Integral - DO l=1, 4 + 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) - r = DOT_PRODUCT(fPsi,self%r) - f = DOT_PRODUCT(fPsi,source) + r = DOT_PRODUCT(fPsi, self%r) + f = DOT_PRODUCT(fPsi, source) localF = localF + r*f*fPsi*wTria(l)*detJ END DO @@ -897,10 +903,10 @@ MODULE moduleMesh2DCyl CLASS(meshCell2DCylTria), INTENT(inout):: self REAL(8):: Xi(1:3) - REAL(8):: r REAL(8):: dPsi(1:3, 1:3), pDer(1:3, 1:3) REAL(8):: detJ REAL(8):: fPsi(1:3) + REAL(8):: r self%volume = 0.D0 self%arNodes = 0.D0 @@ -908,13 +914,13 @@ MODULE moduleMesh2DCyl 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)*PI !2PI*1/2 - fPsi = self%fPsi(Xi, 4) + detJ = self%detJac(pDer) + fPsi = self%fPsi(Xi, 3) !Computes total volume of the cell - r = DOT_PRODUCT(fPsi,self%r) - self%volume = r*detJ + r = DOT_PRODUCT(fPsi, self%r) + self%volume = r*detJ*PI !2PI*1/2 !Computes volume per node - self%arNodes = fPsi*r*detJ + self%arNodes = fPsi*self%volume END SUBROUTINE areaTria @@ -939,9 +945,9 @@ MODULE moduleMesh2DCyl invJ = 0.D0 - 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 + 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 invJ2DCyl diff --git a/src/modules/mesh/3DCart/moduleMesh3DCart.f90 b/src/modules/mesh/3DCart/moduleMesh3DCart.f90 index a2c849d..34474cd 100644 --- a/src/modules/mesh/3DCart/moduleMesh3DCart.f90 +++ b/src/modules/mesh/3DCart/moduleMesh3DCart.f90 @@ -30,7 +30,7 @@ MODULE moduleMesh3DCart PROCEDURE, PASS:: intersection => intersection3DCartTria PROCEDURE, PASS:: randPos => randPosEdgeTria !PARTICULAR PROCEDURES - PROCEDURE, NOPASS:: fPsi => fPsiEdgeTria + PROCEDURE, NOPASS, PRIVATE:: fPsi => fPsiEdgeTria END TYPE meshEdge3DCartTria @@ -60,7 +60,7 @@ MODULE moduleMesh3DCart PROCEDURE, PASS:: phy2log => phy2logTetra PROCEDURE, PASS:: neighbourElement => neighbourElementTetra !PARTICULAR PROCEDURES - PROCEDURE, PASS:: calcVol => volumeTetra + PROCEDURE, PASS, PRIVATE:: calcVol => volumeTetra END TYPE meshCell3DCartTetra From 746c5bea09a07aee8e59973590e4999c80830be2 Mon Sep 17 00:00:00 2001 From: JGonzalez Date: Fri, 6 Jan 2023 21:02:54 +0100 Subject: [PATCH 09/13] First step of performance improvement Finalysing first step of performance improvement focusing on reducing iteration CPU time by improving calculation of basic element functions, which took a lot of the CPU time --- src/modules/common/moduleConstParam.f90 | 3 +- src/modules/init/moduleInput.f90 | 8 +- src/modules/mesh/1DCart/moduleMesh1DCart.f90 | 41 +++--- src/modules/mesh/1DRad/moduleMesh1DRad.f90 | 46 +++--- src/modules/mesh/2DCart/moduleMesh2DCart.f90 | 121 +++++++-------- src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 | 139 +++++++++--------- src/modules/mesh/3DCart/moduleMesh3DCart.f90 | 131 +++++++++-------- .../mesh/inout/0D/moduleMeshInput0D.f90 | 3 +- .../mesh/inout/gmsh2/moduleMeshInputGmsh2.f90 | 3 +- src/modules/mesh/moduleMesh.f90 | 3 +- src/modules/mesh/moduleMeshBoundary.f90 | 4 +- src/modules/moduleCollisions.f90 | 8 +- src/modules/moduleSpecies.f90 | 2 +- 13 files changed, 260 insertions(+), 252 deletions(-) diff --git a/src/modules/common/moduleConstParam.f90 b/src/modules/common/moduleConstParam.f90 index cb12a23..58a3cc8 100644 --- a/src/modules/common/moduleConstParam.f90 +++ b/src/modules/common/moduleConstParam.f90 @@ -6,7 +6,8 @@ MODULE moduleConstParam REAL(8), PARAMETER:: PI = 4.D0*DATAN(1.D0) !number pi REAL(8), PARAMETER:: PI2 = 2.D0*PI !2*pi - REAL(8), PARAMETER:: PI8 = 8.D0*PI !2*pi + REAL(8), PARAMETER:: PI4 = 4.D0*PI !4*pi + REAL(8), PARAMETER:: PI8 = 8.D0*PI !8*pi REAL(8), PARAMETER:: sccm2atomPerS = 4.5D17 !sccm to atom s^-1 REAL(8), PARAMETER:: qe = 1.60217662D-19 !Elementary charge REAL(8), PARAMETER:: kb = 1.38064852D-23 !Boltzmann constants SI diff --git a/src/modules/init/moduleInput.f90 b/src/modules/init/moduleInput.f90 index 0f409fb..ff2cc4b 100644 --- a/src/modules/init/moduleInput.f90 +++ b/src/modules/init/moduleInput.f90 @@ -354,7 +354,7 @@ MODULE moduleInput CALL config%get(object // '.file', spFile, found) !Reads node values at the nodes filename = path // spFile - CALL mesh%readInitial(sp, filename, density, velocity, temperature) + CALL mesh%readInitial(filename, density, velocity, temperature) !For each volume in the node, create corresponding particles DO e = 1, mesh%numCells !Scale variables @@ -378,9 +378,9 @@ MODULE moduleInput ALLOCATE(partNew) partNew%species => species(sp)%obj partNew%r = mesh%cells(e)%obj%randPos() - partNew%xi = mesh%cells(e)%obj%phy2log(partNew%r) + partNew%Xi = mesh%cells(e)%obj%phy2log(partNew%r) !Get mean velocity at particle position - fPsi = mesh%cells(e)%obj%fPsi(partNew%xi, nNodes) + fPsi = mesh%cells(e)%obj%fPsi(partNew%Xi, nNodes) DO j = 1, nNodes source(j) = velocity(nodes(j), 1) @@ -645,7 +645,7 @@ MODULE moduleInput INTEGER:: e CLASS(meshCell), POINTER:: vol - !Firstly, checks if the object 'interactions' exists + !Firstly, check if the object 'interactions' exists CALL config%info('interactions', found) IF (found) THEN !Checks if MC collisions have been defined diff --git a/src/modules/mesh/1DCart/moduleMesh1DCart.f90 b/src/modules/mesh/1DCart/moduleMesh1DCart.f90 index 6a43ca1..82f43c2 100644 --- a/src/modules/mesh/1DCart/moduleMesh1DCart.f90 +++ b/src/modules/mesh/1DCart/moduleMesh1DCart.f90 @@ -41,7 +41,6 @@ MODULE moduleMesh1DCart CLASS(meshNode), POINTER:: n1 => NULL(), n2 => NULL() !Connectivity to adjacent elements CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL() - REAL(8):: arNodes(1:2) CONTAINS !meshCell DEFERRED PROCEDURES PROCEDURE, PASS:: init => initCell1DCartSegm @@ -60,7 +59,7 @@ MODULE moduleMesh1DCart PROCEDURE, PASS:: phy2log => phy2logSegm PROCEDURE, PASS:: neighbourElement => neighbourElementSegm !PARTICLUAR PROCEDURES - PROCEDURE, PASS, PRIVATE:: area => areaSegm + PROCEDURE, PASS, PRIVATE:: vol => volumeSegm END TYPE meshCell1DCartSegm @@ -100,7 +99,7 @@ MODULE moduleMesh1DCart END FUNCTION getCoord1DCart !EDGE FUNCTIONS - !Inits edge element + !Init edge element SUBROUTINE initEdge1DCart(self, n, p, bt, physicalSurface) USE moduleSpecies USE moduleBoundary @@ -133,7 +132,7 @@ MODULE moduleMesh1DCart CALL pointBoundaryFunction(self, s) END DO - + !Physical Surface self%physicalSurface = physicalSurface @@ -162,7 +161,7 @@ MODULE moduleMesh1DCart END FUNCTION intersection1DCart - !Calculates a 'random' position in edge + !Calculate a 'random' position in edge FUNCTION randPosEdge(self) RESULT(r) CLASS(meshEdge1DCart), INTENT(in):: self REAL(8):: r(1:3) @@ -173,7 +172,7 @@ MODULE moduleMesh1DCart !VOLUME FUNCTIONS !SEGMENT FUNCTIONS - !Init segment element + !Init element SUBROUTINE initCell1DCartSegm(self, n, p, nodes) USE moduleRefParam IMPLICIT NONE @@ -194,9 +193,7 @@ MODULE moduleMesh1DCart self%x = (/ r1(1), r2(1) /) !Assign node volume - CALL self%area() - self%n1%v = self%n1%v + self%arNodes(1) - self%n2%v = self%n2%v + self%arNodes(2) + CALL self%vol() CALL OMP_INIT_LOCK(self%lock) @@ -237,7 +234,7 @@ MODULE moduleMesh1DCart END FUNCTION randPos1DCartSegm - !Computes element functions at point Xi + !Compute element functions at point Xi PURE FUNCTION fPsiSegm(Xi, nNodes) RESULT(fPsi) IMPLICIT NONE @@ -317,7 +314,7 @@ MODULE moduleMesh1DCart END FUNCTION gatherMFSegm - !Computes element local stiffness matrix + !Compute element local stiffness matrix PURE FUNCTION elemKSegm(self, nNodes) RESULT(localK) IMPLICIT NONE @@ -348,7 +345,7 @@ MODULE moduleMesh1DCart END FUNCTION elemKSegm - !Computes the local source vector for a force f + !Compute the local source vector for a force f PURE FUNCTION elemFSegm(self, nNodes, source) RESULT(localF) IMPLICIT NONE @@ -422,8 +419,8 @@ MODULE moduleMesh1DCart END SUBROUTINE neighbourElementSegm - !Computes element area - PURE SUBROUTINE areaSegm(self) + !Compute element vol + PURE SUBROUTINE volumeSegm(self) IMPLICIT NONE CLASS(meshCell1DCartSegm), INTENT(inout):: self @@ -433,22 +430,22 @@ MODULE moduleMesh1DCart 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 + !Compute total volume of the cell self%volume = detJ*2.D0 - !Computes volume per node - self%arNodes = fPsi*self%volume + !Compute volume per node + self%n1%v = self%n1%v + fPsi(1)*self%volume + self%n2%v = self%n2%v + fPsi(2)*self%volume - END SUBROUTINE areaSegm + END SUBROUTINE volumeSegm !COMMON FUNCTIONS FOR 1D VOLUME ELEMENTS - !Computes element Jacobian determinant + !Compute element Jacobian determinant PURE FUNCTION detJ1DCart(pDer) RESULT(dJ) IMPLICIT NONE @@ -459,7 +456,7 @@ MODULE moduleMesh1DCart END FUNCTION detJ1DCart - !Computes element Jacobian inverse matrix (without determinant) + !Compute element Jacobian inverse matrix (without determinant) PURE FUNCTION invJ1DCart(pDer) RESULT(invJ) IMPLICIT NONE @@ -575,7 +572,7 @@ MODULE moduleMesh1DCart elemA%e1 => elemB elemB%e2 => elemA - !Revers the normal to point inside the domain + !Rever the normal to point inside the domain elemB%normal = - elemB%normal END IF diff --git a/src/modules/mesh/1DRad/moduleMesh1DRad.f90 b/src/modules/mesh/1DRad/moduleMesh1DRad.f90 index 8230901..c8ff414 100644 --- a/src/modules/mesh/1DRad/moduleMesh1DRad.f90 +++ b/src/modules/mesh/1DRad/moduleMesh1DRad.f90 @@ -41,7 +41,6 @@ MODULE moduleMesh1DRad CLASS(meshNode), POINTER:: n1 => NULL(), n2 => NULL() !Connectivity to adjacent elements CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL() - REAL(8):: arNodes(1:2) CONTAINS !meshCell DEFERRED PROCEDURES PROCEDURE, PASS:: init => initCell1DRadSegm @@ -60,7 +59,7 @@ MODULE moduleMesh1DRad PROCEDURE, PASS:: phy2log => phy2logSegm PROCEDURE, PASS:: neighbourElement => neighbourElementSegm !PARTICLUAR PROCEDURES - PROCEDURE, PASS, PRIVATE:: area => areaSegm + PROCEDURE, PASS, PRIVATE:: vol => volumeSegm END TYPE meshCell1DRadSegm @@ -82,7 +81,7 @@ MODULE moduleMesh1DRad !Node volume, to be determined in mesh self%v = 0.D0 - !Allocates output + !Allocate output ALLOCATE(self%output(1:nSpecies)) CALL OMP_INIT_LOCK(self%lock) @@ -100,7 +99,7 @@ MODULE moduleMesh1DRad END FUNCTION getCoord1DRad !EDGE FUNCTIONS - !Inits edge element + !Init edge element SUBROUTINE initEdge1DRad(self, n, p, bt, physicalSurface) USE moduleSpecies USE moduleBoundary @@ -162,7 +161,7 @@ MODULE moduleMesh1DRad END FUNCTION intersection1DRad - !Calculates a 'random' position in edge + !Calculate a 'random' position in edge FUNCTION randPos1DRad(self) RESULT(r) CLASS(meshEdge1DRad), INTENT(in):: self REAL(8):: r(1:3) @@ -173,7 +172,7 @@ MODULE moduleMesh1DRad !VOLUME FUNCTIONS !SEGMENT FUNCTIONS - !Init segment element + !Init element SUBROUTINE initCell1DRadSegm(self, n, p, nodes) USE moduleRefParam IMPLICIT NONE @@ -194,9 +193,7 @@ MODULE moduleMesh1DRad self%r = (/ r1(1), r2(1) /) !Assign node volume - CALL self%area() - self%n1%v = self%n1%v + self%arNodes(1) - self%n2%v = self%n2%v + self%arNodes(2) + CALL self%vol() CALL OMP_INIT_LOCK(self%lock) @@ -237,7 +234,7 @@ MODULE moduleMesh1DRad END FUNCTION randPos1DRadSegm - !Computes element functions at point Xi + !Compute element functions at point Xi PURE FUNCTION fPsiSegm(Xi, nNodes) RESULT(fPsi) IMPLICIT NONE @@ -317,7 +314,7 @@ MODULE moduleMesh1DRad END FUNCTION gatherMFSegm - !Computes element local stiffness matrix + !Compute element local stiffness matrix PURE FUNCTION elemKSegm(self, nNodes) RESULT(localK) USE moduleConstParam, ONLY: PI2 IMPLICIT NONE @@ -352,7 +349,7 @@ MODULE moduleMesh1DRad END FUNCTION elemKSegm - !Computes the local source vector for a force f + !Compute the local source vector for a force f PURE FUNCTION elemFSegm(self, nNodes, source) RESULT(localF) USE moduleConstParam, ONLY: PI2 IMPLICIT NONE @@ -430,9 +427,9 @@ MODULE moduleMesh1DRad END SUBROUTINE neighbourElementSegm - !Computes element area - PURE SUBROUTINE areaSegm(self) - USE moduleConstParam, ONLY: PI + !Compute element vol + PURE SUBROUTINE volumeSegm(self) + USE moduleConstParam, ONLY: PI4 IMPLICIT NONE CLASS(meshCell1DRadSegm), INTENT(inout):: self @@ -443,28 +440,27 @@ MODULE moduleMesh1DRad 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 + !Compute total volume of the cell + self%volume = r*detJ*PI4 !2*2PI + !Compute 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 + self%n1%v = self%n1%v + fPsi(1)*r*detJ*PI4 Xi = (/ 5.D-1, 0.D0, 0.D0/) r = self%gatherF(Xi, 2, self%r) - self%arNodes(2) = fPsi(2)*self%volume + self%n2%v = self%n2%v + fPsi(2)*r*detJ*PI4 - END SUBROUTINE areaSegm + END SUBROUTINE volumeSegm !COMMON FUNCTIONS FOR 1D VOLUME ELEMENTS - !Computes element Jacobian determinant + !Compute element Jacobian determinant PURE FUNCTION detJ1DRad(pDer) RESULT(dJ) IMPLICIT NONE @@ -475,7 +471,7 @@ MODULE moduleMesh1DRad END FUNCTION detJ1DRad - !Computes element Jacobian inverse matrix (without determinant) + !Compute element Jacobian inverse matrix (without determinant) PURE FUNCTION invJ1DRad(pDer) RESULT(invJ) IMPLICIT NONE @@ -591,7 +587,7 @@ MODULE moduleMesh1DRad elemA%e1 => elemB elemB%e2 => elemA - !Revers the normal to point inside the domain + !Rever the normal to point inside the domain elemB%normal = - elemB%normal END IF diff --git a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 index eab1266..cba0cdf 100644 --- a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 +++ b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 @@ -47,7 +47,6 @@ MODULE moduleMesh2DCart CLASS(meshNode), POINTER:: n1 => NULL(), n2 => NULL(), n3 => NULL(), n4 => NULL() !Connectivity to adjacent elements CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL(), e3 => NULL(), e4 => NULL() - REAL(8):: arNodes(1:4) = 0.D0 CONTAINS !meshCell DEFERRED PROCEDURES @@ -67,7 +66,7 @@ MODULE moduleMesh2DCart PROCEDURE, PASS:: phy2log => phy2logQuad PROCEDURE, PASS:: neighbourElement => neighbourElementQuad !PARTICLUAR PROCEDURES - PROCEDURE, PASS, PRIVATE:: area => areaQuad + PROCEDURE, PASS, PRIVATE:: vol => volumeQuad END TYPE meshCell2DCartQuad @@ -79,7 +78,6 @@ MODULE moduleMesh2DCart CLASS(meshNode), POINTER:: n1 => NULL(), n2 => NULL(), n3 => NULL() !Connectivity to adjacent elements CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL(), e3 => NULL() - REAL(8):: arNodes(1:3) = 0.D0 CONTAINS !meshCell DEFERRED PROCEDURES @@ -99,7 +97,7 @@ MODULE moduleMesh2DCart PROCEDURE, PASS:: phy2log => phy2logTria PROCEDURE, PASS:: neighbourElement => neighbourElementTria !PARTICULAR PROCEDURES - PROCEDURE, PASS, PRIVATE:: area => areaTria + PROCEDURE, PASS, PRIVATE:: vol => volumeTria END TYPE meshCell2DCartTria @@ -141,7 +139,7 @@ MODULE moduleMesh2DCart END FUNCTION getCoord2DCart !EDGE FUNCTIONS - !Inits edge element + !Init edge element SUBROUTINE initEdge2DCart(self, n, p, bt, physicalSurface) USE moduleSpecies USE moduleBoundary @@ -198,6 +196,7 @@ MODULE moduleMesh2DCart END FUNCTION getNodes2DCart + !Calculate intersection between position and edge PURE FUNCTION intersection2DCartEdge(self, r0) RESULT(r) IMPLICIT NONE @@ -216,7 +215,7 @@ MODULE moduleMesh2DCart END FUNCTION intersection2DCartEdge - !Calculates a random position in edge + !Calculate a random position in edge FUNCTION randPosEdge(self) RESULT(r) USE moduleRandom IMPLICIT NONE @@ -237,7 +236,7 @@ MODULE moduleMesh2DCart !VOLUME FUNCTIONS !QUAD FUNCTIONS - !Inits quadrilateral element + !Init element SUBROUTINE initCellQuad2DCart(self, n, p, nodes) USE moduleRefParam IMPLICIT NONE @@ -268,11 +267,7 @@ MODULE moduleMesh2DCart self%y = (/r1(2), r2(2), r3(2), r4(2)/) !Assign node volume - CALL self%area() - self%n1%v = self%n1%v + self%arNodes(1) - self%n2%v = self%n2%v + self%arNodes(2) - self%n3%v = self%n3%v + self%arNodes(3) - self%n4%v = self%n4%v + self%arNodes(4) + CALL self%vol() CALL OMP_INIT_LOCK(self%lock) @@ -303,19 +298,19 @@ 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 functions in point Xi + !Compute element functions in point Xi PURE FUNCTION fPsiQuad(Xi, nNodes) RESULT(fPsi) IMPLICIT NONE @@ -323,10 +318,10 @@ MODULE moduleMesh2DCart 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 = (/ (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 @@ -417,7 +412,7 @@ MODULE moduleMesh2DCart END FUNCTION gatherMFQuad - !Computes element local stiffness matrix + !Compute element local stiffness matrix PURE FUNCTION elemKQuad(self, nNodes) RESULT(localK) IMPLICIT NONE @@ -427,7 +422,6 @@ MODULE moduleMesh2DCart 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 @@ -478,7 +472,7 @@ MODULE moduleMesh2DCart pDer = self%partialDer(4, dPsi) detJ = self%detJac(pDer) fPsi = self%fPsi(Xi, 4) - f = DOT_PRODUCT(fPsi,source) + f = DOT_PRODUCT(fPsi, source) localF = localF + f*fPsi*wQuad(l)*wQuad(m)*detJ END DO @@ -486,7 +480,7 @@ MODULE moduleMesh2DCart END FUNCTION elemFQuad - !Checks if a particle is inside a quad element + !Check if Xi is inside the element PURE FUNCTION insideQuad(Xi) RESULT(ins) IMPLICIT NONE @@ -498,7 +492,7 @@ MODULE moduleMesh2DCart END FUNCTION insideQuad - !Transforms physical coordinates to element coordinates + !Transform physical coordinates to element coordinates PURE FUNCTION phy2logQuad(self,r) RESULT(Xi) IMPLICIT NONE @@ -532,7 +526,7 @@ MODULE moduleMesh2DCart END FUNCTION phy2logQuad - !Gets the next element for a logical position Xi + !Get the neighbour element for a logical position Xi SUBROUTINE neighbourElementQuad(self, Xi, neighbourElement) IMPLICIT NONE @@ -544,7 +538,7 @@ MODULE moduleMesh2DCart XiArray = (/ -Xi(2), Xi(1), Xi(2), -Xi(1) /) nextInt = MAXLOC(XiArray,1) - !Selects the higher value of directions and searches in that direction + !Select the higher value of directions and searches in that direction NULLIFY(neighbourElement) SELECT CASE (nextInt) CASE (1) @@ -559,8 +553,8 @@ MODULE moduleMesh2DCart END SUBROUTINE neighbourElementQuad - !Computes element area - PURE SUBROUTINE areaQuad(self) + !Compute element volume + PURE SUBROUTINE volumeQuad(self) IMPLICIT NONE CLASS(meshCell2DCartQuad), INTENT(inout):: self @@ -570,22 +564,24 @@ MODULE moduleMesh2DCart 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 + !Compute total volume of the cell + self%volume = detJ*4.D0 + !Compute volume per node + self%n1%v = self%n1%v + fPsi(1)*self%volume + self%n2%v = self%n2%v + fPsi(2)*self%volume + self%n3%v = self%n3%v + fPsi(3)*self%volume + self%n4%v = self%n4%v + fPsi(4)*self%volume - END SUBROUTINE areaQuad + END SUBROUTINE volumeQuad - !TRIA ELEMENT - !Init tria element + !TRIA FUNCTIONS + !Init element SUBROUTINE initCellTria2DCart(self, n, p, nodes) USE moduleRefParam IMPLICIT NONE @@ -613,10 +609,7 @@ MODULE moduleMesh2DCart self%x = (/r1(1), r2(1), r3(1)/) self%y = (/r1(2), r2(2), r3(2)/) !Assign node volume - CALL self%area() - self%n1%v = self%n1%v + self%arNodes(1) - self%n2%v = self%n2%v + self%arNodes(2) - self%n3%v = self%n3%v + self%arNodes(3) + CALL self%vol() CALL OMP_INIT_LOCK(self%lock) @@ -625,7 +618,7 @@ MODULE moduleMesh2DCart END SUBROUTINE initCellTria2DCart - !Gets node indexes from triangular element + !Random position in cell PURE FUNCTION getNodesTria(self, nNodes) RESULT(n) IMPLICIT NONE @@ -637,7 +630,7 @@ MODULE moduleMesh2DCart END FUNCTION getNodesTria - !Random position in quadrilateral volume + !Random position in cell FUNCTION randPosCellTria(self) RESULT(r) USE moduleRandom IMPLICIT NONE @@ -659,7 +652,7 @@ MODULE moduleMesh2DCart END FUNCTION randPosCellTria - !Shape functions for triangular element + !Compute element functions in point Xi PURE FUNCTION fPsiTria(Xi, nNodes) RESULT(fPsi) IMPLICIT NONE @@ -673,7 +666,7 @@ MODULE moduleMesh2DCart END FUNCTION fPsiTria - !Derivative element function at coordinates Xi + !Compute element derivative functions in point Xi PURE FUNCTION dPsiTria(Xi, nNodes) RESULT(dPsi) IMPLICIT NONE @@ -688,6 +681,7 @@ MODULE moduleMesh2DCart END FUNCTION dPsiTria + !Compute the derivatives in global coordinates PURE FUNCTION partialDerTria(self, nNodes, dPsi) RESULT(pDer) IMPLICIT NONE @@ -705,6 +699,7 @@ MODULE moduleMesh2DCart END FUNCTION partialDerTria + !Gather electric field at position Xi PURE FUNCTION gatherEFTria(self, Xi) RESULT(array) IMPLICIT NONE CLASS(meshCell2DCartTria), INTENT(in):: self @@ -720,6 +715,7 @@ MODULE moduleMesh2DCart END FUNCTION gatherEFTria + !Gather magnetic field at position Xi PURE FUNCTION gatherMFTria(self, Xi) RESULT(array) IMPLICIT NONE CLASS(meshCell2DCartTria), INTENT(in):: self @@ -743,7 +739,7 @@ MODULE moduleMesh2DCart END FUNCTION gatherMFTria - !Computes element local stiffness matrix + !Compute cell local stiffness matrix PURE FUNCTION elemKTria(self, nNodes) RESULT(localK) IMPLICIT NONE @@ -756,7 +752,8 @@ MODULE moduleMesh2DCart REAL(8):: invJ(1:3,1:3), detJ INTEGER:: l - localK=0.D0 + localK = 0.D0 + Xi=0.D0 !Start 2D Gauss Quad Integral DO l=1, 4 @@ -772,7 +769,7 @@ MODULE moduleMesh2DCart END FUNCTION elemKTria - !Computes element local source vector + !Compute element local source vector PURE FUNCTION elemFTria(self, nNodes, source) RESULT(localF) IMPLICIT NONE @@ -787,22 +784,24 @@ MODULE moduleMesh2DCart INTEGER:: l localF = 0.D0 - Xi = 0.D0 + + Xi = 0.D0 !Start 2D Gauss Quad Integral - DO l=1, 4 + 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) + f = DOT_PRODUCT(fPsi, source) localF = localF + f*fPsi*wTria(l)*detJ END DO END FUNCTION elemFTria + !Check if Xi is inside the element PURE FUNCTION insideTria(Xi) RESULT(ins) IMPLICIT NONE @@ -815,7 +814,7 @@ MODULE moduleMesh2DCart END FUNCTION insideTria - !Transforms physical coordinates to element coordinates + !Transform physical coordinates to element coordinates PURE FUNCTION phy2logTria(self,r) RESULT(Xi) IMPLICIT NONE @@ -838,6 +837,7 @@ MODULE moduleMesh2DCart END FUNCTION phy2logTria + !Get the neighbour cell for a logical position Xi SUBROUTINE neighbourElementTria(self, Xi, neighbourElement) IMPLICIT NONE @@ -861,8 +861,8 @@ MODULE moduleMesh2DCart END SUBROUTINE neighbourElementTria - !Calculates area for triangular element - PURE SUBROUTINE areaTria(self) + !Calculate volume for triangular element + PURE SUBROUTINE volumeTria(self) IMPLICIT NONE CLASS(meshCell2DCartTria), INTENT(inout):: self @@ -872,22 +872,23 @@ MODULE moduleMesh2DCart 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) + fPsi = self%fPsi(Xi, 3) !Computes total volume of the cell - self%volume = detJ + self%volume = detJ !Computes volume per node - self%arNodes = fPsi*detJ + self%n1%v = self%n1%v + fPsi(1)*self%volume + self%n2%v = self%n2%v + fPsi(2)*self%volume + self%n3%v = self%n3%v + fPsi(3)*self%volume - END SUBROUTINE areaTria + END SUBROUTINE volumeTria !COMMON FUNCTIONS FOR CARTESIAN VOLUME ELEMENTS IN 2D - !Computes element Jacobian determinant + !Compute element Jacobian determinant PURE FUNCTION detJ2DCart(pDer) RESULT(dJ) IMPLICIT NONE @@ -898,7 +899,7 @@ MODULE moduleMesh2DCart END FUNCTION detJ2DCart - !Computes element Jacobian inverse matrix (without determinant) + !Compute element Jacobian inverse matrix (without determinant) PURE FUNCTION invJ2DCart(pDer) RESULT(invJ) IMPLICIT NONE diff --git a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 index d9a7f32..c2b0674 100644 --- a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 +++ b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 @@ -47,7 +47,6 @@ MODULE moduleMesh2DCyl CLASS(meshNode), POINTER:: n1 => NULL(), n2 => NULL(), n3 => NULL(), n4 => NULL() !Connectivity to adjacent elements CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL(), e3 => NULL(), e4 => NULL() - REAL(8):: arNodes(1:4) = 0.D0 CONTAINS !meshCell DEFERRED PROCEDURES @@ -67,7 +66,7 @@ MODULE moduleMesh2DCyl PROCEDURE, PASS:: phy2log => phy2logQuad PROCEDURE, PASS:: neighbourElement => neighbourElementQuad !PARTICLUAR PROCEDURES - PROCEDURE, PASS, PRIVATE:: area => areaQuad + PROCEDURE, PASS, PRIVATE:: vol => volumeQuad END TYPE meshCell2DCylQuad @@ -79,7 +78,6 @@ MODULE moduleMesh2DCyl CLASS(meshNode), POINTER:: n1 => NULL(), n2 => NULL(), n3 => NULL() !Connectivity to adjacent elements CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL(), e3 => NULL() - REAL(8):: arNodes(1:3) = 0.D0 CONTAINS !meshCell DEFERRED PROCEDURES @@ -99,13 +97,13 @@ MODULE moduleMesh2DCyl PROCEDURE, PASS:: phy2log => phy2logTria PROCEDURE, PASS:: neighbourElement => neighbourElementTria !PARTICULAR PROCEDURES - PROCEDURE, PASS, PRIVATE:: area => areaTria + PROCEDURE, PASS, PRIVATE:: vol => volumeTria END TYPE meshCell2DCylTria CONTAINS !NODE FUNCTIONS - !Inits node element + !Init node element SUBROUTINE initNode2DCyl(self, n, r) USE moduleSpecies USE moduleRefParam @@ -141,7 +139,7 @@ MODULE moduleMesh2DCyl END FUNCTION getCoord2DCyl !EDGE FUNCTIONS - !Inits edge element + !Init edge element SUBROUTINE initEdge2DCyl(self, n, p, bt, physicalSurface) USE moduleSpecies USE moduleBoundary @@ -198,6 +196,7 @@ MODULE moduleMesh2DCyl END FUNCTION getNodes2DCyl + !Calculate intersection between position and edge PURE FUNCTION intersection2DCylEdge(self, r0) RESULT(r) IMPLICIT NONE @@ -216,15 +215,15 @@ MODULE moduleMesh2DCyl END FUNCTION intersection2DCylEdge - !Calculates a random position in edge + !Calculate a random position in edge FUNCTION randPosEdge(self) RESULT(r) USE moduleRandom IMPLICIT NONE CLASS(meshEdge2DCyl), INTENT(in):: self REAL(8):: rnd - REAL(8):: dr, dz REAL(8):: r(1:3) + REAL(8):: dr, dz rnd = random() dr = self%r(2) - self%r(1) @@ -245,7 +244,7 @@ MODULE moduleMesh2DCyl !VOLUME FUNCTIONS !QUAD FUNCTIONS - !Inits quadrilateral element + !Init element SUBROUTINE initCellQuad2DCyl(self, n, p, nodes) USE moduleRefParam IMPLICIT NONE @@ -276,11 +275,7 @@ MODULE moduleMesh2DCyl self%r = (/r1(2), r2(2), r3(2), r4(2)/) !Assign node volume - CALL self%area() - self%n1%v = self%n1%v + self%arNodes(1) - self%n2%v = self%n2%v + self%arNodes(2) - self%n3%v = self%n3%v + self%arNodes(3) - self%n4%v = self%n4%v + self%arNodes(4) + CALL self%vol() CALL OMP_INIT_LOCK(self%lock) @@ -289,7 +284,7 @@ MODULE moduleMesh2DCyl END SUBROUTINE initCellQuad2DCyl - !Gets nodes from quadrilateral element + !Get nodes from quadrilateral element PURE FUNCTION getNodesQuad(self, nNodes) RESULT(n) IMPLICIT NONE @@ -297,7 +292,7 @@ MODULE moduleMesh2DCyl INTEGER, INTENT(in):: nNodes INTEGER:: n(1:nNodes) - n = (/self%n1%n, self%n2%n, self%n3%n, self%n4%n /) + n = (/ self%n1%n, self%n2%n, self%n3%n, self%n4%n /) END FUNCTION getNodesQuad @@ -331,12 +326,12 @@ MODULE moduleMesh2DCyl 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 = (/ (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 + fPsi = fPsi * 0.25D0 END FUNCTION fPsiQuad @@ -350,15 +345,15 @@ MODULE moduleMesh2DCyl dPsi = 0.D0 - dPsi(1,:) = (/ -(1.D0 - Xi(2)), & - (1.D0 - Xi(2)), & - (1.D0 + Xi(2)), & - -(1.D0 + Xi(2)) /) + dPsi(1, 1:4) = (/ -(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(2, 1:4) = (/ -(1.D0 - Xi(1)), & + -(1.D0 + Xi(1)), & + (1.D0 + Xi(1)), & + (1.D0 - Xi(1)) /) dPsi = dPsi * 0.25D0 @@ -379,6 +374,7 @@ MODULE moduleMesh2DCyl DOT_PRODUCT(dPsi(2,1:4),self%z(1:4)) /) pDer(2, 1:2) = (/ DOT_PRODUCT(dPsi(1,1:4),self%r(1:4)), & DOT_PRODUCT(dPsi(2,1:4),self%r(1:4)) /) + pDer(3,3) = 1.D0 END FUNCTION partialDerQuad @@ -439,10 +435,11 @@ MODULE moduleMesh2DCyl REAL(8):: invJ(1:3,1:3), detJ INTEGER:: l, m - localK=0.D0 - Xi=0.D0 + localK = 0.D0 + + Xi = 0.D0 !Start 2D Gauss Quad Integral - DO l=1, 3 + DO l = 1, 3 Xi(2) = corQuad(l) DO m = 1, 3 Xi(1) = corQuad(m) @@ -479,8 +476,9 @@ MODULE moduleMesh2DCyl INTEGER:: l, m localF = 0.D0 - Xi = 0.D0 - DO l=1, 3 + + Xi = 0.D0 + DO l = 1, 3 Xi(1) = corQuad(l) DO m = 1, 3 Xi(2) = corQuad(m) @@ -489,7 +487,7 @@ MODULE moduleMesh2DCyl detJ = self%detJac(pDer) fPsi = self%fPsi(Xi, 4) r = DOT_PRODUCT(fPsi, self%r) - f = DOT_PRODUCT(fPsi,source) + f = DOT_PRODUCT(fPsi, source) localF = localF + r*f*fPsi*wQuad(l)*wQuad(m)*detJ END DO @@ -498,7 +496,7 @@ MODULE moduleMesh2DCyl END FUNCTION elemFQuad - !Checks if a particle is inside a quad element + !Checks if Xi is inside the element PURE FUNCTION insideQuad(Xi) RESULT(ins) IMPLICIT NONE @@ -510,7 +508,7 @@ MODULE moduleMesh2DCyl END FUNCTION insideQuad - !Transforms physical coordinates to element coordinates + !Transform physical coordinates to element coordinates PURE FUNCTION phy2logQuad(self,r) RESULT(Xi) IMPLICIT NONE @@ -544,7 +542,7 @@ MODULE moduleMesh2DCyl END FUNCTION phy2logQuad - !Get the next element for a logical position Xi + !Get the neighbour element for a logical position Xi SUBROUTINE neighbourElementQuad(self, Xi, neighbourElement) IMPLICIT NONE @@ -571,8 +569,8 @@ MODULE moduleMesh2DCyl END SUBROUTINE neighbourElementQuad - !Computes element area - PURE SUBROUTINE areaQuad(self) + !Compute element volume + PURE SUBROUTINE volumeQuad(self) USE moduleConstParam, ONLY: PI8 IMPLICIT NONE @@ -584,34 +582,33 @@ MODULE moduleMesh2DCyl 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 r = DOT_PRODUCT(fPsi,self%r) + !Computes total volume of the cell self%volume = r*detJ*PI8 !4*2*pi !Computes volume per node Xi = (/-5.D-1, -5.D-1, 0.D0/) r = self%gatherF(Xi, 4, self%r) - self%arNodes(1) = fPsi(1)*self%volume + self%n1%v = self%n1%v + fPsi(1)*r*detJ*PI8 Xi = (/ 5.D-1, -5.D-1, 0.D0/) r = self%gatherF(Xi, 4, self%r) - self%arNodes(2) = fPsi(2)*self%volume + self%n2%v = self%n2%v + fPsi(2)*r*detJ*PI8 Xi = (/ 5.D-1, 5.D-1, 0.D0/) r = self%gatherF(Xi, 4, self%r) - self%arNodes(3) = fPsi(3)*self%volume + self%n3%v = self%n3%v + fPsi(3)*r*detJ*PI8 Xi = (/-5.D-1, 5.D-1, 0.D0/) r = self%gatherF(Xi, 4, self%r) - self%arNodes(4) = fPsi(4)*self%volume + self%n4%v = self%n4%v + fPsi(4)*r*detJ*PI8 - END SUBROUTINE areaQuad + END SUBROUTINE volumeQuad - !TRIA ELEMENT - !Init tria element + !TRIA FUNCTIONS + !Init element SUBROUTINE initCellTria2DCyl(self, n, p, nodes) USE moduleRefParam IMPLICIT NONE @@ -639,10 +636,7 @@ MODULE moduleMesh2DCyl self%z = (/r1(1), r2(1), r3(1)/) self%r = (/r1(2), r2(2), r3(2)/) !Assign node volume - CALL self%area() - self%n1%v = self%n1%v + self%arNodes(1) - self%n2%v = self%n2%v + self%arNodes(2) - self%n3%v = self%n3%v + self%arNodes(3) + CALL self%vol() CALL OMP_INIT_LOCK(self%lock) @@ -651,7 +645,7 @@ MODULE moduleMesh2DCyl END SUBROUTINE initCellTria2DCyl - !Gets node indexes from triangular element + !Random position in cell PURE FUNCTION getNodesTria(self, nNodes) RESULT(n) IMPLICIT NONE @@ -663,7 +657,7 @@ MODULE moduleMesh2DCyl END FUNCTION getNodesTria - !Random position in quadrilateral volume + !Random position in cell FUNCTION randPosCellTria(self) RESULT(r) USE moduleRandom IMPLICIT NONE @@ -685,7 +679,7 @@ MODULE moduleMesh2DCyl END FUNCTION randPosCellTria - !Shape functions for triangular element + !Compute element functions in point Xi PURE FUNCTION fPsiTria(Xi, nNodes) RESULT(fPsi) IMPLICIT NONE @@ -699,7 +693,7 @@ MODULE moduleMesh2DCyl END FUNCTION fPsiTria - !Derivative element function at coordinates Xi + !Compute element derivative functions in point Xi PURE FUNCTION dPsiTria(Xi, nNodes) RESULT(dPsi) IMPLICIT NONE @@ -714,6 +708,7 @@ MODULE moduleMesh2DCyl END FUNCTION dPsiTria + !Compute the derivatives in global coordinates PURE FUNCTION partialDerTria(self, nNodes, dPsi) RESULT(pDer) IMPLICIT NONE @@ -731,6 +726,7 @@ MODULE moduleMesh2DCyl END FUNCTION partialDerTria + !Gather electric field at position Xi PURE FUNCTION gatherEFTria(self, Xi) RESULT(array) IMPLICIT NONE CLASS(meshCell2DCylTria), INTENT(in):: self @@ -746,6 +742,7 @@ MODULE moduleMesh2DCyl END FUNCTION gatherEFTria + !Gather magnetic field at position Xi PURE FUNCTION gatherMFTria(self, Xi) RESULT(array) IMPLICIT NONE CLASS(meshCell2DCylTria), INTENT(in):: self @@ -769,7 +766,7 @@ MODULE moduleMesh2DCyl END FUNCTION gatherMFTria - !Computes element local stiffness matrix + !Compute cell local stiffness matrix PURE FUNCTION elemKTria(self, nNodes) RESULT(localK) USE moduleConstParam, ONLY: PI2 IMPLICIT NONE @@ -784,7 +781,8 @@ MODULE moduleMesh2DCyl REAL(8):: invJ(1:3,1:3), detJ INTEGER:: l - localK=0.D0 + localK = 0.D0 + Xi=0.D0 !Start 2D Gauss Quad Integral DO l=1, 4 @@ -802,7 +800,7 @@ MODULE moduleMesh2DCyl END FUNCTION elemKTria - !Computes element local source vector + !Compute element local source vector PURE FUNCTION elemFTria(self, nNodes, source) RESULT(localF) USE moduleConstParam, ONLY: PI2 IMPLICIT NONE @@ -838,6 +836,7 @@ MODULE moduleMesh2DCyl END FUNCTION elemFTria + !Check if Xi is inside the element PURE FUNCTION insideTria(Xi) RESULT(ins) IMPLICIT NONE @@ -850,7 +849,7 @@ MODULE moduleMesh2DCyl END FUNCTION insideTria - !Transforms physical coordinates to element coordinates + !Transform physical coordinates to element coordinates PURE FUNCTION phy2logTria(self,r) RESULT(Xi) IMPLICIT NONE @@ -873,6 +872,7 @@ MODULE moduleMesh2DCyl END FUNCTION phy2logTria + !Get the neighbour cell for a logical position Xi SUBROUTINE neighbourElementTria(self, Xi, neighbourElement) IMPLICIT NONE @@ -896,8 +896,8 @@ MODULE moduleMesh2DCyl END SUBROUTINE neighbourElementTria - !Calculates area for triangular element - PURE SUBROUTINE areaTria(self) + !Calculate volume for triangular element + PURE SUBROUTINE volumeTria(self) USE moduleConstParam, ONLY: PI IMPLICIT NONE @@ -909,23 +909,24 @@ MODULE moduleMesh2DCyl REAL(8):: r 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, 3) - !Computes total volume of the cell r = DOT_PRODUCT(fPsi, self%r) + !Computes total volume of the cell self%volume = r*detJ*PI !2PI*1/2 !Computes volume per node - self%arNodes = fPsi*self%volume + self%n1%v = self%n1%v + fPsi(1)*self%volume + self%n2%v = self%n2%v + fPsi(2)*self%volume + self%n3%v = self%n3%v + fPsi(3)*self%volume - END SUBROUTINE areaTria + END SUBROUTINE volumeTria !COMMON FUNCTIONS FOR CYLINDRICAL VOLUME ELEMENTS - !Computes element Jacobian determinant + !Compute element Jacobian determinant PURE FUNCTION detJ2DCyl(pDer) RESULT(dJ) IMPLICIT NONE @@ -936,7 +937,7 @@ MODULE moduleMesh2DCyl END FUNCTION detJ2DCyl - !Computes element Jacobian inverse matrix (without determinant) + !Compute element Jacobian inverse matrix (without determinant) PURE FUNCTION invJ2DCyl(pDer) RESULT(invJ) IMPLICIT NONE diff --git a/src/modules/mesh/3DCart/moduleMesh3DCart.f90 b/src/modules/mesh/3DCart/moduleMesh3DCart.f90 index 34474cd..fcd4647 100644 --- a/src/modules/mesh/3DCart/moduleMesh3DCart.f90 +++ b/src/modules/mesh/3DCart/moduleMesh3DCart.f90 @@ -60,13 +60,13 @@ MODULE moduleMesh3DCart PROCEDURE, PASS:: phy2log => phy2logTetra PROCEDURE, PASS:: neighbourElement => neighbourElementTetra !PARTICULAR PROCEDURES - PROCEDURE, PASS, PRIVATE:: calcVol => volumeTetra + PROCEDURE, PASS, PRIVATE:: vol => volumeTetra END TYPE meshCell3DCartTetra CONTAINS !NODE FUNCTIONS - !Inits node element + !Init node element SUBROUTINE initNode3DCart(self, n, r) USE moduleSpecies USE moduleRefParam @@ -102,8 +102,8 @@ MODULE moduleMesh3DCart END FUNCTION getCoord3DCart - !SURFACE FUNCTIONS - !Inits surface element + !EDGE FUNCTIONS + !Init surface element SUBROUTINE initEdge3DCartTria(self, n, p, bt, physicalSurface) USE moduleSpecies USE moduleBoundary @@ -168,6 +168,7 @@ MODULE moduleMesh3DCart END FUNCTION getNodes3DCartTria + !Calculate intersection between position and edge PURE FUNCTION intersection3DCartTria(self, r0) RESULT(r) IMPLICIT NONE @@ -186,7 +187,7 @@ MODULE moduleMesh3DCart END FUNCTION intersection3DCartTria - !Calculates a random position in the surface + !Calculate a random position in the surface FUNCTION randPosEdgeTria(self) RESULT(r) USE moduleRandom IMPLICIT NONE @@ -222,7 +223,7 @@ MODULE moduleMesh3DCart !VOLUME FUNCTIONS !TETRA FUNCTIONS - !Inits tetrahedron element + !Init element SUBROUTINE initCellTetra(self, n, p, nodes) USE moduleRefParam IMPLICIT NONE @@ -232,11 +233,14 @@ MODULE moduleMesh3DCart INTEGER, INTENT(in):: p(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) REAL(8), DIMENSION(1:3):: r1, r2, r3, r4 !Positions of each node - REAL(8):: Xi(1:3), fPsi(1:4) - REAL(8):: volNodes(1:4) !Cellume of each node + !Assign node index self%n = n + + !Assign number of nodes of cell self%nNodes = SIZE(p) + + !Assign nodes to element self%n1 => nodes(p(1))%obj self%n2 => nodes(p(2))%obj self%n3 => nodes(p(3))%obj @@ -251,16 +255,7 @@ MODULE moduleMesh3DCart self%z = (/r1(3), r2(3), r3(3), r4(3)/) !Computes the element volume - CALL self%calcVol() - - !Assign proportional volume to each node - Xi = (/0.25D0, 0.25D0, 0.25D0/) - fPsi = self%fPsi(Xi, 4) - volNodes = fPsi*self%volume - self%n1%v = self%n1%v + volNodes(1) - self%n2%v = self%n2%v + volNodes(2) - self%n3%v = self%n3%v + volNodes(3) - self%n4%v = self%n4%v + volNodes(4) + CALL self%vol() CALL OMP_INIT_LOCK(self%lock) @@ -269,6 +264,7 @@ MODULE moduleMesh3DCart END SUBROUTINE initCellTetra + !Gets node indexes from cell PURE FUNCTION getNodesTetra(self, nNodes) RESULT(n) IMPLICIT NONE @@ -280,7 +276,7 @@ MODULE moduleMesh3DCart END FUNCTION getNodesTetra - !Random position in volume tetrahedron + !Random position in cell FUNCTION randPosCellTetra(self) RESULT(r) USE moduleRandom IMPLICIT NONE @@ -302,7 +298,7 @@ MODULE moduleMesh3DCart END FUNCTION randPosCellTetra - !Computes element functions in point Xi + !Compute element functions in point Xi PURE FUNCTION fPsiTetra(Xi, nNodes) RESULT(fPsi) IMPLICIT NONE @@ -317,7 +313,7 @@ MODULE moduleMesh3DCart END FUNCTION fPsiTetra - !Derivative element function at coordinates Xi + !Compute element derivative functions in point Xi PURE FUNCTION dPsiTetra(Xi, nNodes) RESULT(dPsi) IMPLICIT NONE @@ -333,7 +329,7 @@ MODULE moduleMesh3DCart END FUNCTION dPsiTetra - !Computes the derivatives in global coordinates + !Compute the derivatives in global coordinates PURE FUNCTION partialDerTetra(self, nNodes, dPsi) RESULT(pDer) IMPLICIT NONE @@ -358,6 +354,7 @@ MODULE moduleMesh3DCart END FUNCTION partialDerTetra + !Gather electric field at position Xi PURE FUNCTION gatherEFTetra(self, Xi) RESULT(array) IMPLICIT NONE CLASS(meshCell3DCartTetra), INTENT(in):: self @@ -374,6 +371,7 @@ MODULE moduleMesh3DCart END FUNCTION gatherEFTetra + !Gather magnetic field at position Xi PURE FUNCTION gatherMFTetra(self, Xi) RESULT(array) IMPLICIT NONE CLASS(meshCell3DCartTetra), INTENT(in):: self @@ -400,6 +398,7 @@ MODULE moduleMesh3DCart END FUNCTION gatherMFTetra + !Compute cell local stiffness matrix PURE FUNCTION elemKTetra(self, nNodes) RESULT(localK) IMPLICIT NONE @@ -424,6 +423,7 @@ MODULE moduleMesh3DCart END FUNCTION elemKTetra + !Compute element local source vector PURE FUNCTION elemFTetra(self, nNodes, source) RESULT(localF) IMPLICIT NONE @@ -448,6 +448,7 @@ MODULE moduleMesh3DCart END FUNCTION elemFTetra + !Check if Xi is inside the element PURE FUNCTION insideTetra(Xi) RESULT(ins) IMPLICIT NONE @@ -461,6 +462,7 @@ MODULE moduleMesh3DCart END FUNCTION insideTetra + !Transform physical coordinates to element coordinates PURE FUNCTION phy2logTetra(self,r) RESULT(Xi) IMPLICIT NONE @@ -472,6 +474,7 @@ MODULE moduleMesh3DCart REAL(8):: invJ(1:3, 1:3), detJ REAL(8):: deltaR(1:3) + !Direct method to convert coordinates Xi = 0.D0 deltaR = (/r(1) - self%x(1), r(2) - self%y(1), r(3) - self%z(1) /) dPsi = self%dPsi(Xi, 4) @@ -482,6 +485,7 @@ MODULE moduleMesh3DCart END FUNCTION phy2logTetra + !Get the neighbour cell for a logical position Xi SUBROUTINE neighbourElementTetra(self, Xi, neighbourElement) IMPLICIT NONE @@ -508,25 +512,35 @@ MODULE moduleMesh3DCart END SUBROUTINE neighbourElementTetra - !Computes the element volume + !Calculate volume for triangular element 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) + REAL(8):: detJ + REAL(8):: fPsi(1:4) + REAL(8):: dPsi(1:3, 1:4), pDer(1:3, 1:3) self%volume = 0.D0 + !2D 1 point Gauss Quad Integral Xi = (/0.25D0, 0.25D0, 0.25D0/) dPsi = self%dPsi(Xi, 4) pDer = self%partialDer(4, dPsi) - self%volume = self%detJac(pDer) + detJ = self%detJac(pDer) + !Computes total volume of the cell + self%volume = detJ + !Computes volume per node + fPsi = self%fPsi(Xi, 4) + self%n1%v = self%n1%v + fPsi(1)*self%volume + self%n2%v = self%n2%v + fPsi(2)*self%volume + self%n3%v = self%n3%v + fPsi(3)*self%volume + self%n4%v = self%n4%v + fPsi(4)*self%volume END SUBROUTINE volumeTetra !COMMON FUNCTIONS FOR CARTESIAN VOLUME ELEMENTS IN 3D - !Computes element Jacobian determinant + !Compute element Jacobian determinant PURE FUNCTION detJ3DCart(pDer) RESULT(dJ) IMPLICIT NONE @@ -539,6 +553,7 @@ MODULE moduleMesh3DCart END FUNCTION detJ3DCart + !Compute element Jacobian inverse matrix (without determinant) PURE FUNCTION invJ3DCart(pDer) RESULT(invJ) IMPLICIT NONE @@ -561,7 +576,37 @@ MODULE moduleMesh3DCart END FUNCTION invJ3DCart - !Selects type of elements to build connection + SUBROUTINE connectMesh3DCart(self) + IMPLICIT NONE + + CLASS(meshGeneric), INTENT(inout):: self + INTEGER:: e, et + + DO e = 1, self%numCells + !Connect Cell-Cell + DO et = 1, self%numCells + IF (e /= et) THEN + CALL connectCellCell(self%cells(e)%obj, self%cells(et)%obj) + + END IF + + END DO + + SELECT TYPE(self) + TYPE IS(meshParticles) + !Connect Cell-Edge + DO et = 1, self%numEdges + CALL connectCellEdge(self%cells(e)%obj, self%edges(et)%obj) + + END DO + + END SELECT + + END DO + + END SUBROUTINE connectMesh3DCart + + !Select type of elements to build connection SUBROUTINE connectCellCell(elemA, elemB) IMPLICIT NONE @@ -601,36 +646,6 @@ MODULE moduleMesh3DCart END SUBROUTINE connectCellEdge - SUBROUTINE connectMesh3DCart(self) - IMPLICIT NONE - - CLASS(meshGeneric), INTENT(inout):: self - INTEGER:: e, et - - DO e = 1, self%numCells - !Connect Cell-Cell - DO et = 1, self%numCells - IF (e /= et) THEN - CALL connectCellCell(self%cells(e)%obj, self%cells(et)%obj) - - END IF - - END DO - - SELECT TYPE(self) - TYPE IS(meshParticles) - !Connect Cell-Edge - DO et = 1, self%numEdges - CALL connectCellEdge(self%cells(e)%obj, self%edges(et)%obj) - - END DO - - END SELECT - - END DO - - END SUBROUTINE connectMesh3DCart - !Checks if two sets of nodes are coincidend in any order PURE FUNCTION coincidentNodes(nodesA, nodesB) RESULT(coincident) IMPLICIT NONE diff --git a/src/modules/mesh/inout/0D/moduleMeshInput0D.f90 b/src/modules/mesh/inout/0D/moduleMeshInput0D.f90 index 37dbf82..d968ba3 100644 --- a/src/modules/mesh/inout/0D/moduleMeshInput0D.f90 +++ b/src/modules/mesh/inout/0D/moduleMeshInput0D.f90 @@ -64,10 +64,9 @@ MODULE moduleMeshInput0D END SUBROUTINE read0D - SUBROUTINE readInitial0D(sp, filename, density, velocity, temperature) + SUBROUTINE readInitial0D(filename, density, velocity, temperature) IMPLICIT NONE - INTEGER, INTENT(in):: sp CHARACTER(:), ALLOCATABLE, INTENT(in):: filename REAL(8), ALLOCATABLE, INTENT(out), DIMENSION(:):: density REAL(8), ALLOCATABLE, INTENT(out), DIMENSION(:,:):: velocity diff --git a/src/modules/mesh/inout/gmsh2/moduleMeshInputGmsh2.f90 b/src/modules/mesh/inout/gmsh2/moduleMeshInputGmsh2.f90 index aae2216..ae1fe05 100644 --- a/src/modules/mesh/inout/gmsh2/moduleMeshInputGmsh2.f90 +++ b/src/modules/mesh/inout/gmsh2/moduleMeshInputGmsh2.f90 @@ -321,10 +321,9 @@ MODULE moduleMeshInputGmsh2 END SUBROUTINE readGmsh2 !Reads the initial information from an output file for an species - SUBROUTINE readInitialGmsh2(sp, filename, density, velocity, temperature) + SUBROUTINE readInitialGmsh2(filename, density, velocity, temperature) IMPLICIT NONE - INTEGER, INTENT(in):: sp CHARACTER(:), ALLOCATABLE, INTENT(in):: filename REAL(8), ALLOCATABLE, INTENT(out), DIMENSION(:):: density REAL(8), ALLOCATABLE, INTENT(out), DIMENSION(:,:):: velocity diff --git a/src/modules/mesh/moduleMesh.f90 b/src/modules/mesh/moduleMesh.f90 index 97ce691..f15f880 100644 --- a/src/modules/mesh/moduleMesh.f90 +++ b/src/modules/mesh/moduleMesh.f90 @@ -356,8 +356,7 @@ MODULE moduleMesh END SUBROUTINE readMesh_interface - SUBROUTINE readInitial_interface(sp, filename, density, velocity, temperature) - INTEGER, INTENT(in):: sp + SUBROUTINE readInitial_interface(filename, density, velocity, temperature) CHARACTER(:), ALLOCATABLE, INTENT(in):: filename REAL(8), ALLOCATABLE, INTENT(out), DIMENSION(:):: density REAL(8), ALLOCATABLE, INTENT(out), DIMENSION(:,:):: velocity diff --git a/src/modules/mesh/moduleMeshBoundary.f90 b/src/modules/mesh/moduleMeshBoundary.f90 index 713c091..517835e 100644 --- a/src/modules/mesh/moduleMeshBoundary.f90 +++ b/src/modules/mesh/moduleMeshBoundary.f90 @@ -159,8 +159,8 @@ MODULE moduleMeshBoundary newElectron%vol = part%vol newIon%vol = part%vol - newElectron%xi = mesh%cells(part%vol)%obj%phy2log(newElectron%r) - newIon%xi = newElectron%xi + newElectron%Xi = mesh%cells(part%vol)%obj%phy2log(newElectron%r) + newIon%Xi = newElectron%Xi newElectron%weight = part%weight newIon%weight = newElectron%weight diff --git a/src/modules/moduleCollisions.f90 b/src/modules/moduleCollisions.f90 index 224bfbb..ccca930 100644 --- a/src/modules/moduleCollisions.f90 +++ b/src/modules/moduleCollisions.f90 @@ -111,13 +111,13 @@ MODULE moduleCollisions IMPLICIT NONE REAL(8):: n(1:3) - REAL(8):: cosXii, sinXii, eps + REAL(8):: cosXi, sinXi, eps - cosXii = random(-1.D0, 1.D0) - sinXii = DSQRT(1.D0 - cosXii**2) + cosXi = random(-1.D0, 1.D0) + sinXi = DSQRT(1.D0 - cosXi**2) eps = random(0.D0, PI2) - n = (/ cosXii, sinXii*DCOS(eps), sinXii*DSIN(eps) /) + n = (/ cosXi, sinXi*DCOS(eps), sinXi*DSIN(eps) /) END FUNCTION randomDirectionVHS diff --git a/src/modules/moduleSpecies.f90 b/src/modules/moduleSpecies.f90 index d19ff28..ca7858c 100644 --- a/src/modules/moduleSpecies.f90 +++ b/src/modules/moduleSpecies.f90 @@ -40,7 +40,7 @@ MODULE moduleSpecies CLASS(speciesGeneric), POINTER:: species !Pointer to species associated with this particle INTEGER:: vol !Index of element in which the particle is located INTEGER:: volColl !Index of element in which the particle is located in the Collision Mesh - REAL(8):: xi(1:3) !Logical coordinates of particle in element e_p. + REAL(8):: Xi(1:3) !Logical coordinates of particle in element e_p. LOGICAL:: n_in !Flag that indicates if a particle is in the domain REAL(8):: weight=0.D0 !weight of particle From 600480f5d53c4ce441a3080f956e1a6f1ab9246c Mon Sep 17 00:00:00 2001 From: JGonzalez Date: Fri, 6 Jan 2023 21:37:26 +0100 Subject: [PATCH 10/13] Reduce overhead of probes I noticed that doProbes was causing some overhead even if no probes were being used. Now it should be fixed. --- src/modules/solver/moduleSolver.f90 | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/src/modules/solver/moduleSolver.f90 b/src/modules/solver/moduleSolver.f90 index 02932c9..af0a177 100644 --- a/src/modules/solver/moduleSolver.f90 +++ b/src/modules/solver/moduleSolver.f90 @@ -204,7 +204,10 @@ MODULE moduleSolver DO n = 1, partList%amount partNext => partCurr%next partArray(nStart + n) = partCurr%part - CALL doProbes(partArray(nStart+n)) + IF (nProbes > 0) THEN + CALL doProbes(partArray(nStart+n)) + + END IF DEALLOCATE(partCurr) partCurr => partNext @@ -270,7 +273,10 @@ MODULE moduleSolver IF (partInj(n)%n_in) THEN nn = nn + 1 partOld(nn) = partInj(n) - CALL doProbes(partOld(nn)) + IF (nProbes > 0) THEN + CALL doProbes(partOld(nn)) + + END IF END IF @@ -283,7 +289,10 @@ MODULE moduleSolver IF (partTemp(n)%n_in) THEN nn = nn + 1 partOld(nn) = partTemp(n) - CALL doProbes(partOld(nn)) + IF (nProbes > 0) THEN + CALL doProbes(partOld(nn)) + + END IF END IF From 22dff9ed6967d8c24353331952e59eb869b8d97e Mon Sep 17 00:00:00 2001 From: JGonzalez Date: Fri, 6 Jan 2023 22:36:55 +0100 Subject: [PATCH 11/13] Small style correction --- src/modules/solver/moduleSolver.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/modules/solver/moduleSolver.f90 b/src/modules/solver/moduleSolver.f90 index af0a177..4ee6e7d 100644 --- a/src/modules/solver/moduleSolver.f90 +++ b/src/modules/solver/moduleSolver.f90 @@ -473,9 +473,9 @@ MODULE moduleSolver volOld => mesh%cells(part%vol)%obj CALL volOld%findCell(part) CALL findCellColl(part) - volNew => mesh%cells(part%vol)%obj !Call the NA shcme IF (ASSOCIATED(self%weightingScheme)) THEN + volNew => mesh%cells(part%vol)%obj CALL self%weightingScheme(part, volOld, volNew) END IF From 1c5b887a6d7b0221efd7fcceb072330406f0d7f4 Mon Sep 17 00:00:00 2001 From: JGonzalez Date: Sat, 7 Jan 2023 10:47:18 +0100 Subject: [PATCH 12/13] Small bugfix when testing examples While testing the examples distributed with the code, a few errors were found and fixed, mostly related with the K matrix in 1D geometry and reading values from initial conditions for species. --- runs/1D_Cathode/inputRad.json | 4 +- src/modules/init/moduleInput.f90 | 47 +++++++------------- src/modules/mesh/1DCart/moduleMesh1DCart.f90 | 6 +-- src/modules/mesh/1DRad/moduleMesh1DRad.f90 | 8 ++-- 4 files changed, 25 insertions(+), 40 deletions(-) diff --git a/runs/1D_Cathode/inputRad.json b/runs/1D_Cathode/inputRad.json index 34a09ce..824c0a8 100644 --- a/runs/1D_Cathode/inputRad.json +++ b/runs/1D_Cathode/inputRad.json @@ -31,10 +31,10 @@ ]} ], "boundaryEM": [ - {"name": "Cathode", "type": "dirichlet", "potential": 0.0, "physicalSurface": 1} + {"name": "Cathode", "type": "dirichlet", "potential": 0.0, "physicalSurface": 1} ], "inject": [ - {"name": "Plasma Cat e", "species": "Electron", "flow": 2.64e-2, "units": "A", "v": 180000.0, "T": [ 2300.0, 2300.0, 2300.0], + {"name": "Plasma Cat e", "species": "Electron", "flow": 2.64e-5, "units": "A", "v": 180000.0, "T": [ 2300.0, 2300.0, 2300.0], "velDist": ["Maxwellian", "Maxwellian", "Maxwellian"], "n": [ 1, 0, 0], "physicalSurface": 1} ], "solver": { diff --git a/src/modules/init/moduleInput.f90 b/src/modules/init/moduleInput.f90 index ff2cc4b..60f33ec 100644 --- a/src/modules/init/moduleInput.f90 +++ b/src/modules/init/moduleInput.f90 @@ -331,7 +331,8 @@ MODULE moduleInput REAL(8), ALLOCATABLE, DIMENSION(:,:):: velocity INTEGER, ALLOCATABLE, DIMENSION(:):: nodes INTEGER:: nNodes - REAL(8), ALLOCATABLE, DIMENSION(:):: source, fPsi + REAL(8), ALLOCATABLE, DIMENSION(:):: sourceScalar + REAL(8), ALLOCATABLE, DIMENSION(:,:):: sourceArray !Density at the volume centroid REAL(8):: densityCen !Mean velocity and temperature at particle position @@ -361,14 +362,10 @@ MODULE moduleInput !Density at centroid of cell nNodes = mesh%cells(e)%obj%nNodes nodes = mesh%cells(e)%obj%getNodes(nNodes) - ALLOCATE(fPsi(1:nNodes)) - fPsi = mesh%cells(e)%obj%fPsi((/0.D0, 0.D0, 0.D0/), nNodes) - ALLOCATE(source(1:nNodes)) - DO j = 1, nNodes - source(j) = density(nodes(j)) - - END DO - densityCen = DOT_PRODUCT(fPsi, source) + ALLOCATE(sourceScalar(1:nNodes)) + ALLOCATE(sourceArray(1:nNodes, 1:3)) + sourceScalar = density(nodes) + densityCen = mesh%cells(e)%obj%gatherF((/ 0.D0, 0.D0, 0.D0 /), nNodes, sourceScalar) !Calculate number of particles nNewPart = INT(densityCen * (mesh%cells(e)%obj%volume*Vol_ref) / species(sp)%obj%weight) @@ -380,37 +377,23 @@ MODULE moduleInput partNew%r = mesh%cells(e)%obj%randPos() partNew%Xi = mesh%cells(e)%obj%phy2log(partNew%r) !Get mean velocity at particle position - fPsi = mesh%cells(e)%obj%fPsi(partNew%Xi, nNodes) - DO j = 1, nNodes - source(j) = velocity(nodes(j), 1) - - END DO - velocityXi(1) = DOT_PRODUCT(fPsi, source) - DO j = 1, nNodes - source(j) = velocity(nodes(j), 2) - - END DO - velocityXi(2) = DOT_PRODUCT(fPsi, source) - DO j = 1, nNodes - source(j) = velocity(nodes(j), 3) - - END DO - velocityXi(3) = DOT_PRODUCT(fPsi, source) + sourceArray(:,1) = velocity((nodes), 1) + sourceArray(:,2) = velocity((nodes), 2) + sourceArray(:,3) = velocity((nodes), 3) + velocityXi = mesh%cells(e)%obj%gatherF(partNew%Xi, nNodes, sourceArray) velocityXi = velocityXi / v_ref !Get temperature at particle position - DO j = 1, nNodes - source(j) = temperature(nodes(j)) - - END DO - temperatureXi = DOT_PRODUCT(fPsi, source) + sourceScalar = temperature(nodes) + temperatureXi = mesh%cells(e)%obj%gatherF(partNew%Xi, nNodes, sourceScalar) temperatureXi = temperatureXi / T_ref vTh = DSQRT(temperatureXi / species(sp)%obj%m) partNew%v(1) = velocityXi(1) + vTh*randomMaxwellian() partNew%v(2) = velocityXi(2) + vTh*randomMaxwellian() partNew%v(3) = velocityXi(3) + vTh*randomMaxwellian() + partNew%vol = e IF (doubleMesh) THEN partNew%volColl = findCellBrute(meshColl, partNew%r) @@ -419,7 +402,9 @@ MODULE moduleInput partNew%volColl = partNew%vol END IF + partNew%n_in = .TRUE. + partNew%weight = species(sp)%obj%weight !Assign particle to temporal list of particles @@ -434,7 +419,7 @@ MODULE moduleInput END DO - DEALLOCATE(source) + DEALLOCATE(sourceScalar, sourceArray) END DO diff --git a/src/modules/mesh/1DCart/moduleMesh1DCart.f90 b/src/modules/mesh/1DCart/moduleMesh1DCart.f90 index 82f43c2..2f8b7b8 100644 --- a/src/modules/mesh/1DCart/moduleMesh1DCart.f90 +++ b/src/modules/mesh/1DCart/moduleMesh1DCart.f90 @@ -324,7 +324,7 @@ MODULE moduleMesh1DCart 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 + REAL(8):: invJ(1:3, 1:3), detJ INTEGER:: l localK = 0.D0 @@ -337,8 +337,8 @@ MODULE moduleMesh1DCart 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/)))* & + localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)), & + MATMUL(invJ,dPsi))* & wSeg(l)/detJ END DO diff --git a/src/modules/mesh/1DRad/moduleMesh1DRad.f90 b/src/modules/mesh/1DRad/moduleMesh1DRad.f90 index c8ff414..81a8864 100644 --- a/src/modules/mesh/1DRad/moduleMesh1DRad.f90 +++ b/src/modules/mesh/1DRad/moduleMesh1DRad.f90 @@ -326,7 +326,7 @@ MODULE moduleMesh1DRad 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 + REAL(8):: invJ(1:3, 1:3), detJ INTEGER:: l localK = 0.D0 @@ -339,9 +339,9 @@ MODULE moduleMesh1DRad 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 = self%gatherF(Xi, 2, self%r) + localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)), & + MATMUL(invJ,dPsi))* & r*wSeg(l)/detJ END DO From 7ce1b7a4dd446919d6b5686d80493dab334a487d Mon Sep 17 00:00:00 2001 From: JGonzalez Date: Sat, 7 Jan 2023 12:12:37 +0100 Subject: [PATCH 13/13] Reducing overhead when no collisions are present Particles are added to lists only if there are MCC collisions. Hopefully this will reduce overhead when OpenMP is used and no collisions are active. --- src/fpakc.f90 | 10 ++- src/modules/init/moduleInput.f90 | 37 +++++---- src/modules/mesh/1DCart/moduleMesh1DCart.f90 | 22 +++--- src/modules/mesh/1DRad/moduleMesh1DRad.f90 | 22 +++--- src/modules/mesh/2DCart/moduleMesh2DCart.f90 | 8 +- src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 | 8 +- src/modules/mesh/3DCart/moduleMesh3DCart.f90 | 4 +- src/modules/mesh/moduleMesh.f90 | 38 ++++++---- src/modules/mesh/moduleMeshBoundary.f90 | 6 +- src/modules/moduleInject.f90 | 8 +- src/modules/moduleSpecies.f90 | 4 +- src/modules/solver/moduleSolver.f90 | 79 +++++++++++--------- src/modules/solver/pusher/modulePusher.f90 | 10 +-- 13 files changed, 142 insertions(+), 114 deletions(-) diff --git a/src/fpakc.f90 b/src/fpakc.f90 index 1224f53..3a8a033 100644 --- a/src/fpakc.f90 +++ b/src/fpakc.f90 @@ -74,7 +74,10 @@ PROGRAM fpakc tColl = omp_get_wtime() !$OMP END SINGLE - IF (ASSOCIATED(meshForMCC)) CALL meshForMCC%doCollisions(t) + IF (doMCC) THEN + CALL meshForMCC%doCollisions(t) + + END IF !$OMP SINGLE tColl = omp_get_wtime() - tColl @@ -83,7 +86,10 @@ PROGRAM fpakc tCoul = omp_get_wTime() !$OMP END SINGLE - IF (ASSOCIATED(mesh%doCoulomb)) CALL mesh%doCoulomb() + IF (ASSOCIATED(mesh%doCoulomb)) THEN + CALL mesh%doCoulomb() + + END IF !$OMP SINGLE tCoul = omp_get_wTime() - tCoul diff --git a/src/modules/init/moduleInput.f90 b/src/modules/init/moduleInput.f90 index 60f33ec..81ababd 100644 --- a/src/modules/init/moduleInput.f90 +++ b/src/modules/init/moduleInput.f90 @@ -338,7 +338,7 @@ MODULE moduleInput !Mean velocity and temperature at particle position REAL(8):: velocityXi(1:3), temperatureXi INTEGER:: nNewPart = 0.D0 - CLASS(meshCell), POINTER:: vol + CLASS(meshCell), POINTER:: cell TYPE(particle), POINTER:: partNew REAL(8):: vTh TYPE(lNode), POINTER:: partCurr, partNext @@ -394,12 +394,12 @@ MODULE moduleInput partNew%v(2) = velocityXi(2) + vTh*randomMaxwellian() partNew%v(3) = velocityXi(3) + vTh*randomMaxwellian() - partNew%vol = e + partNew%cell = e IF (doubleMesh) THEN - partNew%volColl = findCellBrute(meshColl, partNew%r) + partNew%cellColl = findCellBrute(meshColl, partNew%r) ELSE - partNew%volColl = partNew%vol + partNew%cellColl = partNew%cell END IF @@ -411,11 +411,14 @@ MODULE moduleInput CALL partInitial%add(partNew) !Assign particle to list in volume - vol => meshforMCC%cells(partNew%volColl)%obj - CALL OMP_SET_LOCK(vol%lock) - CALL vol%listPart_in(sp)%add(partNew) - vol%totalWeight(sp) = vol%totalWeight(sp) + partNew%weight - CALL OMP_UNSET_LOCK(vol%lock) + IF (doMCC) THEN + cell => meshforMCC%cells(partNew%cellColl)%obj + CALL OMP_SET_LOCK(cell%lock) + CALL cell%listPart_in(sp)%add(partNew) + cell%totalWeight(sp) = cell%totalWeight(sp) + partNew%weight + CALL OMP_UNSET_LOCK(cell%lock) + + END IF END DO @@ -628,7 +631,7 @@ MODULE moduleInput REAL(8):: energyThreshold, energyBinding CHARACTER(:), ALLOCATABLE:: electron INTEGER:: e - CLASS(meshCell), POINTER:: vol + CLASS(meshCell), POINTER:: cell !Firstly, check if the object 'interactions' exists CALL config%info('interactions', found) @@ -725,17 +728,17 @@ MODULE moduleInput !Init the required arrays in each volume to account for MCC. DO e = 1, meshForMCC%numCells - vol => meshForMCC%cells(e)%obj + cell => meshForMCC%cells(e)%obj !Allocate Maximum cross section per collision pair and assign the initial collision rate - ALLOCATE(vol%sigmaVrelMax(1:nCollPairs)) - vol%sigmaVrelMax = sigmaVrel_ref/(L_ref**2 * v_ref) + ALLOCATE(cell%sigmaVrelMax(1:nCollPairs)) + cell%sigmaVrelMax = sigmaVrel_ref/(L_ref**2 * v_ref) IF (collOutput) THEN - ALLOCATE(vol%tallyColl(1:nCollPairs)) + ALLOCATE(cell%tallyColl(1:nCollPairs)) DO k = 1, nCollPairs - ALLOCATE(vol%tallyColl(k)%tally(1:interactionmatrix(k)%amount)) - vol%tallyColl(k)%tally = 0 + ALLOCATE(cell%tallyColl(k)%tally(1:interactionmatrix(k)%amount)) + cell%tallyColl(k)%tally = 0 END DO @@ -892,6 +895,8 @@ MODULE moduleInput END IF + doMCC = ASSOCIATED(meshForMCC) + !Get the dimension of the geometry CALL config%get(object // '.dimension', mesh%dimen, found) IF (.NOT. found) THEN diff --git a/src/modules/mesh/1DCart/moduleMesh1DCart.f90 b/src/modules/mesh/1DCart/moduleMesh1DCart.f90 index 2f8b7b8..269f157 100644 --- a/src/modules/mesh/1DCart/moduleMesh1DCart.f90 +++ b/src/modules/mesh/1DCart/moduleMesh1DCart.f90 @@ -59,7 +59,7 @@ MODULE moduleMesh1DCart PROCEDURE, PASS:: phy2log => phy2logSegm PROCEDURE, PASS:: neighbourElement => neighbourElementSegm !PARTICLUAR PROCEDURES - PROCEDURE, PASS, PRIVATE:: vol => volumeSegm + PROCEDURE, PASS, PRIVATE:: calculateVolume => volumeSegm END TYPE meshCell1DCartSegm @@ -193,7 +193,7 @@ MODULE moduleMesh1DCart self%x = (/ r1(1), r2(1) /) !Assign node volume - CALL self%vol() + CALL self%calculateVolume() CALL OMP_INIT_LOCK(self%lock) @@ -419,7 +419,7 @@ MODULE moduleMesh1DCart END SUBROUTINE neighbourElementSegm - !Compute element vol + !Compute element volume PURE SUBROUTINE volumeSegm(self) IMPLICIT NONE @@ -478,10 +478,10 @@ MODULE moduleMesh1DCart INTEGER:: e, et DO e = 1, self%numCells - !Connect Vol-Vol + !Connect Cell-Cell DO et = 1, self%numCells IF (e /= et) THEN - CALL connectVolVol(self%cells(e)%obj, self%cells(et)%obj) + CALL connectCellCell(self%cells(e)%obj, self%cells(et)%obj) END IF @@ -489,9 +489,9 @@ MODULE moduleMesh1DCart SELECT TYPE(self) TYPE IS(meshParticles) - !Connect Vol-Edge + !Connect Cell-Edge DO et = 1, self%numEdges - CALL connectVolEdge(self%cells(e)%obj, self%edges(et)%obj) + CALL connectCellEdge(self%cells(e)%obj, self%edges(et)%obj) END DO @@ -501,7 +501,7 @@ MODULE moduleMesh1DCart END SUBROUTINE connectMesh1DCart - SUBROUTINE connectVolVol(elemA, elemB) + SUBROUTINE connectCellCell(elemA, elemB) IMPLICIT NONE CLASS(meshCell), INTENT(inout):: elemA @@ -517,7 +517,7 @@ MODULE moduleMesh1DCart END SELECT - END SUBROUTINE connectVolVol + END SUBROUTINE connectCellCell SUBROUTINE connectSegmSegm(elemA, elemB) IMPLICIT NONE @@ -542,7 +542,7 @@ MODULE moduleMesh1DCart END SUBROUTINE connectSegmSegm - SUBROUTINE connectVolEdge(elemA, elemB) + SUBROUTINE connectCellEdge(elemA, elemB) IMPLICIT NONE CLASS(meshCell), INTENT(inout):: elemA @@ -558,7 +558,7 @@ MODULE moduleMesh1DCart END SELECT - END SUBROUTINE connectVolEdge + END SUBROUTINE connectCellEdge SUBROUTINE connectSegmEdge(elemA, elemB) IMPLICIT NONE diff --git a/src/modules/mesh/1DRad/moduleMesh1DRad.f90 b/src/modules/mesh/1DRad/moduleMesh1DRad.f90 index 81a8864..d998267 100644 --- a/src/modules/mesh/1DRad/moduleMesh1DRad.f90 +++ b/src/modules/mesh/1DRad/moduleMesh1DRad.f90 @@ -59,7 +59,7 @@ MODULE moduleMesh1DRad PROCEDURE, PASS:: phy2log => phy2logSegm PROCEDURE, PASS:: neighbourElement => neighbourElementSegm !PARTICLUAR PROCEDURES - PROCEDURE, PASS, PRIVATE:: vol => volumeSegm + PROCEDURE, PASS, PRIVATE:: calculateVolume => volumeSegm END TYPE meshCell1DRadSegm @@ -193,7 +193,7 @@ MODULE moduleMesh1DRad self%r = (/ r1(1), r2(1) /) !Assign node volume - CALL self%vol() + CALL self%calculateVolume() CALL OMP_INIT_LOCK(self%lock) @@ -427,7 +427,7 @@ MODULE moduleMesh1DRad END SUBROUTINE neighbourElementSegm - !Compute element vol + !Compute element volume PURE SUBROUTINE volumeSegm(self) USE moduleConstParam, ONLY: PI4 IMPLICIT NONE @@ -493,10 +493,10 @@ MODULE moduleMesh1DRad INTEGER:: e, et DO e = 1, self%numCells - !Connect Vol-Vol + !Connect Cell-Cell DO et = 1, self%numCells IF (e /= et) THEN - CALL connectVolVol(self%cells(e)%obj, self%cells(et)%obj) + CALL connectCellCell(self%cells(e)%obj, self%cells(et)%obj) END IF @@ -504,9 +504,9 @@ MODULE moduleMesh1DRad SELECT TYPE(self) TYPE IS(meshParticles) - !Connect Vol-Edge + !Connect Cell-Edge DO et = 1, self%numEdges - CALL connectVolEdge(self%cells(e)%obj, self%edges(et)%obj) + CALL connectCellEdge(self%cells(e)%obj, self%edges(et)%obj) END DO @@ -516,7 +516,7 @@ MODULE moduleMesh1DRad END SUBROUTINE connectMesh1DRad - SUBROUTINE connectVolVol(elemA, elemB) + SUBROUTINE connectCellCell(elemA, elemB) IMPLICIT NONE CLASS(meshCell), INTENT(inout):: elemA @@ -532,7 +532,7 @@ MODULE moduleMesh1DRad END SELECT - END SUBROUTINE connectVolVol + END SUBROUTINE connectCellCell SUBROUTINE connectSegmSegm(elemA, elemB) IMPLICIT NONE @@ -557,7 +557,7 @@ MODULE moduleMesh1DRad END SUBROUTINE connectSegmSegm - SUBROUTINE connectVolEdge(elemA, elemB) + SUBROUTINE connectCellEdge(elemA, elemB) IMPLICIT NONE CLASS(meshCell), INTENT(inout):: elemA @@ -573,7 +573,7 @@ MODULE moduleMesh1DRad END SELECT - END SUBROUTINE connectVolEdge + END SUBROUTINE connectCellEdge SUBROUTINE connectSegmEdge(elemA, elemB) IMPLICIT NONE diff --git a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 index cba0cdf..c02078a 100644 --- a/src/modules/mesh/2DCart/moduleMesh2DCart.f90 +++ b/src/modules/mesh/2DCart/moduleMesh2DCart.f90 @@ -66,7 +66,7 @@ MODULE moduleMesh2DCart PROCEDURE, PASS:: phy2log => phy2logQuad PROCEDURE, PASS:: neighbourElement => neighbourElementQuad !PARTICLUAR PROCEDURES - PROCEDURE, PASS, PRIVATE:: vol => volumeQuad + PROCEDURE, PASS, PRIVATE:: calculateVolume => volumeQuad END TYPE meshCell2DCartQuad @@ -97,7 +97,7 @@ MODULE moduleMesh2DCart PROCEDURE, PASS:: phy2log => phy2logTria PROCEDURE, PASS:: neighbourElement => neighbourElementTria !PARTICULAR PROCEDURES - PROCEDURE, PASS, PRIVATE:: vol => volumeTria + PROCEDURE, PASS, PRIVATE:: calculateVolume => volumeTria END TYPE meshCell2DCartTria @@ -267,7 +267,7 @@ MODULE moduleMesh2DCart self%y = (/r1(2), r2(2), r3(2), r4(2)/) !Assign node volume - CALL self%vol() + CALL self%calculateVolume() CALL OMP_INIT_LOCK(self%lock) @@ -609,7 +609,7 @@ MODULE moduleMesh2DCart self%x = (/r1(1), r2(1), r3(1)/) self%y = (/r1(2), r2(2), r3(2)/) !Assign node volume - CALL self%vol() + CALL self%calculateVolume() CALL OMP_INIT_LOCK(self%lock) diff --git a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 index c2b0674..307f71c 100644 --- a/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 +++ b/src/modules/mesh/2DCyl/moduleMesh2DCyl.f90 @@ -66,7 +66,7 @@ MODULE moduleMesh2DCyl PROCEDURE, PASS:: phy2log => phy2logQuad PROCEDURE, PASS:: neighbourElement => neighbourElementQuad !PARTICLUAR PROCEDURES - PROCEDURE, PASS, PRIVATE:: vol => volumeQuad + PROCEDURE, PASS, PRIVATE:: calculateVolume => volumeQuad END TYPE meshCell2DCylQuad @@ -97,7 +97,7 @@ MODULE moduleMesh2DCyl PROCEDURE, PASS:: phy2log => phy2logTria PROCEDURE, PASS:: neighbourElement => neighbourElementTria !PARTICULAR PROCEDURES - PROCEDURE, PASS, PRIVATE:: vol => volumeTria + PROCEDURE, PASS, PRIVATE:: calculateVolume => volumeTria END TYPE meshCell2DCylTria @@ -275,7 +275,7 @@ MODULE moduleMesh2DCyl self%r = (/r1(2), r2(2), r3(2), r4(2)/) !Assign node volume - CALL self%vol() + CALL self%calculateVolume() CALL OMP_INIT_LOCK(self%lock) @@ -636,7 +636,7 @@ MODULE moduleMesh2DCyl self%z = (/r1(1), r2(1), r3(1)/) self%r = (/r1(2), r2(2), r3(2)/) !Assign node volume - CALL self%vol() + CALL self%calculateVolume() CALL OMP_INIT_LOCK(self%lock) diff --git a/src/modules/mesh/3DCart/moduleMesh3DCart.f90 b/src/modules/mesh/3DCart/moduleMesh3DCart.f90 index fcd4647..c451689 100644 --- a/src/modules/mesh/3DCart/moduleMesh3DCart.f90 +++ b/src/modules/mesh/3DCart/moduleMesh3DCart.f90 @@ -60,7 +60,7 @@ MODULE moduleMesh3DCart PROCEDURE, PASS:: phy2log => phy2logTetra PROCEDURE, PASS:: neighbourElement => neighbourElementTetra !PARTICULAR PROCEDURES - PROCEDURE, PASS, PRIVATE:: vol => volumeTetra + PROCEDURE, PASS, PRIVATE:: calculateVolume => volumeTetra END TYPE meshCell3DCartTetra @@ -255,7 +255,7 @@ MODULE moduleMesh3DCart self%z = (/r1(3), r2(3), r3(3), r4(3)/) !Computes the element volume - CALL self%vol() + CALL self%calculateVolume() CALL OMP_INIT_LOCK(self%lock) diff --git a/src/modules/mesh/moduleMesh.f90 b/src/modules/mesh/moduleMesh.f90 index f15f880..7482842 100644 --- a/src/modules/mesh/moduleMesh.f90 +++ b/src/modules/mesh/moduleMesh.f90 @@ -480,6 +480,8 @@ MODULE moduleMesh !Logical to indicate if an specific mesh for MC Collisions is used LOGICAL:: doubleMesh + !Logical to indicate if MCC collisions are performed + LOGICAL:: doMCC !Complete path for the two meshes CHARACTER(:), ALLOCATABLE:: pathMeshColl, pathMeshParticle @@ -644,15 +646,18 @@ MODULE moduleMesh Xi = self%phy2log(part%r) !Checks if particle is inside 'self' cell IF (self%inside(Xi)) THEN - part%vol = self%n + part%cell = self%n part%Xi = Xi part%n_in = .TRUE. !Assign particle to listPart_in - CALL OMP_SET_LOCK(self%lock) - sp = part%species%n - CALL self%listPart_in(sp)%add(part) - self%totalWeight(sp) = self%totalWeight(sp) + part%weight - CALL OMP_UNSET_LOCK(self%lock) + IF (doMCC) THEN + CALL OMP_SET_LOCK(self%lock) + sp = part%species%n + CALL self%listPart_in(sp)%add(part) + self%totalWeight(sp) = self%totalWeight(sp) + part%weight + CALL OMP_UNSET_LOCK(self%lock) + + END IF ELSE !If not, searches for a neighbour and repeats the process. @@ -688,14 +693,14 @@ MODULE moduleMesh END SUBROUTINE findCell - !If Coll and Particle are the same, simply copy the part%vol into part%volColl + !If Coll and Particle are the same, simply copy the part%cell into part%cellColl SUBROUTINE findCellSameMesh(part) USE moduleSpecies IMPLICIT NONE TYPE(particle), INTENT(inout):: part - part%volColl = part%vol + part%cellColl = part%cell END SUBROUTINE findCellSameMesh @@ -715,16 +720,19 @@ MODULE moduleMesh found = .FALSE. - cell => meshColl%cells(part%volColl)%obj + cell => meshColl%cells(part%cellColl)%obj DO WHILE(.NOT. found) Xi = cell%phy2log(part%r) IF (cell%inside(Xi)) THEN - part%volColl = cell%n - CALL OMP_SET_LOCK(cell%lock) - sp = part%species%n - CALL cell%listPart_in(sp)%add(part) - cell%totalWeight(sp) = cell%totalWeight(sp) + part%weight - CALL OMP_UNSET_LOCK(cell%lock) + part%cellColl = cell%n + IF (doMCC) THEN + CALL OMP_SET_LOCK(cell%lock) + sp = part%species%n + CALL cell%listPart_in(sp)%add(part) + cell%totalWeight(sp) = cell%totalWeight(sp) + part%weight + CALL OMP_UNSET_LOCK(cell%lock) + + END IF found = .TRUE. ELSE diff --git a/src/modules/mesh/moduleMeshBoundary.f90 b/src/modules/mesh/moduleMeshBoundary.f90 index 517835e..6120111 100644 --- a/src/modules/mesh/moduleMeshBoundary.f90 +++ b/src/modules/mesh/moduleMeshBoundary.f90 @@ -156,10 +156,10 @@ MODULE moduleMeshBoundary newElectron%r = edge%randPos() newIon%r = newElectron%r - newElectron%vol = part%vol - newIon%vol = part%vol + newElectron%cell = part%cell + newIon%cell = part%cell - newElectron%Xi = mesh%cells(part%vol)%obj%phy2log(newElectron%r) + newElectron%Xi = mesh%cells(part%cell)%obj%phy2log(newElectron%r) newIon%Xi = newElectron%Xi newElectron%weight = part%weight diff --git a/src/modules/moduleInject.f90 b/src/modules/moduleInject.f90 index 050ad52..daa3846 100644 --- a/src/modules/moduleInject.f90 +++ b/src/modules/moduleInject.f90 @@ -285,16 +285,16 @@ MODULE moduleInject partInj(n)%r = randomEdge%randPos() !Volume associated to the edge: IF (ASSOCIATED(randomEdge%e1)) THEN - partInj(n)%vol = randomEdge%e1%n + partInj(n)%cell = randomEdge%e1%n ELSEIF (ASSOCIATED(randomEdge%e2)) THEN - partInj(n)%vol = randomEdge%e2%n + partInj(n)%cell = randomEdge%e2%n ELSE CALL criticalError("No Volume associated to edge", 'addParticles') END IF - partInj(n)%volColl = randomEdge%eColl%n + partInj(n)%cellColl = randomEdge%eColl%n sp = self%species%n !Assign particle type @@ -305,7 +305,7 @@ MODULE moduleInject self%v(3)%obj%randomVel() /) !Obtain natural coordinates of particle in cell - partInj(n)%Xi = mesh%cells(partInj(n)%vol)%obj%phy2log(partInj(n)%r) + partInj(n)%Xi = mesh%cells(partInj(n)%cell)%obj%phy2log(partInj(n)%r) !Push new particle with the minimum time step CALL solver%pusher(sp)%pushParticle(partInj(n), tau(sp)) !Assign cell to new particle diff --git a/src/modules/moduleSpecies.f90 b/src/modules/moduleSpecies.f90 index ca7858c..ab08f08 100644 --- a/src/modules/moduleSpecies.f90 +++ b/src/modules/moduleSpecies.f90 @@ -38,8 +38,8 @@ MODULE moduleSpecies REAL(8):: r(1:3) !Position REAL(8):: v(1:3) !Velocity CLASS(speciesGeneric), POINTER:: species !Pointer to species associated with this particle - INTEGER:: vol !Index of element in which the particle is located - INTEGER:: volColl !Index of element in which the particle is located in the Collision Mesh + INTEGER:: cell !Index of element in which the particle is located + INTEGER:: cellColl !Index of element in which the particle is located in the Collision Mesh REAL(8):: Xi(1:3) !Logical coordinates of particle in element e_p. LOGICAL:: n_in !Flag that indicates if a particle is in the domain REAL(8):: weight=0.D0 !weight of particle diff --git a/src/modules/solver/moduleSolver.f90 b/src/modules/solver/moduleSolver.f90 index 4ee6e7d..e557495 100644 --- a/src/modules/solver/moduleSolver.f90 +++ b/src/modules/solver/moduleSolver.f90 @@ -43,14 +43,14 @@ MODULE moduleSolver END SUBROUTINE solveEM_interface !Apply nonAnalogue scheme to a particle - SUBROUTINE weightingScheme_interface(part, volOld, volNew) + SUBROUTINE weightingScheme_interface(part, cellOld, cellNew) USE moduleSpecies USE moduleMesh IMPLICIT NONE TYPE(particle), INTENT(inout):: part - CLASS(meshCell), POINTER, INTENT(in):: volOld - CLASS(meshCell), POINTER, INTENT(inout):: volNew + CLASS(meshCell), POINTER, INTENT(in):: cellOld + CLASS(meshCell), POINTER, INTENT(inout):: cellNew END SUBROUTINE weightingScheme_interface @@ -322,31 +322,37 @@ MODULE moduleSolver !$OMP SECTION !Erase the list of particles inside the cell if particles have been pushed - DO s = 1, nSpecies - DO e = 1, mesh%numCells - IF (solver%pusher(s)%pushSpecies) THEN - CALL mesh%cells(e)%obj%listPart_in(s)%erase() - mesh%cells(e)%obj%totalWeight(s) = 0.D0 + IF (doMCC) THEN + DO s = 1, nSpecies + DO e = 1, mesh%numCells + IF (solver%pusher(s)%pushSpecies) THEN + CALL mesh%cells(e)%obj%listPart_in(s)%erase() + mesh%cells(e)%obj%totalWeight(s) = 0.D0 - END IF + END IF + + END DO END DO - END DO + END IF !$OMP SECTION !Erase the list of particles inside the cell in coll mesh - DO s = 1, nSpecies - DO e = 1, meshColl%numCells - IF (solver%pusher(s)%pushSpecies) THEN - CALL meshColl%cells(e)%obj%listPart_in(s)%erase() - meshColl%cells(e)%obj%totalWeight(s) = 0.D0 + IF (doubleMesh) THEN + DO s = 1, nSpecies + DO e = 1, meshColl%numCells + IF (solver%pusher(s)%pushSpecies) THEN + CALL meshColl%cells(e)%obj%listPart_in(s)%erase() + meshColl%cells(e)%obj%totalWeight(s) = 0.D0 - END IF + END IF + + END DO END DO - - END DO + + END IF !$OMP END SECTIONS @@ -368,7 +374,7 @@ MODULE moduleSolver !Loops over the particles to scatter them !$OMP DO DO n = 1, nPartOld - cell => mesh%cells(partOld(n)%vol)%obj + cell => mesh%cells(partOld(n)%cell)%obj CALL cell%scatter(cell%nNodes, partOld(n)) END DO @@ -387,28 +393,28 @@ MODULE moduleSolver END SUBROUTINE doEMField !Split particles as a function of cell volume and splits particle - SUBROUTINE volumeWScheme(part, volOld, volNew) + SUBROUTINE volumeWScheme(part, cellOld, cellNew) USE moduleSpecies USE moduleMesh USE moduleRandom IMPLICIT NONE TYPE(particle), INTENT(inout):: part - CLASS(meshCell), POINTER, INTENT(in):: volOld - CLASS(meshCell), POINTER, INTENT(inout):: volNew + CLASS(meshCell), POINTER, INTENT(in):: cellOld + CLASS(meshCell), POINTER, INTENT(inout):: cellNew REAL(8):: fractionVolume, pSplit !If particle changes volume to smaller cell - IF (volOld%volume > volNew%volume .AND. & + IF (cellOld%volume > cellNew%volume .AND. & part%weight >= part%species%weight*1.0D-1) THEN - fractionVolume = volOld%volume/volNew%volume + fractionVolume = cellOld%volume/cellNew%volume !Calculate probability of splitting particle pSplit = 1.D0 - DEXP(-fractionVolume*1.0D-1) IF (random() < pSplit) THEN !Split particle in two - CALL splitParticle(part, 2, volNew) + CALL splitParticle(part, 2, cellNew) END IF @@ -418,7 +424,7 @@ MODULE moduleSolver !Subroutine to split the particle 'part' into a number 'nSplit' of particles. !'nSplit-1' particles are added to the partNAScheme list - SUBROUTINE splitParticle(part, nSplit, vol) + SUBROUTINE splitParticle(part, nSplit, cell) USE moduleSpecies USE moduleList USE moduleMesh @@ -427,7 +433,7 @@ MODULE moduleSolver TYPE(particle), INTENT(inout):: part INTEGER, INTENT(in):: nSplit - CLASS(meshCell), INTENT(inout):: vol + CLASS(meshCell), INTENT(inout):: cell REAL(8):: newWeight TYPE(particle), POINTER:: newPart INTEGER:: p @@ -449,10 +455,13 @@ MODULE moduleSolver CALL partWScheme%add(newPart) CALL partWScheme%unsetLock() !Add particle to cell list - CALL OMP_SET_lock(vol%lock) sp = part%species%n - CALL vol%listPart_in(sp)%add(newPart) - CALL OMP_UNSET_lock(vol%lock) + IF (doMCC) THEN + CALL OMP_SET_lock(cell%lock) + CALL cell%listPart_in(sp)%add(newPart) + CALL OMP_UNSET_lock(cell%lock) + + END IF END DO @@ -465,18 +474,18 @@ MODULE moduleSolver CLASS(solverGeneric), INTENT(in):: self TYPE(particle), INTENT(inout):: part - CLASS(meshCell), POINTER:: volOld, volNew + CLASS(meshCell), POINTER:: cellOld, cellNew !Assume that particle is outside the domain part%n_in = .FALSE. - volOld => mesh%cells(part%vol)%obj - CALL volOld%findCell(part) + cellOld => mesh%cells(part%cell)%obj + CALL cellOld%findCell(part) CALL findCellColl(part) !Call the NA shcme IF (ASSOCIATED(self%weightingScheme)) THEN - volNew => mesh%cells(part%vol)%obj - CALL self%weightingScheme(part, volOld, volNew) + cellNew => mesh%cells(part%cell)%obj + CALL self%weightingScheme(part, cellOld, cellNew) END IF diff --git a/src/modules/solver/pusher/modulePusher.f90 b/src/modules/solver/pusher/modulePusher.f90 index c2aa46a..bc02912 100644 --- a/src/modules/solver/pusher/modulePusher.f90 +++ b/src/modules/solver/pusher/modulePusher.f90 @@ -23,7 +23,7 @@ MODULE modulePusher REAL(8):: qmEFt(1:3) !Get the electric field at particle position - qmEFT = mesh%cells(part%vol)%obj%gatherElectricField(part%Xi) + qmEFT = mesh%cells(part%cell)%obj%gatherElectricField(part%Xi) qmEFt = qmEFt*part%species%qm*tauMin !Update velocity @@ -50,14 +50,14 @@ MODULE modulePusher tauInHalf = tauIn *0.5D0 !Half of the force o f the electric field - qmEFT = mesh%cells(part%vol)%obj%gatherElectricField(part%Xi) + qmEFT = mesh%cells(part%cell)%obj%gatherElectricField(part%Xi) qmEFt = qmEFt*part%species%qm*tauInHalf !Half step for electrostatic v_minus = part%v + qmEFt !Full step rotation - B = mesh%cells(part%vol)%obj%gatherMagneticField(part%Xi) + B = mesh%cells(part%cell)%obj%gatherMagneticField(part%Xi) BNorm = NORM2(B) IF (BNorm > 0.D0) THEN fn = DTAN(part%species%qm * tauInHalf*BNorm) / BNorm @@ -126,7 +126,7 @@ MODULE modulePusher part_temp = part !Get electric field at particle position - qmEFT = mesh%cells(part_temp%vol)%obj%gatherElectricField(part_temp%Xi) + qmEFT = mesh%cells(part_temp%cell)%obj%gatherElectricField(part_temp%Xi) qmEFt = qmEFt*part_temp%species%qm*tauMin !z part_temp%v(1) = part%v(1) + qmEFt(1) @@ -202,7 +202,7 @@ MODULE modulePusher part_temp = part !Get electric field at particle position - qmEFT = mesh%cells(part_temp%vol)%obj%gatherElectricField(part_temp%Xi) + qmEFT = mesh%cells(part_temp%cell)%obj%gatherElectricField(part_temp%Xi) qmEFt = qmEFt*part_temp%species%qm*tauMin !r,theta v_p_oh_star(1) = part%v(1) + qmEFt(1)