diff --git a/.github/workflows/build-macos-homebrew.yaml b/.github/workflows/build-macos-homebrew.yaml index 469aae8ce1..adc52fd0f6 100644 --- a/.github/workflows/build-macos-homebrew.yaml +++ b/.github/workflows/build-macos-homebrew.yaml @@ -35,10 +35,18 @@ jobs: uses: actions/checkout@v4 - name: install dependencies + + # Homebrew's Python conflicts with the Python that comes pre-installed + # on the GitHub runners. Some of the dependencies depend on different + # versions of Homebrew's Python. Enforce using the ones from Homebrew + # to avoid errors on updates. + # See: https://github.com/orgs/Homebrew/discussions/3928 + # It looks like "gfortran" isn't working correctly unless "gcc" is # re-installed. run: | brew update + brew install --overwrite python@3.12 python@3.13 brew reinstall gcc brew install \ cmake libomp openblas open-mpi suitesparse \ diff --git a/.github/workflows/build.yaml b/.github/workflows/build.yaml index 92c4861d38..056fa3ccde 100644 --- a/.github/workflows/build.yaml +++ b/.github/workflows/build.yaml @@ -90,7 +90,8 @@ jobs: libqwt-qt5-dev qtscript5-dev libqt5svg5-dev \ libvtk9-qt-dev libglvnd-dev \ occt-misc libocct-data-exchange-dev libocct-draw-dev \ - $([ "${{ matrix.mpi }}" == "with" ] && echo "trilinos-all-dev libptscotch-dev") + $([ "${{ matrix.mpi }}" == "with" ] && echo "trilinos-all-dev libptscotch-dev") \ + $([ "${{ matrix.mpi }}" == "with" ] && echo "libnetcdff-dev") - name: configure # CHOLMOD and rocALUTION require a working OpenMP package. So, disable them for clang. diff --git a/ElmerGUI/Application/plugins/egconvert.cpp b/ElmerGUI/Application/plugins/egconvert.cpp index 90a93bea5f..3911a7a05b 100644 --- a/ElmerGUI/Application/plugins/egconvert.cpp +++ b/ElmerGUI/Application/plugins/egconvert.cpp @@ -5280,9 +5280,9 @@ int LoadGmshInput(struct FemType *data,struct BoundaryType *bound, } if(strstr(line,"$")) { - int verno,minorno; + int verno,minorno,gmshformat; char *cp; - + Getrow(line,in,FALSE); cp = line; verno = next_int(&cp); @@ -5290,7 +5290,14 @@ int LoadGmshInput(struct FemType *data,struct BoundaryType *bound, minorno = next_int(&cp); if(info) printf("Gmsh version is %d.%d\n",verno,minorno); - + + cp++; + gmshformat = next_int(&cp); + if(gmshformat == 1){ + printf("Error: Gmsh input file is in binary format! Exiting.\n"); + bigerror("Gmsh input file is in binary format!"); + } + fclose(in); if( verno == 4 ) { diff --git a/cmake/Modules/FindNETCDF.cmake b/cmake/Modules/FindNETCDF.cmake index 4c583f49a0..e839448f88 100644 --- a/cmake/Modules/FindNETCDF.cmake +++ b/cmake/Modules/FindNETCDF.cmake @@ -64,7 +64,7 @@ IF (NETCDF_INCLUDE_DIR AND NETCDF_LIBRARY AND NETCDFF_LIBRARY) UNSET(NETCDF_FAILMSG) SET(NETCDFLIB_FOUND TRUE) SET(NETCDF_INCLUDE_DIR ${NETCDF_INCLUDE_DIR}) - SET(NETCDF_LIBRARIES "${NETCDF_LIBRARY};${NETCDFF_LIBRARY}") + SET(NETCDF_LIBRARIES "${NETCDFF_LIBRARY};${NETCDF_LIBRARY}") ELSE() SET(NETCDF_FAILMSG "NETCDF libraries not found.") ENDIF() diff --git a/elmergrid/src/egconvert.c b/elmergrid/src/egconvert.c index 90a93bea5f..3911a7a05b 100644 --- a/elmergrid/src/egconvert.c +++ b/elmergrid/src/egconvert.c @@ -5280,9 +5280,9 @@ int LoadGmshInput(struct FemType *data,struct BoundaryType *bound, } if(strstr(line,"$")) { - int verno,minorno; + int verno,minorno,gmshformat; char *cp; - + Getrow(line,in,FALSE); cp = line; verno = next_int(&cp); @@ -5290,7 +5290,14 @@ int LoadGmshInput(struct FemType *data,struct BoundaryType *bound, minorno = next_int(&cp); if(info) printf("Gmsh version is %d.%d\n",verno,minorno); - + + cp++; + gmshformat = next_int(&cp); + if(gmshformat == 1){ + printf("Error: Gmsh input file is in binary format! Exiting.\n"); + bigerror("Gmsh input file is in binary format!"); + } + fclose(in); if( verno == 4 ) { diff --git a/elmergrid/src/egextra.c b/elmergrid/src/egextra.c index 7a39f671ae..b06f166baf 100644 --- a/elmergrid/src/egextra.c +++ b/elmergrid/src/egextra.c @@ -820,7 +820,111 @@ int SaveSizeInfo(struct FemType *data,struct BoundaryType *bound, return(0); } +int MeshPieces(struct FemType *data,int nomesh,int nomeshes,int info) +{ + int i,j,k,n; + int MinIndex,MaxIndex,NoPieces,NoCorners,Loop,Ready; + int *MeshPiece=NULL,*PiecePerm=NULL; + // Indexes only needs to hold the max number of dofs per element + int Indexes[100]; + + if(nomeshes > 1) { + printf("Calculate Mesh Pieces in mesh[%d] of [%d] meshes:\n",nomesh,nomeshes); + } else { + printf("Calculate Mesh Pieces in mesh:\n"); + } + + n = data->noknots; + MeshPiece = Ivector(1,n); + for(i=1;i<=n;i++) MeshPiece[i] = 0; + + /* Only set the piece for the nodes that are used by some element + For others the marker will remain zero. */ + for(i=1; i<=data->noelements; i++) { + NoCorners = data->elementtypes[i]%100; + for(j=0; jtopology[i][j]] = 1; + } + } + + j = 0; + for(i=1; i<=n; i++) { + if(MeshPiece[i] > 0) { + j++; + MeshPiece[i] = j; + } + } + if( n > j) { + printf("Number of non-body (hanging) nodes in mesh is %d\n", n-j ); + printf("Consider running ElmerGrid with -autoclean command\n"); + } + /* We go through the elements and set all the piece indexes to minimum index + until the mesh is unchanged. Thereafter the whole piece will have the minimum index + of the piece. */ + Ready = FALSE; + Loop = 0; + + while(!Ready) { + Ready = TRUE; + for(i=1; i<=data->noelements; i++) { + MaxIndex = 0; + MinIndex = n; + + NoCorners = data->elementtypes[i]%100; + for(j=0; jtopology[i][j]; + } + for(j=0; j= MeshPiece[Indexes[k]] ) + MinIndex = MeshPiece[Indexes[k]]; + } + if(MaxIndex > MinIndex) { + MeshPiece[Indexes[j]] = MinIndex; + Ready = FALSE; + } + } + } + Loop++; + } +/* printf("Mesh coloring loops: %d\n",Loop); */ + + MaxIndex = 0; + for(i=1; i<=n; i++) + if(MeshPiece[i] > MaxIndex) MaxIndex = MeshPiece[i]; + + /* Compute the true number of different pieces */ + if(MaxIndex == 1) { + NoPieces = 1; + } else { + NoPieces = 0; + PiecePerm = Ivector(1,MaxIndex); + for(i=1;i<=MaxIndex;i++) + PiecePerm[i] = 0; + + for(i=1; i<=n; i++) { + j = MeshPiece[i]; + if( j == 0) continue; + if(PiecePerm[j] == 0) { + NoPieces++; + PiecePerm[j] = NoPieces; + } + } + free_Ivector(PiecePerm,1,MaxIndex); + } + if(NoPieces == 1) { + printf("There is a single piece in the mesh, so the mesh is conforming.\n"); + } else { + printf("Number of separate pieces in mesh is %d\n", NoPieces); + printf("The mesh is non-conforming. If not expecting a non-conforming\n"); + printf("mesh, then refer to the Elmer User Forum for help.\n"); + } + free_Ivector(MeshPiece,1,n); + return(0); +} int SaveElmerInputFemBem(struct FemType *data,struct BoundaryType *bound, char *prefix,int decimals,int info) diff --git a/elmergrid/src/egextra.h b/elmergrid/src/egextra.h index aac36de55d..4219ebe3b8 100644 --- a/elmergrid/src/egextra.h +++ b/elmergrid/src/egextra.h @@ -26,6 +26,7 @@ int SaveSizeInfo(struct FemType *data,struct BoundaryType *bound, char *prefix,int info); int SaveElmerInputFemBem(struct FemType *data,struct BoundaryType *bound, char *prefix,int decimals, int info); +int MeshPieces(struct FemType *data,int nomesh,int nomeshes,int info); void InspectVector(Real *vector,int first,int last,Real *min, Real *max,int *mini,int *maxi); diff --git a/elmergrid/src/fempre.c b/elmergrid/src/fempre.c index c8290c4b12..0f7c3c4aca 100644 --- a/elmergrid/src/fempre.c +++ b/elmergrid/src/fempre.c @@ -784,6 +784,9 @@ int main(int argc, char *argv[]) if(info) for(k=0;kNetCDF_FOUND< ") - MESSAGE(WARNING " \n Missing: >NetCDF_INCLUDE_DIR< , >NetCDF_LIBRARY<, >NetCDFF_LIBRARY< \n some functionalities will be disabled") -ENDIF(NetCDF_FOUND) + MESSAGE(STATUS "Library not found: netCDF ") + MESSAGE(WARNING " \n Missing: , , \n some functionalities will be disabled") +ENDIF() # ---------------------- # # -- HDF5 libraries -- # @@ -60,39 +60,39 @@ ENDIF() SET(CMAKE_Fortran_MODULE_DIRECTORY ${PROJECT_BINARY_DIR}/fmodules CACHE PATH "Directory for Fortran modules") -SET(ElmerIce_SRC ElmerIceUtils.F90 AIFlowSolve_nlD2.F90 AIFlowSolve_nlS2.F90 - CaffeSolver.F90 ComputeDevStress.F90 ComputeEigenValues.F90 - ComputeNormal.F90 ComputeStrainRate.F90 DeformationalHeat.F90 - EPLSolver.F90 FabricSolve.F90 Flowdepth.F90 - ForceToStress.F90 GetHydrostaticLoads.F90 GolfLaw.F90 - GroundedSolver.F90 IntegratedVelocity.F90 IDSSolver.F90 - PorousSolve.F90 pointwise.F90 SIASolver.F90 SSASolver.F90 - ThicknessSolver.F90 TemperateIce.F90 ExportVertically.F90 - AdjointSolver.F90 DJDBeta_Adjoint.F90 DJDmu_Adjoint.F90 - CostSolver_Adjoint.F90 DJDBeta_Robin.F90 DJDmu_Robin.F90 - CostSolver_Robin.F90 m1qn3.F Grid2DInterpolator.F90 +SET(ElmerIce_SRC ElmerIceUtils.F90 AIFlowSolve_nlD2.F90 AIFlowSolve_nlS2.F90 + CaffeSolver.F90 ComputeDevStress.F90 ComputeEigenValues.F90 + ComputeNormal.F90 ComputeStrainRate.F90 DeformationalHeat.F90 + EPLSolver.F90 FabricSolve.F90 Flowdepth.F90 + ForceToStress.F90 GetHydrostaticLoads.F90 GolfLaw.F90 + GroundedSolver.F90 IntegratedVelocity.F90 IDSSolver.F90 + PorousSolve.F90 pointwise.F90 SIASolver.F90 SSASolver.F90 + ThicknessSolver.F90 TemperateIce.F90 ExportVertically.F90 + AdjointSolver.F90 DJDBeta_Adjoint.F90 DJDmu_Adjoint.F90 + CostSolver_Adjoint.F90 DJDBeta_Robin.F90 DJDmu_Robin.F90 + CostSolver_Robin.F90 m1qn3.F Grid2DInterpolator.F90 Optimize_m1qn3Parallel.F90 OutputStrainHeating.F90 UpdateExport.F90 IntegrateVertically.F90 EnthalpySolver.F90 SubShelfMelt.F90 ./Adjoint/Adjoint_LinearSolver.F90 ./Adjoint/Adjoint_CostDiscSolver.F90 - ./Adjoint/Adjoint_CostContSolver.F90 ./Adjoint/Adjoint_CostRegSolver.F90 + ./Adjoint/Adjoint_CostContSolver.F90 ./Adjoint/Adjoint_CostRegSolver.F90 ./Adjoint/Adjoint_GradientValidation.F90 - ./AdjointStokes/AdjointStokes_GradientMu.F90 - ./AdjointStokes/AdjointStokes_GradientBetaSolver.F90 + ./AdjointStokes/AdjointStokes_GradientMu.F90 + ./AdjointStokes/AdjointStokes_GradientBetaSolver.F90 ./AdjointSSA/AdjointSSA_AdjointSolver.F90 ./AdjointSSA/AdjointSSA_CostDiscSolver.F90 ./AdjointSSA/AdjointSSA_CostRegSolver.F90 ./AdjointSSA/AdjointSSA_SSASolver.F90 ./AdjointSSA/AdjointSSA_CostContSolver.F90 ./AdjointSSA/AdjointSSA_CostFluxDivSolver.F90 ./AdjointSSA/AdjointSSA_CostTaubSolver.F90 - ./AdjointSSA/AdjointSSA_GradientSolver.F90 + ./AdjointSSA/AdjointSSA_GradientSolver.F90 ./AdjointThickness/AdjointThickness_GradientSolver.F90 ./AdjointThickness/AdjointThickness_ThicknessSolver.F90 ./Permafrost/PermafrostMaterials.F90 ./Permafrost/Permafrost_Utils.F90 ./Permafrost/Permafrost_HTEQ.F90 ./Permafrost/Permafrost_Darcy.F90 ./Permafrost/Permafrost_solute.F90 ./Permafrost/Permafrost_solid.F90 SurfaceBoundaryEnthalpy.F90 - Calving.F90 FrontDisplacement.F90 - TwoMeshes.F90 ProjectCalving.F90 ComputeCalvingNormal.F90 + Calving.F90 FrontDisplacement.F90 + TwoMeshes.F90 ProjectCalving.F90 ComputeCalvingNormal.F90 CalvingGeometry.F90 Calving3D.F90 Calving3D_lset.F90 CalvingGlacierAdvance3D.F90 CalvingRemesh.F90 - CalvingFrontAdvance3D.F90 Emergence.F90 SSAmask.F90 + CalvingFrontAdvance3D.F90 Emergence.F90 SSAmask.F90 GlaDSCoupledSolver.F90 GlaDSchannelSolver.F90 Flotation.F90 - BasalMelt3D.F90 CalvingHydroInterp.F90 HydroRestart.F90 + BasalMelt3D.F90 CalvingHydroInterp.F90 HydroRestart.F90 GMValid.F90 Scalar_OUTPUT_Glacier.F90 IcyMaskSolver.F90 Weertman2Coulomb.F90) @@ -123,7 +123,7 @@ ENDIF() ADD_LIBRARY(ElmerIceSolvers SHARED ${ElmerIce_SRC}) # Library object -SET_TARGET_PROPERTIES(ElmerIceSolvers PROPERTIES PREFIX "") +SET_TARGET_PROPERTIES(ElmerIceSolvers PROPERTIES PREFIX "") SET_TARGET_PROPERTIES(ElmerIceSolvers PROPERTIES LINKER_LANGUAGE Fortran LIBRARY_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/fem/src/modules @@ -137,7 +137,7 @@ ENDIF() TARGET_LINK_LIBRARIES(ElmerIceSolvers Elmer::MPI_Fortran elmersolver ElmerIceUtils) IF(HAVE_NETCDF) -TARGET_LINK_LIBRARIES(ElmerIceSolvers ${NETCDF_LIBRARIES}) + TARGET_LINK_LIBRARIES(ElmerIceSolvers ${NETCDF_LIBRARIES}) ENDIF() IF(HAVE_HDF5) TARGET_LINK_LIBRARIES(ElmerIceSolvers ${PHDF5_LIBRARIES}) @@ -164,6 +164,6 @@ INSTALL(TARGETS ElmerIceSolvers LIBRARY DESTINATION "share/elmersolver/lib" IF(HAVE_NETCDF) ADD_SUBDIRECTORY(GridDataReader) ENDIF() -IF(WITH_ScatteredDataInterpolator) +IF(WITH_ScatteredDataInterpolator) ADD_SUBDIRECTORY(ScatteredDataInterpolator) ENDIF() diff --git a/elmerice/Tests/FrictionHeatMasked/DummySolver.f90 b/elmerice/Tests/FrictionHeatMasked/DummySolver.f90 index 5965efbe0f..2d4386f238 100644 --- a/elmerice/Tests/FrictionHeatMasked/DummySolver.f90 +++ b/elmerice/Tests/FrictionHeatMasked/DummySolver.f90 @@ -31,6 +31,7 @@ RECURSIVE SUBROUTINE DummySolver( Model,Solver,Timestep,TransientSimulation ) VarPerm => Var % Perm VarDOFs = Var % DOFs VarValues => Var % Values + VarValues = 0.0_dp ELSE CALL FATAL('DummySolver','No Variable associated') END IF @@ -41,13 +42,13 @@ RECURSIVE SUBROUTINE DummySolver( Model,Solver,Timestep,TransientSimulation ) ! VarValues(VarDOFs*(VarPerm(i) - 1)+j) = k ! END DO ! END DO - ! VarValues = 0.0_dp DO t=1, Solver % Mesh % NumberOfBoundaryElements ! get element information Element => GetBoundaryElement(t) IF ( .NOT.ActiveBoundaryElement() ) CYCLE BC => GetBC() n = GetElementNOFNodes() + IF(ANY(VarPerm(Element % NodeIndexes) == 0)) CYCLE VarValues(VarPerm(Element % NodeIndexes)) = ListGetReal(BC,TRIM(Solver % Variable % Name),n,Element % NodeIndexes,GotIt) END DO diff --git a/elmerice/Tests/FrictionHeatMasked/test.sif b/elmerice/Tests/FrictionHeatMasked/test.sif index f5a7e1c8b9..1df978a3d7 100644 --- a/elmerice/Tests/FrictionHeatMasked/test.sif +++ b/elmerice/Tests/FrictionHeatMasked/test.sif @@ -180,6 +180,10 @@ Solver 6 Procedure = File "DummySolver" "DummySolver" Variable = -dofs 1 "Friction Load" Exported Variable 1 = -dofs 1 "Friction Load Mask" + +! This seems to result to NaN for some reason on some platforms. +! So supress it for now. + Exec Solver = never End !creates output diff --git a/fem/src/Adaptive.F90 b/fem/src/Adaptive.F90 index f853ee4a18..47dc161a65 100644 --- a/fem/src/Adaptive.F90 +++ b/fem/src/Adaptive.F90 @@ -50,7 +50,8 @@ MODULE Adaptive USE LoadMod USE MeshUtils USE MeshRemeshing - + USE SaveUtils + IMPLICIT NONE @@ -115,7 +116,7 @@ END FUNCTION InsideResidual LOGICAL :: BandwidthOptimize, Found, Coarsening, GlobalBubbles, & MeshNumbering, DoFinalRef - INTEGER :: MaxDepth, MinDepth, NLen + INTEGER :: MaxDepth, MinDepth, NLen, MeshDim CHARACTER(:), ALLOCATABLE :: Path, VarName REAL(KIND=dp), POINTER :: Time(:), NodalError(:), PrevValues(:), & Hvalue(:), HValue1(:), PrevNodalError(:), PrevHValue(:), hConvergence(:), ptr(:), tt(:) @@ -123,6 +124,9 @@ 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) + SAVE DoFinalRef @@ -1279,114 +1283,197 @@ FUNCTION External_ReMesh( RefMesh, ErrorLimit, HValue, NodalError, & TYPE(Mesh_t), POINTER :: NewMesh, RefMesh !------------------------------------------------------------------------------ TYPE(Mesh_t), POINTER :: Mesh - INTEGER :: i,j,k,n + INTEGER :: i,j,k,n,dim REAL(KIND=dp) :: Lambda + REAL(KIND=dp), POINTER :: HValueF(:) CHARACTER(:), ALLOCATABLE :: MeshCommand, Name, MeshInputFile + LOGICAL :: GmshFormat + LOGICAL :: GmshPosFormat !------------------------------------------------------------------------------ - OPEN( 11, STATUS='UNKNOWN', FILE='bgmesh' ) - WRITE( 11,* ) COUNT( NodalError > 100*AEPS ) + dim = CoordinateSystemDimension() + ! Create a temporal field that includes the desired mesh density where Hvalue has been computed. + ! This is in terms of desired mesh density, currently -1 value is given if the nodal error is zero + ! implying that nothing is computed here. + ALLOCATE(HvalueF(SIZE(HValue))) + HValueF = -1.0_dp 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 ( 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 ( CoordinateSystemDimension() == 2 ) THEN - WRITE(11,'(3e23.15)') RefMesh % Nodes % x(i), & - RefMesh % Nodes % y(i), Lambda - ELSE - WRITE(11,'(4e23.15)') RefMesh % Nodes % x(i), & - RefMesh % Nodes % y(i), & - RefMesh % Nodes % z(i), Lambda - END IF - ELSE - IF ( CoordinateSystemDimension() == 2 ) THEN - WRITE(11,'(3e23.15)') RefMesh % Nodes % x(i), & - RefMesh % Nodes % y(i), HValue(i) - ELSE - WRITE(11,'(4e23.15)') RefMesh % Nodes % x(i), & - RefMesh % Nodes % y(i), & - RefMesh % Nodes % z(i), HValue(i) - END IF - END IF + IF ( maxH > 0 ) Lambda = MIN( Lambda, maxH ) + IF ( minH > 0 ) Lambda = MAX( Lambda, minH ) + HValueF(i) = Lambda + END IF END DO - - WRITE(11,*) 0 - CLOSE(11) + ! Save the current mesh in Elmer mesh format Path = ListGetString( Params, 'Adaptive Mesh Name', Found ) - IF ( .NOT. Found ) Path = 'RefinedMesh' - - i = RefMesh % AdaptiveDepth + 1 nLen = LEN_TRIM(Path) - Path = Path(1:nlen) // I2S(i) + + IF ( .NOT. Found ) THEN + i = RefMesh % AdaptiveDepth + 1 + Path = 'RefinedMesh'//I2S(i) + END IF nLen = LEN_TRIM(OutputPath) IF ( nlen > 0 ) THEN - Path = OutputPath(1:nlen) // '/' // TRIM(Path) + Path = OutputPath(1:nlen) // '/' // TRIM(Path) ELSE - Path = TRIM(Path) + Path = TRIM(Path) END IF + + GmshFormat = ListGetLogical( Params,'Adaptive Remesh Use Gmsh', Found ) + + IF( GmshFormat ) THEN + + GmshPosFormat = ListGetLogical( Params,'Adaptive Remesh Gmsh Use Pos Format', Found ) + ! write the bacground mesh in .pos format if user requested it. + IF( GmshPosFormat) THEN + + ! Get the coordinate scaling. This is used to scale the background mesh coordinates according to the original mesh. + MeshDim = RefMesh % MaxDim + + Wrk => ListGetConstRealArray( Model % Simulation,'Coordinate Scaling',Found ) + CoordScale = 1.0_dp + IF( Found ) THEN + DO i=1, MeshDim + 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 in .pos format + CALL Info( Caller,'Saving background mesh density in gmsh .pos format' ) + OPEN( 11, STATUS='UNKNOWN',FILE='gmsh_bgmesh.pos' ) + WRITE( 11,* ) 'View "mesh size field" {' + DO i=1,RefMesh % NumberOfNodes + IF(.NOT. (HValueF(i) > 0.0_dp )) CYCLE + IF (dim == 2 ) THEN + WRITE( 11,* ) 'SP(', (RefMesh % Nodes % x(i)) / CoordScale(1), & + ', ', (RefMesh % Nodes % y(i)) / CoordScale(2), ') {', & + HValueF(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), ') {', & + HValueF(i) / MIN(CoordScale(1), MIN(CoordScale(2), CoordScale(3))), '};' + END IF + END DO + WRITE( 11,* ) '};' + CLOSE(11) + ELSE + + CALL Info( Caller,'Saving background mesh density in gmsh 2.0 (.msh) format' ) + + ! A cludge to change the pointer and save results in Gmsh format. + BLOCK + REAL(KIND=dp), POINTER :: PtoHvalue(:) + TYPE(Variable_t), POINTER :: HVar + HVar => VariableGet( RefMesh % Variables,'Hvalue') + pToHvalue => HVar % Values + HVar % Values => HvalueF + CALL ListAddString(Solver % Values,'Scalar Field 1','Hvalue') + CALL ListAddLogical(Solver % Values,'File Append',.FALSE.) + CALL ListAddLogical(Solver % Values,'Alter Topology',.TRUE.) + CALL ListAddNewString(Solver % Values, 'Output File Name', 'gmsh_bgmesh.msh') + CALL SaveGmshOutput( Model,Solver,0.0_dp,.FALSE.) + HVar % Values => PtoHvalue + END BLOCK + END IF + ELSE + CALL Info( Caller,'Saving background mesh density in point cloud format' ) - CALL MakeDirectory( TRIM(Path) // CHAR(0) ) - CALL WriteMeshToDisk( RefMesh, Path ) + OPEN( 11, STATUS='UNKNOWN', FILE='bgmesh.nodes' ) + WRITE( 11,* ) COUNT( HValueF > 0.0_dp ) + DO i=1,RefMesh % NumberOfNodes + IF(.NOT. (HValueF(i) > 0.0_dp )) CYCLE + IF (dim == 2 ) THEN + WRITE(11,'(3e23.15)') RefMesh % Nodes % x(i), & + RefMesh % Nodes % y(i), HValueF(i) + ELSE + WRITE(11,'(4e23.15)') RefMesh % Nodes % x(i), & + RefMesh % Nodes % y(i), & + RefMesh % Nodes % z(i), HValueF(i) + END IF + END DO + WRITE(11,*) 0 + CLOSE(11) + + CALL MakeDirectory( TRIM(Path) // CHAR(0) ) + CALL WriteMeshToDisk( RefMesh, Path ) + END IF Mesh => RefMesh DO WHILE( ASSOCIATED( Mesh ) ) - IF ( Mesh % AdaptiveDepth == 0 ) EXIT - Mesh => Mesh % Parent + 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 + MeshCommand = ListGetString( Solver % Values,'Mesh Command',Found) + IF(.NOT. Found ) THEN + IF( GmshFormat ) THEN + CALL Fatal('ReMesh','For now, provide "Mesh Command" for Gmsh meshing!') + END IF - MeshCommand = TRIM(OutputPath) // '/' // TRIM(Mesh % Name) // '/' // & - TRIM( MeshInputFile ) + MeshInputFile = ListGetString( Params, 'Mesh Input File', Found ) + IF ( .NOT. Found ) THEN + MeshInputFile = ListGetString( Model % Simulation, 'Mesh Input File' ) + END IF - SELECT CASE( CoordinateSystemDimension() ) - CASE(2) - MeshCommand = 'Mesh2D ' // TRIM(MeshCommand) // ' ' // & - TRIM(Path) // ' --bgmesh=bgmesh' + MeshCommand = TRIM(OutputPath) // '/' // TRIM(Mesh % Name) // '/' // & + TRIM( MeshInputFile ) - CASE(3) - MeshCommand = 'Mesh3D ' // TRIM(MeshCommand) // ' ' // & - TRIM(Path) // ' bgmesh' - END SELECT + SELECT CASE( dim ) + CASE(2) + ! Legacy mesh generator from the Elmer suite. + MeshCommand = 'Mesh2D '//TRIM(MeshCommand)//' '//TRIM(Path)// ' --bgmesh=bgmesh.nodes' + CASE(3) + MeshCommand = 'Mesh3D '//TRIM(MeshCommand)//' '//TRIM(Path)//' bgmesh.nodes' + END SELECT + END IF - CALL Info('ReMesh','System command: '//TRIM(MeshCommand),Level=10) + ! Remeshing command. + CALL Info('ReMesh','Meshing command: '//TRIM(MeshCommand),Level=10) CALL SystemCommand( MeshCommand ) + ! Check if also conversion command is given. + MeshCommand = ListGetString( Solver % Values,'Mesh Conversion Command',Found) + IF( Found ) THEN + ! add the output path to the command. + MeshCommand = MeshCommand // ' -out ' // TRIM(Path) + CALL Info('ReMesh','Conversion command: '//TRIM(MeshCommand),Level=10) + CALL SystemCommand( MeshCommand ) + END IF + + ! Read the new mesh. NewMesh => LoadMesh2( Model, OutPutPath, Path, .FALSE., 1, 0 ) + ! Loading Gebhart factors is more or less obsolite. 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) - + TRIM(Mesh % Name) // '/' // TRIM(Name) CALL LoadGebhartFactors( NewMesh, TRIM(Name) ) END IF END IF + DEALLOCATE(HvalueF) + !------------------------------------------------------------------------------ END FUNCTION External_ReMesh !------------------------------------------------------------------------------ diff --git a/fem/src/CRSMatrix.F90 b/fem/src/CRSMatrix.F90 index 61a0325eb2..c0334d5348 100644 --- a/fem/src/CRSMatrix.F90 +++ b/fem/src/CRSMatrix.F90 @@ -399,7 +399,7 @@ END SUBROUTINE CRS_AddToMatrixElement !------------------------------------------------------------------------------ -!> Check existance of a matrix element. +!> Check existence of a matrix element. !------------------------------------------------------------------------------ FUNCTION CRS_CheckMatrixElement( A,i,j ) RESULT ( Found ) !------------------------------------------------------------------------------ @@ -3677,7 +3677,7 @@ FUNCTION CRS_IncompleteLU(A,ILUn) RESULT(Status) CALL Info( 'CRS_IncompleteLU', Message, Level=6 ) WRITE(Message,'(A,I1,A,F8.2)') 'ILU(',ILUn, & - ') (Real), Factorization ready at (s): ', CPUTime()-st + ') (Real), Factorization time (s): ', CPUTime()-st CALL Info( 'CRS_IncompleteLU', Message, Level=6 ) Status = .TRUE. diff --git a/fem/src/CircuitUtils.F90 b/fem/src/CircuitUtils.F90 index 125ddb7c59..97f1be3d5a 100644 --- a/fem/src/CircuitUtils.F90 +++ b/fem/src/CircuitUtils.F90 @@ -157,6 +157,29 @@ SUBROUTINE GetWPotential(Wbase) END SUBROUTINE GetWPotential !------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ + SUBROUTINE GetWPotentialVar(pVar) +!------------------------------------------------------------------------------ + IMPLICIT NONE + + TYPE(Variable_t), POINTER :: pVar + + pVar => VariableGet( CurrentModel % Mesh % Variables,'W Potential') + IF(.NOT. ASSOCIATED(pVar) ) THEN + pVar => VariableGet( CurrentModel % Mesh % Variables,'W') + END IF + IF(ASSOCIATED(pVar)) THEN + CALL Info('GetWPotentialVar','Using gradient of field to define direction: '& + //TRIM(pVar % Name),Level=7) + ELSE + CALL Warn('GetWPotentialVar','Could not obtain variable for potential "W"') + END IF +!------------------------------------------------------------------------------ + END SUBROUTINE GetWPotentialVar +!------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ SUBROUTINE AddComponentsToBodyLists() !------------------------------------------------------------------------------ @@ -696,7 +719,7 @@ SUBROUTINE SetBoundaryAreasToValueLists() END DO END IF - IF( InfoActive(20) ) THEN + IF( InfoActive(25) ) THEN DO i=1,nBC PRINT *,'A(i)',i,i<=CurrentModel % NumberOfBCs,BoundaryAreas(i) END DO @@ -737,7 +760,7 @@ SUBROUTINE ReadComponents(CId) INTEGER :: ExtMaster CALL Info('ReadComponents','Reading component: '//I2S(Cid),Level=20) - + Circuit => CurrentModel % Circuits(CId) Circuit % CvarDofs = 0 @@ -775,17 +798,25 @@ SUBROUTINE ReadComponents(CId) IF (.NOT. Found) Comp % VoltageFactor = 1._dp Comp % ElBoundaries => ListGetIntegerArray(CompParams, 'Electrode Boundaries', Found) - + ! This is a feature intended to make it easier to extruded meshes internally with ! ElmerSolver. The idea is that the code knows which are the BCs that were created ! from extruding this 2D body. ExtMaster = 0 IF(.NOT. Found ) THEN - IF( ListGetLogical( CurrentModel % Solver % Values,'Extruded Child BC Electrode', Found ) ) THEN + IF( ListGetLogical( CurrentModel % Solver % Values,'Extruded Child BC Electrode', Found ) ) THEN + + IF( ListGetLogical( CurrentModel % Simulation,"Extruded BCs Collect",Found ) ) THEN + CALL Fatal('Circuits_init',& + 'Conflicting keywords: "Extruded Child BC Electrode" vs. "Extruded BCs Collect"') + END IF + + CALL Info('Circuits_init','Setting "Extruded Child BCs"',Level=10) BLOCK INTEGER :: body_id INTEGER, POINTER :: pIntArray(:) => NULL() - pIntArray => ListGetIntegerArray(CompParams, 'Master Bodies', Found ) + pIntArray => ListGetIntegerArray(CompParams, 'Body', Found ) + IF(.NOT. Found) pIntArray => ListGetIntegerArray(CompParams, 'Master Bodies', Found ) IF( Found ) THEN IF(SIZE(pIntArray)==1) THEN body_id = pIntArray(1) @@ -793,7 +824,8 @@ SUBROUTINE ReadComponents(CId) pIntArray => ListGetIntegerArray(CurrentModel % Bodies(body_id) % Values,& 'Extruded Child BCs',Found ) IF(Found) THEN - CALL Info('Circuits_int','Associating "Electrode Boundaries" to extruded bcs!',Level=10) + CALL Info('Circuits_init','Setting Component '//I2S(CompInd)//' "Electrode Boundaries" to '& + //I2S(pIntArray(1))//' '//I2S(pIntArray(2)),Level=10) Comp % ElBoundaries => pIntArray ExtMaster = body_id END IF @@ -816,8 +848,12 @@ SUBROUTINE ReadComponents(CId) IF (.NOT. Found) CALL Fatal('Circuits_Init','Number of Turns not found!') Comp % ElArea = GetConstReal(CompParams, 'Electrode Area', Found) - IF (.NOT. Found) CALL ComputeElectrodeArea(Comp, CompParams, ExtMaster ) - + IF (.NOT. Found) THEN + CALL ComputeElectrodeArea(Comp, CompParams, ExtMaster ) + WRITE(Message,'(A,ES12.5)') 'Component '//I2S(CompInd)//' "Electrode Area" is ',Comp % ElArea + CALL Info('Circuits_Init',Message,Level=10) + END IF + Comp % CoilThickness = GetConstReal(CompParams, 'Coil Thickness', Found) IF (.NOT. Found) Comp % CoilThickness = 1._dp @@ -870,8 +906,12 @@ SUBROUTINE ReadComponents(CId) IF (.NOT. Found) CALL Fatal('Circuits_Init','Number of Turns not found!') Comp % ElArea = GetConstReal(CompParams, 'Electrode Area', Found) - IF (.NOT. Found) CALL ComputeElectrodeArea(Comp, CompParams) - + IF (.NOT. Found) THEN + CALL ComputeElectrodeArea(Comp, CompParams ) + WRITE(Message,'(A,ES12.5)') 'Component '//I2S(CompInd)//' "Electrode Area" is ',Comp % ElArea + CALL Info('Circuits_Init',Message,Level=10) + END IF + Comp % N_j = Comp % nofturns / Comp % ElArea END SELECT END IF @@ -942,8 +982,9 @@ SUBROUTINE ComputeElectrodeArea(Comp, CompParams, ExtMaster ) IF (.NOT. ASSOCIATED(Comp % ElBoundaries)) & CALL Fatal('ComputeElectrodeArea','Electrode Boundaries not found') BCid = Comp % ElBoundaries(1) - IF( BCid > CurrentModel % NumberOfBCs ) & + IF( BCid < 1 .OR. BCid > CurrentModel % NumberOfBCs ) & CALL Fatal('ComputeElectrodeArea', 'BCid is beyond range: '//I2S(BCid)) + BC => CurrentModel % BCs(BCid) % Values IF (.NOT. ASSOCIATED(BC) ) CALL Fatal('ComputeElectrodeArea', 'Boundary not found!') Comp % ElArea = GetConstReal(BC, 'Area', Found) @@ -2321,11 +2362,9 @@ SUBROUTINE Circuits_MatrixInit() CALL CreateBasicCircuitEquations(Rows, Cols, Cnts) CALL CreateComponentEquations(Rows, Cols, Cnts, Done, dofsdone) - IF (n /= SUM(Cnts)) THEN - print *, "Counted Cnts:", n, "Applied Cnts:", SUM(Cnts) CALL Fatal('Circuits_MatrixInit', & - 'There were different amount of matrix elements than was counted') + 'Inconsistent number of matrix elements: '//I2S(n)//' vs. '//I2S(SUM(CNTs))) END IF DEALLOCATE( Cnts, Done ) diff --git a/fem/src/ElementUtils.F90 b/fem/src/ElementUtils.F90 index dcc8e5374f..4bd46e9140 100644 --- a/fem/src/ElementUtils.F90 +++ b/fem/src/ElementUtils.F90 @@ -40,8 +40,11 @@ !-------------------------------------------------------------------------------- !> Some basic finite element utilities. !-------------------------------------------------------------------------------- +#include "../config.h" + MODULE ElementUtils + USE DirectSolve USE Integration USE ListMatrix @@ -74,7 +77,7 @@ RECURSIVE SUBROUTINE FreeMatrix(Matrix) INTERFACE !! destroy the data structures (should be called when the matrix has !! to be updated and SolveHYPRE1 has to be called again). - SUBROUTINE SolveHYPRE4(hypreContainer) + SUBROUTINE SolveHYPRE4(hypreContainer) BIND(C,Name="solvehypre4") USE, INTRINSIC :: iso_c_binding INTEGER(KIND=C_INTPTR_T) :: hypreContainer END SUBROUTINE SolveHYPRE4 diff --git a/fem/src/IterSolve.F90 b/fem/src/IterSolve.F90 index c19fa9ad08..4824d85748 100644 --- a/fem/src/IterSolve.F90 +++ b/fem/src/IterSolve.F90 @@ -538,8 +538,8 @@ END SUBROUTINE SlavePrecComplex PCondType = PRECOND_ILUT ELSE IF ( SEQL(str, 'ilu') ) THEN - ILUn = NINT(ListGetCReal( Params, & - 'Linear System ILU Order', gotit )) + ILUn = ListGetInteger( Params, & + 'Linear System ILU Order', gotit ) IF ( .NOT.gotit ) THEN IF(LEN(str)>=4) ILUn = ICHAR(str(4:4)) - ICHAR('0') END IF @@ -577,6 +577,8 @@ END SUBROUTINE SlavePrecComplex END IF IF ( .NOT. ListGetLogical( Params, 'No Precondition Recompute',GotIt ) ) THEN + CALL ResetTimer("Prec-"//TRIM(str)) + n = ListGetInteger( Params, 'Linear System Precondition Recompute', GotIt ) IF ( n <= 0 ) n = 1 @@ -605,6 +607,7 @@ END SUBROUTINE SlavePrecComplex NullEdges = ListGetLogical(Params, 'Edge Basis', GotIt) CM => A % ConstraintMatrix IF(NullEdges.OR.ASSOCIATED(CM)) THEN + CALL Info('IterSolver','Omitting edge dofs from being target of ILUn',Level=20) IF(ASSOCIATED(A % ILURows)) DEALLOCATE(A % ILURows) IF(ASSOCIATED(A % ILUCols)) DEALLOCATE(A % ILUCols) @@ -679,7 +682,7 @@ END SUBROUTINE SlavePrecComplex ELSE IF ( PCondType == PRECOND_ILUT ) THEN Condition = CRS_ComplexILUT( A,ILUT_TOL ) END IF - ELSE IF (ILUn>=0 .OR. PCondType == PRECOND_ILUT) THEN + ELSE IF (ILUn>=0 .OR. PCondType == PRECOND_ILUT) THEN ! Not ComplexSystem SELECT CASE(PCondType) CASE(PRECOND_ILUn, PRECOND_Circuit) NullEdges = ListGetLogical(Params, 'Edge Basis', GotIt) @@ -781,6 +784,7 @@ END SUBROUTINE SlavePrecComplex END IF END IF END IF + CALL CheckTimer("Prec-"//TRIM(str),Level=8,Delete=.TRUE.) END IF END IF diff --git a/fem/src/IterativeMethods.F90 b/fem/src/IterativeMethods.F90 index 816764e5d9..2501d4c1f1 100644 --- a/fem/src/IterativeMethods.F90 +++ b/fem/src/IterativeMethods.F90 @@ -1205,6 +1205,9 @@ SUBROUTINE itermethod_gcr( xvec, rhsvec, & REAL(KIND=dp), POINTER :: x(:),b(:) + CALL Info('Itermetod_gcr','Starting GCR iteration',Level=25) + + ndim = HUTI_NDIM Rounds = HUTI_MAXIT MinIter = HUTI_MINIT @@ -1944,6 +1947,8 @@ SUBROUTINE itermethod_z_gcr( xvec, rhsvec, & INTEGER :: Rounds, OutputInterval REAL(KIND=dp) :: MinTol, MaxTol, Residual LOGICAL :: Converged, Diverged, UseStopCFun + + CALL Info('Itermetod_z_gcr','Starting GCR iteration',Level=25) ndim = HUTI_NDIM Rounds = HUTI_MAXIT @@ -1989,27 +1994,28 @@ SUBROUTINE GCR_Z( n, A, x, b, Rounds, MinTolerance, MaxTolerance, Residual, & LOGICAL :: Converged, Diverged REAL(KIND=dp) :: MinTolerance, MaxTolerance, Residual INTEGER :: n, OutputInterval, m +!------------------------------------------------------------------------------ REAL(KIND=dp) :: bnorm,rnorm COMPLEX(KIND=dp), ALLOCATABLE :: R(:) - COMPLEX(KIND=dp), ALLOCATABLE :: S(:,:), V(:,:), T1(:), T2(:) - -!------------------------------------------------------------------------------ INTEGER :: i,j,k,allocstat - COMPLEX(KIND=dp) :: beta + COMPLEX(KIND=dp) :: beta, czero REAL(KIND=dp) :: alpha, trueresnorm, normerr - COMPLEX(KIND=dp) :: trueres(n) + COMPLEX(KIND=dp), ALLOCATABLE :: trueres(:) !------------------------------------------------------------------------------ - ALLOCATE( R(n), T1(n), T2(n) ) - IF ( m > 1 ) THEN + ALLOCATE( R(n), T1(n), T2(n), trueres(n), STAT=allocstat ) + IF( allocstat /= 0) & + CALL Fatal('GCR_Z','Failed to allocate memory of size: '//I2S(n)) + IF ( m > 1 ) THEN ALLOCATE( S(n,m-1), V(n,m-1), STAT=allocstat ) IF ( allocstat /= 0 ) THEN CALL Fatal('GCR_Z','Failed to allocate memory of size: '& //I2S(n)//' x '//I2S(m-1)) END IF - V(1:n,1:m-1) = CMPLX( 0.0d0, 0.0d0, kind=dp) - S(1:n,1:m-1) = CMPLX( 0.0d0, 0.0d0, kind=dp) + czero = CMPLX( 0.0_dp, 0.0_dp ) + V(1:n,1:m-1) = czero + S(1:n,1:m-1) = czero END IF CALL matvecsubr( x, r, ipar ) diff --git a/fem/src/Lists.F90 b/fem/src/Lists.F90 index 7ea8f3de11..cb59026771 100644 --- a/fem/src/Lists.F90 +++ b/fem/src/Lists.F90 @@ -218,7 +218,7 @@ FUNCTION InitialPermutation( Perm,Model,Solver,Mesh, & CHARACTER(LEN=*) :: Equation LOGICAL, OPTIONAL :: DGSolver, GlobalBubbles !------------------------------------------------------------------------------ - INTEGER i,j,l,t,n,e,k,k1, MaxNDOFs, MaxEDOFs, MaxFDOFs, BDOFs, ndofs, el_id + INTEGER i,j,l,t,n,m,e,k,k1, MaxNDOFs, MaxEDOFs, MaxFDOFs, BDOFs, ndofs, el_id INTEGER :: NodalIndexOffset, EdgeIndexOffset, FaceIndexOffset, Indexes(128) INTEGER, POINTER :: Def_Dofs(:) INTEGER, ALLOCATABLE :: EdgeDOFs(:), FaceDOFs(:) @@ -643,7 +643,9 @@ FUNCTION InitialPermutation( Perm,Model,Solver,Mesh, & ELSE Solver % PeriodicFlipActive = .FALSE. n = SIZE( Mesh % PeriodicPerm ) - IF( n < SIZE( Perm ) ) THEN + m = SIZE( Perm ) + + IF( n < m ) THEN CALL Info(Caller,'Increasing size of periodic tables from '& //I2S(n)//' to '//I2S(SIZE(Perm))//'!',Level=7) ALLOCATE( TmpPerm(SIZE(Perm)) ) @@ -664,17 +666,17 @@ FUNCTION InitialPermutation( Perm,Model,Solver,Mesh, & n = 0 IF( ASSOCIATED( Mesh % PeriodicPerm ) ) THEN ! Set the eliminated dofs to zero and renumber - WHERE( Mesh % PeriodicPerm > 0 ) Perm = -Perm + WHERE( Mesh % PeriodicPerm(1:m) > 0 ) Perm = -Perm k = 0 - DO i=1,SIZE( Perm ) + DO i=1,m IF( Perm(i) > 0 ) THEN k = k + 1 Perm(i) = k END IF END DO - DO i=1,SIZE( Mesh % PeriodicPerm ) + DO i=1,m j = Mesh % PeriodicPerm(i) IF( j > 0 ) THEN IF( Perm(i) /= 0 ) THEN @@ -8698,8 +8700,11 @@ FUNCTION ListGetElementVectorSolution( Handle, Basis, Element, Found, GaussPoint Val3D = 0.0_dp - IF( .NOT. ASSOCIATED( Handle % Variable ) ) RETURN - + IF( .NOT. ASSOCIATED( Handle % Variable ) ) THEN + IF(PRESENT(Found)) Found = .FALSE. + RETURN + END IF + IF( PRESENT( dofs ) ) THEN Ldofs = dofs ELSE diff --git a/fem/src/MainUtils.F90 b/fem/src/MainUtils.F90 index c27f799c74..6bda829c53 100644 --- a/fem/src/MainUtils.F90 +++ b/fem/src/MainUtils.F90 @@ -5306,71 +5306,71 @@ RECURSIVE SUBROUTINE SingleSolver( Model, Solver, dt, TransientSimulation ) END IF END BLOCK + IF( ListGetLogical( Solver % Values,'Library Adaptivity', Found ) ) THEN #ifdef LIBRARY_ADAPTIVITY - ! Do adaptive meshing, whether to do this before or after "_post" is a matter of taste i guess - BLOCK - USE, INTRINSIC :: ISO_C_BINDING - - CHARACTER(LEN=MAX_NAME_LEN) :: ProcName - LOGICAL :: AdaptiveActive - TYPE(Variable_t), POINTER :: Var - INTEGER(KIND=AddrInt) :: IResidual, EResidual, BResidual - - - INTERFACE - FUNCTION BoundaryResidual( 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 BoundaryResidual - - - FUNCTION EdgeResidual( 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 EdgeResidual - - - FUNCTION InsideResidual( 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 InsideResidual - END INTERFACE - - PROCEDURE(InsideResidual), POINTER :: InsidePtr - PROCEDURE(EdgeResidual), POINTER :: EdgePtr - PROCEDURE(BoundaryResidual), POINTER :: BoundaryPtr - - POINTER( Eresidual, Edgeptr ) - POINTER( Iresidual, Insideptr ) - POINTER( Bresidual, BoundaryPtr ) - - AdaptiveActive = ListGetLogical( Solver % Values,'Adaptive Mesh Refinement',Found ) - - IF( AdaptiveActive ) THEN - ProcName = ListGetString( Solver % Values,'Procedure', Found ) - IResidual = GetProcAddr( TRIM(ProcName)//'_inside_residual', abort=.FALSE. ) - EResidual = GetProcAddr( TRIM(ProcName)//'_edge_residual', abort=.FALSE. ) - BResidual = GetProcAddr( TRIM(ProcName)//'_boundary_residual', abort=.FALSE. ) - IF( IResidual/=0 .AND. EResidual /= 0 .AND. BResidual /= 0 ) THEN - Var => Solver % Variable - CALL RefineMesh( Model, Solver, Var % Values, Var % Perm, InsidePtr, EdgePtr, BoundaryPtr ) + ! Do adaptive meshing, whether to do this before or after "_post" is a matter of taste i guess + BLOCK + USE, INTRINSIC :: ISO_C_BINDING + + CHARACTER(LEN=MAX_NAME_LEN) :: ProcName + LOGICAL :: AdaptiveActive + TYPE(Variable_t), POINTER :: Var + INTEGER(KIND=AddrInt) :: IResidual, EResidual, BResidual + + INTERFACE + FUNCTION BoundaryResidual( 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 BoundaryResidual + + FUNCTION EdgeResidual( 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 EdgeResidual + + FUNCTION InsideResidual( 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 InsideResidual + END INTERFACE + + PROCEDURE(InsideResidual), POINTER :: InsidePtr + PROCEDURE(EdgeResidual), POINTER :: EdgePtr + PROCEDURE(BoundaryResidual), POINTER :: BoundaryPtr + + POINTER( Eresidual, Edgeptr ) + POINTER( Iresidual, Insideptr ) + POINTER( Bresidual, BoundaryPtr ) + + AdaptiveActive = ListGetLogical( Solver % Values,'Adaptive Mesh Refinement',Found ) + + IF( AdaptiveActive ) THEN + ProcName = ListGetString( Solver % Values,'Procedure', Found ) + IResidual = GetProcAddr( TRIM(ProcName)//'_inside_residual', abort=.FALSE. ) + EResidual = GetProcAddr( TRIM(ProcName)//'_edge_residual', abort=.FALSE. ) + BResidual = GetProcAddr( TRIM(ProcName)//'_boundary_residual', abort=.FALSE. ) + IF( IResidual/=0 .AND. EResidual /= 0 .AND. BResidual /= 0 ) THEN + Var => Solver % Variable + CALL RefineMesh( Model, Solver, Var % Values, Var % Perm, InsidePtr, EdgePtr, BoundaryPtr ) + END IF END IF - END IF - END BLOCK + END BLOCK +#else + CALL Fatal('SingleSolver','Library version of adaptivity residuals not compiled with!') #endif - + END IF ! Compute all dependent fields, components and derivatives related to the primary solver. !----------------------------------------------------------------------- diff --git a/fem/src/MeshUtils.F90 b/fem/src/MeshUtils.F90 index 6f28894317..87fda1121e 100644 --- a/fem/src/MeshUtils.F90 +++ b/fem/src/MeshUtils.F90 @@ -2970,7 +2970,10 @@ SUBROUTINE PrepareMesh( Model, Mesh, Parallel, Def_Dofs, mySolver ) CALL NonNodalElements() IF( Parallel ) THEN + CALL Info(Caller,'Generating parallel communications for the non-nodal mesh',Level=20) + CALL ResetTimer('ParallelNonNodal') CALL ParallelNonNodalElements() + CALL CheckTimer('ParallelNonNodal',Level=7,Delete=.TRUE.) END IF CALL EnlargeCoordinates( Mesh ) @@ -18635,6 +18638,8 @@ FUNCTION MeshExtrudeSlices(Mesh_in, Vlist) RESULT(Mesh_out) l = MODULO(Mesh_in % Elements(j) % GElementIndex-1,gelements)+1 + (ilev+i) * gelements END IF Element % GElementIndex = l + ELSE + Element % GElementIndex = cnt END IF Element % ElementIndex = cnt @@ -18692,7 +18697,7 @@ FUNCTION MeshExtrudeSlices(Mesh_in, Vlist) RESULT(Mesh_out) ELSE CALL Fatal(Caller,'Cannot extrude boundary element: '//I2S(ElemCode)) END IF - Mesh_out % Elements(cnt) % ElementIndex = cnt + Element % ElementIndex = cnt END DO END DO @@ -18861,8 +18866,9 @@ FUNCTION MeshExtrudeSlices(Mesh_in, Vlist) RESULT(Mesh_out) TmpPair(2) = ChildBCs(2*i) CALL ListAddIntegerArray(vList,'Extruded Child BCs',2,TmpPair) - IF( InfoActive(20) ) THEN - PRINT *,'Extruded Child BCs for body:',i,TmpPair + IF( InfoActive(10) ) THEN + CALL Info(Caller,'Setting Body '//I2S(i)//' "Extruded Child BCs" to '& + //I2S(TmpPair(1))//' '//I2S(TmpPair(2))) END IF NULLIFY(TmpPair) END IF @@ -19530,7 +19536,8 @@ SUBROUTINE CheckMeshInfo( Mesh ) INTEGER, ALLOCATABLE :: NodeHits(:), TypeHits(:) TYPE(Element_t), POINTER :: Element REAL(KIND=dp) :: mins, maxs, s, s2 - INTEGER :: Dbg(10) + INTEGER(KIND=8) :: Dbg(10) + LOGICAL :: Halt CHARACTER(*), PARAMETER :: Caller="CheckMeshInfo" !------------------------------------------------------------------------------ @@ -19539,6 +19546,7 @@ SUBROUTINE CheckMeshInfo( Mesh ) na = Mesh % NumberOfBulkElements nb = Mesh % NumberOfBoundaryElements nn = Mesh % NumberOfNodes + Halt = .FALSE. CALL Info(Caller,'Number of bulk elements: '//I2S(na)) CALL Info(Caller,'Number of boundary elements: '//I2S(nb)) @@ -19553,8 +19561,8 @@ SUBROUTINE CheckMeshInfo( Mesh ) CALL CheckMeshGeomSize() CALL CheckMeshSerendipity() CALL CheckMeshBodyRadius() - CALL CheckMeshEdges() CALL CheckMeshFaces() + CALL CheckMeshEdges() CALL CheckParallelInfo() CALL CheckParallelEdgeInfo() CALL CheckParallelFaceInfo() @@ -19563,6 +19571,8 @@ SUBROUTINE CheckMeshInfo( Mesh ) CALL Info(Caller,'Finished checking mesh!') + IF(Halt) CALL Fatal(Caller,'Some checksum was invalid, cannot continue!') + CONTAINS @@ -19587,6 +19597,10 @@ SUBROUTINE CheckMeshBulkHits() PRINT *,'NodeIndexes:', Element % NodeIndexes, ' vs. ', nn CALL Fatal(Caller,'Bulk element '//I2S(t)//' has too large index!') END IF + IF(ANY(Element % NodeIndexes <= 0)) THEN + PRINT *,'NodeIndexes:',Element % NodeIndexes + CALL Fatal(Caller,'Non-positive node index encountered') + END IF NodeHits(Element % NodeIndexes) = NodeHits(Element % NodeIndexes) + 1 END DO @@ -19613,6 +19627,8 @@ SUBROUTINE CheckMeshBulkHits() WRITE(Message,*) 'Bulk Checksum: ',Dbg(1:5) CALL Info(Caller,Message) + IF(ANY(Dbg < 0) ) Halt = .TRUE. + END SUBROUTINE CheckMeshBulkHits @@ -19668,6 +19684,8 @@ SUBROUTINE CheckMeshBoundaryHits() WRITE(Message,*) 'Boundary Checksum: ',Dbg(1:5) CALL Info(Caller,Message) + IF(ANY(Dbg < 0) ) Halt = .TRUE. + END SUBROUTINE CheckMeshBoundaryHits @@ -19721,6 +19739,8 @@ SUBROUTINE CheckParentIndeces() IF(Misses > 0) CALL Fatal(Caller,'We need all parent indeces!') + IF(ANY(Dbg < 0) ) Halt = .TRUE. + END SUBROUTINE CheckParentIndeces @@ -19874,6 +19894,7 @@ END SUBROUTINE CheckMeshBodyRadius SUBROUTINE CheckMeshEdges() INTEGER, POINTER :: Indexes(:) + INTEGER :: m IF(Mesh % NumberOfEdges == 0 ) RETURN dbg = 0 @@ -19881,8 +19902,22 @@ SUBROUTINE CheckMeshEdges() DO t=1,Mesh % NumberOfEdges Element => Mesh % Edges(t) + IF(.NOT. ASSOCIATED(Element)) THEN + CALL Fatal(Caller,'Edge not associated on edge list: '//I2S(t)) + END IF Indexes => Element % NodeIndexes - dbg(2) = dbg(2) + SUM(Indexes) + IF(.NOT. ASSOCIATED(Indexes)) THEN + CALL Fatal(Caller,'NodeIndexes not associated on edge: '//I2S(t)) + END IF + IF(.NOT. ASSOCIATED(Element % TYPE)) THEN + CALL Fatal(Caller,'Edge type '//I2S(t)//' not associated!') + END IF + m = Element % Type % NumberOfNodes + IF(SIZE(Indexes) /= m) THEN + CALL Fatal(Caller,'Invalid size of edge '//I2S(t)//& + ' NodeIndexes: '//I2S(SIZE(Indexes))//' vs. '//I2S(m)) + END IF + IF(SIZE(Indexes)>0) dbg(2) = dbg(2) + SUM(Indexes) dbg(3) = dbg(3) + Element % ElementIndex dbg(4) = dbg(4) + Element % GElementIndex END DO @@ -19890,10 +19925,13 @@ SUBROUTINE CheckMeshEdges() WRITE(Message,*) 'Edges Checksum: ',Dbg(1:5) CALL Info(Caller,Message) + IF(ANY(Dbg < 0) ) Halt = .TRUE. + END SUBROUTINE CheckMeshEdges SUBROUTINE CheckMeshFaces() INTEGER, POINTER :: Indexes(:) + INTEGER :: m IF(Mesh % NumberOfFaces == 0 ) RETURN dbg = 0 @@ -19901,15 +19939,32 @@ SUBROUTINE CheckMeshFaces() DO t=1,Mesh % NumberOfFaces Element => Mesh % Faces(t) + IF(.NOT. ASSOCIATED(Element)) THEN + CALL Fatal(Caller,'Face not associated on face list: '//I2S(t)) + END IF Indexes => Element % NodeIndexes - dbg(2) = dbg(2) + SUM(Indexes) + IF(.NOT. ASSOCIATED(Indexes)) THEN + CALL Fatal(Caller,'NodeIndexes not associated on face: '//I2S(t)) + END IF + IF(.NOT. ASSOCIATED(Element % TYPE)) THEN + CALL Fatal(Caller,'Face type '//I2S(t)//' not associated!') + END IF + m = Element % TYPE % NumberOfNodes + IF(SIZE(Indexes) /= m) THEN + CALL Fatal(Caller,'Invalid size of face '//I2S(t)//& + ' NodeIndexes: '//I2S(SIZE(Indexes))//' vs. '//I2S(m)) + END IF + IF(SIZE(Indexes)>0) dbg(2) = dbg(2) + SUM(Indexes) dbg(3) = dbg(3) + Element % ElementIndex dbg(4) = dbg(4) + Element % GElementIndex + END DO WRITE(Message,*) 'Faces Checksum: ',Dbg(1:5) CALL Info(Caller,Message) + IF(ANY(Dbg < 0) ) Halt = .TRUE. + END SUBROUTINE CheckMeshFaces @@ -19940,6 +19995,8 @@ SUBROUTINE CheckParallelInfo() WRITE(Message,*) 'ParallelInfo Checksum: ',Dbg(1:7) CALL Info(Caller,Message) + IF(ANY(Dbg < 0) ) Halt = .TRUE. + END SUBROUTINE CheckParallelInfo SUBROUTINE CheckParallelEdgeInfo() @@ -19975,6 +20032,8 @@ SUBROUTINE CheckParallelEdgeInfo() WRITE(Message,*) 'ParallelEdges Checksum: ',Dbg(1:7) CALL Info(Caller,Message) + IF(ANY(Dbg < 0) ) Halt = .TRUE. + END SUBROUTINE CheckParallelEdgeInfo SUBROUTINE CheckParallelFaceInfo() @@ -20010,6 +20069,8 @@ SUBROUTINE CheckParallelFaceInfo() WRITE(Message,*) 'ParallelFaces Checksum: ',Dbg(1:7) CALL Info(Caller,Message) + IF(ANY(Dbg < 0) ) Halt = .TRUE. + END SUBROUTINE CheckParallelFaceInfo !------------------------------------------------------------------------------ diff --git a/fem/src/ModelDescription.F90 b/fem/src/ModelDescription.F90 index fc05742e5c..13a183f164 100644 --- a/fem/src/ModelDescription.F90 +++ b/fem/src/ModelDescription.F90 @@ -553,6 +553,18 @@ RECURSIVE SUBROUTINE LoadInputFile( Model, InFileUnit, FileName, & ELSE IF ( Section == 'run' ) THEN IF ( PRESENT(runc) ) runc=.TRUE. EXIT + ELSE IF ( Section == 'stop' ) THEN + CALL Warn(Caller,'Encountered "STOP" in sif, rest will be ignored!') + EXIT + ELSE IF( Section == '/*' ) THEN + CALL Info(Caller,'Starting comment section!') + DO WHILE( ReadAndTrim( InFileUnit, Section, Echo ) ) + IF ( Section == '*/' ) THEN + CALL Info(Caller,'Finished comment section!') + EXIT + END IF + END DO + CYCLE END IF FreeNames = ( CheckAbort <= 0 ) @@ -4275,6 +4287,7 @@ SUBROUTINE LoadRestartFile( RestartFile,TimeCount,Mesh,Continuous,EOF,SolverId) CALL Info(Caller,'Number of variable to read is: '//I2S(j),Level=10) IF( ALLOCATED( ListVariableFound ) ) DEALLOCATE( ListVariableFound ) ALLOCATE( ListVariableFound(j) ) + ListVariableFound = .FALSE. CALL Info(Caller,'Reading only '//I2S(j)//' variables given by: "Restart Variable i"',Level=10) ELSE CALL Info(Caller,'Reading all variables (if not wanted use "Restart Variable i" )',Level=10) @@ -4558,10 +4571,9 @@ SUBROUTINE LoadRestartFile( RestartFile,TimeCount,Mesh,Continuous,EOF,SolverId) !------------------------------- LoadThis = .TRUE. - ! If list is give check that variable is on the list. + ! If list is given check that variable is on the list. !--------------------------------------------------------------------------- IF( ListVariableCount > 0 ) THEN - ListVariableFound = .FALSE. DO j=1,ListVariableCount LoadThis = .FALSE. VarName2 = ListGetString( ResList,'Restart Variable '//I2S(j), Found ) diff --git a/fem/src/NavierStokesCylindrical.F90 b/fem/src/NavierStokesCylindrical.F90 index e307015d3b..ffff373cb1 100644 --- a/fem/src/NavierStokesCylindrical.F90 +++ b/fem/src/NavierStokesCylindrical.F90 @@ -218,7 +218,7 @@ SUBROUTINE NavierStokesCylindricalCompose ( & IF ( Bubbles ) THEN IntegStuff = GaussPoints( Element, Element % TYPE % GaussPoints2 ) ELSE - IntegStuff = GaussPoints( Element ) + IntegStuff = GaussPointsAdapt( Element ) END IF U_Integ => IntegStuff % u V_Integ => IntegStuff % v diff --git a/fem/src/ParticleUtils.F90 b/fem/src/ParticleUtils.F90 index e7f7eae351..e186a4c1f3 100644 --- a/fem/src/ParticleUtils.F90 +++ b/fem/src/ParticleUtils.F90 @@ -49,6 +49,7 @@ MODULE ParticleUtils USE Lists USE MeshUtils USE GeneralUtils + USE SaveUtils IMPLICIT NONE diff --git a/fem/src/SOLVER.KEYWORDS b/fem/src/SOLVER.KEYWORDS index 014929c6b7..7698de8e43 100644 --- a/fem/src/SOLVER.KEYWORDS +++ b/fem/src/SOLVER.KEYWORDS @@ -1773,6 +1773,7 @@ solver:real: 'Linear System Robust Tolerance' solver:real: 'Linear System Robust Limit' solver:real: 'Linear System Robust Margin' solver:integer: 'Linear System Robust Max Iterations' +solver:integer: 'Linear System Robust Start Iteration' solver:logical: 'IDRS Smoothing' solver:integer: 'scanning loops' bc:logical: 'air gap' diff --git a/fem/src/SParIterSolver.F90 b/fem/src/SParIterSolver.F90 index bff3a848db..ba7f82c03a 100644 --- a/fem/src/SParIterSolver.F90 +++ b/fem/src/SParIterSolver.F90 @@ -2055,6 +2055,10 @@ END SUBROUTINE SolveTrilinos4 ! !------------------------------------------------------------------ + CALL Info(Caller,'Copying Matrix values into SplittedMatrix',Level=20) + CALL ResetTimer('SplittedMatrix') + + GT => SplittedMatrix % GlueTable DO i = 1, SourceMatrix % NumberOfRows GRow = ParallelInfo % GlobalDOFs(i) @@ -2154,12 +2158,14 @@ END SUBROUTINE SolveTrilinos4 END DO CALL GlueFinalize( SourceMatrix, SplittedMatrix, ParallelInfo ) + CALL CheckTimer('SplittedMatrix',Level=7,Delete=.TRUE.) + !------------------------------------------------------------------ - ! ! Call the actual solver routine (based on older design) - ! !------------------------------------------------------------------ + CALL Info(Caller,'Going into actual parallel solution',Level=20) + CALL Solve( SourceMatrix, SParMatrixDesc % SplittedMatrix, & ParallelInfo, RHSVec, XVec, Solver, Errinfo ) @@ -2436,9 +2442,7 @@ SUBROUTINE Solve( SourceMatrix, SplittedMatrix, ParallelInfo, & PIGpntr => GlobalData !---------------------------------------------------------------------- - ! ! Initialize Right-Hand-Side - ! !---------------------------------------------------------------------- ALLOCATE(TmpRHSVec(SplittedMatrix % InsideMatrix % NumberOfRows)) TmpRHSVec = 0 @@ -2495,12 +2499,10 @@ SUBROUTINE Solve( SourceMatrix, SplittedMatrix, ParallelInfo, & GlobalMatrix % Ematrix => SourceMatrix GlobalMatrix % COMPLEX = SourceMatrix % COMPLEX + !---------------------------------------------------------------------- - ! ! Set up the preconditioner - ! !---------------------------------------------------------------------- - IF (SplittedMatrix % InsideMatrix % NumberOFRows>0) THEN ! IF (SplittedMatrix % InsideMatrix % Diag(1)==0) THEN DO i = 1, SplittedMatrix % InsideMatrix % NumberOfRows @@ -2533,11 +2535,8 @@ SUBROUTINE Solve( SourceMatrix, SplittedMatrix, ParallelInfo, & !---------------------------------------------------------------------- - ! ! Call the main iterator routine - ! !---------------------------------------------------------------------- - CM => SourceMatrix % ConstraintMatrix IF (ASSOCIATED(CM)) THEN ALLOCATE(SPerm(SourceMatrix % NumberOfRows)); SPerm=0 @@ -2576,9 +2575,7 @@ SUBROUTINE Solve( SourceMatrix, SplittedMatrix, ParallelInfo, & GlobalMatrix => SaveMatrix !---------------------------------------------------------------------- - ! ! Collect the result - ! !---------------------------------------------------------------------- ALLOCATE( VecEPerNB( ParEnv % PEs ) ) VecEPerNB = 0 @@ -2609,12 +2606,10 @@ SUBROUTINE Solve( SourceMatrix, SplittedMatrix, ParallelInfo, & END DO CALL ExchangeResult( SourceMatrix,SplittedMatrix,ParallelInfo,XVec ) + !---------------------------------------------------------------------- - ! ! Clean the work space - ! !---------------------------------------------------------------------- - DEALLOCATE( TmpXVec, TmpRHSVec, VecEPerNB ) !---------------------------------------------------------------------- END SUBROUTINE Solve diff --git a/fem/src/SaveUtils.F90 b/fem/src/SaveUtils.F90 index 4e788c3c22..52e787ebc4 100644 --- a/fem/src/SaveUtils.F90 +++ b/fem/src/SaveUtils.F90 @@ -774,6 +774,651 @@ SUBROUTINE GenerateSavePermutation(Mesh,DG,DN,LagN,SaveLinear,ActiveElem,NumberO END IF END SUBROUTINE GenerateSavePermutation - + + + !> Defines and potentially creates output directory. + !> The output directory may given in different ways, and even be part of the + !> filename, or be relative to home directory. We try to parse every possible + !> scenario here that user might have in mind. + !----------------------------------------------------------------------------- + SUBROUTINE SolverOutputDirectory( Solver, Filename, OutputDirectory, & + MakeDir, UseMeshDir ) + + USE ModelDescription + + TYPE(Solver_t) :: Solver + LOGICAL, OPTIONAL :: MakeDir, UseMeshDir + CHARACTER(*) :: Filename + CHARACTER(:), ALLOCATABLE :: OutputDirectory + + LOGICAL :: Found, AbsPathInName, DoDir, PartitioningSubDir + INTEGER :: nd, nf, n + CHARACTER(LEN=MAX_NAME_LEN) :: Str + + IF( PRESENT( MakeDir ) ) THEN + DoDir = MakeDir + ELSE + DoDir = ( Solver % TimesVisited == 0 ) .AND. ( ParEnv % MyPe == 0 ) + END IF + + ! Output directory is obtained in order + ! 1) solver section + ! 2) simulation section + ! 3) header section + OutputDirectory = ListGetString( Solver % Values,'Output Directory',Found) + IF(.NOT. Found) OutputDirectory = ListGetString( CurrentModel % Simulation,& + 'Output Directory',Found) + + IF(.NOT. Found) OutputDirectory = TRIM(OutputPath) + nd = LEN_TRIM(OutputDirectory) + + ! If the path is just working directory then that is not an excude + ! to not use the mesh name, or directory that comes with the filename + IF(.NOT. Found .AND. nd == 1 .AND. OutputDirectory(1:1)=='.') nd = 0 + + ! If requested by the optional parameter use the mesh directory when + ! no results directory given. This is an old convection used in some solvers. + IF( nd == 0 .AND. PRESENT( UseMeshDir ) ) THEN + IF( UseMeshDir ) THEN + OutputDirectory = TRIM(CurrentModel % Mesh % Name) + nd = LEN_TRIM(OutputDirectory) + END IF + END IF + + ! Use may have given part or all of the path in the filename. + ! This is not preferred, but we cannot trust the user. + nf = LEN_TRIM(Filename) + n = INDEX(Filename(1:nf),'/') + AbsPathInName = INDEX(FileName,':')>0 .OR. (Filename(1:1)=='/') & + .OR. (Filename(1:1)==Backslash) + + IF( nd > 0 .AND. .NOT. AbsPathInName ) THEN + ! Check that we have not given the path relative to home directory + ! because the code does not understand the meaning of tilde. + IF(nd>=2) THEN + IF( OutputDirectory(1:2) == '~/') THEN + CALL get_environment_variable('HOME',Str) + OutputDirectory = TRIM(Str)//'/'//OutputDirectory(3:nd) + nd = LEN_TRIM(OutputDirectory) + END IF + END IF + ! To be on the safe side create the directory. If it already exists no harm done. + ! Note that only one directory may be created. Hence if there is a path with many subdirectories + ! that will be a problem. Fortran does not have a standard ENQUIRE for directories hence + ! we just try to make it. + IF( DoDir ) THEN + CALL Info('SolverOutputDirectory','Creating directory: '//TRIM(OutputDirectory(1:nd)),Level=8) + CALL MakeDirectory( OutputDirectory(1:nd) // CHAR(0) ) + END IF + END IF + + ! In this case the filename includes also path and we remove it from there and + ! add it to the directory. + IF( n > 2 ) THEN + CALL Info('SolverOutputDirectory','Parcing path from filename: '//TRIM(Filename(1:n)),Level=10) + IF( AbsPathInName .OR. nd == 0) THEN + ! If the path is absolute then it overruns the given path! + OutputDirectory = Filename(1:n-1) + nd = n-1 + ELSE + ! If path is relative we add it to the OutputDirectory and take it away from Filename + OutputDirectory = OutputDirectory(1:nd)//'/'//Filename(1:n-1) + nd = nd + n + END IF + Filename = Filename(n+1:nf) + + IF( DoDir ) THEN + CALL Info('SolverOutputDirectory','Creating directory: '//TRIM(OutputDirectory(1:nd)),Level=8) + CALL MakeDirectory( OutputDirectory(1:nd) // CHAR(0) ) + END IF + END IF + + ! Finally, on request save each partitioning to different directory. + PartitioningSubDir = ListGetLogical( Solver % Values,'Output Partitioning Directory',Found) + IF(.NOT. Found ) THEN + PartitioningSubDir = ListGetLogical( CurrentModel % Simulation,'Output Partitioning Directory',Found) + END IF + IF( PartitioningSubDir ) THEN + OutputDirectory = TRIM(OutputDirectory)//'/np'//I2S(ParEnv % PEs) + nd = LEN_TRIM(OutputDirectory) + IF( DoDir ) THEN + CALL Info('SolverOutputDirectory','Creating directory: '//TRIM(OutputDirectory(1:nd)),Level=8) + CALL MakeDirectory( OutputDirectory(1:nd) // CHAR(0) ) + END IF + END IF + + END SUBROUTINE SolverOutputDirectory + !----------------------------------------------------------------------------- + + + !------------------------------------------------------------------------------ + !> Saves results in ascii format understood by the pre-/postprocessing software Gmsh. + !------------------------------------------------------------------------------ + SUBROUTINE SaveGmshOutput( Model,Solver,dt,Transient ) + !------------------------------------------------------------------------------ + USE Types + USE Lists + IMPLICIT NONE + !------------------------------------------------------------------------------ + TYPE(Solver_t) :: Solver + TYPE(Model_t) :: Model + REAL(KIND=dp) :: dt + LOGICAL :: Transient + !------------------------------------------------------------------------------ + ! Local variables + !------------------------------------------------------------------------------ + TYPE(Element_t),POINTER :: Element + INTEGER, POINTER :: Perm(:) + REAL(KIND=dp), POINTER :: Values(:),Values2(:),Values3(:) + REAL(KIND=dp) :: Vector(3), Time + COMPLEX(KIND=dp), POINTER :: CValues(:) + TYPE(Variable_t), POINTER :: Solution, TimeVariable + TYPE(ValueList_t), POINTER :: Params + TYPE(Mesh_t), POINTER :: Mesh + + LOGICAL :: Found, GotField, FileAppend, AlterTopology, MaskExists + LOGICAL :: EigenAnalysis = .FALSE., EigenActive, ComponentVector, Parallel + + INTEGER :: VisitedTimes = 0, ExtCount + INTEGER :: i,j,k,l,m,n,nsize,dim,dofs,ElmerCode, GmshCode,body_id, Vari, Rank, truedim + INTEGER :: Tag, NumberOfAllElements, BCOffSet + INTEGER, PARAMETER :: MaxElemCode = 827 + INTEGER :: ElmerToGmshType(MaxElemCode), GmshToElmerType(21), & + ElmerIndexes(27), GmshIndexes(27) + INTEGER, POINTER :: NodeIndexes(:) + + INTEGER, ALLOCATABLE :: NodePerm(:),DgPerm(:) + INTEGER, ALLOCATABLE, TARGET :: InvDgPerm(:), InvNodePerm(:) + LOGICAL, ALLOCATABLE :: ActiveElem(:) + LOGICAL :: NoPermutation, Numbering + INTEGER :: NumberOfGeomNodes, NumberOfDofNodes,NumberOfElements, ElemFirst, ElemLast,bc_id + INTEGER, POINTER :: InvFieldPerm(:), DGInvPerm(:) + + INTEGER, PARAMETER :: LENGTH = 1024 + CHARACTER(LEN=LENGTH) :: Txt, FieldName, CompName + CHARACTER(MAX_NAME_LEN) :: OutputFile + CHARACTER(:), ALLOCATABLE :: OutputDirectory + INTEGER :: GmshUnit + CHARACTER(*), PARAMETER :: Caller = 'SaveGmshOutput' + + SAVE VisitedTimes + + !------------------------------------------------------------------------------ + + CALL Info(Caller,'Saving results in Gmsh format') + + Mesh => Model % Mesh + Params => Solver % Values + Parallel = ( ParEnv % PEs > 1 ) + + ExtCount = ListGetInteger( Params,'Output Count',Found) + IF( Found ) THEN + VisitedTimes = ExtCount + ELSE + VisitedTimes = VisitedTimes + 1 + END IF + + Numbering = ListGetLogical( Params,'Filename Numbering',Found ) + IF(.NOT. Found) Numbering = .TRUE. + + GmshToElmerType = (/ 202, 303, 404, 504, 808, 706, 605, 203, 306, 409, & + 510, 827, 0, 0, 101, 408, 820, 715, 613, 0, 310 /) + ElmerToGmshType = 0 + + DO i=1,SIZE(GmshToElmerType) + j = GmshToElmerType(i) + IF( j > 0 ) ElmerToGmshType(j) = i + END DO + + EigenAnalysis = ListGetLogical( Params, 'Eigen Analysis', Found ) + FileAppend = ListGetLogical( Params,'File Append',Found) + IF(.NOT. Found) FileAppend = .TRUE. + AlterTopology = ListGetLogical( Params,'Alter Topology',Found) + + OutputFile = ListGetString( Params, 'Output File Name', Found ) + IF( Found ) THEN + IF(INDEX(OutputFile,'.') == 0) WRITE( OutputFile,'(A,A)') TRIM(OutputFile),".msh" + ELSE + OutputFile = 'Output.msh' + END IF + + CALL SolverOutputDirectory( Solver, OutputFile, OutputDirectory, UseMeshDir = .TRUE. ) + OutputFile = TRIM(OutputDirectory)// '/' //TRIM(OutputFile) + + !------------------------------------------------------------------------------ + ! Initialize stuff for masked saving + !------------------------------------------------------------------------------ + CALL GenerateSaveMask(Mesh,Params,Parallel,0,.FALSE.,& + NodePerm,ActiveElem,NumberOfGeomNodes,NumberOfElements,& + ElemFirst,ElemLast) + + IF( ParEnv % PEs > 1 ) THEN + IF( NumberOfElements == 0 ) THEN + CALL Info(Caller,'Nothing to save in partition: '//TRIM(I2S(ParEnv % MyPe)),Level=8) + RETURN + ELSE + OutputFile = TRIM(OutputFile)//'_'//I2S(ParEnv % PEs)//'np'//I2S(ParEnv % MyPe+1) + END IF + ELSE + IF( NumberOfElements == 0 ) THEN + CALL Warn(Caller,'Notging to save, this is suspicious') + RETURN + END IF + END IF + + CALL GenerateSavePermutation(Mesh,.FALSE.,.FALSE.,0,.FALSE.,& + ActiveElem,NumberOfGeomNodes,NoPermutation,NumberOfDofNodes,& + DgPerm,InvDgPerm,NodePerm,InvNodePerm) + + InvFieldPerm => InvNodePerm + + dim = CoordinateSystemDimension() + IF( VisitedTimes > 1 ) THEN + IF( AlterTopology ) THEN + IF( Numbering ) THEN + OutputFile = NextFreeFilename( OutputFile ) + END IF + CALL Info(Caller,'Writing mesh and data to a new file: '//TRIM(OutputFile)) + ELSE IF( FileAppend ) THEN + CALL Info(Caller,'Appending data to the same file: '//TRIM(OutputFile)) + OPEN(NEWUNIT=GmshUnit, FILE=OutputFile, POSITION='APPEND' ) + GOTO 10 + ELSE + IF( Numbering ) THEN + OutputFile = NextFreeFilename( OutputFile ) + END IF + CALL Info(Caller,'Writing data to a new file: '//TRIM(OutputFile)) + OPEN(NEWUNIT=GmshUnit, FILE=OutputFile ) + WRITE(GmshUnit,'(A)') '$MeshFormat' + WRITE(GmshUnit,'(A)') '2.0 0 8' + WRITE(GmshUnit,'(A)') '$EndMeshFormat' + GOTO 10 + END IF + END IF + + + ! Save the header + !------------------------------------------------- + CALL Info(Caller,'Saving results to file: '//TRIM(OutputFile)) + OPEN(NEWUNIT=GmshUnit, FILE=OutputFile ) + + WRITE(GmshUnit,'(A)') '$MeshFormat' + WRITE(GmshUnit,'(A)') '2.0 0 8' + WRITE(GmshUnit,'(A)') '$EndMeshFormat' + + + ! Save the mesh nodes + !------------------------------------------------- + CALL Info(Caller,'Writing the mesh nodes') + CALL WriteGmshNodes() + + ! Save the mesh elements + !------------------------------------------------- + CALL Info(Caller,'Writing the mesh elements') + CALL WriteGmshElements() + + ! With a mask the list of physical entities should be checked + !------------------------------------------------------------- + IF(.NOT. MaskExists ) THEN + ! CALL WritePhysicalNames() + END IF + +10 CONTINUE + + CALL Info(Caller,'Writing the nodal data') + CALL WriteGmshData() + + IF(.FALSE.) THEN + WRITE(GmshUnit,'(A)') '$ElementData' + WRITE(GmshUnit,'(A)') '$EndElementData' + END IF + + IF(.FALSE.) THEN + WRITE(GmshUnit,'(A)') '$ElementNodeData' + WRITE(GmshUnit,'(A)') '$EndElementNodeData' + END IF + + CLOSE(GmshUnit) + + IF(ALLOCATED(DgPerm)) DEALLOCATE(DgPerm) + IF(ALLOCATED(InvDgPerm)) DEALLOCATE(InvDgPerm) + IF(ALLOCATED(NodePerm)) DEALLOCATE(NodePerm) + IF(ALLOCATED(InvNodePerm)) DEALLOCATE(InvNodePerm) + IF(ALLOCATED(ActiveElem)) DEALLOCATE(ActiveElem) + + + CALL Info(Caller,'Gmsh output complete') + + CONTAINS + + SUBROUTINE WriteGmshNodes() + + nsize = NumberOfGeomNodes + + WRITE(GmshUnit,'(A)') '$Nodes' + WRITE(GmshUnit,'(I8)') nsize + DO i = 1, nsize + IF( NoPermutation ) THEN + j = i + ELSE + j = InvNodePerm(i) + END IF + + IF( dim == 3 ) THEN + WRITE(GmshUnit,'(I8,3ES16.7E3)') i,Mesh % Nodes % x(j),Mesh % Nodes % y(j), Mesh % Nodes % z(j) + ELSE + WRITE(GmshUnit,'(I8,2ES16.7E3,A)') i,Mesh % Nodes % x(j),Mesh % Nodes % y(j),' 0.0' + END IF + END DO + WRITE(GmshUnit,'(A)') '$EndNodes' + END SUBROUTINE WriteGmshNodes + + + SUBROUTINE WriteGmshElements() + + nsize = NumberOfElements + + BCOffSet = 100 + DO WHILE( BCOffset <= Model % NumberOfBodies ) + BCOffset = 10 * BCOffset + END DO + + WRITE(GmshUnit,'(A)') '$Elements' + WRITE(GmshUnit,'(I8)') nsize + + l = 0 + DO i = ElemFirst, ElemLast + IF(.NOT. ActiveElem(i) ) CYCLE + + l = l + 1 + Element => Mesh % Elements(i) + ElmerCode = Element % TYPE % ElementCode + + n = Element % Type % NumberOfNodes + IF( NoPermutation ) THEN + ElmerIndexes(1:n) = Element % NodeIndexes(1:n) + ELSE + ElmerIndexes(1:n) = NodePerm(Element % NodeIndexes(1:n)) + END IF + + GmshCode = ElmerToGmshType(ElmerCode) + IF( GmshCode == 0 ) THEN + CALL Warn(Caller,'Gmsh element index not found!') + CYCLE + END IF + + IF( i <= Model % NumberOfBulkElements ) THEN + Tag = Element % BodyId + ELSE + DO bc_id=1,Model % NumberOfBCs + IF ( Element % BoundaryInfo % Constraint == Model % BCs(bc_id) % Tag ) EXIT + END DO + Tag = bc_id + BCOffset + END IF + + WRITE(GmshUnit,'(I8,I3,I3,I5,I5)',ADVANCE='NO') l,GmshCode,2,Tag,Tag + k = MOD(ElmerCode,100) + + CALL ElmerToGmshIndex(ElmerCode,ElmerIndexes,GmshIndexes) + + DO j=1,k-1 + WRITE(GmshUnit,'(I8)',ADVANCE='NO') GmshIndexes(j) + END DO + WRITE(GmshUnit,'(I8)') GmshIndexes(k) + END DO + WRITE(GmshUnit,'(A)') '$EndElements' + END SUBROUTINE WriteGmshElements + + + SUBROUTINE WritePhysicalNames() + CALL Info(Caller,'Writing the physical entity names') + nsize = Model % NumberOfBodies + Model % NumberOfBCs + WRITE(GmshUnit,'(A)') '$PhysicalNames' + WRITE(GmshUnit,'(I8)') nsize + DO i=1,Model % NumberOfBodies + Txt = ListGetString( Model % Bodies(i) % Values,'Name',Found) + IF( Found ) THEN + WRITE(GmshUnit,'(I8,A)') i,'"'//TRIM(Txt)//'"' + ELSE + WRITE(GmshUnit,'(I8,A,I0,A)') i,'"Body ',i,'"' + END IF + END DO + DO i=1,Model % NumberOfBCs + Txt = ListGetString( Model % BCs(i) % Values,'Name',Found) + IF( Found ) THEN + WRITE(GmshUnit,'(I8,A)') i+BCOffset,'"'//TRIM(Txt)//'"' + ELSE + WRITE(GmshUnit,'(I8,A,I0,A)') i+BCOffset,'"Boundary Condition ',i,'"' + END IF + END DO + WRITE(GmshUnit,'(A)') '$EndPhysicalNames' + END SUBROUTINE WritePhysicalNames + + + ! In case of DG fields we average the fields on-the-fly to nodes. + !---------------------------------------------------------------- + SUBROUTINE CreateTemporalNodalField(Mesh,Solution,Revert) + TYPE(Mesh_t) :: Mesh + TYPE(Variable_t) :: Solution + LOGICAL, OPTIONAL :: revert + + REAL(KIND=dp), POINTER :: NodalVals(:), TmpVals(:) + INTEGER, POINTER :: NodalPerm(:), TmpPerm(:), NodalCnt(:) + INTEGER :: i,j,k,l,n,t,dofs,ElemFam + + SAVE NodalPerm, NodalVals, NodalCnt, TmpPerm, TmpVals + + IF( PRESENT( Revert ) ) THEN + IF( Revert ) THEN + DEALLOCATE( NodalVals, NodalPerm, NodalCnt ) + Solution % Perm => TmpPerm + Solution % Values => TmpVals + RETURN + END IF + END IF + + dofs = Solution % dofs + + n = Mesh % NumberOfNodes + ALLOCATE( NodalPerm(n), NodalCnt(n), NodalVals(n*dofs) ) + NodalPerm = 0 + NodalCnt = 0 + NodalVals = 0.0_dp + + DO t=1,Mesh % NumberOfBulkElements + Element => Mesh % Elements(t) + + ! This is just a quick hack to not consider those element in averaging that don't + ! even have one face on the active set of nodes. + IF( ALLOCATED(NodePerm) ) THEN + ElemFam = Element % TYPE % ElementCode / 100 + l = COUNT( NodePerm(Element % NodeIndexes ) > 0 ) + SELECT CASE(ElemFam) + CASE(3,4) + IF(l<2) CYCLE + CASE(5,6,7) + IF(l<3) CYCLE + CASE(8) + IF(l<4) CYCLE + END SELECT + END IF + + DO i=1,Element % TYPE % NumberOfNodes + j = Element % DGIndexes(i) + k = Element % NodeIndexes(i) + + NodalCnt(k) = NodalCnt(k) + 1 + NodalPerm(k) = k + + j = Solution % Perm(j) + IF(j==0) CYCLE + + DO l=1,dofs + NodalVals(dofs*(k-1)+l) = NodalVals(dofs*(k-1)+l) + Solution % Values(dofs*(j-1)+l) + END DO + END DO + END DO + + DO i=1,dofs + WHERE ( NodalCnt > 0 ) + NodalVals(i::dofs) = NodalVals(i::dofs) / NodalCnt + END WHERE + END DO + + TmpVals => Solution % Values + TmpPerm => Solution % Perm + + Solution % Perm => NodalPerm + Solution % Values => NodalVals + + + END SUBROUTINE CreateTemporalNodalField + + + + + SUBROUTINE WriteGmshData() + INTEGER :: ii + LOGICAL :: DgVar + + + ! Time is needed + !------------------------------------------------- + TimeVariable => VariableGet( Model % Variables, 'Time' ) + Time = TimeVariable % Values(1) + + ! Loop over different type of variables + !------------------------------------------------- + DO Rank = 0,2 + DO Vari = 1, 999 + IF(Rank==0) WRITE(Txt,'(A,I0)') 'Scalar Field ',Vari + IF(Rank==1) WRITE(Txt,'(A,I0)') 'Vector Field ',Vari + IF(Rank==2) WRITE(Txt,'(A,I0)') 'Tensor Field ',Vari + + FieldName = ListGetString( Params, TRIM(Txt), Found ) + IF(.NOT. Found) EXIT + IF( Rank == 2) THEN + CALL Warn(Caller,'Not implemented yet for tensors!') + CYCLE + END IF + + ComponentVector = .FALSE. + Solution => VariableGet( Mesh % Variables, FieldName ) + DGVar = .FALSE. + + IF(ASSOCIATED(Solution)) THEN + DGVar = ( Solution % TYPE == Variable_on_nodes_on_elements ) + IF(DgVar) CALL CreateTemporalNodalField(Mesh,Solution) + + Values => Solution % Values + Perm => Solution % Perm + dofs = Solution % DOFs + ELSE + IF( Rank == 1 ) THEN + Solution => VariableGet( Mesh % Variables, FieldName//' 1' ) + IF( ASSOCIATED( Solution ) ) THEN + ComponentVector = .TRUE. + Values => Solution % Values + Perm => Solution % Perm + dofs = 1 + Solution => VariableGet( Mesh % Variables, FieldName//' 2' ) + IF( ASSOCIATED(Solution)) THEN + Values2 => Solution % Values + dofs = 2 + END IF + Solution => VariableGet( Mesh % Variables, FieldName//' 3' ) + IF( ASSOCIATED(Solution)) THEN + Values3 => Solution % Values + dofs = 3 + END IF + END IF + END IF + IF( .NOT. ASSOCIATED(Solution)) THEN + CALL Warn(Caller,'Variable not present: '//TRIM(FieldName)) + CYCLE + END IF + END IF + + CALL Info(Caller,'Saving nodal variable: '//TRIM(FieldName),Level=12) + + IF( ASSOCIATED(Solution % EigenVectors) ) THEN + CALL Warn(Caller,'Eigenvectors related to field: '//TRIM(FieldName)) + CALL Warn(Caller,'Eigenvectors saving yet not supported') + END IF + + truedim = MIN(dofs, dim) + nsize = NumberOfGeomNodes + + WRITE(GmshUnit,'(A)') '$NodeData' + WRITE(GmshUnit,'(A)') '1' + WRITE(GmshUnit,'(A)') '"'//TRIM(FieldName)//'"' + WRITE(GmshUnit,'(A)') '1' + + ! Gmsh starts steady state indexes from zero, hence deductions by one + IF( Transient ) THEN + WRITE(GmshUnit,'(ES16.7E3)') Time + ELSE + WRITE(GmshUnit,'(ES16.7E3)') Time - 1.0_dp + END IF + WRITE(GmshUnit,'(A)') '3' + WRITE(GmshUnit,'(I8)') VisitedTimes-1 + IF(Rank == 0) THEN + WRITE(GmshUnit,'(A)') '1' + ELSE IF(Rank == 1) THEN + WRITE(GmshUnit,'(A)') '3' + ELSE + WRITE(GmshUnit,'(A)') '9' + END IF + WRITE(GmshUnit,'(I8)') nsize + + DO ii = 1, NumberOfGeomNodes + IF( NoPermutation ) THEN + i = ii + ELSE + i = InvFieldPerm(ii) + END IF + + IF( ASSOCIATED( Perm ) ) THEN + j = Perm(i) + ELSE + j = i + END IF + + IF( Rank == 0 ) THEN + WRITE(GmshUnit,'(I8,ES16.7E3)') ii,Values(j) + ELSE IF(Rank == 1) THEN + IF( j == 0 ) THEN + WRITE(GmshUnit,'(I8,A)') ii,' 0.0 0.0 0.0' + ELSE IF( ComponentVector ) THEN + IF( truedim == 2 ) THEN + WRITE(GmshUnit,'(I8,2ES16.7E3,A)') ii,& + Values(j),Values2(j),' 0.0' + ELSE + WRITE(GmshUnit,'(I8,3ES16.7E3)') ii,& + Values(j),Values2(j),Values3(j) + END IF + ELSE + IF( truedim == 2 ) THEN + WRITE(GmshUnit,'(I8,2ES16.7E3,A)') ii,& + Values(dofs*(j-1)+1),Values(dofs*(j-1)+2),' 0.0' + ELSE + WRITE(GmshUnit,'(I8,3ES16.7E3)') ii,& + Values(dofs*(j-1)+1),Values(dofs*(j-1)+2),Values(dofs*(j-1)+3) + END IF + END IF + END IF + END DO + WRITE(GmshUnit,'(A)') '$EndNodeData' + + IF(DgVar) CALL CreateTemporalNodalField(Mesh,Solution,Revert=.TRUE.) + + END DO + END DO + END SUBROUTINE WriteGmshData + +!------------------------------------------------------------------------------ + END SUBROUTINE SaveGmshOutput +!------------------------------------------------------------------------------ + END MODULE SaveUtils diff --git a/fem/src/SolverUtils.F90 b/fem/src/SolverUtils.F90 index 93629110d1..69494d9b21 100644 --- a/fem/src/SolverUtils.F90 +++ b/fem/src/SolverUtils.F90 @@ -1875,7 +1875,7 @@ SUBROUTINE DetermineContact( Solver ) WeightVar, NormalActiveVar, StickActiveVar, GapVar, ContactLagrangeVar TYPE(Element_t), POINTER :: Element TYPE(Mesh_t), POINTER :: Mesh - INTEGER :: i,j,k,l,n,m,t,ind,dofs, bf, Upper, & + INTEGER :: i,j,k,l,n,m,t,ind,dofs,cdofs,dim, bf, Upper, & ElemFirst, ElemLast, totsize, i2, j2, ind2, bc_ind, master_ind, & DistSign, LimitSign, DofN, DofT1, DofT2, Limited, LimitedMin, TimeStep REAL(KIND=dp), POINTER :: FieldValues(:), LoadValues(:), ElemLimit(:),pNormal(:,:),& @@ -1927,12 +1927,29 @@ SUBROUTINE DetermineContact( Solver ) FieldPerm => Var % Perm totsize = SIZE( FieldValues ) dofs = Var % Dofs + dim = Mesh % MeshDim Params => Solver % Values + IF(dofs == dim) THEN + cdofs = dim + ELSE IF(dofs == dim+1) THEN + CALL Info(Caller,'We seem to have mixed formulation, ignoring pressure!',Level=7) + cdofs = dim + ELSE + CALL Fatal(Caller,'Invalid number of dofs for contact problem: '//I2S(dofs)) + END IF + pContact = IsPelement(Mesh % Elements(1) ) + IF( pContact ) THEN + ! We only have to deal with the middle dofs if they are not condensated away! + IF( .NOT. ListGetLogical( Params,'Bubbles in Global System',Found ) ) THEN + IF(Found) pContact = .FALSE. + END IF + END IF IF( ListGetLogical( Params,'Contact Linear Basis',Found ) ) THEN pContact = .FALSE. END IF + IF( pContact ) THEN CALL Info(Caller,'Using p-elements for contact, if available in projector!',Level=8) END IF @@ -2046,7 +2063,7 @@ SUBROUTINE DetermineContact( Solver ) IF( FlatProjector ) THEN ActiveDirection = ListGetInteger( BC, 'Flat Projector Coordinate',Found ) - IF( .NOT. Found ) ActiveDirection = dofs + IF( .NOT. Found ) ActiveDirection = cdofs ELSE IF( PlaneProjector ) THEN pNormal => ListGetConstRealArray( BC,'Plane Projector Normal',Found) IF( ThisRotatedContact ) THEN @@ -2102,7 +2119,7 @@ SUBROUTINE DetermineContact( Solver ) ! Get the degrees of freedom related to the normal and tangential directions DofT1 = 0; DofT2 = 0 - DO i=1,dofs + DO i=1,cdofs IF( i == DofN ) CYCLE IF( DofT1 == 0 ) THEN DofT1 = i @@ -2321,12 +2338,12 @@ SUBROUTINE RotatedDisplacementField( ) IF( m == 0 ) CYCLE RotVec = 0._dp - DO k=1,Var % DOFs - RotVec(k) = RotatedField(Var % DOfs*(j-1)+k) + DO k=1,cdofs + RotVec(k) = RotatedField(dofs*(j-1)+k) END DO CALL RotateNTSystem( RotVec, i ) - DO k=1,Var % DOFs - RotatedField(Var % Dofs*(j-1)+k) = RotVec( k ) + DO k=1,cdofs + RotatedField(dofs*(j-1)+k) = RotVec( k ) END DO END DO @@ -2365,7 +2382,7 @@ FUNCTION CalculateContactLoad( ) RESULT ( LoadVar ) TempX => FieldValues END IF - CALL CalculateLoads( Solver, Solver % Matrix, TempX, Var % DOFs, .FALSE., LoadVar ) + CALL CalculateLoads( Solver, Solver % Matrix, TempX, dofs, .FALSE., LoadVar ) IF( InfoActive(30) ) THEN CALL VectorValuesRange(LoadVar % Values, SIZE(LoadVar % Values),'ContactLoad') @@ -2380,7 +2397,7 @@ END FUNCTION CalculateContactLoad SUBROUTINE PickLagrangeMultiplier( ) TYPE(Variable_t), POINTER :: LinSysVar, ContactSysVar, ActiveVar - INTEGER :: i,j,k,l,n,dofs + INTEGER :: i,j,k,l,n INTEGER, POINTER :: InvPerm(:) CALL Info(Caller,'Pick lagrange coefficient from the active set to whole set',Level=10) @@ -2408,7 +2425,6 @@ SUBROUTINE PickLagrangeMultiplier( ) InvPerm => Solver % Matrix % ConstraintMatrix % InvPerm n = Solver % Matrix % ConstraintMatrix % NumberOfRows - dofs = Solver % Variable % dofs DO i=1,SIZE(InvPerm) ! This is related to the full matrix equation @@ -2511,7 +2527,7 @@ SUBROUTINE GetContactFields( DoAllocate ) TRIM(VarName)//' Contact Stick',1,Perm = BoundaryPerm ) IF( CalculateVelocity ) THEN CALL VariableAddVector( Model % Variables,Mesh,Solver,& - TRIM(VarName)//' Contact Velocity',Dofs,Perm = BoundaryPerm ) + TRIM(VarName)//' Contact Velocity',cDofs,Perm = BoundaryPerm ) END IF CALL VariableAddVector( Model % Variables,Mesh,Solver,& TRIM(VarName)//' Lagrange Multiplier',1,Perm = BoundaryPerm ) @@ -2559,7 +2575,7 @@ SUBROUTINE InitializeMortarVectors() LOGICAL :: SamePerm, SameSize onesize = Projector % NumberOfRows - totsize = Dofs * onesize + totsize = cDofs * onesize IF( .NOT. AddDiag .AND. ASSOCIATED(MortarBC % Diag) ) THEN DEALLOCATE( MortarBC % Diag ) @@ -2625,8 +2641,8 @@ SUBROUTINE InitializeMortarVectors() k = MortarBC % Perm(i) IF( k == 0 ) CYCLE - DO l=1,Dofs - Active(Dofs*(j-1)+l) = MortarBC % Active(Dofs*(k-1)+l) + DO l=1,cDofs + Active(cDofs*(j-1)+l) = MortarBC % Active(cDofs*(k-1)+l) END DO END DO @@ -2687,9 +2703,9 @@ SUBROUTINE MarkInterfaceDofs() IF( j2 == 0 ) CYCLE k2 = MortarBC % perm( Indexes(i2) ) - DO l=1,Dofs - ind = Dofs * ( k - 1 ) + l - ind2 = Dofs * ( k2 - 1) + l + DO l=1,cDofs + ind = cDofs * ( k - 1 ) + l + ind2 = cDofs * ( k2 - 1) + l IF( MortarBC % Active(ind) .NEQV. MortarBC % Active(ind2) ) THEN InterfaceDof(ind) = .TRUE. @@ -2830,11 +2846,11 @@ SUBROUTINE CalculateMortarDistance() LocalNormal = NTT(:,1) LocalNormal0 = LocalNormal LocalT1 = NTT(:,2) - IF( Dofs == 3 ) LocalT2 = NTT(:,3) + IF( cDofs == 3 ) LocalT2 = NTT(:,3) ELSE LocalNormal = ContactNormal LocalT1 = ContactT1 - IF( Dofs == 3 ) LocalT2 = ContactT2 + IF( cDofs == 3 ) LocalT2 = ContactT2 END IF ! Compute normal of the master surface from the average sum of normals @@ -2855,13 +2871,13 @@ SUBROUTINE CalculateMortarDistance() ! Weighted direction for the unit vectors LocalNormal = LocalNormal + coeff * NTT(:,1) LocalT1 = LocalT1 + coeff * NTT(:,2) - IF( Dofs == 3 ) LocalT2 = LocalT2 + coeff * NTT(:,3) + IF( cDofs == 3 ) LocalT2 = LocalT2 + coeff * NTT(:,3) END DO ! Normalize the unit vector length to one LocalNormal = LocalNormal / SQRT( SUM( LocalNormal**2 ) ) LocalT1 = LocalT1 / SQRT( SUM( LocalT1**2 ) ) - IF( Dofs == 3 ) LocalT2 = LocalT2 / SQRT( SUM( LocalT1**2 ) ) + IF( cDofs == 3 ) LocalT2 = LocalT2 / SQRT( SUM( LocalT1**2 ) ) !PRINT *,'NodalNormal:',i,j,LocalNormal0,LocalNormal END IF @@ -2945,14 +2961,12 @@ SUBROUTINE CalculateMortarDistance() IF( ThisRotatedContact ) CoeffSign = -1 END IF - IF( dofs == 2 ) THEN - disp(1) = DispVals( 2 * l - 1) - disp(2) = DispVals( 2 * l ) + disp(1) = DispVals( dofs * (l-1) + 1) + disp(2) = DispVals( dofs * (l-1) + 2 ) + IF( cdofs == 2 ) THEN disp(3) = 0.0_dp ELSE - disp(1) = DispVals( 3 * l - 2) - disp(2) = DispVals( 3 * l - 1 ) - disp(3) = DispVals( 3 * l ) + disp(3) = DispVals( dofs * (l-1) + 3 ) END IF ! If nonlinear analysis is used we may need to cancel the introduced gap due to numerical errors @@ -2960,11 +2974,11 @@ SUBROUTINE CalculateMortarDistance() IF( ThisRotatedContact ) THEN ContactVec(1) = ContactVec(1) + coeff * SUM( LocalNormal * Disp ) ContactVec(2) = ContactVec(2) + coeff * SUM( LocalT1 * Disp ) - IF( Dofs == 3) ContactVec(3) = ContactVec(3) + coeff * SUM( LocalT2 * Disp ) + IF( cDofs == 3) ContactVec(3) = ContactVec(3) + coeff * SUM( LocalT2 * Disp ) ELSE ContactVec(1) = ContactVec(1) + coeff * SUM( ContactNormal * Disp ) ContactVec(2) = ContactVec(2) + coeff * SUM( ContactT1 * Disp ) - IF( Dofs == 3 ) ContactVec(3) = ContactVec(3) + coeff * SUM( ContactT2 * Disp ) + IF( cDofs == 3 ) ContactVec(3) = ContactVec(3) + coeff * SUM( ContactT2 * Disp ) END IF CYCLE END IF @@ -2975,14 +2989,12 @@ SUBROUTINE CalculateMortarDistance() PrevDisp = 0._dp IF( CalculateVelocity ) THEN - IF( dofs == 2 ) THEN - PrevDisp(1) = PrevDispVals( 2 * l - 1) - PrevDisp(2) = PrevDispVals( 2 * l ) + PrevDisp(1) = PrevDispVals( dofs * (l-1) + 1) + PrevDisp(2) = PrevDispVals( dofs * (l-1) + 2 ) + IF( cdofs == 2 ) THEN PrevDisp(3) = 0.0_dp ELSE - PrevDisp(1) = PrevDispVals( 3 * l - 2) - PrevDisp(2) = PrevDispVals( 3 * l - 1 ) - PrevDisp(3) = PrevDispVals( 3 * l ) + PrevDisp(3) = PrevDispVals( dofs * (l-1) + 3 ) END IF END IF @@ -3008,10 +3020,10 @@ SUBROUTINE CalculateMortarDistance() IF( ThisRotatedContact ) THEN ContactVec(2) = ContactVec(2) + coeff * SUM( LocalT1 * SlipCoord ) - IF( Dofs == 3) ContactVec(3) = ContactVec(3) + coeff * SUM( LocalT2 * SlipCoord ) + IF( cDofs == 3) ContactVec(3) = ContactVec(3) + coeff * SUM( LocalT2 * SlipCoord ) ELSE ContactVec(2) = ContactVec(2) + coeff * SUM( ContactT1 * SlipCoord ) - IF( Dofs == 3 ) ContactVec(3) = ContactVec(3) + coeff * SUM( ContactT2 * SlipCoord ) + IF( cDofs == 3 ) ContactVec(3) = ContactVec(3) + coeff * SUM( ContactT2 * SlipCoord ) END IF END IF @@ -3049,11 +3061,11 @@ SUBROUTINE CalculateMortarDistance() 200 IF( IsSlave ) THEN - MortarBC % Rhs(Dofs*(i-1)+DofN) = -ContactVec(1) + MortarBC % Rhs(cDofs*(i-1)+DofN) = -ContactVec(1) IF( StickContact .OR. TieContact ) THEN - MortarBC % Rhs(Dofs*(i-1)+DofT1) = -ContactVec(2) - IF( Dofs == 3 ) THEN - MortarBC % Rhs(Dofs*(i-1)+DofT2) = -ContactVec(3) + MortarBC % Rhs(cDofs*(i-1)+DofT1) = -ContactVec(2) + IF( cDofs == 3 ) THEN + MortarBC % Rhs(cDofs*(i-1)+DofT2) = -ContactVec(3) END IF END IF @@ -3075,8 +3087,8 @@ SUBROUTINE CalculateMortarDistance() GapVar % Values( j ) = ContactVec(1) IF( CalculateVelocity ) THEN - DO k=1,Dofs - VeloVar % Values( Dofs*(j-1)+k ) = ContactVelo(k) + DO k=1,cDofs + VeloVar % Values( cDofs*(j-1)+k ) = ContactVelo(k) END DO END IF END DO @@ -3120,8 +3132,8 @@ SUBROUTINE CalculateMortarDistance() DistVar % Values(j) = 0.0_dp GapVar % Values(j) = 0.0_dp IF( CalculateVelocity ) THEN - DO k=1,Dofs - VeloVar % Values( Dofs*(j-1)+k ) = 0.0_dp + DO k=1,cDofs + VeloVar % Values( cDofs*(j-1)+k ) = 0.0_dp END DO END IF ELSE @@ -3136,9 +3148,9 @@ SUBROUTINE CalculateMortarDistance() ( GapVar % Values(j1) + GapVar % Values(j2)) IF( CalculateVelocity ) THEN - DO k=1,Dofs - VeloVar % Values( Dofs*(j-1)+k ) = 0.5_dp * & - ( VeloVar % Values(Dofs*(j1-1)+k) + VeloVar % Values(Dofs*(j2-1)+k)) + DO k=1,cDofs + VeloVar % Values( cDofs*(j-1)+k ) = 0.5_dp * & + ( VeloVar % Values(cDofs*(j1-1)+k) + VeloVar % Values(cDofs*(j2-1)+k)) END DO END IF END IF @@ -3154,8 +3166,8 @@ SUBROUTINE CalculateMortarDistance() DistVar % Values(j) = 0.0_dp GapVar % Values(j) = 0.0_dp IF( CalculateVelocity ) THEN - DO k=1,Dofs - VeloVar % Values( Dofs*(j-1)+k ) = 0.0_dp + DO k=1,cDofs + VeloVar % Values( cDofs*(j-1)+k ) = 0.0_dp END DO END IF ELSE @@ -3171,9 +3183,9 @@ SUBROUTINE CalculateMortarDistance() ( GapVar % Values(j1) + GapVar % Values(j2)) IF( CalculateVelocity ) THEN - DO k=1,Dofs - VeloVar % Values( Dofs*(j-1)+k ) = 0.5_dp * & - ( VeloVar % Values(Dofs*(j1-1)+k) + VeloVar % Values(Dofs*(j2-1)+k)) + DO k=1,cDofs + VeloVar % Values( cDofs*(j-1)+k ) = 0.5_dp * & + ( VeloVar % Values(cDofs*(j1-1)+k) + VeloVar % Values(cDofs*(j2-1)+k)) END DO END IF END IF @@ -3306,7 +3318,7 @@ SUBROUTINE CalculateContactPressure() k = FieldPerm( Indexes(i) ) IF( k == 0 ) CYCLE - DO l=1,dofs + DO l=1,cdofs NodalForce(l) = LoadValues(dofs*(k-1)+l) END DO @@ -3458,7 +3470,7 @@ SUBROUTINE NormalContactSet() IF( k == 0 ) CYCLE k = UseLoadVar % Perm(j) - ind = Dofs * (i-1) + DofN + ind = cDofs * (i-1) + DofN ! Tie contact should always be in contact - if we have found a counterpart IF( TieContact ) THEN @@ -3560,7 +3572,7 @@ SUBROUTINE IncreaseContactSet( LimitedMin ) ! Nothing to do IF( LimitedMin <= 0 ) RETURN - LimitedNow = COUNT( MortarBC % active(DofN::Dofs) ) + LimitedNow = COUNT( MortarBC % active(DofN::cDofs) ) NewNodes = LimitedMin - LimitedNow IF( NewNodes <= 0 ) RETURN @@ -3577,7 +3589,7 @@ SUBROUTINE IncreaseContactSet( LimitedMin ) ! Find additional contact nodes from the closest non-contact nodes DO i = 1,Projector % NumberOfRows - ind = Dofs * (i-1) + DofN + ind = cDofs * (i-1) + DofN IF( MortarBC % Active(ind) ) CYCLE IF( Projector % InvPerm(i) == 0 ) CYCLE @@ -3610,7 +3622,7 @@ SUBROUTINE IncreaseContactSet( LimitedMin ) WRITE(Message,'(A,ES12.4)') 'Maximum distance needed for new nodes:',DistArray(NewNodes) CALL Info(Caller,Message,Level=8) - MortarBC % Active( Dofs*(IndArray-1)+DofN ) = .TRUE. + MortarBC % Active( cDofs*(IndArray-1)+DofN ) = .TRUE. DEALLOCATE( DistArray, IndArray ) @@ -3644,7 +3656,7 @@ SUBROUTINE TangentContactSet() k = UseLoadVar % Perm(j) ! If there is no contact there can be no stick either - indN = Dofs * (i-1) + DofN + indN = cDofs * (i-1) + DofN IF( .NOT. MortarBC % Active(indN) ) CYCLE NodeLoad = UseLoadVar % Values(k) @@ -3671,15 +3683,15 @@ SUBROUTINE TangentContactSet() ! For stick and tie contact inherit the active flag from the normal component IF( SlipContact ) THEN - MortarBC % Active( DofT1 :: Dofs ) = .FALSE. - IF( Dofs == 3 ) THEN - MortarBC % Active( DofT2 :: Dofs ) = .FALSE. + MortarBC % Active( DofT1 :: cDofs ) = .FALSE. + IF( cDofs == 3 ) THEN + MortarBC % Active( DofT2 :: cDofs ) = .FALSE. END IF GOTO 100 ELSE IF( StickContact .OR. TieContact ) THEN - MortarBC % Active( DofT1 :: Dofs ) = MortarBC % Active( DofN :: Dofs ) - IF( Dofs == 3 ) THEN - MortarBC % Active( DofT2 :: Dofs ) = MortarBC % Active( DofN :: Dofs ) + MortarBC % Active( DofT1 :: cDofs ) = MortarBC % Active( DofN :: cDofs ) + IF( cDofs == 3 ) THEN + MortarBC % Active( DofT2 :: cDofs ) = MortarBC % Active( DofN :: cDofs ) END IF GOTO 100 END IF @@ -3698,16 +3710,16 @@ SUBROUTINE TangentContactSet() IF( k == 0 ) CYCLE k = UseLoadVar % Perm(j) - indN = Dofs * (i-1) + DofN + indN = cDofs * (i-1) + DofN indT1 = ind - DofN + DofT1 - IF(Dofs == 3 ) indT2 = ind - DofN + DofT2 + IF(cDofs == 3 ) indT2 = ind - DofN + DofT2 ! If there is no contact there can be no stick either IF( .NOT. MortarBC % Active(indN) ) THEN IF( MortarBC % Active(indT1) ) THEN removed0 = removed0 + 1 MortarBC % Active(indT1) = .FALSE. - IF( Dofs == 3 ) MortarBC % Active(indT2) = .FALSE. + IF( cDofs == 3 ) MortarBC % Active(indT2) = .FALSE. END IF CYCLE END IF @@ -3719,7 +3731,7 @@ SUBROUTINE TangentContactSet() IF( Found .AND. coeff > 0.0_dp ) THEN IF( .NOT. MortarBC % Active(indT1) ) added = added + 1 MortarBC % Active(indT1) = .TRUE. - IF( Dofs == 3 ) MortarBC % Active(indT2) = .TRUE. + IF( cDofs == 3 ) MortarBC % Active(indT2) = .TRUE. CYCLE END IF @@ -3729,7 +3741,7 @@ SUBROUTINE TangentContactSet() IF( Found .AND. coeff > 0.0_dp ) THEN IF( MortarBC % Active(IndT1) ) removed = removed + 1 MortarBC % Active(indT1) = .FALSE. - IF( Dofs == 3 ) MortarBC % Active(indT2) = .FALSE. + IF( cDofs == 3 ) MortarBC % Active(indT2) = .FALSE. CYCLE END IF @@ -3750,15 +3762,15 @@ SUBROUTINE TangentContactSet() IF( TangentLoad > mustatic * ABS( NodeLoad ) ) THEN removed = removed + 1 MortarBC % Active(indT1) = .FALSE. - IF( Dofs == 3 ) MortarBC % Active(indT2) = .FALSE. + IF( cDofs == 3 ) MortarBC % Active(indT2) = .FALSE. END IF ELSE stickcoeff = ListGetRealAtNode( BC,'Stick Contact Coefficient', j, Found ) IF( Found ) THEN - DO l=1,Dofs - du(l) = VeloVar % Values( Dofs*(k-1)+l ) + DO l=1,cDofs + du(l) = VeloVar % Values( cDofs*(k-1)+l ) END DO - IF( Dofs == 3 ) THEN + IF( cDofs == 3 ) THEN Slip = SQRT(du(dofT1)**2 + du(DofT2)**2) ELSE Slip = ABS( du(dofT1) ) @@ -3766,7 +3778,7 @@ SUBROUTINE TangentContactSet() IF( stickcoeff * slip < mudynamic * ABS( NodeLoad ) ) THEN added = added + 1 MortarBC % Active(indT1) = .TRUE. - IF( Dofs == 3 ) MortarBC % Active(indT2) = .TRUE. + IF( cDofs == 3 ) MortarBC % Active(indT2) = .TRUE. END IF END IF END IF @@ -3795,13 +3807,13 @@ SUBROUTINE TangentContactSet() IF( j == 0 ) CYCLE k = NormalActiveVar % Perm(j) - IF( MortarBC % Active(Dofs*(i-1)+DofN) ) THEN + IF( MortarBC % Active(cDofs*(i-1)+DofN) ) THEN NormalActiveVar % Values(k) = 1.0_dp ELSE NormalActiveVar % Values(k) = -1.0_dp END IF - IF( MortarBC % Active(Dofs*(i-1)+DofT1) ) THEN + IF( MortarBC % Active(cDofs*(i-1)+DofT1) ) THEN StickActiveVar % Values(k) = 1.0_dp ELSE StickActiveVar % Values(k) = -1.0_dp @@ -3838,9 +3850,9 @@ SUBROUTINE StickCoefficientSet() IF( k == 0 ) CYCLE k = UseLoadVar % Perm(j) - indN = Dofs * (i-1) + DofN - indT1 = Dofs * (i-1) + DofT1 - IF(Dofs == 3 ) indT2 = Dofs * (i-1) + DofT2 + indN = cDofs * (i-1) + DofN + indT1 = cDofs * (i-1) + DofT1 + IF(cDofs == 3 ) indT2 = cDofs * (i-1) + DofT2 IF( .NOT. MortarBC % Active(indN) ) THEN ! If there is no contact there can be no stick either @@ -3854,7 +3866,7 @@ SUBROUTINE StickCoefficientSet() END IF MortarBC % Diag(indT1) = coeff - IF( Dofs == 3 ) MortarBC % Diag(indT2) = coeff + IF( cDofs == 3 ) MortarBC % Diag(indT2) = coeff END DO IF(InfoActive(30)) THEN @@ -3893,7 +3905,7 @@ SUBROUTINE QuadraticContactSet() DO i=1,n ElemActive(i) = MortarBC % Active( ElemInds(i) ) IF(j>0) THEN - ElemInds(i) = Dofs * ( j - 1) + DofN + ElemInds(i) = cDofs * ( j - 1) + DofN ElemActive(i) = MortarBC % Active( ElemInds(i) ) ELSE ElemActive(i) = .FALSE. @@ -4084,8 +4096,8 @@ SUBROUTINE ProjectFromSlaveToMaster() NormalLoadVar % Values( l2 ) = 0.0_dp SlipLoadVar % Values( l2 ) = 0.0_dp IF( CalculateVelocity ) THEN - DO k=1,Dofs - VeloVar % Values( Dofs*(l2-1)+k ) = 0.0_dp + DO k=1,cDofs + VeloVar % Values( cDofs*(l2-1)+k ) = 0.0_dp END DO END IF NodeDone( l2 ) = .TRUE. @@ -4099,9 +4111,9 @@ SUBROUTINE ProjectFromSlaveToMaster() NormalLoadVar % Values( l2 ) = NormalLoadVar % Values( l2 ) + coeff * NormalLoadVar % Values( l ) SlipLoadVar % Values( l2 ) = SlipLoadVar % Values( l2 ) + coeff * SlipLoadVar % Values( l ) IF( CalculateVelocity ) THEN - DO k=1,Dofs - VeloVar % Values( Dofs*(l2-1)+k ) = VeloVar % Values( Dofs*(l2-1)+k ) + & - coeff * VeloVar % Values( Dofs*(l-1)+k) + DO k=1,cDofs + VeloVar % Values( cDofs*(l2-1)+k ) = VeloVar % Values( cDofs*(l2-1)+k ) + & + coeff * VeloVar % Values( cDofs*(l-1)+k) END DO END IF END DO @@ -4119,16 +4131,16 @@ SUBROUTINE ProjectFromSlaveToMaster() NormalLoadVar % Values( i ) = NormalLoadVar % Values( i ) / CoeffTable( i ) SlipLoadVar % Values( i ) = SlipLoadVar % Values( i ) / CoeffTable( i ) IF( CalculateVelocity ) THEN - DO k=1,Dofs - VeloVar % Values( Dofs*(i-1)+k ) = VeloVar % Values( Dofs*(i-1)+k ) / CoeffTable( i ) + DO k=1,cDofs + VeloVar % Values( cDofs*(i-1)+k ) = VeloVar % Values( cDofs*(i-1)+k ) / CoeffTable( i ) END DO END IF ELSE NormalLoadVar % Values( i ) = 0.0_dp SlipLoadVar % Values( i ) = 0.0_dp IF( CalculateVelocity ) THEN - DO k=1,Dofs - VeloVar % Values( Dofs*(i-1)+k ) = 0.0_dp + DO k=1,cDofs + VeloVar % Values( cDofs*(i-1)+k ) = 0.0_dp END DO END IF END IF @@ -4148,8 +4160,8 @@ SUBROUTINE ProjectFromSlaveToMaster() IF( NormalActiveVar % Values( k ) < 0.0_dp ) THEN IF( CalculateVelocity ) THEN - DO l=1,Dofs - VeloVar % Values( Dofs*(k-1)+l ) = 0.0_dp + DO l=1,cDofs + VeloVar % Values( cDofs*(k-1)+l ) = 0.0_dp END DO END IF END IF @@ -4269,12 +4281,12 @@ SUBROUTINE SetSlideFriction() Rotated = GetSolutionRotation(NTT, j ) LocalNormal = NTT(:,1) LocalT1 = NTT(:,2) - IF( Dofs == 3 ) LocalT2 = NTT(:,3) + IF( cDofs == 3 ) LocalT2 = NTT(:,3) ELSE Rotated = .FALSE. LocalNormal = ContactNormal LocalT1 = ContactT1 - IF( Dofs == 3 ) LocalT2 = ContactT2 + IF( cDofs == 3 ) LocalT2 = ContactT2 END IF VeloCoeff = 0.0_dp @@ -4292,12 +4304,12 @@ SUBROUTINE SetSlideFriction() END IF END IF VeloCoeff(DofT1) = SUM( VeloDir(1:3,1) * LocalT1 ) - IF( Dofs == 3 ) THEN + IF( cDofs == 3 ) THEN VeloCoeff(DofT2) = SUM( VeloDir(1:3,1) * LocalT2 ) END IF ELSE - VeloCoeff(DofT1) = VeloVar % Values(Dofs*(k-1)+DofT1) - IF(Dofs==3) VeloCoeff(DofT2) = VeloVar % Values(Dofs*(k-1)+DofT2) + VeloCoeff(DofT1) = VeloVar % Values(cDofs*(k-1)+DofT1) + IF(cDofs==3) VeloCoeff(DofT2) = VeloVar % Values(cDofs*(k-1)+DofT2) IF( .NOT. Slave .AND. .NOT. Rotated ) THEN VeloSign = -1 END IF @@ -4315,13 +4327,13 @@ SUBROUTINE SetSlideFriction() VeloCoeff = Coeff * VeloCoeff j = FieldPerm( j ) - k = DOFs * (j-1) + DofN + k = cDOFs * (j-1) + DofN - k2 = DOFs * (j-1) + DofT1 + k2 = cDOFs * (j-1) + DofT1 A % Rhs(k2) = A % Rhs(k2) - VeloCoeff(DofT1) * A % Rhs(k) - IF( Dofs == 3 ) THEN - k3 = DOFs * (j-1) + DofT2 + IF( cDofs == 3 ) THEN + k3 = cDOFs * (j-1) + DofT2 A % Rhs(k3) = A % Rhs(k3) - VeloCoeff(DofT2) * A % Rhs(k) END IF @@ -4332,7 +4344,7 @@ SUBROUTINE SetSlideFriction() A % Values(l2) = A % Values(l2) - VeloCoeff(DofT1) * A % Values(l) - IF( Dofs == 3 ) THEN + IF( cDofs == 3 ) THEN DO l3 = A % Rows(k3), A % Rows(k3+1)-1 IF( A % Cols(l3) == A % Cols(l) ) EXIT END DO @@ -10306,7 +10318,7 @@ FUNCTION ComputeNorm(Solver, nin, values) RESULT (Norm) INTEGER, POINTER :: Perm(:) CALL Info('ComputeNorm','Computing norm of solution',Level=10) - + IF(PRESENT(values)) THEN x => values ELSE @@ -10440,8 +10452,10 @@ FUNCTION ComputeNorm(Solver, nin, values) RESULT (Norm) totn = totn + 1 END DO END SELECT - + totn = ParallelReduction(totn) + IF(totn == 0) GOTO 10 + nscale = 1.0_dp * totn SELECT CASE(NormDim) @@ -10456,9 +10470,11 @@ FUNCTION ComputeNorm(Solver, nin, values) RESULT (Norm) END SELECT ELSE IF( NormDofs < Dofs ) THEN + Norm = 0.0_dp totn = ParallelReduction(n) + IF(totn == 0) GOTO 10 + nscale = NormDOFs*totn/(1._dp*DOFs) - Norm = 0.0_dp SELECT CASE(NormDim) CASE(0) @@ -10526,7 +10542,9 @@ FUNCTION ComputeNorm(Solver, nin, values) RESULT (Norm) END IF ELSE - val = 0.0_dp + Norm = 0.0_dp + IF(n==0) GOTO 10 + SELECT CASE(NormDim) CASE(0) Norm = MAXVAL(ABS(x(1:n))) @@ -10539,7 +10557,7 @@ FUNCTION ComputeNorm(Solver, nin, values) RESULT (Norm) END SELECT END IF - IF( ComponentsAllocated ) THEN +10 IF( ComponentsAllocated ) THEN DEALLOCATE( NormComponents ) END IF !------------------------------------------------------------------------------ @@ -10697,6 +10715,12 @@ SUBROUTINE ComputeChange(Solver,SteadyState,nsize,values,values0,Matrix,RHS) Parallel = Solver % Parallel + IF(PRESENT(Matrix)) THEN + A => Matrix + ELSE + A => Solver % Matrix + END IF + IF(SteadyState) THEN Skip = ListGetLogical( SolverParams,'Skip Compute Steady State Change',Stat) IF( Skip ) THEN @@ -10762,7 +10786,7 @@ SUBROUTINE ComputeChange(Solver,SteadyState,nsize,values,values0,Matrix,RHS) END IF ResidualMode = ListGetLogical( SolverParams,'Linear System Residual Mode',Stat) - + ConvergenceType = ListGetString(SolverParams,& 'Nonlinear System Convergence Measure',Stat) IF(.NOT. stat) ConvergenceType = 'norm' @@ -10820,7 +10844,7 @@ SUBROUTINE ComputeChange(Solver,SteadyState,nsize,values,values0,Matrix,RHS) END IF IF( SkipConstraints ) THEN - n = MIN( n, Solver % Matrix % NumberOfRows ) + n = MIN( n, A % NumberOfRows ) END IF ! If requested (for p-elements) only use the dofs associated to nodes. @@ -10896,6 +10920,7 @@ SUBROUTINE ComputeChange(Solver,SteadyState,nsize,values,values0,Matrix,RHS) ! The norm should be bounded in order to reach convergence !-------------------------------------------------------------------------- IF( Norm /= Norm ) THEN + PRINT *,'Norm:',Norm,PrevNorm, n CALL NumericalError(Caller,'Norm of solution appears to be NaN') END IF @@ -10919,16 +10944,10 @@ SUBROUTINE ComputeChange(Solver,SteadyState,nsize,values,values0,Matrix,RHS) ! x is solution of A(x0)x=b(x0) thus residual should really be r=b(x)-A(x)x ! Instead we use r=b(x0)-A(x0)x0 which unfortunately is one step behind. !-------------------------------------------------------------------------- - IF(PRESENT(Matrix)) THEN - A => Matrix - ELSE - A => Solver % Matrix - END IF - IF(PRESENT(RHS)) THEN b => RHS ELSE - b => Solver % Matrix % rhs + b => A % rhs END IF ALLOCATE(r(n)) @@ -10975,8 +10994,7 @@ SUBROUTINE ComputeChange(Solver,SteadyState,nsize,values,values0,Matrix,RHS) ! Here the true linear system residual r=b(x0)-A(x0)x is computed. ! This option is useful for certain special solvers. !-------------------------------------------------------------------------- - A => Solver % Matrix - b => Solver % Matrix % rhs + b => A % rhs IF (Parallel) THEN @@ -12975,24 +12993,21 @@ SUBROUTINE ScaleLinearSystemDiagonal() REAL(KIND=dp), POINTER :: Diag(:) TYPE(Matrix_t), POINTER :: CM - IF( Parallel ) THEN - CALL Info('ScaleLinearSystem','Scaling diagonal entries to unity in parallel',Level=10) - ELSE - CALL Info('ScaleLinearSystem','Scaling diagonal entries to unity in serial',Level=10) - END IF - + A % ScalingMethod = 1 IF( PRESENT( DiagScaling ) ) THEN CALL Info('ScaleLinearSystem','Reusing existing > DiagScaling < vector',Level=12) Diag => DiagScaling ELSE - CALL Info('ScaleLinearSystem','Computing > DiagScaling < vector',Level=12) IF(.NOT. ASSOCIATED(A % DiagScaling)) THEN + CALL Info('ScaleLinearSystem','Creating > DiagScaling < vector of size '//I2S(n),Level=10) ALLOCATE( A % DiagScaling(n) ) + ELSE + CALL Info('ScaleLinearSystem','Recomputing > DiagScaling < vector of size '//I2S(n),Level=12) END IF Diag => A % DiagScaling - Diag = 0._dp + Diag(1:n) = 0._dp IF ( ComplexMatrix ) THEN CALL Info('ScaleLinearSystem','Assuming complex matrix while scaling',Level=20) @@ -13026,7 +13041,10 @@ SUBROUTINE ScaleLinearSystemDiagonal() !$OMP END PARALLEL DO END IF - IF ( Parallel ) CALL ParallelSumVector(A, Diag) + IF ( Parallel ) THEN + CALL Info('ScaleLinearSystem','Performing parallel summation of > DiagScaling < vector',Level=20) + CALL ParallelSumVector(A, Diag) + END IF IF ( ComplexMatrix ) THEN !$OMP PARALLEL DO & @@ -13083,7 +13101,10 @@ SUBROUTINE ScaleLinearSystemDiagonal() ! Optionally we may just create the diag and leave the scaling undone !-------------------------------------------------------------------- IF( PRESENT( ApplyScaling ) ) THEN - IF(.NOT. ApplyScaling ) RETURN + IF(.NOT. ApplyScaling ) THEN + CALL Info('ScaleLinearSystem','Application of scaling skipped!',Level=20) + RETURN + END IF END IF CALL Info('ScaleLinearSystem','Scaling matrix values',Level=20) @@ -13290,7 +13311,7 @@ SUBROUTINE ScaleLinearSystemConstant() DoRHS = .TRUE. IF (PRESENT(RhsScaling)) DoRHS = RhsScaling IF (DoRHS) THEN - bsum = SUM( ABS( b ) ) + bsum = SUM( ABS( b(1:n) ) ) nSum = n IF ( Parallel ) THEN @@ -13628,8 +13649,12 @@ SUBROUTINE BackScaleLinearSystemDiagonal() END IF A % RhsScaling=1._dp - DEALLOCATE(A % DiagScaling); A % DiagScaling=>NULL() + IF(.NOT. PRESENT(DiagScaling) ) THEN + DEALLOCATE(A % DiagScaling) + A % DiagScaling=>NULL() + END IF + END SUBROUTINE BackScaleLinearSystemDiagonal @@ -14427,7 +14452,7 @@ RECURSIVE SUBROUTINE SolveLinearSystem( A, b, & CHARACTER(:), ALLOCATABLE :: Method, Prec, SaveSlot INTEGER(KIND=AddrInt) :: Proc REAL(KIND=dp), ALLOCATABLE, TARGET :: Px(:), & - TempVector(:), TempRHS(:), NonlinVals(:) + TempRHS(:), NonlinVals(:) REAL(KIND=dp), POINTER :: Diag(:) REAL(KIND=dp) :: s,Relaxation,Beta,Gamma,bnorm,Energy,xn,bn TYPE(ValueList_t), POINTER :: Params @@ -14759,45 +14784,8 @@ END SUBROUTINE BlockSolveExt IF( NoSolve ) GOTO 110 END IF - ! Sometimes the r.h.s. may abruptly diminish in value resulting to significant - ! convergence issues or it may be that the system scales linearly with the source. - ! This flag tries to improve on the initial guess of the linear solvers, and may - ! sometimes even result to the exact solution. IF( ListGetLogical( Params,'Linear System Normalize Guess',GotIt ) ) THEN - CALL Info(Caller,'Normalizing initial guess!',Level=30) - - ALLOCATE( TempVector(A % NumberOfRows) ) - - IF ( Parallel ) THEN - IF( .NOT. ALLOCATED( TempRHS ) ) THEN - ALLOCATE( TempRHS(A % NumberOfRows) ); TempRHS=0._dp - END IF - - Tempvector = 0._dp - TempRHS(1:n) = b(1:n) - CALL ParallelInitSolve( A, x, TempRHS, Tempvector ) - - MP => ParallelMatrix(A,mx,mb,mr) - mn = MP % NumberOfRows - - TempVector = 0._dp - CALL ParallelMatrixVector( A, mx, TempVector ) - - bn = ParallelDot( mn, TempVector, mb ) - xn = ParallelDot( mn, TempVector, TempVector ) - DEALLOCATE( TempRHS ) - ELSE - CALL MatrixVectorMultiply( A, x, TempVector ) - xn = SUM( TempVector(1:n)**2 ) - bn = SUM( TempVector(1:n) * b(1:n) ) - END IF - - IF( xn > TINY( xn ) ) THEN - x(1:n) = x(1:n) * ( bn / xn ) - WRITE( Message,'(A,ES12.3)') 'Linear System Normalizing Factor: ',bn/xn - CALL Info(Caller,Message,Level=6) - END IF - DEALLOCATE( TempVector ) + CALL NormalizeInitialGuess() END IF IF( ListGetLogical( Params,'Linear System Nullify Guess',GotIt ) ) THEN @@ -14814,14 +14802,17 @@ END SUBROUTINE BlockSolveExt Prec = ListGetString(Params,'Linear System Preconditioning',GotIt) IF( GotIt ) THEN CALL Info(Caller,'Linear System Preconditioning: '//TRIM(Prec),Level=8) + CALL ResetTimer("Prec0-"//TRIM(Prec)) IF( SEQL(Prec,'vanka') ) THEN IF(LEN(Prec)>=6) THEN i = ICHAR(Prec(6:6)) - ICHAR('0') CALL ListAddNewInteger( Params,'Vanka Mode',i) END IF CALL VankaCreate(A,Solver) + ELSE IF ( Prec=='circuit' ) THEN + CALL CircuitPrecCreate(A,Solver) END IF - IF ( Prec=='circuit' ) CALL CircuitPrecCreate(A,Solver) + CALL CheckTimer("Prec0-"//TRIM(Prec),Level=8,Delete=.TRUE.) END IF END IF @@ -15011,6 +15002,59 @@ END SUBROUTINE BlockSolveExt END IF END IF + + CONTAINS + + + ! Sometimes the r.h.s. may abruptly diminish in value resulting to significant + ! convergence issues or it may be that the system scales linearly with the source. + ! This flag tries to improve on the initial guess of the linear solvers, and may + ! sometimes even result to the exact solution. + !-------------------------------------------------------------------------------- + SUBROUTINE NormalizeInitialGuess() + REAL(KIND=dp) :: xn, bn + REAL(KIND=dp), ALLOCATABLE, TARGET :: TempVector(:) + + + CALL Info(Caller,'Normalizing initial guess!',Level=30) + + ALLOCATE( TempVector(A % NumberOfRows) ) + + IF ( Parallel ) THEN + IF( .NOT. ALLOCATED( TempRHS ) ) THEN + ALLOCATE( TempRHS(A % NumberOfRows) ); TempRHS=0._dp + END IF + + Tempvector = 0._dp + TempRHS(1:n) = b(1:n) + CALL ParallelInitSolve( A, x, TempRHS, Tempvector ) + + MP => ParallelMatrix(A,mx,mb,mr) + mn = MP % NumberOfRows + + TempVector = 0._dp + CALL ParallelMatrixVector( A, mx, TempVector ) + + bn = ParallelDot( mn, TempVector, mb ) + xn = ParallelDot( mn, TempVector, TempVector ) + DEALLOCATE( TempRHS ) + ELSE + CALL MatrixVectorMultiply( A, x, TempVector ) + xn = SUM( TempVector(1:n)**2 ) + bn = SUM( TempVector(1:n) * b(1:n) ) + END IF + + IF( xn > TINY( xn ) ) THEN + x(1:n) = x(1:n) * ( bn / xn ) + WRITE( Message,'(A,ES12.3)') 'Linear System Normalizing Factor: ',bn/xn + CALL Info(Caller,Message,Level=6) + END IF + DEALLOCATE( TempVector ) + + END SUBROUTINE NormalizeInitialGuess + + + !------------------------------------------------------------------------------ END SUBROUTINE SolveLinearSystem !------------------------------------------------------------------------------ @@ -15793,8 +15837,10 @@ END SUBROUTINE BlockSolveExt n = A % NumberOfRows - ResidualMode = ListGetLogical( Params,'Linear System Residual Mode',Found ) - + RestrictionMode = HaveRestrictionMatrix( A ) + + ResidualMode = ListGetLogical( Params,'Linear System Residual Mode',Found ) + BlockMode = ListGetLogical( Params,'Linear System Block Mode',Found ) !------------------------------------------------------------------------------ @@ -15802,7 +15848,7 @@ END SUBROUTINE BlockSolveExt ! work properly with the Dirichlet elimination. !------------------------------------------------------------------------------ NeedPrevSol = ResidualMode - + IF(.NOT. NeedPrevSol ) THEN Relaxation = ListGetCReal( Params, & 'Nonlinear System Relaxation Factor', Found ) @@ -15857,8 +15903,6 @@ END SUBROUTINE BlockSolveExt bb => b END IF - RestrictionMode = HaveRestrictionMatrix( A ) - FirstLoop = .TRUE. Nmode = 0 20 CALL ConstraintModesDriver( A, x, b, Solver, .TRUE., Nmode, LinModes, FirstLoop = FirstLoop ) @@ -18470,7 +18514,6 @@ END SUBROUTINE ChangeToHarmonicSystem !> The restriction matrix is assumed to be in the ConstraintMatrix-field of !> the StiffMatrix. The restriction vector is the RHS-field of the !> ConstraintMatrix. -!> NOTE: Only serial solver implemented so far ... !------------------------------------------------------------------------------ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & Solution, Norm, DOFs, Solver ) @@ -18489,15 +18532,15 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & RestMatrixTranspose, TMat, XMat REAL(KIND=dp), POINTER CONTIG :: CollectionVector(:), RestVector(:),& AddVector(:), Tvals(:), Vals(:) - REAL(KIND=dp), POINTER :: MultiplierValues(:), pSol(:) + REAL(KIND=dp), POINTER :: MultiplierValues(:), pSol(:),DiagScaling(:) REAL(KIND=dp), ALLOCATABLE, TARGET :: CollectionSolution(:), TotValues(:) INTEGER :: NumberOfRows, NumberOfValues, MultiplierDOFs, istat, NoEmptyRows - INTEGER :: i, j, k, l, m, n, p,q, ix, Loop, colj - TYPE(Variable_t), POINTER :: MultVar + INTEGER :: i, j, k, l, m, n, p,q, ix, Loop, colj, nIter + TYPE(Variable_t), POINTER :: MultVar, iterV REAL(KIND=dp) :: scl, rowsum, Relax, val LOGICAL :: Found, ExportMultiplier, NotExplicit, Refactorize, EnforceDirichlet, EliminateDiscont, & NonEmptyRow, ComplexSystem, ConstraintScaling, UseTranspose, EliminateConstraints, & - SkipConstraints + SkipConstraints, ResidualMode SAVE MultiplierValues, SolverPointer TYPE(ListMatrix_t), POINTER :: cList @@ -18507,29 +18550,35 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & INTEGER, POINTER :: UsePerm(:), UseIPerm(:) REAL(KIND=dp), POINTER :: UseDiag(:), svals(:) TYPE(ListMatrix_t), POINTER :: Lmat(:) - LOGICAL :: EliminateFromMaster, EliminateSlave, Parallel, UseTreeGauge, NeedMassDampValues + LOGICAL :: EliminateFromMaster, EliminateSlave, Parallel, UseTreeGauge, & + NeedMassDampValues, DoOwnScaling REAL(KIND=dp), ALLOCATABLE, TARGET :: SlaveDiag(:), MasterDiag(:), DiagDiag(:) LOGICAL, ALLOCATABLE :: TrueDof(:) INTEGER, ALLOCATABLE :: Iperm(:) REAL(KIND=dp) :: t0,rt0,st,rst CHARACTER(:), ALLOCATABLE :: str,MultiplierName + TYPE(ValueList_t), POINTER :: Params CHARACTER(*), PARAMETER :: Caller = 'SolveWithLinearRestriction' - !------------------------------------------------------------------------------ CALL Info( Caller, ' ', Level=12 ) SolverPointer => Solver + Params => Solver % Values t0 = CPUTime() rt0 = RealTime() Parallel = Solver % Parallel - - NotExplicit = ListGetLogical(Solver % Values,'No Explicit Constrained Matrix',Found) + + ResidualMode = ListGetLogical( Params,'Restriction System Residual Mode',Found ) + iterV => VariableGet(Solver % Mesh % Variables,'nonlin iter') + nIter = NINT(iterV % Values(1)) + + NotExplicit = ListGetLogical(Params,'No Explicit Constrained Matrix',Found) IF(.NOT. Found) NotExplicit=.FALSE. - NeedMassDampValues = ListGetLogical( Solver % Values, 'Eigen Analysis', Found ) + NeedMassDampValues = ListGetLogical(Params, 'Eigen Analysis', Found ) RestMatrix => NULL() IF(.NOT.NotExplicit) RestMatrix => StiffMatrix % ConstraintMatrix @@ -18543,9 +18592,11 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & NumberOfRows = StiffMatrix % NumberOfRows CollectionMatrix => StiffMatrix % CollectionMatrix - Refactorize = ListGetLogical(Solver % Values,'Linear System Refactorize',Found) - IF(.NOT.Found) Refactorize = .TRUE. - + Refactorize = ListGetLogical(Params,'Linear System Refactorize',Found) + IF(.NOT.Found) THEN + Refactorize = .NOT. ( ResidualMode .AND. nIter > 1) + END IF + IF(ASSOCIATED(CollectionMatrix)) THEN IF(Refactorize.AND..NOT.NotExplicit) THEN CALL Info( Caller,'Freeing previous collection matrix structures',Level=10) @@ -18562,7 +18613,7 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & ELSE DEALLOCATE(CollectionMatrix % RHS) CollectionMatrix % Values = 0.0_dp - + IF(NeedMassDampValues) THEN IF(ASSOCIATED(CollectionMatrix % MassValues)) CollectionMatrix % MassValues = 0.0_dp IF(ASSOCIATED(CollectionMatrix % DampValues)) CollectionMatrix % DampValues = 0.0_dp @@ -18572,7 +18623,7 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & NumberOfRows = StiffMatrix % NumberOfRows IF(ASSOCIATED(AddMatrix)) NumberOfRows = MAX(NumberOfRows,AddMatrix % NumberOfRows) - EliminateConstraints = ListGetLogical( Solver % Values, 'Eliminate Linear Constraints', Found) + EliminateConstraints = ListGetLogical( Params, 'Eliminate Linear Constraints', Found) IF(ASSOCIATED(RestMatrix)) THEN IF(.NOT.EliminateConstraints) NumberOfRows = NumberOFRows + RestMatrix % NumberOfRows END IF @@ -18586,78 +18637,78 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & CollectionSolution = 0.0_dp ComplexSystem = StiffMatrix % COMPLEX .OR. & - ListGetLogical( Solver % Values,'Linear System Complex', Found ) + ListGetLogical(Params,'Linear System Complex', Found ) !------------------------------------------------------------------------------ ! If multiplier should be exported, allocate memory and export the variable. !------------------------------------------------------------------------------ - ExportMultiplier = ListGetLogical( Solver % Values, 'Export Lagrange Multiplier', Found ) + ExportMultiplier = ListGetLogical(Params, 'Export Lagrange Multiplier', Found ) IF ( ExportMultiplier ) THEN - MultiplierName = LagrangeMultiplierName( Solver ) - MultVar => VariableGet(Solver % Mesh % Variables, MultiplierName) - j = 0 - IF(ASSOCIATED(RestMatrix)) j = RestMatrix % NumberofRows - IF(ASSOCIATED(AddMatrix)) j = j+MAX(0,AddMatrix % NumberofRows-StiffMatrix % NumberOfRows) - - IF ( .NOT. ASSOCIATED(MultVar) ) THEN - CALL Info(Caller,'Creating variable for Lagrange multiplier',Level=8) - ALLOCATE( MultiplierValues(j), STAT=istat ) - IF ( istat /= 0 ) CALL Fatal(Caller,'Memory allocation error.') - - MultiplierValues = 0.0_dp - IF( ComplexSystem ) THEN - CALL VariableAddVector(Solver % Mesh % Variables, Solver % Mesh, SolverPointer, & - MultiplierName, 2, MultiplierValues) - ELSE - CALL VariableAdd(Solver % Mesh % Variables, Solver % Mesh, SolverPointer, & - MultiplierName, 1, MultiplierValues) - END IF - MultVar => VariableGet(Solver % Mesh % Variables, MultiplierName) - END IF + MultiplierName = LagrangeMultiplierName( Solver ) + MultVar => VariableGet(Solver % Mesh % Variables, MultiplierName) + j = 0 + IF(ASSOCIATED(RestMatrix)) j = RestMatrix % NumberofRows + IF(ASSOCIATED(AddMatrix)) j = j+MAX(0,AddMatrix % NumberofRows-StiffMatrix % NumberOfRows) + + IF ( .NOT. ASSOCIATED(MultVar) ) THEN + CALL Info(Caller,'Creating variable for Lagrange multiplier',Level=8) + ALLOCATE( MultiplierValues(j), STAT=istat ) + IF ( istat /= 0 ) CALL Fatal(Caller,'Memory allocation error.') + + MultiplierValues = 0.0_dp + IF( ComplexSystem ) THEN + CALL VariableAddVector(Solver % Mesh % Variables, Solver % Mesh, SolverPointer, & + MultiplierName, 2, MultiplierValues) + ELSE + CALL VariableAdd(Solver % Mesh % Variables, Solver % Mesh, SolverPointer, & + MultiplierName, 1, MultiplierValues) + END IF + MultVar => VariableGet(Solver % Mesh % Variables, MultiplierName) + END IF - IF( InfoActive( 20 ) ) THEN - CALL VectorValuesRange(MultVar % Values,SIZE(MultVar % Values),TRIM(MultVar % Name)) - END IF - - MultiplierValues => MultVar % Values - - IF (j > SIZE(MultiplierValues)) THEN - CALL Info(Caller,'Increasing Lagrange multiplier size to: '//I2S(j),Level=8) - ALLOCATE(MultiplierValues(j)); MultiplierValues=0._dp - MultiplierValues(1:SIZE(MultVar % Values)) = MultVar % Values - - ! If the Lagrange variable includes history also change its size. - IF( ASSOCIATED( MultVar % PrevValues ) ) THEN - MultVar % Values = MultVar % PrevValues(:,1) - DEALLOCATE( MultVar % PrevValues ) - ALLOCATE( MultVar % PrevValues(j,1) ) - MultVar % PrevValues = 0.0_dp - MultVar % PrevValues(:,1) = MultVar % Values - END IF + IF( InfoActive( 20 ) ) THEN + CALL VectorValuesRange(MultVar % Values,SIZE(MultVar % Values),TRIM(MultVar % Name)) + END IF - DEALLOCATE(MultVar % Values) - MultVar % Values => MultiplierValues - END IF + MultiplierValues => MultVar % Values - IF( InfoActive(25) ) THEN - CALL VectorValuesRange(MultVar % values,SIZE(MultVar % values),'MultVar') - END IF + IF (j > SIZE(MultiplierValues)) THEN + CALL Info(Caller,'Increasing Lagrange multiplier size to: '//I2S(j),Level=8) + ALLOCATE(MultiplierValues(j)); MultiplierValues=0._dp + MultiplierValues(1:SIZE(MultVar % Values)) = MultVar % Values + + ! If the Lagrange variable includes history also change its size. + IF( ASSOCIATED( MultVar % PrevValues ) ) THEN + MultVar % Values = MultVar % PrevValues(:,1) + DEALLOCATE( MultVar % PrevValues ) + ALLOCATE( MultVar % PrevValues(j,1) ) + MultVar % PrevValues = 0.0_dp + MultVar % PrevValues(:,1) = MultVar % Values + END IF + + DEALLOCATE(MultVar % Values) + MultVar % Values => MultiplierValues + END IF + + IF( InfoActive(25) ) THEN + CALL VectorValuesRange(MultVar % values,SIZE(MultVar % values),'MultVar') + END IF ELSE - MultiplierValues => NULL() + MultiplierValues => NULL() END IF - UseTreeGauge = ListGetlogical( Solver % Values, 'Use Tree Gauge', Found ) + UseTreeGauge = ListGetlogical(Params, 'Use Tree Gauge', Found ) !------------------------------------------------------------------------------ ! Put the RestMatrix to lower part of CollectionMatrix !------------------------------------------------------------------------------ - EnforceDirichlet = ListGetLogical( Solver % Values, 'Enforce Exact Dirichlet BCs',Found) + EnforceDirichlet = ListGetLogical(Params, 'Enforce Exact Dirichlet BCs',Found) IF(.NOT.Found) EnforceDirichlet = .TRUE. EnforceDirichlet = EnforceDirichlet .AND. ALLOCATED(StiffMatrix % ConstrainedDOF) - UseTranspose = ListGetLogical( Solver % Values, 'Use Transpose values', Found) + UseTranspose = ListGetLogical(Params, 'Use Transpose values', Found) IF( UseTranspose ) THEN CALL Info(Caller,'Using transpose values in elimination',Level=15) END IF @@ -18673,9 +18724,9 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & //I2S(RestMatrix % NumberOfRows)//' / '//I2S(SIZE(RestMatrix % Values)),Level=12) NoEmptyRows = 0 - ConstraintScaling = ListGetLogical(Solver % Values, 'Constraint Scaling',Found) + ConstraintScaling = ListGetLogical(Params, 'Constraint Scaling',Found) IF(ConstraintScaling) THEN - rowsum = ListGetConstReal( Solver % Values, 'Constraint Scale', Found) + rowsum = ListGetConstReal(Params, 'Constraint Scale', Found) IF(Found) RestMatrix % Values = RestMatrix % Values * rowsum END IF @@ -19202,9 +19253,10 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & END IF CALL Info(Caller,'Reverting CollectionMatrix back to CRS matrix',Level=10) - IF(CollectionMatrix % FORMAT==MATRIX_LIST) & - CALL List_toCRSMatrix(CollectionMatrix) - + IF(CollectionMatrix % FORMAT==MATRIX_LIST) THEN + CALL List_toCRSMatrix(CollectionMatrix) + END IF + ! CRS-format matrix needed here IF ( NeedMassDampValues ) THEN ! Doesn't work with constraints, "AddMatrix" only !! CALL CopyMassDampValues(CollectionMatrix, StiffMatrix, AddMatrix) @@ -19221,8 +19273,10 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & i = StiffMatrix % NumberOfRows+1 j = SIZE(CollectionSolution) - CollectionSolution(i:j) = 0._dp - IF(ExportMultiplier) CollectionSolution(i:j) = MultiplierValues(1:j-i+1) + IF( j >= i) THEN + CollectionSolution(i:j) = 0._dp + IF(ExportMultiplier) CollectionSolution(i:j) = MultiplierValues(1:j-i+1) + END IF IF( InfoActive(30) ) THEN pSol => CollectionSolution @@ -19232,7 +19286,6 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & CollectionMatrix % ExtraDOFs = CollectionMatrix % NumberOfRows - & StiffMatrix % NumberOfRows - CollectionMatrix % ParallelDOFs = 0 IF(ASSOCIATED(AddMatrix)) & CollectionMatrix % ParallelDOFs = MAX(AddMatrix % NumberOfRows - & @@ -19246,45 +19299,6 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & ! Collectionmatrix % Complex = StiffMatrix % Complex - ! We may want to skip the constraints for norm if we use certain other options - SkipConstraints = ListGetLogical( Solver % values, & - 'Nonlinear System Convergence Without Constraints',Found ) - IF(.NOT. Found ) THEN - SkipConstraints = ListGetLogical( Solver % values, 'Linear System Residual Mode',Found ) - IF( SkipConstraints ) THEN - CALL Info(Caller,'Linear system residual mode must skip constraints',Level=10) - ELSE - SkipConstraints = ListGetLogical( Solver % values, 'NonLinear System Consistent Norm',Found ) - IF( SkipConstraints ) THEN - CALL Info(Caller,'Nonlinear system consistent norm must skip constraints',Level=10) - END IF - END IF - str = ListGetString( Solver % values, 'NonLinear System Convergence Measure',Found ) - IF( str == 'solution' ) THEN - SkipConstraints = .TRUE. - CALL Info(Caller,& - 'Nonlinear system convergence measure == "solution" must skip constraints',Level=10) - END IF - IF( SkipConstraints ) THEN - CALL Info(Caller,'Enforcing convergence without constraints to True',Level=10) - CALL ListAddLogical( Solver % Values, & - 'Nonlinear System Convergence Without Constraints',.TRUE.) - END IF - END IF - - !------------------------------------------------------------------------------ - ! Look at the nonlinear system previous values again, not taking the constrained - ! system into account... - !------------------------------------------------------------------------------ - Found = ASSOCIATED(Solver % Variable % NonlinValues) - IF( Found .AND. .NOT. SkipConstraints ) THEN - k = CollectionMatrix % NumberOfRows - IF ( SIZE(Solver % Variable % NonlinValues) /= k) THEN - DEALLOCATE(Solver % Variable % NonlinValues) - ALLOCATE(Solver % Variable % NonlinValues(k)) - END IF - Solver % Variable % NonlinValues(1:k) = CollectionSolution(1:k) - END IF CollectionMatrix % Comm = StiffMatrix % Comm @@ -19303,17 +19317,86 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & CALL VectorValuesRange(CollectionMatrix % Values,SIZE(CollectionMatrix % Values),'A') CALL VectorValuesRange(CollectionMatrix % rhs,SIZE(CollectionMatrix % rhs),'b') END IF + + IF( ResidualMode ) THEN + BLOCK + REAL(KIND=dp), POINTER :: Res(:) + ! If residual mode is requested make change of variables: + ! Ax=b -> Adx = b-Ax0 = r + IF( niter > 1 ) THEN + CALL Info(Caller,'Changing the equation to residual based mode',Level=10) + ALLOCATE( Res(SIZE(CollectionSolution)) ) + CALL LinearSystemResidual( CollectionMatrix, CollectionVector, CollectionSolution, res ) + CollectionVector = Res + CollectionSolution = 0.0_dp + DEALLOCATE(Res) + END IF + END BLOCK + END IF + + ! We may want to skip ComputeChange including the constraints if we use certain other options + SkipConstraints = ResidualMode .OR. & + ListGetLogical( Params, 'Nonlinear System Convergence Without Constraints',Found ) .OR. & + ListGetLogical( Params, 'NonLinear System Consistent Norm',Found ) + str = ListGetString( Params, 'NonLinear System Convergence Measure',Found ) + IF( str == 'solution' ) THEN + SkipConstraints = .TRUE. + CALL Info(Caller,& + 'Nonlinear system convergence measure == "solution" must skip constraints',Level=10) + END IF + IF( SkipConstraints ) THEN + CALL ListAddLogical( Params,'Skip Compute Nonlinear Change',.TRUE.) + CALL ListAddLogical( Params,'Skip Advance Nonlinear iter',.TRUE.) + END IF + + DoOwnScaling = ListGetLogical( Params,'Linear System Scaling',Found) + IF(.NOT. Found) DoOwnScaling = .TRUE. + IF(.NOT. ResidualMode) DoOwnScaling = .FALSE. + IF(DoOwnScaling) THEN + CALL Info(Caller,'Performing special scaling with constraints',Level=10) + DiagScaling => CollectionMatrix % DiagScaling + IF(Niter == 1 ) THEN + IF(.NOT. ASSOCIATED(DiagScaling) ) THEN + ALLOCATE( DiagScaling(SIZE(CollectionVector))) + CollectionMatrix % DiagScaling => DiagScaling + END IF + + ! Should we scale only part or the full matrix? + IF(.FALSE.) THEN + DiagScaling = 1.0_dp + StiffMatrix % DiagScaling => DiagScaling + ! Just build the scaling matrix using only the original stiffness matrix. + CALL ScaleLinearSystem(Solver,StiffMatrix,ApplyScaling=.FALSE.) + CollectionMatrix % ScalingMethod = StiffMatrix % ScalingMethod + StiffMatrix % DiagScaling => NULL() + ELSE + CALL ScaleLinearSystem(Solver,CollectionMatrix,ApplyScaling=.FALSE.) + END IF + END IF - CALL Info(Caller,'Now going for the coupled linear system',Level=10) + CALL ScaleLinearSystem(Solver,CollectionMatrix,CollectionVector,& + CollectionSolution,DiagScaling=CollectionMatrix % DiagScaling) + CALL ListAddLogical( Params,'Linear System Skip Scaling',.TRUE. ) + END IF + + CALL Info(Caller,'Now solving the linear system with constraints!',Level=10) + Collectionmatrix % DGMatrix = StiffMatrix % DGMatrix CALL SolveLinearSystem( CollectionMatrix, CollectionVector, & - CollectionSolution, Norm, DOFs, Solver, StiffMatrix ) - + CollectionSolution, Norm, DOFs, Solver, StiffMatrix ) + + + IF(DoOwnScaling) THEN + CALL BackScaleLinearSystem( Solver,CollectionMatrix,CollectionVector,& + CollectionSolution,CollectionMatrix % DiagScaling) + CALL ListAddLogical( Params,'Linear System Skip Scaling',.FALSE. ) + END IF + !------------------------------------------------------------------------------- ! For restricted systems study the norm without some block components. ! For example, excluding gauge constraints may give valuable information ! of the real accuracy of the unconstrained system. Currently just for info. !------------------------------------------------------------------------------- - IF( ListGetLogical( Solver % Values,'Restricted System Norm',Found ) ) THEN + IF( ListGetLogical( Params,'Restricted System Norm',Found ) ) THEN ALLOCATE( TrueDof( CollectionMatrix % NumberOfRows ) ) TrueDof = .TRUE. @@ -19323,14 +19406,14 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & WRITE( Message,'(A,ES13.6)') 'Residual norm of the original system:',Norm CALL Info(Caller,Message, Level = 5 ) - IF( ListGetLogical( Solver % Values,'Restricted System Norm Skip Nodes',Found ) ) THEN + IF( ListGetLogical( Params,'Restricted System Norm Skip Nodes',Found ) ) THEN i = 1 j = MAXVAL( Solver % Variable % Perm(1:Solver % Mesh % NumberOfNodes) ) CALL Info(Caller,'Skipping nodal dof range: '//I2S(i)//'-'//I2S(j),Level=8) TrueDof(i:j) = .FALSE. END IF - IF( ListGetLogical( Solver % Values,'Restricted System Norm Skip Constraints',Found ) ) THEN + IF( ListGetLogical( Params,'Restricted System Norm Skip Constraints',Found ) ) THEN i = StiffMatrix % NumberOfRows + 1 j = CollectionMatrix % NumberOfRows CALL Info(Caller,'Skipping constraints dof range: '& @@ -19353,11 +19436,14 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & !------------------------------------------------------------------------------ CALL Info(Caller,'Picking solution from collection solution',Level=10) - Solution = 0.0_dp - i = 1 j = StiffMatrix % NumberOfRows - Solution(i:j) = CollectionSolution(i:j) + IF( ResidualMode .AND. nIter > 1) THEN + Solution(1:j) = Solution(1:j) + CollectionSolution(1:j) + ELSE + Solution(1:j) = CollectionSolution(1:j) + END IF + IF ( ExportMultiplier ) THEN CALL Info(Caller,'Separating Lagrange multiplier from collection solution',Level=10) @@ -19370,6 +19456,10 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & IF(ASSOCIATED(RestMatrix) .AND. EliminateConstraints) THEN ! Compute eliminated l-coefficient values: ! --------------------------------------- + IF( ResidualMode ) THEN + CALL Fatal(Caller,'Elimination not possible with ResidualMode!') + END IF + MultiplierValues = 0.0_dp DO i=1,RestMatrix % NumberOfRows scl = 1._dp / UseDiag(i) @@ -19377,19 +19467,29 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & MultiplierValues(i) = scl * ForceVector(m) DO j=StiffMatrix % Rows(m), StiffMatrix % Rows(m+1)-1 MultiplierValues(i) = MultiplierValues(i) - & - scl * StiffMatrix % Values(j) * Solution(StiffMatrix % Cols(j)) + scl * StiffMatrix % Values(j) * Solution(StiffMatrix % Cols(j)) END DO END DO ELSE - Relax = ListGetCReal( Solver % Values,'Lagrange Multiplier Relaxation Factor', Found ) - IF( Found ) THEN - MultiplierValues(1:j) = (1-Relax) * MultiplierValues(1:j) + & - Relax * CollectionSolution(i+1:i+j) - ELSE - MultiplierValues(1:j) = CollectionSolution(i+1:i+j) + Relax = ListGetCReal( Params,'Lagrange Multiplier Relaxation Factor', Found ) + IF( ResidualMode .AND. nIter > 1 ) THEN + IF( Found ) THEN + MultiplierValues(1:j) = MultiplierValues(1:j) + & + Relax * CollectionSolution(i+1:i+j) + ELSE + MultiplierValues(1:j) = MultiplierValues(1:j) + CollectionSolution(i+1:i+j) + END IF + ELSE + IF( Found ) THEN + MultiplierValues(1:j) = (1-Relax) * MultiplierValues(1:j) + & + Relax * CollectionSolution(i+1:i+j) + ELSE + MultiplierValues(1:j) = CollectionSolution(i+1:i+j) + END IF END IF END IF + IF(EliminateConstraints .AND. EliminateDiscont) THEN IF (EliminateFromMaster) THEN CALL totv(StiffMatrix,MultiplierValues,MasterIPerm) @@ -19401,10 +19501,17 @@ RECURSIVE SUBROUTINE SolveWithLinearRestriction( StiffMatrix, ForceVector, & !------------------------------------------------------------------------------ + IF( SkipConstraints ) THEN + CALL ListAddLogical( Params,'Skip Advance Nonlinear iter',.FALSE.) + CALL ListAddLogical( Params,'Skip Compute Nonlinear Change',.FALSE.) + CALL ComputeChange(Solver,.FALSE.,StiffMatrix % NumberOfRows,Matrix=StiffMatrix,Rhs=ForceVector) + END IF + StiffMatrix % CollectionMatrix => CollectionMatrix DEALLOCATE(CollectionSolution) CollectionMatrix % ConstraintMatrix => NULL() + CALL Info( Caller, 'All done', Level=10 ) CONTAINS @@ -23610,7 +23717,8 @@ SUBROUTINE GenerateConstraintMatrix( Model, Solver ) TYPE(Solver_t) :: Solver INTEGER, POINTER :: Perm(:) - INTEGER :: i,j,j2,k,k2,l,l2,dofs,maxperm,permsize,bc_ind,constraint_ind,row,col,col2,mcount,bcount,kk + INTEGER :: i,j,j2,k,k2,l,l2,dofs,maxperm,permsize,bc_ind,constraint_ind,row,col,col2,& + mcount,bcount,kk,cdofs,dim TYPE(Matrix_t), POINTER :: Atmp,Btmp, Ctmp LOGICAL :: AllocationsDone, CreateSelf, ComplexMatrix, TransposePresent, Found, & SetDof, SomeSet, SomeSkip, SumProjectors, NewRow, SumThis @@ -23666,7 +23774,7 @@ SUBROUTINE GenerateConstraintMatrix( Model, Solver ) CALL Info(Caller,'Nothing to do for now',Level=12) RETURN END IF - + ! Compute the number and size of initial constraint matrices !----------------------------------------------------------- @@ -23759,23 +23867,16 @@ SUBROUTINE GenerateConstraintMatrix( Model, Solver ) CALL Info(Caller,'There are '& //I2S(row)//' initial rows in constraint matrices',Level=10) - + + dim = Solver % Mesh % MeshDim dofs = Solver % Variable % DOFs + Perm => Solver % Variable % Perm permsize = SIZE( Perm ) maxperm = MAXVAL( Perm ) AllocationsDone = .FALSE. arows = Solver % Matrix % NumberOfRows - ALLOCATE( ActiveComponents(dofs), SetDefined(dofs), rsum(dofs) ) - - IF( SumProjectors ) THEN - ALLOCATE( SumPerm( dofs * permsize ) ) - SumPerm = 0 - ALLOCATE( SumCount( arows ) ) - SumCount = 0 - END IF - ComplexMatrix = Solver % Matrix % Complex ComplexSumRow = .FALSE. @@ -23786,10 +23887,39 @@ SUBROUTINE GenerateConstraintMatrix( Model, Solver ) ! Currently complex matrix is enforced if there is an even number of ! entries since it seems that we cannot rely on the flag to be set. ComplexMatrix = ListGetLogical( Solver % Values,'Linear System Complex',Found ) - IF( .NOT. Found ) ComplexMatrix = ( MODULO( Dofs,2 ) == 0 ) + IF( .NOT. Found ) ComplexMatrix = ( Dofs == 2*dim) END IF + IF( ComplexMatrix ) THEN + IF(dofs==dim .OR. dofs == 2) THEN + cdofs = dofs + ELSE + CALL Fatal(Caller,'Invalid number of dofs for field: '//I2S(dofs)) + END IF + ELSE + IF(dofs==dim .OR. dofs == 1) THEN + cdofs = dofs + ELSE IF(dofs==dim+1) THEN + ! For contact mechanics we want to ignore the pressure. + IF( ListGetLogical( Solver % Values,'Apply Contact BCs',Found ) ) THEN + cdofs = dim + ELSE + cdofs = dofs + END IF + ELSE + CALL Fatal(Caller,'Invalid number of dofs for field: '//I2S(dofs)) + END IF + END IF + + ALLOCATE( ActiveComponents(dofs), SetDefined(dofs), rsum(dofs) ) + IF( SumProjectors ) THEN + ALLOCATE( SumPerm( dofs * permsize ) ) + SumPerm = 0 + ALLOCATE( SumCount( arows ) ) + SumCount = 0 + END IF + AnyPriority = ListCheckPresentAnyBC( Model,'Projector Priority') IF( AnyPriority ) THEN IF(.NOT. SumProjectors ) THEN @@ -23895,8 +24025,8 @@ SUBROUTINE GenerateConstraintMatrix( Model, Solver ) ! or skip some field components. SomeSet = .FALSE. SomeSkip = .FALSE. - DO i=1,Dofs - IF( Dofs > 1 ) THEN + DO i=1,cDofs + IF( cDofs > 1 ) THEN str = ComponentName( Solver % Variable, i ) ELSE str = TRIM(Solver % Variable % Name) @@ -23922,12 +24052,12 @@ SUBROUTINE GenerateConstraintMatrix( Model, Solver ) ! By default all components are applied mortar BC and some are turned off. ! If the user does the opposite then the default for other components is True. - IF( SomeSet .AND. .NOT. ALL(SetDefined) ) THEN + IF( SomeSet .AND. .NOT. ALL(SetDefined(1:cdofs)) ) THEN IF( SomeSkip ) THEN - CALL Fatal(Caller,'Do not know what to do with all components') + CALL Fatal(Caller,'Do not know what to do with all '//I2S(cdofs)//' components') ELSE CALL Info(Caller,'Unspecified components will not be set for BC '//I2S(bc_ind),Level=10) - DO i=1,Dofs + DO i=1,cDofs IF( .NOT. SetDefined(i) ) ActiveComponents(i) = .FALSE. END DO END IF @@ -24418,7 +24548,7 @@ SUBROUTINE GenerateConstraintMatrix( Model, Solver ) ! In case of a vector valued problem create a projector that acts on all ! components of the vector. Otherwise follow the same logic. DO i=1,Atmp % NumberOfRows - DO j=1,Dofs + DO j=1,cDofs IF( .NOT. ActiveComponents(j) ) THEN CALL Info(Caller,'Skipping component: '//I2S(j),Level=12) @@ -24439,7 +24569,7 @@ SUBROUTINE GenerateConstraintMatrix( Model, Solver ) IF( ThisIsMortar ) THEN IF( ASSOCIATED( MortarBC % Active ) ) THEN - IF( .NOT. MortarBC % Active(Dofs*(i-1)+j) ) CYCLE + IF( .NOT. MortarBC % Active(cDofs*(i-1)+j) ) CYCLE END IF END IF @@ -24457,19 +24587,19 @@ SUBROUTINE GenerateConstraintMatrix( Model, Solver ) END IF IF( SumThis ) THEN - IF( Dofs*(k-1)+j > SIZE(SumPerm) ) THEN + IF( cDofs*(k-1)+j > SIZE(SumPerm) ) THEN CALL Fatal(Caller,'Index out of range') END IF - NewRow = ( SumPerm(Dofs*(kk-1)+j) == 0 ) + NewRow = ( SumPerm(cDofs*(kk-1)+j) == 0 ) IF( NewRow ) THEN sumrow = sumrow + 1 IF( Priority /= 0 ) THEN ! Use negative sign to show that this has already been set by priority - SumPerm(Dofs*(kk-1)+j) = -sumrow + SumPerm(cDofs*(kk-1)+j) = -sumrow ELSE - SumPerm(Dofs*(kk-1)+j) = sumrow + SumPerm(cDofs*(kk-1)+j) = sumrow END IF - ELSE IF( Priority /= PrevPriority .AND. SumPerm(Dofs*(kk-1)+j) < 0 ) THEN + ELSE IF( Priority /= PrevPriority .AND. SumPerm(cDofs*(kk-1)+j) < 0 ) THEN IF(.NOT. AllocationsDone ) THEN NeglectedRows = NeglectedRows + 1 END IF @@ -24479,7 +24609,7 @@ SUBROUTINE GenerateConstraintMatrix( Model, Solver ) EliminatedRows = EliminatedRows + 1 END IF END IF - row = ABS( SumPerm(Dofs*(kk-1)+j) ) + row = ABS( SumPerm(cDofs*(kk-1)+j) ) ELSE sumrow = sumrow + 1 row = sumrow @@ -24597,7 +24727,7 @@ SUBROUTINE GenerateConstraintMatrix( Model, Solver ) IF( ThisIsMortar ) THEN IF( ASSOCIATED( MortarBC % Diag ) .OR. HaveMortarDiag ) THEN IF( .NOT. HaveMortarDiag ) THEN - MortarDiag = MortarBC % Diag(Dofs*(i-1)+j) + MortarDiag = MortarBC % Diag(cDofs*(i-1)+j) LumpedDiag = MortarBC % LumpedDiag END IF @@ -24640,7 +24770,7 @@ SUBROUTINE GenerateConstraintMatrix( Model, Solver ) Btmp % Rhs(row) = SetVal(j) ELSE IF( ThisIsMortar ) THEN IF( ASSOCIATED( MortarBC % Rhs ) ) THEN - Btmp % Rhs(row) = wsum * MortarBC % rhs(Dofs*(i-1)+j) + Btmp % Rhs(row) = wsum * MortarBC % rhs(cDofs*(i-1)+j) END IF END IF IF(.NOT. SumThis ) THEN @@ -24821,117 +24951,6 @@ SUBROUTINE ReleaseProjectors(Model, Solver) END SUBROUTINE ReleaseProjectors - !> Defines and potentially creates output directory. - !> The output directory may given in different ways, and even be part of the - !> filename, or be relative to home directory. We try to parse every possible - !> scenario here that user might have in mind. - !----------------------------------------------------------------------------- - SUBROUTINE SolverOutputDirectory( Solver, Filename, OutputDirectory, & - MakeDir, UseMeshDir ) - - TYPE(Solver_t) :: Solver - LOGICAL, OPTIONAL :: MakeDir, UseMeshDir - CHARACTER(*) :: Filename - CHARACTER(:), ALLOCATABLE :: OutputDirectory - - LOGICAL :: Found, AbsPathInName, DoDir, PartitioningSubDir - INTEGER :: nd, nf, n - CHARACTER(LEN=MAX_NAME_LEN) :: Str - - IF( PRESENT( MakeDir ) ) THEN - DoDir = MakeDir - ELSE - DoDir = ( Solver % TimesVisited == 0 ) .AND. ( ParEnv % MyPe == 0 ) - END IF - - ! Output directory is obtained in order - ! 1) solver section - ! 2) simulation section - ! 3) header section - OutputDirectory = ListGetString( Solver % Values,'Output Directory',Found) - IF(.NOT. Found) OutputDirectory = ListGetString( CurrentModel % Simulation,& - 'Output Directory',Found) - - IF(.NOT. Found) OutputDirectory = TRIM(OutputPath) - nd = LEN_TRIM(OutputDirectory) - - ! If the path is just working directory then that is not an excude - ! to not use the mesh name, or directory that comes with the filename - IF(.NOT. Found .AND. nd == 1 .AND. OutputDirectory(1:1)=='.') nd = 0 - - ! If requested by the optional parameter use the mesh directory when - ! no results directory given. This is an old convection used in some solvers. - IF( nd == 0 .AND. PRESENT( UseMeshDir ) ) THEN - IF( UseMeshDir ) THEN - OutputDirectory = TRIM(CurrentModel % Mesh % Name) - nd = LEN_TRIM(OutputDirectory) - END IF - END IF - - ! Use may have given part or all of the path in the filename. - ! This is not preferred, but we cannot trust the user. - nf = LEN_TRIM(Filename) - n = INDEX(Filename(1:nf),'/') - AbsPathInName = INDEX(FileName,':')>0 .OR. (Filename(1:1)=='/') & - .OR. (Filename(1:1)==Backslash) - - IF( nd > 0 .AND. .NOT. AbsPathInName ) THEN - ! Check that we have not given the path relative to home directory - ! because the code does not understand the meaning of tilde. - IF(nd>=2) THEN - IF( OutputDirectory(1:2) == '~/') THEN - CALL get_environment_variable('HOME',Str) - OutputDirectory = TRIM(Str)//'/'//OutputDirectory(3:nd) - nd = LEN_TRIM(OutputDirectory) - END IF - END IF - ! To be on the safe side create the directory. If it already exists no harm done. - ! Note that only one directory may be created. Hence if there is a path with many subdirectories - ! that will be a problem. Fortran does not have a standard ENQUIRE for directories hence - ! we just try to make it. - IF( DoDir ) THEN - CALL Info('SolverOutputDirectory','Creating directory: '//TRIM(OutputDirectory(1:nd)),Level=8) - CALL MakeDirectory( OutputDirectory(1:nd) // CHAR(0) ) - END IF - END IF - - ! In this case the filename includes also path and we remove it from there and - ! add it to the directory. - IF( n > 2 ) THEN - CALL Info('SolverOutputDirectory','Parcing path from filename: '//TRIM(Filename(1:n)),Level=10) - IF( AbsPathInName .OR. nd == 0) THEN - ! If the path is absolute then it overruns the given path! - OutputDirectory = Filename(1:n-1) - nd = n-1 - ELSE - ! If path is relative we add it to the OutputDirectory and take it away from Filename - OutputDirectory = OutputDirectory(1:nd)//'/'//Filename(1:n-1) - nd = nd + n - END IF - Filename = Filename(n+1:nf) - - IF( DoDir ) THEN - CALL Info('SolverOutputDirectory','Creating directory: '//TRIM(OutputDirectory(1:nd)),Level=8) - CALL MakeDirectory( OutputDirectory(1:nd) // CHAR(0) ) - END IF - END IF - - ! Finally, on request save each partitioning to different directory. - PartitioningSubDir = ListGetLogical( Solver % Values,'Output Partitioning Directory',Found) - IF(.NOT. Found ) THEN - PartitioningSubDir = ListGetLogical( CurrentModel % Simulation,'Output Partitioning Directory',Found) - END IF - IF( PartitioningSubDir ) THEN - OutputDirectory = TRIM(OutputDirectory)//'/np'//I2S(ParEnv % PEs) - nd = LEN_TRIM(OutputDirectory) - IF( DoDir ) THEN - CALL Info('SolverOutputDirectory','Creating directory: '//TRIM(OutputDirectory(1:nd)),Level=8) - CALL MakeDirectory( OutputDirectory(1:nd) // CHAR(0) ) - END IF - END IF - - END SUBROUTINE SolverOutputDirectory - !----------------------------------------------------------------------------- ! This routine changes the IP field to DG field just while the results are being written. !--------------------------------------------------------------------------------------- diff --git a/fem/src/Types.F90 b/fem/src/Types.F90 index 11b5f361f9..6bae042bdd 100644 --- a/fem/src/Types.F90 +++ b/fem/src/Types.F90 @@ -223,7 +223,7 @@ MODULE Types DiagScaling(:) => NULL(), TValues(:) => NULL(), Values_im(:) => NULL() REAL(KIND=dp), ALLOCATABLE :: extraVals(:) - REAL(KIND=dp) :: RhsScaling=1.0, AveScaling=1.0 + REAL(KIND=dp) :: RhsScaling=1.0_dp, AveScaling=1.0_dp INTEGER :: ScalingMethod = 0 REAL(KIND=dp), POINTER CONTIG :: MassValues(:)=>NULL(),DampValues(:)=>NULL(), & BulkValues(:)=>NULL(), BulkMassValues(:)=>NULL(), BulkDampValues(:)=>NULL(), & @@ -610,7 +610,8 @@ MODULE Types INTEGER :: DOFs = 0 INTEGER, POINTER :: Perm(:) => NULL() LOGICAL :: PeriodicFlipActive = .FALSE. - REAL(KIND=dp) :: Norm=0, PrevNorm=0,NonlinChange=0, SteadyChange=0 + REAL(KIND=dp) :: Norm=0.0_dp, PrevNorm=0.0_dp,& + NonlinChange=0.0_dp, SteadyChange=0.0_dp INTEGER :: NonlinConverged=-1, SteadyConverged=-1, NonlinIter=-1 INTEGER :: LinConverged=-1 COMPLEX(KIND=dp), POINTER :: EigenValues(:) => NULL(), & @@ -631,7 +632,7 @@ MODULE Types !------------------------------------------------------------------------------ TYPE ListMatrixEntry_t INTEGER :: Index = -1 - REAL(KIND=dp) :: val = 0.0 + REAL(KIND=dp) :: val = 0.0_dp TYPE(ListMatrixEntry_t), POINTER :: Next => NULL() END TYPE ListMatrixEntry_t diff --git a/fem/src/VankaCreate.F90 b/fem/src/VankaCreate.F90 index a317a9b68a..48fc095826 100644 --- a/fem/src/VankaCreate.F90 +++ b/fem/src/VankaCreate.F90 @@ -284,7 +284,7 @@ SUBROUTINE VankaCreate(A,Solver) CASE(0) - ! Pick entries related to ene single element and inverse the matrix. + ! Pick entries related to a single element and inverse the matrix. ! Add the inverse to the preconditioning matrix. !------------------------------------------------------------------- Active = GetNOFActive(Solver) @@ -444,13 +444,13 @@ SUBROUTINE VankaCreate(A,Solver) Mesh => Solver % Mesh IF( Mesh % MeshDim == 3 ) THEN IF(.NOT. ASSOCIATED(Mesh % Faces)) THEN - CALL Warn('VankaCreate','This mode requires existance of Faces in 3D!') + CALL Warn('VankaCreate','This mode requires existence of Faces in 3D!') CALL FindMeshFaces3D(Mesh) END IF NoElems = Mesh % NumberOfFaces ELSE IF(.NOT. ASSOCIATED(Mesh % Edges)) THEN - CALL Warn('VankaCreate','This mode requires existance of Edges in 2D!') + CALL Warn('VankaCreate','This mode requires existence of Edges in 2D!') CALL FindMeshEdges2D(Mesh) END IF @@ -604,7 +604,7 @@ SUBROUTINE VankaCreate(A,Solver) A % ILUCols => B % Cols A % ILURows => B % Rows - ! Nullify these so that they wont be destroyed + ! Nullify these so that they won't be destroyed NULLIFY( B % Values, B % Cols, B % Rows) CALL FreeMatrix( B ) END IF @@ -668,6 +668,7 @@ END SUBROUTINE VankaCreate SUBROUTINE CircuitPrec(u,v,ipar) !------------------------------------------------------------------------------- USE DefUtils + !USE DirectSolve, ONLY: MumpsLocal_SolveSystem, Umfpack_SolveSystem IMPLICIT NONE INTEGER :: ipar(*) @@ -676,8 +677,8 @@ SUBROUTINE CircuitPrec(u,v,ipar) TYPE(Matrix_t), POINTER :: A INTEGER :: i,j,k LOGICAL :: stat - INTEGER :: ndim, n + CHARACTER(:), ALLOCATABLE, SAVE :: str TYPE(Solver_t), POINTER, SAVE :: sv => Null() !------------------------------------------------------------------------------- A => GlobalMatrix @@ -690,24 +691,41 @@ SUBROUTINE CircuitPrec(u,v,ipar) IF(n>0) THEN IF ( .NOT.ASSOCIATED(sv) ) THEN ALLOCATE(sv) + str = ListGetString( CurrentModel % Solver % Values, & + 'Linear System Direct Method', Stat ) + IF(.NOT. Stat ) str = "umfpack" #if !defined (HAVE_UMFPACK) && defined (HAVE_MUMPS) - CALL Warn( 'CheckLinearSolverOptions', 'UMFPACK solver not installed, using MUMPS instead!' ) - CALL ListAddString( sv % Values, 'Linear System Direct Method', 'Mumps') -#else - CALL ListAddString( sv % Values, 'Linear System Direct Method', 'Umfpack') + IF( str == "umfpack" ) THEN + CALL Warn( 'CircuitPrec', 'Umfpack solver not installed, using MUMPS instead!' ) + str = "mumps" + END IF +#elseif !defined (HAVE_MUMPS) && defined(HAVE_UMFPACK) + IF( str == "mumps" ) THEN + CALL Warn( 'CircuitPrec', 'MUMPS solver not installed, using Umfpack instead!' ) + str = "umfpack" + END IF +#elseif !defined (HAVE_MUMPS) && !defined(HAVE_UMFPACK) + CALL Fatal( 'CircuitPrec', 'Preconditioner "circuit" needs either Umfpack or MUMPS!') #endif + CALL ListAddString( sv % Values, 'Linear System Direct Method', TRIM(str) ) CALL ListAddLogical( sv % Values, 'Linear System Refactorize', .FALSE.) CALL ListAddLogical( sv % Values, 'Linear System Free Factorization', .FALSE.) + + CALL Info('CircuitPrec','Using direct solver '& + //TRIM(str)//' of size '//I2S(A % ExtraDofs),Level=10) END IF i = ndim - A % ExtraDOFs + 1 j = ndim - A % ExtraDOFs + n - + IF(ANY(ABS(A % CircuitMatrix % Values)>0)) THEN -#if !defined (HAVE_UMFPACK) && defined (HAVE_MUMPS) - CALL MumpsLocal_SolveSystem( sv, A % CircuitMatrix, u(i:j), v(i:j) ) -#else - CALL Umfpack_SolveSystem( sv, A % CircuitMatrix, u(i:j), v(i:j) ) -#endif + SELECT CASE( str ) + CASE('umfpack') + CALL Umfpack_SolveSystem( sv, A % CircuitMatrix, u(i:j), v(i:j) ) + CASE('mumps') + CALL MumpsLocal_SolveSystem( sv, A % CircuitMatrix, u(i:j), v(i:j) ) + CASE DEFAULT + CALL Fatal('CircuitPrec','Impossible direct method: '//TRIM(str)) + END SELECT END IF END IF @@ -727,7 +745,7 @@ SUBROUTINE CircuitPrecComplex(u,v,ipar) TYPE(Matrix_t), POINTER :: A LOGICAL :: stat INTEGER :: i,j,k,l - + CHARACTER(:), ALLOCATABLE, SAVE :: str REAL(KIND=dp), ALLOCATABLE, SAVE :: ru(:), rv(:) INTEGER :: ndim, n TYPE(Solver_t), POINTER :: sv => Null() @@ -742,14 +760,28 @@ SUBROUTINE CircuitPrecComplex(u,v,ipar) IF(n>0) THEN IF ( .NOT.ASSOCIATED(sv) ) THEN ALLOCATE(sv) + str = ListGetString( CurrentModel % Solver % Values, & + 'Linear System Direct Method', Stat ) + IF(.NOT. Stat ) str = "umfpack" #if !defined (HAVE_UMFPACK) && defined (HAVE_MUMPS) - CALL Warn( 'CheckLinearSolverOptions', 'UMFPACK solver not installed, using MUMPS instead!' ) - CALL ListAddString( sv % Values, 'Linear System Direct Method', 'Mumps') -#else - CALL ListAddString( sv % Values, 'Linear System Direct Method', 'Umfpack') + IF( str == "umfpack" ) THEN + CALL Warn( 'CircuitPrecComplex', 'Umfpack solver not installed, using MUMPS instead!' ) + str = "mumps" + END IF +#elseif !defined (HAVE_MUMPS) && defined(HAVE_UMFPACK) + IF( str == "mumps" ) THEN + CALL Warn( 'CircuitPrecComplex', 'MUMPS solver not installed, using Umfpack instead!' ) + str = "umfpack" + END IF +#elseif !defined (HAVE_MUMPS) && !defined(HAVE_UMFPACK) + CALL Fatal( 'CircuitPrecComplex', 'Preconditioner "circuit" needs either Umfpack or MUMPS!') #endif + CALL ListAddString( sv % Values, 'Linear System Direct Method', TRIM(str) ) CALL ListAddLogical( sv % Values, 'Linear System Refactorize', .FALSE.) CALL ListAddLogical( sv % Values, 'Linear System Free Factorization', .FALSE.) + + CALL Info('CircuitPrecComplex','Using direct solver '& + //TRIM(str)//' of size '//I2S(A % ExtraDofs/2),Level=10) END IF IF(.NOT.ALLOCATED(ru)) THEN @@ -766,12 +798,15 @@ SUBROUTINE CircuitPrecComplex(u,v,ipar) rv(k) = REAL(v(i+j)); rv(k+1) = AIMAG(v(i+j)) END DO -#if !defined (HAVE_UMFPACK) && defined (HAVE_MUMPS) - CALL MumpsLocal_SolveSystem( sv, A % CircuitMatrix, ru, rv ) -#else - CALL Umfpack_SolveSystem( sv, A % CircuitMatrix, ru, rv ) -#endif - + SELECT CASE( str ) + CASE('umfpack') + CALL Umfpack_SolveSystem( sv, A % CircuitMatrix, ru, rv ) + CASE('mumps') + CALL MumpsLocal_SolveSystem( sv, A % CircuitMatrix, ru, rv ) + CASE DEFAULT + CALL Fatal('CircuitPrecComplex','Impossible direct method: '//TRIM(str)) + END SELECT + j = 0 DO k=1,n,2 j = j + 1 diff --git a/fem/src/modules/CircuitsAndDynamics.F90 b/fem/src/modules/CircuitsAndDynamics.F90 index d2d50d6982..d1fbfecfb4 100644 --- a/fem/src/modules/CircuitsAndDynamics.F90 +++ b/fem/src/modules/CircuitsAndDynamics.F90 @@ -355,13 +355,15 @@ SUBROUTINE AddBasicCircuitEquations(p,Crt,dt) RowId = Cvar % ValueId + nm - vphi = GetCReal(Params, Circuit % Source(i), Found) - IF ( .NOT. Found .AND. ASSOCIATED(BF) ) THEN - vphi = GetCReal(BF, Circuit % Source(i), Found) + IF( LEN_TRIM( Circuit % Source(i) ) > 0 ) THEN + vphi = GetCReal(Params, Circuit % Source(i), Found) + IF ( .NOT. Found .AND. ASSOCIATED(BF) ) THEN + vphi = GetCReal(BF, Circuit % Source(i), Found) + END IF + IF (Found) Cvar % SourceRe(i) = vphi + ELSE + vphi = 0.0_dp END IF - IF (Found) Cvar % SourceRe(i) = vphi - - !IF(Found) PRINT *,'vphi',i,vphi,TRIM(Circuit % Source(i)) Cvar % SourceRe(i) = vphi CM % RHS(RowId) = Cvar % SourceRe(i) @@ -574,7 +576,8 @@ SUBROUTINE Add_stranded(Element,Tcoef,Comp,nn,nd,dt,CompParams) REAL(KIND=dp) :: WBasis(nd,3), RotWBasis(nd,3) INTEGER :: dim, ncdofs,q TYPE(VariableHandle_t), SAVE :: Wvec_h - + TYPE(Variable_t), POINTER, SAVE :: Wpot + LOGICAL :: PiolaVersion = .FALSE. SAVE CSymmetry, dim, First, InitHandle @@ -622,6 +625,8 @@ SUBROUTINE Add_stranded(Element,Tcoef,Comp,nn,nd,dt,CompParams) CALL ListInitElementVariable(Wvec_h, CoilWVecVarname) PiolaVersion = GetLogical( ASolver % Values, 'Use Piola Transform', Found ) + + CALL GetWPotentialVar(Wpot) END IF PS => Asolver % Variable % Perm @@ -644,14 +649,14 @@ SUBROUTINE Add_stranded(Element,Tcoef,Comp,nn,nd,dt,CompParams) ncdofs=nd IF (dim == 3) THEN - + ! We can choose the base per component. CoilUseWvec = GetLogical(CompParams, 'Coil Use W Vector', Found) IF (.NOT. Found) CoilUseWvec = CoilUseWvec0 IF (.NOT. CoilUseWvec) THEN !CALL GetLocalSolution(Wbase, 'w') ! when W Potential solver is used, 'w' is not enough. - CALL GetWPotential(WBase) + CALL GetLocalSolution( Wbase,UElement=Element,UVariable=Wpot, Found=Found) END IF ncdofs=nd-nn @@ -777,7 +782,8 @@ SUBROUTINE Add_massive(Element,Tcoef,Comp,nn,nd,dt,crt) REAL(KIND=dp) :: wBase(nn), gradv(3), WBasis(nd,3), RotWBasis(nd,3) INTEGER :: ncdofs,q - + TYPE(Variable_t), POINTER, SAVE :: Wpot + SAVE CSymmetry, dim, First IF (First) THEN @@ -785,6 +791,8 @@ SUBROUTINE Add_massive(Element,Tcoef,Comp,nn,nd,dt,crt) CSymmetry = ( CurrentCoordinateSystem() == AxisSymmetric .OR. & CurrentCoordinateSystem() == CylindricSymmetric ) dim = CoordinateSystemDimension() + + CALL GetWPotentialVar(Wpot) END IF ASolver => CurrentModel % Asolver @@ -835,7 +843,8 @@ SUBROUTINE Add_massive(Element,Tcoef,Comp,nn,nd,dt,crt) ncdofs=nd IF (dim == 3) THEN - CALL GetLocalSolution(Wbase, 'w') + !CALL GetLocalSolution(Wbase, 'w') + CALL GetLocalSolution( Wbase,UElement=Element,UVariable=Wpot, Found=Found) ncdofs=nd-nn END IF @@ -987,7 +996,8 @@ SUBROUTINE Add_foil_winding(Element,Tcoef,Comp,nn,nd,dt) REAL(KIND=dp) :: wBase(nn), gradv(3), WBasis(nd,3), RotWBasis(nd,3), & RotMLoc(3,3), RotM(3,3,nn) INTEGER :: i,ncdofs,q - + TYPE(Variable_t), POINTER, SAVE :: Wpot + SAVE CSymmetry, dim, First IF (First) THEN @@ -995,6 +1005,8 @@ SUBROUTINE Add_foil_winding(Element,Tcoef,Comp,nn,nd,dt) CSymmetry = ( CurrentCoordinateSystem() == AxisSymmetric .OR. & CurrentCoordinateSystem() == CylindricSymmetric ) dim = CoordinateSystemDimension() + + CALL GetWPotentialVar(Wpot) END IF ASolver => CurrentModel % Asolver @@ -1020,7 +1032,8 @@ SUBROUTINE Add_foil_winding(Element,Tcoef,Comp,nn,nd,dt) ncdofs=nd IF (dim == 3) THEN - CALL GetLocalSolution(Wbase, 'w') + CALL GetLocalSolution( Wbase,UElement=Element,UVariable=Wpot, Found=Found) + !CALL GetLocalSolution(Wbase, 'w') CALL GetElementRotM(Element, RotM, nn) ncdofs=nd-nn END IF @@ -1769,7 +1782,8 @@ SUBROUTINE Add_stranded(Element,Tcoef,Comp,nn,nd,CompParams) LOGICAL :: PiolaVersion = .FALSE. TYPE(VariableHandle_t), SAVE :: Wvec_h - + TYPE(Variable_t), POINTER, SAVE :: Wpot + SAVE CSymmetry, dim, First IF (First) THEN @@ -1804,6 +1818,7 @@ SUBROUTINE Add_stranded(Element,Tcoef,Comp,nn,nd,CompParams) IF(.NOT. Found) CoilWVecVarname = 'W Vector E' CALL ListInitElementVariable(Wvec_h, CoilWVecVarname) + CALL GetWPotentialVar(Wpot) END IF ASolver => CurrentModel % Asolver @@ -1827,7 +1842,8 @@ SUBROUTINE Add_stranded(Element,Tcoef,Comp,nn,nd,CompParams) IF(.NOT. Found) CoilUseWvec = CoilUseWvec0 IF (.NOT. CoilUseWvec) THEN - CALL GetWPotential(WBase) + CALL GetLocalSolution( Wbase,UElement=Element,UVariable=Wpot, Found=Found) + !CALL GetWPotential(WBase) END IF END IF @@ -1874,7 +1890,10 @@ SUBROUTINE Add_stranded(Element,Tcoef,Comp,nn,nd,CompParams) CALL GetEdgeBasis(Element,WBasis,RotWBasis,Basis,dBasisdx) END IF IF (CoilUseWvec) THEN - w = ListGetElementVectorSolution( Wvec_h, Basis, Element, dofs = dim ) + w = ListGetElementVectorSolution( Wvec_h, Basis, Element, Found = Found, dofs = dim ) + IF(.NOT. Found ) THEN + CALL Fatal('Add_stranded','Could not find coil current density!') + END IF ELSE w = -MATMUL(WBase(1:nn), dBasisdx(1:nn,:)) END IF @@ -1964,7 +1983,9 @@ SUBROUTINE Add_massive(Element,Tcoef,Comp,nn,nd) INTEGER :: ncdofs,q REAL(KIND=dp) :: ModelDepth COMPLEX(KIND=dp) :: Permittivity(nn), localP + TYPE(Variable_t), POINTER, SAVE :: Wpot + SAVE CSymmetry, dim, First IF (First) THEN @@ -1972,6 +1993,8 @@ SUBROUTINE Add_massive(Element,Tcoef,Comp,nn,nd) CSymmetry = ( CurrentCoordinateSystem() == AxisSymmetric .OR. & CurrentCoordinateSystem() == CylindricSymmetric ) dim = CoordinateSystemDimension() + + CALL GetWPotentialVar(Wpot) END IF ASolver => CurrentModel % Asolver @@ -1990,7 +2013,8 @@ SUBROUTINE Add_massive(Element,Tcoef,Comp,nn,nd) ncdofs=nd IF (dim == 3) THEN - CALL GetWPotential(WBase) + !CALL GetWPotential(WBase) + CALL GetLocalSolution( Wbase,UElement=Element,UVariable=Wpot, Found=Found) ncdofs=nd-nn END IF @@ -2209,7 +2233,9 @@ SUBROUTINE Add_foil_winding(Element,Tcoef,Comp,nn,nd,CompParams) RotMLoc(3,3), RotM(3,3,nn) REAL(KIND=dp) :: Jvec(3) INTEGER :: i,ncdofs,q + TYPE(Variable_t), POINTER, SAVE :: Wpot + SAVE CSymmetry, dim, First, InitHandle, InitJHandle IF( First ) THEN @@ -2243,6 +2269,8 @@ SUBROUTINE Add_foil_winding(Element,Tcoef,Comp,nn,nd,CompParams) END IF IF(.NOT. Found) CoilWVecVarname = 'W Vector E' CALL ListInitElementVariable(Wvec_h, CoilWVecVarname) + + CALL GetWPotentialVar(Wpot) END IF ASolver => CurrentModel % Asolver @@ -2266,7 +2294,8 @@ SUBROUTINE Add_foil_winding(Element,Tcoef,Comp,nn,nd,CompParams) IF (.NOT. CoilUseWvec) THEN !CALL GetLocalSolution(Wbase, 'w') - CALL GetWPotential(WBase) + !CALL GetWPotential(WBase) + CALL GetLocalSolution( Wbase,UElement=Element,UVariable=Wpot, Found=Found) END IF FoilUseJvec = GetLogical(CompParams, 'Foil Winding Use J Vector', Found) @@ -2702,13 +2731,12 @@ SUBROUTINE CircuitsOutput(Model,Solver,dt,Transient) IF (Cvar % pdofs /= 0 ) THEN DO jj = 1, Cvar % pdofs - write (dofnumber, "(I2)") jj CALL SimListAddAndOutputConstReal(& TRIM(Circuits(p) % names(i))& - //'re dof '//TRIM(dofnumber), crt(Cvar % ValueId + ReIndex(jj)), Level=10) + //'re dof '//I2S(jj), crt(Cvar % ValueId + ReIndex(jj)), Level=10) CALL SimListAddAndOutputConstReal(& TRIM(Circuits(p) % names(i))& - //'im dof '//TRIM(dofnumber), crt(Cvar % ValueId + ImIndex(jj)), Level=10) + //'im dof '//I2S(jj), crt(Cvar % ValueId + ImIndex(jj)), Level=10) END DO END IF ELSE @@ -2717,10 +2745,9 @@ SUBROUTINE CircuitsOutput(Model,Solver,dt,Transient) IF (Cvar % pdofs /= 0 ) THEN DO jj = 1, Cvar % pdofs - write (dofnumber, "(I2)") jj CALL SimListAddAndOutputConstReal(& TRIM(Circuits(p) % names(i))& - //'dof '//TRIM(dofnumber), crt(Cvar % ValueId + jj), Level=10) + //'dof '//I2S(jj), crt(Cvar % ValueId + jj), Level=10) END DO END IF END IF @@ -2782,11 +2809,9 @@ SUBROUTINE SimListAddAndOutputConstReal(VariableName, VariableValue, Level) INTEGER :: LevelVal = 3 IF (PRESENT(Level)) LevelVal = Level - - WRITE(VarVal,'(ES15.4)') VariableValue - CALL Info(Caller, TRIM(VariableName)//' '//& - TRIM(VarVal), Level=LevelVal) - + WRITE(Message,'(A,T20,ES15.4)') TRIM(VariableName),VariableValue + CALL Info(Caller,Message,Level=LevelVal) + CALL ListAddConstReal(GetSimulation(),TRIM(CktPrefix)//' '//TRIM(VariableName), VariableValue) !------------------------------------------------------------------- END SUBROUTINE SimListAddAndOutputConstReal diff --git a/fem/src/modules/EMPort.F90 b/fem/src/modules/EMPort.F90 index fe93160be6..cd28667a0d 100644 --- a/fem/src/modules/EMPort.F90 +++ b/fem/src/modules/EMPort.F90 @@ -429,7 +429,7 @@ SUBROUTINE EMPortSolver_Post(Model, Solver, dt, Transient) TYPE(Nodes_t), SAVE :: Nodes CHARACTER(*), PARAMETER :: Caller = 'EMPortSolver_Post' LOGICAL :: PiolaVersion, stat - INTEGER :: soln, i, j, k, n, nd, EdgeBasisDegree + INTEGER :: soln, i, j, k, n, nd, EdgeBasisDegree, normal_ind(1) INTEGER :: DOFs, vdofs, p, q, ModeIndex INTEGER, POINTER, SAVE :: Ind(:) => NULL() REAL(KIND=dp), ALLOCATABLE, TARGET :: Mass(:,:), Force(:) @@ -440,7 +440,7 @@ SUBROUTINE EMPortSolver_Post(Model, Solver, dt, Transient) REAL(KIND=dp) :: u, v, w, detJ, s - REAL(KIND=dp) :: xq, ReEz, ImEz, ReE(3), ImE(3), ReV(3), ImV(3) + REAL(KIND=dp) :: xq, ReEz, ImEz, ReE(3), ImE(3), ReV(3), ImV(3), Normal(3) REAL(KIND=dp) :: Norm @@ -479,7 +479,7 @@ SUBROUTINE EMPortSolver_Post(Model, Solver, dt, Transient) ModeIndex = ListGetInteger(Params, 'Mode Index', Found) ! print *, 'processing eigenvalue', PrimSolver % Variable % Eigenvalues(ModeIndex) - Beta = -im * SQRT(PrimSolver % Variable % Eigenvalues(ModeIndex)) + Beta = SQRT(-PrimSolver % Variable % Eigenvalues(ModeIndex)) ! print *, 'propagation parameter beta', Beta DO k=1, GetNOFActive() @@ -493,6 +493,13 @@ SUBROUTINE EMPortSolver_Post(Model, Solver, dt, Transient) CALL GetElementNodes( Nodes ) + ! At the moment we assume that the wave propagates in the direction of some + ! coordinate axis. Then the following check should be enough to get the positive + ! direction of wave propagation: + Normal = NormalVector(Element, Nodes) + normal_ind = MAXLOC(ABS(Normal)) + IF (Normal(normal_ind(1)) < 0.0_dp) Normal = -Normal + CALL GetScalarLocalEigenmode(re_local_field, 'e re', Element, PrimSolver, ModeIndex, ComplexPart=.FALSE.) CALL GetScalarLocalEigenmode(im_local_field, 'e im', Element, PrimSolver, ModeIndex, ComplexPart=.FALSE.) @@ -538,17 +545,17 @@ SUBROUTINE EMPortSolver_Post(Model, Solver, dt, Transient) END DO SELECT CASE(j) CASE(1) - Force((p-1)*DOFs+1) = Force((p-1)*DOFs+1) + s * ReE(1) * Basis(p) + Force((p-1)*DOFs+1) = Force((p-1)*DOFs+1) + s * (ReE(1) + Normal(1)*ReEz) * Basis(p) CASE(2) - Force((p-1)*DOFs+2) = Force((p-1)*DOFs+2) + s * ReE(2) * Basis(p) + Force((p-1)*DOFs+2) = Force((p-1)*DOFs+2) + s * (ReE(2) + Normal(2)*ReEz) * Basis(p) CASE(3) - Force((p-1)*DOFs+3) = Force((p-1)*DOFs+3) + s * ReEz * Basis(p) + Force((p-1)*DOFs+3) = Force((p-1)*DOFs+3) + s * (ReE(3) + Normal(3)*ReEz) * Basis(p) CASE(4) - Force((p-1)*DOFs+4) = Force((p-1)*DOFs+4) + s * ImE(1) * Basis(p) + Force((p-1)*DOFs+4) = Force((p-1)*DOFs+4) + s * (ImE(1) + Normal(1)*ImEz) * Basis(p) CASE(5) - Force((p-1)*DOFs+5) = Force((p-1)*DOFs+5) + s * ImE(2) * Basis(p) + Force((p-1)*DOFs+5) = Force((p-1)*DOFs+5) + s * (ImE(2) + Normal(2)*ImEz) * Basis(p) CASE(6) - Force((p-1)*DOFs+6) = Force((p-1)*DOFs+6) + s * ImEz * Basis(p) + Force((p-1)*DOFs+6) = Force((p-1)*DOFs+6) + s * (ImE(3) + Normal(3)*ImEz) * Basis(p) END SELECT END DO END DO diff --git a/fem/src/modules/ElasticSolve.F90 b/fem/src/modules/ElasticSolve.F90 index d9ea010707..548af92aeb 100644 --- a/fem/src/modules/ElasticSolve.F90 +++ b/fem/src/modules/ElasticSolve.F90 @@ -110,7 +110,6 @@ SUBROUTINE ElasticSolver_Init( Model,Solver,dt,Transient ) DOFs = dim CALL ListAddString( SolverParams, 'Variable', 'Displacement' ) END IF - CALL ListAddInteger( SolverParams, 'Variable DOFs', DOFs ) END IF @@ -2591,8 +2590,8 @@ SUBROUTINE NeoHookeanLocalMatrix( MassMatrix,DampMatrix,StiffMatrix,ForceVector, !------------------------------------------------------------------------------ IF( MixedFormulation ) THEN - IF (PlaneStress) CALL Warn( Caller, & - 'Mixed formulation does not support plane stress: plane strain assumed instead' ) + IF (PlaneStress) CALL Fatal( Caller, & + 'Mixed formulation does not support plane stress') DOFs = cdim + 1 ! To reuse the code, set the lambda parameter to zero and instead diff --git a/fem/src/modules/FlowSolve.F90 b/fem/src/modules/FlowSolve.F90 index 9c0dd3360d..bb9c9d33b9 100644 --- a/fem/src/modules/FlowSolve.F90 +++ b/fem/src/modules/FlowSolve.F90 @@ -415,39 +415,58 @@ END FUNCTION FlowInsideResidual ListCheckPresentAnyBodyForce(Model,'Angular Velocity 3') !------------------------------------------------------------------------------ + + ! Different options are: + ! 1) stabilized + ! 2) legacy pubbles + ! 3) p-bubbles (or bubbles given in element definion) + ! 4) p2p1 + ! 5) vms + P2P1 = .FALSE. Bubbles = ListGetLogical( Solver % Values,'Bubbles',GotIt ) Stabilize = ListGetLogical( Solver % Values,'Stabilize',GotIt ) - P2P1 = .FALSE. + LegacyBubbles = .FALSE. StabilizeFlag = ListGetString( Solver % Values, & 'Stabilization Method', GotIt ) IF ( .NOT. GotIt ) THEN IF ( Stabilize ) THEN - StabilizeFlag = 'stabilized' + StabilizeFlag = 'stabilized' ELSE IF ( Bubbles ) THEN - StabilizeFlag = 'bubbles' + StabilizeFlag = 'bubbles' + ELSE IF(ListCheckPresent(Solver % Values,'Element')) THEN + StabilizeFlag = 'bubbles' + Bubbles = .TRUE. ELSE - StabilizeFlag = 'stabilized' + CALL Info('FlowSolver','Defaulting to "stabilized" method') + StabilizeFlag = 'stabilized' + Stabilize = .TRUE. END IF ELSE IF (StabilizeFlag == 'p2/p1' .OR. StabilizeFlag == 'p2p1') THEN P2P1 = .TRUE. - Stabilize = .FALSE. ELSE IF( StabilizeFlag == 'bubbles' ) THEN + LegacyBubbles = .NOT. ListCheckPresent(Solver % Values,'Element') + Bubbles = .TRUE. + ELSE IF(StabilizeFlag == 'stabilized' ) THEN + Stabilize = .TRUE. + ELSE IF(StabilizeFlag == 'pbubbles' ) THEN Bubbles = .TRUE. + ELSE IF(StabilizeFlag == 'vms' ) THEN + CONTINUE + ELSE + CALL Fatal('FlowSolver','Unknown "stabilization method": '//TRIM(StabilizeFlag)) END IF - END IF + END IF IF( Stabilize .AND. Bubbles ) THEN CALL Fatal('FlowSolver','You cant have stabilization and bubbles both!') - END IF - - LegacyBubbles = ( Bubbles .AND. .NOT. ListCheckPresent(Solver % Values,'Element') ) + END IF IF( LegacyBubbles ) THEN CALL Info('FlowSolver','Using legacy bubbles (as opposed to elemental ones!)',Level=8) END IF - + DivDiscretization = ListGetLogical( Solver % Values, & 'Div Discretization', GotIt ) @@ -660,13 +679,15 @@ END FUNCTION FlowInsideResidual !------------------------------------------------------------------------------ n = GetElementNOFNodes() - IF( LegacyBubbles ) THEN + IF( Stabilize ) THEN + nb = 0 + ELSE IF( LegacyBubbles ) THEN nb = n ELSE nb = GetElementNOFBDOFs() END IF nd = GetElementDOFs( Indexes ) - + CALL GetElementNodes( ElementNodes ) SELECT CASE( NSDOFs ) @@ -1029,13 +1050,21 @@ END FUNCTION FlowInsideResidual !------------------------------------------------------------------------------ END SELECT + ! We do not have stabilized formulation for compressible fluids. IF ( CompressibilityModel /= Incompressible .AND. & StabilizeFlag == 'stabilized' ) THEN - nb = n + Bubbles = .TRUE. + StabilizeFlag = 'bubbles' END IF + + ! Internally P2P1 is dealt as special case of bubbles. IF ( Element % TYPE % BasisFunctionDegree <= 1 .AND. P2P1 ) THEN - nb = n + Bubbles = .TRUE. + StabilizeFlag = 'bubbles' END IF + + ! If bubbles are requested, but not in element formulation. + IF ( nb==0 .AND. Bubbles ) nb = n !------------------------------------------------------------------------------ ! If time dependent simulation, add mass matrix to global @@ -1051,7 +1080,7 @@ END FUNCTION FlowInsideResidual END IF IF ( nb > 0 ) THEN - CALL NSCondensate( nd, nb, NSDOFs-1, STIFF, FORCE, TimeForce ) + CALL NSCondensate( nd, nb, NSDOFs-1, STIFF, FORCE, TimeForce ) END IF !------------------------------------------------------------------------------ diff --git a/fem/src/modules/GmshOutputReader.F90 b/fem/src/modules/GmshOutputReader.F90 index 12ab5041f1..54a0879952 100644 --- a/fem/src/modules/GmshOutputReader.F90 +++ b/fem/src/modules/GmshOutputReader.F90 @@ -26,8 +26,9 @@ !> \ingroup Solvers !------------------------------------------------------------------------------ SUBROUTINE GmshOutputReader( Model,Solver,dt,TransientSimulation ) -!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ USE DefUtils + USE SaveUtils IMPLICIT NONE !------------------------------------------------------------------------------ TYPE(Solver_t) :: Solver diff --git a/fem/src/modules/HeatSolve.F90 b/fem/src/modules/HeatSolve.F90 index 968f85f1a4..cc02235d69 100644 --- a/fem/src/modules/HeatSolve.F90 +++ b/fem/src/modules/HeatSolve.F90 @@ -69,6 +69,11 @@ SUBROUTINE HeatSolver_init( Model,Solver,dt,Transient ) 'ThermalConductanceMatrix.dat',.FALSE.) CALL ListRenameAllBC( Model,'Conductivity Body','Constraint Mode Temperature') END IF + + ! If library adaptivity is compiled with, use that by default. +#ifdef LIBRARY_ADAPTIVIVTY + CALL ListAddNewLogical(Params,'Library Adaptivity',.TRUE.) +#endif END SUBROUTINE HeatSolver_Init @@ -183,32 +188,32 @@ RECURSIVE SUBROUTINE HeatSolver( Model,Solver,Timestep,TransientSimulation ) INTERFACE - FUNCTION HeatBoundaryResidual( Model,Edge,Mesh,Quant,Perm,Gnorm ) RESULT(Indicator) + FUNCTION HeatSolver_Boundary_Residual( 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 HeatBoundaryResidual + END FUNCTION HeatSolver_Boundary_Residual - FUNCTION HeatEdgeResidual( Model,Edge,Mesh,Quant,Perm ) RESULT(Indicator) + FUNCTION HeatSolver_Edge_Residual( 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 HeatEdgeResidual + END FUNCTION HeatSolver_Edge_Residual - FUNCTION HeatInsideResidual( Model,Element,Mesh,Quant,Perm, Fnorm ) RESULT(Indicator) + FUNCTION HeatSolver_Inside_Residual( 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 HeatInsideResidual + END FUNCTION HeatSolver_Inside_Residual END INTERFACE REAL(KIND=dp) :: at,at0,totat,st,totst,t1 @@ -1369,10 +1374,14 @@ END FUNCTION HeatInsideResidual DEALLOCATE( PrevSolution ) - IF ( ListGetLogical( Solver % Values, 'Adaptive Mesh Refinement', Found ) ) & - CALL RefineMesh( Model,Solver,Temperature,TempPerm, & - HeatInsideResidual, HeatEdgeResidual, HeatBoundaryResidual ) - + IF ( ListGetLogical( Solver % Values, 'Adaptive Mesh Refinement', Found ) ) THEN + IF(.NOT. ListGetLogical( Solver % Values,'Library Adaptivity',Found )) THEN + CALL RefineMesh( Model,Solver,Temperature,TempPerm, & + HeatSolver_Inside_Residual, HeatSolver_Edge_Residual, & + HeatSolver_Boundary_Residual ) + END IF + END IF + CONTAINS @@ -2282,7 +2291,7 @@ END SUBROUTINE HeatSolver !------------------------------------------------------------------------------ - FUNCTION HeatBoundaryResidual( Model, Edge, Mesh, Quant, Perm,Gnorm ) RESULT( Indicator ) + FUNCTION HeatSolver_Boundary_Residual( Model, Edge, Mesh, Quant, Perm,Gnorm ) RESULT( Indicator ) !------------------------------------------------------------------------------ USE DefUtils USE Radiation @@ -2577,13 +2586,13 @@ FUNCTION HeatBoundaryResidual( Model, Edge, Mesh, Quant, Perm,Gnorm ) RESULT( In ! Gnorm = EdgeLength * Gnorm Indicator = EdgeLength * ResidualNorm !------------------------------------------------------------------------------ - END FUNCTION HeatBoundaryResidual + END FUNCTION HeatSolver_Boundary_Residual !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - FUNCTION HeatEdgeResidual(Model,Edge,Mesh,Quant,Perm) RESULT( Indicator ) + FUNCTION HeatSolver_Edge_Residual(Model,Edge,Mesh,Quant,Perm) RESULT( Indicator ) !------------------------------------------------------------------------------ USE DefUtils IMPLICIT NONE @@ -2776,12 +2785,12 @@ FUNCTION HeatEdgeResidual(Model,Edge,Mesh,Quant,Perm) RESULT( Indicator ) Indicator = EdgeLength * ResidualNorm !------------------------------------------------------------------------------ - END FUNCTION HeatEdgeResidual + END FUNCTION HeatSolver_Edge_Residual !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - FUNCTION HeatInsideResidual( Model, Element, Mesh, & + FUNCTION HeatSolver_Inside_Residual( Model, Element, Mesh, & Quant, Perm, Fnorm ) RESULT( Indicator ) !------------------------------------------------------------------------------ USE DefUtils @@ -3114,5 +3123,5 @@ FUNCTION HeatInsideResidual( Model, Element, Mesh, & ! Fnorm = Element % hk**2 * Fnorm Indicator = Element % hK**2 * ResidualNorm !------------------------------------------------------------------------------ - END FUNCTION HeatInsideResidual + END FUNCTION HeatSolver_Inside_Residual !------------------------------------------------------------------------------ diff --git a/fem/src/modules/HeatSolveVec.F90 b/fem/src/modules/HeatSolveVec.F90 index 85f7bf9109..3e1e51fbee 100644 --- a/fem/src/modules/HeatSolveVec.F90 +++ b/fem/src/modules/HeatSolveVec.F90 @@ -143,7 +143,10 @@ SUBROUTINE HeatSolver_init( Model,Solver,dt,Transient ) CALL ListRenameAllBC( Model,'Conductivity Body','Constraint Mode Temperature') END IF - + ! If library adaptivity is compiled with, use that by default. +#ifdef LIBRARY_ADAPTIVIVTY + CALL ListAddNewLogical(Params,'Library Adaptivity',.TRUE.) +#endif END SUBROUTINE HeatSolver_Init @@ -183,32 +186,32 @@ SUBROUTINE HeatSolver( Model,Solver,dt,Transient ) CHARACTER(*), PARAMETER :: Caller = 'HeatSolver' INTERFACE - FUNCTION HeatBoundaryResidual( Model,Edge,Mesh,Quant,Perm,Gnorm ) RESULT(Indicator) + FUNCTION HeatSolver_Boundary_Residual( 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 HeatBoundaryResidual + END FUNCTION HeatSolver_Boundary_Residual - FUNCTION HeatEdgeResidual( Model,Edge,Mesh,Quant,Perm ) RESULT(Indicator) + FUNCTION HeatSolver_Edge_Residual( 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 HeatEdgeResidual + END FUNCTION HeatSolver_Edge_Residual - FUNCTION HeatInsideResidual( Model,Element,Mesh,Quant,Perm, Fnorm ) RESULT(Indicator) + FUNCTION HeatSolver_Inside_Residual( 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 HeatInsideResidual + END FUNCTION HeatSolver_Inside_Residual END INTERFACE IF (.NOT. ASSOCIATED(Solver % Matrix)) RETURN @@ -448,10 +451,14 @@ END FUNCTION HeatInsideResidual CALL DefaultFinish() CALL CalculateRadiosityFields(Pre=.FALSE.) - IF ( ListGetLogical( Solver % Values, 'Adaptive Mesh Refinement', Found ) ) & - CALL RefineMesh( Model,Solver,Temperature,TempPerm, & - HeatInsideResidual, HeatEdgeResidual, HeatBoundaryResidual ) - + IF ( ListGetLogical( Solver % Values, 'Adaptive Mesh Refinement', Found ) ) THEN + IF( .NOT. ListGetLogical(Params,'Library Adaptivity',Found) ) THEN + CALL RefineMesh( Model,Solver,Temperature,TempPerm, & + HeatSolver_Inside_Residual, HeatSolver_Edge_Residual, & + HeatSolver_Boundary_Residual ) + END IF + END IF + CONTAINS @@ -1985,7 +1992,7 @@ END SUBROUTINE HeatSolver !------------------------------------------------------------------------------ - FUNCTION HeatBoundaryResidual( Model, Edge, Mesh, Quant, Perm,Gnorm ) RESULT( Indicator ) + FUNCTION HeatSolver_Boundary_Residual( Model, Edge, Mesh, Quant, Perm,Gnorm ) RESULT( Indicator ) !------------------------------------------------------------------------------ USE DefUtils USE Radiation @@ -2267,13 +2274,13 @@ FUNCTION HeatBoundaryResidual( Model, Edge, Mesh, Quant, Perm,Gnorm ) RESULT( In ! Gnorm = EdgeLength * Gnorm Indicator = EdgeLength * ResidualNorm !------------------------------------------------------------------------------ - END FUNCTION HeatBoundaryResidual + END FUNCTION HeatSolver_Boundary_Residual !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - FUNCTION HeatEdgeResidual(Model,Edge,Mesh,Quant,Perm) RESULT( Indicator ) + FUNCTION HeatSolver_Edge_Residual(Model,Edge,Mesh,Quant,Perm) RESULT( Indicator ) !------------------------------------------------------------------------------ USE DefUtils IMPLICIT NONE @@ -2456,12 +2463,12 @@ FUNCTION HeatEdgeResidual(Model,Edge,Mesh,Quant,Perm) RESULT( Indicator ) IF (dim==3) EdgeLength = SQRT(EdgeLength) Indicator = EdgeLength * ResidualNorm !------------------------------------------------------------------------------ - END FUNCTION HeatEdgeResidual + END FUNCTION HeatSolver_Edge_Residual !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - FUNCTION HeatInsideResidual( Model, Element, Mesh, & + FUNCTION HeatSolver_Inside_Residual( Model, Element, Mesh, & Quant, Perm, Fnorm ) RESULT( Indicator ) !------------------------------------------------------------------------------ USE DefUtils @@ -2791,5 +2798,5 @@ FUNCTION HeatInsideResidual( Model, Element, Mesh, & ! Fnorm = Element % hk**2 * Fnorm Indicator = Element % hK**2 * ResidualNorm !------------------------------------------------------------------------------ - END FUNCTION HeatInsideResidual + END FUNCTION HeatSolver_Inside_Residual !------------------------------------------------------------------------------ diff --git a/fem/src/modules/NodeToEdgeSolver.F90 b/fem/src/modules/NodeToEdgeSolver.F90 index 2aa8039698..a2548fe5b3 100644 --- a/fem/src/modules/NodeToEdgeSolver.F90 +++ b/fem/src/modules/NodeToEdgeSolver.F90 @@ -152,10 +152,18 @@ SUBROUTINE ExtrudedRestart( Model,Solver,dt,Transient) Var => VariableGet( ThisMesh % Variables, VarName, ThisOnly = .TRUE. ) IF(.NOT. ASSOCIATED(Var)) THEN + IF(InfoActive(20)) THEN + PRINT *,'List of variable in 2D mesh:' + Var => ThisMesh % Variables + DO WHILE(ASSOCIATED(Var)) + PRINT *,TRIM(Var % Name), SIZE(Var % Values), ASSOCIATED(Var % Perm) + Var => Var % Next + END DO + END IF CALL Fatal(Caller,'Could not find variable: '//TRIM(VarName)) END IF dofs = Var % Dofs - + IF( InfoActive( 20 ) ) THEN CALL VectorValuesRange(Var % Values,SIZE(Var % Values),TRIM(VarName)) END IF @@ -165,8 +173,8 @@ SUBROUTINE ExtrudedRestart( Model,Solver,dt,Transient) IF(.NOT. Found) TargetName = VarName pVar => VariableGet( TargetMesh % Variables, TargetName, ThisOnly = .TRUE. ) - CreateVar = .NOT. ASSOCIATED(pVar) - + CreateVar = .NOT. ASSOCIATED(pVar) + IF(.NOT. ASSOCIATED( Var % Perm ) ) THEN ! One intended use of this module is to extrude data from 2D electrical machine computation ! to 3D one. The it is often desirable also to copy the related electrical circuits that may be @@ -183,7 +191,7 @@ SUBROUTINE ExtrudedRestart( Model,Solver,dt,Transient) ELSE pVals => pVar % Values END IF - pVals = Var % Values + pVals(1:n) = Var % Values CALL Info(Caller,'Copied variable as such from 2D mesh to 3D mesh: '//TRIM(VarName),Level=8) ELSE maxperm = MAXVAL( Var % Perm ) @@ -198,7 +206,7 @@ SUBROUTINE ExtrudedRestart( Model,Solver,dt,Transient) END IF pVals = 0.0_dp - ! Here we assume that the fields to be mapped are nodal ones and the mesh is linear on!! + ! Here we assume that the fields to be mapped are nodal ones and the mesh is linear one! n = ThisMesh % NumberOfNodes DO j=0,layers-1 DO k=1,ThisMesh % NumberOfNodes @@ -331,7 +339,10 @@ SUBROUTINE NodeToEdgeField(Model, Solver, dt, Transient) CHARACTER(*), PARAMETER :: Caller = 'NodeToEdgeField' -!------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + + CALL Info(Caller,'Projecting 3D nodal field to Hcurl field') + CALL DefaultStart() dim = CoordinateSystemDimension() @@ -519,6 +530,10 @@ SUBROUTINE NodeToEdgeField(Model, Solver, dt, Transient) CALL VectorValuesRange(EdgeVar % Values,SIZE(EdgeVar % Values),TRIM(EdgeVar % Name)) END IF END IF + + ! We should be visiting this routine only once! +! CALL Info(Caller,'Freeing unneeded matrix structures',Level=10) +! CALL FreeMatrix(Solver % Matrix) CALL Info(Caller,'Finished projection to edge basis!') diff --git a/fem/src/modules/ResultOutputSolve/GidOutputSolver.F90 b/fem/src/modules/ResultOutputSolve/GidOutputSolver.F90 index 370061f148..262b065834 100644 --- a/fem/src/modules/ResultOutputSolve/GidOutputSolver.F90 +++ b/fem/src/modules/ResultOutputSolve/GidOutputSolver.F90 @@ -28,6 +28,7 @@ SUBROUTINE GiDOutputSolver( Model,Solver,dt,TransientSimulation ) !------------------------------------------------------------------------------ USE DefUtils + USE SaveUtils, ONLY : SolverOutputDirectory IMPLICIT NONE !------------------------------------------------------------------------------ TYPE(Solver_t) :: Solver diff --git a/fem/src/modules/ResultOutputSolve/GmshOutputSolver.F90 b/fem/src/modules/ResultOutputSolve/GmshOutputSolver.F90 deleted file mode 100644 index 23d244640f..0000000000 --- a/fem/src/modules/ResultOutputSolve/GmshOutputSolver.F90 +++ /dev/null @@ -1,545 +0,0 @@ -!/*****************************************************************************/ -! * -! * 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. -! * -! *****************************************************************************/ - -!------------------------------------------------------------------------------ -!> Saves results in ascii format understood by the pre-/postprocessing software Gmsh. -!> \ingroup Solvers -!------------------------------------------------------------------------------ -SUBROUTINE GmshOutputSolver( Model,Solver,dt,TransientSimulation ) -!------------------------------------------------------------------------------ - USE DefUtils - USE SaveUtils - IMPLICIT NONE -!------------------------------------------------------------------------------ - TYPE(Solver_t) :: Solver - TYPE(Model_t) :: Model - REAL(KIND=dp) :: dt - LOGICAL :: TransientSimulation -!------------------------------------------------------------------------------ -! Local variables -!------------------------------------------------------------------------------ - TYPE(Element_t),POINTER :: Element - INTEGER, POINTER :: Perm(:) - REAL(KIND=dp), POINTER :: Values(:),Values2(:),Values3(:) - REAL(KIND=dp) :: Vector(3), Time - COMPLEX(KIND=dp), POINTER :: CValues(:) - TYPE(Variable_t), POINTER :: Solution, TimeVariable - TYPE(ValueList_t), POINTER :: Params - TYPE(Mesh_t), POINTER :: Mesh - - LOGICAL :: Found, GotField, FileAppend, AlterTopology, MaskExists - LOGICAL :: EigenAnalysis = .FALSE., EigenActive, ComponentVector, Parallel - - INTEGER :: VisitedTimes = 0, ExtCount - INTEGER :: i,j,k,l,m,n,nsize,dim,dofs,ElmerCode, GmshCode,body_id, Vari, Rank, truedim - INTEGER :: Tag, NumberOfAllElements, BCOffSet - INTEGER, PARAMETER :: MaxElemCode = 827 - INTEGER :: ElmerToGmshType(MaxElemCode), GmshToElmerType(21), & - ElmerIndexes(27), GmshIndexes(27) - INTEGER, POINTER :: NodeIndexes(:) - - INTEGER, ALLOCATABLE :: NodePerm(:),DgPerm(:) - INTEGER, ALLOCATABLE, TARGET :: InvDgPerm(:), InvNodePerm(:) - LOGICAL, ALLOCATABLE :: ActiveElem(:) - LOGICAL :: NoPermutation - INTEGER :: NumberOfGeomNodes, NumberOfDofNodes,NumberOfElements, ElemFirst, ElemLast - INTEGER, POINTER :: InvFieldPerm(:), DGInvPerm(:) - - INTEGER, PARAMETER :: LENGTH = 1024 - CHARACTER(LEN=LENGTH) :: Txt, FieldName, CompName - CHARACTER(MAX_NAME_LEN) :: OutputFile - CHARACTER(:), ALLOCATABLE :: OutputDirectory - INTEGER :: GmshUnit - CHARACTER(*), PARAMETER :: Caller = 'GmshOutputSolver' - - SAVE VisitedTimes - -!------------------------------------------------------------------------------ - - CALL Info(Caller,'Saving results in Gmsh format') - - Mesh => Model % Mesh - Params => Solver % Values - Parallel = ( ParEnv % PEs > 1 ) - - ExtCount = ListGetInteger( Params,'Output Count',Found) - IF( Found ) THEN - VisitedTimes = ExtCount - ELSE - VisitedTimes = VisitedTimes + 1 - END IF - - GmshToElmerType = (/ 202, 303, 404, 504, 808, 706, 605, 203, 306, 409, & - 510, 827, 0, 0, 101, 408, 820, 715, 613, 0, 310 /) - ElmerToGmshType = 0 - - DO i=1,SIZE(GmshToElmerType) - j = GmshToElmerType(i) - IF( j > 0 ) ElmerToGmshType(j) = i - END DO - - EigenAnalysis = GetLogical( Params, 'Eigen Analysis', Found ) - FileAppend = GetLogical( Params,'File Append',Found) - IF(.NOT. Found) FileAppend = .TRUE. - AlterTopology = GetLogical( Params,'Alter Topology',Found) - - OutputFile = GetString( Solver % Values, 'Output File Name', Found ) - IF( Found ) THEN - IF(INDEX(OutputFile,'.') == 0) WRITE( OutputFile,'(A,A)') TRIM(OutputFile),".msh" - ELSE - OutputFile = 'Output.msh' - END IF - - CALL SolverOutputDirectory( Solver, OutputFile, OutputDirectory, UseMeshDir = .TRUE. ) - OutputFile = TRIM(OutputDirectory)// '/' //TRIM(OutputFile) - - !------------------------------------------------------------------------------ - ! Initialize stuff for masked saving - !------------------------------------------------------------------------------ - CALL GenerateSaveMask(Mesh,Params,Parallel,0,.FALSE.,& - NodePerm,ActiveElem,NumberOfGeomNodes,NumberOfElements,& - ElemFirst,ElemLast) - - IF( ParEnv % PEs > 1 ) THEN - IF( NumberOfElements == 0 ) THEN - CALL Info(Caller,'Nothing to save in partition: '//TRIM(I2S(ParEnv % MyPe)),Level=8) - RETURN - ELSE - OutputFile = TRIM(OutputFile)//'_'//I2S(ParEnv % PEs)//'np'//I2S(ParEnv % MyPe+1) - END IF - ELSE - IF( NumberOfElements == 0 ) THEN - CALL Warn(Caller,'Notging to save, this is suspicious') - RETURN - END IF - END IF - - CALL GenerateSavePermutation(Mesh,.FALSE.,.FALSE.,0,.FALSE.,& - ActiveElem,NumberOfGeomNodes,NoPermutation,NumberOfDofNodes,& - DgPerm,InvDgPerm,NodePerm,InvNodePerm) - - InvFieldPerm => InvNodePerm - - dim = CoordinateSystemDimension() - IF( VisitedTimes > 1 ) THEN - IF( AlterTopology ) THEN - OutputFile = NextFreeFilename( OutputFile ) - CALL Info(Caller,'Writing mesh and data to a new file: '//TRIM(OutputFile)) - ELSE IF( FileAppend ) THEN - CALL Info(Caller,'Appending data to the same file: '//TRIM(OutputFile)) - OPEN(NEWUNIT=GmshUnit, FILE=OutputFile, POSITION='APPEND' ) - GOTO 10 - ELSE - OutputFile = NextFreeFilename( OutputFile ) - CALL Info(Caller,'Writing data to a new file: '//TRIM(OutputFile)) - OPEN(NEWUNIT=GmshUnit, FILE=OutputFile ) - WRITE(GmshUnit,'(A)') '$MeshFormat' - WRITE(GmshUnit,'(A)') '2.0 0 8' - WRITE(GmshUnit,'(A)') '$EndMeshFormat' - GOTO 10 - END IF - END IF - - - ! Save the header - !------------------------------------------------- - CALL Info('GmshOutputSolver','Saving results to file: '//TRIM(OutputFile)) - OPEN(NEWUNIT=GmshUnit, FILE=OutputFile ) - - WRITE(GmshUnit,'(A)') '$MeshFormat' - WRITE(GmshUnit,'(A)') '2.0 0 8' - WRITE(GmshUnit,'(A)') '$EndMeshFormat' - - - ! Save the mesh nodes - !------------------------------------------------- - CALL Info(Caller,'Writing the mesh nodes') - CALL WriteGmshNodes() - - ! Save the mesh elements - !------------------------------------------------- - CALL Info(Caller,'Writing the mesh elements') - CALL WriteGmshElements() - - ! With a mask the list of physical entities should be checked - !------------------------------------------------------------- - IF(.NOT. MaskExists ) THEN -! CALL WritePhysicalNames() - END IF - -10 CONTINUE - - CALL Info(Caller,'Writing the nodal data') - CALL WriteGmshData() - - IF(.FALSE.) THEN - WRITE(GmshUnit,'(A)') '$ElementData' - WRITE(GmshUnit,'(A)') '$EndElementData' - END IF - - IF(.FALSE.) THEN - WRITE(GmshUnit,'(A)') '$ElementNodeData' - WRITE(GmshUnit,'(A)') '$EndElementNodeData' - END IF - - CLOSE(GmshUnit) - - - - IF(ALLOCATED(DgPerm)) DEALLOCATE(DgPerm) - IF(ALLOCATED(InvDgPerm)) DEALLOCATE(InvDgPerm) - IF(ALLOCATED(NodePerm)) DEALLOCATE(NodePerm) - IF(ALLOCATED(InvNodePerm)) DEALLOCATE(InvNodePerm) - IF(ALLOCATED(ActiveElem)) DEALLOCATE(ActiveElem) - - - CALL Info(Caller,'Gmsh output complete') - -CONTAINS - - SUBROUTINE WriteGmshNodes() - - nsize = NumberOfGeomNodes - - WRITE(GmshUnit,'(A)') '$Nodes' - WRITE(GmshUnit,'(I8)') nsize - DO i = 1, nsize - IF( NoPermutation ) THEN - j = i - ELSE - j = InvNodePerm(i) - END IF - - IF( dim == 3 ) THEN - WRITE(GmshUnit,'(I8,3ES16.7E3)') i,Mesh % Nodes % x(j),Mesh % Nodes % y(j), Mesh % Nodes % z(j) - ELSE - WRITE(GmshUnit,'(I8,2ES16.7E3,A)') i,Mesh % Nodes % x(j),Mesh % Nodes % y(j),' 0.0' - END IF - END DO - WRITE(GmshUnit,'(A)') '$EndNodes' - END SUBROUTINE WriteGmshNodes - - - SUBROUTINE WriteGmshElements() - - nsize = NumberOfElements - - BCOffSet = 100 - DO WHILE( BCOffset <= Model % NumberOfBodies ) - BCOffset = 10 * BCOffset - END DO - - WRITE(GmshUnit,'(A)') '$Elements' - WRITE(GmshUnit,'(I8)') nsize - - l = 0 - DO i = ElemFirst, ElemLast - IF(.NOT. ActiveElem(i) ) CYCLE - - l = l + 1 - Element => Mesh % Elements(i) - ElmerCode = Element % TYPE % ElementCode - - n = Element % Type % NumberOfNodes - IF( NoPermutation ) THEN - ElmerIndexes(1:n) = Element % NodeIndexes(1:n) - ELSE - ElmerIndexes(1:n) = NodePerm(Element % NodeIndexes(1:n)) - END IF - - GmshCode = ElmerToGmshType(ElmerCode) - IF( GmshCode == 0 ) THEN - CALL Warn(Caller,'Gmsh element index not found!') - CYCLE - END IF - - IF( i <= Model % NumberOfBulkElements ) THEN - Tag = Element % BodyId - ELSE - Tag = GetBCId( Element ) + BCOffset - END IF - - WRITE(GmshUnit,'(I8,I3,I3,I5,I5)',ADVANCE='NO') l,GmshCode,2,Tag,Tag - k = MOD(ElmerCode,100) - - CALL ElmerToGmshIndex(ElmerCode,ElmerIndexes,GmshIndexes) - - DO j=1,k-1 - WRITE(GmshUnit,'(I8)',ADVANCE='NO') GmshIndexes(j) - END DO - WRITE(GmshUnit,'(I8)') GmshIndexes(k) - END DO - WRITE(GmshUnit,'(A)') '$EndElements' - END SUBROUTINE WriteGmshElements - - - SUBROUTINE WritePhysicalNames() - CALL Info(Caller,'Writing the physical entity names') - nsize = Model % NumberOfBodies + Model % NumberOfBCs - WRITE(GmshUnit,'(A)') '$PhysicalNames' - WRITE(GmshUnit,'(I8)') nsize - DO i=1,Model % NumberOfBodies - Txt = ListGetString( Model % Bodies(i) % Values,'Name',Found) - IF( Found ) THEN - WRITE(GmshUnit,'(I8,A)') i,'"'//TRIM(Txt)//'"' - ELSE - WRITE(GmshUnit,'(I8,A,I0,A)') i,'"Body ',i,'"' - END IF - END DO - DO i=1,Model % NumberOfBCs - Txt = ListGetString( Model % BCs(i) % Values,'Name',Found) - IF( Found ) THEN - WRITE(GmshUnit,'(I8,A)') i+BCOffset,'"'//TRIM(Txt)//'"' - ELSE - WRITE(GmshUnit,'(I8,A,I0,A)') i+BCOffset,'"Boundary Condition ',i,'"' - END IF - END DO - WRITE(GmshUnit,'(A)') '$EndPhysicalNames' - END SUBROUTINE WritePhysicalNames - - - ! In case of DG fields we average the fields on-the-fly to nodes. - !---------------------------------------------------------------- - SUBROUTINE CreateTemporalNodalField(Mesh,Solution,Revert) - TYPE(Mesh_t) :: Mesh - TYPE(Variable_t) :: Solution - LOGICAL, OPTIONAL :: revert - - REAL(KIND=dp), POINTER :: NodalVals(:), TmpVals(:) - INTEGER, POINTER :: NodalPerm(:), TmpPerm(:), NodalCnt(:) - INTEGER :: i,j,k,l,n,t,dofs,ElemFam - - SAVE NodalPerm, NodalVals, NodalCnt, TmpPerm, TmpVals - - IF( PRESENT( Revert ) ) THEN - IF( Revert ) THEN - DEALLOCATE( NodalVals, NodalPerm, NodalCnt ) - Solution % Perm => TmpPerm - Solution % Values => TmpVals - RETURN - END IF - END IF - - dofs = Solution % dofs - - n = Mesh % NumberOfNodes - ALLOCATE( NodalPerm(n), NodalCnt(n), NodalVals(n*dofs) ) - NodalPerm = 0 - NodalCnt = 0 - NodalVals = 0.0_dp - - DO t=1,Mesh % NumberOfBulkElements - Element => Mesh % Elements(t) - - ! This is just a quick hack to not consider those element in averaging that don't - ! even have one face on the active set of nodes. - IF( ALLOCATED(NodePerm) ) THEN - ElemFam = Element % TYPE % ElementCode / 100 - l = COUNT( NodePerm(Element % NodeIndexes ) > 0 ) - SELECT CASE(ElemFam) - CASE(3,4) - IF(l<2) CYCLE - CASE(5,6,7) - IF(l<3) CYCLE - CASE(8) - IF(l<4) CYCLE - END SELECT - END IF - - DO i=1,Element % TYPE % NumberOfNodes - j = Element % DGIndexes(i) - k = Element % NodeIndexes(i) - - NodalCnt(k) = NodalCnt(k) + 1 - NodalPerm(k) = k - - j = Solution % Perm(j) - IF(j==0) CYCLE - - DO l=1,dofs - NodalVals(dofs*(k-1)+l) = NodalVals(dofs*(k-1)+l) + Solution % Values(dofs*(j-1)+l) - END DO - END DO - END DO - - DO i=1,dofs - WHERE ( NodalCnt > 0 ) - NodalVals(i::dofs) = NodalVals(i::dofs) / NodalCnt - END WHERE - END DO - - TmpVals => Solution % Values - TmpPerm => Solution % Perm - - Solution % Perm => NodalPerm - Solution % Values => NodalVals - - - END SUBROUTINE CreateTemporalNodalField - - - - - SUBROUTINE WriteGmshData() - INTEGER :: ii - LOGICAL :: DgVar - - - ! Time is needed - !------------------------------------------------- - TimeVariable => VariableGet( Model % Variables, 'Time' ) - Time = TimeVariable % Values(1) - - ! Loop over different type of variables - !------------------------------------------------- - CALL Info(Caller,'Writing the nodal data') - DO Rank = 0,2 - DO Vari = 1, 999 - IF(Rank==0) WRITE(Txt,'(A,I0)') 'Scalar Field ',Vari - IF(Rank==1) WRITE(Txt,'(A,I0)') 'Vector Field ',Vari - IF(Rank==2) WRITE(Txt,'(A,I0)') 'Tensor Field ',Vari - - FieldName = GetString( Solver % Values, TRIM(Txt), Found ) - IF(.NOT. Found) EXIT - IF( Rank == 2) THEN - CALL Warn(Caller,'Not implemented yet for tensors!') - CYCLE - END IF - - ComponentVector = .FALSE. - Solution => VariableGet( Mesh % Variables, FieldName ) - DGVar = .FALSE. - - IF(ASSOCIATED(Solution)) THEN - DGVar = ( Solution % TYPE == Variable_on_nodes_on_elements ) - IF(DgVar) CALL CreateTemporalNodalField(Mesh,Solution) - - Values => Solution % Values - Perm => Solution % Perm - dofs = Solution % DOFs - ELSE - IF( Rank == 1 ) THEN - Solution => VariableGet( Mesh % Variables, FieldName//' 1' ) - IF( ASSOCIATED( Solution ) ) THEN - ComponentVector = .TRUE. - Values => Solution % Values - Perm => Solution % Perm - dofs = 1 - Solution => VariableGet( Mesh % Variables, FieldName//' 2' ) - IF( ASSOCIATED(Solution)) THEN - Values2 => Solution % Values - dofs = 2 - END IF - Solution => VariableGet( Mesh % Variables, FieldName//' 3' ) - IF( ASSOCIATED(Solution)) THEN - Values3 => Solution % Values - dofs = 3 - END IF - END IF - END IF - IF( .NOT. ASSOCIATED(Solution)) THEN - CALL Warn('GmshOutputSolver','Variable not present: '//TRIM(FieldName)) - CYCLE - END IF - END IF - IF( ASSOCIATED(Solution % EigenVectors) ) THEN - CALL Warn(Caller,'Eigenvectors related to field: '//TRIM(FieldName)) - CALL Warn(Caller,'Eigenvectors saving yet not supported') - END IF - - truedim = MIN(dofs, dim) - nsize = NumberOfGeomNodes - - WRITE(GmshUnit,'(A)') '$NodeData' - WRITE(GmshUnit,'(A)') '1' - WRITE(GmshUnit,'(A)') '"'//TRIM(FieldName)//'"' - WRITE(GmshUnit,'(A)') '1' - - ! Gmsh starts steady state indexes from zero, hence deductions by one - IF( TransientSimulation ) THEN - WRITE(GmshUnit,'(ES16.7E3)') Time - ELSE - WRITE(GmshUnit,'(ES16.7E3)') Time - 1.0_dp - END IF - WRITE(GmshUnit,'(A)') '3' - WRITE(GmshUnit,'(I8)') VisitedTimes-1 - IF(Rank == 0) THEN - WRITE(GmshUnit,'(A)') '1' - ELSE IF(Rank == 1) THEN - WRITE(GmshUnit,'(A)') '3' - ELSE - WRITE(GmshUnit,'(A)') '9' - END IF - WRITE(GmshUnit,'(I8)') nsize - - DO ii = 1, NumberOfGeomNodes - IF( NoPermutation ) THEN - i = ii - ELSE - i = InvFieldPerm(ii) - END IF - - IF( ASSOCIATED( Perm ) ) THEN - j = Perm(i) - ELSE - j = i - END IF - - IF( Rank == 0 ) THEN - WRITE(GmshUnit,'(I8,ES16.7E3)') ii,Values(j) - ELSE IF(Rank == 1) THEN - IF( j == 0 ) THEN - WRITE(GmshUnit,'(I8,A)') ii,' 0.0 0.0 0.0' - ELSE IF( ComponentVector ) THEN - IF( truedim == 2 ) THEN - WRITE(GmshUnit,'(I8,2ES16.7E3,A)') ii,& - Values(j),Values2(j),' 0.0' - ELSE - WRITE(GmshUnit,'(I8,3ES16.7E3)') ii,& - Values(j),Values2(j),Values3(j) - END IF - ELSE - IF( truedim == 2 ) THEN - WRITE(GmshUnit,'(I8,2ES16.7E3,A)') ii,& - Values(dofs*(j-1)+1),Values(dofs*(j-1)+2),' 0.0' - ELSE - WRITE(GmshUnit,'(I8,3ES16.7E3)') ii,& - Values(dofs*(j-1)+1),Values(dofs*(j-1)+2),Values(dofs*(j-1)+3) - END IF - END IF - END IF - END DO - WRITE(GmshUnit,'(A)') '$EndNodeData' - - IF(DgVar) CALL CreateTemporalNodalField(Mesh,Solution,Revert=.TRUE.) - - END DO - END DO - END SUBROUTINE WriteGmshData - - - -!------------------------------------------------------------------------------ -END SUBROUTINE GmshOutputSolver -!------------------------------------------------------------------------------ - diff --git a/fem/src/modules/ResultOutputSolve/ResultOutputSolver.F90 b/fem/src/modules/ResultOutputSolve/ResultOutputSolver.F90 index 30b7a5f891..0b8ff0f7d6 100644 --- a/fem/src/modules/ResultOutputSolve/ResultOutputSolver.F90 +++ b/fem/src/modules/ResultOutputSolve/ResultOutputSolver.F90 @@ -32,6 +32,7 @@ SUBROUTINE ResultOutputSolver( Model,Solver,dt,TransientSimulation ) !------------------------------------------------------------------------------ USE DefUtils + USE SaveUtils USE AscBinOutputUtils IMPLICIT NONE @@ -271,7 +272,8 @@ END SUBROUTINE ElmerPostOutputSolver IF( SaveGmsh ) THEN CALL Info( Caller,'Saving in gmsh 2.0 (.msh) format' ) CALL ListAddInteger( Params,'Output Count',OutputCount(2)) - CALL GmshOutputSolver( Model,Solver,dt,TransientSimulation ) + ! For other call uses this recides in SaveUtils. + CALL SaveGmshOutput( Model,Solver,dt,TransientSimulation ) END IF IF( SaveVTK ) THEN CALL Info( Caller,'Saving in legacy VTK (.vtk) format' ) diff --git a/fem/src/modules/ResultOutputSolve/VtkOutputSolver.F90 b/fem/src/modules/ResultOutputSolve/VtkOutputSolver.F90 index d69885bbf3..f1183b9d0d 100644 --- a/fem/src/modules/ResultOutputSolve/VtkOutputSolver.F90 +++ b/fem/src/modules/ResultOutputSolve/VtkOutputSolver.F90 @@ -28,6 +28,7 @@ MODULE VtkLegacyFile USE MeshUtils USE ElementDescription + USE SaveUtils, ONLY : SolverOutputDirectory IMPLICIT NONE ! PRIVATE diff --git a/fem/src/modules/ResultOutputSolve/VtuOutputSolver.F90 b/fem/src/modules/ResultOutputSolve/VtuOutputSolver.F90 index b522194e63..2dbcf50743 100644 --- a/fem/src/modules/ResultOutputSolve/VtuOutputSolver.F90 +++ b/fem/src/modules/ResultOutputSolve/VtuOutputSolver.F90 @@ -482,9 +482,19 @@ SUBROUTINE VtuOutputSolver( Model,Solver,dt,TransientSimulation ) END IF END IF + ! Sometimes we may want to ignore eigenmodes completely. + !-------------------------------------------------------------- + IF( ListGetLogical( Params,'Ignore Eigenmodes',GotIt) ) THEN + EigenAnalysis = .FALSE. + EigenVectorMode = 0 + MaxModes = 0 + MaxModes2 = 0 + GOTO 1 + END IF + !------------------------------------------------------------------------------ ! Check whether we have nodes coming from different reasons - !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ ActiveModes => ListGetIntegerArray( Params,'Active EigenModes',GotActiveModes ) IF( GotActiveModes ) THEN MaxModes = SIZE( ActiveModes ) @@ -502,9 +512,9 @@ SUBROUTINE VtuOutputSolver( Model,Solver,dt,TransientSimulation ) GetInteger( Model % Solvers(i) % Values,'Scanning Loops', GotIt ) ) END IF END DO - END IF + END IF END IF - EigenVectorMode = 0 + IF( MaxModes > 0 ) THEN CALL Info(Caller,'Maximum number of eigen/harmonic modes: '//I2S(MaxModes),Level=7) Str = ListGetString( Params,'Eigen Vector Component', GotIt ) @@ -547,6 +557,9 @@ SUBROUTINE VtuOutputSolver( Model,Solver,dt,TransientSimulation ) FileIndex = 1 END IF + ! Let's jump here if we ignore all modes. +1 CONTINUE + BcOffset = 0 WriteIds = GetLogical( Params,'Save Geometry Ids',GotIt) IF( WriteIds ) THEN @@ -972,13 +985,23 @@ SUBROUTINE WriteVtuFile( VtuFile, Model, RemoveDisp ) Values => Solution % Values IF ( ASSOCIATED(Solution2) ) Values2 => Solution2 % Values IF ( ASSOCIATED(Solution3) ) Values3 => Solution3 % Values - - EigenVectors => Solution % EigenVectors - IF(ASSOCIATED(Solution2) ) EigenVectors2 => Solution2 % EigenVectors - IF(ASSOCIATED(Solution3) ) EigenVectors3 => Solution3 % EigenVectors - - ConstraintModes => Solution % ConstraintModes - + + IF( MaxModes == 0 ) THEN + EigenVectors => NULL() + EigenVectors2 => NULL() + EigenVectors3 => NULL() + ELSE + EigenVectors => Solution % EigenVectors + IF(ASSOCIATED(Solution2) ) EigenVectors2 => Solution2 % EigenVectors + IF(ASSOCIATED(Solution3) ) EigenVectors3 => Solution3 % EigenVectors + END IF + + IF( MaxModes2 == 0 ) THEN + ConstraintModes => NULL() + ELSE + ConstraintModes => Solution % ConstraintModes + END IF + ! Default is to save the field only once NoFields = 0 NoFields2 = 0 @@ -1063,7 +1086,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model, RemoveDisp ) IF(.NOT. ASSOCIATED( Solution ) ) THEN Solution => VariableGet( Model % Mesh % Variables, TRIM(FieldNameB)//' 1',ThisOnly=NoInterp) ComponentVectorB = ASSOCIATED(Solution) - EigenVectorsB => Solution % EigenVectors + IF(NoModes>0) EigenVectorsB => Solution % EigenVectors END IF IF( ASSOCIATED(Solution)) THEN @@ -1073,12 +1096,12 @@ SUBROUTINE WriteVtuFile( VtuFile, Model, RemoveDisp ) Solution => VariableGet( Model % Mesh % Variables, TRIM(FieldNameB)//' 2',ThisOnly=NoInterp) IF( ASSOCIATED(Solution)) THEN ValuesB2 => Solution % Values - EigenVectorsB2 => Solution % EigenVectors + IF(NoModes>0) EigenVectorsB2 => Solution % EigenVectors END IF Solution => VariableGet( Model % Mesh % Variables, TRIM(FieldNameB)//' 3',ThisOnly=NoInterp) IF( ASSOCIATED(Solution)) THEN ValuesB3 => Solution % Values - EigenVectorsB3 => Solution % EigenVectors + IF(NoModes>0) EigenVectorsB3 => Solution % EigenVectors END IF END IF ComplementExists = .TRUE. @@ -1367,13 +1390,23 @@ SUBROUTINE WriteVtuFile( VtuFile, Model, RemoveDisp ) dofs = 3 END IF END IF - - EigenVectors => Solution % EigenVectors - IF(ASSOCIATED(Solution2) ) EigenVectors2 => Solution2 % EigenVectors - IF(ASSOCIATED(Solution3) ) EigenVectors3 => Solution3 % EigenVectors - - ConstraintModes => Solution % ConstraintModes - + + IF( MaxModes == 0 ) THEN + EigenVectors => NULL() + EigenVectors2 => NULL() + EigenVectors3 => NULL() + ELSE + EigenVectors => Solution % EigenVectors + IF(ASSOCIATED(Solution2) ) EigenVectors2 => Solution2 % EigenVectors + IF(ASSOCIATED(Solution3) ) EigenVectors3 => Solution3 % EigenVectors + END IF + + IF( MaxModes2 == 0 ) THEN + ConstraintModes => NULL() + ELSE + ConstraintModes => Solution % ConstraintModes + END IF + ! Default is to save the field only once NoFields = 0 NoFields2 = 0 @@ -1383,7 +1416,7 @@ SUBROUTINE WriteVtuFile( VtuFile, Model, RemoveDisp ) IF( EigenAnalysis ) THEN IF( MaxModes > 0 .AND. FileIndex <= MaxModes .AND. & ASSOCIATED(EigenVectors) ) THEN - NoModes = SIZE( Solution % EigenVectors, 1 ) + NoModes = SIZE( EigenVectors, 1 ) IF( GotActiveModes ) THEN IndField = ActiveModes( FileIndex ) @@ -1417,8 +1450,8 @@ SUBROUTINE WriteVtuFile( VtuFile, Model, RemoveDisp ) NoFields2 = 1 END IF ELSE - IF( MaxModes > 0 .AND. ASSOCIATED(Solution % EigenVectors) ) THEN - NoModes = SIZE( Solution % EigenVectors, 1 ) + IF( MaxModes > 0 .AND. ASSOCIATED(EigenVectors) ) THEN + NoModes = SIZE( EigenVectors, 1 ) IF( MaxModes > 0 ) NoModes = MIN( MaxModes, NoModes ) NoFields = NoModes END IF diff --git a/fem/src/modules/SaveData/SaveProjection.F90 b/fem/src/modules/SaveData/SaveProjection.F90 index 188d14c68e..1b5b3b539f 100644 --- a/fem/src/modules/SaveData/SaveProjection.F90 +++ b/fem/src/modules/SaveData/SaveProjection.F90 @@ -34,7 +34,7 @@ ! * Keilaranta 14 ! * 02101 Espoo, Finland ! * -! * Original Date: 20 Nov 2001 +! * Original Date: 1.10.2024 ! * ! *****************************************************************************/ @@ -87,7 +87,11 @@ SUBROUTINE SaveProjection( Model,Solver,dt,Transient ) CALL Info('SaveProjection','Creating selected projected values as fields',Level=8) Params => GetSolverParams() - + + ! Because this solver does not have a DefaultInitialize slot the nonlinear projectors + ! are not initialized. Do it here. + CALL GenerateProjectors(Model,Solver,Nonlinear = .TRUE. ) + i = 0 DO WHILE(.TRUE.) i = i + 1 @@ -101,11 +105,12 @@ SUBROUTINE SaveProjection( Model,Solver,dt,Transient ) END DO NoVar = i-1 CALL Info('SaveProjection','Saving projections from '//I2S(NoVar)//' fields') - + IF(NoVar==0) RETURN + Nrm = 0.0_dp DO i=1,NoVar VarName = ListGetString( Params,'Variable '//I2S(i), Found ) - Var => VariableGet( Model % Variables, TRIM(VarName) ) + Var => VariableGet( Model % Variables, TRIM(VarName), ThisOnly = .TRUE.) CALL info('SaveProjection','Doing variable: '//TRIM(VarName),Level=8) TargetName = ListGetString( Params,'Target Variable '//I2S(i), Found ) @@ -116,7 +121,7 @@ SUBROUTINE SaveProjection( Model,Solver,dt,Transient ) ToSlave = ListGetLogical( Params,'Project To Slave '//I2S(i),Found ) ToMaster = ListGetLogical( Params,'Project To Master '//I2S(i),Found ) - TargetVar => VariableGet( Model % Variables, TRIM(TargetName) ) + TargetVar => VariableGet( Model % Variables, TRIM(TargetName), ThisOnly = .TRUE.) IF(.NOT. ASSOCIATED(TargetVar)) THEN IF(.NOT. ASSOCIATED(Var % Perm) ) THEN UnitPerm => NULL() @@ -139,7 +144,7 @@ SUBROUTINE SaveProjection( Model,Solver,dt,Transient ) CALL ProjectToVariable() Nrm = Nrm + SUM(TargetVar % Values**2) END DO - + Nrm = SQRT(Nrm) IF(SIZE(Solver % Variable % Values) == 1 ) THEN Solver % Variable % Values = Nrm @@ -153,7 +158,7 @@ SUBROUTINE SaveProjection( Model,Solver,dt,Transient ) SUBROUTINE ProjectToVariable() TYPE(Matrix_t), POINTER :: A - INTEGER :: bc, dofs, i, j, k, pi, pj + INTEGER :: bc, dofs, i, j, k, pi, pj, m INTEGER, POINTER :: Rows(:), Cols(:) LOGICAL :: acti, actj, AddThis REAL(KIND=dp) :: r1 @@ -196,27 +201,34 @@ SUBROUTINE ProjectToVariable() END IF ! Create table telling which is slave/master dof. - ALLOCATE(IsInvInvPerm(MAXVAL(Cols))) + m = MAXVAL(Cols) + ALLOCATE(IsInvInvPerm(m)) IsInvInvPerm = .FALSE. DO i=1,n pi = A % InvPerm(i) - IF(pi > 0 ) IsInvInvPerm(pi) = .TRUE. + IF(pi > 0 .AND. pi <= m) IsInvInvPerm(pi) = .TRUE. END DO DO k=1,dofs DO i=1,n pi = A % InvPerm(i) - IF(pi == 0) CYCLE + IF(pi == 0 .OR. pi > m) CYCLE acti = IsInvInvPerm(pi) - IF(ASSOCIATED(Var % Perm)) pi = Var % Perm(pi) - IF(pi==0) CYCLE + IF(ASSOCIATED(Var % Perm)) THEN + IF(pi > SIZE(Var % Perm)) CYCLE + pi = Var % Perm(pi) + IF(pi==0) CYCLE + END IF pi = dofs*(pi-1)+k r1 = 0.0_dp DO j=Rows(i),Rows(i+1)-1 pj = Cols(j) - IF(ASSOCIATED(Var % Perm)) pj = Var % Perm(pj) - IF(pj==0) CYCLE + IF(ASSOCIATED(Var % Perm)) THEN + IF(pj > SIZE(Var % Perm)) CYCLE + pj = Var % Perm(pj) + IF(pj==0) CYCLE + END IF pj = dofs*(pj-1)+k actj = IsInvInvPerm(Cols(j)) diff --git a/fem/src/modules/StatCurrentSolve.F90 b/fem/src/modules/StatCurrentSolve.F90 index abfd567958..3ba86b70bd 100644 --- a/fem/src/modules/StatCurrentSolve.F90 +++ b/fem/src/modules/StatCurrentSolve.F90 @@ -75,7 +75,12 @@ SUBROUTINE StatCurrentSolver_Init( Model,Solver,dt,TransientSimulation) 'Volume Current[Volume Current:3]' ) END IF END IF - + + ! If library adaptivity is compiled with, use that by default. +#ifdef LIBRARY_ADAPTIVIVTY + CALL ListAddNewLogical(Params,'Library Adaptivity',.TRUE.) +#endif + !------------------------------------------------------------------------------ END SUBROUTINE StatCurrentSolver_Init !------------------------------------------------------------------------------ @@ -88,6 +93,7 @@ SUBROUTINE StatCurrentSolver( Model,Solver,dt,TransientSimulation ) !------------------------------------------------------------------------------ USE DefUtils USE Differentials + USE Adaptive IMPLICIT NONE !------------------------------------------------------------------------------ TYPE(Model_t) :: Model @@ -137,7 +143,36 @@ SUBROUTINE StatCurrentSolver( Model,Solver,dt,TransientSimulation ) AllocationsDone, VolCurrent, Heating, Conductivity, & CalculateField, ConstantWeights, & Cwrk, ControlScaling, CalculateNodalHeating - + + INTERFACE + FUNCTION StatCurrentSolver_Boundary_Residual(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 StatCurrentSolver_Boundary_Residual + + FUNCTION StatCurrentSolver_Edge_Residual(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 StatCurrentSolver_Edge_Residual + + FUNCTION StatCurrentSolver_Inside_Residual(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 StatCurrentSolver_Inside_Residual + END INTERFACE + !------------------------------------------------------------------------------ ! Get variables needed for solution !------------------------------------------------------------------------------ @@ -528,9 +563,15 @@ SUBROUTINE StatCurrentSolver( Model,Solver,dt,TransientSimulation ) END DO + IF (ListGetLogical(Params, 'Adaptive Mesh Refinement', GotIt)) THEN + IF(.NOT. ListGetLogical(Params,'Library Adaptivity',GotIt)) THEN + CALL RefineMesh(Model, Solver, Solver % Variable % Values, Solver % Variable % Perm, & + StatCurrentSolver_Inside_Residual, StatCurrentSolver_Edge_Residual, & + StatCurrentSolver_Boundary_Residual) + END IF + END IF -!------------------------------------------------------------------------------ - + CALL InvalidateVariable( Model % Meshes, Solver % Mesh, 'Potential') IF ( CalculateCurrent ) THEN @@ -981,3 +1022,650 @@ END SUBROUTINE StatCurrentBoundary !------------------------------------------------------------------------------ END SUBROUTINE StatCurrentSolver !------------------------------------------------------------------------------ + + + !------------------------------------------------------------------------------ + 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) + 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 +!------------------------------------------------------------------------------ + diff --git a/fem/src/modules/StatCurrentSolveVec.F90 b/fem/src/modules/StatCurrentSolveVec.F90 index aa8e2ea402..09bcdfa29f 100644 --- a/fem/src/modules/StatCurrentSolveVec.F90 +++ b/fem/src/modules/StatCurrentSolveVec.F90 @@ -127,6 +127,11 @@ SUBROUTINE StatCurrentSolver_init( Model,Solver,dt,Transient ) ! If no fields need to be computed do not even call the _post solver! CALL ListAddLogical(Params,'PostSolver Active',PostActive) + + ! If library adaptivity is compiled with, use that by default. +#ifdef LIBRARY_ADAPTIVIVTY + CALL ListAddNewLogical(Params,'Library Adaptivity',.TRUE.) +#endif END SUBROUTINE StatCurrentSolver_Init @@ -138,6 +143,7 @@ END SUBROUTINE StatCurrentSolver_Init SUBROUTINE StatCurrentSolver( Model,Solver,dt,Transient ) !------------------------------------------------------------------------------ USE DefUtils + USE Adaptive IMPLICIT NONE !------------------------------------------------------------------------------ TYPE(Solver_t) :: Solver @@ -157,6 +163,36 @@ SUBROUTINE StatCurrentSolver( Model,Solver,dt,Transient ) CHARACTER(*), PARAMETER :: Caller = 'StatCurrentSolver' !------------------------------------------------------------------------------ + INTERFACE + FUNCTION StatCurrentSolver_Boundary_Residual(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 StatCurrentSolver_Boundary_Residual + + FUNCTION StatCurrentSolver_Edge_Residual(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 StatCurrentSolver_Edge_Residual + + FUNCTION StatCurrentSolver_Inside_Residual(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 StatCurrentSolver_Inside_Residual + END INTERFACE + +!------------------------------------------------------------------------------ CALL Info(Caller,'------------------------------------------------') CALL Info(Caller,'Solving static current conduction solver') @@ -290,6 +326,13 @@ SUBROUTINE StatCurrentSolver( Model,Solver,dt,Transient ) CALL DefaultFinish() + IF (ListGetLogical(Params, 'Adaptive Mesh Refinement', Found)) THEN + IF(.NOT. ListGetLogical(Params,'Library Adaptivity',Found)) THEN + CALL RefineMesh(Model, Solver, Solver % Variable % Values, Solver % Variable % Perm, & + StatCurrentSolver_Inside_Residual, StatCurrentSolver_Edge_Residual, & + StatCurrentSolver_Boundary_Residual) + END IF + END IF CONTAINS @@ -1139,3 +1182,652 @@ END SUBROUTINE GlobalPostScale !------------------------------------------------------------------------ END SUBROUTINE StatCurrentSolver_Post !------------------------------------------------------------------------ + + + !------------------------------------------------------------------------------ + 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) + 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 + !------------------------------------------------------------------------------ + + + diff --git a/fem/src/modules/StatElecSolve.F90 b/fem/src/modules/StatElecSolve.F90 index 76f92205d5..5a9b2c4386 100644 --- a/fem/src/modules/StatElecSolve.F90 +++ b/fem/src/modules/StatElecSolve.F90 @@ -199,32 +199,32 @@ SUBROUTINE StatElecSolver( Model,Solver,dt,TransientSimulation ) !$omp Basis, dBasisdx, PiezoMaterial) INTERFACE - FUNCTION ElectricBoundaryResidual( Model,Edge,Mesh,Quant,Perm,Gnorm ) RESULT(Indicator) + FUNCTION StatElecSolver_Boundary_Residual( 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 + END FUNCTION StatElecSolver_Boundary_Residual - FUNCTION ElectricEdgeResidual( Model,Edge,Mesh,Quant,Perm ) RESULT(Indicator) + FUNCTION StatElecSolver_Edge_Residual( 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 + END FUNCTION StatElecSolver_Edge_Residual - FUNCTION ElectricInsideResidual( Model,Element,Mesh,Quant,Perm, Fnorm ) RESULT(Indicator) + FUNCTION StatElecSolver_Inside_Residual( 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 FUNCTION StatElecSolver_Inside_Residual END INTERFACE !------------------------------------------------------------------------------ @@ -552,7 +552,8 @@ END FUNCTION ElectricInsideResidual IF ( ListGetLogical( Params, 'Adaptive Mesh Refinement', GotIt ) ) & CALL RefineMesh( Model, Solver, Potential, PotentialPerm, & - ElectricInsideResidual, ElectricEdgeResidual, ElectricBoundaryResidual ) + StatElecSolver_Inside_Residual, StatElecSolver_Edge_Residual, & + StatElecSolver_Boundary_Residual ) CALL InvalidateVariable( Model % Meshes, Solver % Mesh, 'Potential') @@ -1507,7 +1508,7 @@ END SUBROUTINE StatElecSolver !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - FUNCTION ElectricBoundaryResidual( Model, Edge, Mesh, Quant, Perm, Gnorm ) & + FUNCTION StatElecSolver_Boundary_Residual( Model, Edge, Mesh, Quant, Perm, Gnorm ) & RESULT( Indicator ) !------------------------------------------------------------------------------ USE DefUtils @@ -1752,13 +1753,13 @@ FUNCTION ElectricBoundaryResidual( Model, Edge, Mesh, Quant, Perm, Gnorm ) & DEALLOCATE( EdgeBasis, Basis, dBasisdx, Flux, x, y, z, & NodalPermittivity, Potential ) !------------------------------------------------------------------------------ - END FUNCTION ElectricBoundaryResidual + END FUNCTION StatElecSolver_Boundary_Residual !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - FUNCTION ElectricEdgeResidual( Model, Edge, Mesh, Quant, Perm ) RESULT( Indicator ) + FUNCTION StatElecSolver_Edge_Residual( Model, Edge, Mesh, Quant, Perm ) RESULT( Indicator ) !------------------------------------------------------------------------------ USE DefUtils IMPLICIT NONE @@ -1970,12 +1971,12 @@ FUNCTION ElectricEdgeResidual( Model, Edge, Mesh, Quant, Perm ) RESULT( Indicato DEALLOCATE( x, y, z, NodalPermittivity, EdgeBasis, Basis, & dBasisdx, Potential ) !------------------------------------------------------------------------------ - END FUNCTION ElectricEdgeResidual + END FUNCTION StatElecSolver_Edge_Residual !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ - FUNCTION ElectricInsideResidual( Model, Element, Mesh, & + FUNCTION StatElecSolver_Inside_Residual( Model, Element, Mesh, & Quant, Perm, Fnorm ) RESULT( Indicator ) !------------------------------------------------------------------------------ USE DefUtils @@ -2195,6 +2196,6 @@ FUNCTION ElectricInsideResidual( Model, Element, Mesh, & DEALLOCATE( Nodes % x, Nodes % y, Nodes % z, NodalPermittivity, & Basis, dBasisdx, ddBasisddx, PrevPot, NodalSource, Potential ) !------------------------------------------------------------------------------ - END FUNCTION ElectricInsideResidual + END FUNCTION StatElecSolver_Inside_Residual !------------------------------------------------------------------------------ diff --git a/fem/src/modules/StatElecSolveVec.F90 b/fem/src/modules/StatElecSolveVec.F90 index b082beb0d9..48a47c3ff5 100644 --- a/fem/src/modules/StatElecSolveVec.F90 +++ b/fem/src/modules/StatElecSolveVec.F90 @@ -175,6 +175,11 @@ SUBROUTINE StatElecSolver_init( Model,Solver,dt,Transient ) ! If no fields need to be computed do not even call the _post solver! CALL ListAddLogical(Params,'PostSolver Active',PostActive) + + ! If library adaptivity is compiled with, use that by default. +#ifdef LIBRARY_ADAPTIVIVTY + CALL ListAddNewLogical(Params,'Library Adaptivity',.TRUE.) +#endif END SUBROUTINE StatElecSolver_Init @@ -204,34 +209,37 @@ SUBROUTINE StatElecSolver( Model,Solver,dt,Transient ) TYPE(Mesh_t), POINTER :: Mesh CHARACTER(*), PARAMETER :: Caller = 'StatElecSolver' +#ifndef LIBRARY_ADAPTIVITY INTERFACE - FUNCTION ElectricBoundaryResidual(Model, Edge, Mesh, Quant, Perm, Gnorm) RESULT(Indicator) + FUNCTION StatElecSolver_Boundary_Residual(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) + END FUNCTION StatElecSolver_Boundary_Residual + + FUNCTION StatElecSolver_Edge_Residual(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) + END FUNCTION StatElecSolver_Edge_Residual + + FUNCTION StatElecSolver_Inside_Residual(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 FUNCTION StatElecSolver_Inside_Residual END INTERFACE +#endif + !------------------------------------------------------------------------------ CALL Info(Caller,'------------------------------------------------') @@ -380,11 +388,13 @@ END FUNCTION ElectricInsideResidual CALL DefaultFinish() -#ifndef LIBRARY_ADAPTIVITY - IF (ListGetLogical(Solver % Values, 'Adaptive Mesh Refinement', Found)) & - CALL RefineMesh(Model, Solver, Solver % Variable % Values, Solver % Variable % Perm, & - ElectricInsideResidual, ElectricEdgeResidual, ElectricBoundaryResidual) -#endif + IF (ListGetLogical(Solver % Values, 'Adaptive Mesh Refinement', Found)) THEN + IF(.NOT. ListGetLogical( Solver % Values,'Library Adaptivity',Found )) THEN + CALL RefineMesh(Model, Solver, Solver % Variable % Values, Solver % Variable % Perm, & + StatElecSolver_Inside_Residual, StatElecSolver_Edge_Residual, & + StatElecSolver_Boundary_Residual) + END IF + END IF CONTAINS @@ -518,7 +528,7 @@ SUBROUTINE LocalMatrix( Element, n, nd, nb, InitHandles, CVersion ) ! This InitHandles flag might be false on threaded 1st call IF( InitHandles ) THEN - CALL ListInitElementKeyword( SourceCoeff_h,'Body Force','Charge Source') + CALL ListInitElementKeyword( SourceCoeff_h,'Body Force','Charge Density') CALL ListInitElementKeyword( EpsCoeff_h,'Material','Relative Permittivity',InitIm=CVersion) Found = .FALSE. @@ -918,7 +928,7 @@ SUBROUTINE LocalPostAssembly( Element, n, nd, InitHandles, MASS, FORCE ) !------------------------------------------------------------------------------ ! This InitHandles flag might be false on threaded 1st call IF( InitHandles ) THEN - CALL ListInitElementKeyword( SourceCoeff_h,'Body Force','Charge Source') + CALL ListInitElementKeyword( SourceCoeff_h,'Body Force','Charge Density') CALL ListInitElementKeyword( EpsCoeff_h,'Material','Relative Permittivity') Found = .FALSE. IF( ASSOCIATED( Model % Constants ) ) THEN @@ -1234,13 +1244,15 @@ SUBROUTINE GlobalPostAve() END SUBROUTINE GlobalPostAve !------------------------------------------------------------------------------ - - -!------------------------------------------------------------------------ END SUBROUTINE StatElecSolver_Post +!------------------------------------------------------------------------ + + !------------------------------------------------------------------------------ -FUNCTION ElectricBoundaryResidual(Model, Edge, Mesh, Quant, Perm, Gnorm) RESULT(Indicator) +! Subroutine for computing residuals for adaptive mesh refinement. +!------------------------------------------------------------------------------ +FUNCTION StatElecSolver_boundary_Residual(Model, Edge, Mesh, Quant, Perm, Gnorm) RESULT(Indicator) !------------------------------------------------------------------------------ USE DefUtils IMPLICIT NONE @@ -1259,12 +1271,13 @@ FUNCTION ElectricBoundaryResidual(Model, Edge, Mesh, Quant, Perm, Gnorm) RESULT( 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 :: NodalPermittivity(:), & - EdgeBasis(:), Basis(:), x(:), y(:), z(:), & - dBasisdx(:, :), Potential(:), Flux(:) + EdgeBasis(:), Basis(:), x(:), y(:), z(:), & + dBasisdx(:, :), Potential(:), Flux(:) REAL(KIND=dp) :: Normal(3), EdgeLength, gx, gy, gz, Permittivity 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 !------------------------------------------------------------------------------ @@ -1464,11 +1477,11 @@ FUNCTION ElectricBoundaryResidual(Model, Edge, Mesh, Quant, Perm, Gnorm) RESULT( ! Gnorm = EdgeLength * Gnorm Indicator = EdgeLength * ResidualNorm !------------------------------------------------------------------------------ -END FUNCTION ElectricBoundaryResidual +END FUNCTION StatElecSolver_boundary_residual !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ -FUNCTION ElectricEdgeResidual(Model, Edge, Mesh, Quant, Perm) RESULT(Indicator) +FUNCTION StatElecSolver_edge_residual(Model, Edge, Mesh, Quant, Perm) RESULT(Indicator) !------------------------------------------------------------------------------ USE DefUtils IMPLICIT NONE @@ -1663,11 +1676,11 @@ FUNCTION ElectricEdgeResidual(Model, Edge, Mesh, Quant, Perm) RESULT(Indicator) DEALLOCATE (x, y, z, NodalPermittivity, EdgeBasis, & Basis, dBasisdx, Potential) !------------------------------------------------------------------------------ -END FUNCTION ElectricEdgeResidual +END FUNCTION StatElecSolver_Edge_Residual !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ -FUNCTION ElectricInsideResidual(Model, Element, Mesh, & +FUNCTION StatElecSolver_Inside_residual(Model, Element, Mesh, & Quant, Perm, Fnorm) RESULT(Indicator) !------------------------------------------------------------------------------ USE DefUtils @@ -1687,16 +1700,13 @@ FUNCTION ElectricInsideResidual(Model, Element, Mesh, & 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 :: NodalPermittivity(:) 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) :: Permittivity, dt + REAL(KIND=dp) :: Permittivity, dt REAL(KIND=dp) :: Residual, ResidualNorm, Area - TYPE(ValueList_t), POINTER :: Material - TYPE(GaussIntegrationPoints_t), TARGET :: IntegStuff LOGICAL :: First = .TRUE. @@ -1780,16 +1790,6 @@ FUNCTION ElectricInsideResidual(Model, Element, Mesh, & 1, Model % NumberOFBodyForces) NodalSource = 0.0d0 - ! TODO doees this work? - ! IF( k > 0 ) THEN - ! NodalSource(1:n) = GetReal( Model % BodyForces(k) % Values, & - ! 'Volumetric Heat Source',VolSource ) - ! IF( .NOT. VolSource ) THEN - ! NodalSource(1:n) = GetReal( Model % BodyForces(k) % Values, & - ! 'Heat Source', Found ) - ! END IF - ! END IF - IF (Found .AND. k > 0) THEN NodalSource(1:n) = ListGetReal(Model % BodyForces(k) % Values, & 'Charge Density', n, Element % NodeIndexes, stat) @@ -1900,659 +1900,5 @@ FUNCTION ElectricInsideResidual(Model, Element, Mesh, & ! Fnorm = Element % hk**2 * Fnorm Indicator = Element % hK**2 * ResidualNorm !------------------------------------------------------------------------------ -END FUNCTION ElectricInsideResidual -!------------------------------------------------------------------------------ -!------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ -FUNCTION StatElecSolver_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 :: NodalPermittivity(:), & - EdgeBasis(:), Basis(:), x(:), y(:), z(:), & - dBasisdx(:, :), Potential(:), Flux(:) - REAL(KIND=dp) :: Normal(3), EdgeLength, gx, gy, gz, Permittivity - 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 +END FUNCTION StatElecSolver_inside_residual !------------------------------------------------------------------------------ - -! 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), NodalPermittivity(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, & - 'Relative Permittivity', Hwrk, en, Edge % NodeIndexes, stat) - IF (.NOT. stat) & - CALL ListGetRealArray(Model % Materials(k) % Values, & - 'Permittivity', Hwrk, En, Edge % NodeIndexes) - NodalPermittivity(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 permittivity at the integration point: -! -------------------------------------------- - Permittivity = SUM(NodalPermittivity(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 + Permittivity * & - SUM(dBasisdx(1:nd, k) * Potential(1:nd)) * Normal(k) - - Gnorm = Gnorm + s * (Permittivity * & - 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) * Permittivity * & - SUM(dBasisdx(1:nd, k) * Potential(1:nd)) * Normal(l) - - Gnorm = Gnorm + s * (Metric(k, l) * Permittivity * & - 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 StatElecSolver_boundary_residual -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ -FUNCTION StatElecSolver_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) :: Permittivity - REAL(KIND=dp) :: u, v, w, s, detJ - REAL(KIND=dp) :: Grad(3, 3), Normal(3), EdgeLength, Jump - REAL(KIND=dp), ALLOCATABLE :: NodalPermittivity(:), 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 (NodalPermittivity(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, & - 'Relative Permittivity', Hwrk, en, Edge % NodeIndexes, stat) ! Should we have stat here? - IF (.NOT. stat) & - CALL ListGetRealArray(Material, & - 'Permittivity', Hwrk, En, Edge % NodeIndexes) - - NodalPermittivity(1:en) = Hwrk(1, 1, 1:en) - Permittivity = SUM(NodalPermittivity(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) = Permittivity * 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, NodalPermittivity, EdgeBasis, & - Basis, dBasisdx, Potential) -!------------------------------------------------------------------------------ -END FUNCTION StatElecSolver_Edge_Residual -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ -FUNCTION StatElecSolver_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 :: NodalPermittivity(:) - 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) :: Permittivity, 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 - -! Alllocate local arrays -! ---------------------- - nd = GetElementNOFDOFs(Element) - n = GetElementNOFNodes(Element) - ALLOCATE (NodalPermittivity(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: relative permittivity -! ------------------------------------------ - k = ListGetInteger(Model % Bodies(Element % BodyId) % Values, 'Material', & - minv=1, maxv=Model % NumberOfMaterials) - - Material => Model % Materials(k) % Values - - CALL ListGetRealArray(Material, 'Relative Permittivity', Hwrk, n, Element % NodeIndexes, stat) - IF (.NOT. stat) & - CALL ListGetRealArray(Material, 'Permittivity', Hwrk, n, Element % NodeIndexes) - NodalPermittivity(1:n) = Hwrk(1, 1, 1:n) - -! -! Charge 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, & - 'Charge Density', 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 - - Permittivity = SUM(NodalPermittivity(1:n) * Basis(1:n)) -! -! Residual of the electrostatic equation: -! -! R = -div(e grad(u)) - s -! --------------------------------------------------- -! -! or more generally: -! -! R = -g^{jk} (C T_{,j}}_{,k} - s -! --------------------------------------------------- -! - Residual = -SUM(NodalSource(1:n) * Basis(1:n)) - - IF (CurrentCoordinateSystem() == Cartesian) THEN - DO j = 1, dim -! -! - grad(e).grad(T): -! -------------------- -! - Residual = Residual - & - SUM(Potential(1:nd) * dBasisdx(1:nd, j)) * & - SUM(NodalPermittivity(1:n) * dBasisdx(1:n, j)) - -! -! - e div(grad(u)): -! ------------------- -! - Residual = Residual - Permittivity * & - SUM(Potential(1:nd) * ddBasisddx(1:nd, j, j)) - END DO - ELSE - DO j = 1, dim - DO k = 1, dim -! -! - g^{jk} C_{,k}T_{j}: -! --------------------- -! - Residual = Residual - Metric(j, k) * & - SUM(Potential(1:nd) * dBasisdx(1:nd, j)) * & - SUM(NodalPermittivity(1:n) * dBasisdx(1:n, k)) - -! -! - g^{jk} C T_{,jk}: -! ------------------- -! - Residual = Residual - Metric(j, k) * Permittivity * & - SUM(Potential(1:nd) * ddBasisddx(1:nd, j, k)) -! -! + g^{jk} C {_jk^l} T_{,l}: -! --------------------------- - DO l = 1, dim - Residual = Residual + Metric(j, k) * Permittivity * & - 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 StatElecSolver_inside_residual -!------------------------------------------------------------------------------ -!------------------------------------------------------------------------ diff --git a/fem/src/modules/StressSolve.F90 b/fem/src/modules/StressSolve.F90 index 19020421c7..db1a617306 100644 --- a/fem/src/modules/StressSolve.F90 +++ b/fem/src/modules/StressSolve.F90 @@ -372,7 +372,12 @@ END FUNCTION StressInsideResidual QuasiStationary = GetLogical( SolverParams, 'Quasi Stationary',Found) Incompr = GetLogical( SolverParams, 'Incompressible', Found ) - + IF( Incompr ) THEN + IF( STDOFs /= dim+1 ) THEN + CALL Fatal('StressSolver','Invalid size for incompressible displacement solution!') + END IF + END IF + MeshDisplacementActive = ListGetLogical( SolverParams, & 'Displace Mesh', Found ) @@ -1105,7 +1110,9 @@ SUBROUTINE BulkAssembly() body_id = -1 RelIntegOrder = ListGetInteger( SolverParams,'Relative Integration Order',Found) - + ! This might be a good idea! + !IF(.NOT. Found .AND. Incompr ) RelIntegOrder = 1 + NoActive = GetNOFActive() DO t=1,NoActive diff --git a/fem/src/modules/VectorHelmholtz.F90 b/fem/src/modules/VectorHelmholtz.F90 index 89d97007a3..b09e0fe607 100644 --- a/fem/src/modules/VectorHelmholtz.F90 +++ b/fem/src/modules/VectorHelmholtz.F90 @@ -174,6 +174,9 @@ SUBROUTINE VectorHelmholtzSolver_Init(Model,Solver,dt,Transient) LOGICAL :: Transient !------------------------------------------------------------------------------ TYPE(ValueList_t), POINTER :: SolverParams + LOGICAL :: Found + INTEGER :: i, j, soln + CHARACTER(LEN=MAX_NAME_LEN) :: sname !------------------------------------------------------------------------------ SolverParams => GetSolverParams() @@ -183,6 +186,27 @@ SUBROUTINE VectorHelmholtzSolver_Init(Model,Solver,dt,Transient) CALL ListAddNewLogical(SolverParams, 'Allocate Preconditioning Matrix', .TRUE.) END IF + ! + ! The following is for creating sources from pre-computed eigenfunctions: + ! + IF (ListGetLogicalAnyBC(Model, 'Eigenfunction BC')) THEN + soln = 0 + DO i=1,Model % NumberOfSolvers + sname = GetString(Model % Solvers(i) % Values, 'Procedure', Found) + j = INDEX(sname, 'EMPortSolver') + IF (j > 0) THEN + soln = i + EXIT + END IF + END DO + + IF( soln == 0 ) THEN + CALL Fatal('VectorHelmholtzSolver_Init','Eigenfunction BC given without solving a port model') + ELSE + CALL Info('VectorHelmholtzSolver_Init','The eigensolver index is: '//I2S(soln), Level=12) + CALL ListAddInteger(SolverParams, 'Eigensolver Index', soln) + END IF + END IF !------------------------------------------------------------------------------ END SUBROUTINE VectorHelmholtzSolver_Init !------------------------------------------------------------------------------ @@ -207,13 +231,15 @@ SUBROUTINE VectorHelmholtzSolver( Model,Solver,dt,Transient ) !------------------------------------------------------------------------------ ! Local variables !------------------------------------------------------------------------------ + TYPE(Solver_t), POINTER :: Eigensolver => NULL() LOGICAL :: Found, HasPrecDampCoeff, MassProportional REAL(KIND=dp) :: Omega, mu0inv, eps0, rob0 - INTEGER :: i, NoIterationsMax, EdgeBasisDegree + INTEGER :: i, soln, NoIterationsMax, EdgeBasisDegree TYPE(Mesh_t), POINTER :: Mesh COMPLEX(KIND=dp) :: PrecDampCoeff LOGICAL :: PiolaVersion, EdgeBasis, LowFrequencyModel, LorenzCondition LOGICAL :: UseGaussLaw, ChargeConservation + LOGICAL :: EigenfunctionSource TYPE(ValueList_t), POINTER :: SolverParams TYPE(Solver_t), POINTER :: pSolver CHARACTER(*), PARAMETER :: Caller = 'VectorHelmholtzSolver' @@ -281,6 +307,16 @@ SUBROUTINE VectorHelmholtzSolver( Model,Solver,dt,Transient ) LorenzCondition = GetLogical(SolverParams, 'Lorenz Condition', Found) UseGaussLaw = GetLogical(SolverParams, 'Use Gauss Law', Found) ChargeConservation = GetLogical(SolverParams, 'Apply Conservation of Charge', Found) + + EigenfunctionSource = ListGetLogicalAnyBC(Model, 'Eigenfunction BC') + IF (EigenfunctionSource) THEN + soln = ListGetInteger(SolverParams, 'Eigensolver Index', Found) + IF (soln == 0) THEN + CALL Fatal(Caller, 'We should know > Eigensolver Index <') + END IF + Eigensolver => Model % Solvers(soln) + END IF + ! Resolve internal nonlinearities, if requested: ! ---------------------------------------------- @@ -781,27 +817,33 @@ SUBROUTINE LocalMatrixBC( BC, Element, n, nd, InitHandles ) LOGICAL :: InitHandles !------------------------------------------------------------------------------ COMPLEX(KIND=dp), ALLOCATABLE :: STIFF(:,:), MASS(:,:), FORCE(:) - COMPLEX(KIND=dp) :: B, L(3), muinv, TemGrad(3), MagLoad(3), BetaPar, jn, Cond, SurfImp, epsr, mur, imu, ep + COMPLEX(KIND=dp) :: B, L(3), muinv, TemGrad(3), MagLoad(3), BetaPar, jn, Cond, SurfImp, epsr, mur, ep REAL(KIND=dp), ALLOCATABLE :: Basis(:),dBasisdx(:,:),WBasis(:,:),RotWBasis(:,:) + REAL(KIND=dp), ALLOCATABLE :: Re_Eigenf(:), Im_Eigenf(:) REAL(KIND=dp) :: th, DetJ - LOGICAL :: Stat, Found, UpdateStiff, WithNdofs, ThinSheet, ConductorBC + LOGICAL :: Stat, Found, UpdateStiff, WithNdofs, ThinSheet, ConductorBC, EigenBC, PortSource LOGICAL :: LineElement, DegenerateElement, Regularize LOGICAL :: AllocationsDone = .FALSE. TYPE(GaussIntegrationPoints_t) :: IP - INTEGER :: t, i, j, m, np, p, q, ndofs + INTEGER :: t, i, j, m, np, p, q, ndofs, EigenInd + INTEGER :: nd_eigen TYPE(Nodes_t), SAVE :: Nodes TYPE(Element_t), POINTER :: Parent TYPE(ValueHandle_t), SAVE :: MagLoad_h, ElRobin_h, MuCoeff_h, EpsCoeff_h, Absorb_h, TemRe_h, TemIm_h, ExtPot_h TYPE(ValueHandle_t), SAVE :: TransferCoeff_h, ElCurrent_h TYPE(ValueHandle_t), SAVE :: Thickness_h, RelNu_h, CondCoeff_h TYPE(ValueHandle_t), SAVE :: GoodConductor, ChargeConservation + TYPE(ValueHandle_t), SAVE :: EigenvectorSource, EigenvectorInd, IncidentWave - SAVE AllocationsDone, WBasis, RotWBasis, Basis, dBasisdx, FORCE, STIFF, MASS + SAVE AllocationsDone, WBasis, RotWBasis, Basis, dBasisdx, FORCE, STIFF, MASS, Re_Eigenf, Im_Eigenf IF(.NOT. AllocationsDone ) THEN m = Mesh % MaxElementDOFs ALLOCATE( WBasis(m,3), RotWBasis(m,3), Basis(m), dBasisdx(m,3),& FORCE(m),STIFF(m,m),MASS(m,m)) + IF (EigenfunctionSource) THEN + ALLOCATE(Re_Eigenf(m), Im_Eigenf(m)) + END IF AllocationsDone = .TRUE. END IF @@ -823,6 +865,10 @@ SUBROUTINE LocalMatrixBC( BC, Element, n, nd, InitHandles ) CALL ListInitElementKeyword( Thickness_h,'Boundary Condition','Layer Thickness') CALL ListInitElementKeyword( RelNu_h,'Boundary Condition','Layer Relative Reluctivity',InitIm=.TRUE.) CALL ListInitElementKeyword( CondCoeff_h,'Boundary Condition','Layer Electric Conductivity',InitIm=.TRUE.) + + CALL ListInitElementKeyword( EigenvectorSource,'Boundary Condition','Eigenfunction BC') + CALL ListInitElementKeyword( EigenvectorInd,'Boundary Condition','Eigenfunction Index') + CALL ListInitElementKeyword( IncidentWave,'Boundary Condition','Incident Wave') InitHandles = .FALSE. END IF @@ -834,6 +880,26 @@ SUBROUTINE LocalMatrixBC( BC, Element, n, nd, InitHandles ) MASS = 0.0_dp FORCE = 0.0_dp + ! Check whether BC should be created in terms of pre-computed eigenfunction: + EigenBC = ListGetElementLogical(EigenvectorSource, Element, Found) + + IF (EigenBC) THEN + EigenInd = ListGetElementInteger(EigenvectorInd, Element, Found) + IF (EigenInd < 1) CALL Fatal(Caller, 'Eigenfunction Index must be positive') + PortSource = ListGetElementLogical(IncidentWave, Element, Found) + + CALL GetScalarLocalEigenmode(Re_Eigenf, ComponentName(Eigensolver % Variable, 1), Element, & + Eigensolver, EigenInd, ComplexPart=.FALSE.) + CALL GetScalarLocalEigenmode(Im_Eigenf, ComponentName(Eigensolver % Variable, 2), Element, & + Eigensolver, EigenInd, ComplexPart=.FALSE.) + + nd_eigen = GetElementNOFDOFs(USolver=Eigensolver) + nd_eigen = nd_eigen - n + IF (nd_eigen /= nd) CALL Fatal(Caller, & + 'The DOFs of the port model are not compatible with the DOFs of this solver') + END IF + + ! Numerical integration: !----------------------- IP = GaussPoints(Element, EdgeBasis=.TRUE., PReferenceElement=PiolaVersion, & @@ -845,12 +911,13 @@ SUBROUTINE LocalMatrixBC( BC, Element, n, nd, InitHandles ) IF (WithNdofs) THEN Regularize = UseGaussLaw .AND. ListGetElementLogical( ChargeConservation, Element, Found ) + IF (EigenBC) THEN + CALL Fatal(Caller, 'Eigenfunction BC needs the plain E-formulation') + END IF END IF LineElement = GetElementFamily(Element) == 2 DegenerateElement = (CoordinateSystemDimension() == 3) .AND. LineElement - - imu = CMPLX(0.0_dp, 1.0_dp) UpdateStiff = .FALSE. DO t=1,IP % n @@ -915,7 +982,7 @@ SUBROUTINE LocalMatrixBC( BC, Element, n, nd, InitHandles ) B = th * Cond ELSE IF( ListGetElementLogical( Absorb_h, Element, Found ) ) THEN - B = imu * rob0 * SQRT( epsr / mur ) + B = im * rob0 * SQRT( epsr / mur ) ELSE ConductorBC = ListGetElementLogical( GoodConductor, Element, Found ) IF (ConductorBC) THEN @@ -933,11 +1000,22 @@ SUBROUTINE LocalMatrixBC( BC, Element, n, nd, InitHandles ) END IF END IF END IF - - MagLoad = ListGetElementComplex3D( MagLoad_h, Basis, Element, Found, GaussPoint = t ) - TemGrad = CMPLX( ListGetElementRealGrad( TemRe_h,dBasisdx,Element,Found), & - ListGetElementRealGrad( TemIm_h,dBasisdx,Element,Found) ) - L = MagLoad + TemGrad + + IF (EigenBC) THEN + B = im * SQRT(-Eigensolver % Variable % Eigenvalues(EigenInd)) + L = CMPLX(0.0_dp, 0.0_dp, kind=dp) + IF (PortSource) THEN + DO p=1,nd + L(:) = L(:) + CMPLX(Re_Eigenf(n+p) * WBasis(p,:), Im_Eigenf(n+p) * WBasis(p,:), kind=dp) + END DO + L = 2.0_dp * B * L + END IF + ELSE + MagLoad = ListGetElementComplex3D( MagLoad_h, Basis, Element, Found, GaussPoint = t ) + TemGrad = CMPLX( ListGetElementRealGrad( TemRe_h,dBasisdx,Element,Found), & + ListGetElementRealGrad( TemIm_h,dBasisdx,Element,Found) ) + L = MagLoad + TemGrad + END IF IF (.NOT. WithNdofs) THEN IF (ABS(B) < AEPS .AND. ABS(DOT_PRODUCT(L,L)) < AEPS) CYCLE @@ -1219,7 +1297,7 @@ SUBROUTINE VectorHelmholtzCalcFields_Init(Model,Solver,dt,Transient) SolverParams => GetSolverParams() - CALL ListAddString( SolverParams, 'Variable', '-nooutput hr_dummy' ) + CALL ListAddString( SolverParams, 'Variable', '-nooutput vectorhelmholtz_dummy' ) CALL ListAddLogical( SolverParams, 'Linear System refactorize', .FALSE.) @@ -1375,7 +1453,7 @@ SUBROUTINE VectorHelmholtzCalcFields(Model,Solver,dt,Transient) UseGaussLaw = GetLogical(pSolver % Values, 'Use Gauss Law', Found) LorenzCondition = GetLogical(pSolver % Values, 'Lorenz Condition', Found) - Omega = GetAngularFrequency(Found=Found) + Omega = GetAngularFrequency(pSolver % Values) Found = .FALSE. IF( ASSOCIATED( Model % Constants ) ) THEN diff --git a/fem/src/modules/WPotentialSolver.F90 b/fem/src/modules/WPotentialSolver.F90 index e6efba8a15..eade12b35f 100644 --- a/fem/src/modules/WPotentialSolver.F90 +++ b/fem/src/modules/WPotentialSolver.F90 @@ -564,8 +564,8 @@ SUBROUTINE SaveElementWSolution(Element, n, Wnorm, RotM, Tcoef, NoRotM) DO t=1,n IF (ASSOCIATED(wpotvar)) THEN DO k=1,wpotvar % DOFs + IF( CoilType/='stranded' ) Wnorm = 1._dp IF (Wnorm > EPSILON(Wnorm)) THEN - IF( CoilType/='stranded' ) Wnorm = 1._dp ! print *, ParEnv % MyPe, "Wnorm:", Wnorm wpotvar % Values( wpotvar % DOFs*(wpotvar % Perm( & Element % DGIndexes(t))-1)+k) = wpot(t)/Wnorm diff --git a/fem/tests/ContactPatch2DIncompressible/CMakeLists.txt b/fem/tests/ContactPatch2DIncompressible/CMakeLists.txt new file mode 100644 index 0000000000..1e7430b0c4 --- /dev/null +++ b/fem/tests/ContactPatch2DIncompressible/CMakeLists.txt @@ -0,0 +1,8 @@ +INCLUDE(test_macros) +INCLUDE_DIRECTORIES(${CMAKE_BINARY_DIR}/fem/src) + +CONFIGURE_FILE(case.sif case.sif COPYONLY) + +file(COPY ELMERSOLVER_STARTINFO squares.grd DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") + +ADD_ELMER_TEST(ContactPatch2DIncompressible LABELS quick contact mortar elasticsolve) diff --git a/fem/tests/ContactPatch2DIncompressible/ELMERSOLVER_STARTINFO b/fem/tests/ContactPatch2DIncompressible/ELMERSOLVER_STARTINFO new file mode 100644 index 0000000000..d21bd7ee27 --- /dev/null +++ b/fem/tests/ContactPatch2DIncompressible/ELMERSOLVER_STARTINFO @@ -0,0 +1 @@ +case.sif diff --git a/fem/tests/ContactPatch2DIncompressible/case.sif b/fem/tests/ContactPatch2DIncompressible/case.sif new file mode 100644 index 0000000000..4607383702 --- /dev/null +++ b/fem/tests/ContactPatch2DIncompressible/case.sif @@ -0,0 +1,157 @@ +!------------------------------------------------------------------ +! 2d patch test. +! Variation for incompressible case with dofs=dim+1. +! +! Peter Råback / 7.11.2024 +!------------------------------------------------------------------ + +Header + CHECK KEYWORDS Warn + Mesh DB "." "squares" + Include Path "" + Results Directory "" +End + +$fileid="b" + +Simulation + Max Output Level = 7 + Coordinate System = Cartesian + Coordinate Mapping(3) = 1 2 3 + Simulation Type = Steady State + + Steady State Min Iterations = 1 + Steady State Max Iterations = 1 + + ascii output = true + Post File = case_$fileid$.vtu + Save Geometry Ids = Logical True + +! The ElasticSolver does not really like the Dirichlet conditions at the start +! of the nonlinear iteration. + Initialize Dirichlet Conditions = False +End + +Equation 1 + Name = "Deformation" + Active Solvers(1) = 1 +End + +Body 1 + Name = "Lower block" + Target Bodies(1) = 1 + Equation = 1 + Material = 1 +End + +Body 2 + Name = "Upper block" + Target Bodies(1) = 2 + Equation = 1 + Material = 1 +End + +Material 1 + Name = "Ideal" + Youngs modulus = 90.0 + Density = 10.0 + Poisson ratio = 0.25 +End + +Solver 1 + Equation = "Nonlinear elasticity" + Procedure = "ElasticSolve" "ElasticSolver" +! Variable = -dofs 2 Displacement + +! Have pressure as variable also! + Mixed Formulation = Logical True + Neo-Hookean Material = Logical True + Bubbles in Global System = False + + Element = p:1 b:3 + + Nonlinear System Convergence Tolerance = 1.0e-5 + Nonlinear System Max Iterations = 10 + Nonlinear System Relaxation Factor = 1.0 + + Linear System Solver = "Iterative" + Linear System Iterative Method = "BiCGStab" + Linear System Abort Not Converged = True + Linear System Preconditioning = "ILU2" + Linear System Residual Output = 100 + Linear System Max Iterations = 5000 + BiCGStabl Polynomial Degree = 4 + + Linear System Convergence Tolerance = 1.0e-10 + + Apply Contact BCs = Logical True +! Save Contact = Logical True + +! Restore the linear solution +! Elasticity Solver Linear = Logical True + + Calculate Stresses = Logical True +! Optimize Bandwidth = False + + Displace Mesh = Logical True + +! Do not include constraints when analyzing the convergence and norm of a solution + Nonlinear System Convergence Without Constraints = Logical True +End + +Solver 2 + Exec Solver = never + Equation = "SaveLine" + Procedure = "SaveData" "SaveLine" + Filename = f_$fileid$.dat +End + +Boundary Condition 1 + Name = "Support" + Target Boundaries(1) = 1 + Displacement 2 = Real 0.0 + Disp 2 = Real 0.0 +End + +Boundary Condition 2 + Name = "Lower surface of upper block" + Target Boundaries(1) = 5 + + Mortar BC = Integer 3 + Mortar BC Nonlinear = Logical True + Contact Depth Offset Initial = Real 1.0e-3 + !Contact Active Set Minimum = Integer 1 + !Contact No-Slip = Logical True + +! Create a strong projector for the line setting y-coordinate to zero + Flat Projector = Logical True + +! a) Use weak projector or not + Galerkin Projector = Logical True + +! b) Use more tailored projector able to do accurate integration + Level Projector = Logical True + Level Projector Generic = True +End + +Boundary Condition 3 + Name = "Upper surface of lower block" + Target Boundaries(1) = 3 +End + +Boundary Condition 4 + Name = "Pressure load the upper surface of upper block" + Target Boundaries(1) = 7 + Normal Surface Traction = -1.0 +End + +Boundary Condition 5 + Name = "Symmetry" + Target Boundaries(2) = 4 8 + Displacement 1 = 0.0 + Disp 1 = Real 0.0 +End + +Solver 1 :: Reference Norm = 1.44268191E-01 +Solver 1 :: Reference Norm Tolerance = 1.0e-5 + diff --git a/fem/tests/ContactPatch2DIncompressible/runtest.cmake b/fem/tests/ContactPatch2DIncompressible/runtest.cmake new file mode 100644 index 0000000000..7528340c9d --- /dev/null +++ b/fem/tests/ContactPatch2DIncompressible/runtest.cmake @@ -0,0 +1,3 @@ +include(test_macros) +execute_process(COMMAND ${ELMERGRID_BIN} 1 2 squares.grd) +RUN_ELMER_TEST() diff --git a/fem/tests/ContactPatch2DIncompressible/squares.grd b/fem/tests/ContactPatch2DIncompressible/squares.grd new file mode 100644 index 0000000000..15aae4259f --- /dev/null +++ b/fem/tests/ContactPatch2DIncompressible/squares.grd @@ -0,0 +1,43 @@ +##### ElmerGrid input file for structured grid generation ###### +Version = 210903 +Coordinate System = Cartesian 2D +Subcell Divisions in 2D = 1 2 +Subcell Sizes 1 = 1 +Subcell Sizes 2 = 1 1 +Material Structure in 2D + 2 + 1 +End +Materials Interval = 1 1 +Boundary Definitions +# type out int + 1 -1 1 0 + 2 -2 1 0 + 3 -3 1 0 + 4 -4 1 0 +End +Element Degree = 1 +Element Innernodes = False +Triangles = False +Element Ratios 1 = 1 +Element Ratios 2 = 1 1 +Element Divisions 1 = 6 +Element Divisions 2 = 6 0 + +Start New Mesh + +Materials Interval = 2 2 +Boundary Definitions +# type out int + 5 -1 2 0 + 6 -2 2 0 + 7 -3 2 0 + 8 -4 2 0 +End +Element Degree = 1 +Element Innernodes = False +Triangles = False +Element Divisions 1 = 7 +Element Divisions 2 = 0 7 + +Unite = True \ No newline at end of file diff --git a/fem/tests/EM_port_eigen_3D/extrude.eg b/fem/tests/EM_port_eigen_3D/extrude.eg index 881ff48138..35e5d1f7a1 100644 --- a/fem/tests/EM_port_eigen_3D/extrude.eg +++ b/fem/tests/EM_port_eigen_3D/extrude.eg @@ -3,7 +3,7 @@ Output File = waveguide3D Input Mode = ElmerSolver Output Mode = ElmerSolver Extruded Divisions = 1 -Extruded Limits = 0 1,0 +Extruded Limits = 0 1.0 Extruded Ratios = 1.0 Extruded Elements = 10 \ No newline at end of file diff --git a/fem/tests/EM_port_eigen_3D/port.grd b/fem/tests/EM_port_eigen_3D/port.grd index c760d83d60..c48c696db9 100644 --- a/fem/tests/EM_port_eigen_3D/port.grd +++ b/fem/tests/EM_port_eigen_3D/port.grd @@ -24,8 +24,8 @@ Coordinate Ratios = 1 Decimals = 8 Element Degree = 1 Element Innernodes = False -Element Divisions 1 = 1 80 80 1 -Element Divisions 2 = 1 80 1 +Element Divisions 1 = 1 10 10 1 +Element Divisions 2 = 1 10 1 Element Ratios 1 = 1 1 1 1 Element Ratios 2 = 1 1 1 End diff --git a/fem/tests/EM_port_eigen_3D/port_eigenanalysis_3D.sif b/fem/tests/EM_port_eigen_3D/port_eigenanalysis_3D.sif index 1b65aa2c30..ed543ad6cb 100755 --- a/fem/tests/EM_port_eigen_3D/port_eigenanalysis_3D.sif +++ b/fem/tests/EM_port_eigen_3D/port_eigenanalysis_3D.sif @@ -1,26 +1,12 @@ -! The following case (see ../EM_port_eigen) solved over a surface of a 3-D mesh: ! -! This is a verification case of an electromagnetic port model to obtain -! a propagation parameter. A waveguide having a rectangular cross section of -! size a x 2a and consisting of two materials is modelled. This problem has been -! discussed for example in +! This is a 3-D application of the 2-D test case ../EM_port_eigen. Here the 2-D +! port model is first solved over a surface of a 3-D mesh. Boundary conditions +! for the 3-D model are then created by using the propagation parameter and the +! corresponding eigenfunction determined by the 2-D solution. ! -! [ZR18] A. Zdunek and W. Rachowicz. Inhomogeneous lossy waveguide mode -! analysis. Computers & Mathematics with Applications, 75(3):798-808, -! 2018. -! -! Here a dimensionless form of the model is used. The four eigenvalues having -! the smallest real part give the following values for a scaled propagation -! parameter (see [ZR18]) -! -! 1.27576 -! 0.97156 -! 0.72854 -! 0.59390 -! -! which are in good agreement with the results given in the literature. -! -! The original author of Elmer case: M.M. +! NOTE: This is WIP and this approach is not yet ready for serious use + +! The original author: M.M. ! Check Keywords "Warn" @@ -45,10 +31,12 @@ Constants End Body 1 + Equation = 2 Material = 1 End Body 2 + Equation = 2 Material = 2 End @@ -78,6 +66,10 @@ Equation 1 Active Solvers(2) = 1 2 End +Equation 2 + Active Solvers(2) = 3 4 +End + Solver 1 Equation = "Port mode" Procedure = "EMPort" "EMPortSolver" @@ -122,7 +114,7 @@ End Solver 2 Equation = "postprocess" Procedure = "EMPort" "EMPortSolver_post" - Variable = postfield[Electric Field Re:3 Electric Field Im:3] + Variable = postfield[EF2D Re:3 EF2D Im:3] Variable DOFs = 6 Mode Index = Integer 8 @@ -135,8 +127,88 @@ Solver 2 Linear System Preconditioning = ILU0 End - Solver 3 + Equation = "VectorHelmholtz" + Use Piola Transform = Logical True + Procedure = "VectorHelmholtz" "VectorHelmholtzSolver" + + Angular Frequency = $wref + + ! Command to seek for a lower-dimensional eigenfunction + ! so that BCs based on it can be constructed: + ! + Eigenfunction Source = Logical True + Variable = EF[EF re:1 EF im:1] + + Linear System Block Mode = True + Block Nested System = True + Block Preconditioner = True + Block Scaling = True + + Linear System Preconditioning Damp Coefficient = Real 0.0 + Linear System Preconditioning Damp Coefficient Im = Real -1.0 + Mass-proportional Damping = True + +! Linear system solver for the outer loop: +!----------------------------------------- + Outer: Linear System Solver = "Iterative" + Outer: Linear System Convergence Tolerance = 1e-7 +! Outer: Linear System Normwise Backward Error = True + Outer: Linear System Iterative Method = gcr + Outer: Linear System GCR Restart = 100 + Outer: Linear System Residual Output = 1 + Outer: Linear System Max Iterations = 100 + Outer: Linear System Pseudo Complex = True + +! Linear system solver for the inner solution: +!--------------------------------------------- + $blocktol = 5.0e-2 + + block 11: Linear System Solver = "Iterative" + block 11: Linear System Complex = True + block 11: Linear System Row Equilibration = False + block 11: Linear System Preconditioning = ILUT + block 11: Linear System ILUT Tolerance = 3.0e-1 + block 11: Linear System Residual Output = 5 + block 11: Linear System Max Iterations = 200 + block 11: Linear System Iterative Method = GCR + block 11: Linear System GCR Restart = 50 +! block 11: BiCGstabl polynomial degree = 4 + block 11: Linear System Normwise Backward Error = False + block 11: Linear System Convergence Tolerance = $blocktol + + Linear System Abort not Converged = False + + Steady State Convergence Tolerance = 1e-9 + Linear System Residual Output = 10 +! Calculate Loads = Logical True +! Calculate Energy Inner Product = Logical True + +End + +Solver 4 + Equation = "calcfields" + + Procedure = "VectorHelmholtz" "VectorHelmholtzCalcFields" + + Calculate Elemental Fields = Logical False + Calculate Magnetic Field Strength = Logical False + Calculate Magnetic Flux Density = Logical False + Calculate Poynting vector = Logical False + !Calculate Div of Poynting Vector = Logical True + Calculate Electric field = Logical True + !Calculate Energy Functional = Logical True + + Steady State Convergence Tolerance = 1 + Linear System Solver = "Iterative" + Linear System Preconditioning = None + Linear System Residual Output = 10 + Linear System Max Iterations = 5000 + Linear System Iterative Method = CG + Linear System Convergence Tolerance = 1.0e-9 +End + +Solver 5 ! Exec Solver = never Equation = "result output" Procedure = "ResultOutputSolve" "ResultOutputSolver" @@ -144,16 +216,16 @@ Solver 3 Vtu Format = Logical True Save Geometry IDs = True Ascii Output = True - Single Precision = Logical True - Vector Field 1 = Electric Field Re - Vector Field 2 = Electric Field Im + Vector Field 1 = EF2D Re + Vector Field 2 = EF2D Im + Vector Field 3 = Electric Field Re + Vector Field 4 = Electric Field Im Eigen Analysis = False End - -Solver 4 +Solver 6 Equation = "SaveScalars" ! Filename = f.dat @@ -166,36 +238,54 @@ End Boundary Condition 1 Target Boundaries(1) = 1 + EF re {e} = Real 0.0 + EF im {e} = Real 0.0 End Boundary Condition 2 Target Boundaries(1) = 2 + EF re {e} = Real 0.0 + EF im {e} = Real 0.0 End Boundary Condition 3 Target Boundaries(1) = 3 + EF re {e} = Real 0.0 + EF im {e} = Real 0.0 End Boundary Condition 4 Target Boundaries(1) = 4 + EF re {e} = Real 0.0 + EF im {e} = Real 0.0 End Boundary Condition 5 Target Boundaries(1) = 5 + EF re {e} = Real 0.0 + EF im {e} = Real 0.0 End Boundary Condition 6 Target Boundaries(1) = 6 + EF re {e} = Real 0.0 + EF im {e} = Real 0.0 End Boundary Condition 7 Target Boundaries(1) = 7 - Body Id = 3 + Body Id = 3 + Eigenfunction BC = Logical True + Eigenfunction Index = Integer 8 + Incident Wave = Logical True End Boundary Condition 8 Target Boundaries(1) = 8 - Body Id = 4 + Body Id = 4 + Eigenfunction BC = Logical True + Eigenfunction Index = Integer 8 + Incident Wave = Logical True End Boundary Condition 9 @@ -246,4 +336,17 @@ Boundary Condition 14 E im {e} = Real 0.0 End -Solver 4 :: Reference Norm = Real 14.647970391372228 +Boundary Condition 15 + Target Boundaries(1) = 9 + Eigenfunction BC = Logical True + Eigenfunction Index = Integer 8 +End + +Boundary Condition 16 + Target Boundaries(1) = 10 + Eigenfunction BC = Logical True + Eigenfunction Index = Integer 8 +End + +Solver 3 :: Reference Norm = Real 2.83977719E-02 +Solver 6 :: Reference Norm = Real 14.647970391372228 diff --git a/fem/tests/FluxIntegralBCInduction/CMakeLists.txt b/fem/tests/FluxIntegralBCInduction/CMakeLists.txt new file mode 100644 index 0000000000..7959a59fc3 --- /dev/null +++ b/fem/tests/FluxIntegralBCInduction/CMakeLists.txt @@ -0,0 +1,8 @@ +INCLUDE(test_macros) +INCLUDE_DIRECTORIES(${CMAKE_BINARY_DIR}/fem/src) + +CONFIGURE_FILE( case.sif case.sif COPYONLY) + +file(COPY ELMERSOLVER_STARTINFO indmesh.grd DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") + +ADD_ELMER_TEST(FluxIntegralBCInduction LABELS quick mumps) diff --git a/fem/tests/FluxIntegralBCInduction/ELMERSOLVER_STARTINFO b/fem/tests/FluxIntegralBCInduction/ELMERSOLVER_STARTINFO new file mode 100644 index 0000000000..d21bd7ee27 --- /dev/null +++ b/fem/tests/FluxIntegralBCInduction/ELMERSOLVER_STARTINFO @@ -0,0 +1 @@ +case.sif diff --git a/fem/tests/FluxIntegralBCInduction/case.sif b/fem/tests/FluxIntegralBCInduction/case.sif new file mode 100755 index 0000000000..cadae070ea --- /dev/null +++ b/fem/tests/FluxIntegralBCInduction/case.sif @@ -0,0 +1,185 @@ +!--------------------------------------------------------------------- +! Solves a axially symmetric magnetodynamics equation such that the net +! surface current generated on the surface of the conducting piece vanishes. +! This involves sort of Robin BC where the "external potential" is unknown and +! is found such that the net integral of the surface currents vanish. +! +! This test case was done in collaboration with Roland Ernst in 2023 +! and saved to a test case later. +! +! P.R. / 1.11.2024 +!-------------------------------------------------------------------- + +Header + CHECK KEYWORDS Warn + Mesh DB "." "indmesh" + Include Path "" + Results Directory "results" +End + +$chr="a" + +Simulation + Max Output Level = 7 + Coordinate System = Axi Symmetric + Coordinate Mapping(3) = 1 2 3 + Simulation Type = Steady state + Steady State Max Iterations = 1 + Output Intervals(1) = 1 + Angular Frequency = 62800.0 + Post File = case-$chr$.vtu + ascii output = true +! Mesh Levels = 3 +End + +Constants + Permittivity of Vacuum = 8.85418781e-12 + Permeability of Vacuum = 1.25663706e-6 +$i0=6.0e7 +$elcond=1.0e6 +End + +Body 1 + Target Bodies(1) = 1 + Name = "Body 1" + Equation = 1 + Material = 1 + Body Force = 1 +End + +Body 2 + Target Bodies(1) = 2 + Name = "Body 2" + Equation = 1 + Material = 1 +End + +Solver 1 + Equation = MgDyn2DHarmonic + Procedure = "MagnetoDynamics2D" "MagnetoDynamics2DHarmonic" + Variable = Potential[Potential Re:1 Potential Im:1] + Exec Solver = Always + Nonlinear System Max Iterations = 1 + + Linear System Solver = Direct + Linear System Direct Method = umfpack + + Linear System Scaling = False + Optimize Bandwidth = False + + Calculate Loads = True + Apply Integral BCs = True +End + +Solver 2 + Equation = MgDynPost + Procedure = "MagnetoDynamics" "MagnetoDynamicsCalcFields" + + Calculate Magnetic Field Strength = True + Calculate Electric Field = True + Calculate Nodal Heating = True + Calculate Current Density = True + + Calculate Nodal Fields = True + Calculate Elemental Fields = False + + Optimize Bandwidth = False + Linear System Scaling = False + + Linear System Solver = Direct + Linear System Direct Method = umfpack + + ctest 1 = Real -1.0 + ctest 2 = Real -1.0 +End + + +Solver 3 + Exec Solver = never !after all + Equation = "SaveLine" + Procedure = "SaveData" "SaveLine" + FileName = f$chr$.dat + + Polyline Coordinates(2,2) = 0.0 0.0 0.05 0.0 + Polyline Divisions(1) = 100 +End + +Solver 4 + Equation = "SaveScalars" + Procedure = "SaveData" "SaveScalars" + Filename = g.dat + Variable 1 = potential re + Operator 1 = "boundary int" + Variable 2 = potential re + Operator 2 = "boundary int" + Variable 3 = potential loads 1 + Operator 3 = "boundary sum" + Variable 4 = potential loads 2 + Operator 4 = "boundary sum" + + Variable 5 = Surface current re 3 + Operator 5 = "boundary int" + Variable 6 = Surface current im 3 + Operator 6 = "boundary int" + Variable 7 = Surface current re 3 + Operator 7 = "boundary min" + Variable 8 = Surface current re 3 + Operator 8 = "boundary max" + + Variable 9 = Lagrange Multiplier MgDyn2DHarmonic 1 + Variable 10 = Lagrange Multiplier MgDyn2DHarmonic 2 + + Show Norm Index = 3 + File Append = True +End + + +Equation 1 + Name = "Equation 1_EM" + Active Solvers(2) = 2 1 +End + +Material 1 + Name = "Air (room temperature)" + Relative Permittivity = 1.00059 + Electric Conductivity = 0 + Relative Permeability = 1.00000037 +End + +Material 2 + Name = "Copper (generic) cold_ crucible" + Electric Conductivity = 59.59e6 + Relative Permeability = 0.999994 +End + +Body Force 1 + Name = "BodyForce 1" + Current Density = $i0 +End + +Boundary Condition 1 + Target Boundaries = 1 + Name = "BC Outside" +! Infinity BC = True + Potential Re = Real 0 + Potential Re = Real 0 +End + +Boundary Condition 2 + Target Boundaries = 2 + Name = "BC CC_surf" + Layer Electric Conductivity = Real 6.0e7 + Layer Relative Permeability = Real 1 + +! fixit re = real $1.0/(2*pi) +! fixit im = real 0.0 + + Flux Integral BC = Logical True + Save Scalars = True +End + +Solver 1 :: Reference Norm = 1.85168787E-04 + +! This should by construction be zero. +Solver 4 :: Reference Norm = 0.0 +Solver 4 :: Reference Norm Absolute = Logical True diff --git a/fem/tests/FluxIntegralBCInduction/indmesh.grd b/fem/tests/FluxIntegralBCInduction/indmesh.grd new file mode 100755 index 0000000000..00de3a659e --- /dev/null +++ b/fem/tests/FluxIntegralBCInduction/indmesh.grd @@ -0,0 +1,32 @@ +##### ElmerGrid input file for structured grid generation ###### +Version = 210903 +Coordinate System = Cartesian 2D +Subcell Divisions in 2D = 6 5 +Subcell Limits 1 = 0 0 0.01 0.02 0.03 0.031 0.05 +Subcell Limits 2 = -0.04 -0.02 -0.015 0.015 0.02 0.04 +Material Structure in 2D +4 2 2 2 2 2 +4 2 2 2 1 2 +4 2 3 2 1 2 +4 2 2 2 1 2 +4 2 2 2 2 2 +End +Materials Interval = 1 2 +Boundary Definitions +# type out int + 1 0 2 1 + 2 3 2 1 + 3 1 2 1 + 4 4 2 1 +End +Numbering = Horizontal +Element Degree = 1 +Element Innernodes = False +Triangles = False +Surface Elements = 10000 +Coordinate Ratios = 1 +Minimum Element Divisions = 3 3 +Element Ratios 1 = 1 1 1 1 1 5 +Element Ratios 2 = 0.2 1 1 1 5 +Element Densities 1 = 1 1 1 1 1 1 +Element Densities 2 = 1 1 1 1 1 diff --git a/fem/tests/FluxIntegralBCInduction/runtest.cmake b/fem/tests/FluxIntegralBCInduction/runtest.cmake new file mode 100644 index 0000000000..1b7172e13a --- /dev/null +++ b/fem/tests/FluxIntegralBCInduction/runtest.cmake @@ -0,0 +1,4 @@ +include(test_macros) +execute_process(COMMAND ${ELMERGRID_BIN} 1 2 indmesh) + +RUN_ELMER_TEST() diff --git a/fem/tests/StatCurr_adaptivity/CMakeLists.txt b/fem/tests/StatCurr_adaptivity/CMakeLists.txt new file mode 100644 index 0000000000..683e9d1501 --- /dev/null +++ b/fem/tests/StatCurr_adaptivity/CMakeLists.txt @@ -0,0 +1,8 @@ +INCLUDE(test_macros) +INCLUDE_DIRECTORIES(${CMAKE_BINARY_DIR}/fem/src) + +CONFIGURE_FILE( adap.sif adap.sif COPYONLY) + +file(COPY ELMERSOLVER_STARTINFO kulma.mif DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") + +ADD_ELMER_TEST(StatCurr_adaptivity LABELS quick amr) diff --git a/fem/tests/StatCurr_adaptivity/ELMERSOLVER_STARTINFO b/fem/tests/StatCurr_adaptivity/ELMERSOLVER_STARTINFO new file mode 100644 index 0000000000..21d54eee60 --- /dev/null +++ b/fem/tests/StatCurr_adaptivity/ELMERSOLVER_STARTINFO @@ -0,0 +1 @@ +adap.sif diff --git a/fem/tests/StatCurr_adaptivity/Makefile b/fem/tests/StatCurr_adaptivity/Makefile new file mode 100644 index 0000000000..aa8677d773 --- /dev/null +++ b/fem/tests/StatCurr_adaptivity/Makefile @@ -0,0 +1,13 @@ +# Electrostatics and adaptivity with remeshing +# + +run: + /bin/mkdir -p kulma + $(ELMER_MESH2D) kulma.mif kulma + /bin/cp kulma.mif kulma + $(ELMER_SOLVER) + +clean: + /bin/rm test.log temp.log bgmesh fort.12 mon.out + /bin/rm -rf kulma + /bin/rm -rf RefinedMesh* diff --git a/fem/tests/StatCurr_adaptivity/adap.sif b/fem/tests/StatCurr_adaptivity/adap.sif new file mode 100644 index 0000000000..162c01a59f --- /dev/null +++ b/fem/tests/StatCurr_adaptivity/adap.sif @@ -0,0 +1,58 @@ +Header + Mesh DB "." "kulma" +End + +Constants + Permittivity Of Vacuum = Real 8.8542e-12 +End + +Simulation + Max Output Level = 5 + Coordinate System = Cartesian 2D + Simulation Type = Steady State + Steady State Max Iterations = 20 + Mesh Input File = "kulma.mif" +! Post File = "kulma.ep" +End + +Body 1 + Material = 1 + Equation = 1 +End + +Equation 1 + Active Solvers(1) = 1 +End + +Material 1 + Electric Conductivity = 1 +End + +Boundary Condition 1 + Target Boundaries(1) = 2 + Potential = 0 +End + +Boundary Condition 2 + Target Boundaries(1) = 5 + Potential = 1 +End + +Solver 1 + Equation = StatCurrent + Variable = Potential + Procedure = "StatCurrentSolve" "StatCurrentSolver" + + Linear System Solver = Direct + Linear System Direct Method = umfpack + + Steady State Convergence Tolerance = 1.0e-8 + + Adaptive Mesh Refinement = True + Adaptive Remesh = True + Adaptive Error Limit = 0.05 + Adaptive Max H = 0.25 +End + +Solver 1 :: Reference Norm = Real 0.536205922533 +Solver 1 :: Reference Norm Tolerance = Real 1.0e-2 diff --git a/fem/tests/StatCurr_adaptivity/kulma.mif b/fem/tests/StatCurr_adaptivity/kulma.mif new file mode 100644 index 0000000000..efa36ccfa3 --- /dev/null +++ b/fem/tests/StatCurr_adaptivity/kulma.mif @@ -0,0 +1,36 @@ +!ElmerMesh input file from ElmerFront +!Saved = Fri Feb 20 13:47:48 2004 +!Case = kulma +!Model dir = /mnt/mds/csc/apursula/adaptive +!Include path = +!Results dir = /mnt/mds/csc/apursula/adaptive +Geometry2D: + H: 0.333 + MeshScalingFactor: 1 + Nodes: 6 + Edges: 6 + Bodies: 1 +NodeId: 1 7 1 1 +NodeId: 2 8 1 0 +NodeId: 3 9 2 0 +NodeId: 4 10 2 2 +NodeId: 5 11 0 2 +NodeId: 6 12 0 1 +EdgeId: 1 1 2 1 2 +EdgeId: 2 2 2 2 3 +EdgeId: 3 3 2 3 4 +EdgeId: 4 4 2 4 5 +EdgeId: 5 5 2 5 6 +EdgeId: 6 6 2 6 1 +BodyId: 1 + ElementOrder: Linear + Layers: 1 + LayerId: 1 + LayerType: MovingFront + FixedNodes: 0 + BGMesh: Delaunay + Loops: 1 + LoopId: 1 + Direction: 1 + Edges: 6 1 2 3 4 5 6 +!End diff --git a/fem/tests/StatCurr_adaptivity/runtest.cmake b/fem/tests/StatCurr_adaptivity/runtest.cmake new file mode 100644 index 0000000000..1ded37788b --- /dev/null +++ b/fem/tests/StatCurr_adaptivity/runtest.cmake @@ -0,0 +1,5 @@ +include(test_macros) +file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/kulma) +execute_process(COMMAND ${MESH2D_BIN} kulma.mif kulma) +file(COPY kulma.mif DESTINATION ${CMAKE_CURRENT_BINARY_DIR}/kulma) +RUN_ELMER_TEST() diff --git a/fem/tests/StatElecSolveMMG2D/CMakeLists.txt b/fem/tests/StatElecSolveMMG2D/CMakeLists.txt index b98373bac5..b7aa93a9ef 100644 --- a/fem/tests/StatElecSolveMMG2D/CMakeLists.txt +++ b/fem/tests/StatElecSolveMMG2D/CMakeLists.txt @@ -6,5 +6,5 @@ CONFIGURE_FILE(case.sif case.sif COPYONLY) file(COPY ELMERSOLVER_STARTINFO squares_inside_square.msh DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") -ADD_ELMER_TEST(StatElecSolveMMG2D LABELS mmg slow cmodes lumping) +ADD_ELMER_TEST(StatElecSolveMMG2D LABELS mmg slow cmodes lumping amr) ENDIF() diff --git a/fem/tests/StatElecSolveMMG3D/CMakeLists.txt b/fem/tests/StatElecSolveMMG3D/CMakeLists.txt index abfd43772e..b1a2228759 100644 --- a/fem/tests/StatElecSolveMMG3D/CMakeLists.txt +++ b/fem/tests/StatElecSolveMMG3D/CMakeLists.txt @@ -6,5 +6,5 @@ CONFIGURE_FILE(case.sif case.sif COPYONLY) file(COPY ELMERSOLVER_STARTINFO cubes_inside_cube.msh DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") -ADD_ELMER_TEST(StatElecSolveMMG3D LABELS mmg slow cmodes) +ADD_ELMER_TEST(StatElecSolveMMG3D LABELS mmg slow cmodes amr) ENDIF() diff --git a/fem/tests/StatElecSolveParMMG3D/CMakeLists.txt b/fem/tests/StatElecSolveParMMG3D/CMakeLists.txt index 97336e805d..261a03692b 100644 --- a/fem/tests/StatElecSolveParMMG3D/CMakeLists.txt +++ b/fem/tests/StatElecSolveParMMG3D/CMakeLists.txt @@ -6,5 +6,5 @@ CONFIGURE_FILE(case.sif case.sif COPYONLY) file(COPY ELMERSOLVER_STARTINFO cubes_inside_cube.msh DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") -ADD_ELMER_TEST(StatElecSolveParMMG3D LABELS mmg slow cmodes NPROCS 3) +ADD_ELMER_TEST(StatElecSolveParMMG3D LABELS mmg slow cmodes amr NPROCS 3) ENDIF() diff --git a/fem/tests/StatElecSolveVecMMG2D/CMakeLists.txt b/fem/tests/StatElecSolveVecMMG2D/CMakeLists.txt index 0494006152..57c721fd1b 100644 --- a/fem/tests/StatElecSolveVecMMG2D/CMakeLists.txt +++ b/fem/tests/StatElecSolveVecMMG2D/CMakeLists.txt @@ -6,5 +6,5 @@ CONFIGURE_FILE(case.sif case.sif COPYONLY) file(COPY ELMERSOLVER_STARTINFO squares_inside_square.msh DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") -ADD_ELMER_TEST(StatElecSolveVecMMG2D LABELS mmg slow cmodes lumping) +ADD_ELMER_TEST(StatElecSolveVecMMG2D LABELS mmg slow cmodes lumping amr) ENDIF() diff --git a/fem/tests/StatElecSolveVecMMG3D/CMakeLists.txt b/fem/tests/StatElecSolveVecMMG3D/CMakeLists.txt index 4643acfcee..b08c3cc56d 100644 --- a/fem/tests/StatElecSolveVecMMG3D/CMakeLists.txt +++ b/fem/tests/StatElecSolveVecMMG3D/CMakeLists.txt @@ -6,5 +6,5 @@ CONFIGURE_FILE(case.sif case.sif COPYONLY) file(COPY ELMERSOLVER_STARTINFO cubes_inside_cube.msh DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") -ADD_ELMER_TEST(StatElecSolveVecMMG3D LABELS mmg slow cmodes) +ADD_ELMER_TEST(StatElecSolveVecMMG3D LABELS mmg slow cmodes amr) ENDIF() diff --git a/fem/tests/TopoOptElast2DCompliance3/case.sif b/fem/tests/TopoOptElast2DCompliance3/case.sif index a10f8cc08f..2cebc81a1c 100644 --- a/fem/tests/TopoOptElast2DCompliance3/case.sif +++ b/fem/tests/TopoOptElast2DCompliance3/case.sif @@ -137,7 +137,7 @@ Material 1 End Boundary Condition 1 - Target Boundaries(1) = 1 + Target Boundaries(1) = 4 Name = "Symmetry" Displacement 1 = 0.0 End diff --git a/fem/tests/TopoOptElast2DCompliance3/case3d.sif b/fem/tests/TopoOptElast2DCompliance3/case3d.sif new file mode 100644 index 0000000000..89a808c9f6 --- /dev/null +++ b/fem/tests/TopoOptElast2DCompliance3/case3d.sif @@ -0,0 +1,194 @@ +!-------------------------------------------------------- +! Test case for topology optimization. +! Peter Råback & Stefan Hiemer, 2024. +! +! This case is the basic compliance minimization problem of a 2D +! elastic structure, see e.g. +! O. Sigmund, “A 99 line topology optimization code written in matlab,” +! Structural and multidisciplinary optimization, vol. 21, pp. 120–127, 200. +! +! This test case with +! - pde based density filter +! - this one is the same in parallel! +! +! Note that the test is not run to the end. Add SS iterations +! and resolution for better solution. +!------------------------------------------------------------- + +$L=60.0 +$H=L/3 +$rmax=0.04*L +$pexp=3.0 +$rhomin=1.0e-7 +$Vfrac=0.5 +$wmin=1.0e-6 + +Header + CHECK KEYWORDS Warn + Mesh DB "." "rect" + Include Path "" + Results Directory "results" +End + +Simulation + Max Output Level = 7 + Coordinate System = Cartesian 3D + Simulation Type = Steady state + Steady State Max Iterations = 1000 + +! Activate for output + Post File = c.vtu +! vtu: Save Bulk Only = Logical True + vtu: ascii output = logical True + + Mesh Levels = 1 + +! Extruded the 2D mesh into 3rd dimension + Extruded Mesh Layers = 10 + Extruded Min Coordinate = -5.0 + Extruded Max Coordinate = 5.0 +End + +Body 1 + Target Bodies(1) = 1 + Name = "Body Property 1" + Equation = 1 + Material = 1 + Initial Condition = 1 +End + +Initial Condition 1 + Name = "Guess" + topo rho = Real $Vfrac + topo mult = Real $Vfrac^pexp +End + +Solver 1 + Equation = LinearElasticity + Procedure = "StressSolve" "StressSolver" +! Procedure = "ElasticSolve" "ElasticSolver" + Variable = -dofs 3 Displacement + + Nonlinear System Max Iterations = 1 + Nonlinear System Consistent Norm = True + + Linear System Solver = Direct + Linear System Direct Method = MUMPS + + Local Matrix Identical = Logical False + Local Matrix Storage = Logical True + + Matrix Multiplier Name = String "topo mult" + + Optimize Bandwidth = False + Solver Timing = True + + Steady State Convergence Tolerance = 1.0e-4 + Displace Mesh = False +End + + +Solver 2 + Equation = TopoOpt + Procedure = "TopoOpt" "TopoOpt" + + Linear System Solver = direct + Linear System Direct Method = MUMPS + + Filter Method = String "density" ! density, sensitivity, none + Sensitivity Filter Threshold = Real $wmin + + Filter Type = String "pde" ! distance, pde, simple +! If you want to use PDE filter activate the two following: + Variable = xNodal + PDE Filter Diffusion Constant = Real 1.0 + +! Distance Filter Radius = Real $rmax +! Simple Filter Iterations = Integer 3 + + Penalty Exponent = Real $pexp + Minimum Relative Density = Real $rhomin + Volume Fraction = Real $Vfrac + + Nonlinear System Consistent Norm = True + +! Convergence tolerance for objective function. + Steady State Convergence Tolerance = 1.0e-5 + Bisection Search Tolerance = Real 1.0e-3 + + Solver Timing = True +End + + +Solver 3 + Exec Solver = After Simulation + Equation = SaveScalars + Procedure = "SaveData" "SaveScalars" + Filename = "f.dat" +End + +Equation 1 + Name = "Elast" +! Calculate Stresses = True + Active Solvers(2) = 1 2 + +! This has been checked! + Plane Stress = True +End + +Material 1 + Name = "PlaneStuff" + Youngs modulus = 1.0 + Poisson ratio = 0.3 +End + +Boundary Condition 1 + Target Boundaries(1) = 1 + Name = "Bot" +End + +Boundary Condition 2 + Target Boundaries(1) = 2 + Name = "Right" + Force 2 = Variable "Coordinate 2" + Real + 0.0 -1.0 + 10.0 0.0 + 20.0 0.0 + End + +End + +Boundary Condition 3 + Target Boundaries(1) = 3 + Name = "Top" +End + +Boundary Condition 4 + Target Boundaries(1) = 4 + Name = "Left" + Displacement 1 = 0.0 + Displacement 2 = 0.0 + Displacement 3 = 0.0 +End + +Boundary Condition 5 + Name = "Front" + Displacement 3 = 0.0 +End + +Boundary Condition 6 + Name = "Back" +End + + + + +! After 3 SS iterations +Solver 1 :: Reference Norm = 2.11183667E+02 +Solver 2 :: Reference Norm = 5.66789913E-01 + +! After 91 SS iterations +!Solver 1 :: Reference Norm = 1.25238929E+02 +!Solver 2 :: Reference Norm = 6.39927233E-01 + diff --git a/fem/tests/TopoOptElast2DCompliance3/rect.grd b/fem/tests/TopoOptElast2DCompliance3/rect.grd index c1e051fe09..68e4fd8799 100755 --- a/fem/tests/TopoOptElast2DCompliance3/rect.grd +++ b/fem/tests/TopoOptElast2DCompliance3/rect.grd @@ -10,7 +10,10 @@ End Materials Interval = 1 1 Boundary Definitions ! type out int - 1 -4 1 1 + 1 -1 1 1 + 2 -2 1 1 + 3 -3 1 1 + 4 -4 1 1 End Numbering = Vertical Element Degree = 1 diff --git a/fem/tests/adaptivity1-mmg2d/CMakeLists.txt b/fem/tests/adaptivity1-mmg2d/CMakeLists.txt index ab853e70ad..b843734ab0 100644 --- a/fem/tests/adaptivity1-mmg2d/CMakeLists.txt +++ b/fem/tests/adaptivity1-mmg2d/CMakeLists.txt @@ -6,5 +6,5 @@ CONFIGURE_FILE(Ldomain.sif Ldomain.sif COPYONLY) file(COPY ELMERSOLVER_STARTINFO Ldomain.grd DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") -ADD_ELMER_TEST(adaptivity1-mmg2d LABELS mmg) +ADD_ELMER_TEST(adaptivity1-mmg2d LABELS mmg amr) ENDIF() diff --git a/fem/tests/adaptivity1-mmg3d/CMakeLists.txt b/fem/tests/adaptivity1-mmg3d/CMakeLists.txt index cd32dceafd..4b5812ce38 100644 --- a/fem/tests/adaptivity1-mmg3d/CMakeLists.txt +++ b/fem/tests/adaptivity1-mmg3d/CMakeLists.txt @@ -6,5 +6,5 @@ CONFIGURE_FILE(case.sif case.sif COPYONLY) file(COPY ELMERSOLVER_STARTINFO winkel.msh DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") -ADD_ELMER_TEST(adaptivity1-mmg3d LABELS mmg) +ADD_ELMER_TEST(adaptivity1-mmg3d LABELS mmg amr) ENDIF() diff --git a/fem/tests/adaptivity1/CMakeLists.txt b/fem/tests/adaptivity1/CMakeLists.txt index e21501bd78..050d52d909 100644 --- a/fem/tests/adaptivity1/CMakeLists.txt +++ b/fem/tests/adaptivity1/CMakeLists.txt @@ -5,5 +5,4 @@ CONFIGURE_FILE( Ldomain.sif Ldomain.sif COPYONLY) file(COPY ELMERSOLVER_STARTINFO Ldomain.mif DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") -ADD_ELMER_TEST(adaptivity1) -ADD_ELMER_LABEL(adaptivity1 quick) +ADD_ELMER_TEST(adaptivity1 LABELS quick amr) diff --git a/fem/tests/adaptivity2/CMakeLists.txt b/fem/tests/adaptivity2/CMakeLists.txt index af5dcc54f5..4d27b36dc7 100644 --- a/fem/tests/adaptivity2/CMakeLists.txt +++ b/fem/tests/adaptivity2/CMakeLists.txt @@ -5,5 +5,4 @@ CONFIGURE_FILE( Ldomain.sif Ldomain.sif COPYONLY) file(COPY ELMERSOLVER_STARTINFO Ldomain.grd Ldomain DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") -ADD_ELMER_TEST(adaptivity2) -ADD_ELMER_LABEL(adaptivity2 quick) +ADD_ELMER_TEST(adaptivity2 LABELS quick amr) diff --git a/fem/tests/adaptivity3/CMakeLists.txt b/fem/tests/adaptivity3/CMakeLists.txt index 2b244f414b..eed540f808 100644 --- a/fem/tests/adaptivity3/CMakeLists.txt +++ b/fem/tests/adaptivity3/CMakeLists.txt @@ -5,5 +5,4 @@ CONFIGURE_FILE( Step.sif Step.sif COPYONLY) file(COPY ELMERSOLVER_STARTINFO Step.grd DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") -ADD_ELMER_TEST(adaptivity3) -ADD_ELMER_LABEL(adaptivity3 quick) +ADD_ELMER_TEST(adaptivity3 LABELS quick amr) diff --git a/fem/tests/adaptivity4/CMakeLists.txt b/fem/tests/adaptivity4/CMakeLists.txt index 6490bc4e82..8fa910ae05 100644 --- a/fem/tests/adaptivity4/CMakeLists.txt +++ b/fem/tests/adaptivity4/CMakeLists.txt @@ -6,5 +6,5 @@ IF(HAVE_UMFPACK OR HAVE_MUMPS) file(COPY ELMERSOLVER_STARTINFO mesh.grd DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") - ADD_ELMER_TEST(adaptivity4 LABELS quick) + ADD_ELMER_TEST(adaptivity4 LABELS quick amr) ENDIF() diff --git a/fem/tests/adaptivity5/CMakeLists.txt b/fem/tests/adaptivity5/CMakeLists.txt index 76c8f02829..207df57d3c 100644 --- a/fem/tests/adaptivity5/CMakeLists.txt +++ b/fem/tests/adaptivity5/CMakeLists.txt @@ -6,5 +6,5 @@ IF(HAVE_UMFPACK OR HAVE_MUMPS) file(COPY ELMERSOLVER_STARTINFO mesh.grd DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") - ADD_ELMER_TEST(adaptivity5 LABELS quick elasticsolve) + ADD_ELMER_TEST(adaptivity5 LABELS quick elasticsolve amr) ENDIF() diff --git a/fem/tests/el_adaptivity/CMakeLists.txt b/fem/tests/el_adaptivity/CMakeLists.txt index 1da0590352..2518e3912b 100644 --- a/fem/tests/el_adaptivity/CMakeLists.txt +++ b/fem/tests/el_adaptivity/CMakeLists.txt @@ -5,5 +5,4 @@ CONFIGURE_FILE( adap.sif adap.sif COPYONLY) file(COPY ELMERSOLVER_STARTINFO kulma.mif DESTINATION "${CMAKE_CURRENT_BINARY_DIR}/") -ADD_ELMER_TEST(el_adaptivity) -ADD_ELMER_LABEL(el_adaptivity quick) +ADD_ELMER_TEST(el_adaptivity LABELS quick amr) diff --git a/fem/tests/rotflow/rotflow.sif b/fem/tests/rotflow/rotflow.sif index 8f8eb0bbea..ffe0e46e23 100644 --- a/fem/tests/rotflow/rotflow.sif +++ b/fem/tests/rotflow/rotflow.sif @@ -49,12 +49,13 @@ End Equation $NST Active Solvers(1) = 1 - Element = "p:1 b:1" +! Element = "p:1 b:1" End Solver 1 Equation = String "Navier-Stokes" + Element = "p:1 b:1" Linear System Solver = String "Iterative" ! "Direct" Linear System Direct Method = "umfpack" @@ -66,8 +67,10 @@ Solver 1 Linear System Ilut Tolerance = 0.0001 Linear System Residual Output = 1 - Stabilization Method = PBubbles -! Bubbles in Global System = False +! Nonlinear System Consistent Norm = True + + Stabilization Method = pbubbles + Bubbles in Global System = False Nonlinear System Convergence Tolerance = 1e-8 Nonlinear System Max Iterations = 20 @@ -105,6 +108,5 @@ Boundary Condition $MeltSilicaCrucibleInterface End -Solver 1 :: Reference Norm = Real 0.172138 -RUN +Solver 1 :: Reference Norm = 2.88756149E-01 !End Of File