Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(vector), | target | :: | verts(0:) | |||
integer | :: | nverts | ||||
type(planeeq) | :: | plane | ||||
logical | :: | error |
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 PlaneEquation(verts,nverts,plane,error)
! PURPOSE OF THIS SUBROUTINE:
! This subroutine calculates the plane equation for a given
! surface (which should be planar).
! REFERENCE:
! Graphic Gems
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
integer :: nverts ! Number of vertices in the surface
type(vector),target :: verts(0:) ! Structure of the surface !Objexx:Arg Changed verts(0:nverts-1) to assumed shape for compatibility with passed allocatable
type(planeeq) :: plane ! Equation of plane from inputs
logical :: error ! returns true for degenerate surface
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
type(vector) :: normal
INTEGER :: i
type(vector) :: refpt
real(r64) :: lenvec
type(vector),POINTER :: u,v
! - - - begin - - -
normal=vector(0.0d0,0.0d0,0.0d0)
refpt=vector(0.0d0,0.0d0,0.0d0)
DO i = 0,nverts-1
u => verts(i)
if (i < nverts-1) then
v => verts(i+1)
else
v => verts(0)
endif
normal%x=normal%x + (u%y-v%y)*(u%z+v%z)
normal%y=normal%y + (u%z-v%z)*(u%x+v%x)
normal%z=normal%z + (u%x-v%x)*(u%y+v%y)
refpt=refpt+u
END DO
! /* normalize the polygon normal to obtain the first
! three coefficients of the plane equation
! */
lenvec=VecLength(normal)
error=.false.
if (lenvec /= 0.0d0) then ! should this be >0
plane%x = normal%x / lenvec
plane%y = normal%y / lenvec
plane%z = normal%z / lenvec
! /* compute the last coefficient of the plane equation */
lenvec=lenvec * nverts
plane%w = -(refpt.dot.normal) / lenvec
else
error=.true.
endif
END SUBROUTINE PlaneEquation