I.1.2 Initialize_Uniform_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



Michael L. Hall