Next: I.1.2 Initialize_Uniform_Multi_Mesh Procedure Up: I.1 Multi_Mesh Class Code Previous: I.1 Multi_Mesh Class Code
The main documentation of the Initialize_Base_Multi_Mesh Procedure contains additional explanation of this code listing.
subroutine Initialize_Base_Multi_Mesh (Mesh, NDimensions, Geometry, &
Uniformity, Orthogonality, Structure, AMR, Shape, &
NNodes_Vector, NCells_Vector, NFaces_Vector, &
Coordinates_Nodes_PE, Nodes_of_Cells_PE, Mesh_Name, status)
! Use associations.
use Caesar_Flags_Module, only: initialized_flag
! ~~~~~~~~~~~~~~~~
! Input variables.
! ~~~~~~~~~~~~~~~~
! Mesh type information.
type(integer), intent(in) :: NDimensions ! Number of Dimensions.
type(character,*), intent(in) :: Geometry ! Mesh geometry.
type(character,*), intent(in) :: Uniformity ! Uniform or Nonuniform.
type(character,*), intent(in) :: Orthogonality ! Orthogonal or
! Nonorthogonal.
type(character,*), intent(in) :: Structure ! Structured or
! Unstructured.
type(logical), intent(in) :: AMR ! Adaptive Mesh Refinement.
type(character,*), intent(in) :: Shape ! Cell shape.
! Structure length vectors, which give numbers for all PEs.
type(integer,1) :: NNodes_Vector ! Number of nodes.
type(integer,1) :: NCells_Vector ! Number of cells.
type(integer,1) :: NFaces_Vector ! Number of faces.
! Mesh coordinates and indices.
! The coordinates of the nodes on this PE.
type(real,2) :: Coordinates_Nodes_PE
! The nodes for the cells on this PE.
type(integer,2) :: Nodes_of_Cells_PE
type(character,*), intent(in), optional :: Mesh_Name ! Mesh name.
! ~~~~~~~~~~~~~~~~~
! Output variables.
! ~~~~~~~~~~~~~~~~~
! Multi_Mesh to be initialized.
type(Multi_Mesh_type), intent(inout) :: Mesh
type(Status_type), intent(out), optional :: status ! Exit status.
! ~~~~~~~~~~~~~~~~~~~
! Internal variables.
! ~~~~~~~~~~~~~~~~~~~
type(Status_type), dimension(20) :: allocate_status ! Allocation Status.
type(Status_type) :: consolidated_status ! Consolidated Status.
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Verify requirements.
! Mesh type info is valid.
VERIFY(NDimensions .InInterval. (/1, 3/),5)
VERIFY(Geometry .InSet. Geometry_Options,5)
VERIFY(Uniformity .InSet. Uniformity_Options,5)
VERIFY(Orthogonality .InSet. Orthogonality_Options,5)
VERIFY(Structure .InSet. Structure_Options,5)
VERIFY(Valid_State(AMR),5)
VERIFY(Shape .InSet. Shape_Options,5)
! Mesh length vectors are correct length.
VERIFY(SIZE(NNodes_Vector) == NPEs,5)
VERIFY(SIZE(NCells_Vector) == NPEs,5)
VERIFY(SIZE(NFaces_Vector) == NPEs,5)
! Input arrays are correct size.
VERIFY(SIZE(Coordinates_Nodes_PE,1) == NDimensions,5)
VERIFY(SIZE(Coordinates_Nodes_PE,2) == NNodes_Vector(this_PE),5)
VERIFY(SIZE(Nodes_of_Cells_PE,1) == NCells_Vector(this_PE),5)
VERIFY(SIZE(Nodes_of_Cells_PE,2) == 2**NDimensions,5)
! Set up internals.
if (PRESENT(Mesh_Name)) Mesh%Name = Mesh_Name
! Set Mesh type information.
Mesh%NDimensions = NDimensions
Mesh%Geometry = Geometry
Mesh%Uniformity = Uniformity
Mesh%Orthogonality = Orthogonality
Mesh%Structure = Structure
Mesh%AMR = AMR
Mesh%Shape = Shape
! Mesh scalar info.
Mesh%NCells_total = SUM(NCells_Vector)
Mesh%NCells_PE = NCells_Vector(this_PE)
Mesh%Last_Cell_PE = SUM(NCells_Vector(1:this_PE))
Mesh%First_Cell_PE = Mesh%Last_Cell_PE - Mesh%NCells_PE + 1
Mesh%Range_Cells_PE = (/ Mesh%First_Cell_PE, Mesh%Last_Cell_PE /)
Mesh%NNodes_total = SUM(NNodes_Vector)
Mesh%NNodes_PE = NNodes_Vector(this_PE)
Mesh%Last_Node_PE = SUM(NNodes_Vector(1:this_PE))
Mesh%First_Node_PE = Mesh%Last_Node_PE - Mesh%NNodes_PE + 1
Mesh%Range_Nodes_PE = (/ Mesh%First_Node_PE, Mesh%Last_Node_PE /)
Mesh%NFaces_total = SUM(NFaces_Vector)
Mesh%NFaces_PE = NFaces_Vector(this_PE)
Mesh%Last_Face_PE = SUM(NFaces_Vector(1:this_PE))
Mesh%First_Face_PE = Mesh%Last_Face_PE - Mesh%NFaces_PE + 1
Mesh%Range_Faces_PE = (/ Mesh%First_Face_PE, Mesh%Last_Face_PE /)
select case (Mesh%Shape)
! Type 1 meshes.
case ('Tetrahedral', 'Triangular')
Mesh%Nodes_per_Cell = NDimensions+1
Mesh%Nodes_per_Face = NDimensions
Mesh%Faces_per_Cell = NDimensions+1
! Type 2 meshes:
case ('Segmented', 'Quadrilateral', 'Hexahedral')
Mesh%Nodes_per_Cell = 2**NDimensions
Mesh%Nodes_per_Face = 2**(NDimensions-1)
Mesh%Faces_per_Cell = 2*NDimensions
! Type N meshes.
case ('Polygonal', 'Polyhedral')
Mesh%Nodes_per_Cell = 0
Mesh%Nodes_per_Face = 0
Mesh%Faces_per_Cell = 0
end select
! Segmented is either Type 1 or Type 2.
! Allocations and initializations.
call Initialize (allocate_status)
call Initialize (consolidated_status)
! Set up mesh structures.
call Initialize (Mesh%Node_Structure, NNodes_Vector, 'Nodes', &
allocate_status(1))
call Initialize (Mesh%Cell_Structure, NCells_Vector, 'Cells', &
allocate_status(2))
call Initialize (Mesh%Face_Structure, NFaces_Vector, 'Faces', &
allocate_status(3))
! Set Mesh coordinates.
call Initialize (Mesh%Coordinates_Nodes_DV, Mesh%Node_Structure, &
2, 'Coordinates of Nodes', status, NDimensions)
Mesh%Coordinates_Nodes_DV = Coordinates_Nodes_PE
! Set Mesh indices.
call Initialize (Mesh%Nodes_of_Cells_Index, Mesh%Node_Structure, &
Mesh%Cell_Structure, &
Many_of_One_Array=Nodes_of_Cells_PE, &
status=allocate_status(4))
! Consolidate and handle status.
consolidated_status = allocate_status
if (PRESENT(status)) then
WARN_IF(Error(consolidated_status), 5)
status = consolidated_status
else
VERIFY(Normal(consolidated_status), 5)
end if
call Finalize (consolidated_status)
call Finalize (allocate_status)
! Set initialization flag.
Mesh%Initialized = initialized_flag
! Verify guarantees.
VERIFY(Valid_State(Mesh),5) ! Mesh is now valid.
return
end subroutine Initialize_Base_Multi_Mesh