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, | intent(in) | :: | ISurf | |||
type(vector), | intent(in) | :: | Orig | |||
type(vector), | intent(in) | :: | Dir | |||
integer, | intent(out) | :: | IPIERC | |||
type(vector), | intent(out) | :: | HitPt |
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 PierceSurfaceVector(ISurf, Orig, Dir, IPIERC, HitPt)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN July 1997
! MODIFIED Sept 2003, FCW: modification of Daylighting routine DayltgPierceSurface
! June 2011, JHK: inputs made vector types; copy of routine from
! SolarReflectionManager
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Returns point CPhit that line through point R1 in direction of unit vector RN intersects
! the plan of surface ISurf. IPIERC = 1 if CPhit is inside the perimeter of ISurf. If not,
! IPIERC = 0. This routine works for convex and concave surfaces with 3 or more vertices.
!
! METHODOLOGY EMPLOYED:
! REFERENCES:
! Based on DOE-2.1E subroutine DPIERC.
! USE STATEMENTS:
USE vectors
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE PARAMETER DEFINITIONS:na
! INTERFACE BLOCK SPECIFICATIONS:na
! DERIVED TYPE DEFINITIONS:na
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ISurf ! Surface index
TYPE (vector), INTENT(IN) :: Orig ! Point from which ray originates
TYPE (vector), INTENT(IN) :: Dir ! Unit vector along in direction of ray whose
! intersection with surface is to be determined
INTEGER, INTENT(OUT) :: IPIERC ! =1 if line through point R1 in direction of unit vector
! RN intersects surface ISurf; =0 otherwise.
TYPE (vector), INTENT(OUT) :: HitPt ! Point that ray along RN intersects plane of surface
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: CPhit(3) ! Point that ray along RN intersects plane of surface
REAL(r64) :: R1(3) ! Point from which ray originates
REAL(r64) :: RN(3) ! Unit vector along in direction of ray whose
REAL(r64) :: V1(3) ! First vertex
REAL(r64) :: V2(3) ! Second vertex
REAL(r64) :: V3(3) ! Third vertex
INTEGER :: NV ! Number of vertices (3 or 4)
REAL(r64) :: A1(3) ! Vector from vertex 1 to 2
REAL(r64) :: A2(3) ! Vector from vertex 2 to 3
REAL(r64) :: AXC(3) ! Cross product of A and C
REAL(r64) :: SN(3) ! Vector normal to surface (SN = A1 X A2)
REAL(r64) :: AA(3) ! AA(I) = A(N,I)
REAL(r64) :: CC(3) ! CC(I) = C(N,I)
REAL(r64) :: CCC(3) ! Vector from vertex 2 to CP
REAL(r64) :: AAA(3) ! Vector from vertex 2 to vertex 1
REAL(r64) :: BBB(3) ! Vector from vertex 2 to vertex 3
INTEGER :: N ! Vertex loop index
INTEGER :: I ! Vertext-to-vertex index
REAL(r64) :: F1,F2 ! Intermediate variables
REAL(r64) :: SCALE ! Scale factor
REAL(r64) :: DOTCB ! Dot product of vectors CCC and BBB
REAL(r64) :: DOTCA ! Dot product of vectors CCC and AAA
REAL(r64) :: DOTAXCSN ! Dot product of vectors AXC and SN
! REAL(r64) :: V(4,3) ! Vertices of surfaces
! REAL(r64) :: A(4,3) ! Vertex-to-vertex vectors; A(1,i) is from vertex 1 to 2, etc.
! REAL(r64) :: C(4,3) ! Vectors from vertices to intersection point
REAL(r64), ALLOCATABLE, SAVE, DIMENSION(:,:) :: V ! Vertices of surfaces
REAL(r64), ALLOCATABLE, SAVE, DIMENSION(:,:) :: A ! Vertex-to-vertex vectors; A(1,i) is from vertex 1 to 2, etc.
REAL(r64), ALLOCATABLE, SAVE, DIMENSION(:,:) :: C ! Vectors from vertices to intersection point
LOGICAL,SAVE :: FirstTime=.true.
! FLOW:
IPIERC = 0
R1 = Orig
RN = Dir
! Vertex vectors
IF (FirstTime) THEN
ALLOCATE(V(MaxVerticesPerSurface,3))
V=0.0d0
ALLOCATE(A(MaxVerticesPerSurface,3))
A=0.0d0
ALLOCATE(C(MaxVerticesPerSurface,3))
C=0.0d0
FirstTime=.false.
ENDIF
NV = Surface(ISurf)%Sides
DO N = 1,NV
V(N,1) = Surface(ISurf)%Vertex(N)%X
V(N,2) = Surface(ISurf)%Vertex(N)%Y
V(N,3) = Surface(ISurf)%Vertex(N)%Z
END DO
! Vertex-to-vertex vectors. A(1,2) is from vertex 1 to 2, etc.
DO I = 1,3
DO N = 1,NV-1
A(N,I) = V(N+1,I) - V(N,I)
END DO
A(NV,I) = V(1,I) - V(NV,I)
A1(I) = A(1,I)
A2(I) = A(2,I)
V1(I) = V(1,I)
V2(I) = V(2,I)
V3(I) = V(3,I)
END DO
! Vector normal to surface
CALL CrossProduct(A1, A2, SN)
! Scale factor, the solution of SN.(CPhit-V2) = 0 and
! CPhit = R1 + SCALE*RN, where CPhit is the point that RN,
! when extended, intersects the plane of the surface.
F1 = DOT_PRODUCT(SN, V2 - R1)
F2 = DOT_PRODUCT(SN, RN)
! Skip surfaces that are parallel to RN
IF (ABS(F2) < 0.01d0) RETURN
SCALE = F1 / F2
! Skip surfaces that RN points away from
IF (SCALE <= 0.0d0) RETURN
! Point that RN intersects plane of surface
CPhit = R1 + RN * SCALE
HitPt = CPhit
! Vector from vertex 2 to CPhit
CCC = CPhit - V2
! Two cases: rectangle and non-rectangle; do rectangle
! first since most common shape and faster calculation
IF (Surface(ISurf)%Shape == Rectangle .OR. Surface(ISurf)%Shape == RectangularDoorWindow .or. &
Surface(ISurf)%Shape == RectangularOverhang .OR. Surface(ISurf)%Shape == RectangularLeftFin .or. &
Surface(ISurf)%Shape == RectangularRightFin) THEN
!
! Surface is rectangular
!
! Vectors from vertex 2 to vertex 1 and vertex 2 to vertex 3
AAA = V1 - V2
BBB = V3 - V2
! Intersection point, CCC, is inside rectangle if
! 0 < CCC.BBB < BBB.BBB AND 0 < CCC.AAA < AAA.AAA
DOTCB = DOT_PRODUCT(CCC, BBB)
IF (DOTCB < 0.0d0) RETURN
IF (DOTCB > DOT_PRODUCT(BBB,BBB)) RETURN
DOTCA = DOT_PRODUCT(CCC, AAA)
IF (DOTCA < 0.0d0) RETURN
IF (DOTCA > DOT_PRODUCT(AAA,AAA)) RETURN
! Surface is intersected
IPIERC = 1
ELSE
!
! Surface is not rectangular
!
! Vectors from surface vertices to CPhit
DO N = 1,NV
DO I=1,3
C(N,I) = CPhit(I) - V(N,I)
END DO
END DO
! Cross products of vertex-to-vertex vectors and
! vertex-to-CPhit vectors
DO N = 1,NV
DO I=1,3
AA(I) = A(N,I)
CC(I) = C(N,I)
END DO
CALL CrossProduct(AA,CC,AXC)
DOTAXCSN = DOT_PRODUCT(AXC,SN)
! If at least one of these dot products is negative
! intersection point is outside of surface
IF (DOTAXCSN < 0.0d0) RETURN
END DO
! Surface is intersected
IPIERC = 1
END IF
RETURN
END SUBROUTINE PierceSurfaceVector