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 ComputeIntSolarAbsorpFactors
! SUBROUTINE INFORMATION:
! AUTHOR Legacy Code
! DATE WRITTEN
! MODIFIED B. Griffith, Oct 2010, deal with no floor case
! L. Lawrie, Mar 2012, relax >154 tilt even further (>120 considered non-wall by ASHRAE)
! RE-ENGINEERED Lawrie, Oct 2000
! PURPOSE OF THIS SUBROUTINE:
! This routine computes the fractions of diffusely transmitted
! solar energy absorbed by each zone surface.
! METHODOLOGY EMPLOYED:
! It is assumed that all transmitted solar energy is incident
! on the floors of the zone. The fraction directly absorbed in
! the floor is given by 'ISABSF'. It is proportional to the
! area * solar absorptance. The remaining solar energy is then
! distributed uniformly around the room according to
! area*absorptance product
! REFERENCES:
! BLAST/IBLAST code, original author George Walton
! USE STATEMENTS:
USE General, ONLY: RoundSigDigits
USE DataWindowEquivalentLayer
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ConstrNum ! Index for constructions
INTEGER :: FirstZoneSurf ! Index of first surface in current zone
INTEGER :: LastZoneSurf ! Index of last surface in current zone
REAL(r64) :: AreaSum ! Intermediate calculation value
INTEGER :: SurfNum ! DO loop counter for zone surfaces
INTEGER :: ZoneNum ! Loop Counter for Zones
INTEGER :: Lay ! Window glass layer number
REAL(r64) :: AbsDiffTotWin ! Sum of a window's glass layer solar absorptances
REAL(r64) :: TestFractSum
REAL(r64) :: HorizAreaSum
! FLOW:
IF (.not. ALLOCATED(ISABSF)) THEN
ALLOCATE(ISABSF(TotSurfaces))
ENDIF
ISABSF=0.0d0
DO ZoneNum=1,NumOfZones
FirstZoneSurf=Zone(ZoneNum)%SurfaceFirst
LastZoneSurf=Zone(ZoneNum)%SurfaceLast
AreaSum = 0.0D0
DO SurfNum = FirstZoneSurf, LastZoneSurf
IF (.not. Surface(SurfNum)%HeatTransSurf) CYCLE
!CR 8229, relaxed from -0.99 to -0.5 (Tilt > 154)
! CR8769 !use ASHRAE std of >120, -0.9 to -0.5 (Tilt > 120)
! IF (Surface(SurfNum)%Class == SurfaceClass_Floor) THEN
! write(outputfiledebug,*) 'surf=',trim(surface(surfnum)%name),Surface(SurfNum)%CosTilt
! endif
IF (Zone(ZoneNum)%OfType == StandardZone .and. Surface(SurfNum)%CosTilt < -0.5d0) &
AreaSum = AreaSum + Surface(SurfNum)%Area
! Next is not implemented but would be:
! IF ((Zone(ZoneNum)%OfType .eq. SolarWallZone .or Zone(ZoneNum)%OfType .eq. RoofPondZone) .and. &
! Surface(SurfNum)%ExtBoundCond > 0) AreaSum = AreaSum + Surface(SurfNum)%Area
END DO
HorizAreaSum = AreaSum
IF ((.NOT. Zone(ZoneNum)%HasFloor) .AND. (HorizAreaSum > 0.d0)) THEN
!fill floor area even though surfs not called "Floor", they are roughly horizontal and face upwards.
Zone(ZoneNum)%FloorArea= HorizAreaSum
CALL ShowWarningError('ComputeIntSolarAbsorpFactors: Solar distribution model is set to place solar gains '// &
'on the zone floor,')
CALL ShowContinueError('...Zone="'//trim(Zone(ZoneNum)%Name)//'" has no floor, but has approximate horizontal surfaces.')
CALL ShowContinueError('...these Tilt > 120°, (area=['//trim(RoundSigDigits(HorizAreaSum,2))//'] m2) will be used.')
ENDIF
! Compute ISABSF
DO SurfNum = FirstZoneSurf, LastZoneSurf
IF (.not. Surface(SurfNum)%HeatTransSurf) CYCLE
! only horizontal surfaces. ! !CR 8229, relaxed from -0.99 to -0.5 (Tilt > 154)
! only horizontal surfaces. ! !CR8769 use ASHRAE std of >120, -0.9 to -0.5 (Tilt > 120)
IF ( (Zone(ZoneNum)%OfType /= StandardZone .or. Surface(SurfNum)%CosTilt < -0.5d0) .and. &
(Zone(ZoneNum)%OfType .eq. StandardZone .or. Surface(SurfNum)%ExtBoundCond > 0) ) THEN
ConstrNum=Surface(SurfNum)%Construction
! last minute V3.1
IF (Construct(ConstrNum)%TransDiff <= 0.0d0) THEN !Opaque surface
IF (AreaSum > 0.0d0) &
ISABSF(SurfNum) = Surface(SurfNum)%Area*Construct(ConstrNum)%InsideAbsorpSolar/AreaSum
ELSE !Window (floor windows are assumed to have no shading device and no divider,
!and assumed to be non-switchable)
IF(SurfaceWindow(SurfNum)%StormWinFlag==1) ConstrNum = Surface(SurfNum)%StormWinConstruction
AbsDiffTotWin = 0.0d0
IF ( .NOT. Construct(Surface(SurfNum)%Construction)%WindowTypeEQL) THEN
DO Lay = 1,Construct(ConstrNum)%TotGlassLayers
AbsDiffTotWin = AbsDiffTotWin + Construct(ConstrNum)%AbsDiffBack(Lay)
END DO
ELSE
DO Lay = 1, CFS(Construct(ConstrNum)%EQLConsPtr)%NL
AbsDiffTotWin = AbsDiffTotWin + Construct(ConstrNum)%AbsDiffBackEQL(Lay)
END DO
ENDIF
IF (AreaSum > 0.0d0) &
ISABSF(SurfNum) = Surface(SurfNum)%Area * AbsDiffTotWin / AreaSum
END IF
END IF
END DO
!CR 8229 test ISABSF for problems
TestFractSum = SUM(ISABSF(FirstZoneSurf:LastZoneSurf))
IF ( TestFractSum <= 0.0d0) THEN
IF (Zone(ZoneNum)%ExtWindowArea > 0.0d0) THEN ! we have a problem, the sun has no floor to go to
IF (Zone(ZoneNum)%FloorArea <= 0.0d0) THEN
CALL ShowSevereError('ComputeIntSolarAbsorpFactors: Solar distribution model is set to place solar gains '// &
'on the zone floor,')
CALL ShowContinueError('but Zone ="'//TRIM(Zone(ZoneNum)%Name)//'" does not appear to have any floor surfaces.')
CALL ShowContinueError('Solar gains will be spread evenly on all surfaces in the zone, and the simulation continues...')
ELSE ! Floor Area > 0 but still can't absorb
CALL ShowSevereError('ComputeIntSolarAbsorpFactors: Solar distribution model is set to place solar gains '// &
'on the zone floor,')
CALL ShowContinueError('but Zone ="'//TRIM(Zone(ZoneNum)%Name)//'" floor cannot absorb any solar gains. ')
CALL ShowContinueError('Check the solar absorptance of the inside layer of the floor surface construction/material.')
CALL ShowContinueError('Solar gains will be spread evenly on all surfaces in the zone, and the simulation continues...')
ENDIF
! try again but use an even spread across all the surfaces in the zone, regardless of horizontal
! so as to not lose solar energy
AreaSum = 0.0d0
DO SurfNum = FirstZoneSurf, LastZoneSurf
IF (.not. Surface(SurfNum)%HeatTransSurf) CYCLE
AreaSum = AreaSum + Surface(SurfNum)%Area
ENDDO
DO SurfNum = FirstZoneSurf, LastZoneSurf
IF (.not. Surface(SurfNum)%HeatTransSurf) CYCLE
ConstrNum=Surface(SurfNum)%Construction
IF (Construct(ConstrNum)%TransDiff <= 0.0d0) THEN !Opaque surface
IF (AreaSum > 0.0d0) &
ISABSF(SurfNum) = Surface(SurfNum)%Area*Construct(ConstrNum)%InsideAbsorpSolar/AreaSum
ELSE !Window (floor windows are assumed to have no shading device and no divider,
!and assumed to be non-switchable)
IF(SurfaceWindow(SurfNum)%StormWinFlag==1) ConstrNum = Surface(SurfNum)%StormWinConstruction
AbsDiffTotWin = 0.0d0
IF ( .NOT. Construct(Surface(SurfNum)%Construction)%WindowTypeEQL) THEN
DO Lay = 1,Construct(ConstrNum)%TotGlassLayers
AbsDiffTotWin = AbsDiffTotWin + Construct(ConstrNum)%AbsDiffBack(Lay)
END DO
ELSE
DO Lay = 1, CFS(Construct(ConstrNum)%EQLConsPtr)%NL
AbsDiffTotWin = AbsDiffTotWin + Construct(ConstrNum)%AbsDiffBackEQL(Lay)
END DO
ENDIF
IF (AreaSum > 0.0d0) &
ISABSF(SurfNum) = Surface(SurfNum)%Area * AbsDiffTotWin / AreaSum
END IF
ENDDO
ENDIF
ENDIF
END DO ! zone loop
RETURN
END SUBROUTINE ComputeIntSolarAbsorpFactors