SHDRVL Subroutine

private subroutine SHDRVL(HTSS, SBSNR, Hour, TS)

Arguments

Type	Intent		Name
integer,	intent(in)	::	HTSS
integer,	intent(in)	::	SBSNR
integer,	intent(in)	::	Hour
integer,	intent(in)	::	TS
Calls

Help
Called By

Help
Source Code

SHDRVL
Source Code

SUBROUTINE SHDRVL(HTSS,SBSNR,Hour,TS)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Legacy Code
          !       DATE WRITTEN
          !       MODIFIED       May 2002 (FCW): allow triangular windows to have reveal.
          !       RE-ENGINEERED  Lawrie, Oct 2000

          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine computes the shadowing from a reveal onto a subsurface.

          ! METHODOLOGY EMPLOYED:
          ! na

          ! REFERENCES:
          ! BLAST/IBLAST code, original author George Walton

          ! USE STATEMENTS:
          ! na

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

          ! SUBROUTINE ARGUMENT DEFINITIONS:
  INTEGER, INTENT(IN) :: HTSS     ! Heat transfer surface number of the subsurface
  INTEGER, INTENT(IN) :: SBSNR    ! Subsurface number
  INTEGER, INTENT(IN) :: Hour
  INTEGER, INTENT(IN) :: TS

          ! SUBROUTINE PARAMETER DEFINITIONS:
  INTEGER, PARAMETER :: None                       = 0  ! for use with RevealStatus
  INTEGER, PARAMETER :: EntireWindowShadedByReveal = 1  ! for use with RevealStatus
  INTEGER, PARAMETER :: WindowShadedOnlyByReveal   = 2  ! for use with RevealStatus

          ! INTERFACE BLOCK SPECIFICATIONS
          ! na

          ! DERIVED TYPE DEFINITIONS
          ! na

          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  REAL(r64) A            ! Area
  REAL(r64) R            ! Depth of the reveal (m)
  INTEGER I                     ! Loop control
  INTEGER N                     ! Vertex number
  INTEGER NS1,NS2               ! Locations in homogeneous coordinate array
  INTEGER NVS                   ! Number of verticies
                                ! note, below dimensions not changed because subsurface still max 4
  REAL(r64) XVT(5)                   ! Projected X coordinates of vertices
  REAL(r64) YVT(5)                   ! Projected Y coordinates of vertices
  LOGICAL :: RevealStatusSet    ! Used to control flow through this subroutine.
                                ! Certain operations performed only if reveal status not yet set.
  INTEGER :: RevealStatus       ! Status of the reveal, takes the parameter values above

          ! FLOW:
  RevealStatus    =  None
  RevealStatusSet = .FALSE.

  IF (.not. CalcSkyDifShading) THEN
    WindowRevealStatus(SBSNR,Hour,TS)=None
  ENDIF

  R = Surface(SBSNR)%Reveal
  IF (R <= 0.0d0) THEN
    RevealStatus    =  None
    RevealStatusSet = .TRUE.
  END IF

  IF (.NOT.RevealStatusSet) THEN

    FRVLHC = LOCHCA + 1
    LOCHCA = LOCHCA + 1
    NVS = Surface(SBSNR)%Sides

    ! Currently (06May02) windows are either rectangles (NVS=4) or triangles (NVS=3)

    SELECT CASE (NVS)

      CASE(4)  ! Rectangular subsurface

            ! Determine vertices of reveal.
            ! Project the subsurface up to the plane of the wall.

        XVT(1) = ShadeV(SBSNR)%XV(1) + R*MAX(XShadowProjection,0.0d0)
        XVT(2) = ShadeV(SBSNR)%XV(2) + R*MAX(XShadowProjection,0.0d0)
        XVT(3) = ShadeV(SBSNR)%XV(3) + R*MIN(XShadowProjection,0.0d0)
        XVT(4) = ShadeV(SBSNR)%XV(4) + R*MIN(XShadowProjection,0.0d0)
        YVT(1) = ShadeV(SBSNR)%YV(1) + R*MIN(YShadowProjection,0.0d0)
        YVT(2) = ShadeV(SBSNR)%YV(2) + R*MAX(YShadowProjection,0.0d0)
        YVT(3) = ShadeV(SBSNR)%YV(3) + R*MAX(YShadowProjection,0.0d0)
        YVT(4) = ShadeV(SBSNR)%YV(4) + R*MIN(YShadowProjection,0.0d0)

              ! Check for complete shadowing.

        IF ((XVT(2) >= XVT(3)).OR.(YVT(2) >= YVT(1))) THEN

          RevealStatus    =  EntireWindowShadedByReveal
          RevealStatusSet = .TRUE.

        ELSE
              ! Re-order vertices to clockwise.

          DO N = 1, NVS
            XVS(N) = XVT(NVS+1-N)
            YVS(N) = YVT(NVS+1-N)
          END DO

              ! Transform to homogeneous coordinates

          CALL HTRANS1(FRVLHC,NVS)
          HCAREA(FRVLHC) = -HCAREA(FRVLHC)
          HCT(FRVLHC)    =  1.0d0

          IF (HCAREA(FRVLHC) <= 0.0d0) THEN
            RevealStatus    =  EntireWindowShadedByReveal
            RevealStatusSet = .TRUE.
          END IF

        END IF

      CASE(3)   ! Triangular window

              ! Project window to outside plane of parent surface

        DO N = 1,3
          XVT(N) = ShadeV(SBSNR)%XV(N) + R*XShadowProjection
          YVT(N) = ShadeV(SBSNR)%YV(N) + R*YShadowProjection
        END DO

              ! Find the overlap between the original window and the projected window
              ! Put XVT,YVT in clockwise order

        DO N = 1, NVS
          XVS(N) = XVT(NVS+1-N)
          YVS(N) = YVT(NVS+1-N)
        END DO

             ! Transform to homogeneous coordinates

        NS1 = LOCHCA + 1
        LOCHCA = NS1
        CALL HTRANS1(NS1,NVS)

             ! Put XV,YV in clockwise order

        DO N = 1, NVS
          XVS(N) = ShadeV(SBSNR)%XV(NVS+1-N)
          YVS(N) = ShadeV(SBSNR)%YV(NVS+1-N)
        END DO

             ! Transform to homogenous coordinates

        NS2 = LOCHCA + 1
        LOCHCA = NS2
        CALL HTRANS1(NS2,NVS)
        HCT(FRVLHC) = 1.0d0

             ! Find overlap

        CALL DeterminePolygonOverlap(NS1,NS2,FRVLHC)
        IF(OverlapStatus == NoOverlap) THEN
            RevealStatus    =  EntireWindowShadedByReveal
            RevealStatusSet = .TRUE.
        END IF

    END SELECT

  END IF

  IF (.NOT.RevealStatusSet) THEN

          ! Check for no shadows on window.

    IF (NSBSHC <= 1) THEN
      RevealStatus    =  WindowShadedOnlyByReveal
      RevealStatusSet = .TRUE.
    ELSE
          ! Reduce all previous shadows to size of reveal opening.
      LOCHCA = FRVLHC
      CALL MULTOL(LOCHCA,FSBSHC,NSBSHC-1)
      IF ( (OverlapStatus == TooManyVertices).OR. &
           (OverlapStatus == TooManyFigures) ) THEN
        RevealStatus    =  None
        RevealStatusSet = .TRUE.
      ELSE
        NRVLHC = LOCHCA - FRVLHC + 1
        IF (NRVLHC <= 1) THEN
          RevealStatus    =  WindowShadedOnlyByReveal
          RevealStatusSet = .TRUE.
        END IF
      END IF
    END IF
  END IF

  IF (.NOT.RevealStatusSet) THEN
          ! Compute sunlit area.
    A = HCAREA(FRVLHC)
    DO I = 2, NRVLHC
      A = A + HCAREA(FRVLHC-1+I)*(1.0d0-HCT(FRVLHC-1+I))
    END DO
    SAREA(HTSS) = A
  END IF

  IF ((RevealStatus == EntireWindowShadedByReveal).OR.(SAREA(HTSS) < 0.0d0)) THEN
    SAREA(HTSS)=0.0d0   ! Window entirely shaded by reveal.
  ELSEIF (RevealStatus == WindowShadedOnlyByReveal) THEN
    SAREA(HTSS)=HCAREA(FRVLHC)    ! Window shaded only by reveal.
  END IF

  IF (.not. CalcSkyDifShading) THEN
    WindowRevealStatus(SBSNR,Hour,TS)=RevealStatus
  ENDIF

  RETURN

END SUBROUTINE SHDRVL
All Procedures
