SUBROUTINE InitSetPointManagers
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN October 2000
! MODIFIED Shirey/Raustad (FSEC), Jan 2004
! Nov 2004 - Jan 2005 M. J. Witte, GARD Analytics, Inc.
! Add new setpoint managers:
! SET POINT MANAGER:SINGLE ZONE HEATING and
! SET POINT MANAGER:SINGLE ZONE COOLING
! SET POINT MANAGER:OUTSIDE AIR PRETREAT
! Work supported by ASHRAE research project 1254-RP
! Haves Oct 2004
! July 2010 B.A. Nigusse, FSEC/UCF
! Added new setpoint managers:
! SetpointManager:MultiZone:Heating:Average
! SetpointManager:MultiZone:Cooling:Average
! SetpointManager:MultiZone:MinimumHumidity:Average
! SetpointManager:MultiZone:MaximumHumidity:Average
! Aug 2010 B.A. Nigusse, FSEC/UCF
! Added new setpoint managers:
! SetpointManager:MultiZone:Humidity:Minimum
! SetpointManager:MultiZone:Humidity:Maximum
! Sep 2010 B.A. Nigusse, FSEC/UCF
! Added control varibles for SetpointManage:Scheduled
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the Setpoint Manager objects.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEquipment, ONLY: ZoneEquipConfig, ZoneEquipInputsFilled
USE DataZoneControls, ONLY: HumidityControlZone, NumHumidityControlZones
USE InputProcessor, ONLY: FindItemInList
USE DataAirSystems, ONLY: PrimaryAirSystem
USE DataHeatBalance, ONLY: Zone
USE DataHVACGlobals, ONLY : NumPlantLoops, NumCondLoops
USE DataPlant
USE InputProcessor, ONLY: SameString
USE DataEnvironment, ONLY: GroundTemp_Deep, GroundTemp,GroundTemp_Surface, GroundTempFC
USE OutAirNodeManager, ONLY: CheckOutAirNodeNumber
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:
LOGICAL,SAVE :: MyOneTimeFlag = .TRUE.
Logical,SAVE :: MyEnvrnFlag = .TRUE. ! flag for init once at start of environment
LOGICAL,SAVE :: MyOneTimeFlag2 = .TRUE.
INTEGER :: SetZoneNum
INTEGER :: ControlledZoneNum
INTEGER :: ZoneNode
INTEGER :: ZoneInletNode
INTEGER :: SetPtMgrNum
INTEGER :: ZoneIndex
INTEGER :: CtrlNodeIndex
INTEGER :: NodeNum
INTEGER :: AirLoopNum
INTEGER :: LoopNum
INTEGER :: LoopNum2
LOGICAL :: ErrorsFound=.false.
INTEGER :: ConZoneNum
INTEGER :: MixedAirNode
INTEGER :: BranchNum
INTEGER :: BranchNum2
INTEGER :: InletBranchNum
INTEGER :: CompNum
INTEGER :: CompNum2
Logical :: LookForFan = .FALSE.
CHARACTER(len=MaxNameLength) :: CompType
CHARACTER(len=MaxNameLength) :: cSetPointManagerType
INTEGER :: FanNodeIn
INTEGER :: FanNodeOut
INTEGER :: LoopInNode
INTEGER :: HstatZoneNum
LOGICAL :: HstatZoneFound
INTEGER :: ZonesCooledIndex ! Cooled zones index in an air loop
INTEGER :: TotalBranches
INTEGER :: TotalComponents
INTEGER :: BranchNumPlantSide
INTEGER :: CompNumPlantSide
INTEGER :: VarNum
!INTEGER :: ChillerIndexPlantSide = 0
!INTEGER :: ChillerIndexDemandSide = 0
!INTEGER :: BranchIndexPlantSide = 0
!INTEGER :: BranchIndexDemandSide = 0
!INTEGER :: LoopIndexPlantSide = 0
!INTEGER :: LoopIndexDemandSide = 0
INTEGER :: TypeNum = 0
INTEGER :: TowerNum = 0
INTEGER :: CondLoopNum = 0
INTEGER :: CondBranchNum = 0
INTEGER :: NumChiller = 0
INTEGER :: NumCT = 0
INTEGER :: TypeOf_Num =0
ManagerOn = .TRUE.
! One time initializations
IF (ZoneEquipInputsFilled .and. AirLoopInputsFilled) THEN ! check that the zone equipment and air loop data has been read in
IF (MyOneTimeFlag) THEN
! Minimum humidity setpoint managers
cSetPointManagerType = cValidSPMTypes(iSPMType_SZMinHum)
DO SetPtMgrNum=1,NumSZMinHumSetPtMgrs
DO SetZoneNum = 1,SZMinHumSetPtMgr(SetPtMgrNum)%NumZones
! set the actual and controlled zone numbers
DO ControlledZoneNum = 1,NumOfZones
IF (ZoneEquipConfig(ControlledZoneNum)%ZoneNode .EQ. SZMinHumSetPtMgr(SetPtMgrNum)%ZoneNodes(SetZoneNum) ) THEN
SZMinHumSetPtMgr(SetPtMgrNum)%CtrlZoneNum(SetZoneNum) = ControlledZoneNum
SZMinHumSetPtMgr(SetPtMgrNum)%ZoneNum(SetZoneNum) = ZoneEquipConfig(ControlledZoneNum)%ActualZoneNum
EXIT
END IF
END DO
! still need to validate...
IF (SZMinHumSetPtMgr(SetPtMgrNum)%CtrlZoneNum(SetZoneNum) == 0) THEN ! didn't find
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'// &
trim(SZMinHumSetPtMgr(SetPtMgrNum)%Name)//'", invalid zone')
CALL ShowContinueError('could not find Controlled Zone='// &
TRIM(Zone(SZMinHumSetPtMgr(SetPtMgrNum)%ZoneNum(SetZoneNum))%Name))
ErrorsFound=.TRUE.
ELSE
! make sure humidity controlled zone
HstatZoneFound=.false.
DO HstatZoneNum = 1, NumHumidityControlZones
IF(HumidityControlZone(HstatZoneNum)%ActualZoneNum .NE. SZMinHumSetPtMgr(SetPtMgrNum)%ZoneNum(SetZoneNum))CYCLE
HstatZoneFound=.TRUE.
EXIT
END DO
IF (.not. HstatZoneFound) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'// &
trim(SZMinHumSetPtMgr(SetPtMgrNum)%Name)//'", invalid humidistat specification')
CALL ShowContinueError('could not locate Humidistat in Zone='// &
TRIM(Zone(SZMinHumSetPtMgr(SetPtMgrNum)%ZoneNum(SetZoneNum))%Name))
ErrorsFound=.TRUE.
ENDIF
ENDIF
END DO
END DO
! Maximum humidity setpoint managers
cSetPointManagerType = cValidSPMTypes(iSPMType_SZMaxHum)
DO SetPtMgrNum=1,NumSZMaxHumSetPtMgrs
DO SetZoneNum = 1,SZMaxHumSetPtMgr(SetPtMgrNum)%NumZones
! set the actual and controlled zone numbers
DO ControlledZoneNum = 1,NumOfZones
IF (ZoneEquipConfig(ControlledZoneNum)%ZoneNode .EQ. SZMaxHumSetPtMgr(SetPtMgrNum)%ZoneNodes(SetZoneNum) ) THEN
SZMaxHumSetPtMgr(SetPtMgrNum)%CtrlZoneNum(SetZoneNum) = ControlledZoneNum
SZMaxHumSetPtMgr(SetPtMgrNum)%ZoneNum(SetZoneNum) = ZoneEquipConfig(ControlledZoneNum)%ActualZoneNum
EXIT
END IF
END DO
! still need to validate...
IF (SZMaxHumSetPtMgr(SetPtMgrNum)%CtrlZoneNum(SetZoneNum) == 0) THEN ! didn't find
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'// &
trim(SZMaxHumSetPtMgr(SetPtMgrNum)%Name)//'", invalid zone')
CALL ShowContinueError('could not find Controlled Zone='// &
TRIM(Zone(SZMaxHumSetPtMgr(SetPtMgrNum)%ZoneNum(SetZoneNum))%Name))
ErrorsFound=.TRUE.
ELSE
! make sure humidity controlled zone
HstatZoneFound=.false.
DO HstatZoneNum = 1, NumHumidityControlZones
IF(HumidityControlZone(HstatZoneNum)%ActualZoneNum .NE. SZMaxHumSetPtMgr(SetPtMgrNum)%ZoneNum(SetZoneNum))CYCLE
HstatZoneFound=.TRUE.
EXIT
END DO
IF (.not. HstatZoneFound) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'// &
trim(SZMaxHumSetPtMgr(SetPtMgrNum)%Name)//'", invalid humidistat specification')
CALL ShowContinueError('could not locate Humidistat in Zone='// &
TRIM(Zone(SZMaxHumSetPtMgr(SetPtMgrNum)%ZoneNum(SetZoneNum))%Name))
ErrorsFound=.TRUE.
ENDIF
ENDIF
END DO
END DO
! single zone reheat setpoint manager
cSetPointManagerType = cValidSPMTypes(iSPMType_SZReheat)
DO SetPtMgrNum=1,NumSZRhSetPtMgrs
FanNodeIn = 0
FanNodeOut = 0
MixedAirNode = 0
AirLoopNum = 0
InletBranchNum = 0
LoopInNode = 0
LookForFan = .FALSE.
ZoneInletNode = SingZoneRhSetPtMgr(SetPtMgrNum)%ZoneInletNodeNum
ZoneNode = SingZoneRhSetPtMgr(SetPtMgrNum)%ZoneNodeNum
! find the index in the ZoneEquipConfig array of the control zone (the one with the main or only thermostat)
ConZoneNum=0
DO ControlledZoneNum = 1,NumOfZones
IF (ZoneEquipConfig(ControlledZoneNum)%ZoneNode .EQ. ZoneNode ) THEN
ConZoneNum = ControlledZoneNum
END IF
END DO
IF (ConZoneNum == 0) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(SingZoneRhSetPtMgr(SetPtMgrNum)%Name)// &
'", Zone Node not found:')
CALL ShowContinueError('Node="'//TRIM(NodeID(SingZoneRhSetPtMgr(SetPtMgrNum)%ZoneNodeNum))// &
'", not found in any controlled Zone')
ErrorsFound=.TRUE.
ELSE
AirLoopNum = ZoneEquipConfig(ConZoneNum)%AirLoopNum
IF (AirLoopNum == 0) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(SingZoneRhSetPtMgr(SetPtMgrNum)%Name)// &
'", Zone not on air loop:')
CALL ShowContinueError('Controlled Zone not on air loop, Zone='// &
TRIM(ZoneEquipConfig(ConZoneNum)%ZoneName))
ErrorsFound=.TRUE.
CYCLE
ENDIF
MixedAirNode = PrimaryAirSystem(AirLoopNum)%OASysOutletNodeNum
InletBranchNum = PrimaryAirSystem(AirLoopNum)%InletBranchNum(1)
LoopInNode = PrimaryAirSystem(AirLoopNum)%Branch(InletBranchNum)%NodeNumIn
! get the supply fan inlet and outlet nodes
IF (MixedAirNode > 0) THEN
DO BranchNum = 1,PrimaryAirSystem(AirLoopNum)%NumBranches
DO CompNum = 1, PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%TotalComponents
CompType = PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%Comp(CompNum)%TypeOf
IF (MixedAirNode == PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%Comp(CompNum)%NodeNumIn) THEN
LookForFan = .TRUE.
END IF
IF (LookForFan) THEN
!cpw22Aug2010 Add Fan:ComponentModel (new)
IF (SameString(CompType , 'Fan:ConstantVolume') .OR. SameString(CompType , 'Fan:VariableVolume') .OR. &
SameString(CompType , 'Fan:OnOff') .OR. SameString(CompType , 'Fan:ComponentModel')) THEN
FanNodeIn = PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%Comp(CompNum)%NodeNumIn
FanNodeOut = PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%Comp(CompNum)%NodeNumOut
EXIT
END IF
END IF
END DO
END DO
ELSE
DO BranchNum = 1,PrimaryAirSystem(AirLoopNum)%NumBranches
DO CompNum = 1, PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%TotalComponents
CompType = PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%Comp(CompNum)%TypeOf
!cpw22Aug2010 Add Fan:ComponentModel (new)
IF (SameString(CompType , 'Fan:ConstantVolume') .OR. SameString(CompType , 'Fan:VariableVolume') .OR. &
SameString(CompType , 'Fan:OnOff') .OR. SameString(CompType , 'Fan:ComponentModel')) THEN
FanNodeIn = PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%Comp(CompNum)%NodeNumIn
FanNodeOut = PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%Comp(CompNum)%NodeNumOut
END IF
END DO
END DO
END IF
SingZoneRhSetPtMgr(SetPtMgrNum)%FanNodeIn = FanNodeIn
SingZoneRhSetPtMgr(SetPtMgrNum)%FanNodeOut = FanNodeOut
SingZoneRhSetPtMgr(SetPtMgrNum)%MixedAirNode = MixedAirNode
SingZoneRhSetPtMgr(SetPtMgrNum)%AirLoopNum = AirLoopNum
SingZoneRhSetPtMgr(SetPtMgrNum)%OAInNode = PrimaryAirSystem(AirLoopNum)%OAMixOAInNodeNum
SingZoneRhSetPtMgr(SetPtMgrNum)%RetNode = PrimaryAirSystem(AirLoopNum)%OASysInletNodeNum
SingZoneRhSetPtMgr(SetPtMgrNum)%OAInNode = PrimaryAirSystem(AirLoopNum)%OAMixOAInNodeNum
SingZoneRhSetPtMgr(SetPtMgrNum)%LoopInNode = LoopInNode
ENDIF
END DO
! Warmest Setpoint Managers
cSetPointManagerType = cValidSPMTypes(iSPMType_Warmest)
DO SetPtMgrNum = 1,NumWarmestSetPtMgrs
IF (NumPrimaryAirSys > 0) THEN
AirLoopNum = FindItemInList(WarmestSetPtMgr(SetPtMgrNum)%AirLoopName, &
AirToZoneNodeInfo%AirLoopName,NumPrimaryAirSys)
IF (AirLoopNum == 0) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(WarmestSetPtMgr(SetPtMgrNum)%Name)// &
'", invalid Air Loop specified:')
CALL ShowContinueError('Air Loop not found ="'//&
TRIM(WarmestSetPtMgr(SetPtMgrNum)%AirLoopName)//'".')
ErrorsFound = .TRUE.
ELSE
WarmestSetPtMgr(SetPtMgrNum)%AirLoopNum = AirLoopNum
END IF
IF (AirToZoneNodeInfo(AirLoopNum)%NumZonesCooled == 0) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(WarmestSetPtMgr(SetPtMgrNum)%Name)// &
'", no zones with cooling found:')
CALL ShowContinueError('Air Loop provides no cooling, Air Loop="'// &
TRIM(WarmestSetPtMgr(SetPtMgrNum)%AirLoopName)//'".')
ErrorsFound = .TRUE.
END IF
ELSE
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(WarmestSetPtMgr(SetPtMgrNum)%Name)// &
'", no AirLoopHVAC objects found:')
CALL ShowContinueError('Setpoint Manager needs an AirLoopHVAC to operate.')
ErrorsFound = .TRUE.
END IF
END DO
! Coldest Setpoint Managers
cSetPointManagerType = cValidSPMTypes(iSPMType_Coldest)
DO SetPtMgrNum = 1,NumColdestSetPtMgrs
IF (NumPrimaryAirSys > 0) THEN
AirLoopNum = FindItemInList(ColdestSetPtMgr(SetPtMgrNum)%AirLoopName, &
AirToZoneNodeInfo%AirLoopName,NumPrimaryAirSys)
IF (AirLoopNum == 0) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(ColdestSetPtMgr(SetPtMgrNum)%Name)// &
'", invalid Air Loop specified:')
CALL ShowContinueError('Air Loop not found ="'//&
TRIM(ColdestSetPtMgr(SetPtMgrNum)%AirLoopName)//'".')
ErrorsFound = .TRUE.
ELSE
ColdestSetPtMgr(SetPtMgrNum)%AirLoopNum = AirLoopNum
END IF
IF (AirToZoneNodeInfo(AirLoopNum)%NumZonesHeated == 0) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(ColdestSetPtMgr(SetPtMgrNum)%Name)// &
'", no zones with heating found:')
CALL ShowContinueError('Air Loop provides no heating, Air Loop="'// &
TRIM(ColdestSetPtMgr(SetPtMgrNum)%AirLoopName)//'".')
ErrorsFound = .TRUE.
END IF
ELSE
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(ColdestSetPtMgr(SetPtMgrNum)%Name)// &
'", no AirLoopHVAC objects found:')
CALL ShowContinueError('Setpoint Manager needs an AirLoopHVAC to operate.')
ErrorsFound = .TRUE.
END IF
END DO
! Warmest Temp Flow Setpoint Managers
cSetPointManagerType = cValidSPMTypes(iSPMType_WarmestTempFlow)
DO SetPtMgrNum = 1,NumWarmestSetPtMgrsTempFlow
IF (NumPrimaryAirSys > 0) THEN
AirLoopNum = FindItemInList(WarmestSetPtMgrTempFlow(SetPtMgrNum)%AirLoopName, &
AirToZoneNodeInfo%AirLoopName,NumPrimaryAirSys)
IF (AirLoopNum == 0) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(WarmestSetPtMgrTempFlow(SetPtMgrNum)%Name)// &
'", invalid Air Loop specified:')
CALL ShowContinueError('Air Loop not found ="'//&
TRIM(WarmestSetPtMgrTempFlow(SetPtMgrNum)%AirLoopName)//'".')
ErrorsFound = .TRUE.
ELSE
WarmestSetPtMgrTempFlow(SetPtMgrNum)%AirLoopNum = AirLoopNum
WarmestSetPtMgrTempFlow(SetPtMgrNum)%SimReady = .TRUE.
END IF
IF (AirToZoneNodeInfo(AirLoopNum)%NumZonesCooled == 0) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(WarmestSetPtMgrTempFlow(SetPtMgrNum)%Name)// &
'", no zones with cooling found:')
CALL ShowContinueError('Air Loop provides no cooling, Air Loop="'// &
TRIM(WarmestSetPtMgrTempFlow(SetPtMgrNum)%AirLoopName)//'".')
ErrorsFound = .TRUE.
END IF
ELSE
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(WarmestSetPtMgrTempFlow(SetPtMgrNum)%Name)// &
'", no AirLoopHVAC objects found:')
CALL ShowContinueError('Setpoint Manager needs an AirLoopHVAC to operate.')
ErrorsFound = .TRUE.
END IF
END DO
! return air bypass flow set manager
cSetPointManagerType = cValidSPMTypes(iSPMType_RAB)
DO SetPtMgrNum=1,NumRABFlowSetPtMgrs
IF (NumPrimaryAirSys > 0) THEN
AirLoopNum = FindItemInList(RABFlowSetPtMgr(SetPtMgrNum)%AirLoopName, &
AirToZoneNodeInfo%AirLoopName,NumPrimaryAirSys)
AllSetPtMgr(RABFlowSetPtMgr(SetPtMgrNum)%AllSetPtMgrIndex)%AirLoopNum = AirLoopNum
AllSetPtMgr(RABFlowSetPtMgr(SetPtMgrNum)%AllSetPtMgrIndex)%AirLoopName = RABFlowSetPtMgr(SetPtMgrNum)%AirLoopName
IF (AirLoopNum == 0) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(RABFlowSetPtMgr(SetPtMgrNum)%Name)// &
'", invalid Air Loop specified:')
CALL ShowContinueError('Air Loop not found ="'//&
TRIM(RABFlowSetPtMgr(SetPtMgrNum)%AirLoopName)//'".')
ErrorsFound = .TRUE.
ELSE
RABFlowSetPtMgr(SetPtMgrNum)%AirLoopNum = AirLoopNum
IF (PrimaryAirSystem(AirLoopNum)%RABExists) THEN
RABFlowSetPtMgr(SetPtMgrNum)%RABMixInNode = PrimaryAirSystem(AirLoopNum)%RABMixInNode
RABFlowSetPtMgr(SetPtMgrNum)%SupMixInNode = PrimaryAirSystem(AirLoopNum)%SupMixInNode
RABFlowSetPtMgr(SetPtMgrNum)%MixOutNode = PrimaryAirSystem(AirLoopNum)%MixOutNode
RABFlowSetPtMgr(SetPtMgrNum)%RABSplitOutNode = PrimaryAirSystem(AirLoopNum)%RABSplitOutNode
RABFlowSetPtMgr(SetPtMgrNum)%SysOutNode = AirToZoneNodeInfo(AirLoopNum)%AirLoopSupplyNodeNum(1)
RABFlowSetPtMgr(SetPtMgrNum)%CtrlNodes(1) = RABFlowSetPtMgr(SetPtMgrNum)%RABSplitOutNode
AllSetPtMgr(RABFlowSetPtMgr(SetPtMgrNum)%AllSetPtMgrIndex)%CtrlNodes(1) = RABFlowSetPtMgr(SetPtMgrNum)%RABSplitOutNode
ELSE
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(RABFlowSetPtMgr(SetPtMgrNum)%Name)// &
'", no RAB in air loop found:')
CALL ShowContinueError('Air Loop="'//&
TRIM(RABFlowSetPtMgr(SetPtMgrNum)%AirLoopName)//'".')
ErrorsFound = .TRUE.
END IF
END IF
ELSE
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(RABFlowSetPtMgr(SetPtMgrNum)%Name)// &
'", no AirLoopHVAC objects found:')
CALL ShowContinueError('Setpoint Manager needs an AirLoopHVAC to operate.')
ErrorsFound = .TRUE.
END IF
END DO
! MultiZone Average Cooling Setpoint Managers
cSetPointManagerType = cValidSPMTypes(iSPMType_MZCoolingAverage)
DO SetPtMgrNum = 1, NumMZClgAverageSetPtMGrs
IF (NumPrimaryAirSys > 0) THEN
AirLoopNum = FindItemInList(MZAverageCoolingSetPtMgr(SetPtMgrNum)%AirLoopName, &
AirToZoneNodeInfo%AirLoopName,NumPrimaryAirSys)
IF (AirLoopNum == 0) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(MZAverageCoolingSetPtMgr(SetPtMgrNum)%Name)// &
'", invalid Air Loop specified:')
CALL ShowContinueError('Air Loop not found ="'//&
TRIM(MZAverageCoolingSetPtMgr(SetPtMgrNum)%AirLoopName)//'".')
ErrorsFound = .TRUE.
ELSE
MZAverageCoolingSetPtMgr(SetPtMgrNum)%AirLoopNum = AirLoopNum
END IF
IF (AirToZoneNodeInfo(AirLoopNum)%NumZonesCooled == 0) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(MZAverageCoolingSetPtMgr(SetPtMgrNum)%Name)// &
'", no zones with cooling found:')
CALL ShowContinueError('Air Loop provides no cooling, Air Loop="'// &
TRIM(MZAverageCoolingSetPtMgr(SetPtMgrNum)%AirLoopName)//'".')
ErrorsFound = .TRUE.
END IF
ELSE
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(MZAverageCoolingSetPtMgr(SetPtMgrNum)%Name)// &
'", no AirLoopHVAC objects found:')
CALL ShowContinueError('Setpoint Manager needs an AirLoopHVAC to operate.')
ErrorsFound = .TRUE.
END IF
END DO
! MultiZone Average Heating Setpoint Managers
cSetPointManagerType = cValidSPMTypes(iSPMType_MZHeatingAverage)
DO SetPtMgrNum = 1, NumMZHtgAverageSetPtMGrs
IF (NumPrimaryAirSys > 0) THEN
AirLoopNum = FindItemInList(MZAverageHeatingSetPtMgr(SetPtMgrNum)%AirLoopName, &
AirToZoneNodeInfo%AirLoopName,NumPrimaryAirSys)
IF (AirLoopNum == 0) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(MZAverageHeatingSetPtMgr(SetPtMgrNum)%Name)// &
'", invalid Air Loop specified:')
CALL ShowContinueError('Air Loop not found ="'//&
TRIM(MZAverageHeatingSetPtMgr(SetPtMgrNum)%AirLoopName)//'".')
ErrorsFound = .TRUE.
ELSE
MZAverageHeatingSetPtMgr(SetPtMgrNum)%AirLoopNum = AirLoopNum
END IF
! Commented out as we are using %NumZonesCooled instead of %NumZonesHeated for all systems for now
!IF (AirToZoneNodeInfo(AirLoopNum)%NumZonesHeated == 0) THEN
! CALL ShowSevereError(TRIM(cSetPointManagerType)//': Air Loop provides no heating ' // &
! TRIM(MZAverageHeatingSetPtMgr(SetPtMgrNum)%Name))
! CALL ShowContinueError('Occurs in Setpoint Manager='//TRIM(MZAverageHeatingSetPtMgr(SetPtMgrNum)%Name))
! ErrorsFound = .TRUE.
!END IF
ELSE
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(MZAverageHeatingSetPtMgr(SetPtMgrNum)%Name)// &
'", no AirLoopHVAC objects found:')
CALL ShowContinueError('Setpoint Manager needs an AirLoopHVAC to operate.')
ErrorsFound = .TRUE.
END IF
END DO
! MultiZone Average Minimum Humidity Setpoint Managers
cSetPointManagerType = cValidSPMTypes(iSPMType_MZMinHumAverage)
DO SetPtMgrNum = 1, NumMZAverageMinHumSetPtMgrs
IF (NumPrimaryAirSys > 0) THEN
AirLoopNum = FindItemInList(MZAverageMinHumSetPtMgr(SetPtMgrNum)%AirLoopName, &
AirToZoneNodeInfo%AirLoopName,NumPrimaryAirSys)
IF (AirLoopNum == 0) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(MZAverageMinHumSetPtMgr(SetPtMgrNum)%Name)// &
'", invalid Air Loop specified:')
CALL ShowContinueError('Air Loop not found ="'//&
TRIM(MZAverageMinHumSetPtMgr(SetPtMgrNum)%AirLoopName)//'".')
ErrorsFound = .TRUE.
ELSE
MZAverageMinHumSetPtMgr(SetPtMgrNum)%AirLoopNum = AirLoopNum
! make sure humidity controlled zone
HstatZoneFound=.false.
DO HstatZoneNum = 1, NumHumidityControlZones
DO ZonesCooledIndex=1,AirToZoneNodeInfo(MZAverageMinHumSetPtMgr(SetPtMgrNum)%AirLoopNum)%NumZonesCooled
IF(HumidityControlZone(HstatZoneNum)%ActualZoneNum .NE. &
AirToZoneNodeInfo(MZAverageMinHumSetPtMgr(SetPtMgrNum)%AirLoopNum)%CoolCtrlZoneNums(ZonesCooledIndex))CYCLE
HstatZoneFound=.TRUE.
EXIT
END DO
END DO
IF (.not. HstatZoneFound) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'// &
trim(MZAverageMinHumSetPtMgr(SetPtMgrNum)%Name)//'", invalid humidistat specification')
CALL ShowContinueError('could not locate Humidistat in any of the zones'// &
' served by the Air loop='//TRIM(PrimaryAirSystem(AirLoopNum)%Name))
ErrorsFound=.TRUE.
ENDIF
END IF
ELSE
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(MZAverageMinHumSetPtMgr(SetPtMgrNum)%Name)// &
'", no AirLoopHVAC objects found:')
CALL ShowContinueError('Setpoint Manager needs an AirLoopHVAC to operate.')
ErrorsFound = .TRUE.
END IF
END DO
! MultiZone Average Maximum Humidity Setpoint Managers
cSetPointManagerType = cValidSPMTypes(iSPMType_MZMaxHumAverage)
DO SetPtMgrNum = 1, NumMZAverageMaxHumSetPtMgrs
IF (NumPrimaryAirSys > 0) THEN
AirLoopNum = FindItemInList(MZAverageMaxHumSetPtMgr(SetPtMgrNum)%AirLoopName, &
AirToZoneNodeInfo%AirLoopName,NumPrimaryAirSys)
IF (AirLoopNum == 0) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(MZAverageMaxHumSetPtMgr(SetPtMgrNum)%Name)// &
'", invalid Air Loop specified:')
CALL ShowContinueError('Air Loop not found ="'//&
TRIM(MZAverageMaxHumSetPtMgr(SetPtMgrNum)%AirLoopName)//'".')
ErrorsFound = .TRUE.
ELSE
MZAverageMaxHumSetPtMgr(SetPtMgrNum)%AirLoopNum = AirLoopNum
! make sure humidity controlled zone
HstatZoneFound=.false.
DO HstatZoneNum = 1, NumHumidityControlZones
DO ZonesCooledIndex=1,AirToZoneNodeInfo(MZAverageMaxHumSetPtMgr(SetPtMgrNum)%AirLoopNum)%NumZonesCooled
IF(HumidityControlZone(HstatZoneNum)%ActualZoneNum .NE. &
AirToZoneNodeInfo(MZAverageMaxHumSetPtMgr(SetPtMgrNum)%AirLoopNum)%CoolCtrlZoneNums(ZonesCooledIndex))CYCLE
HstatZoneFound=.TRUE.
EXIT
END DO
END DO
IF (.not. HstatZoneFound) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'// &
trim(MZAverageMaxHumSetPtMgr(SetPtMgrNum)%Name)//'", invalid humidistat specification')
CALL ShowContinueError('could not locate Humidistat in any of the zones'// &
' served by the Air loop='//TRIM(PrimaryAirSystem(AirLoopNum)%Name))
ErrorsFound=.TRUE.
ENDIF
END IF
ELSE
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(MZAverageMaxHumSetPtMgr(SetPtMgrNum)%Name)// &
'", no AirLoopHVAC objects found:')
CALL ShowContinueError('Setpoint Manager needs an AirLoopHVAC to operate.')
ErrorsFound = .TRUE.
END IF
END DO
! Multizone Minimum Humidity Ratio Setpoint Managers
cSetPointManagerType = cValidSPMTypes(iSPMType_MZMinHum)
DO SetPtMgrNum = 1, NumMZMinHumSetPtMgrs
IF (NumPrimaryAirSys > 0) THEN
AirLoopNum = FindItemInList(MZMinHumSetPtMgr(SetPtMgrNum)%AirLoopName, &
AirToZoneNodeInfo%AirLoopName,NumPrimaryAirSys)
IF (AirLoopNum == 0) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(MZMinHumSetPtMgr(SetPtMgrNum)%Name)// &
'", invalid Air Loop specified:')
CALL ShowContinueError('Air Loop not found ="'//&
TRIM(MZMinHumSetPtMgr(SetPtMgrNum)%AirLoopName)//'".')
ErrorsFound = .TRUE.
ELSE
MZMinHumSetPtMgr(SetPtMgrNum)%AirLoopNum = AirLoopNum
! make sure humidity controlled zone
HstatZoneFound=.false.
DO HstatZoneNum = 1, NumHumidityControlZones
DO ZonesCooledIndex=1,AirToZoneNodeInfo(MZMinHumSetPtMgr(SetPtMgrNum)%AirLoopNum)%NumZonesCooled
IF(HumidityControlZone(HstatZoneNum)%ActualZoneNum .NE. &
AirToZoneNodeInfo(MZMinHumSetPtMgr(SetPtMgrNum)%AirLoopNum)%CoolCtrlZoneNums(ZonesCooledIndex))CYCLE
HstatZoneFound=.TRUE.
EXIT
END DO
END DO
IF (.not. HstatZoneFound) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'// &
trim(MZMinHumSetPtMgr(SetPtMgrNum)%Name)//'", invalid humidistat specification')
CALL ShowContinueError('could not locate Humidistat in any of the zones'// &
' served by the Air loop='//TRIM(PrimaryAirSystem(AirLoopNum)%Name))
ErrorsFound=.TRUE.
ENDIF
END IF
ELSE
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(MZMinHumSetPtMgr(SetPtMgrNum)%Name)// &
'", no AirLoopHVAC objects found:')
CALL ShowContinueError('Setpoint Manager needs an AirLoopHVAC to operate.')
ErrorsFound = .TRUE.
END IF
END DO
! Multizone Maximum Humidity Ratio Setpoint Managers
cSetPointManagerType = cValidSPMTypes(iSPMType_MZMaxHum)
DO SetPtMgrNum = 1, NumMZMaxHumSetPtMgrs
IF (NumPrimaryAirSys > 0) THEN
AirLoopNum = FindItemInList(MZMaxHumSetPtMgr(SetPtMgrNum)%AirLoopName, &
AirToZoneNodeInfo%AirLoopName,NumPrimaryAirSys)
IF (AirLoopNum == 0) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(MZMaxHumSetPtMgr(SetPtMgrNum)%Name)// &
'", invalid Air Loop specified:')
CALL ShowContinueError('Air Loop not found ="'//&
TRIM(MZMaxHumSetPtMgr(SetPtMgrNum)%AirLoopName)//'".')
ErrorsFound = .TRUE.
ELSE
MZMaxHumSetPtMgr(SetPtMgrNum)%AirLoopNum = AirLoopNum
! make sure humidity controlled zone
HstatZoneFound=.false.
DO HstatZoneNum = 1, NumHumidityControlZones
DO ZonesCooledIndex=1,AirToZoneNodeInfo(MZMaxHumSetPtMgr(SetPtMgrNum)%AirLoopNum)%NumZonesCooled
IF(HumidityControlZone(HstatZoneNum)%ActualZoneNum .NE. &
AirToZoneNodeInfo(MZMaxHumSetPtMgr(SetPtMgrNum)%AirLoopNum)%CoolCtrlZoneNums(ZonesCooledIndex))CYCLE
HstatZoneFound=.TRUE.
EXIT
END DO
END DO
IF (.not. HstatZoneFound) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'// &
trim(MZMaxHumSetPtMgr(SetPtMgrNum)%Name)//'", invalid humidistat specification')
CALL ShowContinueError('could not locate Humidistat in any of the zones'// &
' served by the Air loop='//TRIM(PrimaryAirSystem(AirLoopNum)%Name))
ErrorsFound=.TRUE.
ENDIF
END IF
ELSE
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'//TRIM(MZMaxHumSetPtMgr(SetPtMgrNum)%Name)// &
'", no AirLoopHVAC objects found:')
CALL ShowContinueError('Setpoint Manager needs an AirLoopHVAC to operate.')
ErrorsFound = .TRUE.
END IF
END DO
! condenser entering water temperature reset setpoint manager
NumCT = 0
cSetPointManagerType = cValidSPMTypes(iSPMType_CondEntReset)
DO SetPtMgrNum=1,NumCondEntSetPtMgrs
! Scan loops and find the loop index that includes the condenser cooling tower node used as setpoint
DO LoopNum = 1, NumCondLoops + NumPlantLoops ! Begin demand side loops ... When condenser is added becomes NumLoops
DO CtrlNodeIndex=1,CondEntSetPtMgr(SetPtMgrNum)%NumCtrlNodes
IF (PlantLoop(LoopNum)%TempSetPointNodeNum == CondEntSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex)) THEN
DO BranchNum = 1, PlantLoop(LoopNum)%LoopSide(SupplySide)%TotalBranches
DO CompNum = 1, PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%TotalComponents
! Check if cooling tower is single speed and generate and error
TypeOf_Num = PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%Comp(CompNum)%TypeOf_Num
IF (TypeOf_Num == TypeOf_CoolingTower_SingleSpd) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'// &
trim(CondEntSetPtMgr(SetPtMgrNum)%Name)//'", invalid tower found')
CALL ShowContinueError('Found SingleSpeed Cooling Tower, Cooling Tower='// &
TRIM(PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%Comp(CompNum)%Name))
CALL ShowContinueError('SingleSpeed cooling towers cannot be used with this setpoint manager on each loop')
ErrorsFound=.true.
END IF
! Check if there are more than 1 cooling tower on the plant and generate error
IF (TypeOf_Num == TypeOf_CoolingTower_TwoSpd .or. &
TypeOf_Num == TypeOf_CoolingTower_VarSpdMerkel .OR. &
TypeOf_Num == TypeOf_CoolingTower_VarSpd) THEN
NumCT = NumCT + 1
IF (NumCT .GT. 1 )THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'// &
TRIM(CondEntSetPtMgr(SetPtMgrNum)%Name)//'", too many towers found')
CALL ShowContinueError('only one cooling tower can be used with this setpoint manager on each loop')
CALL ShowContinueError('Found more than one cooling tower, Cooling Tower='//&
TRIM(PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%Comp(CompNum)%Name))
ErrorsFound=.true.
END IF
END IF
END DO
END DO
NumCT = 0
! Scan all attached chillers in the condenser loop index found to find the chiller index
DO BranchNum = 1, PlantLoop(LoopNum)%LoopSide(DemandSide)%TotalBranches
DO CompNum = 1, PlantLoop(LoopNum)%LoopSide(DemandSide)%Branch(BranchNum)%TotalComponents
TypeOf_Num = PlantLoop(LoopNum)%LoopSide(DemandSide)%Branch(BranchNum)%Comp(CompNum)%TypeOf_Num
IF (TypeOf_Num == TypeOf_Chiller_Absorption .or. &
TypeOf_Num == TypeOf_Chiller_Indirect_Absorption .or. &
TypeOf_Num == TypeOf_Chiller_CombTurbine .or. &
TypeOf_Num == TypeOf_Chiller_ConstCOP .or. &
TypeOf_Num == TypeOf_Chiller_Electric .or. &
TypeOf_Num == TypeOf_Chiller_ElectricEIR .or. &
TypeOf_Num == TypeOf_Chiller_DFAbsorption .or. &
TypeOf_Num == TypeOf_Chiller_ElectricReformEIR .or. &
TypeOf_Num == TypeOf_Chiller_EngineDriven) THEN
! Scan the supply side to find the chiller index and branch index on plantloop
TypeNum = PlantLoop(LoopNum)%LoopSide(DemandSide)%Branch(BranchNum)%Comp(CompNum)%TypeOf_Num
DO LoopNum2 = 1, NumCondLoops + NumPlantLoops
DO BranchNumPlantSide = 1, PlantLoop(LoopNum2)%LoopSide(SupplySide)%TotalBranches
DO CompNumPlantSide = 1, &
PlantLoop(LoopNum2)%LoopSide(SupplySide)%Branch(BranchNumPlantSide)%TotalComponents
IF(PlantLoop(LoopNum2)%LoopSide(SupplySide)%Branch(BranchNumPlantSide)% &
Comp(CompNumPlantSide)%TypeOf_Num == TypeNum) THEN
CondEntSetPtMgr(SetPtMgrNum)%LoopIndexPlantSide = LoopNum2
CondEntSetPtMgr(SetPtMgrNum)%ChillerIndexPlantSide = CompNumPlantSide
CondEntSetPtMgr(SetPtMgrNum)%BranchIndexPlantSide = BranchNumPlantSide
END IF
END DO
END DO
END DO
CondEntSetPtMgr(SetPtMgrNum)%TypeNum = TypeNum
CondEntSetPtMgr(SetPtMgrNum)%LoopIndexDemandSide = LoopNum
CondEntSetPtMgr(SetPtMgrNum)%ChillerIndexDemandSide = CompNum
CondEntSetPtMgr(SetPtMgrNum)%BranchIndexDemandSide = BranchNum
END IF
END DO
END DO
END IF
END DO
END DO
END DO
! Ideal condenser entering water temperature reset setpoint manager
cSetPointManagerType = cValidSPMTypes(iSPMType_IdealCondEntReset)
NumCT = 0
NumChiller = 0
DO SetPtMgrNum=1,NumIdealCondEntSetPtMgrs
! Scan loops and find the loop index that includes the condenser cooling tower node used as setpoint
DO LoopNum = 1, NumCondLoops + NumPlantLoops ! Begin demand side loops ... When condenser is added becomes NumLoops
DO CtrlNodeIndex=1,IdealCondEntSetPtMgr(SetPtMgrNum)%NumCtrlNodes
IF (PlantLoop(LoopNum)%TempSetPointNodeNum == IdealCondEntSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex)) THEN
DO BranchNum = 1, PlantLoop(LoopNum)%LoopSide(SupplySide)%TotalBranches
DO CompNum = 1, PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%TotalComponents
! Check if cooling tower is single speed and generate and error
TypeOf_Num = PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%Comp(CompNum)%TypeOf_Num
IF (TypeOf_Num == TypeOf_CoolingTower_SingleSpd) THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'// &
TRIM(IdealCondEntSetPtMgr(SetPtMgrNum)%Name)//'", invalid cooling tower found')
CALL ShowContinueError('Found Single Speed Cooling Tower, Cooling Tower='// &
TRIM(PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%Comp(CompNum)%Name))
CALL ShowContinueError('SingleSpeed cooling towers cannot be used with this setpoint manager on each loop')
ErrorsFound=.true.
END IF
! Check if there are more than 1 cooling tower on the plant and generate error
IF (TypeOf_Num == TypeOf_CoolingTower_TwoSpd .or. &
TypeOf_Num == TypeOf_CoolingTower_VarSpdMerkel .or. &
TypeOf_Num == TypeOf_CoolingTower_VarSpd) THEN
NumCT = NumCT + 1
IF (NumCT .GT. 1 )THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'// &
TRIM(IdealCondEntSetPtMgr(SetPtMgrNum)%Name)//'", too many cooling towers found')
CALL ShowContinueError('only one cooling tower can be used with this setpoint manager on each loop')
CALL ShowContinueError('Found more than one cooling tower, Cooling Tower='//&
TRIM(PlantLoop(LoopNum)%LoopSide(SupplySide)%Branch(BranchNum)%Comp(CompNum)%Name))
ErrorsFound=.true.
END IF
END IF
! Scan the pump on the condenser water loop
IF (TypeOf_Num == TypeOf_PumpVariableSpeed .or. &
TypeOf_Num == TypeOf_PumpConstantSpeed) THEN
IdealCondEntSetPtMgr(SetPtMgrNum)%CondPumpNum = CompNum
IdealCondEntSetPtMgr(SetPtMgrNum)%CondPumpBranchNum = BranchNum
END IF
END DO
END DO
NumCT = 0
! Scan all attached chillers in the condenser loop index found to find the chiller index
DO BranchNum = 1, PlantLoop(LoopNum)%LoopSide(DemandSide)%TotalBranches
DO CompNum = 1, PlantLoop(LoopNum)%LoopSide(DemandSide)%Branch(BranchNum)%TotalComponents
TypeOf_Num = PlantLoop(LoopNum)%LoopSide(DemandSide)%Branch(BranchNum)%Comp(CompNum)%TypeOf_Num
IF (TypeOf_Num == TypeOf_Chiller_Absorption .or. &
TypeOf_Num == TypeOf_Chiller_Indirect_Absorption .or. &
TypeOf_Num == TypeOf_Chiller_CombTurbine .or. &
TypeOf_Num == TypeOf_Chiller_ConstCOP .or. &
TypeOf_Num == TypeOf_Chiller_Electric .or. &
TypeOf_Num == TypeOf_Chiller_ElectricEIR .or. &
TypeOf_Num == TypeOf_Chiller_DFAbsorption .or. &
TypeOf_Num == TypeOf_Chiller_ElectricReformEIR .or. &
TypeOf_Num == TypeOf_Chiller_EngineDriven) THEN
! Scan the supply side to find the chiller index and branch index on plantloop
TypeNum = PlantLoop(LoopNum)%LoopSide(DemandSide)%Branch(BranchNum)%Comp(CompNum)%TypeOf_Num
DO LoopNum2 = 1, NumCondLoops + NumPlantLoops
DO BranchNumPlantSide = 1, PlantLoop(LoopNum2)%LoopSide(SupplySide)%TotalBranches
DO CompNumPlantSide = 1, &
PlantLoop(LoopNum2)%LoopSide(SupplySide)%Branch(BranchNumPlantSide)%TotalComponents
TypeOf_Num = PlantLoop(LoopNum2)%LoopSide(SupplySide)%Branch(BranchNumPlantSide)% &
Comp(CompNumPlantSide)%TypeOf_Num
IF(TypeOf_Num == TypeNum) THEN
NumChiller = NumChiller + 1
IdealCondEntSetPtMgr(SetPtMgrNum)%LoopIndexPlantSide = LoopNum2
IdealCondEntSetPtMgr(SetPtMgrNum)%ChillerIndexPlantSide = CompNumPlantSide
IdealCondEntSetPtMgr(SetPtMgrNum)%BranchIndexPlantSide = BranchNumPlantSide
! Scan the pump on the chilled water loop
DO BranchNum2 = 1, PlantLoop(LoopNum2)%LoopSide(SupplySide)%TotalBranches
DO CompNum2 = 1, PlantLoop(LoopNum2)%LoopSide(SupplySide)%Branch(BranchNum2)%TotalComponents
TypeOf_Num =PlantLoop(LoopNum2)%LoopSide(SupplySide)%Branch(BranchNum2)%Comp(CompNum2)%TypeOf_Num
IF (TypeOf_Num == TypeOf_PumpVariableSpeed .or. &
TypeOf_Num == TypeOf_PumpConstantSpeed) THEN
IdealCondEntSetPtMgr(SetPtMgrNum)%ChilledPumpNum = CompNum2
IdealCondEntSetPtMgr(SetPtMgrNum)%ChilledPumpBranchNum = BranchNum2
END IF
END DO
END DO
END IF
END DO
END DO
END DO
IF (NumChiller .GT. 1 )THEN
CALL ShowSevereError(TRIM(cSetPointManagerType)//'="'// &
TRIM(IdealCondEntSetPtMgr(SetPtMgrNum)%Name)//'", too many chillers found')
CALL ShowContinueError('only one chiller can be used with this setpoint manager on each loop')
CALL ShowContinueError('Found more than one chiller, chiller ='// &
TRIM(PlantLoop(LoopNum)%LoopSide(DemandSide)%Branch(BranchNum)%Comp(CompNum)%Name))
ErrorsFound=.true.
END IF
IdealCondEntSetPtMgr(SetPtMgrNum)%TypeNum = TypeNum
IdealCondEntSetPtMgr(SetPtMgrNum)%CondLoopNum = LoopNum
IdealCondEntSetPtMgr(SetPtMgrNum)%TowerNum = CompNum
IdealCondEntSetPtMgr(SetPtMgrNum)%CondBranchNum = BranchNum
END IF
END DO
END DO
NumChiller = 0
END IF
END DO
END DO
END DO
CALL VerifySetPointManagers(ErrorsFound)
END IF
MyOneTimeFlag = .FALSE.
IF (ErrorsFound) THEN
CALL ShowFatalError('InitSetPointManagers: Errors found in getting SetPointManager input.')
ENDIF
END IF
IF ( (BeginEnvrnFlag .and. MyEnvrnFlag) .or. MyOneTimeFlag2) THEN
ManagerOn = .FALSE.
DO SetPtMgrNum=1,NumSchSetPtMgrs
DO CtrlNodeIndex=1,SchSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = SchSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
! Initialize scheduled setpoints
SELECT CASE (SchSetPtMgr(SetPtMgrNum)%CtrlTypeMode)
CASE(iCtrlVarType_Temp)
Node(NodeNum)%TempSetPoint = &
GetCurrentScheduleValue(SchSetPtMgr(SetPtMgrNum)%SchedPtr)
CASE(iCtrlVarType_MaxTemp)
Node(NodeNum)%TempSetPointHi = &
GetCurrentScheduleValue(SchSetPtMgr(SetPtMgrNum)%SchedPtr)
CASE(iCtrlVarType_MinTemp)
Node(NodeNum)%TempSetPointLo = &
GetCurrentScheduleValue(SchSetPtMgr(SetPtMgrNum)%SchedPtr)
CASE(iCtrlVarType_HumRat)
Node(NodeNum)%HumRatSetPoint = &
GetCurrentScheduleValue(SchSetPtMgr(SetPtMgrNum)%SchedPtr)
CASE(iCtrlVarType_MaxHumRat)
Node(NodeNum)%HumRatMax = &
GetCurrentScheduleValue(SchSetPtMgr(SetPtMgrNum)%SchedPtr)
CASE(iCtrlVarType_MinHumRat)
Node(NodeNum)%HumRatMin = &
GetCurrentScheduleValue(SchSetPtMgr(SetPtMgrNum)%SchedPtr)
CASE(iCtrlVarType_MassFlow)
Node(NodeNum)%MassFlowRateSetPoint = &
GetCurrentScheduleValue(SchSetPtMgr(SetPtMgrNum)%SchedPtr)
CASE(iCtrlVarType_MaxMassFlow)
Node(NodeNum)%MassFlowRateMax = &
GetCurrentScheduleValue(SchSetPtMgr(SetPtMgrNum)%SchedPtr)
CASE(iCtrlVarType_MinMassFlow)
Node(NodeNum)%MassFlowRateMin = &
GetCurrentScheduleValue(SchSetPtMgr(SetPtMgrNum)%SchedPtr)
END SELECT
END DO
END DO
DO SetPtMgrNum=1,NumDualSchSetPtMgrs
DO CtrlNodeIndex=1,DualSchSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = DualSchSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (DualSchSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPointHi = GetCurrentScheduleValue(DualSchSetPtMgr(SetPtMgrNum)%SchedPtrHi)
Node(NodeNum)%TempSetPointLo = GetCurrentScheduleValue(DualSchSetPtMgr(SetPtMgrNum)%SchedPtrLo)
Node(NodeNum)%TempSetPoint = (Node(NodeNum)%TempSetPointHi + Node(NodeNum)%TempSetPointLo)/2.0d0
END IF
END DO
END DO
DO SetPtMgrNum=1,NumOutAirSetPtMgrs
DO CtrlNodeIndex=1,OutAirSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = OutAirSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (OutAirSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
! Call the CALC routine, with an optional argument to only set
! the initialization NODE(:)% setpoint, and not the OutAirSetPtMgr(:)%SetPt
CALL CalcOutsideAirSetPoint(SetPtMgrNum, NodeNum, .TRUE.)
END IF
END DO
END DO
DO SetPtMgrNum=1,NumSZMinHumSetPtMgrs ! Minimum humidity setpoint managers
DO ZoneIndex=1,SZMinHumSetPtMgr(SetPtMgrNum)%NumZones
ZoneNode = SZMinHumSetPtMgr(SetPtMgrNum)%ZoneNodes(ZoneIndex)
Node(ZoneNode)%MassFlowRate = 0.0d0
END DO
DO CtrlNodeIndex=1,SZMinHumSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = SZMinHumSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
Node(NodeNum)%HumRatMin = 0.007d0 ! Set the setpoint
END DO
END DO
DO SetPtMgrNum=1,NumSZMaxHumSetPtMgrs ! Maximum humidity setpoint managers
DO ZoneIndex=1,SZMaxHumSetPtMgr(SetPtMgrNum)%NumZones
ZoneNode = SZMaxHumSetPtMgr(SetPtMgrNum)%ZoneNodes(ZoneIndex)
Node(ZoneNode)%MassFlowRate = 0.0d0
END DO
DO CtrlNodeIndex=1,SZMaxHumSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = SZMaxHumSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
Node(NodeNum)%HumRatMax = 0.011d0 ! Set the setpoint
END DO
END DO
DO SetPtMgrNum=1,NumSZRhSetPtMgrs ! single zone reheat setpoint managers
ZoneInletNode = SingZoneRhSetPtMgr(SetPtMgrNum)%ZoneInletNodeNum
ZoneNode = SingZoneRhSetPtMgr(SetPtMgrNum)%ZoneNodeNum
Node(ZoneInletNode)%MassFlowRate = 0.0d0
Node(ZoneNode)%MassFlowRate = 0.0d0
DO CtrlNodeIndex=1,SingZoneRhSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = SingZoneRhSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (SingZoneRhSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = 20.d0 ! Set the setpoint
END IF
END DO
END DO
DO SetPtMgrNum=1,NumSZHtSetPtMgrs ! single zone heating setpoint managers
ZoneInletNode = SingZoneHtSetPtMgr(SetPtMgrNum)%ZoneInletNodeNum
ZoneNode = SingZoneHtSetPtMgr(SetPtMgrNum)%ZoneNodeNum
Node(ZoneInletNode)%MassFlowRate = 0.0d0
Node(ZoneNode)%MassFlowRate = 0.0d0
DO CtrlNodeIndex=1,SingZoneHtSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = SingZoneHtSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (SingZoneHtSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = 20.d0 ! Set the setpoint
END IF
END DO
END DO
DO SetPtMgrNum=1,NumSZClSetPtMgrs ! single zone cooling setpoint managers
ZoneInletNode = SingZoneClSetPtMgr(SetPtMgrNum)%ZoneInletNodeNum
ZoneNode = SingZoneClSetPtMgr(SetPtMgrNum)%ZoneNodeNum
Node(ZoneInletNode)%MassFlowRate = 0.0d0
Node(ZoneNode)%MassFlowRate = 0.0d0
DO CtrlNodeIndex=1,SingZoneClSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = SingZoneClSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (SingZoneClSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = 20.d0 ! Set the setpoint
END IF
END DO
END DO
DO SetPtMgrNum=1,NumMixedAirSetPtMgrs ! mixed air setpoint managers
Node(MixedAirSetPtMgr(SetPtMgrNum)%RefNode)%MassFlowRate = 0.0d0
Node(MixedAirSetPtMgr(SetPtMgrNum)%FanInNode)%MassFlowRate = 0.0d0
Node(MixedAirSetPtMgr(SetPtMgrNum)%FanOutNode)%MassFlowRate = 0.0d0
Node(MixedAirSetPtMgr(SetPtMgrNum)%RefNode)%Temp = 20.d0
Node(MixedAirSetPtMgr(SetPtMgrNum)%FanInNode)%Temp = 20.d0
Node(MixedAirSetPtMgr(SetPtMgrNum)%FanOutNode)%Temp = 20.d0
Node(MixedAirSetPtMgr(SetPtMgrNum)%RefNode)%HumRat = OutHumRat
Node(MixedAirSetPtMgr(SetPtMgrNum)%FanInNode)%HumRat = OutHumRat
Node(MixedAirSetPtMgr(SetPtMgrNum)%FanOutNode)%HumRat = OutHumRat
Node(MixedAirSetPtMgr(SetPtMgrNum)%RefNode)%Quality = 1.0d0
Node(MixedAirSetPtMgr(SetPtMgrNum)%FanInNode)%Quality = 1.0d0
Node(MixedAirSetPtMgr(SetPtMgrNum)%FanOutNode)%Quality = 1.0d0
Node(MixedAirSetPtMgr(SetPtMgrNum)%RefNode)%Press = OutBaroPress
Node(MixedAirSetPtMgr(SetPtMgrNum)%FanInNode)%Press = OutBaroPress
Node(MixedAirSetPtMgr(SetPtMgrNum)%FanOutNode)%Press = OutBaroPress
Node(MixedAirSetPtMgr(SetPtMgrNum)%RefNode)%Enthalpy = PsyHFnTdbW(constant_twenty,OutHumRat)
Node(MixedAirSetPtMgr(SetPtMgrNum)%FanInNode)%Enthalpy = PsyHFnTdbW(constant_twenty,OutHumRat)
Node(MixedAirSetPtMgr(SetPtMgrNum)%FanOutNode)%Enthalpy = PsyHFnTdbW(constant_twenty,OutHumRat)
DO CtrlNodeIndex=1,MixedAirSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = MixedAirSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (MixedAirSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = 20.d0 ! Set the setpoint
END IF
END DO
END DO
DO SetPtMgrNum=1,NumOAPretreatSetPtMgrs ! Outside Air Pretreat setpoint managers
Node(OAPretreatSetPtMgr(SetPtMgrNum)%RefNode)%MassFlowRate = 0.0d0
Node(OAPretreatSetPtMgr(SetPtMgrNum)%MixedOutNode)%MassFlowRate = 0.0d0
Node(OAPretreatSetPtMgr(SetPtMgrNum)%OAInNode)%MassFlowRate = 0.0d0
Node(OAPretreatSetPtMgr(SetPtMgrNum)%ReturnInNode)%MassFlowRate = 0.0d0
Node(OAPretreatSetPtMgr(SetPtMgrNum)%RefNode)%Temp = 20.d0
Node(OAPretreatSetPtMgr(SetPtMgrNum)%MixedOutNode)%Temp = 20.d0
Node(OAPretreatSetPtMgr(SetPtMgrNum)%OAInNode)%Temp = 20.d0
Node(OAPretreatSetPtMgr(SetPtMgrNum)%ReturnInNode)%Temp = 20.d0
Node(OAPretreatSetPtMgr(SetPtMgrNum)%RefNode)%HumRat = OutHumRat
Node(OAPretreatSetPtMgr(SetPtMgrNum)%MixedOutNode)%HumRat = OutHumRat
Node(OAPretreatSetPtMgr(SetPtMgrNum)%OAInNode)%HumRat = OutHumRat
Node(OAPretreatSetPtMgr(SetPtMgrNum)%ReturnInNode)%HumRat = OutHumRat
Node(OAPretreatSetPtMgr(SetPtMgrNum)%RefNode)%Quality = 1.0d0
Node(OAPretreatSetPtMgr(SetPtMgrNum)%MixedOutNode)%Quality = 1.0d0
Node(OAPretreatSetPtMgr(SetPtMgrNum)%OAInNode)%Quality = 1.0d0
Node(OAPretreatSetPtMgr(SetPtMgrNum)%ReturnInNode)%Quality = 1.0d0
Node(OAPretreatSetPtMgr(SetPtMgrNum)%RefNode)%Press = OutBaroPress
Node(OAPretreatSetPtMgr(SetPtMgrNum)%MixedOutNode)%Press = OutBaroPress
Node(OAPretreatSetPtMgr(SetPtMgrNum)%OAInNode)%Press = OutBaroPress
Node(OAPretreatSetPtMgr(SetPtMgrNum)%ReturnInNode)%Press = OutBaroPress
Node(OAPretreatSetPtMgr(SetPtMgrNum)%RefNode)%Enthalpy = PsyHFnTdbW(constant_twenty,OutHumRat)
Node(OAPretreatSetPtMgr(SetPtMgrNum)%MixedOutNode)%Enthalpy = PsyHFnTdbW(constant_twenty,OutHumRat)
Node(OAPretreatSetPtMgr(SetPtMgrNum)%OAInNode)%Enthalpy = PsyHFnTdbW(constant_twenty,OutHumRat)
Node(OAPretreatSetPtMgr(SetPtMgrNum)%ReturnInNode)%Enthalpy = PsyHFnTdbW(constant_twenty,OutHumRat)
DO CtrlNodeIndex=1,OAPretreatSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = OAPretreatSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (OAPretreatSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = 20.d0 ! Set the setpoint
END IF
IF (OAPretreatSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MaxHumRat) THEN
Node(NodeNum)%HumRatMax = OutHumRat ! Set the setpoint
END IF
IF (OAPretreatSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MinHumRat) THEN
Node(NodeNum)%HumRatMin = OutHumRat ! Set the setpoint
END IF
IF (OAPretreatSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_HumRat) THEN
Node(NodeNum)%HumRatSetPoint = OutHumRat ! Set the setpoint
END IF
END DO
END DO
DO SetPtMgrNum=1,NumWarmestSetPtMgrs
DO CtrlNodeIndex=1,WarmestSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = WarmestSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (WarmestSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = 20.d0 ! Set the setpoint
END IF
END DO
END DO
DO SetPtMgrNum=1,NumColdestSetPtMgrs
DO CtrlNodeIndex=1,ColdestSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = ColdestSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (ColdestSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = 20.d0 ! Set the setpoint
END IF
END DO
END DO
DO SetPtMgrNum=1,NumWarmestSetPtMgrsTempFlow
DO CtrlNodeIndex=1,WarmestSetPtMgrTempFlow(SetPtMgrNum)%NumCtrlNodes
NodeNum = WarmestSetPtMgrTempFlow(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (WarmestSetPtMgrTempFlow(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = 20.d0 ! Set the temperature setpoint
IF (WarmestSetPtMgrTempFlow(SetPtMgrNum)%AirLoopNum /= 0) THEN
AirLoopFlow(WarmestSetPtMgrTempFlow(SetPtMgrNum)%AirLoopNum)%ReqSupplyFrac = 1.d0 ! PH 10/09/04 Set the flow
AirLoopControlInfo(WarmestSetPtMgrTempFlow(SetPtMgrNum)%AirLoopNum)%LoopFlowRateSet = .TRUE. ! PH 10/09/04 Set the flag
ENDIF
END IF
END DO
END DO
IF (ZoneEquipInputsFilled .and. AirLoopInputsFilled) THEN
DO SetPtMgrNum=1,NumRABFlowSetPtMgrs
NodeNum = RABFlowSetPtMgr(SetPtMgrNum)%RABSplitOutNode
IF (RABFlowSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MassFlow) THEN
Node(NodeNum)%MassFlowRateSetPoint = 0.0d0
END IF
END DO
END IF
DO SetPtMgrNum=1,NumMZClgAverageSetPtMGrs
DO CtrlNodeIndex=1,MZAverageCoolingSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = MZAverageCoolingSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (MZAverageCoolingSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = 20.d0 ! Set the setpoint
END IF
END DO
END DO
DO SetPtMgrNum=1,NumMZHtgAverageSetPtMGrs
DO CtrlNodeIndex=1,MZAverageHeatingSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = MZAverageHeatingSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (MZAverageHeatingSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = 20.0d0 ! Set the setpoint
END IF
END DO
END DO
DO SetPtMgrNum=1,NumMZAverageMinHumSetPtMgrs
DO CtrlNodeIndex=1,MZAverageMinHumSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = MZAverageMinHumSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
Node(NodeNum)%HumRatMin = 0.007d0 ! Set the setpoint
END DO
END DO
DO SetPtMgrNum=1,NumMZAverageMaxHumSetPtMgrs
DO CtrlNodeIndex=1,MZAverageMaxHumSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = MZAverageMaxHumSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
Node(NodeNum)%HumRatMax = 0.011d0 ! Set the setpoint
END DO
END DO
DO SetPtMgrNum=1,NumMZMinHumSetPtMgrs
DO CtrlNodeIndex=1,MZMinHumSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = MZMinHumSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
Node(NodeNum)%HumRatMin = 0.007d0 ! Set the setpoint
END DO
END DO
DO SetPtMgrNum=1,NumMZMaxHumSetPtMgrs
DO CtrlNodeIndex=1,MZMaxHumSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = MZMaxHumSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
Node(NodeNum)%HumRatMax = 0.011d0 ! Set the setpoint
END DO
END DO
DO SetPtMgrNum=1,NumFollowOATempSetPtMgrs
DO CtrlNodeIndex=1,FollowOATempSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = FollowOATempSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (FollowOATempSetPtMgr(SetPtMgrNum)%RefTypeMode == iRefTempType_WetBulb) THEN
IF (FollowOATempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = OutWetBulbTemp ! Set the setpoint
ELSEIF (FollowOATempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MaxTemp) THEN
Node(NodeNum)%TempSetPointHi = OutWetBulbTemp ! Set the setpoint
ELSEIF (FollowOATempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MinTemp) THEN
Node(NodeNum)%TempSetPointLo = OutWetBulbTemp ! Set the setpoint
END IF
ELSEIF (FollowOATempSetPtMgr(SetPtMgrNum)%RefTypeMode == iRefTempType_DryBulb) THEN
IF (FollowOATempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = OutDryBulbTemp ! Set the setpoint
ELSEIF (FollowOATempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MaxTemp) THEN
Node(NodeNum)%TempSetPointHi = OutDryBulbTemp ! Set the setpoint
ELSEIF (FollowOATempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MinTemp) THEN
Node(NodeNum)%TempSetPointLo = OutDryBulbTemp ! Set the setpoint
END IF
END IF
END DO
END DO
DO SetPtMgrNum=1,NumFollowSysNodeTempSetPtMgrs
DO CtrlNodeIndex=1,FollowSysNodeTempSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = FollowSysNodeTempSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (CheckOutAirNodeNumber(FollowSysNodeTempSetPtMgr(SetPtMgrNum)%RefNodeNum)) THEN
IF (FollowSysNodeTempSetPtMgr(SetPtMgrNum)%RefTypeMode == iRefTempType_WetBulb) THEN
Node(FollowSysNodeTempSetPtMgr(SetPtMgrNum)%RefNodeNum)%SPMNodeWetbulbRepReq = .TRUE.
IF (FollowSysNodeTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = OutWetBulbTemp ! Set the setpoint
ELSEIF (FollowSysNodeTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MaxTemp) THEN
Node(NodeNum)%TempSetPointHi = OutWetBulbTemp ! Set the setpoint
ELSEIF (FollowSysNodeTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MinTemp) THEN
Node(NodeNum)%TempSetPointLo = OutWetBulbTemp ! Set the setpoint
END IF
ELSEIF (FollowSysNodeTempSetPtMgr(SetPtMgrNum)%RefTypeMode == iRefTempType_DryBulb) THEN
IF (FollowSysNodeTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = OutDryBulbTemp ! Set the setpoint
ELSEIF (FollowSysNodeTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MaxTemp) THEN
Node(NodeNum)%TempSetPointHi = OutDryBulbTemp ! Set the setpoint
ELSEIF (FollowSysNodeTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MinTemp) THEN
Node(NodeNum)%TempSetPointLo = OutDryBulbTemp ! Set the setpoint
END IF
ENDIF
ELSE
! If reference node is a water node, then set RefTypeMode to NodeDryBulb
IF (Node(FollowSysNodeTempSetPtMgr(SetPtMgrNum)%RefNodeNum)%FluidType .EQ. NodeType_Water) THEN
FollowSysNodeTempSetPtMgr(SetPtMgrNum)%RefTypeMode = iRefTempType_DryBulb
ELSEIF (Node(FollowSysNodeTempSetPtMgr(SetPtMgrNum)%RefNodeNum)%FluidType .EQ. NodeType_Air) THEN
IF (FollowSysNodeTempSetPtMgr(SetPtMgrNum)%RefTypeMode == iRefTempType_WetBulb) THEN
Node(FollowSysNodeTempSetPtMgr(SetPtMgrNum)%RefNodeNum)%SPMNodeWetbulbRepReq = .TRUE.
ENDIF
ENDIF
IF (FollowSysNodeTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = 20.0d0 ! Set the setpoint
ELSEIF (FollowSysNodeTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MaxTemp) THEN
Node(NodeNum)%TempSetPointHi = 20.0d0 ! Set the setpoint
ELSEIF (FollowSysNodeTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MinTemp) THEN
Node(NodeNum)%TempSetPointLo = 20.0d0 ! Set the setpoint
END IF
END IF
END DO
END DO
DO SetPtMgrNum=1,NumGroundTempSetPtMgrs
DO CtrlNodeIndex=1,GroundTempSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = GroundTempSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (GroundTempSetPtMgr(SetPtMgrNum)%RefTypeMode == iRefGroundTempObjType_BuildingSurface) THEN
IF (GroundTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = GroundTemp ! Set the setpoint
ELSEIF (GroundTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MaxTemp) THEN
Node(NodeNum)%TempSetPointHi = GroundTemp ! Set the setpoint
ELSEIF (GroundTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MinTemp) THEN
Node(NodeNum)%TempSetPointLo = GroundTemp ! Set the setpoint
END IF
ELSEIF (GroundTempSetPtMgr(SetPtMgrNum)%RefTypeMode == iRefGroundTempObjType_Shallow) THEN
IF (GroundTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = GroundTemp_Surface ! Set the setpoint
ELSEIF (GroundTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MaxTemp) THEN
Node(NodeNum)%TempSetPointHi = GroundTemp_Surface ! Set the setpoint
ELSEIF (GroundTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MinTemp) THEN
Node(NodeNum)%TempSetPointLo = GroundTemp_Surface ! Set the setpoint
END IF
ELSEIF (GroundTempSetPtMgr(SetPtMgrNum)%RefTypeMode == iRefGroundTempObjType_Deep) THEN
IF (GroundTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = GroundTemp_Deep ! Set the setpoint
ELSEIF (GroundTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MaxTemp) THEN
Node(NodeNum)%TempSetPointHi = GroundTemp_Deep ! Set the setpoint
ELSEIF (GroundTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MinTemp) THEN
Node(NodeNum)%TempSetPointLo = GroundTemp_Deep ! Set the setpoint
END IF
ELSEIF (GroundTempSetPtMgr(SetPtMgrNum)%RefTypeMode == iRefGroundTempObjType_FCfactorMethod) THEN
IF (GroundTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = GroundTempFC ! Set the setpoint
ELSEIF (GroundTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MaxTemp) THEN
Node(NodeNum)%TempSetPointHi = GroundTempFC ! Set the setpoint
ELSEIF (GroundTempSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_MinTemp) THEN
Node(NodeNum)%TempSetPointLo = GroundTempFC ! Set the setpoint
END IF
END IF
END DO
END DO
DO SetPtMgrNum=1,NumCondEntSetPtMgrs ! Condenser entering water Set point managers
DO CtrlNodeIndex=1,CondEntSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = CondEntSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (CondEntSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = GetCurrentScheduleValue(CondEntSetPtMgr(SetPtMgrNum)%CondEntTempSchedPtr)
END IF
END DO
END DO
DO SetPtMgrNum=1,NumIdealCondEntSetPtMgrs ! Ideal Condenser entering water Set point managers
DO CtrlNodeIndex=1,IdealCondEntSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = IdealCondEntSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (IdealCondEntSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = IdealCondEntSetPtMgr(SetPtMgrNum)%MaxCondEntTemp
END IF
END DO
END DO
DO SetPtMgrNum=1, NumSZOneStageCoolingSetPtMgrs
DO CtrlNodeIndex=1,SZOneStageCoolingSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = SZOneStageCoolingSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (SZOneStageCoolingSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = SZOneStageCoolingSetPtMgr(SetPtMgrNum)%CoolingOffTemp
END IF
END DO
ENDDO
DO SetPtMgrNum=1,NumSZOneStageHeatingSetPtMgrs
DO CtrlNodeIndex=1,SZOneStageHeatingSetPtMgr(SetPtMgrNum)%NumCtrlNodes
NodeNum = SZOneStageHeatingSetPtMgr(SetPtMgrNum)%CtrlNodes(CtrlNodeIndex) ! Get the node number
IF (SZOneStageHeatingSetPtMgr(SetPtMgrNum)%CtrlTypeMode == iCtrlVarType_Temp) THEN
Node(NodeNum)%TempSetPoint = SZOneStageHeatingSetPtMgr(SetPtMgrNum)%HeatingOffTemp
END IF
END DO
ENDDO
MyEnvrnFlag = .FALSE.
IF ( .not. MyOneTimeFlag) MyOneTimeFlag2 = .FALSE.
IF (ErrorsFound) THEN
CALL ShowFatalError('InitSetPointManagers: Errors found. Program Terminates.')
ENDIF
END IF ! end begin environment inits
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag = .TRUE.
ENDIF
RETURN
END SUBROUTINE InitSetPointManagers