SUBROUTINE GetMSHeatPumpInput
! SUBROUTINE INFORMATION:
! AUTHOR: Lixing Gu, FSEC
! DATE WRITTEN: July 2007
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine will get the input required by the multispeed heat pump model
! METHODOLOGY EMPLOYED:
! na
! REFERENCES: na
! USE STATEMENTS:
USE DataInterfaces, ONLY: ShowSevereError, ShowWarningError, ShowFatalError, SetupOutputVariable, ShowContinueError
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, SameString, FindItemInList, GetObjectItemNum, &
GetObjectDefMaxArgs
USE BranchNodeConnections, ONLY: TestCompSet
USE NodeInputManager, ONLY: GetOnlySingleNode
USE FluidProperties, ONLY: FindGlycol
USE CurveManager, ONLY: CurveValue
USE General, ONLY: RoundSigDigits
USE GlobalNames, ONLY: VerifyUniqueChillerName
USE DataSizing, ONLY: Autosize
USE Fans, ONLY: GetFanType, GetFanIndex, GetFanVolFlow, GetFanInletNode, GetFanOutletNode
USE DataHeatBalance, ONLY: Zone
USE DataZoneEquipment, ONLY: ZoneEquipConfig
USE DataAirSystems, ONLY : PrimaryAirSystem
USE DataZoneControls, ONLY: TempControlledZone, NumTempControlledZones, NumComfortControlledZones, &
ComfortControlledZone
USE DataHVACGlobals, ONLY: FanType_SimpleOnOff, FanType_SimpleConstVolume
USE CurveManager, ONLY: GetCurveIndex, GetCurveType, CurveValue
USE BranchNodeConnections, ONLY: SetUpCompSets
USE DXCoils, ONLY: GetDXCoilIndex, GetDXCoilInletNode=>GetCoilInletNode, &
GetDXCoilOutletNode=>GetCoilOutletNode,GetDXCoilNumberOfSpeeds,GetDXCoilNumberOfSpeeds
USE HeatingCoils, ONLY: GetHeatingCoilInletNode=>GetCoilInletNode, GetHeatingCoilOutletNode=>GetCoilOutletNode, &
GetHeatingCoilCapacity=>GetCoilCapacity, GetHeatingCoilIndex, GetCoilIndex, GetCoilInletNode, &
GetCoilOutletNode, GetHeatingCoilNumberOfStages
USE WaterCoils, ONLY: GetCoilWaterInletNode, GetCoilMaxWaterFlowRate, &
GetWaterCoilInletNode=>GetCoilInletNode,GetWaterCoilOutletNode=>GetCoilOutletNode
USE SteamCoils, ONLY: GetSteamCoilAirInletNode=>GetCoilAirInletNode, GetSteamCoilIndex, &
GetSteamCoilAirOutletNode=>GetCoilAirOutletNode, &
GetSteamCoilSteamInletNode=>GetCoilSteamInletNode, &
GetCoilMaxSteamFlowRate=>GetCoilMaxSteamFlowRate, GetTypeOfCoil, ZoneLoadControl
USE FluidProperties, ONLY: GetSatDensityRefrig
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! PARAMETERS
CHARACTER(Len=*), PARAMETER :: RoutineName='GetMSHeatPumpInput: ' ! include trailing blank space
! LOCAL VARIABLES
INTEGER :: MSHPNum ! Engine driven heat pump count
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER :: IOStatus ! Used in GetObjectItem
LOGICAL, SAVE :: ErrorsFound=.false. ! True when input errors found
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL, SAVE :: AllocatedFlag =.FALSE. ! True when arrays are allocated
LOGICAL :: AirNodeFound ! True when an air node is found
LOGICAL :: AirLoopFound ! True when an air loop is found
INTEGER :: ControlledZoneNum ! Controlled zone number
INTEGER :: AirLoopNumber ! Index to air loop
INTEGER :: FanType ! Fan type
INTEGER :: BranchNum ! Index to branch
INTEGER :: CompNum ! Index to component
INTEGER :: TstatZoneNum ! Used to determine if control zone has a thermostat object
INTEGER :: i ! Index to speeds
INTEGER :: j ! Index to speeds
LOGICAL :: Found ! Flag to find autosize
INTEGER :: HeatingCoilInletNode ! Heating coil inlet node number
INTEGER :: HeatingCoilOutletNode ! Heating coil outlet node number
INTEGER :: CoolingCoilInletNode ! Cooling coil inlet node number
INTEGER :: CoolingCoilOutletNode ! Cooling coil outlet node number
INTEGER :: SuppHeatCoilInletNode ! Supplemental heating coil inlet node number
INTEGER :: SuppHeatCoilOutletNode ! Supplemental heating coil outlet node number
LOGICAL :: LocalError ! Local error flag
INTEGER :: SpeedInput ! Status of number of speed input
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 :: MaxNums=0 ! Maximum number of numeric input fields
INTEGER :: MaxAlphas=0 ! Maximum number of alpha input fields
INTEGER :: TotalArgs=0 ! Total number of alpha and numeric arguments (max) for a
! certain object in the input file
LOGICAL :: errFlag
INTEGER :: SteamIndex ! steam coil steam inlet density
REAL(r64) :: SteamDensity ! density of steam at 100C
! FLOW
If (AllocatedFlag) RETURN
CurrentModuleObject = 'AirLoopHVAC:UnitaryHeatPump:AirToAir:MultiSpeed' ! Object type for getting and error messages
CALL GetObjectDefMaxArgs(CurrentModuleObject,TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
ALLOCATE(Alphas(MaxAlphas))
Alphas=' '
ALLOCATE(cAlphaFields(MaxAlphas))
cAlphaFields=' '
ALLOCATE(Numbers(MaxNums))
Numbers=0.0d0
ALLOCATE(cNumericFields(MaxNums))
cNumericFields=' '
ALLOCATE(lAlphaBlanks(MaxAlphas))
lAlphaBlanks=.true.
ALLOCATE(lNumericBlanks(MaxNums))
lNumericBlanks=.true.
NumMSHeatPumps = GetNumObjectsFound(CurrentModuleObject)
IF (NumMSHeatPumps <= 0) THEN
CALL ShowSevereError('No '//TRIM(CurrentModuleObject)//' objects specified in input file.')
ErrorsFound=.true.
END IF
! ALLOCATE ARRAYS
ALLOCATE (MSHeatPump(NumMSHeatPumps))
ALLOCATE (MSHeatPumpReport(NumMSHeatPumps))
ALLOCATE(CheckEquipName(NumMSHeatPumps))
CheckEquipName=.true.
AllocatedFlag = .TRUE.
! Load arrays with reformulated electric EIR chiller data
DO MSHPNum = 1 , NumMSHeatPumps
HeatingCoilInletNode = 0
HeatingCoilOutletNode = 0
CoolingCoilInletNode = 0
CoolingCoilOutletNode = 0
SuppHeatCoilInletNode = 0
SuppHeatCoilOutletNode = 0
CALL GetObjectItem(CurrentModuleObject,MSHPNum,Alphas,NumAlphas, &
Numbers,NumNumbers,IOStatus, NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),MSHeatPump%Name,MSHPNum-1,IsNotOK,IsBlank, TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
END IF
MSHeatPump(MSHPNum)%Name = Alphas(1)
IF (lAlphaBlanks(2)) THEN
MSHeatPump(MSHPNum)%AvaiSchedPtr = ScheduleAlwaysOn
ELSE
MSHeatPump(MSHPNum)%AvaiSchedPtr = GetScheduleIndex(Alphas(2))
IF (MSHeatPump(MSHPNum)%AvaiSchedPtr == 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'" '//TRIM(cAlphaFields(2))//' not found: '//TRIM(Alphas(2)))
ErrorsFound=.true.
ENDIF
ENDIF
MSHeatPump(MSHPNum)%AirInletNodeName = Alphas(3)
MSHeatPump(MSHPNum)%AirOutletNodeName = Alphas(4)
MSHeatPump(MSHPNum)%AirInletNodeNum = &
GetOnlySingleNode(Alphas(3),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsParent)
MSHeatPump(MSHPNum)%AirOutletNodeNum = &
GetOnlySingleNode(Alphas(4),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsParent)
CALL TestCompSet(TRIM(CurrentModuleObject),Alphas(1),Alphas(3),Alphas(4),'Air Nodes')
!Get the Controlling Zone or Location of the engine driven heat pump Thermostat
MSHeatPump(MSHPNum)%ControlZoneNum = FindItemInList(Alphas(5),Zone%Name,NumOfZones)
MSHeatPump(MSHPNum)%ControlZoneName = Alphas(5)
IF (MSHeatPump(MSHPNum)%ControlZoneNum == 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)// &
'" '//TRIM(cAlphaFields(5))//' not found: '//TRIM(MSHeatPump(MSHPNum)%ControlZoneName))
ErrorsFound=.true.
ENDIF
! Get the node number for the zone with the thermostat
IF (MSHeatPump(MSHPNum)%ControlZoneNum > 0) THEN
AirNodeFound=.FALSE.
AirLoopFound=.FALSE.
DO ControlledZoneNum = 1,NumOfZones
IF (ZoneEquipConfig(ControlledZoneNum)%ActualZoneNum /= MSHeatPump(MSHPNum)%ControlZoneNum) CYCLE
! Find the controlled zone number for the specified thermostat location
MSHeatPump(MSHPNum)%NodeNumofControlledZone=ZoneEquipConfig(ControlledZoneNum)%ZoneNode
! Determine if furnace is on air loop served by the thermostat location specified
AirLoopNumber = ZoneEquipConfig(ControlledZoneNum)%AirLoopNum
IF (AirLoopNumber .GT. 0)THEN
DO BranchNum = 1, PrimaryAirSystem(AirLoopNumber)%NumBranches
DO CompNum = 1, PrimaryAirSystem(AirLoopNumber)%Branch(BranchNum)%TotalComponents
IF (.NOT. SameString(PrimaryAirSystem(AirLoopNumber)%Branch(BranchNum)%Comp(CompNum)%Name, &
MSHeatPump(MSHPNum)%Name) .OR. &
.NOT. SameString(PrimaryAirSystem(AirLoopNumber)%Branch(BranchNum)%Comp(CompNum)%TypeOf, &
CurrentModuleObject))CYCLE
AirLoopFound=.TRUE.
EXIT
END DO
IF(AirLoopFound)EXIT
END DO
DO TstatZoneNum = 1, NumTempControlledZones
IF(TempControlledZone(TstatZoneNum)%ActualZoneNum .NE. MSHeatPump(MSHPNum)%ControlZoneNum)CYCLE
AirNodeFound=.TRUE.
END DO
DO TstatZoneNum = 1, NumComfortControlledZones
IF(ComfortControlledZone(TstatZoneNum)%ActualZoneNum .NE. MSHeatPump(MSHPNum)%ControlZoneNum)CYCLE
AirNodeFound=.TRUE.
END DO
ELSE
CALL ShowSevereError('Did not find a AirLoopHVAC for '//TRIM(CurrentModuleObject)//' = "'// &
'"'//TRIM(MSHeatPump(MSHPNum)%Name))
CALL ShowContinueError('Specified '//TRIM(cAlphaFields(5))//' = '//TRIM(Alphas(5)))
ErrorsFound=.TRUE.
END IF
EXIT
ENDDO
IF (.not. AirNodeFound) THEN
CALL ShowSevereError('Did not find Air Node ('//TRIM(cAlphaFields(5))//'), '//TRIM(CurrentModuleObject)//' = "'// &
'"'//TRIM(MSHeatPump(MSHPNum)%Name))
CALL ShowContinueError('Specified '//TRIM(cAlphaFields(5))//' = '//TRIM(Alphas(5)))
ErrorsFound=.TRUE.
ENDIF
IF (.not. AirLoopFound) THEN
CALL ShowSevereError('Did not find correct AirLoopHVAC for '//TRIM(CurrentModuleObject)//' = '// &
TRIM(MSHeatPump(MSHPNum)%Name))
CALL ShowContinueError('The '//TRIM(cAlphaFields(5))//' = '//TRIM(Alphas(5))// &
' is not served by this Primary Air Loop equipment.')
ErrorsFound=.TRUE.
ENDIF
ENDIF
! MSHeatPump(MSHPNum)%FlowFraction = Numbers(1)
! IF (MSHeatPump(MSHPNum)%FlowFraction .LE. 0.0 .AND. MSHeatPump(MSHPNum)%FlowFraction /= AutoSize) THEN
! CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
! '", '//TRIM(cNumericFields(1))//' must greater than zero.')
! ErrorsFound = .TRUE.
! END IF
! IF (MSHeatPump(MSHPNum)%FlowFraction .GT. 1.0 .AND. MSHeatPump(MSHPNum)%FlowFraction /= AutoSize) THEN
! CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
! '", '//TRIM(cNumericFields(1))//' cannot be greater than 1.0.')
! ErrorsFound = .TRUE.
! END IF
!Get supply fan data
MSHeatPump(MSHPNum)%FanName = Alphas(7)
IF (SameString(Alphas(6),'Fan:OnOff') .OR. SameString(Alphas(6),'Fan:ConstantVolume')) THEN
IF (SameString(Alphas(6),'Fan:OnOff')) then
MSHeatPump(MSHPNum)%FanType = FanType_SimpleOnOff
CALL SetUpCompSets(TRIM(CurrentModuleObject), MSHeatPump(MSHPNum)%Name, &
'Fan:OnOff',MSHeatPump(MSHPNum)%FanName,'UNDEFINED', 'UNDEFINED')
MSHeatPump(MSHPNum)%FanInletNode = GetFanInletNode('Fan:OnOff',MSHeatPump(MSHPNum)%FanName,ErrorsFound)
MSHeatPump(MSHPNum)%FanOutletNode = GetFanOutletNode('Fan:OnOff',MSHeatPump(MSHPNum)%FanName,ErrorsFound)
Else
MSHeatPump(MSHPNum)%FanType = FanType_SimpleConstVolume
CALL SetUpCompSets(TRIM(CurrentModuleObject), MSHeatPump(MSHPNum)%Name, &
'Fan:ConstantVolume',MSHeatPump(MSHPNum)%FanName,'UNDEFINED', 'UNDEFINED')
MSHeatPump(MSHPNum)%FanInletNode = GetFanInletNode('Fan:ConstantVolume',MSHeatPump(MSHPNum)%FanName,ErrorsFound)
MSHeatPump(MSHPNum)%FanOutletNode = GetFanOutletNode('Fan:ConstantVolume',MSHeatPump(MSHPNum)%FanName,ErrorsFound)
End If
CALL GetFanIndex(Alphas(7), MSHeatPump(MSHPNum)%FanNum, ErrorsFound, TRIM(CurrentModuleObject))
CALL GetFanType(Alphas(7), FanType, ErrorsFound)
If (FanType /= MSHeatPump(MSHPNum)%FanType) then
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", '//TRIM(cAlphaFields(6))//' and '//TRIM(cAlphaFields(7))//' do not match in Fan objects.')
CALL ShowContinueError('The entered '//TRIM(cAlphaFields(7))//' = '//TRIM(Alphas(7))//' and '// &
TRIM(cAlphaFields(6))//' = '//TRIM(Alphas(6)))
ErrorsFound = .TRUE.
End If
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", '//TRIM(cAlphaFields(6))//' is not allowed = '//TRIM(Alphas(6)))
CALL ShowContinueError('Valid choices are Fan:OnOff or Fan:ConstantVolume')
ErrorsFound=.true.
END IF
!Get supply fan placement data
IF (SameString(Alphas(8),'BlowThrough') .OR. SameString(Alphas(8),'DrawThrough')) THEN
IF (SameString(Alphas(8),'BlowThrough')) then
MSHeatPump(MSHPNum)%FanPlaceType = BlowThru
Else
MSHeatPump(MSHPNum)%FanPlaceType = DrawThru
End If
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", '//TRIM(cAlphaFields(8))//' is not allowed = '//TRIM(Alphas(8)))
CALL ShowContinueError('Valid choices are BlowThrough or DrawThrough')
ErrorsFound=.true.
END IF
MSHeatPump(MSHPNum)%FanSchedule = Alphas(9)
MSHeatPump(MSHPNum)%FanSchedPtr = GetScheduleIndex(Alphas(9))
IF (MSHeatPump(MSHPNum)%FanSchedPtr == 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'" '//TRIM(cAlphaFields(9))//' not found: '//TRIM(Alphas(9)))
ErrorsFound=.true.
ENDIF
IF (MSHeatPump(MSHPNum)%FanSchedPtr .GT. 0 .AND. MSHeatPump(MSHPNum)%FanType == FanType_SimpleConstVolume) THEN
IF (.NOT. CheckScheduleValueMinMax(MSHeatPump(MSHPNum)%FanSchedPtr,'>',0.0d0,'<=',1.0d0)) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' "'//TRIM(MSHeatPump(MSHPNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFields(9))//' must be continuous (fan operating mode schedule values > 0)'//&
' for '//TRIM(cAlphaFields(6))//' = Fan:ConstantVolume.')
CALL ShowContinueError('Error found in '//TRIM(cAlphaFields(9))//' = '//TRIM(Alphas(9)))
CALL ShowContinueError('schedule values must be (>0., <=1.)')
ErrorsFound=.true.
END IF
END IF
IF (SameString(Alphas(10),'Coil:Heating:DX:MultiSpeed')) THEN
MSHeatPump(MSHPNum)%HeatCoilType = MultiSpeedHeatingCoil
MSHeatPump(MSHPNum)%HeatCoilNum = GetObjectItemNum('Coil:Heating:DX:MultiSpeed',Alphas(11))
MSHeatPump(MSHPNum)%DXHeatCoilName = Alphas(11)
If (MSHeatPump(MSHPNum)%HeatCoilNum <= 0) then
CALL ShowSevereError('Configuration error in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
CALL ShowContinueError(TRIM(cAlphaFields(11))//' "'//TRIM(Alphas(11))//'" not found.')
CALL ShowContinueError(TRIM(cAlphaFields(10))//' must be Coil:Heating:DX:MultiSpeed ')
CALL ShowFatalError(RoutineName//'Errors found in getting '//TRIM(CurrentModuleObject)//' input. '//&
'Preceding condition(s) causes termination.')
ErrorsFound=.true.
End If
LocalError = .FALSE.
CALL GetDXCoilIndex(MSHeatPump(MSHPNum)%DXHeatCoilName,MSHeatPump(MSHPNum)%DXHeatCoilIndex, &
LocalError, 'Coil:Heating:DX:MultiSpeed')
IF(LocalError) Then
CALL ShowSevereError('The index of '//TRIM(cAlphaFields(11))//' is not found "'//TRIM(Alphas(11))//'"')
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
ErrorsFound=.true.
LocalError = .FALSE.
End If
HeatingCoilInletNode = GetDXCoilInletNode(Alphas(10),Alphas(11),LocalError)
IF(LocalError) Then
CALL ShowSevereError('The inlet node number of '//TRIM(cAlphaFields(11))//' is not found "'//TRIM(Alphas(11))//'"')
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
ErrorsFound=.true.
LocalError = .FALSE.
End If
HeatingCoilOutletNode = GetDXCoilOutletNode(Alphas(10),Alphas(11),LocalError)
IF(LocalError) Then
CALL ShowSevereError('The outlet node number of '//TRIM(cAlphaFields(11))//' is not found "'//TRIM(Alphas(11))//'"')
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
ErrorsFound=.true.
LocalError = .FALSE.
End If
CALL SetUpCompSets(CurrentModuleObject, MSHeatPump(MSHPNum)%Name, &
'Coil:Heating:DX:MultiSpeed',MSHeatPump(MSHPNum)%DXHeatCoilName,'UNDEFINED', 'UNDEFINED')
Else if (SameString(Alphas(10),'Coil:Heating:Electric:MultiStage') .OR. &
SameString(Alphas(10),'Coil:Heating:Gas:MultiStage') ) THEN
IF (SameString(Alphas(10),'Coil:Heating:Electric:MultiStage')) THEN
MSHeatPump(MSHPNum)%HeatCoilType = Coil_HeatingElectric_MultiStage
MSHeatPump(MSHPNum)%HeatCoilNum = GetObjectItemNum('Coil:Heating:Electric:MultiStage',Alphas(11))
If (MSHeatPump(MSHPNum)%HeatCoilNum <= 0) then
CALL ShowSevereError('Configuration error in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
CALL ShowContinueError(TRIM(cAlphaFields(11))//' "'//TRIM(Alphas(11))//'" not found.')
CALL ShowContinueError(TRIM(cAlphaFields(10))//' must be Coil:Heating:Electric:MultiStage ')
CALL ShowFatalError(RoutineName//'Errors found in getting '//TRIM(CurrentModuleObject)//' input. '//&
'Preceding condition(s) causes termination.')
ErrorsFound=.true.
End If
ELSE
MSHeatPump(MSHPNum)%HeatCoilType = Coil_HeatingGas_MultiStage
MSHeatPump(MSHPNum)%HeatCoilNum = GetObjectItemNum('Coil:Heating:Gas:MultiStage',Alphas(11))
If (MSHeatPump(MSHPNum)%HeatCoilNum <= 0) then
CALL ShowSevereError('Configuration error in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
CALL ShowContinueError(TRIM(cAlphaFields(11))//' "'//TRIM(Alphas(11))//'" not found.')
CALL ShowContinueError(TRIM(cAlphaFields(10))//' must be Coil:Heating:Gas:MultiStage ')
CALL ShowFatalError(RoutineName//'Errors found in getting '//TRIM(CurrentModuleObject)//' input. '//&
'Preceding condition(s) causes termination.')
ErrorsFound=.true.
End If
ENDIF
MSHeatPump(MSHPNum)%HeatCoilName = Alphas(11)
LocalError = .FALSE.
IF (SameString(Alphas(10),'Coil:Heating:Electric:MultiStage')) THEN
CALL GetCoilIndex(MSHeatPump(MSHPNum)%HeatCoilName,MSHeatPump(MSHPNum)%HeatCoilIndex, LocalError)
ELSE
CALL GetCoilIndex(MSHeatPump(MSHPNum)%HeatCoilName,MSHeatPump(MSHPNum)%HeatCoilIndex, LocalError)
ENDIF
IF(LocalError) Then
CALL ShowSevereError('The index of '//TRIM(cAlphaFields(11))//' is not found "'//TRIM(Alphas(11))//'"')
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
ErrorsFound=.true.
LocalError = .FALSE.
End If
HeatingCoilInletNode = GetCoilInletNode(Alphas(10),Alphas(11),LocalError)
IF(LocalError) Then
CALL ShowSevereError('The inlet node number of '//TRIM(cAlphaFields(11))//' is not found "'//TRIM(Alphas(11))//'"')
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
ErrorsFound=.true.
LocalError = .FALSE.
End If
HeatingCoilOutletNode = GetCoilOutletNode(Alphas(10),Alphas(11),LocalError)
IF(LocalError) Then
CALL ShowSevereError('The outlet node number of '//TRIM(cAlphaFields(11))//' is not found "'//TRIM(Alphas(11))//'"')
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
ErrorsFound=.true.
LocalError = .FALSE.
End If
IF (SameString(Alphas(10),'Coil:Heating:Electric:MultiStage')) THEN
CALL SetUpCompSets(CurrentModuleObject, MSHeatPump(MSHPNum)%Name, &
'Coil:Heating:Electric:MultiStage',MSHeatPump(MSHPNum)%HeatCoilName,'UNDEFINED', 'UNDEFINED')
ELSE
CALL SetUpCompSets(CurrentModuleObject, MSHeatPump(MSHPNum)%Name, &
'Coil:Heating:Gas:MultiStage',MSHeatPump(MSHPNum)%HeatCoilName,'UNDEFINED', 'UNDEFINED')
ENDIF
ELSEIF (SameString(Alphas(10),'Coil:Heating:Water')) THEN
MSHeatPump(MSHPNum)%HeatCoilType = Coil_HeatingWater
CALL ValidateComponent(Alphas(10),Alphas(11),IsNotOK,TRIM(CurrentModuleObject))
IF (IsNotOK) THEN
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
ErrorsFound=.TRUE.
ELSE ! mine data from heating coil object
MSHeatPump(MSHPNum)%HeatCoilName = Alphas(11)
! Get the Heating Coil water Inlet or control Node number
ErrFlag = .FALSE.
MSHeatPump(MSHPNum)%CoilControlNode = GetCoilWaterInletNode('Coil:Heating:Water', &
MSHeatPump(MSHPNum)%HeatCoilName,ErrFlag)
IF(ErrFlag)THEN
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound = .TRUE.
END IF
! Get the ReHeat Coil hot water max volume flow rate
ErrFlag = .FALSE.
MSHeatPump(MSHPNum)%MaxCoilFluidFlow = GetCoilMaxWaterFlowRate('Coil:Heating:Water', &
MSHeatPump(MSHPNum)%HeatCoilName,ErrFlag)
IF(ErrFlag)THEN
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound = .TRUE.
END IF
! Get the lemental Heating Coil Inlet Node
ErrFlag = .FALSE.
HeatingCoilInletNode = GetWaterCoilInletNode('Coil:Heating:Water',MSHeatPump(MSHPNum)%HeatCoilName,ErrFlag)
MSHeatPump(MSHPNum)%CoilAirInletNode = HeatingCoilInletNode
IF(ErrFlag)THEN
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound = .TRUE.
END IF
! Get the lemental Heating Coil Outlet Node
ErrFlag = .FALSE.
HeatingCoilOutletNode = GetWaterCoilOutletNode('Coil:Heating:Water',MSHeatPump(MSHPNum)%HeatCoilName,ErrFlag)
IF(ErrFlag)THEN
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound = .TRUE.
END IF
CALL SetUpCompSets(CurrentModuleObject, MSHeatPump(MSHPNum)%Name, &
'Coil:Heating:Water',MSHeatPump(MSHPNum)%HeatCoilName, &
NodeID(HeatingCoilInletNode), NodeID(HeatingCoilOutletNode))
ENDIF
ELSEIF (SameString(Alphas(10),'Coil:Heating:Steam')) THEN
MSHeatPump(MSHPNum)%HeatCoilType = Coil_HeatingSteam
CALL ValidateComponent(Alphas(10),Alphas(11),IsNotOK,TRIM(CurrentModuleObject))
IF (IsNotOK) THEN
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound=.TRUE.
ELSE ! mine data from heating coil object
MSHeatPump(MSHPNum)%HeatCoilName = Alphas(11)
ErrFlag = .FALSE.
MSHeatPump(MSHPNum)%HeatCoilNum = GetSTeamCoilIndex(Alphas(10),MSHeatPump(MSHPNum)%HeatCoilName,ErrFlag)
IF (MSHeatPump(MSHPNum)%HeatCoilNum .EQ. 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' illegal '//TRIM(cAlphaFields(10))//' = ' &
//TRIM(MSHeatPump(MSHPNum)%HeatCoilName))
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound = .TRUE.
END IF
! Get the lemental Heating Coil steam inlet node number
ErrFlag = .FALSE.
MSHeatPump(MSHPNum)%CoilControlNode = GetSteamCoilSteamInletNode('Coil:Heating:Steam', &
MSHeatPump(MSHPNum)%HeatCoilName,ErrFlag)
IF(ErrFlag)THEN
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound = .TRUE.
END IF
! Get the lemental Heating Coil steam max volume flow rate
MSHeatPump(MSHPNum)%MaxCoilFluidFlow = GetCoilMaxSteamFlowRate(MSHeatPump(MSHPNum)%HeatCoilNum,ErrFlag)
IF (MSHeatPump(MSHPNum)%MaxCoilFluidFlow .GT. 0.0d0)THEN
SteamIndex = 0 ! Function GetSatDensityRefrig will look up steam index if 0 is passed
SteamDensity=GetSatDensityRefrig("STEAM",TempSteamIn,1.0d0,SteamIndex,'GetMSHeatPumpInput')
MSHeatPump(MSHPNum)%MaxCoilFluidFlow = MSHeatPump(MSHPNum)%MaxCoilFluidFlow * SteamDensity
END IF
! Get the lemental Heating Coil Inlet Node
ErrFlag = .FALSE.
HeatingCoilInletNode = &
GetSteamCoilAirInletNode(MSHeatPump(MSHPNum)%HeatCoilNum,MSHeatPump(MSHPNum)%HeatCoilName,ErrFlag)
MSHeatPump(MSHPNum)%CoilAirInletNode = HeatingCoilInletNode
IF(ErrFlag)THEN
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound = .TRUE.
END IF
! Get the lemental Heating Coil Outlet Node
ErrFlag = .FALSE.
HeatingCoilOutletNode = &
GetSteamCoilAirOutletNode(MSHeatPump(MSHPNum)%HeatCoilNum,MSHeatPump(MSHPNum)%HeatCoilName,ErrFlag)
IF(ErrFlag)THEN
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound = .TRUE.
END IF
CALL SetUpCompSets(CurrentModuleObject, MSHeatPump(MSHPNum)%Name, &
'Coil:Heating:Steam',MSHeatPump(MSHPNum)%HeatCoilName, &
NodeID(HeatingCoilInletNode), NodeID(HeatingCoilOutletNode))
ENDIF
ELSE
CALL ShowSevereError('The allowed '//TRIM(cAlphaFields(10))//' are Coil:Heating:DX:MultiSpeed, '// &
'Coil:Heating:Electric:MultiStage, and Coil:Heating:Gas:MultiStage '// &
'in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
CALL ShowContinueError('The entered '//TRIM(cAlphaFields(10))//' = "'//TRIM(Alphas(10))//'".')
ErrorsFound=.true.
ENDIF
MSHeatPump(MSHPNum)%MinOATCompressor = Numbers(1)
If (Numbers(1) < -20.0d0) then
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", '//TRIM(cNumericFields(1))//' is -20.0')
CALL ShowContinueError('The input value is '//RoundSigDigits(Numbers(4),2))
ErrorsFound=.true.
End If
IF (SameString(Alphas(12),'Coil:Cooling:DX:MultiSpeed')) THEN
MSHeatPump(MSHPNum)%CoolCoilType = MultiSpeedCoolingCoil
MSHeatPump(MSHPNum)%CoolCoilNum = GetObjectItemNum('Coil:Cooling:DX:MultiSpeed',Alphas(13))
MSHeatPump(MSHPNum)%DXCoolCoilName = Alphas(13)
If (MSHeatPump(MSHPNum)%CoolCoilNum <= 0) then
CALL ShowSevereError('Configuration error in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
CALL ShowContinueError(TRIM(cAlphaFields(13))//' "'//TRIM(Alphas(13))//'" not found.')
CALL ShowContinueError(TRIM(cAlphaFields(12))//' must be Coil:Cooling:DX:MultiSpeed ')
CALL ShowFatalError(RoutineName//'Errors found in getting '//TRIM(CurrentModuleObject)//' input. '//&
'Preceding condition(s) causes termination.')
ErrorsFound=.true.
End If
LocalError = .FALSE.
CALL GetDXCoilIndex(MSHeatPump(MSHPNum)%DXCoolCoilName,MSHeatPump(MSHPNum)%DXCoolCoilIndex, &
LocalError, 'Coil:Cooling:DX:MultiSpeed')
IF(LocalError) Then
CALL ShowSevereError('The index of '//TRIM(cAlphaFields(13))//' is not found "'//TRIM(Alphas(13))//'"')
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
ErrorsFound=.true.
LocalError = .FALSE.
End If
CoolingCoilInletNode = GetDXCoilInletNode(Alphas(12),Alphas(13),LocalError)
IF(LocalError) Then
CALL ShowSevereError('The inlet node number of '//TRIM(cAlphaFields(13))//' is not found "'//TRIM(Alphas(13))//'"')
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
ErrorsFound=.true.
LocalError = .FALSE.
End If
CoolingCoilOutletNode = GetDXCoilOutletNode(Alphas(12),Alphas(13),LocalError)
IF(LocalError) Then
CALL ShowSevereError('The outlet node number of '//TRIM(cAlphaFields(13))//' is not found "'//TRIM(Alphas(13))//'"')
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
ErrorsFound=.true.
LocalError = .FALSE.
End If
Else
CALL ShowSevereError('The allowed '//TRIM(cAlphaFields(12))//' is Coil:Cooling:DX:MultiSpeed '// &
'in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
CALL ShowContinueError('The entered '//TRIM(cAlphaFields(12))//' = "'//TRIM(Alphas(12))//'".')
ErrorsFound=.true.
End If
CALL SetUpCompSets(CurrentModuleObject, MSHeatPump(MSHPNum)%Name, &
'Coil:Cooling:DX:MultiSpeed',MSHeatPump(MSHPNum)%DXCoolCoilName,'UNDEFINED', 'UNDEFINED')
! Get supplemental heating coil data
MSHeatPump(MSHPNum)%SuppHeatCoilName = Alphas(15)
IF (SameString(Alphas(14),'Coil:Heating:Gas')) THEN
MSHeatPump(MSHPNum)%SuppHeatCoilType = SuppHeatingCoilGas
errFlag=.false.
MSHeatPump(MSHPNum)%SuppHeatCoilNum = GetHeatingCoilIndex('Coil:Heating:Gas',Alphas(15),errFlag)
IF (MSHeatPump(MSHPNum)%SuppHeatCoilNum <= 0 .or. errFlag) then
CALL ShowContinueError('Configuration error in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
CALL ShowContinueError(TRIM(cAlphaFields(15))//' of type Coil:Heating:Gas "'//TRIM(Alphas(15))//'" not found.')
ErrorsFound=.true.
End If
! Get the Supplemental Heating Coil Node Numbers
LocalError = .FALSE.
SuppHeatCoilInletNode = GetHeatingCoilInletNode(Alphas(14),Alphas(15),LocalError)
IF(LocalError) Then
CALL ShowSevereError('The inlet node number of '//TRIM(cAlphaFields(15))//' is not found "'//TRIM(Alphas(15))//'"')
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
ErrorsFound=.true.
LocalError = .FALSE.
End If
SuppHeatCoilOutletNode = GetHeatingCoilOutletNode(Alphas(14),Alphas(15),LocalError)
IF(LocalError) Then
CALL ShowSevereError('The outlet node number of '//TRIM(cAlphaFields(15))//' is not found "'//TRIM(Alphas(15))//'"')
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
ErrorsFound=.true.
LocalError = .FALSE.
End If
! Get supplemental heating coil capacity to see if it is autosize
MSHeatPump(MSHPNum)%DesignSuppHeatingCapacity = GetHeatingCoilCapacity(Alphas(14),Alphas(15),LocalError)
IF(LocalError) Then
CALL ShowSevereError('The capacity '//TRIM(cAlphaFields(15))//' is not found "'//TRIM(Alphas(15))//'"')
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
ErrorsFound=.true.
LocalError = .FALSE.
End If
CALL SetUpCompSets(CurrentModuleObject, MSHeatPump(MSHPNum)%Name, &
'Coil:Heating:Gas',MSHeatPump(MSHPNum)%SuppHeatCoilName,'UNDEFINED', 'UNDEFINED')
End If
IF (SameString(Alphas(14),'Coil:Heating:Electric')) THEN
MSHeatPump(MSHPNum)%SuppHeatCoilType = SuppHeatingCoilElec
errFlag=.false.
MSHeatPump(MSHPNum)%SuppHeatCoilNum = GetHeatingCoilIndex('Coil:Heating:Electric',Alphas(15),errFlag)
IF (MSHeatPump(MSHPNum)%SuppHeatCoilNum <= 0 .or. errFlag) then
CALL ShowContinueError('Configuration error in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
CALL ShowContinueError(TRIM(cAlphaFields(15))//' of type Coil:Heating:Electric "'//TRIM(Alphas(15))//'" not found.')
ErrorsFound=.true.
End If
! Get the Supplemental Heating Coil Node Numbers
LocalError = .FALSE.
SuppHeatCoilInletNode = GetHeatingCoilInletNode(Alphas(14),Alphas(15),LocalError)
IF(LocalError) Then
CALL ShowSevereError('The inlet node number of '//TRIM(cAlphaFields(15))//' is not found "'//TRIM(Alphas(15))//'"')
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
ErrorsFound=.true.
LocalError = .FALSE.
End If
SuppHeatCoilOutletNode = GetHeatingCoilOutletNode(Alphas(14),Alphas(15),LocalError)
IF(LocalError) Then
CALL ShowSevereError('The outlet node number of '//TRIM(cAlphaFields(15))//' is not found "'//TRIM(Alphas(15))//'"')
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
ErrorsFound=.true.
LocalError = .FALSE.
End If
! Get supplemental heating coil capacity to see if it is autosize
MSHeatPump(MSHPNum)%DesignSuppHeatingCapacity = GetHeatingCoilCapacity(Alphas(14),Alphas(15),LocalError)
IF(LocalError) Then
CALL ShowSevereError('The capacity '//TRIM(cAlphaFields(15))//' is not found "'//TRIM(Alphas(15))//'"')
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' "'//TRIM(Alphas(1))//'"')
ErrorsFound=.true.
LocalError = .FALSE.
End If
CALL SetUpCompSets(CurrentModuleObject, MSHeatPump(MSHPNum)%Name, &
'Coil:Heating:Electric',MSHeatPump(MSHPNum)%SuppHeatCoilName,'UNDEFINED', 'UNDEFINED')
End If
IF (SameString(Alphas(14),'Coil:Heating:Water')) THEN
MSHeatPump(MSHPNum)%SuppHeatCoilType = Coil_HeatingWater
CALL ValidateComponent(Alphas(14),MSHeatPump(MSHPNum)%SuppHeatCoilName,IsNotOK,TRIM(CurrentModuleObject))
IF (IsNotOK) THEN
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
ErrorsFound=.TRUE.
ELSE ! mine data from heating coil object
! Get the Heating Coil water Inlet or control Node number
ErrFlag = .FALSE.
MSHeatPump(MSHPNum)%SuppCoilControlNode = GetCoilWaterInletNode('Coil:Heating:Water', &
MSHeatPump(MSHPNum)%SuppHeatCoilName,ErrFlag)
IF(ErrFlag)THEN
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound = .TRUE.
END IF
! Get the ReHeat Coil hot water max volume flow rate
ErrFlag = .FALSE.
MSHeatPump(MSHPNum)%MaxSuppCoilFluidFlow = GetCoilMaxWaterFlowRate('Coil:Heating:Water', &
MSHeatPump(MSHPNum)%SuppHeatCoilName,ErrFlag)
IF(ErrFlag)THEN
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound = .TRUE.
END IF
! Get the Supplemental Heating Coil Inlet Node
ErrFlag = .FALSE.
SuppHeatCoilInletNode = GetWaterCoilInletNode('Coil:Heating:Water',MSHeatPump(MSHPNum)%SuppHeatCoilName,ErrFlag)
MSHeatPump(MSHPNum)%SuppCoilAirInletNode = SuppHeatCoilInletNode
IF(ErrFlag)THEN
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound = .TRUE.
END IF
! Get the Supplemental Heating Coil Outlet Node
ErrFlag = .FALSE.
SuppHeatCoilOutletNode = GetWaterCoilOutletNode('Coil:Heating:Water',MSHeatPump(MSHPNum)%SuppHeatCoilName,ErrFlag)
MSHeatPump(MSHPNum)%SuppCoilAirOutletNode = SuppHeatCoilOutletNode
IF(ErrFlag)THEN
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound = .TRUE.
END IF
CALL SetUpCompSets(CurrentModuleObject, MSHeatPump(MSHPNum)%Name, &
'Coil:Heating:Water',MSHeatPump(MSHPNum)%SuppHeatCoilName, &
NodeID(SuppHeatCoilInletNode), NodeID(SuppHeatCoilOutletNode))
ENDIF
ENDIF
IF (SameString(Alphas(14),'Coil:Heating:Steam')) THEN
MSHeatPump(MSHPNum)%SuppHeatCoilType = Coil_HeatingSteam
CALL ValidateComponent(Alphas(14),MSHeatPump(MSHPNum)%SuppHeatCoilName,IsNotOK,TRIM(CurrentModuleObject))
IF (IsNotOK) THEN
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound=.TRUE.
ELSE ! mine data from heating coil object
ErrFlag = .FALSE.
MSHeatPump(MSHPNum)%SuppHeatCoilNum = GetSTeamCoilIndex(Alphas(14),MSHeatPump(MSHPNum)%SuppHeatCoilName,ErrFlag)
IF (MSHeatPump(MSHPNum)%SuppHeatCoilNum .EQ. 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' illegal '//TRIM(cAlphaFields(14))//' = ' &
//TRIM(MSHeatPump(MSHPNum)%SuppHeatCoilName))
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound = .TRUE.
END IF
! Get the Supplemental Heating Coil steam inlet node number
ErrFlag = .FALSE.
MSHeatPump(MSHPNum)%SuppCoilControlNode = GetSteamCoilSteamInletNode('Coil:Heating:Steam', &
MSHeatPump(MSHPNum)%SuppHeatCoilName,ErrFlag)
IF(ErrFlag)THEN
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound = .TRUE.
END IF
! Get the Supplemental Heating Coil steam max volume flow rate
MSHeatPump(MSHPNum)%MaxSuppCoilFluidFlow = GetCoilMaxSteamFlowRate(MSHeatPump(MSHPNum)%SuppHeatCoilNum,ErrFlag)
IF (MSHeatPump(MSHPNum)%MaxSuppCoilFluidFlow .GT. 0.0d0)THEN
SteamIndex = 0 ! Function GetSatDensityRefrig will look up steam index if 0 is passed
SteamDensity=GetSatDensityRefrig("STEAM",TempSteamIn,1.0d0,SteamIndex,'GetMSHeatPumpInput')
MSHeatPump(MSHPNum)%MaxSuppCoilFluidFlow = MSHeatPump(MSHPNum)%MaxSuppCoilFluidFlow * SteamDensity
END IF
! Get the Supplemental Heating Coil Inlet Node
ErrFlag = .FALSE.
SuppHeatCoilInletNode = &
GetSteamCoilAirInletNode(MSHeatPump(MSHPNum)%SuppHeatCoilNum,MSHeatPump(MSHPNum)%SuppHeatCoilName,ErrFlag)
MSHeatPump(MSHPNum)%SuppCoilAirInletNode = SuppHeatCoilInletNode
IF(ErrFlag)THEN
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound = .TRUE.
END IF
! Get the Supplemental Heating Coil Outlet Node
ErrFlag = .FALSE.
SuppHeatCoilOutletNode = &
GetSteamCoilAirOutletNode(MSHeatPump(MSHPNum)%SuppHeatCoilNum,MSHeatPump(MSHPNum)%SuppHeatCoilName,ErrFlag)
MSHeatPump(MSHPNum)%SuppCoilAirOutletNode = SuppHeatCoilOutletNode
IF(ErrFlag)THEN
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(MSHeatPump(MSHPNum)%Name))
ErrorsFound = .TRUE.
END IF
CALL SetUpCompSets(CurrentModuleObject, MSHeatPump(MSHPNum)%Name, &
'Coil:Heating:Steam',MSHeatPump(MSHPNum)%SuppHeatCoilName, &
NodeID(SuppHeatCoilInletNode), NodeID(SuppHeatCoilOutletNode))
ENDIF
ENDIF
If (MSHeatPump(MSHPNum)%SuppHeatCoilType .EQ. 0) then
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", '//TRIM(cAlphaFields(14))//' is not allowed = '//TRIM(Alphas(14)))
CALL ShowContinueError('Valid choices are Coil:Heating:Gas,Coil:Heating:Electric,Coil:Heating:Steam,or Coil:Heating:Water')
ErrorsFound=.true.
End If
MSHeatPump(MSHPNum)%SuppMaxAirTemp = Numbers(2)
MSHeatPump(MSHPNum)%SuppMaxOATemp = Numbers(3)
If (MSHeatPump(MSHPNum)%SuppMaxOATemp > 21.0d0) then
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", '//TRIM(cNumericFields(3))//' is greater than 21.0')
CALL ShowContinueError('The input value is '//RoundSigDigits(Numbers(3),2))
ErrorsFound=.true.
End If
MSHeatPump(MSHPNum)%AuxOnCyclePower = Numbers(4)
MSHeatPump(MSHPNum)%AuxOffCyclePower = Numbers(5)
If (MSHeatPump(MSHPNum)%AuxOnCyclePower .LT. 0.0d0) then
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", A negative value for '//TRIM(cNumericFields(4))//' is not allowed ')
ErrorsFound=.true.
End If
If (MSHeatPump(MSHPNum)%AuxOffCyclePower .LT. 0.0d0) then
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", A negative value for '//TRIM(cNumericFields(5))//' is not allowed ')
ErrorsFound=.true.
End If
! Heat recovery
MSHeatPump(MSHPNum)%DesignHeatRecFlowRate = Numbers(6)
IF (MSHeatPump(MSHPNum)%DesignHeatRecFlowRate > 0.0d0) then
MSHeatPump(MSHPNum)%HeatRecActive=.True.
MSHeatPump(MSHPNum)%DesignHeatRecMassFlowRate = RhoH2O(InitConvTemp)*MSHeatPump(MSHPNum)%DesignHeatRecFlowRate
MSHeatPump(MSHPNum)%HeatRecInletNodeNum = &
GetOnlySingleNode(Alphas(16),ErrorsFound,'MSHP Heat receovery',Alphas(1), &
NodeType_Water,NodeConnectionType_Inlet, 3, ObjectIsNotParent)
IF (MSHeatPump(MSHPNum)%HeatRecInletNodeNum == 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", Missing '//TRIM(cAlphaFields(16))//'.')
ErrorsFound=.True.
END IF
MSHeatPump(MSHPNum)%HeatRecOutletNodeNum = &
GetOnlySingleNode(Alphas(17),ErrorsFound,'MSHP Heat receovery',Alphas(1), &
NodeType_Water,NodeConnectionType_Outlet, 3, ObjectIsNotParent)
IF (MSHeatPump(MSHPNum)%HeatRecOutletNodeNum == 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", Missing '//TRIM(cAlphaFields(17))//'.')
ErrorsFound=.True.
END IF
CALL TestCompSet(CurrentModuleObject,Alphas(1),Alphas(16),Alphas(17),'MSHP Heat receovery Nodes')
ELSE
MSHeatPump(MSHPNum)%HeatRecActive=.False.
MSHeatPump(MSHPNum)%DesignHeatRecMassFlowRate = 0.0d0
MSHeatPump(MSHPNum)%HeatRecInletNodeNum = 0
MSHeatPump(MSHPNum)%HeatRecOutletNodeNum = 0
IF (.NOT. lAlphaBlanks(16) .or. .NOT. lAlphaBlanks(17)) THEN
CALL ShowWarningError('Since '//TRIM(cNumericFields(6))//' = 0.0, heat recovery is inactive for '// &
TRIM(CurrentModuleObject)// ' = '//TRIM(Alphas(1)))
CALL ShowContinueError('However, '//TRIM(cAlphaFields(16))//' or '//TRIM(cAlphaFields(17))//' was specified.')
END IF
End If
MSHeatPump(MSHPNum)%MaxHeatRecOutletTemp = Numbers(7)
IF (MSHeatPump(MSHPNum)%MaxHeatRecOutletTemp .LT. 0.0d0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", The value for '//TRIM(cNumericFields(7))//' is below 0.0')
ErrorsFound=.True.
END IF
IF (MSHeatPump(MSHPNum)%MaxHeatRecOutletTemp .GT. 100.0d0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", The value for '//TRIM(cNumericFields(7))//' is above 100.0')
ErrorsFound=.True.
END IF
MSHeatPump(MSHPNum)%IdleVolumeAirRate = Numbers(8)
IF (MSHeatPump(MSHPNum)%IdleVolumeAirRate .LT. 0.0d0 .AND. MSHeatPump(MSHPNum)%IdleVolumeAirRate /= AutoSize) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", '//TRIM(cNumericFields(8))//' cannot be less than zero.')
ErrorsFound = .TRUE.
END IF
! AirFlowControl only valid if fan opmode = ContFanCycCoil
IF (MSHeatPump(MSHPNum)%IdleVolumeAirRate .EQ. 0.0d0) THEN
MSHeatPump(MSHPNum)%AirFlowControl = UseCompressorOnFlow
ELSE
MSHeatPump(MSHPNum)%AirFlowControl = UseCompressorOffFlow
END IF
! Initialize last mode of compressor operation
MSHeatPump(MSHPNum)%LastMode = HeatingMode
MSHeatPump(MSHPNum)%NumOfSpeedHeating = Numbers(9)
If (MSHeatPump(MSHPNum)%NumOfSpeedHeating .LT. 2 .OR. MSHeatPump(MSHPNum)%NumOfSpeedHeating .GT. 4) Then
If (MSHeatPump(MSHPNum)%HeatCoilType .EQ. MultiSpeedHeatingCoil) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//', The maximum '//TRIM(cNumericFields(9))//' is 4, and ' &
//'the minimum number is 2')
CALL ShowContinueError('The input value is '//RoundSigDigits(Numbers(9),0))
ErrorsFound=.true.
End If
End If
MSHeatPump(MSHPNum)%NumOfSpeedCooling = Numbers(10)
If (MSHeatPump(MSHPNum)%NumOfSpeedCooling .LT. 2 .OR. MSHeatPump(MSHPNum)%NumOfSpeedCooling .GT. 4) Then
CALL ShowSevereError(TRIM(CurrentModuleObject)//', The maximum '//TRIM(cNumericFields(10))//' is 4, and ' &
//'the minimum number is 2')
CALL ShowContinueError('The input value is '//RoundSigDigits(Numbers(10),0))
ErrorsFound=.true.
End If
! Generate a dynamic array for heating
If (MSHeatPump(MSHPNum)%NumOfSpeedHeating .GT. 0) Then
ALLOCATE(MSHeatPump(MSHPNum)%HeatMassFlowRate(MSHeatPump(MSHPNum)%NumOfSpeedHeating))
ALLOCATE(MSHeatPump(MSHPNum)%HeatVolumeFlowRate(MSHeatPump(MSHPNum)%NumOfSpeedHeating))
ALLOCATE(MSHeatPump(MSHPNum)%HeatingSpeedRatio(MSHeatPump(MSHPNum)%NumOfSpeedHeating))
MSHeatPump(MSHPNum)%HeatingSpeedRatio = 1.0d0
Do i=1,MSHeatPump(MSHPNum)%NumOfSpeedHeating
MSHeatPump(MSHPNum)%HeatVolumeFlowRate(i) = Numbers(10+i)
If (MSHeatPump(MSHPNum)%HeatCoilType .EQ. MultiSpeedHeatingCoil) THEN
IF (MSHeatPump(MSHPNum)%HeatVolumeFlowRate(i) .LE. 0.0d0 .AND. MSHeatPump(MSHPNum)%HeatVolumeFlowRate(i) /= AutoSize) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", '//TRIM(cNumericFields(10+i))//' must be greater than zero.')
ErrorsFound = .TRUE.
End If
End If
End Do
! Ensure flow rate at high speed should be greater or equal to the flow rate at low speed
Do i=2,MSHeatPump(MSHPNum)%NumOfSpeedHeating
If (MSHeatPump(MSHPNum)%HeatVolumeFlowRate(i) == AutoSize) Cycle
found = .False.
Do j=i-1,1,-1
If (MSHeatPump(MSHPNum)%HeatVolumeFlowRate(i) /= AutoSize) Then
Found = .True.
Exit
End If
End Do
If (Found) Then
If (MSHeatPump(MSHPNum)%HeatVolumeFlowRate(i) .LT. MSHeatPump(MSHPNum)%HeatVolumeFlowRate(j)) Then
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", '//TRIM(cNumericFields(10+i)))
CALL ShowContinueError(' cannot be less than '//TRIM(cNumericFields(10+j)))
ErrorsFound = .TRUE.
End If
End If
End Do
End If
! Generate a dynamic array for cooling
If (MSHeatPump(MSHPNum)%NumOfSpeedCooling .GT. 0) Then
ALLOCATE(MSHeatPump(MSHPNum)%CoolMassFlowRate(MSHeatPump(MSHPNum)%NumOfSpeedCooling))
ALLOCATE(MSHeatPump(MSHPNum)%CoolVolumeFlowRate(MSHeatPump(MSHPNum)%NumOfSpeedCooling))
ALLOCATE(MSHeatPump(MSHPNum)%CoolingSpeedRatio(MSHeatPump(MSHPNum)%NumOfSpeedCooling))
MSHeatPump(MSHPNum)%CoolingSpeedRatio = 1.0d0
Do i=1,MSHeatPump(MSHPNum)%NumOfSpeedCooling
MSHeatPump(MSHPNum)%CoolVolumeFlowRate(i) = Numbers(14+i)
IF (MSHeatPump(MSHPNum)%CoolVolumeFlowRate(i) .LE. 0.0d0 .AND. MSHeatPump(MSHPNum)%CoolVolumeFlowRate(i) /= AutoSize) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", '//TRIM(cNumericFields(14+i))//' must be greater than zero.')
ErrorsFound = .TRUE.
End If
End Do
! Ensure flow rate at high speed should be greater or equal to the flow rate at low speed
Do i=2,MSHeatPump(MSHPNum)%NumOfSpeedCooling
If (MSHeatPump(MSHPNum)%CoolVolumeFlowRate(i) == AutoSize) Cycle
found = .False.
Do j=i-1,1,-1
If (MSHeatPump(MSHPNum)%CoolVolumeFlowRate(i) /= AutoSize) Then
Found = .True.
Exit
End If
End Do
If (Found) Then
If (MSHeatPump(MSHPNum)%CoolVolumeFlowRate(i) .LT. MSHeatPump(MSHPNum)%CoolVolumeFlowRate(j)) Then
CALL ShowSevereError(TRIM(CurrentModuleObject)//', "'//TRIM(MSHeatPump(MSHPNum)%Name)//&
'", '//TRIM(cNumericFields(14+i)))
CALL ShowContinueError(' cannot be less than '//TRIM(cNumericFields(14+j)))
ErrorsFound = .TRUE.
End If
End If
End Do
End If
! Check node integrity
If (MSHeatPump(MSHPNum)%FanPlaceType == BlowThru) Then
IF (MSHeatPump(MSHPNum)%FanInletNode /= MSHeatPump(MSHPNum)%AirInletNodeNum) THEN
CALL ShowSevereError('For '//TRIM(CurrentModuleObject)//' "'//TRIM(MSHeatPump(MSHPNum)%Name)//'"')
CALL ShowContinueError('When a blow through fan is specified, the fan inlet node name must be '// &
'the same as the '//TRIM(cAlphaFields(3)))
CALL ShowContinueError('...Fan inlet node name = '//TRIM(NodeID(MSHeatPump(MSHPNum)%FanInletNode)))
CALL ShowContinueError('...'//TRIM(cAlphaFields(3))//' = ' &
//TRIM(NodeID(MSHeatPump(MSHPNum)%AirInletNodeNum)))
ErrorsFound=.true.
END IF
IF (MSHeatPump(MSHPNum)%FanOutletNode /= CoolingCoilInletNode) THEN
CALL ShowSevereError('For '//TRIM(CurrentModuleObject)//' "'//TRIM(MSHeatPump(MSHPNum)%Name)//'"')
CALL ShowContinueError('When a blow through fan is specified, the fan outlet node name must be '// &
'the same as the cooling coil inlet node name.')
CALL ShowContinueError('...Fan outlet node name = '//TRIM(NodeID(MSHeatPump(MSHPNum)%FanOutletNode)))
CALL ShowContinueError('...Cooling coil inlet node name = '//TRIM(NodeID(CoolingCoilInletNode)))
ErrorsFound=.true.
END IF
IF(CoolingCoilOutletNode /= HeatingCoilInletNode) THEN
CALL ShowSevereError('For '//TRIM(CurrentModuleObject)//' "'//TRIM(MSHeatPump(MSHPNum)%Name)//'"')
CALL ShowContinueError('The cooling coil outlet node name must be '// &
'the same as the heating coil inlet node name.')
CALL ShowContinueError('...Cooling coil outlet node name = '//TRIM(NodeID(CoolingCoilOutletNode)))
CALL ShowContinueError('...Heating coil inlet node name = '//TRIM(NodeID(HeatingCoilInletNode)))
ErrorsFound=.true.
END IF
IF(HeatingCoilOutletNode /= SuppHeatCoilInletNode) THEN
CALL ShowSevereError('For '//TRIM(CurrentModuleObject)//' "'//TRIM(MSHeatPump(MSHPNum)%Name)//'"')
CALL ShowContinueError('When a blow through fan is specified, the heating coil outlet node name must be '// &
'the same as the reheat coil inlet node name.')
CALL ShowContinueError('...Heating coil outlet node name = '//TRIM(NodeID(HeatingCoilOutletNode)))
CALL ShowContinueError('...Reheat coil inlet node name = '//TRIM(NodeID(SuppHeatCoilInletNode)))
ErrorsFound=.true.
END IF
IF(SuppHeatCoilOutletNode /= MSHeatPump(MSHPNum)%AirOutletNodeNum) THEN
CALL ShowSevereError('For '//TRIM(CurrentModuleObject)//' "'//TRIM(MSHeatPump(MSHPNum)%Name)//'"')
CALL ShowContinueError('The supplemental heating coil outlet node name must be '// &
'the same as the '//TRIM(cAlphaFields(4)))
CALL ShowContinueError('...Supplemental heating coil outlet node name = '//TRIM(NodeID(SuppHeatCoilOutletNode)))
CALL ShowContinueError('...'//TRIM(cAlphaFields(4))//' = ' &
//TRIM(NodeID(MSHeatPump(MSHPNum)%AirOutletNodeNum)))
ErrorsFound=.true.
END IF
Else
IF(CoolingCoilInletNode /= MSHeatPump(MSHPNum)%AirInletNodeNum) THEN
CALL ShowSevereError('For '//TRIM(CurrentModuleObject)//' "'//TRIM(MSHeatPump(MSHPNum)%Name)//'"')
CALL ShowContinueError('When a draw through fan is specified, the cooling coil inlet node name must be '// &
'the same as the '//TRIM(cAlphaFields(3)))
CALL ShowContinueError('...Cooling coil inlet node name = '//TRIM(NodeID(CoolingCoilInletNode)))
CALL ShowContinueError('...'//TRIM(cAlphaFields(3))//' = ' &
//TRIM(NodeID(MSHeatPump(MSHPNum)%AirInletNodeNum)))
ErrorsFound=.true.
END IF
IF(CoolingCoilOutletNode /= HeatingCoilInletNode) THEN
CALL ShowSevereError('For '//TRIM(CurrentModuleObject)//' "'//TRIM(MSHeatPump(MSHPNum)%Name)//'"')
CALL ShowContinueError('The cooling coil outlet node name must be '// &
'the same as the heating coil inlet node name.')
CALL ShowContinueError('...Cooling coil outlet node name = '//TRIM(NodeID(CoolingCoilOutletNode)))
CALL ShowContinueError('...Heating coil inlet node name = '//TRIM(NodeID(HeatingCoilInletNode)))
ErrorsFound=.true.
END IF
IF(HeatingCoilOutletNode /= MSHeatPump(MSHPNum)%FanInletNode) THEN
CALL ShowSevereError('For '//TRIM(CurrentModuleObject)//' "'//TRIM(MSHeatPump(MSHPNum)%Name)//'"')
CALL ShowContinueError('When a draw through fan is specified, the heating coil outlet node name must be '// &
'the same as the fan inlet node name.')
CALL ShowContinueError('...Heating coil outlet node name = '//TRIM(NodeID(HeatingCoilOutletNode)))
CALL ShowContinueError('...Fan inlet node name = '//TRIM(NodeID(MSHeatPump(MSHPNum)%FanInletNode)))
ErrorsFound=.true.
END IF
IF(MSHeatPump(MSHPNum)%FanOutletNode /= SuppHeatCoilInletNode) THEN
CALL ShowSevereError('For '//TRIM(CurrentModuleObject)//' "'//TRIM(MSHeatPump(MSHPNum)%Name)//'"')
CALL ShowContinueError('When a draw through fan is specified, the fan outlet node name must be '// &
'the same as the reheat coil inlet node name.')
CALL ShowContinueError('...Fan outlet node name = '//TRIM(NodeID(MSHeatPump(MSHPNum)%FanOutletNode)))
CALL ShowContinueError('...Reheat coil inlet node name = '//TRIM(NodeID(SuppheatCoilInletNode)))
ErrorsFound=.true.
END IF
IF(SuppHeatCoilOutletNode /= MSHeatPump(MSHPNum)%AirOutletNodeNum) THEN
CALL ShowSevereError('For '//TRIM(CurrentModuleObject)//' "'//TRIM(MSHeatPump(MSHPNum)%Name)//'"')
CALL ShowContinueError('The reheat coil outlet node name must be '// &
'the same as the '//TRIM(cAlphaFields(4)))
CALL ShowContinueError('...Reheat coil outlet node name = '//TRIM(NodeID(SuppHeatCoilOutletNode)))
CALL ShowContinueError('...'//TRIM(cAlphaFields(4))//' = ' &
//TRIM(NodeID(MSHeatPump(MSHPNum)%AirOutletNodeNum)))
ErrorsFound=.true.
END IF
End If
! Ensure the numbers of speeds defined in the parent object are equal to the numbers defined in coil objects
IF (MSHeatPump(MSHPNum)%HeatCoilType .EQ. MultiSpeedHeatingCoil) THEN
I = GetDXCoilNumberOfSpeeds(Alphas(10),Alphas(11),ErrorsFound)
If (MSHeatPump(MSHPNum)%NumOfSpeedHeating /= I) Then
CALL ShowSevereError('For '//TRIM(CurrentModuleObject)//' "'//TRIM(MSHeatPump(MSHPNum)%Name)//'"')
CALL ShowContinueError('The '//TRIM(cNumericFields(9))//' is not equal to the number defined in '// &
TRIM(cAlphaFields(11))//' = '//TRIM(Alphas(11)))
ErrorsFound=.true.
End If
ELSEIF (MSHeatPump(MSHPNum)%HeatCoilType .EQ. Coil_HeatingElectric_MultiStage .OR. &
MSHeatPump(MSHPNum)%HeatCoilType .EQ. Coil_HeatingGas_MultiStage) THEN
I = GetHeatingCoilNumberOfStages(Alphas(10),Alphas(11),ErrorsFound)
If (MSHeatPump(MSHPNum)%NumOfSpeedHeating /= I) Then
CALL ShowSevereError('For '//TRIM(CurrentModuleObject)//' "'//TRIM(MSHeatPump(MSHPNum)%Name)//'"')
CALL ShowContinueError('The '//TRIM(cNumericFields(9))//' is not equal to the number defined in '// &
TRIM(cAlphaFields(11))//' = '//TRIM(Alphas(11)))
ErrorsFound=.true.
End If
ENDIF
I = GetDXCoilNumberOfSpeeds(Alphas(12),Alphas(13),ErrorsFound)
If (MSHeatPump(MSHPNum)%NumOfSpeedCooling /= I) Then
CALL ShowSevereError('For '//TRIM(CurrentModuleObject)//' "'//TRIM(MSHeatPump(MSHPNum)%Name)//'"')
CALL ShowContinueError('The '//TRIM(cNumericFields(10))//' is not equal to the number defined in '// &
TRIM(cAlphaFields(13))//' = '//TRIM(Alphas(13)))
ErrorsFound=.true.
End If
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in getting '//TRIM(CurrentModuleObject)//' input. '//&
'Preceding condition(s) causes termination.')
END IF
! End of multispeed heat pump
DO MSHPNum = 1 , NumMSHeatPumps
! Setup Report Variables for MSHP Equipment
CALL SetupOutputVariable('Unitary System Ancillary Electric Power [W]',MSHeatPump(MSHPNum)%AuxElecPower, &
'System','Average',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System Cooling Ancillary Electric Energy [J]', &
MSHeatPumpReport(MSHPNum)%AuxElecCoolConsumption,'System','Sum',MSHeatPump(MSHPNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='Cooling',GroupKey='System')
CALL SetupOutputVariable('Unitary System Heating Ancillary Electric Energy [J]', &
MSHeatPumpReport(MSHPNum)%AuxElecHeatConsumption,'System','Sum',MSHeatPump(MSHPNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='Heating',GroupKey='System')
CALL SetupOutputVariable('Unitary System Fan Part Load Ratio []',MSHeatPump(MSHPNum)%FanPartLoadRatio, &
'System','Average',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System Compressor Part Load Ratio []',MSHeatPump(MSHPNum)%CompPartLoadRatio, &
'System','Average',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System Electric Power [W]',MSHeatPump(MSHPNum)%ElecPower,&
'System','Average',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System Electric Energy [J]',MSHeatPumpReport(MSHPNum)%ElecPowerConsumption, &
'System','Sum',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System DX Coil Cycling Ratio []',MSHeatPumpReport(MSHPNum)%CycRatio, &
'System','Average',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System DX Coil Speed Ratio []',MSHeatPumpReport(MSHPNum)%SpeedRatio, &
'System','Average',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System DX Coil Speed Level []',MSHeatPumpReport(MSHPNum)%SpeedNum, &
'System','Average',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System Total Cooling Rate [W]',MSHeatPump(MSHPNum)%TotCoolEnergyRate, &
'System','Average',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System Total Heating Rate [W]',MSHeatPump(MSHPNum)%TotHeatEnergyRate, &
'System','Average',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System Sensible Cooling Rate [W]',MSHeatPump(MSHPNum)%SensCoolEnergyRate, &
'System','Average',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System Sensible Heating Rate [W]',MSHeatPump(MSHPNum)%SensHeatEnergyRate, &
'System','Average',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System Latent Cooling Rate [W]',MSHeatPump(MSHPNum)%LatCoolEnergyRate, &
'System','Average',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System Latent Heating Rate [W]',MSHeatPump(MSHPNum)%LatHeatEnergyRate, &
'System','Average',MSHeatPump(MSHPNum)%Name)
If (MSHeatPump(MSHPNum)%HeatRecActive) then
CALL SetupOutputVariable('Unitary System Heat Recovery Rate [W]',MSHeatPump(MSHPNum)%HeatRecoveryRate, &
'System','Average',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System Heat Recovery Inlet Temperature [C]', &
MSHeatPump(MSHPNum)%HeatRecoveryInletTemp,'System','Average',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System Heat Recovery Outlet Temperature [C]', &
MSHeatPump(MSHPNum)%HeatRecoveryOutletTemp,'System','Average',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System Heat Recovery Fluid Mass Flow Rate [kg/s]', &
MSHeatPump(MSHPNum)%HeatRecoveryMassFlowRate,'System','Average',MSHeatPump(MSHPNum)%Name)
CALL SetupOutputVariable('Unitary System Heat Recovery Energy [J]', &
MSHeatPumpReport(MSHPNum)%HeatRecoveryEnergy,'System','Sum',MSHeatPump(MSHPNum)%Name)
End If
END DO
RETURN
END SUBROUTINE GetMSHeatPumpInput