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) | :: | 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 UpdateMicroCHPGeneratorRecords(Num)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN July 2006
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! update variables in structures linked to output reports
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: SecInHour
USE DataHVACGlobals, ONLY: TimeStepSys
USE DataPlant, ONLY: PlantLoop
USE FluidProperties, ONLY: GetSpecificHeatGlycol
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: Num ! Generator number
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: Cp ! local fluid specific heat
! na
MicroCHP(Num)%Report%Mode = MicroCHP(Num)%A42Model%OpMode
MicroCHP(Num)%Report%OffModeTime = MicroCHP(Num)%A42Model%OffModeTime
MicroCHP(Num)%Report%StandyByModeTime = MicroCHP(Num)%A42Model%StandyByModeTime
MicroCHP(Num)%Report%WarmUpModeTime = MicroCHP(Num)%A42Model%WarmUpModeTime
MicroCHP(Num)%Report%NormalModeTime = MicroCHP(Num)%A42Model%NormalModeTime
MicroCHP(Num)%Report%CoolDownModeTime = MicroCHP(Num)%A42Model%CoolDownModeTime
MicroCHP(Num)%Report%ACPowerGen = MicroCHP(Num)%A42Model%Pnet !electrical power produced [W]
MicroCHP(Num)%Report%ACEnergyGen = MicroCHP(Num)%A42Model%Pnet*TimeStepSys*SecInHour ! energy produced (J)
MicroCHP(Num)%Report%QdotGross = MicroCHP(Num)%A42Model%Qgross
MicroCHP(Num)%Report%Qgenss = MicroCHP(Num)%A42Model%Qgenss
MicroCHP(Num)%Report%QdotHX = MicroCHP(Num)%A42Model%UAhx &
* (MicroCHP(Num)%A42Model%Teng - MicroCHP(Num)%A42Model%Tcwout) ! heat recovered rate (W)
Cp = GetSpecificHeatGlycol(PlantLoop(MicroCHP(Num)%CWLoopNum)%FluidName, &
MicroCHP(Num)%A42Model%Tcwin, &
PlantLoop(MicroCHP(Num)%CWLoopNum)%FluidIndex, &
'UpdateMicroCHPGeneratorRecords')
MicroCHP(Num)%Report%QdotHR = MicroCHP(Num)%PlantMassFlowRate * Cp &
* (MicroCHP(Num)%A42Model%Tcwout - MicroCHP(Num)%A42Model%Tcwin)
MicroCHP(Num)%Report%TotalHeatEnergyRec = MicroCHP(Num)%Report%QdotHR & ! heat recovered energy (J)
* TimeStepSys*SecInHour
MicroCHP(Num)%Report%HeatRecInletTemp = MicroCHP(Num)%A42Model%Tcwin ! Heat Recovery Loop Inlet Temperature (C)
MicroCHP(Num)%Report%HeatRecOutletTemp = MicroCHP(Num)%A42Model%Tcwout ! Heat Recovery Loop Outlet Temperature (C)
MicroCHP(Num)%Report%HeatRecMdot = MicroCHP(Num)%PlantMassFlowRate ! Heat Recovery Loop Mass flow rate (kg/s)
MicroCHP(Num)%Report%Tengine = MicroCHP(Num)%A42Model%Teng
MicroCHP(Num)%Report%ElectEfficiency = MicroCHP(Num)%A42Model%ElecEff
MicroCHP(Num)%Report%ThermalEfficiency = MicroCHP(Num)%A42Model%ThermEff
MicroCHP(Num)%Report%OverallEfficiency = MicroCHP(Num)%A42Model%ElecEff + MicroCHP(Num)%A42Model%ThermEff
MicroCHP(Num)%Report%MdotAir = MicroCHP(Num)%A42Model%MdotAir ! air flow in kg/sec
MicroCHP(Num)%Report%NdotFuel = MicroCHP(Num)%A42Model%NdotFuel ! fuel flow in kmol/sec
MicroCHP(Num)%Report%MdotFuel = MicroCHP(Num)%A42Model%MdotFuel ! fuel flow in kg/sec
MicroCHP(Num)%Report%FuelCompressPower = FuelSupply(MicroCHP(Num)%FuelSupplyID)%PfuelCompEl
! electrical power used by fuel supply compressor [W]
MicroCHP(Num)%Report%FuelCompressEnergy = FuelSupply(MicroCHP(Num)%FuelSupplyID)%PfuelCompEl*TimeStepSys*SecInHour ! elect energy
MicroCHP(Num)%Report%FuelCompressSkinLoss = FuelSupply(MicroCHP(Num)%FuelSupplyID)%QskinLoss
!heat rate of losses.by fuel supply compressor [W]
MicroCHP(Num)%Report%FuelEnergyHHV = MicroCHP(Num)%A42Model%NdotFuel * FuelSupply(MicroCHP(Num)%FuelSupplyID)%HHV &
* FuelSupply(MicroCHP(Num)%FuelSupplyID)%KmolPerSecToKgPerSec *TimeStepSys*SecInHour
! reporting: Fuel Energy used (W)
MicroCHP(Num)%Report%FuelEnergyUseRateHHV = MicroCHP(Num)%A42Model%NdotFuel * FuelSupply(MicroCHP(Num)%FuelSupplyID)%HHV &
* FuelSupply(MicroCHP(Num)%FuelSupplyID)%KmolPerSecToKgPerSec
! reporting: Fuel Energy used (J)
MicroCHP(Num)%Report%FuelEnergyLHV = MicroCHP(Num)%A42Model%NdotFuel * FuelSupply(MicroCHP(Num)%FuelSupplyID)%LHV &
* 1000000.0d0 *TimeStepSys*SecInHour
! reporting: Fuel Energy used (W)
MicroCHP(Num)%Report%FuelEnergyUseRateLHV = MicroCHP(Num)%A42Model%NdotFuel * FuelSupply(MicroCHP(Num)%FuelSupplyID)%LHV &
* 1000000.0d0
MicroCHP(Num)%Report%SkinLossPower = MicroCHP(Num)%A42Model%QdotconvZone + MicroCHP(Num)%A42Model%QdotRadZone
MicroCHP(Num)%Report%SkinLossEnergy = (MicroCHP(Num)%A42Model%QdotConvZone + &
MicroCHP(Num)%A42Model%QdotRadZone)*TimeStepSys*SecInHour
MicroCHP(Num)%Report%SkinLossConvect = MicroCHP(Num)%A42Model%QdotConvZone
MicroCHP(Num)%Report%SkinLossRadiat = MicroCHP(Num)%A42Model%QdotRadZone
! update node data for air inlet (and outlet)
IF (MicroCHP(Num)%AirInletNodeId > 0) THEN
Node(MicroCHP(Num)%AirInletNodeId)%MassFlowRate = MicroCHP(Num)%Report%MdotAir
ENDIF
IF (MicroCHP(Num)%AirOutletNodeID > 0) THEN
Node(MicroCHP(Num)%AirOutletNodeID)%MassFlowRate = MicroCHP(Num)%Report%MdotAir
Node(MicroCHP(Num)%AirOutletNodeID)%Temp = MicroCHP(Num)%A42Model%Teng
ENDIF
RETURN
END SUBROUTINE UpdateMicroCHPGeneratorRecords