Reduction in pushing

Reduction in 10-20% of time spend in pushing in 2DCyl thanks to
rewriting fPsi and dPsi.
This commit is contained in:
Jorge Gonzalez 2023-01-05 16:47:13 +01:00
commit 2486ef6316
18 changed files with 1289 additions and 1280 deletions

View file

@ -337,7 +337,7 @@ MODULE moduleInput
!Mean velocity and temperature at particle position !Mean velocity and temperature at particle position
REAL(8):: velocityXi(1:3), temperatureXi REAL(8):: velocityXi(1:3), temperatureXi
INTEGER:: nNewPart = 0.D0 INTEGER:: nNewPart = 0.D0
CLASS(meshVol), POINTER:: vol CLASS(meshCell), POINTER:: vol
TYPE(particle), POINTER:: partNew TYPE(particle), POINTER:: partNew
REAL(8):: vTh REAL(8):: vTh
TYPE(lNode), POINTER:: partCurr, partNext TYPE(lNode), POINTER:: partCurr, partNext
@ -356,13 +356,13 @@ MODULE moduleInput
filename = path // spFile filename = path // spFile
CALL mesh%readInitial(sp, filename, density, velocity, temperature) CALL mesh%readInitial(sp, filename, density, velocity, temperature)
!For each volume in the node, create corresponding particles !For each volume in the node, create corresponding particles
DO e = 1, mesh%numVols DO e = 1, mesh%numCells
!Scale variables !Scale variables
!Density at centroid of cell !Density at centroid of cell
nodes = mesh%vols(e)%obj%getNodes() nodes = mesh%cells(e)%obj%getNodes()
nNodes = SIZE(nodes) nNodes = mesh%cells(e)%obj%nNodes
ALLOCATE(fPsi(1: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)) ALLOCATE(source(1:nNodes))
DO j = 1, nNodes DO j = 1, nNodes
source(j) = density(nodes(j)) source(j) = density(nodes(j))
@ -371,16 +371,16 @@ MODULE moduleInput
densityCen = DOT_PRODUCT(fPsi, source) densityCen = DOT_PRODUCT(fPsi, source)
!Calculate number of particles !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 !Allocate new particles
DO p = 1, nNewPart DO p = 1, nNewPart
ALLOCATE(partNew) ALLOCATE(partNew)
partNew%species => species(sp)%obj partNew%species => species(sp)%obj
partNew%r = mesh%vols(e)%obj%randPos() partNew%r = mesh%cells(e)%obj%randPos()
partNew%xi = mesh%vols(e)%obj%phy2log(partNew%r) partNew%xi = mesh%cells(e)%obj%phy2log(partNew%r)
!Get mean velocity at particle position !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 DO j = 1, nNodes
source(j) = velocity(nodes(j), 1) source(j) = velocity(nodes(j), 1)
@ -426,7 +426,7 @@ MODULE moduleInput
CALL partInitial%add(partNew) CALL partInitial%add(partNew)
!Assign particle to list in volume !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 OMP_SET_LOCK(vol%lock)
CALL vol%listPart_in(sp)%add(partNew) CALL vol%listPart_in(sp)%add(partNew)
vol%totalWeight(sp) = vol%totalWeight(sp) + partNew%weight vol%totalWeight(sp) = vol%totalWeight(sp) + partNew%weight
@ -643,7 +643,7 @@ MODULE moduleInput
REAL(8):: energyThreshold, energyBinding REAL(8):: energyThreshold, energyBinding
CHARACTER(:), ALLOCATABLE:: electron CHARACTER(:), ALLOCATABLE:: electron
INTEGER:: e INTEGER:: e
CLASS(meshVol), POINTER:: vol CLASS(meshCell), POINTER:: vol
!Firstly, checks if the object 'interactions' exists !Firstly, checks if the object 'interactions' exists
CALL config%info('interactions', found) CALL config%info('interactions', found)
@ -739,8 +739,8 @@ MODULE moduleInput
END DO END DO
!Init the required arrays in each volume to account for MCC. !Init the required arrays in each volume to account for MCC.
DO e = 1, meshForMCC%numVols DO e = 1, meshForMCC%numCells
vol => meshForMCC%vols(e)%obj vol => meshForMCC%cells(e)%obj
!Allocate Maximum cross section per collision pair and assign the initial collision rate !Allocate Maximum cross section per collision pair and assign the initial collision rate
ALLOCATE(vol%sigmaVrelMax(1:nCollPairs)) ALLOCATE(vol%sigmaVrelMax(1:nCollPairs))
@ -930,8 +930,8 @@ MODULE moduleInput
CALL config%get(object // '.volume', volume, found) CALL config%get(object // '.volume', volume, found)
!Rescale the volumne !Rescale the volumne
IF (found) THEN IF (found) THEN
mesh%vols(1)%obj%volume = mesh%vols(1)%obj%volume*volume / Vol_ref mesh%cells(1)%obj%volume = mesh%cells(1)%obj%volume*volume / Vol_ref
mesh%nodes(1)%obj%v = mesh%vols(1)%obj%volume mesh%nodes(1)%obj%v = mesh%cells(1)%obj%volume
END IF END IF

View file

@ -11,22 +11,25 @@ MODULE moduleMesh0D
END TYPE meshNode0D END TYPE meshNode0D
TYPE, PUBLIC, EXTENDS(meshVol):: meshVol0D TYPE, PUBLIC, EXTENDS(meshCell):: meshCell0D
CLASS(meshNode), POINTER:: n1 CLASS(meshNode), POINTER:: n1
CONTAINS CONTAINS
PROCEDURE, PASS:: init => initVol0D PROCEDURE, PASS:: init => initCell0D
PROCEDURE, PASS:: getNodes => getNodes0D PROCEDURE, PASS:: getNodes => getNodes0D
PROCEDURE, PASS:: randPos => randPos0D PROCEDURE, PASS:: randPos => randPos0D
PROCEDURE, NOPASS:: fPsi => fPsi0D PROCEDURE, PASS:: fPsi => fPsi0D
PROCEDURE, PASS:: gatherEF => gatherEF0D PROCEDURE, PASS:: dPsi => dPsi0D
PROCEDURE, PASS:: gatherMF => gatherMF0D PROCEDURE, PASS:: detJac => detJ0D
PROCEDURE, PASS:: invJac => invJ0D
PROCEDURE, PASS:: elemK => elemK0D PROCEDURE, PASS:: elemK => elemK0D
PROCEDURE, PASS:: elemF => elemF0D PROCEDURE, PASS:: elemF => elemF0D
PROCEDURE, PASS:: gatherElectricField => gatherEF0D
PROCEDURE, PASS:: gatherMagneticField => gatherMF0D
PROCEDURE, PASS:: phy2log => phy2log0D PROCEDURE, PASS:: phy2log => phy2log0D
PROCEDURE, NOPASS:: inside => inside0D PROCEDURE, NOPASS:: inside => inside0D
PROCEDURE, PASS:: nextElement => nextElement0D PROCEDURE, PASS:: nextElement => nextElement0D
END TYPE meshVol0D END TYPE meshCell0D
CONTAINS CONTAINS
!NODE FUNCTIONS !NODE FUNCTIONS
@ -61,18 +64,20 @@ MODULE moduleMesh0D
!VOLUME FUNCTIONS !VOLUME FUNCTIONS
!Inits dummy 0D volume !Inits dummy 0D volume
SUBROUTINE initVol0D(self, n, p, nodes) SUBROUTINE initCell0D(self, n, p, nodes)
USE moduleRefParam USE moduleRefParam
USE moduleSpecies USE moduleSpecies
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol0D), INTENT(out):: self CLASS(meshCell0D), INTENT(out):: self
INTEGER, INTENT(in):: n INTEGER, INTENT(in):: n
INTEGER, INTENT(in):: p(:) INTEGER, INTENT(in):: p(:)
TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:)
self%n = n self%n = n
self%nNodes = SIZE(p)
self%n1 => nodes(p(1))%obj self%n1 => nodes(p(1))%obj
self%volume = 1.D0 self%volume = 1.D0
self%n1%v = 1.D0 self%n1%v = 1.D0
@ -82,15 +87,13 @@ MODULE moduleMesh0D
ALLOCATE(self%listPart_in(1:nSpecies)) ALLOCATE(self%listPart_in(1:nSpecies))
ALLOCATE(self%totalWeight(1:nSpecies)) ALLOCATE(self%totalWeight(1:nSpecies))
END SUBROUTINE initVol0D END SUBROUTINE initCell0D
PURE FUNCTION getNodes0D(self) RESULT(n) PURE FUNCTION getNodes0D(self) RESULT(n)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol0D), INTENT(in):: self CLASS(meshCell0D), INTENT(in):: self
INTEGER, ALLOCATABLE:: n(:) INTEGER:: n(1:self%nNodes)
ALLOCATE(n(1:1))
n = self%n1%n n = self%n1%n
@ -99,50 +102,65 @@ MODULE moduleMesh0D
FUNCTION randPos0D(self) RESULT(r) FUNCTION randPos0D(self) RESULT(r)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol0D), INTENT(in):: self CLASS(meshCell0D), INTENT(in):: self
REAL(8):: r(1:3) REAL(8):: r(1:3)
r = 0.D0 r = 0.D0
END FUNCTION randPos0D END FUNCTION randPos0D
PURE SUBROUTINE fPsi0D(xi, fPsi) PURE FUNCTION fPsi0D(self, Xi) RESULT(fPsi)
REAL(8), INTENT(in):: xi(1:3) IMPLICIT NONE
REAL(8), INTENT(out):: fPsi(:)
CLASS(meshCell0D), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3)
REAL(8):: fPsi(1:self%nNodes)
fPsi = 1.D0 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 IMPLICIT NONE
CLASS(meshVol0D), INTENT(in):: self CLASS(meshCell0D), INTENT(in):: self
REAL(8), INTENT(in):: xi(1:3) REAL(8), INTENT(in):: Xi(1:3)
REAL(8):: EF(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 IMPLICIT NONE
CLASS(meshVol0D), INTENT(in):: self CLASS(meshCell0D), INTENT(in):: self
REAL(8), INTENT(in):: xi(1:3) REAL(8), INTENT(in):: Xi(1:3)
REAL(8):: MF(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) PURE FUNCTION elemK0D(self) RESULT(localK)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol0D), INTENT(in):: self CLASS(meshCell0D), INTENT(in):: self
REAL(8), ALLOCATABLE:: localK(:,:) REAL(8):: localK(1:self%nNodes,1:self%nNodes)
ALLOCATE(localK(1:1, 1:1))
localK = 0.D0 localK = 0.D0
END FUNCTION elemK0D END FUNCTION elemK0D
@ -150,19 +168,48 @@ MODULE moduleMesh0D
PURE FUNCTION elemF0D(self, source) RESULT(localF) PURE FUNCTION elemF0D(self, source) RESULT(localF)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol0D), INTENT(in):: self CLASS(meshCell0D), INTENT(in):: self
REAL(8), INTENT(in):: source(1:) REAL(8), INTENT(in):: source(1:self%nNodes)
REAL(8), ALLOCATABLE:: localF(:) REAL(8):: localF(1:self%nNodes)
ALLOCATE(localF(1:1))
localF = 0.D0 localF = 0.D0
END FUNCTION elemF0D 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) PURE FUNCTION phy2log0D(self,r) RESULT(xN)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol0D), INTENT(in):: self CLASS(meshCell0D), INTENT(in):: self
REAL(8), INTENT(in):: r(1:3) REAL(8), INTENT(in):: r(1:3)
REAL(8):: xN(1:3) REAL(8):: xN(1:3)
@ -170,21 +217,21 @@ MODULE moduleMesh0D
END FUNCTION phy2log0D END FUNCTION phy2log0D
PURE FUNCTION inside0D(xi) RESULT(ins) PURE FUNCTION inside0D(Xi) RESULT(ins)
IMPLICIT NONE IMPLICIT NONE
REAL(8), INTENT(in):: xi(1:3) REAL(8), INTENT(in):: Xi(1:3)
LOGICAL:: ins LOGICAL:: ins
ins = .TRUE. ins = .TRUE.
END FUNCTION inside0D END FUNCTION inside0D
SUBROUTINE nextElement0D(self, xi, nextElement) SUBROUTINE nextElement0D(self, Xi, nextElement)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol0D), INTENT(in):: self CLASS(meshCell0D), INTENT(in):: self
REAL(8), INTENT(in):: xi(1:3) REAL(8), INTENT(in):: Xi(1:3)
CLASS(meshElement), POINTER, INTENT(out):: nextElement CLASS(meshElement), POINTER, INTENT(out):: nextElement
nextElement => NULL() nextElement => NULL()

View file

