diff --git a/fem/src/Adaptive.F90 b/fem/src/Adaptive.F90 index f853ee4a18..628c6da44f 100644 --- a/fem/src/Adaptive.F90 +++ b/fem/src/Adaptive.F90 @@ -123,6 +123,10 @@ END FUNCTION InsideResidual LOGICAL :: NoInterp, Parallel, AdaptiveOutput, AdaptInit TYPE(ValueList_t), POINTER :: Params CHARACTER(*), PARAMETER :: Caller = 'RefineMesh' + REAL(KIND=dp), POINTER :: Wrk(:,:) + REAL(KIND=dp) :: CoordScale(3) + INTEGER :: mesh_dim + SAVE DoFinalRef @@ -509,6 +513,10 @@ END FUNCTION InsideResidual #else CALL Fatal( Caller,'Remeshing requested with MMG but not compiled with!') #endif + ELSE IF( ListGetLogical( Params,'Adaptive Remesh Use Gmsh', Found ) ) THEN + CALL Info(Caller,'Using Gmsh library for mesh refinement', Level=5) + NewMesh => Gmsh_ReMesh( RefMesh, ErrorLimit/3, HValue, & + NodalError, hConvergence, minH, maxH, MaxChangeFactor, Coarsening ) ELSE CALL Info(Caller,'Using file I/O for mesh refinement',Level=5) NewMesh => External_ReMesh( RefMesh, ErrorLimit/3, HValue, & @@ -1268,7 +1276,163 @@ END FUNCTION MMG_Remesh !------------------------------------------------------------------------------ #endif - +!------------------------------------------------------------------------------ +FUNCTION Gmsh_ReMesh( RefMesh, ErrorLimit, HValue, NodalError, & + hConvergence, minH, maxH, MaxChange, Coarsening ) RESULT( NewMesh ) + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: NodalError(:), hConvergence(:), & + ErrorLimit, minH, maxH, MaxChange, HValue(:) + LOGICAL :: Coarsening + TYPE(Mesh_t), POINTER :: NewMesh, RefMesh + !------------------------------------------------------------------------------ + TYPE(Mesh_t), POINTER :: Mesh + INTEGER :: i,j,k,n + REAL(KIND=dp) :: Lambda + CHARACTER(:), ALLOCATABLE :: MeshCommand, Name, MeshInputFile, MeshConversionCommand + !------------------------------------------------------------------------------ + + ! Before writing the background mesh, find the coordinates scaling and then write the background mesh in the scaled coordinates + ! Scaling of coordinates + !----------------------------------------------------------------------------- + ! Determine the mesh dimension + !---------------------------------------------------------------------------- + CALL SetMeshDimension( RefMesh ) + + mesh_dim = RefMesh % MaxDim + + Wrk => ListGetConstRealArray( Model % Simulation,'Coordinate Scaling',Found ) + CoordScale = 1.0_dp + IF( Found ) THEN + DO i=1, mesh_dim + j = MIN( i, SIZE(Wrk,1) ) + CoordScale(i) = Wrk(j,1) + END DO + WRITE(Message,'(A,3ES10.3)') 'Scaling the background mesh coordinates:',CoordScale(1:3) + CALL Info(Caller ,Message, Level=10) + END IF + + + ! write the bacground mesh for gmsh too. Need to make it to write it if requested + ! View "mesh size field" { + OPEN( 11, STATUS='UNKNOWN', FILE='gmsh_bgmesh.pos' ) + WRITE( 11,* ) 'View "mesh size field" {' + + DO i=1,RefMesh % NumberOfNodes + IF ( NodalError(i) > 100*AEPS ) THEN + Lambda = ( ErrorLimit / NodalError(i) ) ** ( 1.0d0 / hConvergence(i) ) + + IF ( RefMesh % AdaptiveDepth < 1 ) THEN + Lambda = HValue(i) * MAX( MIN( Lambda, 1.33d0), 0.75d0) + ELSE + Lambda = HValue(i) * MAX(MIN(Lambda, MaxChange), 1.0d0/MaxChange) + END IF + + IF( .NOT.Coarsening ) Lambda = MIN( Lambda, Hvalue(i) ) + + IF ( maxH > 0 ) Lambda = MIN( Lambda, maxH ) + IF ( minH > 0 ) Lambda = MAX( Lambda, minH ) + + IF ( CoordinateSystemDimension() == 2 ) THEN + ! Write a list based background mesh for gmsh. S for scalar and P for point. + ! the mesh size is scaled by the minimum of the scaling factors. This may need to be changed to include all cases. + WRITE( 11,* ) 'SP(', (RefMesh % Nodes % x(i)) / CoordScale(1), & + ', ', (RefMesh % Nodes % y(i)) / CoordScale(2), ') {', & + Lambda / MIN(CoordScale(1), CoordScale(2)), '};' + ELSE + ! Write a list based background mesh for gmsh. S for scalar and P for point. + ! the mesh size is scaled by the minimum of the scaling factors. This may need to be changed to include all cases. + WRITE( 11,* ) 'SP(', (RefMesh % Nodes % x(i)) / CoordScale(1), & + ', ', (RefMesh % Nodes % y(i)) / CoordScale(2), & + ', ', (RefMesh % Nodes % z(i)) / CoordScale(3), ') {', & + Lambda / MIN(CoordScale(1), MIN(CoordScale(2), CoordScale(3))), '};' + END IF + ELSE + IF ( CoordinateSystemDimension() == 2 ) THEN + WRITE(11, *) 'SP(', (RefMesh % Nodes % x(i)) / CoordScale(1), & + ', ', (RefMesh % Nodes % y(i)) / CoordScale(2), ') {', & + HValue(i) / MIN(CoordScale(1), CoordScale(2)), '};' + ELSE + WRITE(11, *) 'SP(', (RefMesh % Nodes % x(i)) / CoordScale(1), & + ', ', (RefMesh % Nodes % y(i)) / CoordScale(2), & + ', ', (RefMesh % Nodes % z(i)) / CoordScale(3), ') {', & + HValue(i) / MIN(CoordScale(1), MIN(CoordScale(2), CoordScale(3))), '};' + END IF + END IF + END DO + ! write }; at the end of the file and close it; + WRITE( 11,* ) '};' + CLOSE( 11 ) + + Path = ListGetString( Params, 'Adaptive Mesh Name', Found ) + IF ( .NOT. Found ) Path = 'RefinedMesh' + + IF (ListGetLogical(Params,'Adaptive Mesh Numbering',Found)) THEN + i = RefMesh % AdaptiveDepth + 1 + nLen = LEN_TRIM(Path) + Path = Path(1:nlen) // I2S(i) + END IF + + nLen = LEN_TRIM(OutputPath) + IF ( nlen > 0 ) THEN + Path = OutputPath(1:nlen) // '/' // TRIM(Path) + ELSE + Path = TRIM(Path) + END IF + CALL Info(Caller,'Writing the background mesh to: '//TRIM(Path),Level=10) + CALL MakeDirectory( TRIM(Path) // CHAR(0) ) + CALL WriteMeshToDisk( RefMesh, Path ) + + Mesh => RefMesh + DO WHILE( ASSOCIATED( Mesh ) ) + IF ( Mesh % AdaptiveDepth == 0 ) EXIT + Mesh => Mesh % Parent + END DO + + MeshInputFile = ListGetString( Params, 'Mesh Input File', Found ) + + IF ( .NOT. Found ) THEN + MeshInputFile = ListGetString( Model % Simulation, 'Mesh Input File' ) + END IF + + CALL Info(Caller,'Mesh input file: '//TRIM(MeshInputFile),Level=14) + + ! temporary solution to get the mesh command to work + MeshCommand = ListGetString( Params, 'Mesh Command', Found ) + MeshConversionCommand = ListGetString( Params, 'Mesh Conversion Command', Found ) + CALL Info(Caller, 'Gmsh command: '//TRIM(MeshCommand),Level=10) + CALL SystemCommand( MeshCommand ) + CALL Info(Caller, 'Conversion of mesh using Gmsh done. Starting ElmerGrid', Level=5) + ! the conversion command need to get the path from Path + MeshConversionCommand = MeshConversionCommand // ' -out ' // TRIM(Path) + CALL Info(Caller, 'ElmerGrid command: '//TRIM(MeshConversionCommand),Level=10) + CALL SystemCommand( MeshConversionCommand ) + + CALL Info(Caller, 'Conversion of mesh ElmerGrid done.', Level=5) + + ! print the output path + CAll Info(Caller, 'Output path: '//TRIM(OutputPath), Level=10) + NewMesh => LoadMesh2( Model, OutPutPath, Path, .FALSE., 1, 0 ) + + IF ( Solver % Variable % Name == 'temperature' ) THEN + Name = ListGetString( Model % Simulation, 'Gebhart Factors', Found ) + IF ( Found ) THEN + MeshCommand = 'View ' // TRIM(OutputPath) // & + '/' // TRIM(Mesh % Name) // ' ' // TRIM(Path) + + CALL SystemCommand( MeshCommand ) + + Name = TRIM(OutputPath) // '/' // & + TRIM(Mesh % Name) // '/' // TRIM(Name) + + CALL LoadGebhartFactors( NewMesh, TRIM(Name) ) + END IF + END IF + +!------------------------------------------------------------------------------ +END FUNCTION Gmsh_ReMesh +!------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ FUNCTION External_ReMesh( RefMesh, ErrorLimit, HValue, NodalError, & hConvergence, minH, maxH, MaxChange, Coarsening ) RESULT( NewMesh ) @@ -2533,4 +2697,4 @@ END FUNCTION ComputeError END MODULE Adaptive !----------------------------------------------------------------------------- -!> \} +!> \} \ No newline at end of file diff --git a/fem/src/modules/MagnetoDynamics/WhitneyAVHarmonicSolver.F90 b/fem/src/modules/MagnetoDynamics/WhitneyAVHarmonicSolver.F90 index fa83d011ee..7d87485eb3 100644 --- a/fem/src/modules/MagnetoDynamics/WhitneyAVHarmonicSolver.F90 +++ b/fem/src/modules/MagnetoDynamics/WhitneyAVHarmonicSolver.F90 @@ -37,3107 +37,3107 @@ !> \ingroup Solvers !------------------------------------------------------------------------------ SUBROUTINE WhitneyAVHarmonicSolver_Init0(Model,Solver,dt,Transient) -!------------------------------------------------------------------------------ - USE MagnetoDynamicsUtils - - IMPLICIT NONE -!------------------------------------------------------------------------------ - TYPE(Solver_t) :: Solver - TYPE(Model_t) :: Model - - REAL(KIND=dp) :: dt - LOGICAL :: Transient -!------------------------------------------------------------------------------ - TYPE(ValueList_t), POINTER :: SolverParams - LOGICAL :: Found, PiolaVersion, SecondOrder, SecondFamily - CHARACTER(:), ALLOCATABLE :: ElemType - - TYPE(Solver_t), POINTER :: Solvers(:) - INTEGER :: i,j,k,n - CHARACTER(:), ALLOCATABLE :: eq - INTEGER, POINTER :: ActiveSolvers(:) - - SolverParams => GetSolverParams() - IF ( .NOT.ListCheckPresent(SolverParams, "Element") ) THEN - ! We use one place where all the edge element keywords are defined and checked. - CALL EdgeElementStyle(SolverParams, PiolaVersion, SecondFamily, SecondOrder, Check = .TRUE. ) - - IF (SecondOrder) THEN - ElemType = "n:1 e:2 -brick b:6 -prism b:2 -pyramid b:3 -quad_face b:4 -tri_face b:2" - ELSE IF( SecondFamily ) THEN - ElemType = "n:1 e:2" - ELSE IF( PiolaVersion ) THEN - ElemType = "n:1 e:1 -brick b:3 -quad_face b:2" - ELSE - ElemType = "n:1 e:1" - END IF - CALL Info('WhitneyHarmonicSolver_Init0','Setting element type to: "'//TRIM(ElemType)//'"',Level=6) - CALL ListAddString( SolverParams, "Element", TRIM(ElemType) ) - END IF - - CALL ListAddNewLogical( SolverParams, 'Linear System Complex', .TRUE. ) - -! This is for internal communication with the saving routines - CALL ListAddLogical( SolverParams,'Hcurl Basis',.TRUE.) - - CALL ListAddNewString( SolverParams,'Variable','AV[AV re:1 AV im:1]') - - IF(ListGetLogical(SolverParams, 'Helmholtz Projection', Found)) THEN - Solvers => Model % Solvers - n = Model % NumberOfSolvers - Model % NumberOfSolvers = n+2 - - ALLOCATE(Model % Solvers(Model % NumberOfSolvers)) - Model % Solvers(1:n) = Solvers - - DO i=n+1,n+2 - Model % Solvers(i) % PROCEDURE = 0 - NULLIFY( Model % Solvers(i) % Matrix ) - NULLIFY( Model % Solvers(i) % Mesh ) - NULLIFY( Model % Solvers(i) % Variable ) - NULLIFY( Model % Solvers(i) % ActiveElements ) - Model % Solvers(i) % NumberOfActiveElements = 0 - END DO - - DO i=1,Model % NumberOfSolvers - IF(.NOT.ASSOCIATED(Model % Solvers(i) % Values)) & - Model % Solvers(i) % Values => ListAllocate() - END DO - - Eq = ListGetString( SolverParams, 'Equation' ) - - CALL ListAddIntegerArray( SolverParams, 'Post Solvers', 2, [n+1,n+2] ) - - CALL ListAddString( Model % Solvers(n+1) % Values, 'Procedure', & - 'MagnetoDynamics HelmholtzProjector', CaseConversion=.FALSE. ) - CALL ListAddString( Model % Solvers(n+1) % Values, 'Equation', 'HP' ) - CALL ListAddString( Model % Solvers(n+1) % Values, 'Exec Solver', 'Never' ) - - CALL ListAddString( Model % Solvers(n+2) % Values, 'Procedure', & - 'MagnetoDynamics RemoveKernelComponent',CaseConversion=.FALSE. ) - CALL ListAddString( Model % Solvers(n+2) % Values, 'Equation', 'RMC' ) - CALL ListAddString( Model % Solvers(n+2) % Values, 'Exec Solver', 'Never' ) - - DO i=1,Model % NumberOFEquations - IF ( ListGetLogical( Model % Equations(i) % Values, Eq, Found ) ) THEN - CALL ListAddLogical( Model % Equations(i) % Values, 'HP', .TRUE. ) - CALL ListAddLogical( Model % Equations(i) % Values, 'RMC' , .TRUE.) + !------------------------------------------------------------------------------ + USE MagnetoDynamicsUtils + + IMPLICIT NONE + !------------------------------------------------------------------------------ + TYPE(Solver_t) :: Solver + TYPE(Model_t) :: Model + + REAL(KIND=dp) :: dt + LOGICAL :: Transient + !------------------------------------------------------------------------------ + TYPE(ValueList_t), POINTER :: SolverParams + LOGICAL :: Found, PiolaVersion, SecondOrder, SecondFamily + CHARACTER(:), ALLOCATABLE :: ElemType + + TYPE(Solver_t), POINTER :: Solvers(:) + INTEGER :: i,j,k,n + CHARACTER(:), ALLOCATABLE :: eq + INTEGER, POINTER :: ActiveSolvers(:) + + SolverParams => GetSolverParams() + IF ( .NOT.ListCheckPresent(SolverParams, "Element") ) THEN + ! We use one place where all the edge element keywords are defined and checked. + CALL EdgeElementStyle(SolverParams, PiolaVersion, SecondFamily, SecondOrder, Check = .TRUE. ) + + IF (SecondOrder) THEN + ElemType = "n:1 e:2 -brick b:6 -prism b:2 -pyramid b:3 -quad_face b:4 -tri_face b:2" + ELSE IF( SecondFamily ) THEN + ElemType = "n:1 e:2" + ELSE IF( PiolaVersion ) THEN + ElemType = "n:1 e:1 -brick b:3 -quad_face b:2" ELSE - ActiveSolvers => ListGetIntegerArray( CurrentModel % Equations(i) % Values, & - 'Active Solvers', Found ) - IF ( Found ) THEN - DO k=1,SIZE(ActiveSolvers) - IF ( ActiveSolvers(k) == Solver % SolverId ) THEN - CALL ListAddLogical( Model % Equations(i) % Values, 'HP', .TRUE. ) - CALL ListAddLogical( Model % Equations(i) % Values, 'RMC', .TRUE. ) - EXIT - END IF - END DO - END IF + ElemType = "n:1 e:1" END IF - END DO - END IF - + CALL Info('WhitneyHarmonicSolver_Init0','Setting element type to: "'//TRIM(ElemType)//'"',Level=6) + CALL ListAddString( SolverParams, "Element", TRIM(ElemType) ) + END IF + + CALL ListAddNewLogical( SolverParams, 'Linear System Complex', .TRUE. ) + + ! This is for internal communication with the saving routines + CALL ListAddLogical( SolverParams,'Hcurl Basis',.TRUE.) + + CALL ListAddNewString( SolverParams,'Variable','AV[AV re:1 AV im:1]') + + IF(ListGetLogical(SolverParams, 'Helmholtz Projection', Found)) THEN + Solvers => Model % Solvers + n = Model % NumberOfSolvers + Model % NumberOfSolvers = n+2 + + ALLOCATE(Model % Solvers(Model % NumberOfSolvers)) + Model % Solvers(1:n) = Solvers + + DO i=n+1,n+2 + Model % Solvers(i) % PROCEDURE = 0 + NULLIFY( Model % Solvers(i) % Matrix ) + NULLIFY( Model % Solvers(i) % Mesh ) + NULLIFY( Model % Solvers(i) % Variable ) + NULLIFY( Model % Solvers(i) % ActiveElements ) + Model % Solvers(i) % NumberOfActiveElements = 0 + END DO + + DO i=1,Model % NumberOfSolvers + IF(.NOT.ASSOCIATED(Model % Solvers(i) % Values)) & + Model % Solvers(i) % Values => ListAllocate() + END DO + + Eq = ListGetString( SolverParams, 'Equation' ) + + CALL ListAddIntegerArray( SolverParams, 'Post Solvers', 2, [n+1,n+2] ) + + CALL ListAddString( Model % Solvers(n+1) % Values, 'Procedure', & + 'MagnetoDynamics HelmholtzProjector', CaseConversion=.FALSE. ) + CALL ListAddString( Model % Solvers(n+1) % Values, 'Equation', 'HP' ) + CALL ListAddString( Model % Solvers(n+1) % Values, 'Exec Solver', 'Never' ) + + CALL ListAddString( Model % Solvers(n+2) % Values, 'Procedure', & + 'MagnetoDynamics RemoveKernelComponent',CaseConversion=.FALSE. ) + CALL ListAddString( Model % Solvers(n+2) % Values, 'Equation', 'RMC' ) + CALL ListAddString( Model % Solvers(n+2) % Values, 'Exec Solver', 'Never' ) + + DO i=1,Model % NumberOFEquations + IF ( ListGetLogical( Model % Equations(i) % Values, Eq, Found ) ) THEN + CALL ListAddLogical( Model % Equations(i) % Values, 'HP', .TRUE. ) + CALL ListAddLogical( Model % Equations(i) % Values, 'RMC' , .TRUE.) + ELSE + ActiveSolvers => ListGetIntegerArray( CurrentModel % Equations(i) % Values, & + 'Active Solvers', Found ) + IF ( Found ) THEN + DO k=1,SIZE(ActiveSolvers) + IF ( ActiveSolvers(k) == Solver % SolverId ) THEN + CALL ListAddLogical( Model % Equations(i) % Values, 'HP', .TRUE. ) + CALL ListAddLogical( Model % Equations(i) % Values, 'RMC', .TRUE. ) + EXIT + END IF + END DO + END IF + END IF + END DO + END IF + + + !------------------------------------------------------------------------------ + END SUBROUTINE WhitneyAVHarmonicSolver_Init0 + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + SUBROUTINE WhitneyAVHarmonicSolver_Init(Model,Solver,dt,Transient) + !------------------------------------------------------------------------------ + USE MagnetoDynamicsUtils + IMPLICIT NONE + !------------------------------------------------------------------------------ + TYPE(Solver_t) :: Solver + TYPE(Model_t) :: Model + REAL(KIND=dp) :: dt + LOGICAL :: Transient + !------------------------------------------------------------------------------ + TYPE(Mesh_t), POINTER :: Mesh + LOGICAL :: Found -!------------------------------------------------------------------------------ -END SUBROUTINE WhitneyAVHarmonicSolver_Init0 -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ -SUBROUTINE WhitneyAVHarmonicSolver_Init(Model,Solver,dt,Transient) -!------------------------------------------------------------------------------ - USE MagnetoDynamicsUtils - IMPLICIT NONE -!------------------------------------------------------------------------------ - TYPE(Solver_t) :: Solver - TYPE(Model_t) :: Model - REAL(KIND=dp) :: dt - LOGICAL :: Transient -!------------------------------------------------------------------------------ - TYPE(Mesh_t), POINTER :: Mesh - LOGICAL :: Found - - Mesh => GetMesh() - IF( Mesh % MeshDim /= 3 ) THEN - CALL Fatal('WhitneyAVHarmonicSolver_Init','Solver requires 3D mesh!') - END IF - - ! Historically a real array could be used for H-B Curve. - ! This dirty piece of code makes things backward compatible. - BLOCK - INTEGER :: i - LOGICAL :: Cubic - TYPE(ValueList_t), POINTER :: Material - DO i=1,Model % NumberOfMaterials - Material => Model % Materials(i) % Values - IF( ListCheckPresent( Material, 'H-B Curve') ) THEN - Cubic = GetLogical( Material, 'Cubic spline for H-B curve',Found) - CALL ListRealArrayToDepReal(Material,'H-B Curve','dummy',& - CubicTable=Cubic) !Monotone=.TRUE.) - END IF - END DO - END BLOCK + Mesh => GetMesh() + IF( Mesh % MeshDim /= 3 ) THEN + CALL Fatal('WhitneyAVHarmonicSolver_Init','Solver requires 3D mesh!') + END IF -!------------------------------------------------------------------------------ -END SUBROUTINE WhitneyAVHarmonicSolver_Init -!------------------------------------------------------------------------------ - - -!------------------------------------------------------------------------------ -!> Solve a vector potential A and scalar potential V from -! -!> j omega sigma A+rot (1/mu) rot A+sigma grad(V) = J^s+rot M^s-sigma grad(V^s) -!> -div(sigma (j omega A+grad(V)))=0 -! -!> by using edge elements (Nedelec) + nodal basis for V. -!> \ingroup Solvers -!------------------------------------------------------------------------------ -SUBROUTINE WhitneyAVHarmonicSolver( Model,Solver,dt,Transient ) -!------------------------------------------------------------------------------ - USE MagnetoDynamicsUtils - USE CircuitUtils - - IMPLICIT NONE -!------------------------------------------------------------------------------ - TYPE(Solver_t), TARGET :: Solver - TYPE(Model_t) :: Model - REAL(KIND=dp) :: dt - LOGICAL :: Transient -!------------------------------------------------------------------------------ -! Local variables -!------------------------------------------------------------------------------ - LOGICAL :: AllocationsDone = .FALSE., Found, L1 - LOGICAL :: Stat, TG, Jfix, JfixSolve, LaminateStack, CoilBody, EdgeBasis,LFact,LFactFound - LOGICAL :: PiolaVersion, SecondOrder, GotHbCurveVar, HasTensorReluctivity - LOGICAL :: ExtNewton, StrandedHomogenization - LOGICAL, ALLOCATABLE, SAVE :: TreeEdges(:) - - INTEGER :: n,nb,nd,t,istat,i,j,k,l,nNodes,Active,FluxCount=0 - INTEGER :: NoIterationsMin, NoIterationsMax - INTEGER :: NewtonIter - INTEGER, POINTER :: Perm(:) - INTEGER, ALLOCATABLE :: FluxMap(:) - - COMPLEX(kind=dp) :: Aval - COMPLEX(KIND=dp), ALLOCATABLE :: MASS(:,:), STIFF(:,:), FORCE(:), JFixFORCE(:),JFixVec(:,:) - COMPLEX(KIND=dp), ALLOCATABLE :: LOAD(:,:), Acoef(:), Tcoef(:,:,:) - COMPLEX(KIND=dp), ALLOCATABLE :: LamCond(:) - COMPLEX(KIND=dp), POINTER :: Acoef_t(:,:,:) => NULL() - - REAL(KIND=dp) :: Norm, Omega - REAL(KIND=dp), ALLOCATABLE :: RotM(:,:,:), GapLength(:), MuParameter(:), SkinCond(:), ReLoad(:,:) - REAL(KIND=dp), POINTER :: Cwrk(:,:,:), Cwrk_im(:,:,:), LamThick(:) - REAL(KIND=dp), POINTER :: sValues(:), fixpot(:) - REAL(KIND=dp) :: NewtonTol - - CHARACTER(LEN=MAX_NAME_LEN):: LaminateStackModel, CoilType, HbCurveVarName - - TYPE(Mesh_t), POINTER :: Mesh - TYPE(Element_t),POINTER :: Element, Edge - TYPE(ValueList_t), POINTER :: BodyForce, Material, BC, BodyParams, SolverParams - TYPE(Variable_t), POINTER :: jfixvar, jfixvarIm, HbCurveVar - TYPE(Matrix_t), POINTER :: A - TYPE(ListMatrix_t), POINTER :: BasicCycles(:) - TYPE(ValueList_t), POINTER :: CompParams - - CHARACTER(LEN=MAX_NAME_LEN):: CoilCurrentName - TYPE(Variable_t), POINTER :: CoilCurrentVar - REAL(KIND=dp) :: CurrAmp - LOGICAL :: UseCoilCurrent, ElemCurrent, ElectroDynamics, EigenSystem - TYPE(Solver_t), POINTER :: pSolver - - - SAVE MASS, STIFF, LOAD, FORCE, Tcoef, JFixVec, JFixFORCE, Acoef, Acoef_t, & - Cwrk, Cwrk_im, LamCond, LamThick, AllocationsDone, RotM, GapLength, MuParameter, SkinCond -!------------------------------------------------------------------------------ - IF ( .NOT. ASSOCIATED( Solver % Matrix ) ) RETURN - - CALL Info('WhitneyAVHarmonicSolver','',Level=6 ) - CALL Info('WhitneyAVHarmonicSolver','------------------------------------------------',Level=6 ) - CALL Info('WhitneyAVHarmonicSolver','Solving harmonic AV equations with edge elements',Level=5 ) - - SolverParams => GetSolverParams() - pSolver => Solver - - EigenSystem = GetLogical( SolverParams, 'Eigen Analysis', Found ) - ElectroDynamics = GetLogical( SolverParams, 'Electrodynamics Model', Found ) - - CALL EdgeElementStyle(SolverParams, PiolaVersion, QuadraticApproximation = SecondOrder ) - - IF (PiolaVersion) THEN - CALL Info('WhitneyAVHarmonicSolver', & - 'Using Piola Transformed element basis functions',Level=4) - CALL Info('WhitneyAVHarmonicSolver', & - 'The option > Use Tree Gauge < is not available',Level=4) - END IF - - CoilCurrentName = GetString( SolverParams,'Current Density Name',UseCoilCurrent ) - IF(.NOT. UseCoilCurrent ) THEN - UseCoilCurrent = GetLogical(SolverParams,'Use Nodal CoilCurrent',Found ) - IF(UseCoilCurrent) THEN - CoilCurrentName = 'CoilCurrent' - ELSE - UseCoilCurrent = GetLogical(SolverParams,'Use Elemental CoilCurrent',Found ) - IF(UseCoilCurrent) CoilCurrentName = 'CoilCurrent e' + ! Historically a real array could be used for H-B Curve. + ! This dirty piece of code makes things backward compatible. + BLOCK + INTEGER :: i + LOGICAL :: Cubic + TYPE(ValueList_t), POINTER :: Material + DO i=1,Model % NumberOfMaterials + Material => Model % Materials(i) % Values + IF( ListCheckPresent( Material, 'H-B Curve') ) THEN + Cubic = GetLogical( Material, 'Cubic spline for H-B curve',Found) + CALL ListRealArrayToDepReal(Material,'H-B Curve','dummy',& + CubicTable=Cubic) !Monotone=.TRUE.) + END IF + END DO + END BLOCK + + !------------------------------------------------------------------------------ + END SUBROUTINE WhitneyAVHarmonicSolver_Init + !------------------------------------------------------------------------------ + + + !------------------------------------------------------------------------------ + !> Solve a vector potential A and scalar potential V from + ! + !> j omega sigma A+rot (1/mu) rot A+sigma grad(V) = J^s+rot M^s-sigma grad(V^s) + !> -div(sigma (j omega A+grad(V)))=0 + ! + !> by using edge elements (Nedelec) + nodal basis for V. + !> \ingroup Solvers + !------------------------------------------------------------------------------ + SUBROUTINE WhitneyAVHarmonicSolver( Model,Solver,dt,Transient ) + !------------------------------------------------------------------------------ + USE MagnetoDynamicsUtils + USE CircuitUtils + + IMPLICIT NONE + !------------------------------------------------------------------------------ + TYPE(Solver_t), TARGET :: Solver + TYPE(Model_t) :: Model + REAL(KIND=dp) :: dt + LOGICAL :: Transient + !------------------------------------------------------------------------------ + ! Local variables + !------------------------------------------------------------------------------ + LOGICAL :: AllocationsDone = .FALSE., Found, L1 + LOGICAL :: Stat, TG, Jfix, JfixSolve, LaminateStack, CoilBody, EdgeBasis,LFact,LFactFound + LOGICAL :: PiolaVersion, SecondOrder, GotHbCurveVar, HasTensorReluctivity + LOGICAL :: ExtNewton, StrandedHomogenization + LOGICAL, ALLOCATABLE, SAVE :: TreeEdges(:) + + INTEGER :: n,nb,nd,t,istat,i,j,k,l,nNodes,Active,FluxCount=0 + INTEGER :: NoIterationsMin, NoIterationsMax + INTEGER :: NewtonIter + INTEGER, POINTER :: Perm(:) + INTEGER, ALLOCATABLE :: FluxMap(:) + + COMPLEX(kind=dp) :: Aval + COMPLEX(KIND=dp), ALLOCATABLE :: MASS(:,:), STIFF(:,:), FORCE(:), JFixFORCE(:),JFixVec(:,:) + COMPLEX(KIND=dp), ALLOCATABLE :: LOAD(:,:), Acoef(:), Tcoef(:,:,:) + COMPLEX(KIND=dp), ALLOCATABLE :: LamCond(:) + COMPLEX(KIND=dp), POINTER :: Acoef_t(:,:,:) => NULL() + + REAL(KIND=dp) :: Norm, Omega + REAL(KIND=dp), ALLOCATABLE :: RotM(:,:,:), GapLength(:), MuParameter(:), SkinCond(:), ReLoad(:,:) + REAL(KIND=dp), POINTER :: Cwrk(:,:,:), Cwrk_im(:,:,:), LamThick(:) + REAL(KIND=dp), POINTER :: sValues(:), fixpot(:) + REAL(KIND=dp) :: NewtonTol + + CHARACTER(LEN=MAX_NAME_LEN):: LaminateStackModel, CoilType, HbCurveVarName + + TYPE(Mesh_t), POINTER :: Mesh + TYPE(Element_t),POINTER :: Element, Edge + TYPE(ValueList_t), POINTER :: BodyForce, Material, BC, BodyParams, SolverParams + TYPE(Variable_t), POINTER :: jfixvar, jfixvarIm, HbCurveVar + TYPE(Matrix_t), POINTER :: A + TYPE(ListMatrix_t), POINTER :: BasicCycles(:) + TYPE(ValueList_t), POINTER :: CompParams + + CHARACTER(LEN=MAX_NAME_LEN):: CoilCurrentName + TYPE(Variable_t), POINTER :: CoilCurrentVar + REAL(KIND=dp) :: CurrAmp + LOGICAL :: UseCoilCurrent, ElemCurrent, ElectroDynamics, EigenSystem + TYPE(Solver_t), POINTER :: pSolver + + + SAVE MASS, STIFF, LOAD, FORCE, Tcoef, JFixVec, JFixFORCE, Acoef, Acoef_t, & + Cwrk, Cwrk_im, LamCond, LamThick, AllocationsDone, RotM, GapLength, MuParameter, SkinCond + !------------------------------------------------------------------------------ + IF ( .NOT. ASSOCIATED( Solver % Matrix ) ) RETURN + + CALL Info('WhitneyAVHarmonicSolver','',Level=6 ) + CALL Info('WhitneyAVHarmonicSolver','------------------------------------------------',Level=6 ) + CALL Info('WhitneyAVHarmonicSolver','Solving harmonic AV equations with edge elements',Level=5 ) + + SolverParams => GetSolverParams() + pSolver => Solver + + EigenSystem = GetLogical( SolverParams, 'Eigen Analysis', Found ) + ElectroDynamics = GetLogical( SolverParams, 'Electrodynamics Model', Found ) + + CALL EdgeElementStyle(SolverParams, PiolaVersion, QuadraticApproximation = SecondOrder ) + + IF (PiolaVersion) THEN + CALL Info('WhitneyAVHarmonicSolver', & + 'Using Piola Transformed element basis functions',Level=4) + CALL Info('WhitneyAVHarmonicSolver', & + 'The option > Use Tree Gauge < is not available',Level=4) END IF - END IF - ElemCurrent = .FALSE. - - IF( UseCoilCurrent ) THEN - CoilCurrentVar => VariableGet(Solver % Mesh % Variables, CoilCurrentName ) - IF( ASSOCIATED( CoilCurrentVar ) ) THEN - CALL Info('WhitneyAVHarmonicSolver','Using precomputed field for current density: '//TRIM(CoilCurrentName),Level=5) - IF( CoilCurrentVar % TYPE == Variable_on_nodes_on_elements ) THEN - ElemCurrent = .TRUE. + + CoilCurrentName = GetString( SolverParams,'Current Density Name',UseCoilCurrent ) + IF(.NOT. UseCoilCurrent ) THEN + UseCoilCurrent = GetLogical(SolverParams,'Use Nodal CoilCurrent',Found ) + IF(UseCoilCurrent) THEN + CoilCurrentName = 'CoilCurrent' ELSE - CALL Warn('WhitneyAVHarmonicSolver','Precomputed CoilCurrent is not an elemental field!') + UseCoilCurrent = GetLogical(SolverParams,'Use Elemental CoilCurrent',Found ) + IF(UseCoilCurrent) CoilCurrentName = 'CoilCurrent e' END IF - ELSE - CALL Fatal('WhitneyAVHarmonicSolver','Elemental current requested but not found:'//TRIM(CoilCurrentName)) END IF - END IF - - - ! Allocate some permanent storage, this is done first time only: - !--------------------------------------------------------------- - Mesh => GetMesh() - nNodes = Mesh % NumberOfNodes - Perm => Solver % Variable % Perm - - A => GetMatrix() - - IF ( .NOT. AllocationsDone ) THEN - - IF (Solver % Variable % dofs /= 2) CALL Fatal('WhitneyAVHarmonicSolver', & - 'Variable is not properly defined for time harmonic AV solver, Use: Variable = A[A re:1 A im:1]') - - N = Mesh % MaxElementDOFs ! just big enough - ALLOCATE( FORCE(N), LOAD(7,N), ReLOAD(3,N), STIFF(N,N), MASS(n,n), & - JFixVec(3,N),JFixFORCE(n), Tcoef(3,3,N), RotM(3,3,N), & - GapLength(N), MuParameter(N), SkinCond(N), Acoef(N), LamCond(N), & - LamThick(N), STAT=istat ) - IF ( istat /= 0 ) THEN - CALL Fatal( 'WhitneyAVHarmonicSolver', 'Memory allocation error.' ) - END IF - - NULLIFY( Cwrk ) - NULLIFY( Cwrk_im ) - - AllocationsDone = .TRUE. - END IF - - Omega = GetAngularFrequency(Found=Found) - IF(.NOT. Found .AND. .NOT. EigenSystem ) THEN - CALL Fatal('WhitneyHarmonicAVSolver','Harmonic solution requires frequency!') - END IF + ElemCurrent = .FALSE. + + IF( UseCoilCurrent ) THEN + CoilCurrentVar => VariableGet(Solver % Mesh % Variables, CoilCurrentName ) + IF( ASSOCIATED( CoilCurrentVar ) ) THEN + CALL Info('WhitneyAVHarmonicSolver','Using precomputed field for current density: '//TRIM(CoilCurrentName),Level=5) + IF( CoilCurrentVar % TYPE == Variable_on_nodes_on_elements ) THEN + ElemCurrent = .TRUE. + ELSE + CALL Warn('WhitneyAVHarmonicSolver','Precomputed CoilCurrent is not an elemental field!') + END IF + ELSE + CALL Fatal('WhitneyAVHarmonicSolver','Elemental current requested but not found:'//TRIM(CoilCurrentName)) + END IF + END IF + - Jfix = GetLogical(SolverParams,'Fix input Current Density', Found) - IF(.NOT. Found ) THEN - ! If not specified compute the Jfix field only if there is a specified current BC - Jfix = ListCheckPrefixAnyBodyForce( Model,'Current Density' ) - END IF - JfixSolve = Jfix - - IF (Jfix) THEN - JfixPhase = 1 - CALL JfixPotentialSolver(Model,Solver,dt,Transient) - JfixVar => VariableGet(Mesh % Variables, 'Jfix') - JfixVarIm => VariableGet(Mesh % Variables, 'Jfix Im') - IF(.NOT. ASSOCIATED( JfixRhsC ) ) THEN - CALL Fatal('WhitneyAVHarmonicSolver','JfixRhsC should be associated!') + ! Allocate some permanent storage, this is done first time only: + !--------------------------------------------------------------- + Mesh => GetMesh() + nNodes = Mesh % NumberOfNodes + Perm => Solver % Variable % Perm + + A => GetMatrix() + + IF ( .NOT. AllocationsDone ) THEN + + IF (Solver % Variable % dofs /= 2) CALL Fatal('WhitneyAVHarmonicSolver', & + 'Variable is not properly defined for time harmonic AV solver, Use: Variable = A[A re:1 A im:1]') + + N = Mesh % MaxElementDOFs ! just big enough + ALLOCATE( FORCE(N), LOAD(7,N), ReLOAD(3,N), STIFF(N,N), MASS(n,n), & + JFixVec(3,N),JFixFORCE(n), Tcoef(3,3,N), RotM(3,3,N), & + GapLength(N), MuParameter(N), SkinCond(N), Acoef(N), LamCond(N), & + LamThick(N), STAT=istat ) + IF ( istat /= 0 ) THEN + CALL Fatal( 'WhitneyAVHarmonicSolver', 'Memory allocation error.' ) + END IF + + NULLIFY( Cwrk ) + NULLIFY( Cwrk_im ) + + AllocationsDone = .TRUE. END IF - IF(.NOT. ASSOCIATED( JFixSurfacePerm ) ) THEN - CALL Fatal('WhitneyAVHarmonicSolver','JFixVecSurfacePerm should be associated!') + + Omega = GetAngularFrequency(Found=Found) + IF(.NOT. Found .AND. .NOT. EigenSystem ) THEN + CALL Fatal('WhitneyHarmonicAVSolver','Harmonic solution requires frequency!') END IF - IF(.NOT. ALLOCATED( JFixSurfaceVecC ) ) THEN - CALL Fatal('WhitneyAVHarmonicSolver','JFixVecSurfaceVecC should be associated!') - END IF - END IF - - HbCurveVarName = GetString( SolverParams,'H-B Curve Variable', GotHbCurveVar ) - IF( GotHbCurveVar ) THEN - HbCurveVar => VariableGet( Mesh % Variables, HbCurveVarName ) - IF(.NOT. ASSOCIATED( HbCurveVar ) ) THEN - CALL Fatal('WhitneyAVHarmonicSolver','H-B Curve variable given but does not exist: '& - //TRIM(HbCurveVarName)) + + Jfix = GetLogical(SolverParams,'Fix input Current Density', Found) + IF(.NOT. Found ) THEN + ! If not specified compute the Jfix field only if there is a specified current BC + Jfix = ListCheckPrefixAnyBodyForce( Model,'Current Density' ) END IF - END IF + JfixSolve = Jfix + + IF (Jfix) THEN + JfixPhase = 1 + CALL JfixPotentialSolver(Model,Solver,dt,Transient) + JfixVar => VariableGet(Mesh % Variables, 'Jfix') + JfixVarIm => VariableGet(Mesh % Variables, 'Jfix Im') + IF(.NOT. ASSOCIATED( JfixRhsC ) ) THEN + CALL Fatal('WhitneyAVHarmonicSolver','JfixRhsC should be associated!') + END IF + IF(.NOT. ASSOCIATED( JFixSurfacePerm ) ) THEN + CALL Fatal('WhitneyAVHarmonicSolver','JFixVecSurfacePerm should be associated!') + END IF + IF(.NOT. ALLOCATED( JFixSurfaceVecC ) ) THEN + CALL Fatal('WhitneyAVHarmonicSolver','JFixVecSurfaceVecC should be associated!') + END IF + END IF - ! Resolve internal non.linearities, if requested: - ! ---------------------------------------------- - NoIterationsMax = GetInteger( SolverParams, & - 'Nonlinear System Max Iterations',Found) - IF(.NOT. Found) NoIterationsMax = 1 - - NoIterationsMin = GetInteger( SolverParams, & - 'Nonlinear System Min Iterations',Found) - IF(.NOT. Found) NoIterationsMin = 1 - - ! Use also these keyword for compatibility with ElmerGUI and old practices - NewtonIter = GetInteger( SolverParams,& - 'Nonlinear System Newton After Iterations',Found ) - IF(.NOT. Found ) NewtonIter = NoIterationsMax - NewtonTol = GetCReal( SolverParams,& - 'Nonlinear System Newton After Tolerance',Found ) - - - LFact = GetLogical( SolverParams,'Linear System Refactorize', LFactFound ) - EdgeBasis = .NOT. LFactFound .AND. GetLogical( SolverParams, 'Edge Basis', Found ) - - CALL DefaultStart() - - DO i=1,NoIterationsMax - ExtNewton = ( i > NewtonIter .OR. Solver % Variable % NonlinChange < NewtonTol ) - - IF( DoSolve(i) ) THEN - IF(i>=NoIterationsMin) EXIT + HbCurveVarName = GetString( SolverParams,'H-B Curve Variable', GotHbCurveVar ) + IF( GotHbCurveVar ) THEN + HbCurveVar => VariableGet( Mesh % Variables, HbCurveVarName ) + IF(.NOT. ASSOCIATED( HbCurveVar ) ) THEN + CALL Fatal('WhitneyAVHarmonicSolver','H-B Curve variable given but does not exist: '& + //TRIM(HbCurveVarName)) + END IF END IF - IF( EdgeBasis ) CALL ListAddLogical(SolverParams,'Linear System Refactorize',.FALSE.) - - JFixSolve = .FALSE. - END DO - IF ( EdgeBasis ) CALL ListRemove( SolverParams, 'Linear System Refactorize' ) - - CALL CalculateLumped(Model % NumberOfBodyForces) - - CALL DefaultFinish() - - -CONTAINS - -!--------------------------------------------------------------------------------------------- - FUNCTION DoSolve(IterNo) RESULT(Converged) -!--------------------------------------------------------------------------------------------- - IMPLICIT NONE - INTEGER :: IterNo - LOGICAL :: Converged -!--------------------------------------------------------------------------------------------- - REAL(KIND=dp) :: Norm, PrevNorm, TOL - INTEGER :: i,j,k,n,nd,t,ComponentId - REAL(KIND=dp), ALLOCATABLE :: Diag(:) - LOGICAL :: FoundMagnetization, Found, ConstraintActive, GotCoil, CircuitDrivenBC -!--------------------------------------------------------------------------------------------- - ! System assembly: - !----------------- - CALL DefaultInitialize() - Active = GetNOFActive() - - DO t=1,active - Element => GetActiveElement(t) - n = GetElementNOFNodes() ! vertices - nd = GetElementNOFDOFs() ! dofs - - IF (SIZE(Tcoef,3) /= n) THEN - DEALLOCATE(Tcoef) - ALLOCATE(Tcoef(3,3,n)) - END IF - - LOAD = 0.0d0 - BodyForce => GetBodyForce() - FoundMagnetization = .FALSE. - - ! If the coil current field is elemental it is discontinuous and need not be limited - ! to the body force. For nodal ones we don't have the same luxury. - GotCoil = .FALSE. - IF( UseCoilCurrent ) THEN - IF( ElemCurrent .OR. ASSOCIATED(BodyForce) ) THEN - CALL GetVectorLocalSolution( ReLoad,UElement=Element,UVariable=CoilCurrentVar,Found=GotCoil) - LOAD(1:3,1:n) = ReLoad(1:3,1:n) + + ! Resolve internal non.linearities, if requested: + ! ---------------------------------------------- + NoIterationsMax = GetInteger( SolverParams, & + 'Nonlinear System Max Iterations',Found) + IF(.NOT. Found) NoIterationsMax = 1 + + NoIterationsMin = GetInteger( SolverParams, & + 'Nonlinear System Min Iterations',Found) + IF(.NOT. Found) NoIterationsMin = 1 + + ! Use also these keyword for compatibility with ElmerGUI and old practices + NewtonIter = GetInteger( SolverParams,& + 'Nonlinear System Newton After Iterations',Found ) + IF(.NOT. Found ) NewtonIter = NoIterationsMax + NewtonTol = GetCReal( SolverParams,& + 'Nonlinear System Newton After Tolerance',Found ) + + + LFact = GetLogical( SolverParams,'Linear System Refactorize', LFactFound ) + EdgeBasis = .NOT. LFactFound .AND. GetLogical( SolverParams, 'Edge Basis', Found ) + + CALL DefaultStart() + + DO i=1,NoIterationsMax + ExtNewton = ( i > NewtonIter .OR. Solver % Variable % NonlinChange < NewtonTol ) + + IF( DoSolve(i) ) THEN + IF(i>=NoIterationsMin) EXIT + END IF + IF( EdgeBasis ) CALL ListAddLogical(SolverParams,'Linear System Refactorize',.FALSE.) + + JFixSolve = .FALSE. + END DO + IF ( EdgeBasis ) CALL ListRemove( SolverParams, 'Linear System Refactorize' ) + + CALL CalculateLumped(Model % NumberOfBodyForces) + + CALL DefaultFinish() + + + CONTAINS + + !--------------------------------------------------------------------------------------------- + FUNCTION DoSolve(IterNo) RESULT(Converged) + !--------------------------------------------------------------------------------------------- + IMPLICIT NONE + INTEGER :: IterNo + LOGICAL :: Converged + !--------------------------------------------------------------------------------------------- + REAL(KIND=dp) :: Norm, PrevNorm, TOL + INTEGER :: i,j,k,n,nd,t,ComponentId + REAL(KIND=dp), ALLOCATABLE :: Diag(:) + LOGICAL :: FoundMagnetization, Found, ConstraintActive, GotCoil, CircuitDrivenBC + !--------------------------------------------------------------------------------------------- + ! System assembly: + !----------------- + CALL DefaultInitialize() + Active = GetNOFActive() + + DO t=1,active + Element => GetActiveElement(t) + n = GetElementNOFNodes() ! vertices + nd = GetElementNOFDOFs() ! dofs + + IF (SIZE(Tcoef,3) /= n) THEN + DEALLOCATE(Tcoef) + ALLOCATE(Tcoef(3,3,n)) END IF - END IF - - IF ( ASSOCIATED(BodyForce) ) THEN - ! If not already given by CoilCurrent, request for current density - IF( .NOT. GotCoil ) THEN - CALL GetComplexVector( BodyForce, Load(1:3,1:n), 'Current Density', Found ) + + LOAD = 0.0d0 + BodyForce => GetBodyForce() + FoundMagnetization = .FALSE. + + ! If the coil current field is elemental it is discontinuous and need not be limited + ! to the body force. For nodal ones we don't have the same luxury. + GotCoil = .FALSE. + IF( UseCoilCurrent ) THEN + IF( ElemCurrent .OR. ASSOCIATED(BodyForce) ) THEN + CALL GetVectorLocalSolution( ReLoad,UElement=Element,UVariable=CoilCurrentVar,Found=GotCoil) + LOAD(1:3,1:n) = ReLoad(1:3,1:n) + END IF END IF - - CurrAmp = ListGetCReal( BodyForce,'Current Density Multiplier',Found ) - IF(Found) Load(1:3,1:n) = CurrAmp * Load(1:3,1:n) - - CALL GetComplexVector( BodyForce, Load(4:6,1:n), & - 'Magnetization', FoundMagnetization ) - - Load(7,1:n) = GetReal( BodyForce, 'Electric Potential', Found ) - Load(7,1:n) = CMPLX( REAL(Load(7,1:n)), & - GetReal( BodyForce, 'Electric Potential im', Found), KIND=dp) - END IF - - Material => GetMaterial( Element ) - - IF(ASSOCIATED(Material).AND..NOT.FoundMagnetization) THEN - CALL GetComplexVector( Material, Load(4:6,1:n), & - 'Magnetization', FoundMagnetization ) - END IF - - CoilBody = .FALSE. - CompParams => GetComponentParams( Element ) - CoilType = '' - RotM = 0._dp - ConstraintActive = .TRUE. - IF (ASSOCIATED(CompParams)) THEN - CoilType = GetString(CompParams, 'Coil Type', Found) - IF (Found) THEN - SELECT CASE (CoilType) - CASE ('stranded') - CoilBody = .TRUE. - StrandedHomogenization = GetLogical(CompParams, 'Homogenization Model', Found) - IF( StrandedHomogenization ) THEN + + IF ( ASSOCIATED(BodyForce) ) THEN + ! If not already given by CoilCurrent, request for current density + IF( .NOT. GotCoil ) THEN + CALL GetComplexVector( BodyForce, Load(1:3,1:n), 'Current Density', Found ) + END IF + + CurrAmp = ListGetCReal( BodyForce,'Current Density Multiplier',Found ) + IF(Found) Load(1:3,1:n) = CurrAmp * Load(1:3,1:n) + + CALL GetComplexVector( BodyForce, Load(4:6,1:n), & + 'Magnetization', FoundMagnetization ) + + Load(7,1:n) = GetReal( BodyForce, 'Electric Potential', Found ) + Load(7,1:n) = CMPLX( REAL(Load(7,1:n)), & + GetReal( BodyForce, 'Electric Potential im', Found), KIND=dp) + END IF + + Material => GetMaterial( Element ) + + IF(ASSOCIATED(Material).AND..NOT.FoundMagnetization) THEN + CALL GetComplexVector( Material, Load(4:6,1:n), & + 'Magnetization', FoundMagnetization ) + END IF + + CoilBody = .FALSE. + CompParams => GetComponentParams( Element ) + CoilType = '' + RotM = 0._dp + ConstraintActive = .TRUE. + IF (ASSOCIATED(CompParams)) THEN + CoilType = GetString(CompParams, 'Coil Type', Found) + IF (Found) THEN + SELECT CASE (CoilType) + CASE ('stranded') + CoilBody = .TRUE. + StrandedHomogenization = GetLogical(CompParams, 'Homogenization Model', Found) + IF( StrandedHomogenization ) THEN + CALL GetElementRotM(Element, RotM, n) + END IF + CASE ('massive') + CoilBody = .TRUE. + CASE ('foil winding') + CoilBody = .TRUE. CALL GetElementRotM(Element, RotM, n) - END IF - CASE ('massive') - CoilBody = .TRUE. - CASE ('foil winding') - CoilBody = .TRUE. - CALL GetElementRotM(Element, RotM, n) - CASE DEFAULT - CALL Fatal ('WhitneyAVHarmonicSolver', 'Non existent Coil Type Chosen!') - END SELECT + CASE DEFAULT + CALL Fatal ('WhitneyAVHarmonicSolver', 'Non existent Coil Type Chosen!') + END SELECT + END IF + ConstraintActive = GetLogical( CompParams, 'Activate Constraint', Found) + ! IF(.NOT.Found .AND. CoilType /= 'stranded') ConstraintActive = .TRUE. + IF(.NOT.Found ) ConstraintActive = .FALSE. END IF - ConstraintActive = GetLogical( CompParams, 'Activate Constraint', Found) -! IF(.NOT.Found .AND. CoilType /= 'stranded') ConstraintActive = .TRUE. - IF(.NOT.Found ) ConstraintActive = .FALSE. - END IF - - LaminateStack = .FALSE. - LaminateStackModel = '' - HasTensorReluctivity = .FALSE. - Acoef = 0.0_dp - Tcoef = 0.0_dp - IF ( ASSOCIATED(Material) ) THEN - IF (.NOT. ListCheckPresent(Material, 'H-B Curve')) THEN - CALL GetReluctivity(Material,Acoef_t,n,HasTensorReluctivity) - IF (HasTensorReluctivity) THEN - IF (size(Acoef_t,1)==1 .AND. size(Acoef_t,2)==1) THEN - Acoef(1:n) = Acoef_t(1,1,1:n) - HasTensorReluctivity = .FALSE. - ELSE IF (size(Acoef_t,1)/=3) THEN - CALL Fatal('WhitneyAVHarmonicSolver', 'Reluctivity tensor should be of size 3x3') + + LaminateStack = .FALSE. + LaminateStackModel = '' + HasTensorReluctivity = .FALSE. + Acoef = 0.0_dp + Tcoef = 0.0_dp + IF ( ASSOCIATED(Material) ) THEN + IF (.NOT. ListCheckPresent(Material, 'H-B Curve')) THEN + CALL GetReluctivity(Material,Acoef_t,n,HasTensorReluctivity) + IF (HasTensorReluctivity) THEN + IF (size(Acoef_t,1)==1 .AND. size(Acoef_t,2)==1) THEN + Acoef(1:n) = Acoef_t(1,1,1:n) + HasTensorReluctivity = .FALSE. + ELSE IF (size(Acoef_t,1)/=3) THEN + CALL Fatal('WhitneyAVHarmonicSolver', 'Reluctivity tensor should be of size 3x3') + END IF + ELSE + CALL GetReluctivity(Material,Acoef,n) END IF - ELSE - CALL GetReluctivity(Material,Acoef,n) END IF + !------------------------------------------------------------------------------ + ! Read conductivity values (might be a tensor) + !------------------------------------------------------------------------------ + Tcoef = GetCMPLXElectricConductivityTensor(Element, n, CoilBody, CoilType) + + LaminateStackModel = GetString( Material, 'Laminate Stack Model', LaminateStack ) END IF -!------------------------------------------------------------------------------ -! Read conductivity values (might be a tensor) -!------------------------------------------------------------------------------ - Tcoef = GetCMPLXElectricConductivityTensor(Element, n, CoilBody, CoilType) - - LaminateStackModel = GetString( Material, 'Laminate Stack Model', LaminateStack ) - END IF - - LamThick=0d0 - LamCond=0d0 - IF (LaminateStack) THEN - SELECT CASE(LaminateStackModel) - CASE('low-frequency model') - LamThick(1:n) = GetReal( Material, 'Laminate Thickness', Found ) - IF (.NOT. Found) CALL Fatal('WhitneyAVHarmonicSolver', 'Laminate Thickness not found!') - - LamCond(1:n) = GetReal( Material, 'Laminate Stack Conductivity', Found ) - IF (.NOT. Found) CALL Fatal('WhitneyAVHarmonicSolver', 'Laminate Stack Conductivity not found!') - LamCond(1:n) = CMPLX( REAL(LamCond(1:n)), & - GetReal( Material, 'Electric Conductivity im', Found), KIND=dp) - CASE('wide-frequency-band model') - LamThick(1:n) = GetReal( Material, 'Laminate Thickness', Found ) - IF (.NOT. Found) CALL Fatal('WhitneyAVHarmonicSolver', 'Laminate Thickness not found!') - - LamCond(1:n) = GetReal( Material, 'Laminate Stack Conductivity', Found ) - IF (.NOT. Found) CALL Fatal('WhitneyAVHarmonicSolver', 'Laminate Stack Conductivity not found!') - LamCond(1:n) = CMPLX( REAL(LamCond(1:n)), & - GetReal( Material, 'Electric Conductivity im', Found), KIND=dp) - CASE DEFAULT - CALL WARN('WhitneyAVHarmonicSolver', 'Nonexistent Laminate Stack Model chosen!') - END SELECT - END IF - - Omega = GetAngularFrequency(Found=Found,UElement=Element) - - !Get element local matrix and rhs vector: - !---------------------------------------- - CALL LocalMatrix( MASS, STIFF, FORCE, JFixFORCE, JFixVec, LOAD, & - Tcoef, Acoef, LaminateStack, LaminateStackModel, LamThick, & - LamCond, CoilBody, CoilType, RotM, ConstraintActive, Element, n, nd, PiolaVersion, SecondOrder ) - - !Update global matrix and rhs vector from local matrix & vector: - !--------------------------------------------------------------- - CALL DefaultUpdateEquations( STIFF, FORCE ) - IF (EigenSystem) CALL DefaultUpdateMass(MASS) - - ! Memorize stuff for the fixing potential - ! 1) Divergence of the source term - ! 2) The source terms at the surface to determine the direction - !------------------------------------------------------------------- - IF( JFixSolve ) THEN - JFixRhsC(JFixVar % Perm(Element % NodeIndexes)) = & - JFixRhsC(JFixVar % Perm(Element % NodeIndexes)) + JFixFORCE(1:n) - DO i=1,n - j = JfixSurfacePerm(Element % NodeIndexes(i) ) - IF( j > 0 ) JfixSurfaceVecC(3*j-2:3*j) = & - JfixSurfaceVecC(3*j-2:3*j) + JFixVec(1:3,i) - END DO - END IF - END DO + + LamThick=0d0 + LamCond=0d0 + IF (LaminateStack) THEN + SELECT CASE(LaminateStackModel) + CASE('low-frequency model') + LamThick(1:n) = GetReal( Material, 'Laminate Thickness', Found ) + IF (.NOT. Found) CALL Fatal('WhitneyAVHarmonicSolver', 'Laminate Thickness not found!') - IF( JfixSolve ) THEN - CALL Info('WhitneyAVHarmonicSolver','Solving the fixing potential') - JfixPhase = 2 - CALL JfixPotentialSolver(Model,Solver,dt,Transient) - - CALL Info('WhitneyAVHarmonicSolver','Adding the fixing potential to the r.h.s. of AV equation') - DO t=1,active - Element => GetActiveElement(t) - n = GetElementNOFNodes() - nd = GetElementNOFDOFs() - nb = GetElementNOFBDOFs() - - CALL LocalFixMatrixC( FORCE, Element, n, nd+nb, PiolaVersion, SecondOrder) + LamCond(1:n) = GetReal( Material, 'Laminate Stack Conductivity', Found ) + IF (.NOT. Found) CALL Fatal('WhitneyAVHarmonicSolver', 'Laminate Stack Conductivity not found!') + LamCond(1:n) = CMPLX( REAL(LamCond(1:n)), & + GetReal( Material, 'Electric Conductivity im', Found), KIND=dp) + CASE('wide-frequency-band model') + LamThick(1:n) = GetReal( Material, 'Laminate Thickness', Found ) + IF (.NOT. Found) CALL Fatal('WhitneyAVHarmonicSolver', 'Laminate Thickness not found!') + + LamCond(1:n) = GetReal( Material, 'Laminate Stack Conductivity', Found ) + IF (.NOT. Found) CALL Fatal('WhitneyAVHarmonicSolver', 'Laminate Stack Conductivity not found!') + LamCond(1:n) = CMPLX( REAL(LamCond(1:n)), & + GetReal( Material, 'Electric Conductivity im', Found), KIND=dp) + CASE DEFAULT + CALL WARN('WhitneyAVHarmonicSolver', 'Nonexistent Laminate Stack Model chosen!') + END SELECT + END IF + + Omega = GetAngularFrequency(Found=Found,UElement=Element) + + !Get element local matrix and rhs vector: + !---------------------------------------- + CALL LocalMatrix( MASS, STIFF, FORCE, JFixFORCE, JFixVec, LOAD, & + Tcoef, Acoef, LaminateStack, LaminateStackModel, LamThick, & + LamCond, CoilBody, CoilType, RotM, ConstraintActive, Element, n, nd, PiolaVersion, SecondOrder ) + + !Update global matrix and rhs vector from local matrix & vector: + !--------------------------------------------------------------- + CALL DefaultUpdateEquations( STIFF, FORCE ) + IF (EigenSystem) CALL DefaultUpdateMass(MASS) + + ! Memorize stuff for the fixing potential + ! 1) Divergence of the source term + ! 2) The source terms at the surface to determine the direction + !------------------------------------------------------------------- + IF( JFixSolve ) THEN + JFixRhsC(JFixVar % Perm(Element % NodeIndexes)) = & + JFixRhsC(JFixVar % Perm(Element % NodeIndexes)) + JFixFORCE(1:n) + DO i=1,n + j = JfixSurfacePerm(Element % NodeIndexes(i) ) + IF( j > 0 ) JfixSurfaceVecC(3*j-2:3*j) = & + JfixSurfaceVecC(3*j-2:3*j) + JFixVec(1:3,i) + END DO + END IF END DO - CALL Info('WhitneyAVHarmonicSolver','Finished adding the fixing potential',Level=10) - END IF - - - ! Robin type of BC in terms of H: - !-------------------------------- - Active = GetNOFBoundaryElements() - DO t=1,Active - Element => GetBoundaryElement(t) - BC=>GetBC() - IF (.NOT. ASSOCIATED(BC) ) CYCLE - - SELECT CASE(GetElementFamily()) - CASE(1) - CYCLE - CASE(2) - k = GetBoundaryEdgeIndex(Element,1); Element => Mesh % Edges(k) - CASE(3,4) - k = GetBoundaryFaceIndex(Element) ; Element => Mesh % Faces(k) - END SELECT - IF (.NOT. ActiveBoundaryElement(Element)) CYCLE - - Model % CurrentElement => Element - nd = GetElementNOFDOFs(Element) - n = GetElementNOFNodes(Element) - - CALL GetComplexVector( BC, Load(1:3,1:n), 'Magnetic Field Strength', Found) - - Load(4,1:n) = GetReal( BC, 'Electric Current Density', Found ) - IF (.NOT. Found) Load(4,1:n) = GetReal( BC, 'Electric Flux', Found ) - - Load(4,1:n) = CMPLX( REAL(LOAD(4,1:n)), & - GetReal( BC, 'Electric Current Density im', Found), KIND=dp) - - IF (.NOT. Found) Load(4,1:n) = CMPLX( REAL(LOAD(4,1:n)), & - GetReal( BC, 'Electric Flux im', Found), KIND=dp) - - Load(5,1:n) = GetReal( BC, 'Electric Transfer Coefficient', Found ) - Load(5,1:n) = CMPLX( REAL(Load(5,1:n)), & - GetReal( BC, 'Electric Transfer Coefficient im', Found), KIND=dp) - - Acoef(1:n) = GetReal( BC, 'Magnetic Transfer Coefficient', Found ) - Acoef(1:n) = CMPLX( REAL(Acoef(1:n)), & - GetReal( BC, 'Magnetic Transfer Coefficient im', Found), KIND=dp) - - !If air gap length keyword is detected, use air gap boundary condition - GapLength = GetConstReal( BC, 'Air Gap Length', Found) - IF (Found) THEN - MuParameter=GetConstReal( BC, 'Air Gap Relative Permeability', Found) - IF (.NOT. Found) MuParameter = 1.0_dp ! if not found default to "air" property - CALL LocalMatrixAirGapBC(MASS,STIFF,FORCE,LOAD,GapLength,MuParameter,Element,n,nd ) - ELSE - SkinCond = GetConstReal( BC, 'Layer Electric Conductivity', Found) - IF (ANY(ABS(SkinCond(1:n)) > AEPS)) THEN - MuParameter = GetConstReal( BC, 'Layer Relative Permeability', Found) - ComponentId=GetInteger( BC, 'Component', CircuitDrivenBC) - IF (.NOT. Found) MuParameter = 1.0_dp ! if not found default to "air" property - CALL LocalMatrixSkinBC(MASS,STIFF,FORCE,SkinCond,MuParameter,Element,CircuitDrivenBC,n,nd) - ELSE - GapLength = GetConstReal( BC, 'Thin Sheet Thickness', Found) - IF (Found) THEN - MuParameter=GetConstReal( BC, 'Thin Sheet Relative Permeability', Found) - IF (.NOT. Found) MuParameter = 1.0_dp ! if not found default to "air" property - ! Technically, there is no skin but why create yet another conductivity variable? - SkinCond = GetConstReal( BC, 'Thin Sheet Electric Conductivity', Found) - IF (.NOT. Found) SkinCond = 1.0_dp ! if not found default to "air" property - CALL LocalMatrixThinSheet( MASS, STIFF, FORCE, LOAD, GapLength, MuParameter, & - SkinCond, Element, n, nd ) - ELSE - CALL LocalMatrixBC(MASS,STIFF,FORCE,LOAD,Acoef,Element,n,nd ) + + IF( JfixSolve ) THEN + CALL Info('WhitneyAVHarmonicSolver','Solving the fixing potential') + JfixPhase = 2 + CALL JfixPotentialSolver(Model,Solver,dt,Transient) + + CALL Info('WhitneyAVHarmonicSolver','Adding the fixing potential to the r.h.s. of AV equation') + DO t=1,active + Element => GetActiveElement(t) + n = GetElementNOFNodes() + nd = GetElementNOFDOFs() + nb = GetElementNOFBDOFs() + + CALL LocalFixMatrixC( FORCE, Element, n, nd+nb, PiolaVersion, SecondOrder) + END DO + CALL Info('WhitneyAVHarmonicSolver','Finished adding the fixing potential',Level=10) + END IF + + + ! Robin type of BC in terms of H: + !-------------------------------- + Active = GetNOFBoundaryElements() + DO t=1,Active + Element => GetBoundaryElement(t) + BC=>GetBC() + IF (.NOT. ASSOCIATED(BC) ) CYCLE + + SELECT CASE(GetElementFamily()) + CASE(1) + CYCLE + CASE(2) + k = GetBoundaryEdgeIndex(Element,1); Element => Mesh % Edges(k) + CASE(3,4) + k = GetBoundaryFaceIndex(Element) ; Element => Mesh % Faces(k) + END SELECT + IF (.NOT. ActiveBoundaryElement(Element)) CYCLE + + Model % CurrentElement => Element + nd = GetElementNOFDOFs(Element) + n = GetElementNOFNodes(Element) + + CALL GetComplexVector( BC, Load(1:3,1:n), 'Magnetic Field Strength', Found) + + Load(4,1:n) = GetReal( BC, 'Electric Current Density', Found ) + IF (.NOT. Found) Load(4,1:n) = GetReal( BC, 'Electric Flux', Found ) + + Load(4,1:n) = CMPLX( REAL(LOAD(4,1:n)), & + GetReal( BC, 'Electric Current Density im', Found), KIND=dp) + + IF (.NOT. Found) Load(4,1:n) = CMPLX( REAL(LOAD(4,1:n)), & + GetReal( BC, 'Electric Flux im', Found), KIND=dp) + + Load(5,1:n) = GetReal( BC, 'Electric Transfer Coefficient', Found ) + Load(5,1:n) = CMPLX( REAL(Load(5,1:n)), & + GetReal( BC, 'Electric Transfer Coefficient im', Found), KIND=dp) + + Acoef(1:n) = GetReal( BC, 'Magnetic Transfer Coefficient', Found ) + Acoef(1:n) = CMPLX( REAL(Acoef(1:n)), & + GetReal( BC, 'Magnetic Transfer Coefficient im', Found), KIND=dp) + + !If air gap length keyword is detected, use air gap boundary condition + GapLength = GetConstReal( BC, 'Air Gap Length', Found) + IF (Found) THEN + MuParameter=GetConstReal( BC, 'Air Gap Relative Permeability', Found) + IF (.NOT. Found) MuParameter = 1.0_dp ! if not found default to "air" property + CALL LocalMatrixAirGapBC(MASS,STIFF,FORCE,LOAD,GapLength,MuParameter,Element,n,nd ) + ELSE + SkinCond = GetConstReal( BC, 'Layer Electric Conductivity', Found) + IF (ANY(ABS(SkinCond(1:n)) > AEPS)) THEN + MuParameter = GetConstReal( BC, 'Layer Relative Permeability', Found) + ComponentId=GetInteger( BC, 'Component', CircuitDrivenBC) + IF (.NOT. Found) MuParameter = 1.0_dp ! if not found default to "air" property + CALL LocalMatrixSkinBC(MASS,STIFF,FORCE,SkinCond,MuParameter,Element,CircuitDrivenBC,n,nd) + ELSE + GapLength = GetConstReal( BC, 'Thin Sheet Thickness', Found) + IF (Found) THEN + MuParameter=GetConstReal( BC, 'Thin Sheet Relative Permeability', Found) + IF (.NOT. Found) MuParameter = 1.0_dp ! if not found default to "air" property + ! Technically, there is no skin but why create yet another conductivity variable? + SkinCond = GetConstReal( BC, 'Thin Sheet Electric Conductivity', Found) + IF (.NOT. Found) SkinCond = 1.0_dp ! if not found default to "air" property + CALL LocalMatrixThinSheet( MASS, STIFF, FORCE, LOAD, GapLength, MuParameter, & + SkinCond, Element, n, nd ) + ELSE + CALL LocalMatrixBC(MASS,STIFF,FORCE,LOAD,Acoef,Element,n,nd ) + END IF END IF END IF - END IF - - CALL DefaultUpdateEquations(STIFF,FORCE,Element) - IF(EigenSystem) CALL DefaultUpdateMass(MASS,Element) - END DO - - CALL DefaultFinishAssembly() - - ! - ! Check for tree gauge, if requested or using direct solver: - ! ------------------------------------------------------------ - TG=GetLogical(SolverParams, 'Use tree gauge', Found) - IF (.NOT. Found) TG=GetString(GetSolverParams(), & - 'Linear System Solver',Found)=='direct' - - ! - ! Dirichlet BCs in terms of vector potential A: - ! --------------------------------------------- - IF ( TG ) THEN - ! temporary fix to some scaling problem (to be resolved)... - CALL ListAddLogical( SolverParams, 'Linear System Dirichlet Scaling', .FALSE.) - END IF - - -BLOCK -! Automatic BC for massive,foil coils outer boundaries, when "Activate Constraint" on!! - - TYPE(Element_t), POINTER :: Parent - LOGICAL :: AutomaticBC - INTEGER, POINTER :: Electrodes(:) - - A => GetMatrix() - - IF (.NOT.ALLOCATED(A % ConstrainedDOF)) THEN - ALLOCATE(A % ConstrainedDOF(A % NumberOfRows)) - A % ConstrainedDOF = .FALSE. - END IF - - IF(.NOT.ALLOCATED(A % DValues)) THEN - ALLOCATE(A % Dvalues(A % NumberOfRows)) - A % Dvalues = 0._dp - END IF - - Active = GetNOFBoundaryElements() - DO t = 1, Active - Element => GetBoundaryElement(t) - - Parent => Element % BoundaryInfo % Right - IF(ASSOCIATED(Parent)) CYCLE - - IF(ParEnv % PEs>1) THEN - ! Assuming here that this is an internal boundary, if all elements nodes are - ! interface nodes. Not foolproof i guess, but quite safe (?) - IF (ALL(Solver % Mesh % ParallelInfo % GInterface(Element % NodeIndexes))) CYCLE - END IF - - Parent => Element % BoundaryInfo % Left - IF(.NOT.ASSOCIATED(Parent)) CYCLE - - CompParams => GetComponentParams(Parent) - IF (.NOT. ASSOCIATED(CompParams)) CYCLE - - CoilType = GetString(CompParams, 'Coil Type', Found) - IF(CoilType/='massive' .AND. CoilType/='foil winding') CYCLE - - ConstraintActive = GetLogical(CompParams,'Activate Constraint',Found ) - IF( .NOT. ConstraintActive ) CYCLE - - AutomaticBC = GetLogical( CompParams, 'Automatic electrode BC', Found ) - IF(.NOT.Found) AutomaticBC = .TRUE. - - IF(.NOT.AutomaticBC) CYCLE - - Electrodes => ListGetIntegerArray( CompParams, & - 'Electrode Boundaries', Found ) - - IF(ASSOCIATED(Electrodes)) THEN - IF(ALL(Electrodes/=Element % BoundaryInfo % Constraint)) CYCLE - END IF - - DO i=1,Element % Type % NumberOfNodes - j = 2*(Solver % Variable % Perm(Element % NodeIndexes(i))-1)+1 - A % ConstrainedDOF(j:j+1) = .TRUE. - END DO - END DO -END BLOCK - - CALL DefaultDirichletBCs() - - ! - ! Dirichlet BCs in terms of magnetic flux density B: - ! -------------------------------------------------- - CALL DirichletAfromB() - - - A => GetMatrix() - IF (TG) THEN - IF(.NOT.ALLOCATED(TreeEdges)) & - CALL GaugeTree(Solver,Mesh,TreeEdges,FluxCount,FluxMap,Transient) - - WRITE(Message,*) 'Volume tree edges: ', & - i2s(COUNT(TreeEdges)), & - ' of total: ',Mesh % NumberOfEdges - CALL Info('WhitneyAVHarmonicSolver: ', Message, Level=5) - - DO i=1,SIZE(TreeEdges) - IF(TreeEdges(i)) CALL SetDOFToValue(Solver,i,(0._dp,0._dp)) + + CALL DefaultUpdateEquations(STIFF,FORCE,Element) + IF(EigenSystem) CALL DefaultUpdateMass(MASS,Element) END DO - END IF - - ! - ! Fix unused potential DOFs: - ! -------------------------- - CALL ConstrainUnused(A) - - ! - ! Linear system solution: - ! ----------------------- - Norm = DefaultSolve() - Converged = Solver % Variable % NonlinConverged==1 -!------------------------------------------------------------------------------ - END FUNCTION DoSolve -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ - SUBROUTINE ConstrainUnused(A) -!------------------------------------------------------------------------------ - IMPLICIT NONE - TYPE(Matrix_t) :: A -!------------------------------------------------------------------------------ - INTEGER :: i,j,n - - REAL(KIND=dp), ALLOCATABLE :: dDiag(:) -!------------------------------------------------------------------------------ - n = A % NumberOFRows - ALLOCATE(dDiag(n)); dDiag=0._dp - - DO i=1,n,2 - j = A % Diag(i) - IF(j>0) THEN - dDiag(i) = A % Values(j) - dDiag(i+1) = -A % Values(j+1) - END IF - END DO - IF (ParEnv % PEs>1) CALL ParallelSumVector(A, dDiag) - - n = Mesh % NumberOfNodes - DO i=1,SIZE(Solver % Variable % Perm) !n - j = Solver % Variable % Perm(i) - IF (j==0) CYCLE - - j = 2*(j-1) - Aval = CMPLX(dDiag(j+1), dDiag(j+2), KIND=dp) - - IF (ABS(Aval)==0._dp) THEN - A % RHS(j+1) = 0._dp - CALL ZeroRow(A,j+1) - A % Values(A % Diag(j+1)) = 1._dp - - A % RHS(j+2) = 0._dp - CALL ZeroRow(A,j+2) - A % Values(A % Diag(j+2)) = 1._dp - - IF(ALLOCATED(A % ConstrainedDOF)) THEN - A % ConstrainedDOF(j+1) = .TRUE. - A % ConstrainedDOF(j+2) = .TRUE. - END IF + + CALL DefaultFinishAssembly() + + ! + ! Check for tree gauge, if requested or using direct solver: + ! ------------------------------------------------------------ + TG=GetLogical(SolverParams, 'Use tree gauge', Found) + IF (.NOT. Found) TG=GetString(GetSolverParams(), & + 'Linear System Solver',Found)=='direct' + + ! + ! Dirichlet BCs in terms of vector potential A: + ! --------------------------------------------- + IF ( TG ) THEN + ! temporary fix to some scaling problem (to be resolved)... + CALL ListAddLogical( SolverParams, 'Linear System Dirichlet Scaling', .FALSE.) END IF - END DO -!------------------------------------------------------------------------------ - END SUBROUTINE ConstrainUnused -!------------------------------------------------------------------------------ - - -!------------------------------------------------------------------------------ - SUBROUTINE CalculateLumped(nbf) -!------------------------------------------------------------------------------ - IMPLICIT NONE - INTEGER::nbf -!------------------------------------------------------------------------------ - REAL(KIND=dp) :: a(nbf),IMoment,IA - INTEGER :: i,bfid,n,nd,EdgeBasisDegree - TYPE(Element_t), POINTER :: Element, Parent - COMPLEX(KIND=dp) :: torq, U(nbf), zforce, zzforce - LOGICAL :: Found, CalcTorque,CalcPotential,CalcInertia - TYPE(ValueList_t),POINTER::Params -!------------------------------------------------------------------------------ - - CalcTorque = ListCheckPresentAnyBody(Model,'r inner') - CalcPotential = ListGetLogicalAnyBodyForce( Model,'Calculate Potential') - CalcInertia = ListGetLogicalAnyBody( Model,'Calculate Inertial Moment') - - IF(.NOT. (CalcTorque .OR. CalcPotential .OR. CalcInertia ) ) RETURN - - EdgeBasisDegree = 1 - IF (SecondOrder) EdgeBasisDegree = 2 - - U=0._dp; a=0._dp; torq=0._dp; IMoment=0._dp;IA=0; zforce=0 - DO i=1,GetNOFActive() - Element => GetActiveElement(i) - nd = GetElementNOFDOFs(Element) - n = GetElementNOFNodes(Element) - - IF( CalcTorque ) THEN - CALL Torque(Torq,Element,n,nd,EdgeBasisDegree) - CALL AxialForce(zforce,Element,n,nd,EdgeBasisDegree) - END IF - - IF( CalcPotential ) THEN - Params=>GetBodyForce(Element) - IF(ASSOCIATED(Params)) THEN - bfid=GetBodyForceId(Element) - IF(GetLogical(Params,'Calculate Potential',Found)) & - CALL Potential(u(bfid),a(bfid),Element,n,nd,EdgeBasisDegree) + + + BLOCK + ! Automatic BC for massive,foil coils outer boundaries, when "Activate Constraint" on!! + + TYPE(Element_t), POINTER :: Parent + LOGICAL :: AutomaticBC + INTEGER, POINTER :: Electrodes(:) + + A => GetMatrix() + + IF (.NOT.ALLOCATED(A % ConstrainedDOF)) THEN + ALLOCATE(A % ConstrainedDOF(A % NumberOfRows)) + A % ConstrainedDOF = .FALSE. + END IF + + IF(.NOT.ALLOCATED(A % DValues)) THEN + ALLOCATE(A % Dvalues(A % NumberOfRows)) + A % Dvalues = 0._dp + END IF + + Active = GetNOFBoundaryElements() + DO t = 1, Active + Element => GetBoundaryElement(t) + + Parent => Element % BoundaryInfo % Right + IF(ASSOCIATED(Parent)) CYCLE + + IF(ParEnv % PEs>1) THEN + ! Assuming here that this is an internal boundary, if all elements nodes are + ! interface nodes. Not foolproof i guess, but quite safe (?) + IF (ALL(Solver % Mesh % ParallelInfo % GInterface(Element % NodeIndexes))) CYCLE + END IF + + Parent => Element % BoundaryInfo % Left + IF(.NOT.ASSOCIATED(Parent)) CYCLE + + CompParams => GetComponentParams(Parent) + IF (.NOT. ASSOCIATED(CompParams)) CYCLE + + CoilType = GetString(CompParams, 'Coil Type', Found) + IF(CoilType/='massive' .AND. CoilType/='foil winding') CYCLE + + ConstraintActive = GetLogical(CompParams,'Activate Constraint',Found ) + IF( .NOT. ConstraintActive ) CYCLE + + AutomaticBC = GetLogical( CompParams, 'Automatic electrode BC', Found ) + IF(.NOT.Found) AutomaticBC = .TRUE. + + IF(.NOT.AutomaticBC) CYCLE + + Electrodes => ListGetIntegerArray( CompParams, & + 'Electrode Boundaries', Found ) + + IF(ASSOCIATED(Electrodes)) THEN + IF(ALL(Electrodes/=Element % BoundaryInfo % Constraint)) CYCLE + END IF + + DO i=1,Element % Type % NumberOfNodes + j = 2*(Solver % Variable % Perm(Element % NodeIndexes(i))-1)+1 + A % ConstrainedDOF(j:j+1) = .TRUE. + END DO + END DO + END BLOCK + + CALL DefaultDirichletBCs() + + ! + ! Dirichlet BCs in terms of magnetic flux density B: + ! -------------------------------------------------- + CALL DirichletAfromB() + + + A => GetMatrix() + IF (TG) THEN + IF(.NOT.ALLOCATED(TreeEdges)) & + CALL GaugeTree(Solver,Mesh,TreeEdges,FluxCount,FluxMap,Transient) + + WRITE(Message,*) 'Volume tree edges: ', & + i2s(COUNT(TreeEdges)), & + ' of total: ',Mesh % NumberOfEdges + CALL Info('WhitneyAVHarmonicSolver: ', Message, Level=5) + + DO i=1,SIZE(TreeEdges) + IF(TreeEdges(i)) CALL SetDOFToValue(Solver,i,(0._dp,0._dp)) + END DO + END IF + + ! + ! Fix unused potential DOFs: + ! -------------------------- + CALL ConstrainUnused(A) + + ! + ! Linear system solution: + ! ----------------------- + Norm = DefaultSolve() + Converged = Solver % Variable % NonlinConverged==1 + !------------------------------------------------------------------------------ + END FUNCTION DoSolve + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + SUBROUTINE ConstrainUnused(A) + !------------------------------------------------------------------------------ + IMPLICIT NONE + TYPE(Matrix_t) :: A + !------------------------------------------------------------------------------ + INTEGER :: i,j,n + + REAL(KIND=dp), ALLOCATABLE :: dDiag(:) + !------------------------------------------------------------------------------ + n = A % NumberOFRows + ALLOCATE(dDiag(n)); dDiag=0._dp + + DO i=1,n,2 + j = A % Diag(i) + IF(j>0) THEN + dDiag(i) = A % Values(j) + dDiag(i+1) = -A % Values(j+1) + END IF + END DO + IF (ParEnv % PEs>1) CALL ParallelSumVector(A, dDiag) + + n = Mesh % NumberOfNodes + DO i=1,SIZE(Solver % Variable % Perm) !n + j = Solver % Variable % Perm(i) + IF (j==0) CYCLE + + j = 2*(j-1) + Aval = CMPLX(dDiag(j+1), dDiag(j+2), KIND=dp) + + IF (ABS(Aval)==0._dp) THEN + A % RHS(j+1) = 0._dp + CALL ZeroRow(A,j+1) + A % Values(A % Diag(j+1)) = 1._dp + + A % RHS(j+2) = 0._dp + CALL ZeroRow(A,j+2) + A % Values(A % Diag(j+2)) = 1._dp + + IF(ALLOCATED(A % ConstrainedDOF)) THEN + A % ConstrainedDOF(j+1) = .TRUE. + A % ConstrainedDOF(j+2) = .TRUE. + END IF + END IF + END DO + !------------------------------------------------------------------------------ + END SUBROUTINE ConstrainUnused + !------------------------------------------------------------------------------ + + + !------------------------------------------------------------------------------ + SUBROUTINE CalculateLumped(nbf) + !------------------------------------------------------------------------------ + IMPLICIT NONE + INTEGER::nbf + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: a(nbf),IMoment,IA + INTEGER :: i,bfid,n,nd,EdgeBasisDegree + TYPE(Element_t), POINTER :: Element, Parent + COMPLEX(KIND=dp) :: torq, U(nbf), zforce, zzforce + LOGICAL :: Found, CalcTorque,CalcPotential,CalcInertia + TYPE(ValueList_t),POINTER::Params + !------------------------------------------------------------------------------ + + CalcTorque = ListCheckPresentAnyBody(Model,'r inner') + CalcPotential = ListGetLogicalAnyBodyForce( Model,'Calculate Potential') + CalcInertia = ListGetLogicalAnyBody( Model,'Calculate Inertial Moment') + + IF(.NOT. (CalcTorque .OR. CalcPotential .OR. CalcInertia ) ) RETURN + + EdgeBasisDegree = 1 + IF (SecondOrder) EdgeBasisDegree = 2 + + U=0._dp; a=0._dp; torq=0._dp; IMoment=0._dp;IA=0; zforce=0 + DO i=1,GetNOFActive() + Element => GetActiveElement(i) + nd = GetElementNOFDOFs(Element) + n = GetElementNOFNodes(Element) + + IF( CalcTorque ) THEN + CALL Torque(Torq,Element,n,nd,EdgeBasisDegree) + CALL AxialForce(zforce,Element,n,nd,EdgeBasisDegree) END IF - END IF - - IF( CalcInertia ) THEN - Params=>GetBodyParams(Element) - IF(ASSOCIATED(Params)) THEN - IF(GetLogical(Params,'Calculate Inertial Moment',Found)) & - CALL InertialMoment(IMoment,IA,Element,n,nd) + + IF( CalcPotential ) THEN + Params=>GetBodyForce(Element) + IF(ASSOCIATED(Params)) THEN + bfid=GetBodyForceId(Element) + IF(GetLogical(Params,'Calculate Potential',Found)) & + CALL Potential(u(bfid),a(bfid),Element,n,nd,EdgeBasisDegree) + END IF END IF - END IF - END DO - - zzforce = 0 - IF(ListGetLogicalAnyBC(Model,'Calculate Axial Force')) THEN - DO i=1,Mesh % NumberOFBoundaryElements - Element => GetBoundaryElement(i) - IF (.NOT.GetLogical(GetBC(), 'Calculate Axial Force', Found ) ) CYCLE - - Parent => Element % BoundaryInfo % Left - n = GetELementNofNodes(Parent) - nd = GetELementNofDOFs(Parent) - CALL AxialForceSurf(zzforce,Element,n,nd,EdgeBasisDegree) - END DO - END IF - - IF( CalcPotential ) THEN - DO i=1,nbf - a(i) = ParallelReduction(a(i)) - u(i) = ParallelReduction(u(i)) - END DO - - DO i=1,nbf - IF(a(i)>0) THEN - CALL ListAddConstReal(Model % Simulation,'res: Potential re / bodyforce ' & - //i2s(i),REAL(u(i))/a(i)) - CALL ListAddConstReal(Model % Simulation,'res: Potential im / bodyforce ' & - //i2s(i),AIMAG(u(i))/a(i)) - CALL ListAddConstReal(Model % Simulation,'res: area / bodyforce ' & - //i2s(i),a(i)) + + IF( CalcInertia ) THEN + Params=>GetBodyParams(Element) + IF(ASSOCIATED(Params)) THEN + IF(GetLogical(Params,'Calculate Inertial Moment',Found)) & + CALL InertialMoment(IMoment,IA,Element,n,nd) + END IF END IF END DO - END IF - - IF( CalcTorque ) THEN - Torq = ParallelReduction(Torq) - CALL ListAddConstReal(Model % Simulation,'res: Air Gap Torque re', REAL(Torq)) - CALL ListAddConstReal(Model % Simulation,'res: Air Gap Torque im', AIMAG(Torq)) - - zforce = ParallelReduction(zforce) - CALL ListAddConstReal(Model % Simulation,'res: Axial force(vol) re', REAL(zforce)) - CALL ListAddConstReal(Model % Simulation,'res: Axial force(vol) im', AIMAG(zforce)) - - zzforce = 0 - IF(ListGetLogicalAnyBC(Model,'Calculate Axial Force')) THEN - DO i=1,Mesh % NumberOFBoundaryElements - Element => GetBoundaryElement(i) - IF (.NOT.GetLogical(GetBC(), 'Calculate Axial Force', Found ) ) CYCLE - - Parent => Element % BoundaryInfo % Left - n = GetELementNofNodes(Parent) - nd = GetELementNofDOFs(Parent) - CALL AxialForceSurf(zzforce,Element,n,nd,EdgeBasisDegree) - END DO - END IF + + zzforce = 0 IF(ListGetLogicalAnyBC(Model,'Calculate Axial Force')) THEN - zzforce = ParallelReduction(zzforce) - CALL ListAddConstReal(Model % Simulation,'res: Axial force(surf) re', REAL(zzforce)) - CALL ListAddConstReal(Model % Simulation,'res: Axial force(surf) im', AIMAG(zzforce)) + DO i=1,Mesh % NumberOFBoundaryElements + Element => GetBoundaryElement(i) + IF (.NOT.GetLogical(GetBC(), 'Calculate Axial Force', Found ) ) CYCLE + + Parent => Element % BoundaryInfo % Left + n = GetELementNofNodes(Parent) + nd = GetELementNofDOFs(Parent) + CALL AxialForceSurf(zzforce,Element,n,nd,EdgeBasisDegree) + END DO END IF - END IF - - IF( CalcInertia ) THEN - IMoment = ParallelReduction(IMoment) - IA = ParallelReduction(IA) - CALL ListAddConstReal(Model % Simulation,'res: Inertial Volume', IA) - CALL ListAddConstReal(Model % Simulation,'res: Inertial Moment', IMoment) - END IF - -!------------------------------------------------------------------------------ - END SUBROUTINE CalculateLumped -!------------------------------------------------------------------------------ - - -!------------------------------------------------------------------------------ - SUBROUTINE InertialMoment(U,A,Element,n,nd) -!------------------------------------------------------------------------------ - IMPLICIT NONE - INTEGER :: n,nd - REAL(KIND=dp)::U,a - TYPE(Element_t)::Element -!------------------------------------------------------------------------------ - REAL(KIND=dp) :: Basis(n), DetJ,x,y,r,Density(n) - INTEGER :: t - LOGICAL :: stat,Found - TYPE(Nodes_t), SAVE :: Nodes - TYPE(GaussIntegrationPoints_t) :: IP - !$OMP THREADPRIVATE(Nodes) - - Density(1:n) = GetReal(GetMaterial(),'Density',Found,Element) - IF(.NOT.Found) RETURN - - CALL GetElementNodes( Nodes, Element ) - - !Numerical integration: - !---------------------- - IP = GaussPoints(Element) - DO t=1,IP % n - ! Basis function values & derivatives at the integration point: - !-------------------------------------------------------------- - stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & - IP % W(t), detJ, Basis ) - - x = SUM(Nodes % x(1:n)*Basis(1:n)) - y = SUM(Nodes % y(1:n)*Basis(1:n)) - r = SQRT(x**2+y**2) - A = A + IP % s(t)*detJ - U = U + IP % s(t)*detJ*R*SUM(Density(1:n)*Basis(1:n)) - END DO -!------------------------------------------------------------------------------ - END SUBROUTINE InertialMoment -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ - SUBROUTINE Torque(U,Element,n,nd,EdgeBasisDegree) -!------------------------------------------------------------------------------ - IMPLICIT NONE - INTEGER :: n,nd,EdgeBasisDegree - COMPLEX(KIND=dp)::U - TYPE(Element_t)::Element -!------------------------------------------------------------------------------ - REAL(KIND=dp) :: dBasisdx(nd,3),Basis(nd), DetJ, & - POT(2,nd),x,y,r,r0,r1,Wbasis(nd,3),RotWBasis(nd,3) - COMPLEX(KIND=dp) :: B(3,nd), POTC(nd), Br, Bp, Bx, By - INTEGER :: t - LOGICAL :: stat, Found - TYPE(Nodes_t), SAVE :: Nodes - TYPE(GaussIntegrationPoints_t) :: IP - !$OMP THREADPRIVATE(Nodes) - - r0 = GetCReal(GetBodyParams(),'r inner',Found) - r1 = GetCReal(GetBodyParams(),'r outer',Found) - IF (.NOT.Found) RETURN - - CALL GetElementNodes( Nodes, Element ) - - x = SUM(Nodes % x(1:n))/n - y = SUM(Nodes % y(1:n))/n - r = SQRT(x**2+y**2) - IF (rr1) RETURN - - CALL GetLocalSolution(POT, UElement=Element) - POTC = CMPLX( POT(1,1:nd), POT(2,1:nd) ) - - !Numerical integration: - !---------------------- - IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & - EdgeBasisDegree=EdgeBasisDegree) - - DO t=1,IP % n - ! Basis function values & derivatives at the integration point: - !-------------------------------------------------------------- - stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & - IP % W(t), detJ, Basis, dBasisdx, EdgeBasis = WBasis, & - RotBasis = RotWBasis, USolver = pSolver ) - - x = SUM(Nodes % x(1:n)*Basis(1:n)) - y = SUM(Nodes % y(1:n)*Basis(1:n)) + + IF( CalcPotential ) THEN + DO i=1,nbf + a(i) = ParallelReduction(a(i)) + u(i) = ParallelReduction(u(i)) + END DO + + DO i=1,nbf + IF(a(i)>0) THEN + CALL ListAddConstReal(Model % Simulation,'res: Potential re / bodyforce ' & + //i2s(i),REAL(u(i))/a(i)) + CALL ListAddConstReal(Model % Simulation,'res: Potential im / bodyforce ' & + //i2s(i),AIMAG(u(i))/a(i)) + CALL ListAddConstReal(Model % Simulation,'res: area / bodyforce ' & + //i2s(i),a(i)) + END IF + END DO + END IF + + IF( CalcTorque ) THEN + Torq = ParallelReduction(Torq) + CALL ListAddConstReal(Model % Simulation,'res: Air Gap Torque re', REAL(Torq)) + CALL ListAddConstReal(Model % Simulation,'res: Air Gap Torque im', AIMAG(Torq)) + + zforce = ParallelReduction(zforce) + CALL ListAddConstReal(Model % Simulation,'res: Axial force(vol) re', REAL(zforce)) + CALL ListAddConstReal(Model % Simulation,'res: Axial force(vol) im', AIMAG(zforce)) + + zzforce = 0 + IF(ListGetLogicalAnyBC(Model,'Calculate Axial Force')) THEN + DO i=1,Mesh % NumberOFBoundaryElements + Element => GetBoundaryElement(i) + IF (.NOT.GetLogical(GetBC(), 'Calculate Axial Force', Found ) ) CYCLE + + Parent => Element % BoundaryInfo % Left + n = GetELementNofNodes(Parent) + nd = GetELementNofDOFs(Parent) + CALL AxialForceSurf(zzforce,Element,n,nd,EdgeBasisDegree) + END DO + END IF + IF(ListGetLogicalAnyBC(Model,'Calculate Axial Force')) THEN + zzforce = ParallelReduction(zzforce) + CALL ListAddConstReal(Model % Simulation,'res: Axial force(surf) re', REAL(zzforce)) + CALL ListAddConstReal(Model % Simulation,'res: Axial force(surf) im', AIMAG(zzforce)) + END IF + END IF + + IF( CalcInertia ) THEN + IMoment = ParallelReduction(IMoment) + IA = ParallelReduction(IA) + CALL ListAddConstReal(Model % Simulation,'res: Inertial Volume', IA) + CALL ListAddConstReal(Model % Simulation,'res: Inertial Moment', IMoment) + END IF + + !------------------------------------------------------------------------------ + END SUBROUTINE CalculateLumped + !------------------------------------------------------------------------------ + + + !------------------------------------------------------------------------------ + SUBROUTINE InertialMoment(U,A,Element,n,nd) + !------------------------------------------------------------------------------ + IMPLICIT NONE + INTEGER :: n,nd + REAL(KIND=dp)::U,a + TYPE(Element_t)::Element + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: Basis(n), DetJ,x,y,r,Density(n) + INTEGER :: t + LOGICAL :: stat,Found + TYPE(Nodes_t), SAVE :: Nodes + TYPE(GaussIntegrationPoints_t) :: IP + !$OMP THREADPRIVATE(Nodes) + + Density(1:n) = GetReal(GetMaterial(),'Density',Found,Element) + IF(.NOT.Found) RETURN + + CALL GetElementNodes( Nodes, Element ) + + !Numerical integration: + !---------------------- + IP = GaussPoints(Element) + DO t=1,IP % n + ! Basis function values & derivatives at the integration point: + !-------------------------------------------------------------- + stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & + IP % W(t), detJ, Basis ) + + x = SUM(Nodes % x(1:n)*Basis(1:n)) + y = SUM(Nodes % y(1:n)*Basis(1:n)) + r = SQRT(x**2+y**2) + A = A + IP % s(t)*detJ + U = U + IP % s(t)*detJ*R*SUM(Density(1:n)*Basis(1:n)) + END DO + !------------------------------------------------------------------------------ + END SUBROUTINE InertialMoment + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + SUBROUTINE Torque(U,Element,n,nd,EdgeBasisDegree) + !------------------------------------------------------------------------------ + IMPLICIT NONE + INTEGER :: n,nd,EdgeBasisDegree + COMPLEX(KIND=dp)::U + TYPE(Element_t)::Element + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: dBasisdx(nd,3),Basis(nd), DetJ, & + POT(2,nd),x,y,r,r0,r1,Wbasis(nd,3),RotWBasis(nd,3) + COMPLEX(KIND=dp) :: B(3,nd), POTC(nd), Br, Bp, Bx, By + INTEGER :: t + LOGICAL :: stat, Found + TYPE(Nodes_t), SAVE :: Nodes + TYPE(GaussIntegrationPoints_t) :: IP + !$OMP THREADPRIVATE(Nodes) + + r0 = GetCReal(GetBodyParams(),'r inner',Found) + r1 = GetCReal(GetBodyParams(),'r outer',Found) + IF (.NOT.Found) RETURN + + CALL GetElementNodes( Nodes, Element ) + + x = SUM(Nodes % x(1:n))/n + y = SUM(Nodes % y(1:n))/n r = SQRT(x**2+y**2) - - Bx = SUM(POTC(n+1:nd) * RotWBasis(1:nd-n,1)) - By = SUM(POTC(n+1:nd) * RotWBasis(1:nd-n,2)) - Br = x/r*Bx + y/r*By - Bp = -y/r*Bx + x/r*By - U = U + IP % s(t) * detJ * r * & - CMPLX(REAL(Br)*REAL(Bp),AIMAG(Br)*AIMAG(Bp))/(PI*4.0d-7*(r1-r0)) - END DO -!------------------------------------------------------------------------------ - END SUBROUTINE Torque -!------------------------------------------------------------------------------ - - -!------------------------------------------------------------------------------ - SUBROUTINE AxialForce(U,Element,n,nd,EdgeBasisDegree) -!------------------------------------------------------------------------------ - IMPLICIT NONE - INTEGER :: n,nd,EdgeBasisDegree - COMPLEX(KIND=dp)::U - TYPE(Element_t)::Element -!------------------------------------------------------------------------------ - REAL(KIND=dp) :: dBasisdx(nd,3),Basis(nd), DetJ, & - POT(2,nd),x,y,r,r0,r1,Wbasis(nd,3),RotWBasis(nd,3) - COMPLEX(KIND=dp) :: B(3,nd), POTC(nd), Bx, By, Bz, Br, Bp - INTEGER :: t - LOGICAL :: stat, Found - TYPE(Nodes_t), SAVE :: Nodes - TYPE(GaussIntegrationPoints_t) :: IP - !$OMP THREADPRIVATE(Nodes) - - r0 = GetCReal(GetBodyParams(),'r inner',Found) - r1 = GetCReal(GetBodyParams(),'r outer',Found) - IF (.NOT.Found) RETURN - - CALL GetElementNodes( Nodes, Element ) - - x = SUM(Nodes % x(1:n))/n - y = SUM(Nodes % y(1:n))/n - r = SQRT(x**2+y**2) - IF (rr1) RETURN - - CALL GetLocalSolution(POT, UElement=Element) - POTC = CMPLX( POT(1,1:nd), POT(2,1:nd) ) - - !Numerical integration: - !---------------------- - IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & - EdgeBasisDegree=EdgeBasisDegree) - DO t=1,IP % n - ! Basis function values & derivatives at the integration point: - !-------------------------------------------------------------- - stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & - IP % W(t), detJ, Basis, dBasisdx, EdgeBasis = WBasis, & - RotBasis = RotWBasis, USolver = pSolver ) - - x = SUM(Nodes % x(1:n)*Basis(1:n)) - y = SUM(Nodes % y(1:n)*Basis(1:n)) + IF (rr1) RETURN + + CALL GetLocalSolution(POT, UElement=Element) + POTC = CMPLX( POT(1,1:nd), POT(2,1:nd) ) + + !Numerical integration: + !---------------------- + IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & + EdgeBasisDegree=EdgeBasisDegree) + + DO t=1,IP % n + ! Basis function values & derivatives at the integration point: + !-------------------------------------------------------------- + stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & + IP % W(t), detJ, Basis, dBasisdx, EdgeBasis = WBasis, & + RotBasis = RotWBasis, USolver = pSolver ) + + x = SUM(Nodes % x(1:n)*Basis(1:n)) + y = SUM(Nodes % y(1:n)*Basis(1:n)) + r = SQRT(x**2+y**2) + + Bx = SUM(POTC(n+1:nd) * RotWBasis(1:nd-n,1)) + By = SUM(POTC(n+1:nd) * RotWBasis(1:nd-n,2)) + Br = x/r*Bx + y/r*By + Bp = -y/r*Bx + x/r*By + U = U + IP % s(t) * detJ * r * & + CMPLX(REAL(Br)*REAL(Bp),AIMAG(Br)*AIMAG(Bp))/(PI*4.0d-7*(r1-r0)) + END DO + !------------------------------------------------------------------------------ + END SUBROUTINE Torque + !------------------------------------------------------------------------------ + + + !------------------------------------------------------------------------------ + SUBROUTINE AxialForce(U,Element,n,nd,EdgeBasisDegree) + !------------------------------------------------------------------------------ + IMPLICIT NONE + INTEGER :: n,nd,EdgeBasisDegree + COMPLEX(KIND=dp)::U + TYPE(Element_t)::Element + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: dBasisdx(nd,3),Basis(nd), DetJ, & + POT(2,nd),x,y,r,r0,r1,Wbasis(nd,3),RotWBasis(nd,3) + COMPLEX(KIND=dp) :: B(3,nd), POTC(nd), Bx, By, Bz, Br, Bp + INTEGER :: t + LOGICAL :: stat, Found + TYPE(Nodes_t), SAVE :: Nodes + TYPE(GaussIntegrationPoints_t) :: IP + !$OMP THREADPRIVATE(Nodes) + + r0 = GetCReal(GetBodyParams(),'r inner',Found) + r1 = GetCReal(GetBodyParams(),'r outer',Found) + IF (.NOT.Found) RETURN + + CALL GetElementNodes( Nodes, Element ) + + x = SUM(Nodes % x(1:n))/n + y = SUM(Nodes % y(1:n))/n r = SQRT(x**2+y**2) - x = x/r; y=y/r - - Bx = SUM(POTC(n+1:nd) * RotWBasis(1:nd-n,1)) - By = SUM(POTC(n+1:nd) * RotWBasis(1:nd-n,2)) - Bz = SUM(POTC(n+1:nd) * RotWBasis(1:nd-n,3)) - U = U + IP % s(t) * detJ * 1 * & - CMPLX((REAL(Bx)*REAL(Bz)*x + REAL(By)*REAL(Bz)*y), & - (AIMAG(Bx)*AIMAG(Bz)*x + AIMAG(By)*AIMAG(Bz)*y)) & - /(PI*4.0d-7*(r1-r0)) - END DO -!------------------------------------------------------------------------------ - END SUBROUTINE AxialForce -!------------------------------------------------------------------------------ - - -!------------------------------------------------------------------------------ - SUBROUTINE AxialForceSurf(U,Element,n,nd,EdgeBasisDegree) -!------------------------------------------------------------------------------ - IMPLICIT NONE - INTEGER :: n,nd,EdgeBasisDegree - COMPLEX(KIND=dp)::U - TYPE(Element_t)::Element -!------------------------------------------------------------------------------ - TYPE(Element_t), POINTER ::PARENT - REAL(KIND=dp) :: dBasisdx(nd,3),Basis(nd), DetJ, Pdetj, uu,v,w, & - POT(2,nd),x,y,r,r0,r1,Wbasis(nd,3),RotWBasis(nd,3) - COMPLEX(KIND=dp) :: B(3,nd), POTC(nd), Bx, By, Bz - INTEGER :: t - LOGICAL :: stat, Found - TYPE(Nodes_t), SAVE :: Nodes, PNodes - TYPE(GaussIntegrationPoints_t) :: IP - !$OMP THREADPRIVATE(Nodes) - - CALL GetElementNodes( Nodes, Element ) - Parent => Element % BoundaryInfo % Left - CALL GetElementNodes( PNodes, Parent ) - - CALL GetLocalSolution(POT, UElement=Parent ) - POTC = CMPLX( POT(1,1:nd), POT(2,1:nd) ) - - !Numerical integration: - !---------------------- - IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & - EdgeBasisDegree=EdgeBasisDegree) - - DO t=1,IP % n - ! Basis function values & derivatives at the integration point: - !-------------------------------------------------------------- - stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & - IP % W(t), detJ, Basis, dBasisdx ) - - CALL GetParentUVW(Element,GetElementNOFNodes(Element),Parent,n,uu,v,w,Basis) - IF (PiolaVersion) THEN - stat = EdgeElementInfo( Parent, PNodes, uu, v, w, & - DetF = PDetJ, Basis = Basis, EdgeBasis = WBasis, RotBasis = RotWBasis, & - BasisDegree = EdgeBasisDegree, ApplyPiolaTransform = .TRUE.) + IF (rr1) RETURN + + CALL GetLocalSolution(POT, UElement=Element) + POTC = CMPLX( POT(1,1:nd), POT(2,1:nd) ) + + !Numerical integration: + !---------------------- + IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & + EdgeBasisDegree=EdgeBasisDegree) + DO t=1,IP % n + ! Basis function values & derivatives at the integration point: + !-------------------------------------------------------------- + stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & + IP % W(t), detJ, Basis, dBasisdx, EdgeBasis = WBasis, & + RotBasis = RotWBasis, USolver = pSolver ) + + x = SUM(Nodes % x(1:n)*Basis(1:n)) + y = SUM(Nodes % y(1:n)*Basis(1:n)) + r = SQRT(x**2+y**2) + x = x/r; y=y/r + + Bx = SUM(POTC(n+1:nd) * RotWBasis(1:nd-n,1)) + By = SUM(POTC(n+1:nd) * RotWBasis(1:nd-n,2)) + Bz = SUM(POTC(n+1:nd) * RotWBasis(1:nd-n,3)) + U = U + IP % s(t) * detJ * 1 * & + CMPLX((REAL(Bx)*REAL(Bz)*x + REAL(By)*REAL(Bz)*y), & + (AIMAG(Bx)*AIMAG(Bz)*x + AIMAG(By)*AIMAG(Bz)*y)) & + /(PI*4.0d-7*(r1-r0)) + END DO + !------------------------------------------------------------------------------ + END SUBROUTINE AxialForce + !------------------------------------------------------------------------------ + + + !------------------------------------------------------------------------------ + SUBROUTINE AxialForceSurf(U,Element,n,nd,EdgeBasisDegree) + !------------------------------------------------------------------------------ + IMPLICIT NONE + INTEGER :: n,nd,EdgeBasisDegree + COMPLEX(KIND=dp)::U + TYPE(Element_t)::Element + !------------------------------------------------------------------------------ + TYPE(Element_t), POINTER ::PARENT + REAL(KIND=dp) :: dBasisdx(nd,3),Basis(nd), DetJ, Pdetj, uu,v,w, & + POT(2,nd),x,y,r,r0,r1,Wbasis(nd,3),RotWBasis(nd,3) + COMPLEX(KIND=dp) :: B(3,nd), POTC(nd), Bx, By, Bz + INTEGER :: t + LOGICAL :: stat, Found + TYPE(Nodes_t), SAVE :: Nodes, PNodes + TYPE(GaussIntegrationPoints_t) :: IP + !$OMP THREADPRIVATE(Nodes) + + CALL GetElementNodes( Nodes, Element ) + Parent => Element % BoundaryInfo % Left + CALL GetElementNodes( PNodes, Parent ) + + CALL GetLocalSolution(POT, UElement=Parent ) + POTC = CMPLX( POT(1,1:nd), POT(2,1:nd) ) + + !Numerical integration: + !---------------------- + IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & + EdgeBasisDegree=EdgeBasisDegree) + + DO t=1,IP % n + ! Basis function values & derivatives at the integration point: + !-------------------------------------------------------------- + stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & + IP % W(t), detJ, Basis, dBasisdx ) + + CALL GetParentUVW(Element,GetElementNOFNodes(Element),Parent,n,uu,v,w,Basis) + IF (PiolaVersion) THEN + stat = EdgeElementInfo( Parent, PNodes, uu, v, w, & + DetF = PDetJ, Basis = Basis, EdgeBasis = WBasis, RotBasis = RotWBasis, & + BasisDegree = EdgeBasisDegree, ApplyPiolaTransform = .TRUE.) + ELSE + stat = ElementInfo( Parent, PNodes, uu,v,w, pdetJ, Basis, dBasisdx ) + CALL GetEdgeBasis(Parent,WBasis,RotWBasis,Basis,dBasisdx) + END IF + + x = SUM(Basis(1:n) * PNodes % x(1:n)) + y = SUM(Basis(1:n) * PNodes % y(1:n)) + r = SQRT(x**2 + y**2) + x=x/r; y=y/r + + Bx = SUM(POTC(n+1:nd) * RotWBasis(1:nd-n,1)) + By = SUM(POTC(n+1:nd) * RotWBasis(1:nd-n,2)) + Bz = SUM(POTC(n+1:nd) * RotWBasis(1:nd-n,3)) + U = U + IP % s(t) * detJ * & + CMPLX((REAL(Bx)*REAL(Bz)*x + REAL(By)*REAL(Bz)*y), & + (AIMAG(Bx)*AIMAG(Bz)*x + AIMAG(By)*AIMAG(Bz)*y)) /(PI*4.0d-7) + END DO + !------------------------------------------------------------------------------ + END SUBROUTINE AxialForceSurf + !------------------------------------------------------------------------------ + + + !------------------------------------------------------------------------------ + SUBROUTINE Potential( U, A, Element,n,nd,EdgeBasisDegree) + !------------------------------------------------------------------------------ + IMPLICIT NONE + REAL(KIND=dp) :: A + COMPLEX(KIND=dp) :: U + INTEGER :: n, nd, EdgeBasisDegree + TYPE(Element_t), POINTER :: Element + + REAL(KIND=dp) :: Basis(nd), dBasisdx(nd,3),DetJ,POT(2,nd), & + wBasis(nd,3),rotWBasis(nd,3),Wpot(nd),w(3), Omega + COMPLEX(KIND=dp) :: POTC(nd) + INTEGER :: t + LOGICAL :: stat, WbaseFound + TYPE(Nodes_t), SAVE :: Nodes + TYPE(GaussIntegrationPoints_t) :: IP + !$OMP THREADPRIVATE(Nodes) + + CALL GetElementNodes( Nodes ) + + Omega = GetAngularFrequency(UElement=Element) + CALL GetLocalSolution(POT,UElement=Element) + POTC = Omega*CMPLX( POT(2,1:nd), POT(1,1:nd) ) + + CALL GetLocalSolution(Wpot,'W',UElement=Element) + W = [0._dp, 0._dp, 1._dp] + WbaseFound = ANY(Wpot(1:n)/=0._dp) + + !Numerical integration: + !---------------------- + IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & + EdgeBasisDegree=EdgeBasisDegree) + DO t=1,IP % n + ! Basis function values & derivatives at the integration point: + !-------------------------------------------------------------- + stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & + IP % W(t), detJ, Basis, dBasisdx, EdgeBasis = WBasis, & + RotBasis = RotWBasis, USolver = pSolver ) + + IF(WBaseFound) W = MATMUL(Wpot(1:n),dBasisdx(1:n,:)) + + A = A + IP % s(t) * detJ + U = U + IP % s(t) * detJ * SUM(PotC(n+1:nd)*MATMUL(WBasis(1:nd-n,:),w)) + END DO + !------------------------------------------------------------------------------ + END SUBROUTINE Potential + !------------------------------------------------------------------------------ + + + !----------------------------------------------------------------------------- + SUBROUTINE LocalMatrix( MASS, STIFF, FORCE, JFixFORCE, JFixVec, LOAD, & + Tcoef, Acoef, LaminateStack, LaminateStackModel, & + LamThick, LamCond, CoilBody, CoilType, RotM, ConstraintActive, & + Element, n, nd, PiolaVersion, SecondOrder ) + !------------------------------------------------------------------------------ + IMPLICIT NONE + COMPLEX(KIND=dp) :: MASS(:,:), STIFF(:,:), FORCE(:), JFixFORCE(:), JFixVec(:,:) + COMPLEX(KIND=dp) :: LOAD(:,:), Tcoef(:,:,:), Acoef(:), LamCond(:) + REAL(KIND=dp) :: LamThick(:) + LOGICAL :: LaminateStack, CoilBody, ConstraintActive + CHARACTER(LEN=MAX_NAME_LEN):: LaminateStackModel, CoilType + REAL(KIND=dp) :: RotM(3,3,n) + TYPE(Element_t), POINTER :: Element + INTEGER :: n, nd + LOGICAL :: PiolaVersion, SecondOrder + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: WBasis(nd,3), RotWBasis(nd,3) + REAL(KIND=dp) :: Basis(n),dBasisdx(n,3),DetJ, & + RotMLoc(3,3), velo(3), omega_velo(3,n), & + lorentz_velo(3,n), RotWJ(3) + REAL(KIND=dp) :: LocalLamThick, skind, babs, muder, AlocR(2,nd) + REAL(KIND=dp) :: nu_11(nd), nuim_11(nd), & + nu_22(nd), nuim_22(nd), & + nu_33(nd), nuim_33(nd) + REAL(KIND=dp) :: nu_val, nuim_val + REAL(KIND=dp) :: sigma_33(nd), sigmaim_33(nd) + + COMPLEX(KIND=dp) :: mu, C(3,3), L(3), G(3), M(3), JfixPot(n), Nu(3,3) + COMPLEX(KIND=dp) :: LocalLamCond, JAC(nd,nd), B_ip(3), Aloc(nd), & + CVelo(3), CVeloSum, Permittivity(nd), P_ip, DAMP(nd,nd) + + LOGICAL :: Stat, Newton, HBCurve, & + HasVelocity, HasLorenzVelocity, HasAngularVelocity + LOGICAL :: StrandedHomogenization, UseRotM, FoundIm + + INTEGER :: t, i, j, p, q, np, EdgeBasisDegree + + TYPE(GaussIntegrationPoints_t) :: IP + TYPE(Nodes_t), SAVE :: Nodes + TYPE(ValueList_t), POINTER :: CompParams + !------------------------------------------------------------------------------ + IF (SecondOrder) THEN + EdgeBasisDegree = 2 ELSE - stat = ElementInfo( Parent, PNodes, uu,v,w, pdetJ, Basis, dBasisdx ) - CALL GetEdgeBasis(Parent,WBasis,RotWBasis,Basis,dBasisdx) + EdgeBasisDegree = 1 END IF - - x = SUM(Basis(1:n) * PNodes % x(1:n)) - y = SUM(Basis(1:n) * PNodes % y(1:n)) - r = SQRT(x**2 + y**2) - x=x/r; y=y/r - - Bx = SUM(POTC(n+1:nd) * RotWBasis(1:nd-n,1)) - By = SUM(POTC(n+1:nd) * RotWBasis(1:nd-n,2)) - Bz = SUM(POTC(n+1:nd) * RotWBasis(1:nd-n,3)) - U = U + IP % s(t) * detJ * & - CMPLX((REAL(Bx)*REAL(Bz)*x + REAL(By)*REAL(Bz)*y), & - (AIMAG(Bx)*AIMAG(Bz)*x + AIMAG(By)*AIMAG(Bz)*y)) /(PI*4.0d-7) - END DO -!------------------------------------------------------------------------------ - END SUBROUTINE AxialForceSurf -!------------------------------------------------------------------------------ - - -!------------------------------------------------------------------------------ - SUBROUTINE Potential( U, A, Element,n,nd,EdgeBasisDegree) -!------------------------------------------------------------------------------ - IMPLICIT NONE - REAL(KIND=dp) :: A - COMPLEX(KIND=dp) :: U - INTEGER :: n, nd, EdgeBasisDegree - TYPE(Element_t), POINTER :: Element - - REAL(KIND=dp) :: Basis(nd), dBasisdx(nd,3),DetJ,POT(2,nd), & - wBasis(nd,3),rotWBasis(nd,3),Wpot(nd),w(3), Omega - COMPLEX(KIND=dp) :: POTC(nd) - INTEGER :: t - LOGICAL :: stat, WbaseFound - TYPE(Nodes_t), SAVE :: Nodes - TYPE(GaussIntegrationPoints_t) :: IP - !$OMP THREADPRIVATE(Nodes) - - CALL GetElementNodes( Nodes ) - - Omega = GetAngularFrequency(UElement=Element) - CALL GetLocalSolution(POT,UElement=Element) - POTC = Omega*CMPLX( POT(2,1:nd), POT(1,1:nd) ) - - CALL GetLocalSolution(Wpot,'W',UElement=Element) - W = [0._dp, 0._dp, 1._dp] - WbaseFound = ANY(Wpot(1:n)/=0._dp) - - !Numerical integration: - !---------------------- - IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & - EdgeBasisDegree=EdgeBasisDegree) - DO t=1,IP % n - ! Basis function values & derivatives at the integration point: - !-------------------------------------------------------------- - stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & - IP % W(t), detJ, Basis, dBasisdx, EdgeBasis = WBasis, & - RotBasis = RotWBasis, USolver = pSolver ) - - IF(WBaseFound) W = MATMUL(Wpot(1:n),dBasisdx(1:n,:)) - - A = A + IP % s(t) * detJ - U = U + IP % s(t) * detJ * SUM(PotC(n+1:nd)*MATMUL(WBasis(1:nd-n,:),w)) - END DO -!------------------------------------------------------------------------------ - END SUBROUTINE Potential -!------------------------------------------------------------------------------ - - -!----------------------------------------------------------------------------- - SUBROUTINE LocalMatrix( MASS, STIFF, FORCE, JFixFORCE, JFixVec, LOAD, & - Tcoef, Acoef, LaminateStack, LaminateStackModel, & - LamThick, LamCond, CoilBody, CoilType, RotM, ConstraintActive, & - Element, n, nd, PiolaVersion, SecondOrder ) -!------------------------------------------------------------------------------ - IMPLICIT NONE - COMPLEX(KIND=dp) :: MASS(:,:), STIFF(:,:), FORCE(:), JFixFORCE(:), JFixVec(:,:) - COMPLEX(KIND=dp) :: LOAD(:,:), Tcoef(:,:,:), Acoef(:), LamCond(:) - REAL(KIND=dp) :: LamThick(:) - LOGICAL :: LaminateStack, CoilBody, ConstraintActive - CHARACTER(LEN=MAX_NAME_LEN):: LaminateStackModel, CoilType - REAL(KIND=dp) :: RotM(3,3,n) - TYPE(Element_t), POINTER :: Element - INTEGER :: n, nd - LOGICAL :: PiolaVersion, SecondOrder -!------------------------------------------------------------------------------ - REAL(KIND=dp) :: WBasis(nd,3), RotWBasis(nd,3) - REAL(KIND=dp) :: Basis(n),dBasisdx(n,3),DetJ, & - RotMLoc(3,3), velo(3), omega_velo(3,n), & - lorentz_velo(3,n), RotWJ(3) - REAL(KIND=dp) :: LocalLamThick, skind, babs, muder, AlocR(2,nd) - REAL(KIND=dp) :: nu_11(nd), nuim_11(nd), & - nu_22(nd), nuim_22(nd), & - nu_33(nd), nuim_33(nd) - REAL(KIND=dp) :: nu_val, nuim_val - REAL(KIND=dp) :: sigma_33(nd), sigmaim_33(nd) - - COMPLEX(KIND=dp) :: mu, C(3,3), L(3), G(3), M(3), JfixPot(n), Nu(3,3) - COMPLEX(KIND=dp) :: LocalLamCond, JAC(nd,nd), B_ip(3), Aloc(nd), & - CVelo(3), CVeloSum, Permittivity(nd), P_ip, DAMP(nd,nd) - - LOGICAL :: Stat, Newton, HBCurve, & - HasVelocity, HasLorenzVelocity, HasAngularVelocity - LOGICAL :: StrandedHomogenization, UseRotM, FoundIm - - INTEGER :: t, i, j, p, q, np, EdgeBasisDegree - - TYPE(GaussIntegrationPoints_t) :: IP - TYPE(Nodes_t), SAVE :: Nodes - TYPE(ValueList_t), POINTER :: CompParams -!------------------------------------------------------------------------------ - IF (SecondOrder) THEN - EdgeBasisDegree = 2 - ELSE - EdgeBasisDegree = 1 - END IF - - CALL GetElementNodes( Nodes ) - - MASS = 0.0_dp - DAMP = 0.0_dp - STIFF = 0.0_dp - FORCE = 0.0_dp - - IF( Jfix ) THEN - IF( JfixSolve ) THEN - JfixFORCE = 0.0_dp - JfixVec = 0.0_dp - ELSE - JfixPot(1:n) = CMPLX( JfixVar % Values( JfixVar % Perm( Element % NodeIndexes ) ), & - JfixVarIm % Values( JfixVarIm % Perm( Element % NodeIndexes ) ) ) + + CALL GetElementNodes( Nodes ) + + MASS = 0.0_dp + DAMP = 0.0_dp + STIFF = 0.0_dp + FORCE = 0.0_dp + + IF( Jfix ) THEN + IF( JfixSolve ) THEN + JfixFORCE = 0.0_dp + JfixVec = 0.0_dp + ELSE + JfixPot(1:n) = CMPLX( JfixVar % Values( JfixVar % Perm( Element % NodeIndexes ) ), & + JfixVarIm % Values( JfixVarIm % Perm( Element % NodeIndexes ) ) ) + END IF END IF - END IF - - JAC = 0._dp - Newton = .FALSE. - - HasVelocity = .FALSE. - IF(ASSOCIATED(BodyForce)) THEN - CALL GetRealVector( BodyForce, omega_velo, 'Angular velocity', HasAngularVelocity) - CALL GetRealVector( BodyForce, lorentz_velo, 'Lorentz velocity', HasLorenzVelocity) - HasVelocity = HasAngularVelocity .OR. HasLorenzVelocity - END IF - - CALL GetPermittivity(GetMaterial(), Permittivity, n) - HBCurve = ListCheckPresent(Material,'H-B Curve') - - IF(HBCurve) THEN - Newton = GetLogical( SolverParams,'Newton-Raphson iteration',Found) - IF(.NOT. Found ) Newton = ExtNewton - - IF( GotHbCurveVar ) THEN - CALL GetLocalSolution(AlocR(1,:), UVariable = HbCurveVar ) - Aloc = CMPLX( AlocR(1,1:nd), 0.0_dp, KIND=dp) - ELSE - CALL GetLocalSolution(AlocR) - Aloc = CMPLX( AlocR(1,1:nd), AlocR(2,1:nd), KIND=dp) + + JAC = 0._dp + Newton = .FALSE. + + HasVelocity = .FALSE. + IF(ASSOCIATED(BodyForce)) THEN + CALL GetRealVector( BodyForce, omega_velo, 'Angular velocity', HasAngularVelocity) + CALL GetRealVector( BodyForce, lorentz_velo, 'Lorentz velocity', HasLorenzVelocity) + HasVelocity = HasAngularVelocity .OR. HasLorenzVelocity END IF - END IF - - StrandedHomogenization = .FALSE. - UseRotM = .FALSE. - IF(CoilBody) THEN - IF (CoilType == 'stranded') THEN - CompParams => GetComponentParams( Element ) - StrandedHomogenization = GetLogical(CompParams, 'Homogenization Model', Found) - - IF ( StrandedHomogenization ) THEN - nu_11 = 0._dp - nuim_11 = 0._dp - nu_11 = GetReal(CompParams, 'nu 11', Found) - nuim_11 = GetReal(CompParams, 'nu 11 im', FoundIm) - IF ( .NOT. Found .AND. .NOT. FoundIm ) CALL Fatal ('LocalMatrix', 'Homogenization Model nu 11 not found!') - - nu_22 = 0._dp - nuim_22 = 0._dp - nu_22 = GetReal(CompParams, 'nu 22', Found) - nuim_22 = GetReal(CompParams, 'nu 22 im', FoundIm) - IF ( .NOT. Found .AND. .NOT. FoundIm ) CALL Fatal ('LocalMatrix', 'Homogenization Model nu 22 not found!') - - nu_33 = 0._dp - nuim_33 = 0._dp - nu_33 = GetReal(CompParams, 'nu 33', Found) - nuim_33 = GetReal(CompParams, 'nu 33 im', FoundIm) - IF ( .NOT. Found .AND. .NOT. FoundIm ) CALL Fatal ('LocalMatrix', 'Homogenization Model nu 33 not found!') - - ! Sigma 33 is not needed in because it does not exist in stranded coil - ! Its contribution is taken into account in the circuit module if explicit coil resistance is not used! - + + CALL GetPermittivity(GetMaterial(), Permittivity, n) + HBCurve = ListCheckPresent(Material,'H-B Curve') + + IF(HBCurve) THEN + Newton = GetLogical( SolverParams,'Newton-Raphson iteration',Found) + IF(.NOT. Found ) Newton = ExtNewton + + IF( GotHbCurveVar ) THEN + CALL GetLocalSolution(AlocR(1,:), UVariable = HbCurveVar ) + Aloc = CMPLX( AlocR(1,1:nd), 0.0_dp, KIND=dp) + ELSE + CALL GetLocalSolution(AlocR) + Aloc = CMPLX( AlocR(1,1:nd), AlocR(2,1:nd), KIND=dp) + END IF + END IF + + StrandedHomogenization = .FALSE. + UseRotM = .FALSE. + IF(CoilBody) THEN + IF (CoilType == 'stranded') THEN + CompParams => GetComponentParams( Element ) + StrandedHomogenization = GetLogical(CompParams, 'Homogenization Model', Found) + + IF ( StrandedHomogenization ) THEN + nu_11 = 0._dp + nuim_11 = 0._dp + nu_11 = GetReal(CompParams, 'nu 11', Found) + nuim_11 = GetReal(CompParams, 'nu 11 im', FoundIm) + IF ( .NOT. Found .AND. .NOT. FoundIm ) CALL Fatal ('LocalMatrix', 'Homogenization Model nu 11 not found!') + + nu_22 = 0._dp + nuim_22 = 0._dp + nu_22 = GetReal(CompParams, 'nu 22', Found) + nuim_22 = GetReal(CompParams, 'nu 22 im', FoundIm) + IF ( .NOT. Found .AND. .NOT. FoundIm ) CALL Fatal ('LocalMatrix', 'Homogenization Model nu 22 not found!') + + nu_33 = 0._dp + nuim_33 = 0._dp + nu_33 = GetReal(CompParams, 'nu 33', Found) + nuim_33 = GetReal(CompParams, 'nu 33 im', FoundIm) + IF ( .NOT. Found .AND. .NOT. FoundIm ) CALL Fatal ('LocalMatrix', 'Homogenization Model nu 33 not found!') + + ! Sigma 33 is not needed in because it does not exist in stranded coil + ! Its contribution is taken into account in the circuit module if explicit coil resistance is not used! + + UseRotM = .TRUE. + END IF + ELSE IF( CoilType == 'foil winding') THEN UseRotM = .TRUE. END IF - ELSE IF( CoilType == 'foil winding') THEN - UseRotM = .TRUE. END IF - END IF - - !Numerical integration: - !---------------------- - IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & - EdgeBasisDegree=EdgeBasisDegree ) - - np = n*Solver % Def_Dofs(GetElementFamily(Element),Element % BodyId,1) - - DO t=1,IP % n - stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & - IP % W(t), detJ, Basis, dBasisdx, EdgeBasis = WBasis, & - RotBasis = RotWBasis, USolver = pSolver ) + + !Numerical integration: + !---------------------- + IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & + EdgeBasisDegree=EdgeBasisDegree ) + + np = n*Solver % Def_Dofs(GetElementFamily(Element),Element % BodyId,1) - ! Compute convection type term coming from rotation - ! ------------------------------------------------- - IF(HasVelocity) THEN - velo = 0.0_dp - IF( HasAngularVelocity ) THEN - DO i=1,n - velo(1:3) = velo(1:3) + CrossProduct(omega_velo(1:3,i), [ & - basis(i) * Nodes % x(i), & - basis(i) * Nodes % y(i), & - basis(i) * Nodes % z(i)]) - END DO - END IF - IF( HasLorenzVelocity ) THEN - velo(1:3) = velo(1:3) + [ & - SUM(basis(1:n)*lorentz_velo(1,1:n)), & - SUM(basis(1:n)*lorentz_velo(2,1:n)), & - SUM(basis(1:n)*lorentz_velo(3,1:n))] + DO t=1,IP % n + stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & + IP % W(t), detJ, Basis, dBasisdx, EdgeBasis = WBasis, & + RotBasis = RotWBasis, USolver = pSolver ) + + ! Compute convection type term coming from rotation + ! ------------------------------------------------- + IF(HasVelocity) THEN + velo = 0.0_dp + IF( HasAngularVelocity ) THEN + DO i=1,n + velo(1:3) = velo(1:3) + CrossProduct(omega_velo(1:3,i), [ & + basis(i) * Nodes % x(i), & + basis(i) * Nodes % y(i), & + basis(i) * Nodes % z(i)]) + END DO + END IF + IF( HasLorenzVelocity ) THEN + velo(1:3) = velo(1:3) + [ & + SUM(basis(1:n)*lorentz_velo(1,1:n)), & + SUM(basis(1:n)*lorentz_velo(2,1:n)), & + SUM(basis(1:n)*lorentz_velo(3,1:n))] + END IF END IF - END IF - - ! Compute the conductivity tensor - ! ------------------------------- - DO i=1,3 - DO j=1,3 - C(i,j) = SUM( Tcoef(i,j,1:n) * Basis(1:n) ) - END DO - END DO - - P_ip = SUM( Permittivity(1:n) * Basis(1:n) ) - - ! Transform the conductivity tensor (in case of a foil winding): - ! -------------------------------------------------------------- - IF ( UseRotM ) THEN + + ! Compute the conductivity tensor + ! ------------------------------- DO i=1,3 DO j=1,3 - RotMLoc(i,j) = SUM( RotM(i,j,1:n) * Basis(1:n) ) + C(i,j) = SUM( Tcoef(i,j,1:n) * Basis(1:n) ) END DO END DO - C = MATMUL(MATMUL(RotMLoc, C),TRANSPOSE(RotMLoc)) - END IF - - IF ( HBCurve ) THEN - B_ip = MATMUL( Aloc(np+1:nd), RotWBasis(1:nd-np,:) ) - babs = MAX( SQRT(SUM(ABS(B_ip)**2)), 1.d-8 ) - - IF( Newton ) THEN - mu = ListGetFun( Material,'h-b curve',babs,dFdx=muder) / Babs - muder = (muder-mu)/babs - ELSE - mu = ListGetFun( Material,'h-b curve',babs) / Babs - END IF - ELSE - mu = SUM( Basis(1:n) * Acoef(1:n) ) - END IF - - IF (LaminateStack) THEN - LocalLamThick = SUM( Basis(1:n) * LamThick(1:n) ) - LocalLamCond = SUM( Basis(1:n) * LamCond(1:n) ) - - SELECT CASE(LaminateStackModel) - CASE('low-frequency model') - mu = mu + im*Omega* LocalLamCond* LocalLamThick **2 /12d0 - CASE('wide-frequency-band model') - skind = SQRT(2d0*mu/(omega*LocalLamCond)) - mu = LocalLamCond * LocalLamThick * skind * omega* (1d0 + im)/8d0*& - (-im)*SIN(im*(1d0+im)*LocalLamThick/skind)/(-im*SIN(im*(1d0+im)*LocalLamThick/skind/2d0))**2d0 -! sinh((1d0+im)*LocalLamThick/skind)/sinh((1d0+im)*LocalLamThick/skind/2d0)**2d0 - END SELECT - END IF - - IF (HasTensorReluctivity) THEN - IF (SIZE(Acoef_t,2) == 1) THEN - Nu = CMPLX(0._dp, 0._dp, kind=dp) - DO i = 1,3 - Nu(i,i) = SUM(Basis(1:n)*Acoef_t(i,1,1:n)) + + P_ip = SUM( Permittivity(1:n) * Basis(1:n) ) + + ! Transform the conductivity tensor (in case of a foil winding): + ! -------------------------------------------------------------- + IF ( UseRotM ) THEN + DO i=1,3 + DO j=1,3 + RotMLoc(i,j) = SUM( RotM(i,j,1:n) * Basis(1:n) ) + END DO END DO + C = MATMUL(MATMUL(RotMLoc, C),TRANSPOSE(RotMLoc)) + END IF + + IF ( HBCurve ) THEN + B_ip = MATMUL( Aloc(np+1:nd), RotWBasis(1:nd-np,:) ) + babs = MAX( SQRT(SUM(ABS(B_ip)**2)), 1.d-8 ) + + IF( Newton ) THEN + mu = ListGetFun( Material,'h-b curve',babs,dFdx=muder) / Babs + muder = (muder-mu)/babs + ELSE + mu = ListGetFun( Material,'h-b curve',babs) / Babs + END IF ELSE - DO i = 1,3 - DO j = 1,3 - Nu(i,j) = SUM(Basis(1:n)*Acoef_t(i,j,1:n)) + mu = SUM( Basis(1:n) * Acoef(1:n) ) + END IF + + IF (LaminateStack) THEN + LocalLamThick = SUM( Basis(1:n) * LamThick(1:n) ) + LocalLamCond = SUM( Basis(1:n) * LamCond(1:n) ) + + SELECT CASE(LaminateStackModel) + CASE('low-frequency model') + mu = mu + im*Omega* LocalLamCond* LocalLamThick **2 /12d0 + CASE('wide-frequency-band model') + skind = SQRT(2d0*mu/(omega*LocalLamCond)) + mu = LocalLamCond * LocalLamThick * skind * omega* (1d0 + im)/8d0*& + (-im)*SIN(im*(1d0+im)*LocalLamThick/skind)/(-im*SIN(im*(1d0+im)*LocalLamThick/skind/2d0))**2d0 + ! sinh((1d0+im)*LocalLamThick/skind)/sinh((1d0+im)*LocalLamThick/skind/2d0)**2d0 + END SELECT + END IF + + IF (HasTensorReluctivity) THEN + IF (SIZE(Acoef_t,2) == 1) THEN + Nu = CMPLX(0._dp, 0._dp, kind=dp) + DO i = 1,3 + Nu(i,i) = SUM(Basis(1:n)*Acoef_t(i,1,1:n)) END DO - END DO + ELSE + DO i = 1,3 + DO j = 1,3 + Nu(i,j) = SUM(Basis(1:n)*Acoef_t(i,j,1:n)) + END DO + END DO + END IF + ELSE + Nu = CMPLX(0._dp, 0._dp, kind=dp) + Nu(1,1) = mu + Nu(2,2) = mu + Nu(3,3) = mu + + IF (StrandedHomogenization) THEN + nu_val = SUM( Basis(1:n) * nu_11(1:n) ) + nuim_val = SUM( Basis(1:n) * nuim_11(1:n) ) + Nu(1,1) = CMPLX(nu_val, nuim_val, KIND=dp) + nu_val = SUM( Basis(1:n) * nu_22(1:n) ) + nuim_val = SUM( Basis(1:n) * nuim_22(1:n) ) + Nu(2,2) = CMPLX(nu_val, nuim_val, KIND=dp) + nu_val = SUM( Basis(1:n) * nu_33(1:n) ) + nuim_val = SUM( Basis(1:n) * nuim_33(1:n) ) + Nu(3,3) = CMPLX(nu_val, nuim_val, KIND=dp) + Nu = MATMUL(MATMUL(RotMLoc, Nu),TRANSPOSE(RotMLoc)) + END IF END IF - ELSE - Nu = CMPLX(0._dp, 0._dp, kind=dp) - Nu(1,1) = mu - Nu(2,2) = mu - Nu(3,3) = mu - - IF (StrandedHomogenization) THEN - nu_val = SUM( Basis(1:n) * nu_11(1:n) ) - nuim_val = SUM( Basis(1:n) * nuim_11(1:n) ) - Nu(1,1) = CMPLX(nu_val, nuim_val, KIND=dp) - nu_val = SUM( Basis(1:n) * nu_22(1:n) ) - nuim_val = SUM( Basis(1:n) * nuim_22(1:n) ) - Nu(2,2) = CMPLX(nu_val, nuim_val, KIND=dp) - nu_val = SUM( Basis(1:n) * nu_33(1:n) ) - nuim_val = SUM( Basis(1:n) * nuim_33(1:n) ) - Nu(3,3) = CMPLX(nu_val, nuim_val, KIND=dp) - Nu = MATMUL(MATMUL(RotMLoc, Nu),TRANSPOSE(RotMLoc)) + + M = MATMUL( LOAD(4:6,1:n), Basis(1:n) ) + L = MATMUL( LOAD(1:3,1:n), Basis(1:n) ) + + ! Compute C * grad(V), where C is a tensor + ! ----------------------------------------- + L = L-MATMUL(C, MATMUL(LOAD(7,1:n), dBasisdx(1:n,:))) + + IF( Jfix ) THEN + IF( JFixSolve ) THEN + ! If we haven't solved for the disbalance of source terms assemble it here + DO i = 1,n + p = i + JFixFORCE(p) = JFixFORCE(p) + SUM(L * dBasisdx(i,:)) * detJ * IP%s(t) + JFixVec(:,p) = JFixVec(:,p) + L * Basis(i) * detJ * IP%s(t) + END DO + ELSE + ! If we have already solved for the Jfix potential use it here + L = L - MATMUL(JfixPot, dBasisdx(1:n,:)) + END IF END IF - END IF - - M = MATMUL( LOAD(4:6,1:n), Basis(1:n) ) - L = MATMUL( LOAD(1:3,1:n), Basis(1:n) ) - - ! Compute C * grad(V), where C is a tensor - ! ----------------------------------------- - L = L-MATMUL(C, MATMUL(LOAD(7,1:n), dBasisdx(1:n,:))) - - IF( Jfix ) THEN - IF( JFixSolve ) THEN - ! If we haven't solved for the disbalance of source terms assemble it here - DO i = 1,n + + ! Compute element stiffness matrix and force vector: + ! -------------------------------------------------- + + ! If we calculate a coil, user can request that the nodal degrees of freedom are not used + ! -------------------------------------------------------------------------------------------- + NONCOIL_CONDUCTOR: IF (ConstraintActive .AND. (SUM(ABS(C)) > AEPS .OR. ElectroDynamics) ) THEN + ! + ! The constraint equation: -div(C*(j*omega*A+grad(V)))=0 + ! -------------------------------------------------------- + DO i=1,np + p = i + DO q=1,np + + ! Compute the conductivity term for stiffness + ! matrix (anisotropy taken into account) + ! ------------------------------------------- + IF(ElectroDynamics) THEN + DAMP(p,q) = DAMP(p,q) + P_ip*SUM(dBasisdx(q,:)*dBasisdx(p,:))*detJ*IP % s(t) + END IF + STIFF(p,q) = STIFF(p,q) + SUM(MATMUL(C, dBasisdx(q,:)) * dBasisdx(p,:))*detJ*IP % s(t) + END DO + DO j=1,nd-np + q = j+np + + ! Compute the conductivity term for + ! stiffness matrix (anisotropy taken into account) + ! ------------------------------------------- + DAMP(p,q) = DAMP(p,q) + & + SUM(MATMUL(C,Wbasis(j,:))*dBasisdx(i,:))*detJ*IP % s(t) + + IF(ElectroDynamics) THEN + MASS(p,q) = MASS(p,q) + P_ip*SUM(WBasis(j,:)*dBasisdx(i,:))*detJ*IP % s(t) + END IF + + ! Compute the conductivity term for + ! stiffness matrix (anisotropy taken into account) + ! ------------------------------------------------ + STIFF(q,p) = STIFF(q,p) + SUM(MATMUL(C, dBasisdx(i,:))*WBasis(j,:))*detJ*IP % s(t) + + IF(ElectroDynamics) THEN + DAMP(q,p) = DAMP(q,p) + & + P_ip * SUM( WBasis(j,:)*dBasisdx(i,:) )*detJ*IP % s(t) + END IF + END DO + END DO + END IF NONCOIL_CONDUCTOR + + IF ( HasVelocity ) THEN + DO i=1,np p = i - JFixFORCE(p) = JFixFORCE(p) + SUM(L * dBasisdx(i,:)) * detJ * IP%s(t) - JFixVec(:,p) = JFixVec(:,p) + L * Basis(i) * detJ * IP%s(t) + DO j=1,nd-np + q = j+np + RotWJ(1:3) = RotWBasis(j,1:3) + + CVelo(1:3) = C(1:3,1)*(velo(2)*RotWJ(3) - velo(3)*RotWJ(2)) + CVelo(1:3) = CVelo(1:3) + C(1:3,2)*(-velo(1)*RotWJ(3) + velo(3)*RotWJ(1)) + CVelo(1:3) = CVelo(1:3) + C(1:3,3)*(velo(1)*RotWJ(2) - velo(2)*RotWJ(1)) + CVeloSum = REAL(0,dp) + DO k=1,3 + CVeloSum = CVeloSum + CVelo(k)*dBasisdx(i,k) + END DO + STIFF(p,q) = STIFF(p,q) - CVeloSum*detJ*IP % s(t) + END DO END DO - ELSE - ! If we have already solved for the Jfix potential use it here - L = L - MATMUL(JfixPot, dBasisdx(1:n,:)) END IF - END IF - - ! Compute element stiffness matrix and force vector: - ! -------------------------------------------------- - - ! If we calculate a coil, user can request that the nodal degrees of freedom are not used - ! -------------------------------------------------------------------------------------------- - NONCOIL_CONDUCTOR: IF (ConstraintActive .AND. (SUM(ABS(C)) > AEPS .OR. ElectroDynamics) ) THEN - ! - ! The constraint equation: -div(C*(j*omega*A+grad(V)))=0 - ! -------------------------------------------------------- - DO i=1,np - p = i - DO q=1,np - - ! Compute the conductivity term for stiffness - ! matrix (anisotropy taken into account) - ! ------------------------------------------- - IF(ElectroDynamics) THEN - DAMP(p,q) = DAMP(p,q) + P_ip*SUM(dBasisdx(q,:)*dBasisdx(p,:))*detJ*IP % s(t) - END IF - STIFF(p,q) = STIFF(p,q) + SUM(MATMUL(C, dBasisdx(q,:)) * dBasisdx(p,:))*detJ*IP % s(t) - END DO - DO j=1,nd-np - q = j+np - - ! Compute the conductivity term for - ! stiffness matrix (anisotropy taken into account) - ! ------------------------------------------- - DAMP(p,q) = DAMP(p,q) + & - SUM(MATMUL(C,Wbasis(j,:))*dBasisdx(i,:))*detJ*IP % s(t) - - IF(ElectroDynamics) THEN - MASS(p,q) = MASS(p,q) + P_ip*SUM(WBasis(j,:)*dBasisdx(i,:))*detJ*IP % s(t) - END IF - - ! Compute the conductivity term for - ! stiffness matrix (anisotropy taken into account) - ! ------------------------------------------------ - STIFF(q,p) = STIFF(q,p) + SUM(MATMUL(C, dBasisdx(i,:))*WBasis(j,:))*detJ*IP % s(t) - - IF(ElectroDynamics) THEN - DAMP(q,p) = DAMP(q,p) + & - P_ip * SUM( WBasis(j,:)*dBasisdx(i,:) )*detJ*IP % s(t) - END IF - END DO - END DO - END IF NONCOIL_CONDUCTOR - - IF ( HasVelocity ) THEN - DO i=1,np - p = i - DO j=1,nd-np + ! + ! j*omega*C*A + curl(1/mu*curl(A)) + C*grad(V) = + ! J + curl(M) - C*grad(P'): + ! ---------------------------------------------------- + DO i = 1,nd-np + p = i+np + FORCE(p) = FORCE(p) + (SUM(L*WBasis(i,:)) + & + SUM(M*RotWBasis(i,:)))*detJ*IP%s(t) + + DO j = 1,nd-np q = j+np - RotWJ(1:3) = RotWBasis(j,1:3) - - CVelo(1:3) = C(1:3,1)*(velo(2)*RotWJ(3) - velo(3)*RotWJ(2)) - CVelo(1:3) = CVelo(1:3) + C(1:3,2)*(-velo(1)*RotWJ(3) + velo(3)*RotWJ(1)) - CVelo(1:3) = CVelo(1:3) + C(1:3,3)*(velo(1)*RotWJ(2) - velo(2)*RotWJ(1)) - CVeloSum = REAL(0,dp) - DO k=1,3 - CVeloSum = CVeloSum + CVelo(k)*dBasisdx(i,k) - END DO - STIFF(p,q) = STIFF(p,q) - CVeloSum*detJ*IP % s(t) + + IF ( Newton ) THEN + JAC(p,q) = JAC(p,q) + muder * SUM(B_ip(:)*RotWBasis(i,:)) * & + SUM(CONJG(B_ip(:))*RotWBasis(j,:))*detJ*IP % s(t)/Babs + END IF + + IF( HasVelocity ) THEN + STIFF(p,q) = STIFF(p,q) & + - SUM(WBasis(i,:)*MATMUL(C,CrossProduct(velo, RotWBasis(j,:))))*detJ*IP%s(t) + END IF + + STIFF(p,q) = STIFF(p,q) + & + SUM(MATMUL(Nu, RotWBasis(j,:))*RotWBasis(i,:))*detJ*IP%s(t) + + ! Compute the conductivity term + ! for stiffness matrix (anisotropy taken into account) + ! ---------------------------------------------------- + IF (CoilType /= 'stranded') DAMP(p,q) = DAMP(p,q) + & + SUM(MATMUL(C, WBasis(j,:))*WBasis(i,:))*detJ*IP % s(t) + + IF(ElectroDynamics ) THEN + MASS(p,q) = MASS(p,q) + & + P_ip*SUM(WBasis(j,:)*WBasis(i,:))*detJ*IP % s(t) + END IF END DO END DO - END IF - ! - ! j*omega*C*A + curl(1/mu*curl(A)) + C*grad(V) = - ! J + curl(M) - C*grad(P'): - ! ---------------------------------------------------- - DO i = 1,nd-np - p = i+np - FORCE(p) = FORCE(p) + (SUM(L*WBasis(i,:)) + & - SUM(M*RotWBasis(i,:)))*detJ*IP%s(t) - - DO j = 1,nd-np - q = j+np - - IF ( Newton ) THEN - JAC(p,q) = JAC(p,q) + muder * SUM(B_ip(:)*RotWBasis(i,:)) * & - SUM(CONJG(B_ip(:))*RotWBasis(j,:))*detJ*IP % s(t)/Babs - END IF - - IF( HasVelocity ) THEN - STIFF(p,q) = STIFF(p,q) & - - SUM(WBasis(i,:)*MATMUL(C,CrossProduct(velo, RotWBasis(j,:))))*detJ*IP%s(t) - END IF - - STIFF(p,q) = STIFF(p,q) + & - SUM(MATMUL(Nu, RotWBasis(j,:))*RotWBasis(i,:))*detJ*IP%s(t) - - ! Compute the conductivity term - ! for stiffness matrix (anisotropy taken into account) - ! ---------------------------------------------------- - IF (CoilType /= 'stranded') DAMP(p,q) = DAMP(p,q) + & - SUM(MATMUL(C, WBasis(j,:))*WBasis(i,:))*detJ*IP % s(t) - - IF(ElectroDynamics ) THEN - MASS(p,q) = MASS(p,q) + & - P_ip*SUM(WBasis(j,:)*WBasis(i,:))*detJ*IP % s(t) - END IF - END DO + END DO - - END DO - - IF ( Newton ) THEN - STIFF(1:nd,1:nd) = STIFF(1:nd,1:nd) + JAC - FORCE(1:nd) = FORCE(1:nd) + MATMUL(JAC,Aloc) - END IF - - IF(EigenSystem) THEN - MASS(1:nd,1:nd) = MASS(1:nd,1:nd) + im*DAMP(1:nd,1:nd) - ELSE - STIFF(1:nd,1:nd) = -Omega**2 * MASS(1:nd,1:nd) + & - im*Omega*DAMP(1:nd,1:nd) + STIFF(1:nd,1:nd) - END IF - -!------------------------------------------------------------------------------ - END SUBROUTINE LocalMatrix -!------------------------------------------------------------------------------ - - -!----------------------------------------------------------------------------- - SUBROUTINE LocalFixMatrixC( FORCE, & - Element, n, nd, PiolaVersion, SecondOrder ) -!------------------------------------------------------------------------------ - IMPLICIT NONE - COMPLEX(KIND=dp) :: FORCE(:) - INTEGER :: n, nd - TYPE(Element_t), POINTER :: Element - LOGICAL :: PiolaVersion, SecondOrder -!------------------------------------------------------------------------------ - REAL(KIND=dp) :: WBasis(nd,3), RotWBasis(nd,3) - REAL(KIND=dp) :: Basis(n),dBasisdx(n,3),DetJ - COMPLEX(KIND=dp) :: JfixPot(nd), L(3) - LOGICAL :: Stat - INTEGER :: t, i, p, np, EdgeBasisDegree - TYPE(GaussIntegrationPoints_t) :: IP - TYPE(Nodes_t), SAVE :: Nodes -!------------------------------------------------------------------------------ - IF (SecondOrder) THEN - EdgeBasisDegree = 2 - ELSE - EdgeBasisDegree = 1 - END IF - - CALL GetElementNodes( Nodes ) - - FORCE = 0.0d0 - JfixPot(1:n) = CMPLX( JfixVar % Values(JfixVar % Perm(Element % NodeIndexes)), & - JfixVarIm % Values(JfixVarIm % Perm(Element % NodeIndexes)) ) - -! IF( SUM( ABS( JfixPot(1:n) ) ) < TINY( DetJ ) ) RETURN - - - ! Numerical integration: - !---------------------- - IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & - EdgeBasisDegree=EdgeBasisDegree ) - - np = n*Solver % Def_Dofs(GetElementFamily(Element),Element % BodyId,1) - DO t=1,IP % n - stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & - IP % W(t), detJ, Basis, dBasisdx, EdgeBasis = WBasis, & - RotBasis = RotWBasis, USolver = pSolver ) + + IF ( Newton ) THEN + STIFF(1:nd,1:nd) = STIFF(1:nd,1:nd) + JAC + FORCE(1:nd) = FORCE(1:nd) + MATMUL(JAC,Aloc) + END IF + + IF(EigenSystem) THEN + MASS(1:nd,1:nd) = MASS(1:nd,1:nd) + im*DAMP(1:nd,1:nd) + ELSE + STIFF(1:nd,1:nd) = -Omega**2 * MASS(1:nd,1:nd) + & + im*Omega*DAMP(1:nd,1:nd) + STIFF(1:nd,1:nd) + END IF + + !------------------------------------------------------------------------------ + END SUBROUTINE LocalMatrix + !------------------------------------------------------------------------------ + + + !----------------------------------------------------------------------------- + SUBROUTINE LocalFixMatrixC( FORCE, & + Element, n, nd, PiolaVersion, SecondOrder ) + !------------------------------------------------------------------------------ + IMPLICIT NONE + COMPLEX(KIND=dp) :: FORCE(:) + INTEGER :: n, nd + TYPE(Element_t), POINTER :: Element + LOGICAL :: PiolaVersion, SecondOrder + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: WBasis(nd,3), RotWBasis(nd,3) + REAL(KIND=dp) :: Basis(n),dBasisdx(n,3),DetJ + COMPLEX(KIND=dp) :: JfixPot(nd), L(3) + LOGICAL :: Stat + INTEGER :: t, i, p, np, EdgeBasisDegree + TYPE(GaussIntegrationPoints_t) :: IP + TYPE(Nodes_t), SAVE :: Nodes + !------------------------------------------------------------------------------ + IF (SecondOrder) THEN + EdgeBasisDegree = 2 + ELSE + EdgeBasisDegree = 1 + END IF + + CALL GetElementNodes( Nodes ) + + FORCE = 0.0d0 + JfixPot(1:n) = CMPLX( JfixVar % Values(JfixVar % Perm(Element % NodeIndexes)), & + JfixVarIm % Values(JfixVarIm % Perm(Element % NodeIndexes)) ) + + ! IF( SUM( ABS( JfixPot(1:n) ) ) < TINY( DetJ ) ) RETURN + + + ! Numerical integration: + !---------------------- + IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & + EdgeBasisDegree=EdgeBasisDegree ) - L = MATMUL(JfixPot(1:n), dBasisdx(1:n,:)) - DO i = 1,nd-np - p = i+np - FORCE(p) = FORCE(p) - SUM(L*WBasis(i,:)) * detJ * IP%s(t) + np = n*Solver % Def_Dofs(GetElementFamily(Element),Element % BodyId,1) + DO t=1,IP % n + stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & + IP % W(t), detJ, Basis, dBasisdx, EdgeBasis = WBasis, & + RotBasis = RotWBasis, USolver = pSolver ) + + L = MATMUL(JfixPot(1:n), dBasisdx(1:n,:)) + DO i = 1,nd-np + p = i+np + FORCE(p) = FORCE(p) - SUM(L*WBasis(i,:)) * detJ * IP%s(t) + END DO END DO - END DO - - CALL DefaultUpdateForce(FORCE, Element ) + + CALL DefaultUpdateForce(FORCE, Element ) + + !------------------------------------------------------------------------------ + END SUBROUTINE LocalFixMatrixC + !------------------------------------------------------------------------------ + + -!------------------------------------------------------------------------------ - END SUBROUTINE LocalFixMatrixC -!------------------------------------------------------------------------------ - + + !----------------------------------------------------------------------------- + SUBROUTINE LocalMatrixBC( MASS, STIFF, FORCE, LOAD, Bcoef, Element, n, nd ) + !------------------------------------------------------------------------------ + IMPLICIT NONE + COMPLEX(KIND=dp) :: LOAD(:,:), Bcoef(:) + COMPLEX(KIND=dp) :: MASS(:,:), STIFF(:,:), FORCE(:) + INTEGER :: n, nd + TYPE(Element_t), POINTER :: Element, Parent, Edge + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: Basis(n),dBasisdx(n,3),DetJ + COMPLEX(KIND=dp) :: B, F, TC, L(3) + REAL(KIND=dp) :: WBasis(nd,3), RotWBasis(nd,3) + LOGICAL :: Stat, LineElem + INTEGER, POINTER :: EdgeMap(:,:) + TYPE(GaussIntegrationPoints_t) :: IP + INTEGER :: t, i, j, k, ii,jj, np, p, q, EdgeBasisDegree - + TYPE(Nodes_t), SAVE :: Nodes + !------------------------------------------------------------------------------ + IF (SecondOrder) THEN + EdgeBasisDegree = 2 + ELSE + EdgeBasisDegree = 1 + END IF -!----------------------------------------------------------------------------- - SUBROUTINE LocalMatrixBC( MASS, STIFF, FORCE, LOAD, Bcoef, Element, n, nd ) -!------------------------------------------------------------------------------ - IMPLICIT NONE - COMPLEX(KIND=dp) :: LOAD(:,:), Bcoef(:) - COMPLEX(KIND=dp) :: MASS(:,:), STIFF(:,:), FORCE(:) - INTEGER :: n, nd - TYPE(Element_t), POINTER :: Element, Parent, Edge -!------------------------------------------------------------------------------ - REAL(KIND=dp) :: Basis(n),dBasisdx(n,3),DetJ - COMPLEX(KIND=dp) :: B, F, TC, L(3) - REAL(KIND=dp) :: WBasis(nd,3), RotWBasis(nd,3) - LOGICAL :: Stat, LineElem - INTEGER, POINTER :: EdgeMap(:,:) - TYPE(GaussIntegrationPoints_t) :: IP - INTEGER :: t, i, j, k, ii,jj, np, p, q, EdgeBasisDegree - - TYPE(Nodes_t), SAVE :: Nodes -!------------------------------------------------------------------------------ - IF (SecondOrder) THEN - EdgeBasisDegree = 2 - ELSE - EdgeBasisDegree = 1 - END IF - - CALL GetElementNodes( Nodes ) - - MASS = 0.0_dp - STIFF = 0.0_dp - FORCE = 0.0_dp - - ! We may have line elements that define BC for the conductive layers, for example. - ! However, line elements do not have all the features of edge elements. Only - ! certains BCs are possible. - LineElem = ( Element % TYPE % ElementCode / 100 <= 2 ) + CALL GetElementNodes( Nodes ) + + MASS = 0.0_dp + STIFF = 0.0_dp + FORCE = 0.0_dp + + ! We may have line elements that define BC for the conductive layers, for example. + ! However, line elements do not have all the features of edge elements. Only + ! certains BCs are possible. + LineElem = ( Element % TYPE % ElementCode / 100 <= 2 ) + + ! Numerical integration: + !----------------------- + IF( LineElem ) THEN + IP = GaussPoints(Element) + ELSE + IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & + EdgeBasisDegree=EdgeBasisDegree) + END IF - ! Numerical integration: - !----------------------- - IF( LineElem ) THEN - IP = GaussPoints(Element) - ELSE + np = n*MAXVAL(Solver % Def_Dofs(GetElementFamily(Element),:,1)) + DO t=1,IP % n + IF( LineElem ) THEN + stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & + IP % W(t), detJ, Basis, dBasisdx ) + ELSE + stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & + IP % W(t), detJ, Basis, dBasisdx, & + EdgeBasis = Wbasis, RotBasis = RotWBasis, USolver = pSolver ) + END IF + + B = SUM(Basis(1:n) * Bcoef(1:n)) + L = MATMUL(LOAD(1:3,1:n), Basis(1:n)) + + F = SUM(LOAD(4,1:n)*Basis(1:n)) !* (-im/Omega) + TC = SUM(LOAD(5,1:n)*Basis(1:n)) !* (-im/Omega) + + + ! Compute element stiffness matrix and force vector: + !--------------------------------------------------- + DO p=1,np + FORCE(p) = FORCE(p) + F*Basis(p)*detJ*IP % s(t) + DO q=1,np + STIFF(p,q) = STIFF(p,q) + TC * & + Basis(p)*Basis(q)*detJ*IP % s(T) + END DO + END DO + + ! We cannot do the following for line elements + IF( LineElem ) CYCLE + + DO i = 1,nd-np + p = i+np + FORCE(p) = FORCE(p) - SUM(L*Wbasis(i,:))*detJ*IP%s(t) + DO j = 1,nd-np + q = j+np + STIFF(p,q) = STIFF(p,q) + B * & + SUM(Wbasis(i,:)*Wbasis(j,:))*detJ*IP%s(t) + END DO + END DO + END DO + !------------------------------------------------------------------------------ + END SUBROUTINE LocalMatrixBC + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + SUBROUTINE LocalMatrixAirGapBC(MASS, STIFF, FORCE, LOAD, GapLength, AirGapMu, Element, n, nd ) + !------------------------------------------------------------------------------ + IMPLICIT NONE + COMPLEX(KIND=dp) :: LOAD(:,:) + COMPLEX(KIND=dp) :: MASS(:,:), STIFF(:,:), FORCE(:) + INTEGER :: n, nd + TYPE(Element_t), POINTER :: Element, Parent, Edge + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: Basis(n),dBasisdx(n,3),DetJ + REAL(KIND=dp) :: WBasis(nd,3), RotWBasis(nd,3), localGapLength, muAir, muVacuum + REAL(KIND=dp) :: GapLength(:), AirGapMu(:) + LOGICAL :: Stat + INTEGER, POINTER :: EdgeMap(:,:) + TYPE(GaussIntegrationPoints_t) :: IP + INTEGER :: t, i, j, np, p, q, EdgeBasisDegree + + TYPE(Nodes_t), SAVE :: Nodes + !------------------------------------------------------------------------------ + CALL GetElementNodes( Nodes, Element ) + + EdgeBasisDegree = 1 + IF (SecondOrder) EdgeBasisDegree = 2 + + MASS = 0.0_dp + STIFF = 0.0_dp + FORCE = 0.0_dp + + muVacuum = 4 * PI * 1d-7 + + ! Numerical integration: + !----------------------- IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & - EdgeBasisDegree=EdgeBasisDegree) - END IF - - np = n*MAXVAL(Solver % Def_Dofs(GetElementFamily(Element),:,1)) - DO t=1,IP % n - IF( LineElem ) THEN - stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & - IP % W(t), detJ, Basis, dBasisdx ) - ELSE + EdgeBasisDegree=EdgeBasisDegree) + + np = n*MAXVAL(Solver % Def_Dofs(GetElementFamily(Element),:,1)) + DO t=1,IP % n + stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & IP % W(t), detJ, Basis, dBasisdx, & EdgeBasis = Wbasis, RotBasis = RotWBasis, USolver = pSolver ) - END IF - - B = SUM(Basis(1:n) * Bcoef(1:n)) - L = MATMUL(LOAD(1:3,1:n), Basis(1:n)) - - F = SUM(LOAD(4,1:n)*Basis(1:n)) !* (-im/Omega) - TC = SUM(LOAD(5,1:n)*Basis(1:n)) !* (-im/Omega) - - - ! Compute element stiffness matrix and force vector: - !--------------------------------------------------- - DO p=1,np - FORCE(p) = FORCE(p) + F*Basis(p)*detJ*IP % s(t) - DO q=1,np - STIFF(p,q) = STIFF(p,q) + TC * & - Basis(p)*Basis(q)*detJ*IP % s(T) - END DO - END DO - - ! We cannot do the following for line elements - IF( LineElem ) CYCLE - DO i = 1,nd-np - p = i+np - FORCE(p) = FORCE(p) - SUM(L*Wbasis(i,:))*detJ*IP%s(t) - DO j = 1,nd-np - q = j+np - STIFF(p,q) = STIFF(p,q) + B * & - SUM(Wbasis(i,:)*Wbasis(j,:))*detJ*IP%s(t) - END DO - END DO - END DO -!------------------------------------------------------------------------------ - END SUBROUTINE LocalMatrixBC -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ - SUBROUTINE LocalMatrixAirGapBC(MASS, STIFF, FORCE, LOAD, GapLength, AirGapMu, Element, n, nd ) -!------------------------------------------------------------------------------ - IMPLICIT NONE - COMPLEX(KIND=dp) :: LOAD(:,:) - COMPLEX(KIND=dp) :: MASS(:,:), STIFF(:,:), FORCE(:) - INTEGER :: n, nd - TYPE(Element_t), POINTER :: Element, Parent, Edge -!------------------------------------------------------------------------------ - REAL(KIND=dp) :: Basis(n),dBasisdx(n,3),DetJ - REAL(KIND=dp) :: WBasis(nd,3), RotWBasis(nd,3), localGapLength, muAir, muVacuum - REAL(KIND=dp) :: GapLength(:), AirGapMu(:) - LOGICAL :: Stat - INTEGER, POINTER :: EdgeMap(:,:) - TYPE(GaussIntegrationPoints_t) :: IP - INTEGER :: t, i, j, np, p, q, EdgeBasisDegree - - TYPE(Nodes_t), SAVE :: Nodes -!------------------------------------------------------------------------------ - CALL GetElementNodes( Nodes, Element ) - - EdgeBasisDegree = 1 - IF (SecondOrder) EdgeBasisDegree = 2 - - MASS = 0.0_dp - STIFF = 0.0_dp - FORCE = 0.0_dp - - muVacuum = 4 * PI * 1d-7 - - ! Numerical integration: - !----------------------- - IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & - EdgeBasisDegree=EdgeBasisDegree) - - np = n*MAXVAL(Solver % Def_Dofs(GetElementFamily(Element),:,1)) - DO t=1,IP % n + localGapLength = SUM(Basis(1:n) * GapLength(1:n)) + muAir = SUM(Basis(1:n) * AirGapMu(1:n)) + + DO i = 1,nd-np + p = i+np + DO j = 1,nd-np + q = j+np + STIFF(p,q) = STIFF(p,q) + localGapLength / (muAir*muVacuum) * & + SUM(RotWBasis(i,:)*RotWBasis(j,:))*detJ*IP%s(t) + END DO + END DO + END DO + !------------------------------------------------------------------------------ + END SUBROUTINE LocalMatrixAirGapBC + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + SUBROUTINE LocalMatrixThinSheet(MASS, STIFF, FORCE, LOAD, Thickness, Permeability, & + Conductivity, Element, n, nd ) + !------------------------------------------------------------------------------ + IMPLICIT NONE + COMPLEX(KIND=dp) :: LOAD(:,:) + COMPLEX(KIND=dp) :: MASS(:,:), STIFF(:,:), FORCE(:) + INTEGER :: n, nd + TYPE(Element_t), POINTER :: Element, Parent, Edge + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: Basis(n),dBasisdx(n,3),DetJ + REAL(KIND=dp) :: WBasis(nd,3), RotWBasis(nd,3) + REAL(KIND=dp) :: Thickness(:), Permeability(:), Conductivity(:) + REAL(KIND=dp) :: sheetThickness, mu, muVacuum, C + + COMPLEX(KIND=dp) :: DAMP(nd,nd) - stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & - IP % W(t), detJ, Basis, dBasisdx, & - EdgeBasis = Wbasis, RotBasis = RotWBasis, USolver = pSolver ) - - localGapLength = SUM(Basis(1:n) * GapLength(1:n)) - muAir = SUM(Basis(1:n) * AirGapMu(1:n)) - - DO i = 1,nd-np - p = i+np - DO j = 1,nd-np - q = j+np - STIFF(p,q) = STIFF(p,q) + localGapLength / (muAir*muVacuum) * & - SUM(RotWBasis(i,:)*RotWBasis(j,:))*detJ*IP%s(t) + LOGICAL :: Stat + INTEGER, POINTER :: EdgeMap(:,:) + TYPE(GaussIntegrationPoints_t) :: IP + INTEGER :: t, i, j, np, p, q, EdgeBasisDegree + + TYPE(Nodes_t), SAVE :: Nodes + !------------------------------------------------------------------------------ + CALL GetElementNodes( Nodes, Element ) + + EdgeBasisDegree = 1 + IF (SecondOrder) EdgeBasisDegree = 2 + + MASS = 0.0_dp + DAMP = 0.0_dp + STIFF = 0.0_dp + FORCE = 0.0_dp + + muVacuum = 4 * PI * 1d-7 + + ! Numerical integration: + !----------------------- + IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & + EdgeBasisDegree=EdgeBasisDegree) + + np = n*MAXVAL(Solver % Def_Dofs(GetElementFamily(Element),:,1)) + DO t=1,IP % n + stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & + IP % W(t), detJ, Basis, dBasisdx, & + EdgeBasis = Wbasis, RotBasis = RotWBasis, USolver = pSolver ) + + sheetThickness = SUM(Basis(1:n) * Thickness(1:n)) + mu = SUM(Basis(1:n) * Permeability(1:n)) + C = SUM(Basis(1:n) * Conductivity(1:n)) + + CONDUCTOR: IF ( ABS(C) > AEPS ) THEN + ! + ! The constraint equation: -div(C*(j*omega*A+grad(V)))=0 + ! -------------------------------------------------------- + DO i=1,np + p = i + DO q=1,np + + ! Compute the conductivity term for stiffness + ! matrix (without anisotropy taken into account) + ! ------------------------------------------- + STIFF(p,q) = STIFF(p,q) + sheetThickness * C * SUM(dBasisdx(q,:) * dBasisdx(i,:))*detJ*IP % s(t) + END DO + DO j=1,nd-np + q = j+np + + ! Compute the conductivity term for + ! stiffness matrix (without anisotropy taken into account) + ! ------------------------------------------- + DAMP(p,q) = DAMP(p,q) + & + sheetThickness * C*SUM(Wbasis(j,:)*dBasisdx(i,:))*detJ*IP % s(t) + + ! Compute the conductivity term for + ! stiffness matrix (without anisotropy taken into account) + ! ------------------------------------------------ + STIFF(q,p) = STIFF(q,p) + sheetThickness * C*SUM(dBasisdx(i,:)*WBasis(j,:))*detJ*IP % s(t) + END DO + END DO + END IF CONDUCTOR + + DO i = 1,nd-np + p = i+np + DO j = 1,nd-np + q = j+np + ! Magnetic energy term due to the magnetic flux density + ! ---------------------------------------------------- + STIFF(p,q) = STIFF(p,q) + sheetThickness / (mu*muVacuum) * & + SUM(RotWBasis(i,:)*RotWBasis(j,:))*detJ*IP%s(t) + + ! Compute the conductivity term + ! for stiffness matrix (without anisotropy taken into account) + ! ---------------------------------------------------- + IF (ABS(C) > AEPS) THEN + DAMP(p,q) = DAMP(p,q) + sheetThickness * & + C * SUM(WBasis(j,:)*WBasis(i,:))*detJ*IP % s(t) + END IF + END DO END DO - END DO - END DO -!------------------------------------------------------------------------------ - END SUBROUTINE LocalMatrixAirGapBC -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ - SUBROUTINE LocalMatrixThinSheet(MASS, STIFF, FORCE, LOAD, Thickness, Permeability, & - Conductivity, Element, n, nd ) -!------------------------------------------------------------------------------ - IMPLICIT NONE - COMPLEX(KIND=dp) :: LOAD(:,:) - COMPLEX(KIND=dp) :: MASS(:,:), STIFF(:,:), FORCE(:) - INTEGER :: n, nd - TYPE(Element_t), POINTER :: Element, Parent, Edge -!------------------------------------------------------------------------------ - REAL(KIND=dp) :: Basis(n),dBasisdx(n,3),DetJ - REAL(KIND=dp) :: WBasis(nd,3), RotWBasis(nd,3) - REAL(KIND=dp) :: Thickness(:), Permeability(:), Conductivity(:) - REAL(KIND=dp) :: sheetThickness, mu, muVacuum, C - - COMPLEX(KIND=dp) :: DAMP(nd,nd) - - LOGICAL :: Stat - INTEGER, POINTER :: EdgeMap(:,:) - TYPE(GaussIntegrationPoints_t) :: IP - INTEGER :: t, i, j, np, p, q, EdgeBasisDegree - - TYPE(Nodes_t), SAVE :: Nodes -!------------------------------------------------------------------------------ - CALL GetElementNodes( Nodes, Element ) - - EdgeBasisDegree = 1 - IF (SecondOrder) EdgeBasisDegree = 2 - - MASS = 0.0_dp - DAMP = 0.0_dp - STIFF = 0.0_dp - FORCE = 0.0_dp - - muVacuum = 4 * PI * 1d-7 - - ! Numerical integration: - !----------------------- - IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & - EdgeBasisDegree=EdgeBasisDegree) - - np = n*MAXVAL(Solver % Def_Dofs(GetElementFamily(Element),:,1)) - DO t=1,IP % n - stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & - IP % W(t), detJ, Basis, dBasisdx, & - EdgeBasis = Wbasis, RotBasis = RotWBasis, USolver = pSolver ) - - sheetThickness = SUM(Basis(1:n) * Thickness(1:n)) - mu = SUM(Basis(1:n) * Permeability(1:n)) - C = SUM(Basis(1:n) * Conductivity(1:n)) - - CONDUCTOR: IF ( ABS(C) > AEPS ) THEN - ! - ! The constraint equation: -div(C*(j*omega*A+grad(V)))=0 - ! -------------------------------------------------------- - DO i=1,np - p = i - DO q=1,np - - ! Compute the conductivity term for stiffness - ! matrix (without anisotropy taken into account) - ! ------------------------------------------- - STIFF(p,q) = STIFF(p,q) + sheetThickness * C * SUM(dBasisdx(q,:) * dBasisdx(i,:))*detJ*IP % s(t) + END DO + + IF(EigenSystem) THEN + MASS(1:nd,1:nd) = MASS(1:nd,1:nd) + im*DAMP(1:nd,1:nd) + ELSE + STIFF(1:nd,1:nd) = -omega**2 * MASS(1:nd,1:nd) + & + im*Omega*DAMP(1:nd,1:nd) + STIFF(1:nd,1:nd) + END IF + + !------------------------------------------------------------------------------ + END SUBROUTINE LocalMatrixThinSheet + !------------------------------------------------------------------------------ + + + !------------------------------------------------------------------------------ + SUBROUTINE LocalMatrixSkinBC( MASS, STIFF, FORCE, SkinCond, SkinMu, & + Element, CircuitDrivenBC, n, nd ) + !------------------------------------------------------------------------------ + IMPLICIT NONE + COMPLEX(KIND=dp) :: MASS(:,:), STIFF(:,:), FORCE(:) + REAL(KIND=dp) :: SkinCond(:), SkinMu(:) + TYPE(Element_t), POINTER :: Element + LOGICAL :: CircuitDrivenBC + INTEGER :: n, nd + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: Basis(n), dBasisdx(n,3), DetJ + REAL(KIND=dp) :: WBasis(nd,3), RotWBasis(nd,3), cond, mu, muVacuum, delta + LOGICAL :: Stat + TYPE(GaussIntegrationPoints_t) :: IP + COMPLEX(KIND=dp) :: invZs, DAMP(nd,nd) + INTEGER :: t, i, j, np, p, q, EdgeBasisDegree + + TYPE(Nodes_t), SAVE :: Nodes + !------------------------------------------------------------------------------ + CALL GetElementNodes( Nodes, Element ) + + EdgeBasisDegree = 1 + IF (SecondOrder) EdgeBasisDegree = 2 + + MASS = 0.0_dp + DAMP = 0.0_dp + STIFF = 0.0_dp + FORCE = 0.0_dp + + muVacuum = 4 * PI * 1d-7 + + ! Numerical integration: + !----------------------- + IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & + EdgeBasisDegree=EdgeBasisDegree) + + np = n*MAXVAL(Solver % Def_Dofs(GetElementFamily(Element),:,1)) + + DO t=1,IP % n + stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & + IP % W(t), detJ, Basis, dBasisdx, & + EdgeBasis = Wbasis, RotBasis = RotWBasis, USolver = pSolver ) + + cond = SUM(Basis(1:n) * SkinCond(1:n)) + mu = muVacuum * SUM(Basis(1:n) * SkinMu(1:n)) + delta = SQRT( 2.0_dp/(cond*omega*mu)) + invZs = (cond*delta)/(1.0_dp+im) + !PRINT *,'skin:',cond,delta,omega,invZs + !PRINT *,'elem:',Element % NodeIndexes + + ! + ! The contributions from the constraint (H x n) x n = 1/Z E x n: + ! + DO i = 1,nd-np + p = i+np + DO j = 1,nd-np + q = j+np + ! + ! The term i*omega/Z < A x n, v x n> : With ApplyPiolaTransform = .TRUE. + ! the edge basis functions returned by the function EdgeElementInfo are automatically + ! tangential and hence the normal doesn't appear in the expression. + ! + DAMP(p,q) = DAMP(p,q) + invZs * & + SUM(WBasis(i,:) * WBasis(j,:)) * detJ * IP % s(t) + END DO + + IF (.NOT. CircuitDrivenBC) THEN + DO q = 1,np + ! + ! The term 1/Z < grad V x n, v x n> : + ! Some tensor calculation shows that the component form of this term is analogous to + ! the case < A x n, v x n>. + ! + STIFF(p,q) = STIFF(p,q) + invZs * & + SUM(WBasis(i,:) * dBasisdx(q,:)) * detJ * IP % s(t) END DO - DO j=1,nd-np - q = j+np - - ! Compute the conductivity term for - ! stiffness matrix (without anisotropy taken into account) - ! ------------------------------------------- - DAMP(p,q) = DAMP(p,q) + & - sheetThickness * C*SUM(Wbasis(j,:)*dBasisdx(i,:))*detJ*IP % s(t) - - ! Compute the conductivity term for - ! stiffness matrix (without anisotropy taken into account) - ! ------------------------------------------------ - STIFF(q,p) = STIFF(q,p) + sheetThickness * C*SUM(dBasisdx(i,:)*WBasis(j,:))*detJ*IP % s(t) + END IF + + END DO + + ! + ! The contributions from applying Ohm's law to the tangential surface current + ! + IF (.NOT. CircuitDrivenBC) THEN + DO p = 1,np + DO q = 1,np + STIFF(p,q) = STIFF(p,q) + invZs * & + SUM(dBasisdx(p,:) * dBasisdx(q,:)) * detJ * IP % s(t) + END DO + + DO j = 1,nd-np + q = j+np + DAMP(p,q) = DAMP(p,q) + invZs * & + SUM(dBasisdx(p,:) * WBasis(j,:)) * detJ * IP % s(t) + END DO END DO - END DO - END IF CONDUCTOR - - DO i = 1,nd-np - p = i+np - DO j = 1,nd-np - q = j+np - ! Magnetic energy term due to the magnetic flux density - ! ---------------------------------------------------- - STIFF(p,q) = STIFF(p,q) + sheetThickness / (mu*muVacuum) * & - SUM(RotWBasis(i,:)*RotWBasis(j,:))*detJ*IP%s(t) - - ! Compute the conductivity term - ! for stiffness matrix (without anisotropy taken into account) - ! ---------------------------------------------------- - IF (ABS(C) > AEPS) THEN - DAMP(p,q) = DAMP(p,q) + sheetThickness * & - C * SUM(WBasis(j,:)*WBasis(i,:))*detJ*IP % s(t) - END IF - END DO - END DO - END DO - - IF(EigenSystem) THEN - MASS(1:nd,1:nd) = MASS(1:nd,1:nd) + im*DAMP(1:nd,1:nd) - ELSE - STIFF(1:nd,1:nd) = -omega**2 * MASS(1:nd,1:nd) + & - im*Omega*DAMP(1:nd,1:nd) + STIFF(1:nd,1:nd) - END IF - -!------------------------------------------------------------------------------ - END SUBROUTINE LocalMatrixThinSheet -!------------------------------------------------------------------------------ - - -!------------------------------------------------------------------------------ - SUBROUTINE LocalMatrixSkinBC( MASS, STIFF, FORCE, SkinCond, SkinMu, & - Element, CircuitDrivenBC, n, nd ) -!------------------------------------------------------------------------------ - IMPLICIT NONE - COMPLEX(KIND=dp) :: MASS(:,:), STIFF(:,:), FORCE(:) - REAL(KIND=dp) :: SkinCond(:), SkinMu(:) - TYPE(Element_t), POINTER :: Element - LOGICAL :: CircuitDrivenBC - INTEGER :: n, nd -!------------------------------------------------------------------------------ - REAL(KIND=dp) :: Basis(n), dBasisdx(n,3), DetJ - REAL(KIND=dp) :: WBasis(nd,3), RotWBasis(nd,3), cond, mu, muVacuum, delta - LOGICAL :: Stat - TYPE(GaussIntegrationPoints_t) :: IP - COMPLEX(KIND=dp) :: invZs, DAMP(nd,nd) - INTEGER :: t, i, j, np, p, q, EdgeBasisDegree - - TYPE(Nodes_t), SAVE :: Nodes -!------------------------------------------------------------------------------ - CALL GetElementNodes( Nodes, Element ) - - EdgeBasisDegree = 1 - IF (SecondOrder) EdgeBasisDegree = 2 - - MASS = 0.0_dp - DAMP = 0.0_dp - STIFF = 0.0_dp - FORCE = 0.0_dp - - muVacuum = 4 * PI * 1d-7 + END IF + END DO + + IF(EigenSystem) THEN + MASS(1:nd,1:nd) = MASS(1:nd,1:nd) + im*DAMP(1:nd,1:nd) + ELSE + STIFF(1:nd,1:nd) = -omega**2 * MASS(1:nd,1:nd) + & + im*Omega*DAMP(1:nd,1:nd) + STIFF(1:nd,1:nd) + END IF + !------------------------------------------------------------------------------ + END SUBROUTINE LocalMatrixSkinBC + !------------------------------------------------------------------------------ + - ! Numerical integration: - !----------------------- - IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & - EdgeBasisDegree=EdgeBasisDegree) - - np = n*MAXVAL(Solver % Def_Dofs(GetElementFamily(Element),:,1)) - - DO t=1,IP % n - stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & - IP % W(t), detJ, Basis, dBasisdx, & - EdgeBasis = Wbasis, RotBasis = RotWBasis, USolver = pSolver ) - - cond = SUM(Basis(1:n) * SkinCond(1:n)) - mu = muVacuum * SUM(Basis(1:n) * SkinMu(1:n)) - delta = SQRT( 2.0_dp/(cond*omega*mu)) - invZs = (cond*delta)/(1.0_dp+im) - !PRINT *,'skin:',cond,delta,omega,invZs - !PRINT *,'elem:',Element % NodeIndexes - - ! - ! The contributions from the constraint (H x n) x n = 1/Z E x n: + !----------------------------------------------------------------------------- + FUNCTION LocalFluxBC( LOAD, Element, n, nd ) RESULT(Bn) + !------------------------------------------------------------------------------ + IMPLICIT NONE + COMPLEX(KIND=dp) :: LOAD(:,:), Bn + INTEGER :: n, nd + TYPE(Element_t), POINTER :: Element, Edge, Parent + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: Basis(nd),dBasisdx(nd,3),DetJ + REAL(KIND=dp) :: Normal(3) + COMPLEX(KIND=dp) :: L(3), ln + LOGICAL :: Stat + INTEGER :: t + TYPE(GaussIntegrationPoints_t) :: IP + + TYPE(Nodes_t), SAVE :: Nodes + !------------------------------------------------------------------------------ + CALL GetElementNodes( Nodes, Element ) ! - DO i = 1,nd-np - p = i+np - DO j = 1,nd-np - q = j+np - ! - ! The term i*omega/Z < A x n, v x n> : With ApplyPiolaTransform = .TRUE. - ! the edge basis functions returned by the function EdgeElementInfo are automatically - ! tangential and hence the normal doesn't appear in the expression. - ! - DAMP(p,q) = DAMP(p,q) + invZs * & - SUM(WBasis(i,:) * WBasis(j,:)) * detJ * IP % s(t) + ! Integrate (B,n) over boundary face: + ! ----------------------------------- + IP = GaussPoints(Element) + Bn = 0._dp + DO t=1,IP % n + stat = ElementInfo( Element,Nodes,IP % U(t),IP % V(t), & + IP % W(t),detJ,Basis,dBasisdx ) + + Normal=NormalVector(Element,Nodes,IP % u(t),ip % v(t),.TRUE.) + Ln = SUM(LOAD(4,1:n)*Basis(1:n)) + L = MATMUL(LOAD(1:3,1:n), Basis(1:n)) + Bn = Bn + Detj * IP % S(t) * (Ln+SUM(L*Normal)) + END DO + !------------------------------------------------------------------------------ + END FUNCTION LocalFluxBC + !------------------------------------------------------------------------------ + + + !------------------------------------------------------------------------------ + SUBROUTINE DirichletAfromB() + !------------------------------------------------------------------------------ + USE ElementDescription, ONLY: GetEdgeMap + + IMPLICIT NONE + REAL(KIND=dp) :: p(3),q(3),cx(3),r,xmin,ymin,zmin,xmax,ymax,zmax + COMPLEX(KIND=dp) :: S + TYPE(ListMatrixEntry_t), POINTER :: Ltmp + TYPE(Matrix_t), POINTER :: Smat + TYPE(Nodes_t),SAVE :: Nodes + TYPE(ValueList_t), POINTER :: BC + + LOGICAL :: Found, Found1,Found2,Found3,L1,L2,L3 + INTEGER :: i,j,k,l,m,t,ii,Faces,n,nd,Active,je1,je2,pe1,pe2 + + TYPE(Element_t), POINTER :: Element, Edge, Edge1 + COMPLEX(KIND=dp), ALLOCATABLE :: Bn(:) + INTEGER, POINTER :: EdgeMap(:,:) + INTEGER, ALLOCATABLE :: dMap(:),FaceMap(:) + LOGICAL, ALLOCATABLE :: FluxBoundaryEdge(:), CycleEdges(:), UsedFaces(:) + !------------------------------------------------------------------------------ + ALLOCATE(FluxBoundaryEdge(Mesh % NumberOFEdges)); FluxBoundaryEdge=.FALSE. + + Active = GetNOFBoundaryElements() + DO t=1,Active + Element => GetBoundaryElement(t) + + IF ( GetElementFamily()==1 ) CYCLE + BC=>GetBC() + IF (.NOT. ASSOCIATED(BC) ) CYCLE + + Found = ListCheckPrefix(BC,'Magnetic Flux Density') + + IF ( Found ) THEN + SELECT CASE(GetElementFamily()) + CASE(2) + CYCLE !what would it mean in 2D,at least with only B_z solved? + CASE(3,4) + k = GetBoundaryFaceIndex(Element); Element => Mesh % Faces(k) + END SELECT + IF (.NOT. ActiveBoundaryElement(Element)) CYCLE + FluxBoundaryEdge(Element % EdgeIndexes)=.TRUE. + END IF + END DO + + FluxCount = COUNT(FluxBoundaryEdge) + IF ( FluxCount==0 ) THEN + DEALLOCATE(FluxBoundaryEdge); RETURN + END IF + + IF (.NOT. ALLOCATED(FluxMap) ) ALLOCATE(FluxMap(FluxCount)) + FluxCount = 0 + DO i=1,Mesh % NumberOfEdges + IF ( FluxBoundaryEdge(i) ) THEN + FluxCount = FluxCount+1 + FluxMap(FluxCount) = i + END IF + END DO + DEALLOCATE(FluxBoundaryEdge) + + DO i=1,FluxCount + Edge => Mesh % Edges(FluxMap(i)) + Edge % BoundaryInfo % Left => NULL() + Edge % BoundaryInfo % Right => NULL() + END DO + + ALLOCATE(FaceMap(Mesh % NumberOfFaces)); FaceMap=0 + Faces = 0 + DO t=1,Active + Element => GetBoundaryElement(t) + + IF ( GetElementFamily()==1 ) CYCLE + BC=>GetBC() + IF (.NOT. ASSOCIATED(BC) ) CYCLE + + Found = ListCheckPrefix(BC,'Magnetic Flux Density') + IF ( .NOT. Found ) CYCLE + + k = GetBoundaryFaceIndex(Element); Element=>Mesh % Faces(k) + IF (.NOT. ActiveBoundaryElement(Element)) CYCLE + Faces = Faces + 1 + FaceMap(k) = Faces + + DO i=1,Element % TYPE % NumberOfNodes + Edge => Mesh % Edges(Element % EdgeIndexes(i)) + IF (.NOT.ASSOCIATED(Edge % BoundaryInfo % Left)) THEN + Edge % BoundaryInfo % Left => Element + ELSE IF (.NOT.ASSOCIATED(Edge % BoundaryInfo % Right)) THEN + Edge % BoundaryInfo % Right => Element + END IF END DO - - IF (.NOT. CircuitDrivenBC) THEN - DO q = 1,np - ! - ! The term 1/Z < grad V x n, v x n> : - ! Some tensor calculation shows that the component form of this term is analogous to - ! the case < A x n, v x n>. - ! - STIFF(p,q) = STIFF(p,q) + invZs * & - SUM(WBasis(i,:) * dBasisdx(q,:)) * detJ * IP % s(t) - END DO + END DO + + + ! Make gauge tree for the boundary: + ! --------------------------------- + CALL GaugeTreeFluxBC(Solver,Mesh,TreeEdges,BasicCycles,FluxCount,FluxMap) + + WRITE(Message,*) 'Boundary tree edges: ', & + i2s(COUNT(TreeEdges(FluxMap))), & + ' of total: ',i2s(FluxCount) + CALL Info('WhitneyAVHarmonicSolver: ', Message, Level=5) + + ! Get (B,n) for BC faces: + ! ----------------------- + ALLOCATE(Bn(Faces)) + DO t=1,Active + Element => GetBoundaryElement(t) + + IF ( GetElementFamily()==1 ) CYCLE + BC=>GetBC() + IF (.NOT. ASSOCIATED(BC) ) CYCLE + + n = GetElementNOFNodes(Element) + CALL GetComplexVector(BC,Load(1:3,1:n),'Magnetic Flux Density',Found1) + + LOAD(4,1:n) = GetReal(BC,'Magnetic Flux Density {n}',Found) + LOAD(4,1:n) = LOAD(4,1:n)+im*GetReal(BC,'Magnetic Flux Density im {n}',L1) + Found = Found.OR.L1 + + IF (Found.OR.Found1) THEN + k = GetBoundaryFaceIndex(Element) + Element => Mesh % Faces(k) + IF (.NOT.ActiveBoundaryElement(Element)) CYCLE + nd = GetElementNOFDOFs(Element) + Bn(FaceMap(k))=LocalFluxBC(LOAD,Element,n,nd) END IF - END DO - - ! - ! The contributions from applying Ohm's law to the tangential surface current + ! - IF (.NOT. CircuitDrivenBC) THEN - DO p = 1,np - DO q = 1,np - STIFF(p,q) = STIFF(p,q) + invZs * & - SUM(dBasisdx(p,:) * dBasisdx(q,:)) * detJ * IP % s(t) + ! Calculate value for free edges using the Fundamental Loop Basis + ! generated by GaugeTreeFluxBC(): + ! --------------------------------------------------------------- + ALLOCATE(CycleEdges(Mesh % NumberOFEdges), UsedFaces(Faces)) + CycleEdges = .FALSE. + ALLOCATE(dMap(MAXVAL(BasicCycles(:) % Degree))) + + Smat => GetMatrix() + DO i=1,SIZE(BasicCycles) + IF (BasicCycles(i) % Degree<=0 ) CYCLE + + ! + ! Extract loop edge indices: + ! -------------------------- + j = 0 + Ltmp => BasicCycles(i) % Head + DO WHILE(ASSOCIATED(Ltmp)) + j = j + 1 + dMap(j) = Ltmp % Index; Ltmp => Ltmp % Next + END DO + IF ( j<= 0 ) CYCLE + + ! + ! Orient edges to form a polygonal path: + ! -------------------------------------- + Edge => Mesh % Edges(dMap(j)) + Edge1 => Mesh % Edges(dMap(j-1)) + IF ( ANY(Edge % NodeIndexes(1)==Edge1 % NodeIndexes) ) THEN + l = Edge % NodeIndexes(1) + Edge % NodeIndexes(1) = Edge % NodeIndexes(2) + Edge % NodeIndexes(2) = l + END IF + + DO k=j-1,1,-1 + Edge1 => Mesh % Edges(dMap(k)) + IF (Edge % NodeIndexes(2)==Edge1 % NodeIndexes(2)) THEN + l = Edge1 % NodeIndexes(1) + Edge1 % NodeIndexes(1) = Edge1 % NodeIndexes(2) + Edge1 % NodeIndexes(2) = l + END IF + Edge => Edge1 + END DO + + ! + ! Try to find which way is inside... + ! ---------------------------------- + Edge => Mesh % Edges(dMap(j)) + Element => Edge % BoundaryInfo % Left + IF ( j==3 ) THEN + m = 0 + DO k=1,3 + DO l=1,3 + IF (dMap(l)==Element % EdgeIndexes(k)) m=m+1 END DO - - DO j = 1,nd-np - q = j+np - DAMP(p,q) = DAMP(p,q) + invZs * & - SUM(dBasisdx(p,:) * WBasis(j,:)) * detJ * IP % s(t) + END DO + L1 = m==3 + IF ( .NOT. L1 ) Element=>Edge % BoundaryInfo % Right + S = Bn(FaceMap(Element % ElementIndex)) + ELSE + ! If not a triangle, try a (planar) polygonal test. This + ! will fail for general 3D paths. We'll spot the failure + ! later by trial and error...Might be preferable to skip + ! this altogether? Dunno.... + ! ------------------------------------------------------ + xmin=HUGE(xmin); xmax=-HUGE(xmax); + ymin=HUGE(ymin); ymax=-HUGE(ymax); + zmin=HUGE(zmin); zmax=-HUGE(zmax); + DO k=1,j + Edge1 => Mesh % Edges(dMap(k)) + DO l=1,2 + m = Edge1 % NodeIndexes(l) + xmin = MIN(xmin,Mesh % Nodes % x(m)) + ymin = MIN(ymin,Mesh % Nodes % y(m)) + zmin = MIN(zmin,Mesh % Nodes % z(m)) + + xmax = MAX(xmax,Mesh % Nodes % x(m)) + ymax = MAX(ymax,Mesh % Nodes % y(m)) + zmax = MAX(zmax,Mesh % Nodes % z(m)) END DO END DO + L1 = xmax-xmin > ymax-ymin + L2 = xmax-xmin > zmax-zmin + L3 = ymax-ymin > zmax-zmin + IF ( l1 ) THEN + l=1 + IF ( l3 ) THEN + m=2; n=3 + ELSE + m=3; n=2 + END IF + ELSE + IF ( l2 ) THEN + l=1; m=2; n=3 + ELSE + l=3; m=1; n=2 + END IF + END IF + cx(l) = SUM(Mesh % Nodes % x(Element % NodeIndexes))/3._dp + cx(m) = SUM(Mesh % Nodes % y(Element % NodeIndexes))/3._dp + cx(n) = SUM(Mesh % Nodes % z(Element % NodeIndexes))/3._dp + + L1 = .FALSE. + DO k=j,1,-1 + Edge1 => Mesh % Edges(dMap(k)) + je1 = Edge1 % NodeIndexes(1) + je2 = Edge1 % NodeIndexes(2) + p(l) = Mesh % Nodes % x(je1) + p(m) = Mesh % Nodes % y(je1) + p(n) = Mesh % Nodes % z(je1) + + q(l) = Mesh % Nodes % x(je2) + q(m) = Mesh % Nodes % y(je2) + q(n) = Mesh % Nodes % z(je2) + + IF ((q(2)>cx(2)).NEQV.(p(2)>cx(2))) THEN + IF (cx(1)<(p(1)-q(1))*(cx(2)-q(2))/(p(2)-q(2))+q(1)) L1=.NOT.L1 + END IF + END DO + IF (.NOT.L1) THEN + IF (ASSOCIATED(Edge % BoundaryInfo % Right)) & + Element=>Edge % BoundaryInfo % Right + END IF + + ! Compute integral of (B,n) inside the cycle path + ! ----------------------------------------------- + CycleEdges(dMap(1:j))=.TRUE. + DO m=1,2 + S=0; UsedFaces=.FALSE.; + IF( FloodFill(Element,CycleEdges, & + FaceMap,UsedFaces,Bn,S) )EXIT + + ! the in/out guess was wrong, try the other way: + ! ---------------------------------------------- + IF (ASSOCIATED(Edge % BoundaryInfo % Right,Element)) THEN + Element => Edge % BoundaryInfo % Left + ELSE + Element => Edge % BoundaryInfo % Right + END IF + END DO + CycleEdges(dMap(1:j))=.FALSE. END IF - END DO - - IF(EigenSystem) THEN - MASS(1:nd,1:nd) = MASS(1:nd,1:nd) + im*DAMP(1:nd,1:nd) - ELSE - STIFF(1:nd,1:nd) = -omega**2 * MASS(1:nd,1:nd) + & - im*Omega*DAMP(1:nd,1:nd) + STIFF(1:nd,1:nd) - END IF -!------------------------------------------------------------------------------ - END SUBROUTINE LocalMatrixSkinBC -!------------------------------------------------------------------------------ - -!----------------------------------------------------------------------------- - FUNCTION LocalFluxBC( LOAD, Element, n, nd ) RESULT(Bn) -!------------------------------------------------------------------------------ + ! + ! Orient edge to parent triangle... + ! --------------------------------- + je1 = Edge % NodeIndexes(1) + je2 = Edge % NodeIndexes(2) + EdgeMap => GetEdgeMap(GetElementFamily(Element)) + DO t=1,Element % TYPE % NumberOfEdges + pe1 = Element % NodeIndexes(EdgeMap(t,1)) + pe2 = Element % NodeIndexes(EdgeMap(t,2)) + IF (pe1==je1.AND.pe2==je2 .OR. pe1==je2.AND.pe2==je1) EXIT + END DO + IF ( pe1/=je1 ) S=-S + + ! + ! ...because we now know how to orient against outward normal: + ! ------------------------------------------------------------ + CALL GetElementNodes(Nodes,Element) + p = NormalVector(Element,Nodes,0._dp,0._dp) + q = NormalVector(Element,Nodes,0._dp,0._dp,.TRUE.) + IF ( SUM(p*q)<0 ) S=-S + + ! + ! Check whether some edges in the path have nonzero values, + ! if so, substract from integral: + ! --------------------------------------------------------- + DO k=j-1,1,-1 + l = Perm(dMap(k)+nNodes) + R = Smat % RHS(l) / Smat % Values(Smat % Diag(l)) + IF ( R==0 ) CYCLE + + Edge1 => Mesh % Edges(dMap(k)) + pe1=Edge1 % NodeIndexes(1) + pe2=Edge1 % NodeIndexes(2) + IF ( pe2 Mesh % Edges(j) % BoundaryInfo % Right + IF(.NOT.FloodFill(e,CycleEdges,FaceMap,UsedFaces,Bn,CycleSum)) RETURN + + e => Mesh % Edges(j) % BoundaryInfo % Left + IF(.NOT.FloodFill(e,CycleEdges,FaceMap,UsedFaces,Bn,CycleSum)) RETURN + END DO + Found=.TRUE.; RETURN + !------------------------------------------------------------------------------ + END FUNCTION FloodFill + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + END SUBROUTINE WhitneyAVHarmonicSolver + !------------------------------------------------------------------------------ + + !/*****************************************************************************/ + ! * + ! * Elmer, A Finite Element Software for Multiphysical Problems + ! * + ! * Copyright 1st April 1995 - , CSC - IT Center for Science Ltd., Finland + ! * + ! * This program is free software; you can redistribute it and/or + ! * modify it under the terms of the GNU General Public License + ! * as published by the Free Software Foundation; either version 2 + ! * of the License, or (at your option) any later version. + ! * + ! * This program is distributed in the hope that it will be useful, + ! * but WITHOUT ANY WARRANTY; without even the implied warranty of + ! * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ! * GNU General Public License for more details. + ! * + ! * You should have received a copy of the GNU General Public License + ! * along with this program (in file fem/GPL-2); if not, write to the + ! * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + ! * Boston, MA 02110-1301, USA. + ! * + ! *****************************************************************************/ + ! * + ! * Utilities written as solvers to compute the Helmholtz projection P(A) + ! * of a curl-conforming vector field A. The projection can be obtained as + ! * P(A) = A - W where W is the curl-conforming field fitted to represent + ! * grad Phi, with Phi being a H1-regular scalar field. + ! * + ! * This file contains harmonic version of the transformation and also applies the + ! * correction to the V field within conducting regions. + ! * + ! * + ! * Authors: Mika Malinen, Juha Ruokolainen + ! * Email: mika.malinen@csc.fi + ! * Web: http://www.csc.fi/elmer + ! * Address: CSC - IT Center for Science Ltd. + ! * Keilaranta 14 + ! * 02101 Espoo, Finland + ! * + ! * Original Date: March 20, 2020 + ! * Last Modified: June 18, 2021, Juha + ! * + !****************************************************************************** + + + !------------------------------------------------------------------------------ + SUBROUTINE HelmholtzProjector_Init0(Model, Solver, dt, Transient) + !------------------------------------------------------------------------------ + USE DefUtils IMPLICIT NONE - COMPLEX(KIND=dp) :: LOAD(:,:), Bn - INTEGER :: n, nd - TYPE(Element_t), POINTER :: Element, Edge, Parent -!------------------------------------------------------------------------------ - REAL(KIND=dp) :: Basis(nd),dBasisdx(nd,3),DetJ - REAL(KIND=dp) :: Normal(3) - COMPLEX(KIND=dp) :: L(3), ln - LOGICAL :: Stat - INTEGER :: t - TYPE(GaussIntegrationPoints_t) :: IP - - TYPE(Nodes_t), SAVE :: Nodes -!------------------------------------------------------------------------------ - CALL GetElementNodes( Nodes, Element ) - ! - ! Integrate (B,n) over boundary face: - ! ----------------------------------- - IP = GaussPoints(Element) - Bn = 0._dp - DO t=1,IP % n - stat = ElementInfo( Element,Nodes,IP % U(t),IP % V(t), & - IP % W(t),detJ,Basis,dBasisdx ) - - Normal=NormalVector(Element,Nodes,IP % u(t),ip % v(t),.TRUE.) - Ln = SUM(LOAD(4,1:n)*Basis(1:n)) - L = MATMUL(LOAD(1:3,1:n), Basis(1:n)) - Bn = Bn + Detj * IP % S(t) * (Ln+SUM(L*Normal)) + !------------------------------------------------------------------------------ + TYPE(Model_t) :: Model + TYPE(Solver_t) :: Solver + REAL(KIND=dp) :: dt + LOGICAL :: Transient + !------------------------------------------------------------------------------ + LOGICAL :: Found + INTEGER :: i + TYPE(ValueList_t), POINTER :: SolverParams + !------------------------------------------------------------------------------ + SolverParams => GetSolverParams() + DO i=1,Model % NumberOfSolvers + IF (ListGetLogical( Model % Solvers(i) % Values, 'Helmholtz Projection', Found)) EXIT END DO -!------------------------------------------------------------------------------ - END FUNCTION LocalFluxBC -!------------------------------------------------------------------------------ - - -!------------------------------------------------------------------------------ - SUBROUTINE DirichletAfromB() -!------------------------------------------------------------------------------ - USE ElementDescription, ONLY: GetEdgeMap - + CALL ListCopyPrefixedKeywords(Model % Solvers(i) % Values, SolverParams, 'HelmholtzProjector:') + !------------------------------------------------------------------------------ + END SUBROUTINE HelmholtzProjector_Init0 + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + SUBROUTINE HelmholtzProjector_Init(Model, Solver, dt, Transient) + !------------------------------------------------------------------------------ + USE DefUtils IMPLICIT NONE - REAL(KIND=dp) :: p(3),q(3),cx(3),r,xmin,ymin,zmin,xmax,ymax,zmax - COMPLEX(KIND=dp) :: S - TYPE(ListMatrixEntry_t), POINTER :: Ltmp - TYPE(Matrix_t), POINTER :: Smat - TYPE(Nodes_t),SAVE :: Nodes - TYPE(ValueList_t), POINTER :: BC - - LOGICAL :: Found, Found1,Found2,Found3,L1,L2,L3 - INTEGER :: i,j,k,l,m,t,ii,Faces,n,nd,Active,je1,je2,pe1,pe2 - - TYPE(Element_t), POINTER :: Element, Edge, Edge1 - COMPLEX(KIND=dp), ALLOCATABLE :: Bn(:) - INTEGER, POINTER :: EdgeMap(:,:) - INTEGER, ALLOCATABLE :: dMap(:),FaceMap(:) - LOGICAL, ALLOCATABLE :: FluxBoundaryEdge(:), CycleEdges(:), UsedFaces(:) -!------------------------------------------------------------------------------ - ALLOCATE(FluxBoundaryEdge(Mesh % NumberOFEdges)); FluxBoundaryEdge=.FALSE. - - Active = GetNOFBoundaryElements() - DO t=1,Active - Element => GetBoundaryElement(t) - - IF ( GetElementFamily()==1 ) CYCLE - BC=>GetBC() - IF (.NOT. ASSOCIATED(BC) ) CYCLE - - Found = ListCheckPrefix(BC,'Magnetic Flux Density') - - IF ( Found ) THEN - SELECT CASE(GetElementFamily()) - CASE(2) - CYCLE !what would it mean in 2D,at least with only B_z solved? - CASE(3,4) - k = GetBoundaryFaceIndex(Element); Element => Mesh % Faces(k) - END SELECT - IF (.NOT. ActiveBoundaryElement(Element)) CYCLE - FluxBoundaryEdge(Element % EdgeIndexes)=.TRUE. - END IF + !------------------------------------------------------------------------------ + TYPE(Model_t) :: Model + TYPE(Solver_t) :: Solver + REAL(KIND=dp) :: dt + LOGICAL :: Transient + !------------------------------------------------------------------------------ + LOGICAL :: Found + INTEGER :: i,j + TYPE(ValueList_t), POINTER :: SolverParams + !------------------------------------------------------------------------------ + + SolverParams => GetSolverParams() + CALL ListAddNewLogical(SolverParams, 'Linear System Refactorize', .FALSE.) + + CALL ListAddString( SolverParams, 'Variable', 'pd' ) + CALL ListAddLogical( SolverParams, 'Variable Output',.FALSE. ) + + DO i=1,Model % NumberOfSolvers + IF(ListGetLogical( Model % Solvers(i) % Values, 'Helmholtz Projection', Found)) EXIT END DO - - FluxCount = COUNT(FluxBoundaryEdge) - IF ( FluxCount==0 ) THEN - DEALLOCATE(FluxBoundaryEdge); RETURN - END IF - - IF (.NOT. ALLOCATED(FluxMap) ) ALLOCATE(FluxMap(FluxCount)) - FluxCount = 0 - DO i=1,Mesh % NumberOfEdges - IF ( FluxBoundaryEdge(i) ) THEN - FluxCount = FluxCount+1 - FluxMap(FluxCount) = i + CALL ListAddString( SolverParams, 'Potential Variable', GetVarName(Model % Solvers(i) % Variable)) + + ! Solver is using a single linear system to solve complex components, + ! assign storage for final complex result. + ! ------------------------------------------------------------------- + CALL ListAddString( SolverParams, 'Exported Variable 1', 'P[P re:1 P im:1]' ) + + CALL ListAddLogical( SolverParams, 'Linear System Symmetric', .TRUE. ) + CALL ListAddString( SolverParams, 'Linear System Solver', 'Iterative' ) + CALL ListAddString( SolverParams, 'Linear System Preconditioning', 'ILU' ) + CALL ListAddInteger( SolverParams, 'Linear System Residual Output', 25 ) + CALL ListAddInteger( SolverParams, 'Linear System Max Iterations', 2000 ) + CALL ListAddString( SolverParams, 'Linear System Iterative Method', 'CG' ) + CALL ListAddConstReal( SolverParams, 'Linear System Convergence Tolerance', 1.0d-9 ) + + DO j=1,Model % NumberOfBCs + IF ( ListCheckPrefix( Model % BCs(j) % Values, & + TRIM(GetVarName(Model % Solvers(i) % Variable)) // ' re {e}' ) ) THEN + CALL ListAddConstReal( Model % BCs(j) % Values, 'Pd', 0._dp ) END IF END DO - DEALLOCATE(FluxBoundaryEdge) - - DO i=1,FluxCount - Edge => Mesh % Edges(FluxMap(i)) - Edge % BoundaryInfo % Left => NULL() - Edge % BoundaryInfo % Right => NULL() - END DO - - ALLOCATE(FaceMap(Mesh % NumberOfFaces)); FaceMap=0 - Faces = 0 - DO t=1,Active - Element => GetBoundaryElement(t) - - IF ( GetElementFamily()==1 ) CYCLE - BC=>GetBC() - IF (.NOT. ASSOCIATED(BC) ) CYCLE - - Found = ListCheckPrefix(BC,'Magnetic Flux Density') - IF ( .NOT. Found ) CYCLE - - k = GetBoundaryFaceIndex(Element); Element=>Mesh % Faces(k) - IF (.NOT. ActiveBoundaryElement(Element)) CYCLE - Faces = Faces + 1 - FaceMap(k) = Faces - - DO i=1,Element % TYPE % NumberOfNodes - Edge => Mesh % Edges(Element % EdgeIndexes(i)) - IF (.NOT.ASSOCIATED(Edge % BoundaryInfo % Left)) THEN - Edge % BoundaryInfo % Left => Element - ELSE IF (.NOT.ASSOCIATED(Edge % BoundaryInfo % Right)) THEN - Edge % BoundaryInfo % Right => Element - END IF - END DO - END DO - - - ! Make gauge tree for the boundary: - ! --------------------------------- - CALL GaugeTreeFluxBC(Solver,Mesh,TreeEdges,BasicCycles,FluxCount,FluxMap) - - WRITE(Message,*) 'Boundary tree edges: ', & - i2s(COUNT(TreeEdges(FluxMap))), & - ' of total: ',i2s(FluxCount) - CALL Info('WhitneyAVHarmonicSolver: ', Message, Level=5) - - ! Get (B,n) for BC faces: - ! ----------------------- - ALLOCATE(Bn(Faces)) - DO t=1,Active - Element => GetBoundaryElement(t) - - IF ( GetElementFamily()==1 ) CYCLE - BC=>GetBC() - IF (.NOT. ASSOCIATED(BC) ) CYCLE - - n = GetElementNOFNodes(Element) - CALL GetComplexVector(BC,Load(1:3,1:n),'Magnetic Flux Density',Found1) - - LOAD(4,1:n) = GetReal(BC,'Magnetic Flux Density {n}',Found) - LOAD(4,1:n) = LOAD(4,1:n)+im*GetReal(BC,'Magnetic Flux Density im {n}',L1) - Found = Found.OR.L1 - - IF (Found.OR.Found1) THEN - k = GetBoundaryFaceIndex(Element) - Element => Mesh % Faces(k) - IF (.NOT.ActiveBoundaryElement(Element)) CYCLE - nd = GetElementNOFDOFs(Element) - Bn(FaceMap(k))=LocalFluxBC(LOAD,Element,n,nd) + !------------------------------------------------------------------------------ + END SUBROUTINE HelmholtzProjector_Init + !------------------------------------------------------------------------------ + + + !------------------------------------------------------------------------------ + !> Compute a H1-regular scalar field to obtain the Helmholtz projection P(A) + !> of a curl-conforming vector field A. Given the solution field Phi of this + !> solver, the projection can be evaluated as P(A) = A - grad Phi. + !------------------------------------------------------------------------------ + SUBROUTINE HelmholtzProjector(Model, Solver, dt, TransientSimulation) + !------------------------------------------------------------------------------ + USE DefUtils + IMPLICIT NONE + !------------------------------------------------------------------------------ + TYPE(Model_t) :: Model + TYPE(Solver_t) :: Solver + REAL(KIND=dp) :: dt + LOGICAL :: TransientSimulation + !------------------------------------------------------------------------------ + ! Local variables: + !------------------------------------------------------------------------------ + TYPE(Mesh_t), POINTER :: Mesh + TYPE(ValueList_t), POINTER :: SolverParams + TYPE(Solver_t), POINTER :: SolverPtr + TYPE(Element_t), POINTER :: Element + + LOGICAL :: AllocationsDone = .FALSE. + LOGICAL :: Found + LOGICAL :: PiolaVersion, SecondOrder + LOGICAL :: ConstantBulkMatrix + + INTEGER :: i, j,k,l,n, n_pot, nd_pot, t + INTEGER :: dim, PotDOFs + INTEGER :: istat, active + + REAL(KIND=dp), ALLOCATABLE, TARGET :: Stiff(:,:), Force(:,:), PotSol(:,:), F(:,:) + REAL(KIND=dp) :: Norm, Omega + REAL(KIND=dp), POINTER :: SaveRHS(:), SOL(:) + CHARACTER(LEN=MAX_NAME_LEN) :: PotName + + TYPE(Variable_t), POINTER :: v + + SAVE Stiff, Force, PotSol, AllocationsDone + !------------------------------------------------------------------------------ + CALL DefaultStart() + + dim = CoordinateSystemDimension() + SolverParams => GetSolverParams() + Mesh => GetMesh() + + ! Allocate some permanent storage, this is done first time only: + !--------------------------------------------------------------- + IF (.NOT. AllocationsDone) THEN + n = Mesh % MaxElementDOFs + + ALLOCATE( FORCE(2,n), STIFF(n,n), PotSol(2,n), STAT=istat ) + IF ( istat /= 0 ) THEN + CALL Fatal( 'HelmholtzProjectorZ', 'Memory allocation error.' ) + END IF + AllocationsDone = .TRUE. + END IF + + ! + ! Find the variable which is projected: + ! + PotName = GetString(SolverParams, 'Potential Variable', Found) + IF (.NOT. Found ) PotName = 'av' + Found = .FALSE. + DO i=1,Model % NumberOfSolvers + SolverPtr => Model % Solvers(i) + IF (PotName == GetVarName(SolverPtr % Variable)) THEN + Found = .TRUE. + EXIT END IF END DO - + + IF (Found ) THEN + CALL Info('HelmholtzProjectorZ', 'Solver inherits potential '& + //TRIM(PotName)//' from solver: '//I2S(i),Level=7) + ELSE + CALL Fatal('HelmholtzProjectorZ', 'Solver associated with potential variable > '& + //TRIM(PotName)//' < not found!') + END IF + ! - ! Calculate value for free edges using the Fundamental Loop Basis - ! generated by GaugeTreeFluxBC(): - ! --------------------------------------------------------------- - ALLOCATE(CycleEdges(Mesh % NumberOFEdges), UsedFaces(Faces)) - CycleEdges = .FALSE. - ALLOCATE(dMap(MAXVAL(BasicCycles(:) % Degree))) - - Smat => GetMatrix() - DO i=1,SIZE(BasicCycles) - IF (BasicCycles(i) % Degree<=0 ) CYCLE - - ! - ! Extract loop edge indices: - ! -------------------------- - j = 0 - Ltmp => BasicCycles(i) % Head - DO WHILE(ASSOCIATED(Ltmp)) - j = j + 1 - dMap(j) = Ltmp % Index; Ltmp => Ltmp % Next - END DO - IF ( j<= 0 ) CYCLE - + ! Find some parameters to inherit the vector FE basis as defined in + ! the primary solver: + ! + CALL EdgeElementStyle(SolverPtr % Values, PiolaVersion, QuadraticApproximation = SecondOrder ) + IF (PiolaVersion) CALL Info('HelmholtzProjectorZ', & + 'Using Piola-transformed finite elements', Level=5) + + n = Solver % Matrix % NumberOfRows + ALLOCATE(F(n,2)); F=0 + + !----------------------- + ! System assembly: + !---------------------- + active = GetNOFActive() + CALL DefaultInitialize(Solver) + + SaveRHS => Solver % Matrix % RHS + + DO t=1,active + Element => GetActiveElement(t) ! - ! Orient edges to form a polygonal path: - ! -------------------------------------- - Edge => Mesh % Edges(dMap(j)) - Edge1 => Mesh % Edges(dMap(j-1)) - IF ( ANY(Edge % NodeIndexes(1)==Edge1 % NodeIndexes) ) THEN - l = Edge % NodeIndexes(1) - Edge % NodeIndexes(1) = Edge % NodeIndexes(2) - Edge % NodeIndexes(2) = l - END IF - - DO k=j-1,1,-1 - Edge1 => Mesh % Edges(dMap(k)) - IF (Edge % NodeIndexes(2)==Edge1 % NodeIndexes(2)) THEN - l = Edge1 % NodeIndexes(1) - Edge1 % NodeIndexes(1) = Edge1 % NodeIndexes(2) - Edge1 % NodeIndexes(2) = l - END IF - Edge => Edge1 - END DO - + ! This solver relies on getting basis functions by calling a routine + ! which returns a curl-conforming basis. It is thus assumed that + ! the background mesh defines the number of Lagrange basis functions. ! - ! Try to find which way is inside... - ! ---------------------------------- - Edge => Mesh % Edges(dMap(j)) - Element => Edge % BoundaryInfo % Left - IF ( j==3 ) THEN - m = 0 - DO k=1,3 - DO l=1,3 - IF (dMap(l)==Element % EdgeIndexes(k)) m=m+1 - END DO - END DO - L1 = m==3 - IF ( .NOT. L1 ) Element=>Edge % BoundaryInfo % Right - S = Bn(FaceMap(Element % ElementIndex)) - ELSE - ! If not a triangle, try a (planar) polygonal test. This - ! will fail for general 3D paths. We'll spot the failure - ! later by trial and error...Might be preferable to skip - ! this altogether? Dunno.... - ! ------------------------------------------------------ - xmin=HUGE(xmin); xmax=-HUGE(xmax); - ymin=HUGE(ymin); ymax=-HUGE(ymax); - zmin=HUGE(zmin); zmax=-HUGE(zmax); - DO k=1,j - Edge1 => Mesh % Edges(dMap(k)) - DO l=1,2 - m = Edge1 % NodeIndexes(l) - xmin = MIN(xmin,Mesh % Nodes % x(m)) - ymin = MIN(ymin,Mesh % Nodes % y(m)) - zmin = MIN(zmin,Mesh % Nodes % z(m)) - - xmax = MAX(xmax,Mesh % Nodes % x(m)) - ymax = MAX(ymax,Mesh % Nodes % y(m)) - zmax = MAX(zmax,Mesh % Nodes % z(m)) + n = GetElementNOFNodes() + + ! The DOF counts for the potential (target) variable: + n_pot = n*SolverPtr % Def_Dofs(GetElementFamily(Element), Element % BodyId, 1) + nd_pot = GetElementNOFDOFs(USolver=SolverPtr) + + CALL GetVectorLocalSolution(PotSol, PotName, USolver=SolverPtr) + + ! Get element local matrix and rhs vector: + !---------------------------------------- + CALL LocalMatrix(Stiff, Force, Element, n, dim, PiolaVersion, & + SecondOrder, n_pot, nd_pot, PotSol ) + + ! Update global matrix and rhs vector from local matrix & vector: + !--------------------------------------------------------------- + Solver % Matrix % RHS => F(:,1) + CALL DefaultUpdateForce(FORCE(1,:)) + + Solver % Matrix % RHS => F(:,2) + CALL DefaultUpdateEquations(STIFF, FORCE(2,:)) + END DO + + CALL DefaultFinishBulkAssembly() + CALL DefaultDirichletBCs() + + v => VariableGet( Mesh % Variables, 'P' ) + SOL => v % Values + + Solver % Matrix % RHS => F(:,1) + CALL DefaultDirichletBCs() + Norm = DefaultSolve() + SOL(1::2) = Solver % Variable % Values + + Solver % Matrix % RHS => F(:,2) + CALL DefaultDirichletBCs() + Norm = DefaultSolve() + SOL(2::2) = Solver % Variable % Values + + Solver % Matrix % RHS => SaveRHS + + + omega = GetAngularFrequency() + + ! + ! Finally, redefine the potential variable: + ! ----------------------------------------- + DO i=1,Solver % Mesh % NumberOfNodes + j = Solver % Variable % Perm(i) + IF(j==0) CYCLE + + k = SolverPtr % Variable % Perm(i) + IF (k == 0) THEN + CALL Fatal('HelmholtzProjectorZ', & + 'The variable and potential permutations are nonmatching?') + END IF + + SolverPtr % Variable % Values(2*k-1) = SolverPtr % Variable % Values(2*k-1) - & + omega * SOL(2*j) + + SolverPtr % Variable % Values(2*k) = SolverPtr % Variable % Values(2*k) + & + omega * SOL(2*j-1) + END DO + + CONTAINS + + !------------------------------------------------------------------------------ + SUBROUTINE LocalMatrix(Stiff, Force, Element, n, dim, PiolaVersion, & + SecondOrder, n_pot, nd_pot, PotSol ) + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: Stiff(:,:), Force(:,:) + TYPE(Element_t), POINTER :: Element + INTEGER :: n ! The number of background element nodes + INTEGER :: dim + LOGICAL :: PiolaVersion, SecondOrder + INTEGER :: n_pot, nd_pot ! The size parameters of target field + REAL(KIND=dp) :: PotSol(:,:) ! The values of target field DOFS + !------------------------------------------------------------------------------ + TYPE(GaussIntegrationPoints_t) :: IP + TYPE(Nodes_t), SAVE :: Nodes + + LOGICAL :: Stat + + INTEGER :: i, j, p, q, t, EdgeBasisDegree + + REAL(KIND=dp) :: Basis(n), dBasisdx(n,3), A(2,3) + REAL(KIND=dp) :: u, v, w, s, DetJ + REAL(KIND=dp) :: WBasis(nd_pot-n_pot,3), CurlWBasis(nd_pot-n_pot,3) + !------------------------------------------------------------------------------ + CALL GetElementNodes(Nodes) + + STIFF = 0.0_dp + FORCE = 0.0_dp + + IF (SecondOrder) THEN + EdgeBasisDegree = 2 + ELSE + EdgeBasisDegree = 1 + END IF + IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & + EdgeBasisDegree=EdgeBasisDegree) + IF( dim == 2 .AND. .NOT. PiolaVersion ) THEN + CALL Fatal('HelmholtzProjectorZ', '"Use Piola Transform = True" needed in 2D') + END IF + + DO t=1,IP % n + stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & + IP % W(t), detJ, Basis, dBasisdx, & + EdgeBasis = Wbasis, RotBasis = CurlWBasis, USolver = SolverPtr ) + s = detJ * IP % s(t) + + A = MATMUL(PotSol(:,n_pot+1:nd_pot), WBasis(1:nd_pot-n_pot,:)) + + DO p=1,n + DO q=1,n + STIFF(p,q) = STIFF(p,q) + SUM(dBasisdx(q,1:dim) * dBasisdx(p,1:dim)) * s END DO END DO - L1 = xmax-xmin > ymax-ymin - L2 = xmax-xmin > zmax-zmin - L3 = ymax-ymin > zmax-zmin - IF ( l1 ) THEN - l=1 - IF ( l3 ) THEN - m=2; n=3 - ELSE - m=3; n=2 - END IF - ELSE - IF ( l2 ) THEN - l=1; m=2; n=3 - ELSE - l=3; m=1; n=2 - END IF - END IF - cx(l) = SUM(Mesh % Nodes % x(Element % NodeIndexes))/3._dp - cx(m) = SUM(Mesh % Nodes % y(Element % NodeIndexes))/3._dp - cx(n) = SUM(Mesh % Nodes % z(Element % NodeIndexes))/3._dp - - L1 = .FALSE. - DO k=j,1,-1 - Edge1 => Mesh % Edges(dMap(k)) - je1 = Edge1 % NodeIndexes(1) - je2 = Edge1 % NodeIndexes(2) - p(l) = Mesh % Nodes % x(je1) - p(m) = Mesh % Nodes % y(je1) - p(n) = Mesh % Nodes % z(je1) - - q(l) = Mesh % Nodes % x(je2) - q(m) = Mesh % Nodes % y(je2) - q(n) = Mesh % Nodes % z(je2) - - IF ((q(2)>cx(2)).NEQV.(p(2)>cx(2))) THEN - IF (cx(1)<(p(1)-q(1))*(cx(2)-q(2))/(p(2)-q(2))+q(1)) L1=.NOT.L1 - END IF - END DO - IF (.NOT.L1) THEN - IF (ASSOCIATED(Edge % BoundaryInfo % Right)) & - Element=>Edge % BoundaryInfo % Right - END IF - - ! Compute integral of (B,n) inside the cycle path - ! ----------------------------------------------- - CycleEdges(dMap(1:j))=.TRUE. - DO m=1,2 - S=0; UsedFaces=.FALSE.; - IF( FloodFill(Element,CycleEdges, & - FaceMap,UsedFaces,Bn,S) )EXIT - - ! the in/out guess was wrong, try the other way: - ! ---------------------------------------------- - IF (ASSOCIATED(Edge % BoundaryInfo % Right,Element)) THEN - Element => Edge % BoundaryInfo % Left - ELSE - Element => Edge % BoundaryInfo % Right - END IF + + DO p=1,n + FORCE(1,p) = FORCE(1,p) + SUM(A(1,:) * dBasisdx(p,:)) * s + FORCE(2,p) = FORCE(2,p) + SUM(A(2,:) * dBasisdx(p,:)) * s END DO - CycleEdges(dMap(1:j))=.FALSE. - END IF - - ! - ! Orient edge to parent triangle... - ! --------------------------------- - je1 = Edge % NodeIndexes(1) - je2 = Edge % NodeIndexes(2) - EdgeMap => GetEdgeMap(GetElementFamily(Element)) - DO t=1,Element % TYPE % NumberOfEdges - pe1 = Element % NodeIndexes(EdgeMap(t,1)) - pe2 = Element % NodeIndexes(EdgeMap(t,2)) - IF (pe1==je1.AND.pe2==je2 .OR. pe1==je2.AND.pe2==je1) EXIT - END DO - IF ( pe1/=je1 ) S=-S - - ! - ! ...because we now know how to orient against outward normal: - ! ------------------------------------------------------------ - CALL GetElementNodes(Nodes,Element) - p = NormalVector(Element,Nodes,0._dp,0._dp) - q = NormalVector(Element,Nodes,0._dp,0._dp,.TRUE.) - IF ( SUM(p*q)<0 ) S=-S - - ! - ! Check whether some edges in the path have nonzero values, - ! if so, substract from integral: - ! --------------------------------------------------------- - DO k=j-1,1,-1 - l = Perm(dMap(k)+nNodes) - R = Smat % RHS(l) / Smat % Values(Smat % Diag(l)) - IF ( R==0 ) CYCLE - - Edge1 => Mesh % Edges(dMap(k)) - pe1=Edge1 % NodeIndexes(1) - pe2=Edge1 % NodeIndexes(2) - IF ( pe2 Mesh % Edges(j) % BoundaryInfo % Right - IF(.NOT.FloodFill(e,CycleEdges,FaceMap,UsedFaces,Bn,CycleSum)) RETURN - - e => Mesh % Edges(j) % BoundaryInfo % Left - IF(.NOT.FloodFill(e,CycleEdges,FaceMap,UsedFaces,Bn,CycleSum)) RETURN + !------------------------------------------------------------------------------ + TYPE(Model_t) :: Model + TYPE(Solver_t) :: Solver + REAL(KIND=dp) :: dt + LOGICAL :: Transient + !------------------------------------------------------------------------------ + TYPE(ValueList_t), POINTER :: SolverParams + INTEGER :: i,j + CHARACTER(LEN=MAX_NAME_LEN) :: Avname + LOGICAL :: Found, PiolaVersion, SecondOrder, SecondFamily + !------------------------------------------------------------------------------ + SolverParams => GetSolverParams() + CALL ListAddLogical(SolverParams, 'Linear System Refactorize', .FALSE.) + + + ! ! Solver is using a single linear system to solve complex components, + ! ! the final result is the (Hcurl) imaginary component... + ! ! ------------------------------------------------------------------- + + ! Linear System Symmetric = True + ! Linear System Solver = "Iterative" + ! Linear System Preconditioning = None + ! Linear System Residual Output = 25 + ! Linear System Max Iterations = 2000 + ! Linear System Iterative Method = CG + ! Linear System Convergence Tolerance = 1.0e-9 + + CALL ListAddString( SolverParams, 'Variable', 'avm' ) + CALL ListAddLogical( SolverParams, 'Variable Output',.FALSE. ) + + DO i=1,Model % NumberOfSolvers + IF(ListGetLogical( Model % Solvers(i) % Values, 'Helmholtz Projection', Found)) EXIT END DO - Found=.TRUE.; RETURN -!------------------------------------------------------------------------------ - END FUNCTION FloodFill -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ - END SUBROUTINE WhitneyAVHarmonicSolver -!------------------------------------------------------------------------------ - -!/*****************************************************************************/ -! * -! * Elmer, A Finite Element Software for Multiphysical Problems -! * -! * Copyright 1st April 1995 - , CSC - IT Center for Science Ltd., Finland -! * -! * This program is free software; you can redistribute it and/or -! * modify it under the terms of the GNU General Public License -! * as published by the Free Software Foundation; either version 2 -! * of the License, or (at your option) any later version. -! * -! * This program is distributed in the hope that it will be useful, -! * but WITHOUT ANY WARRANTY; without even the implied warranty of -! * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! * GNU General Public License for more details. -! * -! * You should have received a copy of the GNU General Public License -! * along with this program (in file fem/GPL-2); if not, write to the -! * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -! * Boston, MA 02110-1301, USA. -! * -! *****************************************************************************/ -! * -! * Utilities written as solvers to compute the Helmholtz projection P(A) -! * of a curl-conforming vector field A. The projection can be obtained as -! * P(A) = A - W where W is the curl-conforming field fitted to represent -! * grad Phi, with Phi being a H1-regular scalar field. -! * -! * This file contains harmonic version of the transformation and also applies the -! * correction to the V field within conducting regions. -! * -! * -! * Authors: Mika Malinen, Juha Ruokolainen -! * Email: mika.malinen@csc.fi -! * Web: http://www.csc.fi/elmer -! * Address: CSC - IT Center for Science Ltd. -! * Keilaranta 14 -! * 02101 Espoo, Finland -! * -! * Original Date: March 20, 2020 -! * Last Modified: June 18, 2021, Juha -! * -!****************************************************************************** - - -!------------------------------------------------------------------------------ -SUBROUTINE HelmholtzProjector_Init0(Model, Solver, dt, Transient) -!------------------------------------------------------------------------------ - USE DefUtils - IMPLICIT NONE -!------------------------------------------------------------------------------ - TYPE(Model_t) :: Model - TYPE(Solver_t) :: Solver - REAL(KIND=dp) :: dt - LOGICAL :: Transient -!------------------------------------------------------------------------------ - LOGICAL :: Found - INTEGER :: i - TYPE(ValueList_t), POINTER :: SolverParams -!------------------------------------------------------------------------------ - SolverParams => GetSolverParams() - DO i=1,Model % NumberOfSolvers - IF (ListGetLogical( Model % Solvers(i) % Values, 'Helmholtz Projection', Found)) EXIT - END DO - CALL ListCopyPrefixedKeywords(Model % Solvers(i) % Values, SolverParams, 'HelmholtzProjector:') -!------------------------------------------------------------------------------ -END SUBROUTINE HelmholtzProjector_Init0 -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ -SUBROUTINE HelmholtzProjector_Init(Model, Solver, dt, Transient) -!------------------------------------------------------------------------------ - USE DefUtils - IMPLICIT NONE -!------------------------------------------------------------------------------ - TYPE(Model_t) :: Model - TYPE(Solver_t) :: Solver - REAL(KIND=dp) :: dt - LOGICAL :: Transient -!------------------------------------------------------------------------------ - LOGICAL :: Found - INTEGER :: i,j - TYPE(ValueList_t), POINTER :: SolverParams -!------------------------------------------------------------------------------ - - SolverParams => GetSolverParams() - CALL ListAddNewLogical(SolverParams, 'Linear System Refactorize', .FALSE.) - - CALL ListAddString( SolverParams, 'Variable', 'pd' ) - CALL ListAddLogical( SolverParams, 'Variable Output',.FALSE. ) - - DO i=1,Model % NumberOfSolvers - IF(ListGetLogical( Model % Solvers(i) % Values, 'Helmholtz Projection', Found)) EXIT - END DO - CALL ListAddString( SolverParams, 'Potential Variable', GetVarName(Model % Solvers(i) % Variable)) - - ! Solver is using a single linear system to solve complex components, - ! assign storage for final complex result. - ! ------------------------------------------------------------------- - CALL ListAddString( SolverParams, 'Exported Variable 1', 'P[P re:1 P im:1]' ) - - CALL ListAddLogical( SolverParams, 'Linear System Symmetric', .TRUE. ) - CALL ListAddString( SolverParams, 'Linear System Solver', 'Iterative' ) - CALL ListAddString( SolverParams, 'Linear System Preconditioning', 'ILU' ) - CALL ListAddInteger( SolverParams, 'Linear System Residual Output', 25 ) - CALL ListAddInteger( SolverParams, 'Linear System Max Iterations', 2000 ) - CALL ListAddString( SolverParams, 'Linear System Iterative Method', 'CG' ) - CALL ListAddConstReal( SolverParams, 'Linear System Convergence Tolerance', 1.0d-9 ) - - DO j=1,Model % NumberOfBCs - IF ( ListCheckPrefix( Model % BCs(j) % Values, & - TRIM(GetVarName(Model % Solvers(i) % Variable)) // ' re {e}' ) ) THEN - CALL ListAddConstReal( Model % BCs(j) % Values, 'Pd', 0._dp ) + AVname = ListGetString( Model % Solvers(i) % Values, 'Variable' ) + + j = index(AVname, '[') + IF(j>0) AVname = AVname(1:j-1) + CALL ListAddString( GetSolverParams(), 'Potential Variable', AVName ) + + IF (.NOT. ListCheckPresent(SolverParams, "Element")) THEN + CALL EdgeElementStyle(Model % Solvers(i) % Values, PiolaVersion, SecondFamily, SecondOrder ) + + IF (SecondOrder) THEN + CALL ListAddString(SolverParams, "Element", & + "n:0 e:2 -brick b:6 -pyramid b:3 -prism b:2 -quad_face b:4 -tri_face b:2") + ELSE IF (SecondFamily) THEN + CALL ListAddString(SolverParams, "Element", "n:0 e:2") + ELSE IF (PiolaVersion) THEN + CALL ListAddString(SolverParams, "Element", & + "n:0 e:1 -brick b:3 -quad_face b:2") + ELSE + CALL ListAddString( SolverParams, "Element", "n:0 e:1") + END IF END IF - END DO -!------------------------------------------------------------------------------ -END SUBROUTINE HelmholtzProjector_Init -!------------------------------------------------------------------------------ - - -!------------------------------------------------------------------------------ -!> Compute a H1-regular scalar field to obtain the Helmholtz projection P(A) -!> of a curl-conforming vector field A. Given the solution field Phi of this -!> solver, the projection can be evaluated as P(A) = A - grad Phi. -!------------------------------------------------------------------------------ -SUBROUTINE HelmholtzProjector(Model, Solver, dt, TransientSimulation) -!------------------------------------------------------------------------------ - USE DefUtils - IMPLICIT NONE -!------------------------------------------------------------------------------ - TYPE(Model_t) :: Model - TYPE(Solver_t) :: Solver - REAL(KIND=dp) :: dt - LOGICAL :: TransientSimulation -!------------------------------------------------------------------------------ -! Local variables: -!------------------------------------------------------------------------------ - TYPE(Mesh_t), POINTER :: Mesh - TYPE(ValueList_t), POINTER :: SolverParams - TYPE(Solver_t), POINTER :: SolverPtr - TYPE(Element_t), POINTER :: Element - - LOGICAL :: AllocationsDone = .FALSE. - LOGICAL :: Found - LOGICAL :: PiolaVersion, SecondOrder - LOGICAL :: ConstantBulkMatrix - - INTEGER :: i, j,k,l,n, n_pot, nd_pot, t - INTEGER :: dim, PotDOFs - INTEGER :: istat, active - - REAL(KIND=dp), ALLOCATABLE, TARGET :: Stiff(:,:), Force(:,:), PotSol(:,:), F(:,:) - REAL(KIND=dp) :: Norm, Omega - REAL(KIND=dp), POINTER :: SaveRHS(:), SOL(:) - CHARACTER(LEN=MAX_NAME_LEN) :: PotName - - TYPE(Variable_t), POINTER :: v - - SAVE Stiff, Force, PotSol, AllocationsDone -!------------------------------------------------------------------------------ - CALL DefaultStart() - - dim = CoordinateSystemDimension() - SolverParams => GetSolverParams() - Mesh => GetMesh() - - ! Allocate some permanent storage, this is done first time only: - !--------------------------------------------------------------- - IF (.NOT. AllocationsDone) THEN - n = Mesh % MaxElementDOFs - - ALLOCATE( FORCE(2,n), STIFF(n,n), PotSol(2,n), STAT=istat ) - IF ( istat /= 0 ) THEN - CALL Fatal( 'HelmholtzProjectorZ', 'Memory allocation error.' ) + + ! Solver is using a single linear system to solve complex components, + ! assign storage for final complex result. + ! ------------------------------------------------------------------- + CALL ListAddString( SolverParams, 'Kernel Variable', 'P' ) + + CALL ListAddLogical( SolverParams, 'Linear System Symmetric', .TRUE. ) + CALL ListAddString( SolverParams, 'Linear System Solver', 'Iterative' ) + CALL ListAddString( SolverParams, 'Linear System Preconditioning', 'ILU' ) + CALL ListAddInteger( SolverParams, 'Linear System Residual Output', 25 ) + CALL ListAddInteger( SolverParams, 'Linear System Max Iterations', 2000 ) + CALL ListAddString( SolverParams, 'Linear System Iterative Method', 'CG' ) + CALL ListAddConstReal( SolverParams, 'Linear System Convergence Tolerance', 1.0d-9 ) + CALL ListAddLogical( SolverParams,"Hcurl Basis",.TRUE.) + + CALL ListCopyPrefixedKeywords(Model % Solvers(i) % Values, SolverParams, 'RemoveKernelComponent:') + + !------------------------------------------------------------------------------ + END SUBROUTINE RemoveKernelComponent_Init0 + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + !> Apply the Helmholtz projection on a curl-conforming vector field A + !> when the kernel component grad phi of A (with respect to the curl operator) + !> has been computed by using the subroutine HelmholtzProjector. This solver + !> generates the representation W of grad phi in terms of the curl-conforming + !> basis and finally redefines A := A - W, with W = grad phi. + !------------------------------------------------------------------------------ + SUBROUTINE RemoveKernelComponent(Model, Solver, dt, TransientSimulation) + !------------------------------------------------------------------------------ + USE DefUtils + IMPLICIT NONE + !------------------------------------------------------------------------------ + TYPE(Model_t) :: Model + TYPE(Solver_t) :: Solver + REAL(KIND=dp) :: dt + LOGICAL :: TransientSimulation + !------------------------------------------------------------------------------ + ! Local variables: + !------------------------------------------------------------------------------ + TYPE(Mesh_t), POINTER :: Mesh + TYPE(ValueList_t), POINTER :: SolverParams + TYPE(Solver_t), POINTER :: SolverPtr, KerSolverPtr + TYPE(Element_t), POINTER :: Element + + LOGICAL :: AllocationsDone = .FALSE. + LOGICAL :: Found + ! LOGICAL :: SecondFamily + LOGICAL :: PiolaVersion, SecondOrder + LOGICAL :: ConstantBulkMatrix + + INTEGER :: dim, PotDOFs + INTEGER :: i, j, k, n, nd, n_pot, nd_pot, t + INTEGER :: istat, active + + REAL(KIND=dp), ALLOCATABLE, TARGET :: Stiff(:,:), Force(:,:), PhiSol(:,:), & + SOL(:), F(:,:) + REAL(KIND=dp) :: Norm + CHARACTER(LEN=MAX_NAME_LEN) :: PotName, Name + + REAL(KIND=dp), POINTER :: SaveRHS(:) + + + TYPE(Variable_t), POINTER :: v + + SAVE Stiff, Force, PhiSol, AllocationsDone + !------------------------------------------------------------------------------ + CALL DefaultStart() + + dim = CoordinateSystemDimension() + SolverParams => GetSolverParams() + Mesh => GetMesh() + + ! Allocate some permanent storage, this is done first time only: + !--------------------------------------------------------------- + IF (.NOT. AllocationsDone) THEN + n = Mesh % MaxElementDOFs + ALLOCATE(FORCE(2,n),STIFF(n,n),PhiSol(2,n),STAT=istat) + IF ( istat /= 0 ) THEN + CALL Fatal( 'RemoveKernelComponent', 'Memory allocation error.' ) + END IF + AllocationsDone = .TRUE. END IF - AllocationsDone = .TRUE. - END IF - - ! - ! Find the variable which is projected: - ! - PotName = GetString(SolverParams, 'Potential Variable', Found) - IF (.NOT. Found ) PotName = 'av' - Found = .FALSE. - DO i=1,Model % NumberOfSolvers - SolverPtr => Model % Solvers(i) - IF (PotName == GetVarName(SolverPtr % Variable)) THEN - Found = .TRUE. - EXIT + + ! + ! Find the variable which is projected: + ! + PotName = GetString(SolverParams, 'Potential Variable', Found) + IF (.NOT. Found ) PotName = 'av' + + Found = .FALSE. + DO i=1,Model % NumberOfSolvers + SolverPtr => Model % Solvers(i) + IF (PotName == GetVarName(SolverPtr % Variable)) THEN + Found = .TRUE. + EXIT + END IF + END DO + + IF (.NOT. Found ) THEN + CALL Fatal('RemoveKernelComponent', 'Solver associated with potential variable > '& + //TRIM(PotName)//' < not found!') END IF - END DO - - IF (Found ) THEN - CALL Info('HelmholtzProjectorZ', 'Solver inherits potential '& - //TRIM(PotName)//' from solver: '//I2S(i),Level=7) - ELSE - CALL Fatal('HelmholtzProjectorZ', 'Solver associated with potential variable > '& - //TRIM(PotName)//' < not found!') - END IF - - ! - ! Find some parameters to inherit the vector FE basis as defined in - ! the primary solver: - ! - CALL EdgeElementStyle(SolverPtr % Values, PiolaVersion, QuadraticApproximation = SecondOrder ) - IF (PiolaVersion) CALL Info('HelmholtzProjectorZ', & - 'Using Piola-transformed finite elements', Level=5) - - n = Solver % Matrix % NumberOfRows - ALLOCATE(F(n,2)); F=0 - - !----------------------- - ! System assembly: - !---------------------- - active = GetNOFActive() - CALL DefaultInitialize(Solver) - - SaveRHS => Solver % Matrix % RHS - - DO t=1,active - Element => GetActiveElement(t) + + PotDOFs = SolverPtr % Variable % DOFs + IF (PotDOFs < 2) CALL Fatal('RemoveKernelComponent', 'A complex-valued potential expected') + ! - ! This solver relies on getting basis functions by calling a routine - ! which returns a curl-conforming basis. It is thus assumed that - ! the background mesh defines the number of Lagrange basis functions. + ! Find the variable which defines the kernel component: ! - n = GetElementNOFNodes() - - ! The DOF counts for the potential (target) variable: - n_pot = n*SolverPtr % Def_Dofs(GetElementFamily(Element), Element % BodyId, 1) - nd_pot = GetElementNOFDOFs(USolver=SolverPtr) - - CALL GetVectorLocalSolution(PotSol, PotName, USolver=SolverPtr) - - ! Get element local matrix and rhs vector: - !---------------------------------------- - CALL LocalMatrix(Stiff, Force, Element, n, dim, PiolaVersion, & - SecondOrder, n_pot, nd_pot, PotSol ) + Name = GetString(SolverParams, 'Kernel Variable', Found) + IF (.NOT. Found ) Name = 'phi' + V => VariableGet( Mesh % Variables, Name ) + + Found = ASSOCIATED(v) + + IF (.NOT. Found ) THEN + CALL Fatal('RemoveKernelComponent', 'Solver associated with kernel variable > '& + //TRIM(Name)//' < not found!') + END IF - ! Update global matrix and rhs vector from local matrix & vector: - !--------------------------------------------------------------- + ! + ! Find some parameters to inherit the vector FE basis as defined in the primary solver: + ! + CALL EdgeElementStyle(SolverPtr % Values, PiolaVersion, QuadraticApproximation = SecondOrder ) + + IF (PiolaVersion) CALL Info('RemoveKernelComponent', & + 'Using Piola-transformed finite elements', Level=5) + + ! SecondFamily = GetLogical(SolverPtr % Values, 'Second Kind Basis', Found) + + n = Solver % Matrix % NumberOfRows + ALLOCATE(F(n,2)); F=0 + SaveRHS => Solver % Matrix % RHS + + !----------------------- + ! System assembly: + !---------------------- + active = GetNOFActive() + CALL DefaultInitialize(Solver) + + DO t=1,active + Element => GetActiveElement(t) + + n = GetElementNOFNodes() + nd = GetElementNOFDOFs() + + ! The DOF counts for the potential variable: + n_pot = n*SolverPtr % Def_Dofs(GetElementFamily(Element), Element % BodyId, 1) + nd_pot = GetElementNOFDOFs(USolver=SolverPtr) + + IF (nd /= nd_pot-n_pot) CALL Fatal('RemoveKernelComponent', & + 'Potential variable DOFs count /= the solver DOFs count') + + CALL GetLocalSolution(PhiSol, Name) + + ! Get element local matrix and rhs vector: + !---------------------------------------- + CALL LocalMatrix( STIFF, FORCE, Element, n, nd, dim, PiolaVersion, & + SecondOrder, PhiSol ) + + ! Update global matrix and rhs vector from local matrix & vector: + !--------------------------------------------------------------- + Solver % Matrix % RHS => F(:,1) + CALL DefaultUpdateForce(FORCE(1,:)) + + Solver % Matrix % RHS => F(:,2) + CALL DefaultUpdateEquations(STIFF, FORCE(2,:)) + END DO + + n = Solver % Matrix % NumberOfRows + ALLOCATE(SOL(2*n)) + Solver % Matrix % RHS => F(:,1) - CALL DefaultUpdateForce(FORCE(1,:)) - + CALL DefaultDirichletBCs() + Norm = DefaultSolve() + SOL(1::2) = Solver % Variable % Values + Solver % Matrix % RHS => F(:,2) - CALL DefaultUpdateEquations(STIFF, FORCE(2,:)) - END DO - - CALL DefaultFinishBulkAssembly() - CALL DefaultDirichletBCs() - - v => VariableGet( Mesh % Variables, 'P' ) - SOL => v % Values - - Solver % Matrix % RHS => F(:,1) - CALL DefaultDirichletBCs() - Norm = DefaultSolve() - SOL(1::2) = Solver % Variable % Values - - Solver % Matrix % RHS => F(:,2) - CALL DefaultDirichletBCs() - Norm = DefaultSolve() - SOL(2::2) = Solver % Variable % Values - - Solver % Matrix % RHS => SaveRHS - - - omega = GetAngularFrequency() - - ! - ! Finally, redefine the potential variable: - ! ----------------------------------------- - DO i=1,Solver % Mesh % NumberOfNodes - j = Solver % Variable % Perm(i) - IF(j==0) CYCLE - - k = SolverPtr % Variable % Perm(i) - IF (k == 0) THEN - CALL Fatal('HelmholtzProjectorZ', & - 'The variable and potential permutations are nonmatching?') - END IF - - SolverPtr % Variable % Values(2*k-1) = SolverPtr % Variable % Values(2*k-1) - & - omega * SOL(2*j) - - SolverPtr % Variable % Values(2*k) = SolverPtr % Variable % Values(2*k) + & - omega * SOL(2*j-1) - END DO - -CONTAINS - -!------------------------------------------------------------------------------ - SUBROUTINE LocalMatrix(Stiff, Force, Element, n, dim, PiolaVersion, & - SecondOrder, n_pot, nd_pot, PotSol ) -!------------------------------------------------------------------------------ - REAL(KIND=dp) :: Stiff(:,:), Force(:,:) - TYPE(Element_t), POINTER :: Element - INTEGER :: n ! The number of background element nodes - INTEGER :: dim - LOGICAL :: PiolaVersion, SecondOrder - INTEGER :: n_pot, nd_pot ! The size parameters of target field - REAL(KIND=dp) :: PotSol(:,:) ! The values of target field DOFS -!------------------------------------------------------------------------------ - TYPE(GaussIntegrationPoints_t) :: IP - TYPE(Nodes_t), SAVE :: Nodes - - LOGICAL :: Stat - - INTEGER :: i, j, p, q, t, EdgeBasisDegree - - REAL(KIND=dp) :: Basis(n), dBasisdx(n,3), A(2,3) - REAL(KIND=dp) :: u, v, w, s, DetJ - REAL(KIND=dp) :: WBasis(nd_pot-n_pot,3), CurlWBasis(nd_pot-n_pot,3) -!------------------------------------------------------------------------------ - CALL GetElementNodes(Nodes) - - STIFF = 0.0_dp - FORCE = 0.0_dp - - IF (SecondOrder) THEN - EdgeBasisDegree = 2 - ELSE - EdgeBasisDegree = 1 - END IF - IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & - EdgeBasisDegree=EdgeBasisDegree) - IF( dim == 2 .AND. .NOT. PiolaVersion ) THEN - CALL Fatal('HelmholtzProjectorZ', '"Use Piola Transform = True" needed in 2D') - END IF - - DO t=1,IP % n - stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & - IP % W(t), detJ, Basis, dBasisdx, & - EdgeBasis = Wbasis, RotBasis = CurlWBasis, USolver = SolverPtr ) - s = detJ * IP % s(t) - - A = MATMUL(PotSol(:,n_pot+1:nd_pot), WBasis(1:nd_pot-n_pot,:)) - - DO p=1,n - DO q=1,n - STIFF(p,q) = STIFF(p,q) + SUM(dBasisdx(q,1:dim) * dBasisdx(p,1:dim)) * s - END DO - END DO - - DO p=1,n - FORCE(1,p) = FORCE(1,p) + SUM(A(1,:) * dBasisdx(p,:)) * s - FORCE(2,p) = FORCE(2,p) + SUM(A(2,:) * dBasisdx(p,:)) * s + CALL DefaultDirichletBCs() + Norm = DefaultSolve() + SOL(2::2) = Solver % Variable % Values + + Solver % Matrix % RHS => SaveRHS + + ! + ! Finally, redefine the potential variable: + ! + n = SIZE(Solver % Variable % Perm(:)) + IF (n == SIZE(SolverPtr % Variable % Perm(:))) THEN + DO i=Solver % Mesh % NumberOfNodes+1,n + j = Solver % Variable % Perm(i) + IF (j<=0) CYCLE + + k = SolverPtr % Variable % Perm(i) + IF (k<=0) THEN + CALL Fatal('RemoveKernelComponent', & + 'The variable and potential permutations are nonmatching?') + END IF + + SolverPtr % Variable % Values(2*k-1) = SolverPtr % Variable % Values(2*k-1) - & + SOL(2*j-1) + + SolverPtr % Variable % Values(2*k) = SolverPtr % Variable % Values(2*k) - & + SOL(2*j) END DO - END DO -!------------------------------------------------------------------------------ - END SUBROUTINE LocalMatrix -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ -END SUBROUTINE HelmholtzProjector -!------------------------------------------------------------------------------ - - -!------------------------------------------------------------------------------ -SUBROUTINE RemoveKernelComponent_Init0(Model, Solver, dt, Transient) -!------------------------------------------------------------------------------ - USE DefUtils - IMPLICIT NONE -!------------------------------------------------------------------------------ - TYPE(Model_t) :: Model - TYPE(Solver_t) :: Solver - REAL(KIND=dp) :: dt - LOGICAL :: Transient -!------------------------------------------------------------------------------ - TYPE(ValueList_t), POINTER :: SolverParams - INTEGER :: i,j - CHARACTER(LEN=MAX_NAME_LEN) :: Avname - LOGICAL :: Found, PiolaVersion, SecondOrder, SecondFamily -!------------------------------------------------------------------------------ - SolverParams => GetSolverParams() - CALL ListAddLogical(SolverParams, 'Linear System Refactorize', .FALSE.) - - -! ! Solver is using a single linear system to solve complex components, -! ! the final result is the (Hcurl) imaginary component... -! ! ------------------------------------------------------------------- - -! Linear System Symmetric = True -! Linear System Solver = "Iterative" -! Linear System Preconditioning = None -! Linear System Residual Output = 25 -! Linear System Max Iterations = 2000 -! Linear System Iterative Method = CG -! Linear System Convergence Tolerance = 1.0e-9 - - CALL ListAddString( SolverParams, 'Variable', 'avm' ) - CALL ListAddLogical( SolverParams, 'Variable Output',.FALSE. ) - - DO i=1,Model % NumberOfSolvers - IF(ListGetLogical( Model % Solvers(i) % Values, 'Helmholtz Projection', Found)) EXIT - END DO - AVname = ListGetString( Model % Solvers(i) % Values, 'Variable' ) - - j = index(AVname, '[') - IF(j>0) AVname = AVname(1:j-1) - CALL ListAddString( GetSolverParams(), 'Potential Variable', AVName ) - - IF (.NOT. ListCheckPresent(SolverParams, "Element")) THEN - CALL EdgeElementStyle(Model % Solvers(i) % Values, PiolaVersion, SecondFamily, SecondOrder ) - - IF (SecondOrder) THEN - CALL ListAddString(SolverParams, "Element", & - "n:0 e:2 -brick b:6 -pyramid b:3 -prism b:2 -quad_face b:4 -tri_face b:2") - ELSE IF (SecondFamily) THEN - CALL ListAddString(SolverParams, "Element", "n:0 e:2") - ELSE IF (PiolaVersion) THEN - CALL ListAddString(SolverParams, "Element", & - "n:0 e:1 -brick b:3 -quad_face b:2") ELSE - CALL ListAddString( SolverParams, "Element", "n:0 e:1") + CALL Fatal('RemoveKernelComponent', 'The variable and potential permutations differ') END IF - END IF - - ! Solver is using a single linear system to solve complex components, - ! assign storage for final complex result. - ! ------------------------------------------------------------------- - CALL ListAddString( SolverParams, 'Kernel Variable', 'P' ) - - CALL ListAddLogical( SolverParams, 'Linear System Symmetric', .TRUE. ) - CALL ListAddString( SolverParams, 'Linear System Solver', 'Iterative' ) - CALL ListAddString( SolverParams, 'Linear System Preconditioning', 'ILU' ) - CALL ListAddInteger( SolverParams, 'Linear System Residual Output', 25 ) - CALL ListAddInteger( SolverParams, 'Linear System Max Iterations', 2000 ) - CALL ListAddString( SolverParams, 'Linear System Iterative Method', 'CG' ) - CALL ListAddConstReal( SolverParams, 'Linear System Convergence Tolerance', 1.0d-9 ) - CALL ListAddLogical( SolverParams,"Hcurl Basis",.TRUE.) - - CALL ListCopyPrefixedKeywords(Model % Solvers(i) % Values, SolverParams, 'RemoveKernelComponent:') -!------------------------------------------------------------------------------ -END SUBROUTINE RemoveKernelComponent_Init0 -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ -!> Apply the Helmholtz projection on a curl-conforming vector field A -!> when the kernel component grad phi of A (with respect to the curl operator) -!> has been computed by using the subroutine HelmholtzProjector. This solver -!> generates the representation W of grad phi in terms of the curl-conforming -!> basis and finally redefines A := A - W, with W = grad phi. -!------------------------------------------------------------------------------ -SUBROUTINE RemoveKernelComponent(Model, Solver, dt, TransientSimulation) -!------------------------------------------------------------------------------ - USE DefUtils - IMPLICIT NONE -!------------------------------------------------------------------------------ - TYPE(Model_t) :: Model - TYPE(Solver_t) :: Solver - REAL(KIND=dp) :: dt - LOGICAL :: TransientSimulation -!------------------------------------------------------------------------------ -! Local variables: -!------------------------------------------------------------------------------ - TYPE(Mesh_t), POINTER :: Mesh - TYPE(ValueList_t), POINTER :: SolverParams - TYPE(Solver_t), POINTER :: SolverPtr, KerSolverPtr - TYPE(Element_t), POINTER :: Element - - LOGICAL :: AllocationsDone = .FALSE. - LOGICAL :: Found -! LOGICAL :: SecondFamily - LOGICAL :: PiolaVersion, SecondOrder - LOGICAL :: ConstantBulkMatrix - - INTEGER :: dim, PotDOFs - INTEGER :: i, j, k, n, nd, n_pot, nd_pot, t - INTEGER :: istat, active - - REAL(KIND=dp), ALLOCATABLE, TARGET :: Stiff(:,:), Force(:,:), PhiSol(:,:), & - SOL(:), F(:,:) - REAL(KIND=dp) :: Norm - CHARACTER(LEN=MAX_NAME_LEN) :: PotName, Name - - REAL(KIND=dp), POINTER :: SaveRHS(:) - - - TYPE(Variable_t), POINTER :: v - - SAVE Stiff, Force, PhiSol, AllocationsDone -!------------------------------------------------------------------------------ - CALL DefaultStart() - - dim = CoordinateSystemDimension() - SolverParams => GetSolverParams() - Mesh => GetMesh() - - ! Allocate some permanent storage, this is done first time only: - !--------------------------------------------------------------- - IF (.NOT. AllocationsDone) THEN - n = Mesh % MaxElementDOFs - ALLOCATE(FORCE(2,n),STIFF(n,n),PhiSol(2,n),STAT=istat) - IF ( istat /= 0 ) THEN - CALL Fatal( 'RemoveKernelComponent', 'Memory allocation error.' ) - END IF - AllocationsDone = .TRUE. - END IF - - ! - ! Find the variable which is projected: - ! - PotName = GetString(SolverParams, 'Potential Variable', Found) - IF (.NOT. Found ) PotName = 'av' - - Found = .FALSE. - DO i=1,Model % NumberOfSolvers - SolverPtr => Model % Solvers(i) - IF (PotName == GetVarName(SolverPtr % Variable)) THEN - Found = .TRUE. - EXIT - END IF - END DO - - IF (.NOT. Found ) THEN - CALL Fatal('RemoveKernelComponent', 'Solver associated with potential variable > '& - //TRIM(PotName)//' < not found!') - END IF - - PotDOFs = SolverPtr % Variable % DOFs - IF (PotDOFs < 2) CALL Fatal('RemoveKernelComponent', 'A complex-valued potential expected') - - ! - ! Find the variable which defines the kernel component: - ! - Name = GetString(SolverParams, 'Kernel Variable', Found) - IF (.NOT. Found ) Name = 'phi' - V => VariableGet( Mesh % Variables, Name ) - - Found = ASSOCIATED(v) - - IF (.NOT. Found ) THEN - CALL Fatal('RemoveKernelComponent', 'Solver associated with kernel variable > '& - //TRIM(Name)//' < not found!') - END IF + CONTAINS - ! - ! Find some parameters to inherit the vector FE basis as defined in the primary solver: - ! - CALL EdgeElementStyle(SolverPtr % Values, PiolaVersion, QuadraticApproximation = SecondOrder ) - - IF (PiolaVersion) CALL Info('RemoveKernelComponent', & - 'Using Piola-transformed finite elements', Level=5) - -! SecondFamily = GetLogical(SolverPtr % Values, 'Second Kind Basis', Found) - - n = Solver % Matrix % NumberOfRows - ALLOCATE(F(n,2)); F=0 - SaveRHS => Solver % Matrix % RHS - - !----------------------- - ! System assembly: - !---------------------- - active = GetNOFActive() - CALL DefaultInitialize(Solver) - - DO t=1,active - Element => GetActiveElement(t) - - n = GetElementNOFNodes() - nd = GetElementNOFDOFs() - - ! The DOF counts for the potential variable: - n_pot = n*SolverPtr % Def_Dofs(GetElementFamily(Element), Element % BodyId, 1) - nd_pot = GetElementNOFDOFs(USolver=SolverPtr) - - IF (nd /= nd_pot-n_pot) CALL Fatal('RemoveKernelComponent', & - 'Potential variable DOFs count /= the solver DOFs count') - - CALL GetLocalSolution(PhiSol, Name) - - ! Get element local matrix and rhs vector: - !---------------------------------------- - CALL LocalMatrix( STIFF, FORCE, Element, n, nd, dim, PiolaVersion, & + !------------------------------------------------------------------------------ + SUBROUTINE LocalMatrix(Stiff, Force, Element, n, nd, dim, PiolaVersion, & SecondOrder, PhiSol ) - - ! Update global matrix and rhs vector from local matrix & vector: - !--------------------------------------------------------------- - Solver % Matrix % RHS => F(:,1) - CALL DefaultUpdateForce(FORCE(1,:)) - - Solver % Matrix % RHS => F(:,2) - CALL DefaultUpdateEquations(STIFF, FORCE(2,:)) - END DO - - n = Solver % Matrix % NumberOfRows - ALLOCATE(SOL(2*n)) - - Solver % Matrix % RHS => F(:,1) - CALL DefaultDirichletBCs() - Norm = DefaultSolve() - SOL(1::2) = Solver % Variable % Values - - Solver % Matrix % RHS => F(:,2) - CALL DefaultDirichletBCs() - Norm = DefaultSolve() - SOL(2::2) = Solver % Variable % Values - - Solver % Matrix % RHS => SaveRHS - - ! - ! Finally, redefine the potential variable: - ! - n = SIZE(Solver % Variable % Perm(:)) - IF (n == SIZE(SolverPtr % Variable % Perm(:))) THEN - DO i=Solver % Mesh % NumberOfNodes+1,n - j = Solver % Variable % Perm(i) - IF (j<=0) CYCLE - - k = SolverPtr % Variable % Perm(i) - IF (k<=0) THEN - CALL Fatal('RemoveKernelComponent', & - 'The variable and potential permutations are nonmatching?') + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: STIFF(:,:), FORCE(:,:) + TYPE(Element_t), POINTER :: Element + INTEGER :: n, nd, dim + REAL(KIND=dp) :: PhiSol(:,:) + LOGICAL :: PiolaVersion, SecondOrder + !------------------------------------------------------------------------------ + TYPE(GaussIntegrationPoints_t) :: IP + TYPE(Nodes_t), SAVE :: Nodes + + LOGICAL :: Stat + + INTEGER :: i, j, p, q, t, EdgeBasisDegree + + REAL(KIND=dp) :: Basis(n), dBasisdx(n,3), A(2,3) + REAL(KIND=dp) :: s, DetJ + REAL(KIND=dp) :: WBasis(nd,3), CurlWBasis(nd,3) + !------------------------------------------------------------------------------ + CALL GetElementNodes(Nodes) + + STIFF = 0.0_dp + FORCE = 0.0_dp + + IF (SecondOrder) THEN + EdgeBasisDegree = 2 + ELSE + EdgeBasisDegree = 1 + END IF + + IF (dim==2 .AND. .NOT. PiolaVersion) THEN + CALL Fatal('RemoveKernelComponent', '"Use Piola Transform = True" needed in 2D') END IF - - SolverPtr % Variable % Values(2*k-1) = SolverPtr % Variable % Values(2*k-1) - & - SOL(2*j-1) - - SolverPtr % Variable % Values(2*k) = SolverPtr % Variable % Values(2*k) - & - SOL(2*j) - END DO - ELSE - CALL Fatal('RemoveKernelComponent', 'The variable and potential permutations differ') - END IF - -CONTAINS - -!------------------------------------------------------------------------------ - SUBROUTINE LocalMatrix(Stiff, Force, Element, n, nd, dim, PiolaVersion, & - SecondOrder, PhiSol ) -!------------------------------------------------------------------------------ - REAL(KIND=dp) :: STIFF(:,:), FORCE(:,:) - TYPE(Element_t), POINTER :: Element - INTEGER :: n, nd, dim - REAL(KIND=dp) :: PhiSol(:,:) - LOGICAL :: PiolaVersion, SecondOrder -!------------------------------------------------------------------------------ - TYPE(GaussIntegrationPoints_t) :: IP - TYPE(Nodes_t), SAVE :: Nodes - - LOGICAL :: Stat - - INTEGER :: i, j, p, q, t, EdgeBasisDegree - - REAL(KIND=dp) :: Basis(n), dBasisdx(n,3), A(2,3) - REAL(KIND=dp) :: s, DetJ - REAL(KIND=dp) :: WBasis(nd,3), CurlWBasis(nd,3) -!------------------------------------------------------------------------------ - CALL GetElementNodes(Nodes) - - STIFF = 0.0_dp - FORCE = 0.0_dp - - IF (SecondOrder) THEN - EdgeBasisDegree = 2 - ELSE - EdgeBasisDegree = 1 - END IF - - IF (dim==2 .AND. .NOT. PiolaVersion) THEN - CALL Fatal('RemoveKernelComponent', '"Use Piola Transform = True" needed in 2D') - END IF - - IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & - EdgeBasisDegree=EdgeBasisDegree) - - DO t=1,IP % n - stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & - IP % W(t), detJ, Basis, dBasisdx, & - EdgeBasis = Wbasis, RotBasis = CurlWBasis, USolver = SolverPtr ) - - s = detJ * IP % s(t) - DO p=1,nd + + IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & + EdgeBasisDegree=EdgeBasisDegree) + + DO t=1,IP % n + stat = ElementInfo( Element, Nodes, IP % U(t), IP % V(t), & + IP % W(t), detJ, Basis, dBasisdx, & + EdgeBasis = Wbasis, RotBasis = CurlWBasis, USolver = SolverPtr ) + + s = detJ * IP % s(t) + DO p=1,nd + DO q=1,nd + STIFF(p,q) = STIFF(p,q) + s * SUM(WBasis(q,:) * WBasis(p,:)) + END DO + END DO + + A = MATMUL( PhiSol(:,1:n), dBasisdx(1:n,:) ) DO q=1,nd - STIFF(p,q) = STIFF(p,q) + s * SUM(WBasis(q,:) * WBasis(p,:)) + FORCE(1,q) = FORCE(1,q) + s * SUM(A(1,:) * WBasis(q,:)) + FORCE(2,q) = FORCE(2,q) + s * SUM(A(2,:) * WBasis(q,:)) END DO END DO - - A = MATMUL( PhiSol(:,1:n), dBasisdx(1:n,:) ) - DO q=1,nd - FORCE(1,q) = FORCE(1,q) + s * SUM(A(1,:) * WBasis(q,:)) - FORCE(2,q) = FORCE(2,q) + s * SUM(A(2,:) * WBasis(q,:)) - END DO - END DO -!------------------------------------------------------------------------------ - END SUBROUTINE LocalMatrix -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ -END SUBROUTINE RemoveKernelComponent -!------------------------------------------------------------------------------ - + !------------------------------------------------------------------------------ + END SUBROUTINE LocalMatrix + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + END SUBROUTINE RemoveKernelComponent + !------------------------------------------------------------------------------ + \ No newline at end of file diff --git a/fem/src/modules/StatCurrentSolve.F90 b/fem/src/modules/StatCurrentSolve.F90 index abfd567958..c10c637d17 100644 --- a/fem/src/modules/StatCurrentSolve.F90 +++ b/fem/src/modules/StatCurrentSolve.F90 @@ -40,312 +40,651 @@ !> \ingroup Solvers !------------------------------------------------------------------------------ SUBROUTINE StatCurrentSolver_Init( Model,Solver,dt,TransientSimulation) -!------------------------------------------------------------------------------ - USE DefUtils - IMPLICIT NONE -!------------------------------------------------------------------------------ - TYPE(Model_t) :: Model - TYPE(Solver_t), TARGET :: Solver - LOGICAL :: TransientSimulation - REAL(KIND=dp) :: dt -!------------------------------------------------------------------------------ - LOGICAL :: Found, Calculate - TYPE(ValueList_t), POINTER :: Params - CHARACTER(LEN=MAX_NAME_LEN) :: VariableName - INTEGER :: dim - - Params => GetSolverParams() - dim = CoordinateSystemDimension() - - IF (ListGetLogical(Params,'Calculate Joule Heating',Found)) & - CALL ListAddString( Params,NextFreeKeyword('Exported Variable ',Params), & - 'Joule Heating' ) - - IF (ListGetLogical(Params,'Calculate Nodal Heating',Found)) & - CALL ListAddString( Params,NextFreeKeyword('Exported Variable ',Params), & - 'Nodal Joule Heating' ) - - Calculate = ListGetLogical(Params,'Calculate Volume Current',Found) - IF( Calculate ) THEN - IF( Dim == 2 ) THEN - CALL ListAddString( Params,NextFreeKeyword('Exported Variable ',Params), & - 'Volume Current[Volume Current:2]' ) - ELSE - CALL ListAddString( Params,NextFreeKeyword('Exported Variable ',Params), & - 'Volume Current[Volume Current:3]' ) + !------------------------------------------------------------------------------ + USE DefUtils + IMPLICIT NONE + !------------------------------------------------------------------------------ + TYPE(Model_t) :: Model + TYPE(Solver_t), TARGET :: Solver + LOGICAL :: TransientSimulation + REAL(KIND=dp) :: dt + !------------------------------------------------------------------------------ + LOGICAL :: Found, Calculate + TYPE(ValueList_t), POINTER :: Params + CHARACTER(LEN=MAX_NAME_LEN) :: VariableName + INTEGER :: dim + + Params => GetSolverParams() + dim = CoordinateSystemDimension() + + IF (ListGetLogical(Params,'Calculate Joule Heating',Found)) & + CALL ListAddString( Params,NextFreeKeyword('Exported Variable ',Params), & + 'Joule Heating' ) + + IF (ListGetLogical(Params,'Calculate Nodal Heating',Found)) & + CALL ListAddString( Params,NextFreeKeyword('Exported Variable ',Params), & + 'Nodal Joule Heating' ) + + Calculate = ListGetLogical(Params,'Calculate Volume Current',Found) + IF( Calculate ) THEN + IF( Dim == 2 ) THEN + CALL ListAddString( Params,NextFreeKeyword('Exported Variable ',Params), & + 'Volume Current[Volume Current:2]' ) + ELSE + CALL ListAddString( Params,NextFreeKeyword('Exported Variable ',Params), & + 'Volume Current[Volume Current:3]' ) + END IF END IF - END IF - -!------------------------------------------------------------------------------ -END SUBROUTINE StatCurrentSolver_Init -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ -!> Solve the Poisson equation for the electric potential and compute the -!> volume current and Joule heating -!------------------------------------------------------------------------------ - SUBROUTINE StatCurrentSolver( Model,Solver,dt,TransientSimulation ) -!------------------------------------------------------------------------------ - USE DefUtils - USE Differentials - IMPLICIT NONE -!------------------------------------------------------------------------------ - TYPE(Model_t) :: Model - TYPE(Solver_t), TARGET:: Solver - REAL (KIND=DP) :: dt - LOGICAL :: TransientSimulation -!------------------------------------------------------------------------------ -! Local variables -!------------------------------------------------------------------------------ - TYPE(Matrix_t), POINTER :: StiffMatrix - TYPE(Element_t), POINTER :: CurrentElement - TYPE(Nodes_t) :: ElementNodes - - REAL (KIND=DP), POINTER :: ForceVector(:), Potential(:) - REAL (KIND=DP), POINTER :: ElField(:), VolCurrent(:) - REAL (KIND=DP), POINTER :: Heating(:), NodalHeating(:) - REAL (KIND=DP), POINTER :: EleC(:) - REAL (KIND=DP), POINTER :: Cwrk(:,:,:) - REAL (KIND=DP), ALLOCATABLE :: Conductivity(:,:,:), & - LocalStiffMatrix(:,:), Load(:), LocalForce(:) - - REAL (KIND=DP) :: Norm, HeatingTot, VolTot, CurrentTot, ControlTarget, ControlScaling = 1.0 - REAL (KIND=DP) :: Resistance, PotDiff - REAL (KIND=DP) :: at, st, at0 - - INTEGER, POINTER :: NodeIndexes(:) - INTEGER, POINTER :: PotentialPerm(:) - INTEGER :: i, j, k, n, t, istat, bf_id, LocalNodes, Dim, & - iter, NonlinearIter - - LOGICAL :: AllocationsDone = .FALSE., gotIt, FluxBC - LOGICAL :: CalculateField = .FALSE., ConstantWeights - LOGICAL :: CalculateCurrent, CalculateHeating, CalculateNodalHeating - LOGICAL :: ControlPower, ControlCurrent, Control - - TYPE(ValueList_t), POINTER :: Params - TYPE(Variable_t), POINTER :: Var - - CHARACTER(LEN=MAX_NAME_LEN) :: EquationName - - LOGICAL :: GetCondAtIp - TYPE(ValueHandle_t) :: CondAtIp_h - REAL(KIND=dp) :: CondAtIp - SAVE LocalStiffMatrix, Load, LocalForce, & - ElementNodes, CalculateCurrent, CalculateHeating, & - AllocationsDone, VolCurrent, Heating, Conductivity, & - CalculateField, ConstantWeights, & - Cwrk, ControlScaling, CalculateNodalHeating - -!------------------------------------------------------------------------------ -! Get variables needed for solution -!------------------------------------------------------------------------------ - IF(.NOT.ASSOCIATED(Solver % Matrix)) RETURN - - Potential => Solver % Variable % Values - PotentialPerm => Solver % Variable % Perm - Params => GetSolverParams() - - LocalNodes = Model % NumberOfNodes - StiffMatrix => Solver % Matrix - ForceVector => StiffMatrix % RHS - - Norm = Solver % Variable % Norm - DIM = CoordinateSystemDimension() - - ControlTarget = GetCReal( Params,'Power Control',ControlPower) - IF(ControlPower) THEN - ControlCurrent = .FALSE. - ELSE - ControlTarget = GetCReal( Params,'Current Control',ControlCurrent) - END IF - Control = ControlPower .OR. ControlCurrent - - ! To obtain convergence rescale the potential to the original BCs - IF( Control ) THEN - Potential = Potential / ControlScaling - Solver % Variable % Norm = Solver % Variable % Norm / ControlScaling - END IF - - NonlinearIter = ListGetInteger( Params, & - 'Nonlinear System Max Iterations', GotIt ) - IF ( .NOT. GotIt ) NonlinearIter = 1 - - GetCondAtIp = ListGetLogical( Params,'Conductivity At Ip',GotIt ) - -!------------------------------------------------------------------------------ -! Allocate some permanent storage, this is done first time only -!------------------------------------------------------------------------------ - IF ( .NOT. AllocationsDone .OR. Solver % MeshChanged ) THEN - N = Model % MaxElementNodes - - IF(AllocationsDone) THEN - DEALLOCATE( ElementNodes % x, & - ElementNodes % y, & - ElementNodes % z, & - Conductivity, & - LocalForce, & - LocalStiffMatrix, & - Load ) + !------------------------------------------------------------------------------ + END SUBROUTINE StatCurrentSolver_Init + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + !> Solve the Poisson equation for the electric potential and compute the + !> volume current and Joule heating + !------------------------------------------------------------------------------ + SUBROUTINE StatCurrentSolver( Model,Solver,dt,TransientSimulation ) + !------------------------------------------------------------------------------ + USE Types + USE Lists + USE Integration + USE ElementDescription + USE Differentials + USE SolverUtils + USE ElementUtils + USE Adaptive + USE DefUtils + + IMPLICIT NONE + !------------------------------------------------------------------------------ + TYPE(Model_t) :: Model + TYPE(Solver_t), TARGET:: Solver + REAL (KIND=DP) :: dt + LOGICAL :: TransientSimulation + !------------------------------------------------------------------------------ + ! Local variables + !------------------------------------------------------------------------------ + TYPE(Matrix_t), POINTER :: StiffMatrix + TYPE(Element_t), POINTER :: CurrentElement + TYPE(Nodes_t) :: ElementNodes + + REAL (KIND=DP), POINTER :: ForceVector(:), Potential(:) + REAL (KIND=DP), POINTER :: ElField(:), VolCurrent(:) + REAL (KIND=DP), POINTER :: Heating(:), NodalHeating(:) + REAL (KIND=DP), POINTER :: EleC(:) + REAL (KIND=DP), POINTER :: Cwrk(:,:,:) + REAL (KIND=DP), ALLOCATABLE :: Conductivity(:,:,:), & + LocalStiffMatrix(:,:), Load(:), LocalForce(:) + + REAL (KIND=DP) :: Norm, HeatingTot, VolTot, CurrentTot, ControlTarget, ControlScaling = 1.0 + REAL (KIND=DP) :: Resistance, PotDiff + REAL (KIND=DP) :: at, st, at0 + + INTEGER, POINTER :: NodeIndexes(:) + INTEGER, POINTER :: PotentialPerm(:) + INTEGER :: i, j, k, n, t, istat, bf_id, LocalNodes, Dim, & + iter, NonlinearIter + + LOGICAL :: AllocationsDone = .FALSE., gotIt, FluxBC + LOGICAL :: CalculateField = .FALSE., ConstantWeights + LOGICAL :: CalculateCurrent, CalculateHeating, CalculateNodalHeating + LOGICAL :: ControlPower, ControlCurrent, Control + + TYPE(ValueList_t), POINTER :: Params + TYPE(Variable_t), POINTER :: Var + + CHARACTER(LEN=MAX_NAME_LEN) :: EquationName + + LOGICAL :: GetCondAtIp + TYPE(ValueHandle_t) :: CondAtIp_h + REAL(KIND=dp) :: CondAtIp + + SAVE LocalStiffMatrix, Load, LocalForce, & + ElementNodes, CalculateCurrent, CalculateHeating, & + AllocationsDone, VolCurrent, Heating, Conductivity, & + CalculateField, ConstantWeights, & + Cwrk, ControlScaling, CalculateNodalHeating + + INTERFACE + FUNCTION ElectricBoundaryResidual( Model,Edge,Mesh,Quant,Perm,Gnorm ) RESULT(Indicator) + USE Types + TYPE(Element_t), POINTER :: Edge + TYPE(Model_t) :: Model + TYPE(Mesh_t), POINTER :: Mesh + REAL(KIND=dp) :: Quant(:), Indicator(2), Gnorm + INTEGER :: Perm(:) + END FUNCTION ElectricBoundaryResidual + + FUNCTION ElectricEdgeResidual( Model,Edge,Mesh,Quant,Perm ) RESULT(Indicator) + USE Types + TYPE(Element_t), POINTER :: Edge + TYPE(Model_t) :: Model + TYPE(Mesh_t), POINTER :: Mesh + REAL(KIND=dp) :: Quant(:), Indicator(2) + INTEGER :: Perm(:) + END FUNCTION ElectricEdgeResidual + + FUNCTION ElectricInsideResidual( Model,Element,Mesh,Quant,Perm, Fnorm ) RESULT(Indicator) + USE Types + TYPE(Element_t), POINTER :: Element + TYPE(Model_t) :: Model + TYPE(Mesh_t), POINTER :: Mesh + REAL(KIND=dp) :: Quant(:), Indicator(2), Fnorm + INTEGER :: Perm(:) + END FUNCTION ElectricInsideResidual + END INTERFACE + !------------------------------------------------------------------------------ + ! Get variables needed for solution + !------------------------------------------------------------------------------ + IF(.NOT.ASSOCIATED(Solver % Matrix)) RETURN + + Potential => Solver % Variable % Values + PotentialPerm => Solver % Variable % Perm + Params => GetSolverParams() + + LocalNodes = Model % NumberOfNodes + StiffMatrix => Solver % Matrix + ForceVector => StiffMatrix % RHS + + Norm = Solver % Variable % Norm + DIM = CoordinateSystemDimension() + + ControlTarget = GetCReal( Params,'Power Control',ControlPower) + IF(ControlPower) THEN + ControlCurrent = .FALSE. + ELSE + ControlTarget = GetCReal( Params,'Current Control',ControlCurrent) END IF - - ALLOCATE( ElementNodes % x(N), & - ElementNodes % y(N), & - ElementNodes % z(N), & - Conductivity(3,3,N), & - LocalForce(N), & - LocalStiffMatrix(N,N), & - Load(N), & - STAT=istat ) - - IF ( istat /= 0 ) THEN - CALL Fatal( 'StatCurrentSolve', 'Memory allocation error.' ) + Control = ControlPower .OR. ControlCurrent + + ! To obtain convergence rescale the potential to the original BCs + IF( Control ) THEN + Potential = Potential / ControlScaling + Solver % Variable % Norm = Solver % Variable % Norm / ControlScaling END IF - - NULLIFY( Cwrk ) - - CalculateCurrent = ListGetLogical( Params, & - 'Calculate Volume Current', GotIt ) - IF ( CalculateCurrent ) THEN - Var => VariableGet( Solver % Mesh % Variables,'Volume Current') - IF( ASSOCIATED( Var) ) THEN - VolCurrent => Var % Values - ELSE - CALL Fatal('StatCurrentSolver','Volume Current does not exist') + + NonlinearIter = ListGetInteger( Params, & + 'Nonlinear System Max Iterations', GotIt ) + IF ( .NOT. GotIt ) NonlinearIter = 1 + + GetCondAtIp = ListGetLogical( Params,'Conductivity At Ip',GotIt ) + + !------------------------------------------------------------------------------ + ! Allocate some permanent storage, this is done first time only + !------------------------------------------------------------------------------ + IF ( .NOT. AllocationsDone .OR. Solver % MeshChanged ) THEN + N = Model % MaxElementNodes + + IF(AllocationsDone) THEN + DEALLOCATE( ElementNodes % x, & + ElementNodes % y, & + ElementNodes % z, & + Conductivity, & + LocalForce, & + LocalStiffMatrix, & + Load ) END IF - END IF - - CalculateHeating = ListGetLogicalAnyEquation( & - Model,'Calculate Joule heating') - IF ( .NOT. CalculateHeating ) & - CalculateHeating = ListGetLogical( Params, & - 'Calculate Joule Heating', GotIt ) - IF ( CalculateHeating ) THEN - Var => VariableGet( Solver % Mesh % Variables,'Joule Heating') - IF( ASSOCIATED( Var) ) THEN - Heating => Var % Values - ELSE - CALL Fatal('StatCurrentSolver','Joule Heating does not exist') + + ALLOCATE( ElementNodes % x(N), & + ElementNodes % y(N), & + ElementNodes % z(N), & + Conductivity(3,3,N), & + LocalForce(N), & + LocalStiffMatrix(N,N), & + Load(N), & + STAT=istat ) + + IF ( istat /= 0 ) THEN + CALL Fatal( 'StatCurrentSolve', 'Memory allocation error.' ) END IF - END IF - - CalculateNodalHeating = ListGetLogical( Params, & - 'Calculate Nodal Heating', GotIt ) - IF ( CalculateNodalHeating ) THEN - Var => VariableGet( Solver % Mesh % Variables,'Nodal Joule Heating') - IF( ASSOCIATED( Var) ) THEN - NodalHeating => Var % Values - ELSE - CALL Fatal('StatCurrentSolver','Nodal Joule Heating does not exist') + + NULLIFY( Cwrk ) + + CalculateCurrent = ListGetLogical( Params, & + 'Calculate Volume Current', GotIt ) + IF ( CalculateCurrent ) THEN + Var => VariableGet( Solver % Mesh % Variables,'Volume Current') + IF( ASSOCIATED( Var) ) THEN + VolCurrent => Var % Values + ELSE + CALL Fatal('StatCurrentSolver','Volume Current does not exist') + END IF END IF - END IF - - - - ConstantWeights = ListGetLogical( Params, & - 'Constant Weights', GotIt ) - -!------------------------------------------------------------------------------ - - IF ( .NOT.ASSOCIATED( StiffMatrix % MassValues ) ) THEN - ALLOCATE( StiffMatrix % Massvalues( LocalNodes ) ) - StiffMatrix % MassValues = 0.0d0 - END IF - -!------------------------------------------------------------------------------ -! Add electric field to the variable list (disabled) -!------------------------------------------------------------------------------ - IF ( CalculateField ) THEN - CALL VariableAddVector( Solver % Mesh % Variables, Solver % Mesh, & - Solver, 'Electric Field', dim, ElField, PotentialPerm) - END IF - AllocationsDone = .TRUE. - END IF - -!------------------------------------------------------------------------------ -! Do some additional initialization, and go for it -!------------------------------------------------------------------------------ - - EquationName = ListGetString( Params, 'Equation' ) - - CALL Info( 'StatCurrentSolve', '-------------------------------------',Level=4 ) - CALL Info( 'StatCurrentSolve', 'STAT CURRENT SOLVER: ', Level=4 ) - CALL Info( 'StatCurrentSolve', '-------------------------------------',Level=4 ) - - CALL DefaultStart() - - DO iter = 1, NonlinearIter - at = CPUTime() - at0 = RealTime() - - IF ( NonlinearIter > 1 ) THEN - WRITE( Message, '(a,I0)' ) 'Static current iteration: ', iter - CALL Info( 'StatCurrentSolve', Message, LEVEL=4 ) - END IF - CALL Info( 'StatElecSolve', 'Starting Assembly...', Level=6 ) - - CALL DefaultInitialize() - - !------------------------------------------------------------------------------ - - !------------------------------------------------------------------------------ - ! Do the assembly - !------------------------------------------------------------------------------ - - IF( GetCondAtIp ) THEN - CALL ListInitElementKeyword( CondAtIp_h,'Material','Electric Conductivity') - END IF + CalculateHeating = ListGetLogicalAnyEquation( & + Model,'Calculate Joule heating') + IF ( .NOT. CalculateHeating ) & + CalculateHeating = ListGetLogical( Params, & + 'Calculate Joule Heating', GotIt ) + IF ( CalculateHeating ) THEN + Var => VariableGet( Solver % Mesh % Variables,'Joule Heating') + IF( ASSOCIATED( Var) ) THEN + Heating => Var % Values + ELSE + CALL Fatal('StatCurrentSolver','Joule Heating does not exist') + END IF + END IF + + CalculateNodalHeating = ListGetLogical( Params, & + 'Calculate Nodal Heating', GotIt ) + IF ( CalculateNodalHeating ) THEN + Var => VariableGet( Solver % Mesh % Variables,'Nodal Joule Heating') + IF( ASSOCIATED( Var) ) THEN + NodalHeating => Var % Values + ELSE + CALL Fatal('StatCurrentSolver','Nodal Joule Heating does not exist') + END IF + END IF + + + ConstantWeights = ListGetLogical( Params, & + 'Constant Weights', GotIt ) + + !------------------------------------------------------------------------------ + + IF ( .NOT.ASSOCIATED( StiffMatrix % MassValues ) ) THEN + ALLOCATE( StiffMatrix % Massvalues( LocalNodes ) ) + StiffMatrix % MassValues = 0.0d0 + END IF + + !------------------------------------------------------------------------------ + ! Add electric field to the variable list (disabled) + !------------------------------------------------------------------------------ + IF ( CalculateField ) THEN + CALL VariableAddVector( Solver % Mesh % Variables, Solver % Mesh, & + Solver, 'Electric Field', dim, ElField, PotentialPerm) + END IF + + AllocationsDone = .TRUE. + END IF + + !------------------------------------------------------------------------------ + ! Do some additional initialization, and go for it + !------------------------------------------------------------------------------ + + EquationName = ListGetString( Params, 'Equation' ) + + CALL Info( 'StatCurrentSolve', '-------------------------------------',Level=4 ) + CALL Info( 'StatCurrentSolve', 'STAT CURRENT SOLVER: ', Level=4 ) + CALL Info( 'StatCurrentSolve', '-------------------------------------',Level=4 ) + + CALL DefaultStart() - DO t = 1, Solver % NumberOfActiveElements - - IF ( RealTime() - at0 > 1.0 ) THEN - WRITE(Message,'(a,i3,a)' ) ' Assembly: ', INT(100.0 - 100.0 * & - (Solver % NumberOfActiveElements-t) / & - (1.0*Solver % NumberOfActiveElements)), ' % done' - - CALL Info( 'StatCurrentSolve', Message, Level=5 ) - - at0 = RealTime() + DO iter = 1, NonlinearIter + at = CPUTime() + at0 = RealTime() + + IF ( NonlinearIter > 1 ) THEN + WRITE( Message, '(a,I0)' ) 'Static current iteration: ', iter + CALL Info( 'StatCurrentSolve', Message, LEVEL=4 ) END IF - + CALL Info( 'StatElecSolve', 'Starting Assembly...', Level=6 ) + + CALL DefaultInitialize() + !------------------------------------------------------------------------------ - ! Check if this element belongs to a body where potential - ! should be calculated + !------------------------------------------------------------------------------ - CurrentElement => GetActiveElement(t) - NodeIndexes => CurrentElement % NodeIndexes - - n = GetElementNOFNodes() - - ElementNodes % x(1:n) = Solver % Mesh % Nodes % x(NodeIndexes) - ElementNodes % y(1:n) = Solver % Mesh % Nodes % y(NodeIndexes) - ElementNodes % z(1:n) = Solver % Mesh % Nodes % z(NodeIndexes) + ! Do the assembly !------------------------------------------------------------------------------ - - bf_id = ListGetInteger( Model % Bodies(CurrentElement % BodyId) % & - Values, 'Body Force', gotIt, minv=1, maxv=Model % NumberOfBodyForces ) - - Load = 0.0d0 - IF ( gotIt ) THEN - Load(1:n) = ListGetReal( Model % BodyForces(bf_id) % Values, & - 'Current Source',n,NodeIndexes, Gotit ) + + IF( GetCondAtIp ) THEN + CALL ListInitElementKeyword( CondAtIp_h,'Material','Electric Conductivity') END IF - - IF( .NOT. GetCondAtIp ) THEN - - k = ListGetInteger( Model % Bodies(CurrentElement % BodyId) % & - Values, 'Material', minv=1, maxv=Model % NumberOfMaterials ) - + + + DO t = 1, Solver % NumberOfActiveElements + + IF ( RealTime() - at0 > 1.0 ) THEN + WRITE(Message,'(a,i3,a)' ) ' Assembly: ', INT(100.0 - 100.0 * & + (Solver % NumberOfActiveElements-t) / & + (1.0*Solver % NumberOfActiveElements)), ' % done' + + CALL Info( 'StatCurrentSolve', Message, Level=5 ) + + at0 = RealTime() + END IF + + !------------------------------------------------------------------------------ + ! Check if this element belongs to a body where potential + ! should be calculated + !------------------------------------------------------------------------------ + CurrentElement => GetActiveElement(t) + NodeIndexes => CurrentElement % NodeIndexes + + n = GetElementNOFNodes() + + ElementNodes % x(1:n) = Solver % Mesh % Nodes % x(NodeIndexes) + ElementNodes % y(1:n) = Solver % Mesh % Nodes % y(NodeIndexes) + ElementNodes % z(1:n) = Solver % Mesh % Nodes % z(NodeIndexes) + !------------------------------------------------------------------------------ + + bf_id = ListGetInteger( Model % Bodies(CurrentElement % BodyId) % & + Values, 'Body Force', gotIt, minv=1, maxv=Model % NumberOfBodyForces ) + + Load = 0.0d0 + IF ( gotIt ) THEN + Load(1:n) = ListGetReal( Model % BodyForces(bf_id) % Values, & + 'Current Source',n,NodeIndexes, Gotit ) + END IF + + IF( .NOT. GetCondAtIp ) THEN + + k = ListGetInteger( Model % Bodies(CurrentElement % BodyId) % & + Values, 'Material', minv=1, maxv=Model % NumberOfMaterials ) + + !------------------------------------------------------------------------------ + ! Read conductivity values (might be a tensor) + !------------------------------------------------------------------------------ + + CALL ListGetRealArray( Model % Materials(k) % Values, & + 'Electric Conductivity', Cwrk, n, NodeIndexes ) + + Conductivity = 0.0d0 + IF ( SIZE(Cwrk,1) == 1 ) THEN + DO i=1,3 + Conductivity( i,i,1:n ) = Cwrk( 1,1,1:n ) + END DO + ELSE IF ( SIZE(Cwrk,2) == 1 ) THEN + DO i=1,MIN(3,SIZE(Cwrk,1)) + Conductivity(i,i,1:n) = Cwrk(i,1,1:n) + END DO + ELSE + DO i=1,MIN(3,SIZE(Cwrk,1)) + DO j=1,MIN(3,SIZE(Cwrk,2)) + Conductivity( i,j,1:n ) = Cwrk(i,j,1:n) + END DO + END DO + END IF + END IF + + !------------------------------------------------------------------------------ + ! Get element local matrix, and rhs vector + !------------------------------------------------------------------------------ + CALL StatCurrentCompose( LocalStiffMatrix,LocalForce, & + Conductivity,Load,CurrentElement,n,ElementNodes ) !------------------------------------------------------------------------------ - ! Read conductivity values (might be a tensor) + ! Update global matrix and rhs vector from local matrix & vector !------------------------------------------------------------------------------ + + CALL DefaultUpdateEquations( LocalStiffMatrix, LocalForce ) + + !------------------------------------------------------------------------------ + END DO + CALL DefaultFinishBulkAssembly() + + !------------------------------------------------------------------------------ + ! Neumann boundary conditions + !------------------------------------------------------------------------------ + DO t=Solver % Mesh % NumberOfBulkElements + 1, & + Solver % Mesh % NumberOfBulkElements + & + Solver % Mesh % NumberOfBoundaryElements + + CurrentElement => Solver % Mesh % Elements(t) + + DO i=1,Model % NumberOfBCs + IF ( CurrentElement % BoundaryInfo % Constraint == & + Model % BCs(i) % Tag ) THEN + + !------------------------------------------------------------------------------ + ! Set the current element pointer in the model structure to + ! reflect the element being processed + !------------------------------------------------------------------------------ + Model % CurrentElement => CurrentElement + !------------------------------------------------------------------------------ + n = CurrentElement % TYPE % NumberOfNodes + NodeIndexes => CurrentElement % NodeIndexes + IF ( ANY( PotentialPerm(NodeIndexes) <= 0 ) ) CYCLE + + FluxBC = ListGetLogical(Model % BCs(i) % Values, & + 'Current Density BC',gotIt) + IF(GotIt .AND. .NOT. FluxBC) CYCLE + + !------------------------------------------------------------------------------ + ! BC: cond@Phi/@n = g + !------------------------------------------------------------------------------ + Load = 0.0d0 + Load(1:n) = ListGetReal( Model % BCs(i) % Values,'Current Density', & + n,NodeIndexes,gotIt ) + IF(.NOT. GotIt) CYCLE + + ElementNodes % x(1:n) = Solver % Mesh % Nodes % x(NodeIndexes) + ElementNodes % y(1:n) = Solver % Mesh % Nodes % y(NodeIndexes) + ElementNodes % z(1:n) = Solver % Mesh % Nodes % z(NodeIndexes) + + !------------------------------------------------------------------------------ + ! Get element matrix and rhs due to boundary conditions ... + !------------------------------------------------------------------------------ + CALL StatCurrentBoundary( LocalStiffMatrix, LocalForce, & + Load, CurrentElement, n, ElementNodes ) + !------------------------------------------------------------------------------ + ! Update global matrices from local matrices + !------------------------------------------------------------------------------ + + CALL DefaultUpdateEquations( LocalStiffMatrix, LocalForce ) + + !------------------------------------------------------------------------------ + END IF ! of currentelement bc == bcs(i) + END DO ! of i=1,model bcs + END DO ! Neumann BCs + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + ! FinishAssembly must be called after all other assembly steps, but before + ! Dirichlet boundary settings. Actually no need to call it except for + ! transient simulations. + !------------------------------------------------------------------------------ + CALL DefaultFinishAssembly() + + !------------------------------------------------------------------------------ + ! Dirichlet boundary conditions + !------------------------------------------------------------------------------ + CALL DefaultDirichletBCs() + + at = CPUTime() - at + WRITE( Message, * ) 'Assembly (s) :',at + CALL Info( 'StatCurrentSolve', Message, Level=5 ) + !------------------------------------------------------------------------------ + ! Solve the system and we are done. + !------------------------------------------------------------------------------ + st = CPUTime() + Norm = DefaultSolve() + + st = CPUTime() - st + WRITE( Message, * ) 'Solve (s) :',st + CALL Info( 'StatCurrentSolve', Message, Level=5 ) + + + !------------------------------------------------------------------------------ + ! Compute the electric field from the potential: E = -grad Phi + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + ! Compute the volume current: J = cond (-grad Phi) + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + ! Compute the Joule heating: H,tot = Integral (E . D)dV + !------------------------------------------------------------------------------ + + IF ( Control .OR. CalculateCurrent .OR. CalculateHeating .OR. & + CalculateNodalHeating ) THEN + CALL GeneralCurrent( Model, Potential, PotentialPerm ) + + WRITE( Message, * ) 'Total Heating Power :', Heatingtot + CALL Info( 'StatCurrentSolve', Message, Level=4 ) + CALL ListAddConstReal( Model % Simulation, & + 'RES: Total Joule Heating', Heatingtot ) + + PotDiff = DirichletDofsRange( Solver ) + IF( PotDiff > 0 ) THEN + Resistance = PotDiff**2 / HeatingTot + WRITE( Message, * ) 'Effective Resistance :', Resistance + CALL Info( 'StatCurrentSolve', Message, Level=4 ) + CALL ListAddConstReal( Model % Simulation, & + 'RES: Effective Resistance', Resistance ) + END IF + END IF + + IF(Control ) THEN + WRITE( Message, * ) 'Total Volume :', VolTot + CALL Info( 'StatCurrentSolve', Message, Level=4 ) + + ControlScaling = 1.0_dp + IF( ControlPower ) THEN + ControlScaling = SQRT( ControlTarget / HeatingTot ) + ELSE IF( ControlCurrent ) THEN + IF( PotDiff > 0.0d0 ) THEN + CurrentTot = HeatingTot / PotDiff + ControlScaling = ControlTarget / CurrentTot + WRITE( Message, * ) 'Total Current :', CurrentTot + CALL Info( 'StatCurrentSolve', Message, Level=4 ) + CALL ListAddConstReal( Model % Simulation, & + 'RES: TotalCurrent', CurrentTot ) + ELSE + CALL Warn('StatCurrentSolver','Current cannot be determined without pot. difference') + END IF + END IF + + WRITE( Message, * ) 'Control Scaling :', ControlScaling + CALL Info( 'StatCurrentSolve', Message, Level=4 ) + CALL ListAddConstReal( Model % Simulation, & + 'RES: CurrentSolver Scaling', ControlScaling ) + Potential = ControlScaling * Potential + ! Solver % Variable % Norm = ControlScaling * Solver % Variable % Norm + + IF ( CalculateHeating ) Heating = ControlScaling**2 * Heating + IF ( CalculateNodalHeating) & + NodalHeating = ControlScaling**2 * NodalHeating + IF ( CalculateCurrent ) VolCurrent = ControlScaling * VolCurrent + END IF + + IF( Solver % Variable % NonlinConverged > 0 ) EXIT + + END DO + + IF ( ListGetLogical( Params, 'Adaptive Mesh Refinement', GotIt ) ) & + ! CALL Info( 'StatCurrentSolver', 'Adaptive Mesh Refinement is not supported', Level=4 ) + CALL RefineMesh( Model, Solver, Potential, PotentialPerm, & + ElectricInsideResidual, ElectricEdgeResidual, ElectricBoundaryResidual ) + !------------------------------------------------------------------------------ + + CALL InvalidateVariable( Model % Meshes, Solver % Mesh, 'Potential') + + IF ( CalculateCurrent ) THEN + CALL InvalidateVariable( Model % Meshes, Solver % Mesh, 'Volume Current') + END IF + + IF ( CalculateHeating ) THEN + CALL InvalidateVariable( Model % Meshes, Solver % Mesh, 'Joule Heating') + END IF + + IF ( CalculateNodalHeating ) THEN + CALL InvalidateVariable( Model % Meshes, Solver % Mesh, & + 'Nodal Joule Heating') + END IF + + CALL DefaultFinish() + + + !------------------------------------------------------------------------------ + + CONTAINS + + !------------------------------------------------------------------------------ + !> Compute the Current and Joule Heating at model nodes. + !------------------------------------------------------------------------------ + SUBROUTINE GeneralCurrent( Model, Potential, Reorder ) + !------------------------------------------------------------------------------ + TYPE(Model_t) :: Model + REAL(KIND=dp) :: Potential(:) + INTEGER :: Reorder(:) + !------------------------------------------------------------------------------ + TYPE(Element_t), POINTER :: Element + TYPE(Nodes_t) :: Nodes + TYPE(GaussIntegrationPoints_t), TARGET :: IntegStuff + + REAL(KIND=dp), POINTER :: U_Integ(:), V_Integ(:), W_Integ(:), S_Integ(:) + REAL(KIND=dp), ALLOCATABLE :: SumOfWeights(:), tmp(:) + REAL(KIND=dp) :: Conductivity(3,3,Model % MaxElementNodes) + REAL(KIND=dp) :: Basis(Model % MaxElementNodes) + REAL(KIND=dp) :: dBasisdx(Model % MaxElementNodes,3) + REAL(KIND=DP) :: SqrtElementMetric, ElemVol + REAL(KIND=dp) :: ElementPot(Model % MaxElementNodes) + REAL(KIND=dp) :: Current(3) + REAL(KIND=dp) :: s, ug, vg, wg, Grad(3), EpsGrad(3) + REAL(KIND=dp) :: SqrtMetric, Metric(3,3), Symb(3,3,3), dSymb(3,3,3,3) + REAL(KIND=dp) :: HeatingDensity, x, y, z + INTEGER, POINTER :: NodeIndexes(:) + INTEGER :: N_Integ, t, tg, i, j, k + LOGICAL :: Stat + + !------------------------------------------------------------------------------ + + ALLOCATE( Nodes % x( Model % MaxElementNodes ) ) + ALLOCATE( Nodes % y( Model % MaxElementNodes ) ) + ALLOCATE( Nodes % z( Model % MaxElementNodes ) ) + + IF( CalculateHeating .OR. CalculateCurrent ) THEN + ALLOCATE( SumOfWeights( Model % NumberOfNodes ) ) + SumOfWeights = 0.0d0 + END IF + + HeatingTot = 0.0d0 + VolTot = 0.0d0 + IF ( CalculateHeating ) Heating = 0.0d0 + IF ( CalculateNodalHeating) NodalHeating = 0.0d0 + IF ( CalculateCurrent ) VolCurrent = 0.0d0 + + IF( GetCondAtIp ) THEN + CALL ListInitElementKeyword( CondAtIp_h,'Material','Electric Conductivity') + END IF + + !------------------------------------------------------------------------------ + ! Go through model elements, we will compute on average of elementwise + ! fluxes to nodes of the model + !------------------------------------------------------------------------------ + DO t = 1,Solver % NumberOfActiveElements + !------------------------------------------------------------------------------ + ! Check if this element belongs to a body where electrostatics + ! should be calculated + !------------------------------------------------------------------------------ + Element => Solver % Mesh % Elements( Solver % ActiveElements( t ) ) + Model % CurrentElement => Element + NodeIndexes => Element % NodeIndexes + + IF ( Element % PartIndex /= ParEnv % MyPE ) CYCLE + + n = Element % TYPE % NumberOfNodes + + IF ( ANY(Reorder(NodeIndexes) == 0) ) CYCLE + + ElementPot(1:n) = Potential( Reorder( NodeIndexes(1:n) ) ) + + Nodes % x(1:n) = Model % Nodes % x( NodeIndexes ) + Nodes % y(1:n) = Model % Nodes % y( NodeIndexes ) + Nodes % z(1:n) = Model % Nodes % z( NodeIndexes ) + + !------------------------------------------------------------------------------ + ! Gauss integration stuff + !------------------------------------------------------------------------------ + IntegStuff = GaussPoints( Element ) + U_Integ => IntegStuff % u + V_Integ => IntegStuff % v + W_Integ => IntegStuff % w + S_Integ => IntegStuff % s + N_Integ = IntegStuff % n + + !------------------------------------------------------------------------------ + + IF( .NOT. GetCondAtIp ) THEN + k = ListGetInteger( Model % Bodies( Element % BodyId ) % & + Values, 'Material', minv=1, maxv=Model % NumberOfMaterials ) + CALL ListGetRealArray( Model % Materials(k) % Values, & - 'Electric Conductivity', Cwrk, n, NodeIndexes ) - + 'Electric Conductivity', Cwrk, n, NodeIndexes, gotIt ) + Conductivity = 0.0d0 IF ( SIZE(Cwrk,1) == 1 ) THEN DO i=1,3 @@ -364,620 +703,1007 @@ SUBROUTINE StatCurrentSolver( Model,Solver,dt,TransientSimulation ) END IF END IF - !------------------------------------------------------------------------------ - ! Get element local matrix, and rhs vector - !------------------------------------------------------------------------------ - CALL StatCurrentCompose( LocalStiffMatrix,LocalForce, & - Conductivity,Load,CurrentElement,n,ElementNodes ) - !------------------------------------------------------------------------------ - ! Update global matrix and rhs vector from local matrix & vector - !------------------------------------------------------------------------------ - - CALL DefaultUpdateEquations( LocalStiffMatrix, LocalForce ) - - !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + ! Loop over Gauss integration points + !------------------------------------------------------------------------------ + + HeatingDensity = 0.0d0 + Current = 0.0d0 + ElemVol = 0.0d0 + + + DO tg=1,N_Integ + + ug = U_Integ(tg) + vg = V_Integ(tg) + wg = W_Integ(tg) + + !------------------------------------------------------------------------------ + ! Need SqrtElementMetric and Basis at the integration point + !------------------------------------------------------------------------------ + stat = ElementInfo( Element, Nodes,ug,vg,wg, & + SqrtElementMetric,Basis,dBasisdx ) + + !------------------------------------------------------------------------------ + ! Coordinatesystem dependent info + !------------------------------------------------------------------------------ + s = SqrtElementMetric * S_Integ(tg) + + IF ( CurrentCoordinateSystem() /= Cartesian ) THEN + x = SUM( Nodes % x(1:n)*Basis(1:n) ) + y = SUM( Nodes % y(1:n)*Basis(1:n) ) + z = SUM( Nodes % z(1:n)*Basis(1:n) ) + + CALL CoordinateSystemInfo( Metric,SqrtMetric,Symb,dSymb,x,y,z ) + s = s * SqrtMetric * 2 * PI + END IF + + !------------------------------------------------------------------------------ + + EpsGrad = 0.0d0 + IF( GetCondAtIp ) THEN + CondAtIp = ListGetElementReal( CondAtIp_h, Basis, Element, Stat, GaussPoint = tg ) + DO j = 1, DIM + Grad(j) = SUM( dBasisdx(1:n,j) * ElementPot(1:n) ) + END DO + EpsGrad(1:dim) = CondAtIp * Grad(1:dim) + ELSE + DO j = 1, DIM + Grad(j) = SUM( dBasisdx(1:n,j) * ElementPot(1:n) ) + DO i = 1, DIM + EpsGrad(j) = EpsGrad(j) + SUM( Conductivity(j,i,1:n) * & + Basis(1:n) ) * SUM( dBasisdx(1:n,i) * ElementPot(1:n) ) + END DO + END DO + END IF + + + VolTot = VolTot + s + + HeatingTot = HeatingTot + & + s * SUM( Grad(1:DIM) * EpsGrad(1:DIM) ) + + IF( CalculateHeating .OR. CalculateCurrent .OR. CalculateNodalHeating ) THEN + HeatingDensity = HeatingDensity + & + s * SUM( Grad(1:DIM) * EpsGrad(1:DIM) ) + DO j = 1,DIM + Current(j) = Current(j) - EpsGrad(j) * s + END DO + + ElemVol = ElemVol + s + END IF + + END DO! of the Gauss integration points + + !------------------------------------------------------------------------------ + ! Weight with element area if required + !------------------------------------------------------------------------------ + + IF( CalculateHeating .OR. CalculateCurrent ) THEN + IF ( ConstantWeights ) THEN + HeatingDensity = HeatingDensity / ElemVol + Current(1:Dim) = Current(1:Dim) / ElemVol + SumOfWeights( Reorder( NodeIndexes(1:n) ) ) = & + SumOfWeights( Reorder( NodeIndexes(1:n) ) ) + 1 + ELSE + SumOfWeights( Reorder( NodeIndexes(1:n) ) ) = & + SumOfWeights( Reorder( NodeIndexes(1:n) ) ) + ElemVol + END IF + END IF + + IF ( CalculateHeating ) THEN + Heating( Reorder(NodeIndexes(1:n)) ) = & + Heating( Reorder(NodeIndexes(1:n)) ) + HeatingDensity + END IF + + IF ( CalculateNodalHeating ) THEN + NodalHeating( Reorder(NodeIndexes(1:n)) ) = & + NodalHeating( Reorder(NodeIndexes(1:n)) ) + HeatingDensity + END IF + + IF ( CalculateCurrent ) THEN + DO j=1,DIM + VolCurrent(DIM*(Reorder(NodeIndexes(1:n))-1)+j) = & + VolCurrent(DIM*(Reorder(NodeIndexes(1:n))-1)+j) + & + Current(j) + END DO + END IF + + END DO! of the bulk elements + + IF ( CalculateHeating .OR. CalculateCurrent) THEN + IF ( ParEnv % PEs > 1) THEN + VolTot = ParallelReduction(VolTot) + HeatingTot = ParallelReduction(HeatingTot) + + IF ( CalculateCurrent) THEN + ALLOCATE(tmp(SIZE(VolCurrent)/dim)) + DO i=1,dim + tmp = VolCurrent(i::dim) + CALL ParallelSumVector(Solver % Matrix, tmp) + Volcurrent(i::dim) = tmp + END DO + END IF + IF (CalculateHeating ) CALL ParallelSumVector(Solver % Matrix, Heating) + CALL ParallelSumVector(Solver % Matrix, SumOfWeights) + END IF + + !------------------------------------------------------------------------------ + ! Finally, compute average of the fluxes at nodes + !------------------------------------------------------------------------------ + DO i = 1, Model % NumberOfNodes + IF ( ABS( SumOfWeights(i) ) > 0.0D0 ) THEN + IF ( CalculateHeating ) Heating(i) = Heating(i) / SumOfWeights(i) + DO j = 1, DIM + IF ( CalculateCurrent ) VolCurrent(DIM*(i-1)+j) = & + VolCurrent(DIM*(i-1)+j) / SumOfWeights(i) + END DO + END IF + END DO + DEALLOCATE( SumOfWeights ) + END IF + + DEALLOCATE( Nodes % x, Nodes % y, Nodes % z ) + + !------------------------------------------------------------------------------ + END SUBROUTINE GeneralCurrent + !------------------------------------------------------------------------------ + + + !------------------------------------------------------------------------------ + SUBROUTINE StatCurrentCompose( StiffMatrix,Force,Conductivity, & + Load,Element,n,Nodes ) + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: StiffMatrix(:,:),Force(:),Load(:), Conductivity(:,:,:) + INTEGER :: n + TYPE(Nodes_t) :: Nodes + TYPE(Element_t), POINTER :: Element + !------------------------------------------------------------------------------ + + REAL(KIND=dp) :: SqrtMetric,Metric(3,3),Symb(3,3,3),dSymb(3,3,3,3) + REAL(KIND=dp) :: Basis(n),dBasisdx(n,3) + REAL(KIND=dp) :: SqrtElementMetric,U,V,W,S,A,L,C(3,3),x,y,z + LOGICAL :: Stat + + INTEGER :: i,p,q,t,DIM + + TYPE(GaussIntegrationPoints_t) :: IntegStuff + + !------------------------------------------------------------------------------ + DIM = CoordinateSystemDimension() + + Force = 0.0d0 + StiffMatrix = 0.0d0 + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + ! Numerical integration + !------------------------------------------------------------------------------ + IntegStuff = GaussPoints( Element ) + + DO t=1,IntegStuff % n + U = IntegStuff % u(t) + V = IntegStuff % v(t) + W = IntegStuff % w(t) + S = IntegStuff % s(t) + !------------------------------------------------------------------------------ + ! Basis function values & derivatives at the integration point + !------------------------------------------------------------------------------ + stat = ElementInfo( Element,Nodes,U,V,W,SqrtElementMetric, & + Basis,dBasisdx ) + !------------------------------------------------------------------------------ + ! Coordinatesystem dependent info + !------------------------------------------------------------------------------ + IF ( CurrentCoordinateSystem() /= Cartesian ) THEN + x = SUM( ElementNodes % x(1:n)*Basis(1:n) ) + y = SUM( ElementNodes % y(1:n)*Basis(1:n) ) + z = SUM( ElementNodes % z(1:n)*Basis(1:n) ) + END IF + + CALL CoordinateSystemInfo( Metric,SqrtMetric,Symb,dSymb,x,y,z ) + + S = S * SqrtElementMetric * SqrtMetric + + L = SUM( Load(1:n) * Basis ) + + IF( GetCondAtIp ) THEN + CondAtIp = ListGetElementReal( CondAtIp_h, Basis, Element, Stat, GaussPoint = t ) + C(1:dim,1:dim) = 0.0_dp + DO i=1,dim + C(i,i) = CondAtIp + END DO + ELSE + DO i=1,DIM + DO j=1,DIM + C(i,j) = SUM( Conductivity(i,j,1:n) * Basis(1:n) ) + END DO + END DO + END IF + + !------------------------------------------------------------------------------ + ! The Poisson equation + !------------------------------------------------------------------------------ + DO p=1,N + DO q=1,N + A = 0.d0 + DO i=1,DIM + DO J=1,DIM + A = A + C(i,j) * dBasisdx(p,i) * dBasisdx(q,j) + END DO + END DO + StiffMatrix(p,q) = StiffMatrix(p,q) + S*A + END DO + Force(p) = Force(p) + S*L*Basis(p) + END DO + !------------------------------------------------------------------------------ + END DO + !------------------------------------------------------------------------------ + END SUBROUTINE StatCurrentCompose + !------------------------------------------------------------------------------ + + + !------------------------------------------------------------------------------ + !> Return element local matrices and RHS vector for boundary conditions + !> of the electrostatic equation. + !------------------------------------------------------------------------------ + SUBROUTINE StatCurrentBoundary( BoundaryMatrix, BoundaryVector, & + LoadVector, Element, n, Nodes ) + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: BoundaryMatrix(:,:), BoundaryVector(:), LoadVector(:) + TYPE(Nodes_t) :: Nodes + TYPE(Element_t) :: Element + INTEGER :: n + !------------------------------------------------------------------------------ + REAL(KIND=dp) :: Basis(n) + REAL(KIND=dp) :: dBasisdx(n,3),SqrtElementMetric + REAL(KIND=dp) :: SqrtMetric,Metric(3,3),Symb(3,3,3),dSymb(3,3,3,3) + + REAL(KIND=dp) :: u,v,w,s,x,y,z + REAL(KIND=dp) :: Force + REAL(KIND=dp), POINTER :: U_Integ(:),V_Integ(:),W_Integ(:),S_Integ(:) + + INTEGER :: t,q,N_Integ + + TYPE(GaussIntegrationPoints_t), TARGET :: IntegStuff + + LOGICAL :: stat + !------------------------------------------------------------------------------ + + BoundaryVector = 0.0d0 + BoundaryMatrix = 0.0d0 + !------------------------------------------------------------------------------ + ! Integration stuff + !------------------------------------------------------------------------------ + IntegStuff = GaussPoints( Element ) + U_Integ => IntegStuff % u + V_Integ => IntegStuff % v + W_Integ => IntegStuff % w + S_Integ => IntegStuff % s + N_Integ = IntegStuff % n + + !------------------------------------------------------------------------------ + ! Now we start integrating + !------------------------------------------------------------------------------ + DO t=1,N_Integ + u = U_Integ(t) + v = V_Integ(t) + w = W_Integ(t) + !------------------------------------------------------------------------------ + ! Basis function values & derivates at the integration point + !------------------------------------------------------------------------------ + stat = ElementInfo( Element,Nodes,u,v,w,SqrtElementMetric, & + Basis,dBasisdx ) + + !------------------------------------------------------------------------------ + ! Coordinatesystem dependent info + !------------------------------------------------------------------------------ + IF ( CurrentCoordinateSystem() /= Cartesian ) THEN + x = SUM( ElementNodes % x(1:n)*Basis(1:n) ) + y = SUM( ElementNodes % y(1:n)*Basis(1:n) ) + z = SUM( ElementNodes % z(1:n)*Basis(1:n) ) + END IF + + CALL CoordinateSystemInfo( Metric,SqrtMetric,Symb,dSymb,x,y,z ) + + s = S_Integ(t) * SqrtElementMetric * SqrtMetric + + !------------------------------------------------------------------------------ + Force = SUM( LoadVector(1:n)*Basis ) + + DO q=1,N + BoundaryVector(q) = BoundaryVector(q) + s * Basis(q) * Force + END DO END DO - CALL DefaultFinishBulkAssembly() - - !------------------------------------------------------------------------------ - ! Neumann boundary conditions - !------------------------------------------------------------------------------ - DO t=Solver % Mesh % NumberOfBulkElements + 1, & - Solver % Mesh % NumberOfBulkElements + & - Solver % Mesh % NumberOfBoundaryElements + END SUBROUTINE StatCurrentBoundary + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + END SUBROUTINE StatCurrentSolver + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + FUNCTION ElectricBoundaryResidual( Model, Edge, Mesh, Quant, Perm, Gnorm ) & + RESULT( Indicator ) + !------------------------------------------------------------------------------ + USE DefUtils + IMPLICIT NONE + !------------------------------------------------------------------------------ + TYPE(Model_t) :: Model + INTEGER :: Perm(:) + REAL(KIND=dp) :: Quant(:), Indicator(2), Gnorm + TYPE( Mesh_t ), POINTER :: Mesh + TYPE( Element_t ), POINTER :: Edge + !------------------------------------------------------------------------------ + TYPE(Nodes_t) :: Nodes, EdgeNodes + TYPE(Element_t), POINTER :: Element - CurrentElement => Solver % Mesh % Elements(t) + INTEGER :: i,j,k,n,l,t,dim,Pn,En + LOGICAL :: stat, Found - DO i=1,Model % NumberOfBCs - IF ( CurrentElement % BoundaryInfo % Constraint == & - Model % BCs(i) % Tag ) THEN + REAL(KIND=dp), POINTER :: Hwrk(:,:,:) - !------------------------------------------------------------------------------ - ! Set the current element pointer in the model structure to - ! reflect the element being processed - !------------------------------------------------------------------------------ - Model % CurrentElement => CurrentElement - !------------------------------------------------------------------------------ - n = CurrentElement % TYPE % NumberOfNodes - NodeIndexes => CurrentElement % NodeIndexes - IF ( ANY( PotentialPerm(NodeIndexes) <= 0 ) ) CYCLE + REAL(KIND=dp) :: SqrtMetric, Metric(3,3), Symb(3,3,3), dSymb(3,3,3,3) + REAL(KIND=dp) :: Grad(3,3), Normal(3), EdgeLength + REAL(KIND=dp) :: u, v, w, s, detJ + REAL(KIND=dp) :: Residual, ResidualNorm, Conductivity - FluxBC = ListGetLogical(Model % BCs(i) % Values, & - 'Current Density BC',gotIt) - IF(GotIt .AND. .NOT. FluxBC) CYCLE + REAL(KIND=dp), ALLOCATABLE :: EdgeBasis(:), Basis(:) + REAL(KIND=dp), ALLOCATABLE :: Flux(:) + REAL(KIND=dp), ALLOCATABLE :: x(:), y(:), z(:), dBasisdx(:,:) + REAL(KIND=dp), ALLOCATABLE :: NodalConductivity(:), Potential(:) - !------------------------------------------------------------------------------ - ! BC: cond@Phi/@n = g - !------------------------------------------------------------------------------ - Load = 0.0d0 - Load(1:n) = ListGetReal( Model % BCs(i) % Values,'Current Density', & - n,NodeIndexes,gotIt ) - IF(.NOT. GotIt) CYCLE + TYPE(GaussIntegrationPoints_t), TARGET :: IntegStuff - ElementNodes % x(1:n) = Solver % Mesh % Nodes % x(NodeIndexes) - ElementNodes % y(1:n) = Solver % Mesh % Nodes % y(NodeIndexes) - ElementNodes % z(1:n) = Solver % Mesh % Nodes % z(NodeIndexes) + LOGICAL :: First = .TRUE., Dirichlet - !------------------------------------------------------------------------------ - ! Get element matrix and rhs due to boundary conditions ... - !------------------------------------------------------------------------------ - CALL StatCurrentBoundary( LocalStiffMatrix, LocalForce, & - Load, CurrentElement, n, ElementNodes ) - !------------------------------------------------------------------------------ - ! Update global matrices from local matrices - !------------------------------------------------------------------------------ + SAVE Hwrk, First + !$omp threadprivate(First, Hwrk) + !------------------------------------------------------------------------------ - CALL DefaultUpdateEquations( LocalStiffMatrix, LocalForce ) + ! Initialize: + ! ----------- + IF ( First ) THEN + First = .FALSE. + NULLIFY( Hwrk ) + END IF - !------------------------------------------------------------------------------ - END IF ! of currentelement bc == bcs(i) - END DO ! of i=1,model bcs - END DO ! Neumann BCs - !------------------------------------------------------------------------------ + Gnorm = 0.0_dp - !------------------------------------------------------------------------------ - ! FinishAssembly must be called after all other assembly steps, but before - ! Dirichlet boundary settings. Actually no need to call it except for - ! transient simulations. - !------------------------------------------------------------------------------ - CALL DefaultFinishAssembly() + Metric = 0.0_dp + DO i=1,3 + Metric(i,i) = 1.0_dp + END DO - !------------------------------------------------------------------------------ - ! Dirichlet boundary conditions - !------------------------------------------------------------------------------ - CALL DefaultDirichletBCs() + SELECT CASE( CurrentCoordinateSystem() ) + CASE( AxisSymmetric, CylindricSymmetric ) + dim = 3 + CASE DEFAULT + dim = CoordinateSystemDimension() + END SELECT + ! + ! --------------------------------------------- - at = CPUTime() - at - WRITE( Message, * ) 'Assembly (s) :',at - CALL Info( 'StatCurrentSolve', Message, Level=5 ) - !------------------------------------------------------------------------------ - ! Solve the system and we are done. - !------------------------------------------------------------------------------ - st = CPUTime() - Norm = DefaultSolve() + Element => Edge % BoundaryInfo % Left - st = CPUTime() - st - WRITE( Message, * ) 'Solve (s) :',st - CALL Info( 'StatCurrentSolve', Message, Level=5 ) + IF ( .NOT. ASSOCIATED( Element ) ) THEN + Element => Edge % BoundaryInfo % Right -!------------------------------------------------------------------------------ -! Compute the electric field from the potential: E = -grad Phi -!------------------------------------------------------------------------------ -!------------------------------------------------------------------------------ -! Compute the volume current: J = cond (-grad Phi) -!------------------------------------------------------------------------------ -!------------------------------------------------------------------------------ -! Compute the Joule heating: H,tot = Integral (E . D)dV -!------------------------------------------------------------------------------ - - IF ( Control .OR. CalculateCurrent .OR. CalculateHeating .OR. & - CalculateNodalHeating ) THEN - CALL GeneralCurrent( Model, Potential, PotentialPerm ) - - WRITE( Message, * ) 'Total Heating Power :', Heatingtot - CALL Info( 'StatCurrentSolve', Message, Level=4 ) - CALL ListAddConstReal( Model % Simulation, & - 'RES: Total Joule Heating', Heatingtot ) - - PotDiff = DirichletDofsRange( Solver ) - - IF( PotDiff > 0 ) THEN - Resistance = PotDiff**2 / HeatingTot - WRITE( Message, * ) 'Effective Resistance :', Resistance - CALL Info( 'StatCurrentSolve', Message, Level=4 ) - CALL ListAddConstReal( Model % Simulation, & - 'RES: Effective Resistance', Resistance ) - END IF - END IF + ELSE IF ( ANY( Perm( Element % NodeIndexes ) <= 0 ) ) THEN - IF(Control ) THEN - WRITE( Message, * ) 'Total Volume :', VolTot - CALL Info( 'StatCurrentSolve', Message, Level=4 ) - - ControlScaling = 1.0_dp - IF( ControlPower ) THEN - ControlScaling = SQRT( ControlTarget / HeatingTot ) - ELSE IF( ControlCurrent ) THEN - IF( PotDiff > 0.0d0 ) THEN - CurrentTot = HeatingTot / PotDiff - ControlScaling = ControlTarget / CurrentTot - WRITE( Message, * ) 'Total Current :', CurrentTot - CALL Info( 'StatCurrentSolve', Message, Level=4 ) - CALL ListAddConstReal( Model % Simulation, & - 'RES: TotalCurrent', CurrentTot ) - ELSE - CALL Warn('StatCurrentSolver','Current cannot be determined without pot. difference') - END IF - END IF + Element => Edge % BoundaryInfo % Right - WRITE( Message, * ) 'Control Scaling :', ControlScaling - CALL Info( 'StatCurrentSolve', Message, Level=4 ) - CALL ListAddConstReal( Model % Simulation, & - 'RES: CurrentSolver Scaling', ControlScaling ) - Potential = ControlScaling * Potential -! Solver % Variable % Norm = ControlScaling * Solver % Variable % Norm - - IF ( CalculateHeating ) Heating = ControlScaling**2 * Heating - IF ( CalculateNodalHeating) & - NodalHeating = ControlScaling**2 * NodalHeating - IF ( CalculateCurrent ) VolCurrent = ControlScaling * VolCurrent - END IF + END IF - IF( Solver % Variable % NonlinConverged > 0 ) EXIT + IF ( .NOT. ASSOCIATED( Element ) ) RETURN + IF ( ANY( Perm( Element % NodeIndexes ) <= 0 ) ) RETURN - END DO + En = Edge % TYPE % NumberOfNodes + Pn = Element % TYPE % NumberOfNodes + ALLOCATE( EdgeNodes % x(En), EdgeNodes % y(En), EdgeNodes % z(En) ) -!------------------------------------------------------------------------------ + EdgeNodes % x = Mesh % Nodes % x(Edge % NodeIndexes) + EdgeNodes % y = Mesh % Nodes % y(Edge % NodeIndexes) + EdgeNodes % z = Mesh % Nodes % z(Edge % NodeIndexes) - CALL InvalidateVariable( Model % Meshes, Solver % Mesh, 'Potential') - - IF ( CalculateCurrent ) THEN - CALL InvalidateVariable( Model % Meshes, Solver % Mesh, 'Volume Current') - END IF - - IF ( CalculateHeating ) THEN - CALL InvalidateVariable( Model % Meshes, Solver % Mesh, 'Joule Heating') - END IF + ALLOCATE( Nodes % x(Pn), Nodes % y(Pn), Nodes % z(Pn) ) - IF ( CalculateNodalHeating ) THEN - CALL InvalidateVariable( Model % Meshes, Solver % Mesh, & - 'Nodal Joule Heating') - END IF + Nodes % x = Mesh % Nodes % x(Element % NodeIndexes) + Nodes % y = Mesh % Nodes % y(Element % NodeIndexes) + Nodes % z = Mesh % Nodes % z(Element % NodeIndexes) - CALL DefaultFinish() - + ALLOCATE( EdgeBasis(En), Basis(Pn), dBasisdx(Pn,3), Flux(En), & + x(En), y(En), z(En), NodalConductivity(En), Potential(Pn) ) -!------------------------------------------------------------------------------ - - CONTAINS + DO l = 1,En + DO k = 1,Pn + IF ( Edge % NodeIndexes(l) == Element % NodeIndexes(k) ) THEN + x(l) = Element % TYPE % NodeU(k) + y(l) = Element % TYPE % NodeV(k) + z(l) = Element % TYPE % NodeW(k) + EXIT + END IF + END DO + END DO + ! + ! Integrate square of residual over boundary element: + ! --------------------------------------------------- + + Indicator = 0.0_dp + EdgeLength = 0.0_dp + ResidualNorm = 0.0_dp + + DO j=1,Model % NumberOfBCs + IF ( Edge % BoundaryInfo % Constraint /= Model % BCs(j) % Tag ) CYCLE + + ! + ! Check if dirichlet BC given: + ! ---------------------------- + Dirichlet = ListCheckPresent( Model % BCs(j) % Values, & + ComponentName(Model % Solver % Variable) ) + IF(.NOT. Dirichlet ) THEN + Dirichlet = ListCheckPrefix( Model % BCs(j) % Values, & + 'Constraint Mode') + END IF -!------------------------------------------------------------------------------ -!> Compute the Current and Joule Heating at model nodes. -!------------------------------------------------------------------------------ - SUBROUTINE GeneralCurrent( Model, Potential, Reorder ) -!------------------------------------------------------------------------------ - TYPE(Model_t) :: Model - REAL(KIND=dp) :: Potential(:) - INTEGER :: Reorder(:) -!------------------------------------------------------------------------------ - TYPE(Element_t), POINTER :: Element - TYPE(Nodes_t) :: Nodes - TYPE(GaussIntegrationPoints_t), TARGET :: IntegStuff + ! Get various flux bc options: + ! ---------------------------- - REAL(KIND=dp), POINTER :: U_Integ(:), V_Integ(:), W_Integ(:), S_Integ(:) - REAL(KIND=dp), ALLOCATABLE :: SumOfWeights(:), tmp(:) - REAL(KIND=dp) :: Conductivity(3,3,Model % MaxElementNodes) - REAL(KIND=dp) :: Basis(Model % MaxElementNodes) - REAL(KIND=dp) :: dBasisdx(Model % MaxElementNodes,3) - REAL(KIND=DP) :: SqrtElementMetric, ElemVol - REAL(KIND=dp) :: ElementPot(Model % MaxElementNodes) - REAL(KIND=dp) :: Current(3) - REAL(KIND=dp) :: s, ug, vg, wg, Grad(3), EpsGrad(3) - REAL(KIND=dp) :: SqrtMetric, Metric(3,3), Symb(3,3,3), dSymb(3,3,3,3) - REAL(KIND=dp) :: HeatingDensity, x, y, z - INTEGER, POINTER :: NodeIndexes(:) - INTEGER :: N_Integ, t, tg, i, j, k - LOGICAL :: Stat + ! ...given flux: + ! -------------- + Flux(1:En) = ListGetReal( Model % BCs(j) % Values, & + 'Current Flux', En, Edge % NodeIndexes, Found ) + ! get material parameters: + ! ------------------------ + k = ListGetInteger(Model % Bodies(Element % BodyId) % Values,'Material', & + minv=1, maxv=Model % NumberOfMaterials) -!------------------------------------------------------------------------------ + CALL ListGetRealArray( Model % Materials(k) % Values, & + 'Electric Conductivity', Hwrk, En, Edge % NodeIndexes,stat ) + IF ( .NOT. stat ) & + CALL Fatal('ElectricBoundaryResidual', 'Electric Conductivity not defined.') - ALLOCATE( Nodes % x( Model % MaxElementNodes ) ) - ALLOCATE( Nodes % y( Model % MaxElementNodes ) ) - ALLOCATE( Nodes % z( Model % MaxElementNodes ) ) + NodalConductivity( 1:En ) = Hwrk( 1,1,1:En ) - IF( CalculateHeating .OR. CalculateCurrent ) THEN - ALLOCATE( SumOfWeights( Model % NumberOfNodes ) ) - SumOfWeights = 0.0d0 - END IF + ! elementwise nodal solution: + ! --------------------------- + Potential(1:Pn) = Quant( Perm(Element % NodeIndexes) ) - HeatingTot = 0.0d0 - VolTot = 0.0d0 - IF ( CalculateHeating ) Heating = 0.0d0 - IF ( CalculateNodalHeating) NodalHeating = 0.0d0 - IF ( CalculateCurrent ) VolCurrent = 0.0d0 + ! do the integration: + ! ------------------- + EdgeLength = 0.0_dp + ResidualNorm = 0.0_dp - IF( GetCondAtIp ) THEN - CALL ListInitElementKeyword( CondAtIp_h,'Material','Electric Conductivity') - END IF - -!------------------------------------------------------------------------------ -! Go through model elements, we will compute on average of elementwise -! fluxes to nodes of the model -!------------------------------------------------------------------------------ - DO t = 1,Solver % NumberOfActiveElements -!------------------------------------------------------------------------------ -! Check if this element belongs to a body where electrostatics -! should be calculated -!------------------------------------------------------------------------------ - Element => Solver % Mesh % Elements( Solver % ActiveElements( t ) ) - Model % CurrentElement => Element - NodeIndexes => Element % NodeIndexes + IntegStuff = GaussPoints( Edge ) - IF ( Element % PartIndex /= ParEnv % MyPE ) CYCLE + DO t=1,IntegStuff % n + u = IntegStuff % u(t) + v = IntegStuff % v(t) + w = IntegStuff % w(t) - n = Element % TYPE % NumberOfNodes + stat = ElementInfo( Edge, EdgeNodes, u, v, w, detJ, & + EdgeBasis, dBasisdx ) - IF ( ANY(Reorder(NodeIndexes) == 0) ) CYCLE + Normal = NormalVector( Edge, EdgeNodes, u, v, .TRUE. ) - ElementPot(1:n) = Potential( Reorder( NodeIndexes(1:n) ) ) - - Nodes % x(1:n) = Model % Nodes % x( NodeIndexes ) - Nodes % y(1:n) = Model % Nodes % y( NodeIndexes ) - Nodes % z(1:n) = Model % Nodes % z( NodeIndexes ) + IF ( CurrentCoordinateSystem() == Cartesian ) THEN + s = IntegStuff % s(t) * detJ + ELSE + u = SUM( EdgeBasis(1:En) * EdgeNodes % x(1:En) ) + v = SUM( EdgeBasis(1:En) * EdgeNodes % y(1:En) ) + w = SUM( EdgeBasis(1:En) * EdgeNodes % z(1:En) ) + CALL CoordinateSystemInfo( Metric, SqrtMetric, & + Symb, dSymb, u, v, w ) -!------------------------------------------------------------------------------ -! Gauss integration stuff -!------------------------------------------------------------------------------ - IntegStuff = GaussPoints( Element ) - U_Integ => IntegStuff % u - V_Integ => IntegStuff % v - W_Integ => IntegStuff % w - S_Integ => IntegStuff % s - N_Integ = IntegStuff % n + s = IntegStuff % s(t) * detJ * SqrtMetric + END IF -!------------------------------------------------------------------------------ + ! + ! Integration point in parent element local + ! coordinates: + ! ----------------------------------------- + u = SUM( EdgeBasis(1:En) * x(1:En) ) + v = SUM( EdgeBasis(1:En) * y(1:En) ) + w = SUM( EdgeBasis(1:En) * z(1:En) ) + + stat = ElementInfo( Element, Nodes, u, v, w, detJ, & + Basis, dBasisdx ) + ! + ! Heat conductivity at the integration point: + ! -------------------------------------------- + Conductivity = SUM( NodalConductivity(1:En) * EdgeBasis(1:En) ) + ! + ! given flux at integration point: + ! -------------------------------- + Residual = -SUM( Flux(1:En) * EdgeBasis(1:En) ) + + + ! flux given by the computed solution, and + ! force norm for scaling the residual: + ! ----------------------------------------- + IF ( CurrentCoordinateSystem() == Cartesian ) THEN + DO k=1,dim + Residual = Residual + Conductivity * & + SUM( dBasisdx(1:Pn,k) * Potential(1:Pn) ) * Normal(k) + + Gnorm = Gnorm + s * (Conductivity * & + SUM(dBasisdx(1:Pn,k) * Potential(1:Pn)) * Normal(k))**2 + END DO + ELSE + DO k=1,dim + DO l=1,dim + Residual = Residual + Metric(k,l) * Conductivity * & + SUM( dBasisdx(1:Pn,k) * Potential(1:Pn) ) * Normal(l) + + Gnorm = Gnorm + s * (Metric(k,l) * Conductivity * & + SUM(dBasisdx(1:Pn,k) * Potential(1:Pn) ) * Normal(l))**2 + END DO + END DO + END IF - IF( .NOT. GetCondAtIp ) THEN - k = ListGetInteger( Model % Bodies( Element % BodyId ) % & - Values, 'Material', minv=1, maxv=Model % NumberOfMaterials ) + EdgeLength = EdgeLength + s + IF ( .NOT. Dirichlet ) THEN + ResidualNorm = ResidualNorm + s * Residual ** 2 + END IF + END DO + EXIT + END DO - CALL ListGetRealArray( Model % Materials(k) % Values, & - 'Electric Conductivity', Cwrk, n, NodeIndexes, gotIt ) + IF ( CoordinateSystemDimension() == 3 ) THEN + EdgeLength = SQRT(EdgeLength) + END IF - Conductivity = 0.0d0 - IF ( SIZE(Cwrk,1) == 1 ) THEN - DO i=1,3 - Conductivity( i,i,1:n ) = Cwrk( 1,1,1:n ) - END DO - ELSE IF ( SIZE(Cwrk,2) == 1 ) THEN - DO i=1,MIN(3,SIZE(Cwrk,1)) - Conductivity(i,i,1:n) = Cwrk(i,1,1:n) - END DO - ELSE - DO i=1,MIN(3,SIZE(Cwrk,1)) - DO j=1,MIN(3,SIZE(Cwrk,2)) - Conductivity( i,j,1:n ) = Cwrk(i,j,1:n) - END DO - END DO - END IF + ! Gnorm = EdgeLength * Gnorm + Indicator = EdgeLength * ResidualNorm + + DEALLOCATE( Nodes % x, Nodes % y, Nodes % z) + DEALLOCATE( EdgeNodes % x, EdgeNodes % y, EdgeNodes % z) + + DEALLOCATE( EdgeBasis, Basis, dBasisdx, Flux, x, y, z, & + NodalConductivity, Potential ) + !------------------------------------------------------------------------------ + END FUNCTION ElectricBoundaryResidual + !------------------------------------------------------------------------------ + + + + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + FUNCTION ElectricEdgeResidual( Model, Edge, Mesh, Quant, Perm ) RESULT( Indicator ) + !------------------------------------------------------------------------------ + USE DefUtils + IMPLICIT NONE + + TYPE(Model_t) :: Model + INTEGER :: Perm(:) + REAL(KIND=dp) :: Quant(:), Indicator(2) + TYPE( Mesh_t ), POINTER :: Mesh + TYPE( Element_t ), POINTER :: Edge + !------------------------------------------------------------------------------ + + TYPE(Nodes_t) :: Nodes, EdgeNodes + TYPE(Element_t), POINTER :: Element + + INTEGER :: i,j,k,l,n,t,dim,En,Pn + LOGICAL :: stat, Found + + REAL(KIND=dp), POINTER :: Hwrk(:,:,:) + + REAL(KIND=dp) :: SqrtMetric, Metric(3,3), Symb(3,3,3), dSymb(3,3,3,3) + REAL(KIND=dp) :: Conductivity + REAL(KIND=dp) :: u, v, w, s, detJ + REAL(KIND=dp) :: Grad(3,3), Normal(3), EdgeLength, Jump + + REAL(KIND=dp), ALLOCATABLE :: NodalConductivity(:) + REAL(KIND=dp), ALLOCATABLE :: x(:),y(:),z(:) + REAL(KIND=dp), ALLOCATABLE :: EdgeBasis(:) + REAL(KIND=dp), ALLOCATABLE :: Basis(:), dBasisdx(:,:), Potential(:) + + REAL(KIND=dp) :: Residual, ResidualNorm + + TYPE(GaussIntegrationPoints_t), TARGET :: IntegStuff + + LOGICAL :: First = .TRUE. + + SAVE Hwrk, First + !$omp threadprivate(First, Hwrk) + !------------------------------------------------------------------------------ + + ! Initialize: + ! ----------- + + IF ( First ) THEN + First = .FALSE. + NULLIFY( Hwrk ) + END IF + + SELECT CASE( CurrentCoordinateSystem() ) + CASE( AxisSymmetric, CylindricSymmetric ) + dim = 3 + CASE DEFAULT + dim = CoordinateSystemDimension() + END SELECT + + Metric = 0.0_dp + DO i = 1,3 + Metric(i,i) = 1.0_dp + END DO + + Grad = 0.0_dp + ! + ! --------------------------------------------- + + Element => Edge % BoundaryInfo % Left + n = Element % TYPE % NumberOfNodes + + Element => Edge % BoundaryInfo % Right + n = MAX( n, Element % TYPE % NumberOfNodes ) + + ALLOCATE( Nodes % x(n), Nodes % y(n), Nodes % z(n) ) + + En = Edge % TYPE % NumberOfNodes + ALLOCATE( EdgeNodes % x(En), EdgeNodes % y(En), EdgeNodes % z(En) ) + + EdgeNodes % x = Mesh % Nodes % x(Edge % NodeIndexes) + EdgeNodes % y = Mesh % Nodes % y(Edge % NodeIndexes) + EdgeNodes % z = Mesh % Nodes % z(Edge % NodeIndexes) + + ALLOCATE( x(En), y(En), z(En), NodalConductivity(En), EdgeBasis(En), & + Basis(n), dBasisdx(n,3), Potential(n) ) + + ! Integrate square of jump over edge: + ! ----------------------------------- + ResidualNorm = 0.0_dp + EdgeLength = 0.0_dp + Indicator = 0.0_dp + + IntegStuff = GaussPoints( Edge ) + + DO t=1,IntegStuff % n + + u = IntegStuff % u(t) + v = IntegStuff % v(t) + w = IntegStuff % w(t) + + stat = ElementInfo( Edge, EdgeNodes, u, v, w, detJ, & + EdgeBasis, dBasisdx ) + + Normal = NormalVector( Edge, EdgeNodes, u, v, .FALSE. ) + + IF ( CurrentCoordinateSystem() == Cartesian ) THEN + s = IntegStuff % s(t) * detJ + ELSE + u = SUM( EdgeBasis(1:En) * EdgeNodes % x(1:En) ) + v = SUM( EdgeBasis(1:En) * EdgeNodes % y(1:En) ) + w = SUM( EdgeBasis(1:En) * EdgeNodes % z(1:En) ) + + CALL CoordinateSystemInfo( Metric, SqrtMetric, & + Symb, dSymb, u, v, w ) + s = IntegStuff % s(t) * detJ * SqrtMetric END IF - + + ! + ! Compute flux over the edge as seen by elements + ! on both sides of the edge: + ! ---------------------------------------------- + DO i = 1,2 + SELECT CASE(i) + CASE(1) + Element => Edge % BoundaryInfo % Left + CASE(2) + Element => Edge % BoundaryInfo % Right + END SELECT + ! + ! Can this really happen (maybe it can...) ? + ! ------------------------------------------- + IF ( ANY( Perm( Element % NodeIndexes ) <= 0 ) ) CYCLE + ! + ! Next, get the integration point in parent + ! local coordinates: + ! ----------------------------------------- + Pn = Element % TYPE % NumberOfNodes + + DO j = 1,En + DO k = 1,Pn + IF ( Edge % NodeIndexes(j) == Element % NodeIndexes(k) ) THEN + x(j) = Element % TYPE % NodeU(k) + y(j) = Element % TYPE % NodeV(k) + z(j) = Element % TYPE % NodeW(k) + EXIT + END IF + END DO + END DO + + u = SUM( EdgeBasis(1:En) * x(1:En) ) + v = SUM( EdgeBasis(1:En) * y(1:En) ) + w = SUM( EdgeBasis(1:En) * z(1:En) ) + ! + ! Get parent element basis & derivatives at the integration point: + ! ----------------------------------------------------------------- + Nodes % x(1:Pn) = Mesh % Nodes % x(Element % NodeIndexes) + Nodes % y(1:Pn) = Mesh % Nodes % y(Element % NodeIndexes) + Nodes % z(1:Pn) = Mesh % Nodes % z(Element % NodeIndexes) + + stat = ElementInfo( Element, Nodes, u, v, w, detJ, & + Basis, dBasisdx ) + ! + ! Material parameters: + ! -------------------- + k = ListGetInteger( Model % Bodies( & + Element % BodyId) % Values, 'Material', & + minv=1, maxv=Model % NumberOfMaterials ) + + CALL ListGetRealArray( Model % Materials(k) % Values, & + 'Electric Conductivity', Hwrk, En, Edge % NodeIndexes, stat ) + IF ( .NOT. stat ) & + CALL Fatal('ElectricEdgeResidual', 'Electric Conductivity not defined.') + + NodalConductivity( 1:En ) = Hwrk( 1,1,1:En ) + Conductivity = SUM( NodalConductivity(1:En) * EdgeBasis(1:En) ) + ! + ! Potential at element nodal points: + ! ------------------------------------ + Potential(1:Pn) = Quant( Perm(Element % NodeIndexes) ) + ! + ! Finally, the flux: + ! ------------------ + DO j=1,dim + Grad(j,i) = Conductivity * SUM( dBasisdx(1:Pn,j) * Potential(1:Pn) ) + END DO + END DO + + ! Compute square of the flux jump: + ! ------------------------------- + EdgeLength = EdgeLength + s + Jump = 0.0_dp + DO k=1,dim + IF ( CurrentCoordinateSystem() == Cartesian ) THEN + Jump = Jump + (Grad(k,1) - Grad(k,2)) * Normal(k) + ELSE + DO l=1,dim + Jump = Jump + & + Metric(k,l) * (Grad(k,1) - Grad(k,2)) * Normal(l) + END DO + END IF + END DO + ResidualNorm = ResidualNorm + s * Jump ** 2 + END DO + + IF ( CoordinateSystemDimension() == 3 ) THEN + EdgeLength = SQRT(EdgeLength) + END IF + Indicator = EdgeLength * ResidualNorm + + DEALLOCATE( Nodes % x, Nodes % y, Nodes % z) + DEALLOCATE( EdgeNodes % x, EdgeNodes % y, EdgeNodes % z) + + DEALLOCATE( x, y, z, NodalConductivity, EdgeBasis, Basis, & + dBasisdx, Potential ) + !------------------------------------------------------------------------------ + END FUNCTION ElectricEdgeResidual + !------------------------------------------------------------------------------ + + + !------------------------------------------------------------------------------ + FUNCTION ElectricInsideResidual( Model, Element, Mesh, & + Quant, Perm, Fnorm ) RESULT( Indicator ) !------------------------------------------------------------------------------ -! Loop over Gauss integration points + USE DefUtils !------------------------------------------------------------------------------ - - HeatingDensity = 0.0d0 - Current = 0.0d0 - ElemVol = 0.0d0 - - - DO tg=1,N_Integ - - ug = U_Integ(tg) - vg = V_Integ(tg) - wg = W_Integ(tg) - + IMPLICIT NONE !------------------------------------------------------------------------------ -! Need SqrtElementMetric and Basis at the integration point + TYPE(Model_t) :: Model + INTEGER :: Perm(:) + REAL(KIND=dp) :: Quant(:), Indicator(2), Fnorm + TYPE( Mesh_t ), POINTER :: Mesh + TYPE( Element_t ), POINTER :: Element !------------------------------------------------------------------------------ - stat = ElementInfo( Element, Nodes,ug,vg,wg, & - SqrtElementMetric,Basis,dBasisdx ) -!------------------------------------------------------------------------------ -! Coordinatesystem dependent info -!------------------------------------------------------------------------------ - s = SqrtElementMetric * S_Integ(tg) + TYPE(Nodes_t) :: Nodes - IF ( CurrentCoordinateSystem() /= Cartesian ) THEN - x = SUM( Nodes % x(1:n)*Basis(1:n) ) - y = SUM( Nodes % y(1:n)*Basis(1:n) ) - z = SUM( Nodes % z(1:n)*Basis(1:n) ) - - CALL CoordinateSystemInfo( Metric,SqrtMetric,Symb,dSymb,x,y,z ) - s = s * SqrtMetric * 2 * PI - END IF + LOGICAL :: stat, Found + INTEGER :: i,j,k,l,n,t,dim -!------------------------------------------------------------------------------ + REAL(KIND=dp), POINTER :: Hwrk(:,:,:) - EpsGrad = 0.0d0 - IF( GetCondAtIp ) THEN - CondAtIp = ListGetElementReal( CondAtIp_h, Basis, Element, Stat, GaussPoint = tg ) - DO j = 1, DIM - Grad(j) = SUM( dBasisdx(1:n,j) * ElementPot(1:n) ) - END DO - EpsGrad(1:dim) = CondAtIp * Grad(1:dim) - ELSE - DO j = 1, DIM - Grad(j) = SUM( dBasisdx(1:n,j) * ElementPot(1:n) ) - DO i = 1, DIM - EpsGrad(j) = EpsGrad(j) + SUM( Conductivity(j,i,1:n) * & - Basis(1:n) ) * SUM( dBasisdx(1:n,i) * ElementPot(1:n) ) - END DO - END DO - END IF + REAL(KIND=dp) :: SqrtMetric, Metric(3,3), Symb(3,3,3), dSymb(3,3,3,3) + REAL(KIND=dp) :: Conductivity + REAL(KIND=dp) :: u, v, w, s, detJ + REAL(KIND=dp) :: Source, Residual, ResidualNorm, Area - - VolTot = VolTot + s + REAL(KIND=dp), ALLOCATABLE :: NodalConductivity(:) + REAL(KIND=dp), ALLOCATABLE :: PrevPot(:) + REAL(KIND=dp), ALLOCATABLE :: NodalSource(:), Potential(:) + REAL(KIND=dp), ALLOCATABLE :: Basis(:) + REAL(KIND=dp), ALLOCATABLE :: dBasisdx(:,:), ddBasisddx(:,:,:) - HeatingTot = HeatingTot + & - s * SUM( Grad(1:DIM) * EpsGrad(1:DIM) ) + TYPE( ValueList_t ), POINTER :: Material - IF( CalculateHeating .OR. CalculateCurrent .OR. CalculateNodalHeating ) THEN - HeatingDensity = HeatingDensity + & - s * SUM( Grad(1:DIM) * EpsGrad(1:DIM) ) - DO j = 1,DIM - Current(j) = Current(j) - EpsGrad(j) * s - END DO - - ElemVol = ElemVol + s - END IF + TYPE(GaussIntegrationPoints_t), TARGET :: IntegStuff - END DO! of the Gauss integration points + LOGICAL :: First = .TRUE. -!------------------------------------------------------------------------------ -! Weight with element area if required + SAVE Hwrk, First + !$omp threadprivate(First, Hwrk) !------------------------------------------------------------------------------ - IF( CalculateHeating .OR. CalculateCurrent ) THEN - IF ( ConstantWeights ) THEN - HeatingDensity = HeatingDensity / ElemVol - Current(1:Dim) = Current(1:Dim) / ElemVol - SumOfWeights( Reorder( NodeIndexes(1:n) ) ) = & - SumOfWeights( Reorder( NodeIndexes(1:n) ) ) + 1 - ELSE - SumOfWeights( Reorder( NodeIndexes(1:n) ) ) = & - SumOfWeights( Reorder( NodeIndexes(1:n) ) ) + ElemVol - END IF - END IF - - IF ( CalculateHeating ) THEN - Heating( Reorder(NodeIndexes(1:n)) ) = & - Heating( Reorder(NodeIndexes(1:n)) ) + HeatingDensity - END IF - - IF ( CalculateNodalHeating ) THEN - NodalHeating( Reorder(NodeIndexes(1:n)) ) = & - NodalHeating( Reorder(NodeIndexes(1:n)) ) + HeatingDensity - END IF - - IF ( CalculateCurrent ) THEN - DO j=1,DIM - VolCurrent(DIM*(Reorder(NodeIndexes(1:n))-1)+j) = & - VolCurrent(DIM*(Reorder(NodeIndexes(1:n))-1)+j) + & - Current(j) - END DO - END IF +! Initialize: +! ----------- + Indicator = 0.0_dp + Fnorm = 0.0_dp +! +! Check if this equation is computed in this element: +! --------------------------------------------------- + IF ( ANY( Perm( Element % NodeIndexes ) <= 0 ) ) RETURN + + IF ( First ) THEN + First = .FALSE. + NULLIFY( Hwrk ) + END IF + + Metric = 0.0_dp + DO i=1,3 + Metric(i,i) = 1.0_dp + END DO + + SELECT CASE( CurrentCoordinateSystem() ) + CASE( AxisSymmetric, CylindricSymmetric ) + dim = 3 + CASE DEFAULT + dim = CoordinateSystemDimension() + END SELECT +! +! Element nodal points: +! --------------------- + n = Element % TYPE % NumberOfNodes - END DO! of the bulk elements + ALLOCATE( Nodes % x(n), Nodes % y(n), Nodes % z(n), & + NodalConductivity(n), Basis(n), dBasisdx(n,3), & + ddBasisddx(n,3,3), PrevPot(n), NodalSource(n), Potential(n) ) - IF ( CalculateHeating .OR. CalculateCurrent) THEN - IF ( ParEnv % PEs > 1) THEN - VolTot = ParallelReduction(VolTot) - HeatingTot = ParallelReduction(HeatingTot) - - IF ( CalculateCurrent) THEN - ALLOCATE(tmp(SIZE(VolCurrent)/dim)) - DO i=1,dim - tmp = VolCurrent(i::dim) - CALL ParallelSumVector(Solver % Matrix, tmp) - Volcurrent(i::dim) = tmp - END DO - END IF - IF (CalculateHeating ) CALL ParallelSumVector(Solver % Matrix, Heating) - CALL ParallelSumVector(Solver % Matrix, SumOfWeights) - END IF - -!------------------------------------------------------------------------------ -! Finally, compute average of the fluxes at nodes -!------------------------------------------------------------------------------ - DO i = 1, Model % NumberOfNodes - IF ( ABS( SumOfWeights(i) ) > 0.0D0 ) THEN - IF ( CalculateHeating ) Heating(i) = Heating(i) / SumOfWeights(i) - DO j = 1, DIM - IF ( CalculateCurrent ) VolCurrent(DIM*(i-1)+j) = & - VolCurrent(DIM*(i-1)+j) / SumOfWeights(i) - END DO - END IF - END DO - DEALLOCATE( SumOfWeights ) - END IF - - DEALLOCATE( Nodes % x, Nodes % y, Nodes % z ) + Nodes % x = Mesh % Nodes % x(Element % NodeIndexes) + Nodes % y = Mesh % Nodes % y(Element % NodeIndexes) + Nodes % z = Mesh % Nodes % z(Element % NodeIndexes) +! +! Elementwise nodal solution: +! --------------------------- + Potential(1:n) = Quant( Perm(Element % NodeIndexes) ) +! +! Material parameters: electrical conductivity +! -------------------------------------------- + k = ListGetInteger( Model % Bodies(Element % BodyId) % Values, 'Material', & + minv=1, maxv=Model % NumberOfMaterials ) -!------------------------------------------------------------------------------ - END SUBROUTINE GeneralCurrent -!------------------------------------------------------------------------------ + Material => Model % Materials(k) % Values - -!------------------------------------------------------------------------------ - SUBROUTINE StatCurrentCompose( StiffMatrix,Force,Conductivity, & - Load,Element,n,Nodes ) -!------------------------------------------------------------------------------ - REAL(KIND=dp) :: StiffMatrix(:,:),Force(:),Load(:), Conductivity(:,:,:) - INTEGER :: n - TYPE(Nodes_t) :: Nodes - TYPE(Element_t), POINTER :: Element -!------------------------------------------------------------------------------ - - REAL(KIND=dp) :: SqrtMetric,Metric(3,3),Symb(3,3,3),dSymb(3,3,3,3) - REAL(KIND=dp) :: Basis(n),dBasisdx(n,3) - REAL(KIND=dp) :: SqrtElementMetric,U,V,W,S,A,L,C(3,3),x,y,z - LOGICAL :: Stat - - INTEGER :: i,p,q,t,DIM - - TYPE(GaussIntegrationPoints_t) :: IntegStuff - -!------------------------------------------------------------------------------ - DIM = CoordinateSystemDimension() + CALL ListGetRealArray( Model % Materials(k) % Values, & + 'Electric Conductivity', Hwrk, n, Element % NodeIndexes, stat ) + IF ( .NOT. stat ) & + CALL Fatal('ElectricInsideResidual', 'Electric Conductivity not defined.') - Force = 0.0d0 - StiffMatrix = 0.0d0 -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ -! Numerical integration -!------------------------------------------------------------------------------ - IntegStuff = GaussPoints( Element ) - - DO t=1,IntegStuff % n - U = IntegStuff % u(t) - V = IntegStuff % v(t) - W = IntegStuff % w(t) - S = IntegStuff % s(t) -!------------------------------------------------------------------------------ -! Basis function values & derivatives at the integration point -!------------------------------------------------------------------------------ - stat = ElementInfo( Element,Nodes,U,V,W,SqrtElementMetric, & - Basis,dBasisdx ) -!------------------------------------------------------------------------------ -! Coordinatesystem dependent info -!------------------------------------------------------------------------------ - IF ( CurrentCoordinateSystem() /= Cartesian ) THEN - x = SUM( ElementNodes % x(1:n)*Basis(1:n) ) - y = SUM( ElementNodes % y(1:n)*Basis(1:n) ) - z = SUM( ElementNodes % z(1:n)*Basis(1:n) ) - END IF + NodalConductivity( 1:n ) = Hwrk( 1,1,1:n ) +! +! Current source density (source): +! -------------------------------- +! + k = ListGetInteger( & + Model % Bodies(Element % BodyId) % Values,'Body Force',Found, & + 1, Model % NumberOfBodyForces) + + NodalSource = 0.0_dp + IF ( Found .AND. k > 0 ) THEN + NodalSource(1:n) = ListGetReal( Model % BodyForces(k) % Values, & + 'Current Source', n, Element % NodeIndexes, stat ) + IF ( .NOT. stat ) & + NodalSource(1:n) = ListGetReal( Model % BodyForces(k) % Values, & + 'Source', n, Element % NodeIndexes ) + END IF +! +! Integrate square of residual over element: +! ------------------------------------------ - CALL CoordinateSystemInfo( Metric,SqrtMetric,Symb,dSymb,x,y,z ) - - S = S * SqrtElementMetric * SqrtMetric + ResidualNorm = 0.0_dp + Area = 0.0_dp - L = SUM( Load(1:n) * Basis ) + IntegStuff = GaussPointsAdapt( Element ) - IF( GetCondAtIp ) THEN - CondAtIp = ListGetElementReal( CondAtIp_h, Basis, Element, Stat, GaussPoint = t ) - C(1:dim,1:dim) = 0.0_dp - DO i=1,dim - C(i,i) = CondAtIp - END DO - ELSE - DO i=1,DIM - DO j=1,DIM - C(i,j) = SUM( Conductivity(i,j,1:n) * Basis(1:n) ) - END DO - END DO - END IF - -!------------------------------------------------------------------------------ -! The Poisson equation -!------------------------------------------------------------------------------ - DO p=1,N - DO q=1,N - A = 0.d0 - DO i=1,DIM - DO J=1,DIM - A = A + C(i,j) * dBasisdx(p,i) * dBasisdx(q,j) - END DO - END DO - StiffMatrix(p,q) = StiffMatrix(p,q) + S*A - END DO - Force(p) = Force(p) + S*L*Basis(p) - END DO -!------------------------------------------------------------------------------ - END DO -!------------------------------------------------------------------------------ - END SUBROUTINE StatCurrentCompose -!------------------------------------------------------------------------------ - - -!------------------------------------------------------------------------------ -!> Return element local matrices and RHS vector for boundary conditions -!> of the electrostatic equation. -!------------------------------------------------------------------------------ - SUBROUTINE StatCurrentBoundary( BoundaryMatrix, BoundaryVector, & - LoadVector, Element, n, Nodes ) -!------------------------------------------------------------------------------ - REAL(KIND=dp) :: BoundaryMatrix(:,:), BoundaryVector(:), LoadVector(:) - TYPE(Nodes_t) :: Nodes - TYPE(Element_t) :: Element - INTEGER :: n -!------------------------------------------------------------------------------ - REAL(KIND=dp) :: Basis(n) - REAL(KIND=dp) :: dBasisdx(n,3),SqrtElementMetric - REAL(KIND=dp) :: SqrtMetric,Metric(3,3),Symb(3,3,3),dSymb(3,3,3,3) + DO t=1,IntegStuff % n + u = IntegStuff % u(t) + v = IntegStuff % v(t) + w = IntegStuff % w(t) - REAL(KIND=dp) :: u,v,w,s,x,y,z - REAL(KIND=dp) :: Force - REAL(KIND=dp), POINTER :: U_Integ(:),V_Integ(:),W_Integ(:),S_Integ(:) + stat = ElementInfo( Element, Nodes, u, v, w, detJ, & + Basis, dBasisdx, ddBasisddx, .TRUE., .FALSE. ) - INTEGER :: t,q,N_Integ + IF ( CurrentCoordinateSystem() == Cartesian ) THEN + s = IntegStuff % s(t) * detJ + ELSE + u = SUM( Basis(1:n) * Nodes % x(1:n) ) + v = SUM( Basis(1:n) * Nodes % y(1:n) ) + w = SUM( Basis(1:n) * Nodes % z(1:n) ) - TYPE(GaussIntegrationPoints_t), TARGET :: IntegStuff + CALL CoordinateSystemInfo( Metric, SqrtMetric, & + Symb, dSymb, u, v, w ) + s = IntegStuff % s(t) * detJ * SqrtMetric + END IF - LOGICAL :: stat -!------------------------------------------------------------------------------ + Conductivity = SUM( NodalConductivity(1:n) * Basis(1:n) ) +! +! Residual of the current conduction equation: +! +! R = -div(σ grad(u)) - S +! --------------------------------------------------- +! +! or more generally: +! +! R = -g^{jk} (σ T_{,j}}_{,k}) - S +! --------------------------------------------------- +! + Residual = -SUM( NodalSource(1:n) * Basis(1:n) ) - BoundaryVector = 0.0d0 - BoundaryMatrix = 0.0d0 -!------------------------------------------------------------------------------ -! Integration stuff -!------------------------------------------------------------------------------ - IntegStuff = GaussPoints( Element ) - U_Integ => IntegStuff % u - V_Integ => IntegStuff % v - W_Integ => IntegStuff % w - S_Integ => IntegStuff % s - N_Integ = IntegStuff % n + IF ( CurrentCoordinateSystem() == Cartesian ) THEN + DO j=1,dim +! +! - grad(σ).grad(T): +! -------------------- +! + Residual = Residual - & + SUM( Potential(1:n) * dBasisdx(1:n,j) ) * & + SUM( NodalConductivity(1:n) * dBasisdx(1:n,j) ) -!------------------------------------------------------------------------------ -! Now we start integrating -!------------------------------------------------------------------------------ - DO t=1,N_Integ - u = U_Integ(t) - v = V_Integ(t) - w = W_Integ(t) -!------------------------------------------------------------------------------ -! Basis function values & derivates at the integration point -!------------------------------------------------------------------------------ - stat = ElementInfo( Element,Nodes,u,v,w,SqrtElementMetric, & - Basis,dBasisdx ) +! +! - σ div(grad(u)): +! ------------------- +! + Residual = Residual - Conductivity * & + SUM( Potential(1:n) * ddBasisddx(1:n,j,j) ) + END DO + ELSE + DO j=1,dim + DO k=1,dim +! +! - g^{jk} σ_{,k} T_{,j}: +! ------------------------ +! + Residual = Residual - Metric(j,k) * & + SUM( Potential(1:n) * dBasisdx(1:n,j) ) * & + SUM( NodalConductivity(1:n) * dBasisdx(1:n,k) ) -!------------------------------------------------------------------------------ -! Coordinatesystem dependent info -!------------------------------------------------------------------------------ - IF ( CurrentCoordinateSystem() /= Cartesian ) THEN - x = SUM( ElementNodes % x(1:n)*Basis(1:n) ) - y = SUM( ElementNodes % y(1:n)*Basis(1:n) ) - z = SUM( ElementNodes % z(1:n)*Basis(1:n) ) - END IF +! +! - g^{jk} σ T_{,jk}: +! -------------------- +! + Residual = Residual - Metric(j,k) * Conductivity * & + SUM( Potential(1:n) * ddBasisddx(1:n,j,k) ) +! +! + g^{jk} σ Γ_{jk}^l T_{,l}: +! ----------------------------- + DO l=1,dim + Residual = Residual + Metric(j,k) * Conductivity * & + Symb(j,k,l) * SUM( Potential(1:n) * dBasisdx(1:n,l) ) + END DO + END DO + END DO + END IF - CALL CoordinateSystemInfo( Metric,SqrtMetric,Symb,dSymb,x,y,z ) - - s = S_Integ(t) * SqrtElementMetric * SqrtMetric +! +! Compute also force norm for scaling the residual: +! ------------------------------------------------- + DO i=1,dim + Fnorm = Fnorm + s * ( SUM( NodalSource(1:n) * Basis(1:n) ) ) ** 2 + END DO -!------------------------------------------------------------------------------ - Force = SUM( LoadVector(1:n)*Basis ) + Area = Area + s + ResidualNorm = ResidualNorm + s * Residual ** 2 + END DO - DO q=1,N - BoundaryVector(q) = BoundaryVector(q) + s * Basis(q) * Force - END DO - END DO - END SUBROUTINE StatCurrentBoundary -!------------------------------------------------------------------------------ +! Fnorm = Element % hK**2 * Fnorm + Indicator = Element % hK**2 * ResidualNorm + DEALLOCATE( Nodes % x, Nodes % y, Nodes % z, NodalConductivity, & + Basis, dBasisdx, ddBasisddx, PrevPot, NodalSource, Potential ) !------------------------------------------------------------------------------ - END SUBROUTINE StatCurrentSolver +END FUNCTION ElectricInsideResidual !------------------------------------------------------------------------------ diff --git a/fem/src/modules/StatCurrentSolveVec.F90 b/fem/src/modules/StatCurrentSolveVec.F90 index aa8e2ea402..9c0219c546 100644 --- a/fem/src/modules/StatCurrentSolveVec.F90 +++ b/fem/src/modules/StatCurrentSolveVec.F90 @@ -46,6 +46,8 @@ SUBROUTINE StatCurrentSolver_init( Model,Solver,dt,Transient ) !------------------------------------------------------------------------------ USE DefUtils + USE Adaptive + IMPLICIT NONE !------------------------------------------------------------------------------ TYPE(Solver_t) :: Solver @@ -138,6 +140,7 @@ END SUBROUTINE StatCurrentSolver_Init SUBROUTINE StatCurrentSolver( Model,Solver,dt,Transient ) !------------------------------------------------------------------------------ USE DefUtils + USE Adaptive IMPLICIT NONE !------------------------------------------------------------------------------ TYPE(Solver_t) :: Solver @@ -156,7 +159,37 @@ SUBROUTINE StatCurrentSolver( Model,Solver,dt,Transient ) TYPE(Mesh_t), POINTER :: Mesh CHARACTER(*), PARAMETER :: Caller = 'StatCurrentSolver' !------------------------------------------------------------------------------ + + INTERFACE + FUNCTION ElectricBoundaryResidual(Model, Edge, Mesh, Quant, Perm, Gnorm) RESULT(Indicator) + USE Types + TYPE(Element_t), POINTER :: Edge + TYPE(Model_t) :: Model + TYPE(Mesh_t), POINTER :: Mesh + REAL(KIND=dp) :: Quant(:), Indicator(2), Gnorm + INTEGER :: Perm(:) + END FUNCTION ElectricBoundaryResidual + + FUNCTION ElectricEdgeResidual(Model, Edge, Mesh, Quant, Perm) RESULT(Indicator) + USE Types + TYPE(Element_t), POINTER :: Edge + TYPE(Model_t) :: Model + TYPE(Mesh_t), POINTER :: Mesh + REAL(KIND=dp) :: Quant(:), Indicator(2) + INTEGER :: Perm(:) + END FUNCTION ElectricEdgeResidual + + FUNCTION ElectricInsideResidual(Model, Element, Mesh, Quant, Perm, Fnorm) RESULT(Indicator) + USE Types + TYPE(Element_t), POINTER :: Element + TYPE(Model_t) :: Model + TYPE(Mesh_t), POINTER :: Mesh + REAL(KIND=dp) :: Quant(:), Indicator(2), Fnorm + INTEGER :: Perm(:) + END FUNCTION ElectricInsideResidual + END INTERFACE +!------------------------------------------------------------------------------ CALL Info(Caller,'------------------------------------------------') CALL Info(Caller,'Solving static current conduction solver') @@ -290,6 +323,12 @@ SUBROUTINE StatCurrentSolver( Model,Solver,dt,Transient ) CALL DefaultFinish() +#ifndef LIBRARY_ADAPTIVITY + IF (ListGetLogical(Solver % Values, 'Adaptive Mesh Refinement', Found)) & + ! CALL INFO(Caller, 'Adaptive Mesh Refinement is not available in this version of ElmerSolver', Level=7) + CALL RefineMesh(Model, Solver, Solver % Variable % Values, Solver % Variable % Perm, & + ElectricInsideResidual, ElectricEdgeResidual, ElectricBoundaryResidual) +#endif CONTAINS @@ -1139,3 +1178,1298 @@ END SUBROUTINE GlobalPostScale !------------------------------------------------------------------------ END SUBROUTINE StatCurrentSolver_Post !------------------------------------------------------------------------ + +FUNCTION ElectricBoundaryResidual(Model, Edge, Mesh, Quant, Perm, Gnorm) RESULT(Indicator) + !------------------------------------------------------------------------------ + USE DefUtils + IMPLICIT NONE + !------------------------------------------------------------------------------ + TYPE(Model_t) :: Model + INTEGER :: Perm(:) + REAL(KIND=dp) :: Quant(:), Indicator(2), Gnorm + TYPE(Mesh_t), POINTER :: Mesh + TYPE(Element_t), POINTER :: Edge + !------------------------------------------------------------------------------ + TYPE(Nodes_t) :: Nodes, EdgeNodes + TYPE(Element_t), POINTER :: Element + INTEGER :: i, j, k, n, l, t, dim, Pn, En, nd + LOGICAL :: stat, Found + INTEGER, ALLOCATABLE :: Indexes(:) + REAL(KIND=dp), POINTER :: Hwrk(:, :, :) + REAL(KIND=dp) :: SqrtMetric, Metric(3, 3), Symb(3, 3, 3), dSymb(3, 3, 3, 3) + REAL(KIND=dp), ALLOCATABLE :: NodalConductivity(:), & + EdgeBasis(:), Basis(:), x(:), y(:), z(:), & + dBasisdx(:, :), Potential(:), Flux(:) + REAL(KIND=dp) :: Normal(3), EdgeLength, gx, gy, gz, Conductivity + REAL(KIND=dp) :: u, v, w, s, detJ + REAL(KIND=dp) :: Residual, ResidualNorm + TYPE(GaussIntegrationPoints_t), TARGET :: IntegStuff + LOGICAL :: First = .TRUE., Dirichlet + SAVE Hwrk, First + !------------------------------------------------------------------------------ + + ! Initialize: + ! ----------- + IF (First) THEN + First = .FALSE. + NULLIFY (Hwrk) + END IF + + Indicator = 0.0d0 + Gnorm = 0.0d0 + + Metric = 0.0d0 + DO i = 1, 3 + Metric(i, i) = 1.0d0 + END DO + + SELECT CASE (CurrentCoordinateSystem()) + CASE (AxisSymmetric, CylindricSymmetric) + dim = 3 + CASE DEFAULT + dim = CoordinateSystemDimension() + END SELECT + ! + ! --------------------------------------------- + + Element => Edge % BoundaryInfo % Left + + IF (.NOT. ASSOCIATED(Element)) THEN + Element => Edge % BoundaryInfo % Right + ELSE IF (ANY(Perm(Element % NodeIndexes) <= 0)) THEN + Element => Edge % BoundaryInfo % Right + END IF + + IF (.NOT. ASSOCIATED(Element)) RETURN + IF (ANY(Perm(Element % NodeIndexes) <= 0)) RETURN + + en = Edge % TYPE % NumberOfNodes + pn = Element % TYPE % NumberOfNodes + + ALLOCATE (EdgeNodes % x(en), EdgeNodes % y(en), EdgeNodes % z(en)) + + EdgeNodes % x = Mesh % Nodes % x(Edge % NodeIndexes) + EdgeNodes % y = Mesh % Nodes % y(Edge % NodeIndexes) + EdgeNodes % z = Mesh % Nodes % z(Edge % NodeIndexes) + + nd = GetElementNOFDOFs(Element) + ALLOCATE (Potential(nd), Basis(nd), & + x(en), y(en), z(en), EdgeBasis(nd), & + dBasisdx(nd, 3), NodalConductivity(nd), Flux(nd), & + Indexes(nd)) + + nd = GetElementDOFs(Indexes, Element) + + ALLOCATE (Nodes % x(nd), Nodes % y(nd), Nodes % z(nd)) + Nodes % x(1:nd) = Mesh % Nodes % x(Indexes(1:nd)) + Nodes % y(1:nd) = Mesh % Nodes % y(Indexes(1:nd)) + Nodes % z(1:nd) = Mesh % Nodes % z(Indexes(1:nd)) + + DO l = 1, en + DO k = 1, pn + IF (Edge % NodeIndexes(l) == Element % NodeIndexes(k)) THEN + x(l) = Element % TYPE % NodeU(k) + y(l) = Element % TYPE % NodeV(k) + z(l) = Element % TYPE % NodeW(k) + EXIT + END IF + END DO + END DO + ! + ! Integrate square of residual over boundary element: + ! --------------------------------------------------- + + Indicator = 0.0d0 + EdgeLength = 0.0d0 + ResidualNorm = 0.0d0 + + DO j = 1, Model % NumberOfBCs + IF (Edge % BoundaryInfo % Constraint /= Model % BCs(j) % Tag) CYCLE + + ! + ! Check if dirichlet BC given: + ! ---------------------------- + Dirichlet = ListCheckPresent(Model % BCs(j) % Values, & + ComponentName(Model % Solver % Variable)) + IF (.NOT. Dirichlet) THEN + Dirichlet = ListCheckPrefix(Model % BCs(j) % Values, & + 'Constraint Mode') + END IF + ! TODO s = ListGetConstReal( Model % BCs(j) % Values,'Potential',Dirichlet ) + + ! Get various flux bc options: + ! ---------------------------- + + ! ...given flux: + ! -------------- + Flux(1:en) = ListGetReal(Model % BCs(j) % Values, & + 'Electric Flux', en, Edge % NodeIndexes, Found) + + ! get material parameters: + ! ------------------------ + k = ListGetInteger(Model % Bodies(Element % BodyId) % Values, 'Material', & + minv=1, maxv=Model % NumberOFMaterials) + + CALL ListGetRealArray(Model % Materials(k) % Values, & + 'Electric Conductivity', Hwrk, en, Edge % NodeIndexes, stat) + IF (.NOT. stat) & + CALL FATAL('ElectricBoundaryResidual', 'Electric conductivity not found') + NodalConductivity(1:en) = Hwrk(1, 1, 1:en) + + ! elementwise nodal solution: + ! --------------------------- + nd = GetElementDOFs(Indexes, Element) + Potential(1:nd) = Quant(Perm(Indexes(1:nd))) + + ! do the integration: + ! ------------------- + EdgeLength = 0.0d0 + ResidualNorm = 0.0d0 + + IntegStuff = GaussPoints(Edge) + + DO t = 1, IntegStuff % n + u = IntegStuff % u(t) + v = IntegStuff % v(t) + w = IntegStuff % w(t) + + stat = ElementInfo(Edge, EdgeNodes, u, v, w, detJ, & + EdgeBasis, dBasisdx) + Normal = NormalVector(Edge, EdgeNodes, u, v, .TRUE.) + + IF (CurrentCoordinateSystem() == Cartesian) THEN + s = IntegStuff % s(t) * detJ + ELSE + gx = SUM(EdgeBasis(1:en) * EdgeNodes % x(1:en)) + gy = SUM(EdgeBasis(1:en) * EdgeNodes % y(1:en)) + gz = SUM(EdgeBasis(1:en) * EdgeNodes % z(1:en)) + CALL CoordinateSystemInfo(Metric, SqrtMetric, & + Symb, dSymb, gx, gy, gz) + s = IntegStuff % s(t) * detJ * SqrtMetric + END IF + + ! + ! Integration point in parent element local + ! coordinates: + ! ----------------------------------------- + u = SUM(EdgeBasis(1:en) * x(1:en)) + v = SUM(EdgeBasis(1:en) * y(1:en)) + w = SUM(EdgeBasis(1:en) * z(1:en)) + stat = ElementInfo(Element, Nodes, u, v, w, detJ, Basis, dBasisdx) + + ! + ! Electric conductivity at the integration point: + ! -------------------------------------- + Conductivity = SUM(NodalConductivity(1:en) * EdgeBasis(1:en)) + ! + ! given flux at integration point: + ! -------------------------------- + Residual = -SUM(Flux(1:en) * EdgeBasis(1:en)) + + ! flux given by the computed solution, and + ! force norm for scaling the residual: + ! ----------------------------------------- + IF (CurrentCoordinateSystem() == Cartesian) THEN + DO k = 1, dim + Residual = Residual + Conductivity * & + SUM(dBasisdx(1:nd, k) * Potential(1:nd)) * Normal(k) + + Gnorm = Gnorm + s * (Conductivity * & + SUM(dBasisdx(1:nd, k) * Potential(1:nd)) * Normal(k))**2 + END DO + ELSE + DO k = 1, dim + DO l = 1, dim + Residual = Residual + Metric(k, l) * Conductivity * & + SUM(dBasisdx(1:nd, k) * Potential(1:nd)) * Normal(l) + + Gnorm = Gnorm + s * (Metric(k, l) * Conductivity * & + SUM(dBasisdx(1:nd, k) * Potential(1:nd)) * Normal(l))**2 + END DO + END DO + END IF + + EdgeLength = EdgeLength + s + IF (.NOT. Dirichlet) THEN + ResidualNorm = ResidualNorm + s * Residual**2 + END IF + END DO + EXIT + END DO + + IF (CoordinateSystemDimension() == 3) EdgeLength = SQRT(EdgeLength) + + ! Gnorm = EdgeLength * Gnorm + Indicator = EdgeLength * ResidualNorm + !------------------------------------------------------------------------------ +END FUNCTION ElectricBoundaryResidual + !------------------------------------------------------------------------------ + +FUNCTION ElectricEdgeResidual(Model, Edge, Mesh, Quant, Perm) RESULT(Indicator) + !------------------------------------------------------------------------------ + USE DefUtils + IMPLICIT NONE + + TYPE(Model_t) :: Model + INTEGER :: Perm(:) + REAL(KIND=dp) :: Quant(:), Indicator(2) + TYPE(Mesh_t), POINTER :: Mesh + TYPE(Element_t), POINTER :: Edge + !------------------------------------------------------------------------------ + TYPE(Nodes_t) :: Nodes, EdgeNodes + TYPE(Element_t), POINTER :: Element + INTEGER :: i, j, k, l, n, t, dim, En, Pn, nd + INTEGER, ALLOCATABLE :: Indexes(:) + LOGICAL :: stat + REAL(KIND=dp), POINTER :: Hwrk(:, :, :) + REAL(KIND=dp) :: SqrtMetric, Metric(3, 3), Symb(3, 3, 3), dSymb(3, 3, 3, 3) + REAL(KIND=dp) :: Conductivity + REAL(KIND=dp) :: u, v, w, s, detJ + REAL(KIND=dp) :: Grad(3, 3), Normal(3), EdgeLength, Jump + REAL(KIND=dp), ALLOCATABLE :: NodalConductivity(:), x(:), y(:), z(:), EdgeBasis(:), & + Basis(:), dBasisdx(:, :), Potential(:) + REAL(KIND=dp) :: ResidualNorm + TYPE(GaussIntegrationPoints_t), TARGET :: IntegStuff + TYPE(ValueList_t), POINTER :: Material + + LOGICAL :: First = .TRUE. + SAVE Hwrk, First + !------------------------------------------------------------------------------ + + ! Initialize: + ! ----------- + IF (First) THEN + First = .FALSE. + NULLIFY (Hwrk) + END IF + + SELECT CASE (CurrentCoordinateSystem()) + CASE (AxisSymmetric, CylindricSymmetric) + dim = 3 + CASE DEFAULT + dim = CoordinateSystemDimension() + END SELECT + + Metric = 0.0d0 + DO i = 1, 3 + Metric(i, i) = 1.0d0 + END DO + Grad = 0.0d0 + ! + ! --------------------------------------------- + + n = Mesh % MaxElementDOFs + ALLOCATE (Nodes % x(n), Nodes % y(n), Nodes % z(n)) + + en = Edge % TYPE % NumberOfNodes + ALLOCATE (EdgeNodes % x(en), EdgeNodes % y(en), EdgeNodes % z(en)) + + EdgeNodes % x = Mesh % Nodes % x(Edge % NodeIndexes) + EdgeNodes % y = Mesh % Nodes % y(Edge % NodeIndexes) + EdgeNodes % z = Mesh % Nodes % z(Edge % NodeIndexes) + + ALLOCATE (NodalConductivity(en), EdgeBasis(en), Basis(n), & + dBasisdx(n, 3), x(en), y(en), z(en), Potential(n), Indexes(n)) + + ! Integrate square of jump over edge: + ! ----------------------------------- + ResidualNorm = 0.0d0 + EdgeLength = 0.0d0 + Indicator = 0.0d0 + + IntegStuff = GaussPoints(Edge) + + DO t = 1, IntegStuff % n + + u = IntegStuff % u(t) + v = IntegStuff % v(t) + w = IntegStuff % w(t) + + stat = ElementInfo(Edge, EdgeNodes, u, v, w, detJ, & + EdgeBasis, dBasisdx) + + Normal = NormalVector(Edge, EdgeNodes, u, v, .FALSE.) + + IF (CurrentCoordinateSystem() == Cartesian) THEN + s = IntegStuff % s(t) * detJ + ELSE + u = SUM(EdgeBasis(1:en) * EdgeNodes % x(1:en)) + v = SUM(EdgeBasis(1:en) * EdgeNodes % y(1:en)) + w = SUM(EdgeBasis(1:en) * EdgeNodes % z(1:en)) + + CALL CoordinateSystemInfo(Metric, SqrtMetric, & + Symb, dSymb, u, v, w) + s = IntegStuff % s(t) * detJ * SqrtMetric + END IF + + ! + ! Compute flux over the edge as seen by elements + ! on both sides of the edge: + ! ---------------------------------------------- + DO i = 1, 2 + SELECT CASE (i) + CASE (1) + Element => Edge % BoundaryInfo % Left + CASE (2) + Element => Edge % BoundaryInfo % Right + END SELECT + ! + ! Can this really happen (maybe it can...) ? + ! ------------------------------------------- + IF (ANY(Perm(Element % NodeIndexes) <= 0)) CYCLE + ! + ! Next, get the integration point in parent + ! local coordinates: + ! ----------------------------------------- + pn = Element % TYPE % NumberOfNodes + + DO j = 1, en + DO k = 1, pn + IF (Edge % NodeIndexes(j) == Element % NodeIndexes(k)) THEN + x(j) = Element % TYPE % NodeU(k) + y(j) = Element % TYPE % NodeV(k) + z(j) = Element % TYPE % NodeW(k) + EXIT + END IF + END DO + END DO + + u = SUM(EdgeBasis(1:en) * x(1:en)) + v = SUM(EdgeBasis(1:en) * y(1:en)) + w = SUM(EdgeBasis(1:en) * z(1:en)) + ! + ! Get parent element basis & derivatives at the integration point: + ! ----------------------------------------------------------------- + nd = GetElementDOFs(Indexes, Element) + Nodes % x(1:nd) = Mesh % Nodes % x(Indexes(1:nd)) + Nodes % y(1:nd) = Mesh % Nodes % y(Indexes(1:nd)) + Nodes % z(1:nd) = Mesh % Nodes % z(Indexes(1:nd)) + + stat = ElementInfo(Element, Nodes, u, v, w, detJ, Basis, dBasisdx) + ! + ! Material parameters: + ! -------------------- + k = ListGetInteger(Model % Bodies( & + Element % BodyId) % Values, 'Material', & + minv=1, maxv=Model % NumberOFMaterials) + + Material => Model % Materials(k) % Values + CALL ListGetRealArray(Material, & + 'Electric Conductivity', Hwrk, en, Edge % NodeIndexes, stat) + IF (.NOT. stat) & + CALL Fatal('CurrentEdgeResidual:', 'Electric Conductivity not found') + + NodalConductivity(1:en) = Hwrk(1, 1, 1:en) + Conductivity = SUM(NodalConductivity(1:en) * EdgeBasis(1:en)) + ! + ! Potential at element nodal points: + ! ------------------------------------ + Potential(1:nd) = Quant(Perm(Indexes(1:nd))) + ! + ! Finally, the flux: + ! ------------------ + DO j = 1, dim + Grad(j, i) = Conductivity * SUM(dBasisdx(1:nd, j) * Potential(1:nd)) + END DO + END DO + + ! Compute square of the flux jump: + ! ------------------------------- + EdgeLength = EdgeLength + s + Jump = 0.0d0 + DO k = 1, dim + IF (CurrentCoordinateSystem() == Cartesian) THEN + Jump = Jump + (Grad(k, 1) - Grad(k, 2)) * Normal(k) + ELSE + DO l = 1, dim + Jump = Jump + & + Metric(k, l) * (Grad(k, 1) - Grad(k, 2)) * Normal(l) + END DO + END IF + END DO + ResidualNorm = ResidualNorm + s * Jump**2 + END DO + + IF (dim == 3) EdgeLength = SQRT(EdgeLength) + Indicator = EdgeLength * ResidualNorm + + DEALLOCATE (Nodes % x, Nodes % y, Nodes % z) + + DEALLOCATE (EdgeNodes % x, EdgeNodes % y, EdgeNodes % z) + DEALLOCATE (x, y, z, NodalConductivity, EdgeBasis, & + Basis, dBasisdx, Potential) + !------------------------------------------------------------------------------ + END FUNCTION ElectricEdgeResidual + !------------------------------------------------------------------------------ + + + FUNCTION ElectricInsideResidual(Model, Element, Mesh, Quant, Perm, Fnorm) RESULT(Indicator) + !------------------------------------------------------------------------------ + USE DefUtils + !------------------------------------------------------------------------------ + IMPLICIT NONE + !------------------------------------------------------------------------------ + TYPE(Model_t) :: Model + INTEGER :: Perm(:) + REAL(KIND=dp) :: Quant(:), Indicator(2), Fnorm + TYPE(Mesh_t), POINTER :: Mesh + TYPE(Element_t), POINTER :: Element + !------------------------------------------------------------------------------ + TYPE(Nodes_t) :: Nodes + INTEGER :: i, j, k, l, n, t, dim, nd + INTEGER, ALLOCATABLE :: Indexes(:) + LOGICAL :: stat, Found + TYPE(Variable_t), POINTER :: Var + REAL(KIND=dp), POINTER :: Hwrk(:, :, :) + REAL(KIND=dp) :: SqrtMetric, Metric(3, 3), Symb(3, 3, 3), dSymb(3, 3, 3, 3) + REAL(KIND=dp), ALLOCATABLE :: NodalConductivity(:) + REAL(KIND=dp), ALLOCATABLE :: NodalSource(:), Potential(:), PrevPot(:) + REAL(KIND=dp), ALLOCATABLE :: Basis(:), dBasisdx(:, :), ddBasisddx(:, :, :) + REAL(KIND=dp) :: u, v, w, s, detJ + REAL(KIND=dp) :: Conductivity, dt + REAL(KIND=dp) :: Residual, ResidualNorm, Area + TYPE(ValueList_t), POINTER :: Material + TYPE(GaussIntegrationPoints_t), TARGET :: IntegStuff + + LOGICAL :: First = .TRUE. + SAVE Hwrk, First + !------------------------------------------------------------------------------ + + ! Initialize: + ! ----------- + Indicator = 0.0d0 + Fnorm = 0.0d0 + ! + ! Check if this eq. computed in this element: + ! ------------------------------------------- + IF (ANY(Perm(Element % NodeIndexes) <= 0)) RETURN + + IF (First) THEN + First = .FALSE. + NULLIFY (Hwrk) + END IF + + Metric = 0.0d0 + DO i = 1, 3 + Metric(i, i) = 1.0d0 + END DO + + SELECT CASE (CurrentCoordinateSystem()) + CASE (AxisSymmetric, CylindricSymmetric) + dim = 3 + CASE DEFAULT + dim = CoordinateSystemDimension() + END SELECT + + ! Allocate local arrays + ! ---------------------- + nd = GetElementNOFDOFs(Element) + n = GetElementNOFNodes(Element) + ALLOCATE (NodalConductivity(nd), & + PrevPot(nd), NodalSource(nd), Potential(nd), & + Basis(nd), dBasisdx(nd, 3), ddBasisddx(nd, 3, 3), Indexes(nd)) + ! + ! Element nodal points: + ! --------------------- + ALLOCATE (Nodes % x(nd), Nodes % y(nd), Nodes % z(nd)) + + nd = GetElementDOFs(Indexes, Element) + Nodes % x = Mesh % Nodes % x(Indexes(1:nd)) + Nodes % y = Mesh % Nodes % y(Indexes(1:nd)) + Nodes % z = Mesh % Nodes % z(Indexes(1:nd)) + ! + ! Elementwise nodal solution: + ! --------------------------- + Potential(1:nd) = Quant(Perm(Indexes(1:nd))) + ! + ! Check for time dep. + ! ------------------- + PrevPot(1:nd) = Potential(1:nd) + dt = Model % Solver % dt + IF (ListGetString(Model % Simulation, 'Simulation Type') == 'transient') THEN + Var => VariableGet(Model % Variables, 'Potential', .TRUE.) + PrevPot(1:nd) = Var % PrevValues(Var % Perm(Indexes(1:nd)), 1) + END IF + ! + ! Material parameters: conductivity + ! --------------------------------- + k = ListGetInteger(Model % Bodies(Element % BodyId) % Values, 'Material', & + minv=1, maxv=Model % NumberOfMaterials) + + Material => Model % Materials(k) % Values + + CALL ListGetRealArray(Material, 'Electric Conductivity', Hwrk, n, Element % NodeIndexes, stat) + IF (.NOT. stat) THEN + CALL Fatal('CurrentInsideResidual:', 'Electric Conductivity not found') + END IF + NodalConductivity(1:n) = Hwrk(1, 1, 1:n) + + ! + ! Current source density (source): + ! -------------------------------- + ! + k = ListGetInteger( & + Model % Bodies(Element % BodyId) % Values, 'Body Force', Found, & + 1, Model % NumberOFBodyForces) + + NodalSource = 0.0d0 + IF (Found .AND. k > 0) THEN + NodalSource(1:n) = ListGetReal(Model % BodyForces(k) % Values, & + 'Current Source', n, Element % NodeIndexes, stat) + IF (.NOT. stat) & + NodalSource(1:n) = ListGetReal(Model % BodyForces(k) % Values, & + 'Source', n, Element % NodeIndexes) + END IF + + ! + ! Integrate square of residual over element: + ! ------------------------------------------ + + ResidualNorm = 0.0d0 + Area = 0.0d0 + + IntegStuff = GaussPoints(Element) + ddBasisddx = 0 + + DO t = 1, IntegStuff % n + u = IntegStuff % u(t) + v = IntegStuff % v(t) + w = IntegStuff % w(t) + + stat = ElementInfo(Element, Nodes, u, v, w, detJ, & + Basis, dBasisdx, ddBasisddx, .TRUE., .FALSE.) + + IF (CurrentCoordinateSystem() == Cartesian) THEN + s = IntegStuff % s(t) * detJ + ELSE + u = SUM(Basis(1:nd) * Nodes % x(1:nd)) + v = SUM(Basis(1:nd) * Nodes % y(1:nd)) + w = SUM(Basis(1:nd) * Nodes % z(1:nd)) + + CALL CoordinateSystemInfo(Metric, SqrtMetric, & + Symb, dSymb, u, v, w) + s = IntegStuff % s(t) * detJ * SqrtMetric + END IF + + Conductivity = SUM(NodalConductivity(1:n) * Basis(1:n)) + ! + ! Residual of the current conservation equation: + ! + ! R = -div(σ grad(u)) - s + ! --------------------------------------------------- + ! + ! or more generally: + ! + ! R = -g^{jk} (σ u_{,j}}_{,k}) - s + ! --------------------------------------------------- + ! + Residual = -SUM(NodalSource(1:n) * Basis(1:n)) + + IF (CurrentCoordinateSystem() == Cartesian) THEN + DO j = 1, dim + ! + ! - grad(σ).grad(u): + ! ------------------- + Residual = Residual - & + SUM(Potential(1:nd) * dBasisdx(1:nd, j)) * & + SUM(NodalConductivity(1:n) * dBasisdx(1:n, j)) + + ! + ! - σ div(grad(u)): + ! ------------------ + Residual = Residual - Conductivity * & + SUM(Potential(1:nd) * ddBasisddx(1:nd, j, j)) + END DO + ELSE + DO j = 1, dim + DO k = 1, dim + ! + ! - g^{jk} σ_{,k} u_{,j}: + ! ------------------------ + Residual = Residual - Metric(j, k) * & + SUM(Potential(1:nd) * dBasisdx(1:nd, j)) * & + SUM(NodalConductivity(1:n) * dBasisdx(1:n, k)) + + ! + ! - g^{jk} σ u_{,jk}: + ! -------------------- + Residual = Residual - Metric(j, k) * Conductivity * & + SUM(Potential(1:nd) * ddBasisddx(1:nd, j, k)) + ! + ! + g^{jk} σ Γ_{jk}^l u_{,l}: + ! ---------------------------- + DO l = 1, dim + Residual = Residual + Metric(j, k) * Conductivity * & + Symb(j, k, l) * SUM(Potential(1:nd) * dBasisdx(1:nd, l)) + END DO + END DO + END DO + END IF + + ! + ! Compute also force norm for scaling the residual: + ! ------------------------------------------------- + DO i = 1, dim + Fnorm = Fnorm + s * (SUM(NodalSource(1:n) * Basis(1:n)))**2 + END DO + Area = Area + s + ResidualNorm = ResidualNorm + s * Residual**2 + END DO + + ! Fnorm = Element % hk**2 * Fnorm + Indicator = Element % hK**2 * ResidualNorm + !------------------------------------------------------------------------------ + END FUNCTION ElectricInsideResidual + !------------------------------------------------------------------------------ + + + !------------------------------------------------------------------------------ + FUNCTION StatCurrentSolver_boundary_residual(Model, Edge, Mesh, Quant, Perm, Gnorm) RESULT(Indicator) + !------------------------------------------------------------------------------ + USE DefUtils + IMPLICIT NONE + !------------------------------------------------------------------------------ + TYPE(Model_t) :: Model + INTEGER :: Perm(:) + REAL(KIND=dp) :: Quant(:), Indicator(2), Gnorm + TYPE(Mesh_t), POINTER :: Mesh + TYPE(Element_t), POINTER :: Edge + !------------------------------------------------------------------------------ + TYPE(Nodes_t) :: Nodes, EdgeNodes + TYPE(Element_t), POINTER :: Element + INTEGER :: i, j, k, n, l, t, dim, Pn, En, nd + LOGICAL :: stat, Found + INTEGER, ALLOCATABLE :: Indexes(:) + REAL(KIND=dp), POINTER :: Hwrk(:, :, :) + REAL(KIND=dp) :: SqrtMetric, Metric(3, 3), Symb(3, 3, 3), dSymb(3, 3, 3, 3) + REAL(KIND=dp), ALLOCATABLE :: NodalConductivity(:), & + EdgeBasis(:), Basis(:), x(:), y(:), z(:), & + dBasisdx(:, :), Potential(:), Flux(:) + REAL(KIND=dp) :: Normal(3), EdgeLength, gx, gy, gz, Conductivity + REAL(KIND=dp) :: u, v, w, s, detJ + REAL(KIND=dp) :: Residual, ResidualNorm + TYPE(GaussIntegrationPoints_t), TARGET :: IntegStuff + LOGICAL :: First = .TRUE., Dirichlet + SAVE Hwrk, First + !------------------------------------------------------------------------------ + + ! Initialize: + ! ----------- + IF (First) THEN + First = .FALSE. + NULLIFY (Hwrk) + END IF + + Indicator = 0.0d0 + Gnorm = 0.0d0 + + Metric = 0.0d0 + DO i = 1, 3 + Metric(i, i) = 1.0d0 + END DO + + SELECT CASE (CurrentCoordinateSystem()) + CASE (AxisSymmetric, CylindricSymmetric) + dim = 3 + CASE DEFAULT + dim = CoordinateSystemDimension() + END SELECT + ! + ! --------------------------------------------- + + Element => Edge % BoundaryInfo % Left + + IF (.NOT. ASSOCIATED(Element)) THEN + Element => Edge % BoundaryInfo % Right + ELSE IF (ANY(Perm(Element % NodeIndexes) <= 0)) THEN + Element => Edge % BoundaryInfo % Right + END IF + + IF (.NOT. ASSOCIATED(Element)) RETURN + IF (ANY(Perm(Element % NodeIndexes) <= 0)) RETURN + + en = Edge % TYPE % NumberOfNodes + pn = Element % TYPE % NumberOfNodes + + ALLOCATE (EdgeNodes % x(en), EdgeNodes % y(en), EdgeNodes % z(en)) + + EdgeNodes % x = Mesh % Nodes % x(Edge % NodeIndexes) + EdgeNodes % y = Mesh % Nodes % y(Edge % NodeIndexes) + EdgeNodes % z = Mesh % Nodes % z(Edge % NodeIndexes) + + nd = GetElementNOFDOFs(Element) + ALLOCATE (Potential(nd), Basis(nd), & + x(en), y(en), z(en), EdgeBasis(nd), & + dBasisdx(nd, 3), NodalConductivity(nd), Flux(nd), & + Indexes(nd)) + + nd = GetElementDOFs(Indexes, Element) + + ALLOCATE (Nodes % x(nd), Nodes % y(nd), Nodes % z(nd)) + Nodes % x(1:nd) = Mesh % Nodes % x(Indexes(1:nd)) + Nodes % y(1:nd) = Mesh % Nodes % y(Indexes(1:nd)) + Nodes % z(1:nd) = Mesh % Nodes % z(Indexes(1:nd)) + + DO l = 1, en + DO k = 1, pn + IF (Edge % NodeIndexes(l) == Element % NodeIndexes(k)) THEN + x(l) = Element % TYPE % NodeU(k) + y(l) = Element % TYPE % NodeV(k) + z(l) = Element % TYPE % NodeW(k) + EXIT + END IF + END DO + END DO + ! + ! Integrate square of residual over boundary element: + ! --------------------------------------------------- + + Indicator = 0.0d0 + EdgeLength = 0.0d0 + ResidualNorm = 0.0d0 + + DO j = 1, Model % NumberOfBCs + IF (Edge % BoundaryInfo % Constraint /= Model % BCs(j) % Tag) CYCLE + + ! + ! Check if dirichlet BC given: + ! ---------------------------- + Dirichlet = ListCheckPresent(Model % BCs(j) % Values, & + ComponentName(Model % Solver % Variable)) + IF (.NOT. Dirichlet) THEN + Dirichlet = ListCheckPrefix(Model % BCs(j) % Values, & + 'Constraint Mode') + END IF + ! TODO s = ListGetConstReal( Model % BCs(j) % Values,'Potential',Dirichlet ) + + ! Get various flux bc options: + ! ---------------------------- + + ! ...given flux: + ! -------------- + Flux(1:en) = ListGetReal(Model % BCs(j) % Values, & + 'Electric Flux', en, Edge % NodeIndexes, Found) + + ! get material parameters: + ! ------------------------ + k = ListGetInteger(Model % Bodies(Element % BodyId) % Values, 'Material', & + minv=1, maxv=Model % NumberOFMaterials) + + CALL ListGetRealArray(Model % Materials(k) % Values, & + 'Electric Conductivity', Hwrk, en, Edge % NodeIndexes, stat) + IF (.NOT. stat) THEN + CALL Fatal('StatCurrentSolver_boundary_residual:','Electric Conductivity not found') + END IF + NodalConductivity(1:en) = Hwrk(1, 1, 1:en) + + ! elementwise nodal solution: + ! --------------------------- + nd = GetElementDOFs(Indexes, Element) + Potential(1:nd) = Quant(Perm(Indexes(1:nd))) + + ! do the integration: + ! ------------------- + EdgeLength = 0.0d0 + ResidualNorm = 0.0d0 + + IntegStuff = GaussPoints(Edge) + + DO t = 1, IntegStuff % n + u = IntegStuff % u(t) + v = IntegStuff % v(t) + w = IntegStuff % w(t) + + stat = ElementInfo(Edge, EdgeNodes, u, v, w, detJ, & + EdgeBasis, dBasisdx) + Normal = NormalVector(Edge, EdgeNodes, u, v, .TRUE.) + + IF (CurrentCoordinateSystem() == Cartesian) THEN + s = IntegStuff % s(t) * detJ + ELSE + gx = SUM(EdgeBasis(1:en) * EdgeNodes % x(1:en)) + gy = SUM(EdgeBasis(1:en) * EdgeNodes % y(1:en)) + gz = SUM(EdgeBasis(1:en) * EdgeNodes % z(1:en)) + CALL CoordinateSystemInfo(Metric, SqrtMetric, & + Symb, dSymb, gx, gy, gz) + s = IntegStuff % s(t) * detJ * SqrtMetric + END IF + + ! + ! Integration point in parent element local + ! coordinates: + ! ----------------------------------------- + u = SUM(EdgeBasis(1:en) * x(1:en)) + v = SUM(EdgeBasis(1:en) * y(1:en)) + w = SUM(EdgeBasis(1:en) * z(1:en)) + stat = ElementInfo(Element, Nodes, u, v, w, detJ, Basis, dBasisdx) + + ! + ! Conductivity at the integration point: + ! -------------------------------------- + Conductivity = SUM(NodalConductivity(1:en) * EdgeBasis(1:en)) + ! + ! given flux at integration point: + ! -------------------------------- + Residual = -SUM(Flux(1:en) * EdgeBasis(1:en)) + + ! flux given by the computed solution, and + ! force norm for scaling the residual: + ! ----------------------------------------- + IF (CurrentCoordinateSystem() == Cartesian) THEN + DO k = 1, dim + Residual = Residual + Conductivity * & + SUM(dBasisdx(1:nd, k) * Potential(1:nd)) * Normal(k) + + Gnorm = Gnorm + s * (Conductivity * & + SUM(dBasisdx(1:nd, k) * Potential(1:nd)) * Normal(k))**2 + END DO + ELSE + DO k = 1, dim + DO l = 1, dim + Residual = Residual + Metric(k, l) * Conductivity * & + SUM(dBasisdx(1:nd, k) * Potential(1:nd)) * Normal(l) + + Gnorm = Gnorm + s * (Metric(k, l) * Conductivity * & + SUM(dBasisdx(1:nd, k) * Potential(1:nd)) * Normal(l))**2 + END DO + END DO + END IF + + EdgeLength = EdgeLength + s + IF (.NOT. Dirichlet) THEN + ResidualNorm = ResidualNorm + s * Residual**2 + END IF + END DO + EXIT + END DO + + IF (CoordinateSystemDimension() == 3) EdgeLength = SQRT(EdgeLength) + + ! Gnorm = EdgeLength * Gnorm + Indicator = EdgeLength * ResidualNorm + !------------------------------------------------------------------------------ + END FUNCTION StatCurrentSolver_boundary_residual + !------------------------------------------------------------------------------ + + + FUNCTION StatCurrentSolver_edge_residual(Model, Edge, Mesh, Quant, Perm) RESULT(Indicator) + !------------------------------------------------------------------------------ + USE DefUtils + IMPLICIT NONE + + TYPE(Model_t) :: Model + INTEGER :: Perm(:) + REAL(KIND=dp) :: Quant(:), Indicator(2) + TYPE(Mesh_t), POINTER :: Mesh + TYPE(Element_t), POINTER :: Edge + !------------------------------------------------------------------------------ + TYPE(Nodes_t) :: Nodes, EdgeNodes + TYPE(Element_t), POINTER :: Element + INTEGER :: i, j, k, l, n, t, dim, En, Pn, nd + INTEGER, ALLOCATABLE :: Indexes(:) + LOGICAL :: stat + REAL(KIND=dp), POINTER :: Hwrk(:, :, :) + REAL(KIND=dp) :: SqrtMetric, Metric(3, 3), Symb(3, 3, 3), dSymb(3, 3, 3, 3) + REAL(KIND=dp) :: Conductivity + REAL(KIND=dp) :: u, v, w, s, detJ + REAL(KIND=dp) :: Grad(3, 3), Normal(3), EdgeLength, Jump + REAL(KIND=dp), ALLOCATABLE :: NodalConductivity(:), x(:), y(:), z(:), EdgeBasis(:), & + Basis(:), dBasisdx(:, :), Potential(:) + REAL(KIND=dp) :: ResidualNorm + TYPE(GaussIntegrationPoints_t), TARGET :: IntegStuff + TYPE(ValueList_t), POINTER :: Material + + LOGICAL :: First = .TRUE. + SAVE Hwrk, First + !------------------------------------------------------------------------------ + + ! Initialize: + ! ----------- + IF (First) THEN + First = .FALSE. + NULLIFY (Hwrk) + END IF + + SELECT CASE (CurrentCoordinateSystem()) + CASE (AxisSymmetric, CylindricSymmetric) + dim = 3 + CASE DEFAULT + dim = CoordinateSystemDimension() + END SELECT + + Metric = 0.0d0 + DO i = 1, 3 + Metric(i, i) = 1.0d0 + END DO + Grad = 0.0d0 + ! + ! --------------------------------------------- + + n = Mesh % MaxElementDOFs + ALLOCATE (Nodes % x(n), Nodes % y(n), Nodes % z(n)) + + en = Edge % TYPE % NumberOfNodes + ALLOCATE (EdgeNodes % x(en), EdgeNodes % y(en), EdgeNodes % z(en)) + + EdgeNodes % x = Mesh % Nodes % x(Edge % NodeIndexes) + EdgeNodes % y = Mesh % Nodes % y(Edge % NodeIndexes) + EdgeNodes % z = Mesh % Nodes % z(Edge % NodeIndexes) + + ALLOCATE (NodalConductivity(en), EdgeBasis(en), Basis(n), & + dBasisdx(n, 3), x(en), y(en), z(en), Potential(n), Indexes(n)) + + ! Integrate square of jump over edge: + ! ----------------------------------- + ResidualNorm = 0.0d0 + EdgeLength = 0.0d0 + Indicator = 0.0d0 + + IntegStuff = GaussPoints(Edge) + + DO t = 1, IntegStuff % n + + u = IntegStuff % u(t) + v = IntegStuff % v(t) + w = IntegStuff % w(t) + + stat = ElementInfo(Edge, EdgeNodes, u, v, w, detJ, & + EdgeBasis, dBasisdx) + + Normal = NormalVector(Edge, EdgeNodes, u, v, .FALSE.) + + IF (CurrentCoordinateSystem() == Cartesian) THEN + s = IntegStuff % s(t) * detJ + ELSE + u = SUM(EdgeBasis(1:en) * EdgeNodes % x(1:en)) + v = SUM(EdgeBasis(1:en) * EdgeNodes % y(1:en)) + w = SUM(EdgeBasis(1:en) * EdgeNodes % z(1:en)) + + CALL CoordinateSystemInfo(Metric, SqrtMetric, & + Symb, dSymb, u, v, w) + s = IntegStuff % s(t) * detJ * SqrtMetric + END IF + + ! + ! Compute flux over the edge as seen by elements + ! on both sides of the edge: + ! ---------------------------------------------- + DO i = 1, 2 + SELECT CASE (i) + CASE (1) + Element => Edge % BoundaryInfo % Left + CASE (2) + Element => Edge % BoundaryInfo % Right + END SELECT + ! + ! Can this really happen (maybe it can...) ? + ! ------------------------------------------- + IF (.NOT. ASSOCIATED(Element)) CYCLE + IF (ANY(Perm(Element % NodeIndexes) <= 0)) CYCLE + ! + ! Next, get the integration point in parent + ! local coordinates: + ! ----------------------------------------- + pn = Element % TYPE % NumberOfNodes + + DO j = 1, en + DO k = 1, pn + IF (Edge % NodeIndexes(j) == Element % NodeIndexes(k)) THEN + x(j) = Element % TYPE % NodeU(k) + y(j) = Element % TYPE % NodeV(k) + z(j) = Element % TYPE % NodeW(k) + EXIT + END IF + END DO + END DO + + u = SUM(EdgeBasis(1:en) * x(1:en)) + v = SUM(EdgeBasis(1:en) * y(1:en)) + w = SUM(EdgeBasis(1:en) * z(1:en)) + ! + ! Get parent element basis & derivatives at the integration point: + ! ----------------------------------------------------------------- + nd = GetElementDOFs(Indexes, Element) + Nodes % x(1:nd) = Mesh % Nodes % x(Indexes(1:nd)) + Nodes % y(1:nd) = Mesh % Nodes % y(Indexes(1:nd)) + Nodes % z(1:nd) = Mesh % Nodes % z(Indexes(1:nd)) + + stat = ElementInfo(Element, Nodes, u, v, w, detJ, Basis, dBasisdx) + ! + ! Material parameters: + ! -------------------- + k = ListGetInteger(Model % Bodies( & + Element % BodyId) % Values, 'Material', & + minv=1, maxv=Model % NumberOFMaterials) + + Material => Model % Materials(k) % Values + CALL ListGetRealArray(Material, & + 'Electric Conductivity', Hwrk, en, Edge % NodeIndexes, stat) + IF (.NOT. stat) THEN + CALL Fatal('StatCurrentSolver_edge_residual:', 'Electric Conductivity not found') + END IF + + NodalConductivity(1:en) = Hwrk(1, 1, 1:en) + Conductivity = SUM(NodalConductivity(1:en) * EdgeBasis(1:en)) + ! + ! Potential at element nodal points: + ! ------------------------------------ + Potential(1:nd) = Quant(Perm(Indexes(1:nd))) + ! + ! Finally, the flux: + ! ------------------ + DO j = 1, dim + Grad(j, i) = Conductivity * SUM(dBasisdx(1:nd, j) * Potential(1:nd)) + END DO + END DO + + ! Compute square of the flux jump: + ! ------------------------------- + EdgeLength = EdgeLength + s + Jump = 0.0d0 + DO k = 1, dim + IF (CurrentCoordinateSystem() == Cartesian) THEN + Jump = Jump + (Grad(k, 1) - Grad(k, 2)) * Normal(k) + ELSE + DO l = 1, dim + Jump = Jump + & + Metric(k, l) * (Grad(k, 1) - Grad(k, 2)) * Normal(l) + END DO + END IF + END DO + ResidualNorm = ResidualNorm + s * Jump**2 + END DO + + IF (dim == 3) EdgeLength = SQRT(EdgeLength) + Indicator = EdgeLength * ResidualNorm + + DEALLOCATE (Nodes % x, Nodes % y, Nodes % z) + + DEALLOCATE (EdgeNodes % x, EdgeNodes % y, EdgeNodes % z) + DEALLOCATE (x, y, z, NodalConductivity, EdgeBasis, & + Basis, dBasisdx, Potential) + !------------------------------------------------------------------------------ + END FUNCTION StatCurrentSolver_edge_residual + !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ + FUNCTION StatCurrentSolver_inside_residual(Model, Element, Mesh, Quant, Perm, Fnorm) RESULT(Indicator) + !------------------------------------------------------------------------------ + USE DefUtils + !------------------------------------------------------------------------------ + IMPLICIT NONE + !------------------------------------------------------------------------------ + TYPE(Model_t) :: Model + INTEGER :: Perm(:) + REAL(KIND=dp) :: Quant(:), Indicator(2), Fnorm + TYPE(Mesh_t), POINTER :: Mesh + TYPE(Element_t), POINTER :: Element + !------------------------------------------------------------------------------ + TYPE(Nodes_t) :: Nodes + INTEGER :: i, j, k, l, n, t, dim, nd + INTEGER, ALLOCATABLE :: Indexes(:) + LOGICAL :: stat, Found + TYPE(Variable_t), POINTER :: Var + REAL(KIND=dp), POINTER :: Hwrk(:, :, :) + REAL(KIND=dp) :: SqrtMetric, Metric(3, 3), Symb(3, 3, 3), dSymb(3, 3, 3, 3) + REAL(KIND=dp), ALLOCATABLE :: NodalConductivity(:) + REAL(KIND=dp), ALLOCATABLE :: NodalSource(:), Potential(:), PrevPot(:) + REAL(KIND=dp), ALLOCATABLE :: Basis(:), dBasisdx(:, :), ddBasisddx(:, :, :) + REAL(KIND=dp) :: u, v, w, s, detJ + REAL(KIND=dp) :: Conductivity, dt + REAL(KIND=dp) :: Residual, ResidualNorm, Area + TYPE(ValueList_t), POINTER :: Material + TYPE(GaussIntegrationPoints_t), TARGET :: IntegStuff + + LOGICAL :: First = .TRUE. + SAVE Hwrk, First + !------------------------------------------------------------------------------ + + ! Initialize: + ! ----------- + Indicator = 0.0d0 + Fnorm = 0.0d0 + ! + ! Check if this eq. computed in this element: + ! ------------------------------------------- + IF (ANY(Perm(Element % NodeIndexes) <= 0)) RETURN + + IF (First) THEN + First = .FALSE. + NULLIFY (Hwrk) + END IF + + Metric = 0.0d0 + DO i = 1, 3 + Metric(i, i) = 1.0d0 + END DO + + SELECT CASE (CurrentCoordinateSystem()) + CASE (AxisSymmetric, CylindricSymmetric) + dim = 3 + CASE DEFAULT + dim = CoordinateSystemDimension() + END SELECT + + ! Allocate local arrays + ! ---------------------- + nd = GetElementNOFDOFs(Element) + n = GetElementNOFNodes(Element) + ALLOCATE (NodalConductivity(nd), & + PrevPot(nd), NodalSource(nd), Potential(nd), & + Basis(nd), dBasisdx(nd, 3), ddBasisddx(nd, 3, 3), Indexes(nd)) + ! + ! Element nodal points: + ! --------------------- + ALLOCATE (Nodes % x(nd), Nodes % y(nd), Nodes % z(nd)) + + nd = GetElementDOFs(Indexes, Element) + Nodes % x = Mesh % Nodes % x(Indexes(1:nd)) + Nodes % y = Mesh % Nodes % y(Indexes(1:nd)) + Nodes % z = Mesh % Nodes % z(Indexes(1:nd)) + ! + ! Elementwise nodal solution: + ! --------------------------- + Potential(1:nd) = Quant(Perm(Indexes(1:nd))) + ! + ! Check for time dep. + ! ------------------- + PrevPot(1:nd) = Potential(1:nd) + dt = Model % Solver % dt + IF (ListGetString(Model % Simulation, 'Simulation Type') == 'transient') THEN + Var => VariableGet(Model % Variables, 'Potential', .TRUE.) + PrevPot(1:nd) = Var % PrevValues(Var % Perm(Indexes(1:nd)), 1) + END IF + ! + ! Material parameters: conductivity + ! --------------------------------- + k = ListGetInteger(Model % Bodies(Element % BodyId) % Values, 'Material', & + minv=1, maxv=Model % NumberOfMaterials) + + Material => Model % Materials(k) % Values + + CALL ListGetRealArray(Material, 'Electric Conductivity', Hwrk, n, Element % NodeIndexes, stat) + IF (.NOT. stat) THEN + CALL Fatal('StatCurrentSolver_inside_residual:', 'Electric Conductivity not found') + END IF + NodalConductivity(1:n) = Hwrk(1, 1, 1:n) + + ! + ! Current source density (source): + ! -------------------------------- + ! + k = ListGetInteger( & + Model % Bodies(Element % BodyId) % Values, 'Body Force', Found, & + 1, Model % NumberOFBodyForces) + + NodalSource = 0.0d0 + IF (Found .AND. k > 0) THEN + NodalSource(1:n) = ListGetReal(Model % BodyForces(k) % Values, & + 'Current Source', n, Element % NodeIndexes, stat) + IF (.NOT. stat) & + NodalSource(1:n) = ListGetReal(Model % BodyForces(k) % Values, & + 'Source', n, Element % NodeIndexes) + END IF + + ! + ! Integrate square of residual over element: + ! ------------------------------------------ + + ResidualNorm = 0.0d0 + Area = 0.0d0 + + IntegStuff = GaussPoints(Element) + ddBasisddx = 0 + + DO t = 1, IntegStuff % n + u = IntegStuff % u(t) + v = IntegStuff % v(t) + w = IntegStuff % w(t) + + stat = ElementInfo(Element, Nodes, u, v, w, detJ, & + Basis, dBasisdx, ddBasisddx, .TRUE., .FALSE.) + + IF (CurrentCoordinateSystem() == Cartesian) THEN + s = IntegStuff % s(t) * detJ + ELSE + u = SUM(Basis(1:nd) * Nodes % x(1:nd)) + v = SUM(Basis(1:nd) * Nodes % y(1:nd)) + w = SUM(Basis(1:nd) * Nodes % z(1:nd)) + + CALL CoordinateSystemInfo(Metric, SqrtMetric, & + Symb, dSymb, u, v, w) + s = IntegStuff % s(t) * detJ * SqrtMetric + END IF + + Conductivity = SUM(NodalConductivity(1:n) * Basis(1:n)) + ! + ! Residual of the current conservation equation: + ! + ! R = -div(σ grad(u)) - s + ! --------------------------------------------------- + ! + ! or more generally: + ! + ! R = -g^{jk} (σ u_{,j}}_{,k}) - s + ! --------------------------------------------------- + ! + Residual = -SUM(NodalSource(1:n) * Basis(1:n)) + + IF (CurrentCoordinateSystem() == Cartesian) THEN + DO j = 1, dim + ! + ! - grad(σ).grad(u): + ! ------------------- + Residual = Residual - & + SUM(Potential(1:nd) * dBasisdx(1:nd, j)) * & + SUM(NodalConductivity(1:n) * dBasisdx(1:n, j)) + + ! + ! - σ div(grad(u)): + ! ------------------ + Residual = Residual - Conductivity * & + SUM(Potential(1:nd) * ddBasisddx(1:nd, j, j)) + END DO + ELSE + DO j = 1, dim + DO k = 1, dim + ! + ! - g^{jk} σ_{,k} u_{,j}: + ! ------------------------ + Residual = Residual - Metric(j, k) * & + SUM(Potential(1:nd) * dBasisdx(1:nd, j)) * & + SUM(NodalConductivity(1:n) * dBasisdx(1:n, k)) + + ! + ! - g^{jk} σ u_{,jk}: + ! -------------------- + Residual = Residual - Metric(j, k) * Conductivity * & + SUM(Potential(1:nd) * ddBasisddx(1:nd, j, k)) + ! + ! + g^{jk} σ Γ_{jk}^l u_{,l}: + ! ---------------------------- + DO l = 1, dim + Residual = Residual + Metric(j, k) * Conductivity * & + Symb(j, k, l) * SUM(Potential(1:nd) * dBasisdx(1:nd, l)) + END DO + END DO + END DO + END IF + + ! + ! Compute also force norm for scaling the residual: + ! ------------------------------------------------- + DO i = 1, dim + Fnorm = Fnorm + s * (SUM(NodalSource(1:n) * Basis(1:n)))**2 + END DO + Area = Area + s + ResidualNorm = ResidualNorm + s * Residual**2 + END DO + + ! Fnorm = Element % hk**2 * Fnorm + Indicator = Element % hK**2 * ResidualNorm + !------------------------------------------------------------------------------ + END FUNCTION StatCurrentSolver_inside_residual + !------------------------------------------------------------------------------ + + + \ No newline at end of file