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 GetSimpleWatertoAirHPInput
! SUBROUTINE INFORMATION:
! AUTHOR Arun Shenoy
! DATE WRITTEN Nov 2003
! MODIFIED na
! RE-ENGINEERED Kenneth Tang (Jan 2005)
! PURPOSE OF THIS SUBROUTINE:
! Obtains input data for HPs and stores it in HP data structures
! METHODOLOGY EMPLOYED:
! Uses "Get" routines to read in data.
! REFERENCES:
! (1) Lash.T.A.,1992.Simulation and Analysis of a Water loop Heat Pump System.
! M.S. Thesis, University of Illinois at Urbana Champaign.
! (2) Shenoy, Arun. 2004. Simulation, Modeling and Analysis of Water to Air Heat Pump.
! State Energy Simulation Program. M.S. Thesis, Department of Mechanical and Aerospace Engineering,
! Oklahoma State University. (downloadable from www.hvac.okstate.edu)
! (3) Tang,C.C.. 2005. Modeling Packaged Heat Pumps in a Quasi-Steady
! State Energy Simulation Program. M.S. Thesis, Department of Mechanical and Aerospace Engineering,
! Oklahoma State University. (downloadable from www.hvac.okstate.edu)
! USE STATEMENTS:
USE InputProcessor
USE NodeInputManager
USE BranchNodeConnections, ONLY: TestCompSet
USE GlobalNames, ONLY: VerifyUniqueCoilName
USE OutputReportPredefined
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER (len=*), PARAMETER :: RoutineName='GetSimpleWatertoAirHPInput: ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: HPNum ! The Water to Air HP that you are currently loading input into
INTEGER :: NumCool ! Counter for cooling coil
INTEGER :: NumHeat ! Counter for heating coil
INTEGER :: WatertoAirHPNum ! Counter
INTEGER :: NumAlphas ! Number of variables in String format
INTEGER :: NumNums ! Number of variables in Numeric format
INTEGER :: NumParams ! Total number of input fields
INTEGER :: MaxNums=0 ! Maximum number of numeric input fields
INTEGER :: MaxAlphas=0 ! Maximum number of alpha input fields
INTEGER :: IOSTAT
LOGICAL :: ErrorsFound = .FALSE. ! If errors detected in input
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: errflag
CHARACTER (len=MaxNameLength) :: CurrentModuleObject ! for ease in getting objects
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: AlphArray ! Alpha input items for object
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cAlphaFields ! Alpha field names
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cNumericFields ! Numeric field names
REAL(r64), ALLOCATABLE, DIMENSION(:) :: NumArray ! Numeric input items for object
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaBlanks ! Logical array, alpha field input BLANK = .true.
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericBlanks ! Logical array, numeric field input BLANK = .true.
NumCool = GetNumObjectsFound('Coil:Cooling:WaterToAirHeatPump:EquationFit')
NumHeat = GetNumObjectsFound('Coil:Heating:WaterToAirHeatPump:EquationFit')
NumWatertoAirHPs = NumCool+NumHeat
HPNum=0
IF(NumWatertoAirHPs <= 0) THEN
CALL ShowSevereError('No Equipment found in SimWatertoAirHPSimple')
ErrorsFound=.TRUE.
END IF
! Allocate Arrays
IF (NumWatertoAirHPs.GT.0) THEN
ALLOCATE(SimpleWatertoAirHP(NumWatertoAirHPs))
ALLOCATE(SimpleHPTimeStepFlag(NumWatertoAirHPs))
SimpleHPTimeStepFlag = .TRUE.
ENDIF
CALL GetObjectDefMaxArgs('Coil:Cooling:WaterToAirHeatPump:EquationFit',NumParams,NumAlphas,NumNums)
MaxNums=MAX(MaxNums,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('Coil:Heating:WaterToAirHeatPump:EquationFit',NumParams,NumAlphas,NumNums)
MaxNums=MAX(MaxNums,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
ALLOCATE(AlphArray(MaxAlphas))
AlphArray=' '
ALLOCATE(cAlphaFields(MaxAlphas))
cAlphaFields=' '
ALLOCATE(lAlphaBlanks(MaxAlphas))
lAlphaBlanks=.TRUE.
ALLOCATE(cNumericFields(MaxNums))
cNumericFields=' '
ALLOCATE(lNumericBlanks(MaxNums))
lNumericBlanks=.TRUE.
ALLOCATE(NumArray(MaxNums))
NumArray=0.0d0
! Get the data for cooling coil
CurrentModuleObject = 'Coil:Cooling:WaterToAirHeatPump:EquationFit'
DO WatertoAirHPNum = 1, NumCool
HPNum= HPNum + 1
CALL GetObjectItem(CurrentModuleObject,HPNum,AlphArray,NumAlphas, &
NumArray,NumNums,IOSTAT, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(AlphArray(1),SimpleWatertoAirHP%Name,HPNum-1, ISNotOK,ISBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.TRUE.
IF (IsBlank) AlphArray(1)='xxxxx'
ENDIF
CALL VerifyUniqueCoilName(CurrentModuleObject,AlphArray(1),errflag,TRIM(CurrentModuleObject)//' Name')
IF (errflag) THEN
ErrorsFound=.true.
ENDIF
SimpleWatertoAirHP(HPNum)%Name = TRIM(AlphArray(1))
SimpleWatertoAirHP(HPNum)%WatertoAirHPType = 'COOLING'
SimpleWatertoAirHP(HPNum)%WAHPPlantTypeOfNum = TypeOf_CoilWAHPCoolingEquationFit
SimpleWatertoAirHP(HPNum)%RatedAirVolFlowRate = NumArray(1)
SimpleWatertoAirHP(HPNum)%RatedWaterVolFlowRate=NumArray(2)
SimpleWatertoAirHP(HPNum)%RatedCapCoolTotal=NumArray(3)
SimpleWatertoAirHP(HPNum)%RatedCapCoolSens=NumArray(4)
SimpleWatertoAirHP(HPNum)%RatedCOPCool=NumArray(5)
SimpleWatertoAirHP(HPNum)%TotalCoolCap1=NumArray(6)
SimpleWatertoAirHP(HPNum)%TotalCoolCap2=NumArray(7)
SimpleWatertoAirHP(HPNum)%TotalCoolCap3=NumArray(8)
SimpleWatertoAirHP(HPNum)%TotalCoolCap4=NumArray(9)
SimpleWatertoAirHP(HPNum)%TotalCoolCap5=NumArray(10)
SimpleWatertoAirHP(HPNum)%SensCoolCap1=NumArray(11)
SimpleWatertoAirHP(HPNum)%SensCoolCap2=NumArray(12)
SimpleWatertoAirHP(HPNum)%SensCoolCap3=NumArray(13)
SimpleWatertoAirHP(HPNum)%SensCoolCap4=NumArray(14)
SimpleWatertoAirHP(HPNum)%SensCoolCap5=NumArray(15)
SimpleWatertoAirHP(HPNum)%SensCoolCap6=NumArray(16)
SimpleWatertoAirHP(HPNum)%CoolPower1=NumArray(17)
SimpleWatertoAirHP(HPNum)%CoolPower2=NumArray(18)
SimpleWatertoAirHP(HPNum)%CoolPower3=NumArray(19)
SimpleWatertoAirHP(HPNum)%CoolPower4=NumArray(20)
SimpleWatertoAirHP(HPNum)%CoolPower5=NumArray(21)
SimpleWatertoAirHP(HPNum)%Twet_Rated=NumArray(22)
SimpleWatertoAirHP(HPNum)%Gamma_Rated=NumArray(23)
SimpleWatertoAirHP(HPNum)%WaterInletNodeNum = &
GetOnlySingleNode(AlphArray(2),ErrorsFound,TRIM(CurrentModuleObject),AlphArray(1), &
NodeType_Water,NodeConnectionType_Inlet,2,ObjectIsNotParent)
SimpleWatertoAirHP(HPNum)%WaterOutletNodeNum = &
GetOnlySingleNode(AlphArray(3),ErrorsFound,TRIM(CurrentModuleObject),AlphArray(1), &
NodeType_Water,NodeConnectionType_Outlet,2,ObjectIsNotParent)
SimpleWatertoAirHP(HPNum)%AirInletNodeNum = &
GetOnlySingleNode(AlphArray(4),ErrorsFound,TRIM(CurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
SimpleWatertoAirHP(HPNum)%AirOutletNodeNum = &
GetOnlySingleNode(AlphArray(5),ErrorsFound,TRIM(CurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
CALL TestCompSet(TRIM(CurrentModuleObject),AlphArray(1),AlphArray(2),AlphArray(3),'Water Nodes')
CALL TestCompSet(TRIM(CurrentModuleObject),AlphArray(1),AlphArray(4),AlphArray(5),'Air Nodes')
CALL SetupOutputVariable('Cooling Coil Electric Energy [J]', &
SimpleWatertoAirHP(HPNum)%Energy,'System','Summed',SimpleWatertoAirHP(HPNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='Cooling',GroupKey='System')
CALL SetupOutputVariable('Cooling Coil Total Cooling Energy [J]', &
SimpleWatertoAirHP(HPNum)%EnergyLoadTotal,'System','Summed',SimpleWatertoAirHP(HPNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='COOLINGCOILS',GroupKey='System')
CALL SetupOutputVariable('Cooling Coil Sensible Cooling Energy [J]', &
SimpleWatertoAirHP(HPNum)%EnergySensible,'System','Summed',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Cooling Coil Latent Cooling Energy [J]', &
SimpleWatertoAirHP(HPNum)%EnergyLatent,'System','Summed',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Cooling Coil Source Side Heat Transfer Energy [J]', &
SimpleWatertoAirHP(HPNum)%EnergySource,'System','Summed',SimpleWatertoAirHP(HPNum)%Name, &
ResourceTypeKey='PLANTLOOPCOOLINGDEMAND',EndUseKey='COOLINGCOILS',GroupKey='System')
!create predefined report entries
CALL PreDefTableEntry(pdchCoolCoilType,SimpleWatertoAirHP(HPNum)%Name,CurrentModuleObject)
CALL PreDefTableEntry(pdchCoolCoilTotCap,SimpleWatertoAirHP(HPNum)%Name,SimpleWatertoAirHP(HPNum)%RatedCapCoolTotal)
CALL PreDefTableEntry(pdchCoolCoilSensCap,SimpleWatertoAirHP(HPNum)%Name,SimpleWatertoAirHP(HPNum)%RatedCapCoolSens)
CALL PreDefTableEntry(pdchCoolCoilLatCap,SimpleWatertoAirHP(HPNum)%Name,SimpleWatertoAirHP(HPNum)%RatedCapCoolTotal &
- SimpleWatertoAirHP(HPNum)%RatedCapCoolSens)
CALL PreDefTableEntry(pdchCoolCoilSHR,SimpleWatertoAirHP(HPNum)%Name,SimpleWatertoAirHP(HPNum)%RatedCapCoolSens &
/ SimpleWatertoAirHP(HPNum)%RatedCapCoolTotal)
CALL PreDefTableEntry(pdchCoolCoilNomEff,SimpleWatertoAirHP(HPNum)%Name,SimpleWatertoAirHP(HPNum)%RatedPowerCool &
/ SimpleWatertoAirHP(HPNum)%RatedCapCoolTotal)
END DO
! Get the data for heating coil
CurrentModuleObject = 'Coil:Heating:WaterToAirHeatPump:EquationFit'
DO WatertoAirHPNum = 1, NumHeat
HPNum= HPNum + 1
CALL GetObjectItem(CurrentModuleObject,WatertoAirHPNum,AlphArray,NumAlphas, &
NumArray,NumNums,IOSTAT, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(AlphArray(1),SimpleWatertoAirHP%Name,HPNum-1, ISNotOK,ISBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.TRUE.
IF (IsBlank) AlphArray(1)='xxxxx'
ENDIF
CALL VerifyUniqueCoilName(CurrentModuleObject,AlphArray(1),errflag,TRIM(CurrentModuleObject)//' Name')
IF (errflag) THEN
ErrorsFound=.true.
ENDIF
SimpleWatertoAirHP(HPNum)%Name = TRIM(AlphArray(1))
SimpleWatertoAirHP(HPNum)%WatertoAirHPType = 'HEATING'
SimpleWatertoAirHP(HPNum)%WAHPPlantTypeOfNum = TypeOf_CoilWAHPHeatingEquationFit
SimpleWatertoAirHP(HPNum)%RatedAirVolFlowRate = NumArray(1)
SimpleWatertoAirHP(HPNum)%RatedWaterVolFlowRate=NumArray(2)
SimpleWatertoAirHP(HPNum)%RatedCapHeat=NumArray(3)
SimpleWatertoAirHP(HPNum)%RatedCOPHeat=NumArray(4)
SimpleWatertoAirHP(HPNum)%HeatCap1=NumArray(5)
SimpleWatertoAirHP(HPNum)%HeatCap2=NumArray(6)
SimpleWatertoAirHP(HPNum)%HeatCap3=NumArray(7)
SimpleWatertoAirHP(HPNum)%HeatCap4=NumArray(8)
SimpleWatertoAirHP(HPNum)%HeatCap5=NumArray(9)
SimpleWatertoAirHP(HPNum)%HeatPower1=NumArray(10)
SimpleWatertoAirHP(HPNum)%HeatPower2=NumArray(11)
SimpleWatertoAirHP(HPNum)%HeatPower3=NumArray(12)
SimpleWatertoAirHP(HPNum)%HeatPower4=NumArray(13)
SimpleWatertoAirHP(HPNum)%HeatPower5=NumArray(14)
SimpleWatertoAirHP(HPNum)%WaterInletNodeNum = &
GetOnlySingleNode(AlphArray(2),ErrorsFound,TRIM(CurrentModuleObject), &
AlphArray(1),NodeType_Water,NodeConnectionType_Inlet,2,ObjectIsNotParent)
SimpleWatertoAirHP(HPNum)%WaterOutletNodeNum = &
GetOnlySingleNode(AlphArray(3),ErrorsFound,TRIM(CurrentModuleObject), &
AlphArray(1),NodeType_Water,NodeConnectionType_Outlet,2,ObjectIsNotParent)
SimpleWatertoAirHP(HPNum)%AirInletNodeNum = &
GetOnlySingleNode(AlphArray(4),ErrorsFound,TRIM(CurrentModuleObject), &
AlphArray(1),NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
SimpleWatertoAirHP(HPNum)%AirOutletNodeNum = &
GetOnlySingleNode(AlphArray(5),ErrorsFound,TRIM(CurrentModuleObject), &
AlphArray(1),NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
CALL TestCompSet(TRIM(CurrentModuleObject),AlphArray(1),AlphArray(2),AlphArray(3),'Water Nodes')
CALL TestCompSet(TRIM(CurrentModuleObject),AlphArray(1),AlphArray(4),AlphArray(5),'Air Nodes')
CALL SetupOutputVariable('Heating Coil Electric Energy [J]', &
SimpleWatertoAirHP(HPNum)%Energy,'System','Summed',SimpleWatertoAirHP(HPNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='Heating',GroupKey='System')
CALL SetupOutputVariable('Heating Coil Heating Energy [J]', &
SimpleWatertoAirHP(HPNum)%EnergyLoadTotal,'System','Summed',SimpleWatertoAirHP(HPNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='HEATINGCOILS',GroupKey='System')
CALL SetupOutputVariable('Heating Coil Source Side Heat Transfer Energy [J]', &
SimpleWatertoAirHP(HPNum)%EnergySource,'System','Summed',SimpleWatertoAirHP(HPNum)%Name, &
ResourceTypeKey='PLANTLOOPHEATINGDEMAND',EndUseKey='HEATINGCOILS',GroupKey='System')
!create predefined report entries
CALL PreDefTableEntry(pdchHeatCoilType,SimpleWatertoAirHP(HPNum)%Name,CurrentModuleObject)
CALL PreDefTableEntry(pdchHeatCoilNomCap,SimpleWatertoAirHP(HPNum)%Name,SimpleWatertoAirHP(HPNum)%RatedCapHeat)
CALL PreDefTableEntry(pdchHeatCoilNomEff,SimpleWatertoAirHP(HPNum)%Name,SimpleWatertoAirHP(HPNum)%RatedPowerHeat &
/ SimpleWatertoAirHP(HPNum)%RatedCapHeat)
END DO
DEALLOCATE(AlphArray)
DEALLOCATE(cAlphaFields)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(cNumericFields)
DEALLOCATE(lNumericBlanks)
DEALLOCATE(NumArray)
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found getting input. Program terminates.')
ENDIF
DO HPNum=1,NumWatertoAirHPs
IF ( SimpleWatertoAirHP(HPNum)%WAHPPlantTypeOfNum== TypeOf_CoilWAHPCoolingEquationFit ) THEN
! COOLING COIL Setup Report variables for the Heat Pump
CALL SetupOutputVariable('Cooling Coil Electric Power [W]', &
SimpleWatertoAirHP(HPNum)%Power,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Cooling Coil Total Cooling Rate [W]', &
SimpleWatertoAirHP(HPNum)%QLoadTotal,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Cooling Coil Sensible Cooling Rate [W]', &
SimpleWatertoAirHP(HPNum)%QSensible,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Cooling Coil Latent Cooling Rate [W]', &
SimpleWatertoAirHP(HPNum)%QLatent,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Cooling Coil Source Side Heat Transfer Rate [W]', &
SimpleWatertoAirHP(HPNum)%QSource,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Cooling Coil Part Load Ratio []', &
SimpleWatertoAirHP(HPNum)%PartLoadRatio,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Cooling Coil Runtime Fraction []', &
SimpleWatertoAirHP(HPNum)%RunFrac,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Cooling Coil Air Mass Flow Rate [kg/s]', &
SimpleWatertoAirHP(HPNum)%AirMassFlowRate,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Cooling Coil Air Inlet Temperature [C]', &
SimpleWatertoAirHP(HPNum)%InletAirDBTemp,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Cooling Coil Air Inlet Humidity Ratio [kgWater/kgDryAir]', &
SimpleWatertoAirHP(HPNum)%InletAirHumRat,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Cooling Coil Air Outlet Temperature [C]', &
SimpleWatertoAirHP(HPNum)%OutletAirDBTemp,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Cooling Coil Air Outlet Humidity Ratio [kgWater/kgDryAir]', &
SimpleWatertoAirHP(HPNum)%OutletAirHumRat,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Cooling Coil Source Side Mass Flow Rate [kg/s]', &
SimpleWatertoAirHP(HPNum)%WaterMassFlowRate,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Cooling Coil Source Side Inlet Temperature [C]', &
SimpleWatertoAirHP(HPNum)%InletWaterTemp,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Cooling Coil Source Side Outlet Temperature [C]', &
SimpleWatertoAirHP(HPNum)%OutletWaterTemp,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
ELSEIF ( SimpleWatertoAirHP(HPNum)%WAHPPlantTypeOfNum== TypeOf_CoilWAHPHeatingEquationFit) THEN
! HEATING COIL Setup Report variables for the Heat Pump
CALL SetupOutputVariable('Heating Coil Electric Power [W]', &
SimpleWatertoAirHP(HPNum)%Power,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Heating Coil Heating Rate [W]', &
SimpleWatertoAirHP(HPNum)%QLoadTotal,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Heating Coil Sensible Heating Rate [W]', &
SimpleWatertoAirHP(HPNum)%QSensible,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Heating Coil Source Side Heat Transfer Rate [W]', &
SimpleWatertoAirHP(HPNum)%QSource,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Heating Coil Part Load Ratio []', &
SimpleWatertoAirHP(HPNum)%PartLoadRatio,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Heating Coil Runtime Fraction []', &
SimpleWatertoAirHP(HPNum)%RunFrac,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Heating Coil Air Mass Flow Rate [kg/s]', &
SimpleWatertoAirHP(HPNum)%AirMassFlowRate,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Heating Coil Air Inlet Temperature [C]', &
SimpleWatertoAirHP(HPNum)%InletAirDBTemp,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Heating Coil Air Inlet Humidity Ratio [kgWater/kgDryAir]', &
SimpleWatertoAirHP(HPNum)%InletAirHumRat,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Heating Coil Air Outlet Temperature [C]', &
SimpleWatertoAirHP(HPNum)%OutletAirDBTemp,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Heating Coil Air Outlet Humidity Ratio [kgWater/kgDryAir]', &
SimpleWatertoAirHP(HPNum)%OutletAirHumRat,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Heating Coil Source Side Mass Flow Rate [kg/s]', &
SimpleWatertoAirHP(HPNum)%WaterMassFlowRate,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Heating Coil Source Side Inlet Temperature [C]', &
SimpleWatertoAirHP(HPNum)%InletWaterTemp,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
CALL SetupOutputVariable('Heating Coil Source Side Outlet Temperature [C]', &
SimpleWatertoAirHP(HPNum)%OutletWaterTemp,'System','Average',SimpleWatertoAirHP(HPNum)%Name)
ENDIF
END DO
RETURN
END SUBROUTINE GetSimpleWatertoAirHPInput