@ -32,33 +32,26 @@ MODULE moduleMesh1DCart
END TYPE meshEdge1DCart END TYPE meshEdge1DCart
TYPE, PUBLIC, ABSTRACT, EXTENDS(meshVol):: meshVol1DCart TYPE, PUBLIC, ABSTRACT, EXTENDS(meshCell):: meshCell1DCart
CONTAINS CONTAINS
PROCEDURE, PASS:: detJac => detJ1DCart PROCEDURE, PASS:: detJac => detJ1DCart
PROCEDURE, PASS:: invJac => invJ1DCart PROCEDURE, PASS:: invJac => invJ1DCart
PROCEDURE(dPsi_interface), DEFERRED, NOPASS:: dPsi
PROCEDURE(partialDer_interface), DEFERRED, PASS:: partialDer PROCEDURE(partialDer_interface), DEFERRED, PASS:: partialDer
END TYPE meshVol1DCart END TYPE meshCell1DCart
ABSTRACT INTERFACE 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) PURE SUBROUTINE partialDer_interface(self, dPsi, dx)
IMPORT meshVol1DCart IMPORT meshCell1DCart
CLASS(meshVol1DCart), INTENT(in):: self CLASS(meshCell1DCart), INTENT(in):: self
REAL(8), INTENT(in):: dPsi(1:,1:) REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes)
REAL(8), INTENT(out), DIMENSION(1):: dx REAL(8), INTENT(out), DIMENSION(1):: dx
END SUBROUTINE partialDer_interface END SUBROUTINE partialDer_interface
END INTERFACE END INTERFACE
TYPE, PUBLIC, EXTENDS(meshVol1DCart):: meshVol1DCartSegm TYPE, PUBLIC, EXTENDS(meshCell1DCart):: meshCell1DCartSegm
!Element coordinates !Element coordinates
REAL(8):: x(1:2) REAL(8):: x(1:2)
!Connectivity to nodes !Connectivity to nodes
@ -67,22 +60,22 @@ MODULE moduleMesh1DCart
CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL() CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL()
REAL(8):: arNodes(1:2) REAL(8):: arNodes(1:2)
CONTAINS CONTAINS
PROCEDURE, PASS:: init => initVol1DCartSegm PROCEDURE, PASS:: init => initCell1DCartSegm
PROCEDURE, PASS:: randPos => randPos1DCartSeg PROCEDURE, PASS:: randPos => randPos1DCartSegm
PROCEDURE, PASS:: area => areaSegm PROCEDURE, PASS:: area => areaSegm
PROCEDURE, NOPASS:: fPsi => fPsiSegm PROCEDURE, PASS:: fPsi => fPsiSegm
PROCEDURE, NOPASS:: dPsi => dPsiSegm PROCEDURE, PASS:: dPsi => dPsiSegm
PROCEDURE, PASS:: partialDer => partialDerSegm PROCEDURE, PASS:: partialDer => partialDerSegm
PROCEDURE, PASS:: elemK => elemKSegm PROCEDURE, PASS:: elemK => elemKSegm
PROCEDURE, PASS:: elemF => elemFSegm PROCEDURE, PASS:: elemF => elemFSegm
PROCEDURE, PASS:: gatherElectricField => gatherEFSegm
PROCEDURE, PASS:: gatherMagneticField => gatherMFSegm
PROCEDURE, NOPASS:: inside => insideSegm PROCEDURE, NOPASS:: inside => insideSegm
PROCEDURE, PASS:: gatherEF => gatherEFSegm
PROCEDURE, PASS:: gatherMF => gatherMFSegm
PROCEDURE, PASS:: getNodes => getNodesSegm PROCEDURE, PASS:: getNodes => getNodesSegm
PROCEDURE, PASS:: phy2log => phy2logSegm PROCEDURE, PASS:: phy2log => phy2logSegm
PROCEDURE, PASS:: nextElement => nextElementSegm PROCEDURE, PASS:: nextElement => nextElementSegm
END TYPE meshVol1DCartSegm END TYPE meshCell1DCartSegm
CONTAINS CONTAINS
!NODE FUNCTIONS !NODE FUNCTIONS
@ -193,17 +186,18 @@ MODULE moduleMesh1DCart
!VOLUME FUNCTIONS !VOLUME FUNCTIONS
!SEGMENT FUNCTIONS !SEGMENT FUNCTIONS
!Init segment element !Init segment element
SUBROUTINE initVol1DCartSegm(self, n, p, nodes) SUBROUTINE initCell1DCartSegm(self, n, p, nodes)
USE moduleRefParam USE moduleRefParam
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DCartSegm), INTENT(out):: self CLASS(meshCell1DCartSegm), INTENT(out):: self
INTEGER, INTENT(in):: n INTEGER, INTENT(in):: n
INTEGER, INTENT(in):: p(:) INTEGER, INTENT(in):: p(:)
TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:)
REAL(8), DIMENSION(1:3):: r1, r2 REAL(8), DIMENSION(1:3):: r1, r2
self%n = n self%n = n
self%nNodes = SIZE(p)
self%n1 => nodes(p(1))%obj self%n1 => nodes(p(1))%obj
self%n2 => nodes(p(2))%obj self%n2 => nodes(p(2))%obj
!Get element coordinates !Get element coordinates
@ -221,14 +215,14 @@ MODULE moduleMesh1DCart
ALLOCATE(self%listPart_in(1:nSpecies)) ALLOCATE(self%listPart_in(1:nSpecies))
ALLOCATE(self%totalWeight(1:nSpecies)) ALLOCATE(self%totalWeight(1:nSpecies))
END SUBROUTINE initVol1DCartSegm END SUBROUTINE initCell1DCartSegm
!Calculates a random position in 1D volume !Calculates a random position in 1D volume
FUNCTION randPos1DCartSeg(self) RESULT(r) FUNCTION randPos1DCartSegm(self) RESULT(r)
USE moduleRandom USE moduleRandom
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DCartSegm), INTENT(in):: self CLASS(meshCell1DCartSegm), INTENT(in):: self
REAL(8):: r(1:3) REAL(8):: r(1:3)
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
REAL(8), ALLOCATABLE:: fPsi(:) REAL(8), ALLOCATABLE:: fPsi(:)
@ -236,16 +230,16 @@ MODULE moduleMesh1DCart
Xi(1) = random(-1.D0, 1.D0) Xi(1) = random(-1.D0, 1.D0)
Xi(2:3) = 0.D0 Xi(2:3) = 0.D0
CALL self%fPsi(Xi, fPsi) fPsi = self%fPsi(Xi)
r(1) = DOT_PRODUCT(fPsi, self%x) r(1) = DOT_PRODUCT(fPsi, self%x)
END FUNCTION randPos1DCartSeg END FUNCTION randPos1DCartSegm
!Computes element area !Computes element area
PURE SUBROUTINE areaSegm(self) PURE SUBROUTINE areaSegm(self)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DCartSegm), INTENT(inout):: self CLASS(meshCell1DCartSegm), INTENT(inout):: self
REAL(8):: l !element length REAL(8):: l !element length
REAL(8):: fPsi(1:2) REAL(8):: fPsi(1:2)
REAL(8):: detJ REAL(8):: detJ
@ -255,7 +249,7 @@ MODULE moduleMesh1DCart
self%arNodes = 0.D0 self%arNodes = 0.D0
!1 point Gauss integral !1 point Gauss integral
Xi = 0.D0 Xi = 0.D0
CALL self%fPsi(Xi, fPsi) fPsi = self%fPsi(Xi)
detJ = self%detJac(Xi) detJ = self%detJac(Xi)
l = 2.D0*detJ l = 2.D0*detJ
self%volume = l self%volume = l
@ -264,26 +258,29 @@ MODULE moduleMesh1DCart
END SUBROUTINE areaSegm END SUBROUTINE areaSegm
!Computes element functions at point Xi !Computes element functions at point Xi
PURE SUBROUTINE fPsiSegm(xi, fPsi) PURE FUNCTION fPsiSegm(self, xi) RESULT(fPsi)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshCell1DCartSegm), INTENT(in):: self
REAL(8), INTENT(in):: xi(1:3) 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(1) = 1.D0 - xi(1)
fPsi(2) = 1.D0 + xi(1) fPsi(2) = 1.D0 + xi(1)
fPsi = fPsi * 5.D-1 fPsi = fPsi * 5.D-1
END SUBROUTINE fPsiSegm END FUNCTION fPsiSegm
!Computes element derivative shape function at Xi !Computes element derivative shape function at Xi
PURE FUNCTION dPsiSegm(xi) RESULT(dPsi) PURE FUNCTION dPsiSegm(self, xi) RESULT(dPsi)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshCell1DCartSegm), INTENT(in):: self
REAL(8), INTENT(in):: xi(1:3) 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, 1) = -5.D-1
dPsi(1, 2) = 5.D-1 dPsi(1, 2) = 5.D-1
@ -294,8 +291,8 @@ MODULE moduleMesh1DCart
PURE SUBROUTINE partialDerSegm(self, dPsi, dx) PURE SUBROUTINE partialDerSegm(self, dPsi, dx)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DCartSegm), INTENT(in):: self CLASS(meshCell1DCartSegm), INTENT(in):: self
REAL(8), INTENT(in):: dPsi(1:,1:) REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes)
REAL(8), INTENT(out), DIMENSION(1):: dx REAL(8), INTENT(out), DIMENSION(1):: dx
dx(1) = DOT_PRODUCT(dPsi(1,:), self%x) dx(1) = DOT_PRODUCT(dPsi(1,:), self%x)
@ -306,14 +303,13 @@ MODULE moduleMesh1DCart
PURE FUNCTION elemKSegm(self) RESULT(localK) PURE FUNCTION elemKSegm(self) RESULT(localK)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DCartSegm), INTENT(in):: self CLASS(meshCell1DCartSegm), INTENT(in):: self
REAL(8), ALLOCATABLE:: localK(:,:) REAL(8):: localK(1:self%nNodes,1:self%nNodes)
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
REAL(8):: dPsi(1:1, 1:2) REAL(8):: dPsi(1:3, 1:2)
REAL(8):: invJ(1), detJ REAL(8):: invJ(1:3,1:3), detJ
INTEGER:: l INTEGER:: l
ALLOCATE(localK(1:2,1:2))
localK = 0.D0 localK = 0.D0
Xi = 0.D0 Xi = 0.D0
DO l = 1, 3 DO l = 1, 3
@ -332,22 +328,21 @@ MODULE moduleMesh1DCart
PURE FUNCTION elemFSegm(self, source) RESULT(localF) PURE FUNCTION elemFSegm(self, source) RESULT(localF)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DCartSegm), INTENT(in):: self CLASS(meshCell1DCartSegm), INTENT(in):: self
REAL(8), INTENT(in):: source(1:) REAL(8), INTENT(in):: source(1:self%nNodes)
REAL(8), ALLOCATABLE:: localF(:) REAL(8):: localF(1:self%nNodes)
REAL(8):: fPsi(1:2) REAL(8):: fPsi(1:2)
REAL(8):: detJ, f REAL(8):: detJ, f
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
INTEGER:: l INTEGER:: l
ALLOCATE(localF(1:2))
localF = 0.D0 localF = 0.D0
Xi = 0.D0 Xi = 0.D0
DO l = 1, 3 DO l = 1, 3
Xi(1) = corSeg(l) Xi(1) = corSeg(l)
detJ = self%detJac(Xi) detJ = self%detJac(Xi)
CALL self%fPsi(Xi, fPsi) fPsi = self%fPsi(Xi)
f = DOT_PRODUCT(fPsi, source) f = DOT_PRODUCT(fPsi, source)
localF = localF + f*fPsi*wSeg(l)*detJ localF = localF + f*fPsi*wSeg(l)*detJ
@ -355,6 +350,40 @@ MODULE moduleMesh1DCart
END FUNCTION elemFSegm 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) PURE FUNCTION insideSegm(xi) RESULT(ins)
IMPLICIT NONE IMPLICIT NONE
@ -366,58 +395,13 @@ MODULE moduleMesh1DCart
END FUNCTION insideSegm 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 !Get nodes from 1D volume
PURE FUNCTION getNodesSegm(self) RESULT(n) PURE FUNCTION getNodesSegm(self) RESULT(n)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DCartSegm), INTENT(in):: self CLASS(meshCell1DCartSegm), INTENT(in):: self
INTEGER, ALLOCATABLE:: n(:) INTEGER:: n(1:self%nNodes)
ALLOCATE(n(1:2))
n = (/ self%n1%n, self%n2%n /) n = (/ self%n1%n, self%n2%n /)
END FUNCTION getNodesSegm END FUNCTION getNodesSegm
@ -425,7 +409,7 @@ MODULE moduleMesh1DCart
PURE FUNCTION phy2logSegm(self, r) RESULT(xN) PURE FUNCTION phy2logSegm(self, r) RESULT(xN)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DCartSegm), INTENT(in):: self CLASS(meshCell1DCartSegm), INTENT(in):: self
REAL(8), INTENT(in):: r(1:3) REAL(8), INTENT(in):: r(1:3)
REAL(8):: xN(1:3) REAL(8):: xN(1:3)
@ -438,7 +422,7 @@ MODULE moduleMesh1DCart
SUBROUTINE nextElementSegm(self, xi, nextElement) SUBROUTINE nextElementSegm(self, xi, nextElement)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DCartSegm), INTENT(in):: self 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 CLASS(meshElement), POINTER, INTENT(out):: nextElement
@ -459,10 +443,10 @@ MODULE moduleMesh1DCart
PURE FUNCTION detJ1DCart(self, xi, dPsi_in) RESULT(dJ) PURE FUNCTION detJ1DCart(self, xi, dPsi_in) RESULT(dJ)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DCart), INTENT(in):: self 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:,1:) REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes)
REAL(8), ALLOCATABLE:: dPsi(:,:) REAL(8):: dPsi(1:3,1:self%nNodes)
REAL(8):: dJ REAL(8):: dJ
REAL(8):: dx(1) REAL(8):: dx(1)
@ -483,12 +467,12 @@ MODULE moduleMesh1DCart
PURE FUNCTION invJ1DCart(self, xi, dPsi_in) RESULT(invJ) PURE FUNCTION invJ1DCart(self, xi, dPsi_in) RESULT(invJ)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DCart), INTENT(in):: self 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:,1:) REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes)
REAL(8), ALLOCATABLE:: dPsi(:,:) REAL(8):: invJ(1:3,1:3)
REAL(8):: dPsi(1:3,1:self%nNodes)
REAL(8):: dx(1) REAL(8):: dx(1)
REAL(8):: invJ
IF (PRESENT(dPsi_in)) THEN IF (PRESENT(dPsi_in)) THEN
dPsi = dPsi_in dPsi = dPsi_in
@ -498,8 +482,11 @@ MODULE moduleMesh1DCart
END IF END IF
invJ = 0.D0
CALL self%partialDer(dPsi, dx) CALL self%partialDer(dPsi, dx)
invJ = 1.D0/dx(1)
invJ(1,1) = 1.D0/dx(1)
END FUNCTION invJ1DCart END FUNCTION invJ1DCart
@ -509,11 +496,11 @@ MODULE moduleMesh1DCart
CLASS(meshGeneric), INTENT(inout):: self CLASS(meshGeneric), INTENT(inout):: self
INTEGER:: e, et INTEGER:: e, et
DO e = 1, self%numVols DO e = 1, self%numCells
!Connect Vol-Vol !Connect Vol-Vol
DO et = 1, self%numVols DO et = 1, self%numCells
IF (e /= et) THEN 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 END IF
@ -523,7 +510,7 @@ MODULE moduleMesh1DCart
TYPE IS(meshParticles) TYPE IS(meshParticles)
!Connect Vol-Edge !Connect Vol-Edge
DO et = 1, self%numEdges 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 END DO
@ -536,13 +523,13 @@ MODULE moduleMesh1DCart
SUBROUTINE connectVolVol(elemA, elemB) SUBROUTINE connectVolVol(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol), INTENT(inout):: elemA CLASS(meshCell), INTENT(inout):: elemA
CLASS(meshVol), INTENT(inout):: elemB CLASS(meshCell), INTENT(inout):: elemB
SELECT TYPE(elemA) SELECT TYPE(elemA)
TYPE IS(meshVol1DCartSegm) TYPE IS(meshCell1DCartSegm)
SELECT TYPE(elemB) SELECT TYPE(elemB)
TYPE IS(meshVol1DCartSegm) TYPE IS(meshCell1DCartSegm)
CALL connectSegmSegm(elemA, elemB) CALL connectSegmSegm(elemA, elemB)
END SELECT END SELECT
@ -554,8 +541,8 @@ MODULE moduleMesh1DCart
SUBROUTINE connectSegmSegm(elemA, elemB) SUBROUTINE connectSegmSegm(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DCartSegm), INTENT(inout), TARGET:: elemA CLASS(meshCell1DCartSegm), INTENT(inout), TARGET:: elemA
CLASS(meshVol1DCartSegm), INTENT(inout), TARGET:: elemB CLASS(meshCell1DCartSegm), INTENT(inout), TARGET:: elemB
IF (.NOT. ASSOCIATED(elemA%e1) .AND. & IF (.NOT. ASSOCIATED(elemA%e1) .AND. &
elemA%n2%n == elemB%n1%n) THEN elemA%n2%n == elemB%n1%n) THEN
@ -577,11 +564,11 @@ MODULE moduleMesh1DCart
SUBROUTINE connectVolEdge(elemA, elemB) SUBROUTINE connectVolEdge(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol), INTENT(inout):: elemA CLASS(meshCell), INTENT(inout):: elemA
CLASS(meshEdge), INTENT(inout):: elemB CLASS(meshEdge), INTENT(inout):: elemB
SELECT TYPE(elemA) SELECT TYPE(elemA)
TYPE IS (meshVol1DCartSegm) TYPE IS (meshCell1DCartSegm)
SELECT TYPE(elemB) SELECT TYPE(elemB)
CLASS IS(meshEdge1DCart) CLASS IS(meshEdge1DCart)
CALL connectSegmEdge(elemA, elemB) CALL connectSegmEdge(elemA, elemB)
@ -595,7 +582,7 @@ MODULE moduleMesh1DCart
SUBROUTINE connectSegmEdge(elemA, elemB) SUBROUTINE connectSegmEdge(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DCartSegm), INTENT(inout), TARGET:: elemA CLASS(meshCell1DCartSegm), INTENT(inout), TARGET:: elemA
CLASS(meshEdge1DCart), INTENT(inout), TARGET:: elemB CLASS(meshEdge1DCart), INTENT(inout), TARGET:: elemB
IF (.NOT. ASSOCIATED(elemA%e1) .AND. & IF (.NOT. ASSOCIATED(elemA%e1) .AND. &

View file

@ -32,34 +32,27 @@ MODULE moduleMesh1DRad
END TYPE meshEdge1DRad END TYPE meshEdge1DRad
TYPE, PUBLIC, ABSTRACT, EXTENDS(meshVol):: meshVol1DRad TYPE, PUBLIC, ABSTRACT, EXTENDS(meshCell):: meshCell1DRad
CONTAINS CONTAINS
PROCEDURE, PASS:: detJac => detJ1DRad PROCEDURE, PASS:: detJac => detJ1DRad
PROCEDURE, PASS:: invJac => invJ1DRad PROCEDURE, PASS:: invJac => invJ1DRad
PROCEDURE(dPsi_interface), DEFERRED, NOPASS:: dPsi
PROCEDURE(partialDer_interface), DEFERRED, PASS:: partialDer PROCEDURE(partialDer_interface), DEFERRED, PASS:: partialDer
END TYPE meshVol1DRad END TYPE meshCell1DRad
ABSTRACT INTERFACE 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) PURE SUBROUTINE partialDer_interface(self, dPsi, dx)
IMPORT meshVol1DRad IMPORT meshCell1DRad
CLASS(meshVol1DRad), INTENT(in):: self CLASS(meshCell1DRad), INTENT(in):: self
REAL(8), INTENT(in):: dPsi(1:,1:) REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes)
REAL(8), INTENT(out), DIMENSION(1):: dx REAL(8), INTENT(out), DIMENSION(1):: dx
END SUBROUTINE partialDer_interface END SUBROUTINE partialDer_interface
END INTERFACE END INTERFACE
TYPE, PUBLIC, EXTENDS(meshVol1DRad):: meshVol1DRadSegm TYPE, PUBLIC, EXTENDS(meshCell1DRad):: meshCell1DRadSegm
!Element coordinates !Element coordinates
REAL(8):: r(1:2) REAL(8):: r(1:2)
!Connectivity to nodes !Connectivity to nodes
@ -68,22 +61,22 @@ MODULE moduleMesh1DRad
CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL() CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL()
REAL(8):: arNodes(1:2) REAL(8):: arNodes(1:2)
CONTAINS CONTAINS
PROCEDURE, PASS:: init => initVol1DRadSegm PROCEDURE, PASS:: init => initCell1DRadSegm
PROCEDURE, PASS:: randPos => randPos1DRadSeg PROCEDURE, PASS:: randPos => randPos1DRadSeg
PROCEDURE, PASS:: area => areaRad PROCEDURE, PASS:: area => areaRad
PROCEDURE, NOPASS:: fPsi => fPsiRad PROCEDURE, PASS:: fPsi => fPsiRad
PROCEDURE, NOPASS:: dPsi => dPsiRad PROCEDURE, PASS:: dPsi => dPsiRad
PROCEDURE, PASS:: partialDer => partialDerRad PROCEDURE, PASS:: partialDer => partialDerRad
PROCEDURE, PASS:: elemK => elemKRad PROCEDURE, PASS:: elemK => elemKRad
PROCEDURE, PASS:: elemF => elemFRad PROCEDURE, PASS:: elemF => elemFRad
PROCEDURE, PASS:: gatherElectricField => gatherEFRad
PROCEDURE, PASS:: gatherMagneticField => gatherMFRad
PROCEDURE, NOPASS:: inside => insideRad PROCEDURE, NOPASS:: inside => insideRad
PROCEDURE, PASS:: gatherEF => gatherEFRad
PROCEDURE, PASS:: gatherMF => gatherMFRad
PROCEDURE, PASS:: getNodes => getNodesRad PROCEDURE, PASS:: getNodes => getNodesRad
PROCEDURE, PASS:: phy2log => phy2logRad PROCEDURE, PASS:: phy2log => phy2logRad
PROCEDURE, PASS:: nextElement => nextElementRad PROCEDURE, PASS:: nextElement => nextElementRad
END TYPE meshVol1DRadSegm END TYPE meshCell1DRadSegm
CONTAINS CONTAINS
!NODE FUNCTIONS !NODE FUNCTIONS
@ -195,17 +188,18 @@ MODULE moduleMesh1DRad
!VOLUME FUNCTIONS !VOLUME FUNCTIONS
!SEGMENT FUNCTIONS !SEGMENT FUNCTIONS
!Init segment element !Init segment element
SUBROUTINE initVol1DRadSegm(self, n, p, nodes) SUBROUTINE initCell1DRadSegm(self, n, p, nodes)
USE moduleRefParam USE moduleRefParam
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DRadSegm), INTENT(out):: self CLASS(meshCell1DRadSegm), INTENT(out):: self
INTEGER, INTENT(in):: n INTEGER, INTENT(in):: n
INTEGER, INTENT(in):: p(:) INTEGER, INTENT(in):: p(:)
TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:)
REAL(8), DIMENSION(1:3):: r1, r2 REAL(8), DIMENSION(1:3):: r1, r2
self%n = n self%n = n
self%nNodes = SIZE(p)
self%n1 => nodes(p(1))%obj self%n1 => nodes(p(1))%obj
self%n2 => nodes(p(2))%obj self%n2 => nodes(p(2))%obj
!Get element coordinates !Get element coordinates
@ -223,22 +217,22 @@ MODULE moduleMesh1DRad
ALLOCATE(self%listPart_in(1:nSpecies)) ALLOCATE(self%listPart_in(1:nSpecies))
ALLOCATE(self%totalWeight(1:nSpecies)) ALLOCATE(self%totalWeight(1:nSpecies))
END SUBROUTINE initVol1DRadSegm END SUBROUTINE initCell1DRadSegm
!Calculates a random position in 1D volume !Calculates a random position in 1D volume
FUNCTION randPos1DRadSeg(self) RESULT(r) FUNCTION randPos1DRadSeg(self) RESULT(r)
USE moduleRandom USE moduleRandom
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DRadSegm), INTENT(in):: self CLASS(meshCell1DRadSegm), INTENT(in):: self
REAL(8):: r(1:3) REAL(8):: r(1:3)
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
REAL(8), ALLOCATABLE:: fPsi(:) REAL(8):: fPsi(1:2)
Xi(1) = random(-1.D0, 1.D0) Xi(1) = random(-1.D0, 1.D0)
Xi(2:3) = 0.D0 Xi(2:3) = 0.D0
CALL self%fPsi(Xi, fPsi) fPsi = self%fPsi(Xi)
r(1) = DOT_PRODUCT(fPsi, self%r) r(1) = DOT_PRODUCT(fPsi, self%r)
END FUNCTION randPos1DRadSeg END FUNCTION randPos1DRadSeg
@ -247,7 +241,7 @@ MODULE moduleMesh1DRad
PURE SUBROUTINE areaRad(self) PURE SUBROUTINE areaRad(self)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DRadSegm), INTENT(inout):: self CLASS(meshCell1DRadSegm), INTENT(inout):: self
REAL(8):: l !element length REAL(8):: l !element length
REAL(8):: fPsi(1:2), fPsi_node(1:2) REAL(8):: fPsi(1:2), fPsi_node(1:2)
REAL(8):: r REAL(8):: r
@ -258,7 +252,7 @@ MODULE moduleMesh1DRad
self%arNodes = 0.D0 self%arNodes = 0.D0
!1 point Gauss integral !1 point Gauss integral
Xi = 0.D0 Xi = 0.D0
CALL self%fPsi(Xi, fPsi) fPsi = self%fPsi(Xi)
detJ = self%detJac(Xi) detJ = self%detJac(Xi)
!Computes total volume of the cell !Computes total volume of the cell
r = DOT_PRODUCT(fPsi, self%r) r = DOT_PRODUCT(fPsi, self%r)
@ -266,37 +260,40 @@ MODULE moduleMesh1DRad
self%volume = r*l self%volume = r*l
!Computes volume per node !Computes volume per node
Xi = (/-5.D-1, 0.D0, 0.D0/) 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) r = DOT_PRODUCT(fPsi_node,self%r)
self%arNodes(1) = fPsi(1)*r*l self%arNodes(1) = fPsi(1)*r*l
Xi = (/ 5.D-1, 0.D0, 0.D0/) 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) r = DOT_PRODUCT(fPsi_node,self%r)
self%arNodes(2) = fPsi(2)*r*l self%arNodes(2) = fPsi(2)*r*l
END SUBROUTINE areaRad END SUBROUTINE areaRad
!Computes element functions at point Xi !Computes element functions at point Xi
PURE SUBROUTINE fPsiRad(xi, fPsi) PURE FUNCTION fPsiRad(self, xi) RESULT(fPsi)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshCell1DRadSegm), INTENT(in):: self
REAL(8), INTENT(in):: xi(1:3) 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(1) = 1.D0 - xi(1)
fPsi(2) = 1.D0 + xi(1) fPsi(2) = 1.D0 + xi(1)
fPsi = fPsi * 5.D-1 fPsi = fPsi * 5.D-1
END SUBROUTINE fPsiRad END FUNCTION fPsiRad
!Computes element derivative shape function at Xi !Computes element derivative shape function at Xi
PURE FUNCTION dPsiRad(xi) RESULT(dPsi) PURE FUNCTION dPsiRad(self, xi) RESULT(dPsi)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshCell1DRadSegm), INTENT(in):: self
REAL(8), INTENT(in):: xi(1:3) 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, 1) = -5.D-1
dPsi(1, 2) = 5.D-1 dPsi(1, 2) = 5.D-1
@ -307,8 +304,8 @@ MODULE moduleMesh1DRad
PURE SUBROUTINE partialDerRad(self, dPsi, dx) PURE SUBROUTINE partialDerRad(self, dPsi, dx)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DRadSegm), INTENT(in):: self CLASS(meshCell1DRadSegm), INTENT(in):: self
REAL(8), INTENT(in):: dPsi(1:,1:) REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes)
REAL(8), INTENT(out), DIMENSION(1):: dx REAL(8), INTENT(out), DIMENSION(1):: dx
dx(1) = DOT_PRODUCT(dPsi(1,:), self%r) dx(1) = DOT_PRODUCT(dPsi(1,:), self%r)
@ -320,15 +317,14 @@ MODULE moduleMesh1DRad
USE moduleConstParam, ONLY: PI2 USE moduleConstParam, ONLY: PI2
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DRadSegm), INTENT(in):: self CLASS(meshCell1DRadSegm), INTENT(in):: self
REAL(8), ALLOCATABLE:: localK(:,:) REAL(8):: localK(1:self%nNodes,1:self%nNodes)
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
REAL(8):: dPsi(1:1, 1:2) REAL(8):: dPsi(1:3, 1:2)
REAL(8):: invJ(1), detJ REAL(8):: invJ(1:3,1:3), detJ
REAL(8):: r, fPsi(1:2) REAL(8):: r, fPsi(1:2)
INTEGER:: l INTEGER:: l
ALLOCATE(localK(1:2, 1:2))
localK = 0.D0 localK = 0.D0
Xi = 0.D0 Xi = 0.D0
DO l = 1, 3 DO l = 1, 3
@ -336,7 +332,7 @@ MODULE moduleMesh1DRad
dPsi = self%dPsi(Xi) dPsi = self%dPsi(Xi)
detJ = self%detJac(Xi, dPsi) detJ = self%detJac(Xi, dPsi)
invJ = self%invJac(Xi, dPsi) invJ = self%invJac(Xi, dPsi)
CALL self%fPsi(Xi, fPsi) fPsi = self%fPsi(Xi)
r = DOT_PRODUCT(fPsi, self%r) r = DOT_PRODUCT(fPsi, self%r)
localK = localK + MATMUL(RESHAPE(MATMUL(invJ,dPsi), (/ 2, 1/)), & localK = localK + MATMUL(RESHAPE(MATMUL(invJ,dPsi), (/ 2, 1/)), &
RESHAPE(MATMUL(invJ,dPsi), (/ 1, 2/)))* & RESHAPE(MATMUL(invJ,dPsi), (/ 1, 2/)))* &
@ -352,22 +348,21 @@ MODULE moduleMesh1DRad
USE moduleConstParam, ONLY: PI2 USE moduleConstParam, ONLY: PI2
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DRadSegm), INTENT(in):: self CLASS(meshCell1DRadSegm), INTENT(in):: self
REAL(8), INTENT(in):: source(1:) REAL(8), INTENT(in):: source(1:self%nNodes)
REAL(8), ALLOCATABLE:: localF(:) REAL(8):: localF(1:self%nNodes)
REAL(8):: fPsi(1:2) REAL(8):: fPsi(1:2)
REAL(8):: detJ, f, r REAL(8):: detJ, f, r
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
INTEGER:: l INTEGER:: l
ALLOCATE(localF(1:2))
localF = 0.D0 localF = 0.D0
Xi = 0.D0 Xi = 0.D0
DO l = 1, 3 DO l = 1, 3
Xi(1) = corSeg(l) Xi(1) = corSeg(l)
detJ = self%detJac(Xi) detJ = self%detJac(Xi)
CALL self%fPsi(Xi, fPsi) fPsi = self%fPsi(Xi)
r = DOT_PRODUCT(fPsi, self%r) r = DOT_PRODUCT(fPsi, self%r)
f = DOT_PRODUCT(fPsi, source) f = DOT_PRODUCT(fPsi, source)
localF = localF + f*fPsi*r*wSeg(l)*detJ localF = localF + f*fPsi*r*wSeg(l)*detJ
@ -376,6 +371,40 @@ MODULE moduleMesh1DRad
END FUNCTION elemFRad 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) PURE FUNCTION insideRad(xi) RESULT(ins)
IMPLICIT NONE IMPLICIT NONE
@ -387,58 +416,13 @@ MODULE moduleMesh1DRad
END FUNCTION insideRad 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 !Get nodes from 1D volume
PURE FUNCTION getNodesRad(self) RESULT(n) PURE FUNCTION getNodesRad(self) RESULT(n)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DRadSegm), INTENT(in):: self CLASS(meshCell1DRadSegm), INTENT(in):: self
INTEGER, ALLOCATABLE:: n(:) INTEGER:: n(1:self%nNodes)
ALLOCATE(n(1:2))
n = (/ self%n1%n, self%n2%n /) n = (/ self%n1%n, self%n2%n /)
END FUNCTION getNodesRad END FUNCTION getNodesRad
@ -446,7 +430,7 @@ MODULE moduleMesh1DRad
PURE FUNCTION phy2logRad(self, r) RESULT(xN) PURE FUNCTION phy2logRad(self, r) RESULT(xN)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DRadSegm), INTENT(in):: self CLASS(meshCell1DRadSegm), INTENT(in):: self
REAL(8), INTENT(in):: r(1:3) REAL(8), INTENT(in):: r(1:3)
REAL(8):: xN(1:3) REAL(8):: xN(1:3)
@ -459,7 +443,7 @@ MODULE moduleMesh1DRad
SUBROUTINE nextElementRad(self, xi, nextElement) SUBROUTINE nextElementRad(self, xi, nextElement)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DRadSegm), INTENT(in):: self 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 CLASS(meshElement), POINTER, INTENT(out):: nextElement
@ -479,10 +463,10 @@ MODULE moduleMesh1DRad
PURE FUNCTION detJ1DRad(self, xi, dPsi_in) RESULT(dJ) PURE FUNCTION detJ1DRad(self, xi, dPsi_in) RESULT(dJ)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DRad), INTENT(in):: self 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:,1:) REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes)
REAL(8), ALLOCATABLE:: dPsi(:,:) REAL(8):: dPsi(1:3,1:self%nNodes)
REAL(8):: dJ REAL(8):: dJ
REAL(8):: dx(1) REAL(8):: dx(1)
@ -503,12 +487,12 @@ MODULE moduleMesh1DRad
PURE FUNCTION invJ1DRad(self, xi, dPsi_in) RESULT(invJ) PURE FUNCTION invJ1DRad(self, xi, dPsi_in) RESULT(invJ)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DRad), INTENT(in):: self 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:,1:) REAL(8), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes)
REAL(8), ALLOCATABLE:: dPsi(:,:) REAL(8):: dPsi(1:3,1:self%nNodes)
REAL(8):: dx(1) REAL(8):: dx(1)
REAL(8):: invJ REAL(8):: invJ(1:3,1:3)
IF (PRESENT(dPsi_in)) THEN IF (PRESENT(dPsi_in)) THEN
dPsi = dPsi_in dPsi = dPsi_in
@ -518,8 +502,11 @@ MODULE moduleMesh1DRad
END IF END IF
invJ = 0.D0
CALL self%partialDer(dPsi, dx) CALL self%partialDer(dPsi, dx)
invJ = 1.D0/dx(1)
invJ(1,1) = 1.D0/dx(1)
END FUNCTION invJ1DRad END FUNCTION invJ1DRad
@ -529,11 +516,11 @@ MODULE moduleMesh1DRad
CLASS(meshGeneric), INTENT(inout):: self CLASS(meshGeneric), INTENT(inout):: self
INTEGER:: e, et INTEGER:: e, et
DO e = 1, self%numVols DO e = 1, self%numCells
!Connect Vol-Vol !Connect Vol-Vol
DO et = 1, self%numVols DO et = 1, self%numCells
IF (e /= et) THEN 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 END IF
@ -543,7 +530,7 @@ MODULE moduleMesh1DRad
TYPE IS(meshParticles) TYPE IS(meshParticles)
!Connect Vol-Edge !Connect Vol-Edge
DO et = 1, self%numEdges 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 END DO
@ -556,13 +543,13 @@ MODULE moduleMesh1DRad
SUBROUTINE connectVolVol(elemA, elemB) SUBROUTINE connectVolVol(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol), INTENT(inout):: elemA CLASS(meshCell), INTENT(inout):: elemA
CLASS(meshVol), INTENT(inout):: elemB CLASS(meshCell), INTENT(inout):: elemB
SELECT TYPE(elemA) SELECT TYPE(elemA)
TYPE IS(meshVol1DRadSegm) TYPE IS(meshCell1DRadSegm)
SELECT TYPE(elemB) SELECT TYPE(elemB)
TYPE IS(meshVol1DRadSegm) TYPE IS(meshCell1DRadSegm)
CALL connectSegmSegm(elemA, elemB) CALL connectSegmSegm(elemA, elemB)
END SELECT END SELECT
@ -574,8 +561,8 @@ MODULE moduleMesh1DRad
SUBROUTINE connectSegmSegm(elemA, elemB) SUBROUTINE connectSegmSegm(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DRadSegm), INTENT(inout), TARGET:: elemA CLASS(meshCell1DRadSegm), INTENT(inout), TARGET:: elemA
CLASS(meshVol1DRadSegm), INTENT(inout), TARGET:: elemB CLASS(meshCell1DRadSegm), INTENT(inout), TARGET:: elemB
IF (.NOT. ASSOCIATED(elemA%e1) .AND. & IF (.NOT. ASSOCIATED(elemA%e1) .AND. &
elemA%n2%n == elemB%n1%n) THEN elemA%n2%n == elemB%n1%n) THEN
@ -597,11 +584,11 @@ MODULE moduleMesh1DRad
SUBROUTINE connectVolEdge(elemA, elemB) SUBROUTINE connectVolEdge(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol), INTENT(inout):: elemA CLASS(meshCell), INTENT(inout):: elemA
CLASS(meshEdge), INTENT(inout):: elemB CLASS(meshEdge), INTENT(inout):: elemB
SELECT TYPE(elemA) SELECT TYPE(elemA)
TYPE IS (meshVol1DRadSegm) TYPE IS (meshCell1DRadSegm)
SELECT TYPE(elemB) SELECT TYPE(elemB)
CLASS IS(meshEdge1DRad) CLASS IS(meshEdge1DRad)
CALL connectSegmEdge(elemA, elemB) CALL connectSegmEdge(elemA, elemB)
@ -615,7 +602,7 @@ MODULE moduleMesh1DRad
SUBROUTINE connectSegmEdge(elemA, elemB) SUBROUTINE connectSegmEdge(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol1DRadSegm), INTENT(inout), TARGET:: elemA CLASS(meshCell1DRadSegm), INTENT(inout), TARGET:: elemA
CLASS(meshEdge1DRad), INTENT(inout), TARGET:: elemB CLASS(meshEdge1DRad), INTENT(inout), TARGET:: elemB
IF (.NOT. ASSOCIATED(elemA%e1) .AND. & IF (.NOT. ASSOCIATED(elemA%e1) .AND. &

View file

@ -37,26 +37,19 @@ MODULE moduleMesh2DCart
END TYPE meshEdge2DCart END TYPE meshEdge2DCart
TYPE, PUBLIC, ABSTRACT, EXTENDS(meshVol):: meshVol2DCart TYPE, PUBLIC, ABSTRACT, EXTENDS(meshCell):: meshCell2DCart
CONTAINS CONTAINS
PROCEDURE, PASS:: detJac => detJ2DCart PROCEDURE, PASS:: detJac => detJ2DCart
PROCEDURE, PASS:: invJac => invJ2DCart PROCEDURE, PASS:: invJac => invJ2DCart
PROCEDURE(dPsi_interface), DEFERRED, NOPASS:: dPsi PROCEDURE(partialDer_interface), DEFERRED, PASS, PRIVATE:: partialDer
PROCEDURE(partialDer_interface), DEFERRED, PASS:: partialDer
END TYPE meshVol2DCart END TYPE meshCell2DCart
ABSTRACT INTERFACE 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) PURE SUBROUTINE partialDer_interface(self, dPsi, dx, dy)
IMPORT meshVol2DCart IMPORT meshCell2DCart
CLASS(meshVol2DCart), INTENT(in):: self CLASS(meshCell2DCart), INTENT(in):: self
REAL(8), INTENT(in):: dPsi(1:,1:) REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes)
REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy
END SUBROUTINE partialDer_interface END SUBROUTINE partialDer_interface
@ -64,7 +57,7 @@ MODULE moduleMesh2DCart
END INTERFACE END INTERFACE
!Quadrilateral volume element !Quadrilateral volume element
TYPE, PUBLIC, EXTENDS(meshVol2DCart):: meshVol2DCartQuad TYPE, PUBLIC, EXTENDS(meshCell2DCart):: meshCell2DCartQuad
!Element coordinates !Element coordinates
REAL(8):: x(1:4) = 0.D0, y(1:4) = 0.D0 REAL(8):: x(1:4) = 0.D0, y(1:4) = 0.D0
!Connectivity to nodes !Connectivity to nodes
@ -73,27 +66,27 @@ MODULE moduleMesh2DCart
CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL(), e3 => NULL(), e4 => NULL() CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL(), e3 => NULL(), e4 => NULL()
REAL(8):: arNodes(1:4) = 0.D0 REAL(8):: arNodes(1:4) = 0.D0
CONTAINS CONTAINS
PROCEDURE, PASS:: init => initVolQuad2DCart PROCEDURE, PASS:: init => initCellQuad2DCart
PROCEDURE, PASS:: randPos => randPosVolQuad PROCEDURE, PASS:: randPos => randPosCellQuad
PROCEDURE, PASS:: area => areaQuad PROCEDURE, PASS:: area => areaQuad
PROCEDURE, NOPASS:: fPsi => fPsiQuad PROCEDURE, PASS:: fPsi => fPsiQuad
PROCEDURE, NOPASS:: dPsi => dPsiQuad PROCEDURE, PASS:: dPsi => dPsiQuad
PROCEDURE, NOPASS:: dPsiXi1 => dPsiQuadXi1 PROCEDURE, NOPASS, PRIVATE:: dPsiXi1 => dPsiQuadXi1
PROCEDURE, NOPASS:: dPsiXi2 => dPsiQuadXi2 PROCEDURE, NOPASS, PRIVATE:: dPsiXi2 => dPsiQuadXi2
PROCEDURE, PASS:: partialDer => partialDerQuad PROCEDURE, PASS, PRIVATE:: partialDer => partialDerQuad
PROCEDURE, PASS:: elemK => elemKQuad PROCEDURE, PASS:: elemK => elemKQuad
PROCEDURE, PASS:: elemF => elemFQuad PROCEDURE, PASS:: elemF => elemFQuad
PROCEDURE, PASS:: gatherElectricField => gatherEFQuad
PROCEDURE, PASS:: gatherMagneticField => gatherMFQuad
PROCEDURE, NOPASS:: inside => insideQuad PROCEDURE, NOPASS:: inside => insideQuad
PROCEDURE, PASS:: gatherEF => gatherEFQuad
PROCEDURE, PASS:: gatherMF => gatherMFQuad
PROCEDURE, PASS:: getNodes => getNodesQuad PROCEDURE, PASS:: getNodes => getNodesQuad
PROCEDURE, PASS:: phy2log => phy2logQuad PROCEDURE, PASS:: phy2log => phy2logQuad
PROCEDURE, PASS:: nextElement => nextElementQuad PROCEDURE, PASS:: nextElement => nextElementQuad
END TYPE meshVol2DCartQuad END TYPE meshCell2DCartQuad
!Triangular volume element !Triangular volume element
TYPE, PUBLIC, EXTENDS(meshVol2DCart):: meshVol2DCartTria TYPE, PUBLIC, EXTENDS(meshCell2DCart):: meshCell2DCartTria
!Element coordinates !Element coordinates
REAL(8):: x(1:3) = 0.D0, y(1:3) = 0.D0 REAL(8):: x(1:3) = 0.D0, y(1:3) = 0.D0
!Connectivity to nodes !Connectivity to nodes
@ -103,24 +96,24 @@ MODULE moduleMesh2DCart
REAL(8):: arNodes(1:3) = 0.D0 REAL(8):: arNodes(1:3) = 0.D0
CONTAINS CONTAINS
PROCEDURE, PASS:: init => initVolTria2DCart PROCEDURE, PASS:: init => initCellTria2DCart
PROCEDURE, PASS:: randPos => randPosVolTria PROCEDURE, PASS:: randPos => randPosCellTria
PROCEDURE, PASS:: area => areaTria PROCEDURE, PASS:: area => areaTria
PROCEDURE, NOPASS:: fPsi => fPsiTria PROCEDURE, PASS:: fPsi => fPsiTria
PROCEDURE, NOPASS:: dPsi => dPsiTria PROCEDURE, PASS:: dPsi => dPsiTria
PROCEDURE, NOPASS:: dPsiXi1 => dPsiTriaXi1 PROCEDURE, NOPASS:: dPsiXi1 => dPsiTriaXi1
PROCEDURE, NOPASS:: dPsiXi2 => dPsiTriaXi2 PROCEDURE, NOPASS:: dPsiXi2 => dPsiTriaXi2
PROCEDURE, PASS:: partialDer => partialDerTria PROCEDURE, PASS:: partialDer => partialDerTria
PROCEDURE, PASS:: elemK => elemKTria PROCEDURE, PASS:: elemK => elemKTria
PROCEDURE, PASS:: elemF => elemFTria PROCEDURE, PASS:: elemF => elemFTria
PROCEDURE, PASS:: gatherElectricField => gatherEFTria
PROCEDURE, PASS:: gatherMagneticField => gatherMFTria
PROCEDURE, NOPASS:: inside => insideTria PROCEDURE, NOPASS:: inside => insideTria
PROCEDURE, PASS:: gatherEF => gatherEFTria
PROCEDURE, PASS:: gatherMF => gatherMFTria
PROCEDURE, PASS:: getNodes => getNodesTria PROCEDURE, PASS:: getNodes => getNodesTria
PROCEDURE, PASS:: phy2log => phy2logTria PROCEDURE, PASS:: phy2log => phy2logTria
PROCEDURE, PASS:: nextElement => nextElementTria PROCEDURE, PASS:: nextElement => nextElementTria
END TYPE meshVol2DCartTria END TYPE meshCell2DCartTria
CONTAINS CONTAINS
!NODE FUNCTIONS !NODE FUNCTIONS
@ -204,26 +197,26 @@ MODULE moduleMesh2DCart
END SUBROUTINE initEdge2DCart END SUBROUTINE initEdge2DCart
!Random position in quadrilateral volume !Random position in quadrilateral volume
FUNCTION randPosVolQuad(self) RESULT(r) FUNCTION randPosCellQuad(self) RESULT(r)
USE moduleRandom USE moduleRandom
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartQuad), INTENT(in):: self CLASS(meshCell2DCartQuad), INTENT(in):: self
REAL(8):: r(1:3) REAL(8):: r(1:3)
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
REAL(8), ALLOCATABLE:: fPsi(:) REAL(8):: fPsi(1:4)
Xi(1) = random(-1.D0, 1.D0) Xi(1) = random(-1.D0, 1.D0)
Xi(2) = random(-1.D0, 1.D0) Xi(2) = random(-1.D0, 1.D0)
Xi(3) = 0.D0 Xi(3) = 0.D0
CALL self%fPsi(Xi, fPsi) fPsi = self%fPsi(Xi)
r(1) = DOT_PRODUCT(fPsi, self%x) r(1) = DOT_PRODUCT(fPsi, self%x)
r(2) = DOT_PRODUCT(fPsi, self%y) r(2) = DOT_PRODUCT(fPsi, self%y)
r(3) = 0.D0 r(3) = 0.D0
END FUNCTION randposVolQuad END FUNCTION randposCellQuad
!Get nodes from edge !Get nodes from edge
PURE FUNCTION getNodes2DCart(self) RESULT(n) PURE FUNCTION getNodes2DCart(self) RESULT(n)
@ -232,7 +225,6 @@ MODULE moduleMesh2DCart
CLASS(meshEdge2DCart), INTENT(in):: self CLASS(meshEdge2DCart), INTENT(in):: self
INTEGER, ALLOCATABLE:: n(:) INTEGER, ALLOCATABLE:: n(:)
ALLOCATE(n(1:2))
n = (/self%n1%n, self%n2%n /) n = (/self%n1%n, self%n2%n /)
END FUNCTION getNodes2DCart END FUNCTION getNodes2DCart
@ -277,17 +269,18 @@ MODULE moduleMesh2DCart
!VOLUME FUNCTIONS !VOLUME FUNCTIONS
!QUAD FUNCTIONS !QUAD FUNCTIONS
!Inits quadrilateral element !Inits quadrilateral element
SUBROUTINE initVolQuad2DCart(self, n, p, nodes) SUBROUTINE initCellQuad2DCart(self, n, p, nodes)
USE moduleRefParam USE moduleRefParam
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartQuad), INTENT(out):: self CLASS(meshCell2DCartQuad), INTENT(out):: self
INTEGER, INTENT(in):: n INTEGER, INTENT(in):: n
INTEGER, INTENT(in):: p(:) INTEGER, INTENT(in):: p(:)
TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:)
REAL(8), DIMENSION(1:3):: r1, r2, r3, r4 REAL(8), DIMENSION(1:3):: r1, r2, r3, r4
self%n = n self%n = n
self%nNodes = SIZE(p)
self%n1 => nodes(p(1))%obj self%n1 => nodes(p(1))%obj
self%n2 => nodes(p(2))%obj self%n2 => nodes(p(2))%obj
self%n3 => nodes(p(3))%obj self%n3 => nodes(p(3))%obj
@ -312,13 +305,13 @@ MODULE moduleMesh2DCart
ALLOCATE(self%listPart_in(1:nSpecies)) ALLOCATE(self%listPart_in(1:nSpecies))
ALLOCATE(self%totalWeight(1:nSpecies)) ALLOCATE(self%totalWeight(1:nSpecies))
END SUBROUTINE initVolQuad2DCart END SUBROUTINE initCellQuad2DCart
!Computes element area !Computes element area
PURE SUBROUTINE areaQuad(self) PURE SUBROUTINE areaQuad(self)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartQuad), INTENT(inout):: self CLASS(meshCell2DCartQuad), INTENT(inout):: self
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
REAL(8):: detJ REAL(8):: detJ
REAL(8):: fPsi(1:4) REAL(8):: fPsi(1:4)
@ -328,18 +321,19 @@ MODULE moduleMesh2DCart
!2D 1 point Gauss Quad Integral !2D 1 point Gauss Quad Integral
Xi = 0.D0 Xi = 0.D0
detJ = self%detJac(Xi)*4.D0 !4 detJ = self%detJac(Xi)*4.D0 !4
CALL self%fPsi(Xi, fPsi) fPsi = self%fPsi(Xi)
self%volume = detJ self%volume = detJ
self%arNodes = fPsi*detJ self%arNodes = fPsi*detJ
END SUBROUTINE areaQuad END SUBROUTINE areaQuad
!Computes element functions in point Xi !Computes element functions in point Xi
PURE SUBROUTINE fPsiQuad(Xi, fPsi) PURE FUNCTION fPsiQuad(self, Xi) RESULT(fPsi)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshCell2DCartQuad), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3) 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(1) = (1.D0-Xi(1)) * (1.D0-Xi(2))
fPsi(2) = (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 fPsi = fPsi*0.25D0
END SUBROUTINE fPsiQuad END FUNCTION fPsiQuad
!Derivative element function at coordinates Xi !Derivative element function at coordinates Xi
PURE FUNCTION dPsiQuad(Xi) RESULT(dPsi) PURE FUNCTION dPsiQuad(self, Xi) RESULT(dPsi)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshCell2DCartQuad), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3) 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(1,:) = dPsiQuadXi1(Xi(2))
dPsi(2,:) = dPsiQuadXi2(Xi(1)) dPsi(2,:) = dPsiQuadXi2(Xi(1))
@ -397,8 +392,8 @@ MODULE moduleMesh2DCart
PURE SUBROUTINE partialDerQuad(self, dPsi, dx, dy) PURE SUBROUTINE partialDerQuad(self, dPsi, dx, dy)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartQuad), INTENT(in):: self CLASS(meshCell2DCartQuad), INTENT(in):: self
REAL(8), INTENT(in):: dPsi(1:,1:) REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes)
REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy
dx(1) = DOT_PRODUCT(dPsi(1,:),self%x) dx(1) = DOT_PRODUCT(dPsi(1,:),self%x)
@ -412,14 +407,13 @@ MODULE moduleMesh2DCart
PURE FUNCTION elemKQuad(self) RESULT(localK) PURE FUNCTION elemKQuad(self) RESULT(localK)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartQuad), INTENT(in):: self CLASS(meshCell2DCartQuad), INTENT(in):: self
REAL(8), ALLOCATABLE:: localK(:,:) REAL(8):: localK(1:self%nNodes,1:self%nNodes)
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
REAL(8):: fPsi(1:4), dPsi(1:2,1:4) REAL(8):: fPsi(1:4), dPsi(1:3,1:4)
REAL(8):: invJ(1:2,1:2), detJ REAL(8):: invJ(1:3,1:3), detJ
INTEGER:: l, m INTEGER:: l, m
ALLOCATE(localK(1:4, 1:4))
localK=0.D0 localK=0.D0
Xi=0.D0 Xi=0.D0
!Start 2D Gauss Quad Integral !Start 2D Gauss Quad Integral
@ -429,7 +423,7 @@ MODULE moduleMesh2DCart
DO m = 1, 3 DO m = 1, 3
Xi(1) = corQuad(m) Xi(1) = corQuad(m)
dPsi(2,:) = self%dPsiXi2(Xi(1)) dPsi(2,:) = self%dPsiXi2(Xi(1))
CALL self%fPsi(Xi, fPsi) fPsi = self%fPsi(Xi)
detJ = self%detJac(Xi,dPsi) detJ = self%detJac(Xi,dPsi)
invJ = self%invJac(Xi,dPsi) invJ = self%invJac(Xi,dPsi)
localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*wQuad(l)*wQuad(m)/detJ 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) PURE FUNCTION elemFQuad(self, source) RESULT(localF)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartQuad), INTENT(in):: self CLASS(meshCell2DCartQuad), INTENT(in):: self
REAL(8), INTENT(in):: source(1:) REAL(8), INTENT(in):: source(1:self%nNodes)
REAL(8), ALLOCATABLE:: localF(:) REAL(8):: localF(1:self%nNodes)
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
REAL(8):: fPsi(1:4) REAL(8):: fPsi(1:4)
REAL(8):: detJ, f REAL(8):: detJ, f
INTEGER:: l, m INTEGER:: l, m
ALLOCATE(localF(1:4))
localF = 0.D0 localF = 0.D0
Xi = 0.D0 Xi = 0.D0
DO l=1, 3 DO l=1, 3
@ -459,7 +452,7 @@ MODULE moduleMesh2DCart
DO m = 1, 3 DO m = 1, 3
Xi(2) = corQuad(m) Xi(2) = corQuad(m)
detJ = self%detJac(Xi) detJ = self%detJac(Xi)
CALL self%fPsi(Xi, fPsi) fPsi = self%fPsi(Xi)
f = DOT_PRODUCT(fPsi,source) f = DOT_PRODUCT(fPsi,source)
localF = localF + f*fPsi*wQuad(l)*wQuad(m)*detJ localF = localF + f*fPsi*wQuad(l)*wQuad(m)*detJ
@ -468,6 +461,48 @@ MODULE moduleMesh2DCart
END FUNCTION elemFQuad 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 !Checks if a particle is inside a quad element
PURE FUNCTION insideQuad(Xi) RESULT(ins) PURE FUNCTION insideQuad(Xi) RESULT(ins)
IMPLICIT NONE IMPLICIT NONE
@ -480,97 +515,42 @@ MODULE moduleMesh2DCart
END FUNCTION insideQuad 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 !Gets nodes from quadrilateral element
PURE FUNCTION getNodesQuad(self) RESULT(n) PURE FUNCTION getNodesQuad(self) RESULT(n)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartQuad), INTENT(in):: self CLASS(meshCell2DCartQuad), INTENT(in):: self
INTEGER, ALLOCATABLE:: n(:) INTEGER:: n(1:self%nNodes)
ALLOCATE(n(1:4))
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 END FUNCTION getNodesQuad
!Transforms physical coordinates to element coordinates !Transforms physical coordinates to element coordinates
PURE FUNCTION phy2logQuad(self,r) RESULT(XiN) PURE FUNCTION phy2logQuad(self,r) RESULT(Xi)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartQuad), INTENT(in):: self CLASS(meshCell2DCartQuad), INTENT(in):: self
REAL(8), INTENT(in):: r(1:3) 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):: 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 REAL(8):: conv
!Iterative newton method to transform coordinates !Iterative newton method to transform coordinates
conv=1.D0 conv=1.D0
XiO=0.D0 XiO=0.D0
DO WHILE(conv>1.D-4) DO WHILE(conv>1.D-3)
dPsi = self%dPsi(XiO) dPsi = self%dPsi(XiO)
invJ = self%invJac(XiO, dPsi) invJ = self%invJac(XiO, dPsi)
CALL self%fPsi(XiO, fPsi) fPsi = self%fPsi(XiO)
f(1) = DOT_PRODUCT(fPsi,self%x)-r(1) f(1) = DOT_PRODUCT(fPsi,self%x)-r(1)
f(2) = DOT_PRODUCT(fPsi,self%y)-r(2) f(2) = DOT_PRODUCT(fPsi,self%y)-r(2)
detJ = self%detJac(XiO,dPsi) detJ = self%detJac(XiO,dPsi)
XiN(1:2)=XiO(1:2) - MATMUL(invJ, f)/detJ Xi(1:2)=XiO(1:2) - MATMUL(invJ, f)/detJ
conv=MAXVAL(DABS(XiN-XiO),1) conv=MAXVAL(DABS(Xi-XiO),1)
XiO=XiN XiO=Xi
END DO END DO
@ -580,7 +560,7 @@ MODULE moduleMesh2DCart
SUBROUTINE nextElementQuad(self, Xi, nextElement) SUBROUTINE nextElementQuad(self, Xi, nextElement)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartQuad), INTENT(in):: self CLASS(meshCell2DCartQuad), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3) REAL(8), INTENT(in):: Xi(1:3)
CLASS(meshElement), POINTER, INTENT(out):: nextElement CLASS(meshElement), POINTER, INTENT(out):: nextElement
REAL(8):: XiArray(1:4) REAL(8):: XiArray(1:4)
@ -605,11 +585,11 @@ MODULE moduleMesh2DCart
!TRIA ELEMENT !TRIA ELEMENT
!Init tria element !Init tria element
SUBROUTINE initVolTria2DCart(self, n, p, nodes) SUBROUTINE initCellTria2DCart(self, n, p, nodes)
USE moduleRefParam USE moduleRefParam
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartTria), INTENT(out):: self CLASS(meshCell2DCartTria), INTENT(out):: self
INTEGER, INTENT(in):: n INTEGER, INTENT(in):: n
INTEGER, INTENT(in):: p(:) INTEGER, INTENT(in):: p(:)
TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:)
@ -618,6 +598,9 @@ MODULE moduleMesh2DCart
!Assign node index !Assign node index
self%n = n self%n = n
!Assign number of nodes of cell
self%nNodes = SIZE(p)
!Assign nodes to element !Assign nodes to element
self%n1 => nodes(p(1))%obj self%n1 => nodes(p(1))%obj
self%n2 => nodes(p(2))%obj self%n2 => nodes(p(2))%obj
@ -639,14 +622,14 @@ MODULE moduleMesh2DCart
ALLOCATE(self%listPart_in(1:nSpecies)) ALLOCATE(self%listPart_in(1:nSpecies))
ALLOCATE(self%totalWeight(1:nSpecies)) ALLOCATE(self%totalWeight(1:nSpecies))
END SUBROUTINE initVolTria2DCart END SUBROUTINE initCellTria2DCart
!Random position in quadrilateral volume !Random position in quadrilateral volume
FUNCTION randPosVolTria(self) RESULT(r) FUNCTION randPosCellTria(self) RESULT(r)
USE moduleRandom USE moduleRandom
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartTria), INTENT(in):: self CLASS(meshCell2DCartTria), INTENT(in):: self
REAL(8):: r(1:3) REAL(8):: r(1:3)
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
REAL(8):: fPsi(1:3) REAL(8):: fPsi(1:3)
@ -655,19 +638,19 @@ MODULE moduleMesh2DCart
Xi(2) = random( 0.D0, 1.D0 - Xi(1)) Xi(2) = random( 0.D0, 1.D0 - Xi(1))
Xi(3) = 0.D0 Xi(3) = 0.D0
CALL self%fPsi(Xi, fPsi) fPsi = self%fPsi(Xi)
r(1) = DOT_PRODUCT(fPsi, self%x) r(1) = DOT_PRODUCT(fPsi, self%x)
r(2) = DOT_PRODUCT(fPsi, self%y) r(2) = DOT_PRODUCT(fPsi, self%y)
r(3) = 0.D0 r(3) = 0.D0
END FUNCTION randposVolTria END FUNCTION randposCellTria
!Calculates area for triangular element !Calculates area for triangular element
PURE SUBROUTINE areaTria(self) PURE SUBROUTINE areaTria(self)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartTria), INTENT(inout):: self CLASS(meshCell2DCartTria), INTENT(inout):: self
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
REAL(8):: detJ REAL(8):: detJ
REAL(8):: fPsi(1:3) REAL(8):: fPsi(1:3)
@ -677,33 +660,35 @@ MODULE moduleMesh2DCart
!2D 1 point Gauss Quad Integral !2D 1 point Gauss Quad Integral
Xi = (/1.D0/3.D0, 1.D0/3.D0, 0.D0 /) Xi = (/1.D0/3.D0, 1.D0/3.D0, 0.D0 /)
detJ = self%detJac(Xi)/2.D0 detJ = self%detJac(Xi)/2.D0
CALL self%fPsi(Xi, fPsi) fPsi = self%fPsi(Xi)
self%volume = detJ self%volume = detJ
self%arNodes = fPsi*detJ self%arNodes = fPsi*detJ
END SUBROUTINE areaTria END SUBROUTINE areaTria
!Shape functions for triangular element !Shape functions for triangular element
PURE SUBROUTINE fPsiTria(Xi, fPsi) PURE FUNCTION fPsiTria(self, Xi) RESULT(fPsi)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshCell2DCartTria), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3) 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(1) = 1.D0 - Xi(1) - Xi(2)
fPsi(2) = Xi(1) fPsi(2) = Xi(1)
fPsi(3) = Xi(2) fPsi(3) = Xi(2)
END SUBROUTINE fPsiTria END FUNCTION fPsiTria
!Derivative element function at coordinates Xi !Derivative element function at coordinates Xi
PURE FUNCTION dPsiTria(Xi) RESULT(dPsi) PURE FUNCTION dPsiTria(self, Xi) RESULT(dPsi)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshCell2DCartTria), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3) 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(1,:) = dPsiTriaXi1(Xi(2))
dPsi(2,:) = dPsiTriaXi2(Xi(1)) dPsi(2,:) = dPsiTriaXi2(Xi(1))
@ -739,8 +724,8 @@ MODULE moduleMesh2DCart
PURE SUBROUTINE partialDerTria(self, dPsi, dx, dy) PURE SUBROUTINE partialDerTria(self, dPsi, dx, dy)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartTria), INTENT(in):: self CLASS(meshCell2DCartTria), INTENT(in):: self
REAL(8), INTENT(in):: dPsi(1:,1:) REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes)
REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy REAL(8), INTENT(out), DIMENSION(1:2):: dx, dy
dx(1) = DOT_PRODUCT(dPsi(1,:),self%x) dx(1) = DOT_PRODUCT(dPsi(1,:),self%x)
@ -754,14 +739,13 @@ MODULE moduleMesh2DCart
PURE FUNCTION elemKTria(self) RESULT(localK) PURE FUNCTION elemKTria(self) RESULT(localK)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartTria), INTENT(in):: self CLASS(meshCell2DCartTria), INTENT(in):: self
REAL(8), ALLOCATABLE:: localK(:,:) REAL(8):: localK(1:self%nNodes,1:self%nNodes)
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
REAL(8):: fPsi(1:3), dPsi(1:2,1:3) REAL(8):: fPsi(1:3), dPsi(1:3,1:3)
REAL(8):: invJ(1:2,1:2), detJ REAL(8):: invJ(1:3,1:3), detJ
INTEGER:: l INTEGER:: l
ALLOCATE(localK(1:4, 1:4))
localK=0.D0 localK=0.D0
Xi=0.D0 Xi=0.D0
!Start 2D Gauss Quad Integral !Start 2D Gauss Quad Integral
@ -771,7 +755,7 @@ MODULE moduleMesh2DCart
dPsi = self%dPsi(Xi) dPsi = self%dPsi(Xi)
detJ = self%detJac(Xi,dPsi) detJ = self%detJac(Xi,dPsi)
invJ = self%invJac(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 localK = localK + MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*wTria(l)/detJ
END DO END DO
@ -782,15 +766,14 @@ MODULE moduleMesh2DCart
PURE FUNCTION elemFTria(self, source) RESULT(localF) PURE FUNCTION elemFTria(self, source) RESULT(localF)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartTria), INTENT(in):: self CLASS(meshCell2DCartTria), INTENT(in):: self
REAL(8), INTENT(in):: source(1:) REAL(8), INTENT(in):: source(1:self%nNodes)
REAL(8), ALLOCATABLE:: localF(:) REAL(8):: localF(1:self%nNodes)
REAL(8):: fPsi(1:3) REAL(8):: fPsi(1:3)
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
REAL(8):: detJ, f REAL(8):: detJ, f
INTEGER:: l INTEGER:: l
ALLOCATE(localF(1:3))
localF = 0.D0 localF = 0.D0
Xi = 0.D0 Xi = 0.D0
!Start 2D Gauss Quad Integral !Start 2D Gauss Quad Integral
@ -798,7 +781,7 @@ MODULE moduleMesh2DCart
Xi(1) = Xi1Tria(l) Xi(1) = Xi1Tria(l)
Xi(2) = Xi2Tria(l) Xi(2) = Xi2Tria(l)
detJ = self%detJac(Xi) detJ = self%detJac(Xi)
CALL self%fPsi(Xi, fPsi) fPsi = self%fPsi(Xi)
f = DOT_PRODUCT(fPsi,source) f = DOT_PRODUCT(fPsi,source)
localF = localF + f*fPsi*wTria(l)*detJ localF = localF + f*fPsi*wTria(l)*detJ
@ -806,6 +789,44 @@ MODULE moduleMesh2DCart
END FUNCTION elemFTria 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) PURE FUNCTION insideTria(Xi) RESULT(ins)
IMPLICIT NONE IMPLICIT NONE
@ -818,64 +839,13 @@ MODULE moduleMesh2DCart
END FUNCTION insideTria 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 !Gets node indexes from triangular element
PURE FUNCTION getNodesTria(self) RESULT(n) PURE FUNCTION getNodesTria(self) RESULT(n)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartTria), INTENT(in):: self CLASS(meshCell2DCartTria), INTENT(in):: self
INTEGER, ALLOCATABLE:: n(:) INTEGER:: n(1:self%nNodes)
ALLOCATE(n(1:3))
n = (/self%n1%n, self%n2%n, self%n3%n /) n = (/self%n1%n, self%n2%n, self%n3%n /)
END FUNCTION getNodesTria END FUNCTION getNodesTria
@ -884,27 +854,27 @@ MODULE moduleMesh2DCart
PURE FUNCTION phy2logTria(self,r) RESULT(Xi) PURE FUNCTION phy2logTria(self,r) RESULT(Xi)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartTria), INTENT(in):: self CLASS(meshCell2DCartTria), INTENT(in):: self
REAL(8), INTENT(in):: r(1:3) 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):: invJ(1:3,1:3), detJ
REAL(8):: deltaR(1:2) REAL(8):: deltaR(1:3)
REAL(8):: dPsi(1:2,1:3) REAL(8):: dPsi(1:3,1:3)
!Direct method to convert coordinates !Direct method to convert coordinates
Xi = 0.D0 !Irrelevant, required for input Xi = 0.D0
deltaR = (/ r(1) - self%x(1), r(2) - self%y(1) /) deltaR = (/ r(1) - self%x(1), r(2) - self%y(1), 0.D0 /)
dPsi = self%dPsi(Xi) dPsi = self%dPsi(Xi)
invJ = self%invJac(Xi, dPsi) invJ = self%invJac(Xi, dPsi)
detJ = self%detJac(Xi, dPsi) detJ = self%detJac(Xi, dPsi)
Xi(1:2) = MATMUL(invJ,deltaR)/detJ Xi = MATMUL(invJ,deltaR)/detJ
END FUNCTION phy2logTria END FUNCTION phy2logTria
SUBROUTINE nextElementTria(self, Xi, nextElement) SUBROUTINE nextElementTria(self, Xi, nextElement)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartTria), INTENT(in):: self CLASS(meshCell2DCartTria), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3) REAL(8), INTENT(in):: Xi(1:3)
CLASS(meshElement), POINTER, INTENT(out):: nextElement CLASS(meshElement), POINTER, INTENT(out):: nextElement
REAL(8):: XiArray(1:3) REAL(8):: XiArray(1:3)
@ -929,10 +899,10 @@ MODULE moduleMesh2DCart
PURE FUNCTION detJ2DCart(self, Xi, dPsi_in) RESULT(dJ) PURE FUNCTION detJ2DCart(self, Xi, dPsi_in) RESULT(dJ)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCart), INTENT(in):: self CLASS(meshCell2DCart), 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), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes)
REAL(8), ALLOCATABLE:: dPsi(:,:) REAL(8):: dPsi(1:3,1:self%nNodes)
REAL(8):: dJ REAL(8):: dJ
REAL(8):: dx(1:2), dy(1:2) REAL(8):: dx(1:2), dy(1:2)
@ -953,12 +923,12 @@ MODULE moduleMesh2DCart
PURE FUNCTION invJ2DCart(self,Xi,dPsi_in) RESULT(invJ) PURE FUNCTION invJ2DCart(self,Xi,dPsi_in) RESULT(invJ)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCart), INTENT(in):: self CLASS(meshCell2DCart), 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), INTENT(in), OPTIONAL:: dPsi_in(1:3,1:self%nNodes)
REAL(8), ALLOCATABLE:: dPsi(:,:) REAL(8):: dPsi(1:3,1:self%nNodes)
REAL(8):: dx(1:2), dy(1:2) 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 IF(PRESENT(dPsi_in)) THEN
dPsi=dPsi_in dPsi=dPsi_in
@ -968,9 +938,12 @@ MODULE moduleMesh2DCart
END IF END IF
invJ = 0.D0
CALL self%partialDer(dPsi, dx, dy) 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 END FUNCTION invJ2DCart
@ -980,11 +953,11 @@ MODULE moduleMesh2DCart
CLASS(meshGeneric), INTENT(inout):: self CLASS(meshGeneric), INTENT(inout):: self
INTEGER:: e, et INTEGER:: e, et
DO e = 1, self%numVols DO e = 1, self%numCells
!Connect Vol-Vol !Connect Cell-Cell
DO et = 1, self%numVols DO et = 1, self%numCells
IF (e /= et) THEN 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 END IF
@ -992,9 +965,9 @@ MODULE moduleMesh2DCart
SELECT TYPE(self) SELECT TYPE(self)
TYPE IS(meshParticles) TYPE IS(meshParticles)
!Connect Vol-Edge !Connect Cell-Edge
DO et = 1, self%numEdges 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 END DO
@ -1005,34 +978,34 @@ MODULE moduleMesh2DCart
END SUBROUTINE connectMesh2DCart END SUBROUTINE connectMesh2DCart
!Selects type of elements to build connection !Selects type of elements to build connection
SUBROUTINE connectVolVol(elemA, elemB) SUBROUTINE connectCellCell(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol), INTENT(inout):: elemA CLASS(meshCell), INTENT(inout):: elemA
CLASS(meshVol), INTENT(inout):: elemB CLASS(meshCell), INTENT(inout):: elemB
SELECT TYPE(elemA) SELECT TYPE(elemA)
TYPE IS(meshVol2DCartQuad) TYPE IS(meshCell2DCartQuad)
!Element A is a quadrilateral !Element A is a quadrilateral
SELECT TYPE(elemB) SELECT TYPE(elemB)
TYPE IS(meshVol2DCartQuad) TYPE IS(meshCell2DCartQuad)
!Element B is a quadrilateral !Element B is a quadrilateral
CALL connectQuadQuad(elemA, elemB) CALL connectQuadQuad(elemA, elemB)
TYPE IS(meshVol2DCartTria) TYPE IS(meshCell2DCartTria)
!Element B is a triangle !Element B is a triangle
CALL connectQuadTria(elemA, elemB) CALL connectQuadTria(elemA, elemB)
END SELECT END SELECT
TYPE IS(meshVol2DCartTria) TYPE IS(meshCell2DCartTria)
!Element A is a Triangle !Element A is a Triangle
SELECT TYPE(elemB) SELECT TYPE(elemB)
TYPE IS(meshVol2DCartQuad) TYPE IS(meshCell2DCartQuad)
!Element B is a quadrilateral !Element B is a quadrilateral
CALL connectQuadTria(elemB, elemA) CALL connectQuadTria(elemB, elemA)
TYPE IS(meshVol2DCartTria) TYPE IS(meshCell2DCartTria)
!Element B is a triangle !Element B is a triangle
CALL connectTriaTria(elemA, elemB) CALL connectTriaTria(elemA, elemB)
@ -1040,22 +1013,22 @@ MODULE moduleMesh2DCart
END SELECT END SELECT
END SUBROUTINE connectVolVol END SUBROUTINE connectCellCell
SUBROUTINE connectVolEdge(elemA, elemB) SUBROUTINE connectCellEdge(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol), INTENT(inout):: elemA CLASS(meshCell), INTENT(inout):: elemA
CLASS(meshEdge), INTENT(inout):: elemB CLASS(meshEdge), INTENT(inout):: elemB
SELECT TYPE(elemB) SELECT TYPE(elemB)
CLASS IS(meshEdge2DCart) CLASS IS(meshEdge2DCart)
SELECT TYPE(elemA) SELECT TYPE(elemA)
TYPE IS(meshVol2DCartQuad) TYPE IS(meshCell2DCartQuad)
!Element A is a quadrilateral !Element A is a quadrilateral
CALL connectQuadEdge(elemA, elemB) CALL connectQuadEdge(elemA, elemB)
TYPE IS(meshVol2DCartTria) TYPE IS(meshCell2DCartTria)
!Element A is a triangle !Element A is a triangle
CALL connectTriaEdge(elemA, elemB) CALL connectTriaEdge(elemA, elemB)
@ -1063,13 +1036,13 @@ MODULE moduleMesh2DCart
END SELECT END SELECT
END SUBROUTINE connectVolEdge END SUBROUTINE connectCellEdge
SUBROUTINE connectQuadQuad(elemA, elemB) SUBROUTINE connectQuadQuad(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartQuad), INTENT(inout), TARGET:: elemA CLASS(meshCell2DCartQuad), INTENT(inout), TARGET:: elemA
CLASS(meshVol2DCartQuad), INTENT(inout), TARGET:: elemB CLASS(meshCell2DCartQuad), INTENT(inout), TARGET:: elemB
!Check direction 1 !Check direction 1
IF (.NOT. ASSOCIATED(elemA%e1) .AND. & IF (.NOT. ASSOCIATED(elemA%e1) .AND. &
@ -1112,8 +1085,8 @@ MODULE moduleMesh2DCart
SUBROUTINE connectQuadTria(elemA, elemB) SUBROUTINE connectQuadTria(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartQuad), INTENT(inout), TARGET:: elemA CLASS(meshCell2DCartQuad), INTENT(inout), TARGET:: elemA
CLASS(meshVol2DCartTria), INTENT(inout), TARGET:: elemB CLASS(meshCell2DCartTria), INTENT(inout), TARGET:: elemB
!Check direction 1 !Check direction 1
IF (.NOT. ASSOCIATED(elemA%e1)) THEN IF (.NOT. ASSOCIATED(elemA%e1)) THEN
@ -1204,8 +1177,8 @@ MODULE moduleMesh2DCart
SUBROUTINE connectTriaTria(elemA, elemB) SUBROUTINE connectTriaTria(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartTria), INTENT(inout), TARGET:: elemA CLASS(meshCell2DCartTria), INTENT(inout), TARGET:: elemA
CLASS(meshVol2DCartTria), INTENT(inout), TARGET:: elemB CLASS(meshCell2DCartTria), INTENT(inout), TARGET:: elemB
!Check direction 1 !Check direction 1
IF (.NOT. ASSOCIATED(elemA%e1)) THEN IF (.NOT. ASSOCIATED(elemA%e1)) THEN
@ -1277,7 +1250,7 @@ MODULE moduleMesh2DCart
SUBROUTINE connectQuadEdge(elemA, elemB) SUBROUTINE connectQuadEdge(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartQuad), INTENT(inout), TARGET:: elemA CLASS(meshCell2DCartQuad), INTENT(inout), TARGET:: elemA
CLASS(meshEdge2DCart), INTENT(inout), TARGET:: elemB CLASS(meshEdge2DCart), INTENT(inout), TARGET:: elemB
!Check direction 1 !Check direction 1
@ -1361,7 +1334,7 @@ MODULE moduleMesh2DCart
SUBROUTINE connectTriaEdge(elemA, elemB) SUBROUTINE connectTriaEdge(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol2DCartTria), INTENT(inout), TARGET:: elemA CLASS(meshCell2DCartTria), INTENT(inout), TARGET:: elemA
CLASS(meshEdge2DCart), INTENT(inout), TARGET:: elemB CLASS(meshEdge2DCart), INTENT(inout), TARGET:: elemB
!Check direction 1 !Check direction 1

File diff suppressed because it is too large Load diff

View file

@ -31,26 +31,19 @@ MODULE moduleMesh3DCart
END TYPE meshEdge3DCartTria END TYPE meshEdge3DCartTria
TYPE, PUBLIC, ABSTRACT, EXTENDS(meshVol):: meshVol3DCart TYPE, PUBLIC, ABSTRACT, EXTENDS(meshCell):: meshCell3DCart
CONTAINS CONTAINS
PROCEDURE, PASS:: detJac => detJ3DCart PROCEDURE, PASS:: detJac => detJ3DCart
PROCEDURE, PASS:: invJac => invJ3DCart PROCEDURE, PASS:: invJac => invJ3DCart
PROCEDURE(dPsi_interface), DEFERRED, NOPASS:: dPsi
PROCEDURE(partialDer_interface), DEFERRED, PASS:: partialDer PROCEDURE(partialDer_interface), DEFERRED, PASS:: partialDer
END TYPE meshVol3DCart END TYPE meshCell3DCart
ABSTRACT INTERFACE 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) PURE SUBROUTINE partialDer_interface(self, dPsi, dx, dy, dz)
IMPORT meshVol3DCart IMPORT meshCell3DCart
CLASS(meshVol3DCart), INTENT(in):: self CLASS(meshCell3DCart), INTENT(in):: self
REAL(8), INTENT(in):: dPsi(1:,1:) REAL(8), INTENT(in):: dPsi(1:3,1:self%nNodes)
REAL(8), INTENT(out), DIMENSION(1:3):: dx, dy, dz REAL(8), INTENT(out), DIMENSION(1:3):: dx, dy, dz
END SUBROUTINE partialDer_interface END SUBROUTINE partialDer_interface
@ -58,7 +51,7 @@ MODULE moduleMesh3DCart
END INTERFACE END INTERFACE
!Tetrahedron volume element !Tetrahedron volume element
TYPE, PUBLIC, EXTENDS(meshVol3DCart):: meshVol3DCartTetra TYPE, PUBLIC, EXTENDS(meshCell3DCart):: meshCell3DCartTetra
!Element Coordinates !Element Coordinates
REAL(8):: x(1:4) = 0.D0, y(1:4) = 0.D0, z(1:4) = 0.D0 REAL(8):: x(1:4) = 0.D0, y(1:4) = 0.D0, z(1:4) = 0.D0
!Connectivity to nodes !Connectivity to nodes
@ -66,24 +59,24 @@ MODULE moduleMesh3DCart
!Connectivity to adjacent elements !Connectivity to adjacent elements
CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL(), e3 => NULL(), e4 => NULL() CLASS(meshElement), POINTER:: e1 => NULL(), e2 => NULL(), e3 => NULL(), e4 => NULL()
CONTAINS CONTAINS
PROCEDURE, PASS:: init => initVolTetra3DCart PROCEDURE, PASS:: init => initCellTetra3DCart
PROCEDURE, PASS:: randPos => randPosVolTetra PROCEDURE, PASS:: randPos => randPosCellTetra
PROCEDURE, PASS:: calcVol => volumeTetra PROCEDURE, PASS:: calcCell => volumeTetra
PROCEDURE, NOPASS:: fPsi => fPsiTetra PROCEDURE, PASS:: fPsi => fPsiTetra
PROCEDURE, NOPASS:: dPsi => dPsiTetra PROCEDURE, PASS:: dPsi => dPsiTetra
PROCEDURE, NOPASS:: dPsiXi1 => dPsiTetraXi1 PROCEDURE, NOPASS, PRIVATE:: dPsiXi1 => dPsiTetraXi1
PROCEDURE, NOPASS:: dPsiXi2 => dPsiTetraXi2 PROCEDURE, NOPASS, PRIVATE:: dPsiXi2 => dPsiTetraXi2
PROCEDURE, PASS:: partialDer => partialDerTetra PROCEDURE, PASS:: partialDer => partialDerTetra
PROCEDURE, PASS:: elemK => elemKTetra PROCEDURE, PASS:: elemK => elemKTetra
PROCEDURE, PASS:: elemF => elemFTetra PROCEDURE, PASS:: elemF => elemFTetra
PROCEDURE, PASS:: gatherElectricField => gatherEFTetra
PROCEDURE, PASS:: gatherMagneticField => gatherMFTetra
PROCEDURE, NOPASS:: inside => insideTetra PROCEDURE, NOPASS:: inside => insideTetra
PROCEDURE, PASS:: gatherEF => gatherEFTetra
PROCEDURE, PASS:: gatherMF => gatherMFTetra
PROCEDURE, PASS:: getNodes => getNodesTetra PROCEDURE, PASS:: getNodes => getNodesTetra
PROCEDURE, PASS:: phy2log => phy2logTetra PROCEDURE, PASS:: phy2log => phy2logTetra
PROCEDURE, PASS:: nextElement => nextElementTetra PROCEDURE, PASS:: nextElement => nextElementTetra
END TYPE meshVol3DCartTetra END TYPE meshCell3DCartTetra
CONTAINS CONTAINS
!NODE FUNCTIONS !NODE FUNCTIONS
@ -245,19 +238,20 @@ MODULE moduleMesh3DCart
!VOLUME FUNCTIONS !VOLUME FUNCTIONS
!TETRA FUNCTIONS !TETRA FUNCTIONS
!Inits tetrahedron element !Inits tetrahedron element
SUBROUTINE initVolTetra3DCart(self, n, p, nodes) SUBROUTINE initCellTetra3DCart(self, n, p, nodes)
USE moduleRefParam USE moduleRefParam
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol3DCartTetra), INTENT(out):: self CLASS(meshCell3DCartTetra), INTENT(out):: self
INTEGER, INTENT(in):: n INTEGER, INTENT(in):: n
INTEGER, INTENT(in):: p(:) INTEGER, INTENT(in):: p(:)
TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:)
REAL(8), DIMENSION(1:3):: r1, r2, r3, r4 !Positions of each node REAL(8), DIMENSION(1:3):: r1, r2, r3, r4 !Positions of each node
REAL(8):: Xi(1:3), fPsi(1:4) 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%n = n
self%nNodes = SIZE(p)
self%n1 => nodes(p(1))%obj self%n1 => nodes(p(1))%obj
self%n2 => nodes(p(2))%obj self%n2 => nodes(p(2))%obj
self%n3 => nodes(p(3))%obj self%n3 => nodes(p(3))%obj
@ -272,11 +266,11 @@ MODULE moduleMesh3DCart
self%z = (/r1(3), r2(3), r3(3), r4(3)/) self%z = (/r1(3), r2(3), r3(3), r4(3)/)
!Computes the element volume !Computes the element volume
CALL self%calcVol() CALL self%calcCell()
!Assign proportional volume to each node !Assign proportional volume to each node
Xi = (/0.25D0, 0.25D0, 0.25D0/) Xi = (/0.25D0, 0.25D0, 0.25D0/)
CALL self%fPsi(Xi, fPsi) fPsi = self%fPsi(Xi)
volNodes = fPsi*self%volume volNodes = fPsi*self%volume
self%n1%v = self%n1%v + volNodes(1) self%n1%v = self%n1%v + volNodes(1)
self%n2%v = self%n2%v + volNodes(2) self%n2%v = self%n2%v + volNodes(2)
@ -288,14 +282,14 @@ MODULE moduleMesh3DCart
ALLOCATE(self%listPart_in(1:nSpecies)) ALLOCATE(self%listPart_in(1:nSpecies))
ALLOCATE(self%totalWeight(1:nSpecies)) ALLOCATE(self%totalWeight(1:nSpecies))
END SUBROUTINE initVolTetra3DCart END SUBROUTINE initCellTetra3DCart
!Random position in volume tetrahedron !Random position in volume tetrahedron
FUNCTION randPosVolTetra(self) RESULT(r) FUNCTION randPosCellTetra(self) RESULT(r)
USE moduleRandom USE moduleRandom
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol3DCartTetra), INTENT(in):: self CLASS(meshCell3DCartTetra), INTENT(in):: self
REAL(8):: r(1:3) REAL(8):: r(1:3)
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
REAL(8):: fPsi(1:4) REAL(8):: fPsi(1:4)
@ -304,19 +298,19 @@ MODULE moduleMesh3DCart
Xi(2) = random( 0.D0, 1.D0 - Xi(1)) Xi(2) = random( 0.D0, 1.D0 - Xi(1))
Xi(3) = random( 0.D0, 1.D0 - Xi(1) - Xi(2)) 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), & r = (/ DOT_PRODUCT(fPsi, self%x), &
DOT_PRODUCT(fPsi, self%y), & DOT_PRODUCT(fPsi, self%y), &
DOT_PRODUCT(fPsi, self%z) /) DOT_PRODUCT(fPsi, self%z) /)
END FUNCTION randPosVolTetra END FUNCTION randPosCellTetra
!Computes the element volume !Computes the element volume
PURE SUBROUTINE volumeTetra(self) PURE SUBROUTINE volumeTetra(self)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol3DCartTetra), INTENT(inout):: self CLASS(meshCell3DCartTetra), INTENT(inout):: self
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
self%volume = 0.D0 self%volume = 0.D0
@ -326,27 +320,29 @@ MODULE moduleMesh3DCart
END SUBROUTINE volumeTetra END SUBROUTINE volumeTetra
!Computes element functions in point Xi !Computes element functions in point Xi
PURE SUBROUTINE fPsiTetra(Xi, fPsi) PURE FUNCTION fPsiTetra(self, Xi) RESULT(fPsi)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshCell3DCartTetra), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3) 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(1) = 1.D0 - Xi(1) - Xi(2) - Xi(3)
fPsi(2) = Xi(1) fPsi(2) = Xi(1)
fPsi(3) = Xi(2) fPsi(3) = Xi(2)
fPsi(4) = Xi(3) fPsi(4) = Xi(3)
END SUBROUTINE fPsiTetra END FUNCTION fPsiTetra
!Derivative element function at coordinates Xi !Derivative element function at coordinates Xi
PURE FUNCTION dPsiTetra(Xi) RESULT(dPsi) PURE FUNCTION dPsiTetra(self, Xi) RESULT(dPsi)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshCell3DCartTetra), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3) 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(1,:) = dPsiTetraXi1(Xi(2), Xi(3))
dPsi(2,:) = dPsiTetraXi2(Xi(1), Xi(3)) dPsi(2,:) = dPsiTetraXi2(Xi(1), Xi(3))
@ -397,8 +393,8 @@ MODULE moduleMesh3DCart
PURE SUBROUTINE partialDerTetra(self, dPsi, dx, dy, dz) PURE SUBROUTINE partialDerTetra(self, dPsi, dx, dy, dz)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol3DCartTetra), INTENT(in):: self CLASS(meshCell3DCartTetra), INTENT(in):: self
REAL(8), INTENT(in):: dPsi(1:, 1:) REAL(8), INTENT(in):: dPsi(1:3, 1:self%nNodes)
REAL(8), INTENT(out), DIMENSION(1:3):: dx, dy, dz REAL(8), INTENT(out), DIMENSION(1:3):: dx, dy, dz
dx(1) = DOT_PRODUCT(dPsi(1,:), self%x) dx(1) = DOT_PRODUCT(dPsi(1,:), self%x)
@ -418,13 +414,12 @@ MODULE moduleMesh3DCart
PURE FUNCTION elemKTetra(self) RESULT(localK) PURE FUNCTION elemKTetra(self) RESULT(localK)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol3DCartTetra), INTENT(in):: self CLASS(meshCell3DCartTetra), INTENT(in):: self
REAL(8), ALLOCATABLE:: localK(:,:) REAL(8):: localK(1:self%nNodes,1:self%nNodes)
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
REAL(8):: fPsi(1:4), dPsi(1:3, 1:4) REAL(8):: fPsi(1:4), dPsi(1:3, 1:4)
REAL(8):: invJ(1:3,1:3), detJ REAL(8):: invJ(1:3,1:3), detJ
ALLOCATE(localK(1:4,1:4))
localK = 0.D0 localK = 0.D0
Xi = 0.D0 Xi = 0.D0
!TODO: One point Gauss integral. Upgrade when possible !TODO: One point Gauss integral. Upgrade when possible
@ -432,7 +427,7 @@ MODULE moduleMesh3DCart
dPsi = self%dPsi(Xi) dPsi = self%dPsi(Xi)
detJ = self%detJac(Xi, dPsi) detJ = self%detJac(Xi, dPsi)
invJ = self%invJac(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 localK = MATMUL(TRANSPOSE(MATMUL(invJ,dPsi)),MATMUL(invJ,dPsi))*1.D0/detJ
END FUNCTION elemKTetra END FUNCTION elemKTetra
@ -440,26 +435,66 @@ MODULE moduleMesh3DCart
PURE FUNCTION elemFTetra(self, source) RESULT(localF) PURE FUNCTION elemFTetra(self, source) RESULT(localF)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol3DCartTetra), INTENT(in):: self CLASS(meshCell3DCartTetra), INTENT(in):: self
REAL(8), INTENT(in):: source(1:) REAL(8), INTENT(in):: source(1:self%nNodes)
REAL(8), ALLOCATABLE:: localF(:) REAL(8):: localF(1:self%nNodes)
REAL(8):: fPsi(1:4), dPsi(1:3, 1:4) REAL(8):: fPsi(1:4), dPsi(1:3, 1:4)
REAL(8):: Xi(1:3) REAL(8):: Xi(1:3)
REAL(8):: detJ, f REAL(8):: detJ, f
ALLOCATE(localF(1:4))
localF = 0.D0 localF = 0.D0
Xi = 0.D0 Xi = 0.D0
Xi = (/ 0.25D0, 0.25D0, 0.25D0 /) Xi = (/ 0.25D0, 0.25D0, 0.25D0 /)
dPsi = self%dPsi(Xi) dPsi = self%dPsi(Xi)
detJ = self%detJac(Xi, dPsi) detJ = self%detJac(Xi, dPsi)
CALL self%fPsi(Xi, fPsi) fPsi = self%fPsi(Xi)
f = DOT_PRODUCT(fPsi, source) f = DOT_PRODUCT(fPsi, source)
localF = f*fPsi*1.D0*detJ localF = f*fPsi*1.D0*detJ
END FUNCTION elemFTetra 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) PURE FUNCTION insideTetra(Xi) RESULT(ins)
IMPLICIT NONE IMPLICIT NONE
@ -473,66 +508,12 @@ MODULE moduleMesh3DCart
END FUNCTION insideTetra 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) PURE FUNCTION getNodesTetra(self) RESULT(n)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol3DCartTetra), INTENT(in):: self CLASS(meshCell3DCartTetra), INTENT(in):: self
INTEGER, ALLOCATABLE:: n(:) INTEGER:: n(1:self%nnodes)
ALLOCATE(n(1:4))
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 getNodesTetra END FUNCTION getNodesTetra
@ -540,7 +521,7 @@ MODULE moduleMesh3DCart
PURE FUNCTION phy2logTetra(self,r) RESULT(Xi) PURE FUNCTION phy2logTetra(self,r) RESULT(Xi)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol3DCartTetra), INTENT(in):: self CLASS(meshCell3DCartTetra), INTENT(in):: self
REAL(8), INTENT(in):: r(1:3) 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):: invJ(1:3, 1:3), detJ
@ -559,7 +540,7 @@ MODULE moduleMesh3DCart
SUBROUTINE nextElementTetra(self, Xi, nextElement) SUBROUTINE nextElementTetra(self, Xi, nextElement)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol3DCartTetra), INTENT(in):: self CLASS(meshCell3DCartTetra), INTENT(in):: self
REAL(8), INTENT(in):: Xi(1:3) REAL(8), INTENT(in):: Xi(1:3)
CLASS(meshElement), POINTER, INTENT(out):: nextElement CLASS(meshElement), POINTER, INTENT(out):: nextElement
REAL(8):: XiArray(1:4) REAL(8):: XiArray(1:4)
@ -587,11 +568,11 @@ MODULE moduleMesh3DCart
PURE FUNCTION detJ3DCart(self, Xi, dPsi_in) RESULT(dJ) PURE FUNCTION detJ3DCart(self, Xi, dPsi_in) RESULT(dJ)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol3DCart), INTENT(in)::self CLASS(meshCell3DCart), 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), INTENT(in), OPTIONAL:: dPsi_in(1:3, 1:self%nNodes)
REAL(8):: dJ 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) REAL(8):: dx(1:3), dy(1:3), dz(1:3)
IF (PRESENT(dPsi_in)) THEN IF (PRESENT(dPsi_in)) THEN
@ -612,10 +593,10 @@ MODULE moduleMesh3DCart
PURE FUNCTION invJ3DCart(self,Xi,dPsi_in) RESULT(invJ) PURE FUNCTION invJ3DCart(self,Xi,dPsi_in) RESULT(invJ)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol3DCart), INTENT(in):: self CLASS(meshCell3DCart), 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), INTENT(in), OPTIONAL:: dPsi_in(1:3, 1:self%nNodes)
REAL(8), ALLOCATABLE:: dPsi(:,:) REAL(8):: dPsi(1:3, 1:self%nNodes)
REAL(8), DIMENSION(1:3):: dx, dy, dz REAL(8), DIMENSION(1:3):: dx, dy, dz
REAL(8):: invJ(1:3,1:3) REAL(8):: invJ(1:3,1:3)
@ -645,17 +626,17 @@ MODULE moduleMesh3DCart
END FUNCTION invJ3DCart END FUNCTION invJ3DCart
!Selects type of elements to build connection !Selects type of elements to build connection
SUBROUTINE connectVolVol(elemA, elemB) SUBROUTINE connectCellCell(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol), INTENT(inout):: elemA CLASS(meshCell), INTENT(inout):: elemA
CLASS(meshVol), INTENT(inout):: elemB CLASS(meshCell), INTENT(inout):: elemB
SELECT TYPE(elemA) SELECT TYPE(elemA)
TYPE IS(meshVol3DCartTetra) TYPE IS(meshCell3DCartTetra)
!Element A is a tetrahedron !Element A is a tetrahedron
SELECT TYPE(elemB) SELECT TYPE(elemB)
TYPE IS(meshVol3DCartTetra) TYPE IS(meshCell3DCartTetra)
!Element B is a tetrahedron !Element B is a tetrahedron
CALL connectTetraTetra(elemA, elemB) CALL connectTetraTetra(elemA, elemB)
@ -663,18 +644,18 @@ MODULE moduleMesh3DCart
END SELECT END SELECT
END SUBROUTINE connectVolVol END SUBROUTINE connectCellCell
SUBROUTINE connectVolEdge(elemA, elemB) SUBROUTINE connectCellEdge(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol), INTENT(inout):: elemA CLASS(meshCell), INTENT(inout):: elemA
CLASS(meshEdge), INTENT(inout):: elemB CLASS(meshEdge), INTENT(inout):: elemB
SELECT TYPE(elemB) SELECT TYPE(elemB)
CLASS IS(meshEdge3DCartTria) CLASS IS(meshEdge3DCartTria)
SELECT TYPE(elemA) SELECT TYPE(elemA)
TYPE IS(meshVol3DCartTetra) TYPE IS(meshCell3DCartTetra)
!Element A is a tetrahedron !Element A is a tetrahedron
CALL connectTetraEdge(elemA, elemB) CALL connectTetraEdge(elemA, elemB)
@ -682,7 +663,7 @@ MODULE moduleMesh3DCart
END SELECT END SELECT
END SUBROUTINE connectVolEdge END SUBROUTINE connectCellEdge
SUBROUTINE connectMesh3DCart(self) SUBROUTINE connectMesh3DCart(self)
IMPLICIT NONE IMPLICIT NONE
@ -690,11 +671,11 @@ MODULE moduleMesh3DCart
CLASS(meshGeneric), INTENT(inout):: self CLASS(meshGeneric), INTENT(inout):: self
INTEGER:: e, et INTEGER:: e, et
DO e = 1, self%numVols DO e = 1, self%numCells
!Connect Vol-Vol !Connect Cell-Cell
DO et = 1, self%numVols DO et = 1, self%numCells
IF (e /= et) THEN 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 END IF
@ -702,9 +683,9 @@ MODULE moduleMesh3DCart
SELECT TYPE(self) SELECT TYPE(self)
TYPE IS(meshParticles) TYPE IS(meshParticles)
!Connect Vol-Edge !Connect Cell-Edge
DO et = 1, self%numEdges 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 END DO
@ -740,8 +721,8 @@ MODULE moduleMesh3DCart
SUBROUTINE connectTetraTetra(elemA, elemB) SUBROUTINE connectTetraTetra(elemA, elemB)
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol3DCartTetra), INTENT(inout), TARGET:: elemA CLASS(meshCell3DCartTetra), INTENT(inout), TARGET:: elemA
CLASS(meshVol3DCartTetra), INTENT(inout), TARGET:: elemB CLASS(meshCell3DCartTetra), INTENT(inout), TARGET:: elemB
!Check surface 1 !Check surface 1
IF (.NOT. ASSOCIATED(elemA%e1)) THEN IF (.NOT. ASSOCIATED(elemA%e1)) THEN
@ -869,11 +850,11 @@ MODULE moduleMesh3DCart
USE moduleMath USE moduleMath
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol3DCartTetra), INTENT(inout), TARGET:: elemA CLASS(meshCell3DCartTetra), INTENT(inout), TARGET:: elemA
CLASS(meshEdge3DCartTria), INTENT(inout), TARGET:: elemB CLASS(meshEdge3DCartTria), INTENT(inout), TARGET:: elemB
INTEGER:: nodesEdge(1:3) INTEGER:: nodesEdge(1:3)
REAL(8), DIMENSION(1:3):: vec1, vec2 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 /) nodesEdge = (/ elemB%n1%n, elemB%n2%n, elemB%n3%n /)
@ -888,10 +869,10 @@ MODULE moduleMesh3DCart
vec2 = (/ elemA%x(3) - elemA%x(1), & vec2 = (/ elemA%x(3) - elemA%x(1), &
elemA%y(3) - elemA%y(1), & elemA%y(3) - elemA%y(1), &
elemA%z(3) - elemA%z(1) /) elemA%z(3) - elemA%z(1) /)
normVol = crossProduct(vec1, vec2) normCell = crossProduct(vec1, vec2)
normVol = normalize(normVol) normCell = normalize(normCell)
IF (DOT_PRODUCT(elemB%normal, normVol) == -1.D0) THEN IF (DOT_PRODUCT(elemB%normal, normCell) == -1.D0) THEN
elemA%e1 => elemB elemA%e1 => elemB
elemB%e1 => elemA elemB%e1 => elemA
@ -921,10 +902,10 @@ MODULE moduleMesh3DCart
vec2 = (/ elemA%x(4) - elemA%x(2), & vec2 = (/ elemA%x(4) - elemA%x(2), &
elemA%y(4) - elemA%y(2), & elemA%y(4) - elemA%y(2), &
elemA%z(4) - elemA%z(2) /) elemA%z(4) - elemA%z(2) /)
normVol = crossProduct(vec1, vec2) normCell = crossProduct(vec1, vec2)
normVol = normalize(normVol) normCell = normalize(normCell)
IF (DOT_PRODUCT(elemB%normal, normVol) == -1.D0) THEN IF (DOT_PRODUCT(elemB%normal, normCell) == -1.D0) THEN
elemA%e2 => elemB elemA%e2 => elemB
elemB%e1 => elemA elemB%e1 => elemA
@ -954,10 +935,10 @@ MODULE moduleMesh3DCart
vec2 = (/ elemA%x(4) - elemA%x(1), & vec2 = (/ elemA%x(4) - elemA%x(1), &
elemA%y(4) - elemA%y(1), & elemA%y(4) - elemA%y(1), &
elemA%z(4) - elemA%z(1) /) elemA%z(4) - elemA%z(1) /)
normVol = crossProduct(vec1, vec2) normCell = crossProduct(vec1, vec2)
normVol = normalize(normVol) normCell = normalize(normCell)
IF (DOT_PRODUCT(elemB%normal, normVol) == -1.D0) THEN IF (DOT_PRODUCT(elemB%normal, normCell) == -1.D0) THEN
elemA%e3 => elemB elemA%e3 => elemB
elemB%e1 => elemA elemB%e1 => elemA
@ -987,10 +968,10 @@ MODULE moduleMesh3DCart
vec2 = (/ elemA%x(4) - elemA%x(1), & vec2 = (/ elemA%x(4) - elemA%x(1), &
elemA%y(4) - elemA%y(1), & elemA%y(4) - elemA%y(1), &
elemA%z(4) - elemA%z(1) /) elemA%z(4) - elemA%z(1) /)
normVol = crossProduct(vec1, vec2) normCell = crossProduct(vec1, vec2)
normVol = normalize(normVol) normCell = normalize(normCell)
IF (DOT_PRODUCT(elemB%normal, normVol) == -1.D0) THEN IF (DOT_PRODUCT(elemB%normal, normCell) == -1.D0) THEN
elemA%e4 => elemB elemA%e4 => elemB
elemB%e1 => elemA elemB%e1 => elemA

