DayltgPierceSurface Subroutine

private subroutine DayltgPierceSurface(ISurf, R1, RN, IPIERC, CP)

Arguments

Type	Intent		Name
integer,	intent(in)	::	ISurf
real(kind=r64),	intent(in)	::	R1(3)
real(kind=r64),	intent(in)	::	RN(3)
integer,	intent(out)	::	IPIERC
real(kind=r64),	intent(inout)	::	CP(3)
Source Code

SUBROUTINE DayltgPierceSurface(ISurf, R1, RN, IPIERC, CP)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Fred Winkelmann
          !       DATE WRITTEN   July 1997
          !       MODIFIED       Sept 2003, FCW: change shape test for rectangular surface to exclude
          !                       triangular windows (Surface%Shape=8)
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS SUBROUTINE:
          ! Called to determine if (1) solar disk is visible from reference point,
          ! (2) if a ray intersects an obstruction, or (3) if ray passes through an interior window.
          ! Returns 0 if line through point R1 in direction of unit vector
          ! RN does not intersect surface ISurf.
          !
          ! METHODOLOGY EMPLOYED:

          ! REFERENCES:
          ! Based on DOE-2.1E subroutine DPIERC.

          ! USE STATEMENTS:na

  IMPLICIT NONE ! Enforce explicit typing of all variables in this routine

          ! SUBROUTINE ARGUMENT DEFINITIONS:
  INTEGER, INTENT(IN)          :: ISurf      ! Surface index
  REAL(r64), INTENT(IN)             :: R1(3)      ! Point from which ray originates
  REAL(r64), INTENT(IN) :: RN(3)      ! 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.
  REAL(r64), INTENT(INOUT)          :: CP(3)      ! Point that ray along RN intersects plane of surface

          ! SUBROUTINE PARAMETER DEFINITIONS:na
          ! INTERFACE BLOCK SPECIFICATIONS:na
          ! DERIVED TYPE DEFINITIONS:na

          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  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                        ! Vertex-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
  ! Following must be allocated to MaxVerticesPerSurface
!  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)      :: V(4,3)                   ! Vertices of surfaces
  REAL(r64),SAVE,ALLOCATABLE,DIMENSION(:,:) :: A   ! Vertex-to-vertex vectors; A(1,i) is from vertex 1 to 2, etc.
  REAL(r64),SAVE,ALLOCATABLE,DIMENSION(:,:) :: C   ! Vectors from vertices to intersection point
  REAL(r64),SAVE,ALLOCATABLE,DIMENSION(:,:) :: V   ! Vertices of surfaces
  LOGICAL, SAVE :: FirstTimeFlag=.true.

          ! FLOW:
  IF (FirstTimeFlag) THEN
    ALLOCATE(A(MaxVerticesPerSurface,3))
    ALLOCATE(C(MaxVerticesPerSurface,3))
    ALLOCATE(V(MaxVerticesPerSurface,3))
    FirstTimeFlag=.false.
  ENDIF
  IPIERC = 0
  ! Vertex vectors
  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 DayltgCrossProduct(A1, A2, SN)
  ! Scale factor, the solution of SN.(CP-V2) = 0 and
  ! CP = R1 + SCALE*RN, where CP 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
  CP = R1 + RN * SCALE
  ! Vector from vertex 2 to CP
  CCC = CP - 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 CP
    DO N = 1,NV
      DO I=1,3
        C(N,I) = CP(I) - V(N,I)
      END DO
    END DO
    ! Cross products of vertex-to-vertex vectors and
    ! vertex-to-CP vectors
    DO N = 1,NV
      DO I=1,3
        AA(I) = A(N,I)
        CC(I) = C(N,I)
      END DO
      CALL DayltgCrossProduct(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 DayltgPierceSurface
All Procedures

DayltgPierceSurface Subroutine

Source Code

All Procedures

private subroutine DayltgPierceSurface(ISurf, R1, RN, IPIERC, CP)

Arguments

Calls

Called By

Source Code

Source Code

All Procedures
