set_faces Subroutine

private subroutine set_faces(self, vertices, faces, sizes)

Faces given as polygons: faces the vertex numbers (1-based) of each polygon in turn, sizes how many each has (>= 3; convex, or at least star-shaped from its first vertex: drawn as a fan of triangles from it); the edges are the polygons' sides. E.g. a cube: 8 vertices, 6 faces of 4. A face's front: its vertices counterclockwise.

Type Bound

Polyhedron

Arguments

Type IntentOptional Attributes Name
class(Polyhedron), intent(inout) :: self
real(kind=wp), intent(in) :: vertices(:,:)

(3, n), frame coordinates
integer, intent(in) :: faces(:)

(sum(sizes)) vertex numbers
integer, intent(in) :: sizes(:)

each face's number of vertices

Calls

proc~~set_faces~~CallsGraph proc~set_faces Polyhedron%set_faces proc~drop_colors drop_colors proc~set_faces->proc~drop_colors proc~make_polyhedron make_polyhedron proc~set_faces->proc~make_polyhedron proc~unique_edges unique_edges proc~set_faces->proc~unique_edges interface~vkf_switch_create vkf_switch_create proc~make_polyhedron->interface~vkf_switch_create proc~add add proc~make_polyhedron->proc~add proc~line_node line_node proc~make_polyhedron->proc~line_node proc~marker_node marker_node proc~make_polyhedron->proc~marker_node proc~replace ShapeNodes%replace proc~make_polyhedron->proc~replace proc~surface_node surface_node proc~make_polyhedron->proc~surface_node proc~unit_normal unit_normal proc~make_polyhedron->proc~unit_normal proc~vertex_normals vertex_normals proc~make_polyhedron->proc~vertex_normals proc~vertices_sphere vertices_sphere proc~make_polyhedron->proc~vertices_sphere proc~sort_keys sort_keys proc~unique_edges->proc~sort_keys interface~vkf_node_add_child vkf_node_add_child proc~add->interface~vkf_node_add_child interface~vkf_node_delete vkf_node_delete proc~add->interface~vkf_node_delete proc~check_status check_status proc~add->proc~check_status interface~vkf_line_create vkf_line_create proc~line_node->interface~vkf_line_create proc~line_node->proc~check_status proc~line_set_points line_set_points proc~line_node->proc~line_set_points proc~line_set_segments line_set_segments proc~line_node->proc~line_set_segments proc~line_set_style line_set_style proc~line_node->proc~line_set_style interface~vkf_marker_create vkf_marker_create proc~marker_node->interface~vkf_marker_create proc~marker_node->proc~check_status proc~marker_node->proc~line_set_points proc~marker_set_style marker_set_style proc~marker_node->proc~marker_set_style interface~vkf_compile_node vkf_compile_node proc~replace->interface~vkf_compile_node proc~replace->interface~vkf_node_add_child proc~replace->interface~vkf_node_delete interface~vkf_node_remove_child vkf_node_remove_child proc~replace->interface~vkf_node_remove_child proc~replace->proc~check_status interface~vkf_mesh_array vkf_mesh_array proc~surface_node->interface~vkf_mesh_array interface~vkf_mesh_create vkf_mesh_create proc~surface_node->interface~vkf_mesh_create interface~vkf_mesh_set_bound vkf_mesh_set_bound proc~surface_node->interface~vkf_mesh_set_bound proc~surface_node->proc~check_status proc~mesh_arrays mesh_arrays proc~surface_node->proc~mesh_arrays proc~cross cross proc~unit_normal->proc~cross proc~vertex_normals->proc~cross interface~vkf_line_points vkf_line_points proc~line_set_points->interface~vkf_line_points interface~vkf_line_points_changed vkf_line_points_changed proc~line_set_points->interface~vkf_line_points_changed interface~vkf_line_style vkf_line_style proc~line_set_segments->interface~vkf_line_style interface~vkf_line_style_changed vkf_line_style_changed proc~line_set_segments->interface~vkf_line_style_changed proc~line_set_style->interface~vkf_line_style proc~line_set_style->interface~vkf_line_style_changed proc~marker_set_style->interface~vkf_line_style proc~marker_set_style->interface~vkf_line_style_changed proc~mesh_arrays->interface~vkf_mesh_array

Source Code

    subroutine set_faces(self, vertices, faces, sizes)
        class(Polyhedron), intent(inout) :: self
        real(wp), intent(in) :: vertices(:,:)               !! (3, n), frame coordinates
        integer, intent(in) :: faces(:)                     !! (sum(sizes)) vertex numbers
        integer, intent(in) :: sizes(:)                     !! each face's number of vertices
        integer :: f, k, j, nt, ne, first
        integer, allocatable :: sides(:,:)
        self%v = vertices
        nt = sum(max(sizes - 2, 0))
        if (allocated(self%tri)) deallocate(self%tri)
        allocate(self%tri(3, nt), sides(2, sum(sizes)))
        nt = 0
        ne = 0
        first = 0
        do f = 1, size(sizes)
            do k = 2, sizes(f) - 1                          ! a fan from the first vertex
                nt = nt + 1
                self%tri(:, nt) = [faces(first + 1), faces(first + k), faces(first + k + 1)]
            end do
            do k = 1, sizes(f)
                j = modulo(k, sizes(f)) + 1
                ne = ne + 1
                sides(:, ne) = [faces(first + k), faces(first + j)]
            end do
            first = first + sizes(f)
        end do
        self%edge = unique_edges(sides(:, 1:ne), size(vertices, 2))
        call drop_colors(self)
        call make_polyhedron(self)
    end subroutine set_faces