View file

@ -41,8 +41,8 @@ MODULE moduleMeshInput0D
self%numNodes = 1 self%numNodes = 1
ALLOCATE(self%nodes(1:1)) ALLOCATE(self%nodes(1:1))
!Allocates one volume !Allocates one volume
self%numVols = 1 self%numCells = 1
ALLOCATE(self%vols(1:1)) ALLOCATE(self%cells(1:1))
!Allocates matrix K !Allocates matrix K
SELECT TYPE(self) SELECT TYPE(self)
TYPE IS(meshParticles) TYPE IS(meshParticles)
@ -59,8 +59,8 @@ MODULE moduleMeshInput0D
CALL self%nodes(1)%obj%init(1, r) CALL self%nodes(1)%obj%init(1, r)
!Creates the volume !Creates the volume
ALLOCATE(meshVol0D:: self%vols(1)%obj) ALLOCATE(meshCell0D:: self%cells(1)%obj)
CALL self%vols(1)%obj%init(1, (/ 1/), self%nodes) CALL self%cells(1)%obj%init(1, (/ 1/), self%nodes)
END SUBROUTINE read0D END SUBROUTINE read0D

View file

@ -57,7 +57,7 @@ MODULE moduleMeshOutput0D
END IF END IF
OPEN(20, file = path // folder // '/' // fileName, position = 'append', action = 'write') 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) CLOSE(20)
END SUBROUTINE printColl0D END SUBROUTINE printColl0D

View file

@ -136,7 +136,7 @@ MODULE moduleMeshInputGmsh2
!Substract the number of edges to the total number of elements !Substract the number of edges to the total number of elements
!to obtain the number of volume elements !to obtain the number of volume elements
self%numVols = TotalnumElem - self%numEdges self%numCells = TotalnumElem - self%numEdges
ALLOCATE(self%edges(1:self%numEdges)) ALLOCATE(self%edges(1:self%numEdges))
numEdges = self%numEdges numEdges = self%numEdges
@ -146,13 +146,13 @@ MODULE moduleMeshInputGmsh2
END DO END DO
TYPE IS(meshCollisions) TYPE IS(meshCollisions)
self%numVols = TotalnumElem self%numCells = TotalnumElem
numEdges = 0 numEdges = 0
END SELECT END SELECT
!Allocates arrays !Allocates arrays
ALLOCATE(self%vols(1:self%numVols)) ALLOCATE(self%cells(1:self%numCells))
SELECT TYPE(self) SELECT TYPE(self)
TYPE IS(meshParticles) TYPE IS(meshParticles)
@ -232,7 +232,7 @@ MODULE moduleMeshInputGmsh2
END SELECT END SELECT
!Read and initialize volumes !Read and initialize volumes
DO e = 1, self%numVols DO e = 1, self%numCells
!Reads the volume according to the geometry !Reads the volume according to the geometry
SELECT CASE(self%dimen) SELECT CASE(self%dimen)
CASE(3) CASE(3)
@ -244,7 +244,7 @@ MODULE moduleMeshInputGmsh2
!Tetrahedron element !Tetrahedron element
ALLOCATE(p(1:4)) ALLOCATE(p(1:4))
READ(10, *) n, elemType, eTemp, eTemp, eTemp, 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 END SELECT
@ -259,13 +259,13 @@ MODULE moduleMeshInputGmsh2
!Triangular element !Triangular element
ALLOCATE(p(1:3)) ALLOCATE(p(1:3))
READ(10,*) n, elemType, eTemp, eTemp, eTemp, 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) CASE (3)
!Quadrilateral element !Quadrilateral element
ALLOCATE(p(1:4)) ALLOCATE(p(1:4))
READ(10,*) n, elemType, eTemp, eTemp, eTemp, 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 END SELECT
@ -278,13 +278,13 @@ MODULE moduleMeshInputGmsh2
!Triangular element !Triangular element
ALLOCATE(p(1:3)) ALLOCATE(p(1:3))
READ(10,*) n, elemType, eTemp, eTemp, eTemp, 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) CASE (3)
!Quadrilateral element !Quadrilateral element
ALLOCATE(p(1:4)) ALLOCATE(p(1:4))
READ(10,*) n, elemType, eTemp, eTemp, eTemp, 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 END SELECT
@ -296,19 +296,19 @@ MODULE moduleMeshInputGmsh2
ALLOCATE(p(1:2)) ALLOCATE(p(1:2))
READ(10, *) n, elemType, eTemp, eTemp, eTemp, 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") CASE("Cart")
ALLOCATE(p(1:2)) ALLOCATE(p(1:2))
READ(10, *) n, elemType, eTemp, eTemp, eTemp, 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
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) DEALLOCATE(p)
END DO END DO

