Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | IHOUR | |||
integer, | intent(in) | :: | CurSurf | |||
integer, | intent(in) | :: | NBKS | |||
integer, | intent(in) | :: | NSBS | |||
integer, | intent(in) | :: | HTS | |||
integer, | intent(in) | :: | TS |
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 SHDSBS(IHOUR,CurSurf,NBKS,NSBS,HTS,TS)
! SUBROUTINE INFORMATION:
! AUTHOR Legacy Code
! DATE WRITTEN
! MODIFIED FCW, Oct 2002: Surface%Area --> Surface%Area + SurfaceWindow%DividerArea
! in calculation of SunlitFracWithoutReveal (i.e., use full window area, not
! just glass area.
! TH, May 2009: Bug fixed to address part of CR 7596 - inside reveals
! causing high cooling loads
! RE-ENGINEERED Lawrie, Oct 2000
! PURPOSE OF THIS SUBROUTINE:
! This subroutine determines the shadowing on subsurfaces and
! revises the base surface area accordingly. It also computes
! the effect of transparent subsurfaces.
! 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) :: IHOUR ! Hour Index
INTEGER, INTENT(IN) :: TS ! Time step Index
INTEGER, INTENT(IN) :: CurSurf
INTEGER, INTENT(IN) :: NBKS ! Number of back surfaces
INTEGER, INTENT(IN) :: NSBS ! Number of subsurfaces
INTEGER, INTENT(IN) :: HTS ! Heat transfer surface number of the general receiving surf
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) A ! Area
INTEGER I ! Loop control
INTEGER J ! Loop control
INTEGER K ! Window construction number
INTEGER N ! Vertex number
REAL(r64) SurfArea ! Surface area. For walls, includes all window frame areas.
! For windows, includes divider area
! REAL(r64) FrameAreaAdd ! Additional frame area sunlit
! REAL(r64) DividerAreaAdd ! Additional frame area sunlit
INTEGER HTSS ! Heat transfer surface number of the subsurface
INTEGER SBSNR ! Subsurface number
IF (NSBS > 0) THEN ! Action taken only if subsurfaces present
FSBSHC = LOCHCA + 1
DO I = 1, NSBS ! Do for all subsurfaces (sbs).
SBSNR = ShadowComb(CurSurf)%SubSurf(I)
HTSS=SBSNR
K = Surface(SBSNR)%Construction
IF ( (OverlapStatus /= TooManyVertices).AND. &
(OverlapStatus /= TooManyFigures) .AND. &
(SAREA(HTS) > 0.0d0) ) THEN
! Re-order vertices to clockwise sequential; compute homogeneous coordinates.
NVS = Surface(SBSNR)%Sides
DO N = 1, NVS
XVS(N) = ShadeV(SBSNR)%XV(NVS+1-N)
YVS(N) = ShadeV(SBSNR)%YV(NVS+1-N)
END DO
LOCHCA = FSBSHC
CALL HTRANS1(LOCHCA,NVS)
HCAREA(LOCHCA) = -HCAREA(LOCHCA)
HCT(LOCHCA) = 1.0d0
NSBSHC = LOCHCA - FSBSHC + 1
! Determine sunlit area of subsurface due to shadows on general receiving surface.
IF (NGSSHC > 0) THEN
CALL MULTOL(LOCHCA,FGSSHC-1,NGSSHC)
IF ( (OverlapStatus /= TooManyVertices).AND. &
(OverlapStatus /= TooManyFigures) ) NSBSHC = LOCHCA - FSBSHC + 1
END IF
END IF
IF ( (OverlapStatus == TooManyVertices).OR. &
(OverlapStatus == TooManyFigures) .OR. &
(SAREA(HTS) <= 0.0d0) ) THEN ! General receiving surface totally shaded.
SAREA(HTSS) = 0.0d0
IF(IHour > 0 .AND. TS > 0) SunLitFracWithoutReveal(HTSS,IHour,TS) = 0.0d0
ELSEIF ((NGSSHC <= 0).OR.(NSBSHC == 1)) THEN ! No shadows.
SAREA(HTSS) = HCAREA(FSBSHC)
SAREA(HTS) = SAREA(HTS) - SAREA(HTSS) ! Revise sunlit area of general receiving surface.
! TH. This is a bug. SunLitFracWithoutReveal should be a ratio of area
!IF(IHour > 0 .AND. TS > 0) SunLitFracWithoutReveal(HTSS,IHour,TS) = &
! Surface(HTSS)%NetAreaShadowCalc
! new code fixed part of CR 7596. TH 5/29/2009
IF(IHour > 0 .AND. TS > 0) SunLitFracWithoutReveal(HTSS,IHour,TS) = SAREA(HTSS) / Surface(HTSS)%NetAreaShadowCalc
CALL SHDRVL(HTSS,SBSNR,IHour,TS) ! Determine shadowing from reveal.
IF ( (OverlapStatus == TooManyVertices).OR. &
(OverlapStatus == TooManyFigures) ) SAREA(HTSS) = 0.0d0
ELSE ! Compute area.
A = HCAREA(FSBSHC)
DO J = 2, NSBSHC
A = A + HCAREA(FSBSHC-1+J)*(1.0d0-HCT(FSBSHC-1+J))
END DO
SAREA(HTSS) = A
IF (SAREA(HTSS) > 0.0d0) THEN
SAREA(HTS) = SAREA(HTS) - SAREA(HTSS) ! Revise sunlit area of general receiving surface.
IF(IHour > 0 .AND. TS > 0) SunLitFracWithoutReveal(HTSS,IHour,TS) = SAREA(HTSS)/Surface(HTSS)%Area
CALL SHDRVL(HTSS,SBSNR,IHOUR,TS) ! Determine shadowing from reveal.
IF ( (OverlapStatus == TooManyVertices).OR. &
(OverlapStatus == TooManyFigures) ) SAREA(HTSS) = 0.0d0
ELSE ! General receiving surface totally shaded.
SAREA(HTSS) = 0.0d0
END IF
END IF
! Determine transmittance and absorptances of sunlit window.
IF (Construct(K)%TransDiff > 0.0d0) THEN
IF(.NOT.CalcSkyDifShading) THEN !Overlaps calculation is only done for beam solar
!shading, not for sky diffuse solar shading
CALL CalcInteriorSolarOverlaps(IHOUR,NBKS,HTSS,CurSurf,TS)
END IF
END IF
! Error checking.
SurfArea = Surface(SBSNR)%NetAreaShadowCalc
SAREA(HTSS)=MAX(0.0d0,SAREA(HTSS))
SAREA(HTSS)=MIN(SAREA(HTSS),SurfArea)
END DO ! End of subsurface loop
END IF
RETURN
END SUBROUTINE SHDSBS