SUBROUTINE GetVRFInput
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad, FSEC
! DATE WRITTEN August 2010
! MODIFIED July 2012, Chandan Sharma - FSEC: Added zone sys avail managers
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Obtains input data for VRF systems and stores it in data structures
! METHODOLOGY EMPLOYED:
! Uses "Get" routines to read in data.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor
USE DataLoopNode
USE General, ONLY: TrimSigDigits
USE ScheduleManager, ONLY: GetScheduleIndex, CheckScheduleValueMinMax
USE NodeInputManager, ONLY: GetOnlySingleNode
USE CurveManager, ONLY: GetCurveIndex, GetCurveType
USE BranchNodeConnections, ONLY: TestCompSet, SetUpCompSets
USE Fans, ONLY: GetFanDesignVolumeFlowRate,GetFanInletNode,GetFanOutletNode,GetFanIndex, &
GetFanAvailSchPtr, GetFanType
USE MixedAir, ONLY: GetOAMixerNodeNumbers
USE DXCoils, ONLY: GetDXCoolCoilIndex=>GetDXCoilIndex, &
GetDXCoilInletNode=>GetCoilInletNode, GetDXCoilOutletNode=>GetCoilOutletNode, &
GetCoilCondenserInletNode, GetCoilTypeNum, SetDXCoolingCoilData, GetDXCoilAvailSchPtr
USE DataHeatBalance, ONLY: Zone
USE OutAirNodeManager, ONLY: CheckOutAirNodeNumber
USE WaterManager, ONLY: SetupTankDemandComponent, SetupTankSupplyComponent
USE DataZoneEquipment, ONLY: ZoneEquipConfig, VRFTerminalUnit_Num
USE DataSizing, ONLY: AutoSize
! USE DataIPShortCuts
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetVRFInput: ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NumVRFCTU ! The number of VRF constant volume TUs (anticipating different types of TU's)
INTEGER :: VRFTUNum ! Loop index to the total number of VRF terminal units
INTEGER :: VRFNum ! Loop index to the total number of VRF terminal units
INTEGER :: TUListNum ! Loop index to the total number of VRF terminal unit lists
INTEGER :: NumAlphas ! Number of alpha arguments
INTEGER :: NumNums ! Number of real arguments
! INTEGER :: checkNum
INTEGER :: IOSTAT ! Status
LOGICAL :: ErrFlag ! error flag for mining functions
LOGICAL :: ErrorsFound = .false. ! If errors detected in input
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
CHARACTER(len=MaxNameLength+40),ALLOCATABLE, DIMENSION(:) :: cAlphaFieldNames
CHARACTER(len=MaxNameLength+40),ALLOCATABLE, DIMENSION(:) :: cNumericFieldNames
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericFieldBlanks
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaFieldBlanks
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: cAlphaArgs
REAL(r64),ALLOCATABLE, DIMENSION(:) :: rNumericArgs
CHARACTER(len=MaxNameLength) :: cCurrentModuleObject
INTEGER :: NumParams
INTEGER :: MaxAlphas
INTEGER :: MaxNumbers
CHARACTER(len=MaxNameLength) :: FanType ! Type of supply air fan
CHARACTER(len=MaxNameLength) :: FanName ! Supply air fan name
CHARACTER(len=MaxNameLength) :: OAMixerType ! Type of OA mixer
CHARACTER(len=MaxNameLength) :: DXCoolingCoilType ! Type of VRF DX cooling coil
CHARACTER(len=MaxNameLength) :: DXHeatingCoilType ! Type of VRF DX heating coil
INTEGER :: FanType_Num ! Used in mining function CALLS
REAL(r64) :: FanVolFlowRate ! Fan Max Flow Rate from Fan object (for comparisons to validity)
INTEGER :: FanInletNodeNum ! Used in TU configuration setup
INTEGER :: FanOutletNodeNum ! Used in TU configuration setup
INTEGER, DIMENSION(4) :: OANodeNums ! Node numbers of OA mixer (OA, EA, RA, MA)
INTEGER :: CCoilInletNodeNum ! Used in TU configuration setup
INTEGER :: CCoilOutletNodeNum ! Used in TU configuration setup
INTEGER :: HCoilInletNodeNum ! Used in TU configuration setup
INTEGER :: HCoilOutletNodeNum ! Used in TU configuration setup
INTEGER :: ZoneTerminalUnitListNum ! Used to find connection between VRFTU, TUList and VRF condenser
INTEGER :: NumCond ! loop counter
INTEGER :: NumList ! loop counter
LOGICAL :: ZoneNodeNotFound ! used in error checking
INTEGER :: CtrlZone ! index to loop counter
INTEGER :: NodeNum ! index to loop counter
! Flow
MaxAlphas=0
MaxNumbers=0
NumVRFCTU = GetNumObjectsFound('ZoneHVAC:TerminalUnit:VariableRefrigerantFlow')
IF (NumVRFCTU > 0) THEN
CALL GetObjectDefMaxArgs('ZoneHVAC:TerminalUnit:VariableRefrigerantFlow',NumParams,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNumbers=MAX(MaxNumbers,NumNums)
ENDIF
NumVRFCond = GetNumObjectsFound('AirConditioner:VariableRefrigerantFlow')
IF (NumVRFCond > 0) THEN
CALL GetObjectDefMaxArgs('AirConditioner:VariableRefrigerantFlow',NumParams,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNumbers=MAX(MaxNumbers,NumNums)
ENDIF
NumVRFTULists = GetNumObjectsFound('ZoneTerminalUnitList')
IF (NumVRFTULists > 0) THEN
CALL GetObjectDefMaxArgs('ZoneTerminalUnitList',NumParams,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNumbers=MAX(MaxNumbers,NumNums)
ENDIF
ALLOCATE(cAlphaArgs(MaxAlphas))
cAlphaArgs=' '
ALLOCATE(cAlphaFieldNames(MaxAlphas))
cAlphaFieldNames=' '
ALLOCATE(lAlphaFieldBlanks(MaxAlphas))
lAlphaFieldBlanks=.false.
ALLOCATE(cNumericFieldNames(MaxNumbers))
cNumericFieldNames=' '
ALLOCATE(lNumericFieldBlanks(MaxNumbers))
lNumericFieldBlanks=.false.
ALLOCATE(rNumericArgs(MaxNumbers))
rNumericArgs=0.0d0
NumVRFTU = NumVRFCTU
IF (NumVRFTU > 0) THEN
ALLOCATE(VRFTU(NumVRFTU))
ALLOCATE(CheckEquipName(NumVRFTU))
CheckEquipName=.true.
ENDIF
IF (NumVRFCond > 0) THEN
ALLOCATE(VRF(NumVRFCond))
ALLOCATE(MaxCoolingCapacity(NumVRFCond))
ALLOCATE(MaxHeatingCapacity(NumVRFCond))
ALLOCATE(CoolCombinationRatio(NumVRFCond))
ALLOCATE(HeatCombinationRatio(NumVRFCond))
MaxCoolingCapacity = MaxCap
MaxHeatingCapacity = MaxCap
CoolCombinationRatio = 1.d0
HeatCombinationRatio = 1.d0
ENDIF
IF (NumVRFTULists > 0) THEN
ALLOCATE(TerminalUnitList(NumVRFTULists))
ENDIF
! read all terminal unit list objects
cCurrentModuleObject= 'ZoneTerminalUnitList'
DO VRFNum = 1, NumVRFTULists
CALL GetObjectItem(cCurrentModuleObject,VRFNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),TerminalUnitList%Name,VRFNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
TerminalUnitList(VRFNum)%Name = cAlphaArgs(1)
TerminalUnitList(VRFNum)%NumTUInList = NumAlphas - 1
ALLOCATE(TerminalUnitList(VRFNum)%ZoneTUPtr(TerminalUnitList(VRFNum)%NumTUInList))
ALLOCATE(TerminalUnitList(VRFNum)%ZoneTUName(TerminalUnitList(VRFNum)%NumTUInList))
ALLOCATE(TerminalUnitList(VRFNum)%IsSimulated(TerminalUnitList(VRFNum)%NumTUInList))
ALLOCATE(TerminalUnitList(VRFNum)%TotalCoolLoad(TerminalUnitList(VRFNum)%NumTUInList))
ALLOCATE(TerminalUnitList(VRFNum)%TotalHeatLoad(TerminalUnitList(VRFNum)%NumTUInList))
ALLOCATE(TerminalUnitList(VRFNum)%CoolingCoilPresent(TerminalUnitList(VRFNum)%NumTUInList))
ALLOCATE(TerminalUnitList(VRFNum)%HeatingCoilPresent(TerminalUnitList(VRFNum)%NumTUInList))
ALLOCATE(TerminalUnitList(VRFNum)%TerminalUnitNotSizedYet(TerminalUnitList(VRFNum)%NumTUInList))
ALLOCATE(TerminalUnitList(VRFNum)%HRHeatRequest(TerminalUnitList(VRFNum)%NumTUInList))
ALLOCATE(TerminalUnitList(VRFNum)%HRCoolRequest(TerminalUnitList(VRFNum)%NumTUInList))
ALLOCATE(TerminalUnitList(VRFNum)%CoolingCoilAvailable(TerminalUnitList(VRFNum)%NumTUInList))
ALLOCATE(TerminalUnitList(VRFNum)%HeatingCoilAvailable(TerminalUnitList(VRFNum)%NumTUInList))
ALLOCATE(TerminalUnitList(VRFNum)%CoolingCoilAvailSchPtr(TerminalUnitList(VRFNum)%NumTUInList))
ALLOCATE(TerminalUnitList(VRFNum)%HeatingCoilAvailSchPtr(TerminalUnitList(VRFNum)%NumTUInList))
TerminalUnitList(VRFNum)%ZoneTUPtr = 0
TerminalUnitList(VRFNum)%IsSimulated = .FALSE.
TerminalUnitList(VRFNum)%TotalCoolLoad = 0.0d0
TerminalUnitList(VRFNum)%TotalHeatLoad = 0.0d0
TerminalUnitList(VRFNum)%CoolingCoilPresent = .TRUE.
TerminalUnitList(VRFNum)%HeatingCoilPresent = .TRUE.
TerminalUnitList(VRFNum)%TerminalUnitNotSizedYet = .TRUE.
TerminalUnitList(VRFNum)%HRHeatRequest = .FALSE.
TerminalUnitList(VRFNum)%HRCoolRequest = .FALSE.
TerminalUnitList(VRFNum)%CoolingCoilAvailable = .FALSE.
TerminalUnitList(VRFNum)%HeatingCoilAvailable = .FALSE.
TerminalUnitList(VRFNum)%CoolingCoilAvailSchPtr = -1
TerminalUnitList(VRFNum)%HeatingCoilAvailSchPtr = -1
DO TUListNum = 1, TerminalUnitList(VRFNum)%NumTUInList
TerminalUnitList(VRFNum)%ZoneTUName(TUListNum) = cAlphaArgs(TUListNum+1)
END DO
END DO
! read all VRF condenser objects
cCurrentModuleObject= 'AirConditioner:VariableRefrigerantFlow'
DO VRFNum = 1, NumVRFCond
CALL GetObjectItem(cCurrentModuleObject,VRFNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),VRF%Name,VRFNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
VRF(VRFNum)%Name = cAlphaArgs(1)
VRF(VRFNum)%VRFSystemTypeNum = VRF_HeatPump
IF (lAlphaFieldBlanks(2)) THEN
VRF(VRFNum)%SchedPtr = ScheduleAlwaysOn
ELSE
VRF(VRFNum)%SchedPtr = GetScheduleIndex(cAlphaArgs(2))
IF (VRF(VRFNum)%SchedPtr == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(VRF(VRFNum)%Name)//'" invalid data')
CALL ShowContinueError('Invalid-not found '//trim(cAlphaFieldNames(2))//'="'// &
trim(cAlphaArgs(2))//'".')
ErrorsFound=.true.
ENDIF
ENDIF
! CALL TestCompSet(TRIM(cCurrentModuleObject),VRF(VRFTUNum)%Name,cAlphaArgs(3),cAlphaArgs(4),'Air Nodes')
VRF(VRFNum)%CoolingCapacity = rNumericArgs(1)
VRF(VRFNum)%CoolingCOP = rNumericArgs(2)
VRF(VRFNum)%MinOATCooling = rNumericArgs(3)
VRF(VRFNum)%MaxOATCooling = rNumericArgs(4)
VRF(VRFNum)%CoolCapFT = GetCurveIndex(cAlphaArgs(3))
IF(VRF(VRFNum)%CoolCapFT .GT. 0)THEN
! Verify Curve Object, only legal type is biquadratic
SELECT CASE(GetCurveType(VRF(VRFNum)%CoolCapFT))
CASE('BIQUADRATIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(3))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%CoolCapFT)))
CALL ShowContinueError('... curve type must be BiQuadratic.')
ErrorsFound=.TRUE.
END SELECT
! only show error if cooling coil is present, since TU's have not yet been read, do this later in GetInput
! ELSE
! CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
! '" '//TRIM(cAlphaFieldNames(3))//' not found.')
! ErrorsFound=.TRUE.
END IF
VRF(VRFNum)%CoolBoundaryCurvePtr = GetCurveIndex(cAlphaArgs(4))
IF(VRF(VRFNum)%CoolBoundaryCurvePtr .GT. 0)THEN
! Verify Curve Object, only legal type is linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%CoolBoundaryCurvePtr))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(4))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%CoolBoundaryCurvePtr)))
CALL ShowContinueError('... curve type must be Linear, Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%CoolCapFTHi = GetCurveIndex(cAlphaArgs(5))
IF(VRF(VRFNum)%CoolCapFTHi .GT. 0)THEN
! Verify Curve Object, only legal type is biquadratic
SELECT CASE(GetCurveType(VRF(VRFNum)%CoolCapFTHi))
CASE('BIQUADRATIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(5))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%CoolCapFTHi)))
CALL ShowContinueError('... curve type must be BiQuadratic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%CoolEIRFT = GetCurveIndex(cAlphaArgs(6))
IF(VRF(VRFNum)%CoolEIRFT .GT. 0)THEN
! Verify Curve Object, only legal type is biquadratic
SELECT CASE(GetCurveType(VRF(VRFNum)%CoolEIRFT))
CASE('BIQUADRATIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(6))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%CoolEIRFT)))
CALL ShowContinueError('... curve type must be BiQuadratic.')
ErrorsFound=.TRUE.
END SELECT
! only show error if cooling coil is present, since TU's have not yet been read, do this later in GetInput
! ELSE
! CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
! '" '//TRIM(cAlphaFieldNames(6))//' not found.')
! ErrorsFound=.TRUE.
END IF
VRF(VRFNum)%EIRCoolBoundaryCurvePtr = GetCurveIndex(cAlphaArgs(7))
IF(VRF(VRFNum)%EIRCoolBoundaryCurvePtr .GT. 0)THEN
! Verify Curve Object, only legal type is linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%EIRCoolBoundaryCurvePtr))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(7))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%EIRCoolBoundaryCurvePtr)))
CALL ShowContinueError('... curve type must be Linear, Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%CoolEIRFTHi = GetCurveIndex(cAlphaArgs(8))
IF(VRF(VRFNum)%CoolEIRFTHi .GT. 0)THEN
! Verify Curve Object, only legal type is biquadratic
SELECT CASE(GetCurveType(VRF(VRFNum)%CoolEIRFTHi))
CASE('BIQUADRATIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(8))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%CoolEIRFTHi)))
CALL ShowContinueError('... curve type must be BiQuadratic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%CoolEIRFPLR1 = GetCurveIndex(cAlphaArgs(9))
IF(VRF(VRFNum)%CoolEIRFPLR1 .GT. 0)THEN
! Verify Curve Object, only legal type is linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%CoolEIRFPLR1))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(9))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%CoolEIRFPLR1)))
CALL ShowContinueError('... curve type must be Linear, Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
! only show error if cooling coil is present, since TU's have not yet been read, do this later in GetInput
! ELSE
! CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
! '" '//TRIM(cAlphaFieldNames(9))//' not found.')
! ErrorsFound=.TRUE.
END IF
VRF(VRFNum)%CoolEIRFPLR2 = GetCurveIndex(cAlphaArgs(10))
IF(VRF(VRFNum)%CoolEIRFPLR2 .GT. 0)THEN
! Verify Curve Object, only legal type is linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%CoolEIRFPLR2))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(10))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%CoolEIRFPLR2)))
CALL ShowContinueError('... curve type must be Linear, Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%CoolCombRatioPTR = GetCurveIndex(cAlphaArgs(11))
IF(VRF(VRFNum)%CoolCombRatioPTR .GT. 0)THEN
! Verify Curve Object, only legal type is linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%CoolCombRatioPTR))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(11))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%CoolCombRatioPTR)))
CALL ShowContinueError('... curve type must be Linear, Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%CoolPLFFPLR = GetCurveIndex(cAlphaArgs(12))
IF(VRF(VRFNum)%CoolPLFFPLR .GT. 0)THEN
! Verify Curve Object, only legal type is linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%CoolPLFFPLR))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(12))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%CoolPLFFPLR)))
CALL ShowContinueError('... curve type must be Linear, Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%HeatingCapacity = rNumericArgs(5)
VRF(VRFNum)%HeatingCapacitySizeRatio = rNumericArgs(6)
IF(.NOT. lNumericFieldBlanks(6) .AND. VRF(VRFNum)%HeatingCapacity .EQ. Autosize)THEN
VRF(VRFNum)%LockHeatingCapacity = .TRUE.
ENDIF
VRF(VRFNum)%HeatingCOP = rNumericArgs(7)
VRF(VRFNum)%MinOATHeating = rNumericArgs(8)
VRF(VRFNum)%MaxOATHeating = rNumericArgs(9)
IF(VRF(VRFNum)%MinOATHeating .GE. VRF(VRFNum)%MaxOATHeating)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)//'"')
CALL ShowContinueError('... '//TRIM(cNumericFieldNames(8))//' ('//TRIM(TrimSigDigits(VRF(VRFNum)%MinOATHeating,3))// &
') must be less than maximum ('//TRIM(TrimSigDigits(VRF(VRFNum)%MaxOATHeating,3))//').')
ErrorsFound=.TRUE.
END IF
VRF(VRFNum)%HeatCapFT = GetCurveIndex(cAlphaArgs(13))
IF(VRF(VRFNum)%HeatCapFT .GT. 0)THEN
! Verify Curve Object, only legal type is biquadratic
SELECT CASE(GetCurveType(VRF(VRFNum)%HeatCapFT))
CASE('BIQUADRATIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(13))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%HeatCapFT)))
CALL ShowContinueError('... curve type must be BiQuadratic.')
ErrorsFound=.TRUE.
END SELECT
! only show error if heating coil is present, since TU's have not yet been read, do this later in GetInput
! ELSE
! CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
! '" '//TRIM(cAlphaFieldNames(13))//' not found.')
! ErrorsFound=.TRUE.
END IF
VRF(VRFNum)%HeatBoundaryCurvePtr = GetCurveIndex(cAlphaArgs(14))
IF(VRF(VRFNum)%HeatBoundaryCurvePtr .GT. 0)THEN
! Verify Curve Object, only legal type is linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%HeatBoundaryCurvePtr))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(14))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%HeatBoundaryCurvePtr)))
CALL ShowContinueError('... curve type must be Linear, Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%HeatCapFTHi = GetCurveIndex(cAlphaArgs(15))
IF(VRF(VRFNum)%HeatCapFTHi .GT. 0)THEN
! Verify Curve Object, only legal type is biquadratic
SELECT CASE(GetCurveType(VRF(VRFNum)%HeatCapFTHi))
CASE('BIQUADRATIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(15))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%HeatCapFTHi)))
CALL ShowContinueError('... curve type must be BiQuadratic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%HeatEIRFT = GetCurveIndex(cAlphaArgs(16))
IF(VRF(VRFNum)%HeatEIRFT .GT. 0)THEN
! Verify Curve Object, only legal type is biquadratic
SELECT CASE(GetCurveType(VRF(VRFNum)%HeatEIRFT))
CASE('BIQUADRATIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(16))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%HeatEIRFT)))
CALL ShowContinueError('... curve type must be BiQuadratic.')
ErrorsFound=.TRUE.
END SELECT
! only show error if heating coil is present, since TU's have not yet been read, do this later in GetInput
! ELSE
! CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
! '" '//TRIM(cAlphaFieldNames(16))//' not found.')
! ErrorsFound=.TRUE.
END IF
VRF(VRFNum)%EIRHeatBoundaryCurvePtr = GetCurveIndex(cAlphaArgs(17))
IF(VRF(VRFNum)%EIRHeatBoundaryCurvePtr .GT. 0)THEN
! Verify Curve Object, only legal type is linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%EIRHeatBoundaryCurvePtr))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(17))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%EIRHeatBoundaryCurvePtr)))
CALL ShowContinueError('... curve type must be Linear, Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%HeatEIRFTHi = GetCurveIndex(cAlphaArgs(18))
IF(VRF(VRFNum)%HeatEIRFTHi .GT. 0)THEN
! Verify Curve Object, only legal type is biquadratic
SELECT CASE(GetCurveType(VRF(VRFNum)%HeatEIRFTHi))
CASE('BIQUADRATIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(18))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%HeatEIRFTHi)))
CALL ShowContinueError('... curve type must be BiQuadratic.')
ErrorsFound=.TRUE.
END SELECT
END IF
IF(SameString(cAlphaArgs(19),'WETBULBTEMPERATURE'))THEN
VRF(VRFNum)%HeatingPerformanceOATType = WetBulbIndicator
ELSE IF(SameString(cAlphaArgs(19),'DRYBULBTEMPERATURE'))THEN
VRF(VRFNum)%HeatingPerformanceOATType = DryBulbIndicator
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(19))//' input for this object = '// &
TRIM(cAlphaArgs(19)))
CALL ShowContinueError('... input must be WETBULBTEMPERATURE or DRYBULBTEMPERATURE.')
ErrorsFound=.TRUE.
END IF
VRF(VRFNum)%HeatEIRFPLR1 = GetCurveIndex(cAlphaArgs(20))
IF(VRF(VRFNum)%HeatEIRFPLR1 .GT. 0)THEN
! Verify Curve Object, only legal type is linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%HeatEIRFPLR1))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(20))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%HeatEIRFPLR1)))
CALL ShowContinueError('... curve type must be Linear, Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%HeatEIRFPLR2 = GetCurveIndex(cAlphaArgs(21))
IF(VRF(VRFNum)%HeatEIRFPLR2 .GT. 0)THEN
! Verify Curve Object, only legal type is linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%HeatEIRFPLR2))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(21))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%HeatEIRFPLR2)))
CALL ShowContinueError('... curve type must be Linear, Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%HeatCombRatioPTR = GetCurveIndex(cAlphaArgs(22))
IF(VRF(VRFNum)%HeatCombRatioPTR .GT. 0)THEN
! Verify Curve Object, only legal type is linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%HeatCombRatioPTR))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(22))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%HeatCombRatioPTR)))
CALL ShowContinueError('... curve type must be Linear, Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%HeatPLFFPLR = GetCurveIndex(cAlphaArgs(23))
IF(VRF(VRFNum)%HeatPLFFPLR .GT. 0)THEN
! Verify Curve Object, only legal type is linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%HeatPLFFPLR))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(23))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%HeatPLFFPLR)))
CALL ShowContinueError('... curve type must be Linear, Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%MinPLR = rNumericArgs(10)
VRF(VRFNum)%MasterZonePtr = FindItemInList(cAlphaArgs(24),Zone%Name,NumOfZones)
IF (SameString(cAlphaArgs(25),'LoadPriority') )THEN
VRF(VRFNum)%ThermostatPriority = LoadPriority
ELSE IF (SameString(cAlphaArgs(25),'ZonePriority') )THEN
VRF(VRFNum)%ThermostatPriority = ZonePriority
ELSE IF (SameString(cAlphaArgs(25),'ThermostatOffsetPriority') )THEN
VRF(VRFNum)%ThermostatPriority = ThermostatOffsetPriority
ELSE IF (SameString(cAlphaArgs(25),'Scheduled') )THEN
VRF(VRFNum)%ThermostatPriority = ScheduledPriority
ELSE IF (SameString(cAlphaArgs(25),'MasterThermostatPriority') )THEN
VRF(VRFNum)%ThermostatPriority = MasterThermostatPriority
IF(VRF(VRFNum)%MasterZonePtr == 0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = "'//TRIM(VRF(VRFNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(24))//' must be entered when '// &
TRIM(cAlphaFieldNames(25))//' = '//TRIM(cAlphaArgs(25)))
ErrorsFound = .TRUE.
END IF
! ELSE IF (SameString(cAlphaArgs(25),'FirstOnPriority') )THEN ! strategy not used
! VRF(VRFNum)%ThermostatPriority = FirstOnPriority
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(VRF(VRFNum)%Name))
CALL ShowContinueError('Illegal '//TRIM(cAlphaFieldNames(25))//' = '//TRIM(cAlphaArgs(25)))
ErrorsFound = .TRUE.
END IF
IF(VRF(VRFNum)%ThermostatPriority == ScheduledPriority)THEN
VRF(VRFNum)%SchedPriorityPtr = GetScheduleIndex(cAlphaArgs(26))
IF(VRF(VRFNum)%SchedPriorityPtr == 0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(VRF(VRFNum)%Name))
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(26))//' = '//TRIM(cAlphaArgs(26))//' not found.')
CALL ShowContinueError('A schedule name is required when '//TRIM(cAlphaFieldNames(25))//' = '//TRIM(cAlphaArgs(25)))
ErrorsFound = .TRUE.
END IF
END IF
VRF(VRFNum)%ZoneTUListPtr = FindItemInList(cAlphaArgs(27),TerminalUnitList%Name,NumVRFTULists)
IF(VRF(VRFNum)%ZoneTUListPtr == 0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = "'//TRIM(VRF(VRFNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(27))//' = '//TRIM(cAlphaArgs(27))//' not found.')
ErrorsFound = .TRUE.
END IF
VRF(VRFNum)%HeatRecoveryUsed = .FALSE.
IF(.NOT. lAlphaFieldBlanks(28))THEN
IF (SameString(cAlphaArgs(28),'No') )THEN
VRF(VRFNum)%HeatRecoveryUsed = .FALSE.
ELSE IF (SameString(cAlphaArgs(28),'Yes') )THEN
VRF(VRFNum)%HeatRecoveryUsed = .TRUE.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(VRF(VRFNum)%Name))
CALL ShowContinueError('Illegal '//TRIM(cAlphaFieldNames(28))//' = '//TRIM(cAlphaArgs(28)))
ErrorsFound = .TRUE.
END IF
END IF
VRF(VRFNum)%EquivPipeLngthCool = rNumericArgs(11)
VRF(VRFNum)%VertPipeLngth = rNumericArgs(12)
VRF(VRFNum)%PCFLengthCoolPtr = GetCurveIndex(cAlphaArgs(29))
IF(VRF(VRFNum)%PCFLengthCoolPtr .GT. 0)THEN
! Verify Curve Object, only legal type is linear, quadratic, cubic, or biquadratic
SELECT CASE(GetCurveType(VRF(VRFNum)%PCFLengthCoolPtr))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE('BIQUADRATIC')
VRF(VRFNum)%PCFLengthCoolPtrType = BIQUADRATIC
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(29))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%PCFLengthCoolPtr)))
CALL ShowContinueError('... curve type must be Linear, Quadratic, Cubic or BiQuadratic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%PCFHeightCool = rNumericArgs(13)
VRF(VRFNum)%EquivPipeLngthHeat = rNumericArgs(14)
VRF(VRFNum)%PCFLengthHeatPtr = GetCurveIndex(cAlphaArgs(30))
IF(VRF(VRFNum)%PCFLengthHeatPtr .GT. 0)THEN
! Verify Curve Object, only legal type is linear, quadratic, cubic, or biquadratic
SELECT CASE(GetCurveType(VRF(VRFNum)%PCFLengthHeatPtr))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE('BIQUADRATIC')
VRF(VRFNum)%PCFLengthHeatPtrType = BIQUADRATIC
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(30))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%PCFLengthHeatPtr)))
CALL ShowContinueError('... curve type must be Linear, Quadratic, Cubic or BiQuadratic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%PCFHeightHeat = rNumericArgs(15)
VRF(VRFNum)%CCHeaterPower = rNumericArgs(16)
VRF(VRFNum)%NumCompressors = rNumericArgs(17)
VRF(VRFNum)%CompressorSizeRatio = rNumericArgs(18)
VRF(VRFNum)%MaxOATCCHeater = rNumericArgs(19)
IF(.NOT. lAlphaFieldBlanks(31))THEN
IF (SameString(cAlphaArgs(31),'ReverseCycle')) VRF(VRFNum)%DefrostStrategy = ReverseCycle
IF (SameString(cAlphaArgs(31),'Resistive')) VRF(VRFNum)%DefrostStrategy = Resistive
IF (VRF(VRFNum)%DefrostStrategy .EQ.0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)//&
'" '//TRIM(cAlphaFieldNames(31))//' not found: '//TRIM(cAlphaArgs(31)))
ErrorsFound = .TRUE.
END IF
ELSE
VRF(VRFNum)%DefrostStrategy = ReverseCycle
END IF
IF(.NOT. lAlphaFieldBlanks(32))THEN
IF (SameString(cAlphaArgs(32),'Timed')) VRF(VRFNum)%DefrostControl = Timed
IF (SameString(cAlphaArgs(32),'OnDemand')) VRF(VRFNum)%DefrostControl = OnDemand
IF (VRF(VRFNum)%DefrostControl .EQ.0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)//&
'" '//TRIM(cAlphaFieldNames(32))//' not found: '//TRIM(cAlphaArgs(32)))
ErrorsFound = .TRUE.
END IF
ELSE
VRF(VRFNum)%DefrostControl = Timed
END IF
IF (.NOT. lAlphaFieldBlanks(33)) THEN
VRF(VRFNum)%DefrostEIRPtr = GetCurveIndex(cAlphaArgs(33))
IF(VRF(VRFNum)%DefrostEIRPtr .GT. 0)THEN
! Verify Curve Object, only legal type is linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%DefrostEIRPtr))
CASE('BIQUADRATIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(33))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%DefrostEIRPtr)))
CALL ShowContinueError('... curve type must be BiQuadratic.')
ErrorsFound=.TRUE.
END SELECT
ELSE
IF (SameString(cAlphaArgs(31),'ReverseCycle')) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)//&
'" '//TRIM(cAlphaFieldNames(33))//' not found:'//TRIM(cAlphaArgs(33)))
ErrorsFound = .TRUE.
END IF
END IF
ELSE
IF (SameString(cAlphaArgs(31),'ReverseCycle')) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)//&
'" '//TRIM(cAlphaFieldNames(33))//' not found:'//TRIM(cAlphaArgs(33)))
ErrorsFound = .TRUE.
END IF
END IF
VRF(VRFNum)%DefrostFraction = rNumericArgs(20)
VRF(VRFNum)%DefrostCapacity = rNumericArgs(21)
IF(VRF(VRFNum)%DefrostCapacity .EQ. 0.0d0 .AND. VRF(VRFNum)%DefrostStrategy .EQ. RESISTIVE) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)//&
'" '//TRIM(cNumericFieldNames(21))//' = 0.0 for defrost strategy = RESISTIVE.')
END IF
VRF(VRFNum)%MaxOATDefrost = rNumericArgs(22)
IF (.NOT. lAlphaFieldBlanks(35)) THEN
IF (SameString(cAlphaArgs(34),'AirCooled') ) VRF(VRFNum)%CondenserType = AirCooled
IF (SameString(cAlphaArgs(34),'EvaporativelyCooled') ) VRF(VRFNum)%CondenserType = EvapCooled
IF (SameString(cAlphaArgs(34),'WaterCooled') )THEN
VRF(VRFNum)%CondenserType = WaterCooled
VRF(VRFNum)%VRFPlantTypeOfNum = TypeOf_HeatPumpVRF
END IF
IF (VRF(VRFNum)%CondenserType .EQ. 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(VRF(VRFNum)%Name))
CALL ShowContinueError('Illegal '//TRIM(cAlphaFieldNames(34))//' = '//TRIM(cAlphaArgs(34)))
ErrorsFound = .TRUE.
END IF
ELSE
VRF(VRFNum)%CondenserType = AirCooled
END IF
! outdoor condenser node
IF (lAlphaFieldBlanks(35)) THEN
VRF(VRFNum)%CondenserNodeNum = 0
ELSE
SELECT CASE(VRF(VRFNum)%CondenserType)
CASE(AirCooled, EvapCooled)
VRF(VRFNum)%CondenserNodeNum = &
GetOnlySingleNode(cAlphaArgs(35),ErrorsFound,TRIM(cCurrentModuleObject),VRF(VRFNum)%Name, &
NodeType_Air,NodeConnectionType_OutsideAirReference,1,ObjectIsNotParent)
IF (.not. CheckOutAirNodeNumber(VRF(VRFNum)%CondenserNodeNum)) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)//&
'" '//TRIM(cAlphaFieldNames(35))//' not a valid Outdoor Air Node = '//TRIM(cAlphaArgs(35)))
CALL ShowContinueError('...node name does not appear in an OutdoorAir:NodeList or as an OutdoorAir:Node.')
ErrorsFound=.TRUE.
END IF
CASE(WaterCooled)
VRF(VRFNum)%CondenserNodeNum = &
GetOnlySingleNode(cAlphaArgs(35),ErrorsFound,TRIM(cCurrentModuleObject),VRF(VRFNum)%Name, &
NodeType_Water,NodeConnectionType_Inlet,2,ObjectIsNotParent)
CASE DEFAULT
END SELECT
ENDIF
IF (.NOT. lAlphaFieldBlanks(36) .AND. VRF(VRFNum)%CondenserType == WaterCooled) THEN
VRF(VRFNum)%CondenserOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(36),ErrorsFound,TRIM(cCurrentModuleObject),VRF(VRFNum)%Name, &
NodeType_Water,NodeConnectionType_Outlet,2,ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),VRF(VRFNum)%Name,cAlphaArgs(35),cAlphaArgs(36),'Condenser Water Nodes')
ELSE IF (lAlphaFieldBlanks(36) .AND. VRF(VRFNum)%CondenserType == WaterCooled) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)//&
'" '//TRIM(cAlphaFieldNames(36))//' is blank.')
CALL ShowContinueError('...node name must be entered when Condenser Type = WaterCooled.')
ErrorsFound=.TRUE.
END IF
IF(lNumericFieldBlanks(23))THEN
IF(VRF(VRFNum)%CondenserType == WaterCooled)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)//&
'" '//TRIM(cNumericFieldNames(23))//' is blank.')
CALL ShowContinueError('...input is required when '//TRIM(cAlphaFieldNames(34))//' = '//TRIM(cAlphaArgs(34)))
ErrorsFound=.TRUE.
END IF
ELSE
VRF(VRFNum)%WaterCondVolFlowRate = rNumericArgs(23)
END IF
VRF(VRFNum)%EvapCondEffectiveness = rNumericArgs(24)
VRF(VRFNum)%EvapCondAirVolFlowRate = rNumericArgs(25)
VRF(VRFNum)%EvapCondPumpPower = rNumericArgs(26)
! Get Water System tank connections
! A37, \field Supply Water Storage Tank Name
VRF(VRFNum)%EvapWaterSupplyName = cAlphaArgs(37)
IF (lAlphaFieldBlanks(37)) THEN
VRF(VRFNum)%EvapWaterSupplyMode = WaterSupplyFromMains
ELSE
VRF(VRFNum)%EvapWaterSupplyMode = WaterSupplyFromTank
CALL SetupTankDemandComponent(VRF(VRFNum)%Name,TRIM(cCurrentModuleObject), &
VRF(VRFNum)%EvapWaterSupplyName, ErrorsFound, VRF(VRFNum)%EvapWaterSupTankID, &
VRF(VRFNum)%EvapWaterTankDemandARRID )
ENDIF
! Basin heater power as a function of temperature must be greater than or equal to 0
VRF(VRFNum)%BasinHeaterPowerFTempDiff = rNumericArgs(27)
IF(rNumericArgs(27) .LT. 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = "'//TRIM(VRF(VRFNum)%Name)//&
'", '//TRIM(cNumericFieldNames(27))//' must be >= 0')
ErrorsFound = .TRUE.
END IF
VRF(VRFNum)%BasinHeaterSetPointTemp = rNumericArgs(28)
IF(VRF(VRFNum)%BasinHeaterPowerFTempDiff .GT. 0.0d0) THEN
IF(NumNums .LT. 27) THEN
VRF(VRFNum)%BasinHeaterSetPointTemp = 2.0d0
ENDIF
IF(VRF(VRFNum)%BasinHeaterSetPointTemp < 2.0d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' = "'//TRIM(VRF(VRFNum)%Name)//&
'", '//TRIM(cNumericFieldNames(28))//' is less than 2 deg C. Freezing could occur.')
END IF
END IF
IF(.NOT. lAlphaFieldBlanks(38))THEN
VRF(VRFNum)%BasinHeaterSchedulePtr = GetScheduleIndex(cAlphaArgs(38))
IF(VRF(VRFNum)%BasinHeaterSchedulePtr .EQ. 0)THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' = "'//TRIM(VRF(VRFNum)%Name)//&
'", '// TRIM(cAlphaFieldNames(38))//' = "'//TRIM(cAlphaArgs(38))//&
'" was not found.')
CALL ShowContinueError('Basin heater will be available to operate throughout the simulation.')
END IF
END IF
VRF(VRFNum)%FuelType = FuelTypeElectric
IF(.NOT. lAlphaFieldBlanks(39))THEN
!A39; \field Fuel type
IF (SameString(cAlphaArgs(39),"ELECTRICITY")) THEN
VRF(VRFNum)%FuelType = FuelTypeElectric
ELSE IF (SameString(cAlphaArgs(39),"ELECTRIC")) THEN
VRF(VRFNum)%FuelType = FuelTypeElectric
ELSE IF (SameString(cAlphaArgs(39),"NATURALGAS")) THEN
VRF(VRFNum)%FuelType = FuelTypeNaturalGas
ELSE IF (SameString(cAlphaArgs(39),"PROPANEGAS")) THEN
VRF(VRFNum)%FuelType = FuelTypePropaneGas
ELSE IF (SameString(cAlphaArgs(39),"DIESEL")) THEN
VRF(VRFNum)%FuelType = FuelTypeDiesel
ELSE IF (SameString(cAlphaArgs(39),"GASOLINE")) THEN
VRF(VRFNum)%FuelType = FuelTypeGasoline
ELSE IF (SameString(cAlphaArgs(39),"FUELOIL#1")) THEN
VRF(VRFNum)%FuelType = FuelTypeFuelOil1
ELSE IF (SameString(cAlphaArgs(39),"FUELOIL#2")) THEN
VRF(VRFNum)%FuelType = FuelTypeFuelOil2
ELSE IF (SameString(cAlphaArgs(39),'OtherFuel1')) THEN
VRF(VRFNum)%FuelType = FuelTypeOtherFuel1
ELSE IF (SameString(cAlphaArgs(39),'OtherFuel2')) THEN
VRF(VRFNum)%FuelType = FuelTypeOtherFuel2
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)//&
'", '//TRIM(cAlphaFieldNames(39))//' not found = '//TRIM(cAlphaArgs(39)))
CALL ShowContinueError('Valid choices are Electric, NaturalGas, PropaneGas, Diesel, Gasoline, FuelOil#1, '// &
'FuelOil#2, OtherFuel1 or OtherFuel2')
ErrorsFound=.TRUE.
END IF
END IF
! REAL(r64) :: MinOATHeatRecovery =0.0d0 ! Minimum outdoor air temperature for heat recovery operation (C)
! REAL(r64) :: MaxOATHeatRecovery =0.0d0 ! Maximum outdoor air temperature for heat recovery operation (C)
IF(VRF(VRFNum)%HeatRecoveryUsed)THEN
IF(lNumericFieldBlanks(29))THEN
VRF(VRFNum)%MinOATHeatRecovery = MAX(VRF(VRFNum)%MinOATCooling,VRF(VRFNum)%MinOATHeating)
ELSE
VRF(VRFNum)%MinOATHeatRecovery = rNumericArgs(29)
IF(VRF(VRFNum)%MinOATHeatRecovery .LT. VRF(VRFNum)%MinOATCooling .OR. &
VRF(VRFNum)%MinOATHeatRecovery .LT. VRF(VRFNum)%MinOATHeating)THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' = "'//TRIM(VRF(VRFNum)%Name)//&
'", '//TRIM(cNumericFieldNames(29))//' is less than the minimum temperature in heat pump mode.')
CALL ShowContinueError('...'//TRIM(cNumericFieldNames(29))//' = '// &
TRIM(TrimSigDigits(VRF(VRFNum)%MinOATHeatRecovery,2))//' C')
CALL ShowContinueError('...Minimum Outdoor Temperature in Cooling Mode = '// &
TRIM(TrimSigDigits(VRF(VRFNum)%MinOATCooling,2))//' C')
CALL ShowContinueError('...Minimum Outdoor Temperature in Heating Mode = '// &
TRIM(TrimSigDigits(VRF(VRFNum)%MinOATHeating,2))//' C')
CALL ShowContinueError('...Minimum Outdoor Temperature in Heat Recovery Mode reset to greater'// &
' of cooling or heating minimum temperature and simulation continues.')
VRF(VRFNum)%MinOATHeatRecovery = MAX(VRF(VRFNum)%MinOATCooling,VRF(VRFNum)%MinOATHeating)
CALL ShowContinueError('... adjusted '//TRIM(cNumericFieldNames(29))//' = '// &
TRIM(TrimSigDigits(VRF(VRFNum)%MinOATHeatRecovery,2))//' C')
END IF
END IF
IF(lNumericFieldBlanks(30))THEN
VRF(VRFNum)%MaxOATHeatRecovery = MIN(VRF(VRFNum)%MaxOATCooling,VRF(VRFNum)%MaxOATHeating)
ELSE
VRF(VRFNum)%MaxOATHeatRecovery = rNumericArgs(30)
IF(VRF(VRFNum)%MaxOATHeatRecovery .GT. VRF(VRFNum)%MaxOATCooling .OR. &
VRF(VRFNum)%MaxOATHeatRecovery .GT. VRF(VRFNum)%MaxOATHeating)THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' = "'//TRIM(VRF(VRFNum)%Name)//&
'", '//TRIM(cNumericFieldNames(30))//' is greater than the maximum temperature in heat pump mode.')
CALL ShowContinueError('...'//TRIM(cNumericFieldNames(30))//' = '// &
TRIM(TrimSigDigits(VRF(VRFNum)%MaxOATHeatRecovery,2))//' C')
CALL ShowContinueError('...Maximum Outdoor Temperature in Cooling Mode = '// &
TRIM(TrimSigDigits(VRF(VRFNum)%MaxOATCooling,2))//' C')
CALL ShowContinueError('...Maximum Outdoor Temperature in Heating Mode = '// &
TRIM(TrimSigDigits(VRF(VRFNum)%MaxOATHeating,2))//' C')
CALL ShowContinueError('...Maximum Outdoor Temperature in Heat Recovery Mode reset to lesser'// &
' of cooling or heating minimum temperature and simulation continues.')
VRF(VRFNum)%MaxOATHeatRecovery = MIN(VRF(VRFNum)%MaxOATCooling,VRF(VRFNum)%MaxOATHeating)
CALL ShowContinueError('... adjusted '//TRIM(cNumericFieldNames(30))//' = '// &
TRIM(TrimSigDigits(VRF(VRFNum)%MaxOATHeatRecovery,2))//' C')
END IF
END IF
! INTEGER :: HRCAPFTCool =0 ! Index to cool capacity as a function of temperature curve for heat recovery
! REAL(r64) :: HRInitialCoolCapFrac =0.0d0 ! Fractional cooling degradation at the start of heat recovery from cooling mode
! REAL(r64) :: HRCoolCapTC =0.0d0 ! Time constant used to recover from intial degratation in cooling heat recovery
VRF(VRFNum)%HRCAPFTCool = GetCurveIndex(cAlphaArgs(40))
IF(VRF(VRFNum)%HRCAPFTCool .GT. 0)THEN
! Verify Curve Object, only legal type is bi-quadratic or linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%HRCAPFTCool))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE('BIQUADRATIC')
VRF(VRFNum)%HRCAPFTCoolType = BIQUADRATIC
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(40))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%HRCAPFTCool)))
CALL ShowContinueError('... curve type must be Bi-Quadratic, Linear, Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
END IF
IF(.NOT. lNumericFieldBlanks(31))THEN
VRF(VRFNum)%HRInitialCoolCapFrac = rNumericArgs(31)
END IF
VRF(VRFNum)%HRCoolCapTC = rNumericArgs(32)
! INTEGER :: HREIRFTCool =0 ! Index to cool EIR as a function of temperature curve for heat recovery
! REAL(r64) :: HRInitialCoolEIRFrac =0.0d0 ! Fractional EIR degradation at the start of heat recovery from cooling mode
! REAL(r64) :: HRCoolEIRTC =0.0d0 ! Time constant used to recover from intial degratation in cooling heat recovery
VRF(VRFNum)%HREIRFTCool = GetCurveIndex(cAlphaArgs(41))
IF(VRF(VRFNum)%HREIRFTCool .GT. 0)THEN
! Verify Curve Object, only legal type is bi-quadratic or linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%HREIRFTCool))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE('BIQUADRATIC')
VRF(VRFNum)%HREIRFTCoolType = BIQUADRATIC
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(41))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%HREIRFTCool)))
CALL ShowContinueError('... curve type must be Bi-Quadratic, Linear, Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%HRInitialCoolEIRFrac = rNumericArgs(33)
VRF(VRFNum)%HRCoolEIRTC = rNumericArgs(34)
! INTEGER :: HRCAPFTHeat =0 ! Index to heat capacity as a function of temperature curve for heat recovery
! REAL(r64) :: HRInitialHeatCapFrac =0.0d0 ! Fractional heating degradation at the start of heat recovery from heating mode
! REAL(r64) :: HRHeatCapTC =0.0d0 ! Time constant used to recover from intial degratation in heating heat recovery
VRF(VRFNum)%HRCAPFTHeat = GetCurveIndex(cAlphaArgs(42))
IF(VRF(VRFNum)%HRCAPFTHeat .GT. 0)THEN
! Verify Curve Object, only legal type is bi-quadratic or linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%HRCAPFTHeat))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE('BIQUADRATIC')
VRF(VRFNum)%HRCAPFTHeatType = BIQUADRATIC
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(42))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%HRCAPFTHeat)))
CALL ShowContinueError('... curve type must be Bi-Quadratic, Linear, Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%HRInitialHeatCapFrac = rNumericArgs(35)
VRF(VRFNum)%HRHeatCapTC = rNumericArgs(36)
! INTEGER :: HREIRFTHeat =0 ! Index to heat EIR as a function of temperature curve for heat recovery
! REAL(r64) :: HRInitialHeatEIRFrac =0.0d0 ! Fractional EIR degradation at the start of heat recovery from heating mode
! REAL(r64) :: HRHeatEIRTC =0.0d0 ! Time constant used to recover from intial degratation in heating heat recovery
VRF(VRFNum)%HREIRFTHeat = GetCurveIndex(cAlphaArgs(43))
IF(VRF(VRFNum)%HREIRFTHeat .GT. 0)THEN
! Verify Curve Object, only legal type is bi-quadratic or linear, quadratic, or cubic
SELECT CASE(GetCurveType(VRF(VRFNum)%HREIRFTHeat))
CASE('LINEAR', 'QUADRATIC', 'CUBIC')
CASE('BIQUADRATIC')
VRF(VRFNum)%HREIRFTHeatType = BIQUADRATIC
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(VRF(VRFNum)%Name)// &
'" illegal '//TRIM(cAlphaFieldNames(43))//' type for this object = '// &
TRIM(GetCurveType(VRF(VRFNum)%HREIRFTHeat)))
CALL ShowContinueError('... curve type must be Bi-Quadratic, Linear, Quadratic or Cubic.')
ErrorsFound=.TRUE.
END SELECT
END IF
VRF(VRFNum)%HRInitialHeatEIRFrac = rNumericArgs(37)
VRF(VRFNum)%HRHeatEIRTC = rNumericArgs(38)
ELSE
END IF
IF(VRF(VRFNum)%CondenserType == WaterCooled)THEN
!scan for loop connection data
errFlag=.false.
CALL ScanPlantLoopsForObject(VRF(VRFNum)%Name, &
VRF(VRFNum)%VRFPlantTypeOfNum, &
VRF(VRFNum)%SourceLoopNum, &
VRF(VRFNum)%SourceLoopSideNum, &
VRF(VRFNum)%SourceBranchNum, &
VRF(VRFNum)%SourceCompNum, &
inletNodeNumber = VRF(VRFNum)%CondenserNodeNum, &
errflag=errFlag)
IF (errFlag) THEN
CALL ShowSevereError('GetVRFInput: Error scanning for plant loop data')
ErrorsFound=.TRUE.
ENDIF
END IF
END DO
cCurrentModuleObject= 'ZoneHVAC:TerminalUnit:VariableRefrigerantFlow'
DO VRFNum = 1, NumVRFTU
VRFTUNum = VRFNum
! initialize local node number variables
FanInletNodeNum = 0
FanOutletNodeNum = 0
CCoilInletNodeNum = 0
CCoilOutletNodeNum = 0
HCoilInletNodeNum = 0
HCoilOutletNodeNum = 0
CALL GetObjectItem(cCurrentModuleObject,VRFTUNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),VRFTU%Name,VRFTUNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
VRFTU(VRFTUNum)%Name = cAlphaArgs(1)
ZoneTerminalUnitListNum = 0
DO NumList = 1, NumVRFTULists
ZoneTerminalUnitListNum = FindItemInList(VRFTU(VRFTUNum)%Name,TerminalUnitList(NumList)%ZoneTUName, &
TerminalUnitList(NumList)%NumTUInList)
IF(ZoneTerminalUnitListNum .GT. 0)THEN
VRFTU(VRFTUNum)%IndexToTUInTUList = ZoneTerminalUnitListNum
TerminalUnitList(NumList)%ZoneTUPtr(ZoneTerminalUnitListNum) = VRFTUNum
VRFTU(VRFTUNum)%TUListIndex = NumList
EXIT
END IF
END DO
IF(VRFTU(VRFTUNum)%TUListIndex .EQ. 0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(VRFTU(VRFTUNum)%Name))
CALL ShowContinueError('Terminal unit not found on any ZoneTerminalUnitList.')
ErrorsFound=.true.
END IF
DO NumCond = 1, NumVRFCond
IF(VRF(NumCond)%ZoneTUListPtr /= VRFTU(VRFTUNum)%TUListIndex)CYCLE
VRFTU(VRFTUNum)%VRFSysNum = NumCond
EXIT
END DO
VRFTU(VRFTUNum)%VRFTUType_Num = VRFTUType_ConstVolume
IF (lAlphaFieldBlanks(2)) THEN
VRFTU(VRFTUNum)%SchedPtr = ScheduleAlwaysOn
ELSE
VRFTU(VRFTUNum)%SchedPtr = GetScheduleIndex(cAlphaArgs(2))
IF (VRFTU(VRFTUNum)%SchedPtr == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(VRFTU(VRFTUNum)%Name)//'" invalid data')
CALL ShowContinueError('Invalid-not found '//trim(cAlphaFieldNames(2))//'="'// &
trim(cAlphaArgs(2))//'".')
ErrorsFound=.true.
ENDIF
ENDIF
VRFTU(VRFTUNum)%VRFTUInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),VRFTU(VRFTUNum)%Name, &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsParent)
VRFTU(VRFTUNum)%VRFTUOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),VRFTU(VRFTUNum)%Name, &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsParent)
VRFTU(VRFTUNum)%MaxCoolAirVolFlow = rNumericArgs(1)
VRFTU(VRFTUNum)%MaxNoCoolAirVolFlow = rNumericArgs(2)
VRFTU(VRFTUNum)%MaxHeatAirVolFlow = rNumericArgs(3)
VRFTU(VRFTUNum)%MaxNoHeatAirVolFlow = rNumericArgs(4)
VRFTU(VRFTUNum)%CoolOutAirVolFlow = rNumericArgs(5)
VRFTU(VRFTUNum)%HeatOutAirVolFlow = rNumericArgs(6)
VRFTU(VRFTUNum)%NoCoolHeatOutAirVolFlow = rNumericArgs(7)
VRFTU(VRFTUNum)%FanOpModeSchedPtr = GetScheduleIndex(cAlphaArgs(5))
! default to constant fan operating mode
IF(VRFTU(VRFTUNum)%FanOpModeSchedPtr == 0)THEN
IF(.NOT. lAlphaFieldBlanks(5))THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(VRFTU(VRFTUNum)%Name))
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(5))//' = '//TRIM(cAlphaArgs(5))//' not found.')
CALL ShowContinueError('...Defaulting to constant fan operating mode and simulation continues.')
END IF
VRFTU(VRFTUNum)%OpMode = ContFanCycCoil
END IF
IF (SameString(cAlphaArgs(6),'BlowThrough') ) VRFTU(VRFTUNum)%FanPlace = BlowThru
IF (SameString(cAlphaArgs(6),'DrawThrough') ) VRFTU(VRFTUNum)%FanPlace = DrawThru
IF (VRFTU(VRFTUNum)%FanPlace .EQ.0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(VRFTU(VRFTUNum)%Name))
CALL ShowContinueError('Illegal '//TRIM(cAlphaFieldNames(6))//' = '//TRIM(cAlphaArgs(6)))
ErrorsFound = .TRUE.
END IF
!Get fan data
FanType = cAlphaArgs(7)
FanName = cAlphaArgs(8)
ErrFlag=.FALSE.
CALL GetFanType(TRIM(FanName), FanType_Num, ErrFlag, TRIM(cCurrentModuleObject))
IF (ErrFlag) THEN
CALL ShowContinueError('...occurs in '//TRIM(cCurrentModuleObject)//' = '//TRIM(VRFTU(VRFTUNum)%Name))
ErrorsFound=.TRUE.
END IF
IF(.NOT. SameString(cFanTypes(FanType_Num),FanType))THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(VRFTU(VRFTUNum)%Name))
CALL ShowContinueError('Fan type specified = '//TRIM(cAlphaArgs(7)))
CALL ShowContinueError('Based on the fan name the type of fan actually used = '//TRIM(cFanTypes(FanType_Num)))
ErrorsFound = .TRUE.
END IF
IF (FanType_Num == FanType_SimpleOnOff .OR. FanType_Num == FanType_SimpleConstVolume)THEN
CALL ValidateComponent(cFanTypes(FanType_Num),FanName,IsNotOK,TRIM(cCurrentModuleObject))
IF (IsNotOK) THEN
CALL ShowContinueError('...occurs in '//TRIM(cCurrentModuleObject)//' = '//TRIM(VRFTU(VRFTUNum)%Name))
ErrorsFound=.TRUE.
ELSE ! mine data from fan object
! Get the fan index
ErrFlag=.FALSE.
CALL GetFanIndex(FanName, VRFTU(VRFTUNum)%FanIndex, ErrFlag)
IF (ErrFlag) THEN
CALL ShowContinueError('...occurs in '//TRIM(cCurrentModuleObject)//' = '//TRIM(VRFTU(VRFTUNum)%Name))
ErrorsFound=.TRUE.
ENDIF
!Set the Design Fan Volume Flow Rate
ErrFlag=.FALSE.
FanVolFlowRate = GetFanDesignVolumeFlowRate(FanType,FanName,ErrFlag)
VRFTU(VRFTUNum)%ActualFanVolFlowRate = FanVolFlowRate
IF (ErrFlag) THEN
CALL ShowContinueError('...occurs in '//TRIM(cCurrentModuleObject)//' ='//TRIM(VRFTU(VRFTUNum)%Name))
ErrorsFound=.TRUE.
ENDIF
! Get the Fan Inlet Node
ErrFlag=.FALSE.
FanInletNodeNum = GetFanInletNode(FanType,FanName,ErrFlag)
IF (ErrFlag) THEN
CALL ShowContinueError('...occurs in '//TRIM(cCurrentModuleObject)//' = '//TRIM(VRFTU(VRFTUNum)%Name))
ErrorsFound=.TRUE.
ENDIF
! Get the Fan Outlet Node
ErrFlag=.FALSE.
FanOutletNodeNum = GetFanOutletNode(FanType,FanName,ErrFlag)
IF (ErrFlag) THEN
CALL ShowContinueError('...occurs in '//TRIM(cCurrentModuleObject)//' = '//TRIM(VRFTU(VRFTUNum)%Name))
ErrorsFound=.TRUE.
ENDIF
! Get the fan's availabitlity schedule
ErrFlag=.FALSE.
VRFTU(VRFTUNum)%FanAvailSchedPtr = GetFanAvailSchPtr(FanType,FanName,ErrFlag)
IF (ErrFlag) THEN
CALL ShowContinueError('...occurs in '//TRIM(cCurrentModuleObject)//' = '//TRIM(VRFTU(VRFTUNum)%Name))
ErrorsFound=.TRUE.
ENDIF
! Check fan's schedule for cycling fan operation if constant volume fan is used
IF(VRFTU(VRFTUNum)%FanOpModeSchedPtr .GT. 0 .AND. FanType_Num == FanType_SimpleConstVolume)THEN
IF (.NOT. CheckScheduleValueMinMax(VRFTU(VRFTUNum)%FanOpModeSchedPtr,'>',0.0d0,'<=',1.0d0)) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(VRFTU(VRFTUNum)%Name))
CALL ShowContinueError('For fan type = '//TRIM(cFanTypes(FanType_SimpleConstVolume)))
CALL ShowContinueError('Fan operating mode must be continuous (fan operating mode schedule values > 0).')
CALL ShowContinueError('Error found in '//TRIM(cAlphaFieldNames(5))//' = '//TRIM(cAlphaArgs(5)))
CALL ShowContinueError('...schedule values must be (>0., <=1.)')
ErrorsFound=.TRUE.
END IF
END IF
ENDIF ! IF (IsNotOK) THEN
ELSE ! IF (FanType_Num == FanType_SimpleOnOff .OR. FanType_Num == FanType_SimpleConstVolume)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(VRFTU(VRFTUNum)%Name))
CALL ShowContinueError('Illegal '//TRIM(cAlphaFieldNames(7))//' = '//TRIM(cAlphaArgs(7)))
ErrorsFound=.TRUE.
END IF ! IF (FanType_Num == FanType_SimpleOnOff .OR. FanType_Num == FanType_SimpleConstVolume)THEN
!Get OA mixer data
OAMixerType = cAlphaArgs(9)
IF(.NOT. lAlphaFieldBlanks(10))THEN
VRFTU(VRFTUNum)%OAMixerName = cAlphaArgs(10)
ErrFlag=.FALSE.
OANodeNums = GetOAMixerNodeNumbers(VRFTU(VRFTUNum)%OAMixerName, ErrFlag)
! OANodeNums(1) = OAMixer(OAMixerNum)%InletNode
! OANodeNums(2) = OAMixer(OAMixerNum)%RelNode
! OANodeNums(3) = OAMixer(OAMixerNum)%RetNode
! OANodeNums(4) = OAMixer(OAMixerNum)%MixNode
IF(ErrFlag)THEN
CALL ShowContinueError('Occurs in '//TRIM(cCurrentModuleObject)//' = '//TRIM(VRFTU(VRFTUNum)%Name))
ErrorsFound=.TRUE.
ELSE
VRFTU(VRFTUNum)%OAMixerUsed = .TRUE.
END IF
VRFTU(VRFTUNum)%VRFTUOAMixerOANodeNum = OANodeNums(1)
VRFTU(VRFTUNum)%VRFTUOAMixerRelNodeNum = OANodeNums(2)
VRFTU(VRFTUNum)%VRFTUOAMixerRetNodeNum = OANodeNums(3)
END IF
!Get DX cooling coil data
DXCoolingCoilType = cAlphaArgs(11)
ErrFlag = .FALSE.
VRFTU(VRFTUNum)%DXCoolCoilType_Num = GetCoilTypeNum(TRIM(DXCoolingCoilType),cAlphaArgs(12),ErrFlag,.FALSE.)
IF(VRFTU(VRFTUNum)%DXCoolCoilType_Num == 0)THEN
VRFTU(VRFTUNum)%CoolingCoilPresent = .FALSE.
IF(VRFTU(VRFTUNum)%TUListIndex .GT. 0 .AND. VRFTU(VRFTUNum)%IndexToTUInTUList .GT. 0)THEN
TerminalUnitList(VRFTU(VRFTUNum)%TUListIndex)%CoolingCoilPresent(VRFTU(VRFTUNum)%IndexToTUInTUList) = .FALSE.
END IF
ELSE
IF (SameString(cAllCoilTypes(VRFTU(VRFTUNum)%DXCoolCoilType_Num),cAllCoilTypes(CoilVRF_Cooling))) THEN
ErrFlag = .FALSE.
TerminalUnitList(VRFTU(VRFTUNum)%TUListIndex)%CoolingCoilAvailSchPtr(VRFTU(VRFTUNum)%IndexToTUInTUList) = &
GetDXCoilAvailSchPtr(DXCoolingCoilType,cAlphaArgs(12),ErrFlag)
CALL GetDXCoolCoilIndex(cAlphaArgs(12),VRFTU(VRFTUNum)%CoolCoilIndex, &
ErrFlag, cAllCoilTypes(CoilVRF_Cooling))
CCoilInletNodeNum = GetDXCoilInletNode(cAllCoilTypes(CoilVRF_Cooling),cAlphaArgs(12),ErrFlag)
CCoilOutletNodeNum = GetDXCoilOutletNode(cAllCoilTypes(CoilVRF_Cooling),cAlphaArgs(12),ErrFlag)
IF(ErrFlag)CALL ShowContinueError('...occurs in '//TRIM(cCurrentModuleObject)// &
' "'//TRIM(VRFTU(VRFTUNum)%Name)//'"')
IF(VRFTU(VRFTUNum)%VRFSysNum .GT. 0)THEN
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%CoolCoilIndex,ErrorsFound, &
CondenserType=VRF(VRFTU(VRFTUNum)%VRFSysNum)%CondenserType)
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%CoolCoilIndex,ErrorsFound, &
CondenserInletNodeNum=VRF(VRFTU(VRFTUNum)%VRFSysNum)%CondenserNodeNum)
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%CoolCoilIndex,ErrorsFound, &
MaxOATCrankcaseHeater=VRF(VRFTU(VRFTUNum)%VRFSysNum)%MaxOATCCHeater)
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%CoolCoilIndex,ErrorsFound, &
MinOATCooling=VRF(VRFTU(VRFTUNum)%VRFSysNum)%MinOATCooling)
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%CoolCoilIndex,ErrorsFound, &
MaxOATCooling=VRF(VRFTU(VRFTUNum)%VRFSysNum)%MaxOATCooling)
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//'"')
CALL ShowContinueError('... when checking '//TRIM(cAllCoilTypes(VRFTU(VRFTUNum)%DXCoolCoilType_Num))// &
' "'//TRIM(cAlphaArgs(12))//'"')
CALL ShowContinueError('... terminal unit not connected to condenser.')
CALL ShowContinueError('... check that terminal unit is specified in a terminal unit list object.')
CALL ShowContinueError('... also check that the terminal unit list name is specified in an '// &
'AirConditioner:VariableRefrigerantFlow object.')
ErrorsFound = .TRUE.
END IF
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//'"')
CALL ShowContinueError('... illegal '//TRIM(cAlphaFieldNames(12))//' = '//TRIM(cAlphaArgs(12)))
ErrorsFound = .TRUE.
END IF
END IF
!Get DX heating coil data
DXHeatingCoilType = cAlphaArgs(13)
! Get the heating to cooling sizing ratio input before writing to DX heating coil data
IF(.NOT. lNumericFieldBlanks(10))THEN
VRFTU(VRFTUNum)%HeatingCapacitySizeRatio = rNumericArgs(10)
END IF
ErrFlag = .FALSE.
VRFTU(VRFTUNum)%DXHeatCoilType_Num = GetCoilTypeNum(TRIM(DXHeatingCoilType),cAlphaArgs(14),ErrFlag,.FALSE.)
IF(VRFTU(VRFTUNum)%DXHeatCoilType_Num == 0)THEN
VRFTU(VRFTUNum)%HeatingCoilPresent = .FALSE.
IF(VRFTU(VRFTUNum)%TUListIndex .GT. 0 .AND. VRFTU(VRFTUNum)%IndexToTUInTUList .GT. 0)THEN
TerminalUnitList(VRFTU(VRFTUNum)%TUListIndex)%HeatingCoilPresent(VRFTU(VRFTUNum)%IndexToTUInTUList) = .FALSE.
END IF
ELSE
IF (SameString(cAllCoilTypes(VRFTU(VRFTUNum)%DXHeatCoilType_Num),cAllCoilTypes(CoilVRF_Heating))) THEN
ErrFlag = .FALSE.
TerminalUnitList(VRFTU(VRFTUNum)%TUListIndex)%HeatingCoilAvailSchPtr(VRFTU(VRFTUNum)%IndexToTUInTUList) = &
GetDXCoilAvailSchPtr(DXHeatingCoilType,cAlphaArgs(14),ErrFlag)
CALL GetDXCoolCoilIndex(cAlphaArgs(14),VRFTU(VRFTUNum)%HeatCoilIndex, &
ErrFlag, cAllCoilTypes(CoilVRF_Heating))
HCoilInletNodeNum = GetDXCoilInletNode(cAllCoilTypes(CoilVRF_Heating),cAlphaArgs(14),ErrFlag)
HCoilOutletNodeNum = GetDXCoilOutletNode(cAllCoilTypes(CoilVRF_Heating),cAlphaArgs(14),ErrFlag)
IF(ErrFlag)CALL ShowContinueError('...occurs in '//TRIM(cCurrentModuleObject)// &
' "'//TRIM(VRFTU(VRFTUNum)%Name)//'"')
IF(VRFTU(VRFTUNum)%VRFSysNum .GT. 0)THEN
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%HeatCoilIndex,ErrorsFound, &
CondenserType=VRF(VRFTU(VRFTUNum)%VRFSysNum)%CondenserType)
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%HeatCoilIndex,ErrorsFound, &
CondenserInletNodeNum=VRF(VRFTU(VRFTUNum)%VRFSysNum)%CondenserNodeNum)
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%HeatCoilIndex,ErrorsFound, &
MaxOATCrankcaseHeater=VRF(VRFTU(VRFTUNum)%VRFSysNum)%MaxOATCCHeater)
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%HeatCoilIndex,ErrorsFound, &
MinOATHeating=VRF(VRFTU(VRFTUNum)%VRFSysNum)%MinOATHeating)
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%HeatCoilIndex,ErrorsFound, &
MaxOATHeating=VRF(VRFTU(VRFTUNum)%VRFSysNum)%MaxOATHeating)
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%HeatCoilIndex,ErrorsFound, &
HeatingPerformanceOATType=VRF(VRFTU(VRFTUNum)%VRFSysNum)%HeatingPerformanceOATType)
! Set defrost controls in child object to trip child object defrost calculations
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%HeatCoilIndex,ErrorsFound, &
DefrostStrategy=VRF(VRFTU(VRFTUNum)%VRFSysNum)%DefrostStrategy)
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%HeatCoilIndex,ErrorsFound, &
DefrostControl=VRF(VRFTU(VRFTUNum)%VRFSysNum)%DefrostControl)
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%HeatCoilIndex,ErrorsFound, &
DefrostEIRPtr=VRF(VRFTU(VRFTUNum)%VRFSysNum)%DefrostEIRPtr)
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%HeatCoilIndex,ErrorsFound, &
DefrostFraction=VRF(VRFTU(VRFTUNum)%VRFSysNum)%DefrostFraction)
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%HeatCoilIndex,ErrorsFound, &
MaxOATDefrost=VRF(VRFTU(VRFTUNum)%VRFSysNum)%MaxOATDefrost)
! If defrost is disabled in the VRF condenser, it must be disabled in the DX coil
! Defrost primarily handled in parent object, set defrost capacity to 1 to avoid autosizing.
! Defrost capacity is used for nothing more than setting defrost power/consumption report
! variables which are not reported. The coil's defrost algorythm IS used to derate the coil
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%HeatCoilIndex,ErrorsFound, &
DefrostCapacity=1.d0)
! Terminal unit heating to cooling sizing ratio has precedence over VRF system sizing ratio
IF(VRFTU(VRFTUNum)%HeatingCapacitySizeRatio .GT. 1.d0)THEN
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%HeatCoilIndex,ErrorsFound, &
HeatSizeRatio=VRFTU(VRFTUNum)%HeatingCapacitySizeRatio)
ELSE IF(VRF(VRFTU(VRFTUNum)%VRFSysNum)%HeatingCapacitySizeRatio .GT. 1.d0)THEN
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%HeatCoilIndex,ErrorsFound, &
HeatSizeRatio=VRF(VRFTU(VRFTUNum)%VRFSysNum)%HeatingCapacitySizeRatio)
END IF
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//'"')
CALL ShowContinueError('... when checking '//TRIM(cAllCoilTypes(VRFTU(VRFTUNum)%DXHeatCoilType_Num))// &
' "'//TRIM(cAlphaArgs(14))//'"')
CALL ShowContinueError('... terminal unit not connected to condenser.')
CALL ShowContinueError('... check that terminal unit is specified in a terminal unit list object.')
CALL ShowContinueError('... also check that the terminal unit list name is specified in an '// &
'AirConditioner:VariableRefrigerantFlow object.')
ErrorsFound = .TRUE.
END IF
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//'"')
CALL ShowContinueError('... illegal '//TRIM(cAlphaFieldNames(14))//' = '//TRIM(cAlphaArgs(14)))
ErrorsFound = .TRUE.
END IF
END IF
IF(.NOT. VRFTU(VRFTUNum)%CoolingCoilPresent .AND. .NOT. VRFTU(VRFTUNum)%HeatingCoilPresent)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//'"')
CALL ShowContinueError('... no valid coils entered for this terminal unit. Simulation will not proceed.')
ErrorsFound = .TRUE.
END IF
IF (.NOT. lAlphaFieldBlanks(15)) THEN
VRFTU(VRFTUNum)%AvailManagerListName = cAlphaArgs(15)
ZoneComp(VRFTerminalUnit_Num)%ZoneCompAvailMgrs(VRFTUNum)%AvailManagerListName = cAlphaArgs(15)
ENDIF
VRFTU(VRFTUNum)%ParasiticElec = rNumericArgs(8)
VRFTU(VRFTUNum)%ParasiticOffElec = rNumericArgs(9)
! Add TU to component sets array
CALL SetUpCompSets(TRIM(cCurrentModuleObject), VRFTU(VRFTUNum)%Name, cFanTypes(FanType_Num), &
FanName,NodeID(FanInletNodeNum),NodeID(FanOutletNodeNum))
! Add cooling coil to component sets array
IF(VRFTU(VRFTUNum)%CoolingCoilPresent)THEN
CALL SetUpCompSets(TRIM(cCurrentModuleObject), VRFTU(VRFTUNum)%Name, cAllCoilTypes(VRFTU(VRFTUNum)%DXCoolCoilType_Num), &
cAlphaArgs(12),NodeID(CCoilInletNodeNum),NodeID(CCoilOutletNodeNum))
! set heating coil present flag
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%CoolCoilIndex,ErrorsFound, &
HeatingCoilPresent=VRFTU(VRFTUNum)%HeatingCoilPresent)
! check that curve types are present in VRF Condenser if cooling coil is present in terminal unit (can be blank)
! all curves are checked for correct type if a curve name is entered in the VRF condenser object. Check that the
! curve is present if the corresponding coil is entered in the terminal unit.
IF(VRFTU(VRFTUNum)%VRFSysNum .GT. 0)THEN
IF(VRF(VRFTU(VRFTUNum)%VRFSysNum)%CoolingCapacity .LE. 0 .AND. &
VRF(VRFTU(VRFTUNum)%VRFSysNum)%CoolingCapacity .NE. Autosize)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//'"')
CALL ShowContinueError('...This terminal unit contains a cooling coil and rated cooling capacity is also '// &
'required in the associated condenser object.')
CALL ShowContinueError('...Rated Cooling Capacity must also be '// &
'specified for condenser = '// &
TRIM(cVRFTypes(VRF(VRFTU(VRFTUNum)%VRFSysNum)%VRFSystemTypeNum))//' "'// &
TRIM(VRF(VRFTU(VRFTUNum)%VRFSysNum)%Name)//'".')
ErrorsFound=.TRUE.
END IF
IF(VRF(VRFTU(VRFTUNum)%VRFSysNum)%CoolCapFT .EQ. 0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//'"')
CALL ShowContinueError('...This terminal unit contains a cooling coil and cooling performance curves are also '// &
'required in the associated condenser object.')
CALL ShowContinueError('...Cooling Capacity Ratio Modifier Function of Low Temperature Curve must also be '// &
'specified for condenser = '// &
TRIM(cVRFTypes(VRF(VRFTU(VRFTUNum)%VRFSysNum)%VRFSystemTypeNum))//' "'// &
TRIM(VRF(VRFTU(VRFTUNum)%VRFSysNum)%Name)//'".')
ErrorsFound=.TRUE.
END IF
IF(VRF(VRFTU(VRFTUNum)%VRFSysNum)%CoolEIRFT .EQ. 0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//'"')
CALL ShowContinueError('...This terminal unit contains a cooling coil and cooling performance curves are also '// &
'required in the associated condenser object.')
CALL ShowContinueError('...Cooling Energy Input Ratio Modifier Function of Low Temperature Curve must also be '// &
'specified for condenser = '// &
TRIM(cVRFTypes(VRF(VRFTU(VRFTUNum)%VRFSysNum)%VRFSystemTypeNum))//' "'// &
TRIM(VRF(VRFTU(VRFTUNum)%VRFSysNum)%Name)//'".')
ErrorsFound=.TRUE.
END IF
IF(VRF(VRFTU(VRFTUNum)%VRFSysNum)%CoolEIRFPLR1 .EQ. 0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//'"')
CALL ShowContinueError('...This terminal unit contains a cooling coil and cooling performance curves are also '// &
'required in the associated condenser object.')
CALL ShowContinueError('...Cooling Energy Input Ratio Modifier Function of Low Part-Load Ratio Curve must also '// &
'be specified for condenser = '// &
TRIM(cVRFTypes(VRF(VRFTU(VRFTUNum)%VRFSysNum)%VRFSystemTypeNum))//' "'// &
TRIM(VRF(VRFTU(VRFTUNum)%VRFSysNum)%Name)//'".')
ErrorsFound=.TRUE.
END IF
END IF
END IF
! Add heating coil to component sets array
IF(VRFTU(VRFTUNum)%HeatingCoilPresent)THEN
CALL SetUpCompSets(TRIM(cCurrentModuleObject), VRFTU(VRFTUNum)%Name, cAllCoilTypes(VRFTU(VRFTUNum)%DXHeatCoilType_Num), &
cAlphaArgs(14),NodeID(HCoilInletNodeNum),NodeID(HCoilOutletNodeNum))
! set cooling coil present flag
CALL SetDXCoolingCoilData(VRFTU(VRFTUNum)%HeatCoilIndex,ErrorsFound, &
CoolingCoilPresent=VRFTU(VRFTUNum)%CoolingCoilPresent)
IF(VRFTU(VRFTUNum)%VRFSysNum .GT. 0)THEN
IF(VRF(VRFTU(VRFTUNum)%VRFSysNum)%HeatingCapacity .LE. 0 .AND. &
VRF(VRFTU(VRFTUNum)%VRFSysNum)%HeatingCapacity .NE. Autosize)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//'"')
CALL ShowContinueError('...This terminal unit contains a heating coil and rated heating capacity is also '// &
'required in the associated condenser object.')
CALL ShowContinueError('...Rated Heating Capacity must also be '// &
'specified for condenser = '// &
TRIM(cVRFTypes(VRF(VRFTU(VRFTUNum)%VRFSysNum)%VRFSystemTypeNum))//' "'// &
TRIM(VRF(VRFTU(VRFTUNum)%VRFSysNum)%Name)//'".')
ErrorsFound=.TRUE.
END IF
IF(VRF(VRFTU(VRFTUNum)%VRFSysNum)%HeatCapFT .EQ. 0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//'"')
CALL ShowContinueError('...This terminal unit contains a heating coil and heating performance curves are also '// &
'required in the associated condenser object.')
CALL ShowContinueError('...Heating Capacity Ratio Modifier Function of Low Temperature Curve must also be '// &
'specified for condenser = '// &
TRIM(cVRFTypes(VRF(VRFTU(VRFTUNum)%VRFSysNum)%VRFSystemTypeNum))//' "'// &
TRIM(VRF(VRFTU(VRFTUNum)%VRFSysNum)%Name)//'".')
ErrorsFound=.TRUE.
END IF
IF(VRF(VRFTU(VRFTUNum)%VRFSysNum)%HeatEIRFT .EQ. 0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//'"')
CALL ShowContinueError('...This terminal unit contains a heating coil and heating performance curves are also '// &
'required in the associated condenser object.')
CALL ShowContinueError('...Heating Energy Input Ratio Modifier Function of Low Temperature Curve must also be '// &
'specified for condenser = '// &
TRIM(cVRFTypes(VRF(VRFTU(VRFTUNum)%VRFSysNum)%VRFSystemTypeNum))//' "'// &
TRIM(VRF(VRFTU(VRFTUNum)%VRFSysNum)%Name)//'".')
ErrorsFound=.TRUE.
END IF
IF(VRF(VRFTU(VRFTUNum)%VRFSysNum)%HeatEIRFPLR1 .EQ. 0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//'"')
CALL ShowContinueError('...This terminal unit contains a heating coil and heating performance curves are also '// &
'required in the associated condenser object.')
CALL ShowContinueError('...Heating Energy Input Ratio Modifier Function of Low Part-Load Ratio Curve must also '// &
'be specified for condenser = '// &
TRIM(cVRFTypes(VRF(VRFTU(VRFTUNum)%VRFSysNum)%VRFSystemTypeNum))//' "'// &
TRIM(VRF(VRFTU(VRFTUNum)%VRFSysNum)%Name)//'".')
END IF
END IF
END IF
! Set up component set for OA mixer - use OA node and Mixed air node
IF(VRFTU(VRFTUNum)%OAMixerUsed)CALL SetUpCompSets(TRIM(cCurrentModuleObject), VRFTU(VRFTUNum)%Name, &
'UNDEFINED',VRFTU(VRFTUNum)%OAMixerName,NodeID(OANodeNums(1)),NodeID(OANodeNums(4)))
! TU inlet node must be the same as a zone exhaust node and the OA Mixer return node
! check that TU inlet node is a zone exhaust node.
ZoneNodeNotFound = .TRUE.
DO CtrlZone = 1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZone)%IsControlled) CYCLE
DO NodeNum = 1,ZoneEquipConfig(CtrlZone)%NumExhaustNodes
IF (VRFTU(VRFTUNum)%VRFTUInletNodeNum .EQ. ZoneEquipConfig(CtrlZone)%ExhaustNode(NodeNum)) THEN
ZoneNodeNotFound = .FALSE.
EXIT
END IF
END DO
END DO
IF(ZoneNodeNotFound)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//&
'" Zone terminal unit 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('... Zone terminal unit inlet node name = '//TRIM(NodeID(VRFTU(VRFTUNum)%VRFTUInletNodeNum)))
ErrorsFound=.TRUE.
END IF
! check OA Mixer return node
IF(VRFTU(VRFTUNum)%OAMixerUsed)THEN
IF(VRFTU(VRFTUNum)%VRFTUInletNodeNum /= OANodeNums(3))THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//&
'" Zone terminal unit air inlet node name must be the same as the OutdoorAir:Mixer return air node name.')
CALL ShowContinueError('... Zone terminal unit air inlet node name = '//TRIM(NodeID(VRFTU(VRFTUNum)%VRFTUInletNodeNum)))
CALL ShowContinueError('... OutdoorAir:Mixer return air node name = '//TRIM(NodeID(OANodeNums(3))))
ErrorsFound=.TRUE.
END IF
END IF
! check that TU 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 (VRFTU(VRFTUNum)%VRFTUOutletNodeNum .EQ. ZoneEquipConfig(CtrlZone)%InletNode(NodeNum)) THEN
ZoneNodeNotFound = .FALSE.
EXIT
END IF
END DO
END DO
IF(ZoneNodeNotFound)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//&
'" Zone terminal unit 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('... Zone terminal unit outlet node name = '//TRIM(NodeID(VRFTU(VRFTUNum)%VRFTUOutletNodeNum)))
ErrorsFound=.TRUE.
END IF
! check fan inlet and outlet nodes
IF(VRFTU(VRFTUNum)%FanPlace == BlowThru)THEN
IF(VRFTU(VRFTUNum)%OAMixerUsed)THEN
IF (FanInletNodeNum /= OANodeNums(4)) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//&
'" Fan inlet node name must be the same')
CALL ShowContinueError('as the outside air mixers mixed air node name when blow through '// &
'fan is specified and an outside air mixer is present.')
CALL ShowContinueError('... Fan inlet node = '//TRIM(NodeID(FanInletNodeNum)))
CALL ShowContinueError('... OA mixers mixed air node = '//TRIM(NodeID(OANodeNums(4))))
ErrorsFound=.TRUE.
END IF
ELSE
IF (FanInletNodeNum /= VRFTU(VRFTUNum)%VRFTUInletNodeNum) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//&
'" Fan inlet node name must be the same')
CALL ShowContinueError('as the terminal unit air inlet node name when blow through '// &
'fan is specified and an outside air mixer is not present.')
CALL ShowContinueError('... Fan inlet node = '//TRIM(NodeID(FanInletNodeNum)))
CALL ShowContinueError('... Terminal unit air inlet node = '//TRIM(NodeID(VRFTU(VRFTUNum)%VRFTUInletNodeNum)))
ErrorsFound=.TRUE.
END IF
END IF
IF(VRFTU(VRFTUNum)%CoolingCoilPresent)THEN
IF (FanOutletNodeNum /= CCoilInletNodeNum) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//&
'" Fan outlet node name must be the same')
CALL ShowContinueError('as the DX cooling coil air inlet node name when blow through '// &
'fan is specified.')
CALL ShowContinueError('... Fan outlet node = '//TRIM(NodeID(FanOutletNodeNum)))
CALL ShowContinueError('... DX cooling coil air inlet node = '//TRIM(NodeID(CCoilInletNodeNum)))
ErrorsFound=.TRUE.
END IF
IF(VRFTU(VRFTUNum)%HeatingCoilPresent)THEN
IF(HCoilOutletNodeNum /= VRFTU(VRFTUNum)%VRFTUOutletNodeNum)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//&
'" Heating coil outlet node name must be the same')
CALL ShowContinueError('as the terminal unit air outlet node name when blow through '// &
'fan is specified.')
CALL ShowContinueError('... Heating coil outlet node = '//TRIM(NodeID(HCoilOutletNodeNum)))
CALL ShowContinueError('... Terminal Unit air outlet node = '//TRIM(NodeID(VRFTU(VRFTUNum)%VRFTUOutletNodeNum)))
ErrorsFound=.TRUE.
END IF
ELSE
IF(CCoilOutletNodeNum /= VRFTU(VRFTUNum)%VRFTUOutletNodeNum)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//&
'" Cooling coil outlet node name must be the same')
CALL ShowContinueError('as the terminal unit air outlet node name when blow through '// &
'fan is specified and no DX heating coil is present.')
CALL ShowContinueError('... Cooling coil outlet node = '//TRIM(NodeID(CCoilOutletNodeNum)))
CALL ShowContinueError('... Terminal Unit air outlet node = '//TRIM(NodeID(VRFTU(VRFTUNum)%VRFTUOutletNodeNum)))
ErrorsFound=.TRUE.
END IF
END IF
ELSEIF(VRFTU(VRFTUNum)%HeatingCoilPresent)THEN
IF (FanOutletNodeNum /= HCoilInletNodeNum) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//&
'" Fan outlet node name must be the same')
CALL ShowContinueError('as the DX heating coil air inlet node name when blow through '// &
'fan is specified and a DX cooling coil is not present.')
CALL ShowContinueError('... Fan outlet node = '//TRIM(NodeID(FanOutletNodeNum)))
CALL ShowContinueError('... DX heating coil air inlet node = '//TRIM(NodeID(HCoilInletNodeNum)))
ErrorsFound=.TRUE.
END IF
IF(HCoilOutletNodeNum /= VRFTU(VRFTUNum)%VRFTUOutletNodeNum)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//&
'" Heating coil outlet node name must be the same')
CALL ShowContinueError('as the terminal unit air outlet node name when blow through '// &
'fan is specified.')
CALL ShowContinueError('... Heating coil outlet node = '//TRIM(NodeID(HCoilOutletNodeNum)))
CALL ShowContinueError('... Terminal Unit air outlet node = '//TRIM(NodeID(VRFTU(VRFTUNum)%VRFTUOutletNodeNum)))
ErrorsFound=.TRUE.
END IF
END IF
ELSEIF(VRFTU(VRFTUNum)%FanPlace == DrawThru)THEN
IF(VRFTU(VRFTUNum)%CoolingCoilPresent)THEN
IF(.NOT. VRFTU(VRFTUNum)%OAMixerUsed)THEN
IF(VRFTU(VRFTUNum)%VRFTUInletNodeNum /= CCoilInletNodeNum)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//&
'" Cooling coil inlet node name must be the same')
CALL ShowContinueError('as the terminal unit air inlet node name when draw through '// &
'fan is specified.')
CALL ShowContinueError('... Terminal unit air inlet node = '//TRIM(NodeID(VRFTU(VRFTUNum)%VRFTUInletNodeNum)))
CALL ShowContinueError('... DX cooling coil air inlet node = '//TRIM(NodeID(CCoilInletNodeNum)))
ErrorsFound=.TRUE.
END IF
END IF
IF(VRFTU(VRFTUNum)%HeatingCoilPresent)THEN
IF (FanInletNodeNum /= HCoilOutletNodeNum) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//&
'" Fan inlet node name must be the same')
CALL ShowContinueError('as the DX heating coil air outlet node name when draw through '// &
'fan is specifiedt.')
CALL ShowContinueError('... Fan inlet node = '//TRIM(NodeID(FanInletNodeNum)))
CALL ShowContinueError('... DX heating coil air outlet node = '//TRIM(NodeID(HCoilOutletNodeNum)))
ErrorsFound=.TRUE.
END IF
ELSE
IF (FanInletNodeNum /= CCoilOutletNodeNum) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//&
'" Fan inlet node name must be the same')
CALL ShowContinueError('as the DX cooling coil air outlet node name when draw through '// &
'fan is specified and a DX heating coil is not present.')
CALL ShowContinueError('... Fan inlet node = '//TRIM(NodeID(FanInletNodeNum)))
CALL ShowContinueError('... DX cooling coil air outlet node = '//TRIM(NodeID(CCoilOutletNodeNum)))
ErrorsFound=.TRUE.
END IF
END IF
ELSEIF(VRFTU(VRFTUNum)%HeatingCoilPresent)THEN
IF (FanInletNodeNum /= HCoilOutletNodeNum) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//&
'" Fan inlet node name must be the same')
CALL ShowContinueError('as the DX heating coil air outlet node name when draw through '// &
'fan is specified.')
CALL ShowContinueError('... Fan inlet node = '//TRIM(NodeID(FanInletNodeNum)))
CALL ShowContinueError('... DX heating coil air outlet node = '//TRIM(NodeID(HCoilOutletNodeNum)))
ErrorsFound=.TRUE.
END IF
END IF
IF (FanOutletNodeNum /= VRFTU(VRFTUNum)%VRFTUOutletNodeNum) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//&
'" Fan outlet node name must be the same')
CALL ShowContinueError('as the terminal unit air outlet node name when draw through '// &
'fan is specified.')
CALL ShowContinueError('... Fan outlet node = '//TRIM(NodeID(FanOutletNodeNum)))
CALL ShowContinueError('... Terminal unit air outlet node = '//TRIM(NodeID(VRFTU(VRFTUNum)%VRFTUOutletNodeNum)))
ErrorsFound=.TRUE.
END IF
END IF
IF(VRFTU(VRFTUNum)%CoolingCoilPresent .AND. VRFTU(VRFTUNum)%HeatingCoilPresent)THEN
IF (CCoilOutletNodeNum /= HCoilInletNodeNum) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(VRFTU(VRFTUNum)%Name)//&
'" DX cooling coil air outlet node name must be the same')
CALL ShowContinueError(' as the DX heating coil air inlet node name.')
CALL ShowContinueError('... DX cooling coil air outlet node = '//TRIM(NodeID(CCoilOutletNodeNum)))
CALL ShowContinueError('... DX heating coil air inlet node = '//TRIM(NodeID(HCoilInletNodeNum)))
ErrorsFound=.TRUE.
END IF
END IF
END DO ! end Number of VRF Terminal Unit Loop
! perform additional error checking
DO NumList = 1, NumVRFTULists
DO VRFNum = 1, TerminalUnitList(NumList)%NumTUInList
IF(TerminalUnitList(NumList)%ZoneTUPtr(VRFNum) .GT. 0)CYCLE
! TU name in zone terminal unit list not found
CALL ShowSevereError('ZoneTerminalUnitList "'//TRIM(TerminalUnitList(NumList)%Name)//'"')
CALL ShowContinueError('...Zone Terminal Unit = '//TRIM(TerminalUnitList(NumList)%ZoneTUName(VRFNum))// &
' improperly connected to system.')
CALL ShowContinueError('...either the ZoneHVAC:TerminalUnit:VariableRefrigerantFlow object does not exist,')
CALL ShowContinueError('...or the ZoneTerminalUnitList object is not named in an '// &
'AirConditioner:VariableRefrigerantFlow object.')
ErrorsFound = .TRUE.
END DO
END DO
! warn when number of ZoneTerminalUnitList different from number of AirConditioner:VariableRefrigerantFlow
IF(NumVRFTULists /= NumVRFCond)THEN
CALL ShowSevereError('The number of AirConditioner:VariableRefrigerantFlow objects ('//TRIM(TrimSigDigits(NumVRFCond,0))// &
') does not match the number of ZoneTerminalUnitList objects ('//TRIM(TrimSigDigits(NumVRFTULists,0))//').')
DO NumCond = 1, NumVRFCond
CALL ShowContinueError('...AirConditioner:VariableRefrigerantFlow = '//TRIM(VRF(NumCond)%Name)// &
' specifies Zone Terminal Unit List Name = '//TRIM(TerminalUnitList(VRF(NumCond)%ZoneTUListPtr)%Name))
END DO
CALL ShowContinueError('...listing ZoneTerminalUnitList objects.')
DO NumList = 1, NumVRFTULists
CALL ShowContinueError('...ZoneTerminalUnitList = '//TRIM(TerminalUnitList(NumList)%Name))
END DO
ErrorsFound = .TRUE.
END IF
DO VRFNum = 1, NumVRFTU
IF(VRFTU(VRFNum)%CoolingCoilPresent)THEN
CALL SetupOutputVariable('Zone VRF Air Terminal Cooling Electric Power [W]', &
VRFTU(VRFNum)%ParasiticCoolElecPower,'System','Average', VRFTU(VRFNum)%Name)
CALL SetupOutputVariable('Zone VRF Air Terminal Cooling Electric Energy [J]', &
VRFTU(VRFNum)%ParasiticElecCoolConsumption, 'System','Sum', VRFTU(VRFNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='COOLING',GroupKey='System')
CALL SetupOutputVariable('Zone VRF Air Terminal Total Cooling Rate [W]', &
VRFTU(VRFNum)%TotalCoolingRate,'System','Average', VRFTU(VRFNum)%Name)
CALL SetupOutputVariable('Zone VRF Air Terminal Sensible Cooling Rate [W]', &
VRFTU(VRFNum)%SensibleCoolingRate,'System','Average', VRFTU(VRFNum)%Name)
CALL SetupOutputVariable('Zone VRF Air Terminal Latent Cooling Rate [W]', &
VRFTU(VRFNum)%LatentCoolingRate,'System','Average', VRFTU(VRFNum)%Name)
CALL SetupOutputVariable('Zone VRF Air Terminal Total Cooling Energy [J]', &
VRFTU(VRFNum)%TotalCoolingEnergy, 'System','Sum', VRFTU(VRFNum)%Name)
CALL SetupOutputVariable('Zone VRF Air Terminal Sensible Cooling Energy [J]', &
VRFTU(VRFNum)%SensibleCoolingEnergy, 'System','Sum', VRFTU(VRFNum)%Name)
CALL SetupOutputVariable('Zone VRF Air Terminal Latent Cooling Energy [J]', &
VRFTU(VRFNum)%LatentCoolingEnergy, 'System','Sum', VRFTU(VRFNum)%Name)
END IF
IF(VRFTU(VRFNum)%HeatingCoilPresent)THEN
CALL SetupOutputVariable('Zone VRF Air Terminal Heating Electric Power [W]', &
VRFTU(VRFNum)%ParasiticHeatElecPower,'System','Average', VRFTU(VRFNum)%Name)
CALL SetupOutputVariable('Zone VRF Air Terminal Heating Electric Energy [J]', &
VRFTU(VRFNum)%ParasiticElecHeatConsumption, 'System','Sum', VRFTU(VRFNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='HEATING',GroupKey='System')
CALL SetupOutputVariable('Zone VRF Air Terminal Total Heating Rate [W]', &
VRFTU(VRFNum)%TotalHeatingRate,'System','Average', VRFTU(VRFNum)%Name)
CALL SetupOutputVariable('Zone VRF Air Terminal Sensible Heating Rate [W]', &
VRFTU(VRFNum)%SensibleHeatingRate,'System','Average', VRFTU(VRFNum)%Name)
CALL SetupOutputVariable('Zone VRF Air Terminal Latent Heating Rate [W]', &
VRFTU(VRFNum)%LatentHeatingRate,'System','Average', VRFTU(VRFNum)%Name)
CALL SetupOutputVariable('Zone VRF Air Terminal Total Heating Energy [J]', &
VRFTU(VRFNum)%TotalHeatingEnergy, 'System','Sum', VRFTU(VRFNum)%Name)
CALL SetupOutputVariable('Zone VRF Air Terminal Sensible Heating Energy [J]', &
VRFTU(VRFNum)%SensibleHeatingEnergy, 'System','Sum', VRFTU(VRFNum)%Name)
CALL SetupOutputVariable('Zone VRF Air Terminal Latent Heating Energy [J]', &
VRFTU(VRFNum)%LatentHeatingEnergy, 'System','Sum', VRFTU(VRFNum)%Name)
END IF
CALL SetupOutputVariable('Zone VRF Air Terminal Fan Availability Status []',&
VRFTU(VRFNum)%AvailStatus,'System','Average',VRFTU(VRFNum)%Name)
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupEMSActuator('Variable Refrigerant Flow Terminal Unit', VRFTU(VRFNum)%Name, 'Part Load Ratio' , '[fraction]', &
VRFTU(VRFNum)%EMSOverridePartLoadFrac, VRFTU(VRFNum)%EMSValueForPartLoadFrac )
ENDIF
END DO
DO NumCond = 1, NumVRFCond
CALL SetupOutputVariable('VRF Heat Pump Total Cooling Rate [W]', &
VRF(NumCond)%TotalCoolingCapacity, 'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Total Heating Rate [W]', &
VRF(NumCond)%TotalHeatingCapacity, 'System','Average', VRF(NumCond)%Name)
IF (VRF(NumCond)%FuelType == FuelTypeElectric) THEN
CALL SetupOutputVariable('VRF Heat Pump Cooling Electric Power [W]', &
VRF(NumCond)%ElecCoolingPower, 'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Cooling Electric Energy [J]', &
VRF(NumCond)%CoolElecConsumption, 'System','Sum', VRF(NumCond)%Name, &
ResourceTypeKey=TRIM(cValidFuelTypes(VRF(NumCond)%FuelType)), &
EndUseKey='COOLING',GroupKey='System')
ELSE
CALL SetupOutputVariable('VRF Heat Pump Cooling '// &
TRIM(cValidFuelTypes(VRF(NumCond)%FuelType))//' Rate [W]', &
VRF(NumCond)%ElecCoolingPower, 'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Cooling '// &
TRIM(cValidFuelTypes(VRF(NumCond)%FuelType))//' Energy [J]', &
VRF(NumCond)%CoolElecConsumption, 'System','Sum', VRF(NumCond)%Name, &
ResourceTypeKey=TRIM(cValidFuelTypes(VRF(NumCond)%FuelType)), &
EndUseKey='COOLING',GroupKey='System')
ENDIF
IF (VRF(NumCond)%FuelType == FuelTypeElectric) THEN
CALL SetupOutputVariable('VRF Heat Pump Heating Electric Power [W]', &
VRF(NumCond)%ElecHeatingPower, 'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Heating Electric Energy [J]', &
VRF(NumCond)%HeatElecConsumption, 'System','Sum', VRF(NumCond)%Name, &
ResourceTypeKey=TRIM(cValidFuelTypes(VRF(NumCond)%FuelType)), &
EndUseKey='HEATING',GroupKey='System')
ELSE
CALL SetupOutputVariable('VRF Heat Pump Heating '// &
TRIM(cValidFuelTypes(VRF(NumCond)%FuelType))//' Rate [W]', &
VRF(NumCond)%ElecHeatingPower, 'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Heating '// &
TRIM(cValidFuelTypes(VRF(NumCond)%FuelType))//' Energy [J]', &
VRF(NumCond)%HeatElecConsumption, 'System','Sum', VRF(NumCond)%Name, &
ResourceTypeKey=TRIM(cValidFuelTypes(VRF(NumCond)%FuelType)), &
EndUseKey='HEATING',GroupKey='System')
ENDIF
CALL SetupOutputVariable('VRF Heat Pump Cooling COP []', &
VRF(NumCond)%OperatingCoolingCOP,'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Heating COP []', &
VRF(NumCond)%OperatingHeatingCOP,'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump COP []', &
VRF(NumCond)%OperatingCOP,'System','Average', VRF(NumCond)%Name)
IF(VRF(NumCond)%DefrostStrategy == Resistive .OR. &
(VRF(NumCond)%DefrostStrategy == ReverseCycle .AND. VRF(NumCond)%FuelType == FuelTypeElectric))THEN
CALL SetupOutputVariable('VRF Heat Pump Defrost Electric Power [W]', &
VRF(NumCond)%DefrostPower, 'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Defrost Electric Energy [J]', &
VRF(NumCond)%DefrostConsumption, 'System','Sum',VRF(NumCond)%Name, &
ResourceTypeKey='Electric',EndUseKey='HEATING',GroupKey='System')
ELSE ! defrost energy appied to fuel type
CALL SetupOutputVariable('VRF Heat Pump Defrost '// &
TRIM(cValidFuelTypes(VRF(NumCond)%FuelType))//' Rate [W]', &
VRF(NumCond)%DefrostPower, 'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Defrost '// &
TRIM(cValidFuelTypes(VRF(NumCond)%FuelType))//' Energy [J]', &
VRF(NumCond)%DefrostConsumption, 'System','Sum', VRF(NumCond)%Name, &
ResourceTypeKey=TRIM(cValidFuelTypes(VRF(NumCond)%FuelType)), &
EndUseKey='HEATING',GroupKey='System')
END IF
CALL SetupOutputVariable('VRF Heat Pump Part Load Ratio []', &
VRF(NumCond)%VRFCondPLR, 'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Runtime Fraction []', &
VRF(NumCond)%VRFCondRTF, 'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Cycling Ratio []', &
VRF(NumCond)%VRFCondCyclingRatio, 'System','Average',VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Operating Mode []', &
VRF(NumCond)%OperatingMode, 'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Condenser Inlet Temperature [C]', &
VRF(NumCond)%CondenserInletTemp, 'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Maximum Capacity Cooling Rate [W]', &
MaxCoolingCapacity(NumCond), 'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Maximum Capacity Heating Rate [W]', &
MaxHeatingCapacity(NumCond), 'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Crankcase Heater Electric Power [W]', &
VRF(NumCond)%CrankCaseHeaterPower, 'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Crankcase Heater Electric Energy [J]', &
VRF(NumCond)%CrankCaseHeaterElecConsumption, 'System','Sum', VRF(NumCond)%Name, &
ResourceTypeKey='Electric',EndUseKey='COOLING',GroupKey='System')
CALL SetupOutputVariable('VRF Heat Pump Terminal Unit Cooling Load Rate [W]', &
VRF(NumCond)%TUCoolingLoad, 'System','Average', VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Terminal Unit Heating Load Rate [W]', &
VRF(NumCond)%TUHeatingLoad, 'System','Average', VRF(NumCond)%Name)
IF(VRF(NumCond)%HeatRecoveryUsed)THEN
CALL SetupOutputVariable('VRF Heat Pump Heat Recovery Status Change Multiplier []', &
VRF(NumCond)%SUMultiplier, 'System','Average',VRF(NumCond)%Name)
END IF
IF(VRF(NumCond)%CondenserType .EQ. EvapCooled)THEN
CALL SetupOutputVariable('VRF Heat Pump Evaporative Condenser Water Use Volume [m3]', &
VRF(NumCond)%EvapWaterConsumpRate, 'System','Sum',VRF(NumCond)%Name, &
ResourceTypeKey='Water',EndUseKey='Cooling',GroupKey='System')
CALL SetupOutputVariable('VRF Heat Pump Evaporative Condenser Pump Electric Power [W]', &
VRF(NumCond)%EvapCondPumpElecPower, 'System','Average',VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Evaporative Condenser Pump Electric Energy [J]', &
VRF(NumCond)%EvapCondPumpElecConsumption,'System','Sum',VRF(NumCond)%Name, &
ResourceTypeKey='Electric',EndUseKey='COOLING',GroupKey='System')
IF(VRF(NumCond)%BasinHeaterPowerFTempDiff .GT. 0.0d0)THEN
CALL SetupOutputVariable('VRF Heat Pump Basin Heater Electric Power [W]', &
VRF(NumCond)%BasinHeaterPower,'System','Average',VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Basin Heater Electric Energy [J]', &
VRF(NumCond)%BasinHeaterConsumption,'System','Sum',VRF(NumCond)%Name, &
ResourceTypeKey='Electric',EndUseKey='COOLING',GroupKey='System')
END IF
ELSE IF(VRF(NumCond)%CondenserType .EQ. WaterCooled)THEN
CALL SetupOutputVariable('VRF Heat Pump Condenser Outlet Temperature [C]', &
VRF(NumCond)%CondenserSideOutletTemp, 'System','Average',VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Condenser Mass Flow Rate [kg/s]', &
VRF(NumCond)%WaterCondenserMassFlow, 'System','Average',VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Condenser Heat Transfer Rate [W]', &
VRF(NumCond)%QCondenser, 'System','Average',VRF(NumCond)%Name)
CALL SetupOutputVariable('VRF Heat Pump Condenser Heat Transfer Energy [J]', &
VRF(NumCond)%QCondEnergy, 'System','Sum',VRF(NumCond)%Name)
END IF
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupEMSActuator('Variable Refrigerant Flow Heat Pump', VRF(NumCond)%Name, 'Operating Mode' , '[integer]', &
VRF(NumCond)%EMSOverrideHPOperatingMode, VRF(NumCond)%EMSValueForHPOperatingMode )
ENDIF
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in getting AirConditioner:VariableRefrigerantFlow system input. '//&
'Preceding condition(s) causes termination.')
END IF
RETURN
END SUBROUTINE GetVRFInput