View file

@ -181,9 +181,9 @@ MODULE moduleMeshOutputGmsh2
DO c = 1, interactionMatrix(k)%amount DO c = 1, interactionMatrix(k)%amount
WRITE(cString, "(I2)") c WRITE(cString, "(I2)") c
title = '"Pair ' // interactionMatrix(k)%sp_i%name // '-' // interactionMatrix(k)%sp_j%name // ' collision ' // cString title = '"Pair ' // interactionMatrix(k)%sp_i%name // '-' // interactionMatrix(k)%sp_j%name // ' collision ' // cString
CALL writeGmsh2HeaderElementData(60, title, t, time, 1, self%numVols) CALL writeGmsh2HeaderElementData(60, title, t, time, 1, self%numCells)
DO n=1, self%numVols DO n=1, self%numCells
WRITE(60, "(I6,I10)") n + numEdges, self%vols(n)%obj%tallyColl(k)%tally(c) WRITE(60, "(I6,I10)") n + numEdges, self%cells(n)%obj%tallyColl(k)%tally(c)
END DO END DO
CALL writeGmsh2FooterElementData(60) CALL writeGmsh2FooterElementData(60)
@ -211,9 +211,9 @@ MODULE moduleMeshOutputGmsh2
REAL(8):: time REAL(8):: time
CHARACTER(:), ALLOCATABLE:: fileName CHARACTER(:), ALLOCATABLE:: fileName
CHARACTER (LEN=iterationDigits):: tstring 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 IF (emOutput) THEN
time = DBLE(t)*tauMin*ti_ref time = DBLE(t)*tauMin*ti_ref
@ -231,9 +231,9 @@ MODULE moduleMeshOutputGmsh2
END DO END DO
CALL writeGmsh2FooterNodeData(20) CALL writeGmsh2FooterNodeData(20)
CALL writeGmsh2HeaderElementData(20, 'Electric Field (V m^-1)', t, time, 3, self%numVols) CALL writeGmsh2HeaderElementData(20, 'Electric Field (V m^-1)', t, time, 3, self%numCells)
DO e=1, self%numVols DO e=1, self%numCells
WRITE(20, *) e+self%numEdges, self%vols(e)%obj%gatherEF(xi)*EF_ref WRITE(20, *) e+self%numEdges, self%cells(e)%obj%gatherElectricField(Xi)*EF_ref
END DO END DO
CALL writeGmsh2FooterElementData(20) CALL writeGmsh2FooterElementData(20)

