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.
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 DetermineShadowingCombinations
! SUBROUTINE INFORMATION:
! AUTHOR From Legacy Code
! DATE WRITTEN
! MODIFIED LKL; March 2002 -- another missing translation from BLAST's routine
! FCW; Jan 2003 -- removed line that prevented beam solar through interior windows
! RE-ENGINEERED Rick Strand; 1998
! Linda Lawrie; Oct 2000
! PURPOSE OF THIS SUBROUTINE:
! This routine prepares a list of heat transfer surfaces and
! their possible shadowers which is used to direct the hourly
! calculation of shadows and sunlit areas.
! METHODOLOGY EMPLOYED:
! As appropriate surfaces are identified, they are placed into the
! ShadowComb data structure (module level) with the accompanying lists
! of other surface numbers.
! REFERENCES:
! BLAST/IBLAST code, original author George Walton
! USE STATEMENTS:
USE OutputReportPredefined, ONLY: ShadowRelate,numShadowRelate,recKindSurface,recKindSubsurface
USE DataErrorTracking
USE General, ONLY: TrimSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: fmta='(A)'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER, ALLOCATABLE, DIMENSION(:) :: GSS ! List of shadowing surfaces numbers for a receiving surface
INTEGER, ALLOCATABLE, DIMENSION(:) :: BKS ! List of back surface numbers for a receiving surface
INTEGER, ALLOCATABLE, DIMENSION(:) :: SBS ! List of subsurfaces for a receiving surface
INTEGER, ALLOCATABLE, DIMENSION(:) :: ListTemp ! Temporary array for reallocations
INTEGER :: MaxGSS=50 ! Current Max for GSS array
INTEGER :: MaxBKS=50 ! Current Max for BKS array
INTEGER :: MaxSBS=50 ! Current Max for SBS array
LOGICAL CannotShade ! TRUE if subsurface cannot shade receiving surface
LOGICAL HasWindow ! TRUE if a window is present on receiving surface
REAL(r64) ZMIN ! Lowest point on the receiving surface
INTEGER BackSurfaceNumber ! Back surface number
INTEGER HTS ! Heat transfer surface number for a receiving surface
INTEGER GRSNR ! Receiving surface number
INTEGER GSSNR ! Shadowing surface number
INTEGER SBSNR ! Subsurface number
INTEGER NBKS ! Number of back surfaces for a receiving surface
INTEGER NGSS ! Number of shadowing surfaces for a receiving surface
INTEGER NSBS ! Number of subsurfaces for a receiving surface
LOGICAL ShadowingSurf ! True if a receiving surface is a shadowing surface
LOGICAL, ALLOCATABLE, DIMENSION(:) :: CastingSurface ! tracking during setup of ShadowComb
INTEGER :: MaxDim=0
#ifdef EP_Count_Calls
NumDetShadowCombs_Calls=NumDetShadowCombs_Calls+1
#endif
ALLOCATE(ShadowComb(TotSurfaces))
ShadowComb%UseThisSurf=.false.
ShadowComb%NumGenSurf=0
ShadowComb%NumSubSurf=0
ShadowComb%NumBackSurf=0
ALLOCATE(CastingSurface(TotSurfaces))
CastingSurface=.false.
ALLOCATE(HCA(MaxHCV+1,MaxHCS*2))
HCA=0
ALLOCATE(HCB(MaxHCV+1,MaxHCS*2))
HCB=0
ALLOCATE(HCC(MaxHCV+1,MaxHCS*2))
HCC=0
ALLOCATE(HCX(MaxHCV+1,MaxHCS*2))
HCX=0
ALLOCATE(HCY(MaxHCV+1,MaxHCS*2))
HCY=0
ALLOCATE(HCAREA(MaxHCS*2))
HCAREA=0.0D0
ALLOCATE(HCNS(MaxHCS*2))
HCNS=0
ALLOCATE(HCNV(MaxHCS*2))
HCNV=0
ALLOCATE(HCT(MaxHCS*2))
HCT=0.0D0
ALLOCATE(GSS(MaxGSS))
ALLOCATE(BKS(MaxGSS))
ALLOCATE(SBS(MaxGSS))
GSS=0
BKS=0
SBS=0
HTS = 0
! Check every surface as a possible shadow receiving surface ("RS" = receiving surface).
IF (IgnoreSolarRadiation) THEN
RETURN
ENDIF
DO GRSNR = 1, TotSurfaces ! Loop through all surfaces (looking for potential receiving surfaces)...
ShadowingSurf = Surface(GRSNR)%ShadowingSurf
NGSS=0
NSBS=0
NBKS=0
IF (.NOT. ShadowingSurf .AND. .NOT. Surface(GRSNR)%HeatTransSurf) CYCLE
HTS = GRSNR
IF (.NOT. ShadowingSurf .AND. .NOT.Surface(GRSNR)%ExtSolar) CYCLE ! Skip surfaces with no external solar
IF (.NOT. ShadowingSurf .AND. Surface(GRSNR)%BaseSurf /= GRSNR) CYCLE ! Skip subsurfaces (SBS)
! Get the lowest point of receiving surface
ZMIN=MINVAL(Surface(GRSNR)%Vertex(:)%Z)
! Check every surface as a possible shadow casting surface ("SS" = shadow sending)
NGSS=0
IF (SolarDistribution /= MinimalShadowing) THEN ! Except when doing simplified exterior shadowing.
DO GSSNR = 1, TotSurfaces ! Loop through all surfaces, looking for ones that could shade GRSNR
IF (GSSNR == GRSNR) CYCLE ! Receiving surface cannot shade itself
IF ((Surface(GSSNR)%HeatTransSurf).AND. &
(Surface(GSSNR)%BaseSurf == GRSNR)) CYCLE ! A heat transfer subsurface of a receiving surface
! cannot shade the receiving surface
IF(ShadowingSurf) THEN
! If receiving surf is a shadowing surface exclude matching shadow surface as sending surface
!IF((GSSNR == GRSNR+1 .AND. Surface(GSSNR)%Name(1:3) == 'Mir').OR. &
! (GSSNR == GRSNR-1 .AND. Surface(GRSNR)%Name(1:3) == 'Mir')) CYCLE
IF(((GSSNR == GRSNR+1) .AND. Surface(GSSNR)%MirroredSurf).OR. &
((GSSNR == GRSNR-1) .AND. Surface(GRSNR)%MirroredSurf)) CYCLE
END IF
IF (Surface(GSSNR)%BaseSurf == GRSNR) THEN ! Shadowing subsurface of receiving surface
NGSS=NGSS+1
IF (NGSS > MaxGSS) THEN
ALLOCATE(ListTemp(MaxGSS*2))
ListTemp=0
ListTemp(1:MaxGSS)=GSS(1:MaxGSS)
DEALLOCATE(GSS)
ALLOCATE(GSS(MaxGSS*2))
GSS=ListTemp
MaxGSS=MaxGSS*2
DEALLOCATE(ListTemp)
ENDIF
GSS(NGSS)=GSSNR
ELSEIF ((Surface(GSSNR)%BaseSurf == 0).OR. & ! Detached shadowing surface or
((Surface(GSSNR)%BaseSurf == GSSNR).AND. & ! any other base surface exposed to outside environment
((Surface(GSSNR)%ExtBoundCond == ExternalEnvironment) .or. &
Surface(GSSNR)%ExtBoundCond == OtherSideCondModeledExt ) )) THEN
CALL CHKGSS(GRSNR,GSSNR,ZMIN,CannotShade) ! Check to see if this can shade the receiving surface
IF (.NOT. CannotShade) THEN ! Update the shadowing surface data if shading is possible
NGSS=NGSS+1
IF (NGSS > MaxGSS) THEN
ALLOCATE(ListTemp(MaxGSS*2))
ListTemp=0
ListTemp(1:MaxGSS)=GSS(1:MaxGSS)
DEALLOCATE(GSS)
ALLOCATE(GSS(MaxGSS*2))
GSS=ListTemp
MaxGSS=MaxGSS*2
DEALLOCATE(ListTemp)
ENDIF
GSS(NGSS)=GSSNR
END IF
END IF
END DO ! ...end of surfaces DO loop (GSSNR)
ELSE ! Simplified Distribution -- still check for Shading Subsurfaces
DO GSSNR = 1, TotSurfaces ! Loop through all surfaces (looking for surfaces which could shade GRSNR) ...
IF (GSSNR == GRSNR) CYCLE ! Receiving surface cannot shade itself
IF ((Surface(GSSNR)%HeatTransSurf).AND. &
(Surface(GSSNR)%BaseSurf == GRSNR)) CYCLE ! Skip heat transfer subsurfaces of receiving surface
IF (Surface(GSSNR)%BaseSurf == GRSNR) THEN ! Shadowing subsurface of receiving surface
NGSS=NGSS+1
IF (NGSS > MaxGSS) THEN
ALLOCATE(ListTemp(MaxGSS*2))
ListTemp=0
ListTemp(1:MaxGSS)=GSS(1:MaxGSS)
DEALLOCATE(GSS)
ALLOCATE(GSS(MaxGSS*2))
GSS=ListTemp
MaxGSS=MaxGSS*2
DEALLOCATE(ListTemp)
ENDIF
GSS(NGSS)=GSSNR
ENDIF
ENDDO
END IF ! ...end of check for simplified solar distribution
! Check every surface as a receiving subsurface of the receiving surface
NSBS=0
HasWindow=.FALSE.
!legacy: IF (OSENV(HTS) > 10) WINDOW=.TRUE. -->Note: WINDOW was set true for roof ponds, solar walls, or other zones
DO SBSNR = 1, TotSurfaces ! Loop through the surfaces yet again (looking for subsurfaces of GRSNR)...
IF (.NOT.Surface(SBSNR)%HeatTransSurf) CYCLE ! Skip non heat transfer subsurfaces
IF (SBSNR == GRSNR) CYCLE ! Surface itself cannot be its own subsurface
IF (Surface(SBSNR)%BaseSurf /= GRSNR) CYCLE ! Ignore subsurfaces of other surfaces and other surfaces
IF (Construct(Surface(SBSNR)%Construction)%TransDiff > 0.0d0) HasWindow=.TRUE. ! Check for window
CALL CHKSBS(HTS,GRSNR,SBSNR) ! Check that the receiving surface completely encloses the subsurface;
! severe error if not
NSBS=NSBS+1
IF (NSBS > MaxSBS) THEN
ALLOCATE(ListTemp(MaxSBS*2))
ListTemp=0
ListTemp(1:MaxSBS)=SBS(1:MaxSBS)
DEALLOCATE(SBS)
ALLOCATE(SBS(MaxSBS*2))
SBS=ListTemp
MaxSBS=MaxSBS*2
DEALLOCATE(ListTemp)
ENDIF
SBS(NSBS)=SBSNR
END DO ! ...end of surfaces DO loop (SBSNR)
! Check every surface as a back surface
NBKS=0
! Except for simplified
! interior solar distribution,
IF ((SolarDistribution == FullInteriorExterior) .AND. & ! For full interior solar distribution
(HasWindow)) THEN ! and a window present on base surface (GRSNR)
DO BackSurfaceNumber = 1, TotSurfaces ! Loop through surfaces yet again, looking for back surfaces to GRSNR
IF (.NOT.Surface(BackSurfaceNumber)%HeatTransSurf) CYCLE ! Skip non-heat transfer surfaces
IF (Surface(BackSurfaceNumber)%BaseSurf == GRSNR) CYCLE ! Skip subsurfaces of this GRSNR
IF (BackSurfaceNumber == GRSNR) CYCLE ! A back surface cannot be GRSNR itself
IF (Surface(BackSurfaceNumber)%Zone /= Surface(GRSNR)%Zone) CYCLE ! Skip if back surface not in zone
IF (Surface(BackSurfaceNumber)%Class == SurfaceClass_IntMass) CYCLE
! Following line removed 1/27/03 by FCW. Was in original code that didn't do beam solar transmitted through
! interior windows. Was removed to allow such beam solar but then somehow was put back in.
!IF (Surface(BackSurfaceNumber)%BaseSurf /= BackSurfaceNumber) CYCLE ! Not for subsurfaces of Back Surface
CALL CHKBKS(BackSurfaceNumber,GRSNR) ! CHECK FOR CONVEX ZONE; severe error if not
NBKS=NBKS+1
IF (NBKS > MaxBKS) THEN
ALLOCATE(ListTemp(MaxBKS*2))
ListTemp=0
ListTemp(1:MaxBKS)=BKS(1:MaxBKS)
DEALLOCATE(BKS)
ALLOCATE(BKS(MaxBKS*2))
BKS=ListTemp
MaxBKS=MaxBKS*2
DEALLOCATE(ListTemp)
ENDIF
BKS(NBKS)=BackSurfaceNumber
END DO ! ...end of surfaces DO loop (BackSurfaceNumber)
END IF
! Put this into the ShadowComb data structure
ShadowComb(GRSNR)%UseThisSurf=.true.
ShadowComb(GRSNR)%NumGenSurf=NGSS
ShadowComb(GRSNR)%NumBackSurf=NBKS
ShadowComb(GRSNR)%NumSubSurf=NSBS
MaxDim=MAX(MaxDim,NGSS,NBKS,NSBS)
ALLOCATE(ShadowComb(GRSNR)%GenSurf(0:ShadowComb(GRSNR)%NumGenSurf))
ShadowComb(GRSNR)%GenSurf(0)=0
IF (ShadowComb(GRSNR)%NumGenSurf > 0) THEN
ShadowComb(GRSNR)%GenSurf(1:ShadowComb(GRSNR)%NumGenSurf)=GSS(1:NGSS)
ENDIF
ALLOCATE(ShadowComb(GRSNR)%BackSurf(0:ShadowComb(GRSNR)%NumBackSurf))
ShadowComb(GRSNR)%BackSurf(0)=0
IF (ShadowComb(GRSNR)%NumBackSurf > 0) THEN
ShadowComb(GRSNR)%BackSurf(1:ShadowComb(GRSNR)%NumBackSurf)=BKS(1:NBKS)
ENDIF
ALLOCATE(ShadowComb(GRSNR)%SubSurf(0:ShadowComb(GRSNR)%NumSubSurf))
ShadowComb(GRSNR)%SubSurf(0)=0
IF (ShadowComb(GRSNR)%NumSubSurf > 0) THEN
ShadowComb(GRSNR)%SubSurf(1:ShadowComb(GRSNR)%NumSubSurf)=SBS(1:NSBS)
ENDIF
END DO ! ...end of surfaces (GRSNR) DO loop
DEALLOCATE(GSS)
DEALLOCATE(SBS)
DEALLOCATE(BKS)
WRITE(OutputFileShading,fmta) ' Shadowing Combinations'
SELECT CASE (SolarDistribution)
CASE (MinimalShadowing)
WRITE(OutputFileShading,fmta) ' ..Solar Distribution=Minimal Shadowing, Detached Shading will not be used'// &
' in shadowing calculations'
CASE (FullExterior)
IF (CalcSolRefl) THEN
WRITE(OutputFileShading,fmta) '..Solar Distribution=FullExteriorWithReflectionsFromExteriorSurfaces'
ELSE
WRITE(OutputFileShading,fmta) '..Solar Distribution=FullExterior'
ENDIF
CASE (FullInteriorExterior)
IF (CalcSolRefl) THEN
WRITE(OutputFileShading,fmta) '..Solar Distribution=FullInteriorAndExteriorWithReflectionsFromExteriorSurfaces'
ELSE
WRITE(OutputFileShading,fmta) '..Solar Distribution=FullInteriorAndExterior'
ENDIF
CASE DEFAULT
END SELECT
WRITE(OutputFileShading,fmta) '..In the following, only the first 10 reference surfaces will be shown.'
WRITE(OutputFileShading,fmta) '..But all surfaces are used in the calculations.'
DO HTS=1,TotSurfaces
WRITE(OutputFileShading,fmta) ' =================================='
IF (ShadowComb(HTS)%UseThisSurf) THEN
IF (Surface(HTS)%IsConvex) THEN
WRITE(OutputFileShading,fmta) ' Surface='//TRIM(Surface(HTS)%Name)// &
' is used as Receiving Surface in calculations and is convex.'
ELSE
WRITE(OutputFileShading,fmta) ' Surface='//TRIM(Surface(HTS)%Name)// &
' is used as Receiving Surface in calculations and is non-convex.'
IF (ShadowComb(HTS)%NumGenSurf > 0) THEN
IF (DisplayExtraWarnings) THEN
CALL ShowWarningError('DetermineShadowingCombinations: Surface="'// &
trim(Surface(HTS)%Name)//'" is a receiving surface and is non-convex.')
CALL ShowContinueError('...Shadowing values may be inaccurate. Check .shd report file for more surface shading details')
ELSE
TotalReceivingNonConvexSurfaces=TotalReceivingNonConvexSurfaces+1
ENDIF
ENDIF
ENDIF
ELSE
WRITE(OutputFileShading,fmta) ' Surface='//TRIM(Surface(HTS)%Name)// &
' is not used as Receiving Surface in calculations.'
ENDIF
WRITE(OutputFileShading,*) 'Number of general casting surfaces=',ShadowComb(HTS)%NumGenSurf
DO NGSS=1,ShadowComb(HTS)%NumGenSurf
IF (NGSS <= 10) &
WRITE(OutputFileShading,fmta) ' ..Surface='//TRIM(Surface(ShadowComb(HTS)%GenSurf(NGSS))%Name)
CastingSurface(ShadowComb(HTS)%GenSurf(NGSS))=.true.
ENDDO
WRITE(OutputFileShading,*) 'Number of back surfaces=',ShadowComb(HTS)%NumBackSurf
DO NGSS=1,MIN(10,ShadowComb(HTS)%NumBackSurf)
WRITE(OutputFileShading,fmta) ' ...Surface='//TRIM(Surface(ShadowComb(HTS)%BackSurf(NGSS))%Name)
ENDDO
WRITE(OutputFileShading,*) 'Number of receiving sub surfaces=',ShadowComb(HTS)%NumSubSurf
DO NGSS=1,MIN(10,ShadowComb(HTS)%NumSubSurf)
WRITE(OutputFileShading,fmta) ' ....Surface='//TRIM(Surface(ShadowComb(HTS)%SubSurf(NGSS))%Name)
ENDDO
ENDDO
DO HTS=1,TotSurfaces
IF (CastingSurface(HTS) .and. .not. Surface(HTS)%IsConvex) THEN
IF (DisplayExtraWarnings) THEN
CALL ShowSevereError('DetermineShadowingCombinations: Surface="'// &
trim(Surface(HTS)%Name)//'" is a casting surface and is non-convex.')
CALL ShowContinueError('...Shadowing values may be inaccurate. Check .shd report file for more surface shading details')
ELSE
TotalCastingNonConvexSurfaces=TotalCastingNonConvexSurfaces+1
ENDIF
ENDIF
ENDDO
DEALLOCATE(CastingSurface)
IF (TotalReceivingNonConvexSurfaces > 0) THEN
CALL ShowWarningMessage('DetermineShadowingCombinations: There are '//trim(TrimSigDigits(TotalReceivingNonConvexSurfaces))// &
' surfaces which are receiving surfaces and are non-convex.')
CALL ShowContinueError('...Shadowing values may be inaccurate. Check .shd report file for more surface shading details')
CALL ShowContinueError('...Add Output:Diagnostics,DisplayExtraWarnings; to see individual warnings for each surface.')
TotalWarningErrors=TotalWarningErrors+TotalReceivingNonConvexSurfaces
ENDIF
IF (TotalCastingNonConvexSurfaces > 0) THEN
CALL ShowSevereMessage('DetermineShadowingCombinations: There are '//trim(TrimSigDigits(TotalCastingNonConvexSurfaces))// &
' surfaces which are casting surfaces and are non-convex.')
CALL ShowContinueError('...Shadowing values may be inaccurate. Check .shd report file for more surface shading details')
CALL ShowContinueError('...Add Output:Diagnostics,DisplayExtraWarnings; to see individual severes for each surface.')
TotalSevereErrors=TotalSevereErrors+TotalCastingNonConvexSurfaces
ENDIF
RETURN
END SUBROUTINE DetermineShadowingCombinations