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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | DXSystemNum | |||
integer, | intent(in) | :: | AirLoopNum | |||
integer, | intent(in), | optional | :: | OAUnitNum | ||
real(kind=r64), | intent(in), | optional | :: | OAUCoilOutTemp |
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 InitDXCoolingSystem(DXSystemNum,AirLoopNum,OAUnitNum,OAUCoilOutTemp)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN May 2001
! Feb 2005 M. J. Witte, GARD Analytics, Inc.
! Add dehumidification controls
! May 2009, B. Griffith, NREL added EMS setpoint checks
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the DX Cooling Systems.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataHVACGlobals, ONLY: DoSetPointTest
USE DataAirLoop, ONLY: AirLoopControlInfo
USE EMSManager, ONLY: iTemperatureSetpoint, CheckIfNodeSetpointManagedByEMS, iHumidityRatioMaxSetpoint
USE DataGlobals, ONLY: AnyEnergyManagementSystemInModel
USE DataEnvironment, ONLY: OutBaroPress
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: DXSystemNum ! number of the current DX Sys being simulated
INTEGER, INTENT (IN) :: AirLoopNum ! number of the current air loop being simulated
INTEGER, INTENT (IN), Optional :: OAUnitNum ! number of the current outdoor air unit being simulated
REAL(r64), INTENT(IN), OPTIONAL :: OAUCoilOutTemp ! the coil inlet temperature of OutdoorAirUnit
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
Integer :: OutNode ! outlet node number
INTEGER :: ControlNode ! control node number
INTEGER :: DXSysIndex
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL,SAVE :: MySetPointCheckFlag = .TRUE.
INTEGER :: OutdoorAirUnitNum ! "ONLY" for ZoneHVAC:OutdoorAirUnit
REAL(r64) :: OAUCoilOutletTemp ! "ONLY" for zoneHVAC:OutdoorAirUnit
! FLOW:
IF (MyOneTimeFlag) THEN
MyOneTimeFlag = .false.
END IF
IF (AirLoopNum .EQ.-1) THEN ! This Dx system is component of ZoneHVAC:OutdoorAirUnit
OutdoorAirUnitNum=OAUnitNum
OAUCoilOutletTemp=OAUCoilOutTemp
END IF
IF ( .NOT. SysSizingCalc .AND. MySetPointCheckFlag .AND. DoSetPointTest) THEN
DO DXSysIndex=1,NumDXSystem
ControlNode = DXCoolingSystem(DXSysIndex)%DXSystemControlNodeNum
IF (ControlNode > 0) THEN
IF (AirLoopNum .EQ.-1) THEN ! Outdoor Air Unit
Node(ControlNode)%TempSetPoint = OAUCoilOutletTemp ! Set the coil outlet temperature
IF(DXCoolingSystem(DXSystemNum)%ISHundredPercentDOASDXCoil) THEN
CALL FrostControlSetPointLimit(DXSystemNum,DXCoolingSystem(DXSystemNum)%DesiredOutletTemp,Node(ControlNode)%HumRatMax, &
OutBaroPress, DXCoolingSystem(DXSystemNum)%DOASDXCoolingCoilMinTout,1)
ENDIF
ELSE IF (AirLoopNum /= -1) THEN ! Not an outdoor air unit
IF (Node(ControlNode)%TempSetPoint == SensedNodeFlagValue) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
CALL ShowSevereError(TRIM(DXCoolingSystem(DXSysIndex)%DXCoolingSystemType)//&
': Missing temperature setpoint for DX unit= ' //TRIM(DXCoolingSystem(DXSysIndex)%Name))
CALL ShowContinueError(' use a Setpoint Manager to establish a setpoint at the unit control node.')
SetPointErrorFlag = .TRUE.
ELSE
CALL CheckIfNodeSetpointManagedByEMS(ControlNode,iTemperatureSetpoint, SetpointErrorFlag)
IF (SetpointErrorFlag) THEN
CALL ShowSevereError(TRIM(DXCoolingSystem(DXSysIndex)%DXCoolingSystemType)//&
': Missing temperature setpoint for DX unit= ' //TRIM(DXCoolingSystem(DXSysIndex)%Name))
CALL ShowContinueError(' use a Setpoint Manager to establish a setpoint at the unit control node.')
CALL ShowContinueError(' or use an EMS actuator to establish a temperature setpoint at the unit control node.')
ENDIF
ENDIF
END IF
IF ((DXCoolingSystem(DXSysIndex)%DehumidControlType .NE. DehumidControl_None) .AND. &
(Node(ControlNode)%HumRatMax == SensedNodeFlagValue)) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
CALL ShowSevereError(TRIM(DXCoolingSystem(DXSysIndex)%DXCoolingSystemType)//&
': Missing humidity ratio setpoint (HUMRATMAX) for DX unit= ' &
//TRIM(DXCoolingSystem(DXSysIndex)%Name))
CALL ShowContinueError(' use a Setpoint Manager to establish a setpoint at the unit control node.')
SetPointErrorFlag = .TRUE.
ELSE
CALL CheckIfNodeSetpointManagedByEMS(ControlNode,iHumidityRatioMaxSetpoint, SetpointErrorFlag)
IF (SetpointErrorFlag) THEN
CALL ShowSevereError(TRIM(DXCoolingSystem(DXSysIndex)%DXCoolingSystemType)//&
': Missing maximum humidity ratio setpoint (HUMRATMAX) for DX unit= ' &
//TRIM(DXCoolingSystem(DXSysIndex)%Name))
CALL ShowContinueError(' use a Setpoint Manager to establish a setpoint at the unit control node.')
CALL ShowContinueError(' or use an EMS actuator to establish a maximum humidity ratio setpoint.')
ENDIF
ENDIF
END IF
END IF
END IF
END DO
MySetPointCheckFlag = .FALSE.
END IF
! These initializations are done every iteration
IF (AirLoopNum .EQ.-1) THEN ! This IF-TEHN routine is just for ZoneHVAC:OUTDOORAIRUNIT
OutNode = DXCoolingSystem(DXSystemNum)%DXCoolingCoilOutletNodeNum
ControlNode = DXCoolingSystem(DXSystemNum)%DXSystemControlNodeNum
IF (ControlNode.EQ.0) THEN
DXCoolingSystem(DXSystemNum)%DesiredOutletTemp = 0.0d0
DXCoolingSystem(DXSystemNum)%DesiredOutletHumRat = 1.0d0
ELSE IF (ControlNode.EQ.OutNode) THEN
DXCoolingSystem(DXSystemNum)%DesiredOutletTemp =OAUCoilOutletTemp
IF (DXCoolingSystem(DXSystemNum)%ISHundredPercentDOASDXCoil .AND. DXCoolingSystem(DXSystemNum)%RunOnSensibleLoad) THEN
CALL FrostControlSetPointLimit(DXSystemNum,DXCoolingSystem(DXSystemNum)%DesiredOutletTemp,Node(ControlNode)%HumRatMax, &
OutBaroPress,DXCoolingSystem(DXSystemNum)%DOASDXCoolingCoilMinTout,1)
ENDIF
END IF
! If the Dxsystem is an equipment of Outdoor Air Unit, the desiered coiloutlet humidity level is set to zero
DXCoolingSystem(DXSystemNum)%DesiredOutletHumRat = 1.0d0
ELSE IF (AirLoopNum /=-1) THEN ! Not Outdoor Air Unit
OutNode = DXCoolingSystem(DXSystemNum)%DXCoolingCoilOutletNodeNum
ControlNode = DXCoolingSystem(DXSystemNum)%DXSystemControlNodeNum
EconomizerFlag = AirLoopControlInfo(AirLoopNum)%EconoActive
IF (ControlNode.EQ.0) THEN
DXCoolingSystem(DXSystemNum)%DesiredOutletTemp = 0.0d0
DXCoolingSystem(DXSystemNum)%DesiredOutletHumRat = 1.0d0
ELSE IF (ControlNode.EQ.OutNode) THEN
IF (DXCoolingSystem(DXSystemNum)%ISHundredPercentDOASDXCoil .AND. DXCoolingSystem(DXSystemNum)%RunOnSensibleLoad) THEN
CALL FrostControlSetPointLimit(DXSystemNum, Node(ControlNode)%TempSetPoint,Node(ControlNode)%HumRatMax,OutBaroPress, &
DXCoolingSystem(DXSystemNum)%DOASDXCoolingCoilMinTout,1)
ENDIF
DXCoolingSystem(DXSystemNum)%DesiredOutletTemp = Node(ControlNode)%TempSetPoint
! If HumRatMax is zero, then there is no request from SetpointManager:SingleZone:Humidity:Maximum
IF ((DXCoolingSystem(DXSystemNum)%DehumidControlType .NE. DehumidControl_None) .AND. &
(Node(ControlNode)%HumRatMax .GT. 0.0d0)) THEN
IF (DXCoolingSystem(DXSystemNum)%ISHundredPercentDOASDXCoil .AND. DXCoolingSystem(DXSystemNum)%RunOnLatentLoad) THEN
CALL FrostControlSetPointLimit(DXSystemNum,Node(ControlNode)%TempSetPoint,Node(ControlNode)%HumRatMax,OutBaroPress, &
DXCoolingSystem(DXSystemNum)%DOASDXCoolingCoilMinTout,2)
ENDIF
DXCoolingSystem(DXSystemNum)%DesiredOutletHumRat = Node(ControlNode)%HumRatMax
ELSE
DXCoolingSystem(DXSystemNum)%DesiredOutletHumRat = 1.0d0
END IF
ELSE
IF (DXCoolingSystem(DXSystemNum)%ISHundredPercentDOASDXCoil .AND. DXCoolingSystem(DXSystemNum)%RunOnSensibleLoad) THEN
CALL FrostControlSetPointLimit(DXSystemNum,Node(ControlNode)%TempSetPoint,Node(ControlNode)%HumRatMax,OutBaroPress, &
DXCoolingSystem(DXSystemNum)%DOASDXCoolingCoilMinTout,1)
ENDIF
DXCoolingSystem(DXSystemNum)%DesiredOutletTemp = Node(ControlNode)%TempSetPoint - &
(Node(ControlNode)%Temp - Node(OutNode)%Temp)
IF (DXCoolingSystem(DXSystemNum)%DehumidControlType .NE. DehumidControl_None) THEN
IF (DXCoolingSystem(DXSystemNum)%ISHundredPercentDOASDXCoil .AND. DXCoolingSystem(DXSystemNum)%RunOnLatentLoad) THEN
CALL FrostControlSetPointLimit(DXSystemNum,Node(ControlNode)%TempSetPoint,Node(ControlNode)%HumRatMax,OutBaroPress, &
DXCoolingSystem(DXSystemNum)%DOASDXCoolingCoilMinTout,2)
ENDIF
DXCoolingSystem(DXSystemNum)%DesiredOutletHumRat = Node(ControlNode)%HumRatMax - &
(Node(ControlNode)%HumRat - Node(OutNode)%HumRat)
ELSE
DXCoolingSystem(DXSystemNum)%DesiredOutletHumRat = 1.0d0
END IF
END IF
END IF
RETURN
END SUBROUTINE InitDXCoolingSystem