View file

@ -66,10 +66,10 @@ MODULE moduleMesh
!Parent of Edge element !Parent of Edge element
TYPE, PUBLIC, ABSTRACT, EXTENDS(meshElement):: meshEdge TYPE, PUBLIC, ABSTRACT, EXTENDS(meshElement):: meshEdge
!Connectivity to vols !Connectivity to cells
CLASS(meshVol), POINTER:: e1 => NULL(), e2 => NULL() CLASS(meshCell), POINTER:: e1 => NULL(), e2 => NULL()
!Connectivity to vols in meshColl !Connectivity to cells in meshColl
CLASS(meshVol), POINTER:: eColl => NULL() CLASS(meshCell), POINTER:: eColl => NULL()
!Normal vector !Normal vector
REAL(8):: normal(1:3) REAL(8):: normal(1:3)
!Weight for random injection of particles !Weight for random injection of particles
@ -146,8 +146,10 @@ MODULE moduleMesh
END TYPE meshEdgeCont END TYPE meshEdgeCont
!Parent of Volume element !Parent of cell element
TYPE, PUBLIC, ABSTRACT, EXTENDS(meshElement):: meshVol TYPE, PUBLIC, ABSTRACT, EXTENDS(meshElement):: meshCell
!Number of nodes in the cell
INTEGER:: nNodes
!Maximum collision rate !Maximum collision rate
REAL(8), ALLOCATABLE:: sigmaVrelMax(:) REAL(8), ALLOCATABLE:: sigmaVrelMax(:)
!Arrays for counting number of collisions !Arrays for counting number of collisions
@ -161,114 +163,152 @@ MODULE moduleMesh
!Total weight of particles inside cell !Total weight of particles inside cell
REAL(8), ALLOCATABLE:: totalWeight(:) REAL(8), ALLOCATABLE:: totalWeight(:)
CONTAINS CONTAINS
PROCEDURE(initVol_interface), DEFERRED, PASS:: init !Init the cell
PROCEDURE(initCell_interface), DEFERRED, PASS:: init
!Get the index of the nodes
PROCEDURE(getNodesVol_interface), DEFERRED, PASS:: getNodes PROCEDURE(getNodesVol_interface), DEFERRED, PASS:: getNodes
!Calculate random position on the cell
PROCEDURE(randPosVol_interface), DEFERRED, PASS:: randPos PROCEDURE(randPosVol_interface), DEFERRED, PASS:: randPos
PROCEDURE(fPsi_interface), DEFERRED, NOPASS:: fPsi !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 PROCEDURE, PASS:: scatter
PROCEDURE(gatherEF_interface), DEFERRED, PASS:: gatherEF !Gather value and spatial derivative on the nodes at position Xi
PROCEDURE(gatherMF_interface), DEFERRED, PASS:: gatherMF 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(elemK_interface), DEFERRED, PASS:: elemK
PROCEDURE(elemF_interface), DEFERRED, PASS:: elemF PROCEDURE(elemF_interface), DEFERRED, PASS:: elemF
!Subroutines to find in which cell a particle is located
PROCEDURE, PASS:: findCell PROCEDURE, PASS:: findCell
PROCEDURE(phy2log_interface), DEFERRED, PASS:: phy2log
PROCEDURE(inside_interface), DEFERRED, NOPASS:: inside PROCEDURE(inside_interface), DEFERRED, NOPASS:: inside
PROCEDURE(nextElement_interface), DEFERRED, PASS:: nextElement 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 ABSTRACT INTERFACE
SUBROUTINE initVol_interface(self, n, p, nodes) SUBROUTINE initCell_interface(self, n, p, nodes)
IMPORT:: meshVol IMPORT:: meshCell
IMPORT meshNodeCont IMPORT meshNodeCont
CLASS(meshVol), INTENT(out):: self CLASS(meshCell), INTENT(out):: self
INTEGER, INTENT(in):: n INTEGER, INTENT(in):: n
INTEGER, INTENT(in):: p(:) INTEGER, INTENT(in):: p(:)
TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:) TYPE(meshNodeCont), INTENT(in), TARGET:: nodes(:)
END SUBROUTINE initVol_interface END SUBROUTINE initCell_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
PURE FUNCTION getNodesVol_interface(self) RESULT(n) PURE FUNCTION getNodesVol_interface(self) RESULT(n)
IMPORT:: meshVol IMPORT:: meshCell
CLASS(meshVol), INTENT(in):: self CLASS(meshCell), INTENT(in):: self
INTEGER, ALLOCATABLE:: n(:) INTEGER:: n(1:self%nNodes)
END FUNCTION getNodesVol_interface END FUNCTION getNodesVol_interface
PURE SUBROUTINE fPsi_interface(xi, fPsi) PURE FUNCTION fPsi_interface(self, Xi) RESULT(fPsi)
REAL(8), INTENT(in):: xi(1:3) IMPORT:: meshCell
REAL(8), INTENT(out):: fPsi(:) 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) PURE FUNCTION elemK_interface(self) RESULT(localK)
IMPORT:: meshVol IMPORT:: meshCell
CLASS(meshVol), INTENT(in):: self CLASS(meshCell), INTENT(in):: self
REAL(8), ALLOCATABLE:: localK(:,:) REAL(8):: localK(1:self%nNodes,1:self%nNodes)
END FUNCTION elemK_interface END FUNCTION elemK_interface
PURE FUNCTION elemF_interface(self, source) RESULT(localF) PURE FUNCTION elemF_interface(self, source) RESULT(localF)
IMPORT:: meshVol IMPORT:: meshCell
CLASS(meshVol), INTENT(in):: self CLASS(meshCell), INTENT(in):: self
REAL(8), INTENT(in):: source(1:) REAL(8), INTENT(in):: source(1:self%nNodes)
REAL(8), ALLOCATABLE:: localF(:) REAL(8):: localF(1:self%nNodes)
END FUNCTION elemF_interface END FUNCTION elemF_interface
SUBROUTINE nextElement_interface(self, xi, nextElement) SUBROUTINE nextElement_interface(self, Xi, nextElement)
IMPORT:: meshVol, meshElement IMPORT:: meshCell, meshElement
CLASS(meshVol), INTENT(in):: self CLASS(meshCell), INTENT(in):: self
REAL(8), INTENT(in):: xi(1:3) REAL(8), INTENT(in):: Xi(1:3)
CLASS(meshElement), POINTER, INTENT(out):: nextElement CLASS(meshElement), POINTER, INTENT(out):: nextElement
END SUBROUTINE nextElement_interface END SUBROUTINE nextElement_interface
PURE FUNCTION phy2log_interface(self,r) RESULT(xN) PURE FUNCTION phy2log_interface(self,r) RESULT(Xi)
IMPORT:: meshVol IMPORT:: meshCell
CLASS(meshVol), INTENT(in):: self CLASS(meshCell), INTENT(in):: self
REAL(8), INTENT(in):: r(1:3) REAL(8), INTENT(in):: r(1:3)
REAL(8):: xN(1:3) REAL(8):: Xi(1:3)
END FUNCTION phy2log_interface END FUNCTION phy2log_interface
PURE FUNCTION inside_interface(xi) RESULT(ins) PURE FUNCTION inside_interface(Xi) RESULT(ins)
IMPORT:: meshVol IMPORT:: meshCell
REAL(8), INTENT(in):: xi(1:3) REAL(8), INTENT(in):: Xi(1:3)
LOGICAL:: ins LOGICAL:: ins
END FUNCTION inside_interface END FUNCTION inside_interface
FUNCTION randPosVol_interface(self) RESULT(r) FUNCTION randPosVol_interface(self) RESULT(r)
IMPORT:: meshVol IMPORT:: meshCell
CLASS(meshVol), INTENT(in):: self CLASS(meshCell), INTENT(in):: self
REAL(8):: r(1:3) REAL(8):: r(1:3)
END FUNCTION randPosVol_interface END FUNCTION randPosVol_interface
END INTERFACE END INTERFACE
!Containers for volumes in the mesh !Containers for cells in the mesh
TYPE:: meshVolCont TYPE:: meshCellCont
CLASS(meshVol), ALLOCATABLE:: obj CLASS(meshCell), ALLOCATABLE:: obj
END TYPE meshVolCont END TYPE meshCellCont
!Generic mesh type !Generic mesh type
TYPE, ABSTRACT:: meshGeneric TYPE, ABSTRACT:: meshGeneric
@ -277,11 +317,11 @@ MODULE moduleMesh
!Geometry of the mesh !Geometry of the mesh
CHARACTER(:), ALLOCATABLE:: geometry CHARACTER(:), ALLOCATABLE:: geometry
!Number of elements !Number of elements
INTEGER:: numNodes, numVols INTEGER:: numNodes, numCells
!Array of nodes !Array of nodes
TYPE(meshNodeCont), ALLOCATABLE:: nodes(:) TYPE(meshNodeCont), ALLOCATABLE:: nodes(:)
!Array of volume elements !Array of cell elements
TYPE(meshVolCont), ALLOCATABLE:: vols(:) TYPE(meshCellCont), ALLOCATABLE:: cells(:)
PROCEDURE(readMesh_interface), POINTER, PASS:: readMesh => NULL() PROCEDURE(readMesh_interface), POINTER, PASS:: readMesh => NULL()
PROCEDURE(readInitial_interface), POINTER, NOPASS:: readInitial => NULL() PROCEDURE(readInitial_interface), POINTER, NOPASS:: readInitial => NULL()
PROCEDURE(connectMesh_interface), POINTER, PASS:: connectMesh => NULL() PROCEDURE(connectMesh_interface), POINTER, PASS:: connectMesh => NULL()
@ -310,7 +350,7 @@ MODULE moduleMesh
END SUBROUTINE readInitial_interface END SUBROUTINE readInitial_interface
!Connects volume and edges to the mesh !Connects cell and edges to the mesh
SUBROUTINE connectMesh_interface(self) SUBROUTINE connectMesh_interface(self)
IMPORT meshGeneric IMPORT meshGeneric
@ -318,7 +358,7 @@ MODULE moduleMesh
END SUBROUTINE connectMesh_interface END SUBROUTINE connectMesh_interface
!Prints number of collisions in each volume !Prints number of collisions in each cell
SUBROUTINE printColl_interface(self, t) SUBROUTINE printColl_interface(self, t)
IMPORT meshGeneric IMPORT meshGeneric
@ -416,7 +456,7 @@ MODULE moduleMesh
!Pointer to mesh used for MC collisions !Pointer to mesh used for MC collisions
CLASS(meshGeneric), POINTER:: meshForMCC => NULL() 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() PROCEDURE(findCellColl_interface), POINTER:: findCellColl => NULL()
ABSTRACT INTERFACE ABSTRACT INTERFACE
@ -445,9 +485,9 @@ MODULE moduleMesh
REAL(8), ALLOCATABLE:: localK(:,:) REAL(8), ALLOCATABLE:: localK(:,:)
INTEGER:: nNodes, i, j INTEGER:: nNodes, i, j
DO e = 1, self%numVols DO e = 1, self%numCells
n = self%vols(e)%obj%getNodes() n = self%cells(e)%obj%getNodes()
localK = self%vols(e)%obj%elemK() localK = self%cells(e)%obj%elemK()
nNodes = SIZE(n) nNodes = SIZE(n)
DO i = 1, nNodes DO i = 1, nNodes
@ -480,33 +520,84 @@ MODULE moduleMesh
END SUBROUTINE resetOutput 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) SUBROUTINE scatter(self, part)
USE moduleMath USE moduleMath
USE moduleSpecies USE moduleSpecies
USE OMP_LIB USE OMP_LIB
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol), INTENT(inout):: self CLASS(meshCell), INTENT(inout):: self
CLASS(particle), INTENT(in):: part CLASS(particle), INTENT(in):: part
REAL(8), ALLOCATABLE:: fPsi(:) REAL(8):: fPsi(1:self%nNodes)
INTEGER, ALLOCATABLE:: volNodes(:) INTEGER:: cellNodes(1:self%nNodes)
REAL(8):: tensorS(1:3, 1:3) REAL(8):: tensorS(1:3, 1:3)
INTEGER:: sp INTEGER:: sp
INTEGER:: i, nNodes INTEGER:: i
CLASS(meshNode), POINTER:: node CLASS(meshNode), POINTER:: node
volNodes = self%getNodes() cellNodes = self%getNodes()
nNodes = SIZE(volNodes) fPsi = self%fPsi(part%Xi)
ALLOCATE(fPsi(1:nNodes))
CALL self%fPsi(part%xi, fPsi)
tensorS = outerProduct(part%v, part%v) tensorS = outerProduct(part%v, part%v)
sp = part%species%n sp = part%species%n
DO i = 1, nNodes DO i = 1, self%nNodes
node => mesh%nodes(volNodes(i))%obj node => mesh%nodes(cellNodes(i))%obj
CALL OMP_SET_LOCK(node%lock) CALL OMP_SET_LOCK(node%lock)
node%output(sp)%den = node%output(sp)%den + part%weight*fPsi(i) 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(:) node%output(sp)%mom(:) = node%output(sp)%mom(:) + part%weight*fPsi(i)*part%v(:)
@ -524,18 +615,18 @@ MODULE moduleMesh
USE OMP_LIB USE OMP_LIB
IMPLICIT NONE IMPLICIT NONE
CLASS(meshVol), INTENT(inout):: self CLASS(meshCell), INTENT(inout):: self
CLASS(particle), INTENT(inout), TARGET:: part CLASS(particle), INTENT(inout), TARGET:: part
CLASS(meshVol), OPTIONAL, INTENT(in):: oldCell CLASS(meshCell), OPTIONAL, INTENT(in):: oldCell
REAL(8):: xi(1:3) REAL(8):: Xi(1:3)
CLASS(meshElement), POINTER:: nextElement CLASS(meshElement), POINTER:: nextElement
INTEGER:: sp INTEGER:: sp
xi = self%phy2log(part%r) Xi = self%phy2log(part%r)
!Checks if particle is inside 'self' cell !Checks if particle is inside 'self' cell
IF (self%inside(xi)) THEN IF (self%inside(Xi)) THEN
part%vol = self%n part%vol = self%n
part%xi = xi part%Xi = Xi
part%n_in = .TRUE. part%n_in = .TRUE.
!Assign particle to listPart_in !Assign particle to listPart_in
CALL OMP_SET_LOCK(self%lock) CALL OMP_SET_LOCK(self%lock)
@ -546,10 +637,10 @@ MODULE moduleMesh
ELSE ELSE
!If not, searches for a neighbour and repeats the process. !If not, searches for a neighbour and repeats the process.
CALL self%nextElement(xi, nextElement) CALL self%nextElement(Xi, nextElement)
!Defines the next step !Defines the next step
SELECT TYPE(nextElement) SELECT TYPE(nextElement)
CLASS IS(meshVol) CLASS IS(meshCell)
!Particle moved to new cell, repeat find procedure !Particle moved to new cell, repeat find procedure
CALL nextElement%findCell(part, self) CALL nextElement%findCell(part, self)
@ -598,31 +689,31 @@ MODULE moduleMesh
TYPE(particle), INTENT(inout):: part TYPE(particle), INTENT(inout):: part
LOGICAL:: found LOGICAL:: found
CLASS(meshVol), POINTER:: vol CLASS(meshCell), POINTER:: cell
REAL(8), DIMENSION(1:3):: xii REAL(8), DIMENSION(1:3):: Xi
CLASS(meshElement), POINTER:: nextElement CLASS(meshElement), POINTER:: nextElement
INTEGER:: sp INTEGER:: sp
found = .FALSE. found = .FALSE.
vol => meshColl%vols(part%volColl)%obj cell => meshColl%cells(part%volColl)%obj
DO WHILE(.NOT. found) DO WHILE(.NOT. found)
xii = vol%phy2log(part%r) Xi = cell%phy2log(part%r)
IF (vol%inside(xii)) THEN IF (cell%inside(Xi)) THEN
part%volColl = vol%n part%volColl = cell%n
CALL OMP_SET_LOCK(vol%lock) CALL OMP_SET_LOCK(cell%lock)
sp = part%species%n sp = part%species%n
CALL vol%listPart_in(sp)%add(part) CALL cell%listPart_in(sp)%add(part)
vol%totalWeight(sp) = vol%totalWeight(sp) + part%weight cell%totalWeight(sp) = cell%totalWeight(sp) + part%weight
CALL OMP_UNSET_LOCK(vol%lock) CALL OMP_UNSET_LOCK(cell%lock)
found = .TRUE. found = .TRUE.
ELSE ELSE
CALL vol%nextElement(xii, nextElement) CALL cell%nextElement(Xi, nextElement)
SELECT TYPE(nextElement) SELECT TYPE(nextElement)
CLASS IS(meshVol) CLASS IS(meshCell)
!Try next element !Try next element
vol => nextElement cell => nextElement
CLASS DEFAULT CLASS DEFAULT
!Should never happend, but just in case, stops loops !Should never happend, but just in case, stops loops
@ -647,15 +738,15 @@ MODULE moduleMesh
REAL(8), DIMENSION(1:3), INTENT(in):: r REAL(8), DIMENSION(1:3), INTENT(in):: r
INTEGER:: nVol INTEGER:: nVol
INTEGER:: e INTEGER:: e
REAL(8), DIMENSION(1:3):: xii REAL(8), DIMENSION(1:3):: Xi
!Inits RESULT !Inits RESULT
nVol = 0 nVol = 0
DO e = 1, self%numVols DO e = 1, self%numCells
xii = self%vols(e)%obj%phy2log(r) Xi = self%cells(e)%obj%phy2log(r)
IF(self%vols(e)%obj%inside(xii)) THEN IF(self%cells(e)%obj%inside(Xi)) THEN
nVol = self%vols(e)%obj%n nVol = self%cells(e)%obj%n
EXIT EXIT
END IF END IF
@ -678,7 +769,7 @@ MODULE moduleMesh
CLASS(meshGeneric), INTENT(inout), TARGET:: self CLASS(meshGeneric), INTENT(inout), TARGET:: self
INTEGER, INTENT(in):: t INTEGER, INTENT(in):: t
INTEGER:: e INTEGER:: e
CLASS(meshVol), POINTER:: vol CLASS(meshCell), POINTER:: cell
INTEGER:: k, i, j INTEGER:: k, i, j
INTEGER:: nPart_i, nPart_j, nPart!Number of particles inside the cell INTEGER:: nPart_i, nPart_j, nPart!Number of particles inside the cell
REAL(8):: pMax !Maximum probability of collision REAL(8):: pMax !Maximum probability of collision
@ -689,21 +780,22 @@ MODULE moduleMesh
REAL(8):: vRel, rMass, eRel REAL(8):: vRel, rMass, eRel
REAL(8):: sigmaVrelTotal REAL(8):: sigmaVrelTotal
REAL(8), ALLOCATABLE:: sigmaVrel(:), probabilityColl(:) 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 IF (MOD(t, everyColl) == 0) THEN
!Collisions need to be performed in this iteration !Collisions need to be performed in this iteration
!$OMP DO SCHEDULE(DYNAMIC) PRIVATE(part_i, part_j, partTemp_i, partTemp_j) !$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 !TODO: Simplify this, to many sublevels
!Iterate over the number of pairs !Iterate over the number of pairs
DO k = 1, nCollPairs DO k = 1, nCollPairs
!Reset tally of collisions !Reset tally of collisions
IF (collOutput) THEN IF (collOutput) THEN
vol%tallyColl(k)%tally = 0 cell%tallyColl(k)%tally = 0
END IF END IF
@ -713,8 +805,8 @@ MODULE moduleMesh
j = interactionMatrix(k)%sp_j%n j = interactionMatrix(k)%sp_j%n
!Number of particles per species in the collision pair !Number of particles per species in the collision pair
nPart_i = vol%listPart_in(i)%amount nPart_i = cell%listPart_in(i)%amount
nPart_j = vol%listPart_in(j)%amount nPart_j = cell%listPart_in(j)%amount
IF (nPart_i > 0 .AND. nPart_j > 0) THEN IF (nPart_i > 0 .AND. nPart_j > 0) THEN
!Total number of particles for the collision pair !Total number of particles for the collision pair
@ -724,15 +816,15 @@ MODULE moduleMesh
nColl = 0 nColl = 0
!Probability of collision for pair i-j !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 !Number of collisions in the cell
nColl = NINT(REAL(nPart)*pMax*0.5D0) nColl = NINT(REAL(nPart)*pMax*0.5D0)
!Converts the list of particles to an array for easy access !Converts the list of particles to an array for easy access
IF (nColl > 0) THEN IF (nColl > 0) THEN
partTemp_i = vol%listPart_in(i)%convert2Array() partTemp_i = cell%listPart_in(i)%convert2Array()
partTemp_j = vol%listPart_in(j)%convert2Array() partTemp_j = cell%listPart_in(j)%convert2Array()
END IF END IF
@ -740,10 +832,10 @@ MODULE moduleMesh
!Select random particles !Select random particles
part_i => NULL() part_i => NULL()
part_j => NULL() part_j => NULL()
rnd = random(1, nPart_i) rnd_int = random(1, nPart_i)
part_i => partTemp_i(rnd)%part part_i => partTemp_i(rnd_int)%part
rnd = random(1, nPart_j) rnd_int = random(1, nPart_j)
part_j => partTemp_j(rnd)%part part_j => partTemp_j(rnd_int)%part
!If they are the same particle, skip !If they are the same particle, skip
!TODO: Maybe try to improve this !TODO: Maybe try to improve this
IF (ASSOCIATED(part_i, part_j)) THEN IF (ASSOCIATED(part_i, part_j)) THEN
@ -767,32 +859,32 @@ MODULE moduleMesh
CALL interactionMatrix(k)%getSigmaVrel(vRel, eRel, sigmaVrelTotal, sigmaVrel) CALL interactionMatrix(k)%getSigmaVrel(vRel, eRel, sigmaVrelTotal, sigmaVrel)
!Update maximum sigma*v_rel !Update maximum sigma*v_rel
IF (sigmaVrelTotal > vol%sigmaVrelMax(k)) THEN IF (sigmaVrelTotal > cell%sigmaVrelMax(k)) THEN
vol%sigmaVrelMax(k) = sigmaVrelTotal cell%sigmaVrelMax(k) = sigmaVrelTotal
END IF END IF
ALLOCATE(probabilityColl(0:interactionMatrix(k)%amount)) ALLOCATE(probabilityColl(0:interactionMatrix(k)%amount))
probabilityColl = 0.0 probabilityColl = 0.0
DO c = 1, interactionMatrix(k)%amount 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 END DO
!Selects random number between 0 and 1 !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 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 !Loop over collisions
DO c = 1, interactionMatrix(k)%amount 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) CALL interactionMatrix(k)%collisions(c)%obj%collide(part_i, part_j, vRel)
!If collisions are gonna be output, count the collision !If collisions are gonna be output, count the collision
IF (collOutput) THEN 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 END IF

View file

@ -1,4 +1,4 @@
!moduleMeshBoundary: Boundary functions !moduleMeshBoundary: Boundary functions for the mesh edges
MODULE moduleMeshBoundary MODULE moduleMeshBoundary
USE moduleMesh USE moduleMesh
@ -159,7 +159,7 @@ MODULE moduleMeshBoundary
newElectron%vol = part%vol newElectron%vol = part%vol
newIon%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 newIon%xi = newElectron%xi
newElectron%weight = part%weight newElectron%weight = part%weight

View file

@ -439,7 +439,6 @@ MODULE moduleCollisions
REAL(8), INTENT(in):: vRel REAL(8), INTENT(in):: vRel
TYPE(particle), INTENT(inout), TARGET:: part_i, part_j TYPE(particle), INTENT(inout), TARGET:: part_i, part_j
TYPE(particle), POINTER:: electron => NULL(), ion => NULL() TYPE(particle), POINTER:: electron => NULL(), ion => NULL()
REAL(8):: sigmaVrel
REAL(8), DIMENSION(1:3):: vp_i REAL(8), DIMENSION(1:3):: vp_i
TYPE(particle), POINTER:: remainingIon => NULL() TYPE(particle), POINTER:: remainingIon => NULL()

View file

@ -132,7 +132,7 @@ MODULE moduleInject
IF (doubleMesh) THEN IF (doubleMesh) THEN
nVolColl = findCellBrute(meshColl, mesh%edges(e)%obj%randPos()) nVolColl = findCellBrute(meshColl, mesh%edges(e)%obj%randPos())
IF (nVolColl > 0) THEN IF (nVolColl > 0) THEN
mesh%edges(e)%obj%eColl => meshColl%vols(nVolColl)%obj mesh%edges(e)%obj%eColl => meshColl%cells(nVolColl)%obj
ELSE ELSE
CALL criticalError("No connection between edge and meshColl", "initInject") CALL criticalError("No connection between edge and meshColl", "initInject")
@ -305,7 +305,7 @@ MODULE moduleInject
self%v(3)%obj%randomVel() /) self%v(3)%obj%randomVel() /)
!Obtain natural coordinates of particle in cell !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 !Push new particle with the minimum time step
CALL solver%pusher(sp)%pushParticle(partInj(n), tau(sp)) CALL solver%pusher(sp)%pushParticle(partInj(n), tau(sp))
!Assign cell to new particle !Assign cell to new particle

View file

@ -46,40 +46,6 @@ MODULE moduleEM
END SUBROUTINE 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 !Assemble the source vector based on the charge density to solve Poisson's equation
SUBROUTINE assembleSourceVector(vectorF) SUBROUTINE assembleSourceVector(vectorF)
USE moduleMesh USE moduleMesh
@ -99,8 +65,8 @@ MODULE moduleEM
!$OMP END SINGLE !$OMP END SINGLE
!$OMP DO REDUCTION(+:vectorF) !$OMP DO REDUCTION(+:vectorF)
DO e = 1, mesh%numVols DO e = 1, mesh%numCells
nodes = mesh%vols(e)%obj%getNodes() nodes = mesh%cells(e)%obj%getNodes()
nNodes = SIZE(nodes) nNodes = SIZE(nodes)
!Calculates charge density (rho) in element nodes !Calculates charge density (rho) in element nodes
ALLOCATE(rho(1:nNodes)) ALLOCATE(rho(1:nNodes))
@ -113,7 +79,7 @@ MODULE moduleEM
END DO END DO
!Calculates local F vector !Calculates local F vector
localF = mesh%vols(e)%obj%elemF(rho) localF = mesh%cells(e)%obj%elemF(rho)
!Assign local F to global F !Assign local F to global F
DO i = 1, nNodes DO i = 1, nNodes

View file

@ -49,8 +49,8 @@ MODULE moduleSolver
IMPLICIT NONE IMPLICIT NONE
TYPE(particle), INTENT(inout):: part TYPE(particle), INTENT(inout):: part
CLASS(meshVol), POINTER, INTENT(in):: volOld CLASS(meshCell), POINTER, INTENT(in):: volOld
CLASS(meshVol), POINTER, INTENT(inout):: volNew CLASS(meshCell), POINTER, INTENT(inout):: volNew
END SUBROUTINE weightingScheme_interface END SUBROUTINE weightingScheme_interface
@ -314,10 +314,10 @@ MODULE moduleSolver
!$OMP SECTION !$OMP SECTION
!Erase the list of particles inside the cell if particles have been pushed !Erase the list of particles inside the cell if particles have been pushed
DO s = 1, nSpecies DO s = 1, nSpecies
DO e = 1, mesh%numVols DO e = 1, mesh%numCells
IF (solver%pusher(s)%pushSpecies) THEN IF (solver%pusher(s)%pushSpecies) THEN
CALL mesh%vols(e)%obj%listPart_in(s)%erase() CALL mesh%cells(e)%obj%listPart_in(s)%erase()
mesh%vols(e)%obj%totalWeight(s) = 0.D0 mesh%cells(e)%obj%totalWeight(s) = 0.D0
END IF END IF
@ -328,10 +328,10 @@ MODULE moduleSolver
!$OMP SECTION !$OMP SECTION
!Erase the list of particles inside the cell in coll mesh !Erase the list of particles inside the cell in coll mesh
DO s = 1, nSpecies DO s = 1, nSpecies
DO e = 1, meshColl%numVols DO e = 1, meshColl%numCells
IF (solver%pusher(s)%pushSpecies) THEN IF (solver%pusher(s)%pushSpecies) THEN
CALL meshColl%vols(e)%obj%listPart_in(s)%erase() CALL meshColl%cells(e)%obj%listPart_in(s)%erase()
meshColl%vols(e)%obj%totalWeight(s) = 0.D0 meshColl%cells(e)%obj%totalWeight(s) = 0.D0
END IF END IF
@ -358,7 +358,7 @@ MODULE moduleSolver
!Loops over the particles to scatter them !Loops over the particles to scatter them
!$OMP DO !$OMP DO
DO n = 1, nPartOld 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 END DO
!$OMP END DO !$OMP END DO
@ -383,8 +383,8 @@ MODULE moduleSolver
IMPLICIT NONE IMPLICIT NONE
TYPE(particle), INTENT(inout):: part TYPE(particle), INTENT(inout):: part
CLASS(meshVol), POINTER, INTENT(in):: volOld CLASS(meshCell), POINTER, INTENT(in):: volOld
CLASS(meshVol), POINTER, INTENT(inout):: volNew CLASS(meshCell), POINTER, INTENT(inout):: volNew
REAL(8):: fractionVolume, pSplit REAL(8):: fractionVolume, pSplit
!If particle changes volume to smaller cell !If particle changes volume to smaller cell
@ -416,7 +416,7 @@ MODULE moduleSolver
TYPE(particle), INTENT(inout):: part TYPE(particle), INTENT(inout):: part
INTEGER, INTENT(in):: nSplit INTEGER, INTENT(in):: nSplit
CLASS(meshVol), INTENT(inout):: vol CLASS(meshCell), INTENT(inout):: vol
REAL(8):: newWeight REAL(8):: newWeight
TYPE(particle), POINTER:: newPart TYPE(particle), POINTER:: newPart
INTEGER:: p INTEGER:: p
@ -454,15 +454,15 @@ MODULE moduleSolver
CLASS(solverGeneric), INTENT(in):: self CLASS(solverGeneric), INTENT(in):: self
TYPE(particle), INTENT(inout):: part TYPE(particle), INTENT(inout):: part
CLASS(meshVol), POINTER:: volOld, volNew CLASS(meshCell), POINTER:: volOld, volNew
!Assume that particle is outside the domain !Assume that particle is outside the domain
part%n_in = .FALSE. part%n_in = .FALSE.
volOld => mesh%vols(part%vol)%obj volOld => mesh%cells(part%vol)%obj
CALL volOld%findCell(part) CALL volOld%findCell(part)
CALL findCellColl(part) CALL findCellColl(part)
volNew => mesh%vols(part%vol)%obj volNew => mesh%cells(part%vol)%obj
!Call the NA shcme !Call the NA shcme
IF (ASSOCIATED(self%weightingScheme)) THEN IF (ASSOCIATED(self%weightingScheme)) THEN
CALL self%weightingScheme(part, volOld, volNew) CALL self%weightingScheme(part, volOld, volNew)

View file

@ -15,7 +15,7 @@ MODULE modulePusher
PURE SUBROUTINE pushCartElectrostatic(part, tauIn) PURE SUBROUTINE pushCartElectrostatic(part, tauIn)
USE moduleSPecies USE moduleSPecies
USE moduleEM USE moduleMesh
IMPLICIT NONE IMPLICIT NONE
TYPE(particle), INTENT(inout):: part TYPE(particle), INTENT(inout):: part
@ -23,7 +23,8 @@ MODULE modulePusher
REAL(8):: qmEFt(1:3) REAL(8):: qmEFt(1:3)
!Get the electric field at particle position !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 !Update velocity
part%v = part%v + qmEFt part%v = part%v + qmEFt
@ -34,8 +35,8 @@ MODULE modulePusher
END SUBROUTINE pushCartElectrostatic END SUBROUTINE pushCartElectrostatic
PURE SUBROUTINE pushCartElectromagnetic(part, tauIn) PURE SUBROUTINE pushCartElectromagnetic(part, tauIn)
USE moduleSPecies USE moduleSpecies
USE moduleEM USE moduleMesh
USE moduleMath USE moduleMath
IMPLICIT NONE IMPLICIT NONE
@ -49,13 +50,14 @@ MODULE modulePusher
tauInHalf = tauIn *0.5D0 tauInHalf = tauIn *0.5D0
!Half of the force o f the electric field !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 !Half step for electrostatic
v_minus = part%v + qmEFt v_minus = part%v + qmEFt
!Full step rotation !Full step rotation
B = gatherMagnField(part) B = mesh%cells(part%vol)%obj%gatherMagneticField(part%Xi)
BNorm = NORM2(B) BNorm = NORM2(B)
IF (BNorm > 0.D0) THEN IF (BNorm > 0.D0) THEN
fn = DTAN(part%species%qm * tauInHalf*BNorm) / BNorm fn = DTAN(part%species%qm * tauInHalf*BNorm) / BNorm
@ -112,7 +114,7 @@ MODULE modulePusher
!Push one particle. Boris pusher for 2D Cyl Electrostatic particle !Push one particle. Boris pusher for 2D Cyl Electrostatic particle
PURE SUBROUTINE push2DCylElectrostatic(part, tauIn) PURE SUBROUTINE push2DCylElectrostatic(part, tauIn)
USE moduleSpecies USE moduleSpecies
USE moduleEM USE moduleMesh
IMPLICIT NONE IMPLICIT NONE
TYPE(particle), INTENT(inout):: part TYPE(particle), INTENT(inout):: part
@ -124,7 +126,8 @@ MODULE modulePusher
part_temp = part part_temp = part
!Get electric field at particle position !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 !z
part_temp%v(1) = part%v(1) + qmEFt(1) part_temp%v(1) = part%v(1) + qmEFt(1)
part_temp%r(1) = part%r(1) + part_temp%v(1)*tauIn 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 !Push one particle. Boris pusher for 1D Radial Neutral particle
PURE SUBROUTINE push1DRadNeutral(part, tauIn) PURE SUBROUTINE push1DRadNeutral(part, tauIn)
USE moduleSpecies USE moduleSpecies
USE moduleEM
IMPLICIT NONE IMPLICIT NONE
TYPE(particle), INTENT(inout):: part TYPE(particle), INTENT(inout):: part
@ -188,7 +190,7 @@ MODULE modulePusher
!Push one particle. Boris pusher for 1D Radial Electrostatic particle !Push one particle. Boris pusher for 1D Radial Electrostatic particle
PURE SUBROUTINE push1DRadElectrostatic(part, tauIn) PURE SUBROUTINE push1DRadElectrostatic(part, tauIn)
USE moduleSpecies USE moduleSpecies
USE moduleEM USE moduleMesh
IMPLICIT NONE IMPLICIT NONE
TYPE(particle), INTENT(inout):: part TYPE(particle), INTENT(inout):: part
@ -200,7 +202,8 @@ MODULE modulePusher
part_temp = part part_temp = part
!Get electric field at particle position !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 !r,theta
v_p_oh_star(1) = part%v(1) + qmEFt(1) v_p_oh_star(1) = part%v(1) + qmEFt(1)
x_new = part%r(1) + v_p_oh_star(1)*tauIn x_new = part%r(1) + v_p_oh_star(1)*tauIn
@ -226,7 +229,6 @@ MODULE modulePusher
!Dummy pusher for 0D geometry !Dummy pusher for 0D geometry
PURE SUBROUTINE push0D(part, tauIn) PURE SUBROUTINE push0D(part, tauIn)
USE moduleSpecies USE moduleSpecies
USE moduleEM
IMPLICIT NONE IMPLICIT NONE
TYPE(particle), INTENT(inout):: part TYPE(particle), INTENT(inout):: part