JGonzalez/fpakc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

First implementation of Non-Analogue Scheme using volume weighting. The

Browse source 
scheme to use is chosen in the input file. Additional schemes could be
added easily.
This commit is contained in:
Jorge Gonzalez 2020-12-03 08:57:34 +01:00
commit 7859a73274
8 changed files with 151 additions and 54 deletions
Download patch file Download diff file Expand all files Collapse all files

130
src/modules/moduleSolver.f95
View file

@ -40,10 +40,14 @@ MODULE moduleSolver
END SUBROUTINE solveEM_interface
!Apply nonAnalogue scheme to a particle
SUBROUTINE nonAnalogue_interface(part)
SUBROUTINE nonAnalogue_interface(part, volOld, volNew)
USE moduleSpecies
USE moduleMesh
IMPLICIT NONE
TYPE(particle), INTENT(inout):: part
CLASS(meshVol), POINTER, INTENT(in):: volOld
CLASS(meshVol), POINTER, INTENT(inout):: volNew
END SUBROUTINE nonAnalogue_interface
@ -97,12 +101,16 @@ MODULE moduleSolver
!Initialize the non-analogue scheme
SUBROUTINE initNA(self, NAType)
USE moduleMesh
IMPLICIT NONE
CLASS(solverGeneric), INTENT(inout):: self
CHARACTER(:), ALLOCATABLE:: NAType
SELECT CASE(NAType)
CASE ('Volume')
self%nonAnalogue => volumeNAScheme
CASE DEFAULT
self%nonAnalogue => noNAScheme
@ -170,8 +178,6 @@ MODULE moduleSolver
END IF
part_temp%v(2) = cos_alpha*v_p_oh_star(2)+sin_alpha*v_p_oh_star(3)
part_temp%v(3) = -sin_alpha*v_p_oh_star(2)+cos_alpha*v_p_oh_star(3)
part_temp%sp = part%sp
part_temp%vol = part%vol
part_temp%n_in = .FALSE. !Assume particle is outside until cell is found
!Copy temporal particle to particle
part=part_temp
@ -238,12 +244,14 @@ MODULE moduleSolver
SUBROUTINE doReset()
USE moduleSpecies
USE moduleList
IMPLICIT NONE
INTEGER:: nn, n
INTEGER, SAVE:: nPartNew
INTEGER, SAVE:: nInjIn, nOldIn
INTEGER, SAVE:: nInjIn, nOldIn, nNAScheme
TYPE(particle), ALLOCATABLE, SAVE:: partTemp(:)
TYPE(lNode), POINTER:: partCurr, partNext
!$OMP SECTIONS
!$OMP SECTION
@ -258,13 +266,15 @@ MODULE moduleSolver
nOldIn = COUNT(partOld%n_in)
END IF
!$OMP SECTION
nNAScheme = partNAScheme%amount
!$OMP END SECTIONS
!$OMP BARRIER
!$OMP SINGLE
CALL MOVE_ALLOC(partOld, partTemp)
nPartNew = nInjIn + nOldIn
nPartNew = nInjIn + nOldIn + nNAScheme
ALLOCATE(partOld(1:nPartNew))
!$OMP END SINGLE
@ -290,6 +300,20 @@ MODULE moduleSolver
END IF
END DO
!$OMP SECTION
nn = nInjIn + nOldIn
partCurr => partNAScheme%head
DO n = 1, nNAScheme
partNext => partCurr%next
partOld(nn+n) = partCurr%part
DEALLOCATE(partCurr)
partCurr => partNext
END DO
IF (ASSOCIATED(partNAScheme%head)) NULLIFY(partNAScheme%head)
IF (ASSOCIATED(partNAScheme%tail)) NULLIFY(partNAScheme%tail)
partNAScheme%amount = 0
!$OMP END SECTIONS
!$OMP SINGLE
@ -373,12 +397,88 @@ MODULE moduleSolver
END SUBROUTINE noEMField
!Empty procedure that does no computation of EM field for neutral cases
SUBROUTINE noNAScheme(part)
!Modify particle weight as a function of cell volume and splits particle
SUBROUTINE volumeNAScheme(part, volOld, volNew)
USE moduleSpecies
USE moduleMesh
IMPLICIT NONE
TYPE(particle), INTENT(inout):: part
CLASS(meshVol), POINTER, INTENT(in):: volOld
CLASS(meshVol), POINTER, INTENT(inout):: volNew
REAL(8):: fractionVolume, fractionWeight
INTEGER:: nSplit
!If particle has change cell, call nonAnalogue scheme
IF (volOld%n /= volNew%n) THEN
fractionVolume = volOld%volume/volNew%volume
part%weight = part%weight * fractionVolume
fractionWeight = part%weight / species(part%sp)%obj%weight
IF (fractionWeight >= 2.D0) THEN
nSplit = FLOOR(fractionWeight)
CALL splitParticle(part, nSplit, volNew)
ELSEIF (part%weight < 1.D0) THEN
!Particle has lost statistical meaning and will be terminated
part%n_in = .FALSE.
END IF
END IF
END SUBROUTINE volumeNAScheme
!Subroutine to split the particle 'part' into a number 'nSplit' of particles.
!'nSplit-1' particles are added to the partNAScheme list
SUBROUTINE splitParticle(part, nSplit, vol)
USE moduleSpecies
USE moduleList
USE moduleMesh
USE OMP_LIB
IMPLICIT NONE
TYPE(particle), INTENT(inout):: part
INTEGER, INTENT(in):: nSplit
CLASS(meshVol), INTENT(inout):: vol
REAL(8):: newWeight
TYPE(particle), POINTER:: newPart
INTEGER:: p
newWeight = part%weight / nSplit
!Assign new weight to original particle
part%weight = newWeight
!Add new particles to list of NA particles
DO p = 2, nSplit
!Allocate the pointer for the new particles
ALLOCATE(newPart)
!Copy data from original particle
newPart = part
CALL OMP_SET_LOCK(lockNAScheme)
CALL partNAScheme%add(newPart)
CALL OMP_UNSET_LOCK(lockNASCheme)
!Add particle to cell list
CALL OMP_SET_lock(vol%lock)
CALL vol%listPart_in%add(newPart)
CALL OMP_UNSET_lock(vol%lock)
END DO
END SUBROUTINE splitParticle
!Empty procedure that does no computation of EM field for neutral cases
SUBROUTINE noNAScheme(part, volOld, volNew)
USE moduleSpecies
USE moduleMesh
IMPLICIT NONE
TYPE(particle), INTENT(inout):: part
CLASS(meshVol), POINTER, INTENT(in):: volOld
CLASS(meshVol), POINTER, INTENT(inout):: volNew
END SUBROUTINE noNAScheme
@ -389,17 +489,13 @@ MODULE moduleSolver
CLASS(solverGeneric), INTENT(in):: self
TYPE(particle), INTENT(inout):: part
CLASS(meshVol), POINTER:: vol
INTEGER:: volOld !Old cell for particle
CLASS(meshVol), POINTER:: volOld, volNew
volOld = part%vol
vol => mesh%vols(volOld)%obj
CALL vol%findCell(part)
!If particle has change cell, call nonAnalogue scheme
IF (volOld /= part%vol) THEN
CALL self%nonAnalogue(part)
END IF
volOld => mesh%vols(part%vol)%obj
CALL volOld%findCell(part)
volNew => mesh%vols(part%vol)%obj
!Call the NA shcme
CALL self%nonAnalogue(part, volOld, volNew)
END SUBROUTINE updateParticleCell