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 UpdateGTChillerRecords(MyLoad,RunFlag, Num)
! SUBROUTINE INFORMATION:
! AUTHOR: Dan Fisher / Brandon Anderson
! DATE WRITTEN: September 2000
! PURPOSE OF THIS SUBROUTINE:
! reporting
! METHODOLOGY EMPLOYED: na
! REFERENCES: na
! USE STATEMENTS: na
USE DataGlobals, ONLY : SecInHour
USE DataHVACGlobals, ONLY : TimeStepSys
USE PlantUtilities, ONLY : SafeCopyPlantNode
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64),INTENT(IN) :: MyLoad ! current load
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, water side
INTEGER :: EvapOutletNode ! evaporator outlet node number, water side
INTEGER :: CondInletNode ! condenser inlet node number, water side
INTEGER :: CondOutletNode ! condenser outlet node number, water side
INTEGER :: HeatRecInletNode
INTEGER :: HeatRecOutletNode
REAL(r64) :: ReportingConstant ! Number of seconds per HVAC system time step, to convert from W (J/s) to J
ReportingConstant = TimeStepSys*SecInHour
EvapInletNode = GTChiller(Num)%Base%EvapInletNodeNum
EvapOutletNode = GTChiller(Num)%Base%EvapOutletNodeNum
CondInletNode = GTChiller(Num)%Base%CondInletNodeNum
CondOutletNode = GTChiller(Num)%Base%CondOutletNodeNum
IF (GTChiller(Num)%HeatRecActive) THEN
HeatRecInletNode = GTChiller(Num)%HeatRecInletNodeNum
HeatRecOutletNode = GTChiller(Num)%HeatRecOutletNodeNum
ENDIF
IF (MyLoad >= 0.d0 .OR. .NOT. RunFlag)THEN !Chiller not running so pass inlet states to outlet states
!set node temperatures
Node(EvapOutletNode)%Temp = Node(EvapInletNode)%Temp
Node(CondOutletNode)%Temp = Node(CondInletNode)%Temp
IF (GTChiller(Num)%HeatRecActive) THEN
CALL SafeCopyPlantNode( HeatRecOutletNode, HeatRecInletNode)
GTChillerReport(Num)%HeatRecInletTemp = Node(HeatRecInletNode)%Temp
GTChillerReport(Num)%HeatRecOutletTemp = Node(HeatRecOutletNode)%Temp
ENDIF
GTChillerReport(Num)%Base%Power = 0.0d0
GTChillerReport(Num)%Base%QEvap = 0.0d0
GTChillerReport(Num)%Base%QCond = 0.0d0
GTChillerReport(Num)%Base%Energy = 0.0d0
GTChillerReport(Num)%Base%EvapEnergy = 0.0d0
GTChillerReport(Num)%Base%CondEnergy = 0.0d0
GTChillerReport(Num)%Base%EvapInletTemp = Node(EvapInletNode)%Temp
GTChillerReport(Num)%Base%CondInletTemp = Node(CondInletNode)%Temp
GTChillerReport(Num)%Base%CondOutletTemp = Node(CondOutletNode)%Temp
GTChillerReport(Num)%Base%EvapOutletTemp = Node(EvapOutletNode)%Temp
GTChillerReport(Num)%Base%Evapmdot = EvapMassFlowRate
GTChillerReport(Num)%Base%Condmdot = CondMassFlowRate
GTChillerReport(Num)%FuelEnergyUsedRate = 0.0d0
GTChillerReport(Num)%FuelMassUsedRate = 0.0d0
GTChillerReport(Num)%FuelEnergyUsed = 0.0d0
GTChillerReport(Num)%FuelMassUsed = 0.0d0
GTChillerReport(Num)%HeatRecLubeEnergy = 0.0d0
GTChillerReport(Num)%HeatRecLubeRate = 0.0d0
GTChillerReport(Num)%ExhaustStackTemp = 0.0d0
GTChillerReport(Num)%HeatRecMdot = GTChiller(Num)%HeatRecMdot
GTChillerReport(Num)%FuelCOP = 0.0d0
IF (GTChiller(Num)%Base%CondenserType == EvapCooled) THEN
GTChillerReport(Num)%Base%BasinHeaterPower = BasinHeaterPower
GTChillerReport(Num)%Base%BasinHeaterConsumption = BasinHeaterPower*ReportingConstant
ENDIF
ELSE !Chiller is running so report calculated values
!set node temperatures
Node(EvapOutletNode)%Temp = EvapOutletTemp
Node(CondOutletNode)%Temp = CondOutletTemp
IF (GTChiller(Num)%HeatRecActive) THEN
CALL SafeCopyPlantNode( HeatRecOutletNode, HeatRecInletNode)
Node(HeatRecOutletNode)%Temp = GTChiller(Num)%HeatRecOutletTemp
ENDIF
GTChillerReport(Num)%Base%Power = Power
GTChillerReport(Num)%Base%QEvap = QEvaporator
GTChillerReport(Num)%Base%QCond = QCondenser
GTChillerReport(Num)%Base%Energy = Energy
GTChillerReport(Num)%Base%EvapEnergy = EvaporatorEnergy
GTChillerReport(Num)%Base%CondEnergy = CondenserEnergy
GTChillerReport(Num)%Base%EvapInletTemp = Node(EvapInletNode)%Temp
GTChillerReport(Num)%Base%CondInletTemp = Node(CondInletNode)%Temp
GTChillerReport(Num)%Base%CondOutletTemp = Node(CondOutletNode)%Temp
GTChillerReport(Num)%Base%EvapOutletTemp = Node(EvapOutletNode)%Temp
GTChillerReport(Num)%Base%Evapmdot = EvapMassFlowRate
GTChillerReport(Num)%Base%Condmdot = CondMassFlowRate
GTChillerReport(Num)%HeatRecLubeEnergy = GTChiller(Num)%HeatRecLubeEnergy
GTChillerReport(Num)%HeatRecLubeRate = GTChiller(Num)%HeatRecLubeRate
GTChillerReport(Num)%FuelEnergyUsedRate = GTChiller(Num)%FuelEnergyIn
GTChillerReport(Num)%FuelMassUsedRate = GTChillerReport(Num)%FuelMassUsedRate
GTChillerReport(Num)%FuelEnergyUsed = GTChillerReport(Num)%FuelEnergyUsedRate*TimeStepSys*SecInHour
GTChillerReport(Num)%FuelMassUsed = GTChillerReport(Num)%FuelMassUsedRate*TimeStepSys*SecInHour
GTChillerReport(Num)%ExhaustStackTemp = GTChiller(Num)%ExhaustStackTemp
GTChillerReport(Num)%HeatRecInletTemp = GTChiller(Num)%HeatRecInletTemp
GTChillerReport(Num)%HeatRecOutletTemp = GTChiller(Num)%HeatRecOutletTemp
GTChillerReport(Num)%HeatRecMdot = GTChiller(Num)%HeatRecMdot
IF (GTChillerReport(Num)%FuelEnergyUsedRate .NE. 0.0d0) THEN
GTChillerReport(Num)%FuelCOP = GTChillerReport(Num)%Base%QEvap/GTChillerReport(Num)%FuelEnergyUsedRate
ELSE
GTChillerReport(Num)%FuelCOP = 0.0d0
END IF
IF (GTChiller(Num)%Base%CondenserType == EvapCooled) THEN
GTChillerReport(Num)%Base%BasinHeaterPower = BasinHeaterPower
GTChillerReport(Num)%Base%BasinHeaterConsumption = BasinHeaterPower*ReportingConstant
ENDIF
END IF
RETURN
END SUBROUTINE UpdateGTChillerRecords