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) | :: | CompNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
integer, | intent(in) | :: | EquipIndex | |||
real(kind=r64), | intent(out) | :: | LoadMet |
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 CalcOAUnitCoilComps(CompNum,FirstHVACIteration,EquipIndex,LoadMet)
! SUBROUTINE INFORMATION:
! AUTHOR Young Tae Chae, Rick Strand
! DATE WRITTEN June 2009
! MODIFIED
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine mainly controls the action of water components in the unit
! METHODOLOGY EMPLOYED:
! REFERENCES:
! USE STATEMENTS:
USE HeatingCoils, ONLY : SimulateHeatingCoilComponents
USE WaterCoils, ONLY : SimulateWaterCoilComponents
USE HVACHXAssistedCoolingCoil, ONLY :SimHXAssistedCoolingCoil
USE SteamCoils, ONLY: SimulateSteamCoilComponents
USE DataHVACGlobals, ONLY: SmallLoad
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: CompNum ! actual outdoor air unit num
LOGICAL, INTENT (IN) :: FirstHVACIteration
INTEGER, INTENT(IN) :: EquipIndex ! Component Type -- Integerized for this module
REAL(r64), INTENT(OUT) :: LoadMet
! SUBROUTINE LOCAL VARIABLE DEFINITIONS
INTEGER :: OAUnitNum
REAL(r64) :: CpAirZn
INTEGER :: CoilIndex
INTEGER :: OPMode
REAL(r64) :: AirMassFlow
REAL(r64) :: Faneffect
LOGICAL :: DrawFan ! Fan Flag
INTEGER :: InletNode
INTEGER :: OutletNode
INTEGER :: AirOutletNode
INTEGER :: WaterCoilIndex =0
REAL(r64) :: QCompReq ! Actual equipment load
REAL(r64) :: CoilInTemp
REAL(r64) :: MinWaterFlow
INTEGER :: SHCoilInletNode
INTEGER :: SHCoilOutletNode
INTEGER :: CoilWaterInletNode
INTEGER :: CoilTypeNum
LOGICAL :: ErrorsFound=.FALSE. ! Set to true if errors in input, fatal at end of routine
REAL(r64) ::CoilAirOutTemp
INTEGER :: CoilNum
INTEGER :: CompoNum
! Flow
CoilIndex=0
OAUnitNum=CompNum
CompoNum=EquipIndex
CoilTypeNum=OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%ComponentType_Num
OPMode=OutAirUnit(OAUnitNum)%OperatingMode
CoilAirOutTemp=OutAirUnit(OAUnitNum)%CompOutSetTemp
DrawFan=OutAirUnit(OAUnitNum)%FanEffect
IF (DrawFan) THEN
Faneffect = OutAirUnit(OAUnitNum)%FanCorTemp
ELSE
Faneffect = 0.0d0
END IF
SELECT CASE(CoilTypeNum)
CASE (Coil_ElectricHeat)
InletNode=OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%CoilAirInletNode
OutletNode=OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%CoilAirOutletNode
IF((OPMode == NeutralMode).OR.(OPMode == CoolingMode) &
.OR.(Node(InletNode)%Temp > CoilAirOutTemp)) THEN
QCompReq=0.0d0
ELSE
CpAirZn = PsyCpAirFnWTdb(Node(InletNode)%HumRat,Node(InletNode)%Temp)
QCompReq = Node(InletNode)%MassFlowRate * CpAirZn &
*((CoilAirOutTemp-Node(InletNode)%Temp)-faneffect)
IF (ABS(QCompReq) < SmallLoad) QCompReq = 0.d0
END IF
IF (QCompReq .LE. 0.0d0) THEN
QCompReq = 0.0d0 ! a heating coil can only heat, not cool
Node(OutletNode)%Temp=Node(InletNode)%Temp
Node(OutletNode)%HumRat=Node(InletNode)%HumRat
Node(OutletNode)%Massflowrate=Node(InletNode)%Massflowrate
END IF
CALL SimulateHeatingCoilComponents(OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%ComponentName, &
FirstHVACIteration,QCompReq,CoilIndex)
AirMassFlow = Node(InletNode)%MassFlowRate
LoadMet = AirMassFlow * (PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
CASE(Coil_GasHeat) ! 'Coil:Heating:Steam'
InletNode=OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%CoilAirInletNode
OutletNode=OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%CoilAirOutletNode
IF((OPMode == NeutralMode).OR.(OPMode == CoolingMode) &
.OR.(Node(InletNode)%Temp > CoilAirOutTemp)) THEN
QCompReq=0.0d0
ELSE
Node(OutletNode)%Massflowrate=Node(InletNode)%Massflowrate
CpAirZn = PsyCpAirFnWTdb(Node(InletNode)%HumRat,Node(InletNode)%Temp)
QCompReq = Node(InletNode)%MassFlowRate * CpAirZn &
*((CoilAirOutTemp-Node(InletNode)%Temp)-faneffect)
IF (ABS(QCompReq) < SmallLoad) QCompReq = 0.d0
END IF
IF (QCompReq .LE. 0.0d0) THEN
QCompReq = 0.0d0 ! a heating coil can only heat, not cool
Node(OutletNode)%Temp=Node(InletNode)%Temp
Node(OutletNode)%HumRat=Node(InletNode)%HumRat
Node(OutletNode)%Massflowrate=Node(InletNode)%Massflowrate
END IF
CALL SimulateHeatingCoilComponents(OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%ComponentName, &
FirstHVACIteration,QCompReq,CoilIndex)
AirMassFlow = Node(InletNode)%MassFlowRate
LoadMet = AirMassFlow * (PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
CASE(SteamCoil_AirHeat) ! 'Coil:Heating:Steam'
InletNode=OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%CoilAirInletNode
OutletNode=OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%CoilAirOutletNode
IF((OPMode == NeutralMode).OR.(OPMode == CoolingMode) &
.OR.(Node(InletNode)%Temp > CoilAirOutTemp)) THEN
QCompReq=0.0d0
ELSE
CpAirZn = PsyCpAirFnWTdb(Node(InletNode)%HumRat,Node(InletNode)%Temp)
QCompReq = Node(InletNode)%MassFlowRate * CpAirZn &
*((CoilAirOutTemp-Node(InletNode)%Temp)-faneffect)
IF (ABS(QCompReq) < SmallLoad) QCompReq = 0.d0
END IF
IF (QCompReq .LE. 0.0d0) THEN
QCompReq = 0.0d0 ! a heating coil can only heat, not cool
Node(OutletNode)%Temp=Node(InletNode)%Temp
Node(OutletNode)%HumRat=Node(InletNode)%HumRat
Node(OutletNode)%Massflowrate=Node(InletNode)%Massflowrate
END IF
CALL SimulateSteamCoilComponents(OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%ComponentName, &
FirstHVACIteration,QCompReq,CoilIndex)
AirMassFlow = Node(InletNode)%MassFlowRate
LoadMet = AirMassFlow * (PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
CASE(WaterCoil_SimpleHeat) ! 'Coil:Heating:Water')
CALL SimulateWaterCoilComponents(OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%ComponentName,FirstHVACIteration,CoilIndex)
InletNode = OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%CoilAirInletNode
OutletNode = OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%CoilAirOutletNode
AirMassFlow = Node(InletNode)%MassFlowRate
LoadMet = AirMassFlow * (PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
CASE(WaterCoil_Cooling) ! 'Coil:Cooling:Water'
CALL SimulateWaterCoilComponents(OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%ComponentName,FirstHVACIteration,CoilIndex)
InletNode=OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%CoilAirInletNode
OutletNode=OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%CoilAirOutletNode
AirMassFlow = Node(InletNode)%MassFlowRate
LoadMet = AirMassFlow * (PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
CASE(WaterCoil_DetailedCool)
CALL SimulateWaterCoilComponents(OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%ComponentName,FirstHVACIteration,CoilIndex)
InletNode=OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%CoilAirInletNode
OutletNode=OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%CoilAirOutletNode
AirMassFlow = Node(InletNode)%MassFlowRate
LoadMet = AirMassFlow * (PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
CASE(WaterCoil_CoolingHXAsst)
CALL SimHXAssistedCoolingCoil(OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%ComponentName,FirstHVACIteration,1, &
0.0d0,CoilIndex,ContFanCycCoil)
InletNode=OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%CoilAirInletNode
OutletNode=OutAirUnit(OAUnitNum)%OAEquip(CompoNum)%CoilAirOutletNode
AirMassFlow = Node(InletNode)%MassFlowRate
LoadMet = AirMassFlow * (PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
END SELECT
END SUBROUTINE CalcOAUnitCoilComps