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.
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 GetMicroCHPGeneratorInput
! SUBROUTINE INFORMATION:
! AUTHOR: Brent Griffith
! DATE WRITTEN: July 2005
! PURPOSE OF THIS SUBROUTINE:
! This routine will get the input
! required by the Micro CHP Generator models.
! METHODOLOGY EMPLOYED:
! EnergyPlus input processor
! REFERENCES: na
! USE STATEMENTS:
USE DataGenerators
USE InputProcessor, ONLY : GetNumObjectsFound, GetObjectItem, VerifyName, FindItemInList, SameString
USE DataIPShortCuts ! Data for field names, blank numerics
USE CurveManager, ONLY : GetCurveCheck, CurveValue
USE NodeInputManager, ONLY: GetOnlySingleNode
USE BranchNodeConnections, ONLY: TestCompSet
USE DataHeatBalance, ONLY: Zone, IntGainTypeOf_GeneratorMicroCHP
USE ScheduleManager, ONLY: GetScheduleIndex
USE General, ONLY: RoundSigDigits
USE GeneratorFuelSupply
USE GeneratorDynamicsManager
IMPLICIT NONE !
INTEGER :: GeneratorNum !Generator counter
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNums ! Number of elements in the numeric array
INTEGER :: IOStat ! IO Status when calling get input subroutine
CHARACTER(len=MaxNameLength),DIMENSION(25) :: AlphArray !character string data
REAL(r64), DIMENSION(200) :: NumArray !numeric data TODO deal with allocatable for extensible
LOGICAL, SAVE :: ErrorsFound=.false. ! error flag
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
! INTEGER :: thisMicroCHP !temporary index
! INTEGER :: otherMicroCHP !loop counter and temporary indexer
! INTEGER :: I ! loop counter
Logical, SAve :: myonetimeFlag = .true.
INTEGER :: CHPParamNum ! loop count and temporary index
CHARACTER(len = 100) :: ObjMSGName ! string for error messages
INTEGER :: thisParamID
! execution
If (myonetimeflag) then
! call to Fuel supply module to set up data there.
CALL GetGeneratorFuelSupplyInput
! First get the Micro CHP Parameters so they can be nested in structure later
cCurrentModuleObject = 'Generator:MicroCHP:NonNormalizedParameters'
NumMicroCHPParams = GetNumObjectsFound(cCurrentModuleObject)
IF (NumMicroCHPParams <= 0) THEN
CALL ShowSevereError('No '//TRIM(cCurrentModuleObject)//' equipment specified in input file')
ErrorsFound=.true.
ENDIF
Allocate(MicroCHPParamInput(NumMicroCHPParams))
Allocate(CheckEquipName(NumMicroCHPParams))
CheckEquipName=.true.
DO CHPParamNum = 1 , NumMicroCHPParams
CALL GetObjectItem(cCurrentModuleObject,CHPParamNum,AlphArray,NumAlphas, &
NumArray,NumNums,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks, AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
! Can't validate this name.
! IsNotOK=.false.
! IsBlank=.false.
! CALL VerifyName(AlphArray(1),MicroCHP%Name,CHPParamNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject))
! IF (IsNotOK) THEN
! ErrorsFound=.true.
! IF (IsBlank) AlphArray(1)='xxxxx'
! ENDIF
ObjMSGName = TRIM(cCurrentModuleObject)//' Named ' // TRIM(AlphArray(1))
MicroCHPParamInput(CHPParamNum)%Name = AlphArray(1) !A1 name
MicroCHPParamInput(CHPParamNum)%MaxElecPower = NumArray(1) !N1 Maximum Electric Power [W]
MicroCHPParamInput(CHPParamNum)%MinElecPower = NumArray(2) !N2 Minimum Electric Power [W]
MicroCHPParamInput(CHPParamNum)%MinWaterMdot = NumArray(3) !N3 Minimum Cooling Water Flow Rate [kg/s]
MicroCHPParamInput(CHPParamNum)%MaxWaterTemp = NumArray(4) !N3 Maximum Cooling Water Inlet Temp [C]
MicroCHPParamInput(CHPParamNum)%ElecEffCurveID = GetCurveCheck(AlphArray(2), ErrorsFound,ObjMSGName ) !Electrical Eff. ID
MicroCHPParamInput(CHPParamNum)%ThermalEffCurveID= GetCurveCheck(AlphArray(3), ErrorsFound,ObjMSGName) !Thermal Efficiency
IF (SameString(AlphArray(4), 'InternalControl')) THEN
MicroCHPParamInput(CHPParamNum)%InternalFlowControl = .TRUE. ! A4, \field Cooling Water Flow Rate Mode
MicroCHPParamInput(CHPParamNum)%PlantFlowControl = .false.
ENDIF
IF ( (.NOT. (SameString(AlphArray(4), 'InternalControl'))) .AND. ( .NOT. (SameSTring(AlphArray(4), 'PlantControl'))) ) THEN
CALL ShowSevereError('Invalid, '//TRIM(cAlphaFieldNames(4))//' = '//TRIM(AlphArray(4)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound = .TRUE.
ENDIF
If (MicroCHPParamInput(CHPParamNum)%InternalFlowControl) Then ! get the curve
MicroCHPParamInput(CHPParamNum)%WaterFlowCurveID = GetCurveCheck(AlphArray(5), ErrorsFound, ObjMSGName )
! Curve for Cooling Water Flow Rate
ENDIF
MicroCHPParamInput(CHPParamNum)%AirFlowCurveID = GetCurveCheck(AlphArray(6), Errorsfound, ObjMSGName)
! Name of Curve for Air Flow Rate
MicroCHPParamInput(CHPParamNum)%DeltaPelMax = NumArray(5) ! N5 Maximum rate of change in net electrical power [W/s]
MicroCHPParamInput(CHPParamNum)%DeltaFuelMdotMax = NumArray(6) !N6 Maximum Rate of change in fuel flow rate [kg/s2]
MicroCHPParamInput(CHPParamNum)%UAhx = NumArray(7) ! N7 Heat Exchanger UA_hx
MicroCHPParamInput(CHPParamNum)%UAskin = NumArray(8) !N8 Skin Loss UA_loss
MicroCHPParamInput(CHPParamNum)%RadiativeFraction = NumArray(9) !N9 radiative fraction for skin losses
MicroCHPParamInput(CHPParamNum)%MCeng = NumArray(10) ! N10 Aggregated Thermal Mass of Generator MC_eng
IF (MicroCHPParamInput(CHPParamNum)%MCeng <= 0.d0) THEN
CALL ShowSevereError('Invalid, '//TRIM(cNumericFieldNames(10))//' = '//TRIM(RoundSigDigits(NumArray(10), 5)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Thermal mass must be greater than zero')
ErrorsFound = .TRUE.
ENDIF
MicroCHPParamInput(CHPParamNum)%MCcw = NumArray(11) ! Aggregated Thermal Mass of Heat Recovery MC_cw
IF (MicroCHPParamInput(CHPParamNum)%MCcw <= 0.d0) THEN
CALL ShowSevereError('Invalid, '//TRIM(cNumericFieldNames(11))//' = '//TRIM(RoundSigDigits(NumArray(11), 5)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Thermal mass must be greater than zero')
ErrorsFound = .TRUE.
ENDIF
MicroCHPParamInput(CHPParamNum)%Pstandby = NumArray(12) ! N12 Standby Power [W]
IF (SameString(AlphArray(7), 'TimeDelay')) THEN
MicroCHPParamInput(CHPParamNum)%WarmUpByTimeDelay = .TRUE. !
MicroCHPParamInput(CHPParamNum)%WarmUpByEngineTemp = .false.
ENDIF
IF ( (.NOT. (SameString(AlphArray(7), 'NominalEngineTemperature'))) &
.AND. ( .NOT. (SameSTring(AlphArray(7), 'TimeDelay'))) ) THEN
CALL ShowSevereError('Invalid, '//TRIM(cAlphaFieldNames(7))//' = '//TRIM(AlphArray(7)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound = .TRUE.
ENDIF
MicroCHPParamInput(CHPParamNum)%kf = NumArray(13) ! N13 Warmup Fuel Flow Rate Coefficient k_f
MicroCHPParamInput(CHPParamNum)%TnomEngOp = NumArray(14) ! N14 Nominal Engine Operating Temperature [C]
MicroCHPParamInput(CHPParamNum)%kp = NumArray(15) ! N15 Warmup Power Coefficient k_p
MicroCHPParamInput(CHPParamNum)%Rfuelwarmup = NumArray(16) ! N16 Warm Up Fuel Flow Rate Limit Ratio
MicroCHPParamInput(CHPParamNum)%WarmUpDelay = NumArray(17) ! N17 Warm Up Delay Time
MicroCHPParamInput(CHPParamNum)%PcoolDown = NumArray(18) ! N18 Cool Down Power
MicroCHPParamInput(CHPParamNum)%CoolDownDelay = NumArray(19) ! N19 Cool Down Delay Time in seconds
IF (SameString(AlphArray(8), 'MandatoryCoolDown')) THEN
MicroCHPParamInput(CHPParamNum)%MandatoryFullCoolDown = .TRUE.
MicroCHPParamInput(CHPParamNum)%WarmRestartOkay = .false.
ENDIF
IF ( (.NOT. (SameString(AlphArray(8), 'MandatoryCoolDown'))) &
.AND. ( .NOT. (SameSTring(AlphArray(8), 'OptionalCoolDown'))) ) THEN
CALL ShowSevereError('Invalid, '//TRIM(cAlphaFieldNames(8))//' = '//TRIM(AlphArray(8)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound = .TRUE.
ENDIF
ENDDO
cCurrentModuleObject = 'Generator:MicroCHP'
NumMicroCHPs = GetNumObjectsFound(cCurrentModuleObject)
IF (NumMicroCHPs <= 0) THEN
! shouldn't ever come here?
CALL ShowSevereError('No '//TRIM(cCurrentModuleObject)//' equipment specified in input file')
ErrorsFound=.true.
ENDIF
!ALLOCATE ARRAYS
IF (.not.(ALLOCATED(MicroCHP))) Then
ALLOCATE (MicroCHP( NumMicroCHPs )) ! inits handeled in derived type definitions
ENDIF
! load in Micro CHPs
DO GeneratorNum = 1 , NumMicroCHPs
CALL GetObjectItem(cCurrentModuleObject,GeneratorNum,AlphArray,NumAlphas, &
NumArray,NumNums,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks, AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(AlphArray(1),MicroCHP%Name,GeneratorNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) AlphArray(1)='xxxxx'
ENDIF
!GENERATOR:MICRO CHP,
MicroCHP(GeneratorNum)%Name = AlphArray(1) ! A1 Generator name
ObjMSGName = TRIM(cCurrentModuleObject)//' Named ' // TRIM(alphArray(1))
MicroCHP(GeneratorNum)%ParamObjName = AlphArray(2) ! A2 Micro CHP Parameter Object Name
!find input structure
thisParamID = FindItemInList(AlphArray(2), MicroCHPParamInput%Name, NumMicroCHPParams)
IF (thisParamID /= 0) THEN
MicroCHP(GeneratorNum)%A42Model = MicroCHPParamInput(thisParamID) ! entire structure of input data assigned here!
ELSE
CALL ShowSevereError('Invalid, '//TRIM(cAlphaFieldNames(2))//' = '//TRIM(AlphArray(2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound = .true.
ENDIF
IF (.NOT. lAlphaFieldBlanks(3) ) THEN
MicroCHP(GeneratorNum)%ZoneName = AlphArray(3) ! A3 Zone Name
MicroCHP(GeneratorNum)%ZoneID = FindItemInList(MicroCHP(GeneratorNum)%ZoneName, Zone%Name, NumOfZones)
IF (MicroCHP(GeneratorNum)%ZoneID == 0 ) THEN
CALL ShowSevereError('Invalid, '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(AlphArray(3)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound = .true.
ENDIF
ELSE
MicroCHP(GeneratorNum)%ZoneID = 0
ENDIF
MicroCHP(GeneratorNum)%PlantInletNodeName = AlphArray(4) ! A4 Cooling Water Inlet Node Name
MicroCHP(GeneratorNum)%PlantOutletNodeName = AlphArray(5) ! A5 Cooling Water Outlet Node Name
!find node ids for water path
MicroCHP(GeneratorNum)%PlantInletNodeID = &
GetOnlySingleNode(AlphArray(4),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Water,NodeConnectionType_Inlet,1,ObjectIsNotParent )
MicroCHP(GeneratorNum)%PlantOutletNodeID = &
GetOnlySingleNode(AlphArray(5),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Water,NodeConnectionType_Outlet,1,ObjectIsNotParent )
CALL TestCompSet(TRIM(cCurrentModuleObject),AlphArray(1),AlphArray(4),AlphArray(5), &
'Heat Recovery Nodes')
MicroCHP(GeneratorNum)%AirInletNodeName = AlphArray(6) ! A6 Air Inlet Node Name
! check the node connections
MicroCHP(GeneratorNum)%AirInletNodeId = &
GetOnlySingleNode(AlphArray(6),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_Inlet,2,ObjectIsNotParent)
MicroCHP(GeneratorNum)%AirOutletNodeName = AlphArray(7) ! A7 Air Outlet Node Name
MicroCHP(GeneratorNum)%AirOutletNodeId = &
GetOnlySingleNode(AlphArray(7),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_Outlet,2,ObjectIsNotParent)
MicroCHP(GeneratorNum)%FuelSupplyID = FindItemInList(AlphArray(8), FuelSupply%name,NumGeneratorFuelSups) ! Fuel Supply ID
IF (MicroCHP(GeneratorNum)%FuelSupplyID == 0) THEN
CALL ShowSevereError('Invalid, '//TRIM(cAlphaFieldNames(8))//' = '//TRIM(AlphArray(8)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound = .true.
ENDIF
IF (lAlphaFieldBlanks(9)) THEN
MicroCHP(GeneratorNum)%AvailabilitySchedID = ScheduleAlwaysOn
ELSE
MicroCHP(GeneratorNum)%AvailabilitySchedID = GetScheduleIndex(AlphArray(9))
IF ( MicroCHP(GeneratorNum)%AvailabilitySchedID == 0) THEN
CALL ShowSevereError('Invalid, '//TRIM(cAlphaFieldNames(9))//' = '//TRIM(AlphArray(9)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound = .true.
ENDIF
ENDIF
MicroCHP(GeneratorNum)%A42Model%TengLast = 20.0D0 ! inits
MicroCHP(GeneratorNum)%A42Model%TempCWOutLast = 20.0D0 ! inits
ENDDO
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing input for '//TRIM(cCurrentModuleObject))
ENDIF
!setup report variables
DO GeneratorNum = 1, NumMicroCHPs
CALL SetupOutputVariable('Generator Off Mode Time [s]', &
MicroCHP(GeneratorNum)%Report%OffModeTime, 'System', 'Sum', MicroCHP(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Standby Mode Time [s]', &
MicroCHP(GeneratorNum)%Report%StandyByModeTime, 'System', 'Sum', MicroCHP(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Warm Up Mode Time [s]', &
MicroCHP(GeneratorNum)%Report%WarmUpModeTime, 'System', 'Sum', MicroCHP(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Normal Operating Mode Time [s]', &
MicroCHP(GeneratorNum)%Report%NormalModeTime, 'System', 'Sum', MicroCHP(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Cool Down Mode Time [s]', &
MicroCHP(GeneratorNum)%Report%CoolDownModeTime, 'System', 'Sum', MicroCHP(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Produced Electric Power [W]', &
MicroCHP(GeneratorNum)%Report%ACPowerGen,'System','Average',MicroCHP(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Produced Electric Energy [J]', &
MicroCHP(GeneratorNum)%Report%ACEnergyGen,'System','Sum',MicroCHP(GeneratorNum)%Name, &
ResourceTypeKey='ElectricityProduced',EndUseKey='COGENERATION',GroupKey='Plant')
CALL SetupOutputVariable('Generator Produced Thermal Rate [W]', & !
MicroCHP(GeneratorNum)%report%QdotHR, 'system', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Produced Thermal Energy [J]', & !
MicroCHP(GeneratorNum)%report%TotalHeatEnergyRec, 'system', 'Sum', MicroCHP(GeneratorNum)%Name , &
ResourceTypeKey='ENERGYTRANSFER' , EndUseKey='COGENERATION',GroupKey='Plant')
CALL SetupOutputVariable('Generator Electric Efficiency []', &
MicroCHP(GeneratorNum)%Report%ElectEfficiency, 'System', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Thermal Efficiency []', &
MicroCHP(GeneratorNum)%Report%ThermalEfficiency, 'System', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Gross Input Heat Rate [W]', & !
MicroCHP(GeneratorNum)%report%QdotGross, 'system', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Steady State Engine Heat Generation Rate [W]', & !
MicroCHP(GeneratorNum)%report%Qgenss, 'system', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Engine Heat Exchange Rate [W]', & !
MicroCHP(GeneratorNum)%report%QdotHX, 'system', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Air Mass Flow Rate [kg/s]', &
MicroCHP(GeneratorNum)%Report%MdotAir, 'System', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Fuel Molar Flow Rate [kmol/s]' , &
MicroCHP(GeneratorNum)%Report%NdotFuel, 'System', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Fuel Mass Flow Rate [kg/s]' , &
MicroCHP(GeneratorNum)%Report%MdotFuel, 'System', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Engine Temperature [C]' , &
MicroCHP(GeneratorNum)%Report%Tengine, 'System', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Coolant Inlet Temperature [C]' , &
MicroCHP(GeneratorNum)%Report%HeatRecInletTemp, 'System', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Coolant Outlet Temperature [C]' , &
MicroCHP(GeneratorNum)%Report%HeatRecOutletTemp, 'System', 'Average', MicroCHP(GeneratorNum)%Name )
! this next one needs to be reconciled with non-gas fuel constituents.
! need custom resourceTypeKey or something for user defined fuel compositions.
CALL SetupOutputVariable('Generator Fuel HHV Basis Energy [J]' , &
MicroCHP(GeneratorNum)%Report%FuelEnergyHHV, 'System', 'Sum', MicroCHP(GeneratorNum)%Name , &
ResourceTypeKey='Gas' , EndUseKey='COGENERATION', GroupKey='Plant')
CALL SetupOutputVariable('Generator Fuel HHV Basis Rate [W]' , &
MicroCHP(GeneratorNum)%Report%FuelEnergyUseRateHHV, 'System', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Fuel LHV Basis Energy [J]' , &
MicroCHP(GeneratorNum)%Report%FuelEnergyLHV, 'System', 'Sum', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Fuel LHV Basis Rate [W]' , &
MicroCHP(GeneratorNum)%Report%FuelEnergyUseRateLHV, 'System', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Fuel Compressor Electric Power [W]' , &
MicroCHP(GeneratorNum)%Report%FuelCompressPower, 'System', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Fuel Compressor Electric Energy [J]', &
MicroCHP(GeneratorNum)%Report%FuelCompressEnergy, 'System', 'Sum', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Fuel Compressor Skin Heat Loss Rate [W]' , &
MicroCHP(GeneratorNum)%Report%FuelCompressSkinLoss, 'System', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Zone Sensible Heat Transfer Rate [W]' , &
MicroCHP(GeneratorNum)%Report%SkinLossPower, 'System', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Zone Sensible Heat Transfer Energy [J]' , &
MicroCHP(GeneratorNum)%Report%SkinLossEnergy, 'System', 'Sum', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Zone Convection Heat Transfer Rate [W]' , &
MicroCHP(GeneratorNum)%Report%SkinLossConvect, 'System', 'Average', MicroCHP(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator Zone Radiation Heat Transfer Rate [W]' , &
MicroCHP(GeneratorNum)%Report%SkinLossRadiat, 'System', 'Average', MicroCHP(GeneratorNum)%Name )
IF (MicroCHP(GeneratorNum)%ZoneID > 0) THEN
CALL SetupZoneInternalGain(MicroCHP(GeneratorNum)%ZoneID, &
'Generator:MicroCHP', &
MicroCHP(GeneratorNum)%Name, &
IntGainTypeOf_GeneratorMicroCHP, &
ConvectionGainRate = MicroCHP(GeneratorNum)%Report%SkinLossConvect, &
ThermalRadiationGainRate = MicroCHP(GeneratorNum)%Report%SkinLossRadiat)
ENDIF
END DO
myonetimeflag = .false.
ENDIF
RETURN
END SUBROUTINE GetMicroCHPGeneratorInput