Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer | :: | nvert | ||||
type(Vector_2d), | dimension(nvert) | :: | vertex | |||
integer | :: | ears(nvert) | ||||
integer | :: | nears | ||||
integer | :: | r_vertices(nvert) | ||||
integer | :: | nrverts | ||||
integer | :: | c_vertices(nvert) | ||||
integer | :: | ncverts | ||||
logical | :: | removed(nvert) | ||||
integer | :: | earvert(3) | ||||
real(kind=r64) | :: | rangles(nvert) |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
subroutine generate_ears(nvert, vertex, ears, nears, r_vertices, nrverts, c_vertices, ncverts, removed, earvert, rangles)
! Subroutine information:
! Author Linda Lawrie
! Date written October 2005
! Modified na
! Re-engineered na
! Purpose of this subroutine:
! This routine generates "ears", "reflex angles" and "convex angles" of the polygon
! based on the method set for in the reference.
! Methodology employed:
! No elegance used here. Always starts with first vertex in polygon.
! References:
! Geometric Tools for Computer Graphics, Philip Schneider, David Eberly. 2003. Ear
! clipping for triangulation is described in Chapter 13 on Polygon Partitioning. Also
! described in a small article "Triangulation by Ear Clipping", David Eberly, http://www.geometrictools.com
! Use statements:
! na
implicit none ! Enforce explicit typing of all variables in this routine
! Subroutine argument definitions:
integer :: nvert ! number of vertices in polygon
type(Vector_2d), dimension(nvert) :: vertex
integer :: ears(nvert) ! number of ears possible (dimensioned to nvert)
integer :: nears ! number of ears found
integer :: r_vertices(nvert) ! number of reflex vertices (>180) possible
integer :: nrverts ! number of reflex vertices found (>=180)
integer :: c_vertices(nvert) ! number of convex vertices
integer :: ncverts ! number of convex vertices found (< 180)
logical :: removed(nvert) ! array that shows if a vertex has been removed (calling routine)
integer :: earvert(3) ! vertex indicators for first ear
real(r64) :: rangles(nvert)
! Subroutine parameter definitions:
real(r64),parameter :: twopi_rad=(180.d0/radtodeg)
! Interface block specifications:
! na
! Derived type definitions:
! na
! Subroutine local variable declarations:
integer :: svert ! starting vertex
integer :: mvert ! "middle" vertex (this will be an ear, if calculated)
integer :: evert ! ending vertex
real(r64) :: ang ! ang between
integer tvert ! test vertex, intermediate use
logical inpoly ! in polygon or not
type(Vector_2d) point ! structure for point
type(Vector_2d) testtri(3) ! structure for triangle
integer j ! loop counter
! initialize, always recalculate
ears=0
r_vertices=0
rangles=0.0d0
nears=0
nrverts=0
c_vertices=0
ncverts=0
do svert=1,nvert
if (removed(svert)) cycle
! have starting vertex. now need middle and end
mvert=svert+1
do j=1,nvert
if (mvert > nvert) mvert=1
if (removed(mvert)) then
mvert=mvert+1
if (mvert > nvert) mvert=1
else
exit
endif
enddo
evert=mvert+1
do j=1,nvert
if (evert > nvert) evert=1
if (removed(evert)) then
evert=evert+1
if (evert > nvert) evert=1
else
exit
endif
enddo
! have gotten start, middle and ending vertices. test for reflex angle
ang=angle_2dvector(vertex(svert)%x,vertex(svert)%y,vertex(mvert)%x,vertex(mvert)%y,vertex(evert)%x,vertex(evert)%y)
if (ang > twopi_rad) then ! sufficiently close to 180 degrees.
nrverts=nrverts+1
r_vertices(nrverts)=mvert
rangles(nrverts)=ang
cycle
else
ncverts=ncverts+1
c_vertices(ncverts)=mvert
endif
! convex angle, see if it's an ear
testtri(1)=vertex(svert)
testtri(2)=vertex(mvert)
testtri(3)=vertex(evert)
tvert=evert
do j=4,nvert
tvert=tvert+1
if (tvert > nvert) tvert=1
if (removed(tvert)) cycle
point=vertex(tvert)
inpoly=polygon_contains_point_2d ( 3, testtri, point)
if (.not. inpoly) cycle
exit
enddo
! if (trackit) then
! write(outputfiledebug,*) ' triangle=',svert,mvert,evert
! write(outputfiledebug,*) ' vertex1=',vertex(svert)%x,vertex(svert)%y
! write(outputfiledebug,*) ' vertex2=',vertex(mvert)%x,vertex(mvert)%y
! write(outputfiledebug,*) ' vertex3=',vertex(evert)%x,vertex(evert)%y
! write(outputfiledebug,*) ' inpoly=',inpoly
! endif
if (.not. inpoly) then
! found an ear
nears=nears+1
ears(nears)=mvert
if (nears == 1) then
earvert(1)=svert
earvert(2)=mvert
earvert(3)=evert
endif
if (trackit) then
write(outputfiledebug,*) 'ear=',nears,' triangle=',svert,mvert,evert
endif
endif
enddo
return
end subroutine generate_ears