arrow Subroutine

public subroutine arrow(base, direction, body_length, head_length, body_radius, head_radius, n_segments, xyz, normals, uv, indices)

An arrow (OpenFrames' Vector: a cylinder body and a cone head) from base along direction: body of length body_length and radius body_radius, then a head of length head_length and base radius head_radius, closed at the bottom of the body and of the head, with n_segments around. Triangles are counter-clockwise seen from outside; indices are 0-based; uv is zero. Sizes are given by arrow_size.

Arguments

Type IntentOptional Attributes Name
real(kind=c_double), intent(in) :: base(3)

the arrow's base (start of the body)
real(kind=c_double), intent(in) :: direction(3)

the arrow's axis (need not be unit length)
real(kind=c_double), intent(in) :: body_length

lengths along the axis, and radii
real(kind=c_double), intent(in) :: head_length

lengths along the axis, and radii
real(kind=c_double), intent(in) :: body_radius

lengths along the axis, and radii
real(kind=c_double), intent(in) :: head_radius

lengths along the axis, and radii
integer, intent(in) :: n_segments

segments around
real(kind=c_float), intent(out), dimension(:,:) :: xyz

(3, n_vertices)
real(kind=c_float), intent(out), dimension(:,:) :: normals

(3, n_vertices)
real(kind=c_float), intent(out), dimension(:,:) :: uv

(2, n_vertices): zero
integer(kind=c_int32_t), intent(out), dimension(:) :: indices

(n_indices)

Calls

proc~~arrow~~CallsGraph proc~arrow arrow proc~cross cross proc~arrow->proc~cross

Called by

proc~~arrow~~CalledByGraph proc~arrow arrow proc~arrow_create arrow_create proc~arrow_create->proc~arrow proc~unit_part unit_part proc~unit_part->proc~arrow proc~make_axis make_axis proc~make_axis->proc~arrow_create proc~vector_build_contents VectorHandle%vector_build_contents proc~vector_build_contents->proc~unit_part proc~build_decorations build_decorations proc~build_decorations->proc~make_axis proc~move_axis move_axis proc~move_axis->proc~make_axis proc~remake_axes remake_axes proc~remake_axes->proc~make_axis proc~set_x_label ReferenceFrame%set_x_label proc~set_x_label->proc~make_axis proc~set_y_label ReferenceFrame%set_y_label proc~set_y_label->proc~make_axis proc~set_z_label ReferenceFrame%set_z_label proc~set_z_label->proc~make_axis proc~move_x_axis ReferenceFrame%move_x_axis proc~move_x_axis->proc~move_axis proc~move_y_axis ReferenceFrame%move_y_axis proc~move_y_axis->proc~move_axis proc~move_z_axis ReferenceFrame%move_z_axis proc~move_z_axis->proc~move_axis proc~realize ReferenceFrame%realize proc~realize->proc~build_decorations proc~realize->proc~realize proc~relayout_labels relayout_labels proc~relayout_labels->proc~remake_axes proc~set_color~2 ReferenceFrame%set_color proc~set_color~2->proc~remake_axes proc~set_label_font ReferenceFrame%set_label_font proc~set_label_font->proc~remake_axes proc~add_child ReferenceFrame%add_child proc~add_child->proc~realize proc~axes_set_color CoordinateAxes%axes_set_color proc~axes_set_color->proc~set_color~2 proc~frame WindowProxy%frame proc~frame->proc~realize proc~grid_set_color LatLonGrid%grid_set_color proc~grid_set_color->proc~set_color~2 proc~new_reference_frame new_reference_frame proc~new_reference_frame->proc~set_color~2 proc~place_axes place_axes proc~place_axes->proc~move_x_axis proc~place_axes->proc~move_y_axis proc~place_axes->proc~move_z_axis proc~place_grid_axes place_grid_axes proc~place_grid_axes->proc~move_x_axis proc~place_grid_axes->proc~move_y_axis proc~place_grid_axes->proc~move_z_axis proc~segments_set_color CustomLineSegments%segments_set_color proc~segments_set_color->proc~set_color~2 proc~set_label_alignment ReferenceFrame%set_label_alignment proc~set_label_alignment->proc~relayout_labels proc~set_label_size ReferenceFrame%set_label_size proc~set_label_size->proc~relayout_labels proc~sphere_set_color Sphere%sphere_set_color proc~sphere_set_color->proc~set_color~2 proc~time_set_color TimeHandle%time_set_color proc~time_set_color->proc~set_color~2 proc~vector_set_color VectorHandle%vector_set_color proc~vector_set_color->proc~set_color~2 interface~referenceframe ReferenceFrame interface~referenceframe->proc~new_reference_frame proc~grid_set_parameters LatLonGrid%grid_set_parameters proc~grid_set_parameters->proc~place_grid_axes proc~new_coordinate_axes new_coordinate_axes proc~new_coordinate_axes->proc~place_axes proc~new_lat_lon_grid new_lat_lon_grid proc~new_lat_lon_grid->proc~place_grid_axes proc~new_radial_plane new_radial_plane proc~new_radial_plane->proc~place_axes proc~plane_set_parameters RadialPlane%plane_set_parameters proc~plane_set_parameters->proc~place_axes proc~resize WindowProxy%resize proc~resize->proc~frame proc~run WindowProxy%run proc~run->proc~frame proc~set_axis_length CoordinateAxes%set_axis_length proc~set_axis_length->proc~place_axes interface~coordinateaxes CoordinateAxes interface~coordinateaxes->proc~new_coordinate_axes interface~latlongrid LatLonGrid interface~latlongrid->proc~new_lat_lon_grid interface~radialplane RadialPlane interface~radialplane->proc~new_radial_plane

Source Code

    subroutine arrow(base, direction, body_length, head_length, body_radius, head_radius, n_segments, &
                          xyz, normals, uv, indices)
        real(c_double), intent(in) :: base(3)           !! the arrow's base (start of the body)
        real(c_double), intent(in) :: direction(3)      !! the arrow's axis (need not be unit length)
        real(c_double), intent(in) :: body_length, head_length, body_radius, head_radius !! lengths along the axis, and radii
        integer, intent(in) :: n_segments               !! segments around
        real(c_float), dimension(:,:), intent(out) :: xyz       !! (3, n_vertices)
        real(c_float), dimension(:,:), intent(out) :: normals   !! (3, n_vertices)
        real(c_float), dimension(:,:), intent(out) :: uv        !! (2, n_vertices): zero
        integer(c_int32_t), dimension(:), intent(out) :: indices    !! (n_indices)
        real(c_double), parameter :: pi = acos(-1.0_c_double)
        real(c_double) :: w(3), u(3), v(3), r(3), a, cone_normal(3)
        integer :: i, n, nv, ni, body0, cap0, head0, apex0, disk0

        n = n_segments
        w = direction / norm2(direction)
        u = cross(w, [1.0_c_double, 0.0_c_double, 0.0_c_double])
        if (norm2(u) < 1.0e-6_c_double) u = cross(w, [0.0_c_double, 1.0_c_double, 0.0_c_double])
        u = u / norm2(u)
        v = cross(w, u)
        uv = 0.0_c_float
        nv = 0
        ni = 0

        ! body side: rings at the base and the top of the body
        body0 = nv
        do i = 0, n
            r = radial(i)
            call put(base + body_radius * r, r)
            call put(base + body_radius * r + body_length * w, r)
        end do
        ! body bottom cap (facing -w): center, then a ring
        cap0 = nv
        call put(base, -w)
        do i = 0, n
            call put(base + body_radius * radial(i), -w)
        end do
        ! head side: ring at the head's base, and the apex for each segment
        head0 = nv
        do i = 0, n
            r = radial(i)
            cone_normal = r * head_length + w * head_radius
            call put(base + body_length * w + head_radius * r, cone_normal / norm2(cone_normal))
        end do
        apex0 = nv
        do i = 0, n
            a = 2.0_c_double * pi * (real(i, c_double) + 0.5_c_double) / real(n, c_double)
            r = cos(a) * u + sin(a) * v
            cone_normal = r * head_length + w * head_radius
            call put(base + (body_length + head_length) * w, cone_normal / norm2(cone_normal))
        end do
        ! head base disk (facing -w): center, then a ring
        disk0 = nv
        call put(base + body_length * w, -w)
        do i = 0, n
            call put(base + body_length * w + head_radius * radial(i), -w)
        end do

        do i = 0, n - 1
            ! body side: (a_i, a_i+1, b_i+1) and (a_i, b_i+1, b_i)
            call tri(body0 + 2*i, body0 + 2*(i+1), body0 + 2*(i+1) + 1)
            call tri(body0 + 2*i, body0 + 2*(i+1) + 1, body0 + 2*i + 1)
            ! caps facing -w: (center, ring_i+1, ring_i)
            call tri(cap0, cap0 + 1 + i + 1, cap0 + 1 + i)
            call tri(disk0, disk0 + 1 + i + 1, disk0 + 1 + i)
            ! head side: (ring_i, ring_i+1, apex_i)
            call tri(head0 + i, head0 + i + 1, apex0 + i)
        end do

    contains

        !> The unit vector at angle 2 pi k / n around the arrow's axis.
        pure function radial(k) result(rad)
            integer, intent(in) :: k                            !! index of the angle 2 pi k / n (0 to n)
            real(c_double) :: rad(3), ang
            ang = 2.0_c_double * pi * real(k, c_double) / real(n, c_double)
            rad = cos(ang) * u + sin(ang) * v
        end function radial

        !> Append a vertex at `p` with normal `nrm`.
        subroutine put(p, nrm)
            real(c_double), intent(in) :: p(3), nrm(3)          !! the vertex, and its unit normal
            nv = nv + 1
            xyz(:, nv) = real(p, c_float)
            normals(:, nv) = real(nrm, c_float)
        end subroutine put

        !> Append a triangle of (0-based) vertex indices i1, i2, i3.
        subroutine tri(i1, i2, i3)
            integer, intent(in) :: i1, i2, i3                   !! vertex indices (0-based), counterclockwise from outside
            indices(ni+1:ni+3) = int([i1, i2, i3], c_int32_t)
            ni = ni + 3
        end subroutine tri

    end subroutine arrow