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 CalcThermalComfortSimpleASH55
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer
! DATE WRITTEN June 2005
! MODIFIED
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Determines if the space is within the ASHRAE 55-2004 comfort region
! based on operative temperature and humidity ratio
! METHODOLOGY EMPLOYED:
! REFERENCES:
! USE STATEMENTS:
USE OutputReportTabular, Only: isInQuadrilateral
USE General, ONLY: RoundSigDigits
USE DataEnvironment, Only: EnvironmentName, RunPeriodEnvironment, EnvironmentStartEnd
USE OutputReportPredefined
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: OperTemp
REAL(r64) :: HumidRatio
REAL(r64) :: CurAirTemp
REAL(r64) :: CurMeanRadiantTemp
REAL(r64) :: NumberOccupants
LOGICAL :: isComfortableWithSummerClothes
LOGICAL :: isComfortableWithWinterClothes
INTEGER :: iPeople
INTEGER :: iZone
REAL(r64) :: allowedHours
LOGICAL :: showWarning
AnyZoneTimeNotSimpleASH55Summer = 0.0d0
AnyZoneTimeNotSimpleASH55Winter = 0.0d0
AnyZoneTimeNotSimpleASH55Either = 0.0d0
!assume the zone is unoccupied
ThermalComfortInASH55%ZoneIsOccupied = .FALSE.
!loop through the people objects and determine if the zone is currently occupied
DO iPeople = 1, TotPeople
ZoneNum = People(iPeople)%ZonePtr
NumberOccupants = People(iPeople)%NumberOfPeople * GetCurrentScheduleValue(People(iPeople)%NumberOfPeoplePtr)
IF (NumberOccupants .GT. 0) THEN
ThermalComfortInASH55(ZoneNum)%ZoneIsOccupied = .TRUE.
END IF
END DO
!loop through the zones and determine if in simple ashrae 55 comfort regions
DO iZone = 1, NumOfZones
IF (ThermalComfortInASH55(iZone)%ZoneIsOccupied) THEN
!keep track of occupied hours
ZoneOccHrs(iZone) = ZoneOccHrs(iZone) + TimeStepZone
IF (IsZoneDV(iZone) .or. IsZoneUI(iZone)) THEN
CurAirTemp = TCMF(iZone)
ELSE
CurAirTemp = ZTAV(iZone)
ENDIF
CurMeanRadiantTemp = MRT(iZone)
OperTemp = CurAirTemp * 0.5d0 + CurMeanRadiantTemp * 0.5d0
HumidRatio = ZoneAirHumRat(iZone)
!for debugging
!ThermalComfortInASH55(iZone)%dCurAirTemp = CurAirTemp
!ThermalComfortInASH55(iZone)%dCurMeanRadiantTemp = CurMeanRadiantTemp
!ThermalComfortInASH55(iZone)%dOperTemp = OperTemp
!ThermalComfortInASH55(iZone)%dHumidRatio = HumidRatio
!
! From ASHRAE Standard 55-2004 Appendix D
! Run AirTemp(C) RH(%) Season HumidRatio
! 1 19.6 86 Winter 0.012
! 2 23.9 66 Winter 0.012
! 3 25.7 15 Winter 0.003
! 4 21.2 20 Winter 0.003
! 5 23.6 67 Summer 0.012
! 6 26.8 56 Summer 0.012
! 7 27.9 13 Summer 0.003
! 8 24.7 16 Summer 0.003
!
! But the standard says "no recommended lower humidity limit" so it should
! really extend down to the 0.0 Humidity ratio line. Extrapolating we get
! the values that are shown in the following table
!
! Run AirTemp(C) Season HumidRatio
! 1 19.6 Winter 0.012
! 2 23.9 Winter 0.012
! 3 26.3 Winter 0.000
! 4 21.7 Winter 0.000
! 5 23.6 Summer 0.012
! 6 26.8 Summer 0.012
! 7 28.3 Summer 0.000
! 8 25.1 Summer 0.000
!
!check summer clothing conditions
isComfortableWithSummerClothes = isInQuadrilateral(OperTemp,HumidRatio, &
25.1d0, 0.0d0, &
23.6d0, 0.012d0, &
26.8d0, 0.012d0, &
28.3d0, 0.0d0)
!check winter clothing conditions
isComfortableWithWinterClothes = isInQuadrilateral(OperTemp,HumidRatio, &
21.7d0, 0.0d0, &
19.6d0, 0.012d0, &
23.9d0, 0.012d0, &
26.3d0, 0.0d0)
IF (isComfortableWithSummerClothes) THEN
ThermalComfortInASH55(iZone)%timeNotSummer = 0.0d0
ELSE
ThermalComfortInASH55(iZone)%timeNotSummer = TimeStepZone
ThermalComfortInASH55(iZone)%totalTimeNotSummer = &
ThermalComfortInASH55(iZone)%totalTimeNotSummer + TimeStepZone
AnyZoneTimeNotSimpleASH55Summer = TimeStepZone
END IF
IF (isComfortableWithWinterClothes) THEN
ThermalComfortInASH55(iZone)%timeNotWinter = 0.0d0
ELSE
ThermalComfortInASH55(iZone)%timeNotWinter = TimeStepZone
ThermalComfortInASH55(iZone)%totalTimeNotWinter = &
ThermalComfortInASH55(iZone)%totalTimeNotWinter + TimeStepZone
AnyZoneTimeNotSimpleASH55Winter = TimeStepZone
END IF
IF (isComfortableWithSummerClothes .OR. isComfortableWithWinterClothes) THEN
ThermalComfortInASH55(iZone)%timeNotEither = 0.0d0
ELSE
ThermalComfortInASH55(iZone)%timeNotEither = TimeStepZone
ThermalComfortInASH55(iZone)%totalTimeNotEither = &
ThermalComfortInASH55(iZone)%totalTimeNotEither + TimeStepZone
AnyZoneTimeNotSimpleASH55Either = TimeStepZone
END IF
ELSE
!when no one present in that portion of the zone then no one can be uncomfortable
ThermalComfortInASH55(iZone)%timeNotSummer = 0.0d0
ThermalComfortInASH55(iZone)%timeNotWinter = 0.0d0
ThermalComfortInASH55(iZone)%timeNotEither = 0.0d0
END IF
END DO
! accumulate total time
TotalAnyZoneTimeNotSimpleASH55Summer = TotalAnyZoneTimeNotSimpleASH55Summer + AnyZoneTimeNotSimpleASH55Summer
TotalAnyZoneTimeNotSimpleASH55Winter = TotalAnyZoneTimeNotSimpleASH55Winter + AnyZoneTimeNotSimpleASH55Winter
TotalAnyZoneTimeNotSimpleASH55Either = TotalAnyZoneTimeNotSimpleASH55Either + AnyZoneTimeNotSimpleASH55Either
!was EndEnvrnsFlag prior to CR7562
IF (EndDesignDayEnvrnsFlag) THEN
allowedHours = REAL(NumOfDayInEnvrn,r64) * 24.d0 * 0.04d0
!first check if warning should be printed
showWarning = .FALSE.
DO iZone = 1, NumOfZones
IF (ThermalComfortInASH55(iZone)%Enable55Warning) THEN
IF (ThermalComfortInASH55(iZone)%totalTimeNotEither .GT. allowedHours) THEN
showWarning = .TRUE.
END IF
END IF
END DO
!if any zones should be warning print it out
IF (showWarning) THEN
CALL ShowWarningError('More than 4% of time (' // Trim(RoundSigDigits(allowedHours,1)) // &
' hours) uncomfortable in one or more zones ')
CALL ShowContinueError('Based on ASHRAE 55-2004 graph (Section 5.2.1.1)')
IF (RunPeriodEnvironment) THEN
CALL ShowContinueError('During Environment ['//TRIM(EnvironmentStartEnd)//']: ' // &
Trim(EnvironmentName))
ELSE
CALL ShowContinueError('During SizingPeriod Environment ['//TRIM(EnvironmentStartEnd)//']: ' &
// Trim(EnvironmentName))
ENDIF
DO iZone = 1, NumOfZones
IF (ThermalComfortInASH55(iZone)%Enable55Warning) THEN
IF (ThermalComfortInASH55(iZone)%totalTimeNotEither .GT. allowedHours) THEN
CALL ShowContinueError(Trim(RoundSigDigits( &
ThermalComfortInASH55(iZone)%totalTimeNotEither,1)) &
// ' hours were uncomfortable in zone: ' // TRIM(Zone(iZone)%Name))
END IF
END IF
END DO
END IF
! put in predefined reports
DO iZone = 1, NumOfZones
CALL PreDefTableEntry(pdchSCwinterClothes,Zone(iZone)%Name,ThermalComfortInASH55(iZone)%totalTimeNotWinter)
CALL PreDefTableEntry(pdchSCsummerClothes,Zone(iZone)%Name,ThermalComfortInASH55(iZone)%totalTimeNotSummer)
CALL PreDefTableEntry(pdchSCeitherClothes,Zone(iZone)%Name,ThermalComfortInASH55(iZone)%totalTimeNotEither)
END DO
CALL PreDefTableEntry(pdchSCwinterClothes,'Facility',TotalAnyZoneTimeNotSimpleASH55Winter)
CALL PreDefTableEntry(pdchSCsummerClothes,'Facility',TotalAnyZoneTimeNotSimpleASH55Summer)
CALL PreDefTableEntry(pdchSCeitherClothes,'Facility',TotalAnyZoneTimeNotSimpleASH55Either)
!set value for ABUPS report
TotalTimeNotSimpleASH55EitherForABUPS = TotalAnyZoneTimeNotSimpleASH55Either
!reset accumulation for new environment
DO iZone = 1, NumOfZones
ThermalComfortInASH55(iZone)%totalTimeNotWinter = 0.0d0
ThermalComfortInASH55(iZone)%totalTimeNotSummer = 0.0d0
ThermalComfortInASH55(iZone)%totalTimeNotEither = 0.0d0
END DO
TotalAnyZoneTimeNotSimpleASH55Winter = 0.0d0
TotalAnyZoneTimeNotSimpleASH55Summer = 0.0d0
TotalAnyZoneTimeNotSimpleASH55Either = 0.0d0
! report how the aggregation is conducted
SELECT CASE (kindOfSim)
CASE(ksDesignDay)
CALL addFootNoteSubTable(pdstSimpleComfort,'Aggregated over the Design Days')
CASE(ksRunPeriodDesign)
CALL addFootNoteSubTable(pdstSimpleComfort,'Aggregated over the RunPeriods for Design')
CASE(ksRunPeriodWeather)
CALL addFootNoteSubTable(pdstSimpleComfort,'Aggregated over the RunPeriods for Weather')
END SELECT
!report number of occupied hours per week for LEED report
DO iZone = 1, NumOfZones
CALL PreDefTableEntry(pdchLeedSutHrsWeek,Zone(iZone)%Name,7 * 24 * (ZoneOccHrs(iZone)/ (NumOfDayInEnvrn * 24)))
END DO
END IF
END SUBROUTINE CalcThermalComfortSimpleASH55