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 GetWindowAC
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN May 2000
! MODIFIED Chandan Sharma, FSEC, March 2011: Added zone sys avail manager
! Bereket Nigusse, FSEC, April 2011: eliminated input node names,
! added OA Mixer object type
! and fan object type
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Obtains input data for window AC units and stores it in window AC data structures
! METHODOLOGY EMPLOYED:
! Uses "Get" routines to read in data.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, SameString, GetObjectDefMaxArgs
USE NodeInputManager, ONLY: GetOnlySingleNode
USE BranchNodeConnections, ONLY: SetUpCompSets
USE Fans, ONLY: GetFanIndex, GetFanVolFlow, GetFanAvailSchPtr, GetFanType
USE General, ONLY: TrimSigDigits
USE DXCoils, ONLY: GetDXCoilOutletNode => GetCoilOutletNode
USE HVACHXAssistedCoolingCoil, ONLY: GetDXHXAsstdCoilOutletNode => GetCoilOutletNode
USE DataGlobals, ONLY: AnyEnergyManagementSystemInModel, NumOfZones, ScheduleAlwaysOn
USE DataInterfaces, ONLY: SetupEMSActuator
USE MixedAir, ONLY: GetOAMixerIndex, GetOAMixerNodeNumbers
USE DataHvacGlobals, ONLY: FanType_SimpleConstVolume, FanType_SimpleVAV, FanType_SimpleOnOff, cFanTypes, ZoneComp
USE DataZoneEquipment, ONLY: WindowAC_Num, ZoneEquipConfig
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName = 'GetWindowAC: ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: WindACIndex ! loop index
INTEGER :: WindACNum ! current window AC number
CHARACTER(len=MaxNameLength) :: CompSetFanInlet, CompSetCoolInlet, CompSetFanOutlet, CompSetCoolOutlet
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER, DIMENSION(4) :: OANodeNums ! Node numbers of Outdoor air mixer (OA, EA, RA, MA)
INTEGER :: IOStatus ! Used in GetObjectItem
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input, fatal at end of routine
LOGICAL :: ErrFlag=.false. ! Local error flag for GetOAMixerNodeNums
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: FanErrFlag=.false. ! Error flag used in GetFanIndex call
REAL(r64) :: FanVolFlow ! Fan volumetric flow rate
LOGICAL :: CoilNodeErrFlag ! Used in error messages for mining coil outlet node number
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! Object type for getting and error messages
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: Alphas ! 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(:) :: Numbers ! 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.
INTEGER :: TotalArgs=0 ! Total number of alpha and numeric arguments (max) for a
! INTEGER :: FanType ! Integer index for Fan type
INTEGER :: CtrlZone ! index to loop counter
INTEGER :: NodeNum ! index to loop counter
LOGICAL :: ZoneNodeNotFound ! used in error checking
! find the number of each type of window AC unit
CurrentModuleObject = 'ZoneHVAC:WindowAirConditioner'
NumWindACCyc = GetNumObjectsFound(CurrentModuleObject)
NumWindAC = NumWindACCyc
! allocate the data structures
ALLOCATE(WindAC(NumWindAC))
ALLOCATE(CheckEquipName(NumWindAC))
CheckEquipName=.true.
CALL GetObjectDefMaxArgs(CurrentModuleObject,TotalArgs,NumAlphas,NumNumbers)
ALLOCATE(Alphas(NumAlphas))
Alphas=' '
ALLOCATE(cAlphaFields(NumAlphas))
cAlphaFields=' '
ALLOCATE(cNumericFields(NumNumbers))
cNumericFields=' '
ALLOCATE(Numbers(NumNumbers))
Numbers=0.0d0
ALLOCATE(lAlphaBlanks(NumAlphas))
lAlphaBlanks=.TRUE.
ALLOCATE(lNumericBlanks(NumNumbers))
lNumericBlanks=.TRUE.
! loop over window AC units; get and load the input data
DO WindACIndex = 1,NumWindACCyc
CALL GetObjectItem(CurrentModuleObject,WindACIndex,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
WindACNum = WindACIndex
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(Alphas(1),WindAC%Name,WindACNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
WindAC(WindACNum)%Name = Alphas(1)
WindAC(WindACNum)%UnitType = WindowAC_UnitType ! 'ZoneHVAC:WindowAirConditioner'
WindAC(WindACNum)%Sched = Alphas(2)
IF (lAlphaBlanks(2)) THEN
WindAC(WindACNum)%SchedPtr = ScheduleAlwaysOn
ELSE
WindAC(WindACNum)%SchedPtr = GetScheduleIndex(Alphas(2)) ! convert schedule name to pointer
IF (WindAC(WindACNum)%SchedPtr .EQ. 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//TRIM(WindAC(WindACNum)%Name)//'" invalid data.')
CALL ShowContinueError('invalid-not found '//TRIM(cAlphaFields(2))//'="'//TRIM(Alphas(2))//'".')
ErrorsFound=.TRUE.
END IF
ENDIF
WindAC(WindACNum)%MaxAirVolFlow = Numbers(1)
WindAC(WindACNum)%OutAirVolFlow = Numbers(2)
WindAC(WindACNum)%AirInNode = &
GetOnlySingleNode(Alphas(3),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsParent)
WindAC(WindACNum)%AirOutNode = &
GetOnlySingleNode(Alphas(4),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsParent)
WindAC(WindACNum)%OAMixType = Alphas(5)
WindAC(WindACNum)%OAMixName = Alphas(6)
! Get outdoor air mixer node numbers
ErrFlag = .false.
CALL ValidateComponent(WindAC(WindACNum)%OAMixType,WindAC(WindACNum)%OAMixName,ErrFlag,TRIM(CurrentModuleObject))
IF (ErrFlag) THEN
CALL ShowContinueError('specified in '//TRIM(CurrentModuleObject)//' = "'//TRIM(WindAC(WindACNum)%Name)//'".')
ErrorsFound=.TRUE.
ELSE
! Get outdoor air mixer node numbers
OANodeNums = GetOAMixerNodeNumbers(WindAC(WindACNum)%OAMixName, ErrFlag)
IF (ErrFlag) THEN
CALL ShowContinueError('that was specified in '//TRIM(CurrentModuleObject)//' = "'//TRIM(WindAC(WindACNum)%Name)//'"')
CALL ShowContinueError('..OutdoorAir:Mixer is required. Enter an OutdoorAir:Mixer object with this name.')
ErrorsFound=.true.
ELSE
WindAC(WindACNum)%OutsideAirNode = OANodeNums(1)
WindAC(WindACNum)%AirReliefNode = OANodeNums(2)
WindAC(WindACNum)%MixedAirNode = OANodeNums(4)
ENDIF
ENDIF
WindAC(WindACNum)%FanType = Alphas(7)
WindAC(WindACNum)%FanName = Alphas(8)
FanErrFlag=.false.
CALL ValidateComponent(WindAC(WindACNum)%FanType,WindAC(WindACNum)%FanName,FanErrFlag,TRIM(CurrentModuleObject))
IF (FanErrFlag) THEN
CALL ShowContinueError('specified in '//TRIM(CurrentModuleObject)//' = "'//TRIM(WindAC(WindACNum)%Name)//'".')
ErrorsFound=.TRUE.
ELSE
CALL GetFanType(WindAC(WindACNum)%FanName,WindAC(WindACNum)%FanType_Num, &
FanErrFlag,CurrentModuleObject,WindAC(WindACNum)%Name)
SELECT CASE (WindAC(WindACNum)%FanType_Num)
CASE (FanType_SimpleOnOff, FanType_SimpleConstVolume)
CALL GetFanIndex(WindAC(WindACNum)%FanName,WindAC(WindACNum)%FanIndex,FanErrFlag,TRIM(CurrentModuleObject))
IF (FanErrFlag) THEN
CALL ShowContinueError(' specified in '//TRIM(CurrentModuleObject)//' = "'//TRIM(WindAC(WindACNum)%Name)//'".')
ErrorsFound=.true.
ELSE
CALL GetFanVolFlow(WindAC(WindACNum)%FanIndex,FanVolFlow)
IF(FanVolFlow .NE. AutoSize)THEN
IF(FanVolFlow .LT. WindAC(WindACNum)%MaxAirVolFlow)THEN
CALL ShowWarningError('Air flow rate = '//TRIM(TrimSigDigits(FanVolFlow,7))// &
' in fan object '//TRIM(WindAC(WindACNum)%FanName)//' is less than the maximum supply air flow'// &
' rate ('//TRIM(TrimSigDigits(WindAC(WindACNum)%MaxAirVolFlow,7))//') in the '// &
TRIM(CurrentModuleObject)//' object.')
CALL ShowContinueError(' The fan flow rate must be >= to the '//TRIM(cNumericFields(1))//' in the '// &
TRIM(CurrentModuleObject)//' object.')
CALL ShowContinueError(' Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(WindAC(WindACNum)%Name))
ErrorsFound = .TRUE.
END IF
END IF
ENDIF
CASE DEFAULT
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(Alphas(1))//'".')
CALL ShowContinueError('Fan Type must be Fan:OnOff, or Fan:ConstantVolume.')
ErrorsFound=.TRUE.
END SELECT
! Get the fan's availability schedule
WindAC(WindACNum)%FanAvailSchedPtr = GetFanAvailSchPtr(WindAC(WindACNum)%FanType,WindAC(WindACNum)%FanName,FanErrFlag)
IF (FanErrFlag) THEN
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(WindAC(WindACNum)%Name))
ErrorsFound=.TRUE.
ENDIF
ENDIF
WindAC(WindACNum)%DXCoilName = Alphas(10)
IF(SameString(Alphas(9),'Coil:Cooling:DX:SingleSpeed') .OR. &
SameString(Alphas(9),'CoilSystem:Cooling:DX:HeatExchangerAssisted')) THEN
WindAC(WindACNum)%DXCoilType = Alphas(9)
CoilNodeErrFlag = .FALSE.
IF (SameString(Alphas(9),'Coil:Cooling:DX:SingleSpeed')) THEN
WindAC(WindACNum)%DXCoilType_Num = CoilDX_CoolingSingleSpeed
WindAC(WindACNum)%CoilOutletNodeNum = &
GetDXCoilOutletNode(WindAC(WindACNum)%DXCoilType,WindAC(WindACNum)%DXCoilName,CoilNodeErrFlag)
ELSEIF (SameString(Alphas(9),'CoilSystem:Cooling:DX:HeatExchangerAssisted')) THEN
WindAC(WindACNum)%DXCoilType_Num = CoilDX_CoolingHXAssisted
WindAC(WindACNum)%CoilOutletNodeNum = &
GetDXHXAsstdCoilOutletNode(WindAC(WindACNum)%DXCoilType,WindAC(WindACNum)%DXCoilName,CoilNodeErrFlag)
ENDIF
IF(CoilNodeErrFlag)THEN
CALL ShowContinueError(' that was specified in '//TRIM(CurrentModuleObject)//' = "' &
//TRIM(WindAC(WindACNum)%Name)//'".')
ErrorsFound = .TRUE.
END IF
ELSE
CALL ShowWarningError('Invalid '//TRIM(cAlphaFields(9))//' = '//TRIM(Alphas(9)))
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(WindAC(WindACNum)%Name))
ErrorsFound = .TRUE.
END IF
WindAC(WindACNum)%FanSchedPtr = GetScheduleIndex(Alphas(11))
! Default to cycling fan when fan mode schedule is not present
IF (.NOT. lAlphaBlanks(11) .AND. WindAC(WindACNum)%FanSchedPtr == 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' "'//TRIM(WindAC(WindACNum)%Name)//'" '//&
TRIM(cAlphaFields(11))//' not found: '//TRIM(Alphas(11)))
ErrorsFound=.TRUE.
ELSEIF (lAlphaBlanks(11)) THEN
WindAC(WindACNum)%OpMode = CycFanCycCoil
END IF
IF (SameString(Alphas(12),'BlowThrough')) WindAC(WindACNum)%FanPlace = BlowThru
IF (SameString(Alphas(12),'DrawThrough')) WindAC(WindACNum)%FanPlace = DrawThru
IF (WindAC(WindACNum)%FanPlace .EQ. 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFields(12))//' = '//TRIM(Alphas(12)))
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(WindAC(WindACNum)%Name))
ErrorsFound = .TRUE.
END IF
WindAC(WindACNum)%ConvergenceTol = Numbers(3)
IF (.NOT. lAlphaBlanks(13)) THEN
WindAC(WindACNum)%AvailManagerListName = Alphas(13)
ZoneComp(WindowAC_Num)%ZoneCompAvailMgrs(WindACNum)%AvailManagerListName = Alphas(13)
ENDIF
! Add fan to component sets array
IF (WindAC(WindACNum)%FanPlace == BlowThru) THEN
! Window AC air inlet node must be the same as a zone exhaust node and the OA Mixer return node
! check that Window AC air inlet node is the same as a zone exhaust node.
ZoneNodeNotFound = .TRUE.
DO CtrlZone = 1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZone)%IsControlled) CYCLE
DO NodeNum = 1,ZoneEquipConfig(CtrlZone)%NumExhaustNodes
IF (WindAC(WindACNum)%AirInNode .EQ. ZoneEquipConfig(CtrlZone)%ExhaustNode(NodeNum)) THEN
ZoneNodeNotFound = .FALSE.
EXIT
END IF
END DO
END DO
IF(ZoneNodeNotFound)THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(WindAC(WindACNum)%Name)//'".'//&
' Window AC air inlet node name must be the same as a zone exhaust node name.')
CALL ShowContinueError('..Zone exhaust node name is specified in ZoneHVAC:EquipmentConnections object.')
CALL ShowContinueError('..Window AC air inlet node name = '//TRIM(NodeID(WindAC(WindACNum)%AirInNode)))
ErrorsFound=.TRUE.
END IF
! check that Window AC air outlet node is a zone inlet node.
ZoneNodeNotFound = .TRUE.
DO CtrlZone = 1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZone)%IsControlled) CYCLE
DO NodeNum = 1,ZoneEquipConfig(CtrlZone)%NumInletNodes
IF (WindAC(WindACNum)%AirOutNode .EQ. ZoneEquipConfig(CtrlZone)%InletNode(NodeNum)) THEN
ZoneNodeNotFound = .FALSE.
EXIT
END IF
END DO
END DO
IF(ZoneNodeNotFound)THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(WindAC(WindACNum)%Name)//'".'// &
' Window AC air outlet node name must be the same as a zone inlet node name.')
CALL ShowContinueError('..Zone inlet node name is specified in ZoneHVAC:EquipmentConnections object.')
CALL ShowContinueError('..Window AC air outlet node name = '//TRIM(NodeID(WindAC(WindACNum)%AirOutNode)))
ErrorsFound=.TRUE.
END IF
CompSetFanInlet = NodeID(WindAC(WindACNum)%MixedAirNode)
CompSetFanOutlet = 'UNDEFINED'
CompSetCoolInlet = 'UNDEFINED'
CompSetCoolOutlet = NodeID(WindAC(WindACNum)%AirOutNode)
ELSE ! draw through fan from IF (WindAC(WindACNum)%FanPlace == BlowThru) THEN
! check that Window AC air inlet node is the same as a zone exhaust node.
ZoneNodeNotFound = .TRUE.
DO CtrlZone = 1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZone)%IsControlled) CYCLE
DO NodeNum = 1,ZoneEquipConfig(CtrlZone)%NumExhaustNodes
IF (WindAC(WindACNum)%AirInNode .EQ. ZoneEquipConfig(CtrlZone)%ExhaustNode(NodeNum)) THEN
ZoneNodeNotFound = .FALSE.
EXIT
END IF
END DO
END DO
IF(ZoneNodeNotFound)THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(WindAC(WindACNum)%Name)//'".'// &
' Window AC air inlet node name must be the same as a zone exhaust node name.')
CALL ShowContinueError('..Zone exhaust node name is specified in ZoneHVAC:EquipmentConnections object.')
CALL ShowContinueError('..Window AC inlet node name = '//TRIM(NodeID(WindAC(WindACNum)%AirInNode)))
ErrorsFound=.TRUE.
END IF
! check that Window AC air outlet node is the same as a zone inlet node.
ZoneNodeNotFound = .TRUE.
DO CtrlZone = 1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZone)%IsControlled) CYCLE
DO NodeNum = 1,ZoneEquipConfig(CtrlZone)%NumInletNodes
IF (WindAC(WindACNum)%AirOutNode .EQ. ZoneEquipConfig(CtrlZone)%InletNode(NodeNum)) THEN
ZoneNodeNotFound = .FALSE.
EXIT
END IF
END DO
END DO
IF(ZoneNodeNotFound)THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(WindAC(WindACNum)%Name)//'".'// &
' Window AC air outlet node name must be the same as a zone inlet node name.')
CALL ShowContinueError('..Zone inlet node name is specified in ZoneHVAC:EquipmentConnections object.')
CALL ShowContinueError('..Window AC outlet node name = '//TRIM(NodeID(WindAC(WindACNum)%AirOutNode)))
ErrorsFound=.TRUE.
END IF
CompSetFanInlet = NodeID(WindAC(WindACNum)%CoilOutletNodeNum)
CompSetFanOutlet = NodeID(WindAC(WindACNum)%AirOutNode)
CompSetCoolInlet = NodeID(WindAC(WindACNum)%MixedAirNode)
CompSetCoolOutlet = NodeID(WindAC(WindACNum)%CoilOutletNodeNum)
ENDIF
! Add fan to component sets array
CALL SetUpCompSets(cWindowAC_UnitTypes(WindAC(WindACNum)%UnitType), WindAC(WindACNum)%Name, &
WindAC(WindACNum)%FanType, WindAC(WindACNum)%FanName,CompSetFanInlet,CompSetFanOutlet)
! Add cooling coil to component sets array
CALL SetUpCompSets(cWindowAC_UnitTypes(WindAC(WindACNum)%UnitType), WindAC(WindACNum)%Name, &
WindAC(WindACNum)%DXCoilType,WindAC(WindACNum)%DXCoilName, &
CompSetCoolInlet,CompSetCoolOutlet)
! Set up component set for OA mixer - use OA node and Mixed air node
CALL SetUpCompSets(cWindowAC_UnitTypes(WindAC(WindACNum)%UnitType), WindAC(WindACNum)%Name, &
WindAC(WindACNum)%OAMixType, WindAC(WindACNum)%OAMixName, &
NodeID(WindAC(WindACNum)%OutsideAirNode), NodeID(WindAC(WindACNum)%MixedAirNode))
END DO
DEALLOCATE(Alphas)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
DEALLOCATE(Numbers)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in getting '//TRIM(CurrentModuleObject)// &
' input. Preceding condition causes termination.')
END IF
DO WindACNum=1,NumWindAC
! Setup Report variables for the Fan Coils
CALL SetupOutputVariable('Zone Window Air Conditioner Total Cooling Rate [W]', &
WindAC(WindACNum)%TotCoolEnergyRate,'System','Average',&
WindAC(WindACNum)%Name)
CALL SetupOutputVariable('Zone Window Air Conditioner Total Cooling Energy [J]', &
WindAC(WindACNum)%TotCoolEnergy,'System','Sum',&
WindAC(WindACNum)%Name)
CALL SetupOutputVariable('Zone Window Air Conditioner Sensible Cooling Rate [W]', &
WindAC(WindACNum)%SensCoolEnergyRate,'System','Average',&
WindAC(WindACNum)%Name)
CALL SetupOutputVariable('Zone Window Air Conditioner Sensible Cooling Energy [J]', &
WindAC(WindACNum)%SensCoolEnergy,'System','Sum',&
WindAC(WindACNum)%Name)
CALL SetupOutputVariable('Zone Window Air Conditioner Latent Cooling Rate [W]', &
WindAC(WindACNum)%LatCoolEnergyRate,'System','Average',&
WindAC(WindACNum)%Name)
CALL SetupOutputVariable('Zone Window Air Conditioner Latent Cooling Energy [J]', &
WindAC(WindACNum)%LatCoolEnergy,'System','Sum',&
WindAC(WindACNum)%Name)
CALL SetupOutputVariable('Zone Window Air Conditioner Electric Power [W]', &
WindAC(WindACNum)%ElecPower,'System','Average',&
WindAC(WindACNum)%Name)
CALL SetupOutputVariable('Zone Window Air Conditioner Electric Energy [J]', &
WindAC(WindACNum)%ElecConsumption,'System','Sum',&
WindAC(WindACNum)%Name)
CALL SetupOutputVariable('Zone Window Air Conditioner Fan Part Load Ratio []', &
WindAC(WindACNum)%FanPartLoadRatio,'System','Average',&
WindAC(WindACNum)%Name)
CALL SetupOutputVariable('Zone Window Air Conditioner Compressor Part Load Ratio []', &
WindAC(WindACNum)%CompPartLoadRatio,'System','Average',&
WindAC(WindACNum)%Name)
CALL SetupOutputVariable('Zone Window Air Conditioner Fan Availability Status []', &
WindAC(WindACNum)%AvailStatus,'System','Average',&
WindAC(WindACNum)%Name)
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupEMSActuator('Window Air Conditioner', WindAC(WindACNum)%Name, 'Part Load Ratio' , '[fraction]', &
WindAC(WindACNum)%EMSOverridePartLoadFrac, WindAC(WindACNum)%EMSValueForPartLoadFrac )
ENDIF
END DO
RETURN
END SUBROUTINE GetWindowAC