Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer | :: | nsides | ||||
type(vector), | dimension(nsides) | :: | polygon | |||
type(dTriangle), | allocatable, dimension(:) | :: | outtriangles | |||
real(kind=r64) | :: | surfazimuth | ||||
real(kind=r64) | :: | surftilt | ||||
character(len=*) | :: | surfname | ||||
integer | :: | surfclass |
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.
Integer Function Triangulate(nsides,polygon,outtriangles,surfazimuth,surftilt,surfname,surfclass)
! Subroutine information:
! Author Linda Lawrie
! Date written October 2005
! Modified na
! Re-engineered na
! Purpose of this subroutine:
! This routine is a self-contained triangulation calculation from a polygon
! of 3D vertices, nsides, to a returned set (as possible) of triangles -- noted
! by vertex numbers.
! Methodology employed:
! <Description>
! References:
! na
! Use statements:
USE DataInterfaces, ONLY: ShowWarningError,ShowMessage,ShowContinueError
USE DataGlobals, ONLY: DisplayExtraWarnings
USE DataSurfaces, ONLY: cSurfaceClass,SurfaceClass_Floor,SurfaceClass_Roof,SurfaceClass_Overhang
USE General, ONLY: RoundSigDigits
implicit none ! Enforce explicit typing of all variables in this routine
! Subroutine argument definitions:
integer nsides ! number of sides to polygon
type (vector), dimension(nsides) :: polygon
type (dTriangle), allocatable, dimension(:) :: outtriangles
real(r64) :: surftilt ! surface tilt angle
real(r64) :: surfazimuth ! surface azimuth angle (outward facing normal)
character(len=*) :: surfname ! surface name (for error messages)
integer :: surfclass ! surface class
! Subroutine parameter definitions:
real(r64) , parameter :: point_tolerance=.00001d0
real(r64) , parameter :: twopiang=(180.d0/radtodeg)
! Interface block specifications:
! na
! Derived type definitions:
! na
! Subroutine local variable declarations:
logical :: errflag
integer ears(nsides)
integer r_angles(nsides)
real(r64) rangles(nsides)
integer c_vertices(nsides)
integer earvert(3,nsides)
logical removed(nsides)
type(Vector_2d), dimension(nsides) :: vertex
!unused type(Vector_2d), dimension(3) :: testtri
!unused type(Vector_2d) :: point
integer earverts(3)
real(r64) xvt(nsides)
real(r64) yvt(nsides)
real(r64) zvt(nsides)
type (dTriangle), dimension(nsides) :: Triangle
!'General Variables
integer i
integer j
!unused integer k
integer ntri
!unused logical inpoly
integer nvertcur
integer ncount
integer svert
integer mvert
integer evert
!unused integer tvert
integer nears
integer nrangles
integer ncverts
!unused double precision :: ang
!unused double precision :: val
character(len=200) :: line
integer, save :: errcount=0
errflag=.false.
! vertex=polygon
! if (surfname == 'BOTTOM:OFFICE_E_3') THEN
! trackit=.true.
! else
! trackit=.false.
! endif
if (surfclass == SurfaceClass_Floor .or. surfclass == SurfaceClass_Roof .or. &
surfclass == SurfaceClass_Overhang) then
CALL CalcRfFlrCoordinateTransformation(nsides,polygon,surfazimuth,surftilt,xvt,yvt,zvt)
do svert=1,nsides
do mvert=svert+1,nsides
if (abs(xvt(svert)-xvt(mvert)) <= point_tolerance) xvt(svert)=xvt(mvert)
if (abs(zvt(svert)-zvt(mvert)) <= point_tolerance) zvt(svert)=zvt(mvert)
enddo
enddo
do svert=1,nsides
vertex(svert)%x=xvt(svert)
vertex(svert)%y=zvt(svert)
! if (trackit) write(outputfiledebug,*) 'x=',xvt(svert),' y=',zvt(svert)
enddo
else
CALL CalcWallCoordinateTransformation(nsides,polygon,surfazimuth,surftilt,xvt,yvt,zvt)
do svert=1,nsides
do mvert=svert+1,nsides
if (abs(xvt(svert)-xvt(mvert)) <= point_tolerance) xvt(svert)=xvt(mvert)
if (abs(zvt(svert)-zvt(mvert)) <= point_tolerance) zvt(svert)=zvt(mvert)
enddo
enddo
do svert=1,nsides
vertex(svert)%x=xvt(svert)
vertex(svert)%y=zvt(svert)
enddo
endif
! find ears
nvertcur=nsides
ncount=0
svert=1
mvert=2
evert=3
removed=.false.
do while(nvertcur > 3)
call generate_ears(nsides, vertex, ears, nears, r_angles, nrangles, c_vertices, ncverts, removed, earverts,rangles)
if (.not. any(ears > 0)) then
call showwarningerror('DXFOut: Could not triangulate surface="'//trim(surfname)// &
'", type="'//trim(cSurfaceClass(surfclass))//'", check surface vertex order(entry)')
errcount=errcount+1
if (errcount == 1 .and. .not. DisplayExtraWarnings) then
call showcontinueerror('...use Output:Diagnostics,DisplayExtraWarnings; to show more details on individual surfaces.')
endif
if (DisplayExtraWarnings) then
write(line,*) 'surface=',trim(surfname),' class=',trim(cSurfaceClass(surfclass))
call showmessage(trim(line))
do j=1,nsides
! write(line,"(' side=',i2,' (',2(f6.1,','),f6.1,')')") j,polygon(j)
line=' side='//trim(roundsigdigits(j))//' ('//trim(roundsigdigits(polygon(j)%x,1))//','// &
trim(roundsigdigits(polygon(j)%y,1))//','//trim(roundsigdigits(polygon(j)%z,1))//')'
call showmessage(trim(line))
enddo
write(line,*) 'number of triangles found=',ncount
call showmessage(trim(line))
do j=1,nrangles
! write(line,"(' r angle=',i2,' vert=',i2,' deg=',f6.1)") j,r_angles(j),rangles(j)*radtodeg
line=' r angle='//trim(roundsigdigits(j))//' vert='//trim(roundsigdigits(r_angles(j)))//' deg='// &
trim(roundsigdigits(rangles(j)*radtodeg,1))
call showmessage(trim(line))
enddo
endif
exit ! while loop
endif
if (nears > 0) then
svert=earverts(1)
mvert=earverts(2)
evert=earverts(3)
! remove ear
ncount=ncount+1
removed(mvert)=.true.
earvert(1,ncount)=svert
earvert(2,ncount)=mvert
earvert(3,ncount)=evert
nvertcur=nvertcur-1
endif
if (nvertcur == 3) then
j=1
ncount=ncount+1
do i=1,nsides
if (removed(i)) cycle
earvert(j,ncount)=i
j=j+1
enddo
endif
enddo
ntri = ncount
do i=1,ntri
Triangle(i)%vv0=earvert(1,i)
Triangle(i)%vv1=earvert(2,i)
Triangle(i)%vv2=earvert(3,i)
enddo
allocate(outtriangles(ntri))
do i=1,ntri
outtriangles(i)=triangle(i)
enddo
Triangulate = ntri
End Function Triangulate