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 | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(in) | :: | MyLoad | |||
logical, | intent(in) | :: | RunFlag | |||
integer, | intent(in) | :: | Num |
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 UpdateElectricEIRChillerRecords(MyLoad,RunFlag,Num)
! SUBROUTINE INFORMATION:
! AUTHOR: Richard Raustad, FSEC
! DATE WRITTEN: June 2004
! PURPOSE OF THIS SUBROUTINE:
! Reporting
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY : SecInHour
USE DataHVACGlobals, ONLY : TimeStepSys
USE PlantUtilities, ONLY : SafeCopyPlantNode
USE Psychrometrics, ONLY : PsyHFnTdbW
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64),INTENT(IN) :: MyLoad ! Current load [W]
LOGICAL, INTENT(IN) :: RunFlag ! TRUE if chiller operating
INTEGER, INTENT(IN) :: Num ! Chiller number
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: EvapInletNode ! Evaporator inlet node number
INTEGER :: EvapOutletNode ! Evaporator outlet node number
INTEGER :: CondInletNode ! Condenser inlet node number
INTEGER :: CondOutletNode ! Condenser outlet node number
INTEGER :: HeatRecInNode ! Node number of heat recovery water inlet node
INTEGER :: HeatRecOutNode ! Node number of heat recovery water outlet node
REAL(r64) :: ReportingConstant ! Number of seconds per HVAC system time step, to convert from W (J/s) to J
ReportingConstant = TimeStepSys*SecInHour
EvapInletNode = ElectricEIRChiller(Num)%EvapInletNodeNum
EvapOutletNode = ElectricEIRChiller(Num)%EvapOutletNodeNum
CondInletNode = ElectricEIRChiller(Num)%CondInletNodeNum
CondOutletNode = ElectricEIRChiller(Num)%CondOutletNodeNum
HeatRecInNode = ElectricEIRChiller(Num)%HeatRecInletNodeNum
HeatRecOutNode = ElectricEIRChiller(Num)%HeatRecOutletNodeNum
IF (MyLoad>=0 .OR. .NOT. RunFlag) THEN ! Chiller not running so pass inlet states to outlet states
! Set node conditions
Node(EvapOutletNode)%Temp = Node(EvapInletNode)%Temp
Node(CondOutletNode)%Temp = Node(CondInletNode)%Temp
IF(ElectricEIRChiller(Num)%CondenserType /= WaterCooled) THEN
Node(CondOutletNode)%HumRat = Node(CondInletNode)%HumRat
Node(CondOutletNode)%Enthalpy = Node(CondInletNode)%Enthalpy
END IF
ElectricEIRChillerReport(Num)%ChillerPartLoadRatio = 0.0d0
ElectricEIRChillerReport(Num)%ChillerCyclingRatio = 0.0d0
ElectricEIRChillerReport(Num)%ChillerFalseLoadRate = 0.0d0
ElectricEIRChillerReport(Num)%ChillerFalseLoad = 0.0d0
ElectricEIRChillerReport(Num)%Power = 0.0d0
ElectricEIRChillerReport(Num)%QEvap = 0.0d0
ElectricEIRChillerReport(Num)%QCond = 0.0d0
ElectricEIRChillerReport(Num)%Energy = 0.0d0
ElectricEIRChillerReport(Num)%EvapEnergy = 0.0d0
ElectricEIRChillerReport(Num)%CondEnergy = 0.0d0
ElectricEIRChillerReport(Num)%EvapInletTemp = Node(EvapInletNode)%Temp
ElectricEIRChillerReport(Num)%CondInletTemp = Node(CondInletNode)%Temp
ElectricEIRChillerReport(Num)%CondOutletTemp = Node(CondOutletNode)%Temp
ElectricEIRChillerReport(Num)%EvapOutletTemp = Node(EvapOutletNode)%Temp
ElectricEIRChillerReport(Num)%Evapmdot = EvapMassFlowRate ! could still be flow if in series
ElectricEIRChillerReport(Num)%Condmdot = CondMassFlowRate ! could still be flow if in series
ElectricEIRChillerReport(Num)%ActualCOP = 0.0d0
ElectricEIRChillerReport(Num)%CondenserFanPowerUse = 0.0d0
ElectricEIRChillerReport(Num)%CondenserFanEnergyConsumption = 0.0d0
IF (ElectricEIRChiller(Num)%CondenserType == EvapCooled) THEN
ElectricEIRChillerReport(Num)%BasinHeaterPower = BasinHeaterPower
ElectricEIRChillerReport(Num)%BasinHeaterConsumption = BasinHeaterPower*ReportingConstant
ENDIF
IF (ElectricEIRChiller(Num)%HeatRecActive) THEN
CALL SafeCopyPlantNode( HeatRecInNode, HeatRecOutNode)
ElectricEIRChillerReport(Num)%QHeatRecovery = 0.0d0
ElectricEIRChillerReport(Num)%EnergyHeatRecovery = 0.0d0
ElectricEIRChillerReport(Num)%HeatRecInletTemp = Node(HeatRecInNode)%Temp
ElectricEIRChillerReport(Num)%HeatRecOutletTemp = Node(HeatRecOutNode)%Temp
ElectricEIRChillerReport(Num)%HeatRecMassFlow = Node(HeatRecInNode)%MassFlowRate
END IF
ELSE ! Chiller is running, so pass calculated values
! Set node temperatures
Node(EvapOutletNode)%Temp = EvapOutletTemp
Node(CondOutletNode)%Temp = CondOutletTemp
IF(ElectricEIRChiller(Num)%CondenserType /= WaterCooled) THEN
Node(CondOutletNode)%HumRat = CondOutletHumRat
Node(CondOutletNode)%Enthalpy = PsyHFnTdbW(CondOutletTemp, CondOutletHumRat)
END IF
! Set node flow rates; for these load based models
! assume that sufficient evaporator flow rate is available
ElectricEIRChillerReport(Num)%ChillerPartLoadRatio = ChillerPartLoadRatio
ElectricEIRChillerReport(Num)%ChillerCyclingRatio = ChillerCyclingRatio
ElectricEIRChillerReport(Num)%ChillerFalseLoadRate = ChillerFalseLoadRate
ElectricEIRChillerReport(Num)%ChillerFalseLoad = ChillerFalseLoadRate*TimeStepSys*SecInHour
ElectricEIRChillerReport(Num)%Power = Power
ElectricEIRChillerReport(Num)%QEvap = QEvaporator
ElectricEIRChillerReport(Num)%QCond = QCondenser
ElectricEIRChillerReport(Num)%Energy = Power*TimeStepSys*SecInHour
ElectricEIRChillerReport(Num)%EvapEnergy = QEvaporator*TimeStepSys*SecInHour
ElectricEIRChillerReport(Num)%CondEnergy = QCondenser*TimeStepSys*SecInHour
ElectricEIRChillerReport(Num)%EvapInletTemp = Node(EvapInletNode)%Temp
ElectricEIRChillerReport(Num)%CondInletTemp = Node(CondInletNode)%Temp
ElectricEIRChillerReport(Num)%CondOutletTemp = Node(CondOutletNode)%Temp
ElectricEIRChillerReport(Num)%EvapOutletTemp = Node(EvapOutletNode)%Temp
ElectricEIRChillerReport(Num)%Evapmdot = EvapMassFlowRate
ElectricEIRChillerReport(Num)%Condmdot = CondMassFlowRate
ElectricEIRChillerReport(Num)%CondenserFanPowerUse = CondenserFanPower
ElectricEIRChillerReport(Num)%CondenserFanEnergyConsumption = CondenserFanPower*TimeStepSys*SecInHour
IF (Power .NE. 0.0d0) THEN
ElectricEIRChillerReport(Num)%ActualCOP = (QEvaporator+ChillerFalseLoadRate)/Power
ELSE
ElectricEIRChillerReport(Num)%ActualCOP = 0.0d0
END IF
IF (ElectricEIRChiller(Num)%CondenserType == EvapCooled) THEN
ElectricEIRChillerReport(Num)%BasinHeaterPower = BasinHeaterPower
ElectricEIRChillerReport(Num)%BasinHeaterConsumption = BasinHeaterPower*ReportingConstant
ENDIF
IF(ElectricEIRChiller(Num)%HeatRecActive) THEN
CALL SafeCopyPlantNode( HeatRecInNode, HeatRecOutNode)
ElectricEIRChillerReport(Num)%QHeatRecovery = QHeatRecovered
ElectricEIRChillerReport(Num)%EnergyHeatRecovery = QHeatRecovered*TimeStepSys*SecInHour
Node(HeatRecOutNode)%Temp = HeatRecOutletTemp
ElectricEIRChillerReport(Num)%HeatRecInletTemp = Node(HeatRecInNode)%Temp
ElectricEIRChillerReport(Num)%HeatRecOutletTemp = Node(HeatRecOutNode)%Temp
ElectricEIRChillerReport(Num)%HeatRecMassFlow = Node(HeatRecInNode)%MassFlowRate
END IF
END IF
ElectricEIRChillerReport(Num)%ChillerCapFT = ChillerCapFT
ElectricEIRChillerReport(Num)%ChillerEIRFT = ChillerEIRFT
ElectricEIRChillerReport(Num)%ChillerEIRFPLR = ChillerEIRFPLR
RETURN
END SUBROUTINE UpdateElectricEIRChillerRecords