diff --git a/.gitignore b/.gitignore index 79913e7..36a37a5 100644 --- a/.gitignore +++ b/.gitignore @@ -26,6 +26,3 @@ out/ # ignoring a (potentially added) FEniCS case Partitioned_Heat_Conduction/fenics - -# ignoring precice run directory -*/precice-run diff --git a/Adapter/Coupler_Solver.F90 b/Adapter/Coupler_Solver.F90 index 717440f..0a8babd 100644 --- a/Adapter/Coupler_Solver.F90 +++ b/Adapter/Coupler_Solver.F90 @@ -13,7 +13,7 @@ MODULE HelperMethods ! END SUBROUTINE StoreCheckpoint - SUBROUTINE Print(dataName,mesh,BCPerm,CoordVals) + SUBROUTINE Print(dataName,mesh,BoundaryPerm,CoordVals) !-------------------------Strings---------------------------------------------- CHARACTER(LEN=MAX_NAME_LEN) :: dataName @@ -23,21 +23,26 @@ SUBROUTINE Print(dataName,mesh,BCPerm,CoordVals) TYPE(Mesh_t), POINTER :: mesh !------------------------Data Arrays---------------------------------------------- REAL(KIND=dp), POINTER :: CoordVals(:) - INTEGER, POINTER :: BCPerm(:) + INTEGER, POINTER :: BoundaryPerm(:) !--------------------------Iterators------------------------------------- INTEGER :: i,j - + !--------------------------Mesh------------------------------------- + INTEGER :: meshDim dataVariable => VariableGet( mesh % Variables, dataName) - + meshDim = mesh % MaxDim CALL Info('CouplerSolver','Printing ' //TRIM(dataName)) DO i = 1, mesh % NumberOfNodes - j = BCPerm(i) + j = BoundaryPerm(i) IF(j == 0) CYCLE - - write(infoMessage,'(A,I5,A,I5,A,F10.4,A,F10.2,A,F10.2)') 'Node: ',i,' Index: ',j,' Value: ' & + IF (meshDim == 2) THEN + write(infoMessage,'(A,I5,A,I5,A,F10.4,A,F10.2,A,F10.2)') 'Node: ',i,' Index: ',j,' Value: ' & ,dataVariable % Values(dataVariable % Perm(i)),& - ' X= ', CoordVals(2*j-1), ' Y= ', CoordVals(2*j) - + ' X= ', CoordVals(meshDim * j-1), ' Y= ', CoordVals(meshDim * j) + ELSE IF (meshDim == 3) THEN + write(infoMessage,'(A,I5,A,I5,A,F10.4,A,F10.2,A,F10.2,A,F10.2)') 'Node: ',i,' Index: ',j,' Value: ' & + ,dataVariable % Values(dataVariable % Perm(i)),& + ' X= ', CoordVals(meshDim * j-2), ' Y= ', CoordVals(meshDim *j-1), ' Z= ', CoordVals(meshDim *j) + END IF CALL Info('CouplerSolver',infoMessage) END DO @@ -55,7 +60,7 @@ SUBROUTINE PrintDomain(dataName,mesh) TYPE(Mesh_t), POINTER :: mesh !------------------------Data Arrays---------------------------------------------- REAL(KIND=dp), POINTER :: CoordVals(:) - INTEGER, POINTER :: BCPerm(:) + INTEGER, POINTER :: BoundaryPerm(:) !--------------------------Iterators------------------------------------- INTEGER :: i,j @@ -74,7 +79,7 @@ SUBROUTINE PrintDomain(dataName,mesh) END DO END SUBROUTINE PrintDomain - SUBROUTINE CreateVariable(dataName,dataType,mesh,BCPerm,Solver,solverParams) + SUBROUTINE CreateVariable(dataName,dataType,mesh,BoundaryPerm,Solver,solverParams) !-------------------------Strings----------------------------------------------- CHARACTER(LEN=MAX_NAME_LEN) :: dataName CHARACTER(LEN=MAX_NAME_LEN) :: infoMessage @@ -85,7 +90,7 @@ SUBROUTINE CreateVariable(dataName,dataType,mesh,BCPerm,Solver,solverParams) TYPE(Solver_t) :: Solver TYPE(ValueList_t), POINTER :: solverParams !------------------------Data Arrays-------------------------------------------- - INTEGER, POINTER :: BCPerm(:) + INTEGER, POINTER :: BoundaryPerm(:) !------------------------Mesh Data---------------------------------------------- INTEGER :: Dofs !--------------------------Logic-Control------------------------------------- @@ -97,13 +102,7 @@ SUBROUTINE CreateVariable(dataName,dataType,mesh,BCPerm,Solver,solverParams) IF(ASSOCIATED( dataVariable ) ) THEN CALL Info('CouplerSolver','Using existing variable : '//TRIM(dataName) ) ELSE - CALL Info('CouplerSolver','Creating variable as it does not exist: '//TRIM(dataName)) - - Dofs = ListGetInteger( solverParams,'Field Dofs',Found ) - IF(.NOT. Found ) Dofs = 1 - CALL VariableAddVector( mesh % Variables, mesh, Solver, dataName, Dofs, & - Perm = BCPerm, Secondary = .TRUE. ) - dataVariable => VariableGet( mesh % Variables, dataName ) + CALL FATAL('CouplerSolver', 'Variable does not exist : ' // TRIM(dataName) ) END IF @@ -111,7 +110,7 @@ END SUBROUTINE CreateVariable - SUBROUTINE CopyReadData(dataName,mesh,BCPerm,copyData) + SUBROUTINE CopyReadData(dataName,mesh,BoundaryPerm,copyData) !-------------------------Strings----------------------------------------------- CHARACTER(LEN=MAX_NAME_LEN) :: dataName !-------------------------Elmer_Types---------------------------------------------- @@ -119,7 +118,7 @@ SUBROUTINE CopyReadData(dataName,mesh,BCPerm,copyData) TYPE(Mesh_t), POINTER :: mesh ! !------------------------Data Arrays---------------------------------------------- REAL(KIND=dp), POINTER :: copyData(:) - INTEGER, POINTER :: BCPerm(:) + INTEGER, POINTER :: BoundaryPerm(:) !--------------------------Iterators------------------------------------- INTEGER :: i,j @@ -127,7 +126,7 @@ SUBROUTINE CopyReadData(dataName,mesh,BCPerm,copyData) dataVariable => VariableGet( mesh % Variables, dataName) DO i = 1, mesh % NumberOfNodes - j = BCPerm(i) + j = BoundaryPerm(i) IF(j == 0) CYCLE dataVariable % Values(dataVariable % Perm(i)) = copyData(j) @@ -136,7 +135,7 @@ SUBROUTINE CopyReadData(dataName,mesh,BCPerm,copyData) END SUBROUTINE CopyReadData - SUBROUTINE CopyWriteData(dataName,mesh,BCPerm,copyData) + SUBROUTINE CopyWriteData(dataName,mesh,BoundaryPerm,copyData) !-------------------------Strings----------------------------------------------- CHARACTER(LEN=MAX_NAME_LEN) :: dataName !-------------------------Elmer_Types---------------------------------------------- @@ -144,7 +143,7 @@ SUBROUTINE CopyWriteData(dataName,mesh,BCPerm,copyData) TYPE(Mesh_t), POINTER :: mesh !------------------------Data Arrays---------------------------------------------- REAL(KIND=dp), POINTER :: copyData(:) - INTEGER, POINTER :: BCPerm(:) + INTEGER, POINTER :: BoundaryPerm(:) !--------------------------Iterators------------------------------------- INTEGER :: i,j @@ -152,7 +151,7 @@ SUBROUTINE CopyWriteData(dataName,mesh,BCPerm,copyData) dataVariable => VariableGet( mesh % Variables, dataName) DO i = 1, mesh % NumberOfNodes - j = BCPerm(i) + j = BoundaryPerm(i) IF(j == 0) CYCLE copyData(j) = dataVariable % Values(dataVariable % Perm(i)) ! IF( dataName == "temperature loads") THEN @@ -182,21 +181,16 @@ SUBROUTINE CouplerSolver( Model,Solver,dt,TransientSimulation) !--------------------------Variables-Start------------------------------------------- - - !--------------------------MPI-Variables------------------------------------- - INTEGER :: rank,commsize - !--------------------------Precice-Control------------------------------------- - INTEGER :: itask = 1 - !--------------------------Logic-Control------------------------------------- LOGICAL :: Found - !--------------------------Iterators------------------------------------- - INTEGER :: i,j - - + !--------------------------MPI-Variables------------------------------------- + INTEGER :: rank,commsize + !--------------------------Elmer-Variables------------------------------------- + !-------------------------Loop_Control------------------------------------- + INTEGER :: itask = 1 !-------------------------Strings---------------------------------------------- - CHARACTER(LEN=MAX_NAME_LEN) :: maskName + CHARACTER(LEN=MAX_NAME_LEN) :: BoundaryName CHARACTER(LEN=MAX_NAME_LEN) :: infoMessage !-------------------------Elmer_Types---------------------------------------------- TYPE(Variable_t), POINTER :: readDataVariable,writeDataVariable @@ -204,267 +198,216 @@ SUBROUTINE CouplerSolver( Model,Solver,dt,TransientSimulation) TYPE(ValueList_t), POINTER :: simulation, solverParams ! Simulation gets Simulation list, & solverParams hold solver1,solver 2,etc !------------------------Data Arrays---------------------------------------------- REAL(KIND=dp), POINTER :: CoordVals(:) - INTEGER, POINTER :: BCPerm(:) + INTEGER, POINTER :: BoundaryPerm(:) !------------------------Time Variable---------------------------------------------- TYPE(Variable_t), POINTER :: TimeVar Real(KIND=dp) :: Time - !--------------------------Precice-Variables------------------------------------- + !--------------------------preCICE-Variables------------------------------------- !-------------------------Strings---------------------------------------------- - CHARACTER(LEN=MAX_NAME_LEN) :: participantName, meshName, configPath, readDataName,writeDataName - ! CHARACTER(LEN=MAX_NAME_LEN) :: writeInitialData, readItCheckp, writeItCheckp ! ?? Do not know - CHARACTER*50 :: writeInitialData, readItCheckp, writeItCheckp + CHARACTER(LEN=MAX_NAME_LEN) :: config + CHARACTER(LEN=MAX_NAME_LEN) :: participantName, meshName + CHARACTER(LEN=MAX_NAME_LEN) :: readDataName, writeDataName + !-------------------------IDs-Integer---------------------------------------------- - INTEGER :: meshID,readDataID, writeDataID + INTEGER :: meshID,readDataID, writeDataID, meshDim !------------------------Data Arrays---------------------------------------------- - REAL(KIND=dp), POINTER :: writeData(:), readData(:) + REAL(KIND=dp), POINTER :: vertices(:), writeData(:), readData(:) INTEGER, POINTER :: vertexIDs(:) !------------------------Mesh Data---------------------------------------------- - INTEGER :: vertexSize + INTEGER :: BoundaryNodes INTEGER :: Dofs INTEGER :: dimensions ! ?? Do not know !----------------------Time Loop Control Variables----------------------------- INTEGER :: bool INTEGER :: ongoing + INTEGER :: i,j !--------------------------Variables-End------------------------------------------- - integer, dimension (11) :: vertecies - !--------------------------SAVE-Start------------------------------------------- - SAVE meshID,readDataID,writeDataID SAVE meshName,readDataName,writeDataName SAVE itask - SAVE BCPerm,CoordVals,vertexIDs + SAVE BoundaryPerm,CoordVals,vertexIDs SAVE readData,writeData - SAVE vertexSize - + SAVE BoundaryNodes !--------------------------SAVE-End------------------------------------------- - !--------------------------Initialize-Start------------------------------------------- - CALL Info(''//achar(27)//'[31mCouplerSolver ', 'Transfering results between different software ') + !--------------------------Initialize-Start------------------------------------------- Simulation => GetSimulation() Mesh => Solver % Mesh solverParams => GetSolverParams() - + meshDim = Mesh % MaxDim + rank = 0 commsize = 1 - !--------------------------Initialize-End------------------------------------------- - !----Dirichlet - ! vertecies = (/3,22,21,20,19,18,17,16,15,14,4/) - ! vertecies = (/2,32,33,34,35,36,37,38,39,40,1/) - !----Neumann - vertecies = (/4,32,33,34,35,36,37,38,39,40,1/) - - ! CALL Info('CouplerSolver','Enter Key To Continue') - ! read(*,*) - - writeInitialData(1:50)=' ' - readItCheckp(1:50)=' ' - writeItCheckp(1:50)=' ' - select case(itask) - ! TODO make enum case(1) + CALL Info('CouplerSolver ', 'Initializing Coupler Solver') !--- First Time Visited, Initialization - !-- First Time Visit, Create Precice, create nodes at interface + !-- First Time Visit, Create preCICE, create nodes at interface !----------------------------- Initialize--------------------- + !----------------Acquire Names for solver--------------------- - maskName = GetString( Simulation, 'maskName', Found ) + BoundaryName = GetString( Simulation, 'maskName', Found ) participantName = GetString( Simulation, 'participantName', Found ) - meshName = GetString( Simulation, 'meshName', Found ) - configPath = GetString( Simulation, 'configPath', Found ) - - Print *, TRIM(maskName)," ",TRIM(participantName)," ",TRIM(meshName)," ",TRIM(configPath) + !-----------------Convert to preCICE Naming Convention + IF (participantName == 'solid') THEN + participantName = 'Solid' + END IF + IF (participantName == 'fluid') THEN + participantName = 'Fluid' + END IF + meshName = GetString( Simulation, 'meshName', Found ) + IF (meshName == 'solid-mesh') THEN + meshName = 'Solid-Mesh' + END IF + IF (meshName == 'fluid-mesh') THEN + meshName = 'Fluid-Mesh' + END IF + !--------------------------------------------------------------------- - !-----------Identify Vertex on Coupling Interface & Save Coordinates-------------------- - NULLIFY( BCPerm ) - ALLOCATE( BCPerm( Mesh % NumberOfNodes ) ) - BCPerm = 0 - ! CALL MakePermUsingMask( Model, Solver, Mesh, MaskName, .FALSE., & - ! BCPerm, vertexSize ) - CALL MakePermUsingMask( Model, Solver, Mesh, MaskName, .TRUE., & - BCPerm, vertexSize ) - CALL Info('CouplerSolver','Number of nodes at interface:'//TRIM(I2S(vertexSize))) + !-----------------Get Config Path------------------------------------- + config = GetString( Simulation, 'configPath', Found ) + Print *, TRIM(BoundaryName)," ",TRIM(participantName)," ",TRIM(meshName)," ",TRIM(config) - - ALLOCATE( CoordVals(2*vertexSize) ) - ALLOCATE(vertexIDs(vertexSize)) + !-----------Identify Vertex on Coupling Interface & Save Coordinates-------------------- + NULLIFY( BoundaryPerm ) + ALLOCATE( BoundaryPerm( Mesh % NumberOfNodes ) ) + BoundaryPerm = 0 + BoundaryNodes = 0 + CALL MakePermUsingMask( Model,Model%Solver,Model%Mesh,BoundaryName,.FALSE., & + BoundaryPerm,BoundaryNodes) + + CALL Info('CouplerSolver','Number of nodes at interface:'//TRIM(I2S(BoundaryNodes))) + ALLOCATE( CoordVals(meshDim * BoundaryNodes) ) + ALLOCATE(vertexIDs(BoundaryNodes)) DO i=1,Mesh % NumberOfNodes - j = BCPerm(i) - CoordVals(2*j-1) = mesh % Nodes % x(i) - CoordVals(2*j) = mesh % Nodes % y(i) - ! CoordVals(3*j) = mesh % Nodes % z(i) - ! IF(j /= 0) THEN - ! vertexIDs(j) = j - ! END IF + j = BoundaryPerm(i) + IF(j == 0) CYCLE + IF (meshDim == 2) THEN + CoordVals(meshDim *j-1) = mesh % Nodes % x(i) + CoordVals(meshDim*j) = mesh % Nodes % y(i) + ELSE IF (meshDim == 3) THEN + CoordVals(meshDim *j-2) = mesh % Nodes % x(i) + CoordVals(meshDim *j-1) = mesh % Nodes % y(i) + CoordVals(meshDim *j) = mesh % Nodes % z(i) + END IF END DO - CALL Info('CouplerSolver','Created nodes at interface') - - !-----------Identify read Variables and Create it if it does not exist-------------------- - CALL CreateVariable(readDataName,'readDataName',mesh,BCPerm,Solver,solverParams) - - !-----------Print Read Values, For Debugging Purposes-------------------- - CALL Info('CouplerSolver','Printing read Data') - CALL Print(readDataName,mesh ,BCPerm,CoordVals) - !------------------------------------------------------------------------------ - - !-----------Identify write Variables and Create it if it does not exist-------------------- - CALL CreateVariable(writeDataName,'writeDataName',mesh,BCPerm,Solver,solverParams) - - !-----------Print Write Values, For Debugging Purposes-------------------- - CALL Info('CouplerSolver','Printing write Data') - CALL Print(writeDataName,mesh ,BCPerm,CoordVals) - - !------------------------------------------------------------------------------ - !---------------Initializing Precice------------------------------------------ - - CALL precicef_create(participantName, configPath, rank, commsize) - - writeInitialData(1:50)=' ' - readItCheckp(1:50)=' ' - writeItCheckp(1:50)=' ' - - CALL precicef_get_dims(dimensions) - CALL precicef_get_mesh_id(meshName, meshID) - CALL precicef_set_vertices(meshID, vertexSize, CoordVals, vertexIDs) + CALL Info('CouplerSolver','Created nodes at interface') - CALL precicef_get_data_id(readDataName,meshID,readDataID) - CALL precicef_get_data_id(writeDataName,meshID,writeDataID) + ! !-----------Identify read and write Variables and Create it if it does not exist-------------------- + CALL CreateVariable(readDataName,'readDataName',mesh,BoundaryPerm,Solver,solverParams) + CALL CreateVariable(writeDataName,'writeDataName',mesh,BoundaryPerm,Solver,solverParams) + !----------------------------------------------------------------------------------------- - ALLOCATE(readData(VertexSize)) - ALLOCATE(writeData(VertexSize)) + ! !---------------Initializing preCICE------------------------------------------ + CALL Info('CouplerSolver','Initializing preCICE') + CALL precicef_create(participantName, config, rank, commsize) + + CALL Info('CouplerSolver','Setting up mesh in preCICE') + CALL precicef_get_mesh_dimensions(meshName, dimensions) + CALL precicef_set_vertices(meshName, BoundaryNodes, CoordVals, vertexIDs) + ALLOCATE(readData(BoundaryNodes*dimensions)) + ALLOCATE(writeData(BoundaryNodes*dimensions)) readData = 0 writeData = 0 - - !----------------------Initializing Data------------------------------------ - CALL precicef_initialize(dt) - CALL precicef_action_write_initial_data(writeInitialData) - CALL precicef_is_action_required(writeInitialData, bool) - - - + CALL precicef_requires_initial_data(bool) IF (bool.EQ.1) THEN - CALL Info('CouplerSolver','Writing Initial Data') - CALL CopyWriteData(writeDataName,mesh,BCPerm,writeData) - CALL precicef_write_bsdata(writeDataID, vertexSize, vertexIDs, writeData) - CALL precicef_mark_action_fulfilled(writeInitialData) + WRITE (*,*) 'TODO: Provide initial data if needed' + CALL CopyWriteData(writeDataName,mesh,BoundaryPerm,writeData) + IF (writeDataName == 'temperature') THEN + CALL precicef_write_data(meshName, 'Temperature', BoundaryNodes, vertexIDs, writeData) + ELSE IF (writeDataName == 'temperature flux_abs') THEN + CALL precicef_write_data(meshName, 'Heat-Flux', BoundaryNodes, vertexIDs, writeData) + ELSE + CALL precicef_write_data(meshName, writeDataName, BoundaryNodes, vertexIDs, writeData) + END IF + ELSE + WRITE (*,*) 'No initial data required' ENDIF - - CALL precicef_initialize_data() - + CALL precicef_initialize() CALL precicef_is_coupling_ongoing(ongoing) - + ! !------------------------------------------------------------------------------ itask = 2 case(2) - - CALL precicef_action_write_iter_checkp(writeItCheckp) - CALL precicef_is_action_required(writeItCheckp, bool) - - write(infoMessage,'(A,I2)') writeItCheckp,bool - CALL Info('CouplerSolver',infoMessage) + !-------------------Copy Read values from Variable to buffer--------------------- + CALL precicef_requires_writing_checkpoint(bool) IF (bool.EQ.1) THEN - CALL Info('CouplerSolver','Writing iteration checkpoint') - CALL precicef_mark_action_fulfilled(writeItCheckp) + WRITE (*,*) 'DUMMY: Writing iteration checkpoint' + ELSE + WRITE (*,*) 'Writing iteration checkpoint is not required' ENDIF - - CALL Info('CouplerSolver','Reading Data') - CALL precicef_read_bsdata(readDataID, vertexSize, vertexIDs, readData) - - CALL Info('CouplerSolver','Copy Read Data to Variable') - CALL CopyReadData(readDataName,mesh,BCPerm,readData) - - CALL Info('CouplerSolver','Printing read Data') - CALL Print(readDataName,mesh ,BCPerm,CoordVals) - - CALL Info('CouplerSolver','Printing write Data') - CALL Print(writeDataName,mesh ,BCPerm,CoordVals) + CALL Info('CouplerSolver ', 'Reading the data from preCICE') + CALL precicef_get_max_time_step_size(dt) + !-------------------Sticking preCICE Naming Convention------------------------------------- + IF (readDataName == 'temperature') THEN + CALL precicef_read_data(meshName, 'Temperature', BoundaryNodes, vertexIDs, dt, readData) + ELSE IF (readDataName == 'temperature flux_abs') THEN + CALL precicef_read_data(meshName, 'Heat-Flux', BoundaryNodes, vertexIDs, dt, readData) + ELSE + CALL precicef_read_data(meshName, readDataName, BoundaryNodes, vertexIDs, dt, readData) + END IF + + CALL CopyReadData(readDataName,mesh,BoundaryPerm,readData) + !----------------------------------------------------------------------------------------- itask = 3 case(3) - !-------------------Copy Write values from Variable to buffer--------------------- - - CALL Info('CouplerSolver','Copy Write Data to Variable') - CALL CopyWriteData(writeDataName,mesh,BCPerm,writeData) - CALL Info('CouplerSolver','Writing Data') - CALL precicef_write_bsdata(writeDataID, vertexSize, vertexIDs, writeData) + !-------------------Copy Write values from Variable to buffer---------------------------- + CALL CopyWriteData(writeDataName,mesh,BoundaryPerm,writeData) - CALL Info('CouplerSolver','Printing write Data') - CALL Print(writeDataName,mesh ,BCPerm,CoordVals) - - CALL Info('CouplerSolver','Printing read Data') - CALL Print(readDataName,mesh ,BCPerm,CoordVals) + !-------------------Sticking preCICE Naming Convention------------------------------------- + IF (writeDataName == 'temperature') THEN + CALL precicef_write_data(meshName, 'Temperature', BoundaryNodes, vertexIDs, writeData) + ELSE IF (writeDataName == 'temperature flux_abs') THEN + CALL precicef_write_data(meshName, 'Heat-Flux', BoundaryNodes, vertexIDs, writeData) + ELSE + CALL precicef_write_data(meshName, writeDataName, BoundaryNodes, vertexIDs, writeData) + END IF - !--------------------Advance time loop--------------------------------------- + + !-------------------Advance preCICE------------------------------------------------------- CALL precicef_advance(dt) + CALL precicef_is_coupling_ongoing(ongoing) - CALL precicef_action_read_iter_checkp(readItCheckp) - CALL precicef_is_action_required(readItCheckp, bool) - + CALL precicef_requires_reading_checkpoint(bool) - IF (bool.EQ.1) THEN - - write(infoMessage,'(A,I2)') readItCheckp,bool - CALL Info('CouplerSolver',infoMessage) - CALL Info('CouplerSolver','Reading iteration checkpoint') - CALL precicef_mark_action_fulfilled(readItCheckp) + WRITE (*,*) 'DUMMY: Reading iteration checkpoint' + ELSE + WRITE (*,*) 'Reading iteration checkpoint is not required' ENDIF - - - CALL precicef_is_coupling_ongoing(ongoing) - IF(ongoing.EQ.0) THEN itask = 4 ELSE itask = 2 END IF - - case(4) - !----------------------------------------Finailize-------------------------------------- - CALL Info('CouplerSolver','Precice Finalize') + !----------------------------------------------------------------------------------------- + + case(4) + CALL Info('CouplerSolver','preCICE Finalize') CALL precicef_finalize() + ! DEALLOCATE(writeData) + ! DEALLOCATE(readData) + ! DEALLOCATE(vertexIDs) case(5) - ! CALL PrintDomain('temperature loads',mesh) - CALL Info('CouplerSolver','Printing Temperature') - readDataVariable => VariableGet( mesh % Variables, 'temperature ') - DO i = 1, 11 - - - write(infoMessage,'(A,I5,A,F10.4)') 'Node: ',vertecies(i),' Value: ', & - readDataVariable % Values(readDataVariable % Perm(vertecies(i))) - - CALL Info('CouplerSolver',infoMessage) - - END DO - - CALL Info('CouplerSolver','Printing temperature loads') - readDataVariable => VariableGet( mesh % Variables, 'temperature loads') - DO i = 1, 11 - - - write(infoMessage,'(A,I5,A,F10.4)') 'Node: ',vertecies(i),' Value: ', & - readDataVariable % Values(readDataVariable % Perm(vertecies(i))) - - CALL Info('CouplerSolver',infoMessage) - - END DO + CALL Info('CouplerSolver ', 'Testing') end select - - CALL Info('CouplerSolver',' Ended '//achar(27)//'[0m.') + CALL Info('CouplerSolver','Ended') END SUBROUTINE CouplerSolver diff --git a/Adapter/build.sh b/Adapter/build.sh index 1f1e6a7..a44b8cd 100755 --- a/Adapter/build.sh +++ b/Adapter/build.sh @@ -1,3 +1,3 @@ -elmerf90 -o Coupler_Solver.so Coupler_Solver.F90 /usr/lib/x86_64-linux-gnu/libprecice.so.2 -elmerf90 -o Print_Module.so Print_Module.F90 /usr/lib/x86_64-linux-gnu/libprecice.so.2 -elmerf90 -o UDF_Boundary.so UDF_Boundary.F90 /usr/lib/x86_64-linux-gnu/libprecice.so.2 \ No newline at end of file +elmerf90 -o Coupler_Solver.so Coupler_Solver.F90 /usr/lib/x86_64-linux-gnu/libprecice.so.3 +elmerf90 -o Print_Module.so Print_Module.F90 /usr/lib/x86_64-linux-gnu/libprecice.so.3 +elmerf90 -o UDF_Boundary.so UDF_Boundary.F90 /usr/lib/x86_64-linux-gnu/libprecice.so.3 diff --git a/Flow_Over_Heated_Plate/Coupler_Solver.F90 b/Flow_Over_Heated_Plate/Coupler_Solver.F90 deleted file mode 100644 index 7916ca5..0000000 --- a/Flow_Over_Heated_Plate/Coupler_Solver.F90 +++ /dev/null @@ -1,475 +0,0 @@ -MODULE HelperMethods - - !------------------------------------------------------------------------------ - USE DefUtils - !------------------------------------------------------------------------------ - IMPLICIT NONE - - - - CONTAINS - - ! SUBROUTINE StoreCheckpoint(writeData,t) - - ! END SUBROUTINE StoreCheckpoint - - SUBROUTINE Print(dataName,mesh,BCPerm,CoordVals) - - !-------------------------Strings---------------------------------------------- - CHARACTER(LEN=MAX_NAME_LEN) :: dataName - CHARACTER(LEN=MAX_NAME_LEN) :: infoMessage - !-------------------------Elmer_Types---------------------------------------------- - TYPE(Variable_t), POINTER :: dataVariable - TYPE(Mesh_t), POINTER :: mesh - !------------------------Data Arrays---------------------------------------------- - REAL(KIND=dp), POINTER :: CoordVals(:) - INTEGER, POINTER :: BCPerm(:) - !--------------------------Iterators------------------------------------- - INTEGER :: i,j - - dataVariable => VariableGet( mesh % Variables, dataName) - - CALL Info('CouplerSolver','Printing ' //TRIM(dataName)) - DO i = 1, mesh % NumberOfNodes - j = BCPerm(i) - IF(j == 0) CYCLE - - write(infoMessage,'(A,I5,A,I5,A,F10.4,A,F10.2,A,F10.2)') 'Node: ',i,' Index: ',j,' Value: ' & - ,dataVariable % Values(dataVariable % Perm(i)),& - ' X= ', CoordVals(2*j-1), ' Y= ', CoordVals(2*j) - - CALL Info('CouplerSolver',infoMessage) - - END DO - - END SUBROUTINE Print - - SUBROUTINE PrintDomain(dataName,mesh) - - !-------------------------Strings---------------------------------------------- - ! CHARACTER(LEN=MAX_NAME_LEN) :: dataName - CHARACTER(LEN=MAX_NAME_LEN) :: infoMessage - character(len=*), intent(in) :: dataName - !-------------------------Elmer_Types---------------------------------------------- - TYPE(Variable_t), POINTER :: dataVariable - TYPE(Mesh_t), POINTER :: mesh - !------------------------Data Arrays---------------------------------------------- - REAL(KIND=dp), POINTER :: CoordVals(:) - INTEGER, POINTER :: BCPerm(:) - !--------------------------Iterators------------------------------------- - INTEGER :: i,j - - dataVariable => VariableGet( mesh % Variables, dataName) - - CALL Info('CouplerSolver','Printing ' //TRIM(dataName)) - DO i = 1, mesh % NumberOfNodes - - - write(infoMessage,'(A,I5,A,F10.4,A,F10.2,A,F10.2)') 'Node: ',i,' Value: ' & - ,dataVariable % Values(dataVariable % Perm(i)),& - ' X= ', mesh % Nodes % x(i), ' Y= ', mesh % Nodes % y(i) - - CALL Info('CouplerSolver',infoMessage) - - END DO - END SUBROUTINE PrintDomain - - SUBROUTINE CreateVariable(dataName,dataType,mesh,BCPerm,Solver,solverParams) - !-------------------------Strings----------------------------------------------- - CHARACTER(LEN=MAX_NAME_LEN) :: dataName - CHARACTER(LEN=MAX_NAME_LEN) :: infoMessage - character(len=*), intent(in) :: dataType - !-------------------------Elmer_Types------------------------------------------- - TYPE(Variable_t), POINTER :: dataVariable - TYPE(Mesh_t), POINTER :: mesh - TYPE(Solver_t) :: Solver - TYPE(ValueList_t), POINTER :: solverParams - !------------------------Data Arrays-------------------------------------------- - INTEGER, POINTER :: BCPerm(:) - !------------------------Mesh Data---------------------------------------------- - INTEGER :: Dofs - !--------------------------Logic-Control------------------------------------- - LOGICAL :: Found - - - dataName = ListGetString(solverParams,dataType,Found ) - dataVariable => VariableGet( mesh % Variables, dataName) - IF(ASSOCIATED( dataVariable ) ) THEN - CALL Info('CouplerSolver','Using existing variable : '//TRIM(dataName) ) - ELSE - CALL Info('CouplerSolver','Creating variable as it does not exist: '//TRIM(dataName)) - - Dofs = ListGetInteger( solverParams,'Field Dofs',Found ) - IF(.NOT. Found ) Dofs = 1 - CALL VariableAddVector( mesh % Variables, mesh, Solver, dataName, Dofs, & - Perm = BCPerm, Secondary = .TRUE. ) - dataVariable => VariableGet( mesh % Variables, dataName ) - END IF - - - END SUBROUTINE CreateVariable - - - - SUBROUTINE CopyReadData(dataName,mesh,BCPerm,copyData) - !-------------------------Strings----------------------------------------------- - CHARACTER(LEN=MAX_NAME_LEN) :: dataName - !-------------------------Elmer_Types---------------------------------------------- - TYPE(Variable_t), POINTER :: dataVariable - TYPE(Mesh_t), POINTER :: mesh - ! !------------------------Data Arrays---------------------------------------------- - REAL(KIND=dp), POINTER :: copyData(:) - INTEGER, POINTER :: BCPerm(:) - !--------------------------Iterators------------------------------------- - INTEGER :: i,j - - - dataVariable => VariableGet( mesh % Variables, dataName) - - DO i = 1, mesh % NumberOfNodes - j = BCPerm(i) - IF(j == 0) CYCLE - dataVariable % Values(dataVariable % Perm(i)) = copyData(j) - - - END DO - - END SUBROUTINE CopyReadData - - SUBROUTINE CopyWriteData(dataName,mesh,BCPerm,copyData) - !-------------------------Strings----------------------------------------------- - CHARACTER(LEN=MAX_NAME_LEN) :: dataName - !-------------------------Elmer_Types---------------------------------------------- - TYPE(Variable_t), POINTER :: dataVariable - TYPE(Mesh_t), POINTER :: mesh - !------------------------Data Arrays---------------------------------------------- - REAL(KIND=dp), POINTER :: copyData(:) - INTEGER, POINTER :: BCPerm(:) - !--------------------------Iterators------------------------------------- - INTEGER :: i,j - - - dataVariable => VariableGet( mesh % Variables, dataName) - - DO i = 1, mesh % NumberOfNodes - j = BCPerm(i) - IF(j == 0) CYCLE - copyData(j) = dataVariable % Values(dataVariable % Perm(i)) - ! IF( dataName == "temperature loads") THEN - ! copyData(j) = -1 * dataVariable % Values(dataVariable % Perm(i)) - ! ELSE - ! copyData(j) = dataVariable % Values(dataVariable % Perm(i)) - ! END IF - END DO - END SUBROUTINE CopyWriteData - -END MODULE HelperMethods - - - -SUBROUTINE CouplerSolver( Model,Solver,dt,TransientSimulation) - - !------------------------------------------------------------------------------ - USE DefUtils - USE HelperMethods - !------------------------------------------------------------------------------ - IMPLICIT NONE - !--------------------------UDS Prerequistes------------------------------------ - TYPE(Solver_t) :: Solver - TYPE(Model_t) :: Model - REAL(KIND=dp) :: dt - LOGICAL :: TransientSimulation - - - !--------------------------Variables-Start------------------------------------------- - - !--------------------------MPI-Variables------------------------------------- - INTEGER :: rank,commsize - !--------------------------Precice-Control------------------------------------- - INTEGER :: itask = 1 - - !--------------------------Logic-Control------------------------------------- - LOGICAL :: Found - !--------------------------Iterators------------------------------------- - INTEGER :: i,j - - - !--------------------------Elmer-Variables------------------------------------- - !-------------------------Strings---------------------------------------------- - CHARACTER(LEN=MAX_NAME_LEN) :: maskName - CHARACTER(LEN=MAX_NAME_LEN) :: infoMessage - !-------------------------Elmer_Types---------------------------------------------- - TYPE(Variable_t), POINTER :: readDataVariable,writeDataVariable - TYPE(Mesh_t), POINTER :: mesh - TYPE(ValueList_t), POINTER :: simulation, solverParams ! Simulation gets Simulation list, & solverParams hold solver1,solver 2,etc - !------------------------Data Arrays---------------------------------------------- - REAL(KIND=dp), POINTER :: CoordVals(:) - INTEGER, POINTER :: BCPerm(:) - !------------------------Time Variable---------------------------------------------- - TYPE(Variable_t), POINTER :: TimeVar - Real(KIND=dp) :: Time - - !--------------------------Precice-Variables------------------------------------- - !-------------------------Strings---------------------------------------------- - CHARACTER(LEN=MAX_NAME_LEN) :: participantName, meshName, configPath, readDataName,writeDataName - ! CHARACTER(LEN=MAX_NAME_LEN) :: writeInitialData, readItCheckp, writeItCheckp ! ?? Do not know - CHARACTER*50 :: writeInitialData, readItCheckp, writeItCheckp - !-------------------------IDs-Integer---------------------------------------------- - INTEGER :: meshID,readDataID, writeDataID - !------------------------Data Arrays---------------------------------------------- - REAL(KIND=dp), POINTER :: writeData(:), readData(:) - INTEGER, POINTER :: vertexIDs(:) - !------------------------Mesh Data---------------------------------------------- - INTEGER :: vertexSize - INTEGER :: Dofs - INTEGER :: dimensions ! ?? Do not know - !----------------------Time Loop Control Variables----------------------------- - INTEGER :: bool - INTEGER :: ongoing - !--------------------------Variables-End------------------------------------------- - - integer, dimension (10) :: vertecies - - !--------------------------SAVE-Start------------------------------------------- - SAVE meshID,readDataID,writeDataID - SAVE meshName,readDataName,writeDataName - SAVE itask - SAVE BCPerm,CoordVals,vertexIDs - SAVE readData,writeData - SAVE vertexSize - - !--------------------------SAVE-End------------------------------------------- - - !--------------------------Initialize-Start------------------------------------------- - CALL Info(''//achar(27)//'[31mCouplerSolver ', 'Transfering results between different software ') - - Simulation => GetSimulation() - Mesh => Solver % Mesh - solverParams => GetSolverParams() - - rank = 0 - commsize = 1 - !--------------------------Initialize-End------------------------------------------- - !--Solid - !vertecies = (/1,28,27,26,25,24,23,22,21,3/) - !--Fluid - vertecies = (/1,29,28,27,26,25,24,23,22,3/) - ! CALL Info('CouplerSolver','Enter Key To Continue') - ! read(*,*) - - writeInitialData(1:50)=' ' - readItCheckp(1:50)=' ' - writeItCheckp(1:50)=' ' - - select case(itask) - ! TODO make enum - case(1) - !--- First Time Visited, Initialization - !-- First Time Visit, Create Precice, create nodes at interface - !----------------------------- Initialize--------------------- - !----------------Acquire Names for solver--------------------- - maskName = GetString( Simulation, 'maskName', Found ) - participantName = GetString( Simulation, 'participantName', Found ) - meshName = GetString( Simulation, 'meshName', Found ) - configPath = GetString( Simulation, 'configPath', Found ) - - Print *, TRIM(maskName)," ",TRIM(participantName)," ",TRIM(meshName)," ",TRIM(configPath) - - - !-----------Identify Vertex on Coupling Interface & Save Coordinates-------------------- - NULLIFY( BCPerm ) - ALLOCATE( BCPerm( Mesh % NumberOfNodes ) ) - BCPerm = 0 - ! CALL MakePermUsingMask( Model, Solver, Mesh, MaskName, .FALSE., & - ! BCPerm, vertexSize ) - CALL MakePermUsingMask( Model, Solver, Mesh, MaskName, .TRUE., & - BCPerm, vertexSize ) - CALL Info('CouplerSolver','Number of nodes at interface:'//TRIM(I2S(vertexSize))) - - - - ALLOCATE( CoordVals(2*vertexSize) ) - ALLOCATE(vertexIDs(vertexSize)) - DO i=1,Mesh % NumberOfNodes - j = BCPerm(i) - CoordVals(2*j-1) = mesh % Nodes % x(i) - CoordVals(2*j) = mesh % Nodes % y(i) - ! CoordVals(3*j) = mesh % Nodes % z(i) - ! IF(j /= 0) THEN - ! vertexIDs(j) = j - ! END IF - END DO - CALL Info('CouplerSolver','Created nodes at interface') - - !-----------Identify read Variables and Create it if it does not exist-------------------- - CALL CreateVariable(readDataName,'readDataName',mesh,BCPerm,Solver,solverParams) - - !-----------Print Read Values, For Debugging Purposes-------------------- - CALL Info('CouplerSolver','Printing read Data') - CALL Print(readDataName,mesh ,BCPerm,CoordVals) - !------------------------------------------------------------------------------ - - !-----------Identify write Variables and Create it if it does not exist-------------------- - CALL CreateVariable(writeDataName,'writeDataName',mesh,BCPerm,Solver,solverParams) - - !-----------Print Write Values, For Debugging Purposes-------------------- - CALL Info('CouplerSolver','Printing write Data') - CALL Print(writeDataName,mesh ,BCPerm,CoordVals) - - ! !------------------------------------------------------------------------------ - ! !---------------Initializing Precice------------------------------------------ - - ! IF (participantName == "neumann") THEN - ! rank =1 - ! END IF - - CALL precicef_create(participantName, configPath, rank, commsize) - - writeInitialData(1:50)=' ' - readItCheckp(1:50)=' ' - writeItCheckp(1:50)=' ' - - CALL precicef_get_dims(dimensions) - CALL precicef_get_mesh_id(meshName, meshID) - CALL precicef_set_vertices(meshID, vertexSize, CoordVals, vertexIDs) - - CALL precicef_get_data_id(readDataName,meshID,readDataID) - CALL precicef_get_data_id(writeDataName,meshID,writeDataID) - - ALLOCATE(readData(VertexSize)) - ALLOCATE(writeData(VertexSize)) - - readData = 0 - writeData = 0 - - - !----------------------Initializing Data------------------------------------ - CALL precicef_initialize(dt) - CALL precicef_action_write_initial_data(writeInitialData) - CALL precicef_is_action_required(writeInitialData, bool) - - - - IF (bool.EQ.1) THEN - CALL Info('CouplerSolver','Writing Initial Data') - CALL CopyWriteData(writeDataName,mesh,BCPerm,writeData) - CALL precicef_write_bsdata(writeDataID, vertexSize, vertexIDs, writeData) - CALL precicef_mark_action_fulfilled(writeInitialData) - ENDIF - - CALL precicef_initialize_data() - - CALL precicef_is_coupling_ongoing(ongoing) - - - itask = 2 - case(2) - - CALL precicef_action_write_iter_checkp(writeItCheckp) - CALL precicef_is_action_required(writeItCheckp, bool) - - write(infoMessage,'(A,I2)') writeItCheckp,bool - CALL Info('CouplerSolver',infoMessage) - - IF (bool.EQ.1) THEN - CALL Info('CouplerSolver','Writing iteration checkpoint') - CALL precicef_mark_action_fulfilled(writeItCheckp) - ENDIF - - CALL Info('CouplerSolver','Reading Data') - CALL precicef_read_bsdata(readDataID, vertexSize, vertexIDs, readData) - - CALL Info('CouplerSolver','Copy Read Data to Variable') - CALL CopyReadData(readDataName,mesh,BCPerm,readData) - - CALL Info('CouplerSolver','Printing read Data') - CALL Print(readDataName,mesh ,BCPerm,CoordVals) - - - CALL Info('CouplerSolver','Printing write Data') - CALL Print(writeDataName,mesh ,BCPerm,CoordVals) - - - itask = 3 - case(3) - !-------------------Copy Write values from Variable to buffer--------------------- - - CALL Info('CouplerSolver','Copy Write Data to Variable') - CALL CopyWriteData(writeDataName,mesh,BCPerm,writeData) - - CALL Info('CouplerSolver','Writing Data') - CALL precicef_write_bsdata(writeDataID, vertexSize, vertexIDs, writeData) - - CALL Info('CouplerSolver','Printing write Data') - CALL Print(writeDataName,mesh ,BCPerm,CoordVals) - - CALL Info('CouplerSolver','Printing read Data') - CALL Print(readDataName,mesh ,BCPerm,CoordVals) - - !--------------------Advance time loop--------------------------------------- - CALL precicef_advance(dt) - - CALL precicef_action_read_iter_checkp(readItCheckp) - CALL precicef_is_action_required(readItCheckp, bool) - - IF (bool.EQ.1) THEN - - write(infoMessage,'(A,I2)') readItCheckp,bool - CALL Info('CouplerSolver',infoMessage) - CALL Info('CouplerSolver','Reading iteration checkpoint') - CALL precicef_mark_action_fulfilled(readItCheckp) - ENDIF - - - - CALL precicef_is_coupling_ongoing(ongoing) - - IF(ongoing.EQ.0) THEN - itask = 4 - ELSE - itask = 2 - END IF - - case(4) - !----------------------------------------Finailize-------------------------------------- - CALL Info('CouplerSolver','Precice Finalize') - CALL precicef_finalize() - - case(5) - ! CALL PrintDomain('temperature loads',mesh) - CALL Info('CouplerSolver','Printing Temperature') - readDataVariable => VariableGet( mesh % Variables, 'temperature ') - DO i = 1, 10 - - - write(infoMessage,'(A,I5,A,F10.4)') 'Node: ',vertecies(i),' Value: ', & - readDataVariable % Values(readDataVariable % Perm(vertecies(i))) - - CALL Info('CouplerSolver',infoMessage) - - END DO - - CALL Info('CouplerSolver','Printing temperature flux 2') - readDataVariable => VariableGet( mesh % Variables, 'temperature flux 2') - DO i = 1, 10 - - - write(infoMessage,'(A,I5,A,F10.4)') 'Node: ',vertecies(i),' Value: ', & - readDataVariable % Values(readDataVariable % Perm(vertecies(i))) - - CALL Info('CouplerSolver',infoMessage) - - END DO - end select - - - CALL Info('CouplerSolver',' Ended '//achar(27)//'[0m.') -END SUBROUTINE CouplerSolver - - - - - - - - diff --git a/Flow_Over_Heated_Plate/Fluid_Participant/Fluid_Participant_Mesh.geo b/Flow_Over_Heated_Plate/Fluid_Participant/Fluid_Participant_Mesh.geo deleted file mode 100644 index 6fc3401..0000000 --- a/Flow_Over_Heated_Plate/Fluid_Participant/Fluid_Participant_Mesh.geo +++ /dev/null @@ -1,54 +0,0 @@ -//+ -Point(1) = {0, 0, 0, 1.0}; -//+ -Point(2) = {1, 0, 0, 1.0}; -//+ -Point(3) = {1, 0.5, 0, 1.0}; -//+ -Point(4) = {0, 0.5, 0, 1.0}; -//+ -Point(5) = {-0.5, 0, 0, 1.0}; -//+ -Point(6) = {-0.5, 0.5, 0, 1.0}; -//+ -Point(7) = {3, 0, 0, 1.0}; -//+ -Point(8) = {3, 0.5, 0, 1.0}; -//+ -Line(1) = {5, 1}; -//+ -Line(2) = {1, 2}; -//+ -Line(3) = {2, 7}; -//+ -Line(4) = {7, 8}; -//+ -Line(5) = {8, 3}; -//+ -Line(6) = {3, 4}; -//+ -Line(7) = {4, 6}; -//+ -Line(8) = {6, 5}; -//+ -Line Loop(1) = {6, 7, 8, 1, 2, 3, 4, 5}; -//+ -Plane Surface(1) = {1}; -//+ -Physical Surface("fluid") = {1}; -//+ -Physical Line("Inlet") = {8}; -//+ -Physical Line("Outlet") = {4}; -//+ -Physical Line("Coupling_Interface") = {2}; -//+ -Physical Line("Pipe_Boundary") = {1, 7, 6, 5, 3}; -//+ -Transfinite Surface {1} = {5, 7, 8, 6}; -//+ -Transfinite Line {8, 4, 1, 7} = 5 Using Progression 1; -//+ -Transfinite Line {2, 6} = 10 Using Progression 1; -//+ -Transfinite Line {3, 5} = 20 Using Progression 1; diff --git a/Flow_Over_Heated_Plate/Fluid_Participant/Fluid_Participant_Mesh.msh b/Flow_Over_Heated_Plate/Fluid_Participant/Fluid_Participant_Mesh.msh deleted file mode 100644 index f05565a..0000000 --- a/Flow_Over_Heated_Plate/Fluid_Participant/Fluid_Participant_Mesh.msh +++ /dev/null @@ -1,510 +0,0 @@ -$MeshFormat -2.2 0 8 -$EndMeshFormat -$PhysicalNames -5 -1 2 "Inlet" -1 3 "Outlet" -1 4 "Coupling_Interface" -1 5 "Pipe_Boundary" -2 1 "fluid" -$EndPhysicalNames -$Nodes -165 -1 0 0 0 -2 1 0 0 -3 1 0.5 0 -4 0 0.5 0 -5 -0.5 0 0 -6 -0.5 0.5 0 -7 3 0 0 -8 3 0.5 0 -9 -0.3750000000001735 0 0 -10 -0.2500000000010297 0 0 -11 -0.1250000000005203 0 0 -12 0.1111111111109082 0 0 -13 0.2222222222217143 0 0 -14 0.333333333332501 0 0 -15 0.4444444444432878 0 0 -16 0.5555555555543833 0 0 -17 0.6666666666657874 0 0 -18 0.7777777777771916 0 0 -19 0.8888888888885959 0 0 -20 1.10526315789576 0 0 -21 1.210526315791519 0 0 -22 1.315789473686549 0 0 -23 1.421052631581139 0 0 -24 1.52631578947573 0 0 -25 1.631578947370321 0 0 -26 1.736842105264913 0 0 -27 1.842105263159504 0 0 -28 1.947368421054095 0 0 -29 2.052631578948686 0 0 -30 2.157894736843276 0 0 -31 2.263157894737867 0 0 -32 2.368421052632457 0 0 -33 2.473684210527048 0 0 -34 2.578947368421638 0 0 -35 2.684210526316229 0 0 -36 2.789473684210819 0 0 -37 2.894736842105409 0 0 -38 3 0.1249999999997055 0 -39 3 0.2499999999993461 0 -40 3 0.3749999999996703 0 -41 2.894736842105848 0.5 0 -42 2.789473684211695 0.5 0 -43 2.684210526317543 0.5 0 -44 2.578947368423391 0.5 0 -45 2.473684210529238 0.5 0 -46 2.368421052635086 0.5 0 -47 2.263157894740933 0.5 0 -48 2.157894736846782 0.5 0 -49 2.052631578952629 0.5 0 -50 1.947368421057892 0.5 0 -51 1.842105263162571 0.5 0 -52 1.73684210526725 0.5 0 -53 1.631578947371928 0.5 0 -54 1.526315789476607 0.5 0 -55 1.421052631581285 0.5 0 -56 1.315789473685964 0.5 0 -57 1.210526315790643 0.5 0 -58 1.105263157895321 0.5 0 -59 0.8888888888884262 0.5 0 -60 0.777777777777932 0.5 0 -61 0.6666666666675918 0.5 0 -62 0.5555555555572513 0.5 0 -63 0.4444444444462943 0.5 0 -64 0.3333333333347207 0.5 0 -65 0.2222222222231471 0.5 0 -66 0.1111111111115736 0.5 0 -67 -0.1249999999997055 0.5 0 -68 -0.2499999999993461 0.5 0 -69 -0.3749999999996703 0.5 0 -70 -0.5 0.3750000000001735 0 -71 -0.5 0.2500000000010297 0 -72 -0.5 0.1250000000005203 0 -73 -0.3750000000000477 0.1250000000004912 0 -74 -0.374999999999922 0.2500000000009696 0 -75 -0.3749999999997962 0.3750000000001556 0 -76 -0.2500000000006088 0.1250000000004621 0 -77 -0.2500000000001878 0.2500000000009095 0 -78 -0.249999999999767 0.3750000000001376 0 -79 -0.1250000000003166 0.1250000000004329 0 -80 -0.1250000000001129 0.2500000000008494 0 -81 -0.1249999999999091 0.3750000000001196 0 -82 1.387778780781446e-17 0.1250000000004039 0 -83 -2.775557561562891e-17 0.2500000000007891 0 -84 -5.551115123125783e-17 0.3750000000001016 0 -85 0.1111111111110745 0.125000000000378 0 -86 0.1111111111112408 0.2500000000007357 0 -87 0.1111111111114072 0.3750000000000857 0 -88 0.2222222222220724 0.1250000000003521 0 -89 0.2222222222224307 0.2500000000006822 0 -90 0.222222222222789 0.3750000000000697 0 -91 0.3333333333330559 0.1250000000003262 0 -92 0.3333333333336109 0.2500000000006288 0 -93 0.3333333333341657 0.3750000000000537 0 -94 0.4444444444440395 0.1250000000003004 0 -95 0.444444444444791 0.2500000000005754 0 -96 0.4444444444455427 0.3750000000000376 0 -97 0.5555555555551004 0.1250000000002745 0 -98 0.5555555555558174 0.2500000000005219 0 -99 0.5555555555565344 0.3750000000000217 0 -100 0.6666666666662385 0.1250000000002486 0 -101 0.6666666666666895 0.2500000000004685 0 -102 0.6666666666671407 0.3750000000000058 0 -103 0.7777777777773766 0.1250000000002228 0 -104 0.7777777777775616 0.250000000000415 0 -105 0.777777777777747 0.3749999999999897 0 -106 0.8888888888885534 0.1250000000001969 0 -107 0.888888888888511 0.2500000000003616 0 -108 0.8888888888884686 0.3749999999999739 0 -109 0.9999999999999998 0.1250000000001711 0 -110 1 0.2500000000003081 0 -111 1 0.3749999999999579 0 -112 1.10526315789565 0.1250000000001465 0 -113 1.105263157895541 0.2500000000002575 0 -114 1.105263157895431 0.3749999999999427 0 -115 1.2105263157913 0.125000000000122 0 -116 1.210526315791081 0.2500000000002068 0 -117 1.210526315790862 0.3749999999999275 0 -118 1.315789473686403 0.1250000000000976 0 -119 1.315789473686256 0.2500000000001562 0 -120 1.31578947368611 0.3749999999999125 0 -121 1.421052631581176 0.1250000000000731 0 -122 1.421052631581212 0.2500000000001056 0 -123 1.421052631581248 0.3749999999998974 0 -124 1.526315789475949 0.1250000000000486 0 -125 1.526315789476169 0.250000000000055 0 -126 1.526315789476388 0.3749999999998823 0 -127 1.631578947370723 0.125000000000024 0 -128 1.631578947371125 0.2500000000000043 0 -129 1.631578947371526 0.3749999999998672 0 -130 1.736842105265497 0.1249999999999996 0 -131 1.736842105266081 0.2499999999999537 0 -132 1.736842105266665 0.3749999999998518 0 -133 1.842105263160271 0.124999999999975 0 -134 1.842105263161038 0.2499999999999031 0 -135 1.842105263161804 0.3749999999998367 0 -136 1.947368421055044 0.1249999999999505 0 -137 1.947368421055994 0.2499999999998524 0 -138 1.947368421056943 0.3749999999998216 0 -139 2.052631578949672 0.124999999999926 0 -140 2.052631578950658 0.2499999999998018 0 -141 2.052631578951644 0.3749999999998065 0 -142 2.157894736844153 0.1249999999999015 0 -143 2.157894736845028 0.2499999999997511 0 -144 2.157894736845905 0.3749999999997915 0 -145 2.263157894738634 0.124999999999877 0 -146 2.2631578947394 0.2499999999997005 0 -147 2.263157894740167 0.3749999999997763 0 -148 2.368421052633114 0.1249999999998525 0 -149 2.368421052633771 0.2499999999996498 0 -150 2.368421052634429 0.3749999999997611 0 -151 2.473684210527594 0.124999999999828 0 -152 2.473684210528143 0.2499999999995992 0 -153 2.47368421052869 0.374999999999746 0 -154 2.578947368422076 0.1249999999998035 0 -155 2.578947368422514 0.2499999999995486 0 -156 2.578947368422952 0.3749999999997308 0 -157 2.684210526316558 0.124999999999779 0 -158 2.684210526316887 0.249999999999498 0 -159 2.684210526317215 0.3749999999997157 0 -160 2.789473684211039 0.1249999999997545 0 -161 2.789473684211257 0.2499999999994474 0 -162 2.789473684211476 0.3749999999997006 0 -163 2.894736842105519 0.12499999999973 0 -164 2.894736842105628 0.2499999999993967 0 -165 2.894736842105738 0.3749999999996855 0 -$EndNodes -$Elements -328 -1 1 2 5 1 5 9 -2 1 2 5 1 9 10 -3 1 2 5 1 10 11 -4 1 2 5 1 11 1 -5 1 2 4 2 1 12 -6 1 2 4 2 12 13 -7 1 2 4 2 13 14 -8 1 2 4 2 14 15 -9 1 2 4 2 15 16 -10 1 2 4 2 16 17 -11 1 2 4 2 17 18 -12 1 2 4 2 18 19 -13 1 2 4 2 19 2 -14 1 2 5 3 2 20 -15 1 2 5 3 20 21 -16 1 2 5 3 21 22 -17 1 2 5 3 22 23 -18 1 2 5 3 23 24 -19 1 2 5 3 24 25 -20 1 2 5 3 25 26 -21 1 2 5 3 26 27 -22 1 2 5 3 27 28 -23 1 2 5 3 28 29 -24 1 2 5 3 29 30 -25 1 2 5 3 30 31 -26 1 2 5 3 31 32 -27 1 2 5 3 32 33 -28 1 2 5 3 33 34 -29 1 2 5 3 34 35 -30 1 2 5 3 35 36 -31 1 2 5 3 36 37 -32 1 2 5 3 37 7 -33 1 2 3 4 7 38 -34 1 2 3 4 38 39 -35 1 2 3 4 39 40 -36 1 2 3 4 40 8 -37 1 2 5 5 8 41 -38 1 2 5 5 41 42 -39 1 2 5 5 42 43 -40 1 2 5 5 43 44 -41 1 2 5 5 44 45 -42 1 2 5 5 45 46 -43 1 2 5 5 46 47 -44 1 2 5 5 47 48 -45 1 2 5 5 48 49 -46 1 2 5 5 49 50 -47 1 2 5 5 50 51 -48 1 2 5 5 51 52 -49 1 2 5 5 52 53 -50 1 2 5 5 53 54 -51 1 2 5 5 54 55 -52 1 2 5 5 55 56 -53 1 2 5 5 56 57 -54 1 2 5 5 57 58 -55 1 2 5 5 58 3 -56 1 2 5 6 3 59 -57 1 2 5 6 59 60 -58 1 2 5 6 60 61 -59 1 2 5 6 61 62 -60 1 2 5 6 62 63 -61 1 2 5 6 63 64 -62 1 2 5 6 64 65 -63 1 2 5 6 65 66 -64 1 2 5 6 66 4 -65 1 2 5 7 4 67 -66 1 2 5 7 67 68 -67 1 2 5 7 68 69 -68 1 2 5 7 69 6 -69 1 2 2 8 6 70 -70 1 2 2 8 70 71 -71 1 2 2 8 71 72 -72 1 2 2 8 72 5 -73 2 2 1 1 5 9 72 -74 2 2 1 1 72 9 73 -75 2 2 1 1 72 73 71 -76 2 2 1 1 71 73 74 -77 2 2 1 1 71 74 70 -78 2 2 1 1 70 74 75 -79 2 2 1 1 70 75 6 -80 2 2 1 1 6 75 69 -81 2 2 1 1 9 10 73 -82 2 2 1 1 73 10 76 -83 2 2 1 1 73 76 74 -84 2 2 1 1 74 76 77 -85 2 2 1 1 74 77 75 -86 2 2 1 1 75 77 78 -87 2 2 1 1 75 78 69 -88 2 2 1 1 69 78 68 -89 2 2 1 1 10 11 76 -90 2 2 1 1 76 11 79 -91 2 2 1 1 76 79 77 -92 2 2 1 1 77 79 80 -93 2 2 1 1 77 80 78 -94 2 2 1 1 78 80 81 -95 2 2 1 1 78 81 68 -96 2 2 1 1 68 81 67 -97 2 2 1 1 11 1 79 -98 2 2 1 1 79 1 82 -99 2 2 1 1 79 82 80 -100 2 2 1 1 80 82 83 -101 2 2 1 1 80 83 81 -102 2 2 1 1 81 83 84 -103 2 2 1 1 81 84 67 -104 2 2 1 1 67 84 4 -105 2 2 1 1 1 12 82 -106 2 2 1 1 82 12 85 -107 2 2 1 1 82 85 83 -108 2 2 1 1 83 85 86 -109 2 2 1 1 83 86 84 -110 2 2 1 1 84 86 87 -111 2 2 1 1 84 87 4 -112 2 2 1 1 4 87 66 -113 2 2 1 1 12 13 85 -114 2 2 1 1 85 13 88 -115 2 2 1 1 85 88 86 -116 2 2 1 1 86 88 89 -117 2 2 1 1 86 89 87 -118 2 2 1 1 87 89 90 -119 2 2 1 1 87 90 66 -120 2 2 1 1 66 90 65 -121 2 2 1 1 13 14 88 -122 2 2 1 1 88 14 91 -123 2 2 1 1 88 91 89 -124 2 2 1 1 89 91 92 -125 2 2 1 1 89 92 90 -126 2 2 1 1 90 92 93 -127 2 2 1 1 90 93 65 -128 2 2 1 1 65 93 64 -129 2 2 1 1 14 15 91 -130 2 2 1 1 91 15 94 -131 2 2 1 1 91 94 92 -132 2 2 1 1 92 94 95 -133 2 2 1 1 92 95 93 -134 2 2 1 1 93 95 96 -135 2 2 1 1 93 96 64 -136 2 2 1 1 64 96 63 -137 2 2 1 1 15 16 94 -138 2 2 1 1 94 16 97 -139 2 2 1 1 94 97 95 -140 2 2 1 1 95 97 98 -141 2 2 1 1 95 98 96 -142 2 2 1 1 96 98 99 -143 2 2 1 1 96 99 63 -144 2 2 1 1 63 99 62 -145 2 2 1 1 16 17 97 -146 2 2 1 1 97 17 100 -147 2 2 1 1 97 100 98 -148 2 2 1 1 98 100 101 -149 2 2 1 1 98 101 99 -150 2 2 1 1 99 101 102 -151 2 2 1 1 99 102 62 -152 2 2 1 1 62 102 61 -153 2 2 1 1 17 18 100 -154 2 2 1 1 100 18 103 -155 2 2 1 1 100 103 101 -156 2 2 1 1 101 103 104 -157 2 2 1 1 101 104 102 -158 2 2 1 1 102 104 105 -159 2 2 1 1 102 105 61 -160 2 2 1 1 61 105 60 -161 2 2 1 1 18 19 103 -162 2 2 1 1 103 19 106 -163 2 2 1 1 103 106 104 -164 2 2 1 1 104 106 107 -165 2 2 1 1 104 107 105 -166 2 2 1 1 105 107 108 -167 2 2 1 1 105 108 60 -168 2 2 1 1 60 108 59 -169 2 2 1 1 19 2 106 -170 2 2 1 1 106 2 109 -171 2 2 1 1 106 109 107 -172 2 2 1 1 107 109 110 -173 2 2 1 1 107 110 108 -174 2 2 1 1 108 110 111 -175 2 2 1 1 108 111 59 -176 2 2 1 1 59 111 3 -177 2 2 1 1 2 20 109 -178 2 2 1 1 109 20 112 -179 2 2 1 1 109 112 110 -180 2 2 1 1 110 112 113 -181 2 2 1 1 110 113 111 -182 2 2 1 1 111 113 114 -183 2 2 1 1 111 114 3 -184 2 2 1 1 3 114 58 -185 2 2 1 1 20 21 112 -186 2 2 1 1 112 21 115 -187 2 2 1 1 112 115 113 -188 2 2 1 1 113 115 116 -189 2 2 1 1 113 116 114 -190 2 2 1 1 114 116 117 -191 2 2 1 1 114 117 58 -192 2 2 1 1 58 117 57 -193 2 2 1 1 21 22 115 -194 2 2 1 1 115 22 118 -195 2 2 1 1 115 118 116 -196 2 2 1 1 116 118 119 -197 2 2 1 1 116 119 117 -198 2 2 1 1 117 119 120 -199 2 2 1 1 117 120 57 -200 2 2 1 1 57 120 56 -201 2 2 1 1 22 23 118 -202 2 2 1 1 118 23 121 -203 2 2 1 1 118 121 119 -204 2 2 1 1 119 121 122 -205 2 2 1 1 119 122 120 -206 2 2 1 1 120 122 123 -207 2 2 1 1 120 123 56 -208 2 2 1 1 56 123 55 -209 2 2 1 1 23 24 121 -210 2 2 1 1 121 24 124 -211 2 2 1 1 121 124 122 -212 2 2 1 1 122 124 125 -213 2 2 1 1 122 125 123 -214 2 2 1 1 123 125 126 -215 2 2 1 1 123 126 55 -216 2 2 1 1 55 126 54 -217 2 2 1 1 24 25 124 -218 2 2 1 1 124 25 127 -219 2 2 1 1 124 127 125 -220 2 2 1 1 125 127 128 -221 2 2 1 1 125 128 126 -222 2 2 1 1 126 128 129 -223 2 2 1 1 126 129 54 -224 2 2 1 1 54 129 53 -225 2 2 1 1 25 26 127 -226 2 2 1 1 127 26 130 -227 2 2 1 1 127 130 128 -228 2 2 1 1 128 130 131 -229 2 2 1 1 128 131 129 -230 2 2 1 1 129 131 132 -231 2 2 1 1 129 132 53 -232 2 2 1 1 53 132 52 -233 2 2 1 1 26 27 130 -234 2 2 1 1 130 27 133 -235 2 2 1 1 130 133 131 -236 2 2 1 1 131 133 134 -237 2 2 1 1 131 134 132 -238 2 2 1 1 132 134 135 -239 2 2 1 1 132 135 52 -240 2 2 1 1 52 135 51 -241 2 2 1 1 27 28 133 -242 2 2 1 1 133 28 136 -243 2 2 1 1 133 136 134 -244 2 2 1 1 134 136 137 -245 2 2 1 1 134 137 135 -246 2 2 1 1 135 137 138 -247 2 2 1 1 135 138 51 -248 2 2 1 1 51 138 50 -249 2 2 1 1 28 29 136 -250 2 2 1 1 136 29 139 -251 2 2 1 1 136 139 137 -252 2 2 1 1 137 139 140 -253 2 2 1 1 137 140 138 -254 2 2 1 1 138 140 141 -255 2 2 1 1 138 141 50 -256 2 2 1 1 50 141 49 -257 2 2 1 1 29 30 139 -258 2 2 1 1 139 30 142 -259 2 2 1 1 139 142 140 -260 2 2 1 1 140 142 143 -261 2 2 1 1 140 143 141 -262 2 2 1 1 141 143 144 -263 2 2 1 1 141 144 49 -264 2 2 1 1 49 144 48 -265 2 2 1 1 30 31 142 -266 2 2 1 1 142 31 145 -267 2 2 1 1 142 145 143 -268 2 2 1 1 143 145 146 -269 2 2 1 1 143 146 144 -270 2 2 1 1 144 146 147 -271 2 2 1 1 144 147 48 -272 2 2 1 1 48 147 47 -273 2 2 1 1 31 32 145 -274 2 2 1 1 145 32 148 -275 2 2 1 1 145 148 146 -276 2 2 1 1 146 148 149 -277 2 2 1 1 146 149 147 -278 2 2 1 1 147 149 150 -279 2 2 1 1 147 150 47 -280 2 2 1 1 47 150 46 -281 2 2 1 1 32 33 148 -282 2 2 1 1 148 33 151 -283 2 2 1 1 148 151 149 -284 2 2 1 1 149 151 152 -285 2 2 1 1 149 152 150 -286 2 2 1 1 150 152 153 -287 2 2 1 1 150 153 46 -288 2 2 1 1 46 153 45 -289 2 2 1 1 33 34 151 -290 2 2 1 1 151 34 154 -291 2 2 1 1 151 154 152 -292 2 2 1 1 152 154 155 -293 2 2 1 1 152 155 153 -294 2 2 1 1 153 155 156 -295 2 2 1 1 153 156 45 -296 2 2 1 1 45 156 44 -297 2 2 1 1 34 35 154 -298 2 2 1 1 154 35 157 -299 2 2 1 1 154 157 155 -300 2 2 1 1 155 157 158 -301 2 2 1 1 155 158 156 -302 2 2 1 1 156 158 159 -303 2 2 1 1 156 159 44 -304 2 2 1 1 44 159 43 -305 2 2 1 1 35 36 157 -306 2 2 1 1 157 36 160 -307 2 2 1 1 157 160 158 -308 2 2 1 1 158 160 161 -309 2 2 1 1 158 161 159 -310 2 2 1 1 159 161 162 -311 2 2 1 1 159 162 43 -312 2 2 1 1 43 162 42 -313 2 2 1 1 36 37 160 -314 2 2 1 1 160 37 163 -315 2 2 1 1 160 163 161 -316 2 2 1 1 161 163 164 -317 2 2 1 1 161 164 162 -318 2 2 1 1 162 164 165 -319 2 2 1 1 162 165 42 -320 2 2 1 1 42 165 41 -321 2 2 1 1 37 7 163 -322 2 2 1 1 163 7 38 -323 2 2 1 1 163 38 164 -324 2 2 1 1 164 38 39 -325 2 2 1 1 164 39 165 -326 2 2 1 1 165 39 40 -327 2 2 1 1 165 40 41 -328 2 2 1 1 41 40 8 -$EndElements diff --git a/Flow_Over_Heated_Plate/Fluid_Participant/case.sif b/Flow_Over_Heated_Plate/Fluid_Participant/case.sif deleted file mode 100644 index 90f7c22..0000000 --- a/Flow_Over_Heated_Plate/Fluid_Participant/case.sif +++ /dev/null @@ -1,198 +0,0 @@ -Header - CHECK KEYWORDS Warn - Mesh DB "." "Fluid_Participant_Mesh" - Include Path "" - Results Directory "../out" -End - -Simulation - Max Output Level = 5 - Coordinate System = Cartesian - Coordinate Mapping(3) = 1 2 3 - Simulation Type = Transient - Steady State Max Iterations = 3 - Output Intervals = 1 - Timestepping Method = BDF - BDF Order = 2 - Timestep intervals = 10 - Timestep Sizes = 0.1 - Solver Input File = case.sif - Post File = Fluid.vtu - - maskName = String "Coupler Interface" - participantName = String "Fluid" - meshName = String "Fluid-Mesh" - configPath = String "../precice-config.xml" -End - -Constants - Gravity(4) = 0 -1 0 9.82 - Stefan Boltzmann = 5.67e-08 - Permittivity of Vacuum = 8.8542e-12 - Boltzmann Constant = 1.3807e-23 - Unit Charge = 1.602e-19 -End - -Body 1 - Target Bodies(1) = 1 - Name = "Body 1" - Equation = 1 - Material = 1 - Body Force = 1 - Initial Condition = 1 -End - -Solver 1 - Equation = Navier-Stokes - Procedure = "FlowSolve" "FlowSolver" - Variable = Flow Solution[Velocity:2 Pressure:1] - Exec Solver = Always - Stabilize = True - Bubbles = False - Lumped Mass Matrix = False - Optimize Bandwidth = True - Steady State Convergence Tolerance = 1.0e-5 - Nonlinear System Convergence Tolerance = 1.0e-7 - Nonlinear System Max Iterations = 5 - Nonlinear System Newton After Iterations = 3 - Nonlinear System Newton After Tolerance = 1.0e-3 - Nonlinear System Relaxation Factor = 1 - Linear System Solver = Iterative - Linear System Iterative Method = BiCGStab - Linear System Max Iterations = 500 - Linear System Convergence Tolerance = 1.0e-10 - BiCGstabl polynomial degree = 2 - Linear System Preconditioning = ILU0 - Linear System ILUT Tolerance = 1.0e-3 - Linear System Abort Not Converged = False - Linear System Residual Output = 10 - Linear System Precondition Recompute = 1 -End - -Solver 2 - Equation = Heat Equation - Procedure = "HeatSolve" "HeatSolver" - Variable = Temperature - Calculate Loads = Logical True - Exec Solver = Always - Stabilize = True - Bubbles = False - Lumped Mass Matrix = False - Optimize Bandwidth = True - Steady State Convergence Tolerance = 1.0e-5 - Nonlinear System Convergence Tolerance = 1.0e-7 - Nonlinear System Max Iterations = 20 - Nonlinear System Newton After Iterations = 3 - Nonlinear System Newton After Tolerance = 1.0e-3 - Nonlinear System Relaxation Factor = 1 - Linear System Solver = Iterative - Linear System Iterative Method = BiCGStab - Linear System Max Iterations = 500 - Linear System Convergence Tolerance = 1.0e-10 - BiCGstabl polynomial degree = 2 - Linear System Preconditioning = ILU0 - Linear System ILUT Tolerance = 1.0e-3 - Linear System Abort Not Converged = False - Linear System Residual Output = 10 - Linear System Precondition Recompute = 1 -End - -Solver 3 - Exec Solver = after timestep - Equation = "flux compute" - Procedure = "FluxSolver" "FluxSolver" - Calculate Flux = Logical True - Flux Variable = String Temperature - Flux Coefficient = String "Heat Conductivity" - Linear System Solver = "Iterative" - Linear System Iterative Method = "cg" - Linear System Preconditioning = ILU0 - Linear System Residual Output = 10 - Linear System Max Iterations = Integer 500 - Linear System Convergence Tolerance = 1.0e-10 -End - -Solver 4 - Equation = "Initialize" - Procedure = "../Coupler_Solver.so" "CouplerSolver" - readDataName = String "temperature flux 2" - writeDataName = String "Temperature" - Exec Solver = before all -End - -Solver 5 - Equation = "ReadData" - Procedure = "../Coupler_Solver.so" "CouplerSolver" - readDataName = String "temperature flux 2" - writeDataName = String "Temperature" - Exec Solver = before timestep -End - -Solver 6 - Equation = "WriteDataAdvance" - Procedure = "../Coupler_Solver.so" "CouplerSolver" - readDataName = String "temperature flux 2" - writeDataName = String "Temperature" - Exec Solver = after timestep -End - -Solver 7 - Equation = "Finalize" - Procedure = "../Coupler_Solver.so" "CouplerSolver" - readDataName = String "temperature flux 2" - writeDataName = String "Temperature" - Exec Solver = after all -End - -Equation 1 - Name = "Navier_Stokes_Heat" - Convection = Computed - Active Solvers(3) = 1 2 3 -End - -Material 1 - Name = "Fluid" - Heat Conductivity = 100 - Heat Capacity = 5000 - Viscosity = 0.0002 - Density = 0.2 -End - -Body Force 1 - Name = "buoyancy" - Boussinesq = True -End - -Initial Condition 1 - Name = "liquid_Initial_Condition" - Velocity 1 = 0.0 - Velocity 2 = 0.0 - Temperature = 300 -End - -Boundary Condition 1 - Target Boundaries(1) = 5 - Name = "Fluid_Walls" - Noslip wall BC = True -End - -Boundary Condition 2 - Target Boundaries(1) = 2 - Name = "Inlet" - Velocity 1 = 0.1 - Temperature = 300 -End - -Boundary Condition 3 - Target Boundaries(1) = 3 - Name = "Outlet" - Velocity 2 = 0.0 -End - -Boundary Condition 4 - Target Boundaries(1) = 4 - Name = "Coupling_boundary" - Noslip wall BC = True - Heat Flux = Equals "temperature flux 2" - Coupler Interface = Logical True -End \ No newline at end of file diff --git a/Flow_Over_Heated_Plate/Reference_Problem/Reference_Problem_Mesh.geo b/Flow_Over_Heated_Plate/Reference_Problem/Reference_Problem_Mesh.geo deleted file mode 100644 index 463d166..0000000 --- a/Flow_Over_Heated_Plate/Reference_Problem/Reference_Problem_Mesh.geo +++ /dev/null @@ -1,76 +0,0 @@ -//+ -Point(1) = {0, 0, 0, 1.0}; -//+ -Point(2) = {0, -0.25, 0, 1.0}; -//+ -Point(3) = {1, 0, 0, 1.0}; -//+ -Point(4) = {1, -0.25, 0, 1.0}; -//+ -Line(1) = {2, 4}; -//+ -Line(2) = {4, 3}; -//+ -Line(3) = {3, 1}; -//+ -Line(4) = {1, 2}; -//+ -Line Loop(1) = {3, 4, 1, 2}; -//+ -Plane Surface(1) = {1}; -//+ -Point(5) = {1, 0.5, 0, 1.0}; -//+ -Point(6) = {0, 0.5, 0, 1.0}; -//+ -Point(7) = {-0.5, 0.5, 0, 1.0}; -//+ -Point(8) = {-0.5, 0, 0, 1.0}; -//+ -Point(9) = {3, 0, 0, 1.0}; -//+ -Point(10) = {3, 0.5, 0, 1.0}; -//+ -Line(5) = {8, 1}; -//+ -Line(6) = {8, 7}; -//+ -Line(7) = {7, 6}; -//+ -Line(8) = {6, 5}; -//+ -Line(9) = {5, 10}; -//+ -Line(10) = {10, 9}; -//+ -Line(11) = {9, 3}; -//+ -Line Loop(2) = {8, 9, 10, 11, 3, -5, 6, 7}; -//+ -Plane Surface(2) = {2}; -//+ -Physical Surface("Plate") = {1}; -//+ -Physical Surface("Fluid") = {2}; -//+ -Physical Line("Plate_Bottom") = {1}; -//+ -Physical Line("Plate_Sides") = {2, 4}; -//+ -Physical Line("Coupling_Interface") = {3}; -//+ -Physical Line("Inlet") = {6}; -//+ -Physical Line("Outlet") = {10}; -//+ -Physical Line("Pipe_Boundary") = {5, 7, 8, 9, 11}; -//+ -Transfinite Surface {2} = {8, 9, 10, 7}; -//+ -Transfinite Surface {1} = {2, 4, 3, 1}; -//+ -Transfinite Line {6, 7, 5, 4, 2, 10} = 5 Using Progression 1; -//+ -Transfinite Line {1, 3, 8} = 10 Using Progression 1; -//+ -Transfinite Line {11, 9} = 20 Using Progression 1; diff --git a/Flow_Over_Heated_Plate/Reference_Problem/Reference_Problem_Mesh.msh b/Flow_Over_Heated_Plate/Reference_Problem/Reference_Problem_Mesh.msh deleted file mode 100644 index 2ce83f1..0000000 --- a/Flow_Over_Heated_Plate/Reference_Problem/Reference_Problem_Mesh.msh +++ /dev/null @@ -1,642 +0,0 @@ -$MeshFormat -2.2 0 8 -$EndMeshFormat -$PhysicalNames -8 -1 3 "Plate_Bottom" -1 4 "Plate_Sides" -1 5 "Coupling_Interface" -1 6 "Inlet" -1 7 "Outlet" -1 8 "Pipe_Boundary" -2 1 "Plate" -2 2 "Fluid" -$EndPhysicalNames -$Nodes -205 -1 0 0 0 -2 0 -0.25 0 -3 1 0 0 -4 1 -0.25 0 -5 1 0.5 0 -6 0 0.5 0 -7 -0.5 0.5 0 -8 -0.5 0 0 -9 3 0 0 -10 3 0.5 0 -11 0.1111111111109082 -0.25 0 -12 0.2222222222217143 -0.25 0 -13 0.333333333332501 -0.25 0 -14 0.4444444444432878 -0.25 0 -15 0.5555555555543833 -0.25 0 -16 0.6666666666657874 -0.25 0 -17 0.7777777777771916 -0.25 0 -18 0.8888888888885959 -0.25 0 -19 1 -0.1875000000000868 0 -20 1 -0.1250000000005149 0 -21 1 -0.06250000000026013 0 -22 0.8888888888884262 0 0 -23 0.777777777777932 0 0 -24 0.6666666666675918 0 0 -25 0.5555555555572513 0 0 -26 0.4444444444462943 0 0 -27 0.3333333333347207 0 0 -28 0.2222222222231471 0 0 -29 0.1111111111115736 0 0 -30 0 -0.06249999999985274 0 -31 0 -0.124999999999673 0 -32 0 -0.1874999999998352 0 -33 -0.3750000000001735 0 0 -34 -0.2500000000010297 0 0 -35 -0.1250000000005203 0 0 -36 -0.5 0.1249999999997055 0 -37 -0.5 0.2499999999993461 0 -38 -0.5 0.3749999999996703 0 -39 -0.3750000000001735 0.5 0 -40 -0.2500000000010297 0.5 0 -41 -0.1250000000005203 0.5 0 -42 0.1111111111109082 0.5 0 -43 0.2222222222217143 0.5 0 -44 0.333333333332501 0.5 0 -45 0.4444444444432878 0.5 0 -46 0.5555555555543833 0.5 0 -47 0.6666666666657874 0.5 0 -48 0.7777777777771916 0.5 0 -49 0.8888888888885959 0.5 0 -50 1.10526315789576 0.5 0 -51 1.210526315791519 0.5 0 -52 1.315789473686549 0.5 0 -53 1.421052631581139 0.5 0 -54 1.52631578947573 0.5 0 -55 1.631578947370321 0.5 0 -56 1.736842105264913 0.5 0 -57 1.842105263159504 0.5 0 -58 1.947368421054095 0.5 0 -59 2.052631578948686 0.5 0 -60 2.157894736843276 0.5 0 -61 2.263157894737867 0.5 0 -62 2.368421052632457 0.5 0 -63 2.473684210527048 0.5 0 -64 2.578947368421638 0.5 0 -65 2.684210526316229 0.5 0 -66 2.789473684210819 0.5 0 -67 2.894736842105409 0.5 0 -68 3 0.3750000000001735 0 -69 3 0.2500000000010297 0 -70 3 0.1250000000005203 0 -71 2.894736842105848 0 0 -72 2.789473684211695 0 0 -73 2.684210526317543 0 0 -74 2.578947368423391 0 0 -75 2.473684210529238 0 0 -76 2.368421052635086 0 0 -77 2.263157894740933 0 0 -78 2.157894736846782 0 0 -79 2.052631578952629 0 0 -80 1.947368421057892 0 0 -81 1.842105263162571 0 0 -82 1.73684210526725 0 0 -83 1.631578947371928 0 0 -84 1.526315789476607 0 0 -85 1.421052631581285 0 0 -86 1.315789473685964 0 0 -87 1.210526315790643 0 0 -88 1.105263157895321 0 0 -89 0.1111111111110746 -0.1874999999998631 0 -90 0.1111111111112409 -0.1249999999997666 0 -91 0.1111111111114072 -0.062499999999898 0 -92 0.2222222222220726 -0.1874999999998911 0 -93 0.2222222222224307 -0.1249999999998601 0 -94 0.2222222222227889 -0.06249999999994327 0 -95 0.333333333333056 -0.187499999999919 0 -96 0.3333333333336108 -0.1249999999999536 0 -97 0.3333333333341657 -0.06249999999998854 0 -98 0.4444444444440395 -0.187499999999947 0 -99 0.444444444444791 -0.1250000000000472 0 -100 0.4444444444455426 -0.06250000000003381 0 -101 0.5555555555551003 -0.187499999999975 0 -102 0.5555555555558173 -0.1250000000001407 0 -103 0.5555555555565342 -0.06250000000007905 0 -104 0.6666666666662384 -0.1875000000000029 0 -105 0.6666666666666896 -0.1250000000002343 0 -106 0.6666666666671406 -0.06250000000012434 0 -107 0.7777777777773768 -0.1875000000000309 0 -108 0.7777777777775617 -0.1250000000003278 0 -109 0.777777777777747 -0.06250000000016959 0 -110 0.8888888888885533 -0.1875000000000588 0 -111 0.888888888888511 -0.1250000000004213 0 -112 0.8888888888884686 -0.06250000000021486 0 -113 -0.3750000000001734 0.1249999999997345 -0 -114 -0.3750000000001736 0.2499999999994061 -0 -115 -0.3750000000001735 0.3749999999996884 -0 -116 -0.2500000000010297 0.1249999999997637 -0 -117 -0.2500000000010297 0.2499999999994663 -0 -118 -0.2500000000010297 0.3749999999997062 -0 -119 -0.1250000000005203 0.1249999999997928 -0 -120 -0.1250000000005203 0.2499999999995265 -0 -121 -0.1250000000005202 0.3749999999997243 -0 -122 1.387778780781446e-17 0.1249999999998219 0 -123 0 0.2499999999995867 0 -124 -5.551115123125783e-17 0.3749999999997422 -0 -125 0.1111111111114072 0.1249999999998477 0 -126 0.1111111111112409 0.24999999999964 0 -127 0.1111111111110746 0.3749999999997582 0 -128 0.2222222222227888 0.1249999999998736 0 -129 0.2222222222224306 0.2499999999996935 0 -130 0.2222222222220725 0.3749999999997741 0 -131 0.3333333333341658 0.1249999999998995 0 -132 0.3333333333336108 0.249999999999747 0 -133 0.333333333333056 0.3749999999997902 0 -134 0.4444444444455427 0.1249999999999253 0 -135 0.444444444444791 0.2499999999998004 0 -136 0.4444444444440394 0.374999999999806 0 -137 0.5555555555565344 0.1249999999999512 0 -138 0.5555555555558174 0.2499999999998538 0 -139 0.5555555555551002 0.374999999999822 0 -140 0.6666666666671409 0.124999999999977 0 -141 0.6666666666666895 0.2499999999999073 0 -142 0.6666666666662385 0.374999999999838 0 -143 0.7777777777777468 0.1250000000000029 0 -144 0.7777777777775616 0.2499999999999608 0 -145 0.7777777777773769 0.374999999999854 0 -146 0.8888888888884686 0.1250000000000288 0 -147 0.888888888888511 0.2500000000000141 0 -148 0.8888888888885533 0.37499999999987 0 -149 1 0.1250000000000547 0 -150 0.9999999999999998 0.2500000000000676 0 -151 0.9999999999999998 0.374999999999886 0 -152 1.105263157895431 0.1250000000000792 0 -153 1.10526315789554 0.2500000000001182 0 -154 1.10526315789565 0.3749999999999011 0 -155 1.210526315790862 0.1250000000001037 0 -156 1.210526315791081 0.2500000000001689 0 -157 1.210526315791301 0.3749999999999163 0 -158 1.31578947368611 0.1250000000001282 0 -159 1.315789473686256 0.2500000000002195 0 -160 1.315789473686403 0.3749999999999314 0 -161 1.421052631581249 0.1250000000001527 0 -162 1.421052631581212 0.2500000000002701 0 -163 1.421052631581176 0.3749999999999465 0 -164 1.526315789476388 0.1250000000001772 0 -165 1.526315789476169 0.2500000000003207 0 -166 1.526315789475949 0.3749999999999617 0 -167 1.631578947371527 0.1250000000002017 0 -168 1.631578947371125 0.2500000000003715 0 -169 1.631578947370723 0.3749999999999768 0 -170 1.736842105266665 0.1250000000002262 0 -171 1.736842105266081 0.2500000000004221 0 -172 1.736842105265497 0.3749999999999919 0 -173 1.842105263161804 0.1250000000002507 0 -174 1.842105263161038 0.2500000000004727 0 -175 1.84210526316027 0.3750000000000071 0 -176 1.947368421056943 0.1250000000002752 0 -177 1.947368421055994 0.2500000000005234 0 -178 1.947368421055044 0.3750000000000222 0 -179 2.052631578951643 0.1250000000002997 0 -180 2.052631578950657 0.250000000000574 0 -181 2.052631578949672 0.3750000000000373 0 -182 2.157894736845905 0.1250000000003242 0 -183 2.15789473684503 0.2500000000006247 0 -184 2.157894736844153 0.3750000000000524 0 -185 2.263157894740166 0.1250000000003487 0 -186 2.2631578947394 0.2500000000006752 0 -187 2.263157894738633 0.3750000000000676 0 -188 2.368421052634428 0.1250000000003733 0 -189 2.368421052633772 0.250000000000726 0 -190 2.368421052633114 0.3750000000000827 0 -191 2.47368421052869 0.1250000000003977 0 -192 2.473684210528143 0.2500000000007766 0 -193 2.473684210527595 0.3750000000000978 0 -194 2.578947368422952 0.1250000000004222 0 -195 2.578947368422515 0.2500000000008272 0 -196 2.578947368422076 0.375000000000113 0 -197 2.684210526317214 0.1250000000004468 0 -198 2.684210526316887 0.2500000000008779 0 -199 2.684210526316558 0.3750000000001281 0 -200 2.789473684211477 0.1250000000004712 0 -201 2.789473684211257 0.2500000000009285 0 -202 2.789473684211038 0.3750000000001433 0 -203 2.894736842105738 0.1250000000004957 0 -204 2.894736842105628 0.2500000000009791 0 -205 2.89473684210552 0.3750000000001584 0 -$EndNodes -$Elements -417 -1 1 2 3 1 2 11 -2 1 2 3 1 11 12 -3 1 2 3 1 12 13 -4 1 2 3 1 13 14 -5 1 2 3 1 14 15 -6 1 2 3 1 15 16 -7 1 2 3 1 16 17 -8 1 2 3 1 17 18 -9 1 2 3 1 18 4 -10 1 2 4 2 4 19 -11 1 2 4 2 19 20 -12 1 2 4 2 20 21 -13 1 2 4 2 21 3 -14 1 2 5 3 3 22 -15 1 2 5 3 22 23 -16 1 2 5 3 23 24 -17 1 2 5 3 24 25 -18 1 2 5 3 25 26 -19 1 2 5 3 26 27 -20 1 2 5 3 27 28 -21 1 2 5 3 28 29 -22 1 2 5 3 29 1 -23 1 2 4 4 1 30 -24 1 2 4 4 30 31 -25 1 2 4 4 31 32 -26 1 2 4 4 32 2 -27 1 2 8 5 8 33 -28 1 2 8 5 33 34 -29 1 2 8 5 34 35 -30 1 2 8 5 35 1 -31 1 2 6 6 8 36 -32 1 2 6 6 36 37 -33 1 2 6 6 37 38 -34 1 2 6 6 38 7 -35 1 2 8 7 7 39 -36 1 2 8 7 39 40 -37 1 2 8 7 40 41 -38 1 2 8 7 41 6 -39 1 2 8 8 6 42 -40 1 2 8 8 42 43 -41 1 2 8 8 43 44 -42 1 2 8 8 44 45 -43 1 2 8 8 45 46 -44 1 2 8 8 46 47 -45 1 2 8 8 47 48 -46 1 2 8 8 48 49 -47 1 2 8 8 49 5 -48 1 2 8 9 5 50 -49 1 2 8 9 50 51 -50 1 2 8 9 51 52 -51 1 2 8 9 52 53 -52 1 2 8 9 53 54 -53 1 2 8 9 54 55 -54 1 2 8 9 55 56 -55 1 2 8 9 56 57 -56 1 2 8 9 57 58 -57 1 2 8 9 58 59 -58 1 2 8 9 59 60 -59 1 2 8 9 60 61 -60 1 2 8 9 61 62 -61 1 2 8 9 62 63 -62 1 2 8 9 63 64 -63 1 2 8 9 64 65 -64 1 2 8 9 65 66 -65 1 2 8 9 66 67 -66 1 2 8 9 67 10 -67 1 2 7 10 10 68 -68 1 2 7 10 68 69 -69 1 2 7 10 69 70 -70 1 2 7 10 70 9 -71 1 2 8 11 9 71 -72 1 2 8 11 71 72 -73 1 2 8 11 72 73 -74 1 2 8 11 73 74 -75 1 2 8 11 74 75 -76 1 2 8 11 75 76 -77 1 2 8 11 76 77 -78 1 2 8 11 77 78 -79 1 2 8 11 78 79 -80 1 2 8 11 79 80 -81 1 2 8 11 80 81 -82 1 2 8 11 81 82 -83 1 2 8 11 82 83 -84 1 2 8 11 83 84 -85 1 2 8 11 84 85 -86 1 2 8 11 85 86 -87 1 2 8 11 86 87 -88 1 2 8 11 87 88 -89 1 2 8 11 88 3 -90 2 2 1 1 2 11 32 -91 2 2 1 1 32 11 89 -92 2 2 1 1 32 89 31 -93 2 2 1 1 31 89 90 -94 2 2 1 1 31 90 30 -95 2 2 1 1 30 90 91 -96 2 2 1 1 30 91 1 -97 2 2 1 1 1 91 29 -98 2 2 1 1 11 12 89 -99 2 2 1 1 89 12 92 -100 2 2 1 1 89 92 90 -101 2 2 1 1 90 92 93 -102 2 2 1 1 90 93 91 -103 2 2 1 1 91 93 94 -104 2 2 1 1 91 94 29 -105 2 2 1 1 29 94 28 -106 2 2 1 1 12 13 92 -107 2 2 1 1 92 13 95 -108 2 2 1 1 92 95 93 -109 2 2 1 1 93 95 96 -110 2 2 1 1 93 96 94 -111 2 2 1 1 94 96 97 -112 2 2 1 1 94 97 28 -113 2 2 1 1 28 97 27 -114 2 2 1 1 13 14 95 -115 2 2 1 1 95 14 98 -116 2 2 1 1 95 98 96 -117 2 2 1 1 96 98 99 -118 2 2 1 1 96 99 97 -119 2 2 1 1 97 99 100 -120 2 2 1 1 97 100 27 -121 2 2 1 1 27 100 26 -122 2 2 1 1 14 15 98 -123 2 2 1 1 98 15 101 -124 2 2 1 1 98 101 99 -125 2 2 1 1 99 101 102 -126 2 2 1 1 99 102 100 -127 2 2 1 1 100 102 103 -128 2 2 1 1 100 103 26 -129 2 2 1 1 26 103 25 -130 2 2 1 1 15 16 101 -131 2 2 1 1 101 16 104 -132 2 2 1 1 101 104 102 -133 2 2 1 1 102 104 105 -134 2 2 1 1 102 105 103 -135 2 2 1 1 103 105 106 -136 2 2 1 1 103 106 25 -137 2 2 1 1 25 106 24 -138 2 2 1 1 16 17 104 -139 2 2 1 1 104 17 107 -140 2 2 1 1 104 107 105 -141 2 2 1 1 105 107 108 -142 2 2 1 1 105 108 106 -143 2 2 1 1 106 108 109 -144 2 2 1 1 106 109 24 -145 2 2 1 1 24 109 23 -146 2 2 1 1 17 18 107 -147 2 2 1 1 107 18 110 -148 2 2 1 1 107 110 108 -149 2 2 1 1 108 110 111 -150 2 2 1 1 108 111 109 -151 2 2 1 1 109 111 112 -152 2 2 1 1 109 112 23 -153 2 2 1 1 23 112 22 -154 2 2 1 1 18 4 110 -155 2 2 1 1 110 4 19 -156 2 2 1 1 110 19 111 -157 2 2 1 1 111 19 20 -158 2 2 1 1 111 20 112 -159 2 2 1 1 112 20 21 -160 2 2 1 1 112 21 22 -161 2 2 1 1 22 21 3 -162 2 2 2 2 8 36 33 -163 2 2 2 2 36 113 33 -164 2 2 2 2 36 37 113 -165 2 2 2 2 37 114 113 -166 2 2 2 2 37 38 114 -167 2 2 2 2 38 115 114 -168 2 2 2 2 38 7 115 -169 2 2 2 2 7 39 115 -170 2 2 2 2 33 113 34 -171 2 2 2 2 113 116 34 -172 2 2 2 2 113 114 116 -173 2 2 2 2 114 117 116 -174 2 2 2 2 114 115 117 -175 2 2 2 2 115 118 117 -176 2 2 2 2 115 39 118 -177 2 2 2 2 39 40 118 -178 2 2 2 2 34 116 35 -179 2 2 2 2 116 119 35 -180 2 2 2 2 116 117 119 -181 2 2 2 2 117 120 119 -182 2 2 2 2 117 118 120 -183 2 2 2 2 118 121 120 -184 2 2 2 2 118 40 121 -185 2 2 2 2 40 41 121 -186 2 2 2 2 35 119 1 -187 2 2 2 2 119 122 1 -188 2 2 2 2 119 120 122 -189 2 2 2 2 120 123 122 -190 2 2 2 2 120 121 123 -191 2 2 2 2 121 124 123 -192 2 2 2 2 121 41 124 -193 2 2 2 2 41 6 124 -194 2 2 2 2 1 122 29 -195 2 2 2 2 122 125 29 -196 2 2 2 2 122 123 125 -197 2 2 2 2 123 126 125 -198 2 2 2 2 123 124 126 -199 2 2 2 2 124 127 126 -200 2 2 2 2 124 6 127 -201 2 2 2 2 6 42 127 -202 2 2 2 2 29 125 28 -203 2 2 2 2 125 128 28 -204 2 2 2 2 125 126 128 -205 2 2 2 2 126 129 128 -206 2 2 2 2 126 127 129 -207 2 2 2 2 127 130 129 -208 2 2 2 2 127 42 130 -209 2 2 2 2 42 43 130 -210 2 2 2 2 28 128 27 -211 2 2 2 2 128 131 27 -212 2 2 2 2 128 129 131 -213 2 2 2 2 129 132 131 -214 2 2 2 2 129 130 132 -215 2 2 2 2 130 133 132 -216 2 2 2 2 130 43 133 -217 2 2 2 2 43 44 133 -218 2 2 2 2 27 131 26 -219 2 2 2 2 131 134 26 -220 2 2 2 2 131 132 134 -221 2 2 2 2 132 135 134 -222 2 2 2 2 132 133 135 -223 2 2 2 2 133 136 135 -224 2 2 2 2 133 44 136 -225 2 2 2 2 44 45 136 -226 2 2 2 2 26 134 25 -227 2 2 2 2 134 137 25 -228 2 2 2 2 134 135 137 -229 2 2 2 2 135 138 137 -230 2 2 2 2 135 136 138 -231 2 2 2 2 136 139 138 -232 2 2 2 2 136 45 139 -233 2 2 2 2 45 46 139 -234 2 2 2 2 25 137 24 -235 2 2 2 2 137 140 24 -236 2 2 2 2 137 138 140 -237 2 2 2 2 138 141 140 -238 2 2 2 2 138 139 141 -239 2 2 2 2 139 142 141 -240 2 2 2 2 139 46 142 -241 2 2 2 2 46 47 142 -242 2 2 2 2 24 140 23 -243 2 2 2 2 140 143 23 -244 2 2 2 2 140 141 143 -245 2 2 2 2 141 144 143 -246 2 2 2 2 141 142 144 -247 2 2 2 2 142 145 144 -248 2 2 2 2 142 47 145 -249 2 2 2 2 47 48 145 -250 2 2 2 2 23 143 22 -251 2 2 2 2 143 146 22 -252 2 2 2 2 143 144 146 -253 2 2 2 2 144 147 146 -254 2 2 2 2 144 145 147 -255 2 2 2 2 145 148 147 -256 2 2 2 2 145 48 148 -257 2 2 2 2 48 49 148 -258 2 2 2 2 22 146 3 -259 2 2 2 2 146 149 3 -260 2 2 2 2 146 147 149 -261 2 2 2 2 147 150 149 -262 2 2 2 2 147 148 150 -263 2 2 2 2 148 151 150 -264 2 2 2 2 148 49 151 -265 2 2 2 2 49 5 151 -266 2 2 2 2 3 149 88 -267 2 2 2 2 149 152 88 -268 2 2 2 2 149 150 152 -269 2 2 2 2 150 153 152 -270 2 2 2 2 150 151 153 -271 2 2 2 2 151 154 153 -272 2 2 2 2 151 5 154 -273 2 2 2 2 5 50 154 -274 2 2 2 2 88 152 87 -275 2 2 2 2 152 155 87 -276 2 2 2 2 152 153 155 -277 2 2 2 2 153 156 155 -278 2 2 2 2 153 154 156 -279 2 2 2 2 154 157 156 -280 2 2 2 2 154 50 157 -281 2 2 2 2 50 51 157 -282 2 2 2 2 87 155 86 -283 2 2 2 2 155 158 86 -284 2 2 2 2 155 156 158 -285 2 2 2 2 156 159 158 -286 2 2 2 2 156 157 159 -287 2 2 2 2 157 160 159 -288 2 2 2 2 157 51 160 -289 2 2 2 2 51 52 160 -290 2 2 2 2 86 158 85 -291 2 2 2 2 158 161 85 -292 2 2 2 2 158 159 161 -293 2 2 2 2 159 162 161 -294 2 2 2 2 159 160 162 -295 2 2 2 2 160 163 162 -296 2 2 2 2 160 52 163 -297 2 2 2 2 52 53 163 -298 2 2 2 2 85 161 84 -299 2 2 2 2 161 164 84 -300 2 2 2 2 161 162 164 -301 2 2 2 2 162 165 164 -302 2 2 2 2 162 163 165 -303 2 2 2 2 163 166 165 -304 2 2 2 2 163 53 166 -305 2 2 2 2 53 54 166 -306 2 2 2 2 84 164 83 -307 2 2 2 2 164 167 83 -308 2 2 2 2 164 165 167 -309 2 2 2 2 165 168 167 -310 2 2 2 2 165 166 168 -311 2 2 2 2 166 169 168 -312 2 2 2 2 166 54 169 -313 2 2 2 2 54 55 169 -314 2 2 2 2 83 167 82 -315 2 2 2 2 167 170 82 -316 2 2 2 2 167 168 170 -317 2 2 2 2 168 171 170 -318 2 2 2 2 168 169 171 -319 2 2 2 2 169 172 171 -320 2 2 2 2 169 55 172 -321 2 2 2 2 55 56 172 -322 2 2 2 2 82 170 81 -323 2 2 2 2 170 173 81 -324 2 2 2 2 170 171 173 -325 2 2 2 2 171 174 173 -326 2 2 2 2 171 172 174 -327 2 2 2 2 172 175 174 -328 2 2 2 2 172 56 175 -329 2 2 2 2 56 57 175 -330 2 2 2 2 81 173 80 -331 2 2 2 2 173 176 80 -332 2 2 2 2 173 174 176 -333 2 2 2 2 174 177 176 -334 2 2 2 2 174 175 177 -335 2 2 2 2 175 178 177 -336 2 2 2 2 175 57 178 -337 2 2 2 2 57 58 178 -338 2 2 2 2 80 176 79 -339 2 2 2 2 176 179 79 -340 2 2 2 2 176 177 179 -341 2 2 2 2 177 180 179 -342 2 2 2 2 177 178 180 -343 2 2 2 2 178 181 180 -344 2 2 2 2 178 58 181 -345 2 2 2 2 58 59 181 -346 2 2 2 2 79 179 78 -347 2 2 2 2 179 182 78 -348 2 2 2 2 179 180 182 -349 2 2 2 2 180 183 182 -350 2 2 2 2 180 181 183 -351 2 2 2 2 181 184 183 -352 2 2 2 2 181 59 184 -353 2 2 2 2 59 60 184 -354 2 2 2 2 78 182 77 -355 2 2 2 2 182 185 77 -356 2 2 2 2 182 183 185 -357 2 2 2 2 183 186 185 -358 2 2 2 2 183 184 186 -359 2 2 2 2 184 187 186 -360 2 2 2 2 184 60 187 -361 2 2 2 2 60 61 187 -362 2 2 2 2 77 185 76 -363 2 2 2 2 185 188 76 -364 2 2 2 2 185 186 188 -365 2 2 2 2 186 189 188 -366 2 2 2 2 186 187 189 -367 2 2 2 2 187 190 189 -368 2 2 2 2 187 61 190 -369 2 2 2 2 61 62 190 -370 2 2 2 2 76 188 75 -371 2 2 2 2 188 191 75 -372 2 2 2 2 188 189 191 -373 2 2 2 2 189 192 191 -374 2 2 2 2 189 190 192 -375 2 2 2 2 190 193 192 -376 2 2 2 2 190 62 193 -377 2 2 2 2 62 63 193 -378 2 2 2 2 75 191 74 -379 2 2 2 2 191 194 74 -380 2 2 2 2 191 192 194 -381 2 2 2 2 192 195 194 -382 2 2 2 2 192 193 195 -383 2 2 2 2 193 196 195 -384 2 2 2 2 193 63 196 -385 2 2 2 2 63 64 196 -386 2 2 2 2 74 194 73 -387 2 2 2 2 194 197 73 -388 2 2 2 2 194 195 197 -389 2 2 2 2 195 198 197 -390 2 2 2 2 195 196 198 -391 2 2 2 2 196 199 198 -392 2 2 2 2 196 64 199 -393 2 2 2 2 64 65 199 -394 2 2 2 2 73 197 72 -395 2 2 2 2 197 200 72 -396 2 2 2 2 197 198 200 -397 2 2 2 2 198 201 200 -398 2 2 2 2 198 199 201 -399 2 2 2 2 199 202 201 -400 2 2 2 2 199 65 202 -401 2 2 2 2 65 66 202 -402 2 2 2 2 72 200 71 -403 2 2 2 2 200 203 71 -404 2 2 2 2 200 201 203 -405 2 2 2 2 201 204 203 -406 2 2 2 2 201 202 204 -407 2 2 2 2 202 205 204 -408 2 2 2 2 202 66 205 -409 2 2 2 2 66 67 205 -410 2 2 2 2 71 203 9 -411 2 2 2 2 203 70 9 -412 2 2 2 2 203 204 70 -413 2 2 2 2 204 69 70 -414 2 2 2 2 204 205 69 -415 2 2 2 2 205 68 69 -416 2 2 2 2 205 67 68 -417 2 2 2 2 67 10 68 -$EndElements diff --git a/Flow_Over_Heated_Plate/Reference_Problem/case.sif b/Flow_Over_Heated_Plate/Reference_Problem/case.sif deleted file mode 100644 index 239bf71..0000000 --- a/Flow_Over_Heated_Plate/Reference_Problem/case.sif +++ /dev/null @@ -1,212 +0,0 @@ -Header - CHECK KEYWORDS Warn - Mesh DB "." "Reference_Problem_Mesh" - Include Path "" - Results Directory "../out" -End - -Simulation - Max Output Level = 5 - Coordinate System = Cartesian - Coordinate Mapping(3) = 1 2 3 - Simulation Type = Transient - Steady State Max Iterations = 10 - Output Intervals = 1 - Timestepping Method = BDF - BDF Order = 2 - Timestep intervals = 10 - Timestep Sizes = 0.1 - Solver Input File = case.sif - Post File = Reference.vtu -End - -Constants - Gravity(4) = 0 -1 0 9.82 - Stefan Boltzmann = 5.67e-08 - Permittivity of Vacuum = 8.8542e-12 - Boltzmann Constant = 1.3807e-23 - Unit Charge = 1.602e-19 -End - -Body 1 - Target Bodies(1) = 2 - Name = "Fluid" - Equation = 1 - Material = 1 - Initial Condition = 1 -End - -Body 2 - Target Bodies(1) = 1 - Name = "Solid" - Equation = 2 - Material = 2 - Initial Condition = 1 -End - -Solver 1 - Equation = Navier-Stokes - Procedure = "FlowSolve" "FlowSolver" - Variable = Flow Solution[Velocity:2 Pressure:1] - Exec Solver = Always - Stabilize = True - Bubbles = False - Lumped Mass Matrix = False - Optimize Bandwidth = True - Steady State Convergence Tolerance = 1.0e-5 - Nonlinear System Convergence Tolerance = 1.0e-7 - Nonlinear System Max Iterations = 5 - Nonlinear System Newton After Iterations = 3 - Nonlinear System Newton After Tolerance = 1.0e-3 - Nonlinear System Relaxation Factor = 1 - Linear System Solver = Iterative - Linear System Iterative Method = BiCGStab - Linear System Max Iterations = 500 - Linear System Convergence Tolerance = 1.0e-10 - BiCGstabl polynomial degree = 2 - Linear System Preconditioning = ILU0 - Linear System ILUT Tolerance = 1.0e-3 - Linear System Abort Not Converged = False - Linear System Residual Output = 10 - Linear System Precondition Recompute = 1 -End - -Solver 2 - Equation = Heat Equation - Procedure = "HeatSolve" "HeatSolver" - Variable = Temperature - Calculate Loads = Logical True - Exec Solver = Always - Stabilize = True - Bubbles = False - Lumped Mass Matrix = False - Optimize Bandwidth = True - Steady State Convergence Tolerance = 1.0e-5 - Nonlinear System Convergence Tolerance = 1.0e-7 - Nonlinear System Max Iterations = 20 - Nonlinear System Newton After Iterations = 3 - Nonlinear System Newton After Tolerance = 1.0e-3 - Nonlinear System Relaxation Factor = 1 - Linear System Solver = Iterative - Linear System Iterative Method = BiCGStab - Linear System Max Iterations = 500 - Linear System Convergence Tolerance = 1.0e-10 - BiCGstabl polynomial degree = 2 - Linear System Preconditioning = ILU0 - Linear System ILUT Tolerance = 1.0e-3 - Linear System Abort Not Converged = False - Linear System Residual Output = 10 - Linear System Precondition Recompute = 1 -End - -Solver 3 - Exec Solver = after timestep - Equation = "flux compute" - Procedure = "FluxSolver" "FluxSolver" - Calculate Flux = Logical True - Flux Variable = String Temperature - Flux Coefficient = String "Heat Conductivity" - Linear System Solver = "Iterative" - Linear System Iterative Method = "cg" - Linear System Preconditioning = ILU0 - Linear System Residual Output = 10 - Linear System Max Iterations = Integer 500 - Linear System Convergence Tolerance = 1.0e-10 -End - -Solver 4 - Equation = "ReadData" - Procedure = "../Coupler_Solver.so" "CouplerSolver" - readDataName = String "Temperature" - writeDataName = String "temperature flux 2" - Exec Solver = before timestep -End - -Solver 5 - Equation = "WriteDataAdvance" - Procedure = "../Coupler_Solver.so" "CouplerSolver" - readDataName = String "Temperature" - writeDataName = String "temperature flux 2" - Exec Solver = after timestep -End - -Equation 1 - Name = "Navier_Stokes_Heat" - Convection = Computed - Active Solvers(3) = 1 2 3 -End - -Equation 2 - Name = "Heat" - Active Solvers(2) = 2 3 -End - -Material 1 - Name = "Fluid" - Heat Conductivity = 100 - Heat Capacity = 5000 - Viscosity = 0.0002 - Density = 0.2 -End - -Material 2 - Name = "Solid" - Heat Conductivity = 100 - Heat Capacity = 1 - Density = 0.2 -End - -Body Force 1 - Name = "buoyancy" - Boussinesq = True -End - -Initial Condition 1 - Name = "liquid_Initial_Condition" - Velocity 1 = 0.0 - Velocity 2 = 0.0 - Temperature = 300 -End - -Initial Condition 1 - Name = "solid_Initial_Condition" - Temperature = 300 -End - -Boundary Condition 1 - Target Boundaries(1) = 8 - Name = "Fluid_Walls" - Noslip wall BC = True -End - -Boundary Condition 2 - Target Boundaries(1) = 6 - Name = "Inlet" - Velocity 1 = 0.1 - Temperature = 300 -End - -Boundary Condition 3 - Target Boundaries(1) = 7 - Name = "Outlet" - Velocity 2 = 0.0 -End - -Boundary Condition 4 - Target Boundaries(1) = 5 - Name = "Coupling_boundary" - Noslip wall BC = True - Coupler Interface = Logical True -End - -Boundary Condition 5 - Target Boundaries(1) = 3 - Name = "Plate_Bottom" - Temperature = 310 -End - -Boundary Condition 6 - Target Boundaries(1) = 4 - Name = "Plate_Sides" - -End \ No newline at end of file diff --git a/Flow_Over_Heated_Plate/Solid_Participant/Solid_Participant_Mesh.geo b/Flow_Over_Heated_Plate/Solid_Participant/Solid_Participant_Mesh.geo deleted file mode 100644 index 82b640b..0000000 --- a/Flow_Over_Heated_Plate/Solid_Participant/Solid_Participant_Mesh.geo +++ /dev/null @@ -1,33 +0,0 @@ -Point(1) = {0, 0, 0, 1.0}; -//+ -Point(2) = {0, -0.25, 0, 1.0}; -//+ -Point(3) = {1, 0, 0, 1.0}; -//+ -Point(4) = {1, -0.25, 0, 1.0}; -//+ -Line(1) = {2, 4}; -//+ -Line(2) = {4, 3}; -//+ -Line(3) = {3, 1}; -//+ -Line(4) = {1, 2}; -//+ -Line Loop(1) = {3, 4, 1, 2}; -//+ -Plane Surface(1) = {1}; -//+ -Physical Line("Plate_Bottom") = {1}; -//+ -Physical Line("Plate_Sides") = {4, 2}; -//+ -Physical Line("Coupling_Interface") = {3}; -//+ -Transfinite Surface {1} = {2, 4, 3, 1}; -//+ -Transfinite Line {4, 2} = 10 Using Progression 1; -//+ -Transfinite Line {1, 3} = 10 Using Progression 1; -//+ -Physical Surface("Plate") = {1}; diff --git a/Flow_Over_Heated_Plate/Solid_Participant/Solid_Participant_Mesh.msh b/Flow_Over_Heated_Plate/Solid_Participant/Solid_Participant_Mesh.msh deleted file mode 100644 index bac365b..0000000 --- a/Flow_Over_Heated_Plate/Solid_Participant/Solid_Participant_Mesh.msh +++ /dev/null @@ -1,314 +0,0 @@ -$MeshFormat -2.2 0 8 -$EndMeshFormat -$PhysicalNames -4 -1 1 "Plate_Bottom" -1 2 "Plate_Sides" -1 3 "Coupling_Interface" -2 4 "Plate" -$EndPhysicalNames -$Nodes -100 -1 0 0 0 -2 0 -0.25 0 -3 1 0 0 -4 1 -0.25 0 -5 0.1111111111109082 -0.25 0 -6 0.2222222222217143 -0.25 0 -7 0.333333333332501 -0.25 0 -8 0.4444444444432878 -0.25 0 -9 0.5555555555543833 -0.25 0 -10 0.6666666666657874 -0.25 0 -11 0.7777777777771916 -0.25 0 -12 0.8888888888885959 -0.25 0 -13 1 -0.2222222222221066 0 -14 1 -0.194444444444483 0 -15 1 -0.1666666666668979 0 -16 1 -0.1388888888893128 0 -17 1 -0.1111111111115736 0 -18 1 -0.08333333333368018 0 -19 1 -0.05555555555578678 0 -20 1 -0.02777777777789339 0 -21 0.8888888888884262 0 0 -22 0.777777777777932 0 0 -23 0.6666666666675918 0 0 -24 0.5555555555572513 0 0 -25 0.4444444444462943 0 0 -26 0.3333333333347207 0 0 -27 0.2222222222231471 0 0 -28 0.1111111111115736 0 0 -29 0 -0.02777777777772706 0 -30 0 -0.05555555555542857 0 -31 0 -0.08333333333312526 0 -32 0 -0.111111111110822 0 -33 0 -0.1388888888885958 0 -34 0 -0.1666666666664469 0 -35 0 -0.1944444444442979 0 -36 0 -0.222222222222149 0 -37 0.1111111111109821 -0.2222222222221442 0 -38 0.1111111111110561 -0.1944444444443185 0 -39 0.11111111111113 -0.166666666666497 0 -40 0.1111111111112039 -0.1388888888886755 0 -41 0.1111111111112778 -0.1111111111109055 0 -42 0.1111111111113518 -0.0833333333331869 0 -43 0.1111111111114257 -0.05555555555546837 0 -44 0.1111111111114996 -0.02777777777774554 0 -45 0.2222222222218735 -0.2222222222221395 0 -46 0.2222222222220326 -0.194444444444339 0 -47 0.2222222222221919 -0.1666666666665471 0 -48 0.2222222222223511 -0.1388888888887552 0 -49 0.2222222222225103 -0.111111111110989 0 -50 0.2222222222226695 -0.08333333333324858 0 -51 0.2222222222228287 -0.05555555555550817 0 -52 0.2222222222229879 -0.02777777777776402 0 -53 0.3333333333327477 -0.2222222222221348 0 -54 0.3333333333329943 -0.1944444444443596 0 -55 0.3333333333332409 -0.1666666666665972 0 -56 0.3333333333334876 -0.1388888888888348 0 -57 0.3333333333337342 -0.1111111111110725 0 -58 0.3333333333339807 -0.08333333333331025 0 -59 0.3333333333342274 -0.05555555555554798 0 -60 0.3333333333344741 -0.0277777777777825 0 -61 0.4444444444436219 -0.2222222222221301 0 -62 0.444444444443956 -0.1944444444443802 0 -63 0.44444444444429 -0.1666666666666474 0 -64 0.4444444444446241 -0.1388888888889145 0 -65 0.4444444444449582 -0.111111111111156 0 -66 0.4444444444452921 -0.0833333333333719 0 -67 0.4444444444456261 -0.05555555555558778 0 -68 0.4444444444459603 -0.02777777777780099 0 -69 0.5555555555547019 -0.2222222222221254 0 -70 0.5555555555550206 -0.1944444444444007 0 -71 0.5555555555553392 -0.1666666666666974 0 -72 0.5555555555556581 -0.1388888888889942 0 -73 0.5555555555559767 -0.1111111111112395 0 -74 0.5555555555562953 -0.08333333333343354 0 -75 0.555555555556614 -0.05555555555562758 0 -76 0.5555555555569326 -0.02777777777781947 0 -77 0.666666666665988 -0.2222222222221207 0 -78 0.6666666666661885 -0.1944444444444213 0 -79 0.666666666666389 -0.1666666666667476 0 -80 0.6666666666665892 -0.1388888888890738 0 -81 0.6666666666667898 -0.111111111111323 0 -82 0.6666666666669903 -0.08333333333349521 0 -83 0.6666666666671908 -0.05555555555566738 0 -84 0.6666666666673913 -0.02777777777783795 0 -85 0.777777777777274 -0.222222222222116 0 -86 0.7777777777773563 -0.1944444444444419 0 -87 0.7777777777774384 -0.1666666666667977 0 -88 0.7777777777775207 -0.1388888888891535 0 -89 0.777777777777603 -0.1111111111114065 0 -90 0.7777777777776852 -0.08333333333355686 0 -91 0.7777777777777674 -0.05555555555570718 0 -92 0.7777777777778497 -0.02777777777785643 0 -93 0.8888888888885772 -0.2222222222221113 0 -94 0.8888888888885583 -0.1944444444444625 0 -95 0.8888888888885393 -0.1666666666668478 0 -96 0.8888888888885206 -0.1388888888892332 0 -97 0.8888888888885015 -0.1111111111114901 0 -98 0.8888888888884826 -0.0833333333336185 0 -99 0.888888888888464 -0.05555555555574698 0 -100 0.8888888888884451 -0.02777777777787491 0 -$EndNodes -$Elements -198 -1 1 2 1 1 2 5 -2 1 2 1 1 5 6 -3 1 2 1 1 6 7 -4 1 2 1 1 7 8 -5 1 2 1 1 8 9 -6 1 2 1 1 9 10 -7 1 2 1 1 10 11 -8 1 2 1 1 11 12 -9 1 2 1 1 12 4 -10 1 2 2 2 4 13 -11 1 2 2 2 13 14 -12 1 2 2 2 14 15 -13 1 2 2 2 15 16 -14 1 2 2 2 16 17 -15 1 2 2 2 17 18 -16 1 2 2 2 18 19 -17 1 2 2 2 19 20 -18 1 2 2 2 20 3 -19 1 2 3 3 3 21 -20 1 2 3 3 21 22 -21 1 2 3 3 22 23 -22 1 2 3 3 23 24 -23 1 2 3 3 24 25 -24 1 2 3 3 25 26 -25 1 2 3 3 26 27 -26 1 2 3 3 27 28 -27 1 2 3 3 28 1 -28 1 2 2 4 1 29 -29 1 2 2 4 29 30 -30 1 2 2 4 30 31 -31 1 2 2 4 31 32 -32 1 2 2 4 32 33 -33 1 2 2 4 33 34 -34 1 2 2 4 34 35 -35 1 2 2 4 35 36 -36 1 2 2 4 36 2 -37 2 2 4 1 2 5 36 -38 2 2 4 1 36 5 37 -39 2 2 4 1 36 37 35 -40 2 2 4 1 35 37 38 -41 2 2 4 1 35 38 34 -42 2 2 4 1 34 38 39 -43 2 2 4 1 34 39 33 -44 2 2 4 1 33 39 40 -45 2 2 4 1 33 40 32 -46 2 2 4 1 32 40 41 -47 2 2 4 1 32 41 31 -48 2 2 4 1 31 41 42 -49 2 2 4 1 31 42 30 -50 2 2 4 1 30 42 43 -51 2 2 4 1 30 43 29 -52 2 2 4 1 29 43 44 -53 2 2 4 1 29 44 1 -54 2 2 4 1 1 44 28 -55 2 2 4 1 5 6 37 -56 2 2 4 1 37 6 45 -57 2 2 4 1 37 45 38 -58 2 2 4 1 38 45 46 -59 2 2 4 1 38 46 39 -60 2 2 4 1 39 46 47 -61 2 2 4 1 39 47 40 -62 2 2 4 1 40 47 48 -63 2 2 4 1 40 48 41 -64 2 2 4 1 41 48 49 -65 2 2 4 1 41 49 42 -66 2 2 4 1 42 49 50 -67 2 2 4 1 42 50 43 -68 2 2 4 1 43 50 51 -69 2 2 4 1 43 51 44 -70 2 2 4 1 44 51 52 -71 2 2 4 1 44 52 28 -72 2 2 4 1 28 52 27 -73 2 2 4 1 6 7 45 -74 2 2 4 1 45 7 53 -75 2 2 4 1 45 53 46 -76 2 2 4 1 46 53 54 -77 2 2 4 1 46 54 47 -78 2 2 4 1 47 54 55 -79 2 2 4 1 47 55 48 -80 2 2 4 1 48 55 56 -81 2 2 4 1 48 56 49 -82 2 2 4 1 49 56 57 -83 2 2 4 1 49 57 50 -84 2 2 4 1 50 57 58 -85 2 2 4 1 50 58 51 -86 2 2 4 1 51 58 59 -87 2 2 4 1 51 59 52 -88 2 2 4 1 52 59 60 -89 2 2 4 1 52 60 27 -90 2 2 4 1 27 60 26 -91 2 2 4 1 7 8 53 -92 2 2 4 1 53 8 61 -93 2 2 4 1 53 61 54 -94 2 2 4 1 54 61 62 -95 2 2 4 1 54 62 55 -96 2 2 4 1 55 62 63 -97 2 2 4 1 55 63 56 -98 2 2 4 1 56 63 64 -99 2 2 4 1 56 64 57 -100 2 2 4 1 57 64 65 -101 2 2 4 1 57 65 58 -102 2 2 4 1 58 65 66 -103 2 2 4 1 58 66 59 -104 2 2 4 1 59 66 67 -105 2 2 4 1 59 67 60 -106 2 2 4 1 60 67 68 -107 2 2 4 1 60 68 26 -108 2 2 4 1 26 68 25 -109 2 2 4 1 8 9 61 -110 2 2 4 1 61 9 69 -111 2 2 4 1 61 69 62 -112 2 2 4 1 62 69 70 -113 2 2 4 1 62 70 63 -114 2 2 4 1 63 70 71 -115 2 2 4 1 63 71 64 -116 2 2 4 1 64 71 72 -117 2 2 4 1 64 72 65 -118 2 2 4 1 65 72 73 -119 2 2 4 1 65 73 66 -120 2 2 4 1 66 73 74 -121 2 2 4 1 66 74 67 -122 2 2 4 1 67 74 75 -123 2 2 4 1 67 75 68 -124 2 2 4 1 68 75 76 -125 2 2 4 1 68 76 25 -126 2 2 4 1 25 76 24 -127 2 2 4 1 9 10 69 -128 2 2 4 1 69 10 77 -129 2 2 4 1 69 77 70 -130 2 2 4 1 70 77 78 -131 2 2 4 1 70 78 71 -132 2 2 4 1 71 78 79 -133 2 2 4 1 71 79 72 -134 2 2 4 1 72 79 80 -135 2 2 4 1 72 80 73 -136 2 2 4 1 73 80 81 -137 2 2 4 1 73 81 74 -138 2 2 4 1 74 81 82 -139 2 2 4 1 74 82 75 -140 2 2 4 1 75 82 83 -141 2 2 4 1 75 83 76 -142 2 2 4 1 76 83 84 -143 2 2 4 1 76 84 24 -144 2 2 4 1 24 84 23 -145 2 2 4 1 10 11 77 -146 2 2 4 1 77 11 85 -147 2 2 4 1 77 85 78 -148 2 2 4 1 78 85 86 -149 2 2 4 1 78 86 79 -150 2 2 4 1 79 86 87 -151 2 2 4 1 79 87 80 -152 2 2 4 1 80 87 88 -153 2 2 4 1 80 88 81 -154 2 2 4 1 81 88 89 -155 2 2 4 1 81 89 82 -156 2 2 4 1 82 89 90 -157 2 2 4 1 82 90 83 -158 2 2 4 1 83 90 91 -159 2 2 4 1 83 91 84 -160 2 2 4 1 84 91 92 -161 2 2 4 1 84 92 23 -162 2 2 4 1 23 92 22 -163 2 2 4 1 11 12 85 -164 2 2 4 1 85 12 93 -165 2 2 4 1 85 93 86 -166 2 2 4 1 86 93 94 -167 2 2 4 1 86 94 87 -168 2 2 4 1 87 94 95 -169 2 2 4 1 87 95 88 -170 2 2 4 1 88 95 96 -171 2 2 4 1 88 96 89 -172 2 2 4 1 89 96 97 -173 2 2 4 1 89 97 90 -174 2 2 4 1 90 97 98 -175 2 2 4 1 90 98 91 -176 2 2 4 1 91 98 99 -177 2 2 4 1 91 99 92 -178 2 2 4 1 92 99 100 -179 2 2 4 1 92 100 22 -180 2 2 4 1 22 100 21 -181 2 2 4 1 12 4 93 -182 2 2 4 1 93 4 13 -183 2 2 4 1 93 13 94 -184 2 2 4 1 94 13 14 -185 2 2 4 1 94 14 95 -186 2 2 4 1 95 14 15 -187 2 2 4 1 95 15 96 -188 2 2 4 1 96 15 16 -189 2 2 4 1 96 16 97 -190 2 2 4 1 97 16 17 -191 2 2 4 1 97 17 98 -192 2 2 4 1 98 17 18 -193 2 2 4 1 98 18 99 -194 2 2 4 1 99 18 19 -195 2 2 4 1 99 19 100 -196 2 2 4 1 100 19 20 -197 2 2 4 1 100 20 21 -198 2 2 4 1 21 20 3 -$EndElements diff --git a/Flow_Over_Heated_Plate/Solid_Participant/case.sif b/Flow_Over_Heated_Plate/Solid_Participant/case.sif deleted file mode 100644 index 71b28a2..0000000 --- a/Flow_Over_Heated_Plate/Solid_Participant/case.sif +++ /dev/null @@ -1,153 +0,0 @@ -Header - CHECK KEYWORDS Warn - Mesh DB "." "Solid_Participant_Mesh" - Include Path "" - Results Directory "../out" -End - -Simulation - Max Output Level = 5 - Coordinate System = Cartesian - Coordinate Mapping(3) = 1 2 3 - Simulation Type = Transient - Steady State Max Iterations = 10 - Output Intervals = 1 - Timestepping Method = BDF - BDF Order = 2 - Timestep intervals = 10 - Timestep Sizes = 0.1 - Solver Input File = case.sif - Post File = Solid.vtu - - maskName = String "Coupler Interface" - participantName = String "Solid" - meshName = String "Solid-Mesh" - configPath = String "../precice-config.xml" -End - -Constants - Gravity(4) = 0 -1 0 9.82 - Stefan Boltzmann = 5.67e-08 - Permittivity of Vacuum = 8.8542e-12 - Boltzmann Constant = 1.3807e-23 - Unit Charge = 1.602e-19 -End - -Body 1 - Target Bodies(1) = 4 - Name = "Body 1" - Equation = 1 - Material = 1 - Body Force = 1 - Initial Condition = 1 -End - -Solver 1 - Equation = Heat Equation - Procedure = "HeatSolve" "HeatSolver" - Calculate Loads = Logical True - Variable = Temperature - Exec Solver = Always - Stabilize = True - Bubbles = False - Lumped Mass Matrix = False - Optimize Bandwidth = True - Steady State Convergence Tolerance = 1.0e-5 - Nonlinear System Convergence Tolerance = 1.0e-7 - Nonlinear System Max Iterations = 20 - Nonlinear System Newton After Iterations = 3 - Nonlinear System Newton After Tolerance = 1.0e-3 - Nonlinear System Relaxation Factor = 1 - Linear System Solver = Iterative - Linear System Iterative Method = BiCGStab - Linear System Max Iterations = 500 - Linear System Convergence Tolerance = 1.0e-10 - BiCGstabl polynomial degree = 2 - Linear System Preconditioning = ILU0 - Linear System ILUT Tolerance = 1.0e-3 - Linear System Abort Not Converged = False - Linear System Residual Output = 10 - Linear System Precondition Recompute = 1 -End - -Solver 2 - Exec Solver = after timestep - Equation = "flux compute" - Procedure = "FluxSolver" "FluxSolver" - Calculate Flux = Logical True - Flux Variable = String Temperature - Flux Coefficient = String "Heat Conductivity" - Linear System Solver = "Iterative" - Linear System Iterative Method = "cg" - Linear System Preconditioning = ILU0 - Linear System Residual Output = 10 - Linear System Max Iterations = Integer 500 - Linear System Convergence Tolerance = 1.0e-10 -End - -Solver 3 - Equation = "Initialize" - Procedure = "../Coupler_Solver.so" "CouplerSolver" - readDataName = String "Temperature" - writeDataName = String "temperature flux 2" - Exec Solver = before all -End - -Solver 4 - Equation = "ReadData" - Procedure = "../Coupler_Solver.so" "CouplerSolver" - readDataName = String "Temperature" - writeDataName = String "temperature flux 2" - Exec Solver = before timestep -End - -Solver 5 - Equation = "WriteDataAdvance" - Procedure = "../Coupler_Solver.so" "CouplerSolver" - readDataName = String "Temperature" - writeDataName = String "temperature flux 2" - Exec Solver = after timestep -End - -Solver 6 - Equation = "Finalize" - Procedure = "../Coupler_Solver.so" "CouplerSolver" - readDataName = String "Temperature" - writeDataName = String "temperature flux 2" - Exec Solver = after all -End - -Equation 1 - Name = "Heat_Plate" - Active Solvers(2) = 1 2 -End - -Material 1 - Name = "PlateMaterial" - Heat Conductivity = 100 - Heat Capacity = 1 - Density = 0.2 -End - -Initial Condition 1 - Name = "Temp_Init" - Temperature = 300 -End - -Boundary Condition 1 - Target Boundaries(1) = 1 - Name = "Plate_Bottom" - Temperature = 310 -End - -Boundary Condition 2 - Target Boundaries(1) = 2 - Name = "Plate_Sides" -End - -Boundary Condition 3 - Target Boundaries(1) = 3 - Name = "Coupling Interface" - Temperature = Equals "Temperature" - Coupler Interface = Logical True -End \ No newline at end of file diff --git a/Flow_Over_Heated_Plate/precice-config.xml b/Flow_Over_Heated_Plate/precice-config.xml deleted file mode 100644 index ac413eb..0000000 --- a/Flow_Over_Heated_Plate/precice-config.xml +++ /dev/null @@ -1,59 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/README.md b/README.md index 26722f1..45c209a 100644 --- a/README.md +++ b/README.md @@ -1,18 +1,17 @@ # elmer-adapter -**experimental** preCICE-adapter for the open source multiphysical simulation software Elmer FEM -# Getting started +**experimental** preCICE-adapter for the open source multiphysical simulation software Elmer FEM ## Dependencies & Installation Instructions * preCICE * Recommended: Install debian package, please refer to https://precice.org/installation-overview.html for installation * Elmer - * Recommended: Install debian package, please refer to http://www.elmerfem.org/blog/binaries/ + * Recommended: Install debian package, please refer to http://www.elmerfem.org/blog/binaries/ ## Use the adapter -The adapter uses a custom-made Elmer solver for coupling with preCICE. This solver is compiled using `elmerf90` and then plugged into the `case.sif` file in a minimally-invaisve fashion. Examples for usage of the adapter can be found in `Partitioned_Heat_Conduction` and `Flow_Over_Heated_Plate`. For new users it is recommended to use these cases as a starting point. You can refer to the documentation of `Partitioned_Heat_Conduction` for all necessary steps. +The adapter uses a custom-made Elmer solver for coupling with preCICE. This solver is compiled using `elmerf90` and then plugged into the `case.sif` file in a minimally-invasive fashion. Examples for usage of the adapter can be found in `Partitioned_Heat_Conduction` and in the preCICE tutorial [flow-over-heated-plate](https://precice.org/tutorials-flow-over-heated-plate.html). For new users it is recommended to look at the tutorial case as a starting point. Refer to the README in `Partitioned_Heat_Conduction/` for all necessary steps. ## How to couple your own code @@ -30,10 +29,12 @@ Currently, implicit coupling is not supported by the adapter. Parallelization an Partitioned heat equation is thoroughly tested for explicit coupling and gives correct results for an Elmer-Elmer coupling and for Elmer-FEniCS coupling (where Elmer is the Dirichlet participant). If Elmer is the Neumann participant in Elmer-FEniCS coupling, problems occur (probably due to the flux computation, see thesis of Hisham Saeed for details). -The example case `Perpendicular_Flap` is currently only a monolithic simulation, but a good starting point for FSI. See (the perpendicular flap tutorial)[https://github.com/precice/tutorials/tree/master/perpendicular-flap] for details. +The example case `Perpendicular_Flap` is currently only a monolithic simulation, but a good starting point for FSI. See [the perpendicular flap tutorial](https://github.com/precice/tutorials/tree/master/perpendicular-flap) for details. `Coupler_Solver.F90` is currently duplicated for every example. -# Development History +## Development History The initial version of this adapter was developed by [Hisham Saeed](https://github.com/HishamSaeed) during his work on his [master's thesis](https://mediatum.ub.tum.de/604993?query=hisham&show_id=1636717&srcnodeid=604993) under supervision of [Benjamin Rodenberg](https://www.in.tum.de/i05/personen/personen/benjamin-rodenberg/). + +The adapter was updated for preCICE v3 by [Alihossein Sepahvand](https://github.com/tapegoji). \ No newline at end of file