Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | IHOUR | |||
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 SHADOW(IHOUR,TS)
! SUBROUTINE INFORMATION:
! AUTHOR Legacy Code
! DATE WRITTEN
! MODIFIED Nov 2003, FCW: modify to do shadowing on shadowing surfaces
! RE-ENGINEERED Lawrie, Oct 2000
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is a driving routine for calculations of shadows
! and sunlit areas used in computing the solar beam flux multipliers.
! 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
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) XS ! Intermediate result
REAL(r64) YS ! Intermediate result
REAL(r64) ZS ! Intermediate result
INTEGER N ! Vertex number
INTEGER NGRS ! Coordinate transformation index
INTEGER NZ ! Zone Number of surface
INTEGER NVT
REAL(r64), ALLOCATABLE, DIMENSION(:), SAVE :: XVT ! X Vertices of Shadows
REAL(r64), ALLOCATABLE, DIMENSION(:), SAVE :: YVT ! Y vertices of Shadows
REAL(r64), ALLOCATABLE, DIMENSION(:), SAVE :: ZVT ! Z vertices of Shadows
LOGICAL, SAVE :: OneTimeFlag=.true.
INTEGER HTS ! Heat transfer surface number of the general receiving surface
INTEGER GRSNR ! Surface number of general receiving surface
INTEGER NBKS ! Number of back surfaces
INTEGER NGSS ! Number of general shadowing surfaces
INTEGER NSBS ! Number of subsurfaces (windows and doors)
REAL(r64) :: SurfArea ! Surface area. For walls, includes all window frame areas.
! For windows, includes divider area
IF (OneTimeFlag) THEN
ALLOCATE(XVT(MaxVerticesPerSurface+1))
ALLOCATE(YVT(MaxVerticesPerSurface+1))
ALLOCATE(ZVT(MaxVerticesPerSurface+1))
XVT=0.0d0
YVT=0.0d0
ZVT=0.0d0
OneTimeFlag=.false.
ENDIF
#ifdef EP_Count_Calls
IF (IHOUR == 0) THEN
NumShadow_Calls=NumShadow_Calls+1
ELSE
NumShadowAtTS_Calls=NumShadowAtTS_Calls+1
ENDIF
#endif
SAREA=0.0d0
DO GRSNR=1,TotSurfaces
IF (.NOT. ShadowComb(GRSNR)%UseThisSurf) CYCLE
SAREA(GRSNR)=0.0d0
NZ = Surface(GRSNR)%Zone
NGSS = ShadowComb(GRSNR)%NumGenSurf
NGSSHC = 0
NBKS = ShadowComb(GRSNR)%NumBackSurf
NBKSHC = 0
NSBS = ShadowComb(GRSNR)%NumSubSurf
NRVLHC = 0
NSBSHC = 0
LOCHCA = 1
! Temporarily determine the old heat transfer surface number (HTS)
HTS=GRSNR
IF (CTHETA(GRSNR) < SunIsUpValue) THEN !.001) THEN ! Receiving surface is not in the sun
SAREA(HTS) = 0.0d0
CALL SHDSBS(IHOUR,GRSNR,NBKS,NSBS,HTS,TS)
ELSEIF ((NGSS <= 0).AND.(NSBS <= 0)) THEN ! Simple surface--no shaders or subsurfaces
SAREA(HTS) = Surface(GRSNR)%NetAreaShadowCalc
ELSE ! Surface in sun and either shading surfaces or subsurfaces present (or both)
NGRS=Surface(GRSNR)%BaseSurf
IF(Surface(GRSNR)%ShadowingSurf) NGRS = GRSNR
! Compute the X and Y displacements of a shadow.
XS = Surface(NGRS)%lcsx%x*SUNCOS(1) + Surface(NGRS)%lcsx%y*SUNCOS(2) + Surface(NGRS)%lcsx%z*SUNCOS(3)
YS = Surface(NGRS)%lcsy%x*SUNCOS(1) + Surface(NGRS)%lcsy%y*SUNCOS(2) + Surface(NGRS)%lcsy%z*SUNCOS(3)
ZS = Surface(NGRS)%lcsz%x*SUNCOS(1) + Surface(NGRS)%lcsz%y*SUNCOS(2) + Surface(NGRS)%lcsz%z*SUNCOS(3)
IF (ABS(ZS) > 1.d-4) THEN
XShadowProjection = XS/ZS
YShadowProjection = YS/ZS
IF (ABS(XShadowProjection) < 1.d-8) XShadowProjection=0.0d0
IF (ABS(YShadowProjection) < 1.d-8) YShadowProjection=0.0d0
ELSE
XShadowProjection = 0.0d0
YShadowProjection = 0.0d0
END IF
CALL CTRANS(GRSNR,NGRS,NVT,XVT,YVT,ZVT) ! Transform coordinates of the receiving surface to 2-D form
! Re-order its vertices to clockwise sequential.
DO N = 1, NVT
XVS(N) = XVT(NVT+1-N)
YVS(N) = YVT(NVT+1-N)
END DO
CALL HTRANS1(1,NVT) ! Transform to homogeneous coordinates.
HCAREA(1)=-HCAREA(1) ! Compute (+) gross surface area.
HCT(1)=1.0d0
CALL SHDGSS(NGRS,IHOUR,TS,GRSNR,NGSS,HTS) ! Determine shadowing on surface.
IF(.NOT.CalcSkyDifShading) THEN
CALL SHDBKS(NGRS,GRSNR,NBKS,HTS) ! Determine possible back surfaces.
END IF
CALL SHDSBS(IHOUR,GRSNR,NBKS,NSBS,HTS,TS) ! Subtract subsurf areas from total
! Error checking: require that 0 <= SAREA <= AREA. + or - .01*AREA added for round-off errors
SurfArea = Surface(GRSNR)%NetAreaShadowCalc
SAREA(HTS)=MAX(0.0d0,SAREA(HTS))
SAREA(HTS)=MIN(SAREA(HTS),SurfArea)
END IF ! ...end of surface in sun/surface with shaders and/or subsurfaces IF-THEN block
! NOTE:
! There used to be a call to legacy subroutine SHDCVR here when the
! zone type was not a standard zone.
END DO
RETURN
END SUBROUTINE SHADOW