Next: I.1.3 Initialize_Orthogonal_Multi_Mesh Procedure Up: I.1 Multi_Mesh Class Code Previous: I.1.1 Initialize_Base_Multi_Mesh Procedure
The main documentation of the Initialize_Uniform_Multi_Mesh Procedure contains additional explanation of this code listing.
subroutine Initialize_Uniform_Multi_Mesh (Mesh, NDimensions, Lengths, &
NCells_X_total, NCells_Y_total, &
NCells_Z_total, Mesh_Name, status)
! Input variables.
type(integer), intent(in) :: NDimensions ! Number of Dimensions.
type(real,1,np), intent(in) :: Lengths ! Physical extent of the
! domain in each direction.
! Total number of cells in the X-, Y-, and Z-directions.
type(integer), intent(in) :: NCells_X_total
type(integer), intent(inout), optional :: NCells_Y_total
type(integer), intent(inout), optional :: NCells_Z_total
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(character,name_length) :: Shape ! Cell shape.
type(character,name_length) :: Geometry ! Cell geometry (Cartesian).
type(character,name_length) :: Uniformity ! Set to "Uniform".
type(character,name_length) :: Orthogonality ! Set to "Orthogonal".
type(character,name_length) :: Structure ! Set to "Structured".
type(logical) :: AMR ! Set to false.
type(Status_type), dimension(20) :: allocate_status ! Allocation Status.
type(Status_type) :: consolidated_status ! Consolidated Status.
type(integer) :: NPEs_X ! Number of PEs in X.
type(integer) :: NPEs_Y ! Number of PEs in Y.
type(integer) :: NPEs_Z ! Number of PEs in Z.
! Structure length vectors, which give numbers for all PEs.
type(integer,1) :: NCells_Vector ! Number of cells.
type(integer,1) :: NCells_X_Vector ! Number of cells in the X direction.
type(integer,1) :: NCells_Y_Vector ! Number of cells in the Y direction.
type(integer,1) :: NCells_Z_Vector ! Number of cells in the Z direction.
type(integer,1) :: NFaces_Vector ! Number of faces.
type(integer,1) :: NNodes_Vector ! Number of nodes.
type(integer,1) :: NNodes_X_Vector ! Number of nodes in the X direction.
type(integer,1) :: NNodes_Y_Vector ! Number of nodes in the Y direction.
type(integer,1) :: NNodes_Z_Vector ! Number of nodes in the Z direction.
! Location of this_PE in the PE-mesh.
type(integer) :: this_PE_X, this_PE_Y, this_PE_Z
type(integer) :: node, pe_x, pe_y, pe_z ! Loop parameters.
! Offsets - starting points for this PE.
type(real) :: Offset_PE_X, Offset_PE_Y, Offset_PE_Z ! 1st node coordinates.
! 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
! The cells for the cells (that is, across each face) on this PE.
type(integer,2) :: Cells_of_Cells_PE
! Face Flags for Structured Meshes.
type(integer,2) :: Flag_Faces_of_Cells
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Verify requirements.
! Mesh type info is valid.
VERIFY(NDimensions .InInterval. (/1, 3/),5)
VERIFY(SIZE(Lengths) == NDimensions,5) ! Lengths is correct size.
! Allocations and initializations.
call Initialize (allocate_status)
call Initialize (consolidated_status)
! Generate the connectivity.
call Gen_StructureMesh_Connectivity (NDimensions, Lengths, &
NCells_X_total, NCells_Y_total, NCells_Z_total, Shape, Structure, AMR, &
NPEs_X, NPEs_Y, NPEs_Z, this_PE_X, this_PE_Y, this_PE_Z, &
NNodes_Vector, NCells_Vector, NFaces_Vector, &
NCells_X_Vector, NCells_Y_Vector, NCells_Z_Vector, &
NNodes_X_Vector, NNodes_Y_Vector, NNodes_Z_Vector, &
Nodes_of_Cells_PE, Cells_of_Cells_PE, Flag_Faces_of_Cells, &
allocate_status(1))
! Set mesh type info for a Uniform Mesh.
Geometry = 'Cartesian'
Uniformity = 'Uniform'
Orthogonality = 'Orthogonal'
! Set Offsets for coordinates on this PE.
if (this_PE_X == 1) then
Offset_PE_X = zero
else
Offset_PE_X = SUM(NCells_X_Vector(1:this_PE_X-1)) * &
Lengths(1) / NCells_X_total
end if
if (NDimensions >= 2) then
if (this_PE_Y == 1) then
Offset_PE_Y = zero
else
Offset_PE_Y = SUM(NCells_Y_Vector(1:this_PE_Y-1)) * &
Lengths(2) / NCells_Y_total
end if
end if
if (NDimensions == 3) then
if (this_PE_Z == 1) then
Offset_PE_Z = zero
else
Offset_PE_Z = SUM(NCells_Z_Vector(1:this_PE_Z-1)) * &
Lengths(3) / NCells_Z_total
end if
end if
! Set Node Coordinates on this PE.
call Initialize (Coordinates_Nodes_PE, NDimensions, &
NNodes_Vector(this_PE), allocate_status(2))
node = 1
do pe_z = 1, NNodes_Z_Vector(this_PE_Z)
do pe_y = 1, NNodes_Y_Vector(this_PE_Y)
do pe_x = 1, NNodes_X_Vector(this_PE_X)
Coordinates_Nodes_PE(1,node) = &
Offset_PE_X + (pe_x-1) * Lengths(1) / NCells_X_total
if (NDimensions >= 2) then
Coordinates_Nodes_PE(2,node) = &
Offset_PE_Y + (pe_y-1) * Lengths(2) / NCells_Y_total
end if
if (NDimensions == 3) then
Coordinates_Nodes_PE(3,node) = &
Offset_PE_Z + (pe_z-1) * Lengths(3) / NCells_Z_total
end if
! Increment node.
node = node + 1
end do
end do
end do
VERIFY((node-1)==NNodes_Vector(this_PE),5)
! Initialize the Multi-Mesh object.
call 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, &
allocate_status(3))
! Set Mesh%Cells_of_Cells_Index and Mesh%Flag_Faces_of_Cells.
call Initialize (Mesh%Cells_of_Cells_Index, Mesh%Cell_Structure, &
Mesh%Cell_Structure, &
Many_of_One_Array=Cells_of_Cells_PE, &
status=allocate_status(4))
call Initialize (Mesh%Flag_Faces_of_Cells, NCells_Vector(this_PE), &
NDimensions*2, allocate_status(5))
Mesh%Flag_Faces_of_Cells = Flag_Faces_of_Cells
! Set Uniform-mesh specific variables.
! Set physical dimensions of the mesh (Lengths).
call Initialize (Mesh%Lengths, NDimensions, allocate_status(6))
Mesh%Lengths = Lengths
! Set volume for all cells.
select case (NDimensions)
case (1)
! Suppressed Y, Z.
Mesh%Volume_All_Cells = Lengths(1) / NCells_X_total
case (2)
! Suppressed Z.
Mesh%Volume_All_Cells = Lengths(1) / NCells_X_total * &
Lengths(2) / NCells_Y_total
case (3)
Mesh%Volume_All_Cells = Lengths(1) / NCells_X_total * &
Lengths(2) / NCells_Y_total * &
Lengths(3) / NCells_Z_total
end select
! Set area for all faces (3 types in 3-D).
call Initialize (Mesh%Area_All_Faces, NDimensions, allocate_status(7))
select case (NDimensions)
case (1)
! Suppressed Y, Z.
Mesh%Area_All_Faces(1) = one
case (2)
! Suppressed Z.
Mesh%Area_All_Faces(1) = Lengths(2) / NCells_Y_total
Mesh%Area_All_Faces(2) = Lengths(1) / NCells_X_total
case (3)
Mesh%Area_All_Faces(1) = Lengths(2) / NCells_Y_total * &
Lengths(3) / NCells_Z_total
Mesh%Area_All_Faces(2) = Lengths(1) / NCells_X_total * &
Lengths(3) / NCells_Z_total
Mesh%Area_All_Faces(3) = Lengths(1) / NCells_X_total * &
Lengths(2) / NCells_Y_total
end select
! Finalize temporary variables.
call Finalize (Cells_of_Cells_PE, allocate_status(8))
call Finalize (Coordinates_Nodes_PE, allocate_status(9))
call Finalize (Flag_Faces_of_Cells, allocate_status(10))
call Finalize (NCells_Vector, allocate_status(11))
call Finalize (NCells_X_Vector, allocate_status(12))
call Finalize (NCells_Y_Vector, allocate_status(13))
call Finalize (NCells_Z_Vector, allocate_status(14))
call Finalize (NFaces_Vector, allocate_status(15))
call Finalize (NNodes_Vector, allocate_status(16))
call Finalize (NNodes_X_Vector, allocate_status(17))
call Finalize (NNodes_Y_Vector, allocate_status(18))
call Finalize (NNodes_Z_Vector, allocate_status(19))
call Finalize (Nodes_of_Cells_PE, allocate_status(20))
! 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)
end subroutine Initialize_Uniform_Multi_Mesh