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) | :: | NGRS | |||
| integer, | intent(in) | :: | IHOUR | |||
| integer, | intent(in) | :: | TS | |||
| integer, | intent(in) | :: | CurSurf | |||
| integer, | intent(in) | :: | NGSS | |||
| integer, | intent(in) | :: | HTS |
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 SHDGSS(NGRS,IHOUR,TS,CurSurf,NGSS,HTS)
! SUBROUTINE INFORMATION:
! AUTHOR Legacy Code
! DATE WRITTEN
! MODIFIED na
! RE-ENGINEERED Lawrie, Oct 2000
! PURPOSE OF THIS SUBROUTINE:
! This subroutine determines the shadows on a general receiving surface.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! BLAST/IBLAST code, original author George Walton
! USE STATEMENTS:
USE ScheduleManager, ONLY: LookUpScheduleValue, GetCurrentScheduleValue, GetScheduleMinValue, GetScheduleName
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: NGRS
INTEGER, INTENT(IN) :: IHOUR ! Hour Counter
INTEGER, INTENT(IN) :: TS ! TimeStep
INTEGER, INTENT(IN) :: CurSurf ! Current Surface
INTEGER, INTENT(IN) :: HTS ! Heat transfer surface number of the general receiving surf
INTEGER, INTENT(IN) :: NGSS ! Number of general shadowing surfaces
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER I
INTEGER N
INTEGER M
INTEGER NVR
REAL(r64) A ! Area
INTEGER GSSNR ! General shadowing surface number
INTEGER MainOverlapStatus ! Overlap status of the main overlap calculation not the check for
! multiple overlaps (unless there was an error)
INTEGER NVT
REAL(r64), ALLOCATABLE, DIMENSION(:), SAVE :: XVT
REAL(r64), ALLOCATABLE, DIMENSION(:), SAVE :: YVT
REAL(r64), ALLOCATABLE, DIMENSION(:), SAVE :: ZVT
LOGICAL, SAVE :: OneTimeFlag=.true.
INTEGER NS1 ! Number of the figure being overlapped
INTEGER NS2 ! Number of the figure doing overlapping
INTEGER NS3 ! Location to place results of overlap
REAL(r64) SchValue ! Value for Schedule of shading transmittence
INTEGER ExitLoopStatus
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
FGSSHC = LOCHCA + 1
MainOverlapStatus = NoOverlap ! Set to ensure that the value from the last surface is not saved
OverlapStatus= NoOverlap
IF (NGSS <= 0) THEN ! IF NO S.S., receiving surface FULLY SUNLIT.
SAREA(HTS) = HCAREA(1) ! Surface fully sunlit
ELSE
ShadowingSurfaces: DO I = 1, NGSS ! Loop through all shadowing surfaces...
GSSNR = ShadowComb(CurSurf)%GenSurf(I)
CurrentSurfaceBeingShadowed=GSSNR
CurrentShadowingSurface=I
ExitLoopStatus=-1
IF (CTHETA(GSSNR) > SunIsUpValue) CYCLE !.001) CYCLE ! NO SHADOW IF GSS IN SUNLIGHT.
! This used to check to see if the shadowing surface was not opaque (within the scheduled dates of
! transmittance value. Perhaps it ignored it if it were outside the range. (if so, was an error)
! The proper action seems to be delete this statement all together, but there would also be no shading if
! the shading surface were transparent...
!---former stmt IF ((.NOT.Surface(GSSNR)%HeatTransSurf) .AND. &
!---former stmt GetCurrentScheduleValue(Surface(GSSNR)%SchedShadowSurfIndex,IHOUR) == 0.0) CYCLE
IF (.NOT.Surface(GSSNR)%HeatTransSurf) THEN
IF (Surface(GSSNR)%IsTransparent) CYCLE
IF (Surface(GSSNR)%SchedShadowSurfIndex > 0) THEN
IF (LookUpScheduleValue(Surface(GSSNR)%SchedShadowSurfIndex,IHOUR) == 1.0d0) CYCLE
ENDIF
ENDIF
! No shadow if shading surface is transparent
IF (.not. CalcSkyDifShading) THEN
IF (.not.Surface(GSSNR)%HeatTransSurf) THEN
IF (Surface(GSSNR)%IsTransparent) CYCLE
IF (Surface(GSSNR)%SchedShadowSurfIndex > 0) THEN
IF (LookUpScheduleValue(Surface(GSSNR)%SchedShadowSurfIndex,IHOUR,TS) == 1.0d0) CYCLE
ENDIF
ENDIF
ELSE
IF (.not.Surface(GSSNR)%HeatTransSurf) THEN
IF (Surface(GSSNR)%SchedShadowSurfIndex > 0) THEN
IF (Surface(GSSNR)%IsTransparent) CYCLE
ENDIF
ENDIF
ENDIF
! IF ((.NOT.Surface(GSSNR)%HeatTransSurf) .AND. &
! GetCurrentScheduleValue(Surface(GSSNR)%SchedShadowSurfIndex) == 1.0) CYCLE
! Transform shadow casting surface from cartesian to homogeneous coordinates according to surface type.
IF ((Surface(GSSNR)%BaseSurf /= 0).AND.(.NOT.Surface(GSSNR)%HeatTransSurf)) THEN
! For shadowing subsurface coordinates of shadow casting surface are relative to the receiving surface
! project shadow to the receiving surface
NVS = Surface(GSSNR)%Sides
DO N = 1, NVS
XVS(N) = ShadeV(GSSNR)%XV(N) - XShadowProjection*ShadeV(GSSNR)%ZV(N)
YVS(N) = ShadeV(GSSNR)%YV(N) - YShadowProjection*ShadeV(GSSNR)%ZV(N)
END DO
ELSE
! Transform coordinates of shadow casting surface from general system to the system relative to the receiving surface
CALL CTRANS(GSSNR,NGRS,NVT,XVT,YVT,ZVT)
CALL CLIP(NVT,XVT,YVT,ZVT) ! Clip portions of the shadow casting surface which are behind the receiving surface
IF (NumVertInShadowOrClippedSurface <= 2) CYCLE
! Project shadow from shadow casting surface along sun's rays to receiving surface Shadow vertices
! become clockwise sequential
DO N = 1, NumVertInShadowOrClippedSurface
XVS(N) = XVC(N) - XShadowProjection*ZVC(N)
YVS(N) = YVC(N) - YShadowProjection*ZVC(N)
END DO
END IF
! Transform to the homogeneous coordinate system.
NS3 = LOCHCA + 1
CALL HTRANS1(NS3,NVS)
! Adjust near-duplicate points.
NVR = HCNV(1)
DO N = 1, NumVertInShadowOrClippedSurface
DO M = 1, NVR
IF (ABS(HCX(M,1)-HCX(N,NS3)) > 6) CYCLE
IF (ABS(HCY(M,1)-HCY(N,NS3)) > 6) CYCLE
HCX(N,NS3) = HCX(M,1)
HCY(N,NS3) = HCY(M,1)
END DO
END DO
CALL HTRANS0(NS3,NumVertInShadowOrClippedSurface)
IF (.not. CalcSkyDifShading) THEN
IF (IHOUR /= 0) THEN
SchValue=LookUpScheduleValue(Surface(GSSNR)%SchedShadowSurfIndex,IHOUR,TS)
ELSE
SchValue=Surface(GSSNR)%SchedMinValue
ENDIF
ELSE
SchValue=Surface(GSSNR)%SchedMinValue
ENDIF
HCT(NS3)=SchValue
! Determine overlap of shadow with receiving surface
NS1 = 1
NS2 = NS3
CALL DeterminePolygonOverlap(NS1,NS2,NS3)
! Next statement is special to deal with transmitting shading devices
IF (OverlapStatus == FirstSurfWithinSecond .and. SchValue > 0.0d0) OverlapStatus=PartialOverlap
MainOverlapStatus = OverlapStatus
ExitLoopStatus=MainOverlapStatus
SELECT CASE (MainOverlapStatus)
CASE (NoOverlap) ! No overlap of general surface shadow and receiving surface
CYCLE
CASE (FirstSurfWithinSecond,TooManyVertices,TooManyFigures)
EXIT ShadowingSurfaces
CASE (SecondSurfWithinFirst,PartialOverlap)
! Determine overlaps with previous shadows.
LOCHCA = NS3
NGSSHC = LOCHCA - FGSSHC + 1
IF (NGSSHC <= 1) CYCLE
CALL MULTOL(LOCHCA,FGSSHC-1,NGSSHC-1) ! HOYT - Remove this call
CASE DEFAULT
EXIT ShadowingSurfaces
END SELECT
ExitLoopStatus=-1
END DO ShadowingSurfaces
! Compute sunlit area of surface (excluding effects of subsurfs).
SELECT CASE (ExitLoopStatus)
CASE (FirstSurfWithinSecond) ! Surface fully shaded
SAREA(HTS) = 0.0d0
LOCHCA = FGSSHC
CASE (TooManyVertices,TooManyFigures) ! Array limits exceeded, estimate
SAREA(HTS) = 0.25d0*HCAREA(1)
CASE DEFAULT
! Compute the sunlit area here.
! Call UnionShadow(FGSSHC,LOCHCA)
NGSSHC = LOCHCA - FGSSHC + 1
IF (NGSSHC <= 0) THEN
SAREA(HTS) = HCAREA(1) ! Surface fully sunlit
ELSE
A = HCAREA(1)
DO I = 1, NGSSHC
A = A + HCAREA(FGSSHC-1+I)*(1.0d0-HCT(FGSSHC-1+I))
END DO
SAREA(HTS) = A
IF (SAREA(HTS) <= 0.0d0) THEN ! Surface fully shaded
SAREA(HTS)=0.0d0
LOCHCA=FGSSHC
END IF
END IF
END SELECT
END IF
NGSSHC = LOCHCA - FGSSHC + 1
RETURN
END SUBROUTINE SHDGSS