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 CalcZoneAirTempSetpoints
! SUBROUTINE INFORMATION:
! AUTHOR Russ Taylor
! DATE WRITTEN Nov 1997
! MODIFIED Aug 2013, Xiufeng Pang (XP) - Added code for updating set points during
! optimum start period
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine sets what the setpoints for each controlled zone should be based on schedules.
! This is called each time step.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE ScheduleManager, ONLY: GetCurrentScheduleValue, GetScheduleValuesForDay
USE General, ONLY: TrimSigDigits
USE DataZoneControls, ONLY: OccRoomTSetPointHeat, OccRoomTSetPointCool
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 :: RelativeZoneNum
INTEGER :: ActualZoneNum
INTEGER :: TempControlSchedIndex
INTEGER :: SetPointTempSchedIndex
INTEGER :: SetPointTempSchedIndexHot
INTEGER :: SetPointTempSchedIndexCold
INTEGER :: SchedNameIndex
INTEGER :: SchedTypeIndex
REAL(r64), ALLOCATABLE, DIMENSION(:,:) :: DaySPValues !Day room temp setpoint values - for optimum start
REAL(r64) :: OccRoomSP !Occupied room temp set point - for optimum start
INTEGER :: OccStartTime ! Occupancy start time - for optimum start
! FLOW:
TempControlType = 0 ! Default
! Place holder for occupied heating and cooling set points - for optimum start
IF (.NOT. ALLOCATED(OccRoomTSetPointHeat)) THEN
ALLOCATE(OccRoomTSetPointHeat(NumOfZones))
END IF
IF (.NOT. ALLOCATED(OccRoomTSetPointCool)) THEN
ALLOCATE(OccRoomTSetPointCool(NumOfZones))
END IF
OccRoomTSetPointHeat = 0.0d0
OccRoomTSetPointCool = 100.0d0
DO RelativeZoneNum = 1, NumTempControlledZones
! What if this zone not controlled???
ActualZoneNum = TempControlledZone(RelativeZoneNum)%ActualZoneNum
TempControlSchedIndex = TempControlledZone(RelativeZoneNum)%CTSchedIndex
TempControlType(ActualZoneNum) = GetCurrentScheduleValue(TempControlSchedIndex)
! Error detection for these values is done in the Get routine
SELECT CASE (TempControlType(ActualZoneNum)) ! Is this missing the possibility of sometimes having no control on a zone
! during the simulation?
CASE (0) ! Uncontrolled
CASE (SingleHeatingSetPoint)
SchedNameIndex = TempControlledZone(RelativeZoneNum)%SchIndx_SingleHeatSetPoint
SchedTypeIndex = TempControlledZone(RelativeZoneNum)%ControlTypeSchIndx(SchedNameIndex)
SetPointTempSchedIndex = SetPointSingleHeating(SchedTypeIndex)%TempSchedIndex
TempZoneThermostatSetPoint(ActualZoneNum) = GetCurrentScheduleValue(SetPointTempSchedIndex)
Call AdjustAirSetpointsforOpTempCntrl(RelativeZoneNum, ActualZoneNum, TempZoneThermostatSetPoint(ActualZoneNum))
ZoneThermostatSetPointLo(ActualZoneNum) = TempZoneThermostatSetPoint(ActualZoneNum)
! ZoneThermostatSetPointHi(ActualZoneNum) = TempZoneThermostatSetPoint(ActualZoneNum)
CASE (SingleCoolingSetPoint)
SchedNameIndex = TempControlledZone(RelativeZoneNum)%SchIndx_SingleCoolSetPoint
SchedTypeIndex = TempControlledZone(RelativeZoneNum)%ControlTypeSchIndx(SchedNameIndex)
SetPointTempSchedIndex = SetPointSingleCooling(SchedTypeIndex)%TempSchedIndex
TempZoneThermostatSetPoint(ActualZoneNum) = GetCurrentScheduleValue(SetPointTempSchedIndex)
Call AdjustAirSetpointsforOpTempCntrl(RelativeZoneNum, ActualZoneNum, TempZoneThermostatSetPoint(ActualZoneNum))
ZoneThermostatSetPointHi(ActualZoneNum) = TempZoneThermostatSetPoint(ActualZoneNum)
! ZoneThermostatSetPointLo(ActualZoneNum) = TempZoneThermostatSetPoint(ActualZoneNum)
CALL AdjustCoolingSetPointforTempAndHumidityControl(RelativeZoneNum,ActualZoneNum)
CASE (SingleHeatCoolSetPoint)
SchedNameIndex = TempControlledZone(RelativeZoneNum)%SchIndx_SingleHeatCoolSetPoint
SchedTypeIndex = TempControlledZone(RelativeZoneNum)%ControlTypeSchIndx(SchedNameIndex)
SetPointTempSchedIndex = SetPointSingleHeatCool(SchedTypeIndex)%TempSchedIndex
TempZoneThermostatSetPoint(ActualZoneNum) = GetCurrentScheduleValue(SetPointTempSchedIndex)
Call AdjustAirSetpointsforOpTempCntrl(RelativeZoneNum, ActualZoneNum, TempZoneThermostatSetPoint(ActualZoneNum))
ZoneThermostatSetPointHi(ActualZoneNum) = TempZoneThermostatSetPoint(ActualZoneNum)
ZoneThermostatSetPointLo(ActualZoneNum) = TempZoneThermostatSetPoint(ActualZoneNum)
!Change the room set point to occupied set point during optimum start period--------------
IF (Allocated(OptStartData%OptStartFlag)) THEN
IF (.not. allocated(DaySPValues)) THEN
ALLOCATE (DaySPValues(24,NumOfTimeStepInHour))
END IF
IF (OptStartData%ActualZoneNum(ActualZoneNum)==ActualZoneNum) THEN
Call GetScheduleValuesForDay(SetPointTempSchedIndexCold,DaySPValues)
OccStartTime = ceiling(OptStartData%OccStartTime(ActualZoneNum)) + 1
TempZoneThermostatSetPoint(ActualZoneNum)=DaySPValues(OccStartTime,1)
END IF
IF (OptStartData%OptStartFlag(ActualZoneNum)) THEN
ZoneThermostatSetPointHi(ActualZoneNum) = TempZoneThermostatSetPoint(ActualZoneNum)
ZoneThermostatSetPointLo(ActualZoneNum) = TempZoneThermostatSetPoint(ActualZoneNum)
END IF
END IF
!--------------------------------------------------------------------------------------------
CASE (DualSetPointWithDeadBand)
SchedNameIndex = TempControlledZone(RelativeZoneNum)%SchIndx_DualSetPointWDeadBand
SchedTypeIndex = TempControlledZone(RelativeZoneNum)%ControlTypeSchIndx(SchedNameIndex)
SetPointTempSchedIndexHot = SetPointDualHeatCool(SchedTypeIndex)%HeatTempSchedIndex
SetPointTempSchedIndexCold = SetPointDualHeatCool(SchedTypeIndex)%CoolTempSchedIndex
ZoneThermostatSetPointHi(ActualZoneNum) = GetCurrentScheduleValue(SetPointTempSchedIndexCold)
Call AdjustAirSetpointsforOpTempCntrl(RelativeZoneNum, ActualZoneNum, ZoneThermostatSetPointHi(ActualZoneNum))
ZoneThermostatSetPointLo(ActualZoneNum) = GetCurrentScheduleValue(SetPointTempSchedIndexHot)
Call AdjustAirSetpointsforOpTempCntrl(RelativeZoneNum, ActualZoneNum, ZoneThermostatSetPointLo(ActualZoneNum))
!Change the room set point to occupied set point during optimum start period--------------
IF (Allocated(OptStartData%OptStartFlag)) THEN
IF (.not. allocated(DaySPValues)) THEN
ALLOCATE (DaySPValues(24,NumOfTimeStepInHour))
END IF
IF (OptStartData%ActualZoneNum(ActualZoneNum)==ActualZoneNum) THEN
Call GetScheduleValuesForDay(SetPointTempSchedIndexCold,DaySPValues)
OccStartTime = ceiling(OptStartData%OccStartTime(ActualZoneNum)) + 1
OccRoomTSetPointCool(ActualZoneNum) = DaySPValues(OccStartTime,1)
Call GetScheduleValuesForDay(SetPointTempSchedIndexHot,DaySPValues)
OccRoomTSetPointHeat(ActualZoneNum) = DaySPValues(OccStartTime,1)
END IF
IF (OptStartData%OptStartFlag(ActualZoneNum)) THEN
ZoneThermostatSetPointHi(ActualZoneNum) = OccRoomTSetPointCool(ActualZoneNum)
ZoneThermostatSetPointLo(ActualZoneNum) = OccRoomTSetPointHeat(ActualZoneNum)
END IF
END IF
!--------------------------------------------------------------------------------------------
CALL AdjustCoolingSetPointforTempAndHumidityControl(RelativeZoneNum,ActualZoneNum)
CASE DEFAULT
CALL ShowSevereError('CalcZoneAirTempSetpoints: Illegal control type for Zone='//TRIM(Zone(ActualZoneNum)%Name)// &
', Found value='//TRIM(TrimSigDigits(TempControlType(ActualZoneNum)))// &
', in Schedule='//TRIM(TempControlledZone(RelativeZoneNum)%ControlTypeSchedName))
END SELECT
END DO
If (NumComfortControlledZones > 0) Call CalcZoneAirComfortSetpoints
RETURN
END SUBROUTINE CalcZoneAirTempSetpoints