From 81e114182a4d141a504c183139646d2683d908d6 Mon Sep 17 00:00:00 2001 From: hildf Date: Tue, 12 Apr 2022 16:33:48 +0200 Subject: [PATCH 01/41] alpha per species for energy conservation --- src/particles/bgk/bgk_colloperator.f90 | 52 ++++++++++++++++---------- 1 file changed, 32 insertions(+), 20 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 6efe8571c..113905ae9 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -75,12 +75,12 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES REAL :: vBulk(3), u0ij(3,3), u2, V_rel(3), dtCell -REAL :: alpha, CellTemp, dens, InnerDOF, NewEn, OldEn, Prandtl, relaxfreq, TEqui +REAL :: alpha, alphaRot(nSpecies), CellTemp, dens, InnerDOF, NewEn, OldEn, Prandtl, relaxfreq, TEqui INTEGER, ALLOCATABLE :: iPartIndx_NodeRelax(:),iPartIndx_NodeRelaxTemp(:),iPartIndx_NodeRelaxRot(:),iPartIndx_NodeRelaxVib(:) INTEGER :: iLoop, iPart, nRelax, iPolyatMole REAL, ALLOCATABLE :: Xi_vib_DOF(:), VibEnergyDOF(:,:) INTEGER :: iSpec, nSpec(nSpecies), jSpec, nRotRelax, nVibRelax -REAL :: OldEnRot, NewEnRot, NewEnVib +REAL :: OldEnRot, NewEnRot(nSpecies), NewEnVib(nSpecies) REAL :: TotalMass, u2Spec(nSpecies), u2i(3), vBulkAll(3) REAL :: SpecTemp(nSpecies) #ifdef CODE_ANALYZE @@ -249,10 +249,17 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) END DO ! 9.) Rotation: Scale the new rotational state of the molecules to ensure energy conservation -IF ( (nRotRelax.GT.0)) alpha = OldEn/NewEnRot*(Xi_RotTotal/(Xi_RotTotal+3.*(nPart-1.))) +DO iSpec = 1, nSpecies + IF (NewEnRot(iSpec).GT.0.0) THEN + alphaRot(iSpec) = OldEn/NewEnRot(iSpec)*(Xi_RotSpec(iSpec)*nRotRelaxSpec(iSpec)/(Xi_RotTotal+3.*(nPart-1.))) + ELSE + alphaRot(iSpec) = 0.0 + END IF +END DO DO iLoop = 1, nRotRelax iPart = iPartIndx_NodeRelaxRot(iLoop) - PartStateIntEn( 2,iPart) = alpha*PartStateIntEn( 2,iPart) + iSpec = PartSpecies(iPart) + PartStateIntEn( 2,iPart) = alphaRot(iSpec)*PartStateIntEn( 2,iPart) END DO ! CODE ANALYZE: Compare the old momentum and energy of the cell with the new, abort if relative difference is above the limits @@ -692,7 +699,7 @@ SUBROUTINE RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartI ! INPUT VARIABLES INTEGER, INTENT(IN) :: nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib(nVibRelax), iPartIndx_NodeRelaxRot(nRotRelax) REAL, INTENT(IN) :: Xi_vib_DOF(:), TEqui, Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies) -REAL, INTENT(INOUT) :: NewEnVib, NewEnRot +REAL, INTENT(INOUT) :: NewEnVib(nSpecies), NewEnRot(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES REAL, INTENT(OUT) :: VibEnergyDOF(:,:) @@ -720,7 +727,7 @@ SUBROUTINE RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartI CALL RANDOM_NUMBER(iRan) PartStateIntEn( 1,iPart) = -LOG(iRan)*Xi_VibSpec(iSpec)/2.*TEqui*BoltzmannConst END IF - NewEnVib = NewEnVib + PartStateIntEn(1,iPart) * partWeight + NewEnVib(iSpec) = NewEnVib(iSpec) + PartStateIntEn(1,iPart) * partWeight END DO END IF ! ROT Relaxation @@ -730,7 +737,7 @@ SUBROUTINE RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartI partWeight = GetParticleWeight(iPart) CALL RANDOM_NUMBER(iRan) PartStateIntEn( 2,iPart) = -Xi_RotSpec(iSpec) / 2. * BoltzmannConst*TEqui*LOG(iRan) - NewEnRot = NewEnRot + PartStateIntEn( 2,iPart) * partWeight + NewEnRot(iSpec) = NewEnRot(iSpec) + PartStateIntEn( 2,iPart) * partWeight END DO END SUBROUTINE RelaxInnerEnergy @@ -866,28 +873,38 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, nVibRelaxSpec, iPartIndx_NodeRelaxVib !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT VARIABLES INTEGER, INTENT(IN) :: nPart, nVibRelax, iPartIndx_NodeRelaxVib(:), nVibRelaxSpec(nSpecies) -REAL, INTENT(IN) :: NewEnVib, VibEnergyDOF(:,:), Xi_VibSpec(nSpecies), TEqui +REAL, INTENT(IN) :: NewEnVib(nSpecies), VibEnergyDOF(:,:), Xi_VibSpec(nSpecies), TEqui REAL, INTENT(INOUT) :: OldEn !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES INTEGER :: iPart, iLoop, iDOF, iSpec, iQuant, iQuaMax, iPolyatMole -REAL :: alpha, partWeight, betaV, iRan, MaxColQua, Xi_VibTotal +REAL :: alpha(nSpecies), partWeight, betaV, iRan, MaxColQua, Xi_VibTotal !=================================================================================================================================== IF(BGKDoVibRelaxation) THEN - IF ((NewEnVib.GT.0.0).AND.(nVibRelax.GT.0)) THEN + IF (ANY(NewEnVib.GT.0.0).AND.(nVibRelax.GT.0)) THEN + Xi_VibTotal = 0.0 + DO iSpec = 1, nSpecies + Xi_VibTotal = Xi_VibTotal + Xi_VibSpec(iSpec)*nVibRelaxSpec(iSpec) + END DO + DO iSpec = 1, nSpecies + IF (NewEnVib(iSpec).GT.0.0) THEN + alpha(iSpec) = OldEn/NewEnVib(iSpec)*(Xi_VibSpec(iSpec)*nVibRelaxSpec(iSpec)/(3.*(nPart-1.)+Xi_VibTotal)) + ELSE + alpha(iSpec) = 0. + END IF + END DO IF (BGKUseQuantVibEn) THEN - alpha = OldEn/NewEnVib*(Xi_VibSpec(1)*nVibRelax/(3.*(nPart-1.)+Xi_VibSpec(1)*nVibRelax)) DO iLoop = 1, nVibRelax iPart = iPartIndx_NodeRelaxVib(iLoop) partWeight = GetParticleWeight(iPart) iSpec = PartSpecies(iPart) - IF(SpecDSMC(iSpec)%PolyatomicMol) THEN + IF(SpecDSMC(iSpec)%PolyatomicMol) THEN ! TBC, noch nicht mit verschiedenen alpha pro Spezies PartStateIntEn(1,iPart) = 0.0 iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF - betaV = alpha*VibEnergyDOF(iLoop,iDOF)/(PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)*BoltzmannConst) + betaV = alpha(iSpec)*VibEnergyDOF(iLoop,iDOF)/(PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)*BoltzmannConst) CALL RANDOM_NUMBER(iRan) iQuant = INT(betaV+iRan) IF(iQuant.GT.PolyatomMolDSMC(iPolyatMole)%MaxVibQuantDOF(iDOF)) iQuant=PolyatomMolDSMC(iPolyatMole)%MaxVibQuantDOF(iDOF) @@ -913,7 +930,7 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, nVibRelaxSpec, iPartIndx_NodeRelaxVib PartStateIntEn( 1,iPart) = PartStateIntEn( 1,iPart) & + SpecDSMC(iSpec)%EZeroPoint ELSE ! Diatomic molecules - betaV = alpha*PartStateIntEn( 1,iPart)/(SpecDSMC(iSpec)%CharaTVib*BoltzmannConst) + betaV = alpha(iSpec)*PartStateIntEn( 1,iPart)/(SpecDSMC(iSpec)%CharaTVib*BoltzmannConst) CALL RANDOM_NUMBER(iRan) iQuant = INT(betaV+iRan) IF (iQuant.GT.SpecDSMC(iSpec)%MaxVibQuant) iQuant = SpecDSMC(iSpec)%MaxVibQuant @@ -937,16 +954,11 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, nVibRelaxSpec, iPartIndx_NodeRelaxVib END IF ! SpecDSMC(1)%PolyatomicMol END DO ELSE ! Continuous treatment of vibrational energy - Xi_VibTotal = 0.0 - DO iSpec = 1, nSpecies - Xi_VibTotal = Xi_VibTotal + Xi_VibSpec(iSpec)*nVibRelaxSpec(iSpec) - END DO - alpha = OldEn/NewEnVib*(Xi_VibTotal/(3.*(nPart-1.)+Xi_VibTotal)) DO iLoop = 1, nVibRelax iPart = iPartIndx_NodeRelaxVib(iLoop) iSpec = PartSpecies(iPart) partWeight = GetParticleWeight(iPart) - PartStateIntEn( 1,iPart) = alpha*PartStateIntEn( 1,iPart) + SpecDSMC(iSpec)%EZeroPoint + PartStateIntEn( 1,iPart) = alpha(iSpec)*PartStateIntEn( 1,iPart) + SpecDSMC(iSpec)%EZeroPoint OldEn = OldEn - (PartStateIntEn( 1,iPart) - SpecDSMC(iSpec)%EZeroPoint)*partWeight END DO END IF ! BGKUseQuantVibEn From ff70c8ec7f3b74b8183b6441cfe5c3a123d35ed2 Mon Sep 17 00:00:00 2001 From: hildf Date: Wed, 13 Apr 2022 10:57:31 +0200 Subject: [PATCH 02/41] enable multispec polyatomic for ESBGK --- src/particles/bgk/bgk_init.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/particles/bgk/bgk_init.f90 b/src/particles/bgk/bgk_init.f90 index a7bceb12b..2b266b41d 100644 --- a/src/particles/bgk/bgk_init.f90 +++ b/src/particles/bgk/bgk_init.f90 @@ -127,11 +127,11 @@ SUBROUTINE InitBGK() /(2.*(Species(iSpec)%MassIC * Species(iSpec2)%MassIC)))/CollInf%Tref(iSpec,iSpec2)**(-CollInf%omega(iSpec,iSpec2) +0.5) END DO END DO -IF ((nSpecies.GT.1).AND.(ANY(SpecDSMC(:)%PolyatomicMol))) THEN - CALL abort(& -__STAMP__& -,' ERROR Multispec not implemented with polyatomic molecules!') -END IF +!IF ((nSpecies.GT.1).AND.(ANY(SpecDSMC(:)%PolyatomicMol))) THEN +! CALL abort(& +!__STAMP__& +!,' ERROR Multispec not implemented with polyatomic molecules!') +!END IF BGKCollModel = GETINT('Particles-BGK-CollModel') IF ((nSpecies.GT.1).AND.(BGKCollModel.GT.1)) THEN From e0aa051a7f0eb985c8b82164c7442029b39c0be0 Mon Sep 17 00:00:00 2001 From: hildf Date: Wed, 13 Apr 2022 11:12:39 +0200 Subject: [PATCH 03/41] enable multispec quantised vibration --- src/particles/bgk/bgk_init.f90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/particles/bgk/bgk_init.f90 b/src/particles/bgk/bgk_init.f90 index 2b266b41d..28e080675 100644 --- a/src/particles/bgk/bgk_init.f90 +++ b/src/particles/bgk/bgk_init.f90 @@ -127,11 +127,11 @@ SUBROUTINE InitBGK() /(2.*(Species(iSpec)%MassIC * Species(iSpec2)%MassIC)))/CollInf%Tref(iSpec,iSpec2)**(-CollInf%omega(iSpec,iSpec2) +0.5) END DO END DO -!IF ((nSpecies.GT.1).AND.(ANY(SpecDSMC(:)%PolyatomicMol))) THEN -! CALL abort(& -!__STAMP__& -!,' ERROR Multispec not implemented with polyatomic molecules!') -!END IF +IF ((nSpecies.GT.1).AND.(ANY(SpecDSMC(:)%PolyatomicMol))) THEN + CALL abort(& +__STAMP__& +,' ERROR Multispec not implemented with polyatomic molecules!') +END IF BGKCollModel = GETINT('Particles-BGK-CollModel') IF ((nSpecies.GT.1).AND.(BGKCollModel.GT.1)) THEN @@ -178,11 +178,11 @@ SUBROUTINE InitBGK() ! Vibrational modelling BGKDoVibRelaxation = GETLOGICAL('Particles-BGK-DoVibRelaxation') BGKUseQuantVibEn = GETLOGICAL('Particles-BGK-UseQuantVibEn') - IF ((nSpecies.GT.1).AND.(BGKUseQuantVibEn)) THEN - CALL abort(& - __STAMP__& - ,' ERROR Multispec not implemented for quantized vibrational energy!') - END IF + !IF ((nSpecies.GT.1).AND.(BGKUseQuantVibEn)) THEN + ! CALL abort(& + ! __STAMP__& + ! ,' ERROR Multispec not implemented for quantized vibrational energy!') + !END IF END IF IF(DSMC%CalcQualityFactors) THEN From 16ee2aa945862efba3f68d061c3aaf1638b27633 Mon Sep 17 00:00:00 2001 From: hildf Date: Wed, 13 Apr 2022 15:48:27 +0200 Subject: [PATCH 04/41] BGK mean collisionfrecspec instead of per species --- src/particles/bgk/bgk_colloperator.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 113905ae9..91122b7fe 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -92,7 +92,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) REAL :: totalWeightSpec(nSpecies), totalWeight, partWeight, CellTemptmp REAL :: EVibSpec(nSpecies), ERotSpec(nSpecies), Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies),Xi_Vib_oldSpec(nSpecies) REAL :: TVibSpec(nSpecies), TRotSpec(nSpecies), RotExpSpec(nSpecies), VibExpSpec(nSpecies) -REAL :: collisionfreqSpec(nSpecies),rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies), Xi_RotTotal +REAL :: collisionfreqSpec,rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies), Xi_RotTotal INTEGER :: nVibRelaxSpec(nSpecies), nRotRelaxSpec(nSpecies) !=================================================================================================================================== #ifdef CODE_ANALYZE @@ -160,18 +160,18 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) IF(ANY(SpecDSMC(:)%InterID.EQ.2).OR.ANY(SpecDSMC(:)%InterID.EQ.20)) THEN collisionfreqSpec = 0.0 DO iSpec = 1, nSpecies - DO jSpec = 1, nSpecies + DO jSpec = 1, iSpec IF (iSpec.EQ.jSpec) THEN CellTemptmp = CellTemp !SpecTemp(iSpec) ELSE CellTemptmp = CellTemp END IF - collisionfreqSpec(iSpec) = collisionfreqSpec(iSpec) + SpecBGK(iSpec)%CollFreqPreFactor(jSpec) * totalWeightSpec(iSpec)*totalWeightSpec(jSpec) & + collisionfreqSpec = collisionfreqSpec + SpecBGK(iSpec)%CollFreqPreFactor(jSpec) * totalWeightSpec(iSpec)*totalWeightSpec(jSpec) & *Dens *CellTemptmp**(-CollInf%omega(iSpec,jSpec) +0.5) /(totalWeight*totalWeight) END DO END DO - rotrelaxfreqSpec(:) = collisionfreqSpec(:) * DSMC%RotRelaxProb - vibrelaxfreqSpec(:) = collisionfreqSpec(:) * DSMC%VibRelaxProb + rotrelaxfreqSpec(:) = collisionfreqSpec * DSMC%RotRelaxProb + vibrelaxfreqSpec(:) = collisionfreqSpec * DSMC%VibRelaxProb RotExpSpec=0.; VibExpSpec=0. IF(SpecDSMC(1)%PolyatomicMol) THEN From bf0306a07855446cf0e1a2d498e5efbc36d641ad Mon Sep 17 00:00:00 2001 From: hildf Date: Wed, 27 Apr 2022 15:23:21 +0200 Subject: [PATCH 05/41] Corrected collisionfreqspec for mixtures --- src/particles/bgk/bgk_colloperator.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 91122b7fe..9363f866c 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -92,7 +92,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) REAL :: totalWeightSpec(nSpecies), totalWeight, partWeight, CellTemptmp REAL :: EVibSpec(nSpecies), ERotSpec(nSpecies), Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies),Xi_Vib_oldSpec(nSpecies) REAL :: TVibSpec(nSpecies), TRotSpec(nSpecies), RotExpSpec(nSpecies), VibExpSpec(nSpecies) -REAL :: collisionfreqSpec,rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies), Xi_RotTotal +REAL :: collisionfreqSpec(nSpecies),rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies), Xi_RotTotal INTEGER :: nVibRelaxSpec(nSpecies), nRotRelaxSpec(nSpecies) !=================================================================================================================================== #ifdef CODE_ANALYZE @@ -160,18 +160,18 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) IF(ANY(SpecDSMC(:)%InterID.EQ.2).OR.ANY(SpecDSMC(:)%InterID.EQ.20)) THEN collisionfreqSpec = 0.0 DO iSpec = 1, nSpecies - DO jSpec = 1, iSpec + DO jSpec = 1, nSpecies IF (iSpec.EQ.jSpec) THEN CellTemptmp = CellTemp !SpecTemp(iSpec) ELSE CellTemptmp = CellTemp END IF - collisionfreqSpec = collisionfreqSpec + SpecBGK(iSpec)%CollFreqPreFactor(jSpec) * totalWeightSpec(iSpec)*totalWeightSpec(jSpec) & - *Dens *CellTemptmp**(-CollInf%omega(iSpec,jSpec) +0.5) /(totalWeight*totalWeight) + collisionfreqSpec(iSpec) = collisionfreqSpec(iSpec) + SpecBGK(iSpec)%CollFreqPreFactor(jSpec) * totalWeightSpec(jSpec) & + * (Dens / totalWeight) *CellTemptmp**(-CollInf%omega(iSpec,jSpec) +0.5) END DO END DO - rotrelaxfreqSpec(:) = collisionfreqSpec * DSMC%RotRelaxProb - vibrelaxfreqSpec(:) = collisionfreqSpec * DSMC%VibRelaxProb + rotrelaxfreqSpec(:) = collisionfreqSpec(:) * DSMC%RotRelaxProb + vibrelaxfreqSpec(:) = collisionfreqSpec(:) * DSMC%VibRelaxProb RotExpSpec=0.; VibExpSpec=0. IF(SpecDSMC(1)%PolyatomicMol) THEN From 0c9bc3568318ac665c1efdaac1a967b5fe70d2a0 Mon Sep 17 00:00:00 2001 From: hildf Date: Thu, 28 Apr 2022 15:24:21 +0200 Subject: [PATCH 06/41] CollFreqPreFactor change of factor for mixtures --- src/particles/bgk/bgk_init.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/particles/bgk/bgk_init.f90 b/src/particles/bgk/bgk_init.f90 index 28e080675..3ff014285 100644 --- a/src/particles/bgk/bgk_init.f90 +++ b/src/particles/bgk/bgk_init.f90 @@ -120,7 +120,7 @@ SUBROUTINE InitBGK() IF (iSpec.EQ.iSpec2) THEN delta_ij = 1.0 ELSE - delta_ij = 0.0 + delta_ij = 1.0 END IF SpecBGK(iSpec)%CollFreqPreFactor(iSpec2)= 4.*(2.-delta_ij)*CollInf%dref(iSpec,iSpec2)**2.0 & * SQRT(Pi*BoltzmannConst*CollInf%Tref(iSpec,iSpec2)*(Species(iSpec)%MassIC + Species(iSpec2)%MassIC) & From a69a5da9ff8dab03fe5a9d54dde40a46c5c2e31a Mon Sep 17 00:00:00 2001 From: hildf Date: Tue, 8 Nov 2022 10:28:51 +0100 Subject: [PATCH 07/41] diatomic mixture Pr number with collision integrals for BGK + some code comments in BGK colloperator --- src/particles/bgk/bgk_colloperator.f90 | 172 +++++++++++++++++++------ src/particles/bgk/bgk_init.f90 | 9 +- 2 files changed, 134 insertions(+), 47 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 9363f866c..9af84f8d2 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -105,6 +105,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) Momentum_old(1:3) = Momentum_old(1:3) + PartState(4:6,iPart)*Species(iSpec)%MassIC*partWeight Energy_old = Energy_old + DOTPRODUCT(PartState(4:6,iPart))*0.5*Species(iSpec)%MassIC*partWeight IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + ! Add internal energies (vibration, rotation) for molecules and molecular ions Energy_old = Energy_old + (PartStateIntEn(1,iPart) + PartStateIntEn(2,iPart))*partWeight END IF END DO @@ -115,6 +116,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) ! 1.) Moment calculation: Summing up the relative velocities and their squares CALL CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, totalWeightSpec, TotalMass, u2, u2Spec, u0ij, & u2i, OldEn, EVibSpec, ERotSpec, CellTemp, SpecTemp, dtCell) + IF((CellTemp.LE.0).OR.(MAXVAL(nSpec(:)).EQ.1).OR.(totalWeight.LE.0.0)) RETURN IF(VarTimeStep%UseVariableTimeStep) THEN @@ -166,19 +168,23 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) ELSE CellTemptmp = CellTemp END IF + ! Sum up collision frequencies of species i with itself and the other species + ! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 87f collisionfreqSpec(iSpec) = collisionfreqSpec(iSpec) + SpecBGK(iSpec)%CollFreqPreFactor(jSpec) * totalWeightSpec(jSpec) & * (Dens / totalWeight) *CellTemptmp**(-CollInf%omega(iSpec,jSpec) +0.5) END DO END DO + ! Calculate relaxation frequencies of rotation and vibration with relaxation properties rotrelaxfreqSpec(:) = collisionfreqSpec(:) * DSMC%RotRelaxProb vibrelaxfreqSpec(:) = collisionfreqSpec(:) * DSMC%VibRelaxProb RotExpSpec=0.; VibExpSpec=0. - IF(SpecDSMC(1)%PolyatomicMol) THEN + ! Calculation of the equilibrium temperature + IF(SpecDSMC(1)%PolyatomicMol) THEN ! polyatomic, no mixtures possible by now CALL CalcTEquiPoly(nPart, CellTemp, TRotSpec(1), TVibSpec(1), Xi_vib_DOF, Xi_Vib_oldSpec(1), RotExpSpec(1), VibExpSpec(1), & TEqui, rotrelaxfreqSpec(1), vibrelaxfreqSpec(1), dtCell) Xi_VibSpec(1) = SUM(Xi_vib_DOF(1:PolyatomMolDSMC(iPolyatMole)%VibDOF)) - ELSE + ELSE ! diatomic CALL CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec, Xi_Vib_oldSpec, RotExpSpec, VibExpSpec, & TEqui, rotrelaxfreqSpec, vibrelaxfreqSpec, dtCell) END IF @@ -203,6 +209,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) ALLOCATE(VibEnergyDOF(nVibRelax,PolyatomMolDSMC(iPolyatMole)%VibDOF)) END IF END IF + ! 5.) Determine the new rotational and vibrational state of molecules undergoing a relaxation CALL RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartIndx_NodeRelaxRot, Xi_vib_DOF, Xi_VibSpec, & Xi_RotSpec , TEqui, VibEnergyDOF, NewEnVib, NewEnRot) @@ -233,6 +240,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) END IF OldEn = OldEn + OldEnRot + ! 8.) Determine the new particle state and ensure energy conservation by scaling the new velocities with the factor alpha. Xi_RotTotal = 0.0 DO iSpec = 1, nSpecies @@ -328,6 +336,7 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota USE MOD_BGK_Vars ,ONLY: BGKDoVibRelaxation, BGKCollModel USE MOD_part_tools ,ONLY: GetParticleWeight USE MOD_Globals_Vars ,ONLY: BoltzmannConst +USE MOD_Globals ,ONLY: DOTPRODUCT ! IMPLICIT VARIABLE HANDLING IMPLICIT NONE !----------------------------------------------------------------------------------------------------------------------------------- @@ -346,6 +355,7 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota REAL :: tempweight, tempweight2, tempmass, vBulkTemp(3), totalWeight2, totalWeight3 !=================================================================================================================================== totalWeightSpec = 0.0; totalWeightSpec2=0.0; vBulkAll=0.0; TotalMass=0.0; vBulkSpec=0.0; nSpec=0; dtCell=0.0 +! Loop over all simulation particles to sum up bulk velocities DO iLoop = 1, nPart iPart = iPartIndx_Node(iLoop) partWeight = GetParticleWeight(iPart) @@ -355,31 +365,38 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota vBulkAll(1:3) = vBulkAll(1:3) + PartState(4:6,iPart)*Species(iSpec)%MassIC*partWeight TotalMass = TotalMass + Species(iSpec)%MassIC*partWeight vBulkSpec(1:3,iSpec) = vBulkSpec(1:3,iSpec) + PartState(4:6,iPart)*partWeight - nSpec(iSpec) = nSpec(iSpec) + 1 + nSpec(iSpec) = nSpec(iSpec) + 1 ! Count number of simulation particles per species IF(VarTimeStep%UseVariableTimeStep) THEN dtCell = dtCell + VarTimeStep%ParticleTimeStep(iPart)*partWeight END IF END DO totalWeight = SUM(totalWeightSpec) totalWeight2 = SUM(totalWeightSpec2) + IF ((MAXVAL(nSpec(:)).EQ.1).OR.(totalWeight.LE.0.0)) RETURN + +! Calculate bulk velocities vBulkAll(1:3) = vBulkAll(1:3) / TotalMass DO iSpec = 1, nSpecies - IF (nSpec(iSpec).GT.0) vBulkSpec(:,iSpec) = vBulkSpec(:,iSpec) /totalWeightSpec(iSpec) + IF (nSpec(iSpec).GT.0) vBulkSpec(:,iSpec) = vBulkSpec(:,iSpec) / totalWeightSpec(iSpec) END DO totalWeight3 = 0.; u2Spec=0.0; u0ij=0.0; u2i=0.0; OldEn=0.0; EVibSpec=0.0; ERotSpec=0.0 +! Loop over all simulation particles to sum up relative velocities DO iLoop = 1, nPart iPart = iPartIndx_Node(iLoop) partWeight = GetParticleWeight(iPart) iSpec = PartSpecies(iPart) + ! Calculate thermal velocity with bulk velocity of the species V_rel(1:3)=PartState(4:6,iPart)-vBulkSpec(1:3,iSpec) vmag2 = V_rel(1)**2 + V_rel(2)**2 + V_rel(3)**2 + ! Summing up thermal velocities (squared) of all particles per species u2Spec(iSpec) = u2Spec(iSpec) + vmag2*partWeight + ! Calculate thermal velocity with bulk velocity of the gas V_rel(1:3)=PartState(4:6,iPart)-vBulkAll(1:3) vmag2 = V_rel(1)**2 + V_rel(2)**2 + V_rel(3)**2 - IF (BGKCollModel.EQ.1) THEN + IF (BGKCollModel.EQ.1) THEN ! ESBGK DO fillMa1 =1, 3 DO fillMa2 =fillMa1, 3 u0ij(fillMa1, fillMa2)= u0ij(fillMa1, fillMa2) & @@ -387,25 +404,29 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota END DO END DO END IF - IF (BGKCollModel.EQ.2) THEN + IF (BGKCollModel.EQ.2) THEN ! Shakhov u2i(1:3) = u2i(1:3) + V_rel(1:3)*vmag2 * partWeight*Species(iSpec)%MassIC totalWeight3 = totalWeight3 + partWeight*partWeight*partWeight END IF + + ! Sum up old energy of thermal velocities and calculate internal energies OldEn = OldEn + 0.5*Species(iSpec)%MassIC * vmag2*partWeight IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN IF(BGKDoVibRelaxation) THEN + ! EVib without zero-point energy EVibSpec(iSpec) = EVibSpec(iSpec) + (PartStateIntEn(1,iPart) - SpecDSMC(iSpec)%EZeroPoint) * partWeight END IF ERotSpec(iSpec) = ERotSpec(iSpec) + PartStateIntEn(2,iPart) * partWeight END IF END DO -u0ij = u0ij* totalWeight / (TotalMass*(totalWeight - totalWeight2/totalWeight)) -IF (BGKCollModel.EQ.2) THEN +u0ij = u0ij* totalWeight / (TotalMass*(totalWeight - totalWeight2/totalWeight)) ! ESBGK +IF (BGKCollModel.EQ.2) THEN ! Shakhov u2i = u2i*totalWeight**3/(TotalMass*(totalWeight**3-3.*totalWeight*totalWeight2+2.*totalWeight3)) END IF -IF (nSpecies.GT.1) THEN +! Calculation of cell temperature and bulk velocity (squared) +IF (nSpecies.GT.1) THEN ! mixture SpecTemp = 0.0 EnerTotal = 0.0 tempweight = 0.0; tempweight2 = 0.0; tempmass = 0.0; vBulkTemp = 0.0 @@ -413,22 +434,21 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota IF ((nSpec(iSpec).GE.2).AND.(.NOT.ALMOSTZERO(u2Spec(iSpec)))) THEN SpecTemp(iSpec) = Species(iSpec)%MassIC * u2Spec(iSpec) & /(3.0*BoltzmannConst*(totalWeightSpec(iSpec) - totalWeightSpec2(iSpec)/totalWeightSpec(iSpec))) - EnerTotal = EnerTotal + 3./2.*BoltzmannConst*SpecTemp(iSpec) * totalWeightSpec(iSpec) - vmag2 = vBulkSpec(1,iSpec)**(2.) + vBulkSpec(2,iSpec)**(2.) + vBulkSpec(3,iSpec)**(2.) - EnerTotal = EnerTotal + totalWeightSpec(iSpec) * Species(iSpec)%MassIC / 2. * vmag2 + EnerTotal = EnerTotal + 3./2.*BoltzmannConst*SpecTemp(iSpec) * totalWeightSpec(iSpec) ! thermal energy + vmag2 = DOTPRODUCT(vBulkSpec(1:3,iSpec)) + EnerTotal = EnerTotal + totalWeightSpec(iSpec) * Species(iSpec)%MassIC / 2. * vmag2 ! kinetic energy tempweight = tempweight + totalWeightSpec(iSpec) tempweight2 = tempweight2 + totalWeightSpec2(iSpec) tempmass = tempmass + totalWeightSpec(iSpec) * Species(iSpec)%MassIC vBulkTemp(1:3) = vBulkTemp(1:3) + vBulkSpec(1:3,iSpec)*totalWeightSpec(iSpec) * Species(iSpec)%MassIC END IF END DO - vBulkTemp(1:3) = vBulkTemp(1:3) / tempmass - vmag2 = vBulkTemp(1)*vBulkTemp(1) + vBulkTemp(2)*vBulkTemp(2) + vBulkTemp(3)*vBulkTemp(3) + vmag2 = DOTPRODUCT(vBulkTemp(1:3)) EnerTotal = EnerTotal - tempmass / 2. * vmag2 CellTemp = 2. * EnerTotal / (3.*tempweight*BoltzmannConst) u2 = 3. * CellTemp * BoltzmannConst * (tempweight - tempweight2/tempweight) / tempmass -ELSE +ELSE ! single species gas u2 = u2Spec(1) / (totalWeight - totalWeight2/totalWeight) CellTemp = Species(1)%MassIC * u2 / (3.0*BoltzmannConst) END IF @@ -465,25 +485,33 @@ SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, T IF (nSpec(iSpec).EQ.0) CYCLE IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN IF(BGKDoVibRelaxation) THEN - IF(SpecDSMC(iSpec)%PolyatomicMol) THEN + IF(SpecDSMC(iSpec)%PolyatomicMol) THEN ! polyatomic iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray + ! Calculation of the vibrational temperature (zero-point search) for polyatomic molecules TVibSpec(iSpec) = CalcTVibPoly(EVibSpec(iSpec)/totalWeightSpec(iSpec), 1) IF (TVibSpec(iSpec).GT.0.0) THEN DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF + ! Calculation of vibrational DOFs from Pfeiffer et. al., AIP Conference Proceedings 2132, 100001 (2019), + ! "Extension of particle-based BGK models to polyatomic species in hypersonic flow around a flat-faced cylinder", Xi_VibSpec(iSpec) = Xi_VibSpec(iSpec) + 2.*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TVibSpec(iSpec) & /(EXP(PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TVibSpec(iSpec)) - 1.) END DO END IF - ELSE - TVibSpec(iSpec)=EVibSpec(iSpec) / (totalWeightSpec(iSpec)*BoltzmannConst*SpecDSMC(iSpec)%CharaTVib) + ELSE ! diatomic + ! Calculation of vibrational temperature and DOFs from Pfeiffer, Physics of Fluids 30, 116103 (2018), + ! "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules including quantized vibrational energies" + ! TVibSpec = vibrational energy without zero-point energy + TVibSpec(iSpec) = EVibSpec(iSpec) / (totalWeightSpec(iSpec)*BoltzmannConst*SpecDSMC(iSpec)%CharaTVib) IF (TVibSpec(iSpec).GT.0.0) THEN - TVibSpec(iSpec)= SpecDSMC(iSpec)%CharaTVib/LOG(1. + 1./(TVibSpec(iSpec))) + TVibSpec(iSpec) = SpecDSMC(iSpec)%CharaTVib/LOG(1. + 1./(TVibSpec(iSpec))) Xi_VibSpec(iSpec) = 2.* EVibSpec(iSpec) / (totalWeightSpec(iSpec)*BoltzmannConst*TVibSpec(iSpec)) END IF END IF Xi_Vib_oldSpec(iSpec) = Xi_VibSpec(iSpec) END IF Xi_RotSpec(iSpec) = SpecDSMC(iSpec)%Xi_Rot + ! Calculation of rotational temperature from Pfeiffer, Physics of Fluids 30, 116103 (2018), + ! "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules including quantized vibrational energies" TRotSpec(iSpec) = 2.*ERotSpec(iSpec)/(Xi_RotSpec(iSpec)*totalWeightSpec(iSpec)*BoltzmannConst) END IF InnerDOF = InnerDOF + Xi_RotSpec(iSpec) + Xi_VibSpec(iSpec) @@ -518,7 +546,7 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight REAL :: PrandtlCorrection, dynamicvisSpec(nSpecies), thermalcondSpec(nSpecies), Phi(nSpecies) REAL :: dynamicvis, thermalcond, C_P, nu, A(3,3), W(3), Theta, CellTempSpec(nSpecies+1), Work(100) !=================================================================================================================================== -IF (nSpecies.GT.1) THEN +IF (nSpecies.GT.1) THEN ! gas mixture MolarFraction(1:nSpecies) = totalWeightSpec(1:nSpecies) / totalWeight MassIC_Mixture = TotalMass / totalWeight MassFraction(1:nSpecies) = MolarFraction(1:nSpecies) * Species(1:nSpecies)%MassIC / MassIC_Mixture @@ -527,18 +555,24 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight C_P = 0.0 DO iSpec = 1, nSpecies IF (nSpec(iSpec).EQ.0) CYCLE + ! Correction of Pr for calculation of relaxation frequency, see alpha - Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), + ! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar–Gross–Krook method for monatomic gas species" PrandtlCorrection = PrandtlCorrection + MolarFraction(iSpec)*MassIC_Mixture/Species(iSpec)%MassIC - IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN ! molecules C_P = C_P + ((5. + (Xi_VibSpec(iSpec)+Xi_RotSpec(iSpec)))/2.) * BoltzmannConst / Species(iSpec)%MassIC * MassFraction(iSpec) - ELSE + ELSE ! atoms C_P = C_P + (5./2.) * BoltzmannConst / Species(iSpec)%MassIC * MassFraction(iSpec) END IF END DO SELECT CASE(BGKMixtureModel) + ! Both cases are described in Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), + ! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar–Gross–Krook method for monatomic gas species" + CASE (1) ! Wilke's mixing rules DO iSpec = 1, nSpecies ! Dynamic viscosity per species + ! Omega = OmegaVHS + 0.5 IF ((nSpec(iSpec).GE.2).AND.(.NOT.ALMOSTZERO(u2Spec(iSpec)))) THEN ! Species temperature: Sufficient number of particles per species are available dynamicvisSpec(iSpec) = 30.*SQRT(Species(iSpec)%MassIC* BoltzmannConst*CollInf%Tref(iSpec,iSpec)/Pi) & @@ -551,14 +585,16 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight *CollInf%Tref(iSpec,iSpec)**(CollInf%omega(iSpec,iSpec) + 0.5)*CellTemp**(-CollInf%omega(iSpec,iSpec) - 0.5)) END IF ! Thermal conductivity per species (Eucken's formula with a correction by Hirschfelder for the internal degrees of freedom) - IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN ! inner DOF + ! Istomin et. al., "Eucken correction in high-temperature gases with electronic excitation", J. Chem. Phys. 140, 184311 (2014) thermalcondspec(iSpec) = 0.25 * (15. + 2. * (Xi_VibSpec(iSpec)+Xi_RotSpec(iSpec)) * 1.328) & * dynamicvisSpec(iSpec) * BoltzmannConst / Species(iSpec)%MassIC - ELSE + ELSE ! atoms thermalcondspec(iSpec) = 0.25 * 15. * dynamicvisSpec(iSpec) * BoltzmannConst / Species(iSpec)%MassIC END IF END DO Phi= 0.0 + ! Calculation of factor phi, depending on mass ratios and ratios of dynamic viscosities DO iSpec = 1, nSpecies DO jSpec = 1, nSpecies Phi(iSpec) = Phi(iSpec) & @@ -570,11 +606,13 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight END DO dynamicvis = 0.0 thermalcond = 0.0 + ! Sum up dynamic viscosities and thermal conductivities of species DO iSpec = 1, nSpecies IF (nSpec(iSpec).EQ.0) CYCLE dynamicvis = dynamicvis + REAL(totalWeightSpec(iSpec)) * dynamicvisSpec(iSpec) / Phi(iSpec) thermalcond = thermalcond + REAL(totalWeightSpec(iSpec)) * thermalcondspec(iSpec) / Phi(iSpec) END DO + CASE(2) ! Collision integrals (VHS) DO iSpec = 1, nSpecies IF ((nSpec(iSpec).LT.2).OR.ALMOSTZERO(u2Spec(iSpec))) THEN @@ -584,27 +622,36 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight END IF END DO CellTempSpec(nSpecies+1) = CellTemp - CALL CalcViscosityThermalCondColIntVHS(CellTempSpec(1:nSpecies+1), MolarFraction(1:nSpecies),dens, dynamicvis, thermalcond) + CALL CalcViscosityThermalCondColIntVHS(CellTempSpec(1:nSpecies+1), MolarFraction(1:nSpecies),dens, Xi_RotSpec, Xi_VibSpec, dynamicvis, thermalcond) END SELECT + ! Calculation of Prandtl number Prandtl = C_P*dynamicvis/thermalcond*PrandtlCorrection + IF(DSMC%CalcQualityFactors) BGK_ExpectedPrandtlNumber = BGK_ExpectedPrandtlNumber + Prandtl - A = u0ij - CALL DSYEV('N','U',3,A,3,W,Work,100,INFO) - Theta = u2 / 3. + ! Ensure anisotropic matrix to be positive definite - gas mixtures only for ESBGK by now + A = u0ij ! pressure tensor + CALL DSYEV('N','U',3,A,3,W,Work,100,INFO) ! calculate eigenvalues, W(3) is maximum eigenvalue + Theta = u2 / 3. ! kB*T/m nu = 1.-1./Prandtl nu= MAX(nu,-Theta/(W(3)-Theta)) Prandtl = 1./(1.-nu) + + ! Calculation of relaxation frequency relaxfreq = Prandtl*dens*BoltzmannConst*CellTemp/dynamicvis -ELSE + +ELSE ! single species gas + ! Calculation of reference dynamic viscosity dynamicvis = 30.*SQRT(Species(1)%MassIC* BoltzmannConst*CollInf%Tref(1,1)/Pi) & / (4.*(4.- 2.*CollInf%omega(1,1)) * (6. - 2.*CollInf%omega(1,1))* CollInf%dref(1,1)**2.) - Prandtl =2.*(InnerDOF + 5.)/(2.*InnerDOF + 15.) - IF (BGKCollModel.EQ.1) THEN + ! Calculation of Prandtl number: Pr = cp*mu/K with inner DOF, atoms: Pr = 2/3 + Prandtl = 2.*(InnerDOF + 5.)/(2.*InnerDOF + 15.) + ! Calculation of relaxation frequency using the exponential ansatz of the viscosity mu + IF (BGKCollModel.EQ.1) THEN ! ESBGK: relaxfreq nu = Pr*n*kB*T/mu relaxfreq = Prandtl*dens*BoltzmannConst*CollInf%Tref(1,1)**(CollInf%omega(1,1) + 0.5) & /dynamicvis*CellTemp**(-CollInf%omega(1,1) +0.5) - ELSE + ELSE ! relaxfreq nu = n*kB*T/mu relaxfreq = dens*BoltzmannConst*CollInf%Tref(1,1)**(CollInf%omega(1,1) + 0.5) & /dynamicvis*CellTemp**(-CollInf%omega(1,1) +0.5) END IF @@ -1623,19 +1670,19 @@ SUBROUTINE CalcTEquiPoly(nPart, CellTemp, TRot, TVib, Xi_Vib_DOF, Xi_Vib_old, Ro END SUBROUTINE CalcTEquiPoly -SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Visc, ThermalCond) +SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_VibSpec, Visc, ThermalCond) !=================================================================================================================================== !> Determination of the mixture viscosity and thermal conductivity using collision integrals (derived for the Variable Hard !> Sphere model). Solving an equation system depending on the number of species. !=================================================================================================================================== ! MODULES -USE MOD_DSMC_Vars, ONLY : CollInf +USE MOD_DSMC_Vars, ONLY : CollInf, SpecDSMC USE MOD_Globals_Vars, ONLY : BoltzmannConst USE MOD_Particle_Vars, ONLY : Species, nSpecies IMPLICIT NONE !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT VARIABLES -REAL, INTENT(IN) :: CellTemp(nSpecies+1), Xi(nSpecies), dens +REAL, INTENT(IN) :: CellTemp(nSpecies+1), Xi(nSpecies), dens, Xi_RotSpec(nSpecies), Xi_VibSpec(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES REAL, INTENT(OUT) :: Visc,ThermalCond @@ -1644,29 +1691,53 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Visc, ThermalCo !----------------------------------------------------------------------------------------------------------------------------------- REAL :: Sigma_11, Sigma_22, B_12(nSpecies,nSpecies), A_12(nSpecies,nSpecies), InteractDiam, cv, DiffCoef(nSpecies, nSpecies) REAL :: Mass, ViscSpec(nSpecies), ThermalCondSpec(nSpecies), TVHS, omegaVHS, E_12, CellTemptmp +REAL :: ThermalCondSpec_Vib(nSpecies), ThermalCondSpec_Rot(nSpecies), cv_rot, cv_vib, rhoSpec +REAL :: Xj_Dij(nSpecies,nSpecies), Xi_Dij_tot REAL :: ViscMat(nSpecies, nSpecies), RHSSolve(nSpecies), m0, pressure INTEGER :: iSpec, jSpec, kSpec, IPIV(nSpecies), info_dgesv !=================================================================================================================================== -ViscSpec = 0.; ThermalCondSpec = 0.; DiffCoef =0.; A_12 = 0.; B_12 = 0. +ViscSpec = 0.; ThermalCondSpec = 0.; ThermalCondSpec_Vib = 0.; ThermalCondSpec_Rot = 0.; DiffCoef =0.; A_12 = 0.; B_12 = 0. +Xj_Dij = 0. +! Loop over all species combinations DO iSpec = 1, nSpecies + ! Calculate cv with rotational and vibrational degrees of freedom + IF ((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + cv_rot = (Xi_RotSpec(iSpec)*BoltzmannConst)/(2.*Species(iSpec)%MassIC) + cv_vib = (Xi_VibSpec(iSpec)*BoltzmannConst)/(2.*Species(iSpec)%MassIC) + END IF DO jSpec = iSpec, nSpecies + ! Interaction parameters InteractDiam = CollInf%dref(iSpec,jSpec) - Mass = Species(iSpec)%MassIC*Species(jSpec)%MassIC/(Species(iSpec)%MassIC + Species(jSpec)%MassIC) + Mass = Species(iSpec)%MassIC*Species(jSpec)%MassIC/(Species(iSpec)%MassIC + Species(jSpec)%MassIC) ! reduced mass TVHS = CollInf%Tref(iSpec,jSpec) omegaVHS = CollInf%omega(iSpec,jSpec) IF (iSpec.EQ.jSpec) THEN - CellTemptmp = CellTemp(iSpec) + CellTemptmp = CellTemp(iSpec) ! Species temperature or cell temperature for nSpec<2 or u2spec=0 ELSE - CellTemptmp = CellTemp(nSpecies+1) + CellTemptmp = CellTemp(nSpecies+1) ! Cell temperature END IF + ! Calculation of collision integral Sigma_22 Sigma_22 = CalcSigma_22VHS(CellTemptmp,InteractDiam,Mass,TVHS, omegaVHS) IF (iSpec.EQ.jSpec) THEN - cv= 3./2.*BoltzmannConst/(2.*Mass) + cv= 3./2.*BoltzmannConst/(2.*Mass) ! DOF = 3, translational part + ! Calculation of the viscosity and thermal conductivity + ! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 160 ViscSpec(iSpec) = (5./8.)*(BoltzmannConst*CellTemp(iSpec))/Sigma_22 ThermalCondSpec(iSpec) = (25./16.)*(cv*BoltzmannConst*CellTemp(iSpec))/Sigma_22 !ThermalCondSpec(iSpec) = (15./4.)*BoltzmannConst/(2.*Mass)*ViscSpec(iSpec) + ! Additional calculation of Sigma_11VHS and the diffusion coefficient for molecular species + IF ((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + CALL CalcSigma_11VHS(CellTemp(nSpecies+1),InteractDiam,Mass,TVHS, omegaVHS, Sigma_11) + E_12 = BoltzmannConst*CellTemp(nSpecies+1)/(8.*Species(iSpec)%MassIC*Species(jSpec)%MassIC & + /(Species(iSpec)%MassIC+Species(jSpec)%MassIC)**2.*Sigma_11) + DiffCoef(iSpec,jSpec) = 3.*E_12/(2.*(Species(iSpec)%MassIC+Species(jSpec)%MassIC)*dens) + END IF ELSE + ! Calculation of collision integral Sigma_11 CALL CalcSigma_11VHS(CellTemp(nSpecies+1),InteractDiam,Mass,TVHS, omegaVHS, Sigma_11) + ! Parameters for calculation of contribution of species to mixture transport coefficients + ! Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), + ! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar–Gross–Krook method for monatomic gas species" B_12(iSpec,jSpec) = (5.*GAMMA(4.-omegaVHS)-GAMMA(5.-omegaVHS))/(5.*GAMMA(3.-omegaVHS)) B_12(jSpec,iSpec) = B_12(iSpec,jSpec) A_12(iSpec,jSpec) = Sigma_22 / (5.*Sigma_11) @@ -1676,9 +1747,20 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Visc, ThermalCo DiffCoef(iSpec,jSpec) = 3.*E_12/(2.*(Species(iSpec)%MassIC+Species(jSpec)%MassIC)*dens) DiffCoef(jSpec,iSpec) = DiffCoef(iSpec,jSpec) END IF + Xj_Dij(iSpec,jSpec) = Xi(jSpec)/DiffCoef(iSpec,jSpec) + Xj_Dij(jSpec,iSpec) = Xj_Dij(iSpec,jSpec) END DO + ! Calculation of thermal conductivity of rotation and vibration for each molecular species + ! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 254 + Xi_Dij_tot = SUM(Xj_Dij(iSpec,:)) + rhoSpec = dens * Species(iSpec)%MassIC * Xi(iSpec) + ThermalCondSpec_Rot(iSpec) = (rhoSpec*cv_rot/Xi_Dij_tot) + ThermalCondSpec_Vib(iSpec) = (rhoSpec*cv_vib/Xi_Dij_tot) END DO +! Calculate mixture viscosity by solving a system of linear equations with matrices +! Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), +! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar–Gross–Krook method for monatomic gas species" ViscMat = 0.0 DO iSpec = 1, nSpecies DO jSpec = 1, nSpecies @@ -1699,6 +1781,9 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Visc, ThermalCo CALL DGESV(nSpecies, 1, ViscMat, nSpecies, IPIV, RHSSolve, nSpecies, info_dgesv) Visc = SUM(RHSSolve) +! Calculate mixture thermal conductivity by solving a system of linear equations with matrices +! Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), +! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar–Gross–Krook method for monatomic gas species" pressure = BoltzmannConst*dens*CellTemp(nSpecies+1) ViscMat = 0.0 DO iSpec = 1, nSpecies @@ -1722,7 +1807,8 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Visc, ThermalCo RHSSolve(iSpec) = Xi(iSpec) END DO CALL DGESV(nSpecies, 1, ViscMat, nSpecies, IPIV, RHSSolve, nSpecies, info_dgesv) -ThermalCond = SUM(RHSSolve) +! Thermal conductivity from translation, rotation and vibration +ThermalCond = SUM(RHSSolve) + SUM(ThermalCondSpec_Rot) + SUM(ThermalCondSpec_Vib) END SUBROUTINE CalcViscosityThermalCondColIntVHS @@ -1745,6 +1831,8 @@ SUBROUTINE CalcSigma_11VHS(CellTemp,Dref,Mass,Tref, omegaVHS, Sigma_11) ! LOCAL VARIABLES REAL :: Prefactor !=================================================================================================================================== + ! See Stephani et. al., Physics of Fluids 24, 077101 (2012), + ! “Consistent treatment of transport properties for five-species air direct simulation Monte Carlo/Navier-Stokes applications” Prefactor = Pi/2.*Dref*Dref*SQRT(BoltzmannConst/(2.*Pi*Mass))*Tref**omegaVHS*GAMMA(3.-omegaVHS)/GAMMA(2.-omegaVHS) Sigma_11 = Prefactor*CellTemp**(0.5-omegaVHS) @@ -1767,6 +1855,8 @@ REAL FUNCTION CalcSigma_22VHS(CellTemp,Dref,Mass,Tref, omegaVHS) ! LOCAL VARIABLES REAL :: Prefactor !=================================================================================================================================== + ! See Stephani et. al., Physics of Fluids 24, 077101 (2012), + ! “Consistent treatment of transport properties for five-species air direct simulation Monte Carlo/Navier-Stokes applications” Prefactor = Pi/3.*Dref*Dref*SQRT(BoltzmannConst/(2.*Pi*Mass))*Tref**omegaVHS*GAMMA(4.-omegaVHS)/GAMMA(2.-omegaVHS) CalcSigma_22VHS = Prefactor*CellTemp**(0.5-omegaVHS) diff --git a/src/particles/bgk/bgk_init.f90 b/src/particles/bgk/bgk_init.f90 index 3ff014285..cfba3bb38 100644 --- a/src/particles/bgk/bgk_init.f90 +++ b/src/particles/bgk/bgk_init.f90 @@ -116,13 +116,10 @@ SUBROUTINE InitBGK() DO iSpec=1, nSpecies IF ((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) MoleculePresent = .TRUE. ALLOCATE(SpecBGK(iSpec)%CollFreqPreFactor(nSpecies)) + ! Calculation of the prefacor of the collision frequency per species + ! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 87f DO iSpec2=1, nSpecies - IF (iSpec.EQ.iSpec2) THEN - delta_ij = 1.0 - ELSE - delta_ij = 1.0 - END IF - SpecBGK(iSpec)%CollFreqPreFactor(iSpec2)= 4.*(2.-delta_ij)*CollInf%dref(iSpec,iSpec2)**2.0 & + SpecBGK(iSpec)%CollFreqPreFactor(iSpec2)= 4.*CollInf%dref(iSpec,iSpec2)**2.0 & * SQRT(Pi*BoltzmannConst*CollInf%Tref(iSpec,iSpec2)*(Species(iSpec)%MassIC + Species(iSpec2)%MassIC) & /(2.*(Species(iSpec)%MassIC * Species(iSpec2)%MassIC)))/CollInf%Tref(iSpec,iSpec2)**(-CollInf%omega(iSpec,iSpec2) +0.5) END DO From 1d9c4f306e5fe42d31edc6146e6fec6d1dd37170 Mon Sep 17 00:00:00 2001 From: hildf Date: Tue, 8 Nov 2022 16:19:32 +0100 Subject: [PATCH 08/41] BGK collision integrals checks for innerDOFs and particles of all species --- src/particles/bgk/bgk_colloperator.f90 | 28 +++++++++++++++++--------- 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index bb37fa74b..62916eefb 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -1714,15 +1714,17 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ INTEGER :: iSpec, jSpec, kSpec, IPIV(nSpecies), info_dgesv !=================================================================================================================================== ViscSpec = 0.; ThermalCondSpec = 0.; ThermalCondSpec_Vib = 0.; ThermalCondSpec_Rot = 0.; DiffCoef =0.; A_12 = 0.; B_12 = 0. -Xj_Dij = 0. +Xj_Dij = 0.; cv_rot = 0.; cv_vib = 0.; E_12 = 0. ! Loop over all species combinations DO iSpec = 1, nSpecies + IF (Xi(iSpec).LE.0.0) CYCLE ! Calculate cv with rotational and vibrational degrees of freedom IF ((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN cv_rot = (Xi_RotSpec(iSpec)*BoltzmannConst)/(2.*Species(iSpec)%MassIC) cv_vib = (Xi_VibSpec(iSpec)*BoltzmannConst)/(2.*Species(iSpec)%MassIC) END IF DO jSpec = iSpec, nSpecies + IF (Xi(jSpec).LE.0.0) CYCLE ! Interaction parameters InteractDiam = CollInf%dref(iSpec,jSpec) Mass = Species(iSpec)%MassIC*Species(jSpec)%MassIC/(Species(iSpec)%MassIC + Species(jSpec)%MassIC) ! reduced mass @@ -1764,15 +1766,19 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ DiffCoef(iSpec,jSpec) = 3.*E_12/(2.*(Species(iSpec)%MassIC+Species(jSpec)%MassIC)*dens) DiffCoef(jSpec,iSpec) = DiffCoef(iSpec,jSpec) END IF - Xj_Dij(iSpec,jSpec) = Xi(jSpec)/DiffCoef(iSpec,jSpec) - Xj_Dij(jSpec,iSpec) = Xj_Dij(iSpec,jSpec) + IF ((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + Xj_Dij(iSpec,jSpec) = Xi(jSpec)/DiffCoef(iSpec,jSpec) + Xj_Dij(jSpec,iSpec) = Xj_Dij(iSpec,jSpec) + END IF END DO - ! Calculation of thermal conductivity of rotation and vibration for each molecular species - ! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 254 - Xi_Dij_tot = SUM(Xj_Dij(iSpec,:)) - rhoSpec = dens * Species(iSpec)%MassIC * Xi(iSpec) - ThermalCondSpec_Rot(iSpec) = (rhoSpec*cv_rot/Xi_Dij_tot) - ThermalCondSpec_Vib(iSpec) = (rhoSpec*cv_vib/Xi_Dij_tot) + IF ((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + ! Calculation of thermal conductivity of rotation and vibration for each molecular species + ! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 254 + Xi_Dij_tot = SUM(Xj_Dij(iSpec,:)) + rhoSpec = dens * Species(iSpec)%MassIC * Xi(iSpec) + ThermalCondSpec_Rot(iSpec) = (rhoSpec*cv_rot/Xi_Dij_tot) + ThermalCondSpec_Vib(iSpec) = (rhoSpec*cv_vib/Xi_Dij_tot) + END IF END DO ! Calculate mixture viscosity by solving a system of linear equations with matrices @@ -1780,7 +1786,9 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ ! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar–Gross–Krook method for monatomic gas species" ViscMat = 0.0 DO iSpec = 1, nSpecies + IF (Xi(iSpec).LE.0.0) CYCLE DO jSpec = 1, nSpecies + IF (Xi(jSpec).LE.0.0) CYCLE IF (iSpec.EQ.jSpec) THEN ViscMat(iSpec, jSpec) = ViscMat(iSpec, jSpec) + Xi(iSpec)/ViscSpec(iSpec) DO kSpec = 1, nSpecies @@ -1804,7 +1812,9 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ pressure = BoltzmannConst*dens*CellTemp(nSpecies+1) ViscMat = 0.0 DO iSpec = 1, nSpecies + IF (Xi(iSpec).LE.0.0) CYCLE DO jSpec = 1, nSpecies + IF (Xi(jSpec).LE.0.0) CYCLE IF (iSpec.EQ.jSpec) THEN ViscMat(iSpec, jSpec) = ViscMat(iSpec, jSpec) + Xi(iSpec)/ThermalCondSpec(iSpec) DO kSpec = 1, nSpecies From a6bbd1188c6613a47130eef4cde261838124ffb6 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Mon, 23 Jan 2023 13:34:43 +0100 Subject: [PATCH 09/41] BGK collision integrals bug fix: ensure invertability of matrix for calculation of viscosity and thermal conductivity for gas mixtures + correct calculation of temperature for only one particle of a species + enabled viscosity and thermal conductivity output for paraview --- src/particles/bgk/bgk_adaptation.f90 | 10 +++- src/particles/bgk/bgk_colloperator.f90 | 80 +++++++++++++++----------- src/particles/bgk/bgk_init.f90 | 5 +- src/particles/bgk/bgk_main.f90 | 10 +++- src/particles/bgk/bgk_vars.f90 | 2 + src/particles/dsmc/dsmc_analyze.f90 | 24 +++++--- 6 files changed, 83 insertions(+), 48 deletions(-) diff --git a/src/particles/bgk/bgk_adaptation.f90 b/src/particles/bgk/bgk_adaptation.f90 index 6aba3c4fe..05da1c0c9 100644 --- a/src/particles/bgk/bgk_adaptation.f90 +++ b/src/particles/bgk/bgk_adaptation.f90 @@ -50,6 +50,7 @@ SUBROUTINE BGK_octree_adapt(iElem) USE MOD_FP_CollOperator ,ONLY: FP_CollisionOperator USE MOD_BGK_Vars ,ONLY: BGKInitDone,BGK_MeanRelaxFactor,BGK_MeanRelaxFactorCounter,BGK_MaxRelaxFactor USE MOD_BGK_Vars ,ONLY: BGK_QualityFacSamp, BGK_MaxRotRelaxFactor, BGK_PrandtlNumber, BGK_ExpectedPrandtlNumber +USE MOD_BGK_Vars ,ONLY: BGK_Viscosity, BGK_ThermalConductivity USE MOD_FPFlow_Vars ,ONLY: FPInitDone, FP_PrandtlNumber, FP_QualityFacSamp USE MOD_FPFlow_Vars ,ONLY: FP_MaxRelaxFactor, FP_MaxRotRelaxFactor, FP_MeanRelaxFactor, FP_MeanRelaxFactorCounter USE MOD_part_tools ,ONLY: GetParticleWeight @@ -73,7 +74,7 @@ SUBROUTINE BGK_octree_adapt(iElem) IF(DSMC%CalcQualityFactors) THEN IF(BGKInitDone) THEN BGK_MeanRelaxFactorCounter = 0; BGK_MeanRelaxFactor = 0.; BGK_MaxRelaxFactor = 0.; BGK_MaxRotRelaxFactor = 0. - BGK_PrandtlNumber=0.; BGK_ExpectedPrandtlNumber=0. + BGK_PrandtlNumber=0.; BGK_ExpectedPrandtlNumber=0.; BGK_Viscosity=0.; BGK_ThermalConductivity=0. END IF IF(FPInitDone) THEN FP_MeanRelaxFactorCounter = 0; FP_MeanRelaxFactor = 0.; FP_MaxRelaxFactor = 0.; FP_MaxRotRelaxFactor = 0.; FP_PrandtlNumber = 0. @@ -162,6 +163,8 @@ SUBROUTINE BGK_octree_adapt(iElem) BGK_QualityFacSamp(5,iElem) = BGK_QualityFacSamp(5,iElem) + BGK_MaxRotRelaxFactor BGK_QualityFacSamp(6,iElem) = BGK_QualityFacSamp(6,iElem) + BGK_PrandtlNumber BGK_QualityFacSamp(7,iElem) = BGK_QualityFacSamp(7,iElem) + BGK_ExpectedPrandtlNumber + BGK_QualityFacSamp(8,iElem) = BGK_QualityFacSamp(8,iElem) + BGK_Viscosity + BGK_QualityFacSamp(9,iElem) = BGK_QualityFacSamp(9,iElem) + BGK_ThermalConductivity END IF IF(FPInitDone) THEN FP_QualityFacSamp(1,iElem) = FP_QualityFacSamp(1,iElem) + FP_MeanRelaxFactor @@ -528,6 +531,7 @@ SUBROUTINE BGK_quadtree_adapt(iElem) USE MOD_FP_CollOperator ,ONLY: FP_CollisionOperator USE MOD_BGK_Vars ,ONLY: BGKInitDone,BGK_MeanRelaxFactor,BGK_MeanRelaxFactorCounter,BGK_MaxRelaxFactor USE MOD_BGK_Vars ,ONLY: BGK_QualityFacSamp, BGK_MaxRotRelaxFactor, BGK_PrandtlNumber, BGK_ExpectedPrandtlNumber +USE MOD_BGK_Vars ,ONLY: BGK_Viscosity, BGK_ThermalConductivity USE MOD_FPFlow_Vars ,ONLY: FPInitDone, FP_PrandtlNumber, FP_QualityFacSamp USE MOD_FPFlow_Vars ,ONLY: FP_MaxRelaxFactor, FP_MaxRotRelaxFactor, FP_MeanRelaxFactor, FP_MeanRelaxFactorCounter USE MOD_part_tools ,ONLY: GetParticleWeight @@ -556,7 +560,7 @@ SUBROUTINE BGK_quadtree_adapt(iElem) IF(DSMC%CalcQualityFactors) THEN IF(BGKInitDone) THEN BGK_MeanRelaxFactorCounter = 0; BGK_MeanRelaxFactor = 0.; BGK_MaxRelaxFactor = 0.; BGK_MaxRotRelaxFactor = 0. - BGK_PrandtlNumber=0.; BGK_ExpectedPrandtlNumber=0. + BGK_PrandtlNumber=0.; BGK_ExpectedPrandtlNumber=0.; BGK_Viscosity=0.; BGK_ThermalConductivity=0. END IF IF(FPInitDone) THEN FP_MeanRelaxFactorCounter = 0; FP_MeanRelaxFactor = 0.; FP_MaxRelaxFactor = 0.; FP_MaxRotRelaxFactor = 0.; FP_PrandtlNumber = 0. @@ -641,6 +645,8 @@ SUBROUTINE BGK_quadtree_adapt(iElem) BGK_QualityFacSamp(5,iElem) = BGK_QualityFacSamp(5,iElem) + BGK_MaxRotRelaxFactor BGK_QualityFacSamp(6,iElem) = BGK_QualityFacSamp(6,iElem) + BGK_PrandtlNumber BGK_QualityFacSamp(7,iElem) = BGK_QualityFacSamp(7,iElem) + BGK_ExpectedPrandtlNumber + BGK_QualityFacSamp(8,iElem) = BGK_QualityFacSamp(8,iElem) + BGK_Viscosity + BGK_QualityFacSamp(9,iElem) = BGK_QualityFacSamp(9,iElem) + BGK_ThermalConductivity END IF IF(FPInitDone) THEN FP_QualityFacSamp(1,iElem) = FP_QualityFacSamp(1,iElem) + FP_MeanRelaxFactor diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 62916eefb..22fc50b31 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -56,7 +56,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) USE MOD_TimeDisc_Vars ,ONLY: dt USE MOD_BGK_Vars ,ONLY: SpecBGK, BGKDoVibRelaxation!, BGKMovingAverageLength USE MOD_BGK_Vars ,ONLY: BGK_MeanRelaxFactor, BGK_MeanRelaxFactorCounter, BGK_MaxRelaxFactor, BGK_MaxRotRelaxFactor -USE MOD_BGK_Vars ,ONLY: BGK_PrandtlNumber +USE MOD_BGK_Vars ,ONLY: BGK_PrandtlNumber, BGK_Viscosity, BGK_ThermalConductivity USE MOD_part_tools ,ONLY: GetParticleWeight #ifdef CODE_ANALYZE USE MOD_Globals ,ONLY: abort,unit_stdout,myrank @@ -76,6 +76,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) ! LOCAL VARIABLES REAL :: vBulk(3), u0ij(3,3), u2, V_rel(3), dtCell REAL :: alpha, alphaRot(nSpecies), CellTemp, dens, InnerDOF, NewEn, OldEn, Prandtl, relaxfreq, TEqui +REAL :: dynamicvis, thermalcond INTEGER, ALLOCATABLE :: iPartIndx_NodeRelax(:),iPartIndx_NodeRelaxTemp(:),iPartIndx_NodeRelaxRot(:),iPartIndx_NodeRelaxVib(:) INTEGER :: iLoop, iPart, nRelax, iPolyatMole, nXiVibDOF REAL, ALLOCATABLE :: Xi_vib_DOF(:), VibEnergyDOF(:,:) @@ -117,7 +118,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) CALL CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, totalWeightSpec, TotalMass, u2, u2Spec, u0ij, & u2i, OldEn, EVibSpec, ERotSpec, CellTemp, SpecTemp, dtCell) -IF((CellTemp.LE.0).OR.(MAXVAL(nSpec(:)).EQ.1).OR.(totalWeight.LE.0.0)) RETURN +IF((CellTemp.LE.0.0).OR.(MAXVAL(nSpec(:)).EQ.1).OR.(totalWeight.LE.0.0)) RETURN IF(VarTimeStep%UseVariableTimeStep) THEN dtCell = dt * dtCell / totalWeight @@ -150,13 +151,15 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) ! 2.) Calculation of the relaxation frequency of the distribution function towards the target distribution function CALL CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight, TotalMass, u2Spec, u0ij, u2, SpecTemp, CellTemp, & - Xi_VibSpec, Xi_RotSpec, Prandtl, relaxfreq) + Xi_VibSpec, Xi_RotSpec, Prandtl, relaxfreq, dynamicvis, thermalcond) IF(DSMC%CalcQualityFactors) THEN BGK_MeanRelaxFactor = BGK_MeanRelaxFactor + relaxfreq * dtCell BGK_MeanRelaxFactorCounter = BGK_MeanRelaxFactorCounter + 1 BGK_MaxRelaxFactor = MAX(BGK_MaxRelaxFactor,relaxfreq*dtCell) BGK_PrandtlNumber = BGK_PrandtlNumber + Prandtl + BGK_Viscosity = BGK_Viscosity + dynamicvis + BGK_ThermalConductivity = BGK_ThermalConductivity + thermalcond END IF ! 3.) Treatment of molecules: determination of the rotational and vibrational relaxation frequency using the collision frequency, @@ -355,6 +358,7 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota INTEGER :: iLoop, iPart, iSpec, fillMa1, fillMa2 REAL :: V_rel(1:3), vmag2, partWeight, EnerTotal, totalWeightSpec2(nSpecies), vBulkSpec(3,nSpecies) REAL :: tempweight, tempweight2, tempmass, vBulkTemp(3), totalWeight2, totalWeight3 +LOGICAL :: validSpec(nSpecies) !=================================================================================================================================== totalWeightSpec = 0.0; totalWeightSpec2=0.0; vBulkAll=0.0; TotalMass=0.0; vBulkSpec=0.0; nSpec=0; dtCell=0.0 ! Loop over all simulation particles to sum up bulk velocities @@ -375,8 +379,6 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota totalWeight = SUM(totalWeightSpec) totalWeight2 = SUM(totalWeightSpec2) -IF ((MAXVAL(nSpec(:)).EQ.1).OR.(totalWeight.LE.0.0)) RETURN - ! Calculate bulk velocities vBulkAll(1:3) = vBulkAll(1:3) / TotalMass DO iSpec = 1, nSpecies @@ -429,11 +431,13 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota ! Calculation of cell temperature and bulk velocity (squared) IF (nSpecies.GT.1) THEN ! mixture + validSpec = .FALSE. SpecTemp = 0.0 EnerTotal = 0.0 tempweight = 0.0; tempweight2 = 0.0; tempmass = 0.0; vBulkTemp = 0.0 DO iSpec = 1, nSpecies IF ((nSpec(iSpec).GE.2).AND.(.NOT.ALMOSTZERO(u2Spec(iSpec)))) THEN + validSpec = .TRUE. SpecTemp(iSpec) = Species(iSpec)%MassIC * u2Spec(iSpec) & /(3.0*BoltzmannConst*(totalWeightSpec(iSpec) - totalWeightSpec2(iSpec)/totalWeightSpec(iSpec))) EnerTotal = EnerTotal + 3./2.*BoltzmannConst*SpecTemp(iSpec) * totalWeightSpec(iSpec) ! thermal energy @@ -445,11 +449,16 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota vBulkTemp(1:3) = vBulkTemp(1:3) + vBulkSpec(1:3,iSpec)*totalWeightSpec(iSpec) * Species(iSpec)%MassIC END IF END DO - vBulkTemp(1:3) = vBulkTemp(1:3) / tempmass - vmag2 = DOTPRODUCT(vBulkTemp(1:3)) - EnerTotal = EnerTotal - tempmass / 2. * vmag2 - CellTemp = 2. * EnerTotal / (3.*tempweight*BoltzmannConst) - u2 = 3. * CellTemp * BoltzmannConst * (tempweight - tempweight2/tempweight) / tempmass + IF (ANY(validSpec)) THEN + vBulkTemp(1:3) = vBulkTemp(1:3) / tempmass + vmag2 = DOTPRODUCT(vBulkTemp(1:3)) + EnerTotal = EnerTotal - tempmass / 2. * vmag2 + CellTemp = 2. * EnerTotal / (3.*tempweight*BoltzmannConst) + u2 = 3. * CellTemp * BoltzmannConst * (tempweight - tempweight2/tempweight) / tempmass + ELSE ! only one part per species or cloned species with u2spec = 0 because PartState(4:6) = vBulkAll + u2 = OldEn / (TotalMass*(1. - totalWeight2/totalWeight**2)) * 2. ! variance-free + CellTemp = TotalMass/totalWeight * u2 / (3.0*BoltzmannConst) + END IF ELSE ! single species gas u2 = u2Spec(1) / (totalWeight - totalWeight2/totalWeight) CellTemp = Species(1)%MassIC * u2 / (3.0*BoltzmannConst) @@ -527,7 +536,7 @@ SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, T END SUBROUTINE CalcInnerDOFs SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight, TotalMass, u2Spec, u0ij, u2, SpecTemp, CellTemp, & - Xi_VibSpec, Xi_RotSpec, Prandtl, relaxfreq) + Xi_VibSpec, Xi_RotSpec, Prandtl, relaxfreq, dynamicvis, thermalcond) !=================================================================================================================================== !> Calculate the reference dynamic viscosity, Prandtl number and the resulting relaxation frequency of the distribution function !=================================================================================================================================== @@ -545,13 +554,13 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight REAL, INTENT(IN) :: u0ij(3,3), u2, Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies), dens, InnerDOF !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES -REAL, INTENT(OUT) :: Prandtl, relaxfreq +REAL, INTENT(OUT) :: Prandtl, relaxfreq, dynamicvis, thermalcond !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES INTEGER :: iSpec, jSpec, INFO REAL :: MolarFraction(1:nSpecies), MassFraction(1:nSpecies), MassIC_Mixture REAL :: PrandtlCorrection, dynamicvisSpec(nSpecies), thermalcondSpec(nSpecies), Phi(nSpecies) -REAL :: dynamicvis, thermalcond, C_P, nu, A(3,3), W(3), Theta, CellTempSpec(nSpecies+1), Work(100) +REAL :: C_P, nu, A(3,3), W(3), Theta, CellTempSpec(nSpecies+1), Work(100) !=================================================================================================================================== IF (nSpecies.GT.1) THEN ! gas mixture MolarFraction(1:nSpecies) = totalWeightSpec(1:nSpecies) / totalWeight @@ -563,7 +572,7 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight DO iSpec = 1, nSpecies IF (nSpec(iSpec).EQ.0) CYCLE ! Correction of Pr for calculation of relaxation frequency, see alpha - Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), - ! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar–Gross–Krook method for monatomic gas species" + ! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar-Gross-Krook method for monatomic gas species" PrandtlCorrection = PrandtlCorrection + MolarFraction(iSpec)*MassIC_Mixture/Species(iSpec)%MassIC IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN ! molecules C_P = C_P + ((5. + (Xi_VibSpec(iSpec)+Xi_RotSpec(iSpec)))/2.) * BoltzmannConst / Species(iSpec)%MassIC * MassFraction(iSpec) @@ -574,7 +583,7 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight SELECT CASE(BGKMixtureModel) ! Both cases are described in Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), - ! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar–Gross–Krook method for monatomic gas species" + ! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar-Gross-Krook method for monatomic gas species" CASE (1) ! Wilke's mixing rules DO iSpec = 1, nSpecies @@ -1743,7 +1752,7 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ ! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 160 ViscSpec(iSpec) = (5./8.)*(BoltzmannConst*CellTemp(iSpec))/Sigma_22 ThermalCondSpec(iSpec) = (25./16.)*(cv*BoltzmannConst*CellTemp(iSpec))/Sigma_22 - !ThermalCondSpec(iSpec) = (15./4.)*BoltzmannConst/(2.*Mass)*ViscSpec(iSpec) + ! results in in same as ThermalCondSpec(iSpec) = (15./4.)*BoltzmannConst/(2.*Mass)*ViscSpec(iSpec) ! Additional calculation of Sigma_11VHS and the diffusion coefficient for molecular species IF ((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN CALL CalcSigma_11VHS(CellTemp(nSpecies+1),InteractDiam,Mass,TVHS, omegaVHS, Sigma_11) @@ -1756,7 +1765,7 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ CALL CalcSigma_11VHS(CellTemp(nSpecies+1),InteractDiam,Mass,TVHS, omegaVHS, Sigma_11) ! Parameters for calculation of contribution of species to mixture transport coefficients ! Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), - ! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar–Gross–Krook method for monatomic gas species" + ! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar-Gross-Krook method for monatomic gas species" B_12(iSpec,jSpec) = (5.*GAMMA(4.-omegaVHS)-GAMMA(5.-omegaVHS))/(5.*GAMMA(3.-omegaVHS)) B_12(jSpec,iSpec) = B_12(iSpec,jSpec) A_12(iSpec,jSpec) = Sigma_22 / (5.*Sigma_11) @@ -1783,42 +1792,50 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ ! Calculate mixture viscosity by solving a system of linear equations with matrices ! Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), -! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar–Gross–Krook method for monatomic gas species" +! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar-Gross-Krook method for monatomic gas species" ViscMat = 0.0 DO iSpec = 1, nSpecies - IF (Xi(iSpec).LE.0.0) CYCLE + IF (Xi(iSpec).LE.0.0) THEN + ViscMat(iSpec,iSpec) = 1. ! Ensure invertibility of ViscMat + CYCLE + END IF DO jSpec = 1, nSpecies IF (Xi(jSpec).LE.0.0) CYCLE IF (iSpec.EQ.jSpec) THEN - ViscMat(iSpec, jSpec) = ViscMat(iSpec, jSpec) + Xi(iSpec)/ViscSpec(iSpec) + ViscMat(iSpec, jSpec) = Xi(iSpec)/ViscSpec(iSpec) DO kSpec = 1, nSpecies - IF(kSpec.EQ.iSpec) CYCLE + IF (Xi(kSpec).LE.0.0) CYCLE + IF (kSpec.EQ.iSpec) CYCLE ViscMat(iSpec, jSpec) = ViscMat(iSpec, jSpec) + 3.*Xi(kSpec) / ((Species(iSpec)%MassIC*dens & - + Species(kSpec)%MassIC*dens)*DiffCoef(iSpec,kSpec))*(2./3.+Species(kSpec)%MassIC/Species(iSpec)%MassIC*A_12(iSpec,kSpec)) + + Species(kSpec)%MassIC*dens)*DiffCoef(iSpec,kSpec))*(2./3.+Species(kSpec)%MassIC/Species(iSpec)%MassIC*A_12(iSpec,kSpec)) END DO ELSE - ViscMat(iSpec, jSpec) = ViscMat(iSpec, jSpec) - Xi(iSpec)*3. / ((Species(iSpec)%MassIC*dens & + ViscMat(iSpec, jSpec) = -Xi(iSpec)*3. / ((Species(iSpec)%MassIC*dens & + Species(jSpec)%MassIC*dens)*DiffCoef(iSpec,jSpec))*(2./3.-A_12(iSpec,jSpec)) END IF END DO - RHSSolve(iSpec) = Xi(iSpec) END DO +RHSSolve(:) = Xi(:) CALL DGESV(nSpecies, 1, ViscMat, nSpecies, IPIV, RHSSolve, nSpecies, info_dgesv) Visc = SUM(RHSSolve) ! Calculate mixture thermal conductivity by solving a system of linear equations with matrices ! Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), -! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar–Gross–Krook method for monatomic gas species" +! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar-Gross-Krook method for monatomic gas species" pressure = BoltzmannConst*dens*CellTemp(nSpecies+1) ViscMat = 0.0 DO iSpec = 1, nSpecies - IF (Xi(iSpec).LE.0.0) CYCLE + IF (Xi(iSpec).LE.0.0) THEN + ViscMat(iSpec,iSpec) = 1. ! Ensure invertibility of ViscMat + CYCLE + END IF DO jSpec = 1, nSpecies IF (Xi(jSpec).LE.0.0) CYCLE IF (iSpec.EQ.jSpec) THEN - ViscMat(iSpec, jSpec) = ViscMat(iSpec, jSpec) + Xi(iSpec)/ThermalCondSpec(iSpec) + ViscMat(iSpec, jSpec) = Xi(iSpec)/ThermalCondSpec(iSpec) DO kSpec = 1, nSpecies - IF(kSpec.EQ.iSpec) CYCLE + IF (Xi(kSpec).LE.0.0) CYCLE + IF (kSpec.EQ.iSpec) CYCLE m0 = Species(iSpec)%MassIC+Species(kSpec)%MassIC ViscMat(iSpec, jSpec) = ViscMat(iSpec, jSpec) + CellTemp(nSpecies+1)*Xi(kSpec)/(5.*pressure*DiffCoef(iSpec,kSpec)) & * (6.*Species(iSpec)%MassIC**2./m0**2.+(5.-4.*B_12(iSpec,kSpec))*Species(kSpec)%MassIC**2./m0**2. & @@ -1826,13 +1843,12 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ END DO ELSE m0 = Species(iSpec)%MassIC+Species(jSpec)%MassIC - ViscMat(iSpec, jSpec) = ViscMat(iSpec, jSpec) - Xi(iSpec)*CellTemp(nSpecies+1) & - *(Species(iSpec)%MassIC*Species(jSpec)%MassIC/m0**2.)/(5.*pressure*DiffCoef(iSpec,jSpec)) & - *(11.-4.*B_12(iSpec,jSpec)-8.*A_12(iSpec,jSpec)) + ViscMat(iSpec, jSpec) = -Xi(iSpec)*CellTemp(nSpecies+1) * (Species(iSpec)%MassIC*Species(jSpec)%MassIC/m0**2.) & + /(5.*pressure*DiffCoef(iSpec,jSpec)) *(11.-4.*B_12(iSpec,jSpec)-8.*A_12(iSpec,jSpec)) END IF END DO - RHSSolve(iSpec) = Xi(iSpec) END DO +RHSSolve(:) = Xi(:) CALL DGESV(nSpecies, 1, ViscMat, nSpecies, IPIV, RHSSolve, nSpecies, info_dgesv) ! Thermal conductivity from translation, rotation and vibration ThermalCond = SUM(RHSSolve) + SUM(ThermalCondSpec_Rot) + SUM(ThermalCondSpec_Vib) diff --git a/src/particles/bgk/bgk_init.f90 b/src/particles/bgk/bgk_init.f90 index 70f0ddfe7..ae7b7ecb0 100644 --- a/src/particles/bgk/bgk_init.f90 +++ b/src/particles/bgk/bgk_init.f90 @@ -110,7 +110,6 @@ SUBROUTINE InitBGK() !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES INTEGER :: iSpec, iSpec2 -REAL :: delta_ij LOGICAL :: MoleculePresent !=================================================================================================================================== LBWRITE(UNIT_stdOut,'(A)') ' INIT BGK Solver...' @@ -178,8 +177,8 @@ SUBROUTINE InitBGK() END IF IF(DSMC%CalcQualityFactors) THEN - ALLOCATE(BGK_QualityFacSamp(1:7,nElems)) - BGK_QualityFacSamp(1:7,1:nElems) = 0.0 + ALLOCATE(BGK_QualityFacSamp(1:9,nElems)) + BGK_QualityFacSamp(1:9,1:nElems) = 0.0 END IF BGKInitDone = .TRUE. diff --git a/src/particles/bgk/bgk_main.f90 b/src/particles/bgk/bgk_main.f90 index 7118f5766..bcaf2d04a 100644 --- a/src/particles/bgk/bgk_main.f90 +++ b/src/particles/bgk/bgk_main.f90 @@ -48,6 +48,7 @@ SUBROUTINE BGK_DSMC_main(stage_opt) ! USE MOD_BGK_Vars ,ONLY: BGKMovingAverage,ElemNodeAveraging,BGKMovingAverageLength USE MOD_BGK_Vars ,ONLY: BGK_MeanRelaxFactor,BGK_MeanRelaxFactorCounter,BGK_MaxRelaxFactor,BGK_QualityFacSamp USE MOD_BGK_Vars ,ONLY: BGK_MaxRotRelaxFactor, BGK_PrandtlNumber, BGK_ExpectedPrandtlNumber +USE MOD_BGK_Vars ,ONLY: BGK_Viscosity, BGK_ThermalConductivity USE MOD_BGK_CollOperator ,ONLY: BGK_CollisionOperator USE MOD_DSMC ,ONLY: DSMC_main USE MOD_DSMC_Vars ,ONLY: DSMC, RadialWeighting @@ -128,7 +129,7 @@ SUBROUTINE BGK_DSMC_main(stage_opt) IF(DSMC%CalcQualityFactors) THEN BGK_MeanRelaxFactorCounter = 0; BGK_MeanRelaxFactor = 0.; BGK_MaxRelaxFactor = 0.; BGK_MaxRotRelaxFactor = 0. - BGK_PrandtlNumber=0.; BGK_ExpectedPrandtlNumber=0. + BGK_PrandtlNumber=0.; BGK_ExpectedPrandtlNumber=0.; BGK_Viscosity=0.; BGK_ThermalConductivity=0. END IF ! IF (BGKMovingAverage) THEN ! CALL BGK_CollisionOperator(iPartIndx_Node, nPart, ElemVolume_Shared(CNElemID), & @@ -147,6 +148,8 @@ SUBROUTINE BGK_DSMC_main(stage_opt) BGK_QualityFacSamp(5,iElem) = BGK_QualityFacSamp(5,iElem) + BGK_MaxRotRelaxFactor BGK_QualityFacSamp(6,iElem) = BGK_QualityFacSamp(6,iElem) + BGK_PrandtlNumber BGK_QualityFacSamp(7,iElem) = BGK_QualityFacSamp(7,iElem) + BGK_ExpectedPrandtlNumber + BGK_QualityFacSamp(8,iElem) = BGK_QualityFacSamp(8,iElem) + BGK_Viscosity + BGK_QualityFacSamp(9,iElem) = BGK_QualityFacSamp(9,iElem) + BGK_ThermalConductivity END IF END IF END IF @@ -172,6 +175,7 @@ SUBROUTINE BGK_main(stage_opt) USE MOD_BGK_Vars ,ONLY: DoBGKCellAdaptation!, BGKMovingAverage, ElemNodeAveraging, BGKMovingAverageLength USE MOD_BGK_Vars ,ONLY: BGK_MeanRelaxFactor,BGK_MeanRelaxFactorCounter,BGK_MaxRelaxFactor,BGK_QualityFacSamp USE MOD_BGK_Vars ,ONLY: BGK_MaxRotRelaxFactor, BGK_PrandtlNumber, BGK_ExpectedPrandtlNumber +USE MOD_BGK_Vars ,ONLY: BGK_Viscosity, BGK_ThermalConductivity USE MOD_BGK_CollOperator ,ONLY: BGK_CollisionOperator USE MOD_DSMC_Analyze ,ONLY: DSMCMacroSampling USE MOD_Particle_Mesh_Vars ,ONLY: ElemVolume_Shared @@ -234,7 +238,7 @@ SUBROUTINE BGK_main(stage_opt) IF(DSMC%CalcQualityFactors) THEN BGK_MeanRelaxFactorCounter = 0; BGK_MeanRelaxFactor = 0.; BGK_MaxRelaxFactor = 0.; BGK_MaxRotRelaxFactor = 0. - BGK_PrandtlNumber=0.; BGK_ExpectedPrandtlNumber=0. + BGK_PrandtlNumber=0.; BGK_ExpectedPrandtlNumber=0.; BGK_Viscosity=0.; BGK_ThermalConductivity=0. END IF ! IF (BGKMovingAverage) THEN @@ -254,6 +258,8 @@ SUBROUTINE BGK_main(stage_opt) BGK_QualityFacSamp(5,iElem) = BGK_QualityFacSamp(5,iElem) + BGK_MaxRotRelaxFactor BGK_QualityFacSamp(6,iElem) = BGK_QualityFacSamp(6,iElem) + BGK_PrandtlNumber BGK_QualityFacSamp(7,iElem) = BGK_QualityFacSamp(7,iElem) + BGK_ExpectedPrandtlNumber + BGK_QualityFacSamp(8,iElem) = BGK_QualityFacSamp(8,iElem) + BGK_Viscosity + BGK_QualityFacSamp(9,iElem) = BGK_QualityFacSamp(9,iElem) + BGK_ThermalConductivity END IF END IF END DO diff --git a/src/particles/bgk/bgk_vars.f90 b/src/particles/bgk/bgk_vars.f90 index 536ea1dff..0779e4eff 100644 --- a/src/particles/bgk/bgk_vars.f90 +++ b/src/particles/bgk/bgk_vars.f90 @@ -48,6 +48,8 @@ MODULE MOD_BGK_Vars REAL :: BGK_MaxRotRelaxFactor REAL :: BGK_PrandtlNumber REAL :: BGK_ExpectedPrandtlNumber +REAL :: BGK_Viscosity +REAL :: BGK_ThermalConductivity TYPE tElemNodeAveraging TYPE (tNodeAverage), POINTER :: Root => null() diff --git a/src/particles/dsmc/dsmc_analyze.f90 b/src/particles/dsmc/dsmc_analyze.f90 index d8276bd83..fb702d98b 100644 --- a/src/particles/dsmc/dsmc_analyze.f90 +++ b/src/particles/dsmc/dsmc_analyze.f90 @@ -951,16 +951,20 @@ SUBROUTINE DSMC_output_calc(nVar,nVar_quality,nVarloc,DSMC_MacroVal) DSMC_MacroVal(nVarCount+2,iElem) = BGK_QualityFacSamp(6,iElem) / BGK_QualityFacSamp(2,iElem) ! Mean expected Prandtl number DSMC_MacroVal(nVarCount+3,iElem) = BGK_QualityFacSamp(7,iElem) / BGK_QualityFacSamp(2,iElem) + ! Mean viscosity + DSMC_MacroVal(nVarCount+4,iElem) = BGK_QualityFacSamp(8,iElem) / BGK_QualityFacSamp(2,iElem) + ! Mean thermal conductivity + DSMC_MacroVal(nVarCount+5,iElem) = BGK_QualityFacSamp(9,iElem) / BGK_QualityFacSamp(2,iElem) END IF IF(BGK_QualityFacSamp(4,iElem).GT.0) THEN ! Max relaxation factor (maximal value of all octree subcells) - DSMC_MacroVal(nVarCount+4,iElem) = BGK_QualityFacSamp(3,iElem) / BGK_QualityFacSamp(4,iElem) + DSMC_MacroVal(nVarCount+6,iElem) = BGK_QualityFacSamp(3,iElem) / BGK_QualityFacSamp(4,iElem) ! Max rotational relaxation factor - DSMC_MacroVal(nVarCount+5,iElem) = BGK_QualityFacSamp(5,iElem) / BGK_QualityFacSamp(4,iElem) + DSMC_MacroVal(nVarCount+7,iElem) = BGK_QualityFacSamp(5,iElem) / BGK_QualityFacSamp(4,iElem) END IF ! Ratio between BGK and DSMC usage per cell - DSMC_MacroVal(nVarCount+6,iElem) = BGK_QualityFacSamp(4,iElem) / iter_loc - nVarCount = nVarCount + 6 + DSMC_MacroVal(nVarCount+8,iElem) = BGK_QualityFacSamp(4,iElem) / iter_loc + nVarCount = nVarCount + 8 END IF ! variable rotation and vibration relaxation IF(Collismode.GT.1) THEN @@ -1054,7 +1058,7 @@ SUBROUTINE WriteDSMCToHDF5(MeshFileName,OutputTime,FutureTime) nVar_quality=3 IF(VarTimeStep%UseVariableTimeStep) nVar_quality = nVar_quality + 1 IF(RadialWeighting%PerformCloning) nVar_quality = nVar_quality + 2 - IF(BGKInitDone) nVar_quality = nVar_quality + 6 + IF(BGKInitDone) nVar_quality = nVar_quality + 8 IF(FPInitDone) nVar_quality = nVar_quality + 5 ELSE nVar_quality=0 @@ -1136,10 +1140,12 @@ SUBROUTINE WriteDSMCToHDF5(MeshFileName,OutputTime,FutureTime) StrVarNames(nVarCount+1) ='BGK_MeanRelaxationFactor' StrVarNames(nVarCount+2) ='BGK_MeanPrandtlNumber' StrVarNames(nVarCount+3) ='BGK_ExpectedPrandtlNumber' - StrVarNames(nVarCount+4) ='BGK_MaxRelaxationFactor' - StrVarNames(nVarCount+5) ='BGK_MaxRotationRelaxFactor' - StrVarNames(nVarCount+6) ='BGK_DSMC_Ratio' - nVarCount=nVarCount+6 + StrVarNames(nVarCount+4) ='BGK_Viscosity' + StrVarNames(nVarCount+5) ='BGK_ThermalConductivity' + StrVarNames(nVarCount+6) ='BGK_MaxRelaxationFactor' + StrVarNames(nVarCount+7) ='BGK_MaxRotationRelaxFactor' + StrVarNames(nVarCount+8) ='BGK_DSMC_Ratio' + nVarCount=nVarCount+8 END IF IF(FPInitDone) THEN StrVarNames(nVarCount+1) ='FP_MeanRelaxationFactor' From b93c44729071ec3e9b867802ac85735ed0e2ea00 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Mon, 30 Jan 2023 18:02:52 +0100 Subject: [PATCH 10/41] BGK collision operator: comments and references --- src/particles/bgk/bgk_colloperator.f90 | 309 +++++++++++++++++++++---- 1 file changed, 263 insertions(+), 46 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 22fc50b31..948a30f77 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -163,7 +163,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) END IF ! 3.) Treatment of molecules: determination of the rotational and vibrational relaxation frequency using the collision frequency, -! which is not the same as the relaxation frequency of distribution function, calculated above. +! which is not the same as the relaxation frequency of distribution function, calculated above IF(ANY(SpecDSMC(:)%InterID.EQ.2).OR.ANY(SpecDSMC(:)%InterID.EQ.20)) THEN collisionfreqSpec = 0.0 DO iSpec = 1, nSpecies @@ -175,19 +175,25 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) END IF ! Sum up collision frequencies of species i with itself and the other species ! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 87f + ! For SpecBGK(iSpec)%CollFreqPreFactor(jSpec) see bgk_init.f90 collisionfreqSpec(iSpec) = collisionfreqSpec(iSpec) + SpecBGK(iSpec)%CollFreqPreFactor(jSpec) * totalWeightSpec(jSpec) & * (Dens / totalWeight) *CellTemptmp**(-CollInf%omega(iSpec,jSpec) +0.5) END DO END DO ! Calculate relaxation frequencies of rotation and vibration with relaxation properties + ! M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules including + ! quantized vibrational energies", Phys. Fluids 30, 116103 (2018) + ! N.E. Gimelshein et. al, "Vibrational relaxation rates in the direct simulation Monte Carlo method", Phys. Fluids 14, 4452 (2018) + ! relaxfreqSpec = collisionfreqSpec / collision number Z with RelaxProb = 1/Z rotrelaxfreqSpec(:) = collisionfreqSpec(:) * DSMC%RotRelaxProb vibrelaxfreqSpec(:) = collisionfreqSpec(:) * DSMC%VibRelaxProb RotExpSpec=0.; VibExpSpec=0. ! Calculation of the equilibrium temperature - IF(SpecDSMC(1)%PolyatomicMol) THEN ! polyatomic, no mixtures possible by now + IF(SpecDSMC(1)%PolyatomicMol) THEN ! polyatomic, NO MIXTURES POSSIBLE BY NOW CALL CalcTEquiPoly(nPart, CellTemp, TRotSpec(1), TVibSpec(1), nXiVibDOF, Xi_vib_DOF, Xi_Vib_oldSpec(1), RotExpSpec(1), VibExpSpec(1), & TEqui, rotrelaxfreqSpec(1), vibrelaxfreqSpec(1), dtCell) + ! Corrected vibrational degrees of freedom Xi_VibSpec(1) = SUM(Xi_vib_DOF(1:PolyatomMolDSMC(iPolyatMole)%VibDOF)) ELSE ! diatomic CALL CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec, Xi_Vib_oldSpec, RotExpSpec, VibExpSpec, & @@ -207,6 +213,8 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) CALL DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, RotExpSpec, VibExpSpec, nRelax, nRotRelax, nVibRelax, & nRotRelaxSpec, nVibRelaxSpec, iPartIndx_NodeRelax, iPartIndx_NodeRelaxTemp, iPartIndx_NodeRelaxRot, & iPartIndx_NodeRelaxVib, vBulk, OldEnRot, OldEn) + +! Return if no particles are undergoing a relaxation IF ((nRelax.EQ.0).AND.(nRotRelax.EQ.0).AND.(nVibRelax.EQ.0)) RETURN IF(BGKDoVibRelaxation) THEN @@ -223,19 +231,28 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) CALL SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, u2i, vBulkAll, CellTemp, vBulk) NewEn = 0. + +! Calculation of the new bulk velocity vBulk = vBulk/TotalMass + +! Loop over all relaxing particles for calculation of the new energy DO iLoop = 1, nRelax iPart = iPartIndx_NodeRelax(iLoop) iSpec = PartSpecies(iPart) partWeight = GetParticleWeight(iPart) + ! Thermal velocity of all relaxing particles V_rel(1:3) = PartState(4:6,iPart) - vBulk(1:3) + ! Sum up kinetic energies NewEn = NewEn + (V_rel(1)**(2.) + V_rel(2)**(2.) + V_rel(3)**(2.))*0.5*Species(iSpec)%MassIC*partWeight END DO +! Loop over all non-relaxing particles for calculation of the new energy DO iLoop = 1, nPart-nRelax iPart = iPartIndx_NodeRelaxTemp(iLoop) iSpec = PartSpecies(iPart) partWeight = GetParticleWeight(iPart) + ! Thermal velocity of all non-relaxing particles V_rel(1:3) = PartState(4:6,iPart) - vBulk(1:3) + ! Sum up kinetic energies NewEn = NewEn + (V_rel(1)**(2.) + V_rel(2)**(2.) + V_rel(3)**(2.))*0.5*Species(iSpec)%MassIC*partWeight END DO @@ -244,14 +261,21 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) CALL EnergyConsVib(nPart, nVibRelax, nVibRelaxSpec, iPartIndx_NodeRelaxVib, NewEnVib, OldEn, nXiVibDOF, Xi_VibSpec, VibEnergyDOF, TEqui) END IF +! Remaining vibrational (+ translational) energy + rotational energy for translation and rotation OldEn = OldEn + OldEnRot -! 8.) Determine the new particle state and ensure energy conservation by scaling the new velocities with the factor alpha. +! 8.) Determine the new particle state and ensure energy conservation by scaling the new velocities with the factor alpha Xi_RotTotal = 0.0 +! ! Total number of relaxing rotational degrees of freedom DO iSpec = 1, nSpecies Xi_RotTotal = Xi_RotTotal + Xi_RotSpec(iSpec)*nRotRelaxSpec(iSpec) END DO +! Calculation of scaling factor alpha, see M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method +! to diatomic molecules including quantized vibrational energies", Phys. Fluids 30, 116103 (2018) alpha = SQRT(OldEn/NewEn*(3.*(nPart-1.))/(Xi_RotTotal+3.*(nPart-1.))) +! Calculation of the final particle velocities with vBulkAll (average flow velocity before relaxation), scaling factor alpha, +! the particle velocity PartState(4:6,iPart) after the relaxation but before the energy conservation and vBulk (average value of +! the latter) DO iLoop = 1, nRelax iPart = iPartIndx_NodeRelax(iLoop) PartState(4:6,iPart) = vBulkAll(1:3) + alpha*(PartState(4:6,iPart)-vBulk(1:3)) @@ -263,6 +287,8 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) ! 9.) Rotation: Scale the new rotational state of the molecules to ensure energy conservation DO iSpec = 1, nSpecies + ! Calculate scaling factor alpha per species, see M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross- + ! Krook method to diatomic molecules including quantized vibrational energies", Phys. Fluids 30, 116103 (2018) IF (NewEnRot(iSpec).GT.0.0) THEN alphaRot(iSpec) = OldEn/NewEnRot(iSpec)*(Xi_RotSpec(iSpec)*nRotRelaxSpec(iSpec)/(Xi_RotTotal+3.*(nPart-1.))) ELSE @@ -272,6 +298,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) DO iLoop = 1, nRotRelax iPart = iPartIndx_NodeRelaxRot(iLoop) iSpec = PartSpecies(iPart) + ! Scaling of rotational energy with factor alpha PartStateIntEn( 2,iPart) = alphaRot(iSpec)*PartStateIntEn( 2,iPart) END DO @@ -330,6 +357,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) END SUBROUTINE BGK_CollisionOperator + SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, totalWeightSpec, TotalMass, u2, u2Spec, & u0ij, u2i, OldEn, EVibSpec, ERotSpec, CellTemp, SpecTemp, dtCell) !=================================================================================================================================== @@ -361,7 +389,7 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota LOGICAL :: validSpec(nSpecies) !=================================================================================================================================== totalWeightSpec = 0.0; totalWeightSpec2=0.0; vBulkAll=0.0; TotalMass=0.0; vBulkSpec=0.0; nSpec=0; dtCell=0.0 -! Loop over all simulation particles to sum up bulk velocities +! Loop over all simulation particles to sum up particle velocities to calculate bulk velocities DO iLoop = 1, nPart iPart = iPartIndx_Node(iLoop) partWeight = GetParticleWeight(iPart) @@ -379,7 +407,7 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota totalWeight = SUM(totalWeightSpec) totalWeight2 = SUM(totalWeightSpec2) -! Calculate bulk velocities +! Calculate total bulk velocity and bulk velocities per species vBulkAll(1:3) = vBulkAll(1:3) / TotalMass DO iSpec = 1, nSpecies IF (nSpec(iSpec).GT.0) vBulkSpec(:,iSpec) = vBulkSpec(:,iSpec) / totalWeightSpec(iSpec) @@ -413,7 +441,7 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota totalWeight3 = totalWeight3 + partWeight*partWeight*partWeight END IF - ! Sum up old energy of thermal velocities and calculate internal energies + ! Sum up old energy of thermal velocities and sum up internal energies OldEn = OldEn + 0.5*Species(iSpec)%MassIC * vmag2*partWeight IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN IF(BGKDoVibRelaxation) THEN @@ -424,7 +452,9 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota END IF END DO -u0ij = u0ij* totalWeight / (TotalMass*(totalWeight - totalWeight2/totalWeight)) ! ESBGK +IF (BGKCollModel.EQ.1) THEN ! ESBGK + u0ij = u0ij* totalWeight / (TotalMass*(totalWeight - totalWeight2/totalWeight)) +END IF IF (BGKCollModel.EQ.2) THEN ! Shakhov u2i = u2i*totalWeight**3/(TotalMass*(totalWeight**3-3.*totalWeight*totalWeight2+2.*totalWeight3)) END IF @@ -436,13 +466,17 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota EnerTotal = 0.0 tempweight = 0.0; tempweight2 = 0.0; tempmass = 0.0; vBulkTemp = 0.0 DO iSpec = 1, nSpecies + ! At least two particles and non-zero squared thermal velocity needed for a valid species IF ((nSpec(iSpec).GE.2).AND.(.NOT.ALMOSTZERO(u2Spec(iSpec)))) THEN validSpec = .TRUE. + ! Calculation of the species temperature SpecTemp(iSpec) = Species(iSpec)%MassIC * u2Spec(iSpec) & /(3.0*BoltzmannConst*(totalWeightSpec(iSpec) - totalWeightSpec2(iSpec)/totalWeightSpec(iSpec))) - EnerTotal = EnerTotal + 3./2.*BoltzmannConst*SpecTemp(iSpec) * totalWeightSpec(iSpec) ! thermal energy + ! Thermal energy + EnerTotal = EnerTotal + 3./2.*BoltzmannConst*SpecTemp(iSpec) * totalWeightSpec(iSpec) vmag2 = DOTPRODUCT(vBulkSpec(1:3,iSpec)) - EnerTotal = EnerTotal + totalWeightSpec(iSpec) * Species(iSpec)%MassIC / 2. * vmag2 ! kinetic energy + ! Add kinetic energy + EnerTotal = EnerTotal + totalWeightSpec(iSpec) * Species(iSpec)%MassIC / 2. * vmag2 tempweight = tempweight + totalWeightSpec(iSpec) tempweight2 = tempweight2 + totalWeightSpec2(iSpec) tempmass = tempmass + totalWeightSpec(iSpec) * Species(iSpec)%MassIC @@ -452,7 +486,9 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota IF (ANY(validSpec)) THEN vBulkTemp(1:3) = vBulkTemp(1:3) / tempmass vmag2 = DOTPRODUCT(vBulkTemp(1:3)) + ! EnerTotal = kinetic energy (tempmass / 2. * vmag2) + thermal energy (3. * tempweight * BoltzmannConst * CellTemp / 2) EnerTotal = EnerTotal - tempmass / 2. * vmag2 + ! Calculation of the cell temperature from the thermal energy CellTemp = 2. * EnerTotal / (3.*tempweight*BoltzmannConst) u2 = 3. * CellTemp * BoltzmannConst * (tempweight - tempweight2/tempweight) / tempmass ELSE ! only one part per species or cloned species with u2spec = 0 because PartState(4:6) = vBulkAll @@ -466,6 +502,7 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota END SUBROUTINE CalcMoments + SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, TRotSpec, InnerDOF, Xi_VibSpec, Xi_Vib_oldSpec & ,Xi_RotSpec) !=================================================================================================================================== @@ -495,6 +532,7 @@ SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, T Xi_VibSpec=0.; InnerDOF=0.; Xi_RotSpec=0.; Xi_Vib_oldSpec=0.; TVibSpec=0.; TRotSpec=0. DO iSpec = 1, nSpecies IF (nSpec(iSpec).EQ.0) CYCLE + ! Only for molecules IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN IF(BGKDoVibRelaxation) THEN IF(SpecDSMC(iSpec)%PolyatomicMol) THEN ! polyatomic @@ -503,7 +541,7 @@ SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, T TVibSpec(iSpec) = CalcTVibPoly(EVibSpec(iSpec)/totalWeightSpec(iSpec), 1) IF (TVibSpec(iSpec).GT.0.0) THEN DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF - ! Calculation of vibrational DOFs from Pfeiffer et. al., AIP Conference Proceedings 2132, 100001 (2019), + ! Calculation of vibrational DOFs according to Pfeiffer et. al., AIP Conference Proceedings 2132, 100001 (2019), ! "Extension of particle-based BGK models to polyatomic species in hypersonic flow around a flat-faced cylinder" exparg = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TVibSpec(iSpec) IF(CHECKEXP(exparg))THEN @@ -514,8 +552,9 @@ SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, T END DO END IF ELSE ! diatomic - ! Calculation of vibrational temperature and DOFs from Pfeiffer, Physics of Fluids 30, 116103 (2018), - ! "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules including quantized vibrational energies" + ! Calculation of vibrational temperature and DOFs from Pfeiffer, Physics of Fluids 30, 116103 (2018), "Extending the + ! particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules including quantized vibrational + ! energies" ! TVibSpec = vibrational energy without zero-point energy TVibSpec(iSpec) = EVibSpec(iSpec) / (totalWeightSpec(iSpec)*BoltzmannConst*SpecDSMC(iSpec)%CharaTVib) IF (TVibSpec(iSpec).GT.0.0) THEN @@ -526,8 +565,8 @@ SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, T Xi_Vib_oldSpec(iSpec) = Xi_VibSpec(iSpec) END IF Xi_RotSpec(iSpec) = SpecDSMC(iSpec)%Xi_Rot - ! Calculation of rotational temperature from Pfeiffer, Physics of Fluids 30, 116103 (2018), - ! "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules including quantized vibrational energies" + ! Calculation of rotational temperature from Pfeiffer, Physics of Fluids 30, 116103 (2018), "Extending the particle ellipsoidal + ! statistical Bhatnagar-Gross-Krook method to diatomic molecules including quantized vibrational energies" TRotSpec(iSpec) = 2.*ERotSpec(iSpec)/(Xi_RotSpec(iSpec)*totalWeightSpec(iSpec)*BoltzmannConst) END IF InnerDOF = InnerDOF + Xi_RotSpec(iSpec) + Xi_VibSpec(iSpec) @@ -535,6 +574,7 @@ SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, T END SUBROUTINE CalcInnerDOFs + SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight, TotalMass, u2Spec, u0ij, u2, SpecTemp, CellTemp, & Xi_VibSpec, Xi_RotSpec, Prandtl, relaxfreq, dynamicvis, thermalcond) !=================================================================================================================================== @@ -602,7 +642,8 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight END IF ! Thermal conductivity per species (Eucken's formula with a correction by Hirschfelder for the internal degrees of freedom) IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN ! inner DOF - ! Istomin et. al., "Eucken correction in high-temperature gases with electronic excitation", J. Chem. Phys. 140, 184311 (2014) + ! Istomin et. al., "Eucken correction in high-temperature gases with electronic excitation", J. Chem. Phys. 140, + ! 184311 (2014) thermalcondspec(iSpec) = 0.25 * (15. + 2. * (Xi_VibSpec(iSpec)+Xi_RotSpec(iSpec)) * 1.328) & * dynamicvisSpec(iSpec) * BoltzmannConst / Species(iSpec)%MassIC ELSE ! atoms @@ -675,6 +716,7 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight END SUBROUTINE CalcGasProperties + SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, RotExpSpec, VibExpSpec, nRelax, nRotRelax, nVibRelax, & nRotRelaxSpec, nVibRelaxSpec, iPartIndx_NodeRelax, iPartIndx_NodeRelaxTemp, iPartIndx_NodeRelaxRot, & iPartIndx_NodeRelaxVib, vBulk, OldEnRot, OldEn) @@ -707,36 +749,47 @@ SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, RotExpSp REAL :: ProbAddPartTrans, iRan, partWeight !=================================================================================================================================== nVibRelaxSpec =0; nRotRelaxSpec =0; nRelax=0; nNotRelax=0; vBulk=0.0; nRotRelax=0; nVibRelax=0; OldEnRot=0.0 +! Calculate probability of relaxation of a particle towards the target distribution function ProbAddPartTrans = 1.-EXP(-relaxfreq*dtCell) +! Loop over all simulation particles DO iLoop = 1, nPart iPart = iPartIndx_Node(iLoop) iSpec = PartSpecies(iPart) partWeight = GetParticleWeight(iPart) CALL RANDOM_NUMBER(iRan) + ! Count particles that are undergoing a relaxation IF (ProbAddPartTrans.GT.iRan) THEN nRelax = nRelax + 1 iPartIndx_NodeRelax(nRelax) = iPart + ! Count particles that are not undergoing a relaxation ELSE nNotRelax = nNotRelax + 1 iPartIndx_NodeRelaxTemp(nNotRelax) = iPart + ! Sum up velocities of non-relaxing particles for bulk velocity vBulk(1:3) = vBulk(1:3) + PartState(4:6,iPart)*Species(iSpec)%MassIC*partWeight END IF + + ! For molecules: relaxation of inner DOF IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - !Rotation + ! Rotation CALL RANDOM_NUMBER(iRan) + ! Count particles that are undergoing a relaxation, in total and per species IF ((1.-RotExpSpec(iSpec)).GT.iRan) THEN nRotRelax = nRotRelax + 1 nRotRelaxSpec(iSpec) = nRotRelaxSpec(iSpec) + 1 iPartIndx_NodeRelaxRot(nRotRelax) = iPart + ! Sum up total rotational energy OldEnRot = OldEnRot + PartStateIntEn(2,iPart) * partWeight END IF ! Vibration IF(BGKDoVibRelaxation) THEN CALL RANDOM_NUMBER(iRan) + ! Count particles that are undergoing a relaxation, in total and per species IF ((1.-VibExpSpec(iSpec)).GT.iRan) THEN nVibRelax = nVibRelax + 1 nVibRelaxSpec(iSpec) = nVibRelaxSpec(iSpec) + 1 iPartIndx_NodeRelaxVib(nVibRelax) = iPart + ! Sum up total vibrational energy, considering zero-point energy OldEn = OldEn + (PartStateIntEn(1,iPartIndx_NodeRelaxVib(nVibRelax)) - SpecDSMC(iSpec)%EZeroPoint) * partWeight END IF END IF @@ -745,6 +798,7 @@ SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, RotExpSp END SUBROUTINE DetermineRelaxPart + SUBROUTINE RelaxInnerEnergy(nPart, nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartIndx_NodeRelaxRot, nXiVibDOF, Xi_vib_DOF, Xi_VibSpec, & Xi_RotSpec , TEqui, VibEnergyDOF, NewEnVib, NewEnRot) !=================================================================================================================================== @@ -772,40 +826,51 @@ SUBROUTINE RelaxInnerEnergy(nPart, nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, INTEGER :: iLoop, iPart, iDOF, iPolyatMole, iSpec REAL :: partWeight, iRan !=================================================================================================================================== -! VIB Relaxation NewEnVib = 0.0; NewEnRot=0.0 IF(BGKDoVibRelaxation) THEN + ! Loop over all particles undergoing a relaxation in the vibration DO iLoop = 1, nVibRelax iPart = iPartIndx_NodeRelaxVib(iLoop) iSpec = PartSpecies(iPart) partWeight = GetParticleWeight(iPart) + ! polyatomic, more than one vibrational DOF IF(SpecDSMC(iSpec)%PolyatomicMol) THEN iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray PartStateIntEn(1,iPart) = 0.0 + ! Sum up the new vibrational energy over all DOFs, see M. Pfeiffer et. al., "Extension of Particle-based BGK Models to + ! Polyatomic Species in Hypersonic Flow around a Flat-faced Cylinder", AIP Conference Proceedings 2132, 100001 (2019) DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF CALL RANDOM_NUMBER(iRan) VibEnergyDOF(iLoop,iDOF) = - LOG(iRan)*Xi_vib_DOF(iDOF)/2.*TEqui*BoltzmannConst PartStateIntEn(1,iPart) = PartStateIntEn(1,iPart)+VibEnergyDOF(iLoop,iDOF) END DO + ! ELSE: diatomic, only one vibrational DOF, calculate new vibrational energy according to M. Pfeiffer, "Extending the particle + ! ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules including quantized vibrational energies", + ! Phys. Fluids 30, 116103 (2018) ELSE CALL RANDOM_NUMBER(iRan) PartStateIntEn( 1,iPart) = -LOG(iRan)*Xi_VibSpec(iSpec)/2.*TEqui*BoltzmannConst END IF + ! Sum up new vibrational energy per species NewEnVib(iSpec) = NewEnVib(iSpec) + PartStateIntEn(1,iPart) * partWeight END DO END IF -! ROT Relaxation +! Loop over all particles undergoing a relaxation in the rotation DO iLoop = 1, nRotRelax iPart = iPartIndx_NodeRelaxRot(iLoop) iSpec = PartSpecies(iPart) partWeight = GetParticleWeight(iPart) CALL RANDOM_NUMBER(iRan) + ! Calculate new rotational energy according to M. Pfeiffer et. al., "Extension of Particle-based BGK Models to Polyatomic Species + ! in Hypersonic Flow around a Flat-faced Cylinder", AIP Conference Proceedings 2132, 100001 (2019) PartStateIntEn( 2,iPart) = -Xi_RotSpec(iSpec) / 2. * BoltzmannConst*TEqui*LOG(iRan) + ! Sum up new rotational energy per species NewEnRot(iSpec) = NewEnRot(iSpec) + PartStateIntEn( 2,iPart) * partWeight END DO END SUBROUTINE RelaxInnerEnergy + SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, u2i, vBulkAll, CellTemp, vBulk) !=================================================================================================================================== !> Sample new particle velocities from the target distribution function, depending on the chosen model @@ -829,11 +894,13 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, INTEGER :: iPart, fillMa1, fillMa2, INFO, iLoop, iSpec REAL :: iRanPart(3, nRelax), A(3,3), KronDelta, SMat(3,3), W(3), Work(100), tempVelo(3), partWeight !=================================================================================================================================== +! According to M. Pfeiffer, "Particle-based fluid dynamics: Comparison of different Bhatnagar-Gross-Krook models and the direct +! simulation Monte Carlo method for hypersonic flows", Phys. Fluids 30, 106106 (2018) IF (nRelax.GT.0) THEN SELECT CASE(BGKCollModel) - CASE (1) ! Ellipsoidal Statistical + CASE (1) ! Ellipsoidal Statistical BGK IF (ESBGKModel.EQ.1) THEN - !! Approximated Solution + ! Approximated solution DO fillMa1 =1, 3 DO fillMa2 =fillMa1, 3 IF (fillMa1.EQ.fillMa2) THEN @@ -841,6 +908,7 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, ELSE KronDelta = 0.0 END IF + ! Fill symmetric transformation matrix SMat with anisotopic matrix A = SS SMat(fillMa1, fillMa2)= KronDelta - (1.-Prandtl)/(2.*Prandtl) & *(3./u2*u0ij(fillMa1, fillMa2)-KronDelta) END DO @@ -848,9 +916,9 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, SMat(2,1)=SMat(1,2) SMat(3,1)=SMat(1,3) SMat(3,2)=SMat(2,3) + ! Generate random normals for the sampling of new velocities of all relaxing particles CALL BGK_BuildTransGaussNums(nRelax, iRanPart) ELSE - !! Exact Solution DO fillMa1 =1, 3 DO fillMa2 =fillMa1, 3 IF (fillMa1.EQ.fillMa2) THEN @@ -858,18 +926,19 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, ELSE KronDelta = 0.0 END IF + ! Fill anisotopic matrix A A(fillMa1, fillMa2) = KronDelta - (1.-Prandtl)/Prandtl*(3.*u0ij(fillMa1, fillMa2)/u2 - KronDelta) END DO END DO IF (ESBGKModel.EQ.2) THEN + ! Exact solution + ! Compute eigenvalues and eigenvectors of matrix A --> output: W is the array that contains the eigenvalues, A then contains + ! the orthonormal eigenvectors of anisotropic matrix A CALL DSYEV('V','U',3,A,3,W,Work,100,INFO) SMat = 0.0 - IF (W(1).LT.0.0) THEN - W(1) = 0.0 - IF (W(2).LT.0) W(2) = 0.0 - END IF - IF (W(3).LT.0) THEN - W(3) = 0.0 + IF (W(3).LT.0.0) THEN + ! Due to ascending order of eigenvalues, all three eigenvalues are lower than zero here + ! Same calculation as for approximate solution (ESBGKModel.EQ.1) DO fillMa1 =1, 3 DO fillMa2 =fillMa1, 3 IF (fillMa1.EQ.fillMa2) THEN @@ -885,36 +954,58 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, SMat(3,1)=SMat(1,3) SMat(3,2)=SMat(2,3) ELSE + ! At least W(3) is not negative + ! Set negative eigenvalues to zero + IF (W(1).LT.0.0) THEN + W(1) = 0.0 + IF (W(2).LT.0.0) W(2) = 0.0 + END IF + ! SMat with square roots of the eigenvalues as diagonal elements SMat(1,1) = SQRT(W(1)) SMat(2,2) = SQRT(W(2)) SMat(3,3) = SQRT(W(3)) + ! Diagonalisation of anisotropic matrix, SMat is square root of anisotropic matrix SMat = MATMUL(A, SMat) SMat = MATMUL(SMat, TRANSPOSE(A)) END IF + ! Generate random normals for the sampling of new velocities of all relaxing particles CALL BGK_BuildTransGaussNums(nRelax, iRanPart) ELSE IF (ESBGKModel.EQ.3) THEN + ! Metropolis-Hastings A(2,1)=A(1,2) A(3,1)=A(1,3) A(3,2)=A(2,3) CALL MetropolisES(nRelax, iRanPart, A) END IF END IF - CASE (2) ! Shakov + + CASE (2) ! Shakov BGK ! CALL MetropolisShakhov(nRelax, iRanPart, u2/3., u2i, Prandtl) + ! Acceptance-rejection method CALL ARShakhov(nRelax, iRanPart, u2/3., u2i, Prandtl) + CASE (3) ! Standard BGK (Maxwell target distribution) + ! Generate random normals for the sampling of new velocities of all relaxing particles CALL BGK_BuildTransGaussNums(nRelax, iRanPart) END SELECT + + ! Loop over all particles undergoing a relaxation towards the target distribution function DO iLoop = 1, nRelax iPart = iPartIndx_NodeRelax(iLoop) iSpec = PartSpecies(iPart) + ! Calculation of new velocities of all particles IF ((BGKCollModel.EQ.1).AND.(ESBGKModel.NE.3)) THEN + ! Transformation of normalized thermal velocity vector tempVelo (sampled from a Maxwellian distribution) to a thermal velocity + ! vector sampled from the ESBGK target distribution function (anisotropic Gaussian distribution) tempVelo(1:3) = SQRT(BoltzmannConst*CellTemp/Species(iSpec)%MassIC)*iRanPart(1:3,iLoop) PartState(4:6,iPart) = vBulkAll(1:3) + MATMUL(SMat,tempVelo) ELSE + ! New thermal velocity of particles is sqrt(k_B*T/m) multiplied by normal distributed random vector PartState(4:6,iPart) = vBulkAll(1:3) + SQRT(BoltzmannConst*CellTemp/Species(iSpec)%MassIC)*iRanPart(1:3,iLoop) END IF partWeight = GetParticleWeight(iPart) + ! Sum up new velocities of relaxing particles for bulk velocity, velocities of non-relaxing particles already calculated in + ! subroutine DetermineRelaxPart vBulk(1:3) = vBulk(1:3) + PartState(4:6,iPart)*Species(iSpec)%MassIC*partWeight END DO END IF ! nRelax.GT.0 @@ -947,12 +1038,17 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, nVibRelaxSpec, iPartIndx_NodeRelaxVib INTEGER :: iPart, iLoop, iDOF, iSpec, iQuant, iQuaMax, iPolyatMole REAL :: alpha(nSpecies), partWeight, betaV, iRan, MaxColQua, Xi_VibTotal !=================================================================================================================================== +! According to M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules +! including quantized vibrational energies", Phys. Fluids 30, 116103 (2018) IF(BGKDoVibRelaxation) THEN + ! Vibrational energy is positive for at least one species + there are vibrational relaxations IF (ANY(NewEnVib.GT.0.0).AND.(nVibRelax.GT.0)) THEN Xi_VibTotal = 0.0 + ! Total number of relaxing vibrational degrees of freedom DO iSpec = 1, nSpecies Xi_VibTotal = Xi_VibTotal + Xi_VibSpec(iSpec)*nVibRelaxSpec(iSpec) END DO + ! Calculate scaling factor alpha per species DO iSpec = 1, nSpecies IF (NewEnVib(iSpec).GT.0.0) THEN alpha(iSpec) = OldEn/NewEnVib(iSpec)*(Xi_VibSpec(iSpec)*nVibRelaxSpec(iSpec)/(3.*(nPart-1.)+Xi_VibTotal)) @@ -960,61 +1056,85 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, nVibRelaxSpec, iPartIndx_NodeRelaxVib alpha(iSpec) = 0. END IF END DO + ! Quantized vibrational energy IF (BGKUseQuantVibEn) THEN DO iLoop = 1, nVibRelax iPart = iPartIndx_NodeRelaxVib(iLoop) partWeight = GetParticleWeight(iPart) iSpec = PartSpecies(iPart) - IF(SpecDSMC(iSpec)%PolyatomicMol) THEN ! TBC, noch nicht mit verschiedenen alpha pro Spezies + ! Polyatomic ------------------------------------ TBC, noch nicht mit verschiedenen alpha pro Spezies + IF(SpecDSMC(iSpec)%PolyatomicMol) THEN PartStateIntEn(1,iPart) = 0.0 iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray + ! Loop over all vibrational DOF DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF + ! Energy per vibrational mode alpha*VibEnergyDOF is reformulated to a quantum number iQuant betaV = alpha(iSpec)*VibEnergyDOF(iLoop,iDOF)/(PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)*BoltzmannConst) CALL RANDOM_NUMBER(iRan) iQuant = INT(betaV+iRan) + ! Check maximum vibrational quantum number IF(iQuant.GT.PolyatomMolDSMC(iPolyatMole)%MaxVibQuantDOF(iDOF)) iQuant=PolyatomMolDSMC(iPolyatMole)%MaxVibQuantDOF(iDOF) + ! Remaining energy negative, new quantum number needs to be calculated IF ((OldEn - iQuant*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)*BoltzmannConst*partWeight).LT.0.0) THEN + ! Maximum quantum number MaxColQua = OldEn/(BoltzmannConst*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)*partWeight) + ! OldEn < k_B*CharaTVibDOF --> iQuant < 1 IF (INT(MaxColQua).EQ.0) THEN iQuant = 0 ELSE CALL RANDOM_NUMBER(iRan) + ! Calculation of new iQuant iQuant = INT(-LOG(iRan)*TEqui/PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)) + ! Determine maximum quantum number iQuaMax = MIN(INT(MaxColQua)+1, PolyatomMolDSMC(iPolyatMole)%MaxVibQuantDOF(iDOF)) + ! Calculation of new iQuant as long as iQuant > maximum quantum number DO WHILE (iQuant.GE.iQuaMax) CALL RANDOM_NUMBER(iRan) iQuant = INT(-LOG(iRan)*TEqui/PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)) END DO END IF END IF + ! Sup up the vibrational energy over all vibrational DOF PartStateIntEn( 1,iPart) = PartStateIntEn( 1,iPart) & + iQuant*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)*BoltzmannConst VibQuantsPar(iPart)%Quants(iDOF) = iQuant + ! Remaining OldEn for remaining particles OldEn = OldEn - iQuant*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)*BoltzmannConst*partWeight END DO + ! Add zero-point energy PartStateIntEn( 1,iPart) = PartStateIntEn( 1,iPart) & + SpecDSMC(iSpec)%EZeroPoint ELSE ! Diatomic molecules + ! Vibrational energy is reformulated to a quantum number iQuant betaV = alpha(iSpec)*PartStateIntEn( 1,iPart)/(SpecDSMC(iSpec)%CharaTVib*BoltzmannConst) CALL RANDOM_NUMBER(iRan) iQuant = INT(betaV+iRan) + ! Check maximum vibrational quantum number IF (iQuant.GT.SpecDSMC(iSpec)%MaxVibQuant) iQuant = SpecDSMC(iSpec)%MaxVibQuant PartStateIntEn( 1,iPart) = (iQuant + DSMC%GammaQuant)*SpecDSMC(iSpec)%CharaTVib*BoltzmannConst + ! Remaining energy negative, new quantum number needs to be calculated IF ((OldEn - (PartStateIntEn( 1,iPart) - SpecDSMC(iSpec)%EZeroPoint)*partWeight).LT.0.0) THEN + ! Maximum quantum number MaxColQua = OldEn/(BoltzmannConst*SpecDSMC(iSpec)%CharaTVib*partWeight) + ! OldEn < k_B*CharaTVib --> iQuant < 1 IF (INT(MaxColQua).EQ.0) THEN iQuant = 0 ELSE CALL RANDOM_NUMBER(iRan) + ! Calculation of new iQuant iQuant = INT(-LOG(iRan)*TEqui/SpecDSMC(iSpec)%CharaTVib) + ! Determine maximum quantum number iQuaMax = MIN(INT(MaxColQua)+1, SpecDSMC(iSpec)%MaxVibQuant) + ! Calculation of new iQuant as long as iQuant > maximum quantum number DO WHILE (iQuant.GE.iQuaMax) CALL RANDOM_NUMBER(iRan) iQuant = INT(-LOG(iRan)*TEqui/SpecDSMC(iSpec)%CharaTVib) END DO END IF + ! Calculate vibrational energy including zero-point energy PartStateIntEn( 1,iPart) = (iQuant + DSMC%GammaQuant)*SpecDSMC(iSpec)%CharaTVib*BoltzmannConst END IF + ! Remaining OldEn for remaining particles OldEn = OldEn - (PartStateIntEn( 1,iPart) - SpecDSMC(iSpec)%EZeroPoint)*partWeight END IF ! SpecDSMC(1)%PolyatomicMol END DO @@ -1023,11 +1143,15 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, nVibRelaxSpec, iPartIndx_NodeRelaxVib iPart = iPartIndx_NodeRelaxVib(iLoop) iSpec = PartSpecies(iPart) partWeight = GetParticleWeight(iPart) + ! Scaling of vibrational energy with factor alpha + zero-point energy PartStateIntEn( 1,iPart) = alpha(iSpec)*PartStateIntEn( 1,iPart) + SpecDSMC(iSpec)%EZeroPoint + ! Remaining OldEn for remaining particles OldEn = OldEn - (PartStateIntEn( 1,iPart) - SpecDSMC(iSpec)%EZeroPoint)*partWeight END DO END IF ! BGKUseQuantVibEn - ELSE IF (nVibRelax.GT.0) THEN ! Relaxation towards the vibrational ground-state (new state is simply the zero-point energy) + ! NewEnVib = 0 for all species, relaxation towards the vibrational ground-state (new state is simply the zero-point energy) + ELSE IF (nVibRelax.GT.0) THEN + ! Set zero-point energy as vibrational energy for all particles with vibrational relaxation DO iLoop = 1, nVibRelax iPart = iPartIndx_NodeRelaxVib(iLoop) iSpec = PartSpecies(iPart) @@ -1038,6 +1162,7 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, nVibRelaxSpec, iPartIndx_NodeRelaxVib END SUBROUTINE EnergyConsVib + #ifdef WIP SUBROUTINE ARGrads13(nPart, iRanPart, Vtherm, HeatVec, PressTens) !=================================================================================================================================== @@ -1112,6 +1237,7 @@ SUBROUTINE ARGrads13(nPart, iRanPart, Vtherm, HeatVec, PressTens) END SUBROUTINE ARGrads13 + SUBROUTINE ARChapEnsk(nPart, iRanPart, Vtherm, HeatVec, PressTens) !=================================================================================================================================== !> description @@ -1172,9 +1298,10 @@ SUBROUTINE ARChapEnsk(nPart, iRanPart, Vtherm, HeatVec, PressTens) END SUBROUTINE ARChapEnsk #endif /*WIP*/ + SUBROUTINE MetropolisES(nPart, iRanPart, A) !=================================================================================================================================== -!> description +!> Sampling from ESBGK target distribution function by using a Metropolis-Hastings method !=================================================================================================================================== ! MODULES USE Ziggurat @@ -1195,15 +1322,18 @@ SUBROUTINE MetropolisES(nPart, iRanPart, A) LOGICAL :: Changed REAL :: AC(3), AInvers(3,3), detA !=================================================================================================================================== +! Generate normal distributed random vector as start vector for the thermal velocity iRanPart(1,1) = rnor() iRanPart(2,1) = rnor() iRanPart(3,1) = rnor() +! Inverse matrix of A CALL INV33(A,AInvers, detA) AC(1:3) = MATMUL(AInvers, iRanPart(1:3,1)) V2 = iRanPart(1,1)*AC(1) + iRanPart(2,1)*AC(2) + iRanPart(3,1)*AC(3) OldProb = EXP(-0.5*V2) -!Burn in -DO iLoop = 1, 35 !50 +! Burn-in phase, 35 initial steps +DO iLoop = 1, 35 + ! Generate normal distributed random vector for the thermal velocity iRanPartTemp(1) = rnor() iRanPartTemp(2) = rnor() iRanPartTemp(3) = rnor() @@ -1212,20 +1342,24 @@ SUBROUTINE MetropolisES(nPart, iRanPart, A) NewProb = EXP(-0.5*V2) NormProb = MIN(1.,NewProb/OldProb) CALL RANDOM_NUMBER(iRan) + ! Acceptance of new sample with probability NormProb IF (NormProb.GT.iRan) THEN iRanPart(1:3,1) = iRanPartTemp(1:3) OldProb = NewProb END IF END DO -! All the others +! Main phase, for all following particles DO iPart = 2, nPart + ! Normal distributed random vector from previous particle iRanPart(1,iPart) = iRanPart(1,iPart-1) iRanPart(2,iPart) = iRanPart(2,iPart-1) iRanPart(3,iPart) = iRanPart(3,iPart-1) iRun = 0 Changed = .FALSE. + ! For acception: velocity should be changed at least once and at least ten steps in the Markov chain should be taken DO WHILE ((iRun.LT.10).OR.(.NOT.Changed)) iRun = iRun + 1 + ! Generate normal distributed random vector for the thermal velocity iRanPartTemp(1) = rnor() iRanPartTemp(2) = rnor() iRanPartTemp(3) = rnor() @@ -1234,8 +1368,9 @@ SUBROUTINE MetropolisES(nPart, iRanPart, A) NewProb = EXP(-0.5*V2) NormProb = MIN(1.,NewProb/OldProb) CALL RANDOM_NUMBER(iRan) + ! Acceptance of new sample with probability NormProb, velocity is changed IF (NormProb.GT.iRan) THEN - Changed = .TRUE. + Changed = .TRUE. iRanPart(1:3,iPart) = iRanPartTemp(1:3) OldProb = NewProb END IF @@ -1244,9 +1379,10 @@ SUBROUTINE MetropolisES(nPart, iRanPart, A) END SUBROUTINE MetropolisES + SUBROUTINE ARShakhov(nPart, iRanPart, Vtherm, HeatVec, Prandtl) !=================================================================================================================================== -!> description +!> Acceptance-rejection method for sampling from the Shakhov distribution function !=================================================================================================================================== ! MODULES USE Ziggurat @@ -1264,33 +1400,38 @@ SUBROUTINE ARShakhov(nPart, iRanPart, Vtherm, HeatVec, Prandtl) REAL :: Vheat, V2, iRan, OldProb, Envelope INTEGER :: iPart !=================================================================================================================================== +! Calculate envelope function Envelope = MAX(ABS(HeatVec(1)),ABS(HeatVec(2)),ABS(HeatVec(3)))/Vtherm**(3./2.) Envelope = 1.+4.*Envelope +! Loop over all relaxing particles DO iPart = 1, nPart + ! Generate random normals iRanPart(1,iPart) = rnor() iRanPart(2,iPart) = rnor() iRanPart(3,iPart) = rnor() V2 = iRanPart(1,iPart)*iRanPart(1,iPart) + iRanPart(2,iPart)*iRanPart(2,iPart) + iRanPart(3,iPart)*iRanPart(3,iPart) Vheat = iRanPart(1,iPart)*HeatVec(1) + iRanPart(2,iPart)*HeatVec(2) + iRanPart(3,iPart)*HeatVec(3) - OldProb = (1. + (1.-Prandtl)*VHeat/(5.*Vtherm**(3./2.))*(V2/2.-5./2.)) + OldProb = (1. + (1.-Prandtl)*Vheat/(5.*Vtherm**(3./2.))*(V2/2.-5./2.)) CALL RANDOM_NUMBER(iRan) + ! Acception if Envelope*iRan < OldProb DO WHILE (Envelope*iRan.GT.OldProb) iRanPart(1,iPart) = rnor() iRanPart(2,iPart) = rnor() iRanPart(3,iPart) = rnor() V2 = iRanPart(1,iPart)*iRanPart(1,iPart) + iRanPart(2,iPart)*iRanPart(2,iPart) + iRanPart(3,iPart)*iRanPart(3,iPart) Vheat = iRanPart(1,iPart)*HeatVec(1) + iRanPart(2,iPart)*HeatVec(2) + iRanPart(3,iPart)*HeatVec(3) - OldProb = (1. + (1.-Prandtl)*VHeat/(5.*Vtherm**(3./2.))*(V2/2.-5./2.)) + OldProb = (1. + (1.-Prandtl)*Vheat/(5.*Vtherm**(3./2.))*(V2/2.-5./2.)) CALL RANDOM_NUMBER(iRan) END DO END DO END SUBROUTINE ARShakhov + SUBROUTINE BGK_BuildTransGaussNums(nPart, iRanPart) !=================================================================================================================================== -!> description +!> Generate normal distributed random vector for sampling of new velocities of all relaxing particles relaxing !=================================================================================================================================== ! MODULES USE Ziggurat @@ -1306,6 +1447,7 @@ SUBROUTINE BGK_BuildTransGaussNums(nPart, iRanPart) ! LOCAL VARIABLES INTEGER :: iLoop !=================================================================================================================================== +! Generate three normal distributed random values for all relaxing simulation particles DO iLoop = 1, nPart iRanPart(1,iLoop) = rnor() iRanPart(2,iLoop) = rnor() @@ -1314,10 +1456,11 @@ SUBROUTINE BGK_BuildTransGaussNums(nPart, iRanPart) END SUBROUTINE BGK_BuildTransGaussNums + SUBROUTINE CalcTEqui(nPart, CellTemp, TRot, TVib, Xi_Vib, Xi_Vib_old, RotExp, VibExp, & TEqui, rotrelaxfreq, vibrelaxfreq, dtCell, DoVibRelaxIn) !=================================================================================================================================== -! Calculation of the vibrational temperature (zero-point search) for polyatomic molecules +! Calculation of the vibrational temperature (zero-point search) for non-polyatomic molecules for Fokker-Planck !=================================================================================================================================== ! MODULES USE MOD_DSMC_Vars, ONLY: SpecDSMC @@ -1418,10 +1561,11 @@ SUBROUTINE CalcTEqui(nPart, CellTemp, TRot, TVib, Xi_Vib, Xi_Vib_old, RotExp, Vi END SUBROUTINE CalcTEqui + SUBROUTINE CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec, Xi_Vib_oldSpec, RotExpSpec, VibExpSpec, & TEqui, rotrelaxfreqSpec, vibrelaxfreqSpec, dtCell, DoVibRelaxIn) !=================================================================================================================================== -! Calculation of the vibrational temperature (zero-point search) for polyatomic molecules +! Calculation of the vibrational temperature (zero-point search) for diatomic molecule mixtures !=================================================================================================================================== ! MODULES USE MOD_DSMC_Vars, ONLY: SpecDSMC @@ -1461,10 +1605,16 @@ SUBROUTINE CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec correctFacRot = 1. RotFracSpec = 0.0 VibFracSpec = 0.0 + +! Loop over all molecular species --> only internal energies are relevant here DO iSpec=1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + ! Calculate number of rotational relaxing molecules with number of molecules * probability of relaxation + ! P = 1 - exp(-nu*dt) with relaxation frequency nu and timestep dt RotExpSpec(iSpec) = exp(-rotrelaxfreqSpec(iSpec)*dtCell/correctFacRot) RotFracSpec(iSpec) = nSpec(iSpec)*(1.-RotExpSpec(iSpec)) + ! Calculate number of vibrational relaxing molecules if enabled with number of molecules * probability of relaxation + ! P = 1 - exp(-nu*dt) with relaxation frequency nu and timestep dt IF(DoVibRelax) THEN VibExpSpec(iSpec) = exp(-vibrelaxfreqSpec(iSpec)*dtCell/correctFac) VibFracSpec(iSpec) = nSpec(iSpec)*(1.-VibExpSpec(iSpec)) @@ -1476,8 +1626,12 @@ SUBROUTINE CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec END IF END DO TEqui_Old = 0.0 +! Calculation of equilibrium temperature +! M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules including +! quantized vibrational energies", Phys. Fluids 30, 116103 (2018), Eq. 25 TEqui = 3.*(nPart-1.)*CellTemp TEquiNumDof = 3.*(nPart-1.) +! Sum up over all species DO iSpec=1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN TEqui = TEqui + 2.*RotFracSpec(iSpec)*TRotSpec(iSpec)+Xi_Vib_oldSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) @@ -1485,50 +1639,71 @@ SUBROUTINE CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec END IF END DO TEqui = TEqui / TEquiNumDof +! Required condition of Landau-Teller relaxation not fulfilled --> relaxation probabilities of rotation and vibration are +! corrected with a parameter beta for rotation and vibration as suggested by Burt: +! J. Burt and I. Boyd, “Evaluation of a particle method for the ellipsoidal statistical Bhatnagar-Gross-Krook equation”, +! 44th AIAA Aerospace Sciences Meeting and Exhibit (AIAA, 2006), p. 989 +! Solving of equation system until accuracy eps_prec is reached DO WHILE ( ABS( TEqui - TEqui_Old ) .GT. eps_prec ) DO iSpec = 1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + ! if difference too small: beta is not taken into account IF (ABS(TRotSpec(iSpec)-TEqui).LT.1E-3) THEN RotExpSpec(iSpec) = exp(-rotrelaxfreqSpec(iSpec)*dtCell/correctFacRot) ELSE + ! betaR = beta*nu*dt (= correction parameter rotation * relaxation frequency * time step) betaR = ((TRotSpec(iSpec)-CellTemp)/(TRotSpec(iSpec)-TEqui))*rotrelaxfreqSpec(iSpec)*dtCell/correctFacRot + ! negative betaR would leed to negative relaxation probability! IF (-betaR.GT.0.0) THEN RotExpSpec(iSpec) = 0. + ! Check if the exponent is within the range of machine precision ELSE IF (CHECKEXP(betaR)) THEN RotExpSpec(iSpec) = exp(-betaR) ELSE RotExpSpec(iSpec) = 0. END IF END IF + ! new calculation of number of rotational relaxing molecules RotFracSpec(iSpec) = nSpec(iSpec)*(1.-RotExpSpec(iSpec)) + IF(DoVibRelax) THEN + ! if difference too small: beta is not taken into account IF (ABS(TVibSpec(iSpec)-TEqui).LT.1E-3) THEN VibExpSpec(iSpec) = exp(-vibrelaxfreqSpec(iSpec)*dtCell/correctFac) ELSE + ! betaV = beta*nu*dt (= correction parameter vibration * relaxation frequency * time step) betaV = ((TVibSpec(iSpec)-CellTemp)/(TVibSpec(iSpec)-TEqui))*vibrelaxfreqSpec(iSpec)*dtCell/correctFac + ! negative betaV would leed to negative relaxation probability! IF (-betaV.GT.0.0) THEN VibExpSpec(iSpec) = 0. + ! Check if the exponent is within the range of machine precision ELSE IF (CHECKEXP(betaV)) THEN VibExpSpec(iSpec) = exp(-betaV) ELSE VibExpSpec(iSpec) = 0. END IF END IF + ! new calculation of number of vibrational relaxing molecules + VibFracSpec(iSpec) = nSpec(iSpec)*(1.-VibExpSpec(iSpec)) + + ! new calculation of the vibrational degrees of freedom exparg = SpecDSMC(iSpec)%CharaTVib/TEqui + ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom IF(CHECKEXP(exparg))THEN Xi_VibSpec(iSpec) = 2.*SpecDSMC(iSpec)%CharaTVib/TEqui/(EXP(exparg)-1.) ELSE Xi_VibSpec(iSpec) = 0.0 END IF ! CHECKEXP(exparg) - VibFracSpec(iSpec) = nSpec(iSpec)*(1.-VibExpSpec(iSpec)) END IF END IF END DO TEqui_Old = TEqui TEqui_Old2 = TEqui + ! new calculation of equilibrium temperature with new RotFracSpec, new VibFracSpec, new Xi_VibSpec(TEqui) in denominator TEqui = 3.*(nPart-1.)*CellTemp TEquiNumDof = 3.*(nPart-1.) + ! Sum up over all species DO iSpec=1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN TEqui = TEqui + 2.*RotFracSpec(iSpec)*TRotSpec(iSpec)+Xi_Vib_oldSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) @@ -1537,10 +1712,13 @@ SUBROUTINE CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec END DO TEqui = TEqui / TEquiNumDof IF(DoVibRelax) THEN + ! accuracy eps_prec not reached yet DO WHILE( ABS( TEqui - TEqui_Old2 ) .GT. eps_prec ) + ! mean value of old and new equilibrium temperature TEqui =(TEqui + TEqui_Old2)*0.5 DO iSpec=1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + ! new calculation of the vibrational degrees of freedom exparg = SpecDSMC(iSpec)%CharaTVib/TEqui IF(CHECKEXP(exparg))THEN Xi_VibSpec(iSpec) = 2.*SpecDSMC(iSpec)%CharaTVib/TEqui/(EXP(exparg)-1.) @@ -1549,9 +1727,11 @@ SUBROUTINE CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec END IF ! CHECKEXP(exparg) END IF END DO + ! new calculation of equilibrium temperature with corrected vibrational degrees of freedom in denominator TEqui_Old2 = TEqui TEqui = 3.*(nPart-1.)*CellTemp TEquiNumDof = 3.*(nPart-1.) + ! Sum up over all species DO iSpec=1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN TEqui = TEqui + 2.*RotFracSpec(iSpec)*TRotSpec(iSpec)+Xi_Vib_oldSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) @@ -1565,7 +1745,6 @@ SUBROUTINE CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec END SUBROUTINE CalcTEquiMulti - SUBROUTINE CalcTEquiPoly(nPart, CellTemp, TRot, TVib, nXiVibDOF, Xi_Vib_DOF, Xi_Vib_old, RotExp, VibExp, TEqui, rotrelaxfreq, vibrelaxfreq, & dtCell, DoVibRelaxIn) !=================================================================================================================================== @@ -1600,8 +1779,10 @@ SUBROUTINE CalcTEquiPoly(nPart, CellTemp, TRot, TVib, nXiVibDOF, Xi_Vib_DOF, Xi_ DoVibRelax = BGKDoVibRelaxation END IF +! rotational degrees of freedom of polyatomic molecule Xi_Rot = SpecDSMC(1)%Xi_Rot iPolyatMole = SpecDSMC(1)%SpecToPolyArray + ! Xi_rel = 2.*(2. - CollInf%omega(1,1)) ! correctFac = 0.0 ! DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF @@ -1615,8 +1796,13 @@ SUBROUTINE CalcTEquiPoly(nPart, CellTemp, TRot, TVib, nXiVibDOF, Xi_Vib_DOF, Xi_ correctFac = 1. correctFacRot = 1. + +! Calculate number of rotational relaxing molecules with number of molecules * probability of relaxation +! P = 1 - exp(-nu*dt) with relaxation frequency nu and timestep dt RotExp = exp(-rotrelaxfreq*dtCell/correctFacRot) RotFrac = nPart*(1.-RotExp) +! Calculate number of vibrational relaxing molecules if enabled with number of molecules * probability of relaxation +! P = 1 - exp(-nu*dt) with relaxation frequency nu and timestep dt IF(DoVibRelax) THEN VibExp = exp(-vibrelaxfreq*dtCell/correctFac) VibFrac = nPart*(1.-VibExp) @@ -1626,36 +1812,59 @@ SUBROUTINE CalcTEquiPoly(nPart, CellTemp, TRot, TVib, nXiVibDOF, Xi_Vib_DOF, Xi_ Xi_vib_DOF = 0.0 END IF TEqui_Old = 0.0 +! M. Pfeiffer et. al., "Extension of Particle-based BGK Models to Polyatomic Species in Hypersonic Flow around a Flat-faced +! Cylinder", AIP Conference Proceedings 2132, 100001 (2019) +! Solving of equation system for TEqui and betaR and betaV TEqui = (3.*(nPart-1.)*CellTemp+2.*RotFrac*TRot+Xi_Vib_old*VibFrac*TVib)/(3.*(nPart-1.)+2.*RotFrac+Xi_Vib_old*VibFrac) +! Required condition of Landau-Teller relaxation not fulfilled --> relaxation probabilities of rotation and vibration are +! corrected with a parameter beta for rotation and vibration as suggested by Burt: +! J. Burt and I. Boyd, “Evaluation of a particle method for the ellipsoidal statistical Bhatnagar-Gross-Krook equation”, +! 44th AIAA Aerospace Sciences Meeting and Exhibit (AIAA, 2006), p. 989 +! Solving of equation system until accuracy eps_prec is reached DO WHILE ( ABS( TEqui - TEqui_Old ) .GT. eps_prec ) + ! if difference too small: beta is not taken into account IF (ABS(TRot-TEqui).LT.1E-3) THEN RotExp = exp(-rotrelaxfreq*dtCell/correctFacRot) ELSE + ! betaR = beta*nu*dt (= correction parameter rotation * relaxation frequency * time step) betaR = ((TRot-CellTemp)/(TRot-TEqui))*rotrelaxfreq*dtCell/correctFacRot + ! negative betaR would leed to negative relaxation probability! IF (-betaR.GT.0.0) THEN RotExp = 0. + ! Check if the exponent is within the range of machine precision ELSE IF (CHECKEXP(betaR)) THEN RotExp = exp(-betaR) ELSE RotExp = 0. END IF END IF + ! new calculation of number of rotational relaxing molecules RotFrac = nPart*(1.-RotExp) + IF(DoVibRelax) THEN + ! if difference too small: beta is not taken into account IF (ABS(TVib-TEqui).LT.1E-3) THEN VibExp = exp(-vibrelaxfreq*dtCell/correctFac) ELSE + ! betaV = beta*nu*dt (= correction parameter vibration * relaxation frequency * time step) betaV = ((TVib-CellTemp)/(TVib-TEqui))*vibrelaxfreq*dtCell/correctFac + ! negative betaV would leed to negative relaxation probability! IF (-betaV.GT.0.0) THEN VibExp = 0. + ! Check if the exponent is within the range of machine precision ELSEIF(CHECKEXP(betaV))THEN VibExp = exp(-betaV) ELSE VibExp = 0. END IF END IF + ! new calculation of number of vibrational relaxing molecules + VibFrac = nPart*(1.-VibExp) + + ! Loop over all vibrational degrees of freedom to calculate them using TEqui DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF exparg = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TEqui + ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom IF(CHECKEXP(exparg))THEN IF(exparg.gt.0.)THEN ! positive overflow: exp -> inf Xi_vib_DOF(iDOF) = 2.*exparg/(EXP(exparg)-1.) @@ -1666,17 +1875,22 @@ SUBROUTINE CalcTEquiPoly(nPart, CellTemp, TRot, TVib, nXiVibDOF, Xi_Vib_DOF, Xi_ Xi_vib_DOF(iDOF) = 0.0 END IF ! CHECKEXP(exparg) END DO - VibFrac = nPart*(1.-VibExp) END IF TEqui_Old = TEqui TEqui_Old2 = TEqui + + ! new calculation of equilibrium temperature with new RotFrac, new VibFrac new Xi_vib_DOF(TEqui) in denominator TEqui = (3.*(nPart-1.)*CellTemp+2.*RotFrac*TRot+Xi_Vib_old*VibFrac*TVib) & / (3.*(nPart-1.)+2.*RotFrac+SUM(Xi_vib_DOF(1:PolyatomMolDSMC(iPolyatMole)%VibDOF))*VibFrac) IF(DoVibRelax) THEN + ! accuracy eps_prec not reached yet DO WHILE( ABS( TEqui - TEqui_Old2 ) .GT. eps_prec ) + ! mean value of old and new equilibrium temperature TEqui =(TEqui + TEqui_Old2)*0.5 + ! Loop over all vibrational degrees of freedom DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF exparg = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TEqui + ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom IF(CHECKEXP(exparg))THEN IF(exparg.gt.0.)THEN ! positive overflow: exp -> inf Xi_vib_DOF(iDOF) = 2.*exparg/(EXP(exparg)-1.) @@ -1688,6 +1902,7 @@ SUBROUTINE CalcTEquiPoly(nPart, CellTemp, TRot, TVib, nXiVibDOF, Xi_Vib_DOF, Xi_ END IF ! CHECKEXP(exparg) END DO TEqui_Old2 = TEqui + ! new calculation of equilibrium temperature with corrected vibrational degrees of freedom in denominator TEqui = (3.*(nPart-1.)*CellTemp+2.*RotFrac*TRot+Xi_Vib_old*VibFrac*TVib) & / (3.*(nPart-1.)+2.*RotFrac+SUM(Xi_vib_DOF(1:PolyatomMolDSMC(iPolyatMole)%VibDOF))*VibFrac) END DO @@ -1696,6 +1911,7 @@ SUBROUTINE CalcTEquiPoly(nPart, CellTemp, TRot, TVib, nXiVibDOF, Xi_Vib_DOF, Xi_ END SUBROUTINE CalcTEquiPoly + SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_VibSpec, Visc, ThermalCond) !=================================================================================================================================== !> Determination of the mixture viscosity and thermal conductivity using collision integrals (derived for the Variable Hard @@ -1764,8 +1980,8 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ ! Calculation of collision integral Sigma_11 CALL CalcSigma_11VHS(CellTemp(nSpecies+1),InteractDiam,Mass,TVHS, omegaVHS, Sigma_11) ! Parameters for calculation of contribution of species to mixture transport coefficients - ! Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), - ! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar-Gross-Krook method for monatomic gas species" + ! Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), "Multi-species modeling in the particle-based ellipsoidal + ! statistical Bhatnagar-Gross-Krook method for monatomic gas species" B_12(iSpec,jSpec) = (5.*GAMMA(4.-omegaVHS)-GAMMA(5.-omegaVHS))/(5.*GAMMA(3.-omegaVHS)) B_12(jSpec,iSpec) = B_12(iSpec,jSpec) A_12(iSpec,jSpec) = Sigma_22 / (5.*Sigma_11) @@ -1881,6 +2097,7 @@ SUBROUTINE CalcSigma_11VHS(CellTemp,Dref,Mass,Tref, omegaVHS, Sigma_11) END SUBROUTINE CalcSigma_11VHS + REAL FUNCTION CalcSigma_22VHS(CellTemp,Dref,Mass,Tref, omegaVHS) !=================================================================================================================================== !> From ca162ecd2c7d49dec0670a9223c2970ac2841aac Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Wed, 1 Feb 2023 15:48:49 +0100 Subject: [PATCH 11/41] BGK CollOperator some more comments in code --- src/particles/bgk/bgk_colloperator.f90 | 163 +++---------------------- 1 file changed, 16 insertions(+), 147 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 948a30f77..26cd93e3a 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -176,6 +176,8 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) ! Sum up collision frequencies of species i with itself and the other species ! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 87f ! For SpecBGK(iSpec)%CollFreqPreFactor(jSpec) see bgk_init.f90 + ! VHS according to M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic + ! molecules including quantized vibrational energies", Phys. Fluids 30, 116103 (2018), Eq. (18) collisionfreqSpec(iSpec) = collisionfreqSpec(iSpec) + SpecBGK(iSpec)%CollFreqPreFactor(jSpec) * totalWeightSpec(jSpec) & * (Dens / totalWeight) *CellTemptmp**(-CollInf%omega(iSpec,jSpec) +0.5) END DO @@ -384,8 +386,8 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES INTEGER :: iLoop, iPart, iSpec, fillMa1, fillMa2 -REAL :: V_rel(1:3), vmag2, partWeight, EnerTotal, totalWeightSpec2(nSpecies), vBulkSpec(3,nSpecies) -REAL :: tempweight, tempweight2, tempmass, vBulkTemp(3), totalWeight2, totalWeight3 +REAL :: V_rel(1:3), vmag2, EnerTotal, ThermEner, totalWeightSpec2(nSpecies), vBulkSpec(3,nSpecies) +REAL :: partWeight, tempweight, tempweight2, tempmass, vBulkTemp(3), totalWeight2, totalWeight3 LOGICAL :: validSpec(nSpecies) !=================================================================================================================================== totalWeightSpec = 0.0; totalWeightSpec2=0.0; vBulkAll=0.0; TotalMass=0.0; vBulkSpec=0.0; nSpec=0; dtCell=0.0 @@ -441,7 +443,7 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota totalWeight3 = totalWeight3 + partWeight*partWeight*partWeight END IF - ! Sum up old energy of thermal velocities and sum up internal energies + ! Sum up old energy of thermal velocities and sum up internal energies --> E_T OldEn = OldEn + 0.5*Species(iSpec)%MassIC * vmag2*partWeight IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN IF(BGKDoVibRelaxation) THEN @@ -453,9 +455,11 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota END DO IF (BGKCollModel.EQ.1) THEN ! ESBGK + ! Pressure tensor u0ij = u0ij* totalWeight / (TotalMass*(totalWeight - totalWeight2/totalWeight)) END IF IF (BGKCollModel.EQ.2) THEN ! Shakhov + ! Heatflux u2i = u2i*totalWeight**3/(TotalMass*(totalWeight**3-3.*totalWeight*totalWeight2+2.*totalWeight3)) END IF @@ -469,7 +473,7 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota ! At least two particles and non-zero squared thermal velocity needed for a valid species IF ((nSpec(iSpec).GE.2).AND.(.NOT.ALMOSTZERO(u2Spec(iSpec)))) THEN validSpec = .TRUE. - ! Calculation of the species temperature + ! Calculation of the species temperature --> translational temperatures of the different species SpecTemp(iSpec) = Species(iSpec)%MassIC * u2Spec(iSpec) & /(3.0*BoltzmannConst*(totalWeightSpec(iSpec) - totalWeightSpec2(iSpec)/totalWeightSpec(iSpec))) ! Thermal energy @@ -485,11 +489,13 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota END DO IF (ANY(validSpec)) THEN vBulkTemp(1:3) = vBulkTemp(1:3) / tempmass + ! Squared bulk velocity of the mixture vmag2 = DOTPRODUCT(vBulkTemp(1:3)) ! EnerTotal = kinetic energy (tempmass / 2. * vmag2) + thermal energy (3. * tempweight * BoltzmannConst * CellTemp / 2) - EnerTotal = EnerTotal - tempmass / 2. * vmag2 - ! Calculation of the cell temperature from the thermal energy - CellTemp = 2. * EnerTotal / (3.*tempweight*BoltzmannConst) + ThermEner = EnerTotal - tempmass / 2. * vmag2 + ! Calculation of the cell temperature from the thermal energy --> translational temperature of the mixture + CellTemp = 2. * ThermEner / (3.*tempweight*BoltzmannConst) + ! Mean squared thermal velocity c^2 of a particle, calculated with the cell temperature and the density-averaged mass u2 = 3. * CellTemp * BoltzmannConst * (tempweight - tempweight2/tempweight) / tempmass ELSE ! only one part per species or cloned species with u2spec = 0 because PartState(4:6) = vBulkAll u2 = OldEn / (TotalMass*(1. - totalWeight2/totalWeight**2)) * 2. ! variance-free @@ -789,7 +795,7 @@ SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, RotExpSp nVibRelax = nVibRelax + 1 nVibRelaxSpec(iSpec) = nVibRelaxSpec(iSpec) + 1 iPartIndx_NodeRelaxVib(nVibRelax) = iPart - ! Sum up total vibrational energy, considering zero-point energy + ! Sum up total vibrational energy of all relaxing particles, considering zero-point energy, and add to translational energy OldEn = OldEn + (PartStateIntEn(1,iPartIndx_NodeRelaxVib(nVibRelax)) - SpecDSMC(iSpec)%EZeroPoint) * partWeight END IF END IF @@ -980,7 +986,6 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, END IF CASE (2) ! Shakov BGK -! CALL MetropolisShakhov(nRelax, iRanPart, u2/3., u2i, Prandtl) ! Acceptance-rejection method CALL ARShakhov(nRelax, iRanPart, u2/3., u2i, Prandtl) @@ -1000,7 +1005,7 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, tempVelo(1:3) = SQRT(BoltzmannConst*CellTemp/Species(iSpec)%MassIC)*iRanPart(1:3,iLoop) PartState(4:6,iPart) = vBulkAll(1:3) + MATMUL(SMat,tempVelo) ELSE - ! New thermal velocity of particles is sqrt(k_B*T/m) multiplied by normal distributed random vector + ! New thermal velocity (in x,y,z) of particle is sqrt(k_B*T/m) multiplied by normal distributed random vector PartState(4:6,iPart) = vBulkAll(1:3) + SQRT(BoltzmannConst*CellTemp/Species(iSpec)%MassIC)*iRanPart(1:3,iLoop) END IF partWeight = GetParticleWeight(iPart) @@ -1062,7 +1067,7 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, nVibRelaxSpec, iPartIndx_NodeRelaxVib iPart = iPartIndx_NodeRelaxVib(iLoop) partWeight = GetParticleWeight(iPart) iSpec = PartSpecies(iPart) - ! Polyatomic ------------------------------------ TBC, noch nicht mit verschiedenen alpha pro Spezies + ! Polyatomic molecules IF(SpecDSMC(iSpec)%PolyatomicMol) THEN PartStateIntEn(1,iPart) = 0.0 iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray @@ -1163,142 +1168,6 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, nVibRelaxSpec, iPartIndx_NodeRelaxVib END SUBROUTINE EnergyConsVib -#ifdef WIP -SUBROUTINE ARGrads13(nPart, iRanPart, Vtherm, HeatVec, PressTens) -!=================================================================================================================================== -!> description -!=================================================================================================================================== -! MODULES -USE Ziggurat -! IMPLICIT VARIABLE HANDLING -IMPLICIT NONE -!----------------------------------------------------------------------------------------------------------------------------------- -! INPUT VARIABLES -INTEGER, INTENT(IN) :: nPart -REAL, INTENT(IN) :: HeatVec(3), Vtherm, PressTens(3,3) -!----------------------------------------------------------------------------------------------------------------------------------- -! OUTPUT VARIABLES -REAL, INTENT(OUT) :: iRanPart(:,:) -!----------------------------------------------------------------------------------------------------------------------------------- -! LOCAL VARIABLES -REAL :: Vheat, V2, iRan, OldProb, Envelope, Envelope2, cMat, KronDelta -INTEGER :: iPart, fillMa1, fillMa2 -!=================================================================================================================================== -Envelope = MAX(ABS(HeatVec(1)),ABS(HeatVec(2)),ABS(HeatVec(3)))/Vtherm**(3./2.) -Envelope2 = MAX(ABS(PressTens(1,2)),ABS(PressTens(1,3)),ABS(PressTens(2,3)))/Vtherm -Envelope = 1.+3.*MAX(Envelope, Envelope2) - -DO iPart = 1, nPart - iRanPart(1,iPart) = rnor() - iRanPart(2,iPart) = rnor() - iRanPart(3,iPart) = rnor() - cMat = 0.0 - DO fillMa1 =1, 3 - DO fillMa2 =1, 3 - IF (fillMa1.EQ.fillMa2) THEN - KronDelta = 1.0 - ELSE - KronDelta = 0.0 - END IF - cMat = cMat + iRanPart(fillMa1,iPart)*iRanPart(fillMa2,iPart)*(PressTens(fillMa1,fillMa2)-KronDelta*Vtherm) - END DO - END DO -! cMat=cMat + iRanPart(1,iPart)*iRanPart(2,iPart)*PressTens(1,2) -! cMat=cMat + iRanPart(1,iPart)*iRanPart(3,iPart)*PressTens(1,3) -! cMat=cMat + iRanPart(2,iPart)*iRanPart(3,iPart)*PressTens(2,3) - V2 = iRanPart(1,iPart)*iRanPart(1,iPart) + iRanPart(2,iPart)*iRanPart(2,iPart) + iRanPart(3,iPart)*iRanPart(3,iPart) - Vheat = iRanPart(1,iPart)*HeatVec(1) + iRanPart(2,iPart)*HeatVec(2) + iRanPart(3,iPart)*HeatVec(3) - OldProb = (1. + cMat/(2.*Vtherm) + VHeat/(Vtherm**(3./2.))*(V2/5.-1.)) - CALL RANDOM_NUMBER(iRan) - DO WHILE (Envelope*iRan.GT.OldProb) - iRanPart(1,iPart) = rnor() - iRanPart(2,iPart) = rnor() - iRanPart(3,iPart) = rnor() - cMat = 0.0 - DO fillMa1 =1, 3 - DO fillMa2 =1, 3 - IF (fillMa1.EQ.fillMa2) THEN - KronDelta = 1.0 - ELSE - KronDelta = 0.0 - END IF - cMat = cMat + iRanPart(fillMa1,iPart)*iRanPart(fillMa2,iPart)*(PressTens(fillMa1,fillMa2)-KronDelta*Vtherm) - END DO - END DO -! cMat=cMat + iRanPart(1,iPart)*iRanPart(2,iPart)*PressTens(1,2) -! cMat=cMat + iRanPart(1,iPart)*iRanPart(3,iPart)*PressTens(1,3) -! cMat=cMat + iRanPart(2,iPart)*iRanPart(3,iPart)*PressTens(2,3) - V2 = iRanPart(1,iPart)*iRanPart(1,iPart) + iRanPart(2,iPart)*iRanPart(2,iPart) + iRanPart(3,iPart)*iRanPart(3,iPart) - Vheat = iRanPart(1,iPart)*HeatVec(1) + iRanPart(2,iPart)*HeatVec(2) + iRanPart(3,iPart)*HeatVec(3) - OldProb = (1. + cMat/(2.*Vtherm) + VHeat/(Vtherm**(3./2.))*(V2/5.-1.)) - CALL RANDOM_NUMBER(iRan) - END DO -END DO - -END SUBROUTINE ARGrads13 - - -SUBROUTINE ARChapEnsk(nPart, iRanPart, Vtherm, HeatVec, PressTens) -!=================================================================================================================================== -!> description -!=================================================================================================================================== -! MODULES -USE Ziggurat -! IMPLICIT VARIABLE HANDLING -IMPLICIT NONE -!----------------------------------------------------------------------------------------------------------------------------------- -! INPUT VARIABLES -INTEGER, INTENT(IN) :: nPart -REAL, INTENT(IN) :: HeatVec(3), Vtherm, PressTens(3,3) -!----------------------------------------------------------------------------------------------------------------------------------- -! OUTPUT VARIABLES -REAL, INTENT(OUT) :: iRanPart(:,:) -!----------------------------------------------------------------------------------------------------------------------------------- -! LOCAL VARIABLES -REAL :: Vheat, V2, iRan, OldProb, Envelope, Envelope2, cMat, cPress -INTEGER :: iPart -!=================================================================================================================================== -Envelope = MAX(ABS(HeatVec(1)),ABS(HeatVec(2)),ABS(HeatVec(3)))/Vtherm**(3./2.) -Envelope2 = MAX(ABS(PressTens(1,2)),ABS(PressTens(1,3)),ABS(PressTens(2,3)))/Vtherm -Envelope = 1.+4.*MAX(Envelope, Envelope2) - -DO iPart = 1, nPart - iRanPart(1,iPart) = rnor() - iRanPart(2,iPart) = rnor() - iRanPart(3,iPart) = rnor() - cMat = 0.0 - cPress = 0.0 - cMat=cMat + iRanPart(1,iPart)*iRanPart(2,iPart)*PressTens(1,2) - cMat=cMat + iRanPart(1,iPart)*iRanPart(3,iPart)*PressTens(1,3) - cMat=cMat + iRanPart(2,iPart)*iRanPart(3,iPart)*PressTens(2,3) - cPress=cPress + (PressTens(1,1)-Vtherm)*(iRanPart(1,iPart)*iRanPart(1,iPart)-iRanPart(3,iPart)*iRanPart(3,iPart)) - cPress=cPress + (PressTens(2,2)-Vtherm)*(iRanPart(2,iPart)*iRanPart(2,iPart)-iRanPart(3,iPart)*iRanPart(3,iPart)) - V2 = iRanPart(1,iPart)*iRanPart(1,iPart) + iRanPart(2,iPart)*iRanPart(2,iPart) + iRanPart(3,iPart)*iRanPart(3,iPart) - Vheat = iRanPart(1,iPart)*HeatVec(1) + iRanPart(2,iPart)*HeatVec(2) + iRanPart(3,iPart)*HeatVec(3) - OldProb = (1. + cMat/Vtherm + cPress/(2.*Vtherm) + VHeat/(2.*Vtherm**(3./2.))*(V2/5.-1.)) - CALL RANDOM_NUMBER(iRan) - DO WHILE (Envelope*iRan.GT.OldProb) - iRanPart(1,iPart) = rnor() - iRanPart(2,iPart) = rnor() - iRanPart(3,iPart) = rnor() - cMat = 0.0 - cPress = 0.0 - cMat=cMat + iRanPart(1,iPart)*iRanPart(2,iPart)*PressTens(1,2) - cMat=cMat + iRanPart(1,iPart)*iRanPart(3,iPart)*PressTens(1,3) - cMat=cMat + iRanPart(2,iPart)*iRanPart(3,iPart)*PressTens(2,3) - cPress=cPress + (PressTens(1,1)-Vtherm)*(iRanPart(1,iPart)*iRanPart(1,iPart)-iRanPart(3,iPart)*iRanPart(3,iPart)) - cPress=cPress + (PressTens(2,2)-Vtherm)*(iRanPart(2,iPart)*iRanPart(2,iPart)-iRanPart(3,iPart)*iRanPart(3,iPart)) - V2 = iRanPart(1,iPart)*iRanPart(1,iPart) + iRanPart(2,iPart)*iRanPart(2,iPart) + iRanPart(3,iPart)*iRanPart(3,iPart) - Vheat = iRanPart(1,iPart)*HeatVec(1) + iRanPart(2,iPart)*HeatVec(2) + iRanPart(3,iPart)*HeatVec(3) - OldProb = (1. + cMat/Vtherm + cPress/(2.*Vtherm) + VHeat/(2.*Vtherm**(3./2.))*(V2/5.-1.)) - CALL RANDOM_NUMBER(iRan) - END DO -END DO - -END SUBROUTINE ARChapEnsk -#endif /*WIP*/ - - SUBROUTINE MetropolisES(nPart, iRanPart, A) !=================================================================================================================================== !> Sampling from ESBGK target distribution function by using a Metropolis-Hastings method From d16466f67ed58bda9209e8b73c7876ed938eceb6 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Wed, 1 Mar 2023 11:27:15 +0100 Subject: [PATCH 12/41] BGK colloperator comments --- src/particles/bgk/bgk_colloperator.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 26cd93e3a..96c741c23 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -1867,7 +1867,7 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ END DO IF ((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN ! Calculation of thermal conductivity of rotation and vibration for each molecular species - ! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 254 + ! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 254f Xi_Dij_tot = SUM(Xj_Dij(iSpec,:)) rhoSpec = dens * Species(iSpec)%MassIC * Xi(iSpec) ThermalCondSpec_Rot(iSpec) = (rhoSpec*cv_rot/Xi_Dij_tot) @@ -1878,6 +1878,7 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ ! Calculate mixture viscosity by solving a system of linear equations with matrices ! Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), ! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar-Gross-Krook method for monatomic gas species" +! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 352 ViscMat = 0.0 DO iSpec = 1, nSpecies IF (Xi(iSpec).LE.0.0) THEN @@ -1907,6 +1908,7 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ ! Calculate mixture thermal conductivity by solving a system of linear equations with matrices ! Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), ! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar-Gross-Krook method for monatomic gas species" +! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 350f pressure = BoltzmannConst*dens*CellTemp(nSpecies+1) ViscMat = 0.0 DO iSpec = 1, nSpecies From eebc699276511d28f4c7998e52fca2ba529cfc13 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Wed, 8 Mar 2023 15:45:18 +0100 Subject: [PATCH 13/41] BGK mixture fixed PrandtlCorrection for molecules with inner degrees of freedom --- src/particles/bgk/bgk_colloperator.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 96c741c23..dcfde8def 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -604,14 +604,16 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES INTEGER :: iSpec, jSpec, INFO -REAL :: MolarFraction(1:nSpecies), MassFraction(1:nSpecies), MassIC_Mixture +REAL :: MolarFraction(1:nSpecies), MassFraction(1:nSpecies), MassIC_Mixture, DOFFraction(1:nSpecies) REAL :: PrandtlCorrection, dynamicvisSpec(nSpecies), thermalcondSpec(nSpecies), Phi(nSpecies) -REAL :: C_P, nu, A(3,3), W(3), Theta, CellTempSpec(nSpecies+1), Work(100) +REAL :: TotalDOFWeight, C_P, nu, A(3,3), W(3), Theta, CellTempSpec(nSpecies+1), Work(100) !=================================================================================================================================== IF (nSpecies.GT.1) THEN ! gas mixture MolarFraction(1:nSpecies) = totalWeightSpec(1:nSpecies) / totalWeight MassIC_Mixture = TotalMass / totalWeight MassFraction(1:nSpecies) = MolarFraction(1:nSpecies) * Species(1:nSpecies)%MassIC / MassIC_Mixture + DOFFraction(1:nSpecies) = totalWeightSpec(1:nSpecies) * (5.+Xi_RotSpec(1:nSpecies)+Xi_VibSpec(1:nSpecies)) + TotalDOFWeight = SUM(DOFFraction) PrandtlCorrection = 0. C_P = 0.0 @@ -619,12 +621,10 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight IF (nSpec(iSpec).EQ.0) CYCLE ! Correction of Pr for calculation of relaxation frequency, see alpha - Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), ! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar-Gross-Krook method for monatomic gas species" - PrandtlCorrection = PrandtlCorrection + MolarFraction(iSpec)*MassIC_Mixture/Species(iSpec)%MassIC - IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN ! molecules - C_P = C_P + ((5. + (Xi_VibSpec(iSpec)+Xi_RotSpec(iSpec)))/2.) * BoltzmannConst / Species(iSpec)%MassIC * MassFraction(iSpec) - ELSE ! atoms - C_P = C_P + (5./2.) * BoltzmannConst / Species(iSpec)%MassIC * MassFraction(iSpec) - END IF + ! Extension for inner degrees of freedom using S. Brull, Communications in Mathematical Sciences 19, 2177-2194, 2021, + ! "An Ellipsoidal Statistical Model for a monoatomic and polyatomic gas mixture" + PrandtlCorrection = PrandtlCorrection + DOFFraction(iSpec)*MassIC_Mixture/Species(iSpec)%MassIC/TotalDOFWeight + C_P = C_P + ((5. + (Xi_VibSpec(iSpec)+Xi_RotSpec(iSpec)))/2.) * BoltzmannConst / Species(iSpec)%MassIC * MassFraction(iSpec) END DO SELECT CASE(BGKMixtureModel) From 2710d0864fe26245c91a850262f932a02d03ed58 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Thu, 16 Mar 2023 15:57:23 +0100 Subject: [PATCH 14/41] Polyatomic mixtures enabled for ESBGK with subroutine CalcTEquiMultiPoly, subroutines CalcTEqui and CalcTEquiPoly shifted to fpflow_colloperator --- src/particles/bgk/bgk_colloperator.f90 | 452 +++++------------- src/particles/bgk/bgk_init.f90 | 8 - src/particles/fp_flow/fpflow_colloperator.f90 | 272 ++++++++++- 3 files changed, 382 insertions(+), 350 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index dcfde8def..a7a3af96c 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -29,7 +29,7 @@ MODULE MOD_BGK_CollOperator !----------------------------------------------------------------------------------------------------------------------------------- ! Private Part --------------------------------------------------------------------------------------------------------------------- ! Public Part ---------------------------------------------------------------------------------------------------------------------- -PUBLIC :: BGK_CollisionOperator, ARShakhov, CalcTEquiPoly, CalcTEqui +PUBLIC :: BGK_CollisionOperator, ARShakhov !=================================================================================================================================== CONTAINS @@ -78,8 +78,8 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) REAL :: alpha, alphaRot(nSpecies), CellTemp, dens, InnerDOF, NewEn, OldEn, Prandtl, relaxfreq, TEqui REAL :: dynamicvis, thermalcond INTEGER, ALLOCATABLE :: iPartIndx_NodeRelax(:),iPartIndx_NodeRelaxTemp(:),iPartIndx_NodeRelaxRot(:),iPartIndx_NodeRelaxVib(:) -INTEGER :: iLoop, iPart, nRelax, iPolyatMole, nXiVibDOF -REAL, ALLOCATABLE :: Xi_vib_DOF(:), VibEnergyDOF(:,:) +INTEGER :: iLoop, iPart, nRelax, iPolyatMole, nXiVibDOF, nXiVibDOFSpec(nSpecies) +REAL, ALLOCATABLE :: Xi_vib_DOF(:,:), VibEnergyDOF(:,:) INTEGER :: iSpec, nSpec(nSpecies), jSpec, nRotRelax, nVibRelax REAL :: OldEnRot, NewEnRot(nSpecies), NewEnVib(nSpecies) REAL :: TotalMass, u2Spec(nSpecies), u2i(3), vBulkAll(3) @@ -133,18 +133,19 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) dens = totalWeight * Species(1)%MacroParticleFactor / NodeVolume END IF -! Calculation of the rotational and vibrational degrees of freedom for molecules -nXiVibDOF=0 ! Initialize -IF (nSpecies.EQ.1) THEN - IF((SpecDSMC(1)%InterID.EQ.2).OR.(SpecDSMC(1)%InterID.EQ.20)) THEN - IF(SpecDSMC(1)%PolyatomicMol) THEN - iPolyatMole = SpecDSMC(1)%SpecToPolyArray - nXiVibDOF = PolyatomMolDSMC(iPolyatMole)%VibDOF - ALLOCATE(Xi_vib_DOF(nXiVibDOF)) - Xi_vib_DOF(:) = 0. +! Allocate Xi_vib_DOF +nXiVibDOF=0.0 ! Initialize +DO iSpec = 1, nSpecies + IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + IF(SpecDSMC(iSpec)%PolyatomicMol) THEN + iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray + nXiVibDOFSpec(iSpec) = PolyatomMolDSMC(iPolyatMole)%VibDOF END IF END IF -END IF +END DO +nXiVibDOF = MAXVAL(nXiVibDOFSpec(:)) +ALLOCATE(Xi_vib_DOF(nSpecies,nXiVibDOF)) +Xi_vib_DOF = 0.0 CALL CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, TRotSpec, InnerDOF, Xi_VibSpec, Xi_Vib_oldSpec & ,Xi_RotSpec) @@ -192,15 +193,17 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) RotExpSpec=0.; VibExpSpec=0. ! Calculation of the equilibrium temperature - IF(SpecDSMC(1)%PolyatomicMol) THEN ! polyatomic, NO MIXTURES POSSIBLE BY NOW - CALL CalcTEquiPoly(nPart, CellTemp, TRotSpec(1), TVibSpec(1), nXiVibDOF, Xi_vib_DOF, Xi_Vib_oldSpec(1), RotExpSpec(1), VibExpSpec(1), & - TEqui, rotrelaxfreqSpec(1), vibrelaxfreqSpec(1), dtCell) - ! Corrected vibrational degrees of freedom - Xi_VibSpec(1) = SUM(Xi_vib_DOF(1:PolyatomMolDSMC(iPolyatMole)%VibDOF)) - ELSE ! diatomic - CALL CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec, Xi_Vib_oldSpec, RotExpSpec, VibExpSpec, & + CALL CalcTEquiMultiPoly(nPart, nSpec, nXiVibDOF, Xi_vib_DOF, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec, Xi_Vib_oldSpec, RotExpSpec, VibExpSpec, & TEqui, rotrelaxfreqSpec, vibrelaxfreqSpec, dtCell) - END IF + ! IF(SpecDSMC(1)%PolyatomicMol) THEN ! polyatomic, NO MIXTURES POSSIBLE BY NOW + ! CALL CalcTEquiPoly(nPart, CellTemp, TRotSpec(1), TVibSpec(1), nXiVibDOF, Xi_vib_DOF, Xi_Vib_oldSpec(1), RotExpSpec(1), VibExpSpec(1), & + ! TEqui, rotrelaxfreqSpec(1), vibrelaxfreqSpec(1), dtCell) + ! ! Corrected vibrational degrees of freedom + ! Xi_VibSpec(1) = SUM(Xi_vib_DOF(1:PolyatomMolDSMC(iPolyatMole)%VibDOF)) + ! ELSE ! diatomic + ! CALL CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec, Xi_Vib_oldSpec, RotExpSpec, VibExpSpec, & + ! TEqui, rotrelaxfreqSpec, vibrelaxfreqSpec, dtCell) + ! END IF IF(DSMC%CalcQualityFactors) THEN BGK_MaxRotRelaxFactor = MAX(BGK_MaxRotRelaxFactor,MAXVAL(rotrelaxfreqSpec(:))*dtCell) END IF @@ -822,7 +825,7 @@ SUBROUTINE RelaxInnerEnergy(nPart, nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, ! INPUT VARIABLES INTEGER, INTENT(IN) :: nPart,nXiVibDOF INTEGER, INTENT(IN) :: nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib(nPart), iPartIndx_NodeRelaxRot(nPart) -REAL, INTENT(IN) :: Xi_vib_DOF(nXiVibDOF), TEqui, Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies) +REAL, INTENT(IN) :: Xi_vib_DOF(nSpecies,nXiVibDOF), TEqui, Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies) REAL, INTENT(INOUT) :: NewEnVib(nSpecies), NewEnRot(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES @@ -847,7 +850,7 @@ SUBROUTINE RelaxInnerEnergy(nPart, nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, ! Polyatomic Species in Hypersonic Flow around a Flat-faced Cylinder", AIP Conference Proceedings 2132, 100001 (2019) DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF CALL RANDOM_NUMBER(iRan) - VibEnergyDOF(iLoop,iDOF) = - LOG(iRan)*Xi_vib_DOF(iDOF)/2.*TEqui*BoltzmannConst + VibEnergyDOF(iLoop,iDOF) = - LOG(iRan)*Xi_vib_DOF(iSpec,iDOF)/2.*TEqui*BoltzmannConst PartStateIntEn(1,iPart) = PartStateIntEn(1,iPart)+VibEnergyDOF(iLoop,iDOF) END DO ! ELSE: diatomic, only one vibrational DOF, calculate new vibrational energy according to M. Pfeiffer, "Extending the particle @@ -1141,7 +1144,7 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, nVibRelaxSpec, iPartIndx_NodeRelaxVib END IF ! Remaining OldEn for remaining particles OldEn = OldEn - (PartStateIntEn( 1,iPart) - SpecDSMC(iSpec)%EZeroPoint)*partWeight - END IF ! SpecDSMC(1)%PolyatomicMol + END IF END DO ELSE ! Continuous treatment of vibrational energy DO iLoop = 1, nVibRelax @@ -1326,118 +1329,13 @@ SUBROUTINE BGK_BuildTransGaussNums(nPart, iRanPart) END SUBROUTINE BGK_BuildTransGaussNums -SUBROUTINE CalcTEqui(nPart, CellTemp, TRot, TVib, Xi_Vib, Xi_Vib_old, RotExp, VibExp, & - TEqui, rotrelaxfreq, vibrelaxfreq, dtCell, DoVibRelaxIn) +SUBROUTINE CalcTEquiMultiPoly(nPart, nSpec, nXiVibDOF, Xi_vib_DOF, CellTemp, TRotSpec, TVibSpec, Xi_Vib_Spec, Xi_Vib_oldSpec, RotExpSpec, & + VibExpSpec, TEqui, rotrelaxfreqSpec, vibrelaxfreqSpec, dtCell, DoVibRelaxIn) !=================================================================================================================================== -! Calculation of the vibrational temperature (zero-point search) for non-polyatomic molecules for Fokker-Planck +! Calculation of the vibrational temperature (zero-point search) for polyatomic molecule mixtures !=================================================================================================================================== ! MODULES -USE MOD_DSMC_Vars, ONLY: SpecDSMC -USE MOD_BGK_Vars, ONLY: BGKDoVibRelaxation -! IMPLICIT VARIABLE HANDLING -IMPLICIT NONE -!----------------------------------------------------------------------------------------------------------------------------------- -! INPUT VARIABLES -REAL, INTENT(IN) :: CellTemp, TRot, TVib, Xi_Vib_old, rotrelaxfreq, vibrelaxfreq, dtCell -INTEGER, INTENT(IN) :: nPart -LOGICAL, OPTIONAL, INTENT(IN) :: DoVibRelaxIn -!----------------------------------------------------------------------------------------------------------------------------------- -! OUTPUT VARIABLES -REAL, INTENT(OUT) :: Xi_vib, TEqui, RotExp, VibExp -!----------------------------------------------------------------------------------------------------------------------------------- -! LOCAL VARIABLES -!----------------------------------------------------------------------------------------------------------------------------------- -REAL :: TEqui_Old, betaR, betaV, RotFrac, VibFrac, TEqui_Old2 -REAL :: eps_prec=1.0E-0 -REAL :: correctFac, correctFacRot, maxexp !, Xi_rel -LOGICAL :: DoVibRelax -!=================================================================================================================================== -IF (PRESENT(DoVibRelaxIn)) THEN - DoVibRelax = DoVibRelaxIn -ELSE - DoVibRelax = BGKDoVibRelaxation -END IF -maxexp = LOG(HUGE(maxexp)) -! Xi_rel = 2.*(2. - CollInf%omega(1,1)) -! correctFac = 1. + (2.*SpecDSMC(1)%CharaTVib / (CellTemp*(EXP(SpecDSMC(1)%CharaTVib / CellTemp)-1.)))**(2.) & -! * EXP(SpecDSMC(1)%CharaTVib /CellTemp) / (2.*Xi_rel) -! correctFacRot = 1. + 2./Xi_rel - -correctFac = 1. -correctFacRot = 1. -RotExp = exp(-rotrelaxfreq*dtCell/correctFacRot) -RotFrac = nPart*(1.-RotExp) -IF(DoVibRelax) THEN - VibExp = exp(-vibrelaxfreq*dtCell/correctFac) - VibFrac = nPart*(1.-VibExp) -ELSE - VibExp = 0.0 - VibFrac = 0.0 - Xi_vib = 0.0 -END IF -TEqui_Old = 0.0 -TEqui = (3.*(nPart-1.)*CellTemp+2.*RotFrac*TRot+Xi_Vib_old*VibFrac*TVib)/(3.*(nPart-1.)+2.*RotFrac+Xi_Vib_old*VibFrac) -DO WHILE ( ABS( TEqui - TEqui_Old ) .GT. eps_prec ) - IF (ABS(TRot-TEqui).LT.1E-3) THEN - RotExp = exp(-rotrelaxfreq*dtCell/correctFacRot) - ELSE - betaR = ((TRot-CellTemp)/(TRot-TEqui))*rotrelaxfreq*dtCell/correctFacRot - IF (-betaR.GT.0.0) THEN - RotExp = 0. - ELSE IF (betaR.GT.maxexp) THEN - RotExp = 0. - ELSE - RotExp = exp(-betaR) - END IF - END IF - RotFrac = nPart*(1.-RotExp) - IF(DoVibRelax) THEN - IF (ABS(TVib-TEqui).LT.1E-3) THEN - VibExp = exp(-vibrelaxfreq*dtCell/correctFac) - ELSE - betaV = ((TVib-CellTemp)/(TVib-TEqui))*vibrelaxfreq*dtCell/correctFac - IF (-betaV.GT.0.0) THEN - VibExp = 0. - ELSE IF (betaV.GT.maxexp) THEN - VibExp = 0. - ELSE - VibExp = exp(-betaV) - END IF - END IF - IF ((SpecDSMC(1)%CharaTVib/TEqui).GT.maxexp) THEN - Xi_Vib = 0.0 - ELSE - Xi_vib = 2.*SpecDSMC(1)%CharaTVib/TEqui/(EXP(SpecDSMC(1)%CharaTVib/TEqui)-1.) - END IF - VibFrac = nPart*(1.-VibExp) - END IF - TEqui_Old = TEqui - TEqui_Old2 = TEqui - TEqui = (3.*(nPart-1.)*CellTemp+2.*RotFrac*TRot+Xi_Vib_old*VibFrac*TVib)/(3.*(nPart-1.)+2.*RotFrac+Xi_Vib*VibFrac) - IF(DoVibRelax) THEN - DO WHILE( ABS( TEqui - TEqui_Old2 ) .GT. eps_prec ) - TEqui =(TEqui + TEqui_Old2)*0.5 - IF ((SpecDSMC(1)%CharaTVib/TEqui).GT.maxexp) THEN - Xi_Vib = 0.0 - ELSE - Xi_vib = 2.*SpecDSMC(1)%CharaTVib/TEqui/(EXP(SpecDSMC(1)%CharaTVib/TEqui)-1.) - END IF - TEqui_Old2 = TEqui - TEqui = (3.*(nPart-1.)*CellTemp+2.*RotFrac*TRot+Xi_Vib_old*VibFrac*TVib) / (3.*(nPart-1.)+2.*RotFrac+Xi_vib*VibFrac) - END DO - END IF -END DO - -END SUBROUTINE CalcTEqui - - -SUBROUTINE CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec, Xi_Vib_oldSpec, RotExpSpec, VibExpSpec, & - TEqui, rotrelaxfreqSpec, vibrelaxfreqSpec, dtCell, DoVibRelaxIn) -!=================================================================================================================================== -! Calculation of the vibrational temperature (zero-point search) for diatomic molecule mixtures -!=================================================================================================================================== -! MODULES -USE MOD_DSMC_Vars, ONLY: SpecDSMC +USE MOD_DSMC_Vars, ONLY: SpecDSMC, PolyatomMolDSMC USE MOD_BGK_Vars, ONLY: BGKDoVibRelaxation USE MOD_Particle_Vars, ONLY: nSpecies ! IMPLICIT VARIABLE HANDLING @@ -1446,51 +1344,49 @@ SUBROUTINE CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec ! INPUT VARIABLES REAL, INTENT(IN) :: CellTemp, TRotSpec(nSpecies), TVibSpec(nSpecies), Xi_Vib_oldSpec(nSpecies) REAL, INTENT(IN) :: rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies), dtCell -INTEGER, INTENT(IN) :: nPart, nSpec(nSpecies) +INTEGER, INTENT(IN) :: nPart, nSpec(nSpecies), nXiVibDOF LOGICAL, OPTIONAL, INTENT(IN) :: DoVibRelaxIn !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES -REAL, INTENT(OUT) :: Xi_VibSpec(nSpecies), TEqui, RotExpSpec(nSpecies), VibExpSpec(nSpecies) +REAL, INTENT(OUT) :: Xi_Vib_Spec(nSpecies), TEqui, RotExpSpec(nSpecies), VibExpSpec(nSpecies) +REAL, INTENT(OUT) :: Xi_vib_DOF(nSpecies,nXiVibDOF) !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES !----------------------------------------------------------------------------------------------------------------------------------- REAL :: TEqui_Old, betaR, betaV, RotFracSpec(nSpecies), VibFracSpec(nSpecies), TEqui_Old2 +REAL :: Xi_Rot_Spec(nSpecies) REAL :: eps_prec=1.0E-0 -REAL :: correctFac, correctFacRot, exparg, TEquiNumDof !, Xi_rel, +REAL :: exparg, TEquiNumDof LOGICAL :: DoVibRelax -INTEGER :: iSpec +INTEGER :: iSpec, iDOF, iPolyatMole !=================================================================================================================================== IF (PRESENT(DoVibRelaxIn)) THEN DoVibRelax = DoVibRelaxIn ELSE DoVibRelax = BGKDoVibRelaxation END IF -! Xi_rel = 2.*(2. - CollInf%omega(1,1)) -! correctFac = 1. + (2.*SpecDSMC(1)%CharaTVib / (CellTemp*(EXP(SpecDSMC(1)%CharaTVib / CellTemp)-1.)))**(2.) & -! * EXP(SpecDSMC(1)%CharaTVib /CellTemp) / (2.*Xi_rel) -! correctFacRot = 1. + 2./Xi_rel -correctFac = 1. -correctFacRot = 1. RotFracSpec = 0.0 VibFracSpec = 0.0 ! Loop over all molecular species --> only internal energies are relevant here DO iSpec=1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + ! rotational degrees of freedom of molecules + Xi_Rot_Spec(iSpec) = SpecDSMC(iSpec)%Xi_Rot ! Calculate number of rotational relaxing molecules with number of molecules * probability of relaxation ! P = 1 - exp(-nu*dt) with relaxation frequency nu and timestep dt - RotExpSpec(iSpec) = exp(-rotrelaxfreqSpec(iSpec)*dtCell/correctFacRot) + RotExpSpec(iSpec) = exp(-rotrelaxfreqSpec(iSpec)*dtCell) RotFracSpec(iSpec) = nSpec(iSpec)*(1.-RotExpSpec(iSpec)) ! Calculate number of vibrational relaxing molecules if enabled with number of molecules * probability of relaxation ! P = 1 - exp(-nu*dt) with relaxation frequency nu and timestep dt IF(DoVibRelax) THEN - VibExpSpec(iSpec) = exp(-vibrelaxfreqSpec(iSpec)*dtCell/correctFac) + VibExpSpec(iSpec) = exp(-vibrelaxfreqSpec(iSpec)*dtCell) VibFracSpec(iSpec) = nSpec(iSpec)*(1.-VibExpSpec(iSpec)) ELSE VibExpSpec(iSpec) = 0.0 VibFracSpec(iSpec) = 0.0 - Xi_VibSpec(iSpec) = 0.0 + Xi_Vib_Spec(iSpec) = 0.0 END IF END IF END DO @@ -1498,13 +1394,15 @@ SUBROUTINE CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec ! Calculation of equilibrium temperature ! M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules including ! quantized vibrational energies", Phys. Fluids 30, 116103 (2018), Eq. 25 +! M. Pfeiffer et. al., "Extension of Particle-based BGK Models to Polyatomic Species in Hypersonic Flow around a Flat-faced +! Cylinder", AIP Conference Proceedings 2132, 100001 (2019) TEqui = 3.*(nPart-1.)*CellTemp TEquiNumDof = 3.*(nPart-1.) ! Sum up over all species DO iSpec=1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - TEqui = TEqui + 2.*RotFracSpec(iSpec)*TRotSpec(iSpec)+Xi_Vib_oldSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) - TEquiNumDof = TEquiNumDof + 2.*RotFracSpec(iSpec) + Xi_Vib_oldSpec(iSpec)*VibFracSpec(iSpec) + TEqui = TEqui + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec)+Xi_Vib_oldSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) + TEquiNumDof = TEquiNumDof + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec) + Xi_Vib_oldSpec(iSpec)*VibFracSpec(iSpec) END IF END DO TEqui = TEqui / TEquiNumDof @@ -1516,12 +1414,12 @@ SUBROUTINE CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec DO WHILE ( ABS( TEqui - TEqui_Old ) .GT. eps_prec ) DO iSpec = 1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - ! if difference too small: beta is not taken into account + ! if difference small: equilibrium, no beta IF (ABS(TRotSpec(iSpec)-TEqui).LT.1E-3) THEN - RotExpSpec(iSpec) = exp(-rotrelaxfreqSpec(iSpec)*dtCell/correctFacRot) + RotExpSpec(iSpec) = exp(-rotrelaxfreqSpec(iSpec)*dtCell) ELSE ! betaR = beta*nu*dt (= correction parameter rotation * relaxation frequency * time step) - betaR = ((TRotSpec(iSpec)-CellTemp)/(TRotSpec(iSpec)-TEqui))*rotrelaxfreqSpec(iSpec)*dtCell/correctFacRot + betaR = ((TRotSpec(iSpec)-CellTemp)/(TRotSpec(iSpec)-TEqui))*rotrelaxfreqSpec(iSpec)*dtCell ! negative betaR would leed to negative relaxation probability! IF (-betaR.GT.0.0) THEN RotExpSpec(iSpec) = 0. @@ -1536,12 +1434,12 @@ SUBROUTINE CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec RotFracSpec(iSpec) = nSpec(iSpec)*(1.-RotExpSpec(iSpec)) IF(DoVibRelax) THEN - ! if difference too small: beta is not taken into account + ! if difference small: equilibrium, no beta IF (ABS(TVibSpec(iSpec)-TEqui).LT.1E-3) THEN - VibExpSpec(iSpec) = exp(-vibrelaxfreqSpec(iSpec)*dtCell/correctFac) + VibExpSpec(iSpec) = exp(-vibrelaxfreqSpec(iSpec)*dtCell) ELSE ! betaV = beta*nu*dt (= correction parameter vibration * relaxation frequency * time step) - betaV = ((TVibSpec(iSpec)-CellTemp)/(TVibSpec(iSpec)-TEqui))*vibrelaxfreqSpec(iSpec)*dtCell/correctFac + betaV = ((TVibSpec(iSpec)-CellTemp)/(TVibSpec(iSpec)-TEqui))*vibrelaxfreqSpec(iSpec)*dtCell ! negative betaV would leed to negative relaxation probability! IF (-betaV.GT.0.0) THEN VibExpSpec(iSpec) = 0. @@ -1555,14 +1453,33 @@ SUBROUTINE CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec ! new calculation of number of vibrational relaxing molecules VibFracSpec(iSpec) = nSpec(iSpec)*(1.-VibExpSpec(iSpec)) - ! new calculation of the vibrational degrees of freedom - exparg = SpecDSMC(iSpec)%CharaTVib/TEqui - ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom - IF(CHECKEXP(exparg))THEN - Xi_VibSpec(iSpec) = 2.*SpecDSMC(iSpec)%CharaTVib/TEqui/(EXP(exparg)-1.) - ELSE - Xi_VibSpec(iSpec) = 0.0 - END IF ! CHECKEXP(exparg) + ! new calculation of the vibrational degrees of freedom per species + IF(SpecDSMC(iSpec)%PolyatomicMol) THEN + iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray + ! Loop over all vibrational degrees of freedom to calculate them using TEqui + DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF + exparg = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TEqui + ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom + IF(CHECKEXP(exparg))THEN + IF(exparg.gt.0.)THEN ! positive overflow: exp -> inf + Xi_vib_DOF(iSpec,iDOF) = 2.*exparg/(EXP(exparg)-1.) + ELSE ! negative overflow: exp -> 0 + Xi_vib_DOF(iSpec,iDOF) = 2.*exparg/(-1.) + END IF ! exparg.gt.0. + ELSE + Xi_vib_DOF(iSpec,iDOF) = 0.0 + END IF ! CHECKEXP(exparg) + END DO + Xi_Vib_Spec(iSpec) = SUM(Xi_vib_DOF(iSpec,1:PolyatomMolDSMC(iPolyatMole)%VibDOF)) + ELSE ! diatomic + exparg = SpecDSMC(iSpec)%CharaTVib/TEqui + ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom + IF(CHECKEXP(exparg))THEN + Xi_Vib_Spec(iSpec) = 2.*SpecDSMC(iSpec)%CharaTVib/TEqui/(EXP(exparg)-1.) + ELSE + Xi_Vib_Spec(iSpec) = 0.0 + END IF ! CHECKEXP(exparg) + END IF END IF END IF END DO @@ -1575,8 +1492,8 @@ SUBROUTINE CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec ! Sum up over all species DO iSpec=1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - TEqui = TEqui + 2.*RotFracSpec(iSpec)*TRotSpec(iSpec)+Xi_Vib_oldSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) - TEquiNumDof = TEquiNumDof + 2.*RotFracSpec(iSpec) + Xi_VibSpec(iSpec)*VibFracSpec(iSpec) + TEqui = TEqui + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec)+Xi_Vib_oldSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) + TEquiNumDof = TEquiNumDof + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec) + Xi_Vib_Spec(iSpec)*VibFracSpec(iSpec) END IF END DO TEqui = TEqui / TEquiNumDof @@ -1587,13 +1504,33 @@ SUBROUTINE CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec TEqui =(TEqui + TEqui_Old2)*0.5 DO iSpec=1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - ! new calculation of the vibrational degrees of freedom - exparg = SpecDSMC(iSpec)%CharaTVib/TEqui - IF(CHECKEXP(exparg))THEN - Xi_VibSpec(iSpec) = 2.*SpecDSMC(iSpec)%CharaTVib/TEqui/(EXP(exparg)-1.) - ELSE - Xi_VibSpec(iSpec) = 0.0 - END IF ! CHECKEXP(exparg) + ! new calculation of the vibrational degrees of freedom per species + IF(SpecDSMC(iSpec)%PolyatomicMol) THEN + iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray + ! Loop over all vibrational degrees of freedom to calculate them using TEqui + DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF + exparg = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TEqui + ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom + IF(CHECKEXP(exparg))THEN + IF(exparg.gt.0.)THEN ! positive overflow: exp -> inf + Xi_vib_DOF(iSpec,iDOF) = 2.*exparg/(EXP(exparg)-1.) + ELSE ! negative overflow: exp -> 0 + Xi_vib_DOF(iSpec,iDOF) = 2.*exparg/(-1.) + END IF ! exparg.gt.0. + ELSE + Xi_vib_DOF(iSpec,iDOF) = 0.0 + END IF ! CHECKEXP(exparg) + END DO + Xi_Vib_Spec(iSpec) = SUM(Xi_vib_DOF(iSpec,1:PolyatomMolDSMC(iPolyatMole)%VibDOF)) + ELSE ! diatomic + exparg = SpecDSMC(iSpec)%CharaTVib/TEqui + ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom + IF(CHECKEXP(exparg))THEN + Xi_Vib_Spec(iSpec) = 2.*SpecDSMC(iSpec)%CharaTVib/TEqui/(EXP(exparg)-1.) + ELSE + Xi_Vib_Spec(iSpec) = 0.0 + END IF ! CHECKEXP(exparg) + END IF END IF END DO ! new calculation of equilibrium temperature with corrected vibrational degrees of freedom in denominator @@ -1603,182 +1540,15 @@ SUBROUTINE CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec ! Sum up over all species DO iSpec=1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - TEqui = TEqui + 2.*RotFracSpec(iSpec)*TRotSpec(iSpec)+Xi_Vib_oldSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) - TEquiNumDof = TEquiNumDof + 2.*RotFracSpec(iSpec) + Xi_VibSpec(iSpec)*VibFracSpec(iSpec) + TEqui = TEqui + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec)+Xi_Vib_oldSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) + TEquiNumDof = TEquiNumDof + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec) + Xi_Vib_Spec(iSpec)*VibFracSpec(iSpec) END IF END DO TEqui = TEqui / TEquiNumDof END DO END IF END DO -END SUBROUTINE CalcTEquiMulti - - -SUBROUTINE CalcTEquiPoly(nPart, CellTemp, TRot, TVib, nXiVibDOF, Xi_Vib_DOF, Xi_Vib_old, RotExp, VibExp, TEqui, rotrelaxfreq, vibrelaxfreq, & - dtCell, DoVibRelaxIn) -!=================================================================================================================================== -! Calculation of the vibrational temperature (zero-point search) for polyatomic molecules -!=================================================================================================================================== -! MODULES -USE MOD_DSMC_Vars, ONLY: SpecDSMC, PolyatomMolDSMC -USE MOD_BGK_Vars, ONLY: BGKDoVibRelaxation -! IMPLICIT VARIABLE HANDLING -IMPLICIT NONE -!----------------------------------------------------------------------------------------------------------------------------------- -! INPUT VARIABLES -REAL, INTENT(IN) :: CellTemp, TRot, TVib, Xi_Vib_old, rotrelaxfreq, vibrelaxfreq -INTEGER, INTENT(IN) :: nPart,nXiVibDOF -REAL, INTENT(IN) :: dtCell -LOGICAL, OPTIONAL, INTENT(IN) :: DoVibRelaxIn -!----------------------------------------------------------------------------------------------------------------------------------- -! OUTPUT VARIABLES -REAL, INTENT(OUT) :: Xi_vib_DOF(nXiVibDOF), TEqui, RotExp, VibExp -!----------------------------------------------------------------------------------------------------------------------------------- -! LOCAL VARIABLES -!----------------------------------------------------------------------------------------------------------------------------------- -REAL :: TEqui_Old, betaR, betaV, RotFrac, VibFrac, Xi_Rot, TEqui_Old2, exparg -REAL :: eps_prec=1.0 -REAL :: correctFac, correctFacRot -INTEGER :: iDOF, iPolyatMole -LOGICAL :: DoVibRelax -!=================================================================================================================================== -IF (PRESENT(DoVibRelaxIn)) THEN - DoVibRelax = DoVibRelaxIn -ELSE - DoVibRelax = BGKDoVibRelaxation -END IF - -! rotational degrees of freedom of polyatomic molecule -Xi_Rot = SpecDSMC(1)%Xi_Rot -iPolyatMole = SpecDSMC(1)%SpecToPolyArray - -! Xi_rel = 2.*(2. - CollInf%omega(1,1)) -! correctFac = 0.0 -! DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF -! correctFac = correctFac & -! + (2.*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF) / (CellTemp & -! *(EXP(PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF) / CellTemp)-1.)))**(2.) & -! * EXP(PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF) / CellTemp) / 2. -! END DO -! correctFac = 1. + correctFac/Xi_rel -! correctFacRot = 1. + Xi_Rot/Xi_rel - -correctFac = 1. -correctFacRot = 1. - -! Calculate number of rotational relaxing molecules with number of molecules * probability of relaxation -! P = 1 - exp(-nu*dt) with relaxation frequency nu and timestep dt -RotExp = exp(-rotrelaxfreq*dtCell/correctFacRot) -RotFrac = nPart*(1.-RotExp) -! Calculate number of vibrational relaxing molecules if enabled with number of molecules * probability of relaxation -! P = 1 - exp(-nu*dt) with relaxation frequency nu and timestep dt -IF(DoVibRelax) THEN - VibExp = exp(-vibrelaxfreq*dtCell/correctFac) - VibFrac = nPart*(1.-VibExp) -ELSE - VibExp = 0.0 - VibFrac = 0.0 - Xi_vib_DOF = 0.0 -END IF -TEqui_Old = 0.0 -! M. Pfeiffer et. al., "Extension of Particle-based BGK Models to Polyatomic Species in Hypersonic Flow around a Flat-faced -! Cylinder", AIP Conference Proceedings 2132, 100001 (2019) -! Solving of equation system for TEqui and betaR and betaV -TEqui = (3.*(nPart-1.)*CellTemp+2.*RotFrac*TRot+Xi_Vib_old*VibFrac*TVib)/(3.*(nPart-1.)+2.*RotFrac+Xi_Vib_old*VibFrac) -! Required condition of Landau-Teller relaxation not fulfilled --> relaxation probabilities of rotation and vibration are -! corrected with a parameter beta for rotation and vibration as suggested by Burt: -! J. Burt and I. Boyd, “Evaluation of a particle method for the ellipsoidal statistical Bhatnagar-Gross-Krook equation”, -! 44th AIAA Aerospace Sciences Meeting and Exhibit (AIAA, 2006), p. 989 -! Solving of equation system until accuracy eps_prec is reached -DO WHILE ( ABS( TEqui - TEqui_Old ) .GT. eps_prec ) - ! if difference too small: beta is not taken into account - IF (ABS(TRot-TEqui).LT.1E-3) THEN - RotExp = exp(-rotrelaxfreq*dtCell/correctFacRot) - ELSE - ! betaR = beta*nu*dt (= correction parameter rotation * relaxation frequency * time step) - betaR = ((TRot-CellTemp)/(TRot-TEqui))*rotrelaxfreq*dtCell/correctFacRot - ! negative betaR would leed to negative relaxation probability! - IF (-betaR.GT.0.0) THEN - RotExp = 0. - ! Check if the exponent is within the range of machine precision - ELSE IF (CHECKEXP(betaR)) THEN - RotExp = exp(-betaR) - ELSE - RotExp = 0. - END IF - END IF - ! new calculation of number of rotational relaxing molecules - RotFrac = nPart*(1.-RotExp) - - IF(DoVibRelax) THEN - ! if difference too small: beta is not taken into account - IF (ABS(TVib-TEqui).LT.1E-3) THEN - VibExp = exp(-vibrelaxfreq*dtCell/correctFac) - ELSE - ! betaV = beta*nu*dt (= correction parameter vibration * relaxation frequency * time step) - betaV = ((TVib-CellTemp)/(TVib-TEqui))*vibrelaxfreq*dtCell/correctFac - ! negative betaV would leed to negative relaxation probability! - IF (-betaV.GT.0.0) THEN - VibExp = 0. - ! Check if the exponent is within the range of machine precision - ELSEIF(CHECKEXP(betaV))THEN - VibExp = exp(-betaV) - ELSE - VibExp = 0. - END IF - END IF - ! new calculation of number of vibrational relaxing molecules - VibFrac = nPart*(1.-VibExp) - - ! Loop over all vibrational degrees of freedom to calculate them using TEqui - DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF - exparg = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TEqui - ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom - IF(CHECKEXP(exparg))THEN - IF(exparg.gt.0.)THEN ! positive overflow: exp -> inf - Xi_vib_DOF(iDOF) = 2.*exparg/(EXP(exparg)-1.) - ELSE ! negative overflow: exp -> 0 - Xi_vib_DOF(iDOF) = 2.*exparg/(-1.) - END IF ! exparg.gt.0. - ELSE - Xi_vib_DOF(iDOF) = 0.0 - END IF ! CHECKEXP(exparg) - END DO - END IF - TEqui_Old = TEqui - TEqui_Old2 = TEqui - - ! new calculation of equilibrium temperature with new RotFrac, new VibFrac new Xi_vib_DOF(TEqui) in denominator - TEqui = (3.*(nPart-1.)*CellTemp+2.*RotFrac*TRot+Xi_Vib_old*VibFrac*TVib) & - / (3.*(nPart-1.)+2.*RotFrac+SUM(Xi_vib_DOF(1:PolyatomMolDSMC(iPolyatMole)%VibDOF))*VibFrac) - IF(DoVibRelax) THEN - ! accuracy eps_prec not reached yet - DO WHILE( ABS( TEqui - TEqui_Old2 ) .GT. eps_prec ) - ! mean value of old and new equilibrium temperature - TEqui =(TEqui + TEqui_Old2)*0.5 - ! Loop over all vibrational degrees of freedom - DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF - exparg = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TEqui - ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom - IF(CHECKEXP(exparg))THEN - IF(exparg.gt.0.)THEN ! positive overflow: exp -> inf - Xi_vib_DOF(iDOF) = 2.*exparg/(EXP(exparg)-1.) - ELSE ! negative overflow: exp -> 0 - Xi_vib_DOF(iDOF) = 2.*exparg/(-1.) - END IF ! exparg.gt.0. - ELSE - Xi_vib_DOF(iDOF) = 0.0 - END IF ! CHECKEXP(exparg) - END DO - TEqui_Old2 = TEqui - ! new calculation of equilibrium temperature with corrected vibrational degrees of freedom in denominator - TEqui = (3.*(nPart-1.)*CellTemp+2.*RotFrac*TRot+Xi_Vib_old*VibFrac*TVib) & - / (3.*(nPart-1.)+2.*RotFrac+SUM(Xi_vib_DOF(1:PolyatomMolDSMC(iPolyatMole)%VibDOF))*VibFrac) - END DO - END IF -END DO - -END SUBROUTINE CalcTEquiPoly +END SUBROUTINE CalcTEquiMultiPoly SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_VibSpec, Visc, ThermalCond) diff --git a/src/particles/bgk/bgk_init.f90 b/src/particles/bgk/bgk_init.f90 index ae7b7ecb0..ae67625be 100644 --- a/src/particles/bgk/bgk_init.f90 +++ b/src/particles/bgk/bgk_init.f90 @@ -126,9 +126,6 @@ SUBROUTINE InitBGK() /(2.*(Species(iSpec)%MassIC * Species(iSpec2)%MassIC)))/CollInf%Tref(iSpec,iSpec2)**(-CollInf%omega(iSpec,iSpec2) +0.5) END DO END DO -IF ((nSpecies.GT.1).AND.(ANY(SpecDSMC(:)%PolyatomicMol))) THEN - CALL abort(__STAMP__,' ERROR Multispec not implemented with polyatomic molecules!') -END IF BGKCollModel = GETINT('Particles-BGK-CollModel') IF ((nSpecies.GT.1).AND.(BGKCollModel.GT.1)) THEN @@ -169,11 +166,6 @@ SUBROUTINE InitBGK() ! Vibrational modelling BGKDoVibRelaxation = GETLOGICAL('Particles-BGK-DoVibRelaxation') BGKUseQuantVibEn = GETLOGICAL('Particles-BGK-UseQuantVibEn') - !IF ((nSpecies.GT.1).AND.(BGKUseQuantVibEn)) THEN - ! CALL abort(& - ! __STAMP__& - ! ,' ERROR Multispec not implemented for quantized vibrational energy!') - !END IF END IF IF(DSMC%CalcQualityFactors) THEN diff --git a/src/particles/fp_flow/fpflow_colloperator.f90 b/src/particles/fp_flow/fpflow_colloperator.f90 index 307b979cc..43485cd8f 100644 --- a/src/particles/fp_flow/fpflow_colloperator.f90 +++ b/src/particles/fp_flow/fpflow_colloperator.f90 @@ -51,7 +51,6 @@ SUBROUTINE FP_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) USE MOD_DSMC_Vars ,ONLY: CollInf, RadialWeighting USE Ziggurat USE MOD_Particle_Analyze_Tools ,ONLY: CalcTVibPoly -USE MOD_BGK_CollOperator ,ONLY: CalcTEquiPoly, CalcTEqui USE MOD_part_tools ,ONLY: GetParticleWeight ! IMPLICIT VARIABLE HANDLING IMPLICIT NONE @@ -701,4 +700,275 @@ SUBROUTINE FP_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) END SUBROUTINE FP_CollisionOperator +SUBROUTINE CalcTEqui(nPart, CellTemp, TRot, TVib, Xi_Vib, Xi_Vib_old, RotExp, VibExp, & + TEqui, rotrelaxfreq, vibrelaxfreq, dtCell, DoVibRelaxIn) +!=================================================================================================================================== +! Calculation of the vibrational temperature (zero-point search) for non-polyatomic molecules for Fokker-Planck +!=================================================================================================================================== +! MODULES +USE MOD_DSMC_Vars, ONLY: SpecDSMC +USE MOD_BGK_Vars, ONLY: BGKDoVibRelaxation +! IMPLICIT VARIABLE HANDLING +IMPLICIT NONE +!----------------------------------------------------------------------------------------------------------------------------------- +! INPUT VARIABLES +REAL, INTENT(IN) :: CellTemp, TRot, TVib, Xi_Vib_old, rotrelaxfreq, vibrelaxfreq, dtCell +INTEGER, INTENT(IN) :: nPart +LOGICAL, OPTIONAL, INTENT(IN) :: DoVibRelaxIn +!----------------------------------------------------------------------------------------------------------------------------------- +! OUTPUT VARIABLES +REAL, INTENT(OUT) :: Xi_vib, TEqui, RotExp, VibExp +!----------------------------------------------------------------------------------------------------------------------------------- +! LOCAL VARIABLES +!----------------------------------------------------------------------------------------------------------------------------------- +REAL :: TEqui_Old, betaR, betaV, RotFrac, VibFrac, TEqui_Old2 +REAL :: eps_prec=1.0E-0 +REAL :: correctFac, correctFacRot, maxexp !, Xi_rel +LOGICAL :: DoVibRelax +!=================================================================================================================================== +IF (PRESENT(DoVibRelaxIn)) THEN + DoVibRelax = DoVibRelaxIn +ELSE + DoVibRelax = BGKDoVibRelaxation +END IF +maxexp = LOG(HUGE(maxexp)) +! Xi_rel = 2.*(2. - CollInf%omega(1,1)) +! correctFac = 1. + (2.*SpecDSMC(1)%CharaTVib / (CellTemp*(EXP(SpecDSMC(1)%CharaTVib / CellTemp)-1.)))**(2.) & +! * EXP(SpecDSMC(1)%CharaTVib /CellTemp) / (2.*Xi_rel) +! correctFacRot = 1. + 2./Xi_rel + +correctFac = 1. +correctFacRot = 1. +RotExp = exp(-rotrelaxfreq*dtCell/correctFacRot) +RotFrac = nPart*(1.-RotExp) +IF(DoVibRelax) THEN + VibExp = exp(-vibrelaxfreq*dtCell/correctFac) + VibFrac = nPart*(1.-VibExp) +ELSE + VibExp = 0.0 + VibFrac = 0.0 + Xi_vib = 0.0 +END IF +TEqui_Old = 0.0 +TEqui = (3.*(nPart-1.)*CellTemp+2.*RotFrac*TRot+Xi_Vib_old*VibFrac*TVib)/(3.*(nPart-1.)+2.*RotFrac+Xi_Vib_old*VibFrac) +DO WHILE ( ABS( TEqui - TEqui_Old ) .GT. eps_prec ) + IF (ABS(TRot-TEqui).LT.1E-3) THEN + RotExp = exp(-rotrelaxfreq*dtCell/correctFacRot) + ELSE + betaR = ((TRot-CellTemp)/(TRot-TEqui))*rotrelaxfreq*dtCell/correctFacRot + IF (-betaR.GT.0.0) THEN + RotExp = 0. + ELSE IF (betaR.GT.maxexp) THEN + RotExp = 0. + ELSE + RotExp = exp(-betaR) + END IF + END IF + RotFrac = nPart*(1.-RotExp) + IF(DoVibRelax) THEN + IF (ABS(TVib-TEqui).LT.1E-3) THEN + VibExp = exp(-vibrelaxfreq*dtCell/correctFac) + ELSE + betaV = ((TVib-CellTemp)/(TVib-TEqui))*vibrelaxfreq*dtCell/correctFac + IF (-betaV.GT.0.0) THEN + VibExp = 0. + ELSE IF (betaV.GT.maxexp) THEN + VibExp = 0. + ELSE + VibExp = exp(-betaV) + END IF + END IF + IF ((SpecDSMC(1)%CharaTVib/TEqui).GT.maxexp) THEN + Xi_Vib = 0.0 + ELSE + Xi_vib = 2.*SpecDSMC(1)%CharaTVib/TEqui/(EXP(SpecDSMC(1)%CharaTVib/TEqui)-1.) + END IF + VibFrac = nPart*(1.-VibExp) + END IF + TEqui_Old = TEqui + TEqui_Old2 = TEqui + TEqui = (3.*(nPart-1.)*CellTemp+2.*RotFrac*TRot+Xi_Vib_old*VibFrac*TVib)/(3.*(nPart-1.)+2.*RotFrac+Xi_Vib*VibFrac) + IF(DoVibRelax) THEN + DO WHILE( ABS( TEqui - TEqui_Old2 ) .GT. eps_prec ) + TEqui =(TEqui + TEqui_Old2)*0.5 + IF ((SpecDSMC(1)%CharaTVib/TEqui).GT.maxexp) THEN + Xi_Vib = 0.0 + ELSE + Xi_vib = 2.*SpecDSMC(1)%CharaTVib/TEqui/(EXP(SpecDSMC(1)%CharaTVib/TEqui)-1.) + END IF + TEqui_Old2 = TEqui + TEqui = (3.*(nPart-1.)*CellTemp+2.*RotFrac*TRot+Xi_Vib_old*VibFrac*TVib) / (3.*(nPart-1.)+2.*RotFrac+Xi_vib*VibFrac) + END DO + END IF +END DO + +END SUBROUTINE CalcTEqui + + +SUBROUTINE CalcTEquiPoly(nPart, CellTemp, TRot, TVib, nXiVibDOF, Xi_Vib_DOF, Xi_Vib_old, RotExp, VibExp, TEqui, rotrelaxfreq, vibrelaxfreq, & + dtCell, DoVibRelaxIn) +!=================================================================================================================================== +! Calculation of the vibrational temperature (zero-point search) for polyatomic molecules +!=================================================================================================================================== +! MODULES +USE MOD_DSMC_Vars, ONLY: SpecDSMC, PolyatomMolDSMC +USE MOD_BGK_Vars, ONLY: BGKDoVibRelaxation +! IMPLICIT VARIABLE HANDLING +IMPLICIT NONE +!----------------------------------------------------------------------------------------------------------------------------------- +! INPUT VARIABLES +REAL, INTENT(IN) :: CellTemp, TRot, TVib, Xi_Vib_old, rotrelaxfreq, vibrelaxfreq +INTEGER, INTENT(IN) :: nPart,nXiVibDOF +REAL, INTENT(IN) :: dtCell +LOGICAL, OPTIONAL, INTENT(IN) :: DoVibRelaxIn +!----------------------------------------------------------------------------------------------------------------------------------- +! OUTPUT VARIABLES +REAL, INTENT(OUT) :: Xi_vib_DOF(nXiVibDOF), TEqui, RotExp, VibExp +!----------------------------------------------------------------------------------------------------------------------------------- +! LOCAL VARIABLES +!----------------------------------------------------------------------------------------------------------------------------------- +REAL :: TEqui_Old, betaR, betaV, RotFrac, VibFrac, Xi_Rot, TEqui_Old2, exparg +REAL :: eps_prec=1.0 +REAL :: correctFac, correctFacRot +INTEGER :: iDOF, iPolyatMole +LOGICAL :: DoVibRelax +!=================================================================================================================================== +IF (PRESENT(DoVibRelaxIn)) THEN + DoVibRelax = DoVibRelaxIn +ELSE + DoVibRelax = BGKDoVibRelaxation +END IF + +! rotational degrees of freedom of polyatomic molecule +Xi_Rot = SpecDSMC(1)%Xi_Rot +iPolyatMole = SpecDSMC(1)%SpecToPolyArray + +! Xi_rel = 2.*(2. - CollInf%omega(1,1)) +! correctFac = 0.0 +! DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF +! correctFac = correctFac & +! + (2.*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF) / (CellTemp & +! *(EXP(PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF) / CellTemp)-1.)))**(2.) & +! * EXP(PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF) / CellTemp) / 2. +! END DO +! correctFac = 1. + correctFac/Xi_rel +! correctFacRot = 1. + Xi_Rot/Xi_rel + +correctFac = 1. +correctFacRot = 1. + +! Calculate number of rotational relaxing molecules with number of molecules * probability of relaxation +! P = 1 - exp(-nu*dt) with relaxation frequency nu and timestep dt +RotExp = exp(-rotrelaxfreq*dtCell/correctFacRot) +RotFrac = nPart*(1.-RotExp) +! Calculate number of vibrational relaxing molecules if enabled with number of molecules * probability of relaxation +! P = 1 - exp(-nu*dt) with relaxation frequency nu and timestep dt +IF(DoVibRelax) THEN + VibExp = exp(-vibrelaxfreq*dtCell/correctFac) + VibFrac = nPart*(1.-VibExp) +ELSE + VibExp = 0.0 + VibFrac = 0.0 + Xi_vib_DOF = 0.0 +END IF +TEqui_Old = 0.0 +! M. Pfeiffer et. al., "Extension of Particle-based BGK Models to Polyatomic Species in Hypersonic Flow around a Flat-faced +! Cylinder", AIP Conference Proceedings 2132, 100001 (2019) +! Solving of equation system for TEqui and betaR and betaV +TEqui = (3.*(nPart-1.)*CellTemp+2.*RotFrac*TRot+Xi_Vib_old*VibFrac*TVib)/(3.*(nPart-1.)+2.*RotFrac+Xi_Vib_old*VibFrac) +! Required condition of Landau-Teller relaxation not fulfilled --> relaxation probabilities of rotation and vibration are +! corrected with a parameter beta for rotation and vibration as suggested by Burt: +! J. Burt and I. Boyd, “Evaluation of a particle method for the ellipsoidal statistical Bhatnagar-Gross-Krook equation”, +! 44th AIAA Aerospace Sciences Meeting and Exhibit (AIAA, 2006), p. 989 +! Solving of equation system until accuracy eps_prec is reached +DO WHILE ( ABS( TEqui - TEqui_Old ) .GT. eps_prec ) + ! if difference too small: beta is not taken into account + IF (ABS(TRot-TEqui).LT.1E-3) THEN + RotExp = exp(-rotrelaxfreq*dtCell/correctFacRot) + ELSE + ! betaR = beta*nu*dt (= correction parameter rotation * relaxation frequency * time step) + betaR = ((TRot-CellTemp)/(TRot-TEqui))*rotrelaxfreq*dtCell/correctFacRot + ! negative betaR would leed to negative relaxation probability! + IF (-betaR.GT.0.0) THEN + RotExp = 0. + ! Check if the exponent is within the range of machine precision + ELSE IF (CHECKEXP(betaR)) THEN + RotExp = exp(-betaR) + ELSE + RotExp = 0. + END IF + END IF + ! new calculation of number of rotational relaxing molecules + RotFrac = nPart*(1.-RotExp) + + IF(DoVibRelax) THEN + ! if difference too small: beta is not taken into account + IF (ABS(TVib-TEqui).LT.1E-3) THEN + VibExp = exp(-vibrelaxfreq*dtCell/correctFac) + ELSE + ! betaV = beta*nu*dt (= correction parameter vibration * relaxation frequency * time step) + betaV = ((TVib-CellTemp)/(TVib-TEqui))*vibrelaxfreq*dtCell/correctFac + ! negative betaV would leed to negative relaxation probability! + IF (-betaV.GT.0.0) THEN + VibExp = 0. + ! Check if the exponent is within the range of machine precision + ELSEIF(CHECKEXP(betaV))THEN + VibExp = exp(-betaV) + ELSE + VibExp = 0. + END IF + END IF + ! new calculation of number of vibrational relaxing molecules + VibFrac = nPart*(1.-VibExp) + + ! Loop over all vibrational degrees of freedom to calculate them using TEqui + DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF + exparg = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TEqui + ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom + IF(CHECKEXP(exparg))THEN + IF(exparg.gt.0.)THEN ! positive overflow: exp -> inf + Xi_vib_DOF(iDOF) = 2.*exparg/(EXP(exparg)-1.) + ELSE ! negative overflow: exp -> 0 + Xi_vib_DOF(iDOF) = 2.*exparg/(-1.) + END IF ! exparg.gt.0. + ELSE + Xi_vib_DOF(iDOF) = 0.0 + END IF ! CHECKEXP(exparg) + END DO + END IF + TEqui_Old = TEqui + TEqui_Old2 = TEqui + + ! new calculation of equilibrium temperature with new RotFrac, new VibFrac new Xi_vib_DOF(TEqui) in denominator + TEqui = (3.*(nPart-1.)*CellTemp+2.*RotFrac*TRot+Xi_Vib_old*VibFrac*TVib) & + / (3.*(nPart-1.)+2.*RotFrac+SUM(Xi_vib_DOF(1:PolyatomMolDSMC(iPolyatMole)%VibDOF))*VibFrac) + IF(DoVibRelax) THEN + ! accuracy eps_prec not reached yet + DO WHILE( ABS( TEqui - TEqui_Old2 ) .GT. eps_prec ) + ! mean value of old and new equilibrium temperature + TEqui =(TEqui + TEqui_Old2)*0.5 + ! Loop over all vibrational degrees of freedom + DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF + exparg = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TEqui + ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom + IF(CHECKEXP(exparg))THEN + IF(exparg.gt.0.)THEN ! positive overflow: exp -> inf + Xi_vib_DOF(iDOF) = 2.*exparg/(EXP(exparg)-1.) + ELSE ! negative overflow: exp -> 0 + Xi_vib_DOF(iDOF) = 2.*exparg/(-1.) + END IF ! exparg.gt.0. + ELSE + Xi_vib_DOF(iDOF) = 0.0 + END IF ! CHECKEXP(exparg) + END DO + TEqui_Old2 = TEqui + ! new calculation of equilibrium temperature with corrected vibrational degrees of freedom in denominator + TEqui = (3.*(nPart-1.)*CellTemp+2.*RotFrac*TRot+Xi_Vib_old*VibFrac*TVib) & + / (3.*(nPart-1.)+2.*RotFrac+SUM(Xi_vib_DOF(1:PolyatomMolDSMC(iPolyatMole)%VibDOF))*VibFrac) + END DO + END IF +END DO + +END SUBROUTINE CalcTEquiPoly + END MODULE MOD_FP_CollOperator From 485e7d2d839344966db6036ea8c9931c9be30449 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Thu, 30 Mar 2023 15:30:50 +0200 Subject: [PATCH 15/41] Relaxation according to Mathiaud for molecule mixtures, testing still needs to be done --- src/particles/bgk/bgk_colloperator.f90 | 591 +++++++++++-------------- 1 file changed, 248 insertions(+), 343 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 93b94010a..90fc2ec9d 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -73,7 +73,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES REAL :: vBulk(3), u0ij(3,3), u2, V_rel(3), dtCell -REAL :: alpha, alphaRot(nSpecies), CellTemp, dens, InnerDOF, NewEn, OldEn, Prandtl, relaxfreq, TEqui +REAL :: alpha, alphaRot(nSpecies), CellTemp, dens, InnerDOF, NewEn, OldEn, Prandtl, relaxfreq REAL :: dynamicvis, thermalcond INTEGER, ALLOCATABLE :: iPartIndx_NodeRelax(:),iPartIndx_NodeRelaxTemp(:),iPartIndx_NodeRelaxRot(:),iPartIndx_NodeRelaxVib(:) INTEGER :: iLoop, iPart, nRelax, iPolyatMole, nXiVibDOF, nXiVibDOFSpec(nSpecies) @@ -88,11 +88,11 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal REAL,PARAMETER :: RelMomTol=1e-6 ! Relative tolerance applied to conservation of momentum before/after reaction REAL,PARAMETER :: RelEneTol=1e-12 ! Relative tolerance applied to conservation of energy before/after reaction #endif /* CODE_ANALYZE */ -REAL :: totalWeightSpec(nSpecies), totalWeight, partWeight, CellTemptmp +REAL :: totalWeightSpec(nSpecies), totalWeight, partWeight, CellTemptmp, MassIC_Mixture REAL :: EVibSpec(nSpecies), ERotSpec(nSpecies), Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies),Xi_Vib_oldSpec(nSpecies) -REAL :: TVibSpec(nSpecies), TRotSpec(nSpecies), RotExpSpec(nSpecies), VibExpSpec(nSpecies) -REAL :: collisionfreqSpec(nSpecies),rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies), Xi_RotTotal -INTEGER :: nVibRelaxSpec(nSpecies), nRotRelaxSpec(nSpecies) +REAL :: ERotTtransSpecMean(nSpecies), EVibTtransSpecMean(nSpecies), Xi_VibRelSpec(nSpecies), CellTempRel +REAL :: TVibSpec(nSpecies), TRotSpec(nSpecies), VibRelaxWeightSpec(nSpecies), RotRelaxWeightSpec(nSpecies) +REAL :: collisionfreqSpec(nSpecies),rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies) !=================================================================================================================================== #ifdef CODE_ANALYZE ! Momentum and energy conservation check: summing up old values @@ -154,7 +154,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! 2.) Calculation of the relaxation frequency of the distribution function towards the target distribution function CALL CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight, TotalMass, u2Spec, u0ij, u2, SpecTemp, CellTemp, & - Xi_VibSpec, Xi_RotSpec, Prandtl, relaxfreq, dynamicvis, thermalcond) + Xi_VibSpec, Xi_RotSpec, Prandtl, relaxfreq, dynamicvis, thermalcond, MassIC_Mixture) IF(DSMC%CalcQualityFactors) THEN BGK_MeanRelaxFactor = BGK_MeanRelaxFactor + relaxfreq * dtCell @@ -192,20 +192,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! relaxfreqSpec = collisionfreqSpec / collision number Z with RelaxProb = 1/Z rotrelaxfreqSpec(:) = collisionfreqSpec(:) * DSMC%RotRelaxProb vibrelaxfreqSpec(:) = collisionfreqSpec(:) * DSMC%VibRelaxProb - RotExpSpec=0.; VibExpSpec=0. - - ! Calculation of the equilibrium temperature - CALL CalcTEquiMultiPoly(nPart, nSpec, nXiVibDOF, Xi_vib_DOF, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec, Xi_Vib_oldSpec, RotExpSpec, VibExpSpec, & - TEqui, rotrelaxfreqSpec, vibrelaxfreqSpec, dtCell) - ! IF(SpecDSMC(1)%PolyatomicMol) THEN ! polyatomic, NO MIXTURES POSSIBLE BY NOW - ! CALL CalcTEquiPoly(nPart, CellTemp, TRotSpec(1), TVibSpec(1), nXiVibDOF, Xi_vib_DOF, Xi_Vib_oldSpec(1), RotExpSpec(1), VibExpSpec(1), & - ! TEqui, rotrelaxfreqSpec(1), vibrelaxfreqSpec(1), dtCell) - ! ! Corrected vibrational degrees of freedom - ! Xi_VibSpec(1) = SUM(Xi_vib_DOF(1:PolyatomMolDSMC(iPolyatMole)%VibDOF)) - ! ELSE ! diatomic - ! CALL CalcTEquiMulti(nPart, nSpec, CellTemp, TRotSpec, TVibSpec, Xi_VibSpec, Xi_Vib_oldSpec, RotExpSpec, VibExpSpec, & - ! TEqui, rotrelaxfreqSpec, vibrelaxfreqSpec, dtCell) - ! END IF + IF(DSMC%CalcQualityFactors) THEN BGK_MaxRotRelaxFactor = MAX(BGK_MaxRotRelaxFactor,MAXVAL(rotrelaxfreqSpec(:))*dtCell) END IF @@ -217,25 +204,36 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ALLOCATE(iPartIndx_NodeRelaxRot(nPart),iPartIndx_NodeRelaxVib(nPart)) iPartIndx_NodeRelaxRot = 0; iPartIndx_NodeRelaxVib = 0 -CALL DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, RotExpSpec, VibExpSpec, nRelax, nRotRelax, nVibRelax, & - nRotRelaxSpec, nVibRelaxSpec, iPartIndx_NodeRelax, iPartIndx_NodeRelaxTemp, iPartIndx_NodeRelaxRot, & - iPartIndx_NodeRelaxVib, vBulk, OldEnRot, OldEn) +CALL DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, nRotRelax, nVibRelax, & + RotRelaxWeightSpec, VibRelaxWeightSpec, iPartIndx_NodeRelax, iPartIndx_NodeRelaxTemp, iPartIndx_NodeRelaxRot, & + iPartIndx_NodeRelaxVib, vBulk, OldEnRot, OldEn, rotrelaxfreqSpec, vibrelaxfreqSpec) ! Return if no particles are undergoing a relaxation IF ((nRelax.EQ.0).AND.(nRotRelax.EQ.0).AND.(nVibRelax.EQ.0)) RETURN +! Allocate VibEnergyDOF IF(BGKDoVibRelaxation) THEN - IF(SpecDSMC(1)%PolyatomicMol) THEN - ALLOCATE(VibEnergyDOF(nVibRelax,PolyatomMolDSMC(iPolyatMole)%VibDOF)) - END IF + IF(ANY(SpecDSMC(:)%PolyatomicMol)) THEN + ALLOCATE(VibEnergyDOF(nVibRelax,nXiVibDOF)) + END IF END IF ! 5.) Determine the new rotational and vibrational state of molecules undergoing a relaxation -CALL RelaxInnerEnergy(nPart, nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartIndx_NodeRelaxRot, nXiVibDOF, Xi_vib_DOF, Xi_VibSpec, & - Xi_RotSpec , TEqui, VibEnergyDOF, NewEnVib, NewEnRot) +IF(ANY(SpecDSMC(:)%InterID.EQ.2).OR.ANY(SpecDSMC(:)%InterID.EQ.20)) THEN + + CALL CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, CellTemp, relaxfreq, rotrelaxfreqSpec, & + vibrelaxfreqSpec, ERotTtransSpecMean, EVibTtransSpecMean, Xi_VibRelSpec, Xi_vib_DOF, nXiVibDOF, CellTempRel) + + CALL RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartIndx_NodeRelaxRot, nXiVibDOF, Xi_vib_DOF, & + Xi_VibRelSpec, Xi_RotSpec, VibEnergyDOF, CellTemp, NewEnVib, NewEnRot) + +ELSE + CellTempRel = CellTemp +END IF ! 6.) Sample new particle velocities from the target distribution function, depending on the chosen model -CALL SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, u2i, vBulkAll, CellTemp, vBulk) +CALL SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, u2i, vBulkAll, CellTempRel, CellTemp, vBulk, & + MassIC_Mixture) NewEn = 0. @@ -265,21 +263,20 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! 7.) Vibrational energy of the molecules: Ensure energy conservation by scaling the new vibrational states with the factor alpha IF(ANY(SpecDSMC(:)%InterID.EQ.2).OR.ANY(SpecDSMC(:)%InterID.EQ.20)) THEN - CALL EnergyConsVib(nPart, nVibRelax, nVibRelaxSpec, iPartIndx_NodeRelaxVib, NewEnVib, OldEn, nXiVibDOF, Xi_VibSpec, VibEnergyDOF, TEqui) + CALL EnergyConsVib(nPart, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRelaxVib, NewEnVib, OldEn, nXiVibDOF, VibEnergyDOF, & + CellTemp, EVibTtransSpecMean) END IF ! Remaining vibrational (+ translational) energy + rotational energy for translation and rotation OldEn = OldEn + OldEnRot - -! 8.) Determine the new particle state and ensure energy conservation by scaling the new velocities with the factor alpha -Xi_RotTotal = 0.0 -! ! Total number of relaxing rotational degrees of freedom DO iSpec = 1, nSpecies - Xi_RotTotal = Xi_RotTotal + Xi_RotSpec(iSpec)*nRotRelaxSpec(iSpec) + ! ERotTtransSpecMean(iSpec)*RotRelaxWeightSpec(iSpec) is energy that should be in rotation + OldEn = OldEn - ERotTtransSpecMean(iSpec)*RotRelaxWeightSpec(iSpec) END DO -! Calculation of scaling factor alpha, see M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method -! to diatomic molecules including quantized vibrational energies", Phys. Fluids 30, 116103 (2018) -alpha = SQRT(OldEn/NewEn*(3.*(nPart-1.))/(Xi_RotTotal+3.*(nPart-1.))) + +! 8.) Determine the new particle state and ensure energy conservation by scaling the new velocities with the factor alpha +! Calculation of scaling factor alpha +alpha = SQRT(OldEn/NewEn) ! Calculation of the final particle velocities with vBulkAll (average flow velocity before relaxation), scaling factor alpha, ! the particle velocity PartState(4:6,iPart) after the relaxation but before the energy conservation and vBulk (average value of ! the latter) @@ -297,7 +294,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! Calculate scaling factor alpha per species, see M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross- ! Krook method to diatomic molecules including quantized vibrational energies", Phys. Fluids 30, 116103 (2018) IF (NewEnRot(iSpec).GT.0.0) THEN - alphaRot(iSpec) = OldEn/NewEnRot(iSpec)*(Xi_RotSpec(iSpec)*nRotRelaxSpec(iSpec)/(Xi_RotTotal+3.*(nPart-1.))) + alphaRot(iSpec) = ERotTtransSpecMean(iSpec)*RotRelaxWeightSpec(iSpec)/NewEnRot(iSpec) ELSE alphaRot(iSpec) = 0.0 END IF @@ -655,7 +652,7 @@ END SUBROUTINE CalcInnerDOFs SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight, TotalMass, u2Spec, u0ij, u2, SpecTemp, CellTemp, & - Xi_VibSpec, Xi_RotSpec, Prandtl, relaxfreq, dynamicvis, thermalcond) + Xi_VibSpec, Xi_RotSpec, Prandtl, relaxfreq, dynamicvis, thermalcond, MassIC_Mixture) !=================================================================================================================================== !> Calculate the reference dynamic viscosity, Prandtl number and the resulting relaxation frequency of the distribution function !=================================================================================================================================== @@ -673,17 +670,17 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight REAL, INTENT(IN) :: u0ij(3,3), u2, Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies), dens, InnerDOF !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES -REAL, INTENT(OUT) :: Prandtl, relaxfreq, dynamicvis, thermalcond +REAL, INTENT(OUT) :: Prandtl, relaxfreq, dynamicvis, thermalcond, MassIC_Mixture !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES INTEGER :: iSpec, jSpec, INFO -REAL :: MolarFraction(1:nSpecies), MassFraction(1:nSpecies), MassIC_Mixture, DOFFraction(1:nSpecies) +REAL :: MolarFraction(1:nSpecies), DOFFraction(1:nSpecies), MassFraction(1:nSpecies) REAL :: PrandtlCorrection, dynamicvisSpec(nSpecies), thermalcondSpec(nSpecies), Phi(nSpecies) REAL :: TotalDOFWeight, C_P, nu, A(3,3), W(3), Theta, CellTempSpec(nSpecies+1), Work(100) !=================================================================================================================================== +MassIC_Mixture = TotalMass / totalWeight IF (nSpecies.GT.1) THEN ! gas mixture MolarFraction(1:nSpecies) = totalWeightSpec(1:nSpecies) / totalWeight - MassIC_Mixture = TotalMass / totalWeight MassFraction(1:nSpecies) = MolarFraction(1:nSpecies) * Species(1:nSpecies)%MassIC / MassIC_Mixture DOFFraction(1:nSpecies) = totalWeightSpec(1:nSpecies) * (5.+Xi_RotSpec(1:nSpecies)+Xi_VibSpec(1:nSpecies)) TotalDOFWeight = SUM(DOFFraction) @@ -758,7 +755,8 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight END IF END DO CellTempSpec(nSpecies+1) = CellTemp - CALL CalcViscosityThermalCondColIntVHS(CellTempSpec(1:nSpecies+1), MolarFraction(1:nSpecies),dens, Xi_RotSpec, Xi_VibSpec, dynamicvis, thermalcond) + CALL CalcViscosityThermalCondColIntVHS(CellTempSpec(1:nSpecies+1), MolarFraction(1:nSpecies),dens, Xi_RotSpec, Xi_VibSpec, & + dynamicvis, thermalcond) END SELECT ! Calculation of Prandtl number @@ -796,9 +794,9 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight END SUBROUTINE CalcGasProperties -SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, RotExpSpec, VibExpSpec, nRelax, nRotRelax, nVibRelax, & - nRotRelaxSpec, nVibRelaxSpec, iPartIndx_NodeRelax, iPartIndx_NodeRelaxTemp, iPartIndx_NodeRelaxRot, & - iPartIndx_NodeRelaxVib, vBulk, OldEnRot, OldEn) +SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, nRotRelax, nVibRelax, & + RotRelaxWeightSpec, VibRelaxWeightSpec, iPartIndx_NodeRelax, iPartIndx_NodeRelaxTemp, iPartIndx_NodeRelaxRot, & + iPartIndx_NodeRelaxVib, vBulk, OldEnRot, OldEn, rotrelaxfreqSpec, vibrelaxfreqSpec) !=================================================================================================================================== !> Determine the number of particles undergoing a relaxation (including vibration and rotation) !=================================================================================================================================== @@ -812,74 +810,194 @@ SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, RotExpSp !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT VARIABLES INTEGER, INTENT(IN) :: nPart, iPartIndx_Node(nPart) -REAL, INTENT(IN) :: relaxfreq, dtCell, RotExpSpec(nSpecies), VibExpSpec(nSpecies) +REAL, INTENT(IN) :: relaxfreq, dtCell, rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES -INTEGER, INTENT(OUT) :: nRelax, iPartIndx_NodeRelax(nPart), iPartIndx_NodeRelaxTemp(nPart) -INTEGER, INTENT(OUT) :: iPartIndx_NodeRelaxRot(nPart), iPartIndx_NodeRelaxVib(nPart) -INTEGER, INTENT(OUT) :: nRotRelax, nVibRelax, nRotRelaxSpec(nSpecies), nVibRelaxSpec(nSpecies) -REAL, INTENT(OUT) :: vBulk(3), OldEnRot +INTEGER, INTENT(OUT) :: iPartIndx_NodeRelax(:), iPartIndx_NodeRelaxTemp(:) +INTEGER, INTENT(OUT) :: iPartIndx_NodeRelaxRot(:), iPartIndx_NodeRelaxVib(:) +INTEGER, INTENT(OUT) :: nRelax, nRotRelax, nVibRelax +REAL, INTENT(OUT) :: vBulk(3), OldEnRot, RotRelaxWeightSpec(nSpecies), VibRelaxWeightSpec(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT-OUTPUT VARIABLES REAL, INTENT(INOUT) :: OldEn !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES -INTEGER :: iPart, nNotRelax, iSpec, iLoop -REAL :: ProbAddPartTrans, iRan, partWeight +INTEGER :: iPart, iSpec, iLoop, iPick, iLoopRot, iLoopVib +REAL :: ProbAddPartTrans, iRan, partWeight, ProbAddPartRot, ProbAddPartVib !=================================================================================================================================== -nVibRelaxSpec =0; nRotRelaxSpec =0; nRelax=0; nNotRelax=0; vBulk=0.0; nRotRelax=0; nVibRelax=0; OldEnRot=0.0 +VibRelaxWeightSpec =0; RotRelaxWeightSpec =0; nRelax=0; vBulk=0.0; nRotRelax=0; nVibRelax=0; OldEnRot=0.0 +iLoopRot=1; iLoopVib=1 ! Calculate probability of relaxation of a particle towards the target distribution function ProbAddPartTrans = 1.-EXP(-relaxfreq*dtCell) -! Loop over all simulation particles -DO iLoop = 1, nPart - iPart = iPartIndx_Node(iLoop) - iSpec = PartSpecies(iPart) - partWeight = GetParticleWeight(iPart) +CALL RANDOM_NUMBER(iRan) +! Calculate the number of relaxing particles +nRelax = INT(REAL(nPart) * ProbAddPartTrans + iRan) +! List of non-relaxing particles +iPartIndx_NodeRelaxTemp(:) = iPartIndx_Node(:) +! Relaxing particles +DO iLoop = 1, nRelax CALL RANDOM_NUMBER(iRan) - ! Count particles that are undergoing a relaxation - IF (ProbAddPartTrans.GT.iRan) THEN - nRelax = nRelax + 1 - iPartIndx_NodeRelax(nRelax) = iPart - ! Count particles that are not undergoing a relaxation - ELSE - nNotRelax = nNotRelax + 1 - iPartIndx_NodeRelaxTemp(nNotRelax) = iPart - ! Sum up velocities of non-relaxing particles for bulk velocity - vBulk(1:3) = vBulk(1:3) + PartState(4:6,iPart)*Species(iSpec)%MassIC*partWeight - END IF - + iPick = INT(iRan * (nPart-iLoop+1)) + 1 + iPart = iPartIndx_NodeRelaxTemp(iPick) + partWeight = GetParticleWeight(iPart) + iSpec = PartSpecies(iPart) + iPartIndx_NodeRelax(iLoop) = iPart + iPartIndx_NodeRelaxTemp(iPick) = iPartIndx_NodeRelaxTemp(nPart-iLoop+1) ! For molecules: relaxation of inner DOF IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN ! Rotation CALL RANDOM_NUMBER(iRan) - ! Count particles that are undergoing a relaxation, in total and per species - IF ((1.-RotExpSpec(iSpec)).GT.iRan) THEN + ! Calculate probability of rotational relaxation of a particle that relaxes towards the target distribution function + ProbAddPartRot = rotrelaxfreqSpec(iSpec)/relaxfreq + IF (ProbAddPartRot.GT.iRan) THEN + ! relaxation + iPartIndx_NodeRelaxRot(iLoopRot) = iPartIndx_NodeRelax(iLoop) nRotRelax = nRotRelax + 1 - nRotRelaxSpec(iSpec) = nRotRelaxSpec(iSpec) + 1 - iPartIndx_NodeRelaxRot(nRotRelax) = iPart + iLoopRot = iLoopRot + 1 + RotRelaxWeightSpec(iSpec) = RotRelaxWeightSpec(iSpec) + partWeight ! Sum up total rotational energy OldEnRot = OldEnRot + PartStateIntEn(2,iPart) * partWeight END IF ! Vibration IF(BGKDoVibRelaxation) THEN CALL RANDOM_NUMBER(iRan) - ! Count particles that are undergoing a relaxation, in total and per species - IF ((1.-VibExpSpec(iSpec)).GT.iRan) THEN + ! Calculate probability of vibrational relaxation of a particle that relaxes towards the target distribution function + ProbAddPartVib = vibrelaxfreqSpec(iSpec)/relaxfreq + IF (ProbAddPartVib.GT.iRan) THEN + ! relaxation + iPartIndx_NodeRelaxVib(iLoopVib) = iPartIndx_NodeRelax(iLoop) nVibRelax = nVibRelax + 1 - nVibRelaxSpec(iSpec) = nVibRelaxSpec(iSpec) + 1 - iPartIndx_NodeRelaxVib(nVibRelax) = iPart + VibRelaxWeightSpec(iSpec) = VibRelaxWeightSpec(iSpec) + partWeight ! Sum up total vibrational energy of all relaxing particles, considering zero-point energy, and add to translational energy - OldEn = OldEn + (PartStateIntEn(1,iPartIndx_NodeRelaxVib(nVibRelax)) - SpecDSMC(iSpec)%EZeroPoint) * partWeight + OldEn = OldEn + (PartStateIntEn(1,iPartIndx_NodeRelaxVib(iLoopVib)) - SpecDSMC(iSpec)%EZeroPoint) * partWeight + iLoopVib = iLoopVib + 1 END IF END IF END IF END DO +! Non-relaxing particles +! nNonRelax = nPart-nRelax +DO iLoop = 1, nPart-nRelax + iPart = iPartIndx_NodeRelaxTemp(iLoop) + partWeight = GetParticleWeight(iPart) + iSpec = PartSpecies(iPart) + ! iPartIndx_NodeNonRelax(iLoop) + ! Sum up velocities of non-relaxing particles for bulk velocity + vBulk(1:3) = vBulk(1:3) + PartState(4:6,iPart)*Species(iSpec)%MassIC*partWeight +END DO + END SUBROUTINE DetermineRelaxPart -SUBROUTINE RelaxInnerEnergy(nPart, nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartIndx_NodeRelaxRot, nXiVibDOF, Xi_vib_DOF, Xi_VibSpec, & - Xi_RotSpec , TEqui, VibEnergyDOF, NewEnVib, NewEnRot) +SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, CellTemp, relaxfreq, rotrelaxfreqSpec, & + vibrelaxfreqSpec, ERotTtransSpecMean, EVibTtransSpecMean, Xi_VibRelSpec, Xi_vib_DOF, nXiVibDOF, CellTempRel) +!=================================================================================================================================== +!> Calculate the relaxation energies and temperatures +!=================================================================================================================================== +! MODULES +USE MOD_Particle_Vars ,ONLY: nSpecies +USE MOD_DSMC_Vars ,ONLY: PolyatomMolDSMC, SpecDSMC +USE MOD_BGK_Vars ,ONLY: BGKDoVibRelaxation +USE MOD_Globals_Vars ,ONLY: BoltzmannConst +USE MOD_Globals ,ONLY: abort +! IMPLICIT VARIABLE HANDLING + IMPLICIT NONE +!----------------------------------------------------------------------------------------------------------------------------------- +! INPUT VARIABLES +INTEGER, INTENT(IN) :: nXiVibDOF +REAL, INTENT(IN) :: ERotSpec(nSpecies), Xi_RotSpec(nSpecies), EVibSpec(nSpecies) +REAL, INTENT(IN) :: totalWeightSpec(nSpecies), CellTemp!, MassFraction(nSpecies) +REAL, INTENT(IN) :: relaxfreq, rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies) +!----------------------------------------------------------------------------------------------------------------------------------- +! OUTPUT VARIABLES +REAL, INTENT(OUT) :: ERotTtransSpecMean(nSpecies), EVibTtransSpecMean(nSpecies) +REAL, INTENT(OUT) :: Xi_VibRelSpec(nSpecies), Xi_vib_DOF(nSpecies,nXiVibDOF), CellTempRel +!----------------------------------------------------------------------------------------------------------------------------------- +! LOCAL VARIABLES +INTEGER :: iSpec, iDOF, iPolyatMole +REAL :: ERotSpecMean(nSpecies), EVibSpecMean(nSpecies), TVibRelSpecMean, ETransRelMean +REAL :: EVibTtransPoly, TVibRelPoly +!=================================================================================================================================== +! According to J. Mathiaud et. al., "An ES-BGK model for diatomic gases with correct relaxation rates for internal energies", +! European Journal of Mechanics - B/Fluids, 96, pp. 65-77, 2022 + +ERotSpecMean=0.0; ERotTtransSpecMean=0.0; EVibSpecMean=0.0; EVibTtransSpecMean=0.0; Xi_VibRelSpec=0.0; Xi_vib_DOF=0.0 +ETransRelMean=0.0; CellTempRel=0.0 + +DO iSpec = 1, nSpecies + IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + ! Mean rotational energy per particle of a species + ERotSpecMean(iSpec) = ERotSpec(iSpec)/totalWeightSpec(iSpec) + ! Mean rotational energy per particle of a species for the mixture translational temperature, ERot(Ttrans) + ERotTtransSpecMean(iSpec) = CellTemp * Xi_RotSpec(iSpec) * BoltzmannConst /2. + ! Mean rotational energy per particle of a species to satisfy the Landau-Teller equation + + IF(BGKDoVibRelaxation) THEN + ! Mean vibrational energy per particle of a species + EVibSpecMean(iSpec) = EVibSpec(iSpec)/totalWeightSpec(iSpec) + + IF(SpecDSMC(iSpec)%PolyatomicMol) THEN ! polyatomic + iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray + ! Loop over all vibrational DOF + DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF + ! Mean vibrational energy per DOF for the mixture translational temperature, EVib(Ttrans) + EVibTtransPoly = BoltzmannConst * PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF) / & + (EXP(PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/CellTemp) - 1.) + ! Mean vibrational energy per particle of a species for the mixture translational temperature, EVib(Ttrans) + EVibTtransSpecMean(iSpec) = EVibTtransSpecMean(iSpec) + EVibTtransPoly + ! Mean vibrational temperature per DOF to satisfy the Landau-Teller equation + TVibRelPoly = EVibTtransPoly / (BoltzmannConst*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)) + IF (TVibRelPoly.GT.0.0) THEN + TVibRelPoly = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/LOG(1. + 1./TVibRelPoly) + ! Calculation of the vibrational degrees of freedeom to satisfy the Landau-Teller equation + Xi_vib_DOF(iSpec,iDOF) = 2.* EVibTtransPoly / (BoltzmannConst*TVibRelPoly) + ELSE + Xi_vib_DOF(iSpec,iDOF) = 0.0 + END IF + END DO + + ELSE ! diatomic + ! Mean vibrational energy per particle of a species for the mixture translational temperature, EVib(Ttrans) + EVibTtransSpecMean(iSpec) = BoltzmannConst * SpecDSMC(iSpec)%CharaTVib / (EXP(SpecDSMC(iSpec)%CharaTVib/CellTemp) - 1.) + ! Mean vibrational temperature per particle of a species to satisfy the Landau-Teller equation + TVibRelSpecMean = EVibTtransSpecMean(iSpec) / (BoltzmannConst*SpecDSMC(iSpec)%CharaTVib) + IF (TVibRelSpecMean.GT.0.0) THEN + TVibRelSpecMean = SpecDSMC(iSpec)%CharaTVib/LOG(1. + 1./(TVibRelSpecMean)) + ! Calculation of the vibrational degrees of freedeom to satisfy the Landau-Teller equation + Xi_VibRelSpec(iSpec) = 2.* EVibTtransSpecMean(iSpec) / (BoltzmannConst*TVibRelSpecMean) + ! No negative temperature possible + ELSE + Xi_VibRelSpec(iSpec) = 0.0 + END IF + END IF + END IF + + ! Mean translational energy per particle to satisfy the Landau-Teller equation + ETransRelMean = ETransRelMean + (3./2. * BoltzmannConst * CellTemp - (rotrelaxfreqSpec(iSpec)/relaxfreq) * & + (ERotTtransSpecMean(iSpec)-ERotSpecMean(iSpec))) * totalWeightSpec(iSpec) + IF (BGKDoVibRelaxation) THEN + ETransRelMean = ETransRelMean - (vibrelaxfreqSpec(iSpec)/relaxfreq)*(EVibTtransSpecMean(iSpec)-EVibSpecMean(iSpec)) * & + totalWeightSpec(iSpec) + END IF + ELSE + ! Mean translational energy per particle to satisfy the Landau-Teller equation + ETransRelMean = ETransRelMean + 3./2. * BoltzmannConst * CellTemp * totalWeightSpec(iSpec) + END IF +END DO + +! Calculation of the cell temperature with ETransRelMean to satisfy the Landau-Teller equation +IF (ETransRelMean.GT.0.0) THEN + CellTempRel = 2. * ETransRelMean / (3. * BoltzmannConst) +ELSE + CALL abort(__STAMP__,'Negative energy for relaxation') +END IF + +END SUBROUTINE CalcTRelax + + +SUBROUTINE RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartIndx_NodeRelaxRot, nXiVibDOF, Xi_vib_DOF, & + Xi_VibSpec, Xi_RotSpec, VibEnergyDOF, CellTemp, NewEnVib, NewEnRot) !=================================================================================================================================== !> Determine the new rotational and vibrational energy of relaxing particles !=================================================================================================================================== @@ -893,9 +1011,10 @@ SUBROUTINE RelaxInnerEnergy(nPart, nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, IMPLICIT NONE !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT VARIABLES -INTEGER, INTENT(IN) :: nPart,nXiVibDOF -INTEGER, INTENT(IN) :: nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib(nPart), iPartIndx_NodeRelaxRot(nPart) -REAL, INTENT(IN) :: Xi_vib_DOF(nSpecies,nXiVibDOF), TEqui, Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies) +INTEGER, INTENT(IN) :: nXiVibDOF +INTEGER, INTENT(IN) :: nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib(nVibRelax), iPartIndx_NodeRelaxRot(nRotRelax) +REAL, INTENT(IN) :: Xi_vib_DOF(nSpecies,nXiVibDOF), Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies) +REAL, INTENT(IN) :: CellTemp REAL, INTENT(INOUT) :: NewEnVib(nSpecies), NewEnRot(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES @@ -914,21 +1033,21 @@ SUBROUTINE RelaxInnerEnergy(nPart, nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, partWeight = GetParticleWeight(iPart) ! polyatomic, more than one vibrational DOF IF(SpecDSMC(iSpec)%PolyatomicMol) THEN - iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray - PartStateIntEn(1,iPart) = 0.0 - ! Sum up the new vibrational energy over all DOFs, see M. Pfeiffer et. al., "Extension of Particle-based BGK Models to - ! Polyatomic Species in Hypersonic Flow around a Flat-faced Cylinder", AIP Conference Proceedings 2132, 100001 (2019) - DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF - CALL RANDOM_NUMBER(iRan) - VibEnergyDOF(iLoop,iDOF) = - LOG(iRan)*Xi_vib_DOF(iSpec,iDOF)/2.*TEqui*BoltzmannConst - PartStateIntEn(1,iPart) = PartStateIntEn(1,iPart)+VibEnergyDOF(iLoop,iDOF) - END DO + iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray + PartStateIntEn(1,iPart) = 0.0 + ! Sum up the new vibrational energy over all DOFs, see M. Pfeiffer et. al., "Extension of Particle-based BGK Models to + ! Polyatomic Species in Hypersonic Flow around a Flat-faced Cylinder", AIP Conference Proceedings 2132, 100001 (2019) + DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF + CALL RANDOM_NUMBER(iRan) + VibEnergyDOF(iLoop,iDOF) = - LOG(iRan)*Xi_vib_DOF(iSpec,iDOF)/2.*CellTemp*BoltzmannConst + PartStateIntEn(1,iPart) = PartStateIntEn(1,iPart)+VibEnergyDOF(iLoop,iDOF) + END DO ! ELSE: diatomic, only one vibrational DOF, calculate new vibrational energy according to M. Pfeiffer, "Extending the particle ! ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules including quantized vibrational energies", ! Phys. Fluids 30, 116103 (2018) ELSE CALL RANDOM_NUMBER(iRan) - PartStateIntEn( 1,iPart) = -LOG(iRan)*Xi_VibSpec(iSpec)/2.*TEqui*BoltzmannConst + PartStateIntEn( 1,iPart) = -LOG(iRan)*Xi_VibSpec(iSpec)/2.*CellTemp*BoltzmannConst END IF ! Sum up new vibrational energy per species NewEnVib(iSpec) = NewEnVib(iSpec) + PartStateIntEn(1,iPart) * partWeight @@ -942,7 +1061,7 @@ SUBROUTINE RelaxInnerEnergy(nPart, nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, CALL RANDOM_NUMBER(iRan) ! Calculate new rotational energy according to M. Pfeiffer et. al., "Extension of Particle-based BGK Models to Polyatomic Species ! in Hypersonic Flow around a Flat-faced Cylinder", AIP Conference Proceedings 2132, 100001 (2019) - PartStateIntEn( 2,iPart) = -Xi_RotSpec(iSpec) / 2. * BoltzmannConst*TEqui*LOG(iRan) + PartStateIntEn( 2,iPart) = -Xi_RotSpec(iSpec) / 2. * BoltzmannConst*CellTemp*LOG(iRan) ! Sum up new rotational energy per species NewEnRot(iSpec) = NewEnRot(iSpec) + PartStateIntEn( 2,iPart) * partWeight END DO @@ -950,7 +1069,8 @@ SUBROUTINE RelaxInnerEnergy(nPart, nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, END SUBROUTINE RelaxInnerEnergy -SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, u2i, vBulkAll, CellTemp, vBulk) +SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, u2i, vBulkAll, CellTempRel, CellTemp, vBulk, & + MassIC_Mixture) !=================================================================================================================================== !> Sample new particle velocities from the target distribution function, depending on the chosen model !=================================================================================================================================== @@ -964,7 +1084,7 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT VARIABLES INTEGER, INTENT(IN) :: nRelax, iPartIndx_NodeRelax(:) -REAL, INTENT(IN) :: Prandtl, u2, u0ij(3,3), u2i(3), vBulkAll(3), CellTemp +REAL, INTENT(IN) :: Prandtl, u2, u0ij(3,3), u2i(3), vBulkAll(3), CellTempRel, CellTemp, MassIC_Mixture REAL, INTENT(INOUT) :: vBulk(3) !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES @@ -988,8 +1108,13 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, KronDelta = 0.0 END IF ! Fill symmetric transformation matrix SMat with anisotopic matrix A = SS - SMat(fillMa1, fillMa2)= KronDelta - (1.-Prandtl)/(2.*Prandtl) & - *(3./u2*u0ij(fillMa1, fillMa2)-KronDelta) + ! = Open work: calculation per species? ========================================================================== + SMat(fillMa1, fillMa2)= KronDelta*CellTempRel*BoltzmannConst/MassIC_Mixture - (1.-Prandtl)/(2.*Prandtl) & + *(u0ij(fillMa1, fillMa2)-KronDelta*CellTemp*BoltzmannConst/MassIC_Mixture) + ! SMat(fillMa1, fillMa2)= KronDelta*CellTempRel/CellTemp - (1.-Prandtl)/(2.*Prandtl) & + ! *(3./u2*u0ij(fillMa1, fillMa2)-KronDelta) + ! SMat(fillMa1, fillMa2)= KronDelta*CellTempRel - (1.-Prandtl)/(2.*Prandtl) & + ! *(u0ij(fillMa1, fillMa2)-KronDelta*CellTemp) END DO END DO SMat(2,1)=SMat(1,2) @@ -1006,7 +1131,8 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, KronDelta = 0.0 END IF ! Fill anisotopic matrix A - A(fillMa1, fillMa2) = KronDelta - (1.-Prandtl)/Prandtl*(3.*u0ij(fillMa1, fillMa2)/u2 - KronDelta) + A(fillMa1, fillMa2) = KronDelta*CellTempRel*BoltzmannConst/MassIC_Mixture - (1.-Prandtl)/Prandtl*(u0ij(fillMa1, fillMa2) & + - KronDelta*CellTemp*BoltzmannConst/MassIC_Mixture) END DO END DO IF (ESBGKModel.EQ.2) THEN @@ -1025,8 +1151,8 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, ELSE KronDelta = 0.0 END IF - SMat(fillMa1, fillMa2)= KronDelta - (1.-Prandtl)/(2.*Prandtl) & - *(3./u2*u0ij(fillMa1, fillMa2)-KronDelta) + SMat(fillMa1, fillMa2)= KronDelta*CellTempRel*BoltzmannConst/MassIC_Mixture - (1.-Prandtl)/(2.*Prandtl) & + *(u0ij(fillMa1, fillMa2)-KronDelta*CellTemp*BoltzmannConst/MassIC_Mixture) END DO END DO SMat(2,1)=SMat(1,2) @@ -1075,11 +1201,14 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, IF ((BGKCollModel.EQ.1).AND.(ESBGKModel.NE.3)) THEN ! Transformation of normalized thermal velocity vector tempVelo (sampled from a Maxwellian distribution) to a thermal velocity ! vector sampled from the ESBGK target distribution function (anisotropic Gaussian distribution) - tempVelo(1:3) = SQRT(BoltzmannConst*CellTemp/Species(iSpec)%MassIC)*iRanPart(1:3,iLoop) + tempVelo(1:3) = SQRT(MassIC_Mixture/Species(iSpec)%MassIC)*iRanPart(1:3,iLoop) PartState(4:6,iPart) = vBulkAll(1:3) + MATMUL(SMat,tempVelo) + ELSE IF ((BGKCollModel.EQ.1).AND.(ESBGKModel.EQ.3)) THEN + ! New thermal velocity (in x,y,z) of particle with mass scaling multiplied by normal distributed random vector + PartState(4:6,iPart) = vBulkAll(1:3) + SQRT(MassIC_Mixture/Species(iSpec)%MassIC)*iRanPart(1:3,iLoop) ELSE ! New thermal velocity (in x,y,z) of particle is sqrt(k_B*T/m) multiplied by normal distributed random vector - PartState(4:6,iPart) = vBulkAll(1:3) + SQRT(BoltzmannConst*CellTemp/Species(iSpec)%MassIC)*iRanPart(1:3,iLoop) + PartState(4:6,iPart) = vBulkAll(1:3) + SQRT(BoltzmannConst*CellTempRel/Species(iSpec)%MassIC)*iRanPart(1:3,iLoop) END IF partWeight = GetParticleWeight(iPart) ! Sum up new velocities of relaxing particles for bulk velocity, velocities of non-relaxing particles already calculated in @@ -1091,7 +1220,8 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, END SUBROUTINE SampleFromTargetDistr -SUBROUTINE EnergyConsVib(nPart, nVibRelax, nVibRelaxSpec, iPartIndx_NodeRelaxVib, NewEnVib, OldEn, nXiVibDOF, Xi_VibSpec, VibEnergyDOF, TEqui) +SUBROUTINE EnergyConsVib(nPart, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRelaxVib, NewEnVib, OldEn, nXiVibDOF, & + VibEnergyDOF, CellTemp, EVibTtransSpecMean) !=================================================================================================================================== !> Routine to ensure energy conservation when including vibrational degrees of freedom (continuous and quantized) !=================================================================================================================================== @@ -1106,30 +1236,27 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, nVibRelaxSpec, iPartIndx_NodeRelaxVib !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT VARIABLES INTEGER, INTENT(IN) :: nPart,nXiVibDOF -INTEGER, INTENT(IN) :: nVibRelax, iPartIndx_NodeRelaxVib(nPart), nVibRelaxSpec(nSpecies) -REAL, INTENT(IN) :: NewEnVib(nSpecies), VibEnergyDOF(nVibRelax,nXiVibDOF), Xi_VibSpec(nSpecies), TEqui +INTEGER, INTENT(IN) :: nVibRelax, iPartIndx_NodeRelaxVib(nPart) +REAL, INTENT(IN) :: VibRelaxWeightSpec(nSpecies) +REAL, INTENT(IN) :: NewEnVib(nSpecies), VibEnergyDOF(nVibRelax,nXiVibDOF), CellTemp, EVibTtransSpecMean(nSpecies) REAL, INTENT(INOUT) :: OldEn !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES INTEGER :: iPart, iLoop, iDOF, iSpec, iQuant, iQuaMax, iPolyatMole -REAL :: alpha(nSpecies), partWeight, betaV, iRan, MaxColQua, Xi_VibTotal +REAL :: alpha(nSpecies), partWeight, betaV, iRan, MaxColQua !=================================================================================================================================== ! According to M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules ! including quantized vibrational energies", Phys. Fluids 30, 116103 (2018) IF(BGKDoVibRelaxation) THEN ! Vibrational energy is positive for at least one species + there are vibrational relaxations IF (ANY(NewEnVib.GT.0.0).AND.(nVibRelax.GT.0)) THEN - Xi_VibTotal = 0.0 - ! Total number of relaxing vibrational degrees of freedom - DO iSpec = 1, nSpecies - Xi_VibTotal = Xi_VibTotal + Xi_VibSpec(iSpec)*nVibRelaxSpec(iSpec) - END DO ! Calculate scaling factor alpha per species + ! EVibTtransSpecMean(iSpec)*VibRelaxWeightSpec(iSpec) is energy that should be in vibration DO iSpec = 1, nSpecies IF (NewEnVib(iSpec).GT.0.0) THEN - alpha(iSpec) = OldEn/NewEnVib(iSpec)*(Xi_VibSpec(iSpec)*nVibRelaxSpec(iSpec)/(3.*(nPart-1.)+Xi_VibTotal)) + alpha(iSpec) = EVibTtransSpecMean(iSpec)*VibRelaxWeightSpec(iSpec)/NewEnVib(iSpec) ELSE alpha(iSpec) = 0. END IF @@ -1162,17 +1289,17 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, nVibRelaxSpec, iPartIndx_NodeRelaxVib ELSE CALL RANDOM_NUMBER(iRan) ! Calculation of new iQuant - iQuant = INT(-LOG(iRan)*TEqui/PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)) + iQuant = INT(-LOG(iRan)*CellTemp/PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)) ! Determine maximum quantum number iQuaMax = MIN(INT(MaxColQua)+1, PolyatomMolDSMC(iPolyatMole)%MaxVibQuantDOF(iDOF)) ! Calculation of new iQuant as long as iQuant > maximum quantum number DO WHILE (iQuant.GE.iQuaMax) CALL RANDOM_NUMBER(iRan) - iQuant = INT(-LOG(iRan)*TEqui/PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)) + iQuant = INT(-LOG(iRan)*CellTemp/PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)) END DO END IF END IF - ! Sup up the vibrational energy over all vibrational DOF + ! Sum up the vibrational energy over all vibrational DOF PartStateIntEn( 1,iPart) = PartStateIntEn( 1,iPart) & + iQuant*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)*BoltzmannConst VibQuantsPar(iPart)%Quants(iDOF) = iQuant @@ -1200,13 +1327,13 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, nVibRelaxSpec, iPartIndx_NodeRelaxVib ELSE CALL RANDOM_NUMBER(iRan) ! Calculation of new iQuant - iQuant = INT(-LOG(iRan)*TEqui/SpecDSMC(iSpec)%CharaTVib) + iQuant = INT(-LOG(iRan)*CellTemp/SpecDSMC(iSpec)%CharaTVib) ! Determine maximum quantum number iQuaMax = MIN(INT(MaxColQua)+1, SpecDSMC(iSpec)%MaxVibQuant) ! Calculation of new iQuant as long as iQuant > maximum quantum number DO WHILE (iQuant.GE.iQuaMax) CALL RANDOM_NUMBER(iRan) - iQuant = INT(-LOG(iRan)*TEqui/SpecDSMC(iSpec)%CharaTVib) + iQuant = INT(-LOG(iRan)*CellTemp/SpecDSMC(iSpec)%CharaTVib) END DO END IF ! Calculate vibrational energy including zero-point energy @@ -1399,228 +1526,6 @@ SUBROUTINE BGK_BuildTransGaussNums(nPart, iRanPart) END SUBROUTINE BGK_BuildTransGaussNums -SUBROUTINE CalcTEquiMultiPoly(nPart, nSpec, nXiVibDOF, Xi_vib_DOF, CellTemp, TRotSpec, TVibSpec, Xi_Vib_Spec, Xi_Vib_oldSpec, RotExpSpec, & - VibExpSpec, TEqui, rotrelaxfreqSpec, vibrelaxfreqSpec, dtCell, DoVibRelaxIn) -!=================================================================================================================================== -! Calculation of the vibrational temperature (zero-point search) for polyatomic molecule mixtures -!=================================================================================================================================== -! MODULES -USE MOD_DSMC_Vars, ONLY: SpecDSMC, PolyatomMolDSMC -USE MOD_BGK_Vars, ONLY: BGKDoVibRelaxation -USE MOD_Particle_Vars, ONLY: nSpecies -! IMPLICIT VARIABLE HANDLING -IMPLICIT NONE -!----------------------------------------------------------------------------------------------------------------------------------- -! INPUT VARIABLES -REAL, INTENT(IN) :: CellTemp, TRotSpec(nSpecies), TVibSpec(nSpecies), Xi_Vib_oldSpec(nSpecies) -REAL, INTENT(IN) :: rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies), dtCell -INTEGER, INTENT(IN) :: nPart, nSpec(nSpecies), nXiVibDOF -LOGICAL, OPTIONAL, INTENT(IN) :: DoVibRelaxIn -!----------------------------------------------------------------------------------------------------------------------------------- -! OUTPUT VARIABLES -REAL, INTENT(OUT) :: Xi_Vib_Spec(nSpecies), TEqui, RotExpSpec(nSpecies), VibExpSpec(nSpecies) -REAL, INTENT(OUT) :: Xi_vib_DOF(nSpecies,nXiVibDOF) -!----------------------------------------------------------------------------------------------------------------------------------- -! LOCAL VARIABLES -!----------------------------------------------------------------------------------------------------------------------------------- -REAL :: TEqui_Old, betaR, betaV, RotFracSpec(nSpecies), VibFracSpec(nSpecies), TEqui_Old2 -REAL :: Xi_Rot_Spec(nSpecies) -REAL :: eps_prec=1.0E-0 -REAL :: exparg, TEquiNumDof -LOGICAL :: DoVibRelax -INTEGER :: iSpec, iDOF, iPolyatMole -!=================================================================================================================================== -IF (PRESENT(DoVibRelaxIn)) THEN - DoVibRelax = DoVibRelaxIn -ELSE - DoVibRelax = BGKDoVibRelaxation -END IF - -RotFracSpec = 0.0 -VibFracSpec = 0.0 - -! Loop over all molecular species --> only internal energies are relevant here -DO iSpec=1, nSpecies - IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - ! rotational degrees of freedom of molecules - Xi_Rot_Spec(iSpec) = SpecDSMC(iSpec)%Xi_Rot - ! Calculate number of rotational relaxing molecules with number of molecules * probability of relaxation - ! P = 1 - exp(-nu*dt) with relaxation frequency nu and timestep dt - RotExpSpec(iSpec) = exp(-rotrelaxfreqSpec(iSpec)*dtCell) - RotFracSpec(iSpec) = nSpec(iSpec)*(1.-RotExpSpec(iSpec)) - ! Calculate number of vibrational relaxing molecules if enabled with number of molecules * probability of relaxation - ! P = 1 - exp(-nu*dt) with relaxation frequency nu and timestep dt - IF(DoVibRelax) THEN - VibExpSpec(iSpec) = exp(-vibrelaxfreqSpec(iSpec)*dtCell) - VibFracSpec(iSpec) = nSpec(iSpec)*(1.-VibExpSpec(iSpec)) - ELSE - VibExpSpec(iSpec) = 0.0 - VibFracSpec(iSpec) = 0.0 - Xi_Vib_Spec(iSpec) = 0.0 - END IF - END IF -END DO -TEqui_Old = 0.0 -! Calculation of equilibrium temperature -! M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules including -! quantized vibrational energies", Phys. Fluids 30, 116103 (2018), Eq. 25 -! M. Pfeiffer et. al., "Extension of Particle-based BGK Models to Polyatomic Species in Hypersonic Flow around a Flat-faced -! Cylinder", AIP Conference Proceedings 2132, 100001 (2019) -TEqui = 3.*(nPart-1.)*CellTemp -TEquiNumDof = 3.*(nPart-1.) -! Sum up over all species -DO iSpec=1, nSpecies - IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - TEqui = TEqui + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec)+Xi_Vib_oldSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) - TEquiNumDof = TEquiNumDof + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec) + Xi_Vib_oldSpec(iSpec)*VibFracSpec(iSpec) - END IF -END DO -TEqui = TEqui / TEquiNumDof -! Required condition of Landau-Teller relaxation not fulfilled --> relaxation probabilities of rotation and vibration are -! corrected with a parameter beta for rotation and vibration as suggested by Burt: -! J. Burt and I. Boyd, “Evaluation of a particle method for the ellipsoidal statistical Bhatnagar-Gross-Krook equation”, -! 44th AIAA Aerospace Sciences Meeting and Exhibit (AIAA, 2006), p. 989 -! Solving of equation system until accuracy eps_prec is reached -DO WHILE ( ABS( TEqui - TEqui_Old ) .GT. eps_prec ) - DO iSpec = 1, nSpecies - IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - ! if difference small: equilibrium, no beta - IF (ABS(TRotSpec(iSpec)-TEqui).LT.1E-3) THEN - RotExpSpec(iSpec) = exp(-rotrelaxfreqSpec(iSpec)*dtCell) - ELSE - ! betaR = beta*nu*dt (= correction parameter rotation * relaxation frequency * time step) - betaR = ((TRotSpec(iSpec)-CellTemp)/(TRotSpec(iSpec)-TEqui))*rotrelaxfreqSpec(iSpec)*dtCell - ! negative betaR would leed to negative relaxation probability! - IF (-betaR.GT.0.0) THEN - RotExpSpec(iSpec) = 0. - ! Check if the exponent is within the range of machine precision - ELSE IF (CHECKEXP(betaR)) THEN - RotExpSpec(iSpec) = exp(-betaR) - ELSE - RotExpSpec(iSpec) = 0. - END IF - END IF - ! new calculation of number of rotational relaxing molecules - RotFracSpec(iSpec) = nSpec(iSpec)*(1.-RotExpSpec(iSpec)) - - IF(DoVibRelax) THEN - ! if difference small: equilibrium, no beta - IF (ABS(TVibSpec(iSpec)-TEqui).LT.1E-3) THEN - VibExpSpec(iSpec) = exp(-vibrelaxfreqSpec(iSpec)*dtCell) - ELSE - ! betaV = beta*nu*dt (= correction parameter vibration * relaxation frequency * time step) - betaV = ((TVibSpec(iSpec)-CellTemp)/(TVibSpec(iSpec)-TEqui))*vibrelaxfreqSpec(iSpec)*dtCell - ! negative betaV would leed to negative relaxation probability! - IF (-betaV.GT.0.0) THEN - VibExpSpec(iSpec) = 0. - ! Check if the exponent is within the range of machine precision - ELSE IF (CHECKEXP(betaV)) THEN - VibExpSpec(iSpec) = exp(-betaV) - ELSE - VibExpSpec(iSpec) = 0. - END IF - END IF - ! new calculation of number of vibrational relaxing molecules - VibFracSpec(iSpec) = nSpec(iSpec)*(1.-VibExpSpec(iSpec)) - - ! new calculation of the vibrational degrees of freedom per species - IF(SpecDSMC(iSpec)%PolyatomicMol) THEN - iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray - ! Loop over all vibrational degrees of freedom to calculate them using TEqui - DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF - exparg = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TEqui - ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom - IF(CHECKEXP(exparg))THEN - IF(exparg.gt.0.)THEN ! positive overflow: exp -> inf - Xi_vib_DOF(iSpec,iDOF) = 2.*exparg/(EXP(exparg)-1.) - ELSE ! negative overflow: exp -> 0 - Xi_vib_DOF(iSpec,iDOF) = 2.*exparg/(-1.) - END IF ! exparg.gt.0. - ELSE - Xi_vib_DOF(iSpec,iDOF) = 0.0 - END IF ! CHECKEXP(exparg) - END DO - Xi_Vib_Spec(iSpec) = SUM(Xi_vib_DOF(iSpec,1:PolyatomMolDSMC(iPolyatMole)%VibDOF)) - ELSE ! diatomic - exparg = SpecDSMC(iSpec)%CharaTVib/TEqui - ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom - IF(CHECKEXP(exparg))THEN - Xi_Vib_Spec(iSpec) = 2.*SpecDSMC(iSpec)%CharaTVib/TEqui/(EXP(exparg)-1.) - ELSE - Xi_Vib_Spec(iSpec) = 0.0 - END IF ! CHECKEXP(exparg) - END IF - END IF - END IF - END DO - TEqui_Old = TEqui - TEqui_Old2 = TEqui - - ! new calculation of equilibrium temperature with new RotFracSpec, new VibFracSpec, new Xi_VibSpec(TEqui) in denominator - TEqui = 3.*(nPart-1.)*CellTemp - TEquiNumDof = 3.*(nPart-1.) - ! Sum up over all species - DO iSpec=1, nSpecies - IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - TEqui = TEqui + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec)+Xi_Vib_oldSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) - TEquiNumDof = TEquiNumDof + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec) + Xi_Vib_Spec(iSpec)*VibFracSpec(iSpec) - END IF - END DO - TEqui = TEqui / TEquiNumDof - IF(DoVibRelax) THEN - ! accuracy eps_prec not reached yet - DO WHILE( ABS( TEqui - TEqui_Old2 ) .GT. eps_prec ) - ! mean value of old and new equilibrium temperature - TEqui =(TEqui + TEqui_Old2)*0.5 - DO iSpec=1, nSpecies - IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - ! new calculation of the vibrational degrees of freedom per species - IF(SpecDSMC(iSpec)%PolyatomicMol) THEN - iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray - ! Loop over all vibrational degrees of freedom to calculate them using TEqui - DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF - exparg = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TEqui - ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom - IF(CHECKEXP(exparg))THEN - IF(exparg.gt.0.)THEN ! positive overflow: exp -> inf - Xi_vib_DOF(iSpec,iDOF) = 2.*exparg/(EXP(exparg)-1.) - ELSE ! negative overflow: exp -> 0 - Xi_vib_DOF(iSpec,iDOF) = 2.*exparg/(-1.) - END IF ! exparg.gt.0. - ELSE - Xi_vib_DOF(iSpec,iDOF) = 0.0 - END IF ! CHECKEXP(exparg) - END DO - Xi_Vib_Spec(iSpec) = SUM(Xi_vib_DOF(iSpec,1:PolyatomMolDSMC(iPolyatMole)%VibDOF)) - ELSE ! diatomic - exparg = SpecDSMC(iSpec)%CharaTVib/TEqui - ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom - IF(CHECKEXP(exparg))THEN - Xi_Vib_Spec(iSpec) = 2.*SpecDSMC(iSpec)%CharaTVib/TEqui/(EXP(exparg)-1.) - ELSE - Xi_Vib_Spec(iSpec) = 0.0 - END IF ! CHECKEXP(exparg) - END IF - END IF - END DO - ! new calculation of equilibrium temperature with corrected vibrational degrees of freedom in denominator - TEqui_Old2 = TEqui - TEqui = 3.*(nPart-1.)*CellTemp - TEquiNumDof = 3.*(nPart-1.) - ! Sum up over all species - DO iSpec=1, nSpecies - IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - TEqui = TEqui + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec)+Xi_Vib_oldSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) - TEquiNumDof = TEquiNumDof + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec) + Xi_Vib_Spec(iSpec)*VibFracSpec(iSpec) - END IF - END DO - TEqui = TEqui / TEquiNumDof - END DO - END IF -END DO -END SUBROUTINE CalcTEquiMultiPoly - - SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_VibSpec, Visc, ThermalCond) !=================================================================================================================================== !> Determination of the mixture viscosity and thermal conductivity using collision integrals (derived for the Variable Hard From eb0d298d3d9de7f7e6aa014d33a0de799573113f Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Wed, 12 Apr 2023 16:53:11 +0200 Subject: [PATCH 16/41] BGK molecule mixtures with Mathiaud relaxation - bug fix for sampling and cell temperature for relaxation --- src/particles/bgk/bgk_colloperator.f90 | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 90fc2ec9d..0e9c457ab 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -221,7 +221,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! 5.) Determine the new rotational and vibrational state of molecules undergoing a relaxation IF(ANY(SpecDSMC(:)%InterID.EQ.2).OR.ANY(SpecDSMC(:)%InterID.EQ.20)) THEN - CALL CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, CellTemp, relaxfreq, rotrelaxfreqSpec, & + CALL CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeight, CellTemp, relaxfreq, rotrelaxfreqSpec, & vibrelaxfreqSpec, ERotTtransSpecMean, EVibTtransSpecMean, Xi_VibRelSpec, Xi_vib_DOF, nXiVibDOF, CellTempRel) CALL RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartIndx_NodeRelaxRot, nXiVibDOF, Xi_vib_DOF, & @@ -890,7 +890,7 @@ SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, END SUBROUTINE DetermineRelaxPart -SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, CellTemp, relaxfreq, rotrelaxfreqSpec, & +SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeight, CellTemp, relaxfreq, rotrelaxfreqSpec, & vibrelaxfreqSpec, ERotTtransSpecMean, EVibTtransSpecMean, Xi_VibRelSpec, Xi_vib_DOF, nXiVibDOF, CellTempRel) !=================================================================================================================================== !> Calculate the relaxation energies and temperatures @@ -907,7 +907,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, CellTemp, ! INPUT VARIABLES INTEGER, INTENT(IN) :: nXiVibDOF REAL, INTENT(IN) :: ERotSpec(nSpecies), Xi_RotSpec(nSpecies), EVibSpec(nSpecies) -REAL, INTENT(IN) :: totalWeightSpec(nSpecies), CellTemp!, MassFraction(nSpecies) +REAL, INTENT(IN) :: totalWeightSpec(nSpecies), totalWeight, CellTemp!, MassFraction(nSpecies) REAL, INTENT(IN) :: relaxfreq, rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES @@ -975,14 +975,14 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, CellTemp, ! Mean translational energy per particle to satisfy the Landau-Teller equation ETransRelMean = ETransRelMean + (3./2. * BoltzmannConst * CellTemp - (rotrelaxfreqSpec(iSpec)/relaxfreq) * & - (ERotTtransSpecMean(iSpec)-ERotSpecMean(iSpec))) * totalWeightSpec(iSpec) + (ERotTtransSpecMean(iSpec)-ERotSpecMean(iSpec))) * totalWeightSpec(iSpec)/totalWeight IF (BGKDoVibRelaxation) THEN ETransRelMean = ETransRelMean - (vibrelaxfreqSpec(iSpec)/relaxfreq)*(EVibTtransSpecMean(iSpec)-EVibSpecMean(iSpec)) * & - totalWeightSpec(iSpec) + totalWeightSpec(iSpec)/totalWeight END IF ELSE ! Mean translational energy per particle to satisfy the Landau-Teller equation - ETransRelMean = ETransRelMean + 3./2. * BoltzmannConst * CellTemp * totalWeightSpec(iSpec) + ETransRelMean = ETransRelMean + 3./2. * BoltzmannConst * CellTemp * totalWeightSpec(iSpec)/totalWeight END IF END DO @@ -1108,13 +1108,8 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, KronDelta = 0.0 END IF ! Fill symmetric transformation matrix SMat with anisotopic matrix A = SS - ! = Open work: calculation per species? ========================================================================== - SMat(fillMa1, fillMa2)= KronDelta*CellTempRel*BoltzmannConst/MassIC_Mixture - (1.-Prandtl)/(2.*Prandtl) & - *(u0ij(fillMa1, fillMa2)-KronDelta*CellTemp*BoltzmannConst/MassIC_Mixture) - ! SMat(fillMa1, fillMa2)= KronDelta*CellTempRel/CellTemp - (1.-Prandtl)/(2.*Prandtl) & - ! *(3./u2*u0ij(fillMa1, fillMa2)-KronDelta) - ! SMat(fillMa1, fillMa2)= KronDelta*CellTempRel - (1.-Prandtl)/(2.*Prandtl) & - ! *(u0ij(fillMa1, fillMa2)-KronDelta*CellTemp) + SMat(fillMa1, fillMa2)= KronDelta*CellTempRel/CellTemp - (1.-Prandtl)/(2.*Prandtl) & + *(3./u2*u0ij(fillMa1, fillMa2)-KronDelta) END DO END DO SMat(2,1)=SMat(1,2) @@ -1198,9 +1193,12 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, iPart = iPartIndx_NodeRelax(iLoop) iSpec = PartSpecies(iPart) ! Calculation of new velocities of all particles - IF ((BGKCollModel.EQ.1).AND.(ESBGKModel.NE.3)) THEN + IF ((BGKCollModel.EQ.1).AND.(ESBGKModel.EQ.1)) THEN ! Transformation of normalized thermal velocity vector tempVelo (sampled from a Maxwellian distribution) to a thermal velocity ! vector sampled from the ESBGK target distribution function (anisotropic Gaussian distribution) + tempVelo(1:3) = SQRT(BoltzmannConst*CellTempRel/Species(iSpec)%MassIC)*iRanPart(1:3,iLoop) + PartState(4:6,iPart) = vBulkAll(1:3) + MATMUL(SMat,tempVelo) + ELSE IF ((BGKCollModel.EQ.1).AND.(ESBGKModel.EQ.2)) THEN tempVelo(1:3) = SQRT(MassIC_Mixture/Species(iSpec)%MassIC)*iRanPart(1:3,iLoop) PartState(4:6,iPart) = vBulkAll(1:3) + MATMUL(SMat,tempVelo) ELSE IF ((BGKCollModel.EQ.1).AND.(ESBGKModel.EQ.3)) THEN From d8015b7a6f3c9ec9b9a6d3735c236eeb8b54f3f4 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Thu, 13 Apr 2023 09:29:02 +0200 Subject: [PATCH 17/41] BGK molecule mixtures with Mathiaud relaxation - bug fix for atomic species --- src/particles/bgk/bgk_colloperator.f90 | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 0e9c457ab..b826d04a8 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -218,15 +218,14 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal END IF END IF -! 5.) Determine the new rotational and vibrational state of molecules undergoing a relaxation -IF(ANY(SpecDSMC(:)%InterID.EQ.2).OR.ANY(SpecDSMC(:)%InterID.EQ.20)) THEN - - CALL CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeight, CellTemp, relaxfreq, rotrelaxfreqSpec, & +! 5.) Determine the relaxation temperatures and energies as well as the new rotational and vibrational states of molecules +! undergoing a relaxation +CALL CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeight, CellTemp, relaxfreq, rotrelaxfreqSpec, & vibrelaxfreqSpec, ERotTtransSpecMean, EVibTtransSpecMean, Xi_VibRelSpec, Xi_vib_DOF, nXiVibDOF, CellTempRel) +IF(ANY(SpecDSMC(:)%InterID.EQ.2).OR.ANY(SpecDSMC(:)%InterID.EQ.20)) THEN CALL RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartIndx_NodeRelaxRot, nXiVibDOF, Xi_vib_DOF, & Xi_VibRelSpec, Xi_RotSpec, VibEnergyDOF, CellTemp, NewEnVib, NewEnRot) - ELSE CellTempRel = CellTemp END IF @@ -926,7 +925,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig ETransRelMean=0.0; CellTempRel=0.0 DO iSpec = 1, nSpecies - IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN ! molecules ! Mean rotational energy per particle of a species ERotSpecMean(iSpec) = ERotSpec(iSpec)/totalWeightSpec(iSpec) ! Mean rotational energy per particle of a species for the mixture translational temperature, ERot(Ttrans) @@ -980,7 +979,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig ETransRelMean = ETransRelMean - (vibrelaxfreqSpec(iSpec)/relaxfreq)*(EVibTtransSpecMean(iSpec)-EVibSpecMean(iSpec)) * & totalWeightSpec(iSpec)/totalWeight END IF - ELSE + ELSE ! atomic ! Mean translational energy per particle to satisfy the Landau-Teller equation ETransRelMean = ETransRelMean + 3./2. * BoltzmannConst * CellTemp * totalWeightSpec(iSpec)/totalWeight END IF From fceba805f10bc95ae624c3ad5170afde2db8cc0f Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Thu, 13 Apr 2023 14:57:15 +0200 Subject: [PATCH 18/41] BGK molecule mixtures with Mathiaud relaxation - small clean-up --- src/particles/bgk/bgk_colloperator.f90 | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index b826d04a8..de27cfa65 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -89,7 +89,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal REAL,PARAMETER :: RelEneTol=1e-12 ! Relative tolerance applied to conservation of energy before/after reaction #endif /* CODE_ANALYZE */ REAL :: totalWeightSpec(nSpecies), totalWeight, partWeight, CellTemptmp, MassIC_Mixture -REAL :: EVibSpec(nSpecies), ERotSpec(nSpecies), Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies),Xi_Vib_oldSpec(nSpecies) +REAL :: EVibSpec(nSpecies), ERotSpec(nSpecies), Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies) REAL :: ERotTtransSpecMean(nSpecies), EVibTtransSpecMean(nSpecies), Xi_VibRelSpec(nSpecies), CellTempRel REAL :: TVibSpec(nSpecies), TRotSpec(nSpecies), VibRelaxWeightSpec(nSpecies), RotRelaxWeightSpec(nSpecies) REAL :: collisionfreqSpec(nSpecies),rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies) @@ -139,9 +139,11 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal nXiVibDOF=0.0 ! Initialize DO iSpec = 1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - IF(SpecDSMC(iSpec)%PolyatomicMol) THEN - iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray - nXiVibDOFSpec(iSpec) = PolyatomMolDSMC(iPolyatMole)%VibDOF + IF(BGKDoVibRelaxation) THEN + IF(SpecDSMC(iSpec)%PolyatomicMol) THEN + iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray + nXiVibDOFSpec(iSpec) = PolyatomMolDSMC(iPolyatMole)%VibDOF + END IF END IF END IF END DO @@ -149,8 +151,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ALLOCATE(Xi_vib_DOF(nSpecies,nXiVibDOF)) Xi_vib_DOF = 0.0 -CALL CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, TRotSpec, InnerDOF, Xi_VibSpec, Xi_Vib_oldSpec & - ,Xi_RotSpec) +CALL CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, TRotSpec, InnerDOF, Xi_VibSpec, Xi_RotSpec) ! 2.) Calculation of the relaxation frequency of the distribution function towards the target distribution function CALL CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight, TotalMass, u2Spec, u0ij, u2, SpecTemp, CellTemp, & @@ -217,6 +218,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ALLOCATE(VibEnergyDOF(nVibRelax,nXiVibDOF)) END IF END IF +VibEnergyDOF = 0.0 ! 5.) Determine the relaxation temperatures and energies as well as the new rotational and vibrational states of molecules ! undergoing a relaxation @@ -578,8 +580,7 @@ SUBROUTINE DoAveraging(dens, u2, u0ij, u2i, CellTemp, AverageValues) END SUBROUTINE DoAveraging -SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, TRotSpec, InnerDOF, Xi_VibSpec, Xi_Vib_oldSpec & - ,Xi_RotSpec) +SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, TRotSpec, InnerDOF, Xi_VibSpec, Xi_RotSpec) !=================================================================================================================================== !> Determine the internal degrees of freedom and the respective temperature (rotation/vibration) for diatomic/polyatomic species !=================================================================================================================================== @@ -597,14 +598,14 @@ SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, T REAL, INTENT(IN) :: EVibSpec(nSpecies), ERotSpec(nSpecies), totalWeightSpec(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES -REAL, INTENT(OUT) :: TVibSpec(nSpecies), TRotSpec(nSpecies), InnerDOF, Xi_VibSpec(nSpecies), Xi_Vib_oldSpec(nSpecies) +REAL, INTENT(OUT) :: TVibSpec(nSpecies), TRotSpec(nSpecies), InnerDOF, Xi_VibSpec(nSpecies) REAL, INTENT(OUT) :: Xi_RotSpec(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES INTEGER :: iPolyatMole, iSpec, iDOF REAL :: exparg !=================================================================================================================================== -Xi_VibSpec=0.; InnerDOF=0.; Xi_RotSpec=0.; Xi_Vib_oldSpec=0.; TVibSpec=0.; TRotSpec=0. +Xi_VibSpec=0.; InnerDOF=0.; Xi_RotSpec=0.; TVibSpec=0.; TRotSpec=0. DO iSpec = 1, nSpecies IF (nSpec(iSpec).EQ.0) CYCLE ! Only for molecules @@ -637,7 +638,6 @@ SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, T Xi_VibSpec(iSpec) = 2.* EVibSpec(iSpec) / (totalWeightSpec(iSpec)*BoltzmannConst*TVibSpec(iSpec)) END IF END IF - Xi_Vib_oldSpec(iSpec) = Xi_VibSpec(iSpec) END IF Xi_RotSpec(iSpec) = SpecDSMC(iSpec)%Xi_Rot ! Calculation of rotational temperature from Pfeiffer, Physics of Fluids 30, 116103 (2018), "Extending the particle ellipsoidal @@ -949,7 +949,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig TVibRelPoly = EVibTtransPoly / (BoltzmannConst*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)) IF (TVibRelPoly.GT.0.0) THEN TVibRelPoly = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/LOG(1. + 1./TVibRelPoly) - ! Calculation of the vibrational degrees of freedeom to satisfy the Landau-Teller equation + ! Calculation of the vibrational degrees of freedom to satisfy the Landau-Teller equation Xi_vib_DOF(iSpec,iDOF) = 2.* EVibTtransPoly / (BoltzmannConst*TVibRelPoly) ELSE Xi_vib_DOF(iSpec,iDOF) = 0.0 @@ -963,7 +963,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig TVibRelSpecMean = EVibTtransSpecMean(iSpec) / (BoltzmannConst*SpecDSMC(iSpec)%CharaTVib) IF (TVibRelSpecMean.GT.0.0) THEN TVibRelSpecMean = SpecDSMC(iSpec)%CharaTVib/LOG(1. + 1./(TVibRelSpecMean)) - ! Calculation of the vibrational degrees of freedeom to satisfy the Landau-Teller equation + ! Calculation of the vibrational degrees of freedom to satisfy the Landau-Teller equation Xi_VibRelSpec(iSpec) = 2.* EVibTtransSpecMean(iSpec) / (BoltzmannConst*TVibRelSpecMean) ! No negative temperature possible ELSE From 5164d40bfcbb694e37d511158aa5ed788bdd1845 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Thu, 13 Apr 2023 15:42:43 +0200 Subject: [PATCH 19/41] BGK molecule mixtures with Mathiaud relaxation - bug fix reggie --- src/particles/bgk/bgk_colloperator.f90 | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index de27cfa65..241fe3cbd 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -139,11 +139,9 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal nXiVibDOF=0.0 ! Initialize DO iSpec = 1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - IF(BGKDoVibRelaxation) THEN - IF(SpecDSMC(iSpec)%PolyatomicMol) THEN - iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray - nXiVibDOFSpec(iSpec) = PolyatomMolDSMC(iPolyatMole)%VibDOF - END IF + IF(SpecDSMC(iSpec)%PolyatomicMol) THEN + iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray + nXiVibDOFSpec(iSpec) = PolyatomMolDSMC(iPolyatMole)%VibDOF END IF END IF END DO @@ -218,7 +216,6 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ALLOCATE(VibEnergyDOF(nVibRelax,nXiVibDOF)) END IF END IF -VibEnergyDOF = 0.0 ! 5.) Determine the relaxation temperatures and energies as well as the new rotational and vibrational states of molecules ! undergoing a relaxation @@ -228,8 +225,6 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal IF(ANY(SpecDSMC(:)%InterID.EQ.2).OR.ANY(SpecDSMC(:)%InterID.EQ.20)) THEN CALL RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartIndx_NodeRelaxRot, nXiVibDOF, Xi_vib_DOF, & Xi_VibRelSpec, Xi_RotSpec, VibEnergyDOF, CellTemp, NewEnVib, NewEnRot) -ELSE - CellTempRel = CellTemp END IF ! 6.) Sample new particle velocities from the target distribution function, depending on the chosen model From f0648dc416155f3868181501902a24a553a252a4 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Thu, 13 Apr 2023 17:05:00 +0200 Subject: [PATCH 20/41] BGK molecule mixtures with Mathiaud relaxation - better allocation --- src/particles/bgk/bgk_colloperator.f90 | 36 ++++++++++---------------- 1 file changed, 13 insertions(+), 23 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 241fe3cbd..05e0738d7 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -135,20 +135,6 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal CALL DoAveraging(dens, u2, u0ij, u2i, CellTemp, AveragingValues) END IF -! Allocate Xi_vib_DOF -nXiVibDOF=0.0 ! Initialize -DO iSpec = 1, nSpecies - IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - IF(SpecDSMC(iSpec)%PolyatomicMol) THEN - iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray - nXiVibDOFSpec(iSpec) = PolyatomMolDSMC(iPolyatMole)%VibDOF - END IF - END IF -END DO -nXiVibDOF = MAXVAL(nXiVibDOFSpec(:)) -ALLOCATE(Xi_vib_DOF(nSpecies,nXiVibDOF)) -Xi_vib_DOF = 0.0 - CALL CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, TRotSpec, InnerDOF, Xi_VibSpec, Xi_RotSpec) ! 2.) Calculation of the relaxation frequency of the distribution function towards the target distribution function @@ -210,10 +196,14 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! Return if no particles are undergoing a relaxation IF ((nRelax.EQ.0).AND.(nRotRelax.EQ.0).AND.(nVibRelax.EQ.0)) RETURN -! Allocate VibEnergyDOF +! Allocate Xi_vib_DOF IF(BGKDoVibRelaxation) THEN - IF(ANY(SpecDSMC(:)%PolyatomicMol)) THEN + IF(DSMC%NumPolyatomMolecs.GT.0) THEN + nXiVibDOF = MAXVAL(PolyatomMolDSMC(:)%VibDOF) + ALLOCATE(Xi_vib_DOF(DSMC%NumPolyatomMolecs,nXiVibDOF)) + ! Allocate VibEnergyDOF ALLOCATE(VibEnergyDOF(nVibRelax,nXiVibDOF)) + VibEnergyDOF = 0.0 END IF END IF @@ -891,7 +881,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig !=================================================================================================================================== ! MODULES USE MOD_Particle_Vars ,ONLY: nSpecies -USE MOD_DSMC_Vars ,ONLY: PolyatomMolDSMC, SpecDSMC +USE MOD_DSMC_Vars ,ONLY: PolyatomMolDSMC, SpecDSMC, DSMC USE MOD_BGK_Vars ,ONLY: BGKDoVibRelaxation USE MOD_Globals_Vars ,ONLY: BoltzmannConst USE MOD_Globals ,ONLY: abort @@ -906,7 +896,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES REAL, INTENT(OUT) :: ERotTtransSpecMean(nSpecies), EVibTtransSpecMean(nSpecies) -REAL, INTENT(OUT) :: Xi_VibRelSpec(nSpecies), Xi_vib_DOF(nSpecies,nXiVibDOF), CellTempRel +REAL, INTENT(OUT) :: Xi_VibRelSpec(nSpecies), Xi_vib_DOF(DSMC%NumPolyatomMolecs,nXiVibDOF), CellTempRel !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES INTEGER :: iSpec, iDOF, iPolyatMole @@ -945,9 +935,9 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig IF (TVibRelPoly.GT.0.0) THEN TVibRelPoly = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/LOG(1. + 1./TVibRelPoly) ! Calculation of the vibrational degrees of freedom to satisfy the Landau-Teller equation - Xi_vib_DOF(iSpec,iDOF) = 2.* EVibTtransPoly / (BoltzmannConst*TVibRelPoly) + Xi_vib_DOF(iPolyatMole,iDOF) = 2.* EVibTtransPoly / (BoltzmannConst*TVibRelPoly) ELSE - Xi_vib_DOF(iSpec,iDOF) = 0.0 + Xi_vib_DOF(iPolyatMole,iDOF) = 0.0 END IF END DO @@ -997,7 +987,7 @@ SUBROUTINE RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartI !=================================================================================================================================== ! MODULES USE MOD_Particle_Vars ,ONLY: PartSpecies, nSpecies -USE MOD_DSMC_Vars ,ONLY: SpecDSMC, PartStateIntEn, PolyatomMolDSMC +USE MOD_DSMC_Vars ,ONLY: SpecDSMC, PartStateIntEn, PolyatomMolDSMC, DSMC USE MOD_BGK_Vars ,ONLY: BGKDoVibRelaxation USE MOD_part_tools ,ONLY: GetParticleWeight USE MOD_Globals_Vars ,ONLY: BoltzmannConst @@ -1007,7 +997,7 @@ SUBROUTINE RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartI ! INPUT VARIABLES INTEGER, INTENT(IN) :: nXiVibDOF INTEGER, INTENT(IN) :: nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib(nVibRelax), iPartIndx_NodeRelaxRot(nRotRelax) -REAL, INTENT(IN) :: Xi_vib_DOF(nSpecies,nXiVibDOF), Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies) +REAL, INTENT(IN) :: Xi_vib_DOF(DSMC%NumPolyatomMolecs,nXiVibDOF), Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies) REAL, INTENT(IN) :: CellTemp REAL, INTENT(INOUT) :: NewEnVib(nSpecies), NewEnRot(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- @@ -1033,7 +1023,7 @@ SUBROUTINE RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartI ! Polyatomic Species in Hypersonic Flow around a Flat-faced Cylinder", AIP Conference Proceedings 2132, 100001 (2019) DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF CALL RANDOM_NUMBER(iRan) - VibEnergyDOF(iLoop,iDOF) = - LOG(iRan)*Xi_vib_DOF(iSpec,iDOF)/2.*CellTemp*BoltzmannConst + VibEnergyDOF(iLoop,iDOF) = - LOG(iRan)*Xi_vib_DOF(iPolyatMole,iDOF)/2.*CellTemp*BoltzmannConst PartStateIntEn(1,iPart) = PartStateIntEn(1,iPart)+VibEnergyDOF(iLoop,iDOF) END DO ! ELSE: diatomic, only one vibrational DOF, calculate new vibrational energy according to M. Pfeiffer, "Extending the particle From 5525f4768b25eba8f0dc8c435dffc6f87f1c9c0f Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Wed, 19 Apr 2023 16:00:47 +0200 Subject: [PATCH 21/41] Calculation of TEqui for correction of energy conservation BGK - ongoing, tbc --- src/particles/bgk/bgk_colloperator.f90 | 176 +++++++++++++++++++------ 1 file changed, 134 insertions(+), 42 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 05e0738d7..d00209398 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -89,10 +89,11 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal REAL,PARAMETER :: RelEneTol=1e-12 ! Relative tolerance applied to conservation of energy before/after reaction #endif /* CODE_ANALYZE */ REAL :: totalWeightSpec(nSpecies), totalWeight, partWeight, CellTemptmp, MassIC_Mixture -REAL :: EVibSpec(nSpecies), ERotSpec(nSpecies), Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies) -REAL :: ERotTtransSpecMean(nSpecies), EVibTtransSpecMean(nSpecies), Xi_VibRelSpec(nSpecies), CellTempRel +REAL :: EVibSpec(nSpecies), Xi_VibSpec(nSpecies), Xi_VibRelSpec(nSpecies) +REAL :: ERotSpec(nSpecies), Xi_RotSpec(nSpecies), Xi_RotTotal +REAL :: ERotTtransSpecMean(nSpecies), EVibTtransSpecMean(nSpecies), CellTempRel, TEqui REAL :: TVibSpec(nSpecies), TRotSpec(nSpecies), VibRelaxWeightSpec(nSpecies), RotRelaxWeightSpec(nSpecies) -REAL :: collisionfreqSpec(nSpecies),rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies) +REAL :: collisionfreqSpec(nSpecies),rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies), betaR(nSpecies), betaV(nSpecies) !=================================================================================================================================== #ifdef CODE_ANALYZE ! Momentum and energy conservation check: summing up old values @@ -183,19 +184,12 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal END IF END IF -! 4.) Determine the number of particles undergoing a relaxation (including vibration and rotation) +! 4.) Determine the relaxation temperatures and energies as well as the number of particles undergoing a relaxation (including vibration and rotation) ALLOCATE(iPartIndx_NodeRelax(nPart), iPartIndx_NodeRelaxTemp(nPart)) iPartIndx_NodeRelax = 0; iPartIndx_NodeRelaxTemp = 0 ALLOCATE(iPartIndx_NodeRelaxRot(nPart),iPartIndx_NodeRelaxVib(nPart)) iPartIndx_NodeRelaxRot = 0; iPartIndx_NodeRelaxVib = 0 -CALL DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, nRotRelax, nVibRelax, & - RotRelaxWeightSpec, VibRelaxWeightSpec, iPartIndx_NodeRelax, iPartIndx_NodeRelaxTemp, iPartIndx_NodeRelaxRot, & - iPartIndx_NodeRelaxVib, vBulk, OldEnRot, OldEn, rotrelaxfreqSpec, vibrelaxfreqSpec) - -! Return if no particles are undergoing a relaxation -IF ((nRelax.EQ.0).AND.(nRotRelax.EQ.0).AND.(nVibRelax.EQ.0)) RETURN - ! Allocate Xi_vib_DOF IF(BGKDoVibRelaxation) THEN IF(DSMC%NumPolyatomMolecs.GT.0) THEN @@ -207,14 +201,20 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal END IF END IF -! 5.) Determine the relaxation temperatures and energies as well as the new rotational and vibrational states of molecules -! undergoing a relaxation -CALL CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeight, CellTemp, relaxfreq, rotrelaxfreqSpec, & - vibrelaxfreqSpec, ERotTtransSpecMean, EVibTtransSpecMean, Xi_VibRelSpec, Xi_vib_DOF, nXiVibDOF, CellTempRel) +CALL CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeight, nPart, dtCell, CellTemp, TRotSpec, relaxfreq, rotrelaxfreqSpec, & + vibrelaxfreqSpec, ERotTtransSpecMean, EVibTtransSpecMean, Xi_VibRelSpec, Xi_vib_DOF, nXiVibDOF, CellTempRel, TEqui, betaR, betaV) + +CALL DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, nRotRelax, nVibRelax, & + RotRelaxWeightSpec, VibRelaxWeightSpec, iPartIndx_NodeRelax, iPartIndx_NodeRelaxTemp, iPartIndx_NodeRelaxRot, & + iPartIndx_NodeRelaxVib, vBulk, OldEnRot, OldEn, rotrelaxfreqSpec, vibrelaxfreqSpec, betaR, betaV) + +! Return if no particles are undergoing a relaxation +IF ((nRelax.EQ.0).AND.(nRotRelax.EQ.0).AND.(nVibRelax.EQ.0)) RETURN +! 5.) Determine the new rotational and vibrational states of molecules undergoing a relaxation IF(ANY(SpecDSMC(:)%InterID.EQ.2).OR.ANY(SpecDSMC(:)%InterID.EQ.20)) THEN CALL RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartIndx_NodeRelaxRot, nXiVibDOF, Xi_vib_DOF, & - Xi_VibRelSpec, Xi_RotSpec, VibEnergyDOF, CellTemp, NewEnVib, NewEnRot) + Xi_VibRelSpec, Xi_RotSpec, VibEnergyDOF, TEqui, NewEnVib, NewEnRot) END IF ! 6.) Sample new particle velocities from the target distribution function, depending on the chosen model @@ -249,20 +249,23 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! 7.) Vibrational energy of the molecules: Ensure energy conservation by scaling the new vibrational states with the factor alpha IF(ANY(SpecDSMC(:)%InterID.EQ.2).OR.ANY(SpecDSMC(:)%InterID.EQ.20)) THEN + ! = tbc ======= use TEqui ============================================================================================== CALL EnergyConsVib(nPart, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRelaxVib, NewEnVib, OldEn, nXiVibDOF, VibEnergyDOF, & - CellTemp, EVibTtransSpecMean) + CellTemp, EVibTtransSpecMean, Xi_VibRelSpec, Xi_vib_DOF) END IF ! Remaining vibrational (+ translational) energy + rotational energy for translation and rotation OldEn = OldEn + OldEnRot DO iSpec = 1, nSpecies + ! = tbd ======= nRotRelaxSpec or RotRelaxWeightSpec? ======================================================================= + Xi_RotTotal = Xi_RotTotal + Xi_RotSpec(iSpec)*RotRelaxWeightSpec(iSpec) ! ERotTtransSpecMean(iSpec)*RotRelaxWeightSpec(iSpec) is energy that should be in rotation - OldEn = OldEn - ERotTtransSpecMean(iSpec)*RotRelaxWeightSpec(iSpec) + !OldEn = OldEn - ERotTtransSpecMean(iSpec)*RotRelaxWeightSpec(iSpec) END DO ! 8.) Determine the new particle state and ensure energy conservation by scaling the new velocities with the factor alpha ! Calculation of scaling factor alpha -alpha = SQRT(OldEn/NewEn) +alpha = SQRT(OldEn/NewEn*(3.*(nPart-1.))/(Xi_RotTotal+3.*(nPart-1.))) ! Calculation of the final particle velocities with vBulkAll (average flow velocity before relaxation), scaling factor alpha, ! the particle velocity PartState(4:6,iPart) after the relaxation but before the energy conservation and vBulk (average value of ! the latter) @@ -280,7 +283,9 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! Calculate scaling factor alpha per species, see M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross- ! Krook method to diatomic molecules including quantized vibrational energies", Phys. Fluids 30, 116103 (2018) IF (NewEnRot(iSpec).GT.0.0) THEN - alphaRot(iSpec) = ERotTtransSpecMean(iSpec)*RotRelaxWeightSpec(iSpec)/NewEnRot(iSpec) + ! = tbd ======= nRotRelaxSpec or RotRelaxWeightSpec? ======================================================================= + alphaRot(iSpec) = OldEn/NewEnRot(iSpec)*(Xi_RotSpec(iSpec)*RotRelaxWeightSpec(iSpec)/(Xi_RotTotal+3.*(nPart-1.))) + !alphaRot(iSpec) = ERotTtransSpecMean(iSpec)*RotRelaxWeightSpec(iSpec)/NewEnRot(iSpec) ELSE alphaRot(iSpec) = 0.0 END IF @@ -780,7 +785,7 @@ END SUBROUTINE CalcGasProperties SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, nRotRelax, nVibRelax, & RotRelaxWeightSpec, VibRelaxWeightSpec, iPartIndx_NodeRelax, iPartIndx_NodeRelaxTemp, iPartIndx_NodeRelaxRot, & - iPartIndx_NodeRelaxVib, vBulk, OldEnRot, OldEn, rotrelaxfreqSpec, vibrelaxfreqSpec) + iPartIndx_NodeRelaxVib, vBulk, OldEnRot, OldEn, rotrelaxfreqSpec, vibrelaxfreqSpec, betaR, betaV) !=================================================================================================================================== !> Determine the number of particles undergoing a relaxation (including vibration and rotation) !=================================================================================================================================== @@ -794,7 +799,7 @@ SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT VARIABLES INTEGER, INTENT(IN) :: nPart, iPartIndx_Node(nPart) -REAL, INTENT(IN) :: relaxfreq, dtCell, rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies) +REAL, INTENT(IN) :: relaxfreq, dtCell, rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies), betaR(nSpecies), betaV(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES INTEGER, INTENT(OUT) :: iPartIndx_NodeRelax(:), iPartIndx_NodeRelaxTemp(:) @@ -832,7 +837,7 @@ SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, ! Rotation CALL RANDOM_NUMBER(iRan) ! Calculate probability of rotational relaxation of a particle that relaxes towards the target distribution function - ProbAddPartRot = rotrelaxfreqSpec(iSpec)/relaxfreq + ProbAddPartRot = rotrelaxfreqSpec(iSpec)/relaxfreq*betaR(iSpec) IF (ProbAddPartRot.GT.iRan) THEN ! relaxation iPartIndx_NodeRelaxRot(iLoopRot) = iPartIndx_NodeRelax(iLoop) @@ -846,7 +851,7 @@ SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, IF(BGKDoVibRelaxation) THEN CALL RANDOM_NUMBER(iRan) ! Calculate probability of vibrational relaxation of a particle that relaxes towards the target distribution function - ProbAddPartVib = vibrelaxfreqSpec(iSpec)/relaxfreq + ProbAddPartVib = vibrelaxfreqSpec(iSpec)/relaxfreq*betaV(iSpec) IF (ProbAddPartVib.GT.iRan) THEN ! relaxation iPartIndx_NodeRelaxVib(iLoopVib) = iPartIndx_NodeRelax(iLoop) @@ -874,8 +879,8 @@ SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, END SUBROUTINE DetermineRelaxPart -SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeight, CellTemp, relaxfreq, rotrelaxfreqSpec, & - vibrelaxfreqSpec, ERotTtransSpecMean, EVibTtransSpecMean, Xi_VibRelSpec, Xi_vib_DOF, nXiVibDOF, CellTempRel) +SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeight, nPart, dtCell, CellTemp, TRotSpec, relaxfreq, rotrelaxfreqSpec, & + vibrelaxfreqSpec, ERotTtransSpecMean, EVibTtransSpecMean, Xi_VibRelSpec, Xi_vib_DOF, nXiVibDOF, CellTempRel, TEqui, betaR, betaV) !=================================================================================================================================== !> Calculate the relaxation energies and temperatures !=================================================================================================================================== @@ -889,23 +894,28 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig IMPLICIT NONE !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT VARIABLES -INTEGER, INTENT(IN) :: nXiVibDOF -REAL, INTENT(IN) :: ERotSpec(nSpecies), Xi_RotSpec(nSpecies), EVibSpec(nSpecies) -REAL, INTENT(IN) :: totalWeightSpec(nSpecies), totalWeight, CellTemp!, MassFraction(nSpecies) +INTEGER, INTENT(IN) :: nPart, nXiVibDOF +REAL, INTENT(IN) :: TRotSpec(nSpecies), ERotSpec(nSpecies), Xi_RotSpec(nSpecies), EVibSpec(nSpecies) +REAL, INTENT(IN) :: totalWeightSpec(nSpecies), totalWeight, CellTemp, dtCell REAL, INTENT(IN) :: relaxfreq, rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES REAL, INTENT(OUT) :: ERotTtransSpecMean(nSpecies), EVibTtransSpecMean(nSpecies) -REAL, INTENT(OUT) :: Xi_VibRelSpec(nSpecies), Xi_vib_DOF(DSMC%NumPolyatomMolecs,nXiVibDOF), CellTempRel +REAL, INTENT(OUT) :: Xi_VibRelSpec(nSpecies), Xi_vib_DOF(DSMC%NumPolyatomMolecs,nXiVibDOF), CellTempRel, TEqui +REAL, INTENT(OUT) :: betaR(nSpecies), betaV(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES INTEGER :: iSpec, iDOF, iPolyatMole -REAL :: ERotSpecMean(nSpecies), EVibSpecMean(nSpecies), TVibRelSpecMean, ETransRelMean -REAL :: EVibTtransPoly, TVibRelPoly +REAL :: RotFracSpec(nSpecies), VibFracSpec(nSpecies) +REAL :: ERotSpecMean(nSpecies), Xi_Rot_Spec(nSpecies), EVibSpecMean(nSpecies) +REAL :: EVibTtransPoly, TVibRelPoly, TVibRelSpecMean, ETransRelMean +REAL :: TEqui_Old, TEquiNum, TEquiDenom +REAL :: eps_prec=1.0E-0 !=================================================================================================================================== ! According to J. Mathiaud et. al., "An ES-BGK model for diatomic gases with correct relaxation rates for internal energies", ! European Journal of Mechanics - B/Fluids, 96, pp. 65-77, 2022 +RotFracSpec=0.0; VibFracSpec=0.0 ERotSpecMean=0.0; ERotTtransSpecMean=0.0; EVibSpecMean=0.0; EVibTtransSpecMean=0.0; Xi_VibRelSpec=0.0; Xi_vib_DOF=0.0 ETransRelMean=0.0; CellTempRel=0.0 @@ -915,7 +925,10 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig ERotSpecMean(iSpec) = ERotSpec(iSpec)/totalWeightSpec(iSpec) ! Mean rotational energy per particle of a species for the mixture translational temperature, ERot(Ttrans) ERotTtransSpecMean(iSpec) = CellTemp * Xi_RotSpec(iSpec) * BoltzmannConst /2. - ! Mean rotational energy per particle of a species to satisfy the Landau-Teller equation + ! Rotational degrees of freedom of molecules + Xi_Rot_Spec(iSpec) = SpecDSMC(iSpec)%Xi_Rot + ! Calculate number of rotational relaxing molecules + RotFracSpec(iSpec) = totalWeightSpec(iSpec)*(rotrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell)) IF(BGKDoVibRelaxation) THEN ! Mean vibrational energy per particle of a species @@ -955,6 +968,9 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig Xi_VibRelSpec(iSpec) = 0.0 END IF END IF + + ! Calculate number of vibrational relaxing molecules + VibFracSpec(iSpec) = totalWeightSpec(iSpec)*(vibrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell)) END IF ! Mean translational energy per particle to satisfy the Landau-Teller equation @@ -977,11 +993,73 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig CALL abort(__STAMP__,'Negative energy for relaxation') END IF +! Calculation of equilibrium temperature for relaxation and energy conservation +TEqui_Old = 0.0 +TEquiNum = 3.*(nPart-1.)*CellTemp +TEquiDenom = 3.*(nPart-1.) +! Sum up over all species +DO iSpec = 1, nSpecies + IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + ! - tbc ------ add vibration to calculation of TEqui ------------------------------------------------------------------------ + TEquiNum = TEquiNum + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) + TEquiDenom = TEquiDenom + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec) + END IF +END DO +TEqui = TEquiNum/TEquiDenom +print*, CellTemp, TEqui, CellTempRel, 'start' + +! Solving of equation system until accuracy eps_prec is reached +DO WHILE ( ABS( TEqui - TEqui_Old ) .GT. eps_prec ) + DO iSpec = 1, nSpecies + IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + ! if difference small: equilibrium, no beta + IF (ABS(TRotSpec(iSpec)-TEqui).GT.1E-3) THEN + betaR(iSpec) = (TRotSpec(iSpec)-CellTemp)/(TRotSpec(iSpec)-TEqui) + IF (betaR(iSpec).LT.0.0) THEN + betaR(iSpec) = 1. + END IF + ! new calculation of number of rotational relaxing molecules with betaR + RotFracSpec(iSpec) = totalWeightSpec(iSpec)*(rotrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell))*betaR(iSpec) + END IF + ! IF(BGKDoVibRelaxation) + ! ! if difference small: equilibrium, no beta + ! IF (ABS(TVibSpec(iSpec)-TEqui).GT.1E-3) THEN + ! betaV(iSpec) = (TVibSpec(iSpec)-CellTemp)/(TVibSpec(iSpec)-TEqui) + ! IF (betaV(iSpec).LT.0.0) THEN + ! betaV(iSpec) = 1. + ! END IF + ! ! new calculation of number of rotational relaxing molecules + ! VibFracSpec(iSpec) = totalWeightSpec(iSpec)*(vibrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell))*betaV(iSpec) + ! END IF + ! END IF + ! ! new calculation of the vibrational degrees of freedom per species ----------------------------------------------------- + END IF + END DO + TEqui_Old = TEqui + ! new calculation of equilibrium temperature with new RotFracSpec, new VibFracSpec, new VibDOF(TEqui) in denominator + TEquiNum = 3.*(nPart-1.)*CellTemp + TEquiDenom = 3.*(nPart-1.) + ! Sum up over all species + DO iSpec = 1, nSpecies + IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + ! - tbc - add vibration to calculation of TEqui ----------------------------------------------------------------------------- + TEquiNum = TEquiNum + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) + TEquiDenom = TEquiDenom + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec) + END IF + END DO + TEqui = TEquiNum/TEquiDenom + print*, TEqui, betaR + read* + ! - tbc - additional round for VibDOF(TEqui) and then TEqui with BGKDoVibRelaxation ------------------------------------------- +END DO + +! - tbc - kommentieren, Zeilenumbrüche, Subroutines tauschen ------------------------------------------------------------- + END SUBROUTINE CalcTRelax SUBROUTINE RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartIndx_NodeRelaxRot, nXiVibDOF, Xi_vib_DOF, & - Xi_VibSpec, Xi_RotSpec, VibEnergyDOF, CellTemp, NewEnVib, NewEnRot) + Xi_VibSpec, Xi_RotSpec, VibEnergyDOF, TEqui, NewEnVib, NewEnRot) !=================================================================================================================================== !> Determine the new rotational and vibrational energy of relaxing particles !=================================================================================================================================== @@ -998,7 +1076,7 @@ SUBROUTINE RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartI INTEGER, INTENT(IN) :: nXiVibDOF INTEGER, INTENT(IN) :: nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib(nVibRelax), iPartIndx_NodeRelaxRot(nRotRelax) REAL, INTENT(IN) :: Xi_vib_DOF(DSMC%NumPolyatomMolecs,nXiVibDOF), Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies) -REAL, INTENT(IN) :: CellTemp +REAL, INTENT(IN) :: TEqui REAL, INTENT(INOUT) :: NewEnVib(nSpecies), NewEnRot(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES @@ -1023,7 +1101,7 @@ SUBROUTINE RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartI ! Polyatomic Species in Hypersonic Flow around a Flat-faced Cylinder", AIP Conference Proceedings 2132, 100001 (2019) DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF CALL RANDOM_NUMBER(iRan) - VibEnergyDOF(iLoop,iDOF) = - LOG(iRan)*Xi_vib_DOF(iPolyatMole,iDOF)/2.*CellTemp*BoltzmannConst + VibEnergyDOF(iLoop,iDOF) = - LOG(iRan)*Xi_vib_DOF(iPolyatMole,iDOF)/2.*TEqui*BoltzmannConst PartStateIntEn(1,iPart) = PartStateIntEn(1,iPart)+VibEnergyDOF(iLoop,iDOF) END DO ! ELSE: diatomic, only one vibrational DOF, calculate new vibrational energy according to M. Pfeiffer, "Extending the particle @@ -1031,7 +1109,7 @@ SUBROUTINE RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartI ! Phys. Fluids 30, 116103 (2018) ELSE CALL RANDOM_NUMBER(iRan) - PartStateIntEn( 1,iPart) = -LOG(iRan)*Xi_VibSpec(iSpec)/2.*CellTemp*BoltzmannConst + PartStateIntEn( 1,iPart) = -LOG(iRan)*Xi_VibSpec(iSpec)/2.*TEqui*BoltzmannConst END IF ! Sum up new vibrational energy per species NewEnVib(iSpec) = NewEnVib(iSpec) + PartStateIntEn(1,iPart) * partWeight @@ -1045,7 +1123,7 @@ SUBROUTINE RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartI CALL RANDOM_NUMBER(iRan) ! Calculate new rotational energy according to M. Pfeiffer et. al., "Extension of Particle-based BGK Models to Polyatomic Species ! in Hypersonic Flow around a Flat-faced Cylinder", AIP Conference Proceedings 2132, 100001 (2019) - PartStateIntEn( 2,iPart) = -Xi_RotSpec(iSpec) / 2. * BoltzmannConst*CellTemp*LOG(iRan) + PartStateIntEn( 2,iPart) = -Xi_RotSpec(iSpec) / 2. * BoltzmannConst*TEqui*LOG(iRan) ! Sum up new rotational energy per species NewEnRot(iSpec) = NewEnRot(iSpec) + PartStateIntEn( 2,iPart) * partWeight END DO @@ -1203,7 +1281,7 @@ END SUBROUTINE SampleFromTargetDistr SUBROUTINE EnergyConsVib(nPart, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRelaxVib, NewEnVib, OldEn, nXiVibDOF, & - VibEnergyDOF, CellTemp, EVibTtransSpecMean) + VibEnergyDOF, CellTemp, EVibTtransSpecMean, Xi_VibRelSpec, Xi_vib_DOF) !=================================================================================================================================== !> Routine to ensure energy conservation when including vibrational degrees of freedom (continuous and quantized) !=================================================================================================================================== @@ -1219,7 +1297,7 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRel ! INPUT VARIABLES INTEGER, INTENT(IN) :: nPart,nXiVibDOF INTEGER, INTENT(IN) :: nVibRelax, iPartIndx_NodeRelaxVib(nPart) -REAL, INTENT(IN) :: VibRelaxWeightSpec(nSpecies) +REAL, INTENT(IN) :: VibRelaxWeightSpec(nSpecies), Xi_VibRelSpec(nSpecies), Xi_vib_DOF(DSMC%NumPolyatomMolecs,nXiVibDOF) REAL, INTENT(IN) :: NewEnVib(nSpecies), VibEnergyDOF(nVibRelax,nXiVibDOF), CellTemp, EVibTtransSpecMean(nSpecies) REAL, INTENT(INOUT) :: OldEn !----------------------------------------------------------------------------------------------------------------------------------- @@ -1227,18 +1305,32 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRel !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES INTEGER :: iPart, iLoop, iDOF, iSpec, iQuant, iQuaMax, iPolyatMole -REAL :: alpha(nSpecies), partWeight, betaV, iRan, MaxColQua +REAL :: Xi_VibSpec(nSpecies), Xi_VibTotal, alpha(nSpecies), partWeight, betaV, iRan, MaxColQua !=================================================================================================================================== ! According to M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules ! including quantized vibrational energies", Phys. Fluids 30, 116103 (2018) IF(BGKDoVibRelaxation) THEN ! Vibrational energy is positive for at least one species + there are vibrational relaxations IF (ANY(NewEnVib.GT.0.0).AND.(nVibRelax.GT.0)) THEN + Xi_VibTotal = 0.0 + DO iSpec = 1, nSpecies + ! Total number of relaxing vibrational degrees of freedom + ! = tbd ======= nVibRelaxSpec or VibRelaxWeightSpec? ======================================================================= + ! = tbc ======= Xi_VibSpec as output of TEqui ============================================================================== + IF(SpecDSMC(iSpec)%PolyatomicMol) THEN ! polyatomic + iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray + Xi_VibSpec(iSpec) = SUM(Xi_vib_DOF(iPolyatMole,:)) + ELSE + Xi_VibSpec(iSpec) = Xi_VibRelSpec(iSpec) + END IF + Xi_VibTotal = Xi_VibTotal + Xi_VibSpec(iSpec)*VibRelaxWeightSpec(iSpec) + END DO ! Calculate scaling factor alpha per species ! EVibTtransSpecMean(iSpec)*VibRelaxWeightSpec(iSpec) is energy that should be in vibration DO iSpec = 1, nSpecies IF (NewEnVib(iSpec).GT.0.0) THEN - alpha(iSpec) = EVibTtransSpecMean(iSpec)*VibRelaxWeightSpec(iSpec)/NewEnVib(iSpec) + alpha(iSpec) = OldEn/NewEnVib(iSpec)*(Xi_VibSpec(iSpec)*VibRelaxWeightSpec(iSpec)/(3.*(nPart-1.)+Xi_VibTotal)) + !alpha(iSpec) = EVibTtransSpecMean(iSpec)*VibRelaxWeightSpec(iSpec)/NewEnVib(iSpec) ELSE alpha(iSpec) = 0. END IF From 6631ef7c63cff6b6574afef24a29fd61cb1f08a4 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Thu, 20 Apr 2023 15:13:04 +0200 Subject: [PATCH 22/41] Calculation of TEqui for correction of energy conservation BGK - bug fix for calculation of rot dof - vibration tbc --- src/particles/bgk/bgk_colloperator.f90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index d00209398..b6035b974 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -256,6 +256,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! Remaining vibrational (+ translational) energy + rotational energy for translation and rotation OldEn = OldEn + OldEnRot +Xi_RotTotal = 0.0 DO iSpec = 1, nSpecies ! = tbd ======= nRotRelaxSpec or RotRelaxWeightSpec? ======================================================================= Xi_RotTotal = Xi_RotTotal + Xi_RotSpec(iSpec)*RotRelaxWeightSpec(iSpec) @@ -1006,7 +1007,6 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig END IF END DO TEqui = TEquiNum/TEquiDenom -print*, CellTemp, TEqui, CellTempRel, 'start' ! Solving of equation system until accuracy eps_prec is reached DO WHILE ( ABS( TEqui - TEqui_Old ) .GT. eps_prec ) @@ -1048,8 +1048,6 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig END IF END DO TEqui = TEquiNum/TEquiDenom - print*, TEqui, betaR - read* ! - tbc - additional round for VibDOF(TEqui) and then TEqui with BGKDoVibRelaxation ------------------------------------------- END DO From 0fc397c550c5d6c493dfb09b487b08deec0eed86 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Fri, 21 Apr 2023 12:51:44 +0200 Subject: [PATCH 23/41] Vibration added for TEqui calculation and energy conservation in BGK --- src/particles/bgk/bgk_colloperator.f90 | 244 ++++++++++++++++--------- 1 file changed, 156 insertions(+), 88 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index b6035b974..0112d9bcf 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -76,7 +76,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal REAL :: alpha, alphaRot(nSpecies), CellTemp, dens, InnerDOF, NewEn, OldEn, Prandtl, relaxfreq REAL :: dynamicvis, thermalcond INTEGER, ALLOCATABLE :: iPartIndx_NodeRelax(:),iPartIndx_NodeRelaxTemp(:),iPartIndx_NodeRelaxRot(:),iPartIndx_NodeRelaxVib(:) -INTEGER :: iLoop, iPart, nRelax, iPolyatMole, nXiVibDOF, nXiVibDOFSpec(nSpecies) +INTEGER :: iLoop, iPart, nRelax, nXiVibDOF REAL, ALLOCATABLE :: Xi_vib_DOF(:,:), VibEnergyDOF(:,:) INTEGER :: iSpec, nSpec(nSpecies), jSpec, nRotRelax, nVibRelax REAL :: OldEnRot, NewEnRot(nSpecies), NewEnVib(nSpecies) @@ -89,9 +89,9 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal REAL,PARAMETER :: RelEneTol=1e-12 ! Relative tolerance applied to conservation of energy before/after reaction #endif /* CODE_ANALYZE */ REAL :: totalWeightSpec(nSpecies), totalWeight, partWeight, CellTemptmp, MassIC_Mixture -REAL :: EVibSpec(nSpecies), Xi_VibSpec(nSpecies), Xi_VibRelSpec(nSpecies) +REAL :: EVibSpec(nSpecies), Xi_VibSpec(nSpecies), Xi_VibSpecNew(nSpecies) REAL :: ERotSpec(nSpecies), Xi_RotSpec(nSpecies), Xi_RotTotal -REAL :: ERotTtransSpecMean(nSpecies), EVibTtransSpecMean(nSpecies), CellTempRel, TEqui +REAL :: CellTempRel, TEqui REAL :: TVibSpec(nSpecies), TRotSpec(nSpecies), VibRelaxWeightSpec(nSpecies), RotRelaxWeightSpec(nSpecies) REAL :: collisionfreqSpec(nSpecies),rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies), betaR(nSpecies), betaV(nSpecies) !=================================================================================================================================== @@ -184,7 +184,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal END IF END IF -! 4.) Determine the relaxation temperatures and energies as well as the number of particles undergoing a relaxation (including vibration and rotation) +! 4.) Determine the relaxation temperatures as well as the number of particles undergoing a relaxation (including vibration and rotation) ALLOCATE(iPartIndx_NodeRelax(nPart), iPartIndx_NodeRelaxTemp(nPart)) iPartIndx_NodeRelax = 0; iPartIndx_NodeRelaxTemp = 0 ALLOCATE(iPartIndx_NodeRelaxRot(nPart),iPartIndx_NodeRelaxVib(nPart)) @@ -195,26 +195,31 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal IF(DSMC%NumPolyatomMolecs.GT.0) THEN nXiVibDOF = MAXVAL(PolyatomMolDSMC(:)%VibDOF) ALLOCATE(Xi_vib_DOF(DSMC%NumPolyatomMolecs,nXiVibDOF)) - ! Allocate VibEnergyDOF - ALLOCATE(VibEnergyDOF(nVibRelax,nXiVibDOF)) - VibEnergyDOF = 0.0 END IF END IF -CALL CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeight, nPart, dtCell, CellTemp, TRotSpec, relaxfreq, rotrelaxfreqSpec, & - vibrelaxfreqSpec, ERotTtransSpecMean, EVibTtransSpecMean, Xi_VibRelSpec, Xi_vib_DOF, nXiVibDOF, CellTempRel, TEqui, betaR, betaV) +CALL CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpec, totalWeight, nPart, dtCell, CellTemp, TRotSpec, TVibSpec, relaxfreq, rotrelaxfreqSpec, & + vibrelaxfreqSpec, Xi_VibSpecNew, Xi_vib_DOF, nXiVibDOF, CellTempRel, TEqui, betaR, betaV) CALL DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, nRotRelax, nVibRelax, & RotRelaxWeightSpec, VibRelaxWeightSpec, iPartIndx_NodeRelax, iPartIndx_NodeRelaxTemp, iPartIndx_NodeRelaxRot, & iPartIndx_NodeRelaxVib, vBulk, OldEnRot, OldEn, rotrelaxfreqSpec, vibrelaxfreqSpec, betaR, betaV) +! Allocate VibEnergyDOF +IF(BGKDoVibRelaxation) THEN + IF(DSMC%NumPolyatomMolecs.GT.0) THEN + ALLOCATE(VibEnergyDOF(nVibRelax,nXiVibDOF)) + VibEnergyDOF = 0.0 + END IF +END IF + ! Return if no particles are undergoing a relaxation IF ((nRelax.EQ.0).AND.(nRotRelax.EQ.0).AND.(nVibRelax.EQ.0)) RETURN ! 5.) Determine the new rotational and vibrational states of molecules undergoing a relaxation IF(ANY(SpecDSMC(:)%InterID.EQ.2).OR.ANY(SpecDSMC(:)%InterID.EQ.20)) THEN CALL RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartIndx_NodeRelaxRot, nXiVibDOF, Xi_vib_DOF, & - Xi_VibRelSpec, Xi_RotSpec, VibEnergyDOF, TEqui, NewEnVib, NewEnRot) + Xi_VibSpecNew, Xi_RotSpec, VibEnergyDOF, TEqui, NewEnVib, NewEnRot) END IF ! 6.) Sample new particle velocities from the target distribution function, depending on the chosen model @@ -249,9 +254,8 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! 7.) Vibrational energy of the molecules: Ensure energy conservation by scaling the new vibrational states with the factor alpha IF(ANY(SpecDSMC(:)%InterID.EQ.2).OR.ANY(SpecDSMC(:)%InterID.EQ.20)) THEN - ! = tbc ======= use TEqui ============================================================================================== - CALL EnergyConsVib(nPart, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRelaxVib, NewEnVib, OldEn, nXiVibDOF, VibEnergyDOF, & - CellTemp, EVibTtransSpecMean, Xi_VibRelSpec, Xi_vib_DOF) + CALL EnergyConsVib(nPart, totalWeight, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRelaxVib, NewEnVib, OldEn, nXiVibDOF, VibEnergyDOF, & + Xi_VibSpecNew, TEqui) END IF ! Remaining vibrational (+ translational) energy + rotational energy for translation and rotation @@ -266,7 +270,8 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! 8.) Determine the new particle state and ensure energy conservation by scaling the new velocities with the factor alpha ! Calculation of scaling factor alpha -alpha = SQRT(OldEn/NewEn*(3.*(nPart-1.))/(Xi_RotTotal+3.*(nPart-1.))) +! = tbd ======= nPart or totalWeight? ======================================================================================== +alpha = SQRT(OldEn/NewEn*(3.*(totalWeight-1.))/(Xi_RotTotal+3.*(totalWeight-1.))) ! Calculation of the final particle velocities with vBulkAll (average flow velocity before relaxation), scaling factor alpha, ! the particle velocity PartState(4:6,iPart) after the relaxation but before the energy conservation and vBulk (average value of ! the latter) @@ -284,8 +289,8 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! Calculate scaling factor alpha per species, see M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross- ! Krook method to diatomic molecules including quantized vibrational energies", Phys. Fluids 30, 116103 (2018) IF (NewEnRot(iSpec).GT.0.0) THEN - ! = tbd ======= nRotRelaxSpec or RotRelaxWeightSpec? ======================================================================= - alphaRot(iSpec) = OldEn/NewEnRot(iSpec)*(Xi_RotSpec(iSpec)*RotRelaxWeightSpec(iSpec)/(Xi_RotTotal+3.*(nPart-1.))) + ! = tbd ======= nRotRelaxSpec or RotRelaxWeightSpec? nPart or totalWeight? ================================================ + alphaRot(iSpec) = OldEn/NewEnRot(iSpec)*(Xi_RotSpec(iSpec)*RotRelaxWeightSpec(iSpec)/(Xi_RotTotal+3.*(totalWeight-1.))) !alphaRot(iSpec) = ERotTtransSpecMean(iSpec)*RotRelaxWeightSpec(iSpec)/NewEnRot(iSpec) ELSE alphaRot(iSpec) = 0.0 @@ -880,8 +885,8 @@ SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, END SUBROUTINE DetermineRelaxPart -SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeight, nPart, dtCell, CellTemp, TRotSpec, relaxfreq, rotrelaxfreqSpec, & - vibrelaxfreqSpec, ERotTtransSpecMean, EVibTtransSpecMean, Xi_VibRelSpec, Xi_vib_DOF, nXiVibDOF, CellTempRel, TEqui, betaR, betaV) +SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpec, totalWeight, nPart, dtCell, CellTemp, TRotSpec, TVibSpec, relaxfreq, rotrelaxfreqSpec, & + vibrelaxfreqSpec, Xi_VibSpecNew, Xi_vib_DOF, nXiVibDOF, CellTempRel, TEqui, betaR, betaV) !=================================================================================================================================== !> Calculate the relaxation energies and temperatures !=================================================================================================================================== @@ -896,28 +901,28 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT VARIABLES INTEGER, INTENT(IN) :: nPart, nXiVibDOF -REAL, INTENT(IN) :: TRotSpec(nSpecies), ERotSpec(nSpecies), Xi_RotSpec(nSpecies), EVibSpec(nSpecies) +REAL, INTENT(IN) :: TRotSpec(nSpecies), ERotSpec(nSpecies), Xi_RotSpec(nSpecies) +REAL, INTENT(IN) :: TVibSpec(nSpecies), EVibSpec(nSpecies), Xi_VibSpec(nSpecies) REAL, INTENT(IN) :: totalWeightSpec(nSpecies), totalWeight, CellTemp, dtCell REAL, INTENT(IN) :: relaxfreq, rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES -REAL, INTENT(OUT) :: ERotTtransSpecMean(nSpecies), EVibTtransSpecMean(nSpecies) -REAL, INTENT(OUT) :: Xi_VibRelSpec(nSpecies), Xi_vib_DOF(DSMC%NumPolyatomMolecs,nXiVibDOF), CellTempRel, TEqui +REAL, INTENT(OUT) :: Xi_vib_DOF(DSMC%NumPolyatomMolecs,nXiVibDOF), Xi_VibSpecNew(nSpecies), CellTempRel, TEqui REAL, INTENT(OUT) :: betaR(nSpecies), betaV(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES INTEGER :: iSpec, iDOF, iPolyatMole REAL :: RotFracSpec(nSpecies), VibFracSpec(nSpecies) -REAL :: ERotSpecMean(nSpecies), Xi_Rot_Spec(nSpecies), EVibSpecMean(nSpecies) -REAL :: EVibTtransPoly, TVibRelPoly, TVibRelSpecMean, ETransRelMean -REAL :: TEqui_Old, TEquiNum, TEquiDenom +REAL :: ERotSpecMean(nSpecies), EVibSpecMean(nSpecies), ERotTtransSpecMean(nSpecies), EVibTtransSpecMean(nSpecies) +REAL :: EVibTtransPoly, ETransRelMean!, TVibRelPoly, TVibRelSpecMean +REAL :: TEqui_Old, TEquiNum, TEquiDenom, exparg REAL :: eps_prec=1.0E-0 !=================================================================================================================================== ! According to J. Mathiaud et. al., "An ES-BGK model for diatomic gases with correct relaxation rates for internal energies", ! European Journal of Mechanics - B/Fluids, 96, pp. 65-77, 2022 RotFracSpec=0.0; VibFracSpec=0.0 -ERotSpecMean=0.0; ERotTtransSpecMean=0.0; EVibSpecMean=0.0; EVibTtransSpecMean=0.0; Xi_VibRelSpec=0.0; Xi_vib_DOF=0.0 +ERotSpecMean=0.0; ERotTtransSpecMean=0.0; EVibSpecMean=0.0; EVibTtransSpecMean=0.0; Xi_vib_DOF=0.0; Xi_VibSpecNew=0.0!; Xi_VibRelSpec=0.0 ETransRelMean=0.0; CellTempRel=0.0 DO iSpec = 1, nSpecies @@ -926,8 +931,6 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig ERotSpecMean(iSpec) = ERotSpec(iSpec)/totalWeightSpec(iSpec) ! Mean rotational energy per particle of a species for the mixture translational temperature, ERot(Ttrans) ERotTtransSpecMean(iSpec) = CellTemp * Xi_RotSpec(iSpec) * BoltzmannConst /2. - ! Rotational degrees of freedom of molecules - Xi_Rot_Spec(iSpec) = SpecDSMC(iSpec)%Xi_Rot ! Calculate number of rotational relaxing molecules RotFracSpec(iSpec) = totalWeightSpec(iSpec)*(rotrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell)) @@ -944,32 +947,31 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig (EXP(PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/CellTemp) - 1.) ! Mean vibrational energy per particle of a species for the mixture translational temperature, EVib(Ttrans) EVibTtransSpecMean(iSpec) = EVibTtransSpecMean(iSpec) + EVibTtransPoly - ! Mean vibrational temperature per DOF to satisfy the Landau-Teller equation - TVibRelPoly = EVibTtransPoly / (BoltzmannConst*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)) - IF (TVibRelPoly.GT.0.0) THEN - TVibRelPoly = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/LOG(1. + 1./TVibRelPoly) - ! Calculation of the vibrational degrees of freedom to satisfy the Landau-Teller equation - Xi_vib_DOF(iPolyatMole,iDOF) = 2.* EVibTtransPoly / (BoltzmannConst*TVibRelPoly) - ELSE - Xi_vib_DOF(iPolyatMole,iDOF) = 0.0 - END IF + ! ! Mean vibrational temperature per DOF to satisfy the Landau-Teller equation + ! TVibRelPoly = EVibTtransPoly / (BoltzmannConst*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)) + ! IF (TVibRelPoly.GT.0.0) THEN + ! TVibRelPoly = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/LOG(1. + 1./TVibRelPoly) + ! ! Calculation of the vibrational degrees of freedom to satisfy the Landau-Teller equation + ! Xi_vib_DOF(iPolyatMole,iDOF) = 2.* EVibTtransPoly / (BoltzmannConst*TVibRelPoly) + ! ELSE + ! Xi_vib_DOF(iPolyatMole,iDOF) = 0.0 + ! END IF END DO ELSE ! diatomic ! Mean vibrational energy per particle of a species for the mixture translational temperature, EVib(Ttrans) EVibTtransSpecMean(iSpec) = BoltzmannConst * SpecDSMC(iSpec)%CharaTVib / (EXP(SpecDSMC(iSpec)%CharaTVib/CellTemp) - 1.) - ! Mean vibrational temperature per particle of a species to satisfy the Landau-Teller equation - TVibRelSpecMean = EVibTtransSpecMean(iSpec) / (BoltzmannConst*SpecDSMC(iSpec)%CharaTVib) - IF (TVibRelSpecMean.GT.0.0) THEN - TVibRelSpecMean = SpecDSMC(iSpec)%CharaTVib/LOG(1. + 1./(TVibRelSpecMean)) - ! Calculation of the vibrational degrees of freedom to satisfy the Landau-Teller equation - Xi_VibRelSpec(iSpec) = 2.* EVibTtransSpecMean(iSpec) / (BoltzmannConst*TVibRelSpecMean) - ! No negative temperature possible - ELSE - Xi_VibRelSpec(iSpec) = 0.0 - END IF + ! ! Mean vibrational temperature per particle of a species to satisfy the Landau-Teller equation + ! TVibRelSpecMean = EVibTtransSpecMean(iSpec) / (BoltzmannConst*SpecDSMC(iSpec)%CharaTVib) + ! IF (TVibRelSpecMean.GT.0.0) THEN + ! TVibRelSpecMean = SpecDSMC(iSpec)%CharaTVib/LOG(1. + 1./(TVibRelSpecMean)) + ! ! Calculation of the vibrational degrees of freedom to satisfy the Landau-Teller equation + ! Xi_VibRelSpec(iSpec) = 2.* EVibTtransSpecMean(iSpec) / (BoltzmannConst*TVibRelSpecMean) + ! ! No negative temperature possible + ! ELSE + ! Xi_VibRelSpec(iSpec) = 0.0 + ! END IF END IF - ! Calculate number of vibrational relaxing molecules VibFracSpec(iSpec) = totalWeightSpec(iSpec)*(vibrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell)) END IF @@ -1001,9 +1003,8 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig ! Sum up over all species DO iSpec = 1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - ! - tbc ------ add vibration to calculation of TEqui ------------------------------------------------------------------------ - TEquiNum = TEquiNum + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) - TEquiDenom = TEquiDenom + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec) + TEquiNum = TEquiNum + Xi_RotSpec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) + Xi_VibSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) + TEquiDenom = TEquiDenom + Xi_RotSpec(iSpec)*RotFracSpec(iSpec) + Xi_VibSpec(iSpec)*VibFracSpec(iSpec) END IF END DO TEqui = TEquiNum/TEquiDenom @@ -1021,18 +1022,45 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig ! new calculation of number of rotational relaxing molecules with betaR RotFracSpec(iSpec) = totalWeightSpec(iSpec)*(rotrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell))*betaR(iSpec) END IF - ! IF(BGKDoVibRelaxation) - ! ! if difference small: equilibrium, no beta - ! IF (ABS(TVibSpec(iSpec)-TEqui).GT.1E-3) THEN - ! betaV(iSpec) = (TVibSpec(iSpec)-CellTemp)/(TVibSpec(iSpec)-TEqui) - ! IF (betaV(iSpec).LT.0.0) THEN - ! betaV(iSpec) = 1. - ! END IF - ! ! new calculation of number of rotational relaxing molecules - ! VibFracSpec(iSpec) = totalWeightSpec(iSpec)*(vibrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell))*betaV(iSpec) - ! END IF - ! END IF - ! ! new calculation of the vibrational degrees of freedom per species ----------------------------------------------------- + IF(BGKDoVibRelaxation) THEN + ! if difference small: equilibrium, no beta + IF (ABS(TVibSpec(iSpec)-TEqui).GT.1E-3) THEN + betaV(iSpec) = (TVibSpec(iSpec)-CellTemp)/(TVibSpec(iSpec)-TEqui) + IF (betaV(iSpec).LT.0.0) THEN + betaV(iSpec) = 1. + END IF + ! new calculation of number of rotational relaxing molecules + VibFracSpec(iSpec) = totalWeightSpec(iSpec)*(vibrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell))*betaV(iSpec) + END IF + + ! new calculation of the vibrational degrees of freedom per species + IF(SpecDSMC(iSpec)%PolyatomicMol) THEN + iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray + ! Loop over all vibrational degrees of freedom to calculate them using TEqui + DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF + exparg = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TEqui + ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom + IF(CHECKEXP(exparg))THEN + IF(exparg.gt.0.)THEN ! positive overflow: exp -> inf + Xi_vib_DOF(iSpec,iDOF) = 2.*exparg/(EXP(exparg)-1.) + ELSE ! negative overflow: exp -> 0 + Xi_vib_DOF(iSpec,iDOF) = 2.*exparg/(-1.) + END IF ! exparg.gt.0. + ELSE + Xi_vib_DOF(iSpec,iDOF) = 0.0 + END IF ! CHECKEXP(exparg) + END DO + Xi_VibSpecNew(iSpec) = SUM(Xi_vib_DOF(iSpec,1:PolyatomMolDSMC(iPolyatMole)%VibDOF)) + ELSE ! diatomic + exparg = SpecDSMC(iSpec)%CharaTVib/TEqui + ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom + IF(CHECKEXP(exparg))THEN + Xi_VibSpecNew(iSpec) = 2.*SpecDSMC(iSpec)%CharaTVib/TEqui/(EXP(exparg)-1.) + ELSE + Xi_VibSpecNew(iSpec) = 0.0 + END IF ! CHECKEXP(exparg) + END IF + END IF END IF END DO TEqui_Old = TEqui @@ -1042,16 +1070,64 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, EVibSpec, totalWeightSpec, totalWeig ! Sum up over all species DO iSpec = 1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - ! - tbc - add vibration to calculation of TEqui ----------------------------------------------------------------------------- - TEquiNum = TEquiNum + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) - TEquiDenom = TEquiDenom + Xi_Rot_Spec(iSpec)*RotFracSpec(iSpec) + TEquiNum = TEquiNum + Xi_RotSpec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) + Xi_VibSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) + TEquiDenom = TEquiDenom + Xi_RotSpec(iSpec)*RotFracSpec(iSpec) + Xi_VibSpecNew(iSpec)*VibFracSpec(iSpec) END IF END DO TEqui = TEquiNum/TEquiDenom - ! - tbc - additional round for VibDOF(TEqui) and then TEqui with BGKDoVibRelaxation ------------------------------------------- + IF(BGKDoVibRelaxation) THEN + ! accuracy eps_prec not reached yet + DO WHILE ( ABS( TEqui - TEqui_Old ) .GT. eps_prec ) + ! mean value of old and new equilibrium temperature + TEqui = (TEqui + TEqui_Old) * 0.5 + DO iSpec = 1, nSpecies + IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + ! new calculation of the vibrational degrees of freedom per species + IF(SpecDSMC(iSpec)%PolyatomicMol) THEN + iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray + ! Loop over all vibrational degrees of freedom to calculate them using TEqui + DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF + exparg = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TEqui + ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom + IF(CHECKEXP(exparg))THEN + IF(exparg.gt.0.)THEN ! positive overflow: exp -> inf + Xi_vib_DOF(iSpec,iDOF) = 2.*exparg/(EXP(exparg)-1.) + ELSE ! negative overflow: exp -> 0 + Xi_vib_DOF(iSpec,iDOF) = 2.*exparg/(-1.) + END IF ! exparg.gt.0. + ELSE + Xi_vib_DOF(iSpec,iDOF) = 0.0 + END IF ! CHECKEXP(exparg) + END DO + Xi_VibSpecNew(iSpec) = SUM(Xi_vib_DOF(iSpec,1:PolyatomMolDSMC(iPolyatMole)%VibDOF)) + ELSE ! diatomic + exparg = SpecDSMC(iSpec)%CharaTVib/TEqui + ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom + IF(CHECKEXP(exparg))THEN + Xi_VibSpecNew(iSpec) = 2.*SpecDSMC(iSpec)%CharaTVib/TEqui/(EXP(exparg)-1.) + ELSE + Xi_VibSpecNew(iSpec) = 0.0 + END IF ! CHECKEXP(exparg) + END IF + END IF + END DO + TEqui_Old = TEqui + ! new calculation of equilibrium temperature with new RotFracSpec, new VibFracSpec, new VibDOF(TEqui) in denominator + TEquiNum = 3.*(nPart-1.)*CellTemp + TEquiDenom = 3.*(nPart-1.) + ! Sum up over all species + DO iSpec = 1, nSpecies + IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + TEquiNum = TEquiNum + Xi_RotSpec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) + Xi_VibSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) + TEquiDenom = TEquiDenom + Xi_RotSpec(iSpec)*RotFracSpec(iSpec) + Xi_VibSpecNew(iSpec)*VibFracSpec(iSpec) + END IF + END DO + TEqui = TEquiNum/TEquiDenom + END DO + END IF END DO -! - tbc - kommentieren, Zeilenumbrüche, Subroutines tauschen ------------------------------------------------------------- +! - tbc - kommentieren, Zeilenumbrüche, Subroutines tauschen, wo werden welche Vib-Freiheitsgrade verwendet? --------------------- END SUBROUTINE CalcTRelax @@ -1278,8 +1354,8 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, END SUBROUTINE SampleFromTargetDistr -SUBROUTINE EnergyConsVib(nPart, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRelaxVib, NewEnVib, OldEn, nXiVibDOF, & - VibEnergyDOF, CellTemp, EVibTtransSpecMean, Xi_VibRelSpec, Xi_vib_DOF) +SUBROUTINE EnergyConsVib(nPart, totalWeight, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRelaxVib, NewEnVib, OldEn, nXiVibDOF, & + VibEnergyDOF, Xi_VibSpec, TEqui) !=================================================================================================================================== !> Routine to ensure energy conservation when including vibrational degrees of freedom (continuous and quantized) !=================================================================================================================================== @@ -1293,17 +1369,17 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRel IMPLICIT NONE !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT VARIABLES -INTEGER, INTENT(IN) :: nPart,nXiVibDOF +INTEGER, INTENT(IN) :: nPart, nXiVibDOF INTEGER, INTENT(IN) :: nVibRelax, iPartIndx_NodeRelaxVib(nPart) -REAL, INTENT(IN) :: VibRelaxWeightSpec(nSpecies), Xi_VibRelSpec(nSpecies), Xi_vib_DOF(DSMC%NumPolyatomMolecs,nXiVibDOF) -REAL, INTENT(IN) :: NewEnVib(nSpecies), VibEnergyDOF(nVibRelax,nXiVibDOF), CellTemp, EVibTtransSpecMean(nSpecies) +REAL, INTENT(IN) :: VibRelaxWeightSpec(nSpecies), Xi_VibSpec(nSpecies), totalWeight +REAL, INTENT(IN) :: NewEnVib(nSpecies), VibEnergyDOF(nVibRelax,nXiVibDOF), TEqui!, EVibTtransSpecMean(nSpecies) REAL, INTENT(INOUT) :: OldEn !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES INTEGER :: iPart, iLoop, iDOF, iSpec, iQuant, iQuaMax, iPolyatMole -REAL :: Xi_VibSpec(nSpecies), Xi_VibTotal, alpha(nSpecies), partWeight, betaV, iRan, MaxColQua +REAL :: Xi_VibTotal, alpha(nSpecies), partWeight, betaV, iRan, MaxColQua !=================================================================================================================================== ! According to M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules ! including quantized vibrational energies", Phys. Fluids 30, 116103 (2018) @@ -1313,21 +1389,14 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRel Xi_VibTotal = 0.0 DO iSpec = 1, nSpecies ! Total number of relaxing vibrational degrees of freedom - ! = tbd ======= nVibRelaxSpec or VibRelaxWeightSpec? ======================================================================= - ! = tbc ======= Xi_VibSpec as output of TEqui ============================================================================== - IF(SpecDSMC(iSpec)%PolyatomicMol) THEN ! polyatomic - iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray - Xi_VibSpec(iSpec) = SUM(Xi_vib_DOF(iPolyatMole,:)) - ELSE - Xi_VibSpec(iSpec) = Xi_VibRelSpec(iSpec) - END IF + ! = tbd ======= nVibRelaxSpec or VibRelaxWeightSpec? nPart or totalWeight for alpha? ======================================= Xi_VibTotal = Xi_VibTotal + Xi_VibSpec(iSpec)*VibRelaxWeightSpec(iSpec) END DO ! Calculate scaling factor alpha per species ! EVibTtransSpecMean(iSpec)*VibRelaxWeightSpec(iSpec) is energy that should be in vibration DO iSpec = 1, nSpecies IF (NewEnVib(iSpec).GT.0.0) THEN - alpha(iSpec) = OldEn/NewEnVib(iSpec)*(Xi_VibSpec(iSpec)*VibRelaxWeightSpec(iSpec)/(3.*(nPart-1.)+Xi_VibTotal)) + alpha(iSpec) = OldEn/NewEnVib(iSpec)*(Xi_VibSpec(iSpec)*VibRelaxWeightSpec(iSpec)/(3.*(totalWeight-1.)+Xi_VibTotal)) !alpha(iSpec) = EVibTtransSpecMean(iSpec)*VibRelaxWeightSpec(iSpec)/NewEnVib(iSpec) ELSE alpha(iSpec) = 0. @@ -1361,13 +1430,13 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRel ELSE CALL RANDOM_NUMBER(iRan) ! Calculation of new iQuant - iQuant = INT(-LOG(iRan)*CellTemp/PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)) + iQuant = INT(-LOG(iRan)*TEqui/PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)) ! Determine maximum quantum number iQuaMax = MIN(INT(MaxColQua)+1, PolyatomMolDSMC(iPolyatMole)%MaxVibQuantDOF(iDOF)) ! Calculation of new iQuant as long as iQuant > maximum quantum number DO WHILE (iQuant.GE.iQuaMax) CALL RANDOM_NUMBER(iRan) - iQuant = INT(-LOG(iRan)*CellTemp/PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)) + iQuant = INT(-LOG(iRan)*TEqui/PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)) END DO END IF END IF @@ -1379,8 +1448,7 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRel OldEn = OldEn - iQuant*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)*BoltzmannConst*partWeight END DO ! Add zero-point energy - PartStateIntEn( 1,iPart) = PartStateIntEn( 1,iPart) & - + SpecDSMC(iSpec)%EZeroPoint + PartStateIntEn( 1,iPart) = PartStateIntEn( 1,iPart) + SpecDSMC(iSpec)%EZeroPoint ELSE ! Diatomic molecules ! Vibrational energy is reformulated to a quantum number iQuant betaV = alpha(iSpec)*PartStateIntEn( 1,iPart)/(SpecDSMC(iSpec)%CharaTVib*BoltzmannConst) @@ -1399,13 +1467,13 @@ SUBROUTINE EnergyConsVib(nPart, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRel ELSE CALL RANDOM_NUMBER(iRan) ! Calculation of new iQuant - iQuant = INT(-LOG(iRan)*CellTemp/SpecDSMC(iSpec)%CharaTVib) + iQuant = INT(-LOG(iRan)*TEqui/SpecDSMC(iSpec)%CharaTVib) ! Determine maximum quantum number iQuaMax = MIN(INT(MaxColQua)+1, SpecDSMC(iSpec)%MaxVibQuant) ! Calculation of new iQuant as long as iQuant > maximum quantum number DO WHILE (iQuant.GE.iQuaMax) CALL RANDOM_NUMBER(iRan) - iQuant = INT(-LOG(iRan)*CellTemp/SpecDSMC(iSpec)%CharaTVib) + iQuant = INT(-LOG(iRan)*TEqui/SpecDSMC(iSpec)%CharaTVib) END DO END IF ! Calculate vibrational energy including zero-point energy From fa0a9d9e89e289c6d07d2a509b421fe1c5a140a0 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Fri, 21 Apr 2023 13:10:05 +0200 Subject: [PATCH 24/41] BGK Colloperator small clean-up --- src/particles/bgk/bgk_colloperator.f90 | 228 +++++++++++++------------ 1 file changed, 116 insertions(+), 112 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 0112d9bcf..960623610 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -93,7 +93,8 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal REAL :: ERotSpec(nSpecies), Xi_RotSpec(nSpecies), Xi_RotTotal REAL :: CellTempRel, TEqui REAL :: TVibSpec(nSpecies), TRotSpec(nSpecies), VibRelaxWeightSpec(nSpecies), RotRelaxWeightSpec(nSpecies) -REAL :: collisionfreqSpec(nSpecies),rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies), betaR(nSpecies), betaV(nSpecies) +REAL :: collisionfreqSpec(nSpecies), rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies) +REAL :: betaR(nSpecies), betaV(nSpecies) !=================================================================================================================================== #ifdef CODE_ANALYZE ! Momentum and energy conservation check: summing up old values @@ -184,7 +185,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal END IF END IF -! 4.) Determine the relaxation temperatures as well as the number of particles undergoing a relaxation (including vibration and rotation) +! 4.) Determine the relaxation temperatures and the number of particles undergoing a relaxation (including vibration + rotation) ALLOCATE(iPartIndx_NodeRelax(nPart), iPartIndx_NodeRelaxTemp(nPart)) iPartIndx_NodeRelax = 0; iPartIndx_NodeRelaxTemp = 0 ALLOCATE(iPartIndx_NodeRelaxRot(nPart),iPartIndx_NodeRelaxVib(nPart)) @@ -198,8 +199,8 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal END IF END IF -CALL CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpec, totalWeight, nPart, dtCell, CellTemp, TRotSpec, TVibSpec, relaxfreq, rotrelaxfreqSpec, & - vibrelaxfreqSpec, Xi_VibSpecNew, Xi_vib_DOF, nXiVibDOF, CellTempRel, TEqui, betaR, betaV) +CALL CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpec, totalWeight, nPart, dtCell, CellTemp, TRotSpec, & + TVibSpec, relaxfreq, rotrelaxfreqSpec, vibrelaxfreqSpec, Xi_VibSpecNew, Xi_vib_DOF, nXiVibDOF, CellTempRel, TEqui, betaR, betaV) CALL DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, nRotRelax, nVibRelax, & RotRelaxWeightSpec, VibRelaxWeightSpec, iPartIndx_NodeRelax, iPartIndx_NodeRelaxTemp, iPartIndx_NodeRelaxRot, & @@ -254,8 +255,8 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! 7.) Vibrational energy of the molecules: Ensure energy conservation by scaling the new vibrational states with the factor alpha IF(ANY(SpecDSMC(:)%InterID.EQ.2).OR.ANY(SpecDSMC(:)%InterID.EQ.20)) THEN - CALL EnergyConsVib(nPart, totalWeight, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRelaxVib, NewEnVib, OldEn, nXiVibDOF, VibEnergyDOF, & - Xi_VibSpecNew, TEqui) + CALL EnergyConsVib(nPart, totalWeight, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRelaxVib, NewEnVib, OldEn, nXiVibDOF, & + VibEnergyDOF, Xi_VibSpecNew, TEqui) END IF ! Remaining vibrational (+ translational) energy + rotational energy for translation and rotation @@ -789,104 +790,8 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight END SUBROUTINE CalcGasProperties -SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, nRotRelax, nVibRelax, & - RotRelaxWeightSpec, VibRelaxWeightSpec, iPartIndx_NodeRelax, iPartIndx_NodeRelaxTemp, iPartIndx_NodeRelaxRot, & - iPartIndx_NodeRelaxVib, vBulk, OldEnRot, OldEn, rotrelaxfreqSpec, vibrelaxfreqSpec, betaR, betaV) -!=================================================================================================================================== -!> Determine the number of particles undergoing a relaxation (including vibration and rotation) -!=================================================================================================================================== -! MODULES -USE MOD_Particle_Vars ,ONLY: Species, PartSpecies, PartState, nSpecies -USE MOD_DSMC_Vars ,ONLY: SpecDSMC, PartStateIntEn -USE MOD_BGK_Vars ,ONLY: BGKDoVibRelaxation -USE MOD_part_tools ,ONLY: GetParticleWeight -! IMPLICIT VARIABLE HANDLING - IMPLICIT NONE -!----------------------------------------------------------------------------------------------------------------------------------- -! INPUT VARIABLES -INTEGER, INTENT(IN) :: nPart, iPartIndx_Node(nPart) -REAL, INTENT(IN) :: relaxfreq, dtCell, rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies), betaR(nSpecies), betaV(nSpecies) -!----------------------------------------------------------------------------------------------------------------------------------- -! OUTPUT VARIABLES -INTEGER, INTENT(OUT) :: iPartIndx_NodeRelax(:), iPartIndx_NodeRelaxTemp(:) -INTEGER, INTENT(OUT) :: iPartIndx_NodeRelaxRot(:), iPartIndx_NodeRelaxVib(:) -INTEGER, INTENT(OUT) :: nRelax, nRotRelax, nVibRelax -REAL, INTENT(OUT) :: vBulk(3), OldEnRot, RotRelaxWeightSpec(nSpecies), VibRelaxWeightSpec(nSpecies) -!----------------------------------------------------------------------------------------------------------------------------------- -! INPUT-OUTPUT VARIABLES -REAL, INTENT(INOUT) :: OldEn -!----------------------------------------------------------------------------------------------------------------------------------- -! LOCAL VARIABLES -INTEGER :: iPart, iSpec, iLoop, iPick, iLoopRot, iLoopVib -REAL :: ProbAddPartTrans, iRan, partWeight, ProbAddPartRot, ProbAddPartVib -!=================================================================================================================================== -VibRelaxWeightSpec =0; RotRelaxWeightSpec =0; nRelax=0; vBulk=0.0; nRotRelax=0; nVibRelax=0; OldEnRot=0.0 -iLoopRot=1; iLoopVib=1 -! Calculate probability of relaxation of a particle towards the target distribution function -ProbAddPartTrans = 1.-EXP(-relaxfreq*dtCell) -CALL RANDOM_NUMBER(iRan) -! Calculate the number of relaxing particles -nRelax = INT(REAL(nPart) * ProbAddPartTrans + iRan) -! List of non-relaxing particles -iPartIndx_NodeRelaxTemp(:) = iPartIndx_Node(:) -! Relaxing particles -DO iLoop = 1, nRelax - CALL RANDOM_NUMBER(iRan) - iPick = INT(iRan * (nPart-iLoop+1)) + 1 - iPart = iPartIndx_NodeRelaxTemp(iPick) - partWeight = GetParticleWeight(iPart) - iSpec = PartSpecies(iPart) - iPartIndx_NodeRelax(iLoop) = iPart - iPartIndx_NodeRelaxTemp(iPick) = iPartIndx_NodeRelaxTemp(nPart-iLoop+1) - ! For molecules: relaxation of inner DOF - IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - ! Rotation - CALL RANDOM_NUMBER(iRan) - ! Calculate probability of rotational relaxation of a particle that relaxes towards the target distribution function - ProbAddPartRot = rotrelaxfreqSpec(iSpec)/relaxfreq*betaR(iSpec) - IF (ProbAddPartRot.GT.iRan) THEN - ! relaxation - iPartIndx_NodeRelaxRot(iLoopRot) = iPartIndx_NodeRelax(iLoop) - nRotRelax = nRotRelax + 1 - iLoopRot = iLoopRot + 1 - RotRelaxWeightSpec(iSpec) = RotRelaxWeightSpec(iSpec) + partWeight - ! Sum up total rotational energy - OldEnRot = OldEnRot + PartStateIntEn(2,iPart) * partWeight - END IF - ! Vibration - IF(BGKDoVibRelaxation) THEN - CALL RANDOM_NUMBER(iRan) - ! Calculate probability of vibrational relaxation of a particle that relaxes towards the target distribution function - ProbAddPartVib = vibrelaxfreqSpec(iSpec)/relaxfreq*betaV(iSpec) - IF (ProbAddPartVib.GT.iRan) THEN - ! relaxation - iPartIndx_NodeRelaxVib(iLoopVib) = iPartIndx_NodeRelax(iLoop) - nVibRelax = nVibRelax + 1 - VibRelaxWeightSpec(iSpec) = VibRelaxWeightSpec(iSpec) + partWeight - ! Sum up total vibrational energy of all relaxing particles, considering zero-point energy, and add to translational energy - OldEn = OldEn + (PartStateIntEn(1,iPartIndx_NodeRelaxVib(iLoopVib)) - SpecDSMC(iSpec)%EZeroPoint) * partWeight - iLoopVib = iLoopVib + 1 - END IF - END IF - END IF -END DO - -! Non-relaxing particles -! nNonRelax = nPart-nRelax -DO iLoop = 1, nPart-nRelax - iPart = iPartIndx_NodeRelaxTemp(iLoop) - partWeight = GetParticleWeight(iPart) - iSpec = PartSpecies(iPart) - ! iPartIndx_NodeNonRelax(iLoop) - ! Sum up velocities of non-relaxing particles for bulk velocity - vBulk(1:3) = vBulk(1:3) + PartState(4:6,iPart)*Species(iSpec)%MassIC*partWeight -END DO - -END SUBROUTINE DetermineRelaxPart - - -SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpec, totalWeight, nPart, dtCell, CellTemp, TRotSpec, TVibSpec, relaxfreq, rotrelaxfreqSpec, & - vibrelaxfreqSpec, Xi_VibSpecNew, Xi_vib_DOF, nXiVibDOF, CellTempRel, TEqui, betaR, betaV) +SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpec, totalWeight, nPart, dtCell, CellTemp, TRotSpec, & + TVibSpec, relaxfreq, rotrelaxfreqSpec, vibrelaxfreqSpec, Xi_VibSpecNew, Xi_vib_DOF, nXiVibDOF, CellTempRel, TEqui, betaR, betaV) !=================================================================================================================================== !> Calculate the relaxation energies and temperatures !=================================================================================================================================== @@ -913,8 +818,8 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe ! LOCAL VARIABLES INTEGER :: iSpec, iDOF, iPolyatMole REAL :: RotFracSpec(nSpecies), VibFracSpec(nSpecies) -REAL :: ERotSpecMean(nSpecies), EVibSpecMean(nSpecies), ERotTtransSpecMean(nSpecies), EVibTtransSpecMean(nSpecies) -REAL :: EVibTtransPoly, ETransRelMean!, TVibRelPoly, TVibRelSpecMean +REAL :: ERotSpecMean(nSpecies), EVibSpecMean(nSpecies), EVibTtransPoly, ETransRelMean +REAL :: ERotTtransSpecMean(nSpecies), EVibTtransSpecMean(nSpecies) REAL :: TEqui_Old, TEquiNum, TEquiDenom, exparg REAL :: eps_prec=1.0E-0 !=================================================================================================================================== @@ -922,7 +827,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe ! European Journal of Mechanics - B/Fluids, 96, pp. 65-77, 2022 RotFracSpec=0.0; VibFracSpec=0.0 -ERotSpecMean=0.0; ERotTtransSpecMean=0.0; EVibSpecMean=0.0; EVibTtransSpecMean=0.0; Xi_vib_DOF=0.0; Xi_VibSpecNew=0.0!; Xi_VibRelSpec=0.0 +ERotSpecMean=0.0; ERotTtransSpecMean=0.0; EVibSpecMean=0.0; EVibTtransSpecMean=0.0; Xi_vib_DOF=0.0; Xi_VibSpecNew=0.0 ETransRelMean=0.0; CellTempRel=0.0 DO iSpec = 1, nSpecies @@ -975,6 +880,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe ! Calculate number of vibrational relaxing molecules VibFracSpec(iSpec) = totalWeightSpec(iSpec)*(vibrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell)) END IF +! - tbd - Calculation xi necessary here? ----------------------------------------------------------------------------- ! Mean translational energy per particle to satisfy the Landau-Teller equation ETransRelMean = ETransRelMean + (3./2. * BoltzmannConst * CellTemp - (rotrelaxfreqSpec(iSpec)/relaxfreq) * & @@ -1003,7 +909,8 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe ! Sum up over all species DO iSpec = 1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - TEquiNum = TEquiNum + Xi_RotSpec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) + Xi_VibSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) + TEquiNum = TEquiNum + Xi_RotSpec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) + & + Xi_VibSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) TEquiDenom = TEquiDenom + Xi_RotSpec(iSpec)*RotFracSpec(iSpec) + Xi_VibSpec(iSpec)*VibFracSpec(iSpec) END IF END DO @@ -1070,7 +977,8 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe ! Sum up over all species DO iSpec = 1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - TEquiNum = TEquiNum + Xi_RotSpec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) + Xi_VibSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) + TEquiNum = TEquiNum + Xi_RotSpec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) + & + Xi_VibSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) TEquiDenom = TEquiDenom + Xi_RotSpec(iSpec)*RotFracSpec(iSpec) + Xi_VibSpecNew(iSpec)*VibFracSpec(iSpec) END IF END DO @@ -1118,7 +1026,8 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe ! Sum up over all species DO iSpec = 1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - TEquiNum = TEquiNum + Xi_RotSpec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) + Xi_VibSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) + TEquiNum = TEquiNum + Xi_RotSpec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) + & + Xi_VibSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) TEquiDenom = TEquiDenom + Xi_RotSpec(iSpec)*RotFracSpec(iSpec) + Xi_VibSpecNew(iSpec)*VibFracSpec(iSpec) END IF END DO @@ -1127,11 +1036,106 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe END IF END DO -! - tbc - kommentieren, Zeilenumbrüche, Subroutines tauschen, wo werden welche Vib-Freiheitsgrade verwendet? --------------------- - END SUBROUTINE CalcTRelax +SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, nRotRelax, nVibRelax, & + RotRelaxWeightSpec, VibRelaxWeightSpec, iPartIndx_NodeRelax, iPartIndx_NodeRelaxTemp, iPartIndx_NodeRelaxRot, & + iPartIndx_NodeRelaxVib, vBulk, OldEnRot, OldEn, rotrelaxfreqSpec, vibrelaxfreqSpec, betaR, betaV) +!=================================================================================================================================== +!> Determine the number of particles undergoing a relaxation (including vibration and rotation) +!=================================================================================================================================== +! MODULES +USE MOD_Particle_Vars ,ONLY: Species, PartSpecies, PartState, nSpecies +USE MOD_DSMC_Vars ,ONLY: SpecDSMC, PartStateIntEn +USE MOD_BGK_Vars ,ONLY: BGKDoVibRelaxation +USE MOD_part_tools ,ONLY: GetParticleWeight +! IMPLICIT VARIABLE HANDLING + IMPLICIT NONE +!----------------------------------------------------------------------------------------------------------------------------------- +! INPUT VARIABLES +INTEGER, INTENT(IN) :: nPart, iPartIndx_Node(nPart) +REAL, INTENT(IN) :: relaxfreq, dtCell, rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies) +REAL, INTENT(IN) :: betaR(nSpecies), betaV(nSpecies) +!----------------------------------------------------------------------------------------------------------------------------------- +! OUTPUT VARIABLES +INTEGER, INTENT(OUT) :: iPartIndx_NodeRelax(:), iPartIndx_NodeRelaxTemp(:) +INTEGER, INTENT(OUT) :: iPartIndx_NodeRelaxRot(:), iPartIndx_NodeRelaxVib(:) +INTEGER, INTENT(OUT) :: nRelax, nRotRelax, nVibRelax +REAL, INTENT(OUT) :: vBulk(3), OldEnRot, RotRelaxWeightSpec(nSpecies), VibRelaxWeightSpec(nSpecies) +!----------------------------------------------------------------------------------------------------------------------------------- +! INPUT-OUTPUT VARIABLES +REAL, INTENT(INOUT) :: OldEn +!----------------------------------------------------------------------------------------------------------------------------------- +! LOCAL VARIABLES +INTEGER :: iPart, iSpec, iLoop, iPick, iLoopRot, iLoopVib +REAL :: ProbAddPartTrans, iRan, partWeight, ProbAddPartRot, ProbAddPartVib +!=================================================================================================================================== +VibRelaxWeightSpec =0; RotRelaxWeightSpec =0; nRelax=0; vBulk=0.0; nRotRelax=0; nVibRelax=0; OldEnRot=0.0 +iLoopRot=1; iLoopVib=1 +! Calculate probability of relaxation of a particle towards the target distribution function +ProbAddPartTrans = 1.-EXP(-relaxfreq*dtCell) +CALL RANDOM_NUMBER(iRan) +! Calculate the number of relaxing particles +nRelax = INT(REAL(nPart) * ProbAddPartTrans + iRan) +! List of non-relaxing particles +iPartIndx_NodeRelaxTemp(:) = iPartIndx_Node(:) +! Relaxing particles +DO iLoop = 1, nRelax + CALL RANDOM_NUMBER(iRan) + iPick = INT(iRan * (nPart-iLoop+1)) + 1 + iPart = iPartIndx_NodeRelaxTemp(iPick) + partWeight = GetParticleWeight(iPart) + iSpec = PartSpecies(iPart) + iPartIndx_NodeRelax(iLoop) = iPart + iPartIndx_NodeRelaxTemp(iPick) = iPartIndx_NodeRelaxTemp(nPart-iLoop+1) + ! For molecules: relaxation of inner DOF + IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN + ! Rotation + CALL RANDOM_NUMBER(iRan) + ! Calculate probability of rotational relaxation of a particle that relaxes towards the target distribution function + ProbAddPartRot = rotrelaxfreqSpec(iSpec)/relaxfreq*betaR(iSpec) + IF (ProbAddPartRot.GT.iRan) THEN + ! relaxation + iPartIndx_NodeRelaxRot(iLoopRot) = iPartIndx_NodeRelax(iLoop) + nRotRelax = nRotRelax + 1 + iLoopRot = iLoopRot + 1 + RotRelaxWeightSpec(iSpec) = RotRelaxWeightSpec(iSpec) + partWeight + ! Sum up total rotational energy + OldEnRot = OldEnRot + PartStateIntEn(2,iPart) * partWeight + END IF + ! Vibration + IF(BGKDoVibRelaxation) THEN + CALL RANDOM_NUMBER(iRan) + ! Calculate probability of vibrational relaxation of a particle that relaxes towards the target distribution function + ProbAddPartVib = vibrelaxfreqSpec(iSpec)/relaxfreq*betaV(iSpec) + IF (ProbAddPartVib.GT.iRan) THEN + ! relaxation + iPartIndx_NodeRelaxVib(iLoopVib) = iPartIndx_NodeRelax(iLoop) + nVibRelax = nVibRelax + 1 + VibRelaxWeightSpec(iSpec) = VibRelaxWeightSpec(iSpec) + partWeight + ! Sum up total vibrational energy of all relaxing particles, considering zero-point energy, and add to translational energy + OldEn = OldEn + (PartStateIntEn(1,iPartIndx_NodeRelaxVib(iLoopVib)) - SpecDSMC(iSpec)%EZeroPoint) * partWeight + iLoopVib = iLoopVib + 1 + END IF + END IF + END IF +END DO + +! Non-relaxing particles +! nNonRelax = nPart-nRelax +DO iLoop = 1, nPart-nRelax + iPart = iPartIndx_NodeRelaxTemp(iLoop) + partWeight = GetParticleWeight(iPart) + iSpec = PartSpecies(iPart) + ! iPartIndx_NodeNonRelax(iLoop) + ! Sum up velocities of non-relaxing particles for bulk velocity + vBulk(1:3) = vBulk(1:3) + PartState(4:6,iPart)*Species(iSpec)%MassIC*partWeight +END DO + +END SUBROUTINE DetermineRelaxPart + + SUBROUTINE RelaxInnerEnergy(nVibRelax, nRotRelax, iPartIndx_NodeRelaxVib, iPartIndx_NodeRelaxRot, nXiVibDOF, Xi_vib_DOF, & Xi_VibSpec, Xi_RotSpec, VibEnergyDOF, TEqui, NewEnVib, NewEnRot) !=================================================================================================================================== From d626483a0f1bd6436da05aa7db24bda0f1e946ce Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Fri, 21 Apr 2023 16:13:17 +0200 Subject: [PATCH 25/41] BGK calculation TEqui correction of do while --- src/particles/bgk/bgk_colloperator.f90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 960623610..10e7e4490 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -820,8 +820,8 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe REAL :: RotFracSpec(nSpecies), VibFracSpec(nSpecies) REAL :: ERotSpecMean(nSpecies), EVibSpecMean(nSpecies), EVibTtransPoly, ETransRelMean REAL :: ERotTtransSpecMean(nSpecies), EVibTtransSpecMean(nSpecies) -REAL :: TEqui_Old, TEquiNum, TEquiDenom, exparg -REAL :: eps_prec=1.0E-0 +REAL :: TEqui_Old, TEqui_Old2, TEquiNum, TEquiDenom, exparg +REAL :: eps_prec=1.0E-1 !=================================================================================================================================== ! According to J. Mathiaud et. al., "An ES-BGK model for diatomic gases with correct relaxation rates for internal energies", ! European Journal of Mechanics - B/Fluids, 96, pp. 65-77, 2022 @@ -880,7 +880,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe ! Calculate number of vibrational relaxing molecules VibFracSpec(iSpec) = totalWeightSpec(iSpec)*(vibrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell)) END IF -! - tbd - Calculation xi necessary here? ----------------------------------------------------------------------------- + ! - tbd - Calculation xi necessary here? ----------------------------------------------------------------------------- ! Mean translational energy per particle to satisfy the Landau-Teller equation ETransRelMean = ETransRelMean + (3./2. * BoltzmannConst * CellTemp - (rotrelaxfreqSpec(iSpec)/relaxfreq) * & @@ -971,6 +971,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe END IF END DO TEqui_Old = TEqui + TEqui_Old2 = TEqui ! new calculation of equilibrium temperature with new RotFracSpec, new VibFracSpec, new VibDOF(TEqui) in denominator TEquiNum = 3.*(nPart-1.)*CellTemp TEquiDenom = 3.*(nPart-1.) @@ -985,9 +986,9 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe TEqui = TEquiNum/TEquiDenom IF(BGKDoVibRelaxation) THEN ! accuracy eps_prec not reached yet - DO WHILE ( ABS( TEqui - TEqui_Old ) .GT. eps_prec ) + DO WHILE ( ABS( TEqui - TEqui_Old2 ) .GT. eps_prec ) ! mean value of old and new equilibrium temperature - TEqui = (TEqui + TEqui_Old) * 0.5 + TEqui = (TEqui + TEqui_Old2) * 0.5 DO iSpec = 1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN ! new calculation of the vibrational degrees of freedom per species @@ -1019,7 +1020,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe END IF END IF END DO - TEqui_Old = TEqui + TEqui_Old2 = TEqui ! new calculation of equilibrium temperature with new RotFracSpec, new VibFracSpec, new VibDOF(TEqui) in denominator TEquiNum = 3.*(nPart-1.)*CellTemp TEquiDenom = 3.*(nPart-1.) From 3c167d43020ba838140749c8b8d1f1c2898bf7a3 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Wed, 26 Apr 2023 14:23:12 +0200 Subject: [PATCH 26/41] BGK relax Mathiaud - small clean up and bug fix sampling (testing tbc) --- src/particles/bgk/bgk_colloperator.f90 | 95 ++++++++++---------------- 1 file changed, 36 insertions(+), 59 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 10e7e4490..525365aee 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -572,7 +572,7 @@ SUBROUTINE DoAveraging(dens, u2, u0ij, u2i, CellTemp, AverageValues) dens = AverageValues(1) u2 = AverageValues(2) END IF - CellTemp = Species(1)%MassIC * u2 / (3.0*BoltzmannConst) +CellTemp = Species(1)%MassIC * u2 / (3.0*BoltzmannConst) END SUBROUTINE DoAveraging @@ -818,17 +818,16 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe ! LOCAL VARIABLES INTEGER :: iSpec, iDOF, iPolyatMole REAL :: RotFracSpec(nSpecies), VibFracSpec(nSpecies) -REAL :: ERotSpecMean(nSpecies), EVibSpecMean(nSpecies), EVibTtransPoly, ETransRelMean +REAL :: ERotSpecMean(nSpecies), EVibSpecMean(nSpecies), ETransRelMean REAL :: ERotTtransSpecMean(nSpecies), EVibTtransSpecMean(nSpecies) REAL :: TEqui_Old, TEqui_Old2, TEquiNum, TEquiDenom, exparg -REAL :: eps_prec=1.0E-1 +REAL :: eps_prec=1.0E-0 !=================================================================================================================================== ! According to J. Mathiaud et. al., "An ES-BGK model for diatomic gases with correct relaxation rates for internal energies", ! European Journal of Mechanics - B/Fluids, 96, pp. 65-77, 2022 -RotFracSpec=0.0; VibFracSpec=0.0 -ERotSpecMean=0.0; ERotTtransSpecMean=0.0; EVibSpecMean=0.0; EVibTtransSpecMean=0.0; Xi_vib_DOF=0.0; Xi_VibSpecNew=0.0 -ETransRelMean=0.0; CellTempRel=0.0 +RotFracSpec=0.0; VibFracSpec=0.0; Xi_vib_DOF=0.0; Xi_VibSpecNew=0.0; betaR=1.0; betaV=1.0 +ERotSpecMean=0.0; ERotTtransSpecMean=0.0; EVibSpecMean=0.0; EVibTtransSpecMean=0.0; ETransRelMean=0.0; CellTempRel=0.0 DO iSpec = 1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN ! molecules @@ -842,45 +841,21 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe IF(BGKDoVibRelaxation) THEN ! Mean vibrational energy per particle of a species EVibSpecMean(iSpec) = EVibSpec(iSpec)/totalWeightSpec(iSpec) - IF(SpecDSMC(iSpec)%PolyatomicMol) THEN ! polyatomic iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray ! Loop over all vibrational DOF DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF - ! Mean vibrational energy per DOF for the mixture translational temperature, EVib(Ttrans) - EVibTtransPoly = BoltzmannConst * PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF) / & - (EXP(PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/CellTemp) - 1.) ! Mean vibrational energy per particle of a species for the mixture translational temperature, EVib(Ttrans) - EVibTtransSpecMean(iSpec) = EVibTtransSpecMean(iSpec) + EVibTtransPoly - ! ! Mean vibrational temperature per DOF to satisfy the Landau-Teller equation - ! TVibRelPoly = EVibTtransPoly / (BoltzmannConst*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)) - ! IF (TVibRelPoly.GT.0.0) THEN - ! TVibRelPoly = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/LOG(1. + 1./TVibRelPoly) - ! ! Calculation of the vibrational degrees of freedom to satisfy the Landau-Teller equation - ! Xi_vib_DOF(iPolyatMole,iDOF) = 2.* EVibTtransPoly / (BoltzmannConst*TVibRelPoly) - ! ELSE - ! Xi_vib_DOF(iPolyatMole,iDOF) = 0.0 - ! END IF + EVibTtransSpecMean(iSpec) = EVibTtransSpecMean(iSpec) + BoltzmannConst*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF) / & + (EXP(PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/CellTemp) - 1.) END DO - ELSE ! diatomic ! Mean vibrational energy per particle of a species for the mixture translational temperature, EVib(Ttrans) EVibTtransSpecMean(iSpec) = BoltzmannConst * SpecDSMC(iSpec)%CharaTVib / (EXP(SpecDSMC(iSpec)%CharaTVib/CellTemp) - 1.) - ! ! Mean vibrational temperature per particle of a species to satisfy the Landau-Teller equation - ! TVibRelSpecMean = EVibTtransSpecMean(iSpec) / (BoltzmannConst*SpecDSMC(iSpec)%CharaTVib) - ! IF (TVibRelSpecMean.GT.0.0) THEN - ! TVibRelSpecMean = SpecDSMC(iSpec)%CharaTVib/LOG(1. + 1./(TVibRelSpecMean)) - ! ! Calculation of the vibrational degrees of freedom to satisfy the Landau-Teller equation - ! Xi_VibRelSpec(iSpec) = 2.* EVibTtransSpecMean(iSpec) / (BoltzmannConst*TVibRelSpecMean) - ! ! No negative temperature possible - ! ELSE - ! Xi_VibRelSpec(iSpec) = 0.0 - ! END IF END IF ! Calculate number of vibrational relaxing molecules VibFracSpec(iSpec) = totalWeightSpec(iSpec)*(vibrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell)) END IF - ! - tbd - Calculation xi necessary here? ----------------------------------------------------------------------------- ! Mean translational energy per particle to satisfy the Landau-Teller equation ETransRelMean = ETransRelMean + (3./2. * BoltzmannConst * CellTemp - (rotrelaxfreqSpec(iSpec)/relaxfreq) * & @@ -947,8 +922,8 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF exparg = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TEqui ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom - IF(CHECKEXP(exparg))THEN - IF(exparg.gt.0.)THEN ! positive overflow: exp -> inf + IF(CHECKEXP(exparg)) THEN + IF(exparg.gt.0.) THEN ! positive overflow: exp -> inf Xi_vib_DOF(iSpec,iDOF) = 2.*exparg/(EXP(exparg)-1.) ELSE ! negative overflow: exp -> 0 Xi_vib_DOF(iSpec,iDOF) = 2.*exparg/(-1.) @@ -961,7 +936,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe ELSE ! diatomic exparg = SpecDSMC(iSpec)%CharaTVib/TEqui ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom - IF(CHECKEXP(exparg))THEN + IF(CHECKEXP(exparg)) THEN Xi_VibSpecNew(iSpec) = 2.*SpecDSMC(iSpec)%CharaTVib/TEqui/(EXP(exparg)-1.) ELSE Xi_VibSpecNew(iSpec) = 0.0 @@ -998,8 +973,8 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF exparg = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TEqui ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom - IF(CHECKEXP(exparg))THEN - IF(exparg.gt.0.)THEN ! positive overflow: exp -> inf + IF(CHECKEXP(exparg)) THEN + IF(exparg.gt.0.) THEN ! positive overflow: exp -> inf Xi_vib_DOF(iSpec,iDOF) = 2.*exparg/(EXP(exparg)-1.) ELSE ! negative overflow: exp -> 0 Xi_vib_DOF(iSpec,iDOF) = 2.*exparg/(-1.) @@ -1012,7 +987,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe ELSE ! diatomic exparg = SpecDSMC(iSpec)%CharaTVib/TEqui ! Check if the exponent is within the range of machine precision for calculation of vibrational degrees of freedom - IF(CHECKEXP(exparg))THEN + IF(CHECKEXP(exparg)) THEN Xi_VibSpecNew(iSpec) = 2.*SpecDSMC(iSpec)%CharaTVib/TEqui/(EXP(exparg)-1.) ELSE Xi_VibSpecNew(iSpec) = 0.0 @@ -1220,6 +1195,7 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, USE MOD_BGK_Vars ,ONLY: BGKCollModel, ESBGKModel USE MOD_part_tools ,ONLY: GetParticleWeight USE MOD_Globals_Vars ,ONLY: BoltzmannConst +USE MOD_Globals ,ONLY: abort ! IMPLICIT VARIABLE HANDLING IMPLICIT NONE !----------------------------------------------------------------------------------------------------------------------------------- @@ -1241,15 +1217,15 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, CASE (1) ! Ellipsoidal Statistical BGK IF (ESBGKModel.EQ.1) THEN ! Approximated solution - DO fillMa1 =1, 3 - DO fillMa2 =fillMa1, 3 + DO fillMa1 = 1, 3 + DO fillMa2 = fillMa1, 3 IF (fillMa1.EQ.fillMa2) THEN KronDelta = 1.0 ELSE KronDelta = 0.0 END IF ! Fill symmetric transformation matrix SMat with anisotopic matrix A = SS - SMat(fillMa1, fillMa2)= KronDelta*CellTempRel/CellTemp - (1.-Prandtl)/(2.*Prandtl) & + SMat(fillMa1, fillMa2) = KronDelta - (1.-Prandtl)/(2.*Prandtl) & *(3./u2*u0ij(fillMa1, fillMa2)-KronDelta) END DO END DO @@ -1259,8 +1235,8 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, ! Generate random normals for the sampling of new velocities of all relaxing particles CALL BGK_BuildTransGaussNums(nRelax, iRanPart) ELSE - DO fillMa1 =1, 3 - DO fillMa2 =fillMa1, 3 + DO fillMa1 = 1, 3 + DO fillMa2 = fillMa1, 3 IF (fillMa1.EQ.fillMa2) THEN KronDelta = 1.0 ELSE @@ -1278,22 +1254,23 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, CALL DSYEV('V','U',3,A,3,W,Work,100,INFO) SMat = 0.0 IF (W(3).LT.0.0) THEN - ! Due to ascending order of eigenvalues, all three eigenvalues are lower than zero here - ! Same calculation as for approximate solution (ESBGKModel.EQ.1) - DO fillMa1 =1, 3 - DO fillMa2 =fillMa1, 3 - IF (fillMa1.EQ.fillMa2) THEN - KronDelta = 1.0 - ELSE - KronDelta = 0.0 - END IF - SMat(fillMa1, fillMa2)= KronDelta*CellTempRel*BoltzmannConst/MassIC_Mixture - (1.-Prandtl)/(2.*Prandtl) & - *(u0ij(fillMa1, fillMa2)-KronDelta*CellTemp*BoltzmannConst/MassIC_Mixture) - END DO - END DO - SMat(2,1)=SMat(1,2) - SMat(3,1)=SMat(1,3) - SMat(3,2)=SMat(2,3) + ! ! Due to ascending order of eigenvalues, all three eigenvalues are lower than zero here + ! ! Same calculation as for approximate solution (ESBGKModel.EQ.1) + ! DO fillMa1 = 1, 3 + ! DO fillMa2 = fillMa1, 3 + ! IF (fillMa1.EQ.fillMa2) THEN + ! KronDelta = 1.0 + ! ELSE + ! KronDelta = 0.0 + ! END IF + ! SMat(fillMa1, fillMa2) = KronDelta*CellTempRel*BoltzmannConst/MassIC_Mixture - (1.-Prandtl)/(2.*Prandtl) & + ! *(u0ij(fillMa1, fillMa2)-KronDelta*CellTemp*BoltzmannConst/MassIC_Mixture) + ! END DO + ! END DO + ! SMat(2,1)=SMat(1,2) + ! SMat(3,1)=SMat(1,3) + ! SMat(3,2)=SMat(2,3) + CALL abort(__STAMP__,'Sampling ESBGK 2') ELSE ! At least W(3) is not negative ! Set negative eigenvalues to zero From 7f77aa8fa79015db7aa23aa94dbc90102dc32d20 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Thu, 27 Apr 2023 16:47:39 +0200 Subject: [PATCH 27/41] BGK sampling - correction of matrix A off-diagonals for new relaxation model --- src/particles/bgk/bgk_colloperator.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 525365aee..0d84d2b2b 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -1243,8 +1243,8 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, KronDelta = 0.0 END IF ! Fill anisotopic matrix A - A(fillMa1, fillMa2) = KronDelta*CellTempRel*BoltzmannConst/MassIC_Mixture - (1.-Prandtl)/Prandtl*(u0ij(fillMa1, fillMa2) & - - KronDelta*CellTemp*BoltzmannConst/MassIC_Mixture) + A(fillMa1, fillMa2) = KronDelta*CellTempRel*BoltzmannConst/MassIC_Mixture - (1.-Prandtl)/Prandtl * & + (CellTempRel/CellTemp*u0ij(fillMa1, fillMa2) - KronDelta*CellTempRel*BoltzmannConst/MassIC_Mixture) END DO END DO IF (ESBGKModel.EQ.2) THEN From c10ad9df6c4dcf5fc9e3d22ec5f8b1001f1c2bca Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Tue, 16 May 2023 16:32:11 +0200 Subject: [PATCH 28/41] BGK CalcTRelax check totalweightspec --- src/particles/bgk/bgk_colloperator.f90 | 66 +++++++++++++------------- 1 file changed, 34 insertions(+), 32 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 0d84d2b2b..2d0f97540 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -830,43 +830,45 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe ERotSpecMean=0.0; ERotTtransSpecMean=0.0; EVibSpecMean=0.0; EVibTtransSpecMean=0.0; ETransRelMean=0.0; CellTempRel=0.0 DO iSpec = 1, nSpecies - IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN ! molecules - ! Mean rotational energy per particle of a species - ERotSpecMean(iSpec) = ERotSpec(iSpec)/totalWeightSpec(iSpec) - ! Mean rotational energy per particle of a species for the mixture translational temperature, ERot(Ttrans) - ERotTtransSpecMean(iSpec) = CellTemp * Xi_RotSpec(iSpec) * BoltzmannConst /2. - ! Calculate number of rotational relaxing molecules - RotFracSpec(iSpec) = totalWeightSpec(iSpec)*(rotrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell)) + IF(totalWeightSpec(iSpec).GT.0.) THEN + IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN ! molecules + ! Mean rotational energy per particle of a species + ERotSpecMean(iSpec) = ERotSpec(iSpec)/totalWeightSpec(iSpec) + ! Mean rotational energy per particle of a species for the mixture translational temperature, ERot(Ttrans) + ERotTtransSpecMean(iSpec) = CellTemp * Xi_RotSpec(iSpec) * BoltzmannConst /2. + ! Calculate number of rotational relaxing molecules + RotFracSpec(iSpec) = totalWeightSpec(iSpec)*(rotrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell)) - IF(BGKDoVibRelaxation) THEN - ! Mean vibrational energy per particle of a species - EVibSpecMean(iSpec) = EVibSpec(iSpec)/totalWeightSpec(iSpec) - IF(SpecDSMC(iSpec)%PolyatomicMol) THEN ! polyatomic - iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray - ! Loop over all vibrational DOF - DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF + IF(BGKDoVibRelaxation) THEN + ! Mean vibrational energy per particle of a species + EVibSpecMean(iSpec) = EVibSpec(iSpec)/totalWeightSpec(iSpec) + IF(SpecDSMC(iSpec)%PolyatomicMol) THEN ! polyatomic + iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray + ! Loop over all vibrational DOF + DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF + ! Mean vibrational energy per particle of a species for the mixture translational temperature, EVib(Ttrans) + EVibTtransSpecMean(iSpec) = EVibTtransSpecMean(iSpec) + BoltzmannConst*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF) / & + (EXP(PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/CellTemp) - 1.) + END DO + ELSE ! diatomic ! Mean vibrational energy per particle of a species for the mixture translational temperature, EVib(Ttrans) - EVibTtransSpecMean(iSpec) = EVibTtransSpecMean(iSpec) + BoltzmannConst*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF) / & - (EXP(PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/CellTemp) - 1.) - END DO - ELSE ! diatomic - ! Mean vibrational energy per particle of a species for the mixture translational temperature, EVib(Ttrans) - EVibTtransSpecMean(iSpec) = BoltzmannConst * SpecDSMC(iSpec)%CharaTVib / (EXP(SpecDSMC(iSpec)%CharaTVib/CellTemp) - 1.) + EVibTtransSpecMean(iSpec) = BoltzmannConst * SpecDSMC(iSpec)%CharaTVib / (EXP(SpecDSMC(iSpec)%CharaTVib/CellTemp) - 1.) + END IF + ! Calculate number of vibrational relaxing molecules + VibFracSpec(iSpec) = totalWeightSpec(iSpec)*(vibrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell)) END IF - ! Calculate number of vibrational relaxing molecules - VibFracSpec(iSpec) = totalWeightSpec(iSpec)*(vibrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell)) - END IF - ! Mean translational energy per particle to satisfy the Landau-Teller equation - ETransRelMean = ETransRelMean + (3./2. * BoltzmannConst * CellTemp - (rotrelaxfreqSpec(iSpec)/relaxfreq) * & - (ERotTtransSpecMean(iSpec)-ERotSpecMean(iSpec))) * totalWeightSpec(iSpec)/totalWeight - IF (BGKDoVibRelaxation) THEN - ETransRelMean = ETransRelMean - (vibrelaxfreqSpec(iSpec)/relaxfreq)*(EVibTtransSpecMean(iSpec)-EVibSpecMean(iSpec)) * & - totalWeightSpec(iSpec)/totalWeight + ! Mean translational energy per particle to satisfy the Landau-Teller equation + ETransRelMean = ETransRelMean + (3./2. * BoltzmannConst * CellTemp - (rotrelaxfreqSpec(iSpec)/relaxfreq) * & + (ERotTtransSpecMean(iSpec)-ERotSpecMean(iSpec))) * totalWeightSpec(iSpec)/totalWeight + IF (BGKDoVibRelaxation) THEN + ETransRelMean = ETransRelMean - (vibrelaxfreqSpec(iSpec)/relaxfreq)*(EVibTtransSpecMean(iSpec)-EVibSpecMean(iSpec)) * & + totalWeightSpec(iSpec)/totalWeight + END IF + ELSE ! atomic + ! Mean translational energy per particle to satisfy the Landau-Teller equation + ETransRelMean = ETransRelMean + 3./2. * BoltzmannConst * CellTemp * totalWeightSpec(iSpec)/totalWeight END IF - ELSE ! atomic - ! Mean translational energy per particle to satisfy the Landau-Teller equation - ETransRelMean = ETransRelMean + 3./2. * BoltzmannConst * CellTemp * totalWeightSpec(iSpec)/totalWeight END IF END DO From e6b4dff5c49cead4d973e3525a31b18cc5df30d7 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Thu, 25 May 2023 15:52:32 +0200 Subject: [PATCH 29/41] BGK corrected determinerelaxpart --- src/particles/bgk/bgk_colloperator.f90 | 73 +++++++++++--------------- 1 file changed, 32 insertions(+), 41 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 2d0f97540..13eac9fa7 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -1046,71 +1046,62 @@ SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, REAL, INTENT(INOUT) :: OldEn !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES -INTEGER :: iPart, iSpec, iLoop, iPick, iLoopRot, iLoopVib -REAL :: ProbAddPartTrans, iRan, partWeight, ProbAddPartRot, ProbAddPartVib +INTEGER :: iPart, iSpec, iLoop, nNotRelax +REAL :: ProbAddPartTrans, iRan, partWeight, ProbAddPartRot(nSpecies), ProbAddPartVib(nSpecies) !=================================================================================================================================== -VibRelaxWeightSpec =0; RotRelaxWeightSpec =0; nRelax=0; vBulk=0.0; nRotRelax=0; nVibRelax=0; OldEnRot=0.0 -iLoopRot=1; iLoopVib=1 +VibRelaxWeightSpec=0.0; RotRelaxWeightSpec=0.0; nRelax=0; nNotRelax=0; vBulk=0.0; nRotRelax=0; nVibRelax=0; OldEnRot=0.0 + ! Calculate probability of relaxation of a particle towards the target distribution function ProbAddPartTrans = 1.-EXP(-relaxfreq*dtCell) -CALL RANDOM_NUMBER(iRan) -! Calculate the number of relaxing particles -nRelax = INT(REAL(nPart) * ProbAddPartTrans + iRan) -! List of non-relaxing particles -iPartIndx_NodeRelaxTemp(:) = iPartIndx_Node(:) -! Relaxing particles -DO iLoop = 1, nRelax - CALL RANDOM_NUMBER(iRan) - iPick = INT(iRan * (nPart-iLoop+1)) + 1 - iPart = iPartIndx_NodeRelaxTemp(iPick) - partWeight = GetParticleWeight(iPart) +! Calculate probabilities of relaxation of a particle in the rotation and vibration +ProbAddPartRot(:) = ProbAddPartTrans * rotrelaxfreqSpec(:)/relaxfreq*betaR(:) +ProbAddPartVib(:) = ProbAddPartTrans * vibrelaxfreqSpec(:)/relaxfreq*betaV(:) + +! Loop over all simulation particles +DO iLoop = 1, nPart + iPart = iPartIndx_Node(iLoop) iSpec = PartSpecies(iPart) - iPartIndx_NodeRelax(iLoop) = iPart - iPartIndx_NodeRelaxTemp(iPick) = iPartIndx_NodeRelaxTemp(nPart-iLoop+1) + partWeight = GetParticleWeight(iPart) + CALL RANDOM_NUMBER(iRan) + ! Count particles that are undergoing a relaxation + IF (ProbAddPartTrans.GT.iRan) THEN + nRelax = nRelax + 1 + iPartIndx_NodeRelax(nRelax) = iPart + ! Count particles that are not undergoing a relaxation + ELSE + nNotRelax = nNotRelax + 1 + iPartIndx_NodeRelaxTemp(nNotRelax) = iPart + ! Sum up velocities of non-relaxing particles for bulk velocity + vBulk(1:3) = vBulk(1:3) + PartState(4:6,iPart)*Species(iSpec)%MassIC*partWeight + END IF + ! For molecules: relaxation of inner DOF IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN ! Rotation CALL RANDOM_NUMBER(iRan) - ! Calculate probability of rotational relaxation of a particle that relaxes towards the target distribution function - ProbAddPartRot = rotrelaxfreqSpec(iSpec)/relaxfreq*betaR(iSpec) - IF (ProbAddPartRot.GT.iRan) THEN - ! relaxation - iPartIndx_NodeRelaxRot(iLoopRot) = iPartIndx_NodeRelax(iLoop) + ! Count particles that are undergoing a relaxation, in total and per species + IF (ProbAddPartRot(iSpec).GT.iRan) THEN nRotRelax = nRotRelax + 1 - iLoopRot = iLoopRot + 1 RotRelaxWeightSpec(iSpec) = RotRelaxWeightSpec(iSpec) + partWeight + iPartIndx_NodeRelaxRot(nRotRelax) = iPart ! Sum up total rotational energy OldEnRot = OldEnRot + PartStateIntEn(2,iPart) * partWeight END IF ! Vibration IF(BGKDoVibRelaxation) THEN CALL RANDOM_NUMBER(iRan) - ! Calculate probability of vibrational relaxation of a particle that relaxes towards the target distribution function - ProbAddPartVib = vibrelaxfreqSpec(iSpec)/relaxfreq*betaV(iSpec) - IF (ProbAddPartVib.GT.iRan) THEN - ! relaxation - iPartIndx_NodeRelaxVib(iLoopVib) = iPartIndx_NodeRelax(iLoop) + ! Count particles that are undergoing a relaxation, in total and per species + IF (ProbAddPartVib(iSpec).GT.iRan) THEN nVibRelax = nVibRelax + 1 VibRelaxWeightSpec(iSpec) = VibRelaxWeightSpec(iSpec) + partWeight + iPartIndx_NodeRelaxVib(nVibRelax) = iPart ! Sum up total vibrational energy of all relaxing particles, considering zero-point energy, and add to translational energy - OldEn = OldEn + (PartStateIntEn(1,iPartIndx_NodeRelaxVib(iLoopVib)) - SpecDSMC(iSpec)%EZeroPoint) * partWeight - iLoopVib = iLoopVib + 1 + OldEn = OldEn + (PartStateIntEn(1,iPartIndx_NodeRelaxVib(nVibRelax)) - SpecDSMC(iSpec)%EZeroPoint) * partWeight END IF END IF END IF END DO -! Non-relaxing particles -! nNonRelax = nPart-nRelax -DO iLoop = 1, nPart-nRelax - iPart = iPartIndx_NodeRelaxTemp(iLoop) - partWeight = GetParticleWeight(iPart) - iSpec = PartSpecies(iPart) - ! iPartIndx_NodeNonRelax(iLoop) - ! Sum up velocities of non-relaxing particles for bulk velocity - vBulk(1:3) = vBulk(1:3) + PartState(4:6,iPart)*Species(iSpec)%MassIC*partWeight -END DO - END SUBROUTINE DetermineRelaxPart From 614365ce576b6e7e8b881457191b54981e645938 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Tue, 20 Jun 2023 15:35:53 +0200 Subject: [PATCH 30/41] changed CalcSigma_22VHS to subroutine --- src/particles/bgk/bgk_colloperator.f90 | 27 +++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 13eac9fa7..649c3b8e6 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -1690,7 +1690,7 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ CellTemptmp = CellTemp(nSpecies+1) ! Cell temperature END IF ! Calculation of collision integral Sigma_22 - Sigma_22 = CalcSigma_22VHS(CellTemptmp,InteractDiam,Mass,TVHS, omegaVHS) + CALL CalcSigma_22VHS(CellTemptmp, InteractDiam, Mass, TVHS, omegaVHS, Sigma_22) IF (iSpec.EQ.jSpec) THEN cv= 3./2.*BoltzmannConst/(2.*Mass) ! DOF = 3, translational part ! Calculation of the viscosity and thermal conductivity @@ -1700,14 +1700,14 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ ! results in in same as ThermalCondSpec(iSpec) = (15./4.)*BoltzmannConst/(2.*Mass)*ViscSpec(iSpec) ! Additional calculation of Sigma_11VHS and the diffusion coefficient for molecular species IF ((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - CALL CalcSigma_11VHS(CellTemp(nSpecies+1),InteractDiam,Mass,TVHS, omegaVHS, Sigma_11) + CALL CalcSigma_11VHS(CellTemp(nSpecies+1), InteractDiam, Mass, TVHS, omegaVHS, Sigma_11) E_12 = BoltzmannConst*CellTemp(nSpecies+1)/(8.*Species(iSpec)%MassIC*Species(jSpec)%MassIC & /(Species(iSpec)%MassIC+Species(jSpec)%MassIC)**2.*Sigma_11) DiffCoef(iSpec,jSpec) = 3.*E_12/(2.*(Species(iSpec)%MassIC+Species(jSpec)%MassIC)*dens) END IF ELSE ! Calculation of collision integral Sigma_11 - CALL CalcSigma_11VHS(CellTemp(nSpecies+1),InteractDiam,Mass,TVHS, omegaVHS, Sigma_11) + CALL CalcSigma_11VHS(CellTemp(nSpecies+1), InteractDiam, Mass, TVHS, omegaVHS, Sigma_11) ! Parameters for calculation of contribution of species to mixture transport coefficients ! Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), "Multi-species modeling in the particle-based ellipsoidal ! statistical Bhatnagar-Gross-Krook method for monatomic gas species" @@ -1803,23 +1803,23 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ END SUBROUTINE CalcViscosityThermalCondColIntVHS -SUBROUTINE CalcSigma_11VHS(CellTemp,Dref,Mass,Tref, omegaVHS, Sigma_11) +SUBROUTINE CalcSigma_11VHS(CellTemp, Dref, Mass, Tref, omegaVHS, Sigma_11) !=================================================================================================================================== !> !=================================================================================================================================== ! MODULES -USE MOD_Globals_Vars ,ONLY: Pi, BoltzmannConst +USE MOD_Globals_Vars ,ONLY: Pi, BoltzmannConst ! IMPLICIT VARIABLE HANDLING IMPLICIT NONE !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT VARIABLES -REAL, INTENT(IN) :: CellTemp,Dref,Mass,Tref, omegaVHS +REAL, INTENT(IN) :: CellTemp, Dref, Mass, Tref, omegaVHS REAL, INTENT(OUT) :: Sigma_11 !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES -REAL :: Prefactor +REAL :: Prefactor !=================================================================================================================================== ! See Stephani et. al., Physics of Fluids 24, 077101 (2012), ! “Consistent treatment of transport properties for five-species air direct simulation Monte Carlo/Navier-Stokes applications” @@ -1829,28 +1829,29 @@ SUBROUTINE CalcSigma_11VHS(CellTemp,Dref,Mass,Tref, omegaVHS, Sigma_11) END SUBROUTINE CalcSigma_11VHS -REAL FUNCTION CalcSigma_22VHS(CellTemp,Dref,Mass,Tref, omegaVHS) +SUBROUTINE CalcSigma_22VHS(CellTemp, Dref, Mass, Tref, omegaVHS, Sigma_22) !=================================================================================================================================== !> !=================================================================================================================================== ! MODULES -USE MOD_Globals_Vars ,ONLY: Pi, BoltzmannConst +USE MOD_Globals_Vars ,ONLY: Pi, BoltzmannConst ! IMPLICIT VARIABLE HANDLING IMPLICIT NONE !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT VARIABLES -REAL, INTENT(IN) :: CellTemp,Dref,Mass,Tref, omegaVHS +REAL, INTENT(IN) :: CellTemp, Dref, Mass, Tref, omegaVHS +REAL, INTENT(OUT) :: Sigma_22 !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES -REAL :: Prefactor +REAL :: Prefactor !=================================================================================================================================== ! See Stephani et. al., Physics of Fluids 24, 077101 (2012), ! “Consistent treatment of transport properties for five-species air direct simulation Monte Carlo/Navier-Stokes applications” Prefactor = Pi/3.*Dref*Dref*SQRT(BoltzmannConst/(2.*Pi*Mass))*Tref**omegaVHS*GAMMA(4.-omegaVHS)/GAMMA(2.-omegaVHS) - CalcSigma_22VHS = Prefactor*CellTemp**(0.5-omegaVHS) + Sigma_22 = Prefactor*CellTemp**(0.5-omegaVHS) -END FUNCTION CalcSigma_22VHS +END SUBROUTINE CalcSigma_22VHS END MODULE MOD_BGK_CollOperator From dca3deec00f8722aefb5fb02cdb7152cd3bff816 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Tue, 27 Jun 2023 16:56:21 +0200 Subject: [PATCH 31/41] Bug fix for calculation of polyatomic vib temperature: added zero-point energy --- src/particles/bgk/bgk_colloperator.f90 | 20 +++---------------- src/particles/fp_flow/fpflow_colloperator.f90 | 2 +- 2 files changed, 4 insertions(+), 18 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 649c3b8e6..161881e7e 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -611,30 +611,16 @@ SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, T IF(SpecDSMC(iSpec)%PolyatomicMol) THEN ! polyatomic iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray ! Calculation of the vibrational temperature (zero-point search) for polyatomic molecules - TVibSpec(iSpec) = CalcTVibPoly(EVibSpec(iSpec)/totalWeightSpec(iSpec), 1) - IF (TVibSpec(iSpec).GT.0.0) THEN - DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF - ! Calculation of vibrational DOFs according to Pfeiffer et. al., AIP Conference Proceedings 2132, 100001 (2019), - ! "Extension of particle-based BGK models to polyatomic species in hypersonic flow around a flat-faced cylinder" - exparg = PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TVibSpec(iSpec) - IF(CHECKEXP(exparg))THEN - Xi_VibSpec(iSpec) = Xi_VibSpec(iSpec) + 2.*exparg/(EXP(exparg) - 1.) - ELSE - Xi_VibSpec(iSpec) = 0. - END IF ! CHECKEXP(exparg) - END DO - END IF + TVibSpec(iSpec) = CalcTVibPoly(EVibSpec(iSpec)/totalWeightSpec(iSpec) + SpecDSMC(iSpec)%EZeroPoint, iSpec) ELSE ! diatomic ! Calculation of vibrational temperature and DOFs from Pfeiffer, Physics of Fluids 30, 116103 (2018), "Extending the ! particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules including quantized vibrational ! energies" ! TVibSpec = vibrational energy without zero-point energy TVibSpec(iSpec) = EVibSpec(iSpec) / (totalWeightSpec(iSpec)*BoltzmannConst*SpecDSMC(iSpec)%CharaTVib) - IF (TVibSpec(iSpec).GT.0.0) THEN - TVibSpec(iSpec) = SpecDSMC(iSpec)%CharaTVib/LOG(1. + 1./(TVibSpec(iSpec))) - Xi_VibSpec(iSpec) = 2.* EVibSpec(iSpec) / (totalWeightSpec(iSpec)*BoltzmannConst*TVibSpec(iSpec)) - END IF + IF (TVibSpec(iSpec).GT.0.0) TVibSpec(iSpec) = SpecDSMC(iSpec)%CharaTVib/LOG(1. + 1./(TVibSpec(iSpec))) END IF + IF (TVibSpec(iSpec).GT.0.0) Xi_VibSpec(iSpec) = 2.* EVibSpec(iSpec) / (totalWeightSpec(iSpec)*BoltzmannConst*TVibSpec(iSpec)) END IF Xi_RotSpec(iSpec) = SpecDSMC(iSpec)%Xi_Rot ! Calculation of rotational temperature from Pfeiffer, Physics of Fluids 30, 116103 (2018), "Extending the particle ellipsoidal diff --git a/src/particles/fp_flow/fpflow_colloperator.f90 b/src/particles/fp_flow/fpflow_colloperator.f90 index 0bff3ae3b..7948e5bef 100644 --- a/src/particles/fp_flow/fpflow_colloperator.f90 +++ b/src/particles/fp_flow/fpflow_colloperator.f90 @@ -185,7 +185,7 @@ SUBROUTINE FP_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) nXiVibDOF = PolyatomMolDSMC(iPolyatMole)%VibDOF ALLOCATE(Xi_vib_DOF(nXiVibDOF)) Xi_vib_DOF(:) = 0. - TVib = CalcTVibPoly(Evib/totalWeight, 1) + TVib = CalcTVibPoly(Evib/totalWeight + SpecDSMC(iSpec)%EZeroPoint, 1) IF (TVib.GT.0.0) THEN DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF Xi_vib = Xi_vib + 2.*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TVib & From 53e2610e8614d50a7a7fa81d03c014453b0b9c3b Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Tue, 27 Jun 2023 16:58:18 +0200 Subject: [PATCH 32/41] Bug fix 2.0 - iSpec=1 for FP poly --- src/particles/fp_flow/fpflow_colloperator.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/particles/fp_flow/fpflow_colloperator.f90 b/src/particles/fp_flow/fpflow_colloperator.f90 index 7948e5bef..3918580c3 100644 --- a/src/particles/fp_flow/fpflow_colloperator.f90 +++ b/src/particles/fp_flow/fpflow_colloperator.f90 @@ -185,7 +185,7 @@ SUBROUTINE FP_CollisionOperator(iPartIndx_Node, nPart, NodeVolume) nXiVibDOF = PolyatomMolDSMC(iPolyatMole)%VibDOF ALLOCATE(Xi_vib_DOF(nXiVibDOF)) Xi_vib_DOF(:) = 0. - TVib = CalcTVibPoly(Evib/totalWeight + SpecDSMC(iSpec)%EZeroPoint, 1) + TVib = CalcTVibPoly(Evib/totalWeight + SpecDSMC(1)%EZeroPoint, 1) IF (TVib.GT.0.0) THEN DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF Xi_vib = Xi_vib + 2.*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/TVib & From 7aecc1a96255f766c183a775e6fd2f6213c56ee8 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Tue, 11 Jul 2023 16:28:13 +0200 Subject: [PATCH 33/41] BGK some bug fixes and added fallbacks instead of aborts --- src/particles/bgk/bgk_colloperator.f90 | 100 +++++++++++-------------- 1 file changed, 43 insertions(+), 57 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 161881e7e..ace9e84a6 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -88,7 +88,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal REAL,PARAMETER :: RelMomTol=1e-6 ! Relative tolerance applied to conservation of momentum before/after reaction REAL,PARAMETER :: RelEneTol=1e-12 ! Relative tolerance applied to conservation of energy before/after reaction #endif /* CODE_ANALYZE */ -REAL :: totalWeightSpec(nSpecies), totalWeight, partWeight, CellTemptmp, MassIC_Mixture +REAL :: totalWeightSpec(nSpecies), totalWeight, totalWeight2, partWeight, CellTemptmp, MassIC_Mixture REAL :: EVibSpec(nSpecies), Xi_VibSpec(nSpecies), Xi_VibSpecNew(nSpecies) REAL :: ERotSpec(nSpecies), Xi_RotSpec(nSpecies), Xi_RotTotal REAL :: CellTempRel, TEqui @@ -115,7 +115,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal IF(nPart.LE.2) RETURN ! 1.) Moment calculation: Summing up the relative velocities and their squares -CALL CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, totalWeightSpec, TotalMass, u2, u2Spec, u0ij, & +CALL CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, totalWeight2, totalWeightSpec, TotalMass, u2, u2Spec, u0ij, & u2i, OldEn, EVibSpec, ERotSpec, CellTemp, SpecTemp, dtCell) IF((CellTemp.LE.0.0).OR.(MAXVAL(nSpec(:)).EQ.1).OR.(totalWeight.LE.0.0)) RETURN @@ -199,8 +199,9 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal END IF END IF -CALL CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpec, totalWeight, nPart, dtCell, CellTemp, TRotSpec, & - TVibSpec, relaxfreq, rotrelaxfreqSpec, vibrelaxfreqSpec, Xi_VibSpecNew, Xi_vib_DOF, nXiVibDOF, CellTempRel, TEqui, betaR, betaV) +CALL CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpec, totalWeight, totalWeight2, nPart, dtCell, CellTemp, & + TRotSpec, TVibSpec, relaxfreq, rotrelaxfreqSpec, vibrelaxfreqSpec, Xi_VibSpecNew, Xi_vib_DOF, nXiVibDOF, CellTempRel, TEqui, & + betaR, betaV) CALL DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, nRotRelax, nVibRelax, & RotRelaxWeightSpec, VibRelaxWeightSpec, iPartIndx_NodeRelax, iPartIndx_NodeRelaxTemp, iPartIndx_NodeRelaxRot, & @@ -360,7 +361,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal END SUBROUTINE BGK_CollisionOperator -SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, totalWeightSpec, TotalMass, u2, u2Spec, & +SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, totalWeight2, totalWeightSpec, TotalMass, u2, u2Spec, & u0ij, u2i, OldEn, EVibSpec, ERotSpec, CellTemp, SpecTemp, dtCell) !=================================================================================================================================== !> Moment calculation: Summing up the relative velocities and their squares @@ -382,12 +383,12 @@ SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, tota INTEGER, INTENT(OUT) :: nSpec(nSpecies) REAL, INTENT(OUT) :: u2Spec(nSpecies),u0ij(3,3), OldEn, EVibSpec(nSpecies), ERotSpec(nSpecies), u2i(3), u2 REAL, INTENT(OUT) :: CellTemp, SpecTemp(nSpecies), totalWeightSpec(nSpecies) -REAL, INTENT(OUT) :: vBulkAll(3), totalWeight, TotalMass, dtCell +REAL, INTENT(OUT) :: vBulkAll(3), totalWeight, totalWeight2, TotalMass, dtCell !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES INTEGER :: iLoop, iPart, iSpec, fillMa1, fillMa2 REAL :: V_rel(1:3), vmag2, EnerTotal, ThermEner, totalWeightSpec2(nSpecies), vBulkSpec(3,nSpecies) -REAL :: partWeight, tempweight, tempweight2, tempmass, vBulkTemp(3), totalWeight2, totalWeight3 +REAL :: partWeight, tempweight, tempweight2, tempmass, vBulkTemp(3), totalWeight3 LOGICAL :: validSpec(nSpecies) !=================================================================================================================================== totalWeightSpec = 0.0; totalWeightSpec2=0.0; vBulkAll=0.0; TotalMass=0.0; vBulkSpec=0.0; nSpec=0; dtCell=0.0 @@ -583,7 +584,7 @@ SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, T !=================================================================================================================================== ! MODULES USE MOD_Particle_Vars ,ONLY: nSpecies -USE MOD_DSMC_Vars ,ONLY: SpecDSMC, PolyatomMolDSMC +USE MOD_DSMC_Vars ,ONLY: SpecDSMC USE MOD_BGK_Vars ,ONLY: BGKDoVibRelaxation USE MOD_Globals_Vars ,ONLY: BoltzmannConst USE MOD_Particle_Analyze_Tools ,ONLY: CalcTVibPoly @@ -599,8 +600,7 @@ SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, T REAL, INTENT(OUT) :: Xi_RotSpec(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES -INTEGER :: iPolyatMole, iSpec, iDOF -REAL :: exparg +INTEGER :: iSpec !=================================================================================================================================== Xi_VibSpec=0.; InnerDOF=0.; Xi_RotSpec=0.; TVibSpec=0.; TRotSpec=0. DO iSpec = 1, nSpecies @@ -609,7 +609,6 @@ SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, T IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN IF(BGKDoVibRelaxation) THEN IF(SpecDSMC(iSpec)%PolyatomicMol) THEN ! polyatomic - iPolyatMole = SpecDSMC(iSpec)%SpecToPolyArray ! Calculation of the vibrational temperature (zero-point search) for polyatomic molecules TVibSpec(iSpec) = CalcTVibPoly(EVibSpec(iSpec)/totalWeightSpec(iSpec) + SpecDSMC(iSpec)%EZeroPoint, iSpec) ELSE ! diatomic @@ -746,14 +745,6 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight IF(DSMC%CalcQualityFactors) BGK_ExpectedPrandtlNumber = BGK_ExpectedPrandtlNumber + Prandtl - ! Ensure anisotropic matrix to be positive definite - gas mixtures only for ESBGK by now - A = u0ij ! pressure tensor - CALL DSYEV('N','U',3,A,3,W,Work,100,INFO) ! calculate eigenvalues, W(3) is maximum eigenvalue - Theta = u2 / 3. ! kB*T/m - nu = 1.-1./Prandtl - nu= MAX(nu,-Theta/(W(3)-Theta)) - Prandtl = 1./(1.-nu) - ! Calculation of relaxation frequency relaxfreq = Prandtl*dens*BoltzmannConst*CellTemp/dynamicvis @@ -776,8 +767,9 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight END SUBROUTINE CalcGasProperties -SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpec, totalWeight, nPart, dtCell, CellTemp, TRotSpec, & - TVibSpec, relaxfreq, rotrelaxfreqSpec, vibrelaxfreqSpec, Xi_VibSpecNew, Xi_vib_DOF, nXiVibDOF, CellTempRel, TEqui, betaR, betaV) +SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpec, totalWeight, totalWeight2, nPart, dtCell, & + CellTemp, TRotSpec, TVibSpec, relaxfreq, rotrelaxfreqSpec, vibrelaxfreqSpec, Xi_VibSpecNew, Xi_vib_DOF, nXiVibDOF, & + CellTempRel, TEqui, betaR, betaV) !=================================================================================================================================== !> Calculate the relaxation energies and temperatures !=================================================================================================================================== @@ -794,7 +786,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe INTEGER, INTENT(IN) :: nPart, nXiVibDOF REAL, INTENT(IN) :: TRotSpec(nSpecies), ERotSpec(nSpecies), Xi_RotSpec(nSpecies) REAL, INTENT(IN) :: TVibSpec(nSpecies), EVibSpec(nSpecies), Xi_VibSpec(nSpecies) -REAL, INTENT(IN) :: totalWeightSpec(nSpecies), totalWeight, CellTemp, dtCell +REAL, INTENT(IN) :: totalWeightSpec(nSpecies), totalWeight, totalWeight2, CellTemp, dtCell REAL, INTENT(IN) :: relaxfreq, rotrelaxfreqSpec(nSpecies), vibrelaxfreqSpec(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES @@ -821,7 +813,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe ! Mean rotational energy per particle of a species ERotSpecMean(iSpec) = ERotSpec(iSpec)/totalWeightSpec(iSpec) ! Mean rotational energy per particle of a species for the mixture translational temperature, ERot(Ttrans) - ERotTtransSpecMean(iSpec) = CellTemp * Xi_RotSpec(iSpec) * BoltzmannConst /2. + ERotTtransSpecMean(iSpec) = CellTemp * Xi_RotSpec(iSpec) * BoltzmannConst / 2. ! Calculate number of rotational relaxing molecules RotFracSpec(iSpec) = totalWeightSpec(iSpec)*(rotrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell)) @@ -833,8 +825,8 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe ! Loop over all vibrational DOF DO iDOF = 1, PolyatomMolDSMC(iPolyatMole)%VibDOF ! Mean vibrational energy per particle of a species for the mixture translational temperature, EVib(Ttrans) - EVibTtransSpecMean(iSpec) = EVibTtransSpecMean(iSpec) + BoltzmannConst*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF) / & - (EXP(PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/CellTemp) - 1.) + EVibTtransSpecMean(iSpec) = EVibTtransSpecMean(iSpec) + BoltzmannConst*PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF) & + / (EXP(PolyatomMolDSMC(iPolyatMole)%CharaTVibDOF(iDOF)/CellTemp) - 1.) END DO ELSE ! diatomic ! Mean vibrational energy per particle of a species for the mixture translational temperature, EVib(Ttrans) @@ -862,19 +854,22 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe IF (ETransRelMean.GT.0.0) THEN CellTempRel = 2. * ETransRelMean / (3. * BoltzmannConst) ELSE - CALL abort(__STAMP__,'Negative energy for relaxation') + CellTempRel = CellTemp END IF ! Calculation of equilibrium temperature for relaxation and energy conservation TEqui_Old = 0.0 -TEquiNum = 3.*(nPart-1.)*CellTemp -TEquiDenom = 3.*(nPart-1.) +TEquiNum = 3.*(totalWeight - totalWeight2/totalWeight)*CellTemp +TEquiDenom = 3.*(totalWeight - totalWeight2/totalWeight) ! Sum up over all species DO iSpec = 1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - TEquiNum = TEquiNum + Xi_RotSpec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) + & - Xi_VibSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) - TEquiDenom = TEquiDenom + Xi_RotSpec(iSpec)*RotFracSpec(iSpec) + Xi_VibSpec(iSpec)*VibFracSpec(iSpec) + TEquiNum = TEquiNum + Xi_RotSpec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) + TEquiDenom = TEquiDenom + Xi_RotSpec(iSpec)*RotFracSpec(iSpec) + IF(BGKDoVibRelaxation) THEN + TEquiNum = TEquiNum + Xi_VibSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) + TEquiDenom = TEquiDenom + Xi_VibSpec(iSpec)*VibFracSpec(iSpec) + END IF END IF END DO TEqui = TEquiNum/TEquiDenom @@ -899,7 +894,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe IF (betaV(iSpec).LT.0.0) THEN betaV(iSpec) = 1. END IF - ! new calculation of number of rotational relaxing molecules + ! new calculation of number of vibrational relaxing molecules VibFracSpec(iSpec) = totalWeightSpec(iSpec)*(vibrelaxfreqSpec(iSpec)/relaxfreq)*(1.-EXP(-relaxfreq*dtCell))*betaV(iSpec) END IF @@ -936,14 +931,17 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe TEqui_Old = TEqui TEqui_Old2 = TEqui ! new calculation of equilibrium temperature with new RotFracSpec, new VibFracSpec, new VibDOF(TEqui) in denominator - TEquiNum = 3.*(nPart-1.)*CellTemp - TEquiDenom = 3.*(nPart-1.) + TEquiNum = 3.*(totalWeight - totalWeight2/totalWeight)*CellTemp + TEquiDenom = 3.*(totalWeight - totalWeight2/totalWeight) ! Sum up over all species DO iSpec = 1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - TEquiNum = TEquiNum + Xi_RotSpec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) + & - Xi_VibSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) - TEquiDenom = TEquiDenom + Xi_RotSpec(iSpec)*RotFracSpec(iSpec) + Xi_VibSpecNew(iSpec)*VibFracSpec(iSpec) + TEquiNum = TEquiNum + Xi_RotSpec(iSpec)*RotFracSpec(iSpec)*TRotSpec(iSpec) + TEquiDenom = TEquiDenom + Xi_RotSpec(iSpec)*RotFracSpec(iSpec) + IF(BGKDoVibRelaxation) THEN + TEquiNum = TEquiNum + Xi_VibSpec(iSpec)*VibFracSpec(iSpec)*TVibSpec(iSpec) + TEquiDenom = TEquiDenom + Xi_VibSpecNew(iSpec)*VibFracSpec(iSpec) + END IF END IF END DO TEqui = TEquiNum/TEquiDenom @@ -985,8 +983,8 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe END DO TEqui_Old2 = TEqui ! new calculation of equilibrium temperature with new RotFracSpec, new VibFracSpec, new VibDOF(TEqui) in denominator - TEquiNum = 3.*(nPart-1.)*CellTemp - TEquiDenom = 3.*(nPart-1.) + TEquiNum = 3.*(totalWeight - totalWeight2/totalWeight)*CellTemp + TEquiDenom = 3.*(totalWeight - totalWeight2/totalWeight) ! Sum up over all species DO iSpec = 1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN @@ -1233,26 +1231,14 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, CALL DSYEV('V','U',3,A,3,W,Work,100,INFO) SMat = 0.0 IF (W(3).LT.0.0) THEN - ! ! Due to ascending order of eigenvalues, all three eigenvalues are lower than zero here - ! ! Same calculation as for approximate solution (ESBGKModel.EQ.1) - ! DO fillMa1 = 1, 3 - ! DO fillMa2 = fillMa1, 3 - ! IF (fillMa1.EQ.fillMa2) THEN - ! KronDelta = 1.0 - ! ELSE - ! KronDelta = 0.0 - ! END IF - ! SMat(fillMa1, fillMa2) = KronDelta*CellTempRel*BoltzmannConst/MassIC_Mixture - (1.-Prandtl)/(2.*Prandtl) & - ! *(u0ij(fillMa1, fillMa2)-KronDelta*CellTemp*BoltzmannConst/MassIC_Mixture) - ! END DO - ! END DO - ! SMat(2,1)=SMat(1,2) - ! SMat(3,1)=SMat(1,3) - ! SMat(3,2)=SMat(2,3) - CALL abort(__STAMP__,'Sampling ESBGK 2') + ! Due to ascending order of eigenvalues, all three eigenvalues are lower than zero here + ! Fallback to Maxwell BGK + SMat(1,1) = SQRT(BoltzmannConst*CellTempRel/MassIC_Mixture) + SMat(2,2) = SQRT(BoltzmannConst*CellTempRel/MassIC_Mixture) + SMat(3,3) = SQRT(BoltzmannConst*CellTempRel/MassIC_Mixture) ELSE ! At least W(3) is not negative - ! Set negative eigenvalues to zero + ! Set negative eigenvalues to zero to get positive semidefinite matrix IF (W(1).LT.0.0) THEN W(1) = 0.0 IF (W(2).LT.0.0) W(2) = 0.0 From 1caabbb617eabad362eed057f6f568cbad0d2ad7 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Mon, 17 Jul 2023 15:01:39 +0200 Subject: [PATCH 34/41] BGK collint thermalcond rot vib bug fix remove if --- src/particles/bgk/bgk_colloperator.f90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index ace9e84a6..f35094dfd 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -1692,10 +1692,8 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ DiffCoef(iSpec,jSpec) = 3.*E_12/(2.*(Species(iSpec)%MassIC+Species(jSpec)%MassIC)*dens) DiffCoef(jSpec,iSpec) = DiffCoef(iSpec,jSpec) END IF - IF ((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN - Xj_Dij(iSpec,jSpec) = Xi(jSpec)/DiffCoef(iSpec,jSpec) - Xj_Dij(jSpec,iSpec) = Xj_Dij(iSpec,jSpec) - END IF + Xj_Dij(iSpec,jSpec) = Xi(jSpec)/DiffCoef(iSpec,jSpec) + Xj_Dij(jSpec,iSpec) = Xj_Dij(iSpec,jSpec) END DO IF ((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN ! Calculation of thermal conductivity of rotation and vibration for each molecular species From 80adedd646d93b173840fef1bf1c2e81f2898995 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Wed, 9 Aug 2023 17:31:35 +0200 Subject: [PATCH 35/41] BGK some small stuff + exits to do while loops --- src/particles/bgk/bgk_colloperator.f90 | 69 ++++++++++++++------------ src/particles/bgk/bgk_init.f90 | 17 ++++--- src/particles/bgk/bgk_main.f90 | 2 +- 3 files changed, 48 insertions(+), 40 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index d6f29cce7..4b7841268 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -131,6 +131,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! totalWeight contains the weighted particle number dens = totalWeight / NodeVolume ELSE + ! MPF is the same for all species dens = totalWeight * Species(1)%MacroParticleFactor / NodeVolume END IF @@ -168,7 +169,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 87f ! For SpecBGK(iSpec)%CollFreqPreFactor(jSpec) see bgk_init.f90 ! VHS according to M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic - ! molecules including quantized vibrational energies", Phys. Fluids 30, 116103 (2018), Eq. (18) + ! molecules including quantized vibrational energies", Phys. Fluids 30, 116103 (2018), Eq. (18) - NEW (tbd) collisionfreqSpec(iSpec) = collisionfreqSpec(iSpec) + SpecBGK(iSpec)%CollFreqPreFactor(jSpec) * totalWeightSpec(jSpec) & * (Dens / totalWeight) *CellTemptmp**(-CollInf%omega(iSpec,jSpec) +0.5) END DO @@ -261,19 +262,16 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal VibEnergyDOF, Xi_VibSpecNew, TEqui) END IF -! Remaining vibrational (+ translational) energy + rotational energy for translation and rotation +! Remaining vibrational + translational energy + old rotational energy for translation and rotation OldEn = OldEn + OldEnRot Xi_RotTotal = 0.0 DO iSpec = 1, nSpecies - ! = tbd ======= nRotRelaxSpec or RotRelaxWeightSpec? ======================================================================= + ! Sum of relaxing rotational degrees of freedom Xi_RotTotal = Xi_RotTotal + Xi_RotSpec(iSpec)*RotRelaxWeightSpec(iSpec) - ! ERotTtransSpecMean(iSpec)*RotRelaxWeightSpec(iSpec) is energy that should be in rotation - !OldEn = OldEn - ERotTtransSpecMean(iSpec)*RotRelaxWeightSpec(iSpec) END DO ! 8.) Determine the new particle state and ensure energy conservation by scaling the new velocities with the factor alpha ! Calculation of scaling factor alpha -! = tbd ======= nPart or totalWeight? ======================================================================================== alpha = SQRT(OldEn/NewEn*(3.*(totalWeight-1.))/(Xi_RotTotal+3.*(totalWeight-1.))) ! Calculation of the final particle velocities with vBulkAll (average flow velocity before relaxation), scaling factor alpha, ! the particle velocity PartState(4:6,iPart) after the relaxation but before the energy conservation and vBulk (average value of @@ -300,11 +298,9 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! 9.) Rotation: Scale the new rotational state of the molecules to ensure energy conservation DO iSpec = 1, nSpecies ! Calculate scaling factor alpha per species, see M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross- - ! Krook method to diatomic molecules including quantized vibrational energies", Phys. Fluids 30, 116103 (2018) + ! Krook method to diatomic molecules including quantized vibrational energies", Phys. Fluids 30, 116103 (2018) - NEW (tbd) IF (NewEnRot(iSpec).GT.0.0) THEN - ! = tbd ======= nRotRelaxSpec or RotRelaxWeightSpec? nPart or totalWeight? ================================================ alphaRot(iSpec) = OldEn/NewEnRot(iSpec)*(Xi_RotSpec(iSpec)*RotRelaxWeightSpec(iSpec)/(Xi_RotTotal+3.*(totalWeight-1.))) - !alphaRot(iSpec) = ERotTtransSpecMean(iSpec)*RotRelaxWeightSpec(iSpec)/NewEnRot(iSpec) ELSE alphaRot(iSpec) = 0.0 END IF @@ -625,7 +621,7 @@ SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, T ELSE ! diatomic ! Calculation of vibrational temperature and DOFs from Pfeiffer, Physics of Fluids 30, 116103 (2018), "Extending the ! particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules including quantized vibrational - ! energies" + ! energies" - check ref (tbd) ! TVibSpec = vibrational energy without zero-point energy TVibSpec(iSpec) = EVibSpec(iSpec) / (totalWeightSpec(iSpec)*BoltzmannConst*SpecDSMC(iSpec)%CharaTVib) IF (TVibSpec(iSpec).GT.0.0) TVibSpec(iSpec) = SpecDSMC(iSpec)%CharaTVib/LOG(1. + 1./(TVibSpec(iSpec))) @@ -805,7 +801,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe REAL, INTENT(OUT) :: betaR(nSpecies), betaV(nSpecies) !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES -INTEGER :: iSpec, iDOF, iPolyatMole +INTEGER :: iSpec, iDOF, iPolyatMole, i, j REAL :: RotFracSpec(nSpecies), VibFracSpec(nSpecies) REAL :: ERotSpecMean(nSpecies), EVibSpecMean(nSpecies), ETransRelMean REAL :: ERotTtransSpecMean(nSpecies), EVibTtransSpecMean(nSpecies) @@ -885,8 +881,10 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe END DO TEqui = TEquiNum/TEquiDenom +i=0 ! Solving of equation system until accuracy eps_prec is reached -DO WHILE ( ABS( TEqui - TEqui_Old ) .GT. eps_prec ) +outerLoop: DO WHILE ( ABS( TEqui - TEqui_Old ) .GT. eps_prec ) + i = i + 1 DO iSpec = 1, nSpecies IF((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN ! if difference small: equilibrium, no beta @@ -957,8 +955,10 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe END DO TEqui = TEquiNum/TEquiDenom IF(BGKDoVibRelaxation) THEN + j=0 ! accuracy eps_prec not reached yet - DO WHILE ( ABS( TEqui - TEqui_Old2 ) .GT. eps_prec ) + innerLoop: DO WHILE ( ABS( TEqui - TEqui_Old2 ) .GT. eps_prec ) + j=j+1 ! mean value of old and new equilibrium temperature TEqui = (TEqui + TEqui_Old2) * 0.5 DO iSpec = 1, nSpecies @@ -1005,9 +1005,11 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe END IF END DO TEqui = TEquiNum/TEquiDenom - END DO + IF (j.EQ.30) EXIT innerLoop + END DO innerLoop END IF -END DO + IF (i.EQ.30) EXIT outerLoop +END DO outerLoop END SUBROUTINE CalcTRelax @@ -1269,7 +1271,7 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, A(2,1)=A(1,2) A(3,1)=A(1,3) A(3,2)=A(2,3) - CALL MetropolisES(nRelax, iRanPart, A) + CALL MetropolisES(nRelax, iRanPart, A*MassIC_Mixture, CellTempRel) END IF END IF @@ -1297,7 +1299,7 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, PartState(4:6,iPart) = vBulkAll(1:3) + MATMUL(SMat,tempVelo) ELSE IF ((BGKCollModel.EQ.1).AND.(ESBGKModel.EQ.3)) THEN ! New thermal velocity (in x,y,z) of particle with mass scaling multiplied by normal distributed random vector - PartState(4:6,iPart) = vBulkAll(1:3) + SQRT(MassIC_Mixture/Species(iSpec)%MassIC)*iRanPart(1:3,iLoop) + PartState(4:6,iPart) = vBulkAll(1:3) + SQRT(1./Species(iSpec)%MassIC)*iRanPart(1:3,iLoop) ELSE ! New thermal velocity (in x,y,z) of particle is sqrt(k_B*T/m) multiplied by normal distributed random vector PartState(4:6,iPart) = vBulkAll(1:3) + SQRT(BoltzmannConst*CellTempRel/Species(iSpec)%MassIC)*iRanPart(1:3,iLoop) @@ -1346,8 +1348,7 @@ SUBROUTINE EnergyConsVib(nPart, totalWeight, nVibRelax, VibRelaxWeightSpec, iPar IF (ANY(NewEnVib.GT.0.0).AND.(nVibRelax.GT.0)) THEN Xi_VibTotal = 0.0 DO iSpec = 1, nSpecies - ! Total number of relaxing vibrational degrees of freedom - ! = tbd ======= nVibRelaxSpec or VibRelaxWeightSpec? nPart or totalWeight for alpha? ======================================= + ! Sum of relaxing vibrational degrees of freedom Xi_VibTotal = Xi_VibTotal + Xi_VibSpec(iSpec)*VibRelaxWeightSpec(iSpec) END DO ! Calculate scaling factor alpha per species @@ -1466,44 +1467,46 @@ SUBROUTINE EnergyConsVib(nPart, totalWeight, nVibRelax, VibRelaxWeightSpec, iPar END SUBROUTINE EnergyConsVib -SUBROUTINE MetropolisES(nPart, iRanPart, A) +SUBROUTINE MetropolisES(nPart, iRanPart, A, CellTempRel) !=================================================================================================================================== !> Sampling from ESBGK target distribution function by using a Metropolis-Hastings method !=================================================================================================================================== ! MODULES USE Ziggurat -USE MOD_Basis ,ONLY: INV33 +USE MOD_Basis ,ONLY: INV33 +USE MOD_Globals_Vars ,ONLY: BoltzmannConst ! IMPLICIT VARIABLE HANDLING IMPLICIT NONE !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT VARIABLES INTEGER, INTENT(IN) :: nPart -REAL, INTENT(IN) :: A(3,3) +REAL, INTENT(IN) :: A(3,3), CellTempRel !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES REAL, INTENT(OUT) :: iRanPart(:,:) !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES -REAL :: iRanPartTemp(3), V2, iRan, NewProb, OldProb, NormProb +REAL :: iRanPartTemp(3), V2, iRan, NewProb, OldProb, NormProb, prefacor INTEGER :: iLoop, iPart, iRun LOGICAL :: Changed REAL :: AC(3), AInvers(3,3), detA !=================================================================================================================================== ! Generate normal distributed random vector as start vector for the thermal velocity -iRanPart(1,1) = rnor() -iRanPart(2,1) = rnor() -iRanPart(3,1) = rnor() +prefacor = SQRT(BoltzmannConst*CellTempRel) +iRanPart(1,1) = rnor()*prefacor +iRanPart(2,1) = rnor()*prefacor +iRanPart(3,1) = rnor()*prefacor ! Inverse matrix of A -CALL INV33(A,AInvers, detA) +CALL INV33(A, AInvers, detA) AC(1:3) = MATMUL(AInvers, iRanPart(1:3,1)) V2 = iRanPart(1,1)*AC(1) + iRanPart(2,1)*AC(2) + iRanPart(3,1)*AC(3) OldProb = EXP(-0.5*V2) ! Burn-in phase, 35 initial steps DO iLoop = 1, 35 ! Generate normal distributed random vector for the thermal velocity - iRanPartTemp(1) = rnor() - iRanPartTemp(2) = rnor() - iRanPartTemp(3) = rnor() + iRanPartTemp(1) = rnor()*prefacor + iRanPartTemp(2) = rnor()*prefacor + iRanPartTemp(3) = rnor()*prefacor AC(1:3) = MATMUL(AInvers, iRanPartTemp(1:3)) V2 = iRanPartTemp(1)*AC(1) + iRanPartTemp(2)*AC(2) + iRanPartTemp(3)*AC(3) NewProb = EXP(-0.5*V2) @@ -1527,9 +1530,9 @@ SUBROUTINE MetropolisES(nPart, iRanPart, A) DO WHILE ((iRun.LT.10).OR.(.NOT.Changed)) iRun = iRun + 1 ! Generate normal distributed random vector for the thermal velocity - iRanPartTemp(1) = rnor() - iRanPartTemp(2) = rnor() - iRanPartTemp(3) = rnor() + iRanPartTemp(1) = rnor()*prefacor + iRanPartTemp(2) = rnor()*prefacor + iRanPartTemp(3) = rnor()*prefacor AC(1:3) = MATMUL(AInvers, iRanPartTemp(1:3)) V2 = iRanPartTemp(1)*AC(1) + iRanPartTemp(2)*AC(2) + iRanPartTemp(3)*AC(3) NewProb = EXP(-0.5*V2) diff --git a/src/particles/bgk/bgk_init.f90 b/src/particles/bgk/bgk_init.f90 index 7bd5d6f93..1d8fcae12 100644 --- a/src/particles/bgk/bgk_init.f90 +++ b/src/particles/bgk/bgk_init.f90 @@ -68,7 +68,7 @@ SUBROUTINE DefineParametersBGK() 'cell refinement') CALL prms%CreateLogicalOption('Particles-BGK-MovingAverage', 'Enable a moving average of variables for the calculation '//& 'of the cell temperature for relaxation frequencies','.FALSE.') -CALL prms%CreateRealOption( 'Particles-BGK-MovingAverageFac', 'Use the moving average of moments M with '//& +CALL prms%CreateRealOption( 'Particles-BGK-MovingAverageFac', 'Use the moving average of moments M with '//& 'M^n+1=AverageFac*M+(1-AverageFac)*M^n','0.01') CALL prms%CreateRealOption( 'Particles-BGK-SplittingDens', 'Octree-refinement will only be performed above this number '//& 'density', '0.0') @@ -128,32 +128,35 @@ SUBROUTINE InitBGK() BGKCollModel = GETINT('Particles-BGK-CollModel') IF ((nSpecies.GT.1).AND.(BGKCollModel.GT.1)) THEN - CALL abort(__STAMP__,' ERROR Multispec only with ESBGK model!') + CALL abort(__STAMP__,'ERROR Multispec only with ESBGK model!') END IF BGKMixtureModel = GETINT('Particles-BGK-MixtureModel') -! ESBGK options -ESBGKModel = GETINT('Particles-ESBGK-Model') ! 1: Approximative, 2: Exact, 3: MetropolisHastings +! ESBGK options for sampling: 1: Approximative, 2: Exact, 3: MetropolisHastings +ESBGKModel = GETINT('Particles-ESBGK-Model') + ! Coupled BGK with DSMC, use a number density as limit above which BGK is used, and below which DSMC is used CoupledBGKDSMC = GETLOGICAL('Particles-CoupledBGKDSMC') IF(CoupledBGKDSMC) THEN IF (DoVirtualCellMerge) THEN - CALL abort(__STAMP__,' Virtual cell merge not implemented for coupled DSMC-BGK simulations!') + CALL abort(__STAMP__,'Virtual cell merge not implemented for coupled DSMC-BGK simulations!') END IF BGKDSMCSwitchDens = GETREAL('Particles-BGK-DSMC-SwitchDens') ELSE IF(RadialWeighting%DoRadialWeighting) RadialWeighting%PerformCloning = .TRUE. END IF + ! Octree-based cell refinement, up to a certain number of particles DoBGKCellAdaptation = GETLOGICAL('Particles-BGK-DoCellAdaptation') IF(DoBGKCellAdaptation) THEN BGKMinPartPerCell = GETINT('Particles-BGK-MinPartsPerCell') IF(.NOT.DSMC%UseOctree) THEN DSMC%UseOctree = .TRUE. - IF(NGeo.GT.PP_N) CALL abort(__STAMP__,' Set PP_N to NGeo, otherwise the volume is not computed correctly.') + IF(NGeo.GT.PP_N) CALL abort(__STAMP__,'Set PP_N to NGeo, otherwise the volume is not computed correctly.') CALL DSMC_init_octree() END IF END IF BGKSplittingDens = GETREAL('Particles-BGK-SplittingDens') + ! Moving Average BGKMovingAverage = GETLOGICAL('Particles-BGK-MovingAverage') IF(BGKMovingAverage) THEN @@ -162,6 +165,7 @@ SUBROUTINE InitBGK() CALL BGK_init_MovingAverage() IF(nSpecies.GT.1) CALL abort(__STAMP__,'nSpecies >1 and molecules not implemented for BGK averaging!') END IF + IF(MoleculePresent) THEN ! Vibrational modelling BGKDoVibRelaxation = GETLOGICAL('Particles-BGK-DoVibRelaxation') @@ -237,6 +241,7 @@ SUBROUTINE FinalizeBGK() END SUBROUTINE FinalizeBGK + SUBROUTINE DeleteElemNodeAverage() !----------------------------------------------------------------------------------------------------------------------------------! ! Delete the pointer tree ElemNodeVol diff --git a/src/particles/bgk/bgk_main.f90 b/src/particles/bgk/bgk_main.f90 index 2ffa679bd..d856dd6dc 100644 --- a/src/particles/bgk/bgk_main.f90 +++ b/src/particles/bgk/bgk_main.f90 @@ -132,7 +132,7 @@ SUBROUTINE BGK_DSMC_main(stage_opt) BGK_PrandtlNumber=0.; BGK_ExpectedPrandtlNumber=0.; BGK_Viscosity=0.; BGK_ThermalConductivity=0. END IF IF (BGKMovingAverage) THEN - CALL BGK_CollisionOperator(iPartIndx_Node, nPart, ElemVolume_Shared(CNElemID), ElemNodeAveraging(iElem)%Root%AverageValues(:)) + CALL BGK_CollisionOperator(iPartIndx_Node, nPart, ElemVolume_Shared(CNElemID), ElemNodeAveraging(iElem)%Root%AverageValues(:)) ELSE CALL BGK_CollisionOperator(iPartIndx_Node, nPart, ElemVolume_Shared(CNElemID)) END IF From dae6588890e350b6a9485961d689908c9ac9a60e Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Fri, 11 Aug 2023 11:47:15 +0200 Subject: [PATCH 36/41] BGK colloperator comments + new references --- src/particles/bgk/bgk_colloperator.f90 | 34 ++++++++++++++++---------- 1 file changed, 21 insertions(+), 13 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index 4b7841268..bce073021 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -169,7 +169,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 87f ! For SpecBGK(iSpec)%CollFreqPreFactor(jSpec) see bgk_init.f90 ! VHS according to M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic - ! molecules including quantized vibrational energies", Phys. Fluids 30, 116103 (2018), Eq. (18) - NEW (tbd) + ! molecules including quantized vibrational energies", Phys. Fluids 30, 116103 (2018), Eq. (18) collisionfreqSpec(iSpec) = collisionfreqSpec(iSpec) + SpecBGK(iSpec)%CollFreqPreFactor(jSpec) * totalWeightSpec(jSpec) & * (Dens / totalWeight) *CellTemptmp**(-CollInf%omega(iSpec,jSpec) +0.5) END DO @@ -297,8 +297,8 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal ! 9.) Rotation: Scale the new rotational state of the molecules to ensure energy conservation DO iSpec = 1, nSpecies - ! Calculate scaling factor alpha per species, see M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross- - ! Krook method to diatomic molecules including quantized vibrational energies", Phys. Fluids 30, 116103 (2018) - NEW (tbd) + ! Calculate scaling factor alpha per species, see F. Hild, M. Pfeiffer, "Multi-species modeling in the particle-based ellipsoidal + ! statistical Bhatnagar-Gross-Krook method including internal degrees of freedom", subitted to Phys. Fluids, August 2023 IF (NewEnRot(iSpec).GT.0.0) THEN alphaRot(iSpec) = OldEn/NewEnRot(iSpec)*(Xi_RotSpec(iSpec)*RotRelaxWeightSpec(iSpec)/(Xi_RotTotal+3.*(totalWeight-1.))) ELSE @@ -621,7 +621,7 @@ SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, T ELSE ! diatomic ! Calculation of vibrational temperature and DOFs from Pfeiffer, Physics of Fluids 30, 116103 (2018), "Extending the ! particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules including quantized vibrational - ! energies" - check ref (tbd) + ! energies" ! TVibSpec = vibrational energy without zero-point energy TVibSpec(iSpec) = EVibSpec(iSpec) / (totalWeightSpec(iSpec)*BoltzmannConst*SpecDSMC(iSpec)%CharaTVib) IF (TVibSpec(iSpec).GT.0.0) TVibSpec(iSpec) = SpecDSMC(iSpec)%CharaTVib/LOG(1. + 1./(TVibSpec(iSpec))) @@ -677,10 +677,9 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight C_P = 0.0 DO iSpec = 1, nSpecies IF (nSpec(iSpec).EQ.0) CYCLE - ! Correction of Pr for calculation of relaxation frequency, see alpha - Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), - ! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar-Gross-Krook method for monatomic gas species" - ! Extension for inner degrees of freedom using S. Brull, Communications in Mathematical Sciences 19, 2177-2194, 2021, - ! "An Ellipsoidal Statistical Model for a monoatomic and polyatomic gas mixture" + ! Correction of Pr for calculation of relaxation frequency, see alpha - F. Hild, M. Pfeiffer, "Multi-species modeling in the + ! particle-based ellipsoidal statistical Bhatnagar-Gross-Krook method including internal degrees of freedom", subitted to Phys. + ! Fluids, August 2023 PrandtlCorrection = PrandtlCorrection + DOFFraction(iSpec)*MassIC_Mixture/Species(iSpec)%MassIC/TotalDOFWeight C_P = C_P + ((5. + (Xi_VibSpec(iSpec)+Xi_RotSpec(iSpec)))/2.) * BoltzmannConst / Species(iSpec)%MassIC * MassFraction(iSpec) END DO @@ -688,6 +687,8 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight SELECT CASE(BGKMixtureModel) ! Both cases are described in Pfeiffer et. al., Physics of Fluids 33, 036106 (2021), ! "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar-Gross-Krook method for monatomic gas species" + ! Extension to poyatomic mixtures according to F. Hild, M. Pfeiffer, "Multi-species modeling in the particle-based ellipsoidal + ! statistical Bhatnagar-Gross-Krook method including internal degrees of freedom", subitted to Phys. Fluids, August 2023 CASE (1) ! Wilke's mixing rules DO iSpec = 1, nSpecies @@ -810,6 +811,8 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe !=================================================================================================================================== ! According to J. Mathiaud et. al., "An ES-BGK model for diatomic gases with correct relaxation rates for internal energies", ! European Journal of Mechanics - B/Fluids, 96, pp. 65-77, 2022 +! For implentation, see F. Hild, M. Pfeiffer, "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar-Gross- +! Krook method including internal degrees of freedom", subitted to Phys. Fluids, August 2023 RotFracSpec=0.0; VibFracSpec=0.0; Xi_vib_DOF=0.0; Xi_VibSpecNew=0.0; betaR=1.0; betaV=1.0 ERotSpecMean=0.0; ERotTtransSpecMean=0.0; EVibSpecMean=0.0; EVibTtransSpecMean=0.0; ETransRelMean=0.0; CellTempRel=0.0 @@ -1051,6 +1054,8 @@ SUBROUTINE DetermineRelaxPart(nPart, iPartIndx_Node, relaxfreq, dtCell, nRelax, ! Calculate probability of relaxation of a particle towards the target distribution function ProbAddPartTrans = 1.-EXP(-relaxfreq*dtCell) ! Calculate probabilities of relaxation of a particle in the rotation and vibration +! See F. Hild, M. Pfeiffer, "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar-Gross-Krook method +! including internal degrees of freedom", subitted to Phys. Fluids, August 2023 ProbAddPartRot(:) = ProbAddPartTrans * rotrelaxfreqSpec(:)/relaxfreq*betaR(:) ProbAddPartVib(:) = ProbAddPartTrans * vibrelaxfreqSpec(:)/relaxfreq*betaV(:) @@ -1201,7 +1206,9 @@ SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, REAL :: iRanPart(3, nRelax), A(3,3), KronDelta, SMat(3,3), W(3), Work(100), tempVelo(3), partWeight !=================================================================================================================================== ! According to M. Pfeiffer, "Particle-based fluid dynamics: Comparison of different Bhatnagar-Gross-Krook models and the direct -! simulation Monte Carlo method for hypersonic flows", Phys. Fluids 30, 106106 (2018) +! simulation Monte Carlo method for hypersonic flows", Phys. Fluids 30, 106106 (2018) and F. Hild, M. Pfeiffer, "Multi-species +! modeling in the particle-based ellipsoidal statistical Bhatnagar-Gross-Krook method including internal degrees of freedom", +! subitted to Phys. Fluids, August 2023 IF (nRelax.GT.0) THEN SELECT CASE(BGKCollModel) CASE (1) ! Ellipsoidal Statistical BGK @@ -1341,8 +1348,8 @@ SUBROUTINE EnergyConsVib(nPart, totalWeight, nVibRelax, VibRelaxWeightSpec, iPar INTEGER :: iPart, iLoop, iDOF, iSpec, iQuant, iQuaMax, iPolyatMole REAL :: Xi_VibTotal, alpha(nSpecies), partWeight, betaV, iRan, MaxColQua !=================================================================================================================================== -! According to M. Pfeiffer, "Extending the particle ellipsoidal statistical Bhatnagar-Gross-Krook method to diatomic molecules -! including quantized vibrational energies", Phys. Fluids 30, 116103 (2018) +! According to F. Hild, M. Pfeiffer, "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar-Gross-Krook +! method including internal degrees of freedom", subitted to Phys. Fluids, August 2023 IF(BGKDoVibRelaxation) THEN ! Vibrational energy is positive for at least one species + there are vibrational relaxations IF (ANY(NewEnVib.GT.0.0).AND.(nVibRelax.GT.0)) THEN @@ -1356,7 +1363,6 @@ SUBROUTINE EnergyConsVib(nPart, totalWeight, nVibRelax, VibRelaxWeightSpec, iPar DO iSpec = 1, nSpecies IF (NewEnVib(iSpec).GT.0.0) THEN alpha(iSpec) = OldEn/NewEnVib(iSpec)*(Xi_VibSpec(iSpec)*VibRelaxWeightSpec(iSpec)/(3.*(totalWeight-1.)+Xi_VibTotal)) - !alpha(iSpec) = EVibTtransSpecMean(iSpec)*VibRelaxWeightSpec(iSpec)/NewEnVib(iSpec) ELSE alpha(iSpec) = 0. END IF @@ -1683,7 +1689,7 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ ! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 160 ViscSpec(iSpec) = (5./8.)*(BoltzmannConst*CellTemp(iSpec))/Sigma_22 ThermalCondSpec(iSpec) = (25./16.)*(cv*BoltzmannConst*CellTemp(iSpec))/Sigma_22 - ! results in in same as ThermalCondSpec(iSpec) = (15./4.)*BoltzmannConst/(2.*Mass)*ViscSpec(iSpec) + ! Results in the same as ThermalCondSpec(iSpec) = (15./4.)*BoltzmannConst/(2.*Mass)*ViscSpec(iSpec) ! Additional calculation of Sigma_11VHS and the diffusion coefficient for molecular species IF ((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN CALL CalcSigma_11VHS(CellTemp(nSpecies+1), InteractDiam, Mass, TVHS, omegaVHS, Sigma_11) @@ -1712,6 +1718,8 @@ SUBROUTINE CalcViscosityThermalCondColIntVHS(CellTemp, Xi, dens, Xi_RotSpec, Xi_ IF ((SpecDSMC(iSpec)%InterID.EQ.2).OR.(SpecDSMC(iSpec)%InterID.EQ.20)) THEN ! Calculation of thermal conductivity of rotation and vibration for each molecular species ! S. Chapman and T.G. Cowling, "The mathematical Theory of Non-Uniform Gases", Cambridge University Press, 1970, S. 254f + ! F. Hild, M. Pfeiffer, "Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar-Gross-Krook method + ! including internal degrees of freedom", subitted to Phys. Fluids, August 2023 Xi_Dij_tot = SUM(Xj_Dij(iSpec,:)) rhoSpec = dens * Species(iSpec)%MassIC * Xi(iSpec) ThermalCondSpec_Rot(iSpec) = (rhoSpec*cv_rot/Xi_Dij_tot) From 5e40b73ce2f2e10e63f0f6dab00dfa995f216a9c Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Tue, 22 Aug 2023 15:35:00 +0200 Subject: [PATCH 37/41] BGK clean-up warnings (unused variables) --- src/particles/bgk/bgk_colloperator.f90 | 28 +++++++++++++------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/particles/bgk/bgk_colloperator.f90 b/src/particles/bgk/bgk_colloperator.f90 index bce073021..fb1a8cf74 100644 --- a/src/particles/bgk/bgk_colloperator.f90 +++ b/src/particles/bgk/bgk_colloperator.f90 @@ -142,8 +142,8 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal CALL CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, TRotSpec, InnerDOF, Xi_VibSpec, Xi_RotSpec) ! 2.) Calculation of the relaxation frequency of the distribution function towards the target distribution function -CALL CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight, TotalMass, u2Spec, u0ij, u2, SpecTemp, CellTemp, & - Xi_VibSpec, Xi_RotSpec, Prandtl, relaxfreq, dynamicvis, thermalcond, MassIC_Mixture) +CALL CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight, TotalMass, u2Spec, SpecTemp, CellTemp, Xi_VibSpec, & + Xi_RotSpec, Prandtl, relaxfreq, dynamicvis, thermalcond, MassIC_Mixture) IF(DSMC%CalcQualityFactors) THEN BGK_MeanRelaxFactor = BGK_MeanRelaxFactor + relaxfreq * dtCell @@ -201,7 +201,7 @@ SUBROUTINE BGK_CollisionOperator(iPartIndx_Node, nPart, NodeVolume, AveragingVal END IF END IF -CALL CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpec, totalWeight, totalWeight2, nPart, dtCell, CellTemp, & +CALL CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpec, totalWeight, totalWeight2, dtCell, CellTemp, & TRotSpec, TVibSpec, relaxfreq, rotrelaxfreqSpec, vibrelaxfreqSpec, Xi_VibSpecNew, Xi_vib_DOF, nXiVibDOF, CellTempRel, TEqui, & betaR, betaV) @@ -369,7 +369,7 @@ END SUBROUTINE BGK_CollisionOperator SUBROUTINE CalcMoments(nPart, iPartIndx_Node, nSpec, vBulkAll, totalWeight, totalWeight2, totalWeightSpec, TotalMass, u2, u2Spec, & - u0ij, u2i, OldEn, EVibSpec, ERotSpec, CellTemp, SpecTemp, dtCell) + u0ij, u2i, OldEn, EVibSpec, ERotSpec, CellTemp, SpecTemp, dtCell) !=================================================================================================================================== !> Moment calculation: Summing up the relative velocities and their squares !=================================================================================================================================== @@ -639,7 +639,7 @@ SUBROUTINE CalcInnerDOFs(nSpec, EVibSpec, ERotSpec, totalWeightSpec, TVibSpec, T END SUBROUTINE CalcInnerDOFs -SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight, TotalMass, u2Spec, u0ij, u2, SpecTemp, CellTemp, & +SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight, TotalMass, u2Spec, SpecTemp, CellTemp, & Xi_VibSpec, Xi_RotSpec, Prandtl, relaxfreq, dynamicvis, thermalcond, MassIC_Mixture) !=================================================================================================================================== !> Calculate the reference dynamic viscosity, Prandtl number and the resulting relaxation frequency of the distribution function @@ -655,16 +655,16 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight ! INPUT VARIABLES INTEGER, INTENT(IN) :: nSpec(nSpecies) REAL, INTENT(IN) :: totalWeightSpec(nSpecies), totalWeight, TotalMass, u2Spec(nSpecies), SpecTemp(nSpecies), CellTemp -REAL, INTENT(IN) :: u0ij(3,3), u2, Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies), dens, InnerDOF +REAL, INTENT(IN) :: Xi_VibSpec(nSpecies), Xi_RotSpec(nSpecies), dens, InnerDOF !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES REAL, INTENT(OUT) :: Prandtl, relaxfreq, dynamicvis, thermalcond, MassIC_Mixture !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES -INTEGER :: iSpec, jSpec, INFO +INTEGER :: iSpec, jSpec REAL :: MolarFraction(1:nSpecies), DOFFraction(1:nSpecies), MassFraction(1:nSpecies) REAL :: PrandtlCorrection, dynamicvisSpec(nSpecies), thermalcondSpec(nSpecies), Phi(nSpecies) -REAL :: TotalDOFWeight, C_P, nu, A(3,3), W(3), Theta, CellTempSpec(nSpecies+1), Work(100) +REAL :: TotalDOFWeight, C_P, CellTempSpec(nSpecies+1) !=================================================================================================================================== MassIC_Mixture = TotalMass / totalWeight IF (nSpecies.GT.1) THEN ! gas mixture @@ -775,9 +775,9 @@ SUBROUTINE CalcGasProperties(nSpec, dens, InnerDOF, totalWeightSpec, totalWeight END SUBROUTINE CalcGasProperties -SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpec, totalWeight, totalWeight2, nPart, dtCell, & - CellTemp, TRotSpec, TVibSpec, relaxfreq, rotrelaxfreqSpec, vibrelaxfreqSpec, Xi_VibSpecNew, Xi_vib_DOF, nXiVibDOF, & - CellTempRel, TEqui, betaR, betaV) +SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpec, totalWeight, totalWeight2, dtCell, CellTemp, & + TRotSpec, TVibSpec, relaxfreq, rotrelaxfreqSpec, vibrelaxfreqSpec, Xi_VibSpecNew, Xi_vib_DOF, nXiVibDOF, CellTempRel, TEqui, & + betaR, betaV) !=================================================================================================================================== !> Calculate the relaxation energies and temperatures !=================================================================================================================================== @@ -791,7 +791,7 @@ SUBROUTINE CalcTRelax(ERotSpec, Xi_RotSpec, Xi_VibSpec, EVibSpec, totalWeightSpe IMPLICIT NONE !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT VARIABLES -INTEGER, INTENT(IN) :: nPart, nXiVibDOF +INTEGER, INTENT(IN) :: nXiVibDOF REAL, INTENT(IN) :: TRotSpec(nSpecies), ERotSpec(nSpecies), Xi_RotSpec(nSpecies) REAL, INTENT(IN) :: TVibSpec(nSpecies), EVibSpec(nSpecies), Xi_VibSpec(nSpecies) REAL, INTENT(IN) :: totalWeightSpec(nSpecies), totalWeight, totalWeight2, CellTemp, dtCell @@ -1181,7 +1181,7 @@ END SUBROUTINE RelaxInnerEnergy SUBROUTINE SampleFromTargetDistr(nRelax, iPartIndx_NodeRelax, Prandtl, u2, u0ij, u2i, vBulkAll, CellTempRel, CellTemp, vBulk, & - MassIC_Mixture) + MassIC_Mixture) !=================================================================================================================================== !> Sample new particle velocities from the target distribution function, depending on the chosen model !=================================================================================================================================== @@ -1322,7 +1322,7 @@ END SUBROUTINE SampleFromTargetDistr SUBROUTINE EnergyConsVib(nPart, totalWeight, nVibRelax, VibRelaxWeightSpec, iPartIndx_NodeRelaxVib, NewEnVib, OldEn, nXiVibDOF, & - VibEnergyDOF, Xi_VibSpec, TEqui) + VibEnergyDOF, Xi_VibSpec, TEqui) !=================================================================================================================================== !> Routine to ensure energy conservation when including vibrational degrees of freedom (continuous and quantized) !=================================================================================================================================== From 17963feceaffbb7cb062c174dcef5b6f15b3ab83 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Wed, 30 Aug 2023 11:55:22 +0200 Subject: [PATCH 38/41] BGK userguide update --- docs/documentation/references.bib | 11 +++- .../Bhatnagar-Gross-Krook.md | 56 +++++++------------ 2 files changed, 30 insertions(+), 37 deletions(-) diff --git a/docs/documentation/references.bib b/docs/documentation/references.bib index 1c72dd77e..4fcca4049 100644 --- a/docs/documentation/references.bib +++ b/docs/documentation/references.bib @@ -66,6 +66,15 @@ @article{Pfeiffer2018b volume = {30}, year = {2018} } +@ARTICLE{Pfeiffer2021, +author = {Pfeiffer, Marcel and Mirza, Asim and Nizenkov, Paul}, +year = "2021", +journal = "Physics of Fluids", +volume = "33", +pages = "036106", +doi = "10.1063/5.0037915", +title = {{Multi-species modeling in the particle-based ellipsoidal statistical Bhatnagar–Gross–Krook method for monatomic gas species}}, +} @article{Jun2019, author = {Jun, Eunji and Pfeiffer, Marcel and Mieussens, Luc and Gorji, M. Hossein}, @@ -336,7 +345,7 @@ @article{Abe1994 } @phdthesis{Farbar2010, -author = {Farbar, Erin D.}, +author = {Farbar, Erin D.}, title = {Kinetic Simulation of Rarefied and Weakly Ionized Hypersonic Flow Fields.}, school = {University of Michigan, Horace H. Rackham School of Graduate Studies}, year = 2010, diff --git a/docs/documentation/userguide/features-and-models/Bhatnagar-Gross-Krook.md b/docs/documentation/userguide/features-and-models/Bhatnagar-Gross-Krook.md index 720795cfc..3527840a0 100644 --- a/docs/documentation/userguide/features-and-models/Bhatnagar-Gross-Krook.md +++ b/docs/documentation/userguide/features-and-models/Bhatnagar-Gross-Krook.md @@ -2,7 +2,7 @@ # Bhatnagar-Gross-Krook Collision Operator The implementation of the BGK-based collision operator is based on the publications by {cite}`Pfeiffer2018a` and {cite}`Pfeiffer2018b`. -It allows the simulation of gas flows in the continuum and transitional regime, where the DSMC method is computationally too expensive. +It allows the simulation of gas flows in the continuum and transitional regimes, where the DSMC method is computationally too expensive. The collision integral is hereby approximated by a relaxation process: $$ \left.\frac{\partial f}{\partial t}\right|_{\mathrm{coll}} \approx \nu(f^t-f), $$ @@ -11,74 +11,59 @@ where $f^t$ is the target distribution function and $\nu$ the relaxation frequen The current implementation supports: -- 3 different methods (i.e. different target distribution functions): Ellipsoidal Statistical, Shakov, and standard BGK -- Single species, monatomic and polyatomic gases -- Multi species, monatomic and diatomic gas mixtures +- Three different BGK methods (i.e. different target distribution functions): Ellipsoidal Statistical, Shakov, and standard BGK +- Single species: monatomic, diatomic, and polyatomic gases +- Gas mixtures with an arbitrary number of monatomic, diatomic, and polyatomic species - Thermal non-equilibrium with rotational and vibrational excitation (continuous or quantized treatment) -- 2D/Axisymmetric simulations +- 2D axisymmetric simulations - Variable time step (adaption of the distribution according to the maximal relaxation factor and linear scaling) Relevant publications of the developers: - Implementation and comparison of the ESBGK, SBGK, and Unified models in PICLas for atomic species {cite}`Pfeiffer2018a` -- Extension of the modelling to diatomic species including quantized vibrational energy treatment, validation of ESBGK with the Mach -20 hypersonic flow measurements of the heat flux on a $70^\circ$ cone {cite}`Pfeiffer2018b` -- Simulation of a nozzle expansion (including the pressure chamber) with ESBGK, SBGK and coupled ESBGK-DSMC, comparison to experimental -measurements {cite}`Pfeiffer2019a`,{cite}`Pfeiffer2019b` -- Extension to polyatomic molecules, simulation of the carbon dioxide hypersonic flow around a flat-faced cylinder, comparison of -ESBGK, SBGK and DSMC regarding the shock structure and heat flux {cite}`Pfeiffer2019c` -- Implemention of Brull's multi-species modelling using Wilke's mixture rules and collision integrals for the calculation of -transport coefficients (under review) +- Extension of the modeling to diatomic species including quantized vibrational energy treatment, validation of ESBGK with the Mach 20 hypersonic flow measurements of the heat flux on a $70^\circ$ cone {cite}`Pfeiffer2018b` +- Simulation of a nozzle expansion (including the pressure chamber) with ESBGK, SBGK and coupled ESBGK-DSMC, comparison to experimental measurements {cite}`Pfeiffer2019a`,{cite}`Pfeiffer2019b` +- Extension to polyatomic molecules, simulation of the carbon dioxide hypersonic flow around a flat-faced cylinder, comparison of ESBGK, SBGK and DSMC regarding the shock structure and heat flux {cite}`Pfeiffer2019c` +- Implemention of Brull's multi-species modeling for monatomic gas mixtures using Wilke's mixture rules and collision integrals for the calculation of transport coefficients {cite}`Pfeiffer2021` +- Extension of the implementation of Brull's ESBGK multi-species model to diatomic gas mixtures using Wilke's mixture rules (under review) +- Extension of the ESBGK method to multi-species modeling of polyatomic molecules, based on the ESBGK models of Mathiaud, Mieussens, Pfeiffer, and Brull, and including internal energies with multiple vibrational degrees of freedom, using Wilke's mixture rules and collision integrals in comparison (under review) To enable the simulation with the BGK module, the respective compiler setting has to be activated: PICLAS_TIMEDISCMETHOD = BGK-Flow -A parameter file and species initialization file is required, analogous to the DSMC setup. It is recommended to utilize a previous -DSMC parameter file to ensure a complete simulation setup. To enable the simulation with the BGK methods, select the BGK method, -ES (`= 1`), Shakov (`= 2`), and standard BGK (`= 3`): +A parameter file and species initialization file is required, analogous to the DSMC setup. It is recommended to utilize a previous DSMC parameter file to ensure a complete simulation setup. To enable the simulation with the BGK methods, select the BGK method, ES (`= 1`), Shakov (`= 2`), and standard BGK (`= 3`): Particles-BGK-CollModel = 1 -The **recommended method is ESBGK**. If the simulation contains a gas mixture, a choice for the determination of the transport -coefficients is available. The first model uses Wilke's mixture rules (`= 1`) to calculate the gas mixture viscosity and thermal -conductivity. The second model utilizes collision integrals (derived for the VHS model, `= 2`) to calculate these mixture properties. -While both allow mixtures with three or more components, only the implementation of Wilke's mixing rules allows diatomic molecules. +The **recommended method is ESBGK**. If the simulation contains a gas mixture, a choice for the determination of the transport coefficients is available. The first model uses Wilke's mixture rules (`= 1`) to calculate the gas mixture viscosity and thermal conductivity. The second model utilizes collision integrals (derived for the VHS model, `= 2`) to calculate these mixture properties. Particles-BGK-MixtureModel = 1 -The vibrational excitation can be controlled with the following flags, including the choice between continuous and quantized -vibrational energy. Quantized vibrational energy levels are currently only available for the single-species implementation. +The vibrational excitation can be controlled with the following flags, including the choice between continuous and quantized vibrational energy. Particles-BGK-DoVibRelaxation = T Particles-BGK-UseQuantVibEn = T -An octree cell refinement until the given number of particles is reached can be utilized, which corresponds to an equal refinement -in all three directions (x,y,z): +An octree cell refinement can be utilized until the given number of particles is reached, which corresponds to an equal refinement in all three directions (x,y,z): Particles-BGK-DoCellAdaptation = T Particles-BGK-MinPartsPerCell = 10 -It is recommended to utilize at least between 7 and 10 particles per (sub)cell. To enable the cell refinement above a certain number -density, the following option can be utilized +It is recommended to utilize at least between 7 and 10 particles per (sub)cell. To enable the cell refinement above a certain number density, the following option can be utilized: Particles-BGK-SplittingDens = 1E23 -A coupled BGK-DSMC simulation can be enabled, where the BGK method will be utilized if the number density $[\text{m}^{-3}]$ is -above a certain value: +A coupled BGK-DSMC simulation can be enabled, where the BGK method will be utilized if the number density $[\text{m}^{-3}]$ is above a certain value: Particles-CoupledBGKDSMC = T Particles-BGK-DSMC-SwitchDens = 1E22 -The flag `Particles-DSMC-CalcQualityFactors` controls the output of quality factors such as mean/maximal relaxation factor (mean: -average over a cell, max: maximal value within the octree), max rotational relaxation factor, which are defined as +The flag `Particles-DSMC-CalcQualityFactors` controls the output of quality factors such as mean/maximum relaxation factor (mean: average over a cell, max: maximal value within the octree), max. rotational relaxation factor, which are defined as $$ \frac{\Delta t}{\tau} < 1,$$ -where $\Delta t$ is the chosen time step and $1/\tau$ the relaxation frequency. The time step should be chosen as such that the -relaxation factors are below unity. The `BGK_DSMC_Ratio` gives the percentage of the sampled time during which the BGK model was -utilized. In a couple BGK-DSMC simulation this variable indicates the boundary between BGK and DSMC. However, a value below 1 can -occur for pure BGK simulations due to low particle numbers, when an element is skipped. +where $\Delta t$ is the chosen time step and $1/\tau$ the relaxation frequency. The time step should be chosen as such that the relaxation factors are below unity. The `BGK_DSMC_Ratio` gives the percentage of the sampled time during which the BGK model was utilized. In a coupled BGK-DSMC simulation this variable indicates the boundary between BGK and DSMC. However, a value below 1 can occur for pure BGK simulations due to low particle numbers, when an element is skipped. An option is available to utilize a moving average for the variables used in the calculation of the relaxation frequency: @@ -88,7 +73,6 @@ The purpose is to increase the sample size and reduce the noise for steady gas f Particles-BGK-MovingAverageFac = 0.01 -between zero and one must be defined with which the old $M^n$ and newly sampled moments $M$ are weighted -to define the moments for the next time step $M^{n+1}$: +between zero and one must be defined with which the old $M^n$ and newly sampled moments $M$ are weighted to define the moments for the next time step $M^{n+1}$: $$ M^{n+1}=f M+(1-f) M^n.$$ From 381c2d4f5a73b7020eaaef01f5b13202fdb51951 Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Wed, 30 Aug 2023 17:08:56 +0200 Subject: [PATCH 39/41] BGK regressioncheck WEK_BGKFlow: new - Couette CO2-N2, deleted: 70degcone N2-O2, added recommended mixture option in userguide --- REGGIE.md | 4 +- .../Bhatnagar-Gross-Krook.md | 4 +- ...rfState_000.00200000000000000_reference.h5 | Bin 9648 -> 0 bytes .../WEK_BGKFlow/Flow_N2-O2_70degCone/DSMC.ini | 21 --- .../Flow_N2-O2_70degCone/analyze.ini | 7 - .../mesh_70degCone2D_Set1_noWake_mesh.h5 | Bin 203283 -> 0 bytes .../Flow_N2-O2_70degCone/parameter.ini | 156 ------------------ .../Flow_N2-O2_70degCone/readme.md | 4 - .../CouetteFlow_DSMCState_001.000000_ref.h5 | Bin 0 -> 54224 bytes .../DSMC.ini | 26 +++ .../analyze.ini | 8 + .../command_line.ini | 2 +- .../externals.ini | 9 + .../parameter.ini | 136 +++++++++++++++ .../post-vtk-DSMC-conversion/parameter.ini | 1 + .../pre-hopr/hopr.ini | 39 +++++ .../readme.md | 3 + 17 files changed, 227 insertions(+), 193 deletions(-) delete mode 100644 regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/70degCone2D_Set1_DSMCSurfState_000.00200000000000000_reference.h5 delete mode 100644 regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/DSMC.ini delete mode 100644 regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/analyze.ini delete mode 100755 regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/mesh_70degCone2D_Set1_noWake_mesh.h5 delete mode 100644 regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/parameter.ini delete mode 100644 regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/readme.md create mode 100644 regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/CouetteFlow_DSMCState_001.000000_ref.h5 create mode 100644 regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/DSMC.ini create mode 100644 regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/analyze.ini rename regressioncheck/WEK_BGKFlow/{Flow_N2-O2_70degCone => MultiSpec_Supersonic_Couette_CO2-N2}/command_line.ini (76%) create mode 100644 regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/externals.ini create mode 100644 regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/parameter.ini create mode 100644 regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/post-vtk-DSMC-conversion/parameter.ini create mode 100755 regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/pre-hopr/hopr.ini create mode 100644 regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/readme.md diff --git a/REGGIE.md b/REGGIE.md index 589591f98..d62e19251 100644 --- a/REGGIE.md +++ b/REGGIE.md @@ -439,7 +439,7 @@ Overview of the test cases performed every week. | ** | Flow_N2_70degCone | ** | 2D axisymmetric 70 degree cone | nProcs=6 | Surface Sampling, includes CalcSurfaceImpact and adaptive wall temperature | [Link](regressioncheck/WEK_DSMC/Flow_N2_70degCone/readme.md) | | ** | fully_periodic_3D | ** | Periodic boundary conditions in all three directions | nProcs=10,20,30 | Check whether particles end up outside of the domain | [Link](regressioncheck/WEK_DSMC/fully_periodic_3D/readme.md) | | ** | Surface_Sticking_Coefficient | ** | Channel flow with a sticking coefficient model | nProcs=5 | Surface sampling | [Link](regressioncheck/WEK_DSMC/Surface_Sticking_Coefficient/readme.md) | -| 5 | Flow_N2-O2_70degCone | [BGK](regressioncheck/WEK_BGKFlow/builds.ini) | 2D axisymmetric 70 degree cone with a N2-O2 mixture | nProcs=6 | | [Link](regressioncheck/WEK_DSMC/Flow_N2-O2_70degCone/readme.md) | -| ** | Flow_N2_70degCone | ** | 2D axisymmetric 70 degree cone | nProcs=6 | | [Link](regressioncheck/WEK_DSMC/Flow_N2_70degCone/readme.md) | +| 5 | Flow_N2_70degCone | [BGK](regressioncheck/WEK_BGKFlow/builds.ini) | 2D axisymmetric 70 degree cone | nProcs=6 | | [Link](regressioncheck/WEK_DSMC/Flow_N2_70degCone/readme.md) | | ** | MultiSpec_Supersonic_Couette_Ar-He | ** | Supersonic Couette flow with an Ar-He mixture | nProcs=5 | Temperature | [Link](regressioncheck/WEK_DSMC/MultiSpec_Supersonic_Couette_Ar-He/readme.md) | +| ** | MultiSpec_Supersonic_Couette_CO2-N2 | ** | Supersonic Couette flow with a CO2-N2 mixture | nProcs=5 | Temperature | [Link](regressioncheck/WEK_DSMC/MultiSpec_Supersonic_Couette_CO2-N2/readme.md) | | 6 | Flow_N2_70degCone | [FP](regressioncheck/WEK_FPFlow/builds.ini) | 2D axisymmetric 70 degree cone | nProcs=6 | Surface Sampling, includes CalcSurfaceImpact | [Link](regressioncheck/WEK_DSMC/Flow_N2_70degCone/readme.md) | diff --git a/docs/documentation/userguide/features-and-models/Bhatnagar-Gross-Krook.md b/docs/documentation/userguide/features-and-models/Bhatnagar-Gross-Krook.md index 3527840a0..05833f388 100644 --- a/docs/documentation/userguide/features-and-models/Bhatnagar-Gross-Krook.md +++ b/docs/documentation/userguide/features-and-models/Bhatnagar-Gross-Krook.md @@ -36,9 +36,9 @@ A parameter file and species initialization file is required, analogous to the D Particles-BGK-CollModel = 1 -The **recommended method is ESBGK**. If the simulation contains a gas mixture, a choice for the determination of the transport coefficients is available. The first model uses Wilke's mixture rules (`= 1`) to calculate the gas mixture viscosity and thermal conductivity. The second model utilizes collision integrals (derived for the VHS model, `= 2`) to calculate these mixture properties. +The **recommended method is ESBGK**. If the simulation contains a gas mixture, a choice for the determination of the transport coefficients is available. The first model uses Wilke's mixture rules (`= 1`) to calculate the gas mixture viscosity and thermal conductivity. The **recommended second model utilizes collision integrals** (derived for the VHS model, `= 2`) to calculate these mixture properties. - Particles-BGK-MixtureModel = 1 + Particles-BGK-MixtureModel = 2 The vibrational excitation can be controlled with the following flags, including the choice between continuous and quantized vibrational energy. diff --git a/regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/70degCone2D_Set1_DSMCSurfState_000.00200000000000000_reference.h5 b/regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/70degCone2D_Set1_DSMCSurfState_000.00200000000000000_reference.h5 deleted file mode 100644 index 6144f02876b7ffe2457ac561a9cf9e75e8e71353..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 9648 zcmeHLc~lcu7f%2+tb!m0K|q$E#fC*hlqEMIASg&Q2#8>eaoE0uU=p;rRj5`Ae&SMT zD=t+lNJZ;f4Im((ep0m_rBzW8DSlW%ltryYu``p*jK>}i?bm<4bHd9x^Jd<>-@WhN z`@8SH$!B5wP*bDPMl`H37&HT#IetrA-e}tqSIr3VOuS#9y`gLS_1gY`p5}&*%ER6< zwd3Ym`HuRU0rL@>K6-XY2o0S{$R~O&j0V=4I|eZ@*z1%B!a}$L%-}e!)dZjZqvaXl z3}L1sNi0G5VwD&lB6tbJgumHaX!-gsuT5y4xM(_!f&Q2@fkK|F5X)$m=z89uI_Pwb zWOXuNK`V_Z%?iz1oPRNhLYXR0 z$0%sw$U*&zHK6$z(|q1&>(u-5ISFq=f#UUWOQKqRS%5`FVm6u zl4nlI3zkczsme(CBIJLNw?Ml-L!38}h%yD^BtD2Qzl`usC5s)c^{ps*)RSs-(Qt~U7=YWL+ z-GB6O{>;Rm{yGmSUK4dx!<(5X`Q9p{1I8gHTsTL!&;$Q( z9wC_8g>rMK0LPbNiiEV z;|##@QNGY>HRj@jsxe@FI{7p!Fc|JmzJFr>D0(%47esh4Up}sb2i*?W3oJ5L^@SvAhqi*O+EJ>T(C#Ijm&l76&oe?UZltxSU$GZ_nncC_EF zeaQv7^xWK}e>;=-mFFL)%^R$N%600rU>`Z_*%GXMAciv)GozCoJ3isYitxiXVot-&j!i zyC>JIxT*|-8$M6`LWa4(@s}wXUaf&plGqxxG2e#7ch(n5T#MD@V%Vm z-|IC6R{OhTH*vbi{NH6X#rc7t0?=p&obmP}@i-rT^#RWLJ15t?vIYL83PC~sRA_gI zH@326kouP|yv~fSDT5t#jz<&^{YkuN{14_Awgbc+m~`3yiYufQ&v=w|g#%kGEw3(L zNAWk{*_!&MA~j^$d zKx|s#MlGfASk!tiq4^un3wmh7g2g6Z#XU;|*zijMgd0+Ld8}-Y;7l1ztUJn17gBil zb=J486a%DHsJ1fsEU09+u1sSBRP8w=h;O6T-_1Y0Y*Szvgnr-iy1|daZ(h|mHRB4v z=Ep10t&jyTLl1U)%>!84V~}O~(^zu-9(yXP3x<}%Gj(I`YlOmI<==eTTMvN8F`fl2 z=b8##H~>x_$)=_2DSWo`j6IuWWq^9CuS87Y4RakNosR&#u|yQIV0I+a?*0LQ#;5fu z;~zMY`X}led~&Lz9Ab7KJaqG83Xk(7 z-=Of^F3F`tW3DEyr&!RjKId**GXUH0rnv=&!dq{MnPKB{2DUHVvDaBm;e`cbH)eJL z(3|uOb44tOv&}Rr*a5J`zzpZy<``!HJ6pc^~iJBu4_*}@Zc{VNq zt)oTlRSAvbxp3Tb{ zpLy^#z|cmsO0zZ!pRv2ir~St>VEFRu5?fpei%auvr(C7*g>%q=`f(vB3(Y`NH;8(1b6LL^7Z~h>vWAsZ{fp}F z0!w8zv@1`J?CYcO4p;$7=R#2-n%Lbae-u7l1tDArf6BMB%%Je4>=9k=ylTLzURfk3K1oazYB< zD;@LVasITU=~61iy0)#ayfP)FV2aD{9^=DOIut(oEHwsmjyamZ<#oFM_xOKj2bx@2 zza=YM6qo1rS(7^d-g@1Bopsz%pY+(SXiAfuX9ZGHQ%YiYx9i@o|1Eubr<|OY0O3fc zTzo>x#Yf_OUZB9yGsK-I?lDK2av)I@dX54q$EFlTz7{>Z_u=c}NOlaLq@?Bi8Or1G z<>fgpCr|Gydv(9P|9?HtzBti8y^>0%Daqw`LQ=hLE3zVg&Q$>nkV zE_Sr8>w4dE$H4CKtp4lueG{)^-unGRzIb;3^?Z$wE)LeMaL#q^=pS6iN=NH1c(kFe zukmFp#eZE0*F`G*^*$E6iM(LJqlr@ED`}wu=|{I&%DievJ9PBV67lZiF=uzEbVEu? zUw!*O_PkAtYa4MdA6>PSl-ig5@2zuAZb%OOi}SfdoF=vI|32T4`0Xi$;uA0+kDHj% z$G`Kx87uARH&_ z6|+gg$@(G4vV@Z{H`y$N%R_c|%;pIv8-*ZSB%Ewq%$5izqbFH5!sREM9A$lAmhe&`N>wrELAw!Is{p9 z;bfZ-WTl0ZaqeVk!d*RNm4xqvmUAboA)M@c1X*q2WIrRwlETUUK#(;NPL>k0mcq#j zBgi@kCo3AWbm3$r5M&v`$yh5{U*TkD#cYUhvI+>YOyOizVm3xN8GArBNjO=pm}Lnk ztBW9;C7i55%;pIvYl0wKB%G{8%$5izYl|Su7EabNW^06#v1eo(gp>7%*%sksy%1zO zg_HG**?!?6;3t@K~`Ki*>nV1Y2jp#A;{8% zlg&nu@jInE@5tsM$Z7~DTZka5Eu3sIf-EVVY$<}QiEy%P1X)YrWUCNl9fXsuLy)Bl zC)1gx{RpxS!pSBe$kK(AO-7Jq2q()z zko6T#HWNWML^#=81X-qVvgZ(FV}z3}LXb@oPWCE-EK4}qG6dNy;bd8eaL6&k%-u@>m8naa4WF-(}#f6iVMv#>jPIeaG14|Q5Rslg)NjO;*1X&H? zWHlIIwS|+_LXahelhs9#H4#qM072GLI9YQ9SqI@{tr2AD!pS-!$TEbJbwiN#6;5_5 zf^3NJ90pF7DZDS(AOzVM;beCq$R-IV8-XCp5>7S-K{iV`*+c}{JmF+h5oC*mlg&Vo zEfG#O3qh7Goa|`?*&5+w3lL-*gp<95Alo9GYzcyFr*N|62(tac$=*Sb9S~0T9)j$U zaIy^uvJ`yDcGrKh%?Pqo;bhwoWW|M(?Lv^17EZ=LOA}7E5J6T+IN4$ZSq8eSYe<$QoGcYVHcL3!i3qZJ!pTY^$QB7FD}x|gBAhG@L6$9? ztRjMJjc~H_5o8;Llhs6!Z4pjZ8$q^HI9WXe*?!?8U z*MG8h2(nb+WStRY#f6jIgdi&|oGb%DmL{C6H-fB^aIygivKqq4h9Ssm3n$A&kR^qa z-H#w^BAjdjf~=)*vdIXt4#LT@5M=4X$z~$RGK7=OMUeFsPWBvvY>05OMF_G?;bgBO z$i@gKTZSN;B%JJR1X-4FvNZ^@S;EQIBgp0nC;JFNwn#YHRs`7+;bc1zWZA;W_9DpE z2q*g%LAF6S*+B%^7U5)v5M(=rll_e#+b^6f6?>WNfN-+n2(m-M$x0!}_(OfS|H;ZC z$neh$ayi-A2r~ZNm(!C~LXedfPF5X3mL{C+Vgy+w;be6XWHp47B@tw`g_AW#kR^qa zHAj#&5l+?`LDo_@SqB7J2jOI0_#RlgaI$U)vJBy5w<5^;3McE!02?BlYzPA^Q#je( z2(mH4$wnc_CJ84Shak%mp2NV&W(l7JHXT7WPdM3Q2(m@O$z~(SmIx=Chak%qPPPz1 zwnjMFVg%U+;bcn@WLt!jWh2OT3MX5IAlomTY#oB^fN-)+2(m-M$+jTKQi|m5XR;j# zvQ*(@dk|#Bg_C`aAS*4L>;Qr+O*q-F2(n7T$qpmPY6vGQh;x*zws5jk1X)rz*@+0U zCc?=|BFI__Co6*>>mZyg4MCPJoU9^(EJHZi`3SPU!pUkP$c6|ftBoMb6i!wTK{iG> zStA75B;jOD5oB4y$yy@FW(g;2haj6LoUAi~Y>{xXn-FA6gp*|;$g+i#^+u4b5l%J$ zLAF6S*)Rmz7U5)>2(q2R$?ivx?H5iq0YP>^IN4+b*&*R%SqQR}D`S;EOmA;{(lCo78}TO^$9Yy{a7;bfH%WZA;Wsw2qO2q(K3LAF6S zSset~7U5(`1ldmEWQ`GI`-PJ=N01#5PSzShc1So`2Lu`Z>0|Ew3|SWhS*mcdZV0mC z!pUw$kd+or))zsRCY)>#f~=BovbzvuHH4FmK#D_vX>BKLxhtpL6Bt%CtHpn8zY?T9R%4V;biY2 z$g+f!Z9tIC5>B=mK{ih~*){~(BH?7a5M)b)lkG>4WeX?!9znK7IN8q#vJJw?{y>mz z5l)tZYcttS;besoWc!7a6-AI85KdMCL3T(uS!o0r|6z~2pC>yDL6$0aI$^~vLV9BhA_Y~g_GTlAR8l`Y!rfQl5nzd2(m2U zISia^mheen(-CCzgp)mnAX_AyY&L>yiEy%c2(oP9WD5~wYlM?6Mv!d~PPP<5wnaEu zHiB%YaI#ehvi-uz)*;9a2q)WwAUh1gx9t2qj;bdPU$kK(A z@m`WFLpa&52(rGy$qpmPh6pDsh|gZKOyOjy2(mH4$xcL&O%hI45y02w6;3t)K~`Ki*)RlIY2jp<2(mQc zWcMS;DhVf>fFP?OoQ%JtLB`*)_*cKb;C`P2KMu|r{_Fhz{z7WKqnR@H#VKAeNVMhPF zu6_UE{r}X9f7K87`)clb=fD2{e!crF?#sXWJ+}Ys_3l5__x~wA+~@qAYkqCLBAyi4 z-(b9zsUpnn0V19k)VU}{h{4zHoZ)My`vduS9^lp^XHbW~ipse*s_*a6@hgP-rsf=R z^beO0Ut?1^AN9p8aPDxrUy!dNPHpvNt@Kyl-{SeHFX!Qg%g3JZx%%QZDt9>D0pvT+ z^Zfyg^H$%(V7&6EZ;9M&dHp*DjD1kwl7{YQxX6YT2er@Nfl;r0 zJ{PauaC6xX9ebdCuINN~bh>Y#<8xi#^F&84#un(f&(*iG=v+R&&pErb=drFP%AM|H zJm-7rdp-s6aK4-2%RR2X)tm^AF5f2Tm`m%uz|d6yW1rQxhUnb-UMS3Y)D-6C=hm8U zIbC@?XYX}=tK&8M;(Ed3FGjfG@~uT3JRh{)T26#V=TQmI*%$5erG}36Ftpyb@18^=gYcy-BsVqod}Ok_YU%vg|Ygsh-*{dx50S5Q(w1+OzZN|lXa+X z60hBGx;4nh>#X`lU_7tYcR3iZi|X6ZCBvi3$1j)cmHIX^bZ;OZ`=`EF;x%hi-=)xT z@2l@scf6rHJ&SzopZd1PYu2W|^PuCkTz#*{Yd2i~ngOs5_3h|Hcyzj_kT1>ab7#@H z>&6`D_*tXAT}0>d-3Ufc^-VW)ZNONY*4tHd&i6_9viItHljxl9&0stS)wi3WyB3V= zp}yTk=X@WBFLSAH579Z_o?yJ5s&9s&s}IKgr@ps{&iOt9U)G_%w~EgBUINC?OZC0Y z&~fkZ`l7y5;lbl|Urhn41*X2e@!AdN+XsO6N$T6ziSX!j4R!c^}S1UZhc2W#~!FJ|Jws@xP12joP|)|Oeeyl(+$RR_CH*$4)|MqY=X(Pf>r&rG4BZT{3JCRmG-kTK-Qdgb8|wQwUc2FZI{@%= zRefhV5gwhcEApLE;2(W^fU#HVn-0dlsPB_TzP4ced{f`qhORsE@$+2ky%mi6Kz--n zHGjt8Qt&foE`oc~4YH>YZm*DYou1~Cc({6J;WhiL^Lr-N@WJUiz>|H}`OU*?_CV+N zEMEKbdk*Y8gd3dSd_+<7*$vKbfqQ{R=ld9*voAWo=M7zJ%&)k&ZZAN`9_aj9LRSe) z*X>0wUlug&;(80l?{R)Fc{;Ldpkp1{m&M@BufENoyD;W>$XSn9`6M2$-bHxLUTM9r zIT0S6t_kuL^L!t``@BY|?^V$8^GNGmiq~#1AM5RmI2X^g-Zz{GkIuIdbnL0t`zBt~ zLwy@SR|8CaBfNIQ<;w1;oCuH3w-t0;5B0qRuX(SczICCy3QT=h;f9@ZR&dgbX*Vh{Rpq!aQT)4P@}#dI}sk8t_t$;dZ50W@tSj1-^%g))OQOsZn%7} z0Py@!-%p(gk4{$+`Hu0f8z16*)~3GaLe~gPeYfGY8!q1`0IWlOw>uFYo$hSpJJ$34 z9PeL@C>`s0J>3~U=Yu=;3t`kSb_sL3-C&m@cn##BZV#e1f<7E%U*aDDz&n9KK@utIoF?IB@KS2mts zz4$%qen-%^ys$sw=X`Ma{uJi&9fy3}lZp5}<~wZY3PE={xYk<~jO&(+^*r|P_&Fb( zZvp7I-f4sw)TQA3bHmMr|Cv{MXz$~{QqGY&-Cww=YYdXip-1!aI^u@&`FXO5@3*}%CXM3h%o1SJXjKX^*zDR{R|JDo9g=$7|%l< z&q3c4_5B`<`;44}zWhGY0FQbel{E653dS|k zYe^|X_Z2+2_tdupblfjV1P6UfgVpCF0S4LWM!wU)IA`s18AJDF+*9@C&+d~rmcc;} z{+!tj*XOf@x&ECD#yP7me^%^<)BOtHx`67tC+?`j(Ys&6Gjw-fp5L#Mu# zq2o1M>-`iu_CWVg6(ipV(D0r?eXAO}kC2ajQQz~SanSL4nnZAr@$Y`wQ(fPS zz^(*SkBbeDZ{WdwkcQx3zDo>UAuwKZk_Zm!4j^hFw9gxmkG{IEY8m<7f#!UK_W4pn z_X+ZGEw#_JMd!}n%Y?bTTL)~e=W)5Adj}p(q0{qs1=uXGB!YwW){|qMZ$g;!O@c9> z_P)NMTMmzA(CO#Gn_%<7k_Zm^Hj-nV@0G%wZ(Xn^(5r7_LzfMYtD)0+Uk7^{EQ#Qt zZxcDz`Mw5SXS|n&;GnLl=-gZyfYC$e(#+5;M!qi4B@rCVca7)@#;k=f=kX$rZGrdI zqotvH0lJpZX`dH@T?3XxaL~66j=c_#dj7UG^3BJw*FvYh?F`+s(6xq6&)?S2H3v%~ zIOy9!j&=23FU-~ZH1Z9AUVS?mx@%((UEjI!oRc`7gT6OF*A|ajZxDkde91t{nNR0Gjxw4AA6rfa4=sF z=srPcy*-U%Gr)MPepcLK=%&M?19V#NZP2lfB!Yv!y}-Dy^g7udjJ?u2^dC68db8ls z3c54|2lMsDv2HkBcQEepWc&toeZYp|QGF*NAJ<%KyTi!W59}j^UZ49Lx(UeF4*B%@ zJP^7;p6?v!c+TkO!XP7GU$8dNsqbJzHwO9GQ}rDJ9c$BipNEcpR^OpUzF}ajLw)Zw zbW@R!dqaH(K*u?&@BQ)ow9j`L`G$jSMyT)Io{m3HychYncimfD-%PyNhv4TZ2id(& zfah*+j1b1B)QuG8bfdtypKBpFsJjpBdOTiCfI)UY*p~=Bk4EFQ8!q3iVBEX9$Hy4D zyHHzu=+t*CbREHx2oCy=lVkamY`ie%J3&~%SoeT1r@J%u<^2x_^G$?~zFO~ta;(cY zNtny`5E##Wt#`7a>jz)Gf(F z7}qF?;GpkxIo5sdKP=4oUJcd^diBjRbUop56Ljj^1MCK{B!Yv!kK))H@u>UiF(cpO zV7zD0b8Dud>k5yq(5deX=y?B(x|XxS+;Ba(Ij$oueuKx( zF?7wr*sG-I(s3;7P~YxxKD}PeHS#?LwjQCqf7;Mpk9_Iy(CgJR(6L^#bBJX`o3o9n!w{$ z==47Js<;P9a1Qz|#j)(Y_W2DX-wR+}p;O;whOQwzZh=nkV_%1kJxC%r=(_+c9gn)N z8prd~eYM>1h``=M=)TG}bP43^0T12JZ$Za;)wdpWJ;C%EvBJpr4%oX0^<8P`>LA}R z&-XGg_C?R%+F%)AS}*gv;nw_ZFxH{Itltf%y9D{}1k`%hK*!p2eb*Vs@;v4IvO|WiYx`#G`x#2u6iu;llzrlQ)4Bdxd+~Y~n z@jlcIcOF$mKF%*KeuMdVALWMgT>{2^s`KN0lp9W04f)usWc&v6Z4sUG{ZyDc_G2*4 zS=Vx_q5BN14|Lk+8gXBe;2iYb2Hov=)IM)F^6d~-Fh2HkVQzjq!S2BO>iY#)U$F8B z4*FKWTzcVAeRmo8b_;WT*(1#P@*a`L~zjeupI09{FgA- z=ab;eIjisAhVBU10O-{BSRBh9BoQ3+O`%yloNobP&bI)L<($>GprPvs-xkoR?_Yl% z{h3TM_Mz`FICc;owa>>I`3lE#R^P&g?ne0XJG=T8f{r~%A~@)K92nPEKYtI$^E;6u z4C+!1k0N0F8HHXuk2iGVG3U0>>F3}H&~ZPjZ;`k*^(|`TD+V^i^F7hf{f;`=Q}sOw zy5XMhPtdUk`dM4t$agXr?k>k?(Xc-hZoa8AJCa^0B8{?^+zk`wjIy9rNS$RM)qx zk?%Ax-mj_enTBo`e7T3z_bljGoB9@mFR!QSTh7Rr2F5znx4fbI1-{%b>U#!soU{7w zjOV9)KHJE54j8{9sc!{C_apLg52^3D(2e(eD}tfqBfvR>_q6AMJs7{{16d`oNy2!Z zR|a##UF)iV-3zGmt7_;z!u;-mPUm+%ba#VkUp|CxBAE82x{>b!uuSOGw}zqn0Qva6 zU43gp$2qI-#&~|}dy$dvVz3dO?=uh71Z}q=*D@zo1tS5)VH>g?=rCaJl{Ho zZawm4LZ`l$$H!{D>tdby);0270XEX}t!L=oLO%YiMtzgejl!|&y8^lqVCq}n$kzZY zfqc5Y4GrBgm$eteMy6>kQo+$j82@FaN*6O5#}ESIcwx(7Vp8;pGI!PqPH?PBO&Mn3jWeQ$)09$N1#=*D}#U5$J#z?e^cZ!&c6 zBHz89@6FHw|HEfRH?TF(xxvqh?qCxfz~eE99$^0GOi!>?qT{g{U@L|3*jvEdI2KRH z(!sc&wT@d2-Dj9Eucz9-+n_7pt=m-SScmSH+r51J`F z^?*&zpsp`;Y@V*$9bkT6`hjtNZm=)C!Tg@~2Xn*qr85}!z4m2*p?ebZWB;@-1EB-{ zhxHuYEN-mgoDVk?&D3)}ei#ZRl=5KK@)qk4!U`s?|dWQ0xS-zAFq}d*tJO(RyEjj=fUfdeE^i>idq7Z!{RMb?Up)(6vTB?tArJ1>J10 z(g+S-UsfB(t^s=r@9A9LHFUM$@icVh5FE^R1budXpnU#*9Zds2PNLdPEHd9=^S_Z%3nL+ZQV(4B^S{5)6Rub|_c z)wfhUKlS~_$oCXjmgoDep*scn`1kMXyB9jvroJVh;~Ht7e=zcW4aPdO-UEj2B;@12 z1yJAbp=0lLUmY}#-37)q*M0Sqp}P_1U>E50{A~!&tHF{84(_X;D)wE)BuKe199d zBVe3M62U=T&M(pN5yRDcAqI5?`DQ#^4-O&U0x+FlAwyRH^Lrk;WPCjH z9V0sDd#o_$!T)dam!VgW;|yIzc+7=P`&=1p4pU)Br zJ3sc&>s3+cIOimSgTBSUxW4LpqLJ?}^pw5QbNVDh_bb+jpIho%96GLB62U>=ljT@G zB`YD!^|=5T_lBOUrx?0#;mg|8_W&4sl|*pR<5W48PsvINbG{|PIA`tiX@>3(c<{4U zeSeO7kOb$T2me3lm*P>cSNouQ1x$Nd#_%`;>}}|@2W1W2Zsc16onEibg6<8^_Y3H_ z=IWbf#bnuK0`j9GwORT zbgWJLdrS+DxmHS%2nwjDa{eLX|BI_{NTuM*Jl zo*{|gpl>#G%%|t?N-)-@eXehKGyvn?&^|XbbnB3hJ=H!pg6=c0D-ax<%X;XzZd%)w zM!v>i+0d!)RfcW}^6`4AzE?xH6-<4XLdSiozDQ#RNqDLWe?Oh z-OEScM-1Pto{qkAk&k^*- zdLM(1Jy74CM!sHX@C45{!_%=ZkHvi{04)c5a0_(n@Tk7i;maPV?`>W_9@`6ye^;sX z-frk-ARqgp_4bBtt>^m?bi9VCZ(k$dtzhhx`rcvaX2$(f-+s_-^n4$H?o-cqfRS$? z7<;9@gACndk{ z9d6{i8|*N2TJJrEE))4!oBG}h-LGKkdpC3+d%h!$e51fPKlQ!O&<#Vr4W934=zjBj z?}Bc<=R3y8cNf_Ep6^&gHwgK-hqT`Np`(Y^I}o~$Jl_dMz6ZdVPwSm%=)bby-HfN5HrqTJH=)*B$vj@q8bHj(b<@?Frq7U|R3vM!xZ2 zTo3h~Y3RBl-xkkz7IZ&)zBfY09;okZBi{%x?n(8XW9YgeAN!(x?hLjYtSEwm*ZWRj zyYQ%ee%i?QBp7?8zRwuCTal0bQ{P9SBhx;2fNm$4`aWyqdk&2KQ{VZ9t}XKM{$72b zfQ~&--*(V(A84PSH}Wk6<9VsRFBrO($j9#n>iZyc+#BlK8amdYzAqa2`h%_Yd|xtj z*B~E1SJn4r=s0KfZ6420eP1#1^#Oa&^L^FOy@q_*p6?>)SeyD@4IS4*eU}*d7K5=4 z?ept~ZW;3NyMflb06MOv`Ywl#-%ZtbsgdtBFs_^WzG3J#BHvQaHwhg*^gLPywiE0k z1P9NpH;sHNknc^rmxkb=Zn>e0z;@uhB!YvwY|-&4Spxa?;xP@uLH4%j+|LeIfPIel zbbjv`y86hs9l9ifgZWm9j!(%}33DE+!S>)i^;l!*u7C$?)1NeQp2D%4@u>BFXyp3{Y&Uee$3Hf7Rp7zCsP87|z5q)iIOsbU zjJ~>`KLI-craj$ac$^>Ckp?XX^L=XQwt}%&NdyOVpNWo7$+ih|eclMhIqO`u8@kId z7p|q&dv@G|Bsd2>9>%dB;!*qjxsh)(7}rRBcN)4&;IR`r_1yv89q`>BL61FhET58nDa`rq1^WT-X}$XlU1@lH z1)chy2KEzJ62U=_ujN=iCA$zhu4Nj6gX|m8xw(7`Mh~6KcZRMa^6iE$iQr(q??uO_ zWIqUV9{a)e;XU;@VCYK1gL_x6S0{n-{751==y6bvPO6(=Xnyr!NX3%A6#?2uloh_NPSBh`A!A<#q%v?=zc^#_EddOfsXZRpHDN6EeytUOZ!~f(ESwmO4s)*^qFg( zL~!u1)A7e4JZimraV+c5y?ch?Q5NhtTobg5^{r~;J0Gl|=UdIt?L$7+roPpo zvJtb_X+Z`FY0?KbVYEi_IU*A<s}9@Y19yuqI#t8Xv(ZUR%^x?Vo|u0Xyc(5Y`dPsf*U zL6?Hs)HjJYaLdcXb4CXKtPgfPbZ(F}06Re#^EJdD{_it20%QN&;IWs1u{Jk&?3Mf@ z9`3WYG1$pCR`<(QhHgn*uh!87I`&@scQu(;+ZAB!y&IfgQ+mjp`LY@Rh=-eBb1?oc zqt5RdLpKQxeE`Sm{1VX7SLZhx>$?t2*SCe2kL&xYvA)-OI=);49siz5eOvMkF!h}Z z-*-LVR$e~(PK@i&ebw62@#Qq=Cg4$h+u#kJgX;Sc=Ew6*>uqb~yAG_7*XMSI?pfsH z=cW2~fbJO2cRqBy?yB$gM!t?f6=GcLNxErM@>Ay62IP{ZrqYp=0m0-cO<9=ehcJ zGxBu@<26Ekdl$QQtlA<>#gP_B8TkfN|Z__ZCCbnJ`zK5XR60z1v~eZdor?_mXi=aEx^Su^2uDSZYWaN7pjC0m~wb;;gjO)-o zzXDxZ&-WVW*n9PT)yVf6SY^+5iJ`j=`M4hH%b({LLuj9`f{r~<-=#*rH^3@-zRL_< zGvs4m)c0z57WaG`LRZf7U2f!i9gMxwK1YVGCGxR<>YEK6J+$5gbUe4T-nWf>FM=_j z`mQi^-H?yxhx)cattWf+)`gDOUG-gQ!H4@3|$iWxKGu$6Ff_LzP+I1XO#M` zHuAj##$KuK8bfy}^09yF`z~~>P5ayzI(}BD?|VkRx4>A3`mQx}U67C0UG-fjI=q#_ zm+uR6_ZI8H&V@jKPW^$Qs{xN{(3L|T4oWuSk8{AP=8&Uo6BvKCr}b9Dv6aBI-j58A z3!pn2x`gEW*w9sh?tJL9-qUdmYf|6J(4FV`ZZYzm2OWE$zFQ4lb?8{H`hF%lyp_|J zZNgli&%%3!5!&bNhOQ<&*aPkJr_iyd+Goyz-wU+fD{(BZ2ioTyhR5e%?2GQJorbO) z^6`4A_3~PUzn=I9-}2D$`lr6TjC`Mfu@3d!ZRpA(ANPy;?tzYT)_Tu~=cm4VjeH-1 zaoyB+pP?&_d{sQ(FQ8*>>U%YGypF5yS4O@s!B~g-er@PZMLvE`YrXs9W7W50tW)3b zjC|jN@%&KV9}Hb_V#`99o-#-l9vGBMMIz4}X zfsX4@75O=M*kL)=`Tix$`Th;YeCm6|(51ka|9uSgEr28!c)kU}*aPkJUw`2LzZOjU zd<-WL4>y-1&{c;{`+TgS`vbbV(CL2u4RdA>)c1Gjxc}5Q)yVf7bnJop9&hOWhK}{B z?+K#ATRFWiDvVFr&Oh-7_mK9vn4v3(KC=hf=OWOtr@FpBAs^3at@j}2$NOxp_awuk zI2ik)=h4ZA?tA3B1Ujwv0DO7QsP6&jc)qFcDMr5Iz*vX+mNazVARqUO`ko3M=d8Y8 z$MaL)(~NwDz_@PeTiVd=L%vHr-xAQVHuc>L-Bn=fdxnv(6d3DJ-?D~oH}ci;e9wfA zy;t8|&^7XW%NhC7z*vX+mN#@eknb|j_jKquXZ76~&rj<;$H-R!jOV5Lo@?l~B42IK zw<2_$v-*A-&rf|T8Tl%MUGDi-F?1gz-_4%y+0e1~>iZFN4Z+m6nvw53FxH{qbpH;dNK98y6Y6b@1p4onALCfsTFA>qadwu94RJ365nQ zTJNQX$6Dy>K&RKq+Jt%Qy}P~Ws^AMbB%(P)?453XaH6p z$LhXnXy}$X^L&@XcckZgrID{OSkm*o%Fr!=Z)eZuUBPSEi) zPkrY?$Ns7B4Mx7Rz<7;S-!6vkS>$71w9hv}*Vyx21ReL9`lcKCI)kxS>f6=OEkr){ zPknEKjz25adLM_5drf`28Tq<{u~+Kb!_Ym6eC(h4_Jof2aO(RgbnJopW*GU(fbpI| zeQz;zPaz-sqP{QSBFOJx>N_1e_CS4aGxD7X#(O07?Pcg5K|c0HeV>DGY0q~Gbo{xz z`t~;R-3rEDsc#=cHxv2TKlSYk9X+((2chFNTYdW(`ECYdKK1Qy=w3oT?o;(009|v> zcLA=?qrL0%KqKEBVBCM|JIK&w!@@v*wE?u~Wo`;d`u zGFThWcZ#9wg?wW@-)Ydb1ykSN&~d-0?{p*I!(g{~zFCH@C-RN)d}lz{-t+Aa9s8%g zj~V$M2kYVa&NOtlAs_pqeSQMEcAjrP=(u0hcb1XwQ84yO_tlezt}pVjf9g9MI^O$e zpKpMUdrf`k8u^|AW3SZrX+zf)`Pe`8eFi$-`>1ax=-31GooD2G7OcDH`<$Wcfqd+X z`gVkl_de=-9dzu0`Ytf?JrBn3ms;;aLw7y$u`lY|4m#fZsBbIic%QAli;R5p!PqPH zebLZ$K|c0ReP4o(9_o7ybi9VC?_wk095Cin-&YLX0OaF7Ro`o%PTo3hKV(3~RANQ&HHi3@c)ztSY=$`O=mm2wA1!J$&_YFhW2>IAQ^<4%XYg6Bb z(9QCEmmB$B24fxS8yUKx$j9rw`eus`Z{>W)eoGji;?^MLZ9M4;fqw5^Vd(0@<96uu zd-qD{ZUn1}JRHoo3M?H=>%9!eb_3J(U1NA$4qX@M^yduk8oFB0^@2|8y$rg`J>N^9 zyV>(yXXLvGI`%+)*BiPz(6L_i{XlehE2jq=gz+i+axtFNfk6Ab(a_a{2YaA>ejhsa zRQr4Z*kxea=QcQ&*8}bICd1=HF!n|F)klV|D)RAqs`XZduD0h}4LV-`)OWLyZ!H+> zP~T4sT_xn>eo@~o&~eUM?|Je3)OV|qZ#5X#O?^KzbQO@Vr|0`IbgWH%+e63excY84 z@_h=%I@EWEp(~Gkyg$%-KZlOJSKphVQq`upr9$u=!(Ll zFLZj{_ys!lr7H4pFyF6WTqCWw6pm#bTJLX$#|hBg3Y}gj4;i}Spz8yj?yL8p<2k6l zXF$g_SKmL3e8)n^9;okOLw7uMtXF;i5*^;k>A~N^_>_Hl2Tyq2)jl6FbSJ`tJ9@K#PwPY~v6`x#HzKkai-L-$kM1MPDvbnL12 z`3L0VHB9S0h-3NvP3t|$@F)((zUcXTvZ4DP`369zef}1{JZIGR0CYUh)%O%5UtuuT zp}r*z-8aa`{i437LdQ9)@7MAC)b}(aUjZ<#oBEbEbo-ERkmp+hI@YGXd!ZW*roLww z`AUJY4)rZ-=yoIDK+pF~=-7Mp-38q!&$pbBFAa=!sBd{gw*&bGLzj%tLtYO~hmLbr z-<|RNwBB=!d=&~1w6qMr+epkr;iuNr}k2h)1rz_Aa4X}ygNkE_7$g--k2#L&Hl zeD^@7^)?k9-pZ-B8Ca(0+gx<62QMSvM9;T{p}QLFZqN5x(K+9iU?V)=R-$vhuf%m| zy{!#h8!+}o>un1*4ov&}I`VOT+UM(xeC@#QgHCU*Q1O9$iUoBDPI<7ch* zc_#94e(HO(k?$-pUhmbno1vS9eC(h4c8BhM&-Xd#xDV8~hmr3lFxH{IJq_L5xG(CP z0Udw#uk}6*9rv30-fHB#4UD}~-(H69QRHL)^#1C0=y>m_zSE#%57f7}k*^FG?^V>d zkD+@4`PdireFU4NjpsWFI`%+)?=bS62*!Ie_3dZqrXU~tqP|n%+uHMe0J;Y}-vLIx zzF_Q?`VKU7S;)u!sqY}@=%IZc3mvc7TJI1e-z{Lwr@liC-2&v}K2_gg&`t1s?}P3! z&-X4P-(WEAKlL4M=$0WLuYc-$Kl*&F=Q{$r$35SBjC`43?3Mc7Yv}GrKK4(2?}cv* z&o>h~_CWhQ!pPSjjQdZ0M;f|u$j82@?ZNn)b~-aEHGW)Zpb&)^L^aNHxZ0=XrE^qx*l;~)b|PK9`=0G zq1);CK568842*TC?`%VNL);hjohv$|$XVYkFs_^S`6S;Q?eKhGF!C(|cjV(fP~TUfd)D*44m$QgeP1*3EdiV1 z`Mz%GS|A_$qP|O^oA3EHfsQ>;-#3hW%fR@#rS-mP=o%m&`=Y+fq2rvj&&}icsc&TD z%Le1MU47p&bp4T!=ehd64ISsKzR7rg>bt_ocPAJ>SJn3&LpK=tcpX>YmC!Bld>cW> z9;ojsBj4R%{G3+b)rPJf^06=Kn<$9yez;y}y|tm6?fJfILgbs}`F;@3S$%87^V2?WH1fR(-y1yNO@^)- z@;&eQu7i%XsqgvFJq4z|9~=2LfUyo;-_3@uGV(p=`PM?8Grc}nf^LrI`>By{4H)OF zzFQ65xp5u3uP%h|J)Um`=-%>tw;TDkfN}q+?+!y(9{J`%r@o&<$J(^dY0zbRzF!#m zc7bs{)OWX`D~o*3c)p)O$2qI-S@HaIeZMsFeFVnyLw)xey3>*GY0q~bbeyyLmX7DA zzF!&nz6RrdQQvP2T}kBQXOH%I4|MFk`kn&aGBEZ1-pIEfjCH8*4~DKd^6}n6eGfp# z-mC9P(7oaL9yId(1jahl_h&=b0r~j3s=nVs$2qHSv3P!3?=MEaU%~hps=mJ&x~9m- z&sFvP1Ul{w^(_S*=c2xcjC{X?@j9fwe;B%Bk&p9J-#?+_-caA;p=1Bl_pp)gFEDYH*LE-vwK_pu}Kgx{Ujw}7F$9QpVeuf89`m)BVJ zJq|kdKz$1u`NqJvrRQ77&=o*F_C*B(1iD3@?;p@D1XJJRjeIA7z3%xIHFQ5A-(t`AMCjIdzCS|89;k0|Bj3qjOFZ8a zhVD1yV_&q-r$G0v=erMm9_IDAq>=9=F!oCK)v1Q=aNIxjEd?EWulwp7_zv}aPc!nB z27ATxJ>Aglh3`kusc$NDTub%+0lq^#-!qJSWx=>^TJM>L?rZqIy3di1ebIW$L&rI*@BVmx>U*}4?;NmKJ>Lq3?la{3*z>Ij9p|jR z+vEAE?|ELnEc~arwm`QO$KqBgXYlWnD|#gbO==(l&tWA9{f{y3D*82-| z+-vH4v6qj&YYpF8o{qjBL&vpL-%Fw6oYl8BnE&7Ps|Lnn-Qa)MuM!yh=LS7419QWD zZq)(f{fnM&mm9iwFu!fk>HMyMj`v(Tzg5t2Uuj?J8To$1XCCjb)Hh-1vXPHJ&r#p{ z(D9yHeV0SWUa4u74|-i_Bo>u3gDgk!aTi=ks3+P`bO zd|9adCFt0DJ&&$6bgx6l^}zpf2J2`E-P-`_`vP>Uz|^<3k?(oKx2>n6$1BjW_ge3D z(DA#U`nCh}*P{&>`{D-IqXn41mhHjZaO<%X`-qX-Tb)EI=?Qlug>pD=srX~UAJ^EUl#Vu zQ_!*Zx?j3_I?j0!bnLzQ&cs2}@t*q5gl?1Pd$X61zE2yz-8>zAXG6#Ssc(1aR)eYU z4Cr|8sP*9ve1{M z$mgGzw?oIZRNu+au?Ong$IHk5wF2Y1sc&CHHy!!d7p?aW=r(x16QNt{`Sv&R^#)_F z)OUcPdldQDKlL359X+((anSJ|UF#ieciR-j}HFQ0U(CeCy&Q?}0w5 z?=U0ZATaJf^}W;3eFtBDpHbhtpnKo*tqEiyW?~k}nJ_iro&z<0Vqvt!`$TtCuy;9!?4Be2p zf9m@ke4q7v2SCRjXrCt<`5pw@==n}Ebiufbm+V^-eW( z4}=z1(P^1T4| zspq@M)3GntA|L06|K$wM`6cMMmg?III`&z8UpDeJhmPNqamwcAd&ST-HGE%#&R>rg z!RYG-*W*<%*5(H1d>!&}eRY0IJYVWw2ip#vuE$bCcO~-eflk+>3UvILg7&2gbX+6# zUFPM>LZ2H#=l5l~r{nxuK*!qDw=Q)2nS%O8VAz8H@Ll{(Fs_>$?A2m0zgO8{Zn*Dn zZ-IS|W3?}D8@eknKlV@Ow*orWrt`ZBI_@j&%R5HCm0&wO-&Kb0GUWTh^IZcS=d8Y$ z$MaL)ca3}t@qO@N&-Xn;cM0S@$5&GY?4bZ$Raiu0-Or-p7L80V+;ZWW#L-2%qGXuY3_ z&iPh=?_TKCce|nc7>w(tzHfl>oY6j?jePuEP~Xpue4FBY>buj>m5b-6zRyF)Yp41S z!^Ncodaj>uyNrB0z_<_8cekM{3*UXvsqdGf!&^D)yA6!{Kif0moNp%j(%$RKH->Hx7}w4DZr!$N@|h=0j;8J}Qo7vdT@r_% z{c+PZHzgAR9=$(rc&$ChPK_#m-ss1|59H|sJi7nB!tLfCcqlsgt=gj=Jk&cke}G5F z_r36)?EO=sPk-2Z!AXnr^a1{F&tK}YZ%&T3KNL-EJg(~B*A32{e}G4oFZ%Z0s+*@o zgVvwAcXZV}eSqh?-a=hR4BfVQT6FC>n~pD=$m>sl=X*YNzF+gjwAIt17p}N3tNGqR zx%CEkzV}0=jq~?a{&8A#?q3(yUjOF}x%mV9-`<}<-x2{HCH}lES##OL(KEl_-mOHh z+jHk1;8CD&i2#q*jjdni^OqiuzI$~+IG;ehiO@U)`jBtJ&A)ZV;@UfI>-10a_vabV2iI$7+Y>rwt$jF3 zWQ^{+wou+a49zp3j{^HP5#UiEPa?phz&`wM+n*aBE>^Nd&8bm(>B3$5e{x)1cl{6W z=#_hVKd`aP^yrIkvra3x_BEX~Qtk2gzv*+RH$nf#6&n@?T?)(G% z-@d+qeVe=g@sXZ0T%QB_-1ErO2lrc`-rznA=%Yr}cJ_Jbg2~aQL30i^?^HZ@{{(mx z*jI@Fj{^50|84gt-?eDaqRg%bqjL|RGp*N|eR8ie0iN&sjT+xH7_)ErgVEd*Ue3Cs zci#O#fJcG*ibQ}%k2K#mxae_{qMn=IU3O>T8*}F$;Q8)npbv=v&v$={Z{NT2p(Ep? z@(2DpaZa(k`3HEu>upu<_mS9tj_xU*5OsCh=)I%5~*%|F2N zJ)hZrBYLFmx8J{znm7Ldj{?4l z0FSPnbMU(gt@=g9cDFcr$Gp7n-2onb_5fxaaI zJWAeMsNL&@21Zjh{yg^XJ1XYZ8{qlgZ}Yd+JG`prfar>X)puPz^6K3EAK?G?{DFO& z2=J)aiW_d*zH(61a>DArUhL35cm4q$br?H&;fRexqLY?)Ec{EibN^L869Ii_U4ruo z^fM8fXFwmEe`uZ?OZEBuwR)M+@eN)Yd*fB-g`S+UkqsxA9Pju+MV{gp5 zEARRl;8DOg5#ag0-wXIA0zBXMdvyj+Xf(0=JyEx7dj0)EM&A8-fJcG*>frr$`k1|^ zeR9S<(Sh%O`}9!Ly!+<>j{^7Ai2#oRefa-Pe**h3cpl}q-cs9}Z@Iqa;HW~u4~Jg* zXWriz1b7r!_e6k4fjo%-&v*VW7GFMd@Zmwx_7RCU2RF#uKLH*E_EjRlqx%Qkobp(a z{!z0NH>8wF%iI3}p6_~h|5mg{lOOv}S9?5#ag0UIp^}x8i(Xs(a;Ijw*SDs1Fa9d?lGf2@pNuRx|IaG9-?IYxD4>rz)w$`XQG**qsnLp` zhgZw{KK}C+=f8PH-}+Ilj~8BX-khqr`2+eWpbz;bLh~7V;hfh#{=0Luszv)tn_rPv zSAYlm6Y4|Y=az{8j{?4l0FMGc7fJ+p6z~nsC-8Hj;LnQ!eMkg&zUTAPSD*gb`K30| zMWqI{T$!HteLTSP{qx>Hp3wXg0extnL~|N{cFL2D>PLh2beWj4`1;)QE3nTK0e$E^ z3Y`}T_wO*yyM5oEMXoqM_xuW-M*)4vH}Q4vXU=@?vtR0EUwdoERm&RxtGc3qKI%EF z!qi*FotpT3@ekwgDwO;4uKenQ^T}^N1Nua0y$&}YQEbxGT8Xmzo1gjN+j;kg0Ul+Q zI5g{yWt9@A7b^Me8RNU=_AS7p^iJ*1xp20}8{eY;ExGytkFI;VMZ1a@)ro#Q zuUd_DpWd9S5Ae`@g6k5PXCknUiI8ug&%yZz^oeJ-Z2dK3YpX=|ou!B0-Zb~$A4cU0 zCKp`#bkjt;b+ey1r+PovhbW*=1oVl~t**{Isd_R|w(6Cyb<4>8_mI))i#w-Bld2}3 zuTrAbF+b(y59kvCeImN9c=o0~bV*7#}n^%ANMZL@4 z8(lE7d+z;bXkSGEeIl^m5|7?q==0ToHi(Ytcg{-(s`Yh!P7Gi4``UJ=HjD;WJ-g$i zvu?}f0euwE=X*YZ`3LL$dGx!NPWt$Ys9CpNCsdi4cYhU_XCk1F0{YNC39Ukmj&Kegz{8plk|&ELKKx2;R{ z>7S_Bx6Z2jTjb>r=o0~b;>5pOO>XwtkVOB9=l2`ec1mvk7Z&VZ{lUt?iG#=0IOpKB zJl}vm5zr^@pItI-=5>P-KipEcSe3`}@}D_>`*+(b4NS~@dHSM3@8#tW=o0~b$Tte~ zISS1)pbz;*fj&o}c?R@}?Ijz$IqtyF#DniQJM;GvQ(gZx`I0Um|=AK?Fsyt4qxs_Wjq-Cfv?1$JX>Td@NR3~WVF8U@5aMa9NeZ0zn{ zb}M#wBZ`P!_^th)ci;Q|&huRJ&Y6*K=9|AW*Kp47TxadI_g-h8a|cMxir)J^t=DML zuvXX1OCLn2{4Lz$QsKNy-Y)(JH~58$WAKX|5tTmP8aYy|OtGxf#)CTktl_O2?>RkE zcyD)g54x%21HS-%k*iXN@pI1wh%D`g6)o#-i7!^Qxo~js<iDSlhu_URdHIKLI})H<%B|ANE&`+ns7Y*_)nSqQ==$&jxOpFI4{qPB-1+ zubv7G5;nJ1->N%7#|IqN8>*|)ZY$FF9PKAgb-sB&WzJ=m{7ZJcUF&ka;UaHL(fd1Z z>gxjd3HT{h;O7|cJ%OUqo7?vDE9>|me*yex90*;%fTKJG${&myT$fP40H^A=`gY88 z&R^XBFd_Kmb6w|vlT)kDX%Yf`#FC0bZcmQZe!%I(l4BuFFZqkp9V7BYUDfLt;8gYW z_*xHreZrSBS5%fy{j@DJU4uF0Mz!N<_s6%)k0d)xL6Z8xA7tEso z-1PPGuyN*$IcNEZxj&9(sQgf`8-UZNg;h_r=HGL!vDjw$*_6xG`a?^SJh}WM#9zE^ zx3}Q<7|nrS0KYhT_2R6_rvgQ5x3i8_v*|dV8|$5Z;1l$Z_`olKU!Z)zI*I%Q{DkrW z>m=+i@Du2l`3s~U6a2l2<-TL- zm%(p|WAMZL(RiZ#fgiPN$rC+481q#9HTX^6Pf?!W{v}qsT$=JGMWFCp7}@>OWy|Xe z0-T{Wbl1 z5REh7rt<;)5`Yt$U%;tIf#FfpN_dN5Jv-JqoI%$E;E5i8eyUk%uJ7{`6+6}1Su0NG z12}E^GA!c4IB#+6?mDNw-?blb0&!5C3*blNK>f0MMYxR}AwI3@=#=4z&Ii=F0Dg2G zQOTAaw-(D8B;J&2vEyu*B|chbkRPpMrt<;$qjgN&dHU-_?*b#m-bZ}~Hm^Tdtv@JF z0)7F;LF5W6^5OaJ0C9QFn2!U)bbOE}0Y4fC@nPKdx7(5p7hfNiYIZ*5Je5DH6XZvA zXgVK|KdM92F3R8Z^@YX8UGMzu*1o|ZaClE(~`~~o%aiHK$!&jd99wd%Wb?mw3kRBh`mA-#Q z77h|k{Ax@Nu+<#+3HVKqC+ZjA@cKp9Daca*PF^c^=WxywET(Q)anvPNUoU{e^%JbC zXxv~vpkHtu-Z5^&nZ2n;iDs#H^~yENGLNWV1pET@SD38_;79!xwud6FR@xUNT6XW7 z^+&Y6zKRZU8xX*s3oI(s-)7=5&4HhQpVo%Nyz0CzSlnwkD)Zj(1(x+kz21qaH*RLd zF`5Iv<@J=oPiFH0egX0qhYDXW=>BV@=<#qz^LD~A4wRwMJeS(hqr{SLeTV+C*Btl- z@Wb&3>kRUvb&OCxs7`<%tz&Q;K%FDM0Dd_BAb->SRdpES?=t3B(}k)&VZ8yr<$VA{ zeTqt{ZA&I85-c9xnct$i(D6~71HS-%aXi@Nm*apy(bFNT&Bn}@_^3{hA6`dh^8tRe z4p6EA^X+aG2;|?Fay@_Mx6U8+3-}56seJm$-)g1|7TXqV?|LVTe!m^$DS)4V-%=+F z&(+M+KEEZtg`>JM_$~Eg@SDyDoxE?Q~*xr`rfPK6g*t)+f-f@|6+Mg6M$3t zM`zEEE95K2*iBnoE>`;iN6%gGbs~5j3SXb1=T*Q>_ZP%L&kv^KC-(XP=JBu1FIWfu z+WJsF%bGaHjNK@yL+kr@Z%&$ z)cLJ3mhTw~z^R&J`hYbL+{wStkp?fV{D3EV{D_G|&Kv1f`^8G^rIPDm= zv-Iw3?sO;D?dnV3YCqtn`#Ykd|M3*B{75`czasNnJ)VG@&Zp($YX;H?ywt3ZaUjX+9;l${%pk`PBXBbU(o} zgyyGS7jGM@>j!XZckWH@vaf=va;fX-irvul065tNu5Vx8CxlY2yz$}IHSGsH(Z>hW ztpMC~e?cAowfc0+lc8nycYaiV@Q~Iq*TO98Kj74f`bR&A38q_V-QNwqqWypq7>B<$ zKA>FzIQeHCe6*8)2u--+Q$1;v&L42o^9AZq08U%VH&{3HV=#57{b$Rc^P!gU2b{KK z%bY4SD1;^!k1YP?jFtc2x#{@=;~)U1O%DdFm>cg$$wZ%q52JKGfSc|ws6zp`>Hbb! z)G&Ri*Y0$rVElwjH+4M#PM}?w4|pyTfSbNv4nI%WezkNrnpU^d+qZXh{(uwcmjIl= zbKqZlJ}j5rZtRdB{b<$q;KA!|PqNfM;8fy$r=D+P+{yLcZ}I1b_5)6zCiL1qF`*x= zDYt6hgWGz105?58CmOiz*!td`{>)4Jz5ESb|A3pmUckJ-`7&Fd`y(5)*<)iTk~){V zKF;cS0C3aK+qR?MqzrjiR@mepcl_`h{X76Tf#+)Yyj`aB`eh@wHKRJ`pGVxjtDgq| zH(k%&+FxAwd`dIw-~2+9&)XT6`UISg*cWCqsedhhW-CA71mXz5O~+sGY4eNN z1G_@3&H0_%fc9cZ=OaZQ#Od(?oMxP#_O;^M(qhcgwAEj}(|*9o zy_;jIp$FTGKMM*huMn$W?*LAqZUx|`^8xb$=L@t8^8xcB0He$aor3CHEGj!P_ zUH^a+xGn_Xi9SAY@2YJtQ=y&6y>k4?&L4FCfSc|ws6zp`>HdN`6o8wq&lfl9e>|AJ zgQ)B}-?8Fb%kMb~z$tFl+%gek?L~%KH_tDR(SE=Q#QAISlji*uw!L!)v8`9>jwh|w zf4~Xc7X;wse_+YnVOe{LOIb>}9*Ncc1>AIh>y^!I)4O#qvE8fk-%kN2u&xTgY0bTT%ZB~#DGE#<+tl%wjt@A2brr6+YX`d8+9&iAJC0UL zwJWWT4>*B-3BYOd!N!%JzUwc(RA|zyb8200fSc~G&HbyDlGPp}g6+m;Ta{er4>*B- z3Bbv<^?th4T9@9HJ0wR3M>(dzjV)TaP`0)Eqf z&jkGa6SR(@cK_P-1^Nre;cnIg=N-Eb6|2|hc$M^zUatT*eZ7PGCcK}5b_L+3pSMAr zzZQQ`tycB-_8BG$RgUfGo}gd908Zd_jR2eydw#+16~f;)1pN|#!{6UT{Q~)*ae%+S z39eJqf3GRY;*8}Vwe%1^k?-;+e?3{fze;1X~`oGcffnNZ>*pd*Q?M?gsB4|wS!7tiR zQTZcIJ&rbLIq9*Rn7$`#g$8A&TKs?$$_H@T{j~G#L!m=O{Jk;@M;+1m08TY#7PwN< z#Z#=GIevE=7wrcejz5?e)A@jY!FfdY{Xy^VemxW5Ey|Use4;=T%kv3*egJ-WpGD6z z;Jz$?Ux4Q>@q2ZO*zY!jMa=MQ6;}_KW~me4C*ViVUEh&L(Ic!=2gp_P3~==dN{ z0)Eu40QHReg{}+Kt^oCn`i1I{8tiU4D9p`E46A0By2xeA^@y$uXV_m* zwYgJbjRItQGR%t-U9@uIe3Tf5c)6MtLkK>$u>*MHD20XUs$+&i|( z*nZ;ogW!p~>goIeH{D-!odRyUzhGU0>j3DN035DApk34B3D#S*Zkv9857eOm+;n|{ z_eJ6RrQm&F`2H}M7dT&_U$DR6eNp&+soDMx9d_qM)?eMk?jr}2jI^^ne+s~=Up=eZA+v5fD^c`;q?yIF#$LQ-RhSs-{`(#L&17oYqiz+08XG^u)m4DzM=Ra zfB0Mt{P6i1J+~{tOV` zUX8Xn5TN6Oei87ac2WMcpu&s7U#9dBWj^JJIcB5V1w7H~6I^!!aB3cZ=GmNMxkc){ z%^qKkv%KyTfSZ2a=+u01@`~gq&_)V654S)Exgc#9tbpJii^z#_tRO8hBTh1?= zQL!YM`=)rH{eUO>{DS93_&f>vB>*@5JOJXr_-3C6!1s;>;AA!*FpmOo)87{Y--CkR zj{@z&eEfb~Z8t4nH)>Y9{qtvcbbSJD`ukdDzpo3fYXLZc?-dKcO<#{-90cG5);$3@ z1!lE9x3X?GO3^5~VAwsqegaNl9RAw)fOZAo1ilw705?5f;Cs;maLQ8fNufFYx={|h zmuphp*WZ5zoL;tnKXqvG{uCIRWr53W?FZcSe1UO*<1^6vRc*iG&1u=6Qj;n?(fI&w zy1$?f|5|;%>cm?*f51)W1L{x!P8qY!Zcx5KcM6J~xh(m;F_!TMoYJm2 zSH`P;f2!eN-=Wks?FXDzjjH)9{#7^novPEkWcNcX@d2l1FSGe~DAk`LXYH#KeM9>J zr!OrEwAvq#i&Df#&bpawtR+6+bad|M=j}4LA(vJS3rEK4`~j!dIi9U-wI>tJZF>Dl zeA022_<+;soSp9N9M+1Sk2sO9_FJ7l;HL8d^CAE@oe!870eGU1&y}&23N`gzT6cH1 zQbQ_z($@>%1lA1!c%qLFXcy)K)(yCxfO&!Q1+F6jxasv4tYZRj%IJ{yQ=N;Q#m(Re zg>N?2*B9V4XW0IL5tEw54h=kz`7v-H=Pf-E(G9oAx%T)<nTQDyIaMSC_ zw*Di$$F%A!yjNZgKk`TC54h?6f;tp{o2~~?hXQcZ^#I=25`a^~*MrWwcWEsmbG4kb zF`0gU3~WtO`fJyh+0Q%7_SbCw;C+7hetWY%bvI=yz`q}n z&wlKcQu=xX9KFwvJ};mT6N4`lavdTDwQ|~%BdK1m0H-hRXXZ|B=q8#JXg2WV)Crd7 zdB9EQ1NtQZNBPj!;77|g6(1bm7|9}(*p8F90W z<+%d+1@MbT8>22S$ka=0?7lE>(*zxVMZHkpuOE7d@6YSJcb}=_1HS-%^c*6<^AGY9 z@RQkmfS*AArk}?^o~XZ+HP_Tht!sA`gMY4`87lPaeZWzkX#C-Iis}kor@)V{J2Wq- z&QTr0>l8fSB0qW^XF4Brouaw|-zAk@7jt1i+Z&@o-xS6fnNYWT=&3wNGbY%PuB22FVQSXvl~9!MyqxO;HIxf za9s<)Q9fv#kzb&BLG6NZhU*pZi+h{=vpG6-5zr)sZ7xh++3qH4d~LVetb_q3s+;XD(MyNiyv@$_i0k< zLf=c#ZpV5lJK5{}KZTyHKI29mYSH&;`Z7zrEpdRKfFI_QXJ;!@53UQ->qBCX4~h@+hw}pbgzlTD&ViqRpVB?6Q!vlLb`<+3 z(~sG4mgh79I2Guh>15K;J!!?J8W(RJ)_%aLm`D8Skr&$1srfTK4?WiP1~_%jviVew zMLnoQ#ndsc4{1N(rt1Op3-%XW7Xon8{RMIUT6}Qb!Rrxxjw}E--Cr<|0`Nrte7R?j zf@{nFX-Az-t%&OU$lvlD1vvHoF?#d(|K)(dwiGF>7 z=UxFg9bZ^B;@S2NbnEc+)^~R6=W4)BKOcf|fa3$&6@XL7(NE4>dbm>L&1I*SEzQ3vkj%Sud+2;bzZ+81-R+&!#wQN^H;T09Di)8{If4x-ft9u zCwhGFxj+0qz?BQnZ+-mXPEHvorh9tT^1ieHoQ7nwJ?>X%D79Ho_w~T3`hEvEC4D;R zciklZH18-id>&qwZ@|KcZvAOs#Lt|wBJ}zXc%pwl7QF5gfSa!8#2z1T9sRZI z3(SiE-1PGRi1XLtgYQKPzzIAD3cyXTSGh`8iaVUdo80qlT2W=NUf%#WJ)VoJ1egDv z+M8aVKIS)LjK01AC(y0{oIKB8ZRL{SM_X$*d}7m0=MOl6b_L+3pAVmX%}}A)2QT`( zWuS{oNxhx}PQRKpIxx`2pT3RBaVTwJ?FXFdCoS%k=a(1ddzpJl+SdAh2RJ?1S!;>^ zFF$%PRvhwgp#6ZGz8`^p3BXO?uR*^A;E5g|-1i0Grt2B>3-%YxqX67=KHxeMfSay2 z*NHD}Zsi+Aaj{?Td~2@j6L8blW5oTk**~NoMK#^e=Pof!uRnk%dVKJ@PXJCQ>+I~% zHX)dz=I`GcbzHxG1e`#>1mN_iLhX6EW`xin|B*Lpc>iHk=|L?~K{69(paMS<45~#z!R-fSiQ4)Zg z{{NLmv`lf};^a_zxUl7xETroVaB9*jtZC*MVKn_uNUyE?wI6WWuspy0JW zBd*&{Zr9@vxaslSGGj|z?D*-_KKZUKyZ7nw2b@5=0&wcF=1Eb{(=%!DFS}^bHHiqyIMOou9{Ab z5>6)h*h~8XPxSc(?FztYWSt>Z11`^`T=O2k&D2!q4|t-_Z-tl!6JH&kPOH-InD04M zKhFS8xoXB_r3W)ch5dk>eUt4JKmo1?*>G_Ey^L_RB18#c0 zz&HrNO^*+F?h=5T?k{*Q6@U}y7wj*H^Vi~o`}kkGzb{a3Y+H9D%;f+p88n6w=964 zfS*Kx*G|6<&7rJkIu~w!N5=si#Stie)SYEtp6{7MzU6mBO!wFM0}lI(`sEON=EA0|Y3a&u$JpHrC%;QMUxwQ0^%ii`&l@HE>V?Ie4X2`;e=OUZPv4IK zC(y0{oIqU(zzMV~05@H4AkJTlUvu5pV$Y9;lXHcBF4t!1>lbhW*R=pV(dQSuE)akd z=$8Q8v>%KE9G@H6x7!~(7*0+DU;nJJOurrhoLpuEIONzlhenR<)N;oZ?FZcS>nSh} zaD2e)CIL8sehI)$*BiKx!22c`Hvu?pFYa>u>6&>o_1ozKeSP)#18%wRKgpfCf1MuM zuhw(JbAsi*VDMYw82m6FG!7_F;J38fwr%XU=slLdlW)m${H^u-e$UW<2U7LR;J3sv z_$hh%oXJzIo=2%B#|3TNr{h0JTR8tl<^{^Hjus1aeBdYGr(y*jwm!FQ4z*i<>(<6d z9S3j}N1*tTm0tXwwsj8q7irz$|)@;3jb_L+3uSXE)uf-p+aMHl|J>fL&+s$_UPU!0waQ^;)x$7OwqX69W z{HFAAeE;IWObQwl9@pWl&L40B{Str^h$8?u9X}?+j+O;E{|>z?Z(JCo{~trZsrZhs z!`kqC?cWhndWMxBaMSsionO$d0Gtvsyjhcv?-xTu?CMXp${%pk{RMFZ;B>Re>!P!G zJnj9mPk#3)-10sK;B@WRfl3`X|D29?FSdQve!vOLqX67=e{&cAS*jb?PwdC^$0x_@ zd;mAyUv>Z58u-0l&YwEI;_uq+EjZq49u+tEE%z^jpORm3ij0n&N9_lU`c(agj(<37 z$-3v5XNy{pEz~ML@DuQxt~U@z0B*V-K>h-7)9WpGjuL<;`uM1NFwDEMe*v7r|Mbk>(l3;zbbVO8)>Z8XoE)Fr z%(}`eger!n`IP*vUjG57kd%c3Ci`&w3HDW=TU{4`Cwlz4AD!+ec!tpY)a&AHWA*h5 zIPDF;zp)YLzuw>1dxMo9aMS&L*R{&puYO@fLmQ>Dcvy_*f6PE*c}KDWVY`~fF0 zZUS%$Z#eD3LXMyM&)E70;`I0fZaN=uUxxQ<(5?WSz*Bw_-o?>+7*BkcwGixuYo!gfSayQ@I98l_Wc$x4u5TY!1uBQ;HJON z1L{x!Zn{3ZZ^)k`T|g-Hj%`@9>IGfTfD>pJ<^!IK1mLEx7yqn-k9P78p$S)fswa)o z`2$X%UjlFf&w&DP)6WB2vSm&c8Wchki$@lJb4I^^4!G&>6M}INfSVp4@V!3xeLrwr z!0QFf3!E>r^_l6}sk@^CL#fWi%!T@XSzvj80C1{y&G+KZv0>DI>FX8+ziU6>lVvcw0Re0vTXxn@cj`8i#&as00RfYa{6%@-{64xzzM`i1QLr1Jrs zK)(dwH2CS(5;c57sOS*SCG<(>1Gwq_KC;<=I*eZ*wFt{Q>wWw@%lH6JuT$CPn&%%% zzqUQ@*Z-6D1D@#P1KJgUQ=K2N!&mb2M$KX2^>=;I`2%ixzCaxcz)jb4oqO-UUk{y5 znL;})cmJ*H4RF)-eC)}YRQ+d9r;P>EEV}nw*Bjsj+7*D4L)9XmB98O>u^H0ZCnR5J zsW-q0v?~CoWNWTRFF7}p0{q*iN|SQ2B|hNfnZ3ce6Qib6nvxR>HT$9K0dRhQZ*`tp zG?NbA4ShcIkM;we=;H(GRse3gzo2emJ%f3N^$@&nP3oKcdVGDwjqMyh&auoF;8g5Q z(hgtw^;+>uWGC0&oK3AOKJF_cuTt3cyX*gKxTgr5pK%(zwS_Gv})Y;KS=89!frc{23fxHvt(fD`B!>@SET05=^U zJO>KEO+O#1&o2hpxKEBLIp4DWE1t8)BG<4?bN|5&e#_?<20t}h+isaVf1he_^-iuX z`E`8f!WB{t=I{Rui}0yEG@XtQ`~>_IJF>*4di?#Lx=nkZs*^&;0UX5jeZB_9K>%)geEwUV7(OSpeEwyu6BWnchxvg1 z!g&OK)9+V<&&~P%{;!|2o4%jEDcn2gr$8JSAH1#Q`WHui#k8plLy8>|flBHwa_PgiMxH1uTP4emd0XN-W5Jvz` zIX<>@OnoYxQa81)oIZDH0Zg+G}58YqIM<@MMyZ zUyp#BzTUw+3cyW|=YtZ3J+i!-~{3bz)i<*@#UO%$v-ox z@|=o4yL{5)4>;K!Nb)2mA)GR8`1~>TSM3MfbUt9+7J!@1$7R;!d*1Kn(53l}uP*+n z^9P)c*dGlWU_YDQ{?GTcms{o+aC&_+zG|i7v;N@++;sk6UIgHlb$jjRc>5ArbpC4n z?@+(*iiFa7927VBEpZHfs(iY0+GOYE(aJ2la=Rwi@xlF606)4fTiQkW80H1}h3c2V z5A&({VrSJE&*mBD5%w4Og-K2e=iTp_Joj8{S4;p7s=K^rk`GD&}08XG?m=9QI z1mLFc7pQIlH=RG27g&d?ZVlI+rJfDXX%=qqTdoU(A6<9oIZdE(fX{WquJ*k@B7`<-%-YX9FxgYkA zd;mAy-;py5A8K(Tj9Mi**DYzh9)G}1_ZQ5&0G#p{=w842rZ8%>Wy1a&vATW$H=PgY zmjIk*xQ(yUJ^hS-j6dL}=j%)O%y9)@O{XP0qME(38h^kEGbUxs9C49XJ+J*Um*M0Ey zAow2LU;BO?m=^)K>GxZ}_i_c`roT@J>QDe~x*qONi)lE1QYiJRn!!HsqpoMb3A79I z0r$bbc7Ocj;W@u2fB%25OLX?HA9VhJ6X=%!oWOIS0NnKRA^0A(0NnKVtHC%3z)g=2 z_#V3e-1PT>!MwovGFzYExmN&AE&abP>b*YrAJ0pGn|}Ux4}Eqdcvmp3DYDBUnbq?@ z;57J)?WsdYgQ;;H-(Cf*UcUftx}HJ10&vs)&0O-^$SL7|G(CNtcTsQj^AF&r`}@ph z;PG+Zew1mQN4K~*{rnF&fqudMf_WE!Q)tz!g~vJh{iA*WH=PgYmjK*!KHi;bL`Ody z{Ez$rC(tg;=hx?CR|*dtLao~$sPe&Tz5u6Y&F-hFcW($q)Yw|_uvPs4PN1#?-~`$g zfSc~`o14)yCk*aN5tpm4`ec+`x_JHjCVC3V1tpvGN0+=|ocauM zIuyBy|9{NkHL5SN8Xv$-=L6OOxITb+7l2dd8dZ|T9`U1gcZU^8_fgjy;HK*VjDrB& zbUt~`#=bv#Etp(91|{sV${%pk^VK-b@*Zg~1XI?m=ab~IdY%V7(c_z~2k_h_04LBd z0XTu@cKAFG+J*Um*ER6<4w!cVxar>~1>^A7#;4`uYOSa4J&p zZSB%egULR3#E3&ye!yw_*XmX5ANf()lSMs~z1QDo2An1*+cM$zqhMNncjykX@&j%< zAMkr6@b^tXy8>_mzxM%u9|XktYw^Dn`gX6vgJ3F9YRI9u5Bm2d0VnW#CGhu6z&r}T zP0#O;CZT)#-u9!N%UzS$Smh5mfqn_VX~(dgrFUO*r#rcBS6}j0*FWF{t_uM;^$k8a ztMmzX@?ZJlO!in^|A3pmULqzAId}NJ3+1oZuE(($oj>5F`&;qI2#4-#T&UWBLs2K+ z>ihvW-Cqz#0B$;dJ(tJ7>kn|D?LSgazZ$FSA8=~4dF#u%o88Ip_{9$e;&_O>p}o-y1yU}jDJE@EqZtckLRM`vwuG5-mOpySKJ;>W}$dD8ALeFBz@!2b@5^1mFbX2*6Fp2e0D<;HF>SfqudMf_W5x zo6ZNkju3#GzFxq61m0gjzhHkm?Qi1W>`pLszH*}GvX8p{0XKcUfH(s1M1Oq*+J*Um zzw06ZC-5Bp*PhSK)`QvStHd6k^pDP-A6Lj%jIo=xwp^_K{W!p>;_?{_2Ick?QA76Z zihHa5fK&bMKMq~Z=_}eTTt521dtJ|fllXEd!L6{T__=22-0iX254h=k?3b6%GsD46 zw8~)fYMWL5fSbH7J>+s>grV!*xX-X2ze&j)bR{RMR>05{#=usXYvI7j-3 z2BSWBJdf4ChXpvDytMwp3>!}ob1z?u7w@$naB^z(IZZ;Kk62Q1$nD9|`u#4z=}9he z@mqRNadleh_RZq7AMixKzQ8yLz)g=2xUL1@1g;|ixaoWbj+wZ-kh7auUwBde(Q$fy z0Z;V!VBQ7b^x@{*S)HBS#FUrS>RtYz>j!WG{StuF>IrYWQxE7ZYW&*Na-!Av0B$;; zB?HdYIp@(^G_Jg7QcA1O7XUY14_hMBt#8!5wL-u8DKF}8}h_bX+OlUCO+-~`$gfSZ233ECBa zoBllUNTy4NqCQs?x$gG5T=1QK{sG+d>wPc|e{FogbteEP&@TaaqSt4{__{r9?VQ9J z|18J%ywQI@2XG2@?00IILq+kaME{`QG1?C}y(>|7T8ExaqUeE~h3dT3^9#7?@d;W! z`&9Jn4x;U-Q%Cr&{BFUCKPFg1F}GR_gv6?FXE|I0(Q^j}K^908Ze2QTTo- zs4G}+;C(arewyv*Hz`Bjl@&Jm#~nZXM!)|IIDz-21>mOV%k22fD*0&ks^uNT&GZ=` zCVey8^8IJPsr88u?XLKi7oVGc^}T522b@413cyYGH)-BqVcR=*5Zii{?s(E_`~fF0 zF9L7^;~)SxJwDgg*!5d^WRM8TKOu04)%pWCb$98y$n|qCk!0rF$dXomz)ini2J1Fl z&q2EaaMSCF*?hpdDgY-j@?FKfM|+8TX?n)Lwpu>{H(k$Q9RAw)Ob93#lHGlfxUptQ zI=dLXo&#>Wzn~5U;HK*{df%pe@smA7#x)x{g~aLmDc}U!h53N@kp$qTua^j#`=@0o zA2GrELw?8aI)A_k^h*Fv;C&ztT3pjys5P+K=AJDDFzI4v)q z`sw}_14Yq$N4yGt*7*Z&Iv-Gn0&vsy-0u62?gu9I5_Kysc3x!l{0X?}>mA(p1>mN~ zvtHTUHoaT-65DP2cX6=#z761sK0csb0XTu@Y5_Qbc@cn{e%=Og{#tx6@30=g>l*la z2Ye1905|>lNY&HhYd!S!5koiBn=|97{`-4?)43(pyT3{5DUwE=o;)#5`vEtd4|pG5 z0B$;;E;p9e|5DFQ5! z54%3|5ZTl9sT+Qoj0`~aMSTiyRAsybF`m0)%oWAlsWb9 zPXSK${g=L=(jFqK&8Dyl3HtZB05?6JU>*hFru&<7`pV@O@Z!yc~_4}}Z6KEIa1AcEy0B$-T@OxG8_pQL^ zP=D?7ssG={hiJt>hfPAXF0|=a#-q{U;*7_7;Pd{<^&W zqrU$FPM}``aMQn!S!hJ2xF2^L3*+C90^Ia?f;?gVpj`ntmF-jg{+*ot{*gc6rpFV^ zivT>)?~n63N823j=poLnI^J~rcU?b#6UYzLAwHQT9V|+CHi??&KY*@Kjd0BZ_l1r~VCjIhQK9)R|pCykKV98?zS*l&ho>9dFyS)Hs*r?Q$%2 zp3z^Pk5ynPUq#-o#8N)veq}yZg{9i5%G=dg%2%DYYp|5BCT}~iR69n0Ek0J8rF?aG zyDm%ljQfI*)nlo4>hpF3RwGtJmNA~Z^W|}QY#?g@OP%M&+k>pQ znkU88JPl^g5SE%}citY#QuF-Z{Koc%@wpx>71y}$$;Z4{svU3M_F*ZXFK_#?hO_)x zBUk|}`X3ucXGjbe>qjb$lrjHmc$_DH{KN9ALzrx5mxV@+UPVw%{x8u6*)bdEQ~xA(o6MV;x};OSUcBJ;pl9GWr!)b*SQ~x-sq_ z;TSTmsv~*6oI@E~&Y>DNHI6F2%0rF2ng@BVJWthw@~eD~^RW}GQ>>G$)2uVBbF8zh z^Q;T3ORS5mDAr}xRn`@jJSJnvV={(3CS%BBGR8I5b(TC|#=60}$&%;GShrZWS$A1? zSoc`>Sr1tcSdUnbSx;F{Sc)s3Jogz(p8K37&was?=e}e;X1!v`b6>L*SH5UwZ&N}uebO2)k9+TrMkIAuC&c4T=}vy%fXT!d0f?%sx!rvPsWq6aJ zZwZzy%eY^XSt(W-R%wO2)k<|lKL9(lYn zs|ri@Pxe)D<*WLimWtDfw>$pJzFMc$dZy|~)mvvirwhxO)s-dZM$U`!$+48< zsC>qKW4_9#;u-UG;aJ^RJy_jYJz1`--mG5#vfqbUUsiusKbGN&fu~gh4 zygis@^sDoR@-cUoI?sc*hp`m*;%!fs;y%3X&GKdWv4*q!Sw_EVSNV+Xjo@*95(UxW-H$o-rmYmzHPj{ouzy`czY*H`F8R4Zq{Db9+uIsxEdD~N9DDT&)LsX z{XD?i2U)70hj{xiOZkYmkFb>QC~qHQDc^D4KEYBx^;7wc`6{m3Gv<4eW1V81VV!2F z=ibx2-pc1-V|!<%ho#z)=gRYxPsWq6luvTm2br_%$9dKT)+N?OmVD-x&)=7MJBlTr zxn;Z3Cp{{zYDaP9yTTsX=2ez#S3P&D=Wt^_(l5Q&S=U%9Pt_mA)jS*bZ}2%cS*lKq z@v`%=94zIN`_dzsY*#*?$sE<|h+E8Vv+lC)un`oAtn>Q>uH!&Crjn2`tzGv0!#T+p2{cp zrAN-O^vQX9z*2P}kNsiEWAcr7c`Paalr@r!f68N$r(h*#NxyY_Dz8+0EG0|jm4>%d zvlLIq+i6*fXW;Gh|FWNvSteE%R%Vtlo*GBxGw!Q#UCDW_Vkw`Br}!K`HkYM%Hf}2` zOK}%I){Uj|4CU>K|KeBu%E9MmXBqv9PvUbYvs9d^ygiMTlh4V;%FVK28U1;f>9EC*Iimf|W8#Z?}) z*i)OO`f2pn;bV1K%J<*eQ`bp7K1Z;O?J3@XkJV?XJXF6GSMzAxH(pQ1c*g6|n2%Z~ zlusR3*Lg$EsS!)A0m)d6Sxs2YSWQ`qE1zVJ|2f{Af68-Pu;lTUEE!+UNphB)7sZvY z6|>f?wyZX+cC7X+CsqfR9B(-Xa*pLZD6V{JUer8wWKSoSJXgk%xyd$UZn6!Tn><(M zCS%FmWE(O!*@oiEC-0rI|9AMO9EQ;v&TCp+_Y7nU=tE6at|jn#wIohADu`{&B) z$x?Z#JSCGc2qyZm>FUGjDHVDZZ7rx3Co7&fD8qJ6Jne zyIH$f#(0YFqK<9Ht6whyunvktL{b%b?{b(D3Sb%G_C+&{@W#gabh$-=p1X60h#WEuT3 zwheO`J1_r~aimwql72OA8F)KAOO5jxK7N{|xN1jn)sAuhET40ZrSde!Q+1$x>ZkIb z=W{QxF0n4MjDA%&%BRj#Shrbs zS$A0XSoc|y$^8echb-xn9%Fk(zl<$&kg;VBGLFna#*#T0`}2s|W7bpF6PD_yYDaO^ zj&c7PpYxoh@-)VK!N*>*l+U>TijTc!y^JTmr8U1TGx3w&lhl-=x%g$}*VC7=v zWZAHCv+}a?u=26;vy`s@Zx>`KUm@Nu%qq$%!ZP|5FV4q`u~Zz@p88pWkJ++RyQO%$ zBunu!yj_~5xIJ&%vC6W_u`002vy6V#uJRe%tH|e6VpU;PW*Pm8SL0(zBHY)q1GLxfvgC%2Hglqqu6vxbMj4 zG-s(ijq%jHDW7p))mcl9(SoIXDxTu4`B*EKalZ|-wygH7b}VB&RkzC5fjv&FPOOfs z&a5shXI591YDY4;ui{Fd^r*bld>H*Qwwz-bTh6hJBfT<~oIe*oKNp5k77%#-EK@?rV0d|B$aisR30I4giPf)&V;V;97d<0tt@ zmh=U)Bp=0+zR~}Y+#kyt!;)NjRQrmnJQP=XsJzvDspBe+%uUXb%uUXb^vOArxyd;S zVU1%=V2x*mvL>=7vnH{^SW{TjSW{VwE8lcxGg!(ulecGC`BdE5%)+g>^37p3m!;y& z(Q-i~CgVXbAUb`@8?b$o2Sm2U%YZ)7Q-io2QFCM&Ldif`p(TUd&3=k0B*9ju)! z)sEuIw~LSMw({-a?Y%7JQ*rk*+h@g?F(RSNsegJIzvY&hhryf7w^#pyoyS)VwRM=1av@bz=0p@w4S1mIrGX>pZu4 zfpv*>k)^nL&QQE2A9Jwssr@Ksmsy2ag;~aUSD0O8DPMnXvmZ<4agC2%w>qy6AM49f zz8ie(CQJE@`?vVmZPs1Z9V?&8LvfXdasM8lbD#B)^?+rJ_lVhJmhu_*jrF8_DxR?( zR32(Plz+2^7ads;;(u8 z6-)6qydBMoVZCL=vfib2dzKZ*Wk9}q--#6a=%2NCXZ+~a0e*WU^pDd$a^*e!&{bs3gN|J(KAOFj~F`kN> zjQvSjs@)X4ot&k(sx!q^ouy^W4s6sq5J2&&n~gv2w7ovyAO+;Bz;!R2-u}C!dpxm78V5GR}wM zDsMF&s-JoIoV+a6uF;>5kL716pRv6He5@c#aaHFkj}n}_Elc@~*F#=DmWNfCV-#W; z{fetRR2rzXui`rJv6?L9BVMcIbC2S?czZW11$*Q=q}H4N=C8%x+N?c%u6zzN zwpWLb)nzH)e)jBR)ng{C&Qr$~Z@|auTb-xk7{{w2dm6FSapQa?;Tn{`tD$@ZM*8IjYH*eZJpB_4dQ}$u~EdFrU=(?Y-&80V$UtK=j zT*vR(H+oq5taGU3&;zsG8nw3g3spS&GSmCHv}1d>>la3~vhZDln%=y>cRo43j<|lk zdP@u6GOJC8z4^oGQJ*y_vhUV$Vsc%)zW>z>s`A#s=bpFjZ-no+<==kIpt5T|xK?VQ z$L;ZvUr#2)Po>Ne31#9sXuiOI!}(qpr&8-Kp;bf2>Nv;Vq%6Mj#3U+kxNS_y5Y4k6 zTYU8V%SjXx`FYp1Ryxkl;M?QA-X2e}AKiiq7t#FX&!G0 zrkFr$g3@F=xl;ElS0UT|z0yr4w~6z2JpZBj+fI&8*5;c=O`bjLmpNS<%lL?sO+WU| zJ(ET~8sv5{Ui)neN4)6syf?jznwouZbVrMS!j%^uZ=DCx!JLc6Mjh8&G&{cFc0Lc9 zSU1g#x|KC=*f`($M@@&(@E*%%FYZ>`5~sX(l@(7%4x~N!|t^2M5hrDU~%hz?Dd3Lbyjq5Yy+gs0%_BR>kZ@jY>CUEAw%K7GDI`C3t9=zwoV z*DGsveU{(*ETl$@Kq}+6uJp=qUC(`=AKsbKK9KsJx{>2fc^zk2-z3{gXZ58?o4tJ- z=Jd4W(=5Dv>)jbWX-U1Yt{2K`p1f0|D`)rlQ1gCYrnsfz|H9xu|1S0J|6odTPx_u^ z|j=U|tdZse4< z+ilNK&6{^}omO*$2lae+pq^89%}1S?lkEG-KGbk=sbgo}>2}9FdC|S9-mKr`cfZS=ei(?!#K_B6ug=v>#G)YYEPYq^Bd`T zuUkGSY5ssNl(9shd&%FmEcpk;Jk9nyS8qx;#`#a`i@JU$4eXt-$;_^lP~qX=DxSIy z>+ZSyao)m~v~XjiEuC{YS>g;?a(Ro_;)*ml^}LcrKUcT#0{31V{av;Kl^;0ba!I@P z7QSrHC~>szvBN!w&2&AsTF?94l=W7f8)-{-YgMV-;c*X(f7FyYwcEQi7Q@#xnv_t* z$HMa#UcMnbp_Dk<>w0vVje{+`;GtS?O4qDPDTx|59twR}YK7Q12Yi+l^^Szv_%De)P8XPv6qKviIJWw6a{PH@P+s zvG^B%eP6@wdRH2{FvFkj-E}@^Hy<8c&)u1FzKsT_|?8R#h=t@WSXGvG>j;^b9o8t4_|KlU(uk|a_YvxQ# zK6w(--hGkUU;KW1-l=Jha0~Z~DCE}io3H5HwfiaCHnS|;bycHJXKD-=2cP8rS^lc_ z-yZPubbO^zqT<#bfn7UCSp0u%*Y+r0BS`Feoo8m{@|ssk-E>^OmZL=7LJcQXa9?ck zj~=? z^A!V~x?FgXSMyyjf8AKP+(%SSzpS9kCe5Q_vhL|}&qo};cwn&o_&JvNb4K5~x@(ue zxV*P^+htywZwhHPVNZ(y;qm6+l%h>Ef9&;r^k?Tlad*a(E=5z#wZuu5?u)DMq2c1k zy-Znqw$`H>eZ_njLNERx+D|1jBm9Y3Mb(%;2rj}kLJk90}>O2^;o zIkx&PhmoSI`!iSD9h#>*{QAnx^+DoDhxfgD&0A<`_wmb9V+sr&CB~Qi7G<+Z^ZPM5 zD+alY5_xVHII%Nyk;R{6V6~k)1A~O~vSW>=kFetTzD0U?jS%$$5|J{z80{z5|V#_K#^3uF{p#gS(YWRtw3GNk>4$*PGEy^32VVs|s zX*($0B!4|V^ZRDlY@a+p485IX<;)S9*Y!Gb!=qY&=z3>Mrr-cQ4qYmFk6Uwq>!k0) zOw+wJ&l_`jz@ZQQsAs*KcVc2@So%ABV1-{{uliA^>UpDo$LMu$THwN%N3Xr;Q}1kZ z{N8H*qE&@HgWr15+GYj6Y_WpRX7YOzKnG8!$yM(9R7?KdXSeCs z)OQR;M)ywRd{y%|t1G8?GJFhWp5E(l$BUCJ{?M9DmmPW^K>2@NYSHSl=617!Y{Yvn z`ckpnu3@`r11YH5}?TZ-}0k-X(tD>uT#naXWuK z$v#Bizh-@`o5}8JV{zuk@yb1hYToX1pLuWND^l)BJJ%n!^7nZ=r2n9{l_*b(s?T1y z>-e!5JvNm6*husl^zwd`r{+8D`<&R{y@|M7Y*Wz{L-f2CPrK&WzS~VigH)mCI}XWFM{;24sdB-++mgX$jS8V8?_Cd|zI)45% zSvK@7?<}g%D%~l)hvvr|9=H`;+(m4ioYys7fX=i3??{`%x%!AKzdKio3DNvh_HRAP zJs%_-bK2&3H(B$f^}Cjuy{eB0UvaZWlTmuyJ~!}f@+qjRSY5vPg!w+2uR34v?36=Z zV(Eivt$j%I#VcG=7M|-SZdSfDHFk>TuX-$NU%NB^iOn9#7TR{c&T7L@81#lCPnGL`t%aNhC>`#Wln=UsEoLM8wr~T|=ofXf`yc%-c{R z5lJdVQc{`cq2ak2?z+F<^ZGr1{Qh|Ua{jp6eV^sC*Is*{wYPJebAlm0bsJh%3&(gP z)6Kn#-(!J0uCps!T17@bOM7;IXvBXUB*GLwE!M2EQN$7XuOF^>!S znLTVqu3m`ap`e9ITP%~mu9r4&VZ=E*MmM^81;k<5!#G8A15flVIQvDj;0dNZx;?sC zXq5*_PQ1&fau$xq!S9A#&JVm%X#UHUCv||QSovp#=lUSo{cOWG3gVeM)jCpSGaWOu zc~#oL%K2a~?XH?N985rCmIm`&lz}U|J)P&_>w>;JXg1l!0Jo3(r*`RG7i9XRgj}Hj zewryfy4iEf37QDSH%9 zEIbiK08U;cYV3p{I3uoJ* ze-~T#M+7NoqgKzSI{HJv2Xpxco8D@p@Q9_{@!b&rg4hEC*)57#I_RQuZ7c93yPR}| zt)|#b@KXQf*T8iItf=%ordYw^AH~&gK)+_6>Vr5RQ`{ubD`fE&{4~DwNX(Frfb*^| ze)97b@PPe#?caq6cwSNSZK>DM%<<6j{DWdzx+x~sOO`6P0$={|bG`I?Q`~hwMs!YF z6w^Lc^YLQYe+YPzy7(jCYv9Kht}l`1WFMCAn|c%U0r<9&Z(Br`Z^cUYh{v=Bjxu#B8z_sU-S=WY%G}Av?Z7W6hVo@2 z0xo^Le23>N;HuX5*R^z-p!M7wj^u@rOr6Zg+M&~#n~?kK(sML!;7{u)=F&MTNcOQ# zjMRb%ru~+bqe_kXCdl-t+ADJc@FAYkietumk%jGrFnRW4O#8iqT1Yr>D@vg~5q&TL z@#z}6QZ-KBjHiU2uMhkJT;TieC%Sej*hzo3(PS6If0t(I@r`s1ls4EC7B&TZ_(y43 zJ7pgdGB6CeA_U|4%lw+^aS2BhUCA*gWDVFGS}Ryh^|_#AE0gS#ao}h6tPN^g7{|*7 zUQK6FVen^OMRs-M0((>uP%_sl3;4crDG$Ch#;dzIiB`rU5Qm`n>~u1(HBz&P>of5O zPOASpyVBSUwbQ;G%u$2>t$w7McsJY;{Ug)VahnSLHSRtn+Tme~dSsO~w)O&7xBbbT zDd~oadfvRs9ffv<&bPX6*<^-H@@n~WbPh4&zfOOy*+X|b)R{D_W_%-@$vYQo-!>Dr zMh>b*0d4YOOs<&YW}(Kh3z@Vwa`^5HWODDO#A{=;UiHB++ihfhe!G z{;6$NNM>^93yJl|CO09j{b#IN+z&GOz_8al$!EHVZ7q?s8JuyX5d3r|E60B3Rz%K{>4!tPpa?brWPGCX@GHc z$xyLCUVw;+p6B^hpTqdse>+y*jnfxD+!^)uVkN|_skw0<&m;-QHuM`sJcT?^xiYiI zl#PhT`tPTGZ-Vj9)_IS|cGMM%7dr{?H^Vr*8TUkB6VU+|im$!CIs@7(erso@b{rAg z^AL(%!hrKxO+9Pp0|OB!d>fRE++k=9%!;2#|VHj^(P z&cw~86Ip@|_`>Zm?~Y99$JU=+<6*W$e8hrwY%UdepT;ap5hWttC6E%epcZuIX_5M? zd3~^R%BKPS|-%Ds12Nwf>c5(THVnR3`b(0Gea0DG8Ye7kJ zXgH2scJ5P5CG`6bv{<}wjErS9S|nyY25zzJaZb;%7`&S^x^-SD@Sf_;TNg(};^BD% zlBE^EZ>{_hA`wf$XZelZa~1%f<^N&7_CqSJN;BK#coX<%1#OzdDGJt+8~b|YF8IG) zs>7%G2^DiqjT~XkV`X`|uh?Ev@yCgS?$%b&F1e&k!=@YxjwfrhIC%p9_`1CFTv7~P zCGhUvqC(J@%^MscU5mlwTJgA#eqis~-+rU$Y$P_3%S#aV2EOQJ%N^VJNZkH@_a-)$ zI4>I8Z$Q70icR;c_q)h|{#+OT26QJG*Z6n6-f0cIr?w={B|jO{$N3CDUV}XF#;mQT zJ|h*A$ifLAQb5Np4SVYwDbO#kDyV{8Wi;GN{bZLK z1HA7=k<$G8bX;s=o-1@7_-cE~@Ki1xSG6S=T)YSMez(y}d|5!lykxtPiW1-%zAGXV z@@cqYe&O5jPw;n&u_S%P)EzqJ^)c>S-3fd!%zo)}22VQ_9MIbje}9!8m*g;G=^3((=QTpR77|ceF5&XbVsDMZzM(?&mGqFfd1uGA8haV$Ka+1 z?nS;VJT50f;!;2ij#_3qsKlbPJz#-TULXZ$tLP?uX0hMAoxojKNX4U%>X%>a1^p#c zXS;ZdsMt}8)_kE0{NZqPSRZkaf=vX&)fqx19L>oI!!Os88l5w8`o$Ppeitr;we0Z~4gxJ%V^}ZGx5587L#rhwu{2G3M z&YYY}T6K*0tjkH>^L_%j>D7P({2>&4R7FGa&?uZA9tkkd+Eqfu1=gWSTPK0*D+S&n zG5VKF^lVb7QH2y`ChA0}8Z z#@mS~VgKTOu%B1o;Z9(TTTf$=(SknU92*6+EE(gx|8V>g>p{>NQTG_tV&siQ)x#3T zB5zsfp#wJE0Iz>5S^zF8-k{um57Yft3SF@0(ir?epO18QzR8jI;TM_}1} zqA>Kk(tNJ&jt4ZnzvWnA<{aP>wpYrQGUhLZ7^iE`wSXsW!0L6kl5z1xM0qa*yvZ>^ zAR;>%TV|5T$Cg38L52L`!;CoJwiDb`w-)%9zFw=2(qz0Uu+N!)6CfRH z?QyRzI#%I5v-M;saJ`;%-5WxQc=m);%_;BmO#5nC8e4A`BMu>}#!k?|zH97+^?Jtt zlT@E0$*}k8M#H#Xom2RG(pSx}1 z-Bf-IzAe0Z^LZ9t5pXkHim_gjsXd{&*AH|uTAD>Ke4^lir1HFPEcV`PlFYG>KmWSU1n>}@?vcQ!RQ%L5H;Dcdu5TV0US67&O2L-W@?YB~fGgg)x=HV3 z41O=jrm~$Ah#7F;{YN>;JIOfbHW;?U=%LcC{q{MVGt}0C5rOLwR2rZ&c z#*lGFnv^nP(fM2?MeR@};X3InL#ix1YHW|20+EDmuE@y9vFL=|*il>)=7^iS15K4# z_>Mcf4iL;YWPY(mvMbcbZk2(FUveKwTP}>?H!KU#6;Ef2Otm2q`qpDe@n*1Qz-{Y{lLo` z-|-f7kns8t`|Bk=pnr}l-z)fq6LwvEC$_E|cxt>ew`YkH-l%9BMd}3|F@KvK>)(*D z-yQxMS|4z}wtI#d4J5ogw01ab0OsYex_9q&&pF`_vhvi!{lJ&Zy<#pzcET$c4eaY2 zfb~G^+5T<36(rnpErFCg2)wP?mCd16| ztC|$bJb+)lxzVav#1p-pYH6PB4m#ZppTt)8kdXbR?Q$Akz$L^!x@>A7p-+`pH%qfz zpB)j2TKV`J3E3QYG`!Ob{A`+1$`94^M5}dAboj9F&sA#agsq+^r8(ddIX z95HhAZ>E`|LU+&0?LEMEmgyYOxv?F6k1I6ba)CL zolSap*zH5phi>3+zbd`l)2N5*cOI^c{tDySG$Btd>WLnjS|Y3EN`!Thpwri;cP4ts z*>6n?oe1{TF6-aE9CJdHg+Z+)MDWL&&&V`wtu^9Kwg0}%4fvvsixsHvtQcajj3;zw+uV^fuRj9QD6+X$>Y?t+LyTmT&7G8)BIkN}h`cS`KJq zb-7vdyIJOug+c2qw#n;au30NLZDi5OzI$5e{bf!3Y;?7W2h04}nP^!Uv27pHl%5PY zz_R|CT=?nhv%Onz=ds3KOO|=lsFtf~u*e)`q(+T$u&jS}PjXv6I_-+?)aq52AB1&I zp2EvJHP*gp;hgtcEk}V%E!WbN8zCYN)wra2KCq5*58qC^KkAD%PSEs|S=Np0Y_q2C zeqr3N_=VEU2G)7#&Yld*pq%@;?%UeCw4*@sPuk4gtn?a}d zb8v9{`c0lcdYtSLyuVF0O+Vp_xh?pkGHtxlT*l`2!|#~8|LZ^edpu-*`N00WIlmq& zHVqh0JNdOuKW1!t`}>`f@es4=wg~btZnyfiNBr04{~eb?(cf_~|7G|01WOThi&nneLNfg zgVD^cnF!28U?u`H5%_;bp#RU`(KF@m0M5i=CJxgPm>CB%<6veS%p3;9DPf64$xIel)u{?GS+ E0d5wHI{*Lx diff --git a/regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/parameter.ini b/regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/parameter.ini deleted file mode 100644 index 03ab0e44e..000000000 --- a/regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/parameter.ini +++ /dev/null @@ -1,156 +0,0 @@ -! =============================================================================== ! -! EQUATION (linearscalaradvection) -! =============================================================================== ! -IniExactFunc = 0 - -! =============================================================================== ! -! DISCRETIZATION -! =============================================================================== ! -N = 1 ! Polynomial degree -NAnalyze = 1 ! Number of analyze points - -! =============================================================================== ! -! MESH -! =============================================================================== ! -MeshFile = mesh_70degCone2D_Set1_noWake_mesh.h5 -useCurveds = F -TrackingMethod = triatracking -! =============================================================================== ! -! OUTPUT / VISUALIZATION -! =============================================================================== ! -ProjectName = 70degCone2D_Set1 -Logging = F -printRandomSeeds = F -IterDisplayStep = 100 -! =============================================================================== ! -! CALCULATION -! =============================================================================== ! -tend = 2.0E-3 ! End time -Analyze_dt = 5.0E-4 ! Timestep of analyze outputs -CFLscale = 0.2 ! Scaling of theoretical CFL number -c0 = 299792458. -eps = 8.8541878176E-12 -mu = 12.566370614e-7 -! =============================================================================== ! -! LOAD BALANCE -! =============================================================================== ! -DoLoadBalance = T -PartWeightLoadBalance = T -DoInitialAutoRestart = T -InitialAutoRestart-PartWeightLoadBalance = T -LoadBalanceMaxSteps = 2 ! one initial and one at 5E-4 -! =============================================================================== ! -! BOUNDARIES -! =============================================================================== ! -Part-nBounds = 5 -Part-Boundary1-SourceName = IN -Part-Boundary1-Condition = open -Part-Boundary2-SourceName = OUT -Part-Boundary2-Condition = open -Part-Boundary3-SourceName = WALL -Part-Boundary3-Condition = reflective -Part-Boundary3-WallTemp = 300. -Part-Boundary3-TransACC = 1. -Part-Boundary3-MomentumACC = 1. -Part-Boundary3-VibACC = 1. -Part-Boundary3-RotACC = 1. -Part-Boundary4-SourceName = SYMAXIS -Part-Boundary4-Condition = symmetric_axis -Part-Boundary5-SourceName = ROTSYM -Part-Boundary5-Condition = symmetric -Part-FIBGMdeltas = (/0.001,0.001,0.01/) -! =============================================================================== ! -! PARTICLES -! =============================================================================== ! -Part-maxParticleNumber = 500000 -Part-nSpecies = 2 -! =============================================================================== ! -! Species1 N2 -! =============================================================================== ! -Part-Species1-ChargeIC=0 -Part-Species1-MassIC=4.65E-26 -Part-Species1-MacroParticleFactor = 1E10 - -Part-Species1-nInits = 1 -Part-Species1-Init1-SpaceIC = cell_local -Part-Species1-Init1-velocityDistribution = maxwell_lpn -Part-Species1-Init1-VeloIC = 1502.57 -Part-Species1-Init1-VeloVecIC = (/1.,0.,0./) -Part-Species1-Init1-PartDensity = 2.775E+020 -Part-Species1-Init1-MWTemperatureIC = 13.3 -Part-Species1-Init1-TempVib = 13.3 -Part-Species1-Init1-TempRot = 13.3 - -Part-Species1-nSurfaceFluxBCs = 1 -Part-Species1-Surfaceflux1-BC = 1 -Part-Species1-Surfaceflux1-velocityDistribution = maxwell_lpn -Part-Species1-Surfaceflux1-VeloIC = 1502.57 -Part-Species1-Surfaceflux1-VeloVecIC = (/1.,0.,0./) -Part-Species1-Surfaceflux1-PartDensity = 2.775E+020 -Part-Species1-Surfaceflux1-MWTemperatureIC = 13.3 -Part-Species1-Surfaceflux1-TempVib = 13.3 -Part-Species1-Surfaceflux1-TempRot = 13.3 -! =============================================================================== ! -! Species2 O2 -! =============================================================================== ! -Part-Species2-ChargeIC=0 -Part-Species2-MassIC=5.31400E-26 -Part-Species2-MacroParticleFactor = 1E10 - -Part-Species2-nInits = 1 -Part-Species2-Init1-SpaceIC = cell_local -Part-Species2-Init1-velocityDistribution = maxwell_lpn -Part-Species2-Init1-VeloIC = 1502.57 -Part-Species2-Init1-VeloVecIC = (/1.,0.,0./) -Part-Species2-Init1-PartDensity = 0.925E+020 -Part-Species2-Init1-MWTemperatureIC = 13.3 -Part-Species2-Init1-TempVib = 13.3 -Part-Species2-Init1-TempRot = 13.3 - -Part-Species2-nSurfaceFluxBCs = 1 -Part-Species2-Surfaceflux1-BC = 1 -Part-Species2-Surfaceflux1-velocityDistribution = maxwell_lpn -Part-Species2-Surfaceflux1-VeloIC = 1502.57 -Part-Species2-Surfaceflux1-VeloVecIC = (/1.,0.,0./) -Part-Species2-Surfaceflux1-PartDensity = 0.925E+020 -Part-Species2-Surfaceflux1-MWTemperatureIC = 13.3 -Part-Species2-Surfaceflux1-TempVib = 13.3 -Part-Species2-Surfaceflux1-TempRot = 13.3 -! =============================================================================== ! -! DSMC -! =============================================================================== ! -UseDSMC = T -ManualTimeStep= 2.0000E-07 -Particles-HaloEpsVelo = 12.000E+03 -Particles-NumberForDSMCOutputs = 1 -Part-TimeFracForSampling = 0.5 -Particles-DSMC-CalcSurfaceVal = T -Particles-DSMC-CalcQualityFactors = T -Particles-DSMCReservoirSim = F -Particles-DSMC-CollisMode = 2 !(1:elast coll, 2: elast + rela, 3:chem) -Part-NumberOfRandomSeeds = 2 -Particles-RandomSeed1 = 1 -Particles-RandomSeed2 = 2 -Particles-ModelForVibrationEnergy = 0 !(0:SHO, 1:TSHO) -Particles-DSMC-UseOctree = T -Particles-DSMC-UseNearestNeighbour = T -Particles-OctreePartNumNode = 40 -Particles-OctreePartNumNodeMin = 28 -Particles-MPIWeight = 1000 -! Symmetry -Particles-Symmetry-Order = 2 -Particles-Symmetry2DAxisymmetric = T -! Radial Weighting -Particles-RadialWeighting = T -Particles-RadialWeighting-PartScaleFactor = 60 -Particles-RadialWeighting-CloneMode = 2 -Particles-RadialWeighting-CloneDelay = 5 -! BGK-Flow -Particles-BGK-CollModel = 1 -Particles-BGK-MixtureModel = 1 -Particles-BGK-DoVibRelaxation = T -Particles-BGK-UseQuantVibEn = F -! BGK Refinement -Particles-BGK-DoCellAdaptation = T -Particles-BGK-MinPartsPerCell = 12 -Particles-BGK-SplittingDens = 3.8E20 diff --git a/regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/readme.md b/regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/readme.md deleted file mode 100644 index 7d59cfd97..000000000 --- a/regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/readme.md +++ /dev/null @@ -1,4 +0,0 @@ -# BGK-Flow - Hypersonic flow around a 70° Cone (Axisymmetric) -* Simulation of a hypersonic N2/O2 flow around a 70° blunted cone at M = 20 -* Test case based on Allègre, J., Bisch, D., & Lengrand, J. C. (1997). Experimental Rarefied Heat Transfer at Hypersonic Conditions over 70-Degree Blunted Cone. Journal of Spacecraft and Rockets, 34(6), 724–728. https://doi.org/10.2514/2.3302 -* Comparison of the heat flux with a reference surface state file (produced with DSMC) diff --git a/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/CouetteFlow_DSMCState_001.000000_ref.h5 b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/CouetteFlow_DSMCState_001.000000_ref.h5 new file mode 100644 index 0000000000000000000000000000000000000000..7a11973208d5b486c876138d14962a0a06ba8787 GIT binary patch literal 54224 zcmeFZc|29$+doW$WQt14l%!CE5<+J$IV4h)%=1C!;haN;NXAs6P?E?{q(R1H+FK}7 z=DB2OkfAa(N_kepZo7M4_j5nL-yioszUTA$^mf*|*0rwdy{@(Pwbx$zL}-xJ*;#m5 z7=C`3nHiQaaQ^xe|7Y&cr@8HS3H}|gxBT-5;~zZr2QwG_{)3T$jp1kA+CSx-fAkA2 z{$0?#^Ec`pQd47qlDK{x|1@J@Q2hND^WTF1{IQT2&`?v+`RT9WAE)tns`(RVI2UTp zwk~8Vx)uH%k4u0T{2wCMpLqQ@uGtu*f2n3{iFsy?1%)vew8GrYT z_m88_KGpqJG@*t1fvbVSAKqAg@uu$JY-^$C<8J$BT>dBi$cMF657VvawhNQNdHk{C zap!1Dp<5iVa`{E!|HPlFo2Mc5ERs2>JW9jKC`mJHu)?Z-2#~zAcsJ;O6=> z1i6F|$m`D!V31{Hke&N;o%-+Q^Dj{bWyy3}_2&{nQ?ar6rSji+{3Q%) zaQxZ5w6qKiU}rbOg%_9e-8Wj;?i(*$_w{UD-1VqduC#?U1MuMg>;A%;0sk-e7uF2G z-9O;zVr@$$+q%*m=spW)4Zz+18T|SV)(gk+-=5BQ|BxGfA-fN^5-1DIe|+>0JGkgr zQR#3ASWpDu?*F~;Y1>-4E*u7ayT5&5=ls9jUsxH>uMnR<`U@-L`7iGOo%;(h=ihGe z*ZqYx1MuMg>;A%;0l51MI_Li#{0lbc|Ly*Q&G~=3zhHCz?G_6<=bv}sTUa^2o*UiD zd7)I&s`wKAR$K79`89(m+-<5x1W&A=yKhIEFXj^%!x;Z<;bE^yO8Ru{J z;gg+(>Hlx{RS#RZdD&7ewAFR~B*O~?_UzTN_&MPZ**aT!ThZaMPjxE_-Hp1y+}DA} znr!IKztg`3;yZNn=jf|>!?TTaTbl()!B6+~9cUD{g>|L}kME!E>)G2-hZBl zXM+F3&z~2v7#YNV)i5slUGV#KJaG>G-|vgzS^A%n|K0loOW|qzpY@CWDExW${^$3_ zj1vF?{0v<9jlch03FUu&e#)#jdJns^|MmTU>z~614w4yR@4u~JV3<(&-|G24{rrc4 z|1j_$2L8jqe;D}RW8jI&6KAtf2Q1A3qu-5+L7T4*{*V|iMA}c*y&&b%z?$H~6Zfvu zz#WAjJ6uv}fOB6?%Oy27^28%MpGVC!U~d_Iy)lOdaEl8K*vQHjHsI9ij_}${8sJem zmT@M)0jsOumB6OqiG(b@rQ(xWgKE8D?EjWW11t6i81-h;fav4PDX9fCz&n=_;;@H} z?3njp{R2@?;53w&bh?nxZ*rU^aMIKUbR5pp5QFVMKR`-8oOHlMUa~oF3^key(Ln80n&qPaYJB-7I&U4wmo!dO{+f(9i71 zI<&@|4tB1Mz53-2QI7kE>(UC=5U6AGKFCt%y4Y%Edld%bQTB#b>d_s|NY1%8CvQXEaYS;9Hh0EOlB~=0bxKLG2rh?w9JobhB6#0nx3QS< z@lj0UYd@3f;RIwyRCM8|v;tHz@$r@KJv1PEWrdM@8x71kKCDGsX<(^hj^Se_g7;AE z!o8i(3A=5z95}zq*nsMRzF3dB;;4 zcz#0Yrrx8YSj)iInj*hwgmQD|-GUdfNFTTO@UCYxAX6S(bO*NIeS5I{8?@(!0-N!} z#r)*!o980g*y%vN-s$d@UPAwOM-I*gDLPmeC{?G`O_bw&XvJ*NGi{Nsi54VuR$4dUjdoA_d7pvEH*t!);eXc3dsNGzoo#gXO zRPVs8@aA_kFsa7Op!^cff6*%QqpxT{fVyhG(G=_7bw*Rv)QJz4w5_%Gf49NdsZ|olaMWX@KO5#FjubEQ~jhd&ftvNH`h&NPrIf3(uC_ zg#F_7b8@^eQ4^wrP%={7JFgtC$I)nidVM}$GZHp)iRmun9mmAP94D!}lce~wkB1!0 zVi8>Kw&SO@>-q@Z&jfu~qRecERm|GRdB!CoGduT5XYWiwj@L>Hvop|vIg9?esvk7K zCW5Fv{YC?38K0^S))TxdXj)$pgY~#Q{B-_9>zCO8?e8iXyI{GN%@NgCP`_TCh2yx? zDRle$mz(FNh7jfBiej6V(E-Zz^4y|DbRZMEq9qohf5fGZyA7=5<~hOFL-*)l=oX{+ zXJ`km|FHZPO@3w@@L*YS(8yvsczj6dMl{qfxK&9w;CLW%GU(u!I;M6cI_8SfWmw;r z(-TjD?FW8X3n|RefXmvw+H>`MWM8TUtqahBDaJ7t1v1%+O%QKpYesl-D~lap4*$g~0=#TPrIV!8XX{!8++q=24!QV_T=|gT{YRMZ4LwO) zjH|yV_w@8>M29!=wdu!llvyY;MUhx!NP zhf}9l(7`A$<7DTC*Rx&k#3}b!$pcvUfbddJpdpqsb%l-4&-b?ecF{BiWT)m|np{Z- zO9tecd$-wQW$#Q3U3NwyQ+GX@tfniFg3wN$T&Uk513Z2U+i&2OXg7oF%7HeXHSPs` zWFF}U7rNnm8b8?WxeNA>^O-6+e8}`O4cI!ZIj=Xb9IwZ*$iDYY#iC~9d*w=vM=;)T zG*n~iZmgapJMz1Mv4LNHwS6(;*)6Nz}aAm4VWh;9Rv zbB&Xh#?rt`i#JxKHjY?sL|DdDod;^x=0Xu@s6%~a-mKwEr-9gYU+YOpG!QJ!aZ&yX z4cIJtUB+U~A3iZZC+i_H1qJfk5ypy(FqyfxE`t>dgezLTz+CUAN4#qwe z+nk4TIG^q>#LM$N=pg5fv{C}}A20tGTYH~bwrDmZRr>|HUk?rcMP7s8(S6>Nq^hpE zd~Lp11eX)jtatX2BCf0NA25A-uIhxX7a=X49(F>fC9Rr^gVGQ_Zj%s!lQa-z6tvy+ zI1L>4)%mC$NCO>8-VH}W2;P$zzHMhaP1sjxp({c?YXhvmJUF-K1T3$8y?I8>38N0) zzo{#ff_4SEHV(+{LynO<&-;hbz?s4)i}}N8AZwlETM78RS8rT7!iSB#%$t+pfrlq} zQ{J`VBdo{$UM)PpnH6FKc9~8DUV`!mw^^Btlbx{7gMK-$pI$)Q@~f{)j>RC=^$(bz zz__Ra9&1XVA1iWthLquVLyg>!_W}Imy#ksuUcPkjeVn(CA%f8V3XA7GcZv?eV;S|w zgNSmxe;oZhrUR!8ni1QsUTsi7Mq2CQsI*OT?TCW9{pZeaf9|mF_gqJ}BF$NrCY$Rc-&tfd;Z$KWti=MeshI zlaXOfBka?iQx{9iumOGRCY%@@VgBQ-EpSQP8Jp76$qZLGg)#}Y?9i}oMsAUJY>M)r zfzIB7H~bLqK7Y#c-Gv6M`MAEuUuGkJtJuJO<2@aGiLxb~^dj^>cvxaub;SnQ&RsN9 zfcEi!XdQ?Zb;fLB^gk$jc%!O{j<%U`Pmro}H@}HNy%qZ+pUXfyw9Z`E^wo(5m_G+a zb)@ir@j-iVp8v(yJnKzZjy5B8kHh(O zAn!P$UZRDMj3-H1A-?CFKgS@r+{of5JRdCy-X%N2+3J?KU=4iYZ}Vr~bH932FmaolZ#r zeHthpiESGC>Wt0g%1yucVvC&fk5Sw)+=L8I78#-zG+?yqmOvZqC#=a{$pm87ny0eJ z12*#4E${iw-_n8Cs=n(328902hnJ>Z$h85NCf~jKY7BYp5*9a{bH>6w(?o14e3AOI zzTeK$nh|Pe_17KHF2$_aoz*ZKQ9_9a4l@bZ6AA?G3cGS6m2`i#p>0mwU!5h^7OTeT-ia+^qHL3|xALX6#9#Vr12;?sce7>6o)-PImVzkEv>nhD!viQ3#{yuJpUwc}Q2T@t#I#?}OsgA|w^K zPKFPyx&V<$W}8=1A3s@7B6!u=opiA0>7u0jdkFo$O|HB(4e)xMu_vH^UcdkHuBs94 zWq6_)k*q-a#o%=n$Cx!yyBl^-k}eu0E1zwTL2$W86^gW?(**COvFnSS3tce{C4Jq5 zy&-7wCQG;dXf5K@;}9RcnFhL24A@geX}~>r_=Cn48VK2%om2Onjr{1cV!pW?4Nzp7 zNAALM+^&G9o8NzWVFQ%1B6o<3(SZ4R&->n(D`wpMl~%qh0SS9w*GBy|h;-yO$9PM^ zysm^VFvw7PZ6`J1ODS8N(fjjHkR-6?5uFoc(r3E`jYhGA-*epA>&& zWX5ZSn>#h7cIK}sA!ti(XfY)5O&UQ z*LvA#pdQH7c(BueLz{b*BP+Dy!O0hjqU?Wpzk$BmaSO`f_6&c!IoZl+3$Vfnn+vcU z;XCLOn*sH|a38-@z8|@EJM;U*;bJ76zcQ4G3*K)Q4L&%zk_JlDcK4;hek3xC9}7va zlRvcB(0PmL;E_Z8oh48X*DvXQ_L%WfTY%FZwMTPqg=*m!E z?e32ii0r$a*aQc>zGTuqe_cTX-TO=J!=XKEq+L7ihzpR(^{bxk|3U)>LnqdELpfYO zi` z7595qZ+=Md9(pRE>(y>|tScavZ&>LTvPr~nNUWy<(Fm1WB{53{_jLGjxyGmK7`gjt<&34doZh(<5y3*vaeDSB^bVp@ZZrwH2M8 z2>n~%9r|u2Yzw6GxZKq~Q-Pne$LUnyj$PIIEbwkT8X1$Ue&6X|gY-Tz$h7`O1?@b; zL0OYjaJ=efyBEZc)=Ax#BLZY&#=+(lr8M9bc0KLlS3*DO?L?Q&Mo&O_k($-{fhfoQ z!?BS=V2D4r8S$WRp`L=gakqU!9FVZ)V3fqXmqq21{^_eZ*@z%ag>i2>SEaGQ6m|AYY9 zh^+I&sRCYKbZ=Sheop8&bE*E3tKtbBrzlLDLwj(Z|3$63CDfOd&4?-E0pE1UJC1ud zjmlSkogghwUs<7g62|)QaL!t z7M$t(dgR&_Do|{0ytVv_2X@e(H#jmi7I6;KzUld31Q|TLzOVW^9M@ZyA4()sK}bUV z2N$U4d~xEgiWlr;0sXs|9*M&H%_5F3v#=ibd-s(i$+seGLG6{3GD4|TVCI)j_Dk@< zYTl%-p=8RT)dq*3w(t%kDpsRse>qIJWmH2F52JM$QVu95@7a%Wsc26ee z6ub`%*=6z+mgD;0HTJsjgn5E594i|KV0*m$U;GxmLFL9+Gol}m<`w{X$MI~`$~%&+ z6QoaXc>Kb3V-Q@f`SST!E_(^yJ65>KmWp^_OVkT^&YOoJ*MFSYd|+}AN!v2-cY^+9RM1HAag-P|*c4_~q7f6D9 z3UgvP6^QbUek&@Wf|J7RkMBI70%OPR!<;t-$SZgImwafZfs`Ko+s~mKuHQ#P(9_Do z6Yz+hddD!YU%Vd2g8akh_qI19PTRShkHLHf#{Q~GkSb-Z#-$u$5L~Y99&;Na zNbo*ZH)3*nITf>1IDFz3?tRaq02ZVMb{Om}cY`SFuTKo~0(oAP3~%KRx9C0*%pk|-ZX zr7<4}$TIBXu^CIj3}j^ft9k^PqeTg3E1Bl`+qDBzTwSseBjWOT~7R?=5=co`f(y zd7!E_Gl+~Ii-@qbpaR~8Z?{jHQo*EL&g~czDoF8gt3Rtk@NQqK8GG59u+PeQLygK4 zTW~nw=qE8VDmZ9;KcMI&75fled6Jjy1}gMaZ%JQAFJcvx!Wj(Poqi%H^1+e{-gip- zN!Y^meyBFcT7!eUUg50>7tAx)9=KV2--^)hF!m&FTdOTdzJFbD5Vog}HVUo}pklI> zN};Y6eke6oZ>GSeAGvm)*Y~I1oyS|mO3bO?V#~E8OZc53i$CKtS&-bQ9MZf2=4W>D z#R+2b?0D`SEbtfx%T z6pTS|IWvE~^-AXn-UI7;okrhNF&|OK-8$u7Xu&J9B>v$+gozz{zeIxyx))0{GbvNS zF^yefIcikUb!%BZ*@xiW?0)0jQ+o;fz~Zh&_8)BlKaK4RNtFuNv*lx~C#hJKF`dg% zfD_%Bysp7&@HxWqG9X)f9~Eqlxwq|=Iu$%|ynDS`g$h=wKYp^tg@ZgcSu(l`u4@8E zdlJ2&9^CzcwvodrcREZ2%?X)|G;t8(=vFFrfacl7XTEhxV-KekE6o`(7ONuK>2cM^@8(;&SK8$v!uCT#k; zkqWjo?>hehwhw>cyw*mL3dZC%DEFsxkn0omj18pWeM8-Cxt;U$e{A&gYFljwqH?*_ z_+b0(fo#clY-rf#Sl`JnU(X@Cz8za~t#t_DJe9{)y9v(I` z3d#4TAlZ8`p{xYv^RwT#w+PJBpBpN)Y|~mV;Pr+}AP?G)^ZYMTo@&dyCbb}mt)uyp zkarx9((HWp2Eg_GS$k;v_yq))a~TpH2Hg=5is1=Smn zVN_2-KF9+k>j@vf72pBlFLNG^J?;S(cW~^!QM-bi}I)?1{ZqxI0bruwf3YW)XxJ% zI$sZe8|(o#M(lX~?8yqU(7VS9_3*ysZMD~d;Jbu=k5cZ$_E9^~@eL?3!}hFSzr^h# zd1Cjk3-fL93qv0?-`j8e80N_}{rh!KdVm#44)mS=9$@F1J3CdN{3@xG^A+{$$y^T` z25n$o%yG$##+*s$FS#Z2?cj(PP;Q@{y#($5mv8)gxaR(bp28MHlF6>K6!MOvx*>ZI zE5`)MsZ^9a=6C_Y<-(p;#XZj~|C>j;?JA7gK@`yF7sG)cW4lPdz}z z7!M{ON$~#i+SQPWe!{+pf-kEXj@bcLwlW)`ZVxafTIZd0kd849Th^02q7lvGOBG5l zJVl<@#t%#Pd4PLlE}QpI|C(n4?_WdxPM&(uH#k@(-*h62F5TIl)8hex9#uXMf%+x& zRz3HJ@)tb}q9nGiCmRPkFA;2|0_R<2g6IID-&8ED<+7(2c>SvL;Ca{{=lNgMQ%&9? z=h=d=o%goh19`{MPR2cK??YzXa@q%ec!1`H9AEOR2XJeMJ@yIW@?37oRpT6g*O@OHrWO?~Bi2Fc zkIk!vHSEBu#hI7Pzr%SVRRVgR(y)s>Oh&@j9T1sx`EsL{K16$`x=0o?71;B|aus~_ z0ABXF9$t)8urChT8}pij+#50)GaNtz3IaJ%QA~t>AJ7xKm23w%VtVBFLV01A4!(`O zG|c);Xz1XJKxF5!VI7XPKBRnxjlFs?6;NCDy_lWx0J%|iDspok;AYwu#ls_lE^1EQQIj#J4zYi98wu{3;8yS_y+4DI(YMCQ%FrO@qE$?i9PZ|jshy1 z`96Df(t&4@=!tvnQkcNBSnhTt3th%}V)D8`EBZ`8c=XmwI_R#x+Me;04x)AL)vkjm zsW5wS_8JR$TYt)^u`L}W7B2C1hk9^-59@KR5tF8X3cF3+KF{eOzpC7>#9s=V;yd8` zOg#$SID;8;iS?p`yo&zXeek(Ag{0*O@svS{W_CLrr0zV)RdSt|TrNE^^6DHNOn9su zO6(@|zueclGiC>TzPgty=h!^I@cwaZQP^);4UcewcP`fi<4)x#q!j5S(H(uGFOAm8m8sOcty=ohC)mm(nV_o>14 z*PvaS6Ryqiv_PJf-Kh1q3Et@z^eSN}huhP2uR$YAfdZylzX+{?<>J+q!#>|OU>!%) z9&egVM>LE2jb}Y8(DX}Ll{o`+a45p5o7P1KZ2gCmr6Dhu6B8R0DF=kfCEToD{sMux^!)E+tzR5-P!jzbtb{Iu~|5%4Tv>mMm#k+rv0XTu4hrHARn5*D*Y3QT@1F8Bpx)*5Sryua z`}HpdIGo+FN~8(tTSfhT^7Zgvyw3LGex1e?=|QN;0KZTig3GOu8wK%W1n;bQ=?v-y zi!fEe)lO&nuc7+}v(`k6-A7+;5zJSC{T|a$bVs3oj3HLan$2{;e6^aZKbzn^JaV9n zX&x_DKK^ZkiWE?r@usd4^1kSS(#7Sn4A^X(q2Jygmyk2dtr+c*W>g&8HB=9ISG>q@ z+W^Luu)@YFKiJ>X;fAD(sVwC79p%^kR(k^D7w<%*A%D2v^5+cC9F(B|$=+J`)3AK- zQ`CnsHAbwJ(#}drqM>2(dj2KykI=^Y*@UIf=-{ZHs2?lTztQ&v?@${ZQ1|TXR=mke zHZ7}iq`ansGZL5Bu0a2A{SAwqve&}r3bY+}Y;Vl-3$Mp<@%E>u)(bZwi3KiuAHaCW z(IVz`k;}d*(wf^oA`&p(ak=tiYx56`61=Z@6lTs8CWl!i29!6cM53J+cXvHC=|?X( zp3`ZAc5bs-rC*UT$!+DI`qm}k7+6cz`tnHEmW3c_w zO1Z7|O>$Vkq*IPkUk0)^_I;4Ae=j=ZY0e8EZ@Z?{5PK-scv11#2N-u!UPVXj@34>? z2bfpWxI95ju0?MtoCmmmO#Q?WzFidfd@fl{7TWcIu_j<7OAae<^M7L#8I5p`ejQF4 ze})RwNYq5Y`YVdJWo+R1E2z(@loftsaGgth=YQ?fJbsxzO45oI z;BzdOb*)kJ<}uzsj_YMNNv3aVLOA(99mQb0<9O+b&yn)IQ>1jB%2h*xaR@H=qk&cL z{y4$A!b_0z`p9lfu|jh0nP@8F#WV2ifMqSJXz#GS5Zbd{Mu#-pL{dv`yJL;$N6UHfa+lZRT_QpOhm#yCdf~h-yQKWFMt3)M`>JYggdY_VX#K_?-r9zi zGw>S=!gjg48&Xr?c((9|GpRs7MMg74#d284Nf}6H7ON*X5*4pe4X-P>zh@iSJ~k>* z07moGXMpl;X-AfIAKr~kq$GiU?^xtPzsUDl(2UBZ@~ezO``5}?y*U8&D@J#TML~P? zmn+TI=kb!y9;J z8PkNkt9uBU^Lrj*tDA+Fv$u4emy;2q6!?|umV!tJ_kcdxWug#wo5 ze&}(7&nZiF7FkecRj@^E`|R1!c!XC~;SsxQ6-xf#asL*qpXt0*w-#PEBx&N?>Y$zt zg}vvN=dzG#3ac8!*LZ?V_wLy5MOI$9hd$+5!6UN&Otg0+H91;&{J+m;BQ2uAeJ>ek*rbCruRU z!RcNb@2Hz z4~H0EB|JAbH6vg$kN2BguNt4tvwL@ulGA<2`-6QB0e+9+bBkL$BN8Lkuvby0W0DDB zD3$keu(4b#;#3xtBm?8@q3q|1OHl5$d}G;b*x%Bq1Y3;~M5Azk_xb=^}Xufk!4O7o#Z97^Sh2FVn<-KOS4WZ5`ryYPi?`u^! zv8NVZS4|U+Gd`k&4_IA=ZaFVmWAO>cfe<>-?NDl!n8)v@Z)1zJ)M(&Hk@4xLupQp- zzqssr{Khjon~B zPXilKdUXS2#voQ(wmi9)*o_#x9Mwmv=%6I^0Jx0NL2pv>Mg@rWOS^TwtB827mrY$& z3+DlDSBI8Q!h?Mj@YPC#bgzOA>^j+YB)rnVwze(1r_r8?RO~Hd>Dzl?{w^8?$5op@_YiY63pt~K5}IrX^?r!Z9ENt_`hB>js z3H6=2e0NX-I~c5gS3@raDL556yNA||TsX=&y%E-1XBTI$ucm{5to>Oppgp~uYKO2Y zUh?vh)KN9c#3j4P@y?X7J`;d2^M z*3tuAMN0dz>Es^=I;gi%f96enLnST9oF?XI0^0?~^u+c<{VeRS)E+?`{ZqyqvCI%{j!g?W;k=N>ilp0m~onR>UE=oN!YT z5C1oUcbDUQx2`(tVq9y;_Lgqx$O-l6Df|5+2p9L(Qkz0L_!>6nzdM%>(h^TAf4U3L zMH^fyi0Wk_ul;a=w9N@#w|x2plJg1s4zU!Mr5jN|RM~maQ?Q*GpJTxjJ6$ZZD825D zNH+R)-5}LAvkOUPcZ=}42lI@|uQ$zMKb-+lpZp*S<#Vn-)XhSsRx=C<-|+-#5r&*m z1%&>VkB%MVDWZeiRoygq)=LJaoyUgH1v2 zzH37{&P|q+MbMu1rFx_8J-p<@ign!^*gV0G6YEy;%+tRz@B()yJg;;$CQvI0TnFw#8>;8wYVNRldvjNbre+ z*vDmwiR+SYAj`*=?A?C(5%T?wLYh)39gqr*TT~vv`=-1(er;%<$5(LX%@cz6ZBOqB zxt0+2t*)266Q)A}_3mNP?~3R^I_7qZ673*%YgE(w9@lx~_?(vSkHBsuPen~90k*46 z$)4O(49CwoV`U(WJNL)0m`&SR$fM(ocV}HZL2SHS=?okX+;4$I&pe4E6cElU%fG&i z4le8t>ooT{h$(Im;Rc(NkvMs4zDvU`NT&ho#3|LAghg5=d|90>w2Q~x7=(xXo?56c~H-jna6XF z`dP>g9l@Eid|qH|^>o|JZ9+eNm%^Bx83l0m4li8=<dEBW1O3@A?umRJIw1?iAu|P_MfYI zo-|`l15&qAv0NyR^ZYLwg$0zd9BM+6kIk;0fcH%}%B{L+?kzDzvP<8(b^kZ`-oYQa zq2xVkBC84BYg)FQcvPx~4KUg8rU+1t$D@sfwuJ)!%OJ;Bzk8mVt!Ij*0T&8TnmC|qYI^juu#mE-j|R&~~S ze=%)BoaWL_rb6Cv0_3W3}Pl( zS5Q@UH^wbj?jypt&jpWMf$tqGM*>#F!*jDj&*ONm(t+Ohgux?U2;McxpN>C(a=1O- zQR-{gxlzFSsTbi(VY!c)9#mP4%XLEgaIjIxo-xAD@Dd zu8<+t8z80=K}$nLs=Hn+%jrf<Iff^)R(cZdd#ux6(GKmz^;g{-iFEO% zf%I0FwANUn9IwaGG~(L;>d}Pw%!wwWFy3)QIPGgFDFNVVP;D_INp>y!QrfBJx zbzB7R=G2jcfpA=KdrB)A5+?)U`rg;u-*uV}cALi7MV1+1RtCl0O3Ol!3p;s+(z)AE z$%?*}C~UV;mLYKp_EWmzfL%lwT!;M*Jbk>9m29dtZo>+B-?hEKxD)EZ^_zqov=j}Z zfF%YGa#o#z*B#xK5s6|WZ0%Cx2$j1rNd5aYYi_M+L2LUXC-y@9yH9nVBS*mZ2&^9V z=|Mep>#{~BxcJDizOrA1An(1sC7N4d|G0iO5wU=?@I8gl`1`dV=k<%% zkQH@bPSzp5hxq1Hg6JSiq0hm=2c92N`WAfQ7__^HwKZ%#!FyGp#Yi-i!|mB|`qf4K zGZgTA{M!N4j}D9;*AAL^nPAuL?thgH2}YlZ42PbEy{+bW!mv(I2;{9{|O^9L)CiI&#QnMeNqJWmP#HogpaGV|;K3WF#hrMEm zbbE6Fbx!v0dGNU$@$@&fjEC(4BXqv4@u!0%?)^@w(4JSf8gCa0@R3(HTbxRRyl*Tn zQmCD0|F7qWr{VjT`QOK@1BiZc|8VRnd#kr5v8Mq zsrZ|u+QWU_W`6}%d4hL+`{16XPK13Oxdr7KiSW5cpQ`?SD8F8#uidG}91FAMdwhfY zI;zf~KE1iO2Kjj7@$n=tn8!FC<_NTbdB-W^aA~OLwDBRulPaua`#^=tD0psbQB`)l znH!-$x447WnnnSUJ4BhPpi?qKhoI{T299bm8`v951Ht$>PN(V*O zTS^Z=JJL&)?~ORnfjYPSE_G!-vi=G+Z?9KyKj>`l#_cYI{;EQ?%k1!dDz}e4=gS?5 za-44*Pi%P}pK`4U2~?v>OTqOWN5!TNQ}abrq+Xw5|ILqM5nQfxdxpELA;EjrmdzAx zUNdZqPQ2>5>1ZV9px%ai@1LOY4BCeb-RYoy*F&+(ke}0WUcJW9KGptvX&b}|-qm$( z-Mj$naeIV*zIbqf06m8$ZYVb4_G9!K|iBX8;kW~T-#(GF)hzdN3E5E*5-Wr#`#OiJ8x|r<|&f7wbPD(##jWGGiki6zFLRiJ$Q|CQ@~*xY=qRQCsiMVUZhniY>8+? zKkVW%QQrXfN!M_S3JJhGzUA!Q^mXw1_uoX|HukLcIA-5;hsKyH{mpBdZ&_kTXPOTXfW`zKx( z7@60@eS%v`#TwUG$yqwepZ380NCok}dq9xT|M)}5Cc!rpp!xPAhng_#-^z{c9kie0 z=z|mXHx8q(eU{yRX;zG;m@;Or+Dr%2N-ys&f_5k$OXARn{kS(T*{YbvM?Q|UyK}+o zZj*V1YlRS@U#_p3WA`WxBp9D;XoU9QJpYSbRSLHfKQ|%EZa(NYgYU26nBklLHo19{ z6xqE=N9I&4g3HC(7~d1TPVg>Tde%TUh=Qp)9_&y`$wVZ{PPdz*%TP?o%6w3g4i2~R z%O=Ud{lY4dPZ<2}E8FwHC!FA2)zE9(tQ2A2wmV@}yF20j`{Y0nH!SZs5dGOFgo3#* z;nuZ_jzj88{70Q`CZR{=$r{?b;Pb2Up`aa5Z%&?8>qR&YftjIw%%@q&<3&%4zIVds zN#xS2cVIp4_uI;&-Q3+2P!Q=SYbFizkxJWq+h7Xzi79@)Z9dG$guh0vx|)khTdH2V zv;#gr{J5*a9@_C(%C=>z1bi>qHCwCV6d(Dm{73yjINt=UEW6vc5&F+59BUNsqJdi{ zwI~nf`Gxn7;}I2?Bz9ulCc2df{fn}1GSQz<0IPO^ z8Vi(N;I(*U%(s-^1OV(MhogF30-mBzov9!FyT)4O4n%h21LYFTP=tj+pE4-HALL zgx*kcA&c*!gCIk}A3>^gFgF;wh8^_SJTQ{jD-vW}GXH4Q?)s`%b_ohSudwT@=b*$3A_(K9Kry;j%}H{Ao{CqfV& z?$wd^jVe(Y>Tcgzb-2$a{bUOh)L$y9f7}Y{$+v5sKI+OxrW_j51s3r75H_Q59O}XO ze0pJzx?~l6Kj&RtffsC#m;Z}oul0vM*EJ!e8ugp{karx}Z|Q2yfGu}GqDiKe^p8Wg6d1M6?9>~zuR^7ie*;tw##8L-@62K zXvOL)p@Aq8u%~;up#hAy_SsKiP_9(>(#&^LxF77~BQtk|m2A2C%7)c2|H!P@n$tN# z=x;I2IDavh0_ucCZtjEaZHyICgO*xhXV)z~7WFh3jdEWSCC&Z_dCgmrVFTOkG3V=1 zhWcaj-BQ=a#C|M` zmP?fiN2U%jtiHIX0`ciEyA)vspXWHFR5kj7pT&kCwDb;7F%8xqa_5#BhHevR z;A4R6j6a^ zlcej!M;e3gf5OHnS;x=k)#VssP@WSQpYfcz)~ML4yW19iihtZc%R$lkiY#X!As6*`R!5Z6!5Z0M7{{}ZqjHz#NcEJ zRCROqUr+EtH*<>!a(sD-inFd%)`EHJ`$Rp;2|M`wd%f?~B*+t6^C!v^GAr4w@WscH zNO)d&u}s>9d3khauxaV`8x)YZ=bD2z9H;e+R%1@~mSA7e(MOruDF~m!x5V!g!|2|Z zVP7O*{n|%aD$&pn<9!0EXCc2@t`+K8s(j?#mLkoqM`(c0wWVwb=Jzu@>5cm;Z~wPFHKU-)KVQRxxgog1qB6eM@Ys-j7L=#dXH@@mMT^%e^TuJydH( z@Sb7wq>Mqu3efeobvN!mgP6#&etEKQ7!56H7B~Q(v)$ZwuVAM(+$VVda%B^?kel~wQ=)2C8k1T(@hF>xZp1*YLm79Y7;`%4nXz0uq!rvjPd*t;L%H!q#BDO~{ zjI*o>k;ojo{~oS0IC5op*cW`9B-u3<6)!K0MR2(XkIcne=dCkmm<^7Mvs;6N(gRiO zZBD4sNX4?MC1dDz8{wJN@VcT9(otTw2l5k~kL}q9uT!)*?HosfcL}YIZ1#EAz3>tH zJ%JT)KT_nSKPzm1jPvDM6A^20V_IbDIr%(Fr5LVhecO$ui#+%H0I#bh<6Ft1P;YS4 zb;&$9zV`A3JYCK(kBq3=vID-iN&Q%{jCz3Z-%b9mGg~DE?7yaXFafq_5r`5MS!WHX zPin{N&=7RPNLpNE*$eb`oO|~Ys5j;oWy4oBct7Uv!tMv<$w#hluX5reCt2lpM8n^e zFstqOhQM;1SHI{p2I}y4x115DMQ!u^!s~Htdg)lVwYCY-Ty-;F9L772U6w0Cwv11b zyw<3_GRlfYa5)<{b92SxM7&$__64epSp!$j`YaxF9oatc;^T?BJr!Jbp z_mYNcZ@hd2^ATKsed4w=5ipOuy3D{U70T0;-rd z*!BbW?f)NnU&JKKb743P`M6F!=gPSrR7cVJN(Q{IGJY~XTP_ZtH)_=xu7viS zy=j!e8^cG=_2e^3gX@e$bE>G~Jo~dE;RC1VG?2uXcin$0(J$UVjy?mCYt2WSkacof zl^4T!$FaV&tZ%w|l4Mi%;_Rynu?Q|VSk$Pp{W8J((+dUNMeuh;G@DYTue=RIif0-g zRR;H>GNJS`k}w^lBn^bd3&ME08qzoc@nLN#Lr^lo`%x{W93K(FzBP{8)8~fa{&<{* z$y<1zeeI2|^4&BWz|O_SIkGYuc~90$oCE?b6Y3Tz^OgAF7BLX zeEwuD?eQq(d@+EcCijXNS1 z!R2a%mTtY2O7N~~WO>fk)C>g6s5>_~#v!gZ4mCJ^e}g7vUi;7$4EG`Zg-brc`{|Dc z9Jx>Z>EP|j>gKcj#J-rVWT*eBlZ1UO1GOh*A}HY4i3!ga0r0s)v_aZKb2Bi|pmuD9 z867!#XQM|ZynggKFZI424#)G6&az1;C#zv$w>FFpPWbDO@`$mLk6rx{z7qcKP6Iig zharg2pO$c9Fz7r547Q!$uNVU3*ICXe*31mF?DE}{5O5kG-vt;fe_pq+(tk!FX4`N-g|Uwrr{_`XN1zd_YJ`{8K_8RJMAIM$m?jha{f zFYgAjFGGvYG$DiL7aJwuz8H>_>!__e*A!{HU7A{0H+Yw`h+C+z(N~+8Y*GfETCrzS?jGBX1k9(DEz&=zh)NHH}_y zK5^%dtftaI)s4%Q+;Du?iX<+Hmt!SAZ53nq0Dre+^=M3r56m}lzjf=*mwdcJ0k3Xz zjUR&TyE{821(sNVCCDtLOXEB3t&5HARIsB1PPZCsGO7qRqY~ z@jM7^Qr2Y2PSzqzL|H0wC2Pr^ouaZN*%C$ioxZQn{avs8b6)12Irq$a=9xQp?wR-b z{=K1Y01q$|FvcO*MOhFpVhN>$q7>2PQv0{$mf&IwR;Xg~C>LV~h zuk;$1nTZ~W`{oqtzi_zR7Znj?YmUbgkBabd|x)Fr$144+99-k%!x`qttk-d?#FuL1Ta`&xY8 zK>e_R?}`C1{(Dzh8Q$U(q_iz6s_@gn{PV>o%ocukgngHsCV?m)8lql5AS&limJ`OJ0*PJ;ojaBh=ljYp@voJ>sTmPL-j_U0RNOzl}tQ)7-=7(Quof>fc>926}he9@IAv| zef(~A6O`D_zSXEK92@(Cr55GR;1-*?`{kk_KHD1=!A0RDHg&5JqjKzwI?f41fV8BgHEGWWZgu^^ z-Vw(W$o+_U$j-{AxNKM5^Off(@hV#FSY0BlOWm3)65&41sZDN%N$`A)oMq%)#X{L( zHBdT24{=GY-~I$GvoHA}|8eL=3-obEgV~n^*uOMoQn3dAgZCYm*pz$^@6PKmH#j(n z@0(-Juz>4=dgJLl5KnNircJsK7>-|fl zN!)KotZ6dHGDNwti^8g*so4Iy`l1NNS)55#d}=t`1uY$(*zN}Ss7bFZ`HQdl&EEy3 z<0S4pz2=5FS)_md9kVQMHWsMz&YHw6sW6^>C2rd08=_A7F{Pf{VORv}9v+>T#Gj=r z3#`2V_xGPYWs(N_k@e4-`7_|$hfcuS9W%_71xBUjHH|d1PF+^&&7Sd!5mzb_hI=>R(vvUdV7WQWj z?biJpmrBT8?4g-YwoI#pU7-JPay9}Z^meSEub&hpaYwX2kMHvsAo-j1QM)|v;(N8D z4)-d};g7d`$bFRu@u(Yd@sr@!+_wG{j!cNx)zW`+_5+FgbB&k~$wJaUkwa6f-a$N< zaf{>@E9j5ar`IWOUt@q+oqMJpd^?Amuun$2KAgtOMr9s1!}X3@Q88BN--yeS^{!aPf4othyaC+-%B+Z*7XS)Zx4UZ zCGDR&=#Y?RK|@S_sx!*V#uIUWLgt*6?sGA2!~`T)mF$7IR6;&3Qu-qX@nVU6M%sBH-TQ)mftZ2<90E zO5djv*zZu=!6Mj5;=b#}#oqhHq~DJsto$u>Es%qGnHXmQjCcQSw@+B>AydYs$~7nM zVFoXCZ};lW;z6#5O!J|?4#~T{JPYztnIU7vLsVQ9Vq7u*Sy9FqhF8c_nZ*f6Fvijw{%lv;#zr-5|ynAE6?uZydeFEoy zW%RAIF*U75OnaokqZn`}Bxm^1_>;2JDg~zwrhSCCR6@^^v82CnSzM|P^G`c(J{`2h zr`6o!!$44$q}jcC*muFwRe2GQL{_@p{s^*@xj=01*#7YV+#2 zW+myLsUx$>heH-<4Og~qIn=j2^DD=SNe4M??mo80JP0>h|F)D@cnUY7a7^ffJth71 zmpWd$Anmxxp_k8KT|@C&VGD7oe*E8FeM|x#yzr}{Jg-Rm0{2|?@6Sl817r#9&Si#PHAy(^_+?gtvNoQ7-mYJfW->&(l} z-&BOSr6tk9aMnnS&=YZHf0eR|9Pg%viA&cibP<=Xe1t`_0shNJ@0H!#8JwT%uDMpe z3p)I&YM&d72dASpPQBni$B$3a~I3s7fKTlE3z9ZQ%0 zmG)E@$s4UsV|kZ`_aib~m508ym6^g@CZwbR>%0R3Z>MyZ+5Z+)H(RFA$*I=L*Br&WHuA9^#(5s49c8!ERAURxs19aOej#d@C6L^@86kuTU&v6UNI zn9ap|@di!vs4N(d?jo#fxnLfsNO!52s)K#tNuj)=C**k#35Iz0Na!EJubLX3*mPxx z*ERVerU>nM^tR{7_<2p#;nHbo^*Iq=h}f_)L+>-bqQ&izRy~YI*4=W~0KdukyFu=+ zA>KInt^^LaKfD(-bQIb+0PfDhd)3;O-Iusd$a&2J5te|v)7te5)_^-9>3r2yO0a2_YbgzT)OjK? zLeJa2COdW+?h6ht-E>6M(URbuGxg<8_-)NA8J!o0aV`e_IX@U5ie`LG4?&8WE#4^y ze9Q|nm{gaYqjam^|2nyu^qX;LWa<)(ckviDkq6M;P+{w2`VH#n+UQT)KCV2K9Dh_z`gShD1Bz=0Y`&HTq^M?N4ve5k} zy8-q+%f%eS0r&lqZKsD}ew+3dJNy932|QycP1!tvJLlp-87rtyl>aM3U2C)1_BUc5 z?4zC7R03vzsva42=BoxRj*FNeFVxj7%D^i zS1TxZ1jF+~;OqToQ*hsF_EH+^%lef%^_tNeo*(6(!^f^c{SlMjeTyxsNOWaSJD0LA zUM;5=?kL-Xv$rN^9{{_zZZ_tf1-t9dd&&rdKN)vVZ&_I^K(Xdh@O=d1>7;?xe%}_- z{~S^O^=p8icK_G;u83v*@h|QPZ~Kk6?rg;Tvl`5f!FVU+8khOSDYa>p5pBCzv-Ob} zp=U!&rCalzoM(DDAB!@0tDweBKA75*NX*65s92e`1#j1Wz;4s&f^wIxJv$2HrOPR6 z#vc5ekfjf#D&xf*Z=m%)hvMb>tMuLXt%hm>$Zs}DripjO#GVeJp9o1 z^dhSR@9>17!-d>{o9{Wj$xrVf?||s(-?!S~yJA$5^@9RtN}#&kwUI@L^J^S5EnU{H zf5YhXRVezXy4bH1r>dfms6`)*=RftROhImgq4ezsXf5LycoGovE0`5okQhp08>kr~OAtj|U z+t$l8Vg{FFC|vN~M98ywE5ywXPOHd_i8F->Mq-5Cp4rh4a&si^w;~HDoG%s7o?*|r z2Y-^V0@rJ473bdIId?y9?(c{3e$brvD~xmL?dE4bg5TmZatT&|3&F<`rB_mRsgLx# z@0MzsIN%aua=U*Yw5QPFWwt|x0!q(ef3s&_G?wM2x9Nsn7cTj{^4wAA*VYegibs1O zeu%|dG5SPl~WAw!f?n|_HbH|qO?Ql+B>-I5AUBGRVjaf)} zfdZBm1jJ!}L@KHaO)6%M1HlB#Zs1w8;bRgcK?JenJrV z3HU`Mi*tb&g3x2*=T>?SiZ!tg(LUilpJGTf_*V{I6_NWZ%p=JY_-xELw6A68{nQ%?4r&Fyby$5E`3}%{Wytx@rVxd=1B>J ze#DG6NZrG{`EHy0#I)ky>e^mwf}cD3hVmw0e&x{cDp~^n-4CeNRhN+CU1v;#IdqwS zTSEU#xWYX1?0y-CEwtxC_|_4X*AmFXujai<#RIHU{K3=D%mesUK~4)bz$KkITd)x9 zj@#A_t%mXGxt00+2Y7yHeta|L1p8!W2Sy5hFYniUPX7*gew^%X7t4bCo|+BYv9C`8 zy`5p{DRNE2g6EaSqT9Oh8*`n52f^N-pY^8A&~H7LovW^cou6`>A{PnW`2n!cZgUW=bT;lJ#6@GtJh@81=;!a4bTX|-2YfIA^uSG$&10}o0K z$A+ABFy0A0-nFmpIxagWuM?eSyi;8Uv0q5I>MxaoeTnR?eKFsJd-GliY6o20oD!QY z0rz&!bZZvCr+0EDYR9tievP5Eb~!HW1}uLTVZ0yoM_(O4KWNWHg1w0hl6`Q&Fy!qE zJhi}a3;(e}{Qir>kA?t;9E&@l>j4*5vod@mw6j=}Yny2P&tNQ zT!>Y(M#%N7mHNChYM|NYl)s1l>>FQv7NRpSy7Fsw@NxxAyM%=8%27va<~QXf34W_Y(g6Ns)+U;D&DKS;+QqMcjeX_AK>AlV+@k# z8HDd6DfAWEcpPT*^+&s_LkBLAk(xaUJX<9mD+T(&{*jN9PaJ^nN^EAs82z{i<-Jlu zKxH2l^}U{SxeNCt?4Oi4A=Gfl4Y3)?wpv5`iSmEt;3|)hkdw{Wm6qbuCxEw;kTPlf z4*M)8RSYY?XQ%_u6`>dBpI`HqiR8IDe$=zfUl;c26n1&ZehS4eywr10E^@+;P6-+3 zb~z(~57FmJ-vQs?$gJG7WV(=sbx7QXB5><`gcd_Vh}$Kcm|b&Gi2MG zQETwiOTEY7y@f^cb&+`r-X1Nnu%LGjKbtS(DF*czd#6Lf!G7`5&atxh&d3af930-o zPB~bi8*o{iik_xq?|-|D*DZM+|KsN#z#DhddGQj|zsC`2FRKIVT=B*qV(qbbBukE_ z_W4NMNomXUF!-+{`SRBTuz&VD!-b2$Q@8aK+w{?GqLke~Rkv38Qjx)!=5g76(*O0z z8cB9;Zpf@wyUqys;Qqy%`2T3Qzi|@qy1l8Fy|o5#C#3q325F-slPYJnhXr+C>fwz&*hHWRuec&^6KGrb$ zz!}+`opK1jM)K(`M!wiT^PKcgF#EaOxyRPX&yi8{H}En(yJYvU66TBAsfickcY-lS zOQW9L)&e{|)MfTB41zAC4n~~ zbE!IeFGn_GKjXNky@1z^kgj%COgnc>s`ykCe47isgAsam41)b37s&Dc%P05Btg{mE;m|X#U9&%^J)U#9KJ38fjjuB$H!fqm7dmaE^kh*GxD zAFE@wq9QYIu4lC=q9W%4F$At{@w!m1kV3T+2F>xkI$O1{?OwaYXNsczTBVP z^p0gx#Y5*uH=o@djL_RZ-g>(%m&ASB)#}|UwvcybWwps(zI)i!JM{vujo;yBXHbwh zj0Y7dU_n}5Ld!xCNl48i}iYZ5**0pG5kZ;484fe2;8<&(RlfPa`R@0V~L=n=RE@mpve z-{6LR@obvf_)DrU-sn=pW~Ew$ORoE~{f-(Hg$}-+<=zj!$9#qA0Yxf0 zr@Hpyb$1f??XxKXni`~khX--Jp6^y@;5OZ{?J881nz2zd81hHRJH|5?*`?q!?^lSM ze0+oLk2MN^fPf!fq(0-s0V?{i$28*-Mn!jAgM0#j_nEq4t3*j6@JZ4bBM(D4(eAid z_ygW&Q|;?1SD}9OKu|^VBo!SMT=^gtcu?jW3No82@~}PA#@#}yRHU%K(4+|bpi5JG zxkH(XmU@m}UF{)4d3IRBWcn2q;>A`hX+k>*`_nHTx+%`OA`kWIMT2GcC9V?^U(2-q zkaRN^m=wPCC-8O>@;SaYdMph1BNN)wzOD|(2tD1;;=|@eB<|jUY+v7Bqavm6R<@tG z1M#1xjE~~ZR^v$}(-L&2fWJH4{EewG6$RB{w)rN&=YGUDK1`j&eNbxBIOZ(r_xcJ- z)cYnY6v^gSn+N(W?sJxH*Qv<(nz~`9dmMHrVYjbsa|^Dnqf*Il13dUk*ZUrx0siq_ zB^s_^N6BC2ewGFsrD(S`CEyqh-E$Ogqq89Ge|^%&m(^^A{mrOVJ}^K#zHVW);09iFo-aM3A{rtT?$atix&`4p zeAjg1QP3msT%p9-L1}hHb?a`$D}Y}_`M)x|r2p0v-e!zhA#ZCv;7-Vl&foa?^huTZ z5wqQ#z(Y>xh2PAr%ezD3zVvNn`Uwume-f04TdPH3QZ-sqR)sxy-Nz}13>V0Ia$nnK z(36TpgX022-Qjl;rc^J&M&jxDtMCHZ{wY&9Fj?`H7-TpfA`{%@@N3<9WwB zv-t&U%tIh!(<7}{xGgujd+IM<=9(9bK}NT8bGAbN>&}<2RptU7a-X?_2C_6HxwWb$ z|0-#pmY{ATm2HK39OVkOLp^<+II24*72VITYzPwzz*5d^}B9pr!0Nl4!rxE-Pr94;7g_X4)+egeF^{Tm-KGt0`LALmsY+Y=o97t z%J_NxTY|v5zgc%j>UNlC2x%c=l9}~LT3R6n?^U{OP;arV((K@FXQYs6%o!GyiPLffeO5X3;0k4%4<3NL4?OXU zg^$ai-)~=o-CG#{&(*0#Icq82D^m{Kvx59So?T8hV25Zozo}@#b8{UD(8&8om&0iQN=a<_{+*&YzNwL^m$Asv6PC$%^lm$gXEveKPp^8MddaN>~xQW zDV0fAzW;%EV2^8$1Wn-n|8M_M(1r{PS0rU?T)h_R5#|5N%QHdcXFHm(beRH*KHyHs zn~ptZG{`d{e{Q?#l5IFf=$SW!n+1uJxHI&nMQptX{KdRKoAK}zk&S<}H@Ex;BPn_{x3)9k42QF+q>8F1W^4MUs+_WSr`aX6ciWg+gb-~hY zVE>GEH{t@B+F zz~Z~{)Q}Z>=KIarK04O9~2S1H->aNXW#6E zd@$l3BFX{ec%Qf_<^B}P34h$bDW9SqvO*b|UfHi9e-CTYx-|DnC-lN^C#%=T2;8*v zN}NjaYrI8ODgI>_6|J-2i(v;j@zW{yct7Mja5Fe{!F?@7M}cE+1;j_n$&RS9!gazv zi_pge!~Irh=Ka_#OAm|#=Qo#AUO6HDq{sbU1?Jd5i-w|?a0Q;G82M@kTrao8rqY4u zo&Jw;mp%NyQOicT-AkC#YPF(+4fbKytc=$kT;{*3562ZtRadkrkiFY}*?o!o6SDSg zt3G386IQ~}6ch57hn$dN0%eQylPWfwP6b+f0q+0lDNTPCa9Bx>caPVsM`_wl=<|t> z;(Z!Xc$%x)(}tc%9(-+pVoU$q0LW(6{S`VIYZArE=O zeHhpxoX&!s07J1iwK{NO^DEQMz73Gyt?agh%d-4c|I0@yYK1zACzPYXpVZ0#-xxh7 zG^bgiS+HXtR^Sqj4TiPg$$AM|Li6x@W#4h@E!fX5<(hpD_Pv(g%RkT)rey51mP~^D zaW^}~H^$A9{kkfrJoKHIEAnAJJTbnkoWPrq(Lq1vnet(t!Tn5+{+(z3lY7b)bG}2~ zEJ;5DRf*_ujL^Fr=GyaRfXtiKyAbzAujB&yn4Ng}VtOo&fA>jy|EU{~O80-J$xcJt z^%~fg7-$ghy!ZDk_@ReE^4Yp+7gg z$}29Q#}qovGpBR0b?@DR6(?))BiBV|J0Z{8m*T3Kzxhp)V%Xi&Aise|e6|6V1MeF)ylL_%%pu*O+Bdwuzzgqzo5NDyZ)7Xi|_eM-fzO{w%6Yn2iyrM$Xuu$EePj^+4PG&vmhVke|lL*2Yfl+ zkhpVp%gk@+aYXq$^)2NfPQF=*`G%~V_98#GI5;T;i|3zw{%Mm^7qru}R9j}qjx$%c*0AKA; znP?C8p6{y_Xb1aAueH8xguI1!)m4l%c-B(#riGQGcp+c$shu&$Hj(zjdzhG{zgwa= zo-?=HK>sF#;g8$hj>!1_gjvt=0Nl>y@zuiZA8~nxZ+a|nJ(VUUcpvPaH96^J2!2|M z*wB4u6Q(q#eek^qc^~!u#P8??N#L4tS-)L#65>A8o3)LWl@r$q+0^!kJ~*-o%b1zp z8v*&72uXuC=Avy=Dkb@!Dv#me7@>E+sy&4>pTxa$*VSV0h4aYOUE$@Ckw;kWm-aNO zcMtx|d&gB#_}=xfdD~`d6^Ngji@&!UcysScMde$5B=dmUcGB|W)k(i&#)S_}HCZC3 z^}qSTp`O1(K#<0t^Jv#tw`i}}1DwajjM3^*1x_z^d@xsohPZR8w7Gy67QJ5`$afI> zS*O_aR)*>zxl=C)#_$THN3p*ss}lc63?|a7-N#v-*7=UG<%08xFdT z3H>bH$9=v9H>z6LISkj0H_s@Rf*%d00Z|h0yx3b@oM!$}h@y6G(_H&L8cNrH{)z+i z2>bJrDGd|weX`B*3Y{A06XpNP$(m~cN!~Ety>yyp|Bm|H4F9&GA07L|bH?&5YrEX!rLc=O?zDM`brQJa=P> z!oHVG1`gkbt&&CY=7gbejL>uE8%WD{A#vx9GGqI5+yQlo zT3hTsnT8E4c#rO~c!;|jpLESS5BZn7`ZLGQ(a^fa5$-Vu8tT=;v#Mf9+%x%iHt9oL z7vYyLclP>ia9)bXu&Cr6=sWn!b<7$#pyUHTHc~-2x36|)U&20Qns6VHC z!QWHg0i~S0GPK&1V?yG-arcaJ>&0{Ex<=)(n~%Kkuq{VDecBuGeMcxchaec0U3xU*7L ztoL(n;fL=r%@=<&-y-d|hd!-oxnYSuyZzC#2!i>4HdXnK^Ep(VGIBhY-xuTH^l1;; z-Gz&<7TkFv5c1*l%9rfE32~N^Sw|GX&v*8#I`|sQ)n1*v~H@0D!sl&Z$CO(PBLO$AL{=Hcd5T~iC`X#JsQe!x=ay6RG{e??t3N;xmq%=7@>K18#M% zdm}S|&q>YbmfxeHfDa7WH&SS5y}x+vd^`>5w;s`7X~0UkL=9kbg7?vVcdg~?Q%U>N zwn1{!E1HovBVgUYQEvM(D2cSc0n(}*bA)(AXAY^4aL$Rq`Cn=2 zDaNUBs0q7Pw02c7;7&+q{uGZ6_bHVjO!~)Kx@ZVLhUAb7``~Le&Ws@u5ymP|1o$y*0wD|4hrcbX}D3jIJ9@R|{ zznLtZ)W$)6hfJ1Tx>8MVi8{)y-!n5ooE~e4Y>uZDx~^F);C<5(AE}Hp;rTRx_Z*|P z>9Dz=NUd+1+&F>fYbo^iO0X}#G1PgXfQ90;oMvp_z( z7j(Zt{q%>A{qDG0A?4SHF8l2X#U5^AVO=Bn5!XZh^7*U~N09vBiVQQv>5NJibAbIA zMz_}&N(Cu5c%*-nz&f(yNpqmlGXMV`Yp_{_=lwU~h6QNZ#hnX> zlKKe``!tkG{Rw%PgZ5<{o2DVZXvQ(Q1sc*4-!+5{khn|8u(^u;A;*Qrf~@p6UQ6_Q zg~hoCa}bBJemMU68EZtB?D0MFb}+7F_H$bz#|W-u!Zl<{59cw=t-6Fk_B{E0vjf_D z;>W%>GSw`U7eB7fYG0OuycGZoY!p?q{v=KobTIALmv-# z(FQ<|u&+N-TD=4MC-u1uwGi4%l>aLiR;9QUvo~Qcgs+Vzz<4KQRyDpPbBf zO?D9&p~w8bPn@le#C^y4E2B5J*`SAeN0WKYQZQ?g@zT!~@9?^5x}R$&Xy~@Ko7L;D zf6tMg<~ADzo;jx|hLj-^_s)9h_36+rgkL*F_grldutY^2>X&SxUT)Mll2))ml1bOz zTfX+jU8EEu2RlFFI?pOK!k}HZ{a&-~fcs65aTwE;lg)cs}~B+aY6v{5RHjYgq(f??kRAV_`7f37Hu#v&A)kN+rqpsPbFW2#nBUIpQj3-b&(r!|{?> z46`jN+@0WR;md*PaQN@nZ>+*ct!i&gHN$(&eg8X#EigZ3ie(%CIo`~cFwVsK|MSej zWZ{y=UedpmvvBZ0&JxuPHGSO<`q6L8^tZFwqOt2&jP@`E;cbRdjEW__ct-0rRi6PG z+7RluxeTNRnrN~60Qu#sF8eb~vrt0a(x*0?Q_<&L{oPKTr2XE;w5b7rizh!*ilcvJ5sylAgu@4dIJ_)hg6?x$TeRIHKBwWb@!y<1Q5ari&yO%>O# z-+~kkI`5yA>uG3TNawy3xK7}y5-@0+BJF})=-ra?K%Xf8SB`oFX+7Q0ge9K17bp(n zoshLhn|>6gOsO=-3Ck^NMPP)UQhRS@$`FaWAh&(2)vztv^5?g?`fMilbX(im{bGZ7 zEC>6*wo)33pBTDQ^#abT@4cWZ{S?-F(p#rIw~)BY7wzVoe?|IdZ?N}5fTks~vaOdt zTLOGh1Cj0JVE+N#mCsmbCO)5qU+oX*!`bW-cdUTt!{9CK+up)D@iv!KIM^?CFx?b=ZZlTO zcxq!T?E~)aQt!o64fEEgwV7ey-wT!Lz>OelI7cKtiwIE^^<~waATI2r#QbO88q&Ue z@|%~&YJcOkz745XlI8#6zO8p>fZWa|%rwaFy8+-%$URz>FLy*tsbq0W3!hewzzDrJ zu8aQ3e@NWuH?JX>P;6@bQT5Potrhic2MHvfx}ZldO|q zHVv7}jym=say`Qr8?q*#fb`FDRE@9gq$Q%IAjj7kG{i0_p%-6lhv?0>pFL>z^79yOY%tj zA!+QVb&LS_o|PPtpx-4qDCzRT4&B*xME_GtAU47*bxwA)3!je<8IH{b|F321H$I{v z@zQ67_rQ*C)|Ja8%0d+Hw|O*6bs9S8cS$MrF=^kkMpE&PF`WBJ&|S!ddjH~0{J$e@ t`l;RiCd^yYe$x-Yosc6e=95LfQ!0u+d~R*qA}~S^??1gkhnHN>{2#-%;Aj8< literal 0 HcmV?d00001 diff --git a/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/DSMC.ini b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/DSMC.ini new file mode 100644 index 000000000..e606a8d77 --- /dev/null +++ b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/DSMC.ini @@ -0,0 +1,26 @@ +! =============================================================================== ! +! Species1, CO2 +! =============================================================================== ! +Part-Species1-SpeciesName = CO2 +Part-Species1-PolyatomicMol = true +Part-Species1-InteractionID = 2 +Part-Species1-Tref = 273 +Part-Species1-dref = 5.10E-10 +Part-Species1-omega = 0.24 +Part-Species1-NumOfAtoms = 3 +Part-Species1-LinearMolec = true +Part-Species1-CharaTempVib1 = 959.66 +Part-Species1-CharaTempVib2 = 959.66 +Part-Species1-CharaTempVib3 = 1918.6 +Part-Species1-CharaTempVib4 = 3382 +Part-Species1-Ediss_eV = 5.45 +! =============================================================================== ! +! Species2, N2 +! =============================================================================== ! +Part-Species2-SpeciesName = N2 +Part-Species2-InteractionID = 2 +Part-Species2-Tref = 273 +Part-Species2-dref = 4.17E-10 +Part-Species2-omega = 0.24 +Part-Species2-CharaTempVib = 3393.3 +Part-Species2-Ediss_eV = 9.79 diff --git a/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/analyze.ini b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/analyze.ini new file mode 100644 index 000000000..ee8aafcd1 --- /dev/null +++ b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/analyze.ini @@ -0,0 +1,8 @@ +! hdf5 diff +h5diff_file = CouetteFlow_DSMCState_001.000000.h5 +h5diff_reference_file = CouetteFlow_DSMCState_001.000000_ref.h5 +h5diff_data_set = ElemData +h5diff_tolerance_value = 4 +h5diff_tolerance_type = absolute +h5diff_max_differences = 300 +h5diff_one_diff_per_run = T diff --git a/regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/command_line.ini b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/command_line.ini similarity index 76% rename from regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/command_line.ini rename to regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/command_line.ini index 11fbc4524..a2534cbf8 100644 --- a/regressioncheck/WEK_BGKFlow/Flow_N2-O2_70degCone/command_line.ini +++ b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/command_line.ini @@ -1,2 +1,2 @@ -MPI=6 +MPI=5 cmd_suffix=DSMC.ini diff --git a/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/externals.ini b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/externals.ini new file mode 100644 index 000000000..38d2ee749 --- /dev/null +++ b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/externals.ini @@ -0,0 +1,9 @@ +! --- Externals Tool Reggie +MPI = 1 , 1 ! Single execution +externalbinary = ./bin/piclas2vtk , ./bin/hopr ! Relative binary path in build directory +externaldirectory = post-vtk-DSMC-conversion , ./pre-hopr ! Directory name, where the files are located for the external tool reggie +externalruntime = post , pre ! Run after piclas is completed (post: after, pre: before) +cmd_suffix = ../CouetteFlow_DSMCState_001.000000.h5 , ! Suffix for the binary execution +cmd_pre_execute = cp\s-r\s../pre-hopr\s. , ! "\s" resembles a white space character in the command (simply using " " is not allowed) + +nocrosscombination:MPI,externalbinary,externaldirectory,externalruntime,cmd_suffix,cmd_pre_execute diff --git a/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/parameter.ini b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/parameter.ini new file mode 100644 index 000000000..aa3a184ae --- /dev/null +++ b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/parameter.ini @@ -0,0 +1,136 @@ +! =============================================================================== ! +! EQUATION (linearscalaradvection) +! =============================================================================== ! +IniExactFunc = 0 +! =============================================================================== ! +! DISCRETIZATION +! =============================================================================== ! +N = 1 ! Polynomial degree +NAnalyze = 1 ! Number of analyze points +CFLscale = 0.2 ! Scaling of theoretical CFL number +! =============================================================================== ! +! POSTI +! =============================================================================== ! +NVisu = 1 ! Number of visualization points +TimeStampLength = 10 +! =============================================================================== ! +! MESH +! =============================================================================== ! +MeshFile = pre-hopr/tunnel_mesh.h5 +useCurveds = F +! =============================================================================== ! +! OUTPUT / VISUALIZATION +! =============================================================================== ! +ProjectName = CouetteFlow +Logging = F +WriteErrorFiles = F +! =============================================================================== ! +! CALCULATION +! =============================================================================== ! +IterDisplayStep = 1000 +Part-AnalyzeStep = 1000 + +tend = 1.0 +Analyze_dt = 0.25 + +ManualTimeStep = 1E-5 + +Particles-NumberForDSMCOutputs=1 +Part-TimeFracForSampling=0.75 +! =============================================================================== ! +! LOAD BALANCE +! =============================================================================== ! +DoLoadBalance = T +PartWeightLoadBalance = T + +! Initial load balance +DoInitialAutoRestart = T +InitialAutoRestart-PartWeightLoadBalance = T +LoadBalanceMaxSteps = 2 +Load-DeviationThreshold = 1E-9 +! =============================================================================== ! +! ESBGK +! =============================================================================== ! +Particles-BGK-CollModel = 1 ! 1: ESBGK, 2: SBGK, 3: BGK +Particles-BGK-MixtureModel = 2 +! =============================================================================== ! +! BOUNDARIES +! =============================================================================== ! +Part-nBounds=6 +Part-Boundary1-SourceName=BC_periodicx+ +Part-Boundary1-Condition=periodic +Part-Boundary2-SourceName=BC_periodicx- +Part-Boundary2-Condition=periodic +Part-Boundary3-SourceName=BC_periodicy+ +Part-Boundary3-Condition=reflective +Part-Boundary3-MomentumACC=1. +Part-Boundary3-TransACC=1. +Part-Boundary3-WallTemp=273. +Part-Boundary3-WallVelo=(/350,0.,0./) +Part-Boundary4-SourceName=BC_periodicy- +Part-Boundary4-Condition=reflective +Part-Boundary4-MomentumACC=1. +Part-Boundary4-TransACC=1. +Part-Boundary4-WallTemp=273. +Part-Boundary4-WallVelo=(/-350,0.,0./) +Part-Boundary5-SourceName=BC_periodicz+ +Part-Boundary5-Condition=periodic +Part-Boundary6-SourceName=BC_periodicz- +Part-Boundary6-Condition=periodic +Part-nPeriodicVectors=2 +Part-FIBGMdeltas=(/0.005,0.005,0.005/) +! =============================================================================== ! +! PARTICLES +! =============================================================================== ! +Part-maxParticleNumber=50000 +Part-nSpecies=2 +Part-Species1-MacroParticleFactor=1E11 +Part-Species2-MacroParticleFactor=1E11 +! =============================================================================== ! +! Species1 CO2 +! =============================================================================== ! +Part-Species1-MassIC = 7.306E-26 +Part-Species1-ChargeIC=0 + +Part-Species1-nInits=1 +Part-Species1-Init1-SpaceIC=cuboid +Part-Species1-Init1-PartDensity=6.5E19 +Part-Species1-Init1-velocityDistribution=maxwell_lpn +Part-Species1-Init1-MWTemperatureIC=273. +Part-Species1-Init1-TempVib=273. +Part-Species1-Init1-TempRot=273. +Part-Species1-Init1-BasePointIC=(/0.0,-0.5,0.0/) +Part-Species1-Init1-BaseVector1IC=(/0.005,0.0,0.0/) +Part-Species1-Init1-BaseVector2IC=(/0.,1.0,0.0/) +Part-Species1-Init1-CuboidHeightIC=0.005 +Part-Species1-Init1-VeloIC=0.0 +Part-Species1-Init1-VeloVecIC=(/1.,0.,0./) +! =============================================================================== ! +! Species2 N2 +! =============================================================================== ! +Part-Species2-ChargeIC=0 +Part-Species2-MassIC=4.65E-26 ! N2 Molecular Mass + +Part-Species2-nInits=1 +Part-Species2-Init1-SpaceIC=cuboid +Part-Species2-Init1-PartDensity=6.5E19 +Part-Species2-Init1-velocityDistribution=maxwell_lpn +Part-Species2-Init1-MWTemperatureIC=273. +Part-Species2-Init1-TempVib=273. +Part-Species2-Init1-TempRot=273. +Part-Species2-Init1-BasePointIC=(/0.0,-0.5,0.0/) +Part-Species2-Init1-BaseVector1IC=(/0.005,0.0,0.0/) +Part-Species2-Init1-BaseVector2IC=(/0.,1.0,0.0/) +Part-Species2-Init1-CuboidHeightIC=0.005 +Part-Species2-Init1-VeloIC=0.0 +Part-Species2-Init1-VeloVecIC=(/1.,0.,0./) +! =============================================================================== ! +! DSMC +! =============================================================================== ! +Particles-DSMC-CalcQualityFactors=true +UseDSMC=true +Particles-DSMC-CollisMode=2 !(1:elast coll, 2: elast + rela, 3:chem) +Part-NumberOfRandomSeeds =2 +Particles-RandomSeed1= 1 +Particles-RandomSeed2= 2 +Particles-HaloEpsVelo = 9000 diff --git a/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/post-vtk-DSMC-conversion/parameter.ini b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/post-vtk-DSMC-conversion/parameter.ini new file mode 100644 index 000000000..26b9fd923 --- /dev/null +++ b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/post-vtk-DSMC-conversion/parameter.ini @@ -0,0 +1 @@ +NVisu = 1 \ No newline at end of file diff --git a/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/pre-hopr/hopr.ini b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/pre-hopr/hopr.ini new file mode 100755 index 000000000..17388af01 --- /dev/null +++ b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/pre-hopr/hopr.ini @@ -0,0 +1,39 @@ +! =============================================================================== ! +! PREPROC +! =============================================================================== ! +projectname=tunnel +mode=1 ! 1 Cartesian 2 gambit file 3 CGNS +useCurveds=F +DebugVisu=T +!=============================================================================== ! +! MESH +!=============================================================================== ! + Mode =1 ! 1 Cartesian 2 gambit file 3 CGNS + nZones =1 ! number of zones + Corner =(/0.,-0.5,0.,,0.005,-0.5,0.,,0.005,0.5,0.,,0.,0.5,0.,,0.,-0.5,0.005,,0.005,-0.5,0.005,,0.005,0.5,0.005,,0.,0.5,0.005/) + nElems =(/1,100,1/) + BCIndex =(/5,3,2,4,1,6/) ! Indices of UserDefinedBoundaries + elemtype =108 ! Elementform (108: Hexaeder) + useCurveds =F ! T if curved boundaries defined + SpaceQuandt =1. ! characteristic length of the mesh + ConformConnect=T + +!=============================================================================== ! +! BOUNDARY CONDITIONS +!=============================================================================== ! + nUserDefinedBoundaries=6 + BoundaryName=BC_periodicx+ ! Periodic (+vv1) + BoundaryType=(/1,0,0,1/) ! Periodic (+vv1) + BoundaryName=BC_periodicx- ! Periodic (-vv1) + BoundaryType=(/1,0,0,-1/) ! Periodic (-vv1) + BoundaryName=BC_periodicy+ ! Periodic (+vv2) + BoundaryType=(/4,0,0,0/) ! Periodic (+vv2) + BoundaryName=BC_periodicy- ! Periodic (-vv2) + BoundaryType=(/4,0,0,0/) ! Periodic (-vv2) + BoundaryName=BC_periodicz+ ! Periodic (+vv3) + BoundaryType=(/1,0,0,2/) ! Periodic (+vv3) + BoundaryName=BC_periodicz- ! Periodic (-vv3) + BoundaryType=(/1,0,0,-2/) ! Periodic (-vv3) + nVV=2 ! Anzahl der Verschiebungsvektoren für periodische RB (=Anzahl periodische Ränder) + VV=(/0.005,0.,0./) ! Verschiebungsvektor 1 (x-Richtung) + VV=(/0.,0.,0.005/) ! Verschiebungsvektor 3 (z-Richtung) diff --git a/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/readme.md b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/readme.md new file mode 100644 index 000000000..21d214e4d --- /dev/null +++ b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/readme.md @@ -0,0 +1,3 @@ +# BGK Multispecies - Supersonic Couette flow +* Simulation of supersonic Couette flow: upper (y+) and lower (y-) boundaries with a wall velocity of +/-350 m/s, periodic boundary conditions in x and z +* CO2-N2 mixture From 743aecf943aab75e41eecde58a9d1b436649da8b Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Thu, 31 Aug 2023 15:19:17 +0200 Subject: [PATCH 40/41] BGK regressioncheck WEK_BGKFlow: updated ref files for Couette Ar-He + changed analyze.ini to 600 max diffs because of vibrational temperatures --- ...teFlow_DSMCState_001.000000_CollInt_ref.h5 | Bin 52488 -> 54216 bytes ...etteFlow_DSMCState_001.000000_Wilke_ref.h5 | Bin 52488 -> 54216 bytes .../analyze.ini | 2 +- 3 files changed, 1 insertion(+), 1 deletion(-) diff --git a/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_Ar-He/CouetteFlow_DSMCState_001.000000_CollInt_ref.h5 b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_Ar-He/CouetteFlow_DSMCState_001.000000_CollInt_ref.h5 index 6091c765376a5fcecd0c86d2c50a38f7beec1576..a4322bc385869966766a634fa087d8869dabcc0b 100644 GIT binary patch literal 54216 zcmeFZc|29!`|xj05}HMZM4D)zG;sDZRE7qL$~+xorZdP?3Q;$DEn4cZQT` zK;}6`11ht^Z&mlczn{nR+C9JD?~msnANT9-a_nned#(4n*0rv^_FCtfs>-3ITmoE7 zzkWD5nb?^4e*cR9GxyKWv-&@O!9U~IP5$|X`5$@pADP7R=ND!sZl+(?`2YDk-#_+6 zS^xau+3r75TkGIKCa8(q$K^l8m?roA`Hd6*!++(1BA|LuQS(=W&-~MB+@GHP<7YUG zgLW47DyDQ({4?&C0RO}PN4e}Df1U5w+)O)un`UO>g#Ym~X;K}nsHXNzD`0)*;60d` z|J)hBKQ1-Zl#iIwL>KB0j0SuE;l}lw+aVh}3uA3JCyRgj<^RM_<>XQ2lXO$M#lj@` zAN-c$erIc8PB%VgYX2MI|B0Wnqq7B_ZgI%Y(PbeLg#3Po5jfK({(=%9Q#mG|&{u1CNgI1jQz{*X zfCU8rZ~ng%-%$%whlNAnPxE&z?418k^A}de^V`M$v-cNP#`C{4|KG8{5Oe-r#{V{d zVT}OX`TuSH!Wsd1^A~i^|Ht_kY|j6u`3pAZ|I_>hoAd87UeG!Je@uJ}E9cjCq?_6; z)Qn$L^naSau=1UM9%}!m`3o!G`Cppv=Q*9`3p4T z|4-*%fEoXPHh%$T{Quef1(@;U&0nAyKi>R*Bmct6_(es3?VU6}YU--&XlDoat1h&6 zoPU}R-|Q^R_WxbVup} zYrZDj)38TebzPv5@Aue;Sr2^P`5pFuV^~13|5xw-p8K_aH6I@m3r7Cl z_5N!=JO}(A{`_+giqKfBx`icl`hCgP;GI74D_~rAc&dfF16(|8r*$a*@FGin4=R`x z+(my!qXJU;@Bw4^nRjD|skkh+3Q-O9%6DyGXpw=ytpbBCS1M5B&iHnF$QpZIX(}_Z zs{uJ-)#;Q-EkuJ;c1*F~q=H<>%L20(s9<1smfC*1k&g zf@1)mPiZB3@1&&9^gSxL@+jKqD7+6-Wk=9R2o?0XW?cFvPi$X=RG!YHO9o4ZdS0)% zMFj~8izbxCtg)M>vm*(EIVf$hbc0()4LXyj^}qyPpH{6Bk%Rnsy7Dt_`cr|E1dlg) zCoy*(&MV*2H0j{9dibmS0AlVtIr}Yzn(C1~uDc$aK<>EoSu212W56V-yXWX~33&#B z>&@q0QzqT{MZ*f4*}oGzvE~YTX|_CYQEU@>I@*ML{T(V8PxX=e1nVupQoVQ`vK{y)yZH{LTVis)Q_=vbwE?q3QK#){y6?{ zDl)l@FS4dOAN_Lsp-52#6|A})%#{#G1)48r2A_w*e%&I5jEfR;ujxcsn^frF=}!wo z^V`JSl``Hw33^$Nc!ZW~XF=|`Ja4ErK)O9iI`1eR9;?JaaJ~85JyLa~hrBGYmq0UO zy7Uq{xV@8F9@dSHdyx)&jG=<5HC2Ldf?<5gsZ;w9Mg`@Rpmp(!h`ChDwYA^fMFu*K zk-NL^Qh}#JJ6nvWB{m}wwM0(;Hu`Y=dEQTfjfi#ZI%m~1Dv(N;)EkSUf+IYwJF4QS z;8XR_<1B*2_6sst`>z8s&=88(NsXt1hw1f;4qvjwYP6Mmq|qB_wDzQ&8`WD)&5zA|(Ay<44XMDv(}XQX>oboa#Si!3X;x^huXr5HB%z4Zrb< zqkGA~@_ww5Bh+7;>Nn+|WPxQ5tjzPqwx(uB%P|4uWfb)y~jmRso9=jbf zH8Ws86_v0%#4{6fueJ+PJ0wj97xFL3R>FGWyynY9bH}7lkL!_r>8FhkK!3+2&!yVi zGf9&qwvBzyEDab4u7{V$<9ivaOq4?l8CyedW)YJ1K=(%^Y^@Y-Kt&B-A9IKGu6$f6 zD+ufRqm&)n9ZLlbXTR{zejw(4Nb7yzGC{~avh(Z^tT%^sjUM|GGUmhYI`q*Z8y%(Y zEE2ujj`}QLes`dV3g((6_g;TQ1>u)5lg?~Fe%jI^lS>5~e(pSZDuoI}HeHY4NvDD(W;d=C zeHSG38|XFX{Wj2nUFWC zdNT%s>*3{b?z5miF71sCcK_imbCup8B&cudUjM;L)HI^K^`s*e#3IaORVylxsSwq> zW=9201}&cy4-@-ilgP27jwWPK;y<@5|11@pC`zBwuCc-NBbIC39xFj#1_y*(t%ye* zPv&%=g7Ypt`~B^7m?vE~yYqR8I~Dk^-gd2AhuFU6+BwoYTQYcEYw>~|&i7JB`yVj9 zvcXO#u%&$u}lb!eRyZj)|6evE3EOhV2UtRuUCAr-{EU6U+fLA?I>Zs~f5bSEm{ zPwV+{#DNM-n_Syqd3AUK>6&t#hpsP9AvYps>kAJ`Ie*P1#x zXE0Qcy#5*Y_6g*UO9yGj#tfTD(yTiF@YpH_g6qxa9#iMbJ$dmgRBx z5A+&P0gVyLo&f#lOefde3Oi!%@^vF#6Yg}dy4h)CK5ReEYrgce_})n#t4B^zz0a}1 zc@>w>Uf(~C8c&iq&WR}9qCy31m)?%gTq5RjN;sdo*q;op)Gqt}9qOk(-jF|f!Vcql zRd?pul469-pK0j5R|j&;XLg4VY?t&&ku5RWR8VE|jbjh&C)bU6n7bu!4vTUS9SnPimjpn4oY#C=+bYju%F%#)+M>{?3gbI2=>uXrn2%19 zZVr-ztEQ6>Tn{ggb5C2pi1qvqdn`OpOUJ135*l~N?MN;khD6-eakNyTg4V?@bbT4< zCnBfIs}YzFqZSuE!ic$ew|W=&-XnwI+j(-A<*8uVaZ9NdaeGYgd)7Hg%WDX)^YX2` z(!xJ{0FIjJg3wf<*KuSY^{8bodaQPFFU*F>KrNHpePt*@-g+UtqsZ zTs0nG-Ae^SQ*Q+t_ECZC%r}Ml5@P#ydu*h-a>+pJTgxp)*smrx_nN4)IbgkJqoE1s zi;=m)U8CExULrr14_w~@?G-&rN}SjU z_tj=nFtS|cO3Ki=2845`lz#MDD$w7Uo$^zd3ceO2i?@ovJW`?a$<171E_wrouRdjv z0p$@_rjig9xUW;#cdpI>^LJO1^Iy?`Ui;p`BXPP1ap)HFxB~m-=PeEED-u+IPJc1n zw3!N+?c^$%+KBC|jqdV)Urh!}C7!P;f%+AqWrEX<4p{cSq%Ss0%h9x^yQ2s0v>~3u zR`~+rR3LUDZi|W-6?n5Nk8FdVKQ;I(t3D&48iq*lToTR?ger=^diFv2DBtwrls)Nu7>0a2;nPXw*m)=KCXtmj#B1?W>+q zoJwjYgX0_kON0JUSPnwiQXMgU@jXkNLQB!%caMf|-RMS24F@%+*TH$?jr?FQtOs_W zBPtHwN4I5Jyv6`AcR!utV7CT3c(Nf)Z7Xa)&TGD$N(X^u`x}r>8oMedoL6xf8)q(T zv|^HU-_^xc?r{==>*3|`IJ5MgUVIC1!pPbOBN^Ylkslu_X~&MXAk!E9rmP_E(=RJS z)1myzIJQQG4aQ0PkZjQp#9Z>OKgs-9M+TTyXU{WO&gCv&m=(zh^W+%JP_}xBF!68E z_Gb(uI*V+sZh+%y=y2bp?qV2Us(Zt=ms7#^?rkec97_qGYy1xGdb9Ks8C>AxGY(${ z*MF`_etm#AVS*8kzA*_X!XvnT!cgi1QomHKN(1^yGRO87Uk)k=b}U3Rm%#PTgf8># z(u=4@tO^O}qky{-8hedNgR!{qlQow_dqI<5YW_6g4; z4M^qbz}v0R-*LJ9Vrzfv_yoz0bUu?WJ_*6~=5sGysrStF3I!9MDPRk@tB+hb6_lTU zHwzhErgWjSlLB5lzL(c-q<}~DY^vdJDBwz#RP9b_Vt-r_z@E~?VF4tocuw7HqJZLu z8@CzWpkQ(n@9x=edyRGrx2A}C_aGcAPoUG#4+Z-^kVM)j0Fg~(yU|MlAAiIgX;de+ z|770=bq_%c;9U41MGopu1Z1AI^QT~}3B4sR`7u;18-f_yvoG9ap+0=5j5&ICWDfXZVE+DuS(*U~+S zpM>CgczHa|(0A#}Yn-KGJA)qR95V7mPvsoxNPy2xSuU%zR_0Ium=W9dGJ^tw_TRQu z&!>Q_;6-_~bHrTIPVl}N*lz*6_76WS%%%X-sM*m{V=A`h{+H4)r>lr`5cjZL{aeK4 zLdEICatcUZ(sS`S>`&c77J~wm0z&ORp2_zlwlCVxr_li{z=g9nEPv_0H}_DxY(d3z zJkoku0?m+~oXtnvJ8F>ws|>z$Lc8(fKT>OQDd27SwP`Q-dBa85E4ST=xm&K|<9Vmx z4El%1+6oJaxoc-HUNv{M0hz4u>o&y3{*?v=O`3AK6Qt_y7E8V}NeHetpSwi0cxitZ z6+`#tjm4C0L@e5OeIDObfoz|cCHbXLK%?zb$;b!_psm?SmWrZ)!*%w9tF9As$-k29 zdr=*7*`zfj@Q?y_U+OR!Z>3^lmJU&U(UAj#T^KBeuUzBID&wZ3|$Hed#xb`b+l&U3BQ6VyW+9=y@!Ukw$HE#~Q&( zr2cEIiDDXzGq)mENySot^nKAIN8>3#{Byhh>kwk@wvF48&m4CKF2>Sfq(oxwH_@G0 z_d*+xM^gv$0wH%?vVV~wB|n7RXCven9ZEuQz4_b~06v7DvZco#Lq+b9;@Bv$V>7I9z}Rmpj(%K1~6(sXY@)dK8ecNTQMs@8@oJ>2#$i zvHh4f4T0EP3(zN7Cv{v0jwgX_uij#G?7;K6Mk|gdXi;r^dy7dXYWVPiTecPjbak~k z3mm6_i-!edHmFg+DGs*XW?O^_>o4v4=5$c8GaxCyG0}we!FkP>QtzZ+we>e3+=cZ+ zd}U+*%C)>p2AK{`kZf$mn;Tmb5nK;1kH?w*FPv#v$LUz|d7Ir|JbaPRi<{zF`KplB z+rLF5SWy5qnKqK5O97wltYlXhQNXnHkWmcRU${)}{E!|G=hd>Iuo`0uNPG54esm`t zbJ~y=HM1li+Jvc}j6)4S&G5RdZ$xxv7EQ<5!uYZ$spBIV`p;%| znHA;~VDxrK;Qbu2zaPs<3Hl!C40x-9S@&2Hb0>3mJ=A>Dfc)f1>CA-Oaaj~IYA1LJ>Yz>@zKm^DGj@qby=KcHX0R~9r~y^ z-HhC$rn6#Kp+6o=QaRxV??bbz9A5e(cJann9x(?;KsdFQ+T~5h*Mb16V4+(=6frEiOv~uO5?|Q$%Q>(2m_OM2ZHM zRYi}e7!lhKZ4te7y}%r-Pn~66zm*0IHXr>Ky?X~%Pm;1J9w|icmR$?_B=H^{d(hJE zDoFz^kM(Vlbu_@z{dLOhlckH`L%!UCIu%GOVj^8Fj^cXTiiTn{gg$M;(jvrjbY#IRLu!E3h0Mj+{Z zeKASg@6g<}*aIcVgOmrZiu2My`PVxukBiZO9&_^dMh#*v*+$&&RZ`4>0=R0^5BqIr zVW^?)>J8Z99nASMuWqB#t2;)R3f`d-K_b&}duTxYO;FG-*gnTSH4m+J(twZ~OU1>% zaPQ`{7|ny+H99=Wwy>W*N-WB>92LXN%b!*KIYGoj}-hA$2Y&xBZ^^38K1Irq~D?xO+%RzD?k! z!>i&L0y&@TE}c0Ax!A|wjc(XP0|F~$4~v@;+u!K)*&(XP9OSSy&|gBoxZKgH-H7eM zZvO~;5NUlKiHS<^;w>yhu};UtILOT`q_tLEkOn;YUuv)k(}1gtabVjCV(!=W39^T0 z&_K5o=jR{LZ*X4otbL$Q25wgkCgdXVcxcu%Yf;n%PB7qt-SFD|Z;Cgs@oV!uA zwDJx_0s9`hb!1TM&#sR^uj?Yst z{zjZ>o_YZNG5M*U39}`!eX9cI2O_2Bz-~QhY7maUVP&Cy0Z#?Yy)dh6zfCrx+Oe~y z!R-<1@pRL>%dlT8ZX2sM!uhFcN9>MP$p6TbSF+8giMfAs+GO)Nn+9&Qm_J_z`w8bY zUv}kBE@p;tX7ou=77234Wt+{nX^Q9+>AYFclEP*Ng6rYsaqbtr+Rs%sC}Ls`ABPv& zUqam7TC-f5i&3q#*}8}DzN1X~wkKe{#XL$n0Oaq@b-?z90x_4&o5u{NqRqhu^Q`P; zaGdmKZB=zAG>N%;(+-7>r_(@ta@Mu{zi=OB`Xub9SC5=#s;Opy+;NHN z?o)mX=hcz>bdiEi27>F&=e|7Fo}+701v_hLB`FiE~hGz&h zU|pCxr5*+3qN2fVG*C+|c+&*A6uDPThi#yN)4TmLoUMuNkJ7^p`%rT*SZVG39O?&Y zS4Yn+JBa0ORU;?W<|D{uo$Xo84QRBCP|JQ8C)Y)A)_TFb3bD7|o(=td_>oeknl3T- zXDja|jOEaP_R7|8ub@88YrYh(yKZ9x{r&5GroNuyv43R}ZST$}LQ^FF_7#3YO$-Fr z!^`9T-o@KRS5Q*LLO6GCG9Gk7*eKSV`>(a43W3aR%CNq))2gMPIcdPi%P`|7%xfeS zu{Fp^VlK2jTzkSZ%>jF@96uTAYkahSw#-fyE1G@DODYaS+rIYlX%$BxJ~t9K(;>Gu zcT>MBa6BCs%%-1#{NFY&e|_AB*uFyMxW5->4)&RT%zFyQ$+DHKOLv@B#j1k&vOOxnrZRb1mE-`H$Xw?lZmIJi|#E7#}s* z!;c(_JeCu6cC31Z-fb*lp)8{TpKCi8FI@!llK4&f*LmPL&FqUS|4Y8{y1+?P9OfJG zsaY1tFDiR%Q1O@soY1{F-7v1=yyiY6Fimos1QEP2U5a6P;{?(Z*@czY7rPhb@vyjb36`XEzZV}vbj z8<2FCx^#c&=Yz`00im;0VECTXD~XK;)($J{?6V@~k{Zxv%>?7X$wDvEAS(@A_X?sX6n+_CQR+SUo?@*8Iewwy*2jq^+%luOD zOgvL0UiM&d*>VPg>&@rR?S4~n^{Zpp`kf+{qJEypxrdPzN7m*c&-CxJl9s@D*th1f zD-#WzP1}wYa?!xSJnIiD|MFa;aBj@jTWK+gO2>O$13 zM?*#_As-pP*VEk?VQSEmH>c^J&S8hwx!fG$Om6X4HfJzr}dEMlDiyqTVW?v7v z^$zbd3Wi(`Zf2Hv4g1;KorNswNz7eQb@dLfSLQ%+!-V%%=)ZGwgOZ$ST3C$t%|?GG zS5!ga3`K8G6{_KrtFQ^i$*Z$PZA)Q2f*WtBbwEE5X`d@Krx9~MeiaE;n*+$rR~MantBIl!4%SczK-rjIh3%my$N- zJfS{t;i@rO?O!G-R~3$qux~j!#17+PMBiZgB;40>(POOiI~CY9*T{2Ih`I3IYzkZX z)EvCXZ7vf20r#E%m`*5@*2Yvm$PFrbMWAEfnAMJ~X+^pj^4^XxP9%S5OMD0K6I?xg zR~`0qrkq4X*kxk-BElI`n;Xo5vGAkM*I*nN4!`RhwO1Q^%ugHG>l273J&KGgAwNU7 z>@^vWVEodl?TXcyqk^TePsgvqc*(=*X7|ROnERbm%Duw1@Og3c=h-IMUpTM%vTx71 zu!FREguOPW)dl)HE>*eO?<%rSkxou_Y~EDJKyW?0JkFiLy8L!yw+>e8`ebPD((}ks z-IEi6wRwm_YSgzlcwe`83C^NnDv-=p{T4Sw1=YMNt9jgrxnS$H87(i&fm*8WG3Ie9 zsOj`kldsglI1z_X{(urh`|~s5X}?_LeU$WJX6TQKXO)$FVH_I|@~(RV=M%Y)1_{>! ziS7SXi1N{HGY5;Wop@db^(#_YxY_D;FlHMghsskKNZoM z5rclSX|Tw>0Q$kD^O~J6e2BSsZg*RKrykC0o0jBS!2ZH{&6g|J%%nxR)+2(;g|?VM z?zsG1)zVqcG)1DYq&Vv2G7wx3FOPGtBgru0yia4b5pSBVt`A1T9vnZLaw88-5a_w{ z2;Nu0Q)%ywk8ppU&Id{tSmC~^|6*Wr@0Boh2$O{dFeFvS^UH;bX6uIM!)<0{>?g+5joiE2lD`oZ!r2i9H-IFo}R)m zUXn$(#4!Shx$m)@+pN?=1L=7}v$?QdIIsEA-It~qcfKAOIUmmS7IMdBz!4>dv$K<= zx5dhl!H_$yhnL5>mj{0I*es!o*@rZ}JGvnRRmgGH52(&XGXs>9#9_Mz57cVL4nY1@ zM;x=i!gC1wwu8-H#9W$G+@><$n1hka^xFCncz!f#dWL7aF7`I^Nay#u2sG-*p6_3r zI??r&0q(|-OP+$#lsW9rYrbWn>tR3Fy}G2~9!+fj(|Ump#Q}35+T6-AF$4G8LV(uo{ zYGCr7i{ z#+$@ke6Q=#D`6a9ncA~-{UD4pO6$Iq59wjUKUA=*J4%q8wffQp;`QjPho-e7^e2mS zEsjdqpSJ}`$%!!jjwO_6krRpSznRH6sxS!i)HNEMqp*HAS7QC!-|1n|!Ln%sHn|96 z&BO;Stt`}7G_~^k6x<)*ea5N;`pu&~)$%T|e39ZT{o04;cuqhnL5>KgvN~3|=z8I?bca zx9`Us4KVqgdj&sljzI2j)C=rQe~Sh=Zq>aA$Gy!%2T}zb7rP9_M*BwLzG}&GYc!46 ze$l6urEk8OgThy&7BlFN&55110LHZ>&Z#t?I_`62PDcL2VBiM%|X1KW@DnlGacI@VsjT916&Ue$6J za>u1e_v;9?!AX+unwUIq$Q{?i%j4W9lN#>qSwzNiK)JhHg$L4dC&-w`ycIpcaYg;x zV;C2=-IuJ+hWi*7dk4RT=OT-H4xE%}Am+j+15cVSh3AG>_N4e`!Sk-Xbvn{4WbDQ^ zju*qxo|a;ca2bLFO7+h{z`2Brul3iix?R^ zkx*>;`~>b(cJq{e#74%pXk=!Yx&$MelLb0Tw4b4KPT52I%Bg@$X+|}=0G>NJCe_#m z>vPq`;ipY6F?Y>h2V~dKff18>hI|n*_vGAdRtCxSi0>=qZac^wm#_BT2iSj*^ z2W2R$)_K;~#9Rs^gEGCj$e*G$DsFK@aR)+E`bo-0j zZD-@oBomeM_%cwmrash2CTNza%Ld7-hA$0vFXc` zG&5|_ldodLTqM9z zDg8Nfu&!Suk{5E3^fwwAwl~AJ$5=EmNyedlbM%Cooh_*M+lu^|Mk-+UQT6nOeDceV zC>Ong-#;NyIBe2NY=4b=Q}*;SxW7L8*@YFa;W?c^ndoRIGwh}f%S#_7I@y_T4}uwls8WKKHxmii+8)(c|pQ`=O;2zvi@U@?aJ~85cT{v+$|jm(JGKqo|MnpS9gZx_ zHc+iZmr!SSt@!1SJKUBs!+3Cz?{%Apb2QKx=zlMVE^*pRM zb&dB8Pgsxdqx-f7ClGU)yM23O{1>>7gUNmSRj7ZPHTnIGDif@!ihGsPOcBbvE;i*@ z9Th#3kQpgOaxl7(v zd7Uy&1Dl`j)vSm41kP)|Bw2sUj|#3woJ9n-yn^u^m&F0z)|9qM(&aaUap6G>1lPmM z-iz+1YUHBw`!4L+bD|p!&fj-K9_HHV`N})zPLG%a zHVz$*eX!s5N$%OXzttG*Dps@`GI@qB*IYjN;MymYBeJ;rHq7(3h?`Cq!uGjcWb$W* z>k<1iiq}psi0!9VCNl94L+-1%T%4f(g(UT+pblfOdLpD?>7G24bxzayIogR{5&EG? z`vjktA93CNg{gTj$Qb zGy(i|w<0V#%8QV{;T3XdT4o>33#uwf2!Lu5eaCOZvBzigIf5!?dOBsKHt+ctAp{by?JXR z9mW~G_OG1J^NG1{4%63LIzXH2iMZdj<+;OStl3aKX z#u@$FX+FCzFc4f1FOPFi-g_vo>82?-uznv^T*Vscl{*`I!nh9g^LV&*2FCRhO}&!U zl`!AfIDIDq=9OIsMazXMiMgy;WABl~LI!OYwoLuXAL5K7K8M~h1-E>Hk0~yDfR4r) znk`MML@s%)J8>EMx!pHT*(k_`dr`huADjnY1!Pcfln~o5)W5iQ_l!B1xuC|92K}Ow zd*XTSEmNQ&dlsx=yN>#~xl`82q@!G`*F_=l`r5Bm^4Tyy2-!e0Mqs|wG|+!v=Ls=) z%YEZ5LvwJQprFe7@f%|9f`WT58HCp(3N`sm(vUkY_k2Dl6R){$o-V0p27ZclEM2V*-;-@u zKm6k3Thw~h*|cBW66%)T3onP`hZ6*8PS1srLBkC3L_YE3GO9{RZbX zUsg!fd)P9=w3(Y;d_p)-$i}*(B*!!Ov6SXBh~thnL6wT{=c9VA=Lx?{Ad! zW-w=TMt3#u(d$o;`kVHndqj&w&ZXp+)`2Kc+vS0)_$U$Q;b~ zbGJp49@P=s-?ZpygA+FyNL_leXFuf9<$l@2W~(`HmrPCd<-dar`ES=F4VIy|^Tv21 zpTRiuFz%`;eC}2ad|o97{UF6vk#wewnEQz7yZ+SWbTByaqPqAm&rM^diZa^pd3Cak zN#-u}cU%VQE43tIlO&3F&=iU)seK;4cGqsJaH=3CCLRa!?d)4MUBhUOC zzLY|4EVI+p1jzkFZgXx(Cj366XS{og`iZ%a&r}NDgWtE5V|~_O2KLi2;g4SD;d9jP zqe-$Fi{SUY{hh&o?}25^smx=a!6{6~p$7 z`sLSEbrEy_{rv~4=-_PoCST7IVt;>>q0E$;T95oV*vrU;+;NGCan`n#Op>xT?c#lF z#6WPp`P^;uB6*oE8-UxIq@%HUp{RM7h!9wE5Ao?RkpnPauw0(A*dMOvJ+mJBSON2G zab-`Nr!mA_(zyDic78MmK|<-~t#DneF+Vcwet-cWZC0EWkWE3UN%gZESgK^f^*Wr_e0jksUMJ#8JyKU41jHeCTnYtUx&3fxl0N*bQsz03*KJ=glQLp%|!eXJ8v4(mInv%-J}<{7%H(40?@d%q3btrJho zJ;zhjavgkbTD-JiUntBcmJA?^B90mXg&#a$IMY+m8YYK}M^=}iV{A(L#&A9IRnxNf zGBDpGUw*#$4Qyvof9@yU2x9w3W{MfA@6ADha}IwE>hS zo!Po09}NpV!pjG*8+@8wB?|lBfbIRx4(La(lO_{Z|7AUrsdVT{7F>_4+{!1E0rhcS z|C{tvRq}xA!0)Uj=wpyOE;V1AzjyBQB&j_tug%~l17Z3{4=;~%S6TWY&%Rp^_}3-% z2{1<>QyZ;HPH;7$C#Hf0f}lT*=0;sZA^-Ya-%r2jhtD@kXfhT~%*B&`y?iTt50@Ri zMB51FiG{R#a!H+f!0dr|yVv9+r0cc|!m+3mjef|gb_l+2LS;0c_>98$pDBm-n9Rbw zW<++;2TITA8S&3vy?+u$Eq+poLj40-g0= zqP{VVuJzOKz6!`0&0p*AslF2DU_D;13#Z-rOC0d%S9oj#;{a9KoqiOylhomESYn_H zHoxk%EQm}+F63BLW*GFK!o32*^pVRK?z7n5_G47RmzewhZ)N2% za6iFZ!|A17@I9VTZ&P9BX>(=w{|9cZAO*4I~Ysg_5RHP!kggpS@ftw z#Wd^(rt=y(wl|2m>)BmGeOqZ@NISBH{DYYLPc|bD#H${;Q(v={0=eU|r!lrt2fpW% zGhgIX7R5ktz4_dgmVO915_cLXUWj{RZ={djb@VbF%jrbXdqP!C(Eps1+9eXw=tg;J%DVTCJShU-r-Br@r0!1n!?niIo-q0N;zp3ymh2 z1fB+&4tK(zY;r=GFS_uqP3=J0O9g$@;C_RaH0MNn*smQY91eQH{UW^u?G5+;vY+7Q z&nFlS?kBhvn(STz-?QVq=F2-PE*2|z!0)LodHk9Sa>wQ8hBRL?>lDcujJPtx_k6e> zULN=Nx?NX|z_bo%QC|IIMbs5kv%xW4guM%uDL>!X5AVA{_s*qlu-{+2KJs-G?zgy- zu{AuZ?Tq%Z{c zEv-BhzCQuJKW9HB%f|%wyX^Imurm6K{ffy`%k-iBu-<&PHUh(3D-bd&!mzPbtPs9CsCigaZopUAjcTxB?jCL>J{;5WC zgd^0)dCiya#2C$0aQ}>}#v1soU1R^swZ|q}>6}xfv~#kBhFJ^**Tc)>+>_g>HOEhB zgM`7Fmc5zo=*q1O`~odV5U zYTl^6*6*YGnAJd8L%PTtj6~ldcFGiSjU19w`r*iPEQ_%)Hr8V5ldT$}3d4nH&3tG_Q zQRMwE;l8Lsjkz0i=r1eo3$Zo9xE4{fZs?^8G57Dhsu?5IG?3HycE}Lw+Ku{g6rYsaqiET#?sX?v;gyd%#7w2hMZqL zxMbYDAKe$w_xL#62d83Y2@b)2-*w^QnN&D#XD*IDUu#dy#r4CahkUs?c<-vbZZ+ID zbXaR5M5(x z7QuK_$09hk9=3=7$70^nv&7uP53c&GSO)h|S}zm41NCuU^W~0jeUD}A>yeCQ5uW~# zJ1*;yRhtc$PmxL#ziv5O#6WO8ygbgmue@Aq!>eOp+&h%XMP)V0?H+#ENUj;3yJ+~% z8^!_04FW%Y?ZdvxcJrYklqR=cDPVuu4;+xq`@j@62Z_C@Z@ormvJcyqDtzEJ+=rbr{^P)gzwEb&+KtS4{SAVUl01&_%R zafOg$)*;jM3_D^jj|*;ad@VBv!?EakSt_BCmprA5QfkwXT#vwt~PwsXHs!-2=k%IXiE=i0ZWxzYHMV}QR!ot4Te*jX3m6ElhnL6w zy~}SSSJMRzpeOtM)4s>&5Z-8(%3`TzG=s&6lNH8WTLVvfML156#qHjI75dE)A$auO zgqXWHwV_WQp0{&3rT=~i#*e2TxmES_HNcV1qjz)BQ>fvn#|L)hHuM}v-2Fux;rub9 z-na|;ZL!ZKdL4{AlSd*}ZqO&TuiwU8p`HiNlQh4I(S_#}Mp#j^`*s>&)aIy(IFBhZ zoFUe_55{-B7|9cC(B3NpA^Cl<9VZL*qf=o&i0!tY>oO$fj%_^Kpj-gYo%H*YWB+pA z<6it*ngl#|Ablq=)Dh0BxKt2Rv)KpFdkhJ@GGuweKybbJ+{2|L2kp&NK}uCaw#;!C z)Y^qCR151ZeX45kA>@7Ct#8M#eB&;6bW`kK_P_79&>wjX_rEW(XJ7dm zwpY(Jg=|1k1x8h|hJ|kv(aZMxlefsWq04p3Cjz#?b1zl zd03N}`@nOt{om5z^Dyb0=o@i354SR_zq3&V>@U_W7kM9wMwm2xPN-=^!>WRUli~HO zM=8BUa9l**Ss%s@WzfB%p67o#&lkJ~UEPxn&xNp8pLq%W0p~SeK1^AXh?>AE`5`@D_s81D!gFOt zfnS@%Xdo?y=lKMjUu^kfN4a4Cn=!Y%f1yjvrRUDH+sRybo{tmjQ-$+G`svXJZr@da z^O@2IZy#46J191;^psZ2$Lrj||wa z`g}8sBxt~ack%s#tmB>*aVNNdt>gqCfgT-fh80(;q=U zvd+m*8T!k4ZKug{Rx`;a5a)-ZHosjd z3iHZxTX>@mdH<_8#cU-r&C!jEO=%L~zdMjEi=|B&360tce14gOb#S})U*FY?$5h&N zYKcL9?9s9{jc^_EqmpZG!ThqTQr74GgZuV`f)F#{KCk0^LJqEr;I-WTy}fewF>ucl zm|{Nx>kMJP`^aDX!9PbS=yYB6s5TWN{D}5Myz@(MWWIM+3Eha0iOZaNg6Au);StdM ziHlLVs=R@_pU3;mQ?TDX&q=QMFORj`&v>d!jhxHF>WQd~WH_(eu-DcU;w$#!?wMD- zO6atHa&LBfE&h#X?6`;hU7YXwXKso8FfT1hNk*{Fh^!mqrtWn_9lDFjxsCa7OiS~86UKJ>Mh+L8pCRn8tkLjI zLUWWfN!Nl^kT*>D5$y@?RjKbK6~4=%%omDsOPPt8tM85Mez=d-%MZN@ zfjHl?ifeQ;yyyI89WPY)NB-)kqYngmAb)jAAuC1$#ygk&+B>954k_n3*j~J35vletdl-zsg0Q1)O4?<6!iCb+MN-eCk1-F6Lo;&*$V{YYtjDCF^Ou+NwN6m);af7$(#hJDQ2F7dX&M@clFSDjc@;eaje z@!rrZ-->S$^p5`u`>NWZu+%i*QPjwGN*1`|(eyJ~y5#+L=)0tIWSJww!VUi6u+A7_ zl@1S{N}_<&Xg2G)~L=nX2R z`;C7f*P+tJ`GkJES)ey8=?x`;G!!@!tu}=@q6ynVvzq=?ocF@iJTGe+9-`^Hc|YhQ z&PQZfCB)Fs=VPJPhM;#f+9#9b9YWs!5bw&YR&CJhqpBV&0-dbJ{OT9U>hODn{cPFd z$xu8%qkYe}+Bls5!^SJK5uiucqv2`~dR-k9t$P@Z$73^%Gyf&I&eir`n}++S&gkh} zz#e(f-6D7`w?l31N_n7jRplhMcKq$s|14);j9pUT4CRQCbY&5H3P$)5?FsIOqpaNf z-a4Y<-eJ7V&=or*kR~i((t*b@3#;4*oi&Ndv0e#B8k&@h8vW=4dci7>x=+uLbNT-~ zn+OXu#1OPb5_Hrmv`cD^LHs;Rk(4jeeTfYv4{chp;Wf7AsFpl_1N8a!C#Oq-ZrS01 z!!gL8hLm4(hW*GQ@BbA04>mVT3&iQV#mC|{=&d&UIg8{%p42AZMYn=DtSx4KO(bI_ zzE{>cPzd^WNM2BihwDgeHW_CE{W#49{etZ+&^cMM+&A9cia zUPWyg&g#Hr;>P+{gHGUL+uJT*BN|fin9Fc8qanA#vvtZmR zeO(B;okA7eeZgf;=*6bj`uJH-oZ-e+Sz1vY{&=Z7FytiYQ~uEx;XMwzkp=IJ(zR(Q zrC3|AUW{C~^GS)tiHKrnN7V$&l+VOCoI#LJyU>&VF z$M*C-tjCcc4|eb+`8t3%*GKtNVI4RVwC74J4RN`@sZN3ON#QL^6W1JHV!?LVci$Ly z;dquqy+#_uA6MJ_mUJ3Y+}@#bH4}6PFG?B4xsvzKzt2;mOc8WyXH7Dqp`Fx#j4Iwr zN9Hrzc`CJ^V&cMS-%1}h;fy2qIjWOs=%BSUdqn~bb>0~s`;$aNjAt~uMncHreQZTC zRp_KM%6@!5`#Sg&yq4QD4!+M79yMbo{iWV&u)Y(v_$pWQnkO@qU=~NUGT{`A@FUt2 z-0!dtem1m&yoh}~ypcR<_{BB)OEY*g{`q*M#Hu2=j}P_0kM zK+ZjTLB(z0Rx?(XY^2Bs+zI<-@=t5U>lsS*bGt@m&<7^`mU9o}_z|#Aj(&+-El{MtUz%t=4V`=)Z)yCOhOBtJRtDRoV^;Q~XAB{Ks>;LvfLkpM zm9w5Gj)ieBZ)i?7dJ8(xIr+?6^vJpEFXX$22sk4tnch1d(2n4>+_Hwdi^N0ynJ0G* z6jzl`{m)W<(dP`yXDG4lr;<%{QZT}gXivoZY{XXa%|SFc|Li9k zxy}L|i8fdo>7k+Bm^SN7APpJKjKKNZSiF#3<%*(15B|a_L1+>_|1`aQDYp&uQt2yZ zue8uWSF6{|N`;)e-MYCaRvgY~rKYm6>1T58eGe}Pc-uE)c2;liF#~tP9!wN@_O@k) zlGyy?>!4K%M))n~9&MY{;UVYb$5C4wQy#@6*6ffO4BlU}h ztlNt_LVklTY{dL6cL8!P*nfqmmZ(UQed^P;NvP{!F391Zei{A2$FF=8d4pZmIyzJ! zQH%53<7V|{gu090BCLW%n zMf`+16Wm9NvGd?h@LF#7sGZ~;KGlq^_^PsR1FSQI&6Ssn5{5bx)<*|I{@zT%2tT4d z5%0r~VwAV;prLEqInOf9g<@EzmXzR9J1$D!m}vTwhNjHU?<|8j^s_rtn)Myx_H#e& z)cMj~jI>hs}9f>z{c7h)Ajz8-{+sg3#!4(=ca^3jcZLRgUCP43< zvr}^0Fb%n%m6{A3gLv-?j`wCK?|+MO#%Z13ROFFdP0b&rA?H5)d>>r@jdLEtPGT?d zu(e5Aha)?2p+c9Jmmyy6tAy5DLp>PXP17m7Fdo64qV+faQCH>vb?Kn4%DD{PyoEt> z?v#m7mrRVCF#}B1QVzHi_Q4-*<%|6@lp9{M)4!ZkFv4#+cfPBq=w;Yt^r&3_QipyJ zK3}uuUF7>x{Qay?q$4w&4y&M$VF>&UsZKF`^XhN;MH=|saA z`1gNYNEkYN8J)84>zw`^g6*I8EtUHC34iSOctZ?39jO~UXFbOP=iV=<8;op#{D1%> zY2iNdcyEtX8IXlKMG6-?gyUEtuXEBCZ&ALCL?7WbGH1_V&1!LbwKMARh)Sj_t2WV5 z&yB8IcUHlBxHW^I}XdeWekMIar41TBLLH$~W(N8DBU3QKZ#j1fbxNM{QwLOf<^74u3nrMnH`T=Y$S16a zR&Sui3w8P0)G{rB%c_GprSD)K4lN40OiYk-iQD~@F4Rdy?BbECUYp@OFr%qkVw?k7 zVO-^%Efb498t*!7TwjZ=yf827EeLr{MVkx;w?SR87!L+d_`X&q?I^EW^8P0qsKc~3 zROBBl(K@po&TpP_PZ(yIw)5Ld6>i@?oda6;cb~96Q4fOs1ZOGLV<;IZti6hGe!Of*{eUFYE$cj(GiE!ScHtq!J7E_l_&kQCA&-*sfM>ia1ta{3_Qbv_DZfgjQ^X#v|HZh;Kj{(1 z`?2Y_heZRX7clmIKo#nizL$1Zm!%^s$vD$i1sLb`tg|;V$ho*?9%jA&oQkN|mE{-@ zfq&MYa2tMm)Zz2^@PnobEa_B;|3uD5e2u)lsjm*?XD`XBMX5mEu#jR{ktXDoi0sbU zbeFvUBBzjTOux8*p`c{-^Gw~=MEVPsfl$$xo2B#;trE@=Sh36agC!HYu>PBsS4tq zu&cdB7zUMRDKZjTG~-Vx7~!{^JL8N{)d^)gbbXPpalfWF-WQ@-*=U}J<%yk4A3g=& zD|>))?Fb!t6n|H2gn7Vy3x8brM_pRebZK-S>e5;nyKS&J3VFKuwoCmAcF5@3o#%P| zxwwAds|ys+`|#Li+vRUWM`pKPp4_Gj`=3|3wYom!EA5wKI_*l%{bo5FOoe*GVXsCy zXTd*a`eQ=0k{zN=uYCTbFBMOimzel^@GVZ2jbh3_3;QTLAG`W-I+C*Z`s(%xxL>=j zxU}6Q=MGgejy2qMLY#emsuKT=pX49cvEiE?Q1^C+GE2%LoLeI7sJC92rS>dE?`@mm z-+>g2@FTh*;(gl+N%v&?i^!)yEJ!Z@I9{}R{+k6Q0Pyb0ue$3``8_If7En1>1M$3?T~vwh{6!>qX~n|)5ROF^>ay(7`+%L6 zys^k)Lr1s1xo^$B0D5<mI}Ov85DF&{cSXZW|K#@oXA_xhz+ z1{&1A+$f{<;S_oQidWcd)>>0hV)&m9QwKUK0mc0+xPG(bI4PN)hxqF(2epos@3F`; z20N_n;CakkA@4brjvfS-Gp1S7k>n^>{E#6zcX5HWw#-o1yrr~CBMkfrUd!!jn&0H{ zu_nxv@^@nv#5-ZdTb8CySj|!{3y;JqF{WaKAJLwOckOR=``4A)pv(S^F1a@MFp<*@ zJL8z*v0ro9h545tzowN{;UdK4hZF;)2f*k0MnRsvM&w)stW32PFH_MzPvgQM_`Ryw z|NIC~jSZqcJ{1-z?}~}8G8=W>S&wm;dWG`eg1m&)O2w?MbTpsKwUg5wbWNOgia<3- z()vnw9XK+b4WRC#vAX-VYmf)Q9bmJm!UpAc%R(mXO^nT+-@0u@4%g~ zdi##wnW4{8=C558@nBBH2*2grHIC)#6;)HwEqkkxyK#b;`1;Ws6Juf6XN4|~U#}sa ze*NTbeg=6#RLl12WYFg^+Fw#MNB;LuK7mU85D_Z+*iK#9{sQt>wG>78o2e*f>+{4y ziMtq=fUXJ$%R7AN-1y%u@9Ah|jRfO?%>U}8*Nh6}!F$lTy*t?Y$oqdL(_4|j1$oIm zPyYxOfv!yWuz-CX6-5|sx&GVP1A9E}DSzs4F3!-V-LUWmbmgebJxu9zq${9zVKM{a z=6vQat5Nd5uTsTy@9)~>gqU|K8Z5jb=RVBYuzMk=343a|{cL2m zB)Gw@r;4ALTumO29>SKz+oWM0Qw@&qd``SDn$YIx$w`8W8h znwK^K1)vAR8ht$=jgBJs)ZO?B^Yqe0y8QYmIrs2e(Y^b3QPB>)3%gTbzP_|-vIIP~ zK;}PfTwK;az+4xfTgiBN;*SgFLVv^Ol(qKnvJ*jvCZN{;4_G6!jJ1mM_u{nk;O>UP@FaRRVXyF5J4SCHZWY0#&^emDEx(!jEWAtTSvH z{&^>;mS}^AyKzm+X>9A^cT8WUDlj?N7>lFf`FA(lBwq;Rl?ihzafU+ub{^_C2DIJqT2$K6-r4E7c-$YUo0$9eZ=^hzhx1)|JxWv zP23MZ#3|>(o&dTQb;4P$k?=hBnWd#T2J~n0b|?94BwuF+R6d6K!`}^0hY2j%L!1%3 zmRsE`l!jGRO<1K**8&IZtAxFpNq=`Yc9tS4ouB?yJ{2SUi1q|`RujIeNmVQ4c5m*} ztmZAOSsxpUt7*hX+C-u);vlbSkzqpgKIs2UWDj4vM@QU^cl?Az$hiy8D6+58q@q2) zj(TRmJVnSlU;3h8h3tN8ptL2HVH;c&T}IrqFtpXC?`#z4+(k1NiUE%mti71uBjEIf z-Gpl`dH>UFh4I61KXry}f07RElf2fc+F@2G@5d*G zf9jxsdX9+wP zK($1stSg`c#O4*RcZ8hF6}pMm24gB>wMmM23hk0}b>^9;tdZ4KRW~Wq3Y^R7ZdvG` zIIO)(^0@-sKf*@yiVpBx)B5DyO#jXX-W8C^9}gD$5g5>#0zvO-_&wa!LnF(y8n?U=l)w= ztkF)_3H9W#6#s%aBX}*h#nIc<%Q~B|Ggn`#?EvnCU0Lk4KGb`b($LNI`W$yEM)(o! H3GV*~=i!X^ literal 52488 zcmeFZd0b83_xN854I)a0P(;R(RFXKGG>{U_0}c14qUqk-C?t}SW>X{;sg&lD!a0RX z^E?U_B^8kdk$wxW^ZLBMeILi?_xFI zUZ0d&dzAK>vqY!ri)|L0{6E}yesfc?v9&bSad))*XI%a}e!I0bl+^ZXJDEFKPDO_Q z!HG%ZWfH+uNOPp zH28TTo96G|*x2}Ca5;bfEc*L@DtlzU{;zT6{@pK42l{{XitWG6_j-G@b*JvIivGvA zPX9gMbZq|QssGn`_GkD8V4jh2@@G6WELqmS=J22Q|BT0M_=Rd*ot*9MEq_G{%UaSJ zYR_40{1U(ZmK}cjwT|nVGk>L0)=oP8x5>%#_IG1=hm_immNY4;O)$}I9So-4K>w%v zhEv;pqp9n@j-{QW4%6J8HMM2{8T|jcKecAS|KmdxFj_ADDG_o^?klp-nOW$>e`?JD()}r2 z^ZyC{DO>aZaevCz{D0h^vNgZ7>6EVd|6}2sS~b6pgOj=KRIT_$MgPnFsa5a%b5r|Y z?oX|H=l^j3-`YDn|G2NDZR+4+ z$u!ka(fX$to+4tGs=Dc~34hSi*4)k93AV?onA4mbm{ZJsE!fsXce4Fc{!J0z!OdTz zuj~eU8=WlaQxL)L;5T=hqOt#b^kLnDiud=#|BYb^&Hi7b|2z91{N?`Cne_j7`g`B= zf9|vXy?_4KM_)FUtlw|KfB%2?(Zja=-!FEy8L-D1UjJ;YXJ=dUM?dY4;?HjD|JqkQ z`F9T3oBgXL)xPoRuzUO0`_tI}82q)D``7Or?A8bbyrM4tk$?W52kn2oezoZ^kT7Lq zv;O`2|I~lln)`RN!`1)v0^=B zqpBQFUdO!eTE8*!NW>2&Mmk<}VIuA~vNNwUnW*5~mwCn@zsvhb?~%#m`Fm8|H)>!PSVi# zpXZ&KsPt&)ao_FK_P2cXGBJMADkDN|X^;)^-}-`hHsdR<{sr z7aPZj-FYTj6m2}H>di!RJ$yfBcrekf;p-~$!qgmIeL3|a1JP0C;h0D_;K=%x`DBKe zH4(Mwk;v+n42)x6UTbMeCWbE&R}czjq64ff6(MN1>0|$T)3Zz@`uyFBz75p&gJ;U> zIcv}nQP&?R3H^K7YyUE6jWzKji{s|8=h0Zhkg~~-c?lRF5_Nv+&qRHy8P6oau277} z(+i$Vly-=anYWUf^Oo`EAVF0pl$zt9QwM&Nye3Pd4GtI2m(^m5HtRMh0cTQ@da^yq z`Ax%9cHGd45cMn@O;ifTIRtup)g$t-^kbWK{DPP$c15w>R$nGMXLepY!;6X5ZQfvI zJ(rrpyt70}^j12$wZ9?l1pHl0xpv2CO)FwPhfUDp(+ ze@I@Fr5bM&*HB?Cc9mz|%EkE5zmn9G?McqP$=gNJ{ErZBs6w`9tuwYO^yBW~(GuLb zKl)YQ4JKkw*~Y#P;!c|5-fZOnCVGA0=S2SuY7Uz%b3X`5(~-Qa#Ms&}CbD3T4OpE& zLWF2b=dwhKa9X3NgYKQj*a>@=(v$?qLpNj>UAxRgt$qtjzr*!(eEgM(#O3%+%ipTr*DX*-IVWRW1$4$P3GEwDI z#@=Wc7y1^=Re^_^^Ww)6$DC!HkS&j5cqxn%$!oF{u$A1yOVnbQMYiOQ0%uZ^da^yq z*;iBGU3jV`u}=8SldBUk*i84<1a_kad{@Q2#trwF=Z?qI-G_2SzEAC+ppMh!sn0#9UXYETX9<)6Rr1HZFJ$4uh` z4mFFVhI6hn(eii)!Q$JnUTKU}nUC>Ot|Puh$JBY&(h*BSD8)OLi6VlB4zGPhCr)C6qp7Cyjdbm<9K_BZ1dG9UfEWHM21#11bh7{C7Y{T(83 z9nSF>L5Z)zl>NVFdF*7!N+(pEz%@odoRPdH%NYyr?pMsN#o|UTop#6{`d5;AvOO8k z$Fztr@fsVVL*Z+G{nALhHBXvw+*XaxGvsHhW-?Lja_-ibR!rpSJuT0I&O~cv0(cB} zQ^%X}Xm^m_VLB?C$araVl!+XpBA*>-u^~p|ANe%zDa4#Q?n-_Z@4&g{Y@c!VBok#0 z5$AnvnP|nG8yz>HF6g9}UDwd1wm-7|!tTJMkpBaGS9L;rzHQc)+Z$|%S!w}K`U281 zyyR4?cTo%8a)0N|^=>eq=AEE#hJFZN-|+YhT*s#@>0s?X>Udr|Z|hMe-3g5rk6wy$ zpyoV;hWOrh)?&?}UCnzTZ;+DIPv$JwdNWk^?os0MsqP&&yU$`NHO`+mixPN!rC+m> zB@>AZ_`07s#6(r`yBDq0W1_Z|Mz?kyq~^e{mNIB!O-DQ3nC{W=cMCf1tPV~-N~j*J zR%s4-hBLN5Zko2F8}ITQJ(C8UlHQp6g_tuDze?SrDi}wNQ;%-Dn^M~kT_K&+!Jwn| zi*qby*f5cys%Zo5-ciDR*nF|GK?d%-dfN6gYg+N{MV?WvzBn(Q#Q|I zLp$~>cI7E zclGD(OtiN+{JH%eCQ27~F-bW~&7obMLvGBUju;k;wdg7krzzK0{m{21>|Zy|6utcf ze=i!sFxcOYdo)?i-wkn0r1toXg5CMnngj6%nMid@7f0iHYWq2OK-_2`9X*e|&>Rip zK5topK!}ztaaB23%*!GcFNhx<$$0w`&&99_UzmTlrOrnTDZxCk9g~`+$wWUSC8eI8 zqvpKtM6tblfD?Kfc{%*71~q4%-9a2GoOPK0R<}7G5YMC}^^-ZjYTWr+dZ`@|reV3- zrpXhF6y#h!Fs~J_T;C(H4r3y}J8te0QV?fVStC0^+PY3$cD_Q*A#-fp*(;om#NN!5 z-7E_n_*rk4uCpUfbG2!f4~Ak)tIiwJwohQ>_t`JDA_%23CB zOt@PG{dnp4Gp=qc+^4Jy%omEF=Iqrs^fBnB6Ix~Vme)&>n)7O%rsbk@>M*MSw)#&` zhW?eLelq8BRfUp~pLWE|!y$*7MUUg7+6VGB+N@k~lmPqruXhM{K8!|b>A#EmVm zqb@O*KeH#U6)$^nHYF0jz3A@H&5R!W=tfmBS4k#P+pXQPNQ{Y8<{zdDuVtc=u_qZ^KuaJfVx2nPil|fnO6|_V{I6@**Z$xxSz?emWDy8Mj&<fKH#V^R&5;ZKrE?Tetdp;9409tFw^0B6+ZX*@#jI{ zN1Xe(vI;-sO?s}Y*#cN^U#6_T+DUDnqsT38el;B_w)1;gLI3)%St%8zIS~FO;dg@S zA~Ao{Tq)O(I^5~<(}zOwGArrKMZ*D<@<%>M8JY8a3yTjq+?~Xl=Np70&3yNC_t zW*5omW#F&ge%~`6>uGsGJWUrcHiN9R9;ISD zxBN|~$}j^l3vIC--3*kgEjFKLfPs{%TNhgKP;)5OwA{hhPe&so#~*L}#6ZaweaXFG ze{QJ0=v)+qIjj40F+*zbrw7ej*K+0SYeq*3}P4xk(v#IT?a=7uX z9H65FaZHTk2Ln0mc*I`=_FFeC87>;Wg1x`AP^&$o0#8#t+WZjSpLuZw*LvtjujJR3 z_b@Mq>kMlBXHj$JO89u^+D9j}MelS^_z*Sc)Z`$g`TOcHd3(Qa_pV=bH(O z2K^bt^Pg|(4jV>cpUk#TXN?u$XHD6Kzc(<@CLbwf!KVyVtrnSDT*g2fOa-GHm8m&6 z=P0FKU0{hC>B^~Jp#5E?W%BO=8N_%%fb_bx*0?1HP1sMW6}$Sf+fowZtS;3iPPvYO z`Y*fg-3#;OSjzU<3V*R*qW|fTBiLVRevOGi`#Klz)wTf)f}zrv{P2DNW^izUwM0ff z_Vx6l$Cp|ds55uZ$D~pQ+Ky+ta@R7@zL{(Fb(N_(i~25_>Ak=irD{go5v^y-Q@S;fB$ZYHabvVyYds8v+<42q0;RQtuB(3M&TUE|LOJ4C`H!-EQpTFsqjq*B6WS!?C zZwT#^#Jue`k1`0_1>;mr#mBgyn@~~Loidz1v1EBe1q1!`*Z=V9F$2A3xurA~GSG}4 z8q$`Bs5x`WjU~3MaYlDKeRp_6dy>~=$(8k?N5QQQ!*kH9FA&e9B=uzbe>q3ox@2a} zB<$1qHg59|$EsPru6?`(Si)Xum4#^xR1?qL=5ddK)cEe7UIe`BIWsgv7}OkAsA^Qu zwpgO8x}*MYQy6HeUea?mGbXXoXUE1xGpn()Sq)YPpNHee?p3J`lyXCF=Y&-biN>5?0gN@5U5haIQ@o(gCrRID}VcBM_ZO+JCL}HsH_)GGdEL+7n zBC@^fFomrv>p~!&NlEI-_9SPB1 zxBWH)U5YsIP`;K)@QtYHh-N>)N998IzG`@ezv|b!CkXEsEO(5U1^u`%u}4}HuCsyL zbe~5EHD`4EX19f=GkTaZy|xnkCwWblF+Ww`91E$#1{s?RE(2#$l6tZ|$vMtSlHU8$ ziD*d;mAh7S7PnrdUigTXjB|^XFqWz_P`*~EG;=2dwegKB9Z+DPu#38VCxmBHuGit~ z7GADPgLtc7I=Xiktech&8Hdg}5v>y1gSp!(aJIOcN(|(@7@pEOZ zXN|8V;AT8O_a|yW-uJcDxBzyaBx-f}D=`qiqT&`8(PfnVciF#8=xCNR;+)^JzIQJ* z=YfZDISx$(^_0(rGNY!RoMk!!yhviOCeU zW1vT8d>-sJhP-y$yet;vfoCry1P7_(ZS3}C>+DOGh+AdZL49)uk{k6H!WTOc*0M6o z8&;;`fv>~e6^HWhbu(kkt?U^nTWZI;op7C(+DkNqEuk)GJW%jqgxdc5j~ZRl*DMj% z{PRoiQ3evq&wSY?>qN|UKYZ=#>Ii(DTSB@7{RXysF~c<%CVr195Hzu{rw}CSjXav|(#J8A#xDsq0zj?+K@|J1ZFs#C;|H+4X8_4*q#M zo>xym-l+C}aoq{>xjb*IU@VK+()YN(Zhj(WH+Q{y;P*OQ?w-i}bv}@nrrU1HIKx0A zreC(EIK%zW(%25JdTRSQ-wZK+PfOIEQn$_<`Zt>FS=67yB1S#iA|$-SFiAb^XP&bA#8k zXVqbL^@dj)A#ae9)KBItWo^0E`2dT^p4YQewZ6u*`#}t3VE1Lu z7w{+Z&|;rjZw3maaXsqErsj}Wyr9U~#uDwxE*_`?j_-CXG?bNR5q;tV7@mCYOdK}NC@P! zmmbgSce98e=Mt>gUf;$q=5xKWx39xDm(SSw5$u|2jqddYyAE$vmoGgJ^~tkUe(71% zoK1}Q{5-6k5u0AY)=d|wIp5r|XU&Pbb(kmD-F`lZXHt^-$($eBd`8l;n~2Ye#`Y;j zrud6c3C)uNQFwB?emmzP77E+^3YpDjp|yQ?ZN<4*NK16qJ~Jcg&+q(#%dMYe(NOt7 z5Xd7MgvM_I7kJ z3vDJ8y)Nvbwm&}X{3arShL-wu(+@6Vp~C?ucZqG^M9eUB%67F&!^{Z_ms<7~+|T}0 zoWXJyy8R?^x9&U^3X$4UaB(gR?Q*vQ&F; zyuAHTEw;2&oNXR(CMBsS+mq|y?g5Uhb)2h+Wao!I;@Nw!o6lcqCU{liW#3YhzJcF6 zlH!EU@PgDkzAK2Eg?@Z{+T?FS&Eb_x^h3=DG-Q`>BZ-5bg^JiV48*XB6SIDBT+)4; zgWIs3c%yf-A9vJij4@rqLQms1WM|K3p`n@<`!`EisQ*a9S7B9Z`)xHx)n3NY5Z?{> z_zXCw2I1oRaQ*|>b|n!j+)U-ct!)!|xfLfrbID{v+ysh`ZbRd!>UI^SGE*8BGU zMOW=`$GuAx)_-fj^R`%tmV@8;miy%^A&yTi$+KAlymR(06FFo~&Ed?%eR@$Y4QV%j zD&hkFRJ1;MHyoWyw7gbONTioxaV7;ZpVDe@s~n9X<^~q>>@rl%?FDf^s5Pz{LUv0rs7E-d_)4UD( z*`RBb6Ecg1;!fVJvofIOAQmmreK3=ThWD4L?SuGvX2P5Aw_*$N(@-~Jcuf@U>g$p; zbgu(<@lROi1Dtm`$~>!txKX<9)Uy;ge;RJ>9YECf)%W~xJ$jplbj}N_Rg1FF2j7MH zX0}_1i@HZIbuV|p-@6|7(mc?FfBpH`x)eBXJoHY26Zi&j-Qv}Od84kd(=2HpHRmlu zmr`COve33N;tem%XOh=sS>>>eN71+ztFTUTj0eu7B=ux_lCy^vbBK$32eCFqVetKz z8(84Mu_eh;O?XGdIvGK@jtQfzrUy9RDms1aUwJa z{2SfLNG_AuL5ydMr0Up(;+tyjM6ebQ;9S?&On(pg*>4yyG&L8V(3LpJ>}&j!NPuwe!{v}bm3Mq{u{r;`$w|I z#KxiD29=HDkHDYg@sk^u|0Qqiu`Ycm2zledb`jz3zi?i+oX5%*^2S=9fsr)eOiEHe znR9OS2SJy$yNDmXUEL)SwwPYBj13R*0r$3DI4lk8pjX_z6Aq9!o{xOzcLv_hcVF7y zHlyb3>L7h}C*+N5$(UC%@}XE<`hE@G`s?k*X*5?tjVm$=n>;IM3=y~}zQ;`7Q? ziG_A}ret0y#Pd;J7kj${)b_W>r`=Oep`k~Gx~mkR{g52Te4h2Yh)cdaEA<~e#P2%H zX)tzqkLS`xRv(0M;}&9U_k(%Jb|L(e7mVkCL4rM(A$2^r@P3IZ%w(Y}dWj4tXixH* zEQzMe?5P&Dm~;1?k9|>kFm2ZNK|8jUFD+dlPYJPVu5kRtel0WLQ8?Hi@j08H z0PBZ_$C{An^U4J4q0r3!t`PjfG47sE;obO~!LAobgoPf@ksP=Tb z{Ol2-!+Zk%u_=h$Nl8^BUg!QiRsE>|yDib%(U|@o|1Og=YPpJq_O-R0`V4l%a!Uz0 z;OvxiOp!;I+P;1f=bWxI$V=g()*FR^bGzha!DclgNXX^f>{ChD^|fB@w?}&L4HE}j zf2}Vq!Ecnd^FiIi%(I*g+=@3ESk2O>=FAl&7if?HanBa(GW&9(3&Cw0fI{4Sf8>{;ui`KKrZmc3xO-4Fzs+7qPQY zo=l*w66BAGi`!EasAd&yp|n#_Leqk9=EaA$?B4S2_(U}p=A+Xo@# z3!0oP6k$`+<~0NAo7i^s)7I3SeZPH~)`vsAc*5L1kcXP{-VC;px}&vN>lwyL7Q{0t zN&RHbN~NnM7hCNo3`)Fxme$|N^P*jUKp_5)fHaJD`? z?0l0>&4Gt|{TdO7=SQE!rA~og_>WJ_n(+Mui(A3UKQs)F55yi^yYmWfyxTkT*ZrD8 z+gPj@%AMT}n@;bKiKs*WWQ2B{Wt`qmn4Xu>IhhfT zub^+gzbC%|KYyw6(_P)RXPWc>a1?=e}0uL1ItPd_MJEk=T&j@P6sR8vIKC z;cul7k7DP=w&{++zNsPuZ<8Ot_A|c_n{7|c+3s*bVBb?3N_sLFS~m{+F$z16JpOo) z*d>?prmHm^&$t;|aph7SzS!IK1{ZMXaa)$q3Gud4sy)*O{IWdY|L*%=#_{5lGcq(7 zM;g6myb8wUtXqg9=j($+@$KS<%qQm9V?DE(1y5`7eZG4RTf_VN>;pq@Ou+s zTxWyFJq*v@_8tO{T z`9&gYR&fap9kBm$QSLkJn-l16<_py!u6+8cww4>mX8U7V#_8|yd0m$zk3oJ7Ht0_N z3I5*?j`w$ld5Zf9tU7H?ZC^b7M^`USL&D0l#D<_=yMEfzd6tI`p&R{m+9r>C*uwDT zU9KozcM{tm%==pc+-)Z4)c;{t;#NLM{3TalJG?EISX<1Nm~m*zerw_ zWyR4&>^k;PZ;XH0)%~m9_(zg@vOURpC@kS+&yX(Bqu1-tKhFmLATWHRU8xhVT)9qi z0mQSlRPMg_LrmnFqrDXa&P~EXA@^C-9884Q6@DwCp?8Lly98k#D0$u(99pDDgaoqA zwD)IYJ2I_mdR6i`ACqDU@<`<5|N+9D?vXM!R;6)=lU~bJ2XSSQz&s zg%ayz8PuGE8m|aS7qZasIsJ$t=oiUrvRtLuVCG|2i!Hh_f4~#+1}RBB*`DP5hF{vI#$0~0+>bN|5MNzGZH zTu5wH6%9FT9DX17;X!Sm|Jg;3f^r%%TarbSgK^n1gQMK}nm+Mm5iMx<{tVpG@%yp@ z?=IZ=U`TI0#P6%j4Ynd*!H*jnO5PyN=1R30pQPp-T6`dEu!4n-$r-*nIZDm>q&WUW z#HkjWZhY$2clbPol%#$#=gLCq3tg)Wi4`^mn}0TVW3CrwdAPiMf;D0{#NQ7v(P)lW z{-SP(2h$feHvLSr0qv=4K2Ob|jm6?T+dxC|#ruTa`(PjV{9Q3Y`wWSq{#XuNvH-i* z)KpS|b>R(;)jSa}UziT2yvsiW=bpZ>>zm6SL-TVTbq)*Q`xF{Tg^%sdvu*2O{AL&v8^M1Saw$V#JP%-|WZ@0s?=|ZYA^Wz;&6S%AaLgXz+8NR z+WxRGoA-()8tV9Z;BE@cx2S;5TVX9mgq1_s6>iQntn{G$?jlp05#_kb~U?>7Ij@#KYZ)Eq2YW6EaqL%fOaNw;|k>*hkOAkRgIi9-Ulg<^?5cwXxL{gN+WC1WZx zZUNV1Re1+17{|A-A~`O+g8Ab0rt@qJwSBoThwO(vH1tC{bGQZg83^I>4jT>=mF4%$ z3>FJvMi-vlF&yi}GX%9wJ$)nQM?9cs?|w)pKd>t&&4 zy1~Hmc52SNf_E!gF2Fg>-DWGf;XZ|wq<%8zXIy)eug97Yw?pe>uC0u~?(fXJmK4{3 z2SonV#39a7gwyBR0WTi0SML1~pGFaWDp}X5In?i18noywJm>%FJ$MK>lvu<`@AEPt zwAPKUk(m7yUnzc~_F&B$+|6oT-)6|4Lws3seb6p<8cK48d@f_uVUTo*+Wvip*g@ho z4Lztaz5WvNz$?LITjwwnqO+sVbocBOJQh#Y3R?9N$44;FQHbYZab=MW!0TLo)Y>%g zNA-JFW$IOG&N~gF2Kw4rNFZv~wFqcW@|rA<&W+Pu=v|9NPP<+02k}fwQct!g@8g8Og=P0r38ujnWG~LO-f|(s#6^!?`Zi)pN6TJ!N)aW98m zAHn&NtD4IPfp_n5Lut=!Ch{_P@$=M6Y7Q|$v-Wuj(9!lVucxC~a84~h%&ICX#edmQF@ki~1YdTRS?^L%FPpG`+I zSFjwj3Yf@r#+}n|SJ8;H%dtTh3u1An+KBQRz32EHO~1q&&*1#xUhcIr(2pla`PnwZ zb?OG^f9h6i<6RQb{Oq-`zK%RxGCLR6ztE5CUgg6$zTcJqp@N!oyu#ZfIowXDDRg1+Hy9_9 z*JQcvuHka&=vu6C;lnL^fHNscJ=vb*{Bovn3vxCmI;71e=Ct`?E$S*K{9(O5w`bq; zxJtO+zRkn(0A49>KbCOb}~`LXV-5b&tbp0$^JC+M#xh{(A~}X)bL+u)R_g62oMlGr zDoDO=Fz*Cr;Tp7JQ2Z^v=FH~`W$;_dtee&I6nGn~$Z#!ZqRsm(b!`f$IefP6^vzo(uS5@qLVZ}fkQt8Z{l zoeTBLE#pq(PcPv65H4;#*9~=3i+c5=u3T!)%${>=_I+m|*EFft7?=+vugUVuN`bFE zS8FjZnba&js5eMS>dE$GJnID3nLVjBB_y`E9d8ec!evbO;(MPq;GvGwJpI9sh<$3Rm1n4l;5pv&!y&YqdEVE+IJfAvy8g^tqRWJe}dD`Ri=deuxIAPs)rcC zk#Z?h^gSNs_jTbkxPJ&sviv3t{%qCFe8d5DP25p!-;sD~`?nJBH<^Bt?{Q z?tz)NQH?3l_SJ?HtBt}O@r^;scss7$dA;&!2NTshEv{$6crVb)-cr&4^~{p-#J)6Y z&NmCTDAavrA>ysr*Lx6WB(KRbWuw4&Q)n%A@ROGEVc<+kQct!gIX5^a_AjtEMN(Wn z4(DbD;g2qS8faCl#ngsk2?2<&(u8D>^N8)c#RSZBrBlDIcqJBgfYEdr z>gA<13&t?$hxl6OJKP}kZnIt7n@P?2hk|2;?=TB}v7b1x_b>5WHO;TZ960CI7GxV2u*6fm2s~e*sBfVKO&cV1OHu15_m}bb-T)v~fITII}@Bd&-?ji2l%DzAp zI0(t<-mC)uAEa}QiUaS8fv(vlkEl6Y3^MHEf6$QaPUo$MU|ggRYy0G!GDCOD0iI=E&xiK7X^bKYm_2PWnq{ zKHg-yy?ZwFPld%HS_yUSNi&TQZ&(l0M)pb`DWT@DxHyW0_Is%o>j4*jyamH*JNoFvAc}-W-T^od*7)5;+d4Bo@`HY z-ds_d?JjG9lydp%!1?e+eEIdtT|u_=l_2hN{95_nO$(E^pf6ZN`qs|Zgt7r6W2bs~1Ur$BW#jN_$_ z{rvlN9=+3Q@NYje9gjeL zzXKV}G`q({86yt|8{?SB8#VD&wNrD@SS7@(w*bxsKe}2W1NV>1@89n%nL$G;-eT=r zTPrX(6^~EpaUHl=MW<*G9s8ESIGSHM`BMNmtQ(gdzx|i{LD`O%TjSt<&{$R0 z9YI|@2Y)#8I~RO@GvnwITsR-w)+lk?J)sr%Ju1!V0i250x@+Re@ck*Ba@&Vf;QZjS z^V4%Xs5$4Kb&vVEzzGG_M788Xzerw_CDTuAI(K3%ro(tQvmEjUDM>xqo{Ze;8doOl^Nfsl$_>tLVs8JlNA3+6ODVw>;BILum>Pk~7n+@pEyze%gmu z;rLs%g+G83{X@fGLJSiJtsE?7Dut4Cl#m}P=2{N{Rx zYG+}0&+z+~ioC-bhqPV@L0uQ*>M}S()L^A$PYF_FWvmYp}RQrq8S=F|MDorY97 zZ>0%$!}st6RPMdG!UWCkddrIPkHuyNcJsF01p6nwgd{&ey}0Nsv91-qM~^i-_dC=l z!6rqiYoe*+S)$M8JpLX&N8?C4$9PT6dBu?jHm$z3*!#7?8oZDv{!!fp`Lj@_8^`IrD)hbjN@k}Rw@E@6+?DndSWtgTh#&Z6cJ`179J zJgDo|?~$3^2=#OFzS~GO=Mbu^iEauH%EP_~is_j3HsY%#z2xP4pdQ)ACo2p7k6bQ` zSqJqq!$``fHj&zXqll)4!vGB_=`Kr^hW`2R++T9^`5{!fYH(X+N*tEKetg~j!fecN z$KJ7(Fn;ur2?ZIbW4@&Bu1$k@84x;SZl6lcSvu%PJ~7BbK_lMxIiO!8ugUU>M}o(a z5cpoT4f)oGVI3qTsVCc$@hn-QF#BDA5z^P;cE7-L981oADY7W68`~6dB`{=|i2}c0 z$j)nlc>82(B~=T&#lB^^-K6FaaQ^Lq1zj{mKXZDkCp?cF;|%+9BE$&kM1EM}j)&om zzS9ozrN77AzMsop3-&)<8P1Oc9yyf{3cmKjy#6L@7y6gyqQCcn!*fxy(j!lLU_Laz z*`A#mWQ1lFN$!zl9LFWDZCr9<#d}Q4rT^X`u+OU^KvP zuTt{p=z#rgPxXU0!+armO_s8_@~)lmT-4nE(RLn)XHt@SvOUT9TmBi}qEQ1Rxa@ta z#)2bQOqb$;nF%czi4FUHD}fQBVi4|c~ju( z{lRcQ7C&2l?0u^Ndd#H}a;KYxe@@U}tm8C*aYQ>c^?rlzpQ~87y&QP0QFWJi3G-Zh z(Lv(^Uuyeu8#afoYosClP<^5E@cD??vA{2fJ{X{`$Y#UPTL7E?5A+K7@ zV&)HKDsUzxsVCc$oY~q`G6jtF(b#IvM7`)M7(UbB>K=hEto-XYbEA*&d?0eHQ5yQW z<&Mq{6Bu8wPhz~+gQz)3sGFBAdy&Iw6B7)R#(`ly?K`FwD= zI$`}S_$c*r zmU*zAnKWUsQk-ya2A`|-?Hc3;zFcNwuVzC(1CHDBt_r5+pgtD(^#pL%sGC1S1Lni< zIzqeSk}m3WxZ1p4IS2o&U33c5dx<$6&D_uepTll9_j7&+oI`F)Yd#%>d9(inHsDTe zfAz|ws1s$tc~#ZeX_ya7-j%M`xTA|iy&6QX=)~i~;`9fZ1}&J`b@R|Fcwgn((kv&4 zmwRuIEbj(6&C)5B=NxrBZw~pzM zwvZNH~SF0UB&JE@v4Jmm=U!EkPLR;9QOQtg=7xGy3V z`_8#)M7)WPHJqG9W5GU`XQ2*0_aN>OYfq*Y^yl8~+bveE)SSzm7uzJ1z`pv1ov&BI zz7LYuWSKhrfDy}p?^WYX4q^glQj&VIJ<0i*Kxk*E_d&EiK`yb-CJejoVSQ}Ji4t5l z(J4O({Lso;?dc2g#=l%)#|*gc_t@@L{VvoTe&UVeTCg9fyFSA63A8`I?9|oRGY8R) zo7g+o9Ywfc`i_0+95uMHQL*Y~*oXK!ozEs5_P@<89X(bFpMU$_(YaY~MQwi`XV!EE z>_@V@`RTA9?1PDvGWCi$dk{r@74qF!l8JXk3VC~>N}P4t+N~enH`AW$7Wfms_g8zo zpa;ft*Q!W!a|de9To#4w?ax@~+pLpa%VEBeye7+)OOMe`!#IL=q)DujE+1ICI19j2-S(_)dp2%JZO~b8EbF%7AyE<3wE)a1e|*wkYN= z`?5B!_BhN*!1Li?eU*CHH@0!e(dhMBO%%B~?O^=%0=(C;CKyh6``trfpPW_cm-(+i2AG>4<)l$_UUuuY^=KXowa?;}JocCU zqBe&zb*zuT{b12|*(~5pN>V?Wb5>bL%f?PEWPD2Cm`=I{{)l$^g1h7coO5&j1v{8` zTEmZHGe_Zh(3h+`KES(Wk>M`QzwFDJrj=f>81`lHX3kZWpMd-rt-)(t$5(yne|X_Hjp4EDw4E`?rof53Sz`91@dlmdN~NALC{ew4?SB4P}Tu zA72mqnbcpqDDUpmLTOjDA3O-p#&*0>ADLfYk0Zg#iFYt=sNyMY5A?$x4QJ6{+;`E< zH}3q)KE~hA!3Y+L_EnXzwxGbu?u*`ADN$*$J%svYXc zs*U$u*Z=JlHRir@t> zuZy^?v3W2~v#Orfdo5Q-eb(DF6!^2Tz6b2Svv1Vm6~|SFY&xU=*8|WIj|3>Kt((j_DzS@GDp@+siU}v%o7IM_c0@(yX6N=tME{- zZ}M4?mz3Qcc=do+Pe5V0H}vOHI-T>91$8`&zAil)2l0I6Om1om%x99#ha;qWn=}P|Xj+Zd6>J3{S4&eA4;-Qrc#KS_J1^M?N zUno3Yvtg+mHc*dYR<`{ ztPyeGeEkR4N=;}_@|rBw3v~DP0%!eemx6wMpE)T>J=vb*{2)hRZB5i}B+^wUSoGl% zc65FxeN|~9KG7*Pu@cVfJ|?c+6@c~N^Jxt>V;EoWZ3TNj{$;;?m0}n_4*Tu5KA73j z3hf=5S%(fk-HqO#zg=B`+j{vzZ^JUaZCI7YiLjMnk>z?-bgE^!RJo*w=wqu zXHt@SvOUT9%18Ntvz9y2^PJYI-RG|0F#>%m&8HghBVs~tc_Gd?GvAaff%6?&BHH27 zuy0$w0f`m<H_h1kFU8@@gQ|Phb+K_+TmQ=D&vQ9c;NiZruVIq4##$) zH?}95%SLiB?ba&?A~v++rAhHW9e{I%i{e}th)WH=?ul9$&(EJPy0ZV}yww^1`LfsG zyj6^4xKY?&&Zm5m^(xDP^Mfzi@kDpvOiEHenX}ajt-9eeib&nWw~sq03~QddF|NGr z5zZs{r28cFGq-S+p#x^gNDj zA#fIbf7I$boNLosuYXqCNf9ZOZ=I?3(F3bdUlf|Yp$(T>wKr@goG~e8;N& ze~D-2vTc{Y!MV0Q1P6Bl#DmQ1A=Q%(a!5h)w9m+`cBOc8o^J!*ZzA`s40Mu1L)D znHjtI%np2+09%!!7|h2F(GlNZ{`V@Kj6M(7*X?Qq%v42Wj&7(_LuYB z3e~621;hF7>^yqH3W#S?lKRPJaZLV89MwWe|qvhmr{WIX}$hxqZ4p0_0*7Az{`n>uryU9f@Agd zj105P2<%Aa(!A@y*}g#`egXL7Jk-tS0p}`T&#wDux|cd{cm=?N*LyVdbRDs3jwlPQ z*<@v@Bs~pXjyTNs!R9`e&TCiR*vrB)-Ai^9Ltct>d2MzK`k|<$A;JsiG@L#xyXLynOS5;Z)$fd;fvO5^%n`e~9Z^A&hIz zbVbXazkL73?K7#U9ln1gGjTmgJf zjR|r%z&e%QvwS(XHZ^CB!9Z;%$j|deV^p{yzp?DEuy&o@h+gk-+IU1d0~4y%>noAI zh);WBQ$GRYIJB+I>sMV+yVZ8RB*YK@;n|wlero%0THw^f`!w_^@6G7|$j=5mUlxB0 z+=z(v3_(Ms2<&3(oI`tq3h;|Jg%WnJ{Qvqo^Kh!Z?~f-*BB6+iC=$9vaZ7S`C{l(< zQbKi28FH_S42435$Pl8U&|oYiV~#l@ndgWyB}(a2A$?cR^EC$#9nD4g$ebK5O%736+MDSW{R}Q~4J)Y2pY0k3j(SY?SgeCk$dm^7twhGyAehE4V zJEP~cmb>GJhgWV3jH<#i3$A|=bf-feuyO1GJt?W5wej~shf2-{KQLZN&iP1;kAES< z5-A#p^v%KNH1^CGmS=-*fXb>ijXx!r@WL@++tD&i;+=Yc;8i+0Z$+`?2P?j-x!KT{ zjvUnJx3oIR8yU z-G=?3p_KoCGhqoo(VpNue|5pxMu&;=ztAju$5-IXmvypjpcUbh*)=5(Y~VQN#;QGL zkPoTOd-YA|$hcDY0Ck+4L(rZLY_~%#(YG;w>jR);rus;wOIiqir!Vf}-kx2Da~pI8 z@zZ*7n_%39-HDEN-Vl4R9Q4%=cPVd52A#Bpca+(PU*z#yLAK{yoF&qk%e4sy9kS!G zEPiS`nP`XLHoMZoLVWe;#5|3q8BchA__nb<9VK{f_G5rP+MC(YmGhwUCf)KNkv2`v zS+*tH$vesgnb2MqeENs3+B*8Iae7r7W>B+FI~C@2geCloInRyECDei5aSY$vy*!mS zuwBMub{9nI@DxM&Wt>{jFFmsfCp9`M&TS~vM35Jb{G$aVZSR0g$kWmzH$qb@WC zbouzJPg_0rXQF`EFOBJQU0Ci@AMR%jH8^YIpS1bEI)N`@#n+ysqskr6Yu*{sQQT1J zq?H(Xd_95YpmooI^SF@09DIK1;LUPs4io*3+Y_p^P>1>Y8x@@V{t_2q-JtBRM@Qz} zg#{YApj$dG%`2cyN6y>MpKsYft`nGNpDD+e1Ha8$J2lR63Fz5Zqb~dY2m&BBiMD zpfemaW$58co^Q`gz8ChWS)$-=3(~`&Gf5enTdD^2FjvwP(!$g$v6fBKuSUG;@OhlK z{^K*a4)<^l@iaObmAaw$*B&j;(0U(19zU}zyggIb68)x#W))|G-eZJ;;T!lJ-t%}x zgb5`N%R7Iw*L>s!9?n=Est@|6<*TUMT~p|&iLZ57E(vrsALuk@1(E0Tj#ZVKRa!2{ zB7jZN0CYJCUW=`QU~|Uuur^F;wfakM$Y;V5exf}wZuImSXKgymKq-T3y8AP3;ySnW znrvHKvE6rF?`z?p-J;6CH(qsF*NjhT69rhb+2**NPV#Y=|A7Br&-yS>knvOc$bFsak>pRzX>=MVF7%^%U1!@A0_{f)Sb zdmHEwy0Luq2HscLQ~zjzt^DMzF=I*|U*1dONYFM*lq=NeX7`GYST&tfL_X4yzH)SM zlUp+0ojD(NO!zrwqb52t*hEL?Hg4Hx2K^8Vi52UFyb-6q5w|))&bjcS<+A+}E-3k@ zRtMms843hHmsA!b4vqoCM@A!%voW_%eEKrT#ZqFFtPqk6h52iks0Qdi5-y& z;L#ia{pPZowZm|{FZ}&TRuHJw4`CKO*)&4hPEYJb%_Fod{QX`MQ{ltro0)Ehq z7h~5L>87K)b4F1(%p)$RP39IAJjAEReUo3g24Wfdj20aF&oi-mmBbr5+QghRcWbAk zlsZlE2}I8MUYv50(OMUjpd5I<4*EmzT5RtJBsGuQv|)7t4pRv*eTxUR^{<|^PzJKV(FS%~r)byE##>@|`{`w2%=cm4IkWY3(A|(lB6EiRHbiX9Q zm9npKQ&Bku4bY9>K=pOWo2H`z6VHlXu(do{*3Vavb562+#cZEoqT=CmTQt9ua}G+* zt?bci!_>-mSP4Qt6PEBV=6ronaC!S`I>O~w$jfV8ijU z*+2U%@#!9B|A89u>>C}Gt*d_62;+*tdHpd~XrH=O%^7t3`!3fQ2iR|2}R#ITR zD9rKirL3Z(Wu|#)1sOTmh}fDzk%c@=Q|X1i5^(jRdAeR70-gSliQqLbQ_ZTJTY_6GU;&{9btIDf-*$A8oOZXRaF7jsXs1lPmyzWn}r z_RxRi@e7Mwy~6rwXl5|*n#W40%iUIc)oPCuvf}ZczDS9~u&nUL>WFsydN9L2iVNxi z&4$AaSs19w+SBa=+&}YoUppIpA>Y^IVTiJYMh_Dqr-NJLpkD;9#rC3yr-7hK83zsJba)U~Vw~pCUIY8JtuT*m<6t1} zwM1+shj)h3i?^5n`;1;IEubPCQ-XxRP=MMDa=9nmUMtwa4I&XeQPFCr7gema}tvzWUR4yfrN~n-k(am|Hy(4!q5W zu1iF1f;t&GRqSUCIp;rOpvYUoM0Y3^mQSIh_~h&%6~{h!u$n~#ekz#yI}r@J_kfKq9C)?<=B{H@0ygJcKm5+ppNHm(2e-! zV>>Dd`_~!T`?JcyI+&%JL4!DXe6J%BwkPvxsF|guv;o@FbC%1A4LP8~G%2x`3#nM{ z1`)SDUD$W&>BQvlF3{ibxZu8HE35~?l@nWJpssAQU(E4mmaus>?2kZT%FAY<1=9i|64g7-LsTIbUo;I>I!Qe6qJlos5?)G7sb|kLw)Ju+-GM$)zIrcaA%CuNu1Xgbzadj~#@%T)AB97A2^o5;PIBfaB~q zxm0dGj+`@myWP!shlvKc&#GThA?Lj7##uJGRc%wYq*MIJIm`w;xs!IC zh63O2vy21|b*EBp;1It;aOLmZoD97F_b1(t55Pzs5{Z-Y^SiG5iAme^TDrWJ>E;vFD z#-*B?!|e!k_bRGOi`8I#4Ys{>ESQ}0GOmI)*$DVvt;nFy0{TVpT5MO!T2&;lwPETD z+7j%L&x9rXM0;Y~_*JDCByrLX`D#(x^(XwXp!QzD5|-Q8?kV=z&8D#5ns|w13Y^b2 zFB931hv2!Ge%bwyBRPkuIqlgnFWA4kheI!1AL@BE9ji|0+ablbx&?t7Ju%_QwNqQ- zAK^s>8nXgtKxabLSE2#hUEz~ir*i`8Cciy)()T2fFXY_G_tl?<4zkXb6hV82TQ<9@ zksV^Kmt$e#;T_rqP@H<{cugF00C>=(Orp`L1$hL-SA7_Z-~`QE@J=j=y~ z2td9tK69$MJUm9uS^xbz)r?=QSX>i#&?ewaSi--UbN-F_T=Bs3$Ol(fa9@&w8`hWb zNQb<_UwdNQy70Y6ar}$W4r2zAe}8#>9^}X7r|);%G9~BmH086_n+r4)_4xAWUErXB zc5z3BokwLX^^cCee}g5=t?b-%&3*kB~jg~rV8gd>fJSf|nJ8;Tg(wBSmmzp9w)K^iF3&Hm*l-!m@G6WO zgeCk$dm^75Sevrvvux1-$CuDS?O3e9K+QXbI}3MMjbXBOa35paKOVD!JhL>yLo67G zJ@I}D{UAAKm1UlLy3JwVQWf-b8GMdUoBN1kxh?2JY>h`7Z(_?kkFk#&n84=E55K$0 zfOyCfyJ}$K+d9str8HYn84993|)cb^jZyc55c0FYV~8 zgFGO3Ew-+TaShJHt(YXf6;vR<|Gy>tM0wIqHLZ?YL}o{#pR$ zJZ8g=--h+jy7Cdbq9C8Mr{8u&!+N|k8d*K8GpM?=4VT$P-Pf%OW9XO5pu zg7GwjbcJsZBYk$5s+zlv}goHw5SWa=KwYY%Lwh)QLkab=T3^DN}?kIFX= z_{q|cOU~ejfro$fnxcEkQ)#HkN?iEDqawvkH#sb=@G0xU`Wv-agdfBD%+l=_++rCB zzfqzZ1LyU=Ib*TIUiR&E3m5) z^kjmp;t?3wr`>Fd*Y?DMF?C(1zb#iwo%+r6g=5-2_bN&R|v&5<~ zQRJ;FODe+1Ics*PDAm@tVrvAh)$Rb!geCloIT!pIzpX;GMsv9(Diz@tc%0Mvs8dgR zutU$6T$H^6dR_cNSds@=?OxY<;QZcf^(c=tIS1_LIR~r5G?d8xh!*4x>u^l3GFauU zQLX=tcdIj)*!r3Ak_%j2*oswy#oUoFpY4&kHg^r)(@G9!9D%%BqSRWkdkcAdaaO~3 zZU;fPN2yki0UTPBxNJmsS)-UIBF2VgCos8^FPYqC-Pq`l(InwucrU58U!x2C_R2jf z8WIHa6Yc4?l&$2Pb1wC6{j9}A-#n;a=L5(&GX-@ogfz8chnUYLj>3F{u!Mgx=e>a} zW(mt|&_dVigKIplW2P*(1*=0}V(Ua>kLN=F{@c5trR@AyA1CWc03GHp7it*RVm}+5B-dUqU61A4zSEEjUI)BH~q4HMn0mmS=OyEVV(0bgy3gq*aN@Hh<#@ zHtWRhV>^>w;s39+Ct`;#!a637wQVoG;C-Oa&t61ZAqqi{Q1` zb`J@>F>Y_gE{XHr+z0tgSi(=VC!T{0@#ef;uYhyEjI+>i0Pb%yxZ;dXDVBTu==Yt# z_te`)8}SS9eT}*1fe&CMGTc;*l*l>!w97fT4>))PY#uCy`2$_E{!Mh94a(r`NcQq* z!(*r3TkXktiJdvJeffR3PwFk$DCgif0WkwZj=&+p;6SdDCV71PlJIV83mS?LIK|!! z{36fu$P7dLKl{`Vg;J~W%RXJNiybPl{+znF30IiMIBGj+Kz>XtuXUDzzfXDh|EN|a q=iE1AjTxL|BI8vv+v=F)oC{t}PU`ixVv1kx%vAwr!V><)oc{+~oI3mf diff --git a/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_Ar-He/CouetteFlow_DSMCState_001.000000_Wilke_ref.h5 b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_Ar-He/CouetteFlow_DSMCState_001.000000_Wilke_ref.h5 index 6aa323bb9f9767ae0f0cf39c879c837dfd45ab2e..3cc6b5f34951ff996ed71a838b45aebc34f8d86a 100644 GIT binary patch literal 54216 zcmeFZc|29!`~Qz7q?D2dl`+v|EG70Tb0LIOW``)#IY1lHWfP|4jY!DXaVQ7vgu~xY<8HF#luy{;|m{e|}(Q;$WISw(_69FZri_ zzBzyXP$u)o>gg&gGl3^jKVknV#x%C`&rhtxAO34+6#+HnJ=)V9HvFg8gr3U&(HQ|l z+0M#d$=t=9_?^%tBL49I(JuW*uQPSc!6g2>YGx)@_-`eXHqG%E&D@@88MJ2#&cV$5 z=gh?U39GHHsA2BRH(Ngt4P^h}#{Qd|imjcMsorTPtAEDj|HMz}pr+zM7jqY@*-7v} z_$?xIcihU-#Z=4O{x`z^6F)^qS1T76D-}COx7kP#`27weu+l7IS`PE}xBd*QXwJ5d z4$~4`%7+2h=?`L(UdSXp_0Kv*HlKgHGO?on(KY9vaj~_uGj}%qx90!TxJYdk-zq*E zN90eR|6^RZ;Ae=Z{~JGb2bVvfnU=ud%>Df{-|v6P#zoxqPXP`lwLgAL^L~%Fp6#D` z^8as~hp_*tkL~w3Yg#$mOl#=R*_eLE|HbeNS-V_Z9UQFeOzolARvXBD{w^*?nC{m)YEXxP@Rj%lc1@{y|%NZF8Cngn(HE zfaw0e3!kQyxx?%s@TdEdvpeVi)BV|%@%)zfe~$j_%6R^_?*BXYXJgJUY5H&XXV(lM z#Q$&iXV(lMx<9LP{y*ZMwK@Nv?$6qs|4;X4ZO$)gI;(U3|5*5DSI)2J=wfa+TQhz> zzW?d|?8QK|J(i9HUs{M|KIMM^)9{t~IzwUJRi77E_?C)Lg)BEA) z!~gL4=S3`Lrj5UkFthym!=K&p|FaK%=I?W0Fa5M9*?R-?V7LABah887oZfps{reo| z9s~wH9l?L>pMSZ)fBG}+qkM4)PG|G`_y1e}9Mn3X#0+Qu(+Vc09@+m}Xa4Vb{!8G$ z1pZ6lzXbkE;Qt#!9q0AmuYY}yANp?WvJlbGk1)2B%I!2X zZ)i}pM4E>5tA!Qow{s|wwQ$w)4o0LN1(kWx+@yEXP?Ogglbx+LbOAPl4U%ceSb}d` zw|mhW{On0S*-siY6yG|g7`m5+j;foW&5AS>I8QN` z8yTC~j5k!_a3%l6aIpsnHv{+Dsx_4xZHe;C&>9nIszS~QdzANl;k zuVeILWr=kDt0s7j%<=JnXYX*Hb1TxRIyCfVvyDcJ5)DbuclEmuHlQxNut|!X`$#qA zGga3G<;v+a{!}C9{)V@2&=}{0mX;7X zclm(Ix0osg1>D|h#2EwnPsC45l~vxy861mZGUR&kO)DhB!cA$&$m{L% zG~lmy(xK%OoG-fjD^I!@dHsF7bF!QEQ;>T4+59|18uCHvQ{Oioqg#dUEPP}Vh5xKF zHJvBdgLkaGdU^9v8sc5=(h&;nP`D6?8NxV~ySqtwiI8(&u6L{~K-~r5z1!X!!?+Q= zX4(iYlVb(n7}y)PcdrD2`@dFdVVa2HxI#v~>~gjC42I6s8sb@Z(E8D0axQcB$3$fAprCG% z#Mjn`XlOh0{GE$1YkG_9_vc*8=vY^G2oFnQ0CwfPw{!`WhNSEsrHGo-koaSf8>W^t zB&m3+L6V!ie(JRZPUGDalyIe@4!*$x$*b1ix}s)HeYsgBbQ;E|<;cS(I*dbnW_Rq@rR3aq*~it*-{pcN-W^u716>fjX4=51xX#%3 z3~ZoB(uWPW6E?oC!iM$OxPqa-hnD)642~1kYO@d3LF9@IyCf+X(%Oad2up~!vy`b#OTk3r16neK1To6CJNHsMrGOyJj*B& z)if_Fdf$`aaaq?;>`L-L%uV4u{F{7oRP7m2_Fo(@2^Tc{((BzzXb-__rk&ujg+C;l5)^dnlutFq ziH6!YN-O^a?jGzBj*@MvEcjN?@8{`5hZPX~@^4PLXRA(aio-(e)Y*%dotO91@ul>$&vdD7Q4W@N_Q8I znVX3benfeKI}1xih()|Dy)ZUBh<&XyCf{EEt;XvO{v>N*$ypiTw%t`wmW?N$kjR3Nl;I{c|O(J6990QLU3~ z=`J2x7t&(x;acVf7Y$^ZaXm(>3l4dJR_H}ZZOFs8b*Y&PAiqLkmlys}C)axcE#;1t zg$t73t+Lh_{0Uw&?S>b|I*v=Ku!h82mfWCs!XBTxe)zb;xWZKHiDN2d85rS5lqa|w zlqztuoIXy!Ga$fTzAyq4FMi&%`BE3o>{xyK*A^PO)@`xj`$igKyDFAwAwom$*Rd!c zO>!=GHdc##p-_<2_i~}NVlc10w|{S@9jBMDvN>f@V=$lQ_ zJymq5IPJRNf#;g9@dyR>uUw)uM_$tsPCwmf1NoWtiNmKFp`C7h~ellD0GaR``NR`X0~oF$kf3uKzjo@cT?e2^Xf#Z zu*tQK7d8QR!dh)}j!WGxWw$ynvv>q1t1B)Q9;q*!~@h0cu&*CX?z@LIf{CmcCFQg%ZtjE;lLw59uwz~2~ zo1bA4SC$-bd-(y^uT36F2j0%3o7aEgfH*MbvY>{ChE^v$#_Yq%>#vJn?s6uIf<(e! zux@~Ht#&xFG4-1r-C1GttId(gSS{cB;gCmNc;Dj9M`hu75bMCN18g*8dVaN3Fc%G3 zw5m7v+gk@6Lz$e=9xs^Ar_Lw(Ioa zb7<(@FdNJHYvf$s2fh?M8%jY3Y%C`n!GGYY{cYJ=dpb9du#{&qj$gRP75ZgvCqA5B zIOpSXxSm|gq@%omhSr^Vzp@&}RoIwz&?Jex{s#`>37H8LG|sc5>KFLi_1={pY_O-B z?n>FVKQ|p$KdKN_&eVoCpm$PbaGdGD9QSBwM|qU`nhI7}KST<|oMOniYj|aK@x;2I zjzw0HdEig*nrZv>7iUN5S7Ft`I@x=HJ7HJbc-DX97*|*pB&bvFmw^#}M0rB*tAc9g z809(81vGWpyS`BIRXyU1f5^4rFCTc_kYj?p_wMK|$`BQ0B%3@}oS>rn3Ti=K3FKV1 zeJLI`h^L^POsXm0$EfJzi)clyR0n!%_YHsB{%Y*rr@}1txeUD3A^B<)^viNp;mG}; zRHSIxcs2vh)Acyz`u&cJU#LjnLSewKE-KOwDW13i*6qo%0pSPaT(%u%S@9tq^6MQ> z-ON6L|B}IN)F4MX_pT2-jRAqUqs(wpSWGRx-`=N#X_AWQ963@azEM$#l*V#@u(j`g z9``OLum4(m>(^uX6eM%4(IN?WcC!W6NQXPpee6fDb9o;4_YBrDH~%_3OrNVt362+w z#U0tvPeq|Eb=)h!#xwlV>YkEwH|2GlC-Tq*O_Xisz65$Bc+IrqdXBp1s8!gnLk9}3 zL3}5y=LeY=tA@uEyyM@oKeWui2tT4c!F|DtZ}$7-o#@#M&8;MF#bT^W@@PSe+VF_W z@6^Y-smQ?Il>bp96)j)5%<*VD6=|^lYB^Cs&P6sWy6{T@1?i_!NAAC+B8ksWuGjBy zq8EBea2jLf_&EBcQ=9b$??5NREJvs))04I8Je+6UJ1ygyk5r_T8GTy0k-YxQ=JxZRf-!UV_dDUNdcl=Ke05^T1tr*;oMRov`2ep45hQ zk10I75R&ylI|C#9i1GyYc+I@dSRN|fRg!H{(B=Es$~?vf`QZ=vvg!m4hbk&+yE^B6 zejyb#ue+I&@sx_}_MVT69wg_ow`)P+vt|nF7quUWEux~rV3D3(98`MExapQ#qczyD zSz+H|+9&)hwbw4U1?E#;=t7BdD!R9PKlKirFR!@M?m5#U((B2s2K8pEKTweUamBk^ zYp6(dtHs0KrBwPOXJwOx_lvPad9R+il0EqAm}FM&1}a+oXgJ8Nn2H)DR<~^`p(3ui z*_XDCk#m<_JFw()y9-kA4if39Am<)f{$%d(ohr;|!;`CvfIDGToRXehD<4yMo~hoK zA`bUw{_&g1-Fs`LsbiuOU5C??!oMvNk72)cH^;dH&zGH>>;0OF=6`;iUkLrXEu`e> z4z^}$`Mb(`a_;Q=cgNY4P>}0NrXQc`U|y@pN-EuTqO%9dpOyOBfa|Sm_+fgt9oO%@ zq44Mf=U>ctJm zE>P+DMsst)2M&?$@4o^QdT3#%cD^EGk-HQ)k`$go=1-&5mYrkn8bc zYw2kA00n*fWj=A{F%^kFWM6UpJe5A@r^IlDLm^&cC$-r^st1=%QL`gQQH-F& zx_WaT)8Q9XePlZ zyYL{n3sTi>xIYZK^LTRyKAdV0Xg@s z6$`gSJ*vWVd_(Tz!2MtQEK95-e@r1#OSiXyCj%q=W^(6y+2V6|gi1dp$4EbB6N0@g zyJY+RS06r)O?7v64#f98?^DJSAg(i^-Ob5Vl=LR{XqN~%7rjR^oSH0FNY+8n+&h(u z99m6IJ?Nv-E5EOm<(5srk1f5nalEV-e{JR~5ciCV*vbSBOT&4No*G4a9#PTozseZQX!!vTT zi10MfjboEuUORZcx#ByQnGGC@S)3s9XA8f}D%J7Cb3qvqG0;zet9}QqgYPSmnCIH2P{w zo?ARSpW?sTALY;KAI2ST)hU*zQ<2b!%y?x zkk=>=x4CU6=N=V)qU#lhE4mwRxlHUXIro(N1<8YrRhU`&2j(Q;PS`IWWxDp?8dJ!R zYCl35O~(koncM|hzDD2dpwTx*WJXssApSBNcbT^_&sM=$=% zCwgO63>CegiK^#?LLO;aw^cKoiuRp6v&HxjdHsUiB`eMgSs~uFZ~TKJs7TN7h0o+` z8vW751u87kS=ih+wr!s-f5!LWp7#E5+;nsC57(UOyk6 zdaO8$aB>GN!O~Z_UBt;5O+Uhl-bL}I<|)Wv|tT6 zm(u+^F7NTMLRW07wZHD6A|Ks*yT&41==S4Qn;+L+!A8>eu8aFY#eA*|tcuYAednA; zO}a2XJ@)rAwLq7mFIfVL$m=&+Ik{x3vlXhfP`$qp%J+v`^hiE+p%fP=hzl=)CxV^ z<|4htn2LNkH3LTlUFaVbzHXLVmyM}0*=8?ne~&At8YG^!r=m4qN7%V+sp#zEm)(-b zsL1)L1{J?UUccB9?XPu5tk5@JW6549_jZp)%rntZaK2K% zRdgGOLqAk)_L@`C97T03&Wwt_KD(NsewUoP#gX)&9Y|Y6X6tXDbf5w|V(7SA(~F9X&jg%sccCKY&)+QOxKq)d_KErfSIFzn zXBWlp?XyDiVF`1hPD8v-l~T_tb*2l}n%_Sl8i3W&BF<}NJjajaO$6^eMMVvlmpRP<}@$mnZ-a_+t7mh#7_yQ2Gx?(g3X?IL*1v`Gg2Zl#>n*nP!V^Z5{G z2-}dwJJMtaapscnUhF|SM)(os3B7lpa5it(cczaojb7$2s*hvCN(-(SzQeB!S7mni z1BZYeM!vwq`Smu%HgC9YJ$v1Ey*)XX)(J2+D>)c2&5v4;L5fem#CITbf&vGR156;bOF2Ae5mK_+Bdk-gi5mltS@rMJt@KGsL0RgWlk!z zhkZZWyR#1D+@mgYHgAz}MeKbo38ELtxj$I9NVRBAHFhA}VA)&XPT1gGOB?mijVZ*e zahx-W5|cqhCVkhJ`+wQuV1xUM*38VCGym*6dYpE&}GHN zB}Nan(BC}~GqPt+#$^IUmNGU}VQSIYpAxHRi1k(mR|vGDI7djlvxJ7uTj5>GG}0Q_U5 z!XDm5E1-WTS=qe?fD_NtCOa`2IrqvR!d35}e)VWiuL>9^)x*V;8#nONE8Xq3IqL1f z&GxO#srD_$mMQgHcf)b+q8%B$MKmPWu;=?4IM1OCiUBvMR%YR zzx6O~e>h{e{lii$Q8XdA5cIxc&?hzkc-z)`W#1@(=h~UOnU}hdbFrGc$9_+lB{J8N z{jT`}o`*O3j9(vOq9>KrKhRXWk4H|i9BdwWfps#5*hSyaP~Oo`?wQcPpztRt3^-qL zOL-`l6M6kLdKOt`#g>S(?~+v@aNVA>WqbPx7CQgnmMm`Wo4Ec~X~mNIVriaw(0RdrX=RXAN-Y_4ktO{|omE=|>Y58Z)q%&~NM0 zfjeQxHuJJgbJq|kTfbR86C?a)au-fYkWN*Tp@%#%TQJlbjXB4jP<8)Oj>#%LTN(~} z&yNhg&uX+3-yh$-!wc8nV8^BSZ|A`AIbugoWkNeBTT+bEAkNU!g>0BTkR3>CwR@YWh;sTcR-x^wraJu2E-Y{`k*mQtA=rfDDDe=({YCI zBgzwTrtq;?k%)mDUHoJ#*D0Y(c*;iSasCyxn0~-I*LXPZ#_ubh(DG>LZg*DV+ov=n z^Qlm9+c|PQx=QoYC#x;dL$^COCSiVrZC~Tau}zMSXB zJ-m*;S;wvXE4Ki9EM>j2sgi~=CGF>QD*qfaD!wzNB zJ++qTf$S=M^?cCR`9X31&xr2lz+YP{^aS@`)NuRd!Fo*K(sBRw5GPI?wv!J99+~;U z#r4y1=0o!(%3t&zoTzuh6ZCHT_EqzF@P8Q6`y>A?qD!w_Q}ldkDvs~Z&D@@yi5Z!v z&ozWN;dym&bS%u*A?mjIk3sjRBD1(RogwEQulUN-^p!K}cOBo}1^p*@&9pa`CsXKF z46MK0f@>J!3}IDQ^O^8fk1I&(i>&RI$;1dhqCCNU^|ynjT*6B9nD)6ocDrM-pdO~g z;?_I3!x1UfeGs3Qr-@690dFs7sf>9LXIApx|Do(f&i$A}s>+QjOO(3t&Ew~w_vrre zYcF+`=)+;dKaTZ2$LJ1s0(e&!;mdz?Otpc&y{hFN#DN~amx-BOg>}zwQN%gwDf0TG zR$r~RskB5}+IWl(LmYhVnakcUr$mq5yKKXu>yI#3K~;Xcs$6{Y`k%`}puTbu?UfoZ zPkobWLeyb=wRr>zj{b%FxuP3^=Ye~DylL1X=s&@0rWIAJRl7xDU@v%bYJ))Ugx$Gv zRpo}-afQql54T;inHb?mlqa~m&gW)a(o?0o@vF;=cwEB$#r7`rx2na9Uvc*s0FN=D z%|`DtAx^&K+BJ|vL!9S1r!20LbJ;4Sc~7?05``)AisiyQX_vI-5Y$qo2UMC;l8)r! zdr{2LmJ`WXV^2X~7wFXt~s7bUfmfB?`h9sLzG? zw4p$EzJZP^eNls8cacCUF1ck-$$Y#3Ph6EzumgjE#XpcL?kjX z!jC9VaF=G=L$`aekFKg<)z{GIfi*wYPVzLa#&?U9Doa2+J5u*5&rPNw(YGJ@w*$xO zmM*=)XmT!cY{3-8E=yF{ov`yXj8l*M?(La5`{>vux=?229qbw_on^`GT)f1lM$-ql z$Mr2&b$<-|Ney$9F=O7PfRNA5$Q*Pm5aRq``v=ycylyB>%)osYuoGOmzwuNyf2@>jDnn(r~X z_ZM8Z5WHqu-I_(L(QXWE;kTBxHo%>*Ctu3%PA-9Ub!jJS+$P8)|M4Tr6Wn)xtct3- ztxZRzyuvSa60lK;=dbzGJ8=gi_JAbd+|<7QA`@^|s5l$`1lq5^2UEKfNzR?gM_?%W z9poDoEC z*9P53WIxTBxE8u_ab>=FWy^c^_~p z_s?&}a2(Ivx1~58@_g2fPtQZV{67BkXZ1C5?)yw)Em4~@5{Y)-w*&M*@S15^o*az4 ze~N*Pn=zhD-;X40o#|y$s}~U86L+V@ZqCFAKcYOrz3Q@~QU9bSeLO@|X2aJoJaXBN z7>-E>?(}fp5en%2vBOE#tP~pR%^G^jl@0ArJ8X9-ikwT*qr#JG-&>;jUl=ZnK<`K5 z*9KV4)uM|=I~(qPcLw9nO37MhSc&JlCcPGi_}pyMc*_^gbLzRWq8{ki2g_(1`b)la zGa%}aUyUW26A-R27yK)}S-nhR(xMAIixzvi#0!rK-Tm{u*em?)5GGRw<7n7%<6I=P zWAbRuhi#zW53W8!LV@Jm1#WNosN3RLceNb258MgM!;rh9 zQ97{zf^CZ%e(U_9 z4xjU(y0Zw@IWaNWJ;A_*Be9*s~)N3pLi)NFRy}3HtUX6jK>l%-$E!fV*E!9SDSWJ`O+X%XSa;apmz-6jN#F`EKVq z$Nmy$g1mn0a)LNh`qg4Y?LNerEfdtNIeK()#BqL#wHRNy#&N8*v<27VZn&ui>o&)w zq|{Atp2!USm+in^=5u)O-?&Hbx}%SP`;V0>*(IRIi!avM2n-#hr`89A2HR%iEt}uU zoDqGE?>fe2d>q!(UkVXbt02zsY_t--{(y!&md_hq6H3lKyiH5Zu-zFs4KkO^2Y-Us zOuP9AsI>E69Tz-7a-99}<&r)STc z*f11MUO)ZodtQr9OVrmq@<{^L1rAA%n=E1a^l#oK8$@1~VsEyUWXdXL<4R%GeLo;B zS}lLoYy-ME`b=~8OVGi=a=R7cQRLj?kKS0v{2uZdfpPsM&@O`4OzUmAr1qsJ150Xa zKNAUhC+uOaMKwlG#ue-@XJ`6}WnzRMQJ&zwQ8+TXS^5xNW_{UX(JB}0=%d}wS`^RX zCSg1Ir=Y#@6RaGaH{d&k`LysbPCM4%P+ixY0ei zLv*iBNzLWaCHPmV=#-SP>-bwku`WTF$9F20Zu5upqzNjp@b?511dhi^_$`pR3wfA4 z4^v$NtgDt4>qG94bAJi@L4i;(^aH%x<8g;4SljuJhtl7dG8 z;K&*C^VnMEIZxvK?%=z7Dk&-uCnR_~euzUmmd_iOl!5sdPuV_ImQBw6BkTO1v~SMn zoT0Qt7qpAuHPd=rX-P8+XJD(>(zGQ&?}W|Tb9&h8{Q?GLb12~_~M7(s6sH0YcJVY_eKKu zn%AQ_pvxxrrjE;W^7^-)nc^^-vP9Z*pGEiGq#>L4L8FEF#`MqDMN@XGE@MA-J$);! z+>KMRf=b4L^Uci%)GU7%Oo{$>f+iOKh*!{Pql zieqf*!$;|tF*$`3M;~M7M^32cFwW!o9CE`iA)Z?W6*5=A_-2?r^I*LN?>XJ6c)*iO zUcb0TBD>1CB^uHTarcL~q0Qndleol)F7wf&k$)r+bIE<GtX(@9rsac0HuoRxYmwupk z!hTlO78JfWuCSBSZg>Ico$w>d6MC1D)2(N2vZQNhXRiLv6ph>M9}BKct;hFY`FNVe z9r85&x)8cGw0oEA8x0$HuT1|$O-e607x`Sd6OY$Yknn>aV;S~vKZ@)86(5Er{i}}j zlh2N2*ySz9FW>B}!Y};{-r46vLzT<4^nIx`6nrsveCJ6Tda9A{7(7K@|F^8Ll+w)< zv|m!{_0`if^r&AXy0F%g{&@ZSFCx1hVv{DF{tlY8I0x^`_ovQ+&a0KigzezIWO&a! z6-Rh(sS^^n?i)GxRS$doF<}?9(K|Wrwlg{R6UQ#aG0GX(j$dxir{5bUY}1R8k78cq z3R$`*8|E#{#0bBc+&B6g8K(ZUpdTLYKYoFF6Jys}(D!j)4Iay8J{ac-?^8Q8@|Duy z{!+zA`F!Bgv5nh*LpwQ_bNxaTK8FKDvd!E+!6u|SQrziH{AO}L zpYD`Mq8E`oL`>moLD2T3Grb0?z-nw(J}A6baxM^po#l(nM(1*1@{Ay-T!kAxq30FmT;a59c+(QH5IaWdC zoF%|defcuU6R?hK%)PYrRS$XnY=Z9NO z5xi#FV+nVJt+NxpUS;wU2qY&>+RGZ^Md;t`@>SF->g9r}cG z@_*@h4&$oo%IDtz<7y=stGpfJ+Unl=gdW$jPN7M6Ws4{?q(9ZZbrZA*glqf_!|Du zc;~B4O*@g>c&SW?Fv~Tj}e&nwmKJdE;Z309FPqWpPewQtheYGb%K3@!;Jx7qi}Fk!SWjEFJ3oC3 z?Rc{D=!OJ156ep~`SD6}?tWX79itYwpo=PRTBTsz2wpSoIz;i^kqGx^=B6M!h%2*j@FU6-+;_;Iwi!KdN!WEXNUA z5Ra{oNK-XA@D^{ADz{R*MMEKeH`QGYws%p|ufO@-YzSMA;Tx z2#0x>R&)7Xe=#{1%|3N!g*ov3FbP^{A&l4PC@o!nkr}d*Yg19o3BmS!M+vpB8?fiw zQ&?i*de(60=Bw#>^{m6`@ps_<%vICM?l0U^w{x921Kic__cVP3f1@`|WeKciDB$5I zd6^fgc#~mUf#uVBEYxT_XDJ*{3Jh6lb{XzJ*z@VALLU6!ZlBvgnkt_!Lz z9TRqk{u8`rT9d-G=jsUz%oO%ti2!%Pp67R&;GEX`28YQQh%r&Ch{)n3pXZUFOg9{tTxd+BqtQA~L zLDwczc1_2n^%oT-joQtSkjUlN%MIw*7AEgaZz;|Ah;Clo9?+wldAN1bCD`|6;5`}( z_ag){xPKjMBCp@L$jzb=;*5N{a!M17*F4R$vUsBzvcBSBwYD`C^RdNsd+2mLvc1m# zBW8j&A_aG zoLT$`xD!_A#o3q>VdDxR-|ukMF3-dWKcYOreT(@4zo&8LD8O~AX4BYJ+|l&K@T6lLd z-W;iP+7Gt|_+U33;w98XTktD8H)cMA_$wBNRF}iL+FEOFFAKW-_CRXaP#byuJ6@;1 zuU$q#7k3VvoC93$%k52SyJL?n7_O4I z3fE04mJ^elnHb?mlqb0RD35Pi?O}m9_D6o}8?wMl0zZe&m#M_|THBSULB6{=*}Wwe z^6N}4sU4P(2lujTo_6XY=W=k~-QZoTD2RQb$;~bpui(zefMb^}&|x8qtch0-u!Ukf zR*CUG!u_+v-*1C;%T9Tn+d~+iT-Wp5wh+(mQiY>U-jdf}QuN_{%W?|ZB^2ZC2)cOJ z^v^0DXa3pJ!lufYo?9exFqF3J_9QfF&hX5?u1>jT*0pY65JPy<`ODk%ftvj zqCCO9wEF%;yNV^cGq6q;T|JFU@-F3MQhI~6Hy?bI0ldp?N*2&45MMr3ZqKu)p>52K zpYHtS`w!FT z!hjR+h3l&;`?^k3fJ;xtn%DK+Z9?|BCUKsQ%jk9Fh^lXIt-u}?AtTu|TxE*E|9 zCwR@Y%^&sq&r~w7iNkL-BjA1{VL6_!2ubo7R}kEVm)lQfV1yr0p5R_^oHy(^#Dxc5 zn^x@h^T9edA6ouqss>x3S>0m{*VR%T3Vz%cG}PzN@l6i+SE@xO{$wV9&+%!_$<~Wo zDQKy5g4?cRupTeEURne94Qjm4%Dpzr!*^$z2Bq58V~wJ!G0nhb&t50$e7GK7y)QEU zA@uWLZQlLH5pwRTZcF423Q>^tN5|`JpbOd>nPP`iN}ZIh!#+&u zYORLjH`1%e79NLvz>9hxpR|MT(^(`c);mGY{d|~WfSsrd(*JZgRB{w9 zWFiLUS^tvPFB-0Ah6ApgfV|+T{LtZS$g5ses05cJlXGFdF?@YD+#lCuevx_w%CT^? zjdYY5p*ug4HVmN)SmFul_UCLZ*u;Pt*QdMi+*VQaN;#~rIZbN{;~=jr8)^10`%9i0 zAzG)O1bOOX!yT?Aa6fYW5*8VkN+WcroX_X_z;*1vQ{9Yt5%rkmf=%kXpuR(tu6!4;Xug z!S(8^x&?8NHwcwKs?mk~U?M5Ud2tpwcW$QltE9hLBGwR3E)N)|;#{4U5K9wO-8-sg zhVEheWgkUK_}sylbLo4J#nVv3*H=l-p>TcH&3bPq-2ZD>8Q8J6h`j#plY5`Dvrv%# zxMj>0@E;14QW&r@K}g%iNbO}L)|f*58hr0L#=iLzutSfNa#k;_runUTgZdFJaS7?a1 z$Xx{YBMCpEJi%T4bXV&n&ru|HXy|Do%>!qqZ8WU+d5dl5sI0Vue#J5m)cQhu_e8Tt zK8Jj^P1-BJB9)v=?TGiN&5$KpAiIZ49?JEfn;*fs`Y57XFk96&WaCc~@I9ISRhV*w zy}buKe?2$n$}(}_)0`F>?hW_LRf{+8k9(erOpNfG$-TwT_lMJ& z!-$(#O9WOyT^w-l)?Gk0_L0APXWy-(0hzhWXYPl@Z05h^bp9XNe>v1jn#7%PUD?R7gmVB^8I?QwGrk|_XZ`bcA zZ$E?zKdWO5!Bm`mEAKwvWm)*E5rN{ihp-RZX_wFRbEoE>!mB6XIYn{(yyA6#SwEhC znMi!m5BGmoJ^aGB5AoY&yht9}A4#!^elrn>_iGIvUr}}r?gK}!FwB7azY{0K^pX@=SsdC0X_b> zcSDRF+Dm_~!Ez9uKMfis**5=Wp9ONPrxPUIDwFw!ZImhK%j~Jz6 z?sU^j&5b_Tgy>){?J4YYEiuVF47?A`XS-;Z1>ZBM@?mBBU-lE21U8@b?*Z=E8D$19b3QW1#ee7j~)Z+%i?K+nE2N1ziu|_=Hwax+L&>l3mR{9I9e?Px<=3E0^9?|fg z@Cqi^dxd0C*4DR{C~J-W`Cjl>5Vf;^6|9HmT-R8!Mj#v;Ns>A+nOKD9S&s4f7D66a zQDZ#{yyH~Yy5O!;$675i z$+_R^6YJnO!@wx#9MfOHePF^KPD`q7dpfQVqxZRZu6QO!_|4@0(dgO-sVQA_B)LU? z@r%niYp%DePvA9t-9e4uH89?<-AffegKqgbIac^X`$yegZ?p>{=kA+vBgN(o#P?h5 z@!~LFj%VFai~6OD)YR6+2=0OXEt=1)X+n*dx1DtcKj>ZO8oPuo@a|vzSz>8E4eb^7 z8LbE#Y- z38sR6M)o+b)dKzB(As)^O$a&nFFXA&-FoYcXrUJ?vOy07ubGzBDVIM3_D5P7axd5c zdME7Yn8MST0=WM^r~a7xwoHuhBgzwTCU9J2ewpS06lvHUYU7rMC0IHn4yDpDzS}+8 za!+8tmyM0gG2mTce*BUzv}1BV*ROZ}A%`uq;rZsb*pEF42T*^m zA!Ucqc|4eTSVBrY2V1bXgWcp6To>fjm+g86`RdYo!7v>Bn`&(H{K)IC&UNAwYO+M3 zDzB3$FMzx4ul&Z-2N3JoVaLS52uwiZL07f*6YO?Op5{w9&LrTMpbh*#s+?VXH5YWV z^otbZGC6mawpAg0P0r}G0ZM%j{U>)oJt!j`hQtyls3Qqww{ z-JVNjVuT-2p5VS6dH-6Ztb;VIHH$W(b9jj92H%%jh1iMURf_9CPnG;THIIO9pP4Rn zmILmA4;Fkf`pdr5DvocAGq5jJC(Fek2>jU;b~srd)IoDtdA=T2NWv9OxBS|w5|7Dm z31bWa@0&YPmrU=c>zYqv;{+~`PrM#%`^$V9<2M?}gZb1a_~Fh$@Hg~RdbLYK2PIlZ z7JWMqgI~$}`M&~h_cgyeW`>WQJ&z=^G!;p zVz&lT%SZ@5d^Q?qe6-QKnTlgYJWW>~7s2;G4pe_vgLuO>xNAWZ^y6dLh;7?n-uF;E z^KQd+c;AB~Y5&$(7&mLZ==ffW2Kq2J%YV7)Qw-Bxwxir6856dKFCD9ZJZVF|ab5wu zk0ZrMwuJMwl-*_Gy-2Qi2@fTW%k`E>BP>kh7Wl97_U~`h);5EeZ!E2^n zF@(3ia%Ny0>?=)OfIDH2Ozms7dNr<~H2&kKqjV-l_z~p^?*30}>cwi+P)@$<<;?L= zeDlfF_5`8Z*zGE}pHk03=RuXss?hHC7CrGzz#EAQ=XYRj zG3#a8q1}ofo;SM#zvJ-5JwIR_G+o-bg5@voeFclTU0Dh5eO-{Fj)!;*Q zmPoI(x#vp>%ty-H4y`U_G=E9uxLw>u%+khO>`X!nrY!XGYBtO#M@Hb=0}#(rJBR&O zK)hG?`}y&SCpq`XnDd;nRnCa-hQrV7>Ggr+^OMc+gdx1ow=Zv!$q={`7TdyEL#ZEE zxayvDZvnioP52Sj5Zvhx?ytKLyBG03lo|_=490YQGx)zSHDd35y&l=aJRWV#Ub7Rp zXRg%W`2*T7aQ*va*=cev4WGRY%;3G@t)5MDwgb;aDyCT0x4o#aX#Ty)#4C9IIm49g z30;^p&yJ%G)$l#3PW9oxV0_}OF2^qd?zKz98W#LzJ{9uHdpW{T>Zy91|;}wD|zXiE3rrp1-`$SNXsC zI`g=mp6`#_Qnn&#Q)w4%S}a-KGeR3_k)pJ}+f%*sRw6AFsnAN4L?zmlN|CF5-;oyW zDM>_VvHZ^G_xRp_dOWVb&ZEcs%-p%pId^8dcjk2h%*RIHJfEV>3vm{>f0EaHE81gL z8wBV1CQBoTFR-2=Z9o`Hl`EWI4V` zc9-l@^!CHxN?HZ9TUf$K2I9Pfek|b``!G4RvrLhD5=-1yX zc9PViH_Y-WKuHdsCz98E+me4J&D{#lul@`;`U$v`)?>2q zg&myN-g&YAQwwk>{mAkpciwMv3T}Eka0Z85?(J`ph-R7Z&a$9_7>ykfZ3oWp<9b#P zL7YEbch_VmjFT*%S}JQ9)ZFn3fx$a)o?4dQvr`Y^Y#Cix#*e0gefOt^e7jUej4(GQ zE+}Y2qFcXDm%{iS{X?m)40uFF)tuIXzmp}R0+0VgpWs|;TvH_I6Y${&_FrI}nqrSy z^Sx>Zj`r+bInMf+;N!L0YvY`Qj(2+u9D?U3n5DJ84esNzeuqdY#P88%N|K!a(1qx6 zInluj`UK+7Exsf`+>yNITbFwDP0_d!`So>CGzBbk8?sSap2Ht%LX1@mh3*5s5|us$)kKOUCm zOU->!j%V@?oRd%6SaUZI`b#=MP9bn$HRdVW^e$$&1$i0iJo@lJ2 z15&l(<0Wx|cYv?D<#S?8KgWK*T_0Mv{(W69jPIs)6MJ*u{se@AyHvm?iLPFDz?GW& z|K~d>x5k~p8xkiVF0O5IxgTjNi9fE(A4%5DA`%{R@BJ{)igc6BtqkG!@Rq&iZZOVh zZO)H84)e&4$j|MvUexnyb%=S$7Z_&>w+dD*|Hr&K94xV17{>Qsd%qpkhIy5=2Uf^A zoP+huj*O7~La>e`{pNGe93ClObW8z%nB;acZH-1rB2jfO-^3GU?fZ4^0JpraJzE0d zJx6zDoX=`#|A=Q@C`SM_m)^{Pt}5WJD}_^^!F=2P0{G>QkZJHcIva{xEL*TC>%->nt_*sauuH zBw=1v5Eg?GLx2u76dTdU=$L4Q^<-J9r;-u1>OuzFBAp=X|qYhrL%0MVHjV zkNv(}h_ZHerp?0d2d2zV{f2fp2EE_20G(JX_rI+AxZm%TZnvHg{bc zY`IxiVv!^0pGIYuc~nkpsqhBSvly}ejBWLWZxDiD4)M{_Wdx73mNz5>oq1`5<*EK+gWAH&_v6V zV?RKbZQ?X*#!b+d(@u`wv>J5jj%B*)Scg(`U(&0tQJ{4iTP3*_DZ~Afyyn|oY3&Tw zHO=VgaW3XBh~6xu92L>K?4rX6Z4u?~ zN$Z;sJzMwH0C4uqD6MB0F!1KNTjn2)K&SRAr-f4vH5a1%K$noM4K}J)S@6;Xbew~e zlwD<+*g9(Al!Jc@3QKyo#s54ChrzG@?NnQEjIxEms)o*`g2D*uSA6Y7-{-I;o zGRkgc2ReqMN0ONp5D(SQqS-w6Gx6}zBe(vz!}qKu+*3zcpChMRZ@B_M$B-k?@J`jO>H?(TW}N?PADaox7*#D>Hx=wP~kI&bwE^yAL+uLjx- z92OXp^J6CiHyFHdPuT~0jTe7Bzx|GyJG*Pyx;=rQXDanLXAb;Vd+S|$9LL1HlB*8O zS(OpeHouLnmv<6edj~51>(9sg^yE%}Zs%vY#KGNQ8C#0|7M4-h-=P|Ik<;AVZY^Qr7vFQoqh35FvNNIFgTuoWgS`&d*I*dGyT-LNb>BcfmZyzqbi9t3T&;WBIsP4*6CPg2 zcAJ5H_?|p;2Yp&YS>3A${x*13{Afg-y8gFba<*oCHu$sWblGSO=h}{z#Xv7{Z4k~z;gH9|iPcHs7&Z3{w$epLhT}(nf1V(wClo5{4|26X*RZF9SVwK;9}Mt1u}4-J(qO#H)~UKagS&# zmlCwWzBZzMYM}qSOG4L$odNrWxYZ??3I*t4yopG}cnk69N!j`!GXu!YpL*4l>*{3G~dpWJD9KP}bY#x{_N^zBlILd)Y& z-7isvlkmIs$@QK2perrR@HyB4`pla4DV-l_)Z8V7bhiz2p2qx|QB{xbQFAYI9FM#@ z*o4YMZ+8y>chV*W{?rqWo2E4y8P~J*XCl&XKKD0`_LXU?+;Nz-5BEU6BBJ@%9+nPn zM;qJsCiMcB)~J0t0}mKDriN3%2-?vo>U&jLo|+4%L<-&i>Dqa5# zI&Arw+OjGR-6F&-l=y4#En)}9+u@NaXO~^sNJzpQVlh!38!tlkz zX<9(Bq;KliOho$4=Pt|XGv@=(cY}tMoxeaTQJW)iqI!0AD2_N7xvS=)^2A=n%Gmck!Pt>46h9&LjuO=Sc}u=s}J~Ff6QK%49_92 z%2@+klY`hJhtJWu5(+7+BY%%J5q=17Ck^6KC*&dVi!~p^5K~ z*L3VDy62;7E94`1BvQELr5l!g;A?UvI-Uqo)End5RYo-33~6KSVPHG2h`N?e@G~D` z^XY?m_M&m+@-FK7jZ7XBl75BIHZ)~<$p(33 z*aVg`px)A=(7cVW88|Sksx1F411IoXJeD7z&NHzSKCf~%GhshbvoAmRlf33z(Y|-D zog-o0hnjxd0(a7;8O2l{%P8CPUdtxb^5jR=Rz-)8t zKMcr1-lsslgzLGd3EulwG7@=pM9?O4^*ZQR-G+&kPPL$q-znwf3)hQz`avD%h_v)2R1nPbb=iXw6l$=)U8N23Hg#XtSY83` zuxj|?T?OOhAIAD0Gt}I(g&U43_cQTk1*Pn0Xcx(AzU2w#p8k;1gdSU#IaUI9(t6)b zIX_T6O_PbcWGB2K3z2?gd6IjT`|4}uYHnC;^j!C(To{qI==`Ag*N5oj`c(c^??LZf zYk7up2k4Ls;u^wQ~d z7?)h^4=x~9Z+C1QnSgQq;F%mzxK3XGQNgZpm}eCy!Xy8Yrzq=1ia7^C$4lxtgAaX# z@!F7n$oG&No_d>`(YN#>vFJSa%OQ>%#JLUyn%5WuTX=+xJ%V;H`cwr(;5z1E%8Spm zQgbg-xv-ZgXX5grg*?u~)Z8s*O|)7rHzDijFE}5#llHUnl2#|kBUBn*ePf?$79#!T zbKlH*c1F0=6>nb_%xdj(j$p1Izizp(0adDJpD_Fa|8FMPr%4Y&+}vYzvH~u>J)QT) ztEjmf_CJ@9EQb8r7xT{DgZqBWs&DwA!4(@+f*$j>7G&Nm_m_}(N~nyViV*t?`3-Ke z$xZ|RaXI!KyQV-_ym>-$Ssr!$G#&1iD_L}WZkOC|fghlY-gRQf;%ZkMvg_ROrDZSC zpG&oG7W~Ra91Ux(6#ayGS9;+ujt>m{o;T>SHr!89JALTv3u^9KF%EM^`H*jz<;rnW z@F#iAw@mCBGe>$8QXlcr7`#hgH&4q6zztt6GAqo)K&AB-wGZ zx#KdmV8bD32TzxQy5tN4E3@fr4SGb)y?fv5Qk25PGf{6Au7LKCyyn|F1#kLddJ`J; z)rmg=+)1ldZmjV6?=-DqjmH;J`z%EIk>yG5WsIRk@*FO>qi#pjQ3(d(&&sq>(J3No zf~xiNm%@IoS*|U*3*dZH=nlV;C6G6{;AYsD7-}xx=RPhv7z^jMjae7Y0++~?XL^FG zU2yq9)kTx+iG(bdc>K;seT42^&DuadcP#f+_uh+T@V)6_&LLOmhtzESv`bOc^{d3q zycURo{CxK15$`$RyY@*zkq6Lz^$kI~iKAh}t(c!z_`bFgA!joT1XsiR(B2CxSYe&{ z`SmJ+H0Xz4O5g81yFtwzzGjW*-eTgaBCc1TpAo=XGoj& z!mG*<@*+lyv@O2lm4!$@vOLK>fjd>{Cq9V}#_kt08*@iPBA)_S)6<9_`W=nxYau_c z?NI6_cF-jlxa6t;Tm;Rz2KxSy2Q(?L=X*Nj0gby-qP-2cl!;&Vd9QgATU>a4ASEi1 z5GF+5Z&N5o3j+1kOeI05c34zv7boZ;<)@=(0>Fp$Z9LmWYVKMWt2r)&&@qu`aex8- zbsGD>xEwf%e?AU5(y%?8kl7rddhu#1TIsd+c`N+RJ+eAb5%@>jpTFS21$s3~9xs^} zsJVLvv|Zo{fjrMKeIMJ_QFD*KmUq}nwF!y;u!yDuchZhBeS6Y)XK2oMyG$}dvk>Vw zpL>OB*rQEW&N%I$$Wqq2%V?#ag7;v37ZJ+!qb?8PG1atSf{n)=3tO4riv|9%ek|$( z|Hua%VgN5BFVM03WTuc1wA*(oLu|^{8K3Q2rnQ*w7GdMSyxZs8fu8d`3feCNdaQRA zSvm>Bdy0wF4d!E^e5ijjvtr{4*>Ik$z-(GTyV4-A=_^bHZ6F zs}G+2dy5z{7VTbKQcL{3*JQCk40PNStkcCIEucW@W?8zfUK8jqhBEZvk#4EDUV=!up;PC-So+2+XQi*_GoIO zEPQufn6SCZin@Lg7t1gEAis7?bxCC;_%FJ3>B1D$FQEUfjDH{%6$)aPf!r{Z97^M> z+zfgL8ML|^8$lm5>Jz^c^pow+6TDd#)ZDpFq(3ZiXX0=B8~@&fawM<$R=-~PTEAEm zifTVNSqj`qd#K4Q`VZuJo|7u>R!qr4q#s$Hrvu{qGb-dVV~ZW;K#ahaBgkj-QnfRaIW{|>x@iXG^ zI{v_}bWHECSUe8?4;_;gm)AOCpV@7hlKUQ_{*LFx?h8R5_DpAi(l*fjiM})Y82J11 z+4nTT^Yz!iq*&X8nmd0(fpotM6N|4(2;2?#Px6{?o7rz09~Wst>7y;-%V1t5?KX!9 z;X&mY8c}(DxlmRXBK^qnBzJ{!y;o=Z9dJzw=abh*!q8ySF1v-*_lZ-z8=XXV!aVwY z{{~^Wexw0M=x>P6-Q(fMZ4Oa$*;8F1Ek>u~s#UK}tOG8#n=-sBM;!25)9D1c!|lZH zhQ7W0zsk^!Po9?~_QO7m0X@xMP%j_jB+U@Rei(Yu-wIvo`dcNIWog;baoW1#B~p9f zytjYj`-C9}?DSx`wpFW=SUz*PZ%Irh`u$|YL>$5O!+nj}6+lM6ImVSFF-;P_A1jkKr4q7C+<8Co^J)=PKDCr|p# z=Wgh|MnG|xj>U5p8(kLkBU*@!wm zNUU{%@i*3RT-F};IW6UH^`4{tetYovr5$fJ(J@c-C-E{UXPWNOZ97WGraM*%Xl`*M z#wN0)`T8r-KB>}`W3G_bT=t1(kPSRnfn6*URkS**NkA5AMegy7MKsY7)DEz%KN&E&kHFr&sL~heP zbUYNpth{Or{r1wqwfTh&7B$foxvv<4I7&7;MP&4#I|lSUi+~$r`_!>?Gsrg~j!g=I zPfALnMF2Z>{m<3KLPNJh9?-CN$)eD{het1KOc&YUQ~K5qXr*q%J3$xEV~rii**GXp z(h>GEu!W{eABX)jY}-3?A#U!EB&uHJq>lFs%GNE+o$&vv7@wt)1vU3zkEJ)(y>CRU zpRW8?2JWP-P#(G@Z9hY!H8Hdj#(75rF<&bg73n3jF&r*i~1rr>;NQF!0+A4Cj*h z?Si+0f6hkTX``#QcuLjA$NzQ=`l;<}@?c*#Vu{yFbO&x4Ld)|AXvbSk!)y6)9Tp3N z13G-v+_y0QIvqhwT#z32^Zqev?$)!~bw5TM(K4OZyD67C;9seI$pvj^W!kA2f|(numkUgqgNy&G=R^K zUf)hJYA(uwjZWigbS!(dwW<3ctUJBxJa~-l@Cx1o>38EF5;c^Z<9yPF+{F)h9D;VnCQTk$u@C<5koPaV2J;~Qdx9>H+j;?t+Rfv2eZh zr^5?h%Tm`Lk(-?&c$kjW|86ej(}8$kc5N!yVUJI#?WU{9`y%{k^bQBJ2l4Tl3dz88 z>g4ev=IsIK*A9c)C{5UBpV9TILXMjI`xB56?JyJXJtHBl1aU+1ns4{4EuRXRgK;Jp ze{1`1ocW*C;JLUf`^XHfByaXvXKNNB{mAm<`2M-{ptv`i1Fra`&3alff#_oG{i)_& ziaKOX*2?dNeMF}#j=ICT#=}VUY%Ht~=-QWxU+<#k;_+WXv14>B@<;fd0}ak^G%vYQ z&*gxRY*R^P$*DvfgKq{Oej7$F*Xezj(S>pMy0vy7tYdf+=It5{4eDfBKyJ^|CtaT<6-?dare@Ywf+SeQtkM<=s59 zm&|6HcyV#DO=p|?`%m(p@qb=i^?x+vd-8LOfBs0gB7k3v=UkJQ&yQDK9YWdEf6=WA>p+yDHNnvAFFf8vaU zq2gfesBFoyB;S*9iAcr&Ps#sJyiSg5ZnllTyJlzOg8u~Bw3*JfOiM?$c`%-FI0ifW zpCgmUC#ANU(mqR9k*WG(<7V6T54YLBx$QpWU~R5{)W!NAzx;3fl=U=}RJHV2mMrV3 z$nZb-@sM$6Z%t#FYg#(~M)<$+Q*w5*X0fbyJ2<;fQGUPE2&^{*FHbYo_ZV zXQzn}%b{rBG@zyGD`kIdKq5|9t+(AH48}%C9UpCnxKPNO85> zUn4dEWkR44;rv&&8UyaicU$bO&dnspshb zG~ak?n}1;Hny+u|=%UZGbaI_qGk^^Kf6bp-GvNPa{?wWQr1_d|j#k!8WoswbL#(4y zCkK$`PXxcgA*-ol_#aFE(|lcL)>JkhF1gUAnEj;p^$s~|TQXUY0;UuI()@oHJ`FhW znmPpjm@hN6YyLmxPpyjQcZmO|_or6H^M9EC@7$k?HNTAczvfS^89)aAzvfS^89iM^)g8kQbP&JGT+zjvzL+6uU>+cWYpZ~A>=waLb?-x7UOxR-$uYWeyv$Ki+(NFuM__N#kfA&>R ze$N4WvnN_o?Hiu~ySFDkpT_>D!->7z6Yn|L?GOlfB?SGEfBqGK_7ks(HtGk~o3pXm z{eJ&{>mNN$EoF8%`kzt2(YO8II`V&y^Iro0CGcMY|0VEW0{{021Q^);h+KGxC~@C= z$oaiHmT~0zw9eKV?6SVe!BBZ7lHaW>SigaZK4q|%j>s_)!u+$5_LxkfRLB)~Y0^F}4`ee1tWBgj;_mM4onJ9YYzS3CeclONW zowB=_Xkf48^gG+B`&ZF#n4V=oN2Sr<#taph=*Rin4|dHvL@c$CNKZ0K!DH>p_j?`5 z!xOXLWmqaP(OcVvOJro3C}0=kqQFijTHlwg^Gj(d<@i$;C2d?_#zI`xUNu2rKb4&u z@Z7tb`5Ljn87kYyO5gu0Nj>?!k^cER+1N%fHB*C)V#tm->DMZ7>7zGZvTWF^q96lv zH}|_>qs&Bs534;mb}*64XS$>v*rg)R88#wE%^@vOByf)r9UZfJb!P-)q9H~kwtTN0 zQR*wYMR4a0Z0FA(tkWx=;tBKCM=}kWXync!>9npg@>3M1u@X<0yj+Jbo40rE0DS(ny*;`U#!de+ z`{zrrNB+}7#V%=T&R;an$xYW`A@MIogMGWHIUmMOYnP2TU|F@BizR?FDM|fg&QG{s zH58fJ5)Ut_;$ap3xQx+Z39aEoOyoH41Akp6iak2F)<%VilAV2TRl+zEKV7Z9yq20n z_{a9^57g;MWMz;;81Q?0vcf*b#g@=hJ|#25J{kA2Na4Spk%-Y|ZEHSb!9+QI8@qb7 zA&wUh=IHA)k#jXyT-Flm{+HMsKn@P ztxv=pX3y03HD;puQ9C!SRA-`-3c<$%_c4*5nL$qKN@~t+lIcc#yIE-emk|RS7#GQF zviwjHdMxxq17`dzs+bcvlakbv?a6p%7Y!7+bjpTEDi?gYJ>3-(I49Ms9G->wbxS)~ z8ZnXMvCu?rINndT0L!F3O!V&MT+UG;Y7T)%XA zvSwS`-k35`Q~%1GDnA<{0}o)Azn_l#arOv*c8tP~G=5xCZ_Y%8SMoTo>H+8Vdycy5 zFwvL$pKNUAQFCs+@>7*xj)nSrwEVvqP;)LR{QOJ>s|;7m$VKbbR!Z$tOv zB5Oi#-%b9Ufni*wIo@Xj;prgoR-;TsuGtpvhpZn;JHL-zv-uGcz4*p~4bxDd@ z7dGN$i#O7l=;E&$e*^GGYpl4?O0b6~rjl05Ma_BFD9zDk6AKBOx~>oeKasp9%heBV zW67NjSQyjnswi+KC8;OdlkqHHE}km(j!w{}w_SdaAB-925w8vlHDWKP$>h}>W+J!I z#@B;pOf=^LcWAc>6V-`qveBAO&EZaWVUF}hI;vlPfbT4DJK=iwdE0wBQ8IE(%3mWG zlUMAwcvyTBlMnq|!S2CCxQyVw3zke2{G|4EogEYH?%CC%_;n8DI_0|{BDi)99d&G0 z{pAYdJL5O~@vmVz@pbxbo`O@sm{d~Isyf>;%)s%qc0YrOHk;j3mj^%kaeXvuf${i_ z7cQ;&DMZVM7t~A1pZ(YE*~~;Agl;Xmqd^_dan=$Ji>+BmR`+|=LugO(nk;9> zF0|jipb^X57&^ldIFpjplkLfPjvi{JYu~jeUbd*ciJTRS^Ryk*Eq2bvpGMStvV`#& zujYw+xrB){TSqX7(=+>+$2J5Ul zI-_S!%{h7+zNw1ALeF?}26G_3NM4iWQ#~!0O{*KRM|1_o0^m$aQct!gIe)P59NQ9b zm`G2-MfnQtux?TRP(!h9OoyNQ><&22J>K>ac|j%;eX(yKN(kz@t?4XZ2Wk$_ea|VW z9iyYUhI2(`EQfVxiAIIrnZrcU+F7qoye-7`XIyqSEPRBWN)=TLmu8}QW*tAitYV`5 z`Va2rtzjZ_-c^FV*3|uf8oj4+68xy)8l8c|_@Z*(ZMHafmRWe!nuK8z=+_It3;7m$VPqrsHGjqF~7uz`y5+BCb=biS#_nNrhoaJ#F8+o?D-xxSq zdY~_v0!(y3*-^W70TZdJc09>BLe1gzug58uedwrf^QYmDi^!5=StfM$NE!?;|RTrFA6L~UNQ5qB7O8f*Hj(8Wxo z{eDTs0v0uAc?Gw#cfDCi@`1O%;!lKRP<-UX}fxUw*mNf1_4d2$6-LdWR{wt5 zwTpDL_1&-M{G3cw{r>LZ^BWxrsjp3;x4$Q0@1rYDR&&>3({zK}B_Ph)T@B99NQjJIyeuex5nFLQ(vEYq z4lB~z9-|L_=Eyhmy#wQzds%DmE^es*Mnj2Lt&OtoNyccv*5`OMPDq zHRsZOop??h3pu#SUN3`jk-R2LZ1Ec*XM;xUaju2XL_Cv{)RXPWywPRo!M=3ViI}+# zH(%-MiEVp3-qhyZg!|^HN_Tu=put~QzQ9`sN`D%OuL1d}X8jlOJZcVAZ!wkEH|c1W z^z7$Z!wj@wg*IExQzs%$B=V-LlOcA?QFXPb$WhE{TlSl{nM~AolUrfIHwHSvJNuE@ z7z1s5{=s5#8g>5?r;44nrqGc>s$#~BUks$Vc{Ft3jT5mT|Kw612^VaJ-}gIx%L$z4 z!6us`_`K4LEk5i6107g#MP1<|15GmsS-0XQHRsVSKRbfcS;%_v`|=6k!YRB=ux_lJnf=t%>>%oe4rCv+GSP9W$*ic_(E546l9{vFP&<108z?IihZ`v2|-z-ht#CIU`g(FL)a;f{z@XO5I41UZClT0#w&p-{) zb40&XI1?F%EO@srTa0;1vu51)e~KIQ+*vp869ZMHq>5y|W}yBTjl1rFbXU;Xi;Af^ z|Jri-xq2=Ou^+YBa1zEt@|r9Q#&R`yTpBU9u`0G4h-Xs%tN-TgpM4Fyc8tBk2Wui%4cY}5bd(xn*5@lVv+=vK z#%Q|VL#*MA`0KW220E0P!v4LQf%bRPL$vCFbNBW4wV$Z_AA+>x*$wA|Ui>F4p#9R* zH2Irr7=*xboI`%ad}^c_iN2t69XJpG{okAsA3?8jy=RcEd$NVpsn?MN6n#CRsF?KJ6spl z)%6zxKXobPZu2U1Aw*A{Pf(I+!?iNbFVRYTioJbc-+ck%_tfKr)xnP$2)#E`Hg9Jj z4&|Z6-+QS0zr0jXudJSqwx1JqZ0&?~`SRm4w~Aee#~Ij`*h7`Ld_vAk=lBZjWPSMJ zuqO-@z%lr!1b7Q;d*mg7J%R4xNyRUzITz(f#~HP-5ceG2XWv_>IqQ09gsVk0Vzkw7 zGy@=>NlEG_bM{h~dVTvMgP7i~9O!!M2+k0y)9_<9V<9aUXZ|c=Ajc$`RUA1Cw2QaU zU^tI~9_yv9TE)#nd40h2{i}Bx@91crc-nb7#FvR>$XivMfyUOn={^ASg|`2oSJoWr{_|y?MU4&7k&N*EdE4$YkiE3c zJVpqESW;OCS8KyD{nQ8j@A>ty?4fzL*a(;(8`phLE@Yrz-0$ZmgFW&3r?dy>ETbI% ztT4LLs&_2(p|CjI=?*n#9;X4zuG~hf`3lF(65vcqQa_n4zI0+L10DTI9ACMFn!^ItF*VvK9U1E-S`^%1 zpb_KE>~qGzkH37rny#tDG?V1zzb>!F&nV?Guij=L)!5}OD%lKlWVF6f9{duJ&owe6 zMBV?LaH|71ztPdcc-fbhFuu4ehO66tF^Hdm--UNw&BwCGwD>yg-eK<^J|XbX0C56q@Z)-eoz)QXYmZ_h`D$p_R-kwh9%?; zQj+?~oY|w!;zI6BA}nLE#2Ni$TvD5LZaRBD_MzH7-ZTlg+RB&_@eIV>6Qn;F3-y5C zi_nKM)EwlWY_nQF+Zwe@=XJ@v%s?fPtEMG5Fo{nc4^&?oT*d{n1+rJ?bmK#NhQ2GM zKt1!SN4^V=bH-t190T6BTO8lYElb`1)0<~HtL9iEHGi$RjmZpjc{D$>o53VnT))M3 zV@bHLK$q=y*J_-&o%K}v8UsyFW7=pYFi^Drt#um`q0VDv(}y=vbG}gCb9rpG8(Ka( zvU(WWle{KN`KnQIf!0Q>ko$|nS>Q}cQct!g^RtJ2p6B>0CgErOQT6JEXzZ)Q2cz98 zc~~m{f)mUL2J*N(aI7VWfwE>ro4h;0KqtM%Lw;ybbNHztu1qYmMzOEEmfj73x|N}^ z+UNu5*!r5>Cm*dV)O1tL|eR4%}TujrZ@P?qA^H zdd=Xa)~Kdwd8u_I1NH3GWS4x#Bos2jBIbsq;GQT6DVZ1IyD!{+UVzHY>fb}wG`4e|ylN&RHb zf{GjF-tA=(D+cUo-^RRgIW1b)+kvN8w5`}0MO6lJlUb?NpaODm^X%eX4Af{a^YR{o znge$rJxR#L8a--jJ*lJ&@m8pnd-gnwxW46*(WQ)XeCHD4o3Q3X{E&^2@EcvIx45tM z8|yRBqD?s-5?Tz@ojL!A=6&k^bvT2#I-vh$&-+_e!S`*ak6jljU=bW`GC^1Fj-Mj8`M1Zd%C!xSpjEMH>*=~ zevy|K@3*Q6E1j)op%0u%N$Mwa-q&fchF6b87_nlyJoS>X{>1G`ixt~26;~6V01K$& zzFax;{2&AQ>EvxpFoJx2@bvm^m#8^xm9pIPMb8?Iyxwuo*aX)12jdBggjqzNY0w$f z*H^Ji9!8r*jgs)p;ko@|bOySry=iwDje*MXxAS&eL7i^4rvJoM>i(0q9e8be&>C^F z-I;#_zIWO&QT@U;7Ln}xP^vWk8n!q0(%{1nWmxj(ss&}xpV)cBh!%4O8kG(jbv0$6 zmtC!X2QO1|ew*99DBaKvMTK4n)0Oz?b+#*soJmRQCvy%6?n`-M>Pozeahvl)#|M*to7pE-UX9fT=;WCDGEf=^ z+nS#+-i_Pt$vp=SyS3$x6x&jBc*dbwvu~p{3XHlnbHQ=oc(SBr%??+>etqq&2)AM^ zX@C5?x4Kn$(dp_vj*!2F*KPLBgyYnu^&AoNVW7~2po&5p>i$np>slNxWsROyeVo7W zECX#i6flQT`pvPv&r;fd4MN%J(rb?0sMH|S+d#Md+) zmr%__J^EkR)elqm?{V!F$MAg`%Hl|C$*N(Zf|>7ngXN@&EvKq$I!~owHoG?$y83nD z7dTUjc2&Xs_7Iaa&JreCrzg9v>OSn>SW!w;lvP^(O1G3tw4HEE0=h49~rS zZGFAF#98DeE+;25n);B5^4P18D{!{!mA?JF9PT4{R?TYt3+L3_@cTNYG*msSNNXJY zGX1OtXKUzcqA6)!R65-UnirJjEm$oS*lvPSwvYjU?JD+Q*q!-N>Wd@C-d{*z!mfFYXk@# z*TA^qlODLihdyDC)_ja5T=8oN{O{wVX~_?q*ItP|dj+I&@R~;-ys0@~SSM8G51jMu zcO*Rpzf_!Z`uRj$fY`wh(w^Bbf*qqxOkI}LG=@ylixdO zdIu8~r72Y#6L6oD!`AZx#4|e|yM_RRx_|7p?q|VD8oEDFnD`AiTG`*@JQ%T+=-46Y z_5&-zS6F4q?BHs`gSHCac7k{=qbogL1>?{N%rf2%ar4!lZG)&Mbv)m08PH37;EFc! z%+yf+OFY-(>TqAY0aKsNwpI~1laka==A7#6t#|JGPD18WIm#0X!4=vDKUUUeVD@Ih zZWqCy9CW`8*||)VT^MwIPZ1NnUN`bw>@Ru4p|t7eEr{p5mOG1mA)ZZ_Kd5X^-bqwu zpZ0$BG6EkoXn)(t-GE1A)@;>iVWJt~8E(1YPxC_M;Sf09YtHC(KUvhAI~^Crys4(4 zpSt1x8zKL8sebn>YT8NYveD;MdWYfT>kb?p;xEAWcy<05u4ST~-yi9!rmOwSX(@0fC8;OdlX*iT zVoT77mm;yDD!bl8^gM1ZYmRHaEyaf}kMGTb`HZ*KG+oYz`OUegau0BuzHI|i|4Te8 z#AMs;fOrm-NJuybakRVS;=?bhio{Uc=sN*v2EOG=-2J6CRk%u{mgO4A8&BT%EE9uv zv-2Wu4}e{r$NYZY^`PdQ`uW=SD|Iwf)cl739>jmHYSfKUD@7vq_Vjn(p8DWt`3lOb z#4B*Cm^1SBb?`ZFqrr1n$18jf2t@@avq6Jg!3A$RPG$`e*Up&ndhv%u;;CP(FP%97oTqqi_?9 z6DI^`%z?O=Ij3w_@?YZF!uXKx?1waTxA3{e3aB@9o;WBo52_G_84T{v;+Jt>=PJdH z)@EF1-0)g{1LWoSsO-a#KTC$#*9L%JJAysDoR3g*R*lhRe5s+K*7oGJ+aaGX4;wQ% z=b%FTw7GFICN%<2`=)32apcz<>8QcHajB0to$W=c(FEL**f_4=8S;~N@WBIXAaA4<^zL`bVxroVkN#i&63_CP)sONao)cwNyKX>U4_nZi zpi`(yY%Anye*cxgY&J=Zb+9*JuNLN{R6%~#jPYcD2=SbA&F#_=$Q!a-+pn_z!dZF& zm-rZPPFlL<@C+EAZ_JyZAJG4-q^**zYB|{Ys(|7jQJL70!&1Luzz+`J9{e1GaYSru zLkx%$w&52SWsg&H-eL(mBY?Bm(~%NGh<}pTWZ7=>sv!$Fo9-*y=n0%jN$Sb=WZnog zUHI$CH+8~%no@~oK{$Rngg>riRx2ht=xl6qn~8#MrLs-%bxhO>d2y48wiXyJdl5h# zZ)acbIG@)J`FURb=!GtcCHU0tnJ3`7BcZK9 z-#f73eb0o}!sp3*=&?-@Clc<@qh#SYqw5cyHt?n9T)Z^SEw|MbMclMnGIzo+6tC%t zLG%TV4cM`bRz*#4eS?&wp8Oig*<+#q<(R!XME|VqQspj@IBjO_d)I(Y?CG?b3cKA=`6i8t40vh|4P`LV{r$=(6~m}G>wXwq%F#nZ8aaKwIhnBDe`*`lGteRA@EO~! zIx6r^M){8?o6h33K><$F92_w4?O4H|H65re}bU| zaQ-x7iTn`Qx9OEFUkav099UN6Al>bZAD`=@ggEQ)NDsY^O^}bb@|K8ShIq?ay7p5O z#Pj}ngD)Nal9&9vmC|$}FP+?SC^Zn~HJ41;+`a3y2!C407m3*{ymXPb-SX>YSlpTG zkNLrGN=ki!BQOtVtm6oh1a3Xker*2`K+U;p`iJp*?XGBF$`h?(@C(UnveeI47iKUU zFnPy}buGY|l%$?)PjXh3eg?K}7k&Qo{?>uMnWZ7&_>>-eBc%oo_ZTj|(se0_^; z@)7N3tk$GIR2ewAimXzW1`f@kH|jEgciZZNfvYZ1_g|^>A#F}44Naf%N_Gx#h!VKM zdizP2(A5jORvMFtH{ZsNs?B(enfLx&-T>=&Ro{HY1J|MM8T$NY{w*fDCi{No*)VF( z?pYYX_@PpD3`BZ8Wwe$37xIZ;+DIlkG{)2QTWJJG0J!crSX~`;~JdepT?gL7n4MOvaAObp*!s)GhF8O(I;6 zNq4s&PKNWt*cA2Y@zfl~X}r#5FKFn6&&@~Y!7tlltNJYj4G5$8)~^?{*JHzB3wR~? zTQJ#{9LZ5wXAD;U40)Ie*EzBsH{SuyIex*>U4NM`RX=KG=)-(ja6V7_F|=11-Bk5) zg#j@Tawg9cFPmNI3Tq;$%!*w7eeThBCMBsS+moE%wvXskCK(bRFD}{Yu+<3n zaQM`-jqfG4FtDWR6~tr0#uW=a;+g2P&8UCuB_>iA;#u%Cg_^U-tGVjkZ)qraj%vML z0ux56XZrEAB4|4CkxW#QiYZ*TcDU?_H}20L&j zC8;Odlbplz_$2V1#>DJZ{JExB7|t~>+38CAbIeSldHZXK#|8S)38s;-Uv$C8=TcFS zPe=L^!}F;*i-n92yM3i0wX-z?&9O}6bZ$tt@@piY z0&sR|_!`v>{#c~0q3{I!dN%F!=hRs0{^OH%oT~ewZk(YustfU!_APOAsf;mEd{s`) z=*T^6mXTkhbZrl&U@zY^7xFPK5HPp|#$hsaDaRX*P&?#muPN2%Jet>dE#bXH(wW?Lm(Y5Ukz3EBl<>@I!n*A4K+d zV_)YySmzDLshYKO$Ss(O_8O+Bors3#XhiZIF`Sx1^wp|i$6qwW(HLB}2I4<1q|iw)SBu!xRlz?qb!ellks zn-5P5HkuK_3+~!m#$3fYjeihT2y8pefF zbN+ckaM#Z(@ElNXa%ntpCMBt#%(*W{!oAMhgxG*ZJ4AMe;&SJ?E)L?|n44QxohSG+ z!AZd{{5)KTkv|dh8RGi6_JaB}f|^5u3EIybr=j?KPc3%vQw&M)hKn&jVI8gVq^7_OeA6}Y+~pD*L&>p)ST&GuB>FOW+8tgw;4)cKgnyd6c*CA zZLDj+(i7w)Re>`pNj=$~3gtkk5tgI)@>TCN4Ga8Kvg1dGWEOAH^VVypfCJa)I@ylK(}R7L7>zfi1ty8IKM4 zYvsz_eurJXmYm7(h5nm{5mZ{-Z;a3yUpVJ7kR_;9U^Z^%imCQFfxdV@DZk? z&MPzhRDpx;E2;e(9IOb=x+43<;sw}(H>Dc<+V8NI#lAdMkiR|a#D`adKXnrV3)cC- zbMe{)S7i%z{|DAO@7cyfM*))a zyWS6;FSpsoc@}tmXRDgG0=UN(KC-TOO3m4rnC{fQ0G`t<6)ji;_L96N%i1Gz)1Tjg z=Z?Fp)g8;=x#NE%sVCc$oE^?+^302|B!18&zMg*{i@6HP1_|ePVX9AeNZkew-AUyK z4jzTPrg)W=2jlc&Tl(Z{4>gDI>pnVa5N{f9d-bD$TZ`zB)_}hyp|&9SI@|91c;RsS z+oE$l*jYz~_T`Yj2X=2gwc|A0KbT#iYUvN>6D{jc9IB!2|M%||%%G#@i1}LvU|se! zd9KACW=Y%)jU7IBG6N5s{jQh)ayMq;q7-om*1fXcxan#q;QCSGRx5v)KjMR{ZftC& z=KNNtP}rA;gZImyM$1C%xd0ti8MFs} z0J|=Nq!pIewjaYEhLPK)Y!3+uDW_^j`%?^+PQLKOz*Ctt%Ab4|beSn~|KeeRK-3#@wu zaEdE$GJp0O*Y%zOoPQbM%woS9&1i<>$fvyP+=FsA{-pZXtF5kx4#T=o<~S6q_#Tgt{v@Cq_89%bXb2 zEL{Kmga;n$;5`s*`3#fWEx@+}>OQpx0S$)WZ%OVSHtE3a(}3>q;#z9XYy67&&`cHz zHTSz;0)8ZUO_s~?x1uHK4OqaZ^3A(|Gbu?u*`DN_v$r5SCDa^!tQk6UH0%^kcfFlC zSX+(->32Mkfx5F?@m?!RE; z=n9kBbo98kN303_@}N34ZLhyMs^&j)|5#rfrhc{f_(|O??9|uPZ2=I^?nVB|>M)LG zfyV5gkOz+HahHu%Q*&mjXRKh%V4>)X`+awV|4CkxWxM^_?*>;Juo(&)!m5b(|4LF% zwkJ6Y?aSiqinT!O!%9(^BP`sfQvLh0dmY%AVePS75Rdb9dG_5p#zd#|m))Gmb8FLX zI_;^W=CDI}llEdxI`SP)@j4Id$YHKa4p{*fsIu~vY|{IDti1EUBm8|T7I4@s!U;Io zy}hpV3pnIR9^_F54rO;GS5n|YP%(_Epv#lD;7Y;-1ng-x-D!iB}0rTbPv<`8@e(L^*SY!I) zi(wr+WxwSxaCpU9nyz}-66sx63OlkS3Jb;gdn!JsVdL|+b3X*XJ-amSY3;#8Hxyc3 zqCuwTmrcv-PBcqI*8;oSsvZBXe(!a16IZ}5+)DvOiEHuwkJ6+ z)6dp$(6mC%T?d2LnOwm5`Oa9~PH)2b-G$SFA%1UM9QXWW59evNI&q#*KTmgEvN5Wc zngfx1e(FVi34N14G_xHC#IhJP||J>*Lpo)_K4 zP|rjNs^lFSFG`+t9!f7hvHbhPTlds$QPOMA-2*adP{2-o>}F73Q@2+r$1ByIOFXQEYif3)=dCEm8l-pf7@@isOsL;#2HohZ+~Lz_WEr`H6D z_Ltwol(EuZVM>h{U-RA+Kj3=s`96;aFkgH^g;xfFT^6&eI<|hN<{WaY-uIdW9cekd zvQL2c%;pkw+92m{O_O`gXdYUEU&mR|On810@X66FHJUHJxd<>_Z1F6{e ztc_=cnls&~Lg>;87Frkeq(BDZgyc0@wq6TJJzds-nHZg2xEMH-lGKy!NzMyHck#5q z^;|U-G~aT^DXf^Qq*uwS6nEYA^4oQ=KQ`O&Nj@E}$H)l?h+4z%f4yCpFzX#Phk5l2 zMOVXl@hM)HuikK;>lv+ekMk7`74vE7m&e@2_M3QVY97CV@tj(vBnI>4Jy-Z)U+DjI zhDWtK*yZJx<(5B_`nk4C^nS^=(scBQf9`QhXutmcsj_!{G~{31z*$^>6AN9j?veV{ z6#OA;XVV*qUsEpC=y>QqHeGVH_QZV5?h7yng4>XrlMh<|W2qI?YQZ4Av*M z+S8p-2e5xV-Z>rCom)XZmZrC;IUlE6%>MC#hUAwzUFL@T>&G?}I<(US84mWRCK+d8 zP06p_<965JORhwiC?>!>QKCKm2FF>X9R9QhuDd=lH|J2Sr0#z_eT%>`4mjWB?l@?8 z3F?)E09zjD|D=h6%uVk=Y%@>j8v3jz%sk4haW{N!d%tJo4XlR`*Upz6426A|UtDq; zi>W!6oKwFb_uUowwN>ck{pETc=XKA-xo}-{r`Ru|8seFhq<%8zydUp(ntw1wKCKel zR$NZTem-ax3U_M31md9thH>rbDv)KudLsGZZR!HZrzxwuv}=p0Ig}?}%iQ{%h9r;f z`?YSuFL9o0@n@!}Ip#;J8Gku`pJ^!+{ka8m8RIq^Nrv?`7A@Kd_H3SB(s%>>azMFr zKHpzBGro_S831RcO~wu%;XLYy(%LgTgQiI9lkBtUW|{cNDQj)foEEG&X|wVuTyNf* zH1wez;$$XmS^YB@4_kg`jsro>Ii^8#=ALobk96LiJrwLGc}(KSw%aSfPb??&k_ zz?qb!o@`IX^NM|isU7JD(1j~sZyHCR!uX$N)%~3L92*r_J^~J@05J_VLF>=O9jZT{sxfmwW)-`ugfZaY_R2F6LvdY0`t? z2Rw2eZ$KXMJN?=Tcu5P>+boipC@#3Hfc}^J2;X|LLJ$dfp0zHRZ z>i%6lgl@k6OhbigUytX*_?}hAD{Pr(jOwIfF4^$j!Q`^ce=s9jFvhL#jfH72e)MWy z9^|8Jr>@HpWua{8RBON+4{SLx5ZDRBMv(I)vY;PvJ19NS1Z zuE32?vEd2S9JF&vm*~Hyq0Sp{{|vbK#b+$3G%-Zzc>T1n2j$qpO)a7c++~=LjH1}N zEV!`wj*=k<{VqHkgUhMhvD z-Zg5@q6-9Onw*9ER{E(|5`Z%)N&RHb=4D=D=hOEiq0ccdg`*gFt>vub5b+x9aP6H) zeVCV<&c69R1LDokBjma(jB~~DPm*QP)Eq2lyttYJ`!}qj1r80vI=5<9Kq}+Teq=mv z_qHynGW?Tnc-8i&O&Cg*P`{E3*8$6(KG+0#+FU-1O&sF8-%$QhV-j`$w#tW`M+Ruf z?fFiw>yUS}`i4f>a`z*hQ=j*I!*lWJ7k2RMWz}OR-6c+cPY1uveU`K=5zfDBRu*VN zeEZl7o~ntb=G?z3)n5nhcjr_TsntWAk-R2L0^wLMJxLEnfz#{Q%JWWXSoLv&aZi|ue3}bJrdZsKW1+s-c-3E%saOdznfSg(Rmy8DHwRD9fIQ& zzmx9WIgziWt|qbnWxm{z(tk4ub>hXZjY4g=;JKtzh4Hov^pVH<9!2G#>v)b^@Hwfy zIIeT8@qT|c6V;o}j}Zi3vxbYe9EADO-}+tgNengTBYQezH}|_Dnsz`Z6Z}N-nk>C9 z>}r4D)qn->HVHKY&ZH#uWP6hHvU#@*t&Zvwf%pad~WiqBPPY>;Qa7{IsnzK$wg=i1#%aZz36fFYn^RLG|*kuI2yegpL$+xBo z)7aUQt=~)Fg;>Zl#k;T%QROMC6!>-?v|jcJxSZXZe0J;-b^j~xy!aUg_44L~_s7y; zJ}5lCbFkh{7wx~srs3zFhviofMu&-4;zp)rkK6K?NN79ffh>sQYckmJ>tN4lVPRzA zU-lyvCqD`)g#AdlLz%(WH>o*W6-2PjhkakSu1&M^1J0x*^^-XtJhh{sFhUcp%n0Sq zN_4>_BX8tA6wAVL#4pd_%!limdM=jpAp>&>$(n7+U|EuJUI*s3ns8C(z#Yb>Jj zHbY)+Q<4#Kgn75=*hi^Nf7vfOR!z(w1rGUZ_s4C6c^6Wc%+=SVjh4(>Agy@s4%VY! z^MpsU1sfF`7B7MKiavKzJqqk!5Rc7#Gh&4JMEQ! ziRUAqcmDM3g6Dv4nwYlUnaFD|t(Lf|qiD^f$}sH=jAMnMehv zb>_gn{yOms=3vi4C++U+v()jtYECqf`N$Q;-cVv>L3@(dWO>!E(`|!&1Gab1z#RwR zOiEHuwkJ7H3k+{f9o>UW*<6@Po(b63S9ea%<9&v?hN}nk!Z@$mjemFx`ArR9n)U+X z+4-cl$HTwu=WmU9xhxg-^Vfy1ERcgZJ#uYFgQJKl3K5Yg$=FtcZI9^QXRDNjFX~$^ z$_05N{ZrOlheCLc#hAuk3weWIQ$x($m)ehJ?95w5tu%CS?p=O+m=B>_Jv#ijRT0OJ zd0U#c=VE@e^B3mxHDC*_(1t%kf5ZE|?`1$-ddHexGJyF>yliL`^rPmySo4NWR+}qY zzwz)Q-M?`5NUOT?*r@?)^yJL+vl;(KwxsY4l+XjytQQ?KFAwy(RCIKL0$ zIj>@N9^x(CCD&IC=G(T4*04;-(=3ZcvZv2bb2#T1C?fh)nJ#eRpFRj|Kq-Cfzc;Lp{^6bgAEp1n#e%Ig2J&wSa9ao6Y; z=-=&e)gjg=PEiVISQj+?~oL{G`u0P|Y zfO5F!r`0U>$4-PSd46K37t`Y1;JyazNVVhN5CnW*it^G1V1DaK4ZL9eWgXm>9drLf z8|>%zE1$L*?30?scJb^31>`R?*T~SU3_Jhijd1+A4$SA})!L_(@O+8Gh8}6iqk^Ao z-*JLpzq)l>9q^&{>*A$RZlX2SEP#$)c(Hviv-HoZg z@VM_&2G3`j99A}iyb-fNulFl(OV*`bv;E8SDG8T#>T!5JrMSxW>%{ZyB(KRb_MGfZ zQFuP3Os`OTF6`eRC8;OdlX=5Dc2;a&SXmFnc(_!;7Qdv5p1HQv-5nzhu=eu3w7{BDbDU4(pKP)vKsQ7ex=KQlYp6m$=F zlK4c+Ue$-ihA|_KHpBgpH1kKNAdbc6=ow1XFwqWvHS1Y_>Hl42~!7Y+{DHDI+_%X*eUJd={tlkG{)XOoQs)Va2x zl20Z5x7*`z9lQG?Vr%;`MP*r2d$8kj2$o$jQP*yt|Fay{ozMdxoy`8i;iZgft1vtd zyYfIgM=IErv>fY_7?wr18h_2HGHk<|G-Pj|z0`wk`_ZN@4IK90^DH_B^;y$X|DBBx z&*pmWV%i?mew<(S`hhk)r&-hekvIW)p(-ao;O=)>q|szknSHh#GZjxf(RAk-W_SI@ zd5v1wKh^oJayf7weu^$lJU=*UAggZpm*)q6dPX;Gh3DGpj;Lvc{e`n0hhf?xc&=^c ztRV9ih-Xrg`pKMk4My(Sko+BsyRxLy+{zliUioT!nO`q<^sDL$ZHVXhJKed1Ag_H{ zBWuVB>%yLS9`*Kr$qe4KZ~#cB>1JI&wy(aogMM)~c4 z{N0ZlV4v)~WwP3^9)_!Q9mRp$vX`DC4))ZXbtL@9HQ_mWS`NpVeGmu6myW$yEIW=Z zl0Kx#H{%Lc6RV@b_@>UgfbIs3pis|HM*Yt_b7;7m$VKbiCL+EaTL8>~RFKDugRI^Otf%ldm> zH@Y#axh^Y}fs?M%dya94hic1kzGE<6J)Y?NBY$}wwiV~EeGTz^QvL`3Amq1>Uz|Tb zo32C&4$oE=on+!k8?FiY$~55*P8}^$Yl8o;$@&7n*I>^bn~07q;5M}Vy4zhRYR==+ z7p=1|ry(uQD6=onUL#2S`jd_os39Oe&LR9LE}5>WAUp34R(CPqs0{qK;?fZXCh+x^ zYjn5uOrtuBcI1zh&b08c1G~<%U)AZVtft<=y5T6aT*nQj&VI zJ()Ky`hM>hVwXbubYdPozmG7*aQ)RI_a90T}u}xzjor%X5JiuA)b&Qyl zCpCxMCj+0ZKcFG}lI`MrSl=#P(63Jn*ns%u@=G5F-o+FbAAa=3F&jS@RIr>A;(62Q zU2OLujxVpw9F>Ln)7g1y*K8N+{)c~g+&WMJzrQi}S&lw%_OUx#J5aF!ZEU<+C6smp zo0WK9!1>W#%+C7ULLOKLukGP{*adm1tvUFv2yhdy;>}(9m*0hG{(t&9^Kh!ZE{>bW zU%Dwn5elV&$W)@UGelG(AsWynGncDWBtyo^Os2{#Lqc&g9Z98(!ueqw_o4aY&6tDGJBd7) zp9xE}FXbHcaof{1MxH1s%2~BB>lT)^@Fd=tr4e6zZ2o#0ba4hGbv9Xpj*(2pUflzr z!_(kD&7pCeTvrEncURWP*rFo2{f`FxXy~`h8o38*@SbtUvu9OiR^!>{ z)4SY3uZ=Cnx9$^I+7|lRbkNxenZ7?)>rCE%*Ylv0pA~IU8NWjDAJF}&`Z&WeqT`87 zS@c%7J<7nYHP>^T7Jr0yhQFYcfsUGa@%x62L7)p%EL!aix97vLA$ASjN$(J)#SM7)2lgn z&{N*#9W1ptU)V)c70{ttUU6jqWk=A9+%N6D*PVv=C!UGg_>gn3J$z?U4zoqEuYYry zg6ux9jg4|YIc4v(DO63 z2v@mE-hZ&;abH6NTQt@D_5Kmip%U?l%W16iM3Tq!wd*6BYimYiAFDY&#%Jzo(1$_S zNhbY-+BX>Y^Oc{*3q3$Dc74p@rXX_8Ki;vcVme-Ec3t-OLHDszC2?%M`sRSqR#)0UdL%00Jn1z|p6e>*r2JFS2yGtj*qKB+$r zR*QLcrBMPohyUvK7}=st>vrwW2VJ$+->cvA3er*TR(RESYW5qBcRIy5ggcMC|C8;)MVTjTQI?95?>7e;8rd7QB}RdchNGMH zQgqWWjm>Hvn5ue>THz7Vos-Av%4Z3P;1H7Zpf<4lF|Ca1ca?XM>>KFEyd%^S7 zX6r+s+eYwOY6}?RV_|}=SbPjKM-jY7A}rBP_!IGL@QwS=xjs4){jq!dCayp{E#7f_ zp*0&fc$LA!a*&2HVrMlnv}mZ5vAMoqjfNgp$JbU>l5-GvA{Zd*Y>UEq6Ir){PGCey z)91=7bkq|cwqAF6E#}|tA<+J%SXec{58RDyW<@VcGL042tdA%f9 zkrWTsV2qrDT5*Yi$x2(4c#!W;Q#1`(e&C*b4bLC9qr);EgxKOte-^ZaVuJ7sQJM{M zsi1S2Ciuq`^e)-Q?5AB4X-MO`xqqA)dH?^t&q~>%pU1yM=YW6OtG6^OShtu>atsI@ zJAp+BYe`my#^Pq2++4PxhpKltT+<))E2U`!Ihvqcq9;|6P4s@3Md` z= zJ=bGvcaK=?B+)cnDrgZIEJ6;+LKl?9Co$l}O-BSfZWqC*qm6 zvzRM(7JlE21+vRDBJkuBrmyOf%CY9=^@f%V&|?(T(?6I)L+Z@!yWYUKnOqtB;|0k% ztXhUicYcRF!~LstyMZImts5V`N8mmuVxX{-r5sz#Z&eO;sltx4UiWFJh4@O|$-5l% zi#^x$F--5k?^<%MS9>dY{~=8QXXxxO|Bqf1;41^&Z%^O3fUh+4Nb1wNWmy?m>m9kk zaJC1S^Uec8(N#2b$*8A#8|W%~)KDan;W!Mvo|P`^$T>HU4IIe&O-Ik`t8+Z>l5<}F z&ZH~#Q48b~Ex3IF&V(h}mvXjnz^b0Zx@S&`Wg%`T6f+(%G38iZhs|DiDs|)`=tNcv zjhWs9{p+0SFZXLeKc0^#osEN>L-zFqrw^Z~Xl6#yc1V>@< za$!kZDxTqrY^D5;FKNguCtyMXry-mE#*+CuxGrVE=3^_!`*$i94)y*tvdHwuvndrjxOL#SfZWqC*oPlsE<(+W^l~nGTs+4BW5Pnh-FsfGe&{0X@j5sH2l6b z3lhG_Jc0Xm=dZE!NpcPakp6a|mx^jD;tdPI|IzEZxyXM&*ZllVukFc|*l(L3<4^YX z;A6+v%W8Im9)Bt&TCoY9Cq6jlu)d(7B1>21ufNFq=lbDMIs$bTTy82g`L=*g@m%~;I-5$G*M!n-D<(s)m6840%yV!?SwxO&x?HL*d>uWQj+FxW1+-j zcI+~Fu7?xwK&7qSa$~T*SK4A#-b+KV9^Bi7-q6sHO?U2M4LOJ0Q9ZfE`&9IO`uWR0 z12i<@R;n7W=#CV_N6%lpP>iczYC9#ey91xi=%}0;ry;toq3u10yL6fGPl3ar>)o}} zRl1kF|5;yYU)|?a$ot&M$_Mkl97S{4>z(dsT7Ei!ohu&C=0CZEx3B@{crRN)f&Rbi zZV*;|M?*#)$NE}eJhG`=5&TW$oDCH#j!4$gk*iYFdrtVh5xkb#xg_yQjSDT<{H3OI zmw+>2iFU%D;2e0@%q}d$4Y6KgR$r(J$LB&$-4L*@$5&kyRY-&TBhJ;s(ELb4+KYw8 zUq8crCuhc6zJ#2E{IW;74TV%xrV!zf4Cnb!*zl#RpBu_O=gR(!xf)ZRX*f(Y%rSnw@%BdI8;a8f1r5%@Qn&8I)!acTl)j_d$r>HW~1ED z9B*JrQK_KSwv?bMB@zQFTRam(wxOwv$+lagTYH>eA7Om8|qtKc%Epq4>+(? zaej7s=!(`3I(4}UKfsLwa+qF4bznCtWjFh9L!HhU%2}7+G_<16-b)3J=XkMhWlu3V z=b~%eVoe29G%9e>kg+Iq%nmHEWnyjOWKb{3+m(S?wzG8##U{a3V zO)!oK%ZWo)KjC?6{D+`^E;;AR%6XKGY}hxk5Psei;(*|_)J8AwfBgPL3-&5@<(@C_ zJV;ogo$x0(m$!Cg9hi4P=P1|wsX5UYqfWIXWHJF`H&D~<;Dz`4*PRM~!10W7nGPvJ zd<%0w7wWr8&Y|*Ft?j{BDw^xLBDlCnL$_!0{T_XHK~asdty(AcbdncP(ouVIJ%Db=H&`+!SXfl7MpU#=swqvLA}xQ?uTl{3sdkl$R5?mw{Zu()(gHG!P-iOX>}O_J!y z>e}fAW*8U2YpIntz1Zk(*n%Z)@Qd9J@l05vo$x0(r&RbC>WaCbt)j2#`yZ#_30|}9 zyCXWW4CSj|Cipo~hqsTpsAu zwFkF0uXRC1&!<0mx7@|`BzKuxu?}N*ZBM!wioyOr{&!6pa2%V3Vc)b>u#aS~WoTb4 zdH*+CdxFvvsVJh2ca$LjdHVKfoB{oJe+t%&*3QFkE0y~jALz&O9rCp^1ffpZ!Mhrq za6K{w94ThYV80m8fy9%cAm+=8QP*taWJG9FFmZO=xf%c3~aAEu{=aKrgvub22Z)U2w!e-uw!9 ze$GGj;nrX3X(qw8gX2(7b3^Uf^&Y@MX5X7R-u=$V`aWXwXEfjqr&Y{qZZ}=EY&iUfM1qiQE(Uxq=h6V69l#tem)p16%F>LBm z5@onpd(7Y=iB8OMtZ}Y(9dN?j^y6Us*Hzc?_Xt6K*hrttkIs>EzGAkQ(isGG#MXI= zK3Gl8x%mCz@4l)n7+SOai4epyVTtyooNL(l15`bnP>y7=qxIMsjA8L!zRrt*Hz&Nf zS+WuGrC!Imga`xg!UBO!FwUldajkhPat>zRi4k)iR5WkeG?SXUNw6*jQ$2@!|y)~kn18f{qpEoe~V2}&)o5) zcM%+q-^Xr<<1fFL;WG8*6X&76Rj81lGF&Go-Xdi@-Vv$QpYHt5mxO6KufA8{Sb>Xd zI@IJY5Bpy%+@k|@uEV$pUQ4YC(_R$5 zz6C2u?_DbnoC!;`6aEBecg+uY9K!*HTP7;XIlOWt0M8 zeEjlaZov>AE=7(gNspX!X}&?3oi!CXyzu+j1ODf^3Yf>U9T4?U-l5tParixZJEml) zTNg-KbbF1#-|O~`VhXT7zmdAtTNU<`XWt%oG$-%>WfS~^ddE77k^b^KATLp{MrU`i z15%)voGFwzk4wBTeX2c+<5}$o3%5akH$T{Xw%H2nj)T`lnc+BBHt`4r93tmjx9gv} z)u-twzEC(i82kxdORb~*n3o#Vm3FEd+g1njGhvB#!k^$AP|k7sNj~hW6!~?dXEY6O z)7LjYshEZJXO>A%J9(gI4=i&X&0v1Z5m0fqg1q=*Azo`Hat_q$j__l$R3uPnZK`Dr z-$}!oP8mbJz;EIEJ`RUB;j3PGS(@w`#w6cy9{cDC`zjPYMlPO${FOKI?~mKVz6p-l zUz01y`xmPYQ({x2BBftDY!VzHznVeuio6H=y|IyxLmTVxLf;dJ;V1|iRZVwen=gu<1z+W}9TE;%Y76mj+ zFco#yU?cfl5y1r&m_4Q`7JVAxT_ya;N$5XxT;`>-C49d>wLe~S1v%%wsh#1$JL#zH zg;CuzxIP50rFPa_(sZF8@^a@L%>95fVTpFapNQwh{)$cOkJ+IgDQDxQQ?BDHk3Ah{ z{q+jFp_z0@7v38${9c*hbpX}{q1^tl`mmn1;pi3oOT2YmlH)wRlZx_*M)r_r?I;fi;83Aji?K!S*OJ(hZRu_o{^%p1GIXEd~6U!U4Pi&lFf z@9RQDg#2IP?cXxFcMuhQUbcN#`97EzBQKi!Z##{WIX6n&aD9RKCe9T0yLV&OLiEld zn2%P5tuj95`-pHH2yC9wm6nC3QlXKW*DVw&SOGQS%{wZQ0&|}cKr5ywP zmp+?&AvIHv|4bkGAh53vyWNvk@Z})r6Kvn$v;#Od8a%lrs^ftcOKOht?;`L2-(_8{ z85R8$mD8w$|3{6VR0xFrt@V^5+O6*33g`eUUr-x{c!rz;fNM`og2E?=ld+#`=MTbo z8t=>*D9V#_hS9UO8^Zee?VIhpVLSw{rPlszxOmcBGq&$b-U@x-Ojx3w@FzHXE}MS5 zY{VW#i>zVk&d?;KSXdXSy@P2zld3*S4zfTHwFf{Sd3e<`j zZ{_(CtO@yKr!Phe!+GepN!dK#3Hf#sBGEt9$T?rrV~&hBgSyg9JM|?s$T>?|qOTiR Wpx*J_bSoQ}HwgRx_Wyw Date: Fri, 1 Sep 2023 08:30:38 +0200 Subject: [PATCH 41/41] BGK regressioncheck WEK_BGKFlow: comment in analyze.ini to 600 max diffs --- .../WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/analyze.ini | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/analyze.ini b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/analyze.ini index 102af287d..550e3909b 100644 --- a/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/analyze.ini +++ b/regressioncheck/WEK_BGKFlow/MultiSpec_Supersonic_Couette_CO2-N2/analyze.ini @@ -4,5 +4,5 @@ h5diff_reference_file = CouetteFlow_DSMCState_001.000000_ref.h5 h5diff_data_set = ElemData h5diff_tolerance_value = 4 h5diff_tolerance_type = absolute -h5diff_max_differences = 600 +h5diff_max_differences = 600 ! Allowed differences for 3x100 densities and 3x100 vibrational temperatures h5diff_one_diff_per_run = T