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 | ||
---|---|---|---|---|---|---|
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 UpdateFuelCellGeneratorRecords(RunFlag, Num)
! SUBROUTINE INFORMATION:
! AUTHOR: BG
! DATE WRITTEN:
! PURPOSE OF THIS SUBROUTINE:
! reporting
! METHODOLOGY EMPLOYED: na
! REFERENCES: na
! USE STATEMENTS: na
USE DataHVACGlobals, ONLY: TimeStepSys
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(IN) :: RunFlag ! TRUE if Generator operating
INTEGER, INTENT(IN) :: Num ! Generator number
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
FuelCell(Num)%Report%ACPowerGen = FuelCell(Num)%ACPowerGen !electrical power produced [W]
FuelCell(Num)%Report%ACEnergyGen = FuelCell(Num)%ACPowerGen*TimeStepSys*SecInHour ! energy produced (J)
FuelCell(Num)%Report%QdotExhaust = 0.0d0 ! reporting: exhaust gas heat recovered (W)
FuelCell(Num)%Report%TotalHeatEnergyRec = 0.0d0 ! reporting: total heat recovered (J)
FuelCell(Num)%Report%ExhaustEnergyRec = 0.0d0 ! reporting: exhaust gas heat recovered (J)
FuelCell(Num)%Report%HeatRecInletTemp = 0.0d0 ! reporting: Heat Recovery Loop Inlet Temperature (C)
FuelCell(Num)%Report%HeatRecOutletTemp = 0.0d0 ! reporting: Heat Recovery Loop Outlet Temperature (C)
FuelCell(Num)%Report%HeatRecMdot = 0.0d0 ! reporting: Heat Recovery Loop Mass flow rate (kg/s)
FuelCell(Num)%Report%ElectEfficiency = 0.0d0
FuelCell(Num)%Report%ThermalEfficiency = 0.0d0
FuelCell(Num)%Report%OverallEfficiency = 0.0d0
FuelCell(Num)%Report%ExergyEfficiency = 0.0d0
FuelCell(Num)%Report%TairInlet = FuelCell(Num)%AirSup%TairIntoBlower ! State point 1
FuelCell(Num)%Report%TairIntoFCPM = FuelCell(Num)%AirSup%TairIntoFCPM ! State point 4
FuelCell(Num)%Report%NdotAir = FuelCell(Num)%FCPM%NdotAir ! air flow in kmol/sec
FuelCell(Num)%Report%TotAirInEnthalphy = FuelCell(Num)%FCPM%TotAirInEnthalphy ! State point 4
FuelCell(Num)%Report%BlowerPower = FuelCell(Num)%AirSup%PairCompEl ! electrical power used by air supply blower
FuelCell(Num)%Report%BlowerEnergy = FuelCell(Num)%AirSup%PairCompEl*TimeStepSys*SecInHour ! electrical energy
FuelCell(Num)%Report%BlowerSkinLoss = FuelCell(Num)%AirSup%QskinLoss ! heat rate of losses by blower
FuelCell(Num)%Report%TfuelInlet = FuelSupply(FuelCell(Num)%FuelSupNum)%TfuelIntoCompress ! State point 2
FuelCell(Num)%Report%TfuelIntoFCPM = FuelSupply(FuelCell(Num)%FuelSupNum)%TfuelIntoFCPM ! TEmperature state point 5 [C]
FuelCell(Num)%Report%NdotFuel = FuelCell(Num)%FCPM%NdotFuel ! fuel flow in kmol/sec
FuelCell(Num)%Report%TotFuelInEnthalpy = FuelCell(Num)%FCPM%TotFuelInEnthalphy ! enthalpy at state point 5 [W]
FuelCell(Num)%Report%FuelCompressPower = FuelSupply(FuelCell(Num)%FuelSupNum)%PfuelCompEl
! electrical power used by fuel supply compressor [W]
FuelCell(Num)%Report%FuelCompressEnergy = FuelSupply(FuelCell(Num)%FuelSupNum)%PfuelCompEl*TimeStepSys*SecInHour ! elect energy
FuelCell(Num)%Report%FuelCompressSkinLoss = FuelSupply(FuelCell(Num)%FuelSupNum)%QskinLoss
!heat rate of losses.by fuel supply compressor [W]
FuelCell(Num)%Report%FuelEnergyLHV = FuelCell(Num)%FCPM%NdotFuel * FuelSupply(FuelCell(Num)%FuelSupNum)%LHV &
* 1000000.0d0 *TimeStepSys*SecInHour ! reporting: Fuel Energy used (J)
FuelCell(Num)%Report%FuelEnergyUseRateLHV = FuelCell(Num)%FCPM%NdotFuel * FuelSupply(FuelCell(Num)%FuelSupNum)%LHV &
* 1000000.0d0 ! reporting: Fuel Energy used (W)
FuelCell(Num)%Report%FuelEnergyHHV = FuelCell(Num)%FCPM%NdotFuel * FuelSupply(FuelCell(Num)%FuelSupNum)%HHV &
* FuelSupply(FuelCell(Num)%FuelSupNum)%KmolPerSecToKgPerSec*TimeStepSys*SecInHour
FuelCell(Num)%Report%FuelEnergyUseRateHHV = FuelCell(Num)%FCPM%NdotFuel * FuelSupply(FuelCell(Num)%FuelSupNum)%HHV &
* FuelSupply(FuelCell(Num)%FuelSupNum)%KmolPerSecToKgPerSec
FuelCell(Num)%Report%FuelRateMdot = 0.0d0 ! (Kg/s)
FuelCell(Num)%Report%TwaterInlet = FuelCell(Num)%WaterSup%TwaterIntoCompress
FuelCell(Num)%Report%TwaterIntoFCPM = FuelCell(Num)%WaterSup%TwaterIntoFCPM
FuelCell(Num)%Report%NdotWater = FuelCell(Num)%FCPM%NdotLiqwater ! water flow in kmol/sec (reformer water)
FuelCell(Num)%Report%WaterPumpPower = FuelCell(Num)%WaterSup%PwaterCompEl
FuelCell(Num)%Report%WaterPumpEnergy = FuelCell(Num)%WaterSup%PwaterCompEl*TimeStepSys*SecInHour ! electrical energy
FuelCell(Num)%Report%WaterIntoFCPMEnthalpy = FuelCell(Num)%FCPM%WaterInEnthalpy
FuelCell(Num)%Report%TprodGas = FuelCell(Num)%FCPM%TprodGasLeavingFCPM ! temperature at State point 7
FuelCell(Num)%Report%EnthalProdGas = FuelCell(Num)%FCPM%TotProdGasEnthalphy ! enthalpy at State point 7
FuelCell(Num)%Report%NdotProdGas = FuelCell(Num)%FCPM%NdotProdGas ! flow rate at point 7 [kmol/sec]
FuelCell(Num)%Report%NdotProdAr = FuelCell(Num)%FCPM%ConstitMolalFract(5) * FuelCell(Num)%FCPM%NdotProdGas
FuelCell(Num)%Report%NdotProdCO2 = FuelCell(Num)%FCPM%ConstitMolalFract(1) * FuelCell(Num)%FCPM%NdotProdGas
FuelCell(Num)%Report%NdotProdH2O = FuelCell(Num)%FCPM%ConstitMolalFract(4) * FuelCell(Num)%FCPM%NdotProdGas
FuelCell(Num)%Report%NdotProdN2 = FuelCell(Num)%FCPM%ConstitMolalFract(2) * FuelCell(Num)%FCPM%NdotProdGas
FuelCell(Num)%Report%NdotProdO2 = FuelCell(Num)%FCPM%ConstitMolalFract(3) * FuelCell(Num)%FCPM%NdotProdGas
FuelCell(Num)%Report%qHX = FuelCell(Num)%ExhaustHX%qHX
FuelCell(Num)%Report%HXenergy = FuelCell(Num)%ExhaustHX%qHX*TimeStepSys*SecInHour
FuelCell(Num)%Report%THXexh = FuelCell(Num)%ExhaustHX%THXexh
FuelCell(Num)%Report%WaterVaporFractExh = FuelCell(Num)%ExhaustHX%WaterVaporFractExh
FuelCell(Num)%Report%CondensateRate = FuelCell(Num)%ExhaustHX%CondensateRate
FuelCell(Num)%Report%SeqSubstIterations = FuelCell(Num)%FCPM%SeqSubstitIter ! number of iterations in FuelCell loop
FuelCell(Num)%Report%RegulaFalsiIterations = FuelCell(Num)%FCPM%RegulaFalsiIter ! number of iterations in Tproduct gas solving
FuelCell(Num)%Report%ACancillariesPower = FuelCell(Num)%FCPM%PelancillariesAC
FuelCell(Num)%Report%ACancillariesEnergy = FuelCell(Num)%FCPM%PelancillariesAC*TimeStepSys*SecInHour
FuelCell(Num)%Report%PCULosses = FuelCell(Num)%Inverter%PCUlosses ! inverter losses
FuelCell(Num)%Report%DCPowerGen = FuelCell(Num)%FCPM%Pel !DC power out of FCPM.
FuelCell(Num)%Report%DCPowerEff = FuelCell(Num)%FCPM%Eel ! FCPM efficienty Eel.
FuelCell(Num)%Report%ElectEnergyinStorage = FuelCell(Num)%ElecStorage%ThisTimeStepStateOfCharge
FuelCell(Num)%Report%StoredPower = FuelCell(Num)%ElecStorage%PelIntoStorage
FuelCell(Num)%Report%StoredEnergy = FuelCell(Num)%ElecStorage%PelIntoStorage*TimeStepSys*SecInHour
FuelCell(Num)%Report%DrawnPower = FuelCell(Num)%ElecStorage%PelFromStorage
FuelCell(Num)%Report%DrawnEnergy = FuelCell(Num)%ElecStorage%PelFromStorage*TimeStepSys*SecInHour
FuelCell(Num)%Report%SkinLossPower = FuelCell(Num)%QconvZone + FuelCell(Num)%QradZone
FuelCell(Num)%Report%SkinLossEnergy = (FuelCell(Num)%QconvZone + FuelCell(Num)%QradZone)*TimeStepSys*SecInHour
FuelCell(Num)%Report%SkinLossConvect = FuelCell(Num)%QconvZone
FuelCell(Num)%Report%SkinLossRadiat = FuelCell(Num)%QradZone
RETURN
END SUBROUTINE UpdateFuelCellGeneratorRecords