set_grid Subroutine

private subroutine set_grid(self, points, closed_u, closed_v, lines)

Faces given as a grid of points (3, nu, nv): quadrilaterals between neighbours (two triangles each), joined around if closed_u (the last point i to the first, for each j; e.g. a tube's circumference) or closed_v. The edges: the grid's lines, those of constant i (along j) every lines(1) and of constant j (along i) every lines(2) (default: every one; 0 for none).

Type Bound

Polyhedron

Arguments

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

(3, nu, nv), frame coordinates
logical, intent(in), optional :: closed_u

joined around in i, in j (default false)
logical, intent(in), optional :: closed_v

joined around in i, in j (default false)
integer, intent(in), optional :: lines(2)

edges every lines(1) in i, lines(2) in j (default 1; 0: none)

Calls

proc~~set_grid~~CallsGraph proc~set_grid Polyhedron%set_grid proc~drop_colors drop_colors proc~set_grid->proc~drop_colors proc~make_polyhedron make_polyhedron proc~set_grid->proc~make_polyhedron 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 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_grid(self, points, closed_u, closed_v, lines)
        class(Polyhedron), intent(inout) :: self
        real(wp), intent(in) :: points(:,:,:)               !! (3, nu, nv), frame coordinates
        logical, intent(in), optional :: closed_u, closed_v !! joined around in i, in j (default false)
        integer, intent(in), optional :: lines(2)           !! edges every lines(1) in i, lines(2) in j (default 1; 0: none)
        integer :: nu, nv, mu, mv, i, j, i2, j2, nt, ne, every(2)
        logical :: cu, cv
        nu = size(points, 2)
        nv = size(points, 3)
        cu = .false.
        cv = .false.
        if (present(closed_u)) cu = closed_u .and. nu > 2
        if (present(closed_v)) cv = closed_v .and. nv > 2
        every = 1
        if (present(lines)) every = max(lines, 0)
        self%v = reshape(points, [3, nu * nv])
        mu = merge(nu, nu - 1, cu)                          ! quadrilaterals along i, j
        mv = merge(nv, nv - 1, cv)
        if (allocated(self%tri)) deallocate(self%tri)
        allocate(self%tri(3, 2 * max(mu, 0) * max(mv, 0)))
        nt = 0
        do j = 1, mv
            j2 = modulo(j, nv) + 1
            do i = 1, mu
                i2 = modulo(i, nu) + 1
                self%tri(:, nt + 1) = [at(i, j), at(i2, j), at(i2, j2)]
                self%tri(:, nt + 2) = [at(i, j), at(i2, j2), at(i, j2)]
                nt = nt + 2
            end do
        end do
        if (allocated(self%edge)) deallocate(self%edge)
        allocate(self%edge(2, nu * nv * 2))
        ne = 0
        if (every(1) > 0) then                              ! lines of constant i, along j
            do i = 1, nu
                if (.not. shown_line(i, nu, every(1), cu)) cycle
                do j = 1, mv
                    ne = ne + 1
                    self%edge(:, ne) = [at(i, j), at(i, modulo(j, nv) + 1)]
                end do
            end do
        end if
        if (every(2) > 0) then                              ! lines of constant j, along i
            do j = 1, nv
                if (.not. shown_line(j, nv, every(2), cv)) cycle
                do i = 1, mu
                    ne = ne + 1
                    self%edge(:, ne) = [at(i, j), at(modulo(i, nu) + 1, j)]
                end do
            end do
        end if
        self%edge = self%edge(:, 1:ne)
        call drop_colors(self)
        call make_polyhedron(self)

    contains

        pure integer function at(i_, j_)
            integer, intent(in) :: i_, j_                       !! grid indices
            at = i_ + (j_ - 1) * nu
        end function at

        !> Line k of n drawn, every `step` (and the last, if the grid is open).
        pure logical function shown_line(k, n, step, closed)
            integer, intent(in) :: k, n, step                   !! the line, number of lines, and spacing
            logical, intent(in) :: closed                       !! the grid is joined around (else the last line drawn too)
            shown_line = modulo(k - 1, step) == 0 .or. (k == n .and. .not. closed)
        end function shown_line

    end subroutine set_grid