InitiateCellToCellData
This routine initiates cellToCell data (mapping) between two Domain_ or Mesh_.
- The topology of elements in both meshes should be the same, this means that if one mesh is made of triangles then other mesh should be made of triangles.
- The
xidim
of the elements in both meshes should be the same, this means that if themesh1
is surface mesh thenmesh2
should be a surface mesh. - This routine needs
nodeToNode
information, so make sure it is initiated before calling this routine.
Interface1
INTERFACE
MODULE SUBROUTINE dc_initiateCellToCellData1(obj, domain1, domain2, &
& dim1, dim2, entityNum1, entityNum2)
CLASS(DomainConnectivity_), INTENT(INOUT) :: obj
!! Domain connectivity object,
!! [[DomainConnectivity:cellToCell]] will be initiated
CLASS(Domain_), INTENT(IN) :: domain1
!! Primary domain, in cellToCell(i), i denotes the
!! global element number in domain1 domain.
CLASS(Domain_), INTENT(IN) :: domain2
!! secondary domain, => cellToCell(i) denotes the
!! global cell number in `domain2` domain.
INTEGER(I4B), INTENT(IN) :: dim1
!! dimension of mesh in domain1
INTEGER(I4B), INTENT(IN) :: dim2
!! dimension of mesh in domain2
INTEGER(I4B), INTENT(IN) :: entityNum1
!! entity num of mesh in domain1
INTEGER(I4B), INTENT(IN) :: entityNum2
!! entity num of mesh in domain2
END SUBROUTINE dc_initiateCellToCellData1
END INTERFACE
This subroutine generates the cell to cell connectivity between two meshes.
obj%cellToCell
will be initiateddomain1
main domaindomain2
secondary domaindim1, entitynum1
dimension and entity number of mesh indomain1
dim2, entitynum2
dimension and entity number of mesh indomain2
Following points should be noted
- The topology of elements in both meshes should be the same, this means that if one mesh is triangle then other mesh should be a triangle.
- The xidim of the elements in both meshes should be the same, this means that if the mesh1 is surface mesh then mesh2 should be a surface mesh.
- This routine needs
nodeToNode
information, so make sure it is initiated before calling this routine.
- ️܀ Example 1
- ️܀ Example 2
- ️܀ Example 3
- ️܀ Example 4
- ️܀ Example 5
- ↢
In this example we will generate cell to cell connectivity information between part of pressure-domain and part of pressure-Domain.
- dim1=2, entity=1
- dim2=2, entity=1
Pressure domain consists Triangle3 elements as shown below.
PROGRAM main
USE easifemBase
USE easifemClasses
IMPLICIT NONE
TYPE(DomainConnectivity_) :: obj
TYPE( Domain_ ) :: pressureDomain
TYPE( HDF5File_ ) :: pressureMeshFile
CLASS( Mesh_ ), POINTER :: pressureMesh => NULL()
INTEGER( I4B ), POINTER :: cellToCell( : ) => NULL()
INTEGER( I4B ) :: ii
INTEGER(i4b) :: dim1=2, dim2=2, entity1=1, entity2=1
Create domain for pressure variables, 🎇 READ the mesh file, and ⭕ initiates the domain for pressure
CALL pressureMeshFile%Initiate( FileName="./mesh_tri3.h5", MODE="READ" )
CALL pressureMeshFile%Open()
CALL pressureDomain%Initiate( pressureMeshFile, "")
CALL pressureMeshFile%Deallocate()
Initiates the node to node connectivity DATA. It is important that we initiate the node to node DATA before initiating cell to cell DATA.
CALL obj%InitiateNodeToNodeData( domain1=pressureDomain, &
& domain2=pressureDomain, dim1=dim1, entityNum1=entity1, dim2=dim2, &
& entityNum2=entity2)
This will create node-to-node connectivity DATA from domain1 (dim=2, entityNum=1) to domain2 (dim=2, entityNum=2).
Now we can initiate cell-to-cell DATA between the above mentioned meshes.
CALL obj%InitiateCellToCellData( domain1=pressureDomain, &
& domain2=pressureDomain, dim1=dim1, entityNum1=entity1, dim2=dim2, &
& entityNum2=entity2)
CALL Display("Success!!")
Now let us run some checks on the results. This is ONLY for the testing purpose. IF you want, you can skip this part, and move on to the next examples.
cellToCell => obj%getCellToCellPointer()
pressureMesh => pressureDomain%getMeshPointer(dim=dim1, &
& entityNum=entity1)
DO ii = pressureMesh%minElemNum, pressureMesh%maxElemNum
IF (.NOT. pressureMesh%isElementPresent(ii)) CYCLE
IF (cellToCell(ii) .NE. ii) THEN
CALL FAIL("DomainConnectivity-test has failed")
STOP
END IF
END DO
CALL PASS("DomainConnectivity-test-11 has passed")
Cleaning up.
CALL pressureDomain%Deallocate()
CALL obj%Deallocate()
END PROGRAM main
In this example we will generate cell to cell connectivity information between part of velocity-domain and part of velocity-Domain.
Velocity domain consists Triangle6 elements as shown below.
PROGRAM main
USE easifemBase
USE easifemClasses
IMPLICIT NONE
TYPE(DomainConnectivity_) :: obj
TYPE( Domain_ ) :: velocityDomain
TYPE( HDF5File_ ) :: velocityMeshFile
CLASS( Mesh_ ), POINTER :: velocityMesh => NULL()
INTEGER( I4B ), POINTER :: cellToCell( : ) => NULL()
INTEGER( I4B ) :: ii
INTEGER(i4b) :: dim1=2, dim2=2, entity1=1, entity2=1
create domain for velocity variables, 🎇 READ the mesh file, and ⭕ initiates the domain for pressure
CALL velocityMeshFile%Initiate( FileName="./mesh_tri6.h5", MODE="READ" )
CALL velocityMeshFile%Open()
CALL velocityDomain%Initiate( velocityMeshFile, "")
CALL velocityMeshFile%Deallocate()
Initiates the node to node connectivity DATA. It is important that we initiate the node to node DATA before initiating cell to cell DATA.
CALL obj%InitiateNodeToNodeData( domain1=velocityDomain, &
& domain2=velocityDomain, dim1=dim1, entityNum1=entity1, dim2=dim2, &
& entityNum2=entity2)
This will create node-to-node connectivity DATA from domain1 (dim=2, entityNum=1) to domain2 (dim=2, entityNum=2).
Now we can initiate cell-to-cell DATA between the above mentioned meshes.
CALL obj%InitiateCellToCellData( domain1=velocityDomain, &
& domain2=velocityDomain, dim1=dim1, entityNum1=entity1, dim2=dim2, &
& entityNum2=entity2)
Now let us run some checks on the results. This is ONLY for the testing purpose. IF you want, you can skip this part, and move on to the next examples.
cellToCell => obj%getCellToCellPointer()
velocityMesh => velocityDomain%getMeshPointer(dim=dim1, &
& entityNum=entity1)
DO ii = velocityMesh%minElemNum, velocityMesh%maxElemNum
IF (.NOT. velocityMesh%isElementPresent(ii)) CYCLE
IF (cellToCell(ii) .NE. ii) THEN
CALL FAIL("DomainConnectivity-test has failed")
STOP
END IF
END DO
CALL PASS("DomainConnectivity-test has passed")
Cleaning up.
CALL velocityDomain%Deallocate()
CALL obj%Deallocate()
END PROGRAM main
In this example we will generate cell to cell connectivity information between part of pressure-domain and part of pressure-Domain. We will map boundary of a domain with the boundary of the other domain
Pressure domain consists Triangle3 elements as shown below.
Velocity domain consists Triangle6 elements as shown below.
Importing modules and variables
PROGRAM main
USE easifemBase
USE easifemClasses
IMPLICIT NONE
TYPE(DomainConnectivity_) :: obj
TYPE( Domain_ ) :: pressureDomain
TYPE( HDF5File_ ) :: pressureMeshFile
CLASS( Mesh_ ), POINTER :: pressureMesh => NULL()
INTEGER( I4B ), POINTER :: cellToCell( : ) => NULL()
INTEGER( I4B ) :: ii
INTEGER(i4b) :: dim1=1, dim2=1, entity1=1, entity2=1
Create domain for pressure variables, 🎇 READ the mesh file, and ⭕ initiates the domain for pressure
CALL pressureMeshFile%Initiate( FileName="./mesh_tri3.h5", MODE="READ" )
CALL pressureMeshFile%Open()
CALL pressureDomain%Initiate( pressureMeshFile, "")
CALL pressureMeshFile%Deallocate()
Initiates the node to node connectivity DATA. It is important that we initiate the node to node DATA before initiating cell to cell DATA.
CALL obj%InitiateNodeToNodeData( domain1=pressureDomain, &
& domain2=pressureDomain, dim1=dim1, entityNum1=entity1, dim2=dim2, &
& entityNum2=entity2)
This will create node-to-node connectivity DATA from domain1 (dim=2, entityNum=1) to domain2 (dim=2, entityNum=2).
Now we can initiate cell-to-cell DATA between the above mentioned meshes.
CALL obj%InitiateCellToCellData( domain1=pressureDomain, &
& domain2=pressureDomain, dim1=dim1, entityNum1=entity1, dim2=dim2, &
& entityNum2=entity2)
CALL Display("Success!!")
Now let us run some checks on the results. This is ONLY for the testing purpose. IF you want, you can skip this part, and move on to the next examples.
cellToCell => obj%getCellToCellPointer()
pressureMesh => pressureDomain%getMeshPointer(dim=dim1, &
& entityNum=entity1)
DO ii = pressureMesh%minElemNum, pressureMesh%maxElemNum
IF (.NOT. pressureMesh%isElementPresent(ii)) CYCLE
IF (cellToCell(ii) .NE. ii) THEN
CALL FAIL("DomainConnectivity-test-11 has failed")
STOP
END IF
END DO
CALL PASS("DomainConnectivity-test has passed")
Cleaning up.
CALL pressureDomain%Deallocate()
CALL obj%Deallocate()
END PROGRAM main
In this example we will generate cell to cell connectivity information between part of velocity-domain and part of velocity-Domain.
Pressure domain consists Triangle3 elements as shown below.
Velocity domain consists Triangle6 elements as shown below.
Importing modules and variables
PROGRAM main
USE easifemBase
USE easifemClasses
IMPLICIT NONE
TYPE(DomainConnectivity_) :: obj
TYPE( Domain_ ) :: velocityDomain
TYPE( HDF5File_ ) :: velocityMeshFile
CLASS( Mesh_ ), POINTER :: velocityMesh => NULL()
INTEGER( I4B ), POINTER :: cellToCell( : ) => NULL()
INTEGER( I4B ) :: ii
INTEGER(i4b) :: dim1=1, dim2=1, entity1=1, entity2=1
Create domain for velocity variables, 🎇 READ the mesh file, and ⭕ initiates the domain for pressure
CALL velocityMeshFile%Initiate( FileName="./mesh_tri6.h5", MODE="READ" )
CALL velocityMeshFile%Open()
CALL velocityDomain%Initiate( velocityMeshFile, "")
CALL velocityMeshFile%Deallocate()
Initiates the node to node connectivity DATA. It is important that we initiate the node to node DATA before initiating cell to cell DATA.
CALL obj%InitiateNodeToNodeData( domain1=velocityDomain, &
& domain2=velocityDomain, dim1=dim1, entityNum1=entity1, dim2=dim2, &
& entityNum2=entity2)
This will create node-to-node connectivity DATA from domain1 (dim=2, entityNum=1) to domain2 (dim=2, entityNum=2).
Now we can initiate cell-to-cell DATA between the above mentioned meshes.
CALL obj%InitiateCellToCellData( domain1=velocityDomain, &
& domain2=velocityDomain, dim1=dim1, entityNum1=entity1, dim2=dim2, &
& entityNum2=entity2)
Now let us run some checks on the results. This is ONLY for the testing purpose. IF you want, you can skip this part, and move on to the next examples.
cellToCell => obj%getCellToCellPointer()
velocityMesh => velocityDomain%getMeshPointer(dim=dim1, &
& entityNum=entity1)
DO ii = velocityMesh%minElemNum, velocityMesh%maxElemNum
IF (.NOT. velocityMesh%isElementPresent(ii)) CYCLE
IF (cellToCell(ii) .NE. ii) THEN
CALL FAIL("DomainConnectivity-test-11 has failed")
STOP
END IF
END DO
CALL PASS("DomainConnectivity-test has passed")
Cleaning up.
CALL velocityDomain%Deallocate()
CALL obj%Deallocate()
END PROGRAM main
In this example we will show how to USE [[DomainConnectivity_#InitiateCellToCell]] method to generate cell-to-cell connectivity information between part of velocity-domain and part of pressure-Domain.
Pressure domain consists Triangle3 elements as shown below.
Velocity domain consists Triangle6 elements as shown below.
IMPORT modules and classes
PROGRAM main
USE easifemBase
USE easifemClasses
IMPLICIT NONE
TYPE(DomainConnectivity_) :: obj
TYPE( Domain_ ) :: pressureDomain
TYPE( Domain_ ) :: velocityDomain
TYPE( HDF5File_ ) :: pressureMeshFile
TYPE( HDF5File_ ) :: velocityMeshFile
CLASS( Mesh_ ), POINTER :: velocityMesh
CLASS( Mesh_ ), POINTER :: pressureMesh
INTEGER( I4B ), POINTER :: cellToCell( : )
INTEGER( I4B ) :: ii
INTEGER(i4b), PARAMETER :: dim1=2, dim2=2, entity1=1, entity2=1
create domain for velocity variables, 🎇 READ the mesh file, and ⭕ initiates the domain for pressure
CALL velocityMeshFile%Initiate( FileName="./mesh_tri6.h5", MODE="READ" )
CALL velocityMeshFile%Open()
CALL velocityDomain%Initiate( velocityMeshFile, "")
CALL velocityMeshFile%Deallocate()
create domain for pressure variables, 🎇 READ the mesh file, and ⭕ initiates the domain for pressure
CALL pressureMeshFile%Initiate( FileName="./mesh_tri3.h5", MODE="READ" )
CALL pressureMeshFile%Open()
CALL pressureDomain%Initiate( pressureMeshFile, "")
CALL pressureMeshFile%Deallocate()
Initiates the node to node connectivity DATA. It is important that we initiate the node to node DATA before initiating cell to cell DATA.
CALL obj%InitiateNodeToNodeData( domain1=velocityDomain, &
& domain2=pressureDomain, dim1=dim1, entityNum1=entity1, dim2=dim2, &
& entityNum2=entity2)
This will create node-to-node connectivity DATA from domain1 (dim=2, entityNum=1) to domain2 (dim=2, entityNum=2).
Now we can initiate cell-to-cell DATA between the above mentioned meshes.
CALL obj%InitiateCellToCellData( domain1=velocityDomain, &
& domain2=pressureDomain, dim1=dim1, entityNum1=entity1, dim2=dim2, &
& entityNum2=entity2)
Now let us run some checks on the results. This is ONLY for the testing purpose. IF you want, you can skip this part, and move on to the next examples.
cellToCell => obj%getCellToCellPointer()
velocityMesh => velocityDomain%getMeshPointer(dim=dim1, &
& entityNum=entity1)
DO ii = velocityMesh%minElemNum, velocityMesh%maxElemNum
IF (.NOT. velocityMesh%isElementPresent(ii)) CYCLE
IF (cellToCell(ii) .EQ. 0) THEN
CALL FAIL("DomainConnectivity-test has failed")
STOP
END IF
END DO
CALL PASS("DomainConnectivity-test has passed")
CALL pressureDomain%Deallocate()
CALL velocityDomain%Deallocate()
CALL obj%Deallocate()
END PROGRAM main
- ️܀ Example 6
- ️܀ Example 7
- ️܀ Example 8
- ↢
In this example, we will show how to USE [[DomainConnectivity_#InitiateCellToCellData]] method to generate cell-to-cell connectivity information between part of velocity-domain and part of pressure-Domain.
Pressure domain consists Triangle3 elements as shown below.
Velocity domain consists Triangle6 elements as shown below.
PROGRAM main
USE easifemBase
USE easifemClasses
IMPLICIT NONE
TYPE(DomainConnectivity_) :: obj
TYPE( Domain_ ) :: pressureDomain
TYPE( Domain_ ) :: velocityDomain
TYPE( HDF5File_ ) :: pressureMeshFile
TYPE( HDF5File_ ) :: velocityMeshFile
CLASS( Mesh_ ), POINTER :: velocityMesh
CLASS( Mesh_ ), POINTER :: pressureMesh
INTEGER( I4B ), POINTER :: cellToCell( : )
INTEGER( I4B ) :: ii
INTEGER(i4b), PARAMETER :: dim1=2, dim2=2, entity1=1, entity2=1
Create domain for velocity variables, 🎇 READ the mesh file, and ⭕ initiates the domain for pressure
CALL velocityMeshFile%Initiate( FileName="./mesh_tri6.h5", MODE="READ" )
CALL velocityMeshFile%Open()
CALL velocityDomain%Initiate( velocityMeshFile, "")
CALL velocityMeshFile%Deallocate()
Create domain for pressure variables, 🎇 READ the mesh file, and ⭕ initiates the domain for pressure
CALL pressureMeshFile%Initiate( FileName="./mesh_tri3.h5", MODE="READ" )
CALL pressureMeshFile%Open()
CALL pressureDomain%Initiate( pressureMeshFile, "")
CALL pressureMeshFile%Deallocate()
Initiates the node to node connectivity DATA. It is important that we initiate the node to node DATA before initiating cell to cell DATA.
CALL obj%InitiateNodeToNodeData( domain1=pressureDomain, &
& domain2=velocityDomain, dim1=dim1, entityNum1=entity1, dim2=dim2, &
& entityNum2=entity2)
This will create node-to-node connectivity DATA from domain1 (dim=2, entityNum=1) to domain2 (dim=2, entityNum=2).
Now we can initiate cell-to-cell DATA between the above mentioned meshes.
CALL obj%InitiateCellToCellData( domain1=pressureDomain, &
& domain2=velocityDomain, dim1=dim1, entityNum1=entity1, dim2=dim2, &
& entityNum2=entity2)
Now let us run some checks on the results. This is ONLY for the testing purpose. IF you want, you can skip this part, and move on to the next examples.
cellToCell => obj%getCellToCellPointer()
pressureMesh => pressureDomain%getMeshPointer(dim=dim1, &
& entityNum=entity1)
DO ii = pressureMesh%minElemNum, pressureMesh%maxElemNum
IF (.NOT. pressureMesh%isElementPresent(ii)) CYCLE
IF (cellToCell(ii) .EQ. 0) THEN
CALL FAIL("DomainConnectivity-test has failed")
STOP
END IF
END DO
CALL PASS("DomainConnectivity-test has passed")
CALL pressureDomain%Deallocate()
CALL velocityDomain%Deallocate()
CALL obj%Deallocate()
END PROGRAM main
In this example we will generate cell to cell connectivity information between pressure-domain and pressure-Domain.
Pressure domain consists Triangle3 elements as shown below.
Velocity domain consists Triangle6 elements as shown below.
Importing modules and variables
PROGRAM main
USE easifemBase
USE easifemClasses
IMPLICIT NONE
TYPE(DomainConnectivity_) :: obj
TYPE( Domain_ ) :: pressureDomain
TYPE( HDF5File_ ) :: pressureMeshFile
CLASS( Mesh_ ), POINTER :: pressureMesh
CLASS( ReferenceElement_ ), POINTER :: refelem
INTEGER( I4B ), POINTER :: cellToCell( : )
INTEGER( I4B ) :: ii, iel
INTEGER(I4B), PARAMETER :: dim1=2, dim2=2, entity1=1, entity2=1
Initiate domain for pressure variable.
CALL pressureMeshFile%Initiate( FileName="./mesh_tri3.h5", MODE="READ" )
CALL pressureMeshFile%Open()
CALL pressureDomain%Initiate( pressureMeshFile, "")
Initiate node to node DATA.
CALL obj%InitiateNodeToNodeData( domain1=pressureDomain, &
& domain2=pressureDomain )
CALL PASS("InitiateNodeToNodeData()")
This will create node to node connectivity DATA from domain1 (dim=2, entityNum=1) to domain2 (dim=2, entityNum=2).
Initiate cell to cell connectivity DATA.
CALL obj%InitiateCellToCellData(domain1=pressureDomain, &
& domain2=pressureDomain)
now let us run some tests.
cellToCell => obj%getCellToCellPointer()
DO iel = pressureDomain%minElemNum, pressureDomain%maxElemNum
IF (.NOT. pressureDomain%isElementPresent(iel)) CYCLE
IF (cellToCell(iel) .EQ. 0) THEN
pressureMesh => pressureDomain%getMeshPointer(globalElement=iel)
refelem => pressureMesh%getRefElemPointer()
IF (refelem%xidimension .EQ. pressureDomain%getNSD()) &
& CALL fail("CellToCell: error code 1")
ELSE
IF (cellToCell(iel) .NE. iel) THEN
CALL fail("CellToCell: error code 2")
STOP
END IF
END IF
END DO
CALL PASS("InitiateCellToCellData()")
CALL pressureMeshFile%Deallocate()
CALL pressureDomain%Deallocate()
CALL obj%Deallocate()
END PROGRAM main
In this example we will generate cell to cell connectivity information between velocity-domain and velocity-Domain.
Pressure domain consists Triangle3 elements as shown below.
Velocity domain consists Triangle6 elements as shown below.
Importing modules and variables
PROGRAM main
USE easifemBase
USE easifemClasses
IMPLICIT NONE
TYPE(DomainConnectivity_) :: obj
TYPE( Domain_ ) :: velocityDomain
TYPE( HDF5File_ ) :: velocityMeshFile
CLASS( Mesh_ ), POINTER :: velocityMesh
CLASS( ReferenceElement_ ), POINTER :: refelem
INTEGER( I4B ), POINTER :: cellToCell( : )
INTEGER( I4B ) :: ii, iel
INTEGER(I4B), PARAMETER :: dim1=2, dim2=2, entity1=1, entity2=1
Initiate domain for velocity variable.
CALL velocityMeshFile%Initiate( FileName="./mesh_tri6.h5", MODE="READ" )
CALL velocityMeshFile%Open()
CALL velocityDomain%Initiate( velocityMeshFile, "")
Initiate node to node DATA.
CALL obj%InitiateNodeToNodeData( domain1=velocityDomain, &
& domain2=velocityDomain )
CALL PASS("InitiateNodeToNodeData()")
This will create node to node connectivity DATA from domain1 (dim=2, entityNum=1) to domain2 (dim=2, entityNum=2).
Initiate cell to cell connectivity DATA.
CALL obj%InitiateCellToCellData(domain1=velocityDomain, &
& domain2=velocityDomain)
now let us run some tests, this is only for testing purpose, so you can ignore the forthcoming section.
cellToCell => obj%getCellToCellPointer()
DO iel = velocityDomain%minElemNum, velocityDomain%maxElemNum
IF (.NOT. velocityDomain%isElementPresent(iel)) CYCLE
IF (cellToCell(iel) .EQ. 0) THEN
velocityMesh => velocityDomain%getMeshPointer(globalElement=iel)
refelem => velocityMesh%getRefElemPointer()
IF (refelem%xidimension .EQ. velocityDomain%getNSD()) &
& CALL fail("CellToCell: error code 1")
ELSE
IF (cellToCell(iel) .NE. iel) THEN
CALL fail("CellToCell: error code 2")
STOP
END IF
END IF
END DO
CALL PASS("InitiateCellToCellData()")
CALL velocityMeshFile%Deallocate()
CALL velocityDomain%Deallocate()
CALL obj%Deallocate()
END PROGRAM main
Interface2
INTERFACE
MODULE SUBROUTINE dc_InitiateCellToCellData2(obj, domain1, domain2)
CLASS(DomainConnectivity_), INTENT(INOUT) :: obj
!! Domain connectivity object
CLASS(Domain_), INTENT(IN) :: domain1
!! Primary domain, in CellToCell(i), i denotes the
!! global element number in domain1 domain.
CLASS(Domain_), INTENT(IN) :: domain2
!! Secondary domain => CellToCell(i) denotes the
!! global element number in domain2 domain.
END SUBROUTINE dc_InitiateCellToCellData2
END INTERFACE
This subroutine generates the cell to cell connectivity between two domains.
obj%cellToCell
will be initiateddomain1
main domaindomain2
secondary domain
All CELL elements in domain-1 will be mapped to CELL elements in domain-2.
If cellToCell(iel)
is equal to zero then it means there is no element found in domain-2 corresponding to element number iel in domain-1.
The size of cellToCell
is the largest element number present in domain1.
Currently, lowerbound and upper bound of cellToCell is 1 and domain1%maxElemNumber. In the future, the lower bound will be domain1%minElemNumber.
Following points should be noted before calling this routine
- This routine provides map between cell elements of one domain to cell elements of another domain.
- The topology of the both elements should be the same
- There is one to one mapping between elements of domain 1 and elements of domain2
- This routine works well for two domains of same region with same/different order. For example, domain of tri3 and domain of tri6 elements.
- ️܀ Example 1
- ️܀ Example 2
- ↢
In this example we will generate cell to cell connectivity information between velocity-domain and pressure-Domain.
Pressure domain consists Triangle3 elements as shown below.
Velocity domain consists Triangle6 elements as shown below.
Importing modules and variables
PROGRAM main
USE easifemBase
USE easifemClasses
IMPLICIT NONE
TYPE(DomainConnectivity_) :: obj
TYPE( Domain_ ) :: pressureDomain
TYPE( Domain_ ) :: velocityDomain
TYPE( HDF5File_ ) :: pressureMeshFile
TYPE( HDF5File_ ) :: velocityMeshFile
CLASS( Mesh_ ), POINTER :: velocityMesh
CLASS( Mesh_ ), POINTER :: pressureMesh
CLASS( ReferenceElement_ ), POINTER :: velocityRefelem
CLASS( ReferenceElement_ ), POINTER :: pressureRefelem
CLASS( ReferenceElement_ ), POINTER :: refelem
INTEGER( I4B ), POINTER :: cellToCell( : )
INTEGER( I4B ) :: ii, iel
Open the mesh file for pressure and velocity domain
CALL velocityMeshFile%Initiate( FileName="./mesh_tri6.h5", MODE="READ" )
CALL velocityMeshFile%Open()
CALL pressureMeshFile%Initiate( FileName="./mesh_tri3.h5", MODE="READ" )
CALL pressureMeshFile%Open()
Initiate the domain for pressure and velocity
CALL velocityDomain%Initiate( velocityMeshFile, "")
CALL pressureDomain%Initiate( pressureMeshFile, "")
Initiate node to node data between velocity domain and pressure domain.
CALL obj%InitiateNodeToNodeData( domain1=velocityDomain, &
& domain2=pressureDomain )
CALL PASS("InitiateNodeToNodeData()")
Now that node-to-node data is ready, let us initiate cell to cell data from velocity domain to pressure domain.
CALL obj%InitiateCellToCellData( domain1=velocityDomain, &
& domain2=pressureDomain )
now let us run some tests to check the validity of the data. This is only for testing purpose, so you can ignore the forthcoming section.
cellToCell => obj%getCellToCellPointer()
DO iel = velocityDomain%minElemNum, velocityDomain%maxElemNum
IF (.NOT. velocityDomain%isElementPresent(iel)) CYCLE
IF (cellToCell(iel) .EQ. 0) THEN
velocityMesh => velocityDomain%getMeshPointer(globalElement=iel)
refelem => velocityMesh%getRefElemPointer()
IF (refelem%xidimension .EQ. velocityDomain%getNSD()) THEN
CALL fail("CellToCell: error code 1")
STOP
END IF
ELSE
!! here i am checking if the cellToCell(iel) is present in
!! in the pressure domain or not.
!! If it is present then it should be a cell element.
ii = cellToCell(iel)
IF (.NOT. pressureDomain%isElementPresent(ii)) THEN
CALL fail("CellToCell: error code 2")
STOP
ELSE
velocityMesh => velocityDomain%getMeshPointer(globalElement=iel)
velocityRefelem => velocityMesh%getRefElemPointer()
pressureMesh => pressureDomain%getMeshPointer(globalElement=ii)
pressureRefelem => pressureMesh%getRefElemPointer()
IF (pressureRefelem%xidimension .NE. velocityRefelem%xidimension) THEN
CALL fail("CellToCell: error code 3")
STOP
END IF
END IF
END IF
END DO
CALL PASS("InitiateCellToCellData()")
CALL pressureMeshFile%Deallocate()
CALL velocityMeshFile%Deallocate()
CALL pressureDomain%Deallocate()
CALL velocityDomain%Deallocate()
CALL obj%Deallocate()
END PROGRAM main
In this example we will generate cell to cell connectivity information between pressure-domain and velocity-Domain.
Pressure domain consists Triangle3 elements as shown below.
Velocity domain consists Triangle6 elements as shown below.
Importing modules and variables
PROGRAM main
USE easifemBase
USE easifemClasses
IMPLICIT NONE
TYPE(DomainConnectivity_) :: obj
TYPE( Domain_ ) :: pressureDomain
TYPE( Domain_ ) :: velocityDomain
TYPE( HDF5File_ ) :: pressureMeshFile
TYPE( HDF5File_ ) :: velocityMeshFile
CLASS( Mesh_ ), POINTER :: velocityMesh
CLASS( Mesh_ ), POINTER :: pressureMesh
CLASS( ReferenceElement_ ), POINTER :: refelem
CLASS( ReferenceElement_ ), POINTER :: velocityRefelem
CLASS( ReferenceElement_ ), POINTER :: pressureRefelem
INTEGER( I4B ), POINTER :: cellToCell( : )
INTEGER( I4B ) :: ii, iel
Open the mesh file for pressure and velocity domain
CALL velocityMeshFile%Initiate( FileName="./mesh_tri6.h5", MODE="READ" )
CALL velocityMeshFile%Open()
CALL pressureMeshFile%Initiate( FileName="./mesh_tri3.h5", MODE="READ" )
CALL pressureMeshFile%Open()
Initiate the domain for pressure and velocity
CALL velocityDomain%Initiate( velocityMeshFile, "")
CALL pressureDomain%Initiate( pressureMeshFile, "")
Initiate node to node data between velocity domain and pressure domain.
CALL obj%InitiateNodeToNodeData( domain1=pressureDomain, &
& domain2=velocityDomain )
CALL PASS("InitiateNodeToNodeData()")
Now that node-to-node data is ready, let us initiate cell to cell data from pressure domain to velocity domain.
CALL obj%InitiateCellToCellData( domain1=pressureDomain, &
& domain2=velocityDomain )
now let us run some tests to check the validity of the data. This is only for testing purpose, so you can ignore the forthcoming section.
cellToCell => obj%getCellToCellPointer()
DO iel = pressureDomain%minElemNum, pressureDomain%maxElemNum
IF (.NOT. pressureDomain%isElementPresent(iel)) CYCLE
IF (cellToCell(iel) .EQ. 0) THEN
pressureMesh => pressureDomain%getMeshPointer(globalElement=iel)
refelem => pressureMesh%getRefElemPointer()
IF (refelem%xidimension .EQ. pressureDomain%getNSD()) THEN
CALL fail("CellToCell: error code 1")
STOP
END IF
ELSE
!! here i am checking if the cellToCell(iel) is present in
!! in the pressure domain or not.
!! If it is present then it should be a cell element.
ii = cellToCell(iel)
IF (.NOT. velocityDomain%isElementPresent(ii)) THEN
CALL fail("CellToCell: error code 2")
STOP
ELSE
velocityMesh => velocityDomain%getMeshPointer(globalElement=ii)
velocityRefelem => velocityMesh%getRefElemPointer()
pressureMesh => pressureDomain%getMeshPointer(globalElement=iel)
pressureRefelem => pressureMesh%getRefElemPointer()
IF (pressureRefelem%xidimension .NE. velocityRefelem%xidimension) THEN
CALL fail("CellToCell: error code 3")
STOP
END IF
END IF
END IF
END DO
CALL PASS("InitiateCellToCellData()")
CALL pressureMeshFile%Deallocate()
CALL velocityMeshFile%Deallocate()
CALL pressureDomain%Deallocate()
CALL velocityDomain%Deallocate()
CALL obj%Deallocate()
END PROGRAM main