Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE GetUnitHeaterInput
! SUBROUTINE INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN May 2000
! MODIFIED Chandan Sharma, FSEC, March 2011: Added ZoneHVAC sys avail manager
! Bereket Nigusse, FSEC, April 2011: eliminated input node names
! & added fan object type
!
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Obtain the user input data for all of the unit heaters in the input file.
! METHODOLOGY EMPLOYED:
! Standard EnergyPlus methodology.
! REFERENCES:
! Fred Buhl's fan coil module (FanCoilUnits.f90)
! USE STATEMENTS:
USE InputProcessor, ONLY : GetNumObjectsFound, GetObjectItem, VerifyName, SameString,GetObjectDefMaxArgs
USE NodeInputManager, ONLY : GetOnlySingleNode
USE BranchNodeConnections, ONLY: SetUpCompSets
! USE DataIPShortCuts
USE Fans, ONLY: GetFanType, GetFanOutletNode, GetFanIndex, GetFanVolFlow, GetFanAvailSchPtr
USE WaterCoils, ONLY: GetCoilWaterInletNode
USE SteamCoils, ONLY: GetSteamCoilSteamInletNode=>GetCoilSteamInletNode, GetSteamCoilIndex
USE DataZoneEquipment, ONLY: UnitHeater_Num, ZoneEquipConfig
USE DataSizing, ONLY: AutoSize
USE General, ONLY: TrimSigDigits
USE DataHVACGlobals, ONLY: FanType_SimpleConstVolume, FanType_SimpleVAV, ZoneComp
USE DataGlobals, ONLY: NumOfZones
USE DataPlant, ONLY : TypeOf_CoilWaterSimpleHeating, TypeOf_CoilSteamAirHeating
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input, fatal at end of routine
INTEGER :: IOStatus ! Used in GetObjectItem
LOGICAL :: IsBlank ! TRUE if the name is blank
LOGICAL :: IsNotOk ! TRUE if there was a problem with a list name
LOGICAL :: ErrFlag=.FALSE. ! interim error flag
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER :: NumFields ! Total number of fields in object
INTEGER :: UnitHeatNum ! Item to be "gotten"
CHARACTER(len=*), PARAMETER :: RoutineName='GetUnitHeaterInput: ' ! include trailing blank space
! LOGICAL :: FanErrFlag ! Error flag used in GetFanIndex call
REAL(r64) :: FanVolFlow ! Fan volumetric flow rate
CHARACTER(len=MaxNameLength) :: CurrentModuleObject
CHARACTER(len=MaxNameLength), &
ALLOCATABLE, DIMENSION(:) :: Alphas ! Alpha items for object
REAL(r64), ALLOCATABLE, DIMENSION(:) :: Numbers ! Numeric items for object
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cAlphaFields ! Alpha field names
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cNumericFields ! Numeric field names
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaBlanks ! Logical array, alpha field input BLANK = .true.
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericBlanks ! Logical array, numeric field input BLANK = .true.
INTEGER :: CtrlZone ! index to loop counter
INTEGER :: NodeNum ! index to loop counter
LOGICAL :: ZoneNodeNotFound ! used in error checking
! FLOW:
! Figure out how many unit heaters there are in the input file
CurrentModuleObject = cMO_UnitHeater
NumOfUnitHeats = GetNumObjectsFound(CurrentModuleObject)
CALL GetObjectDefMaxArgs(CurrentModuleObject,NumFields,NumAlphas,NumNumbers)
ALLOCATE(Alphas(NumAlphas))
Alphas=' '
ALLOCATE(Numbers(NumNumbers))
Numbers=0.0d0
ALLOCATE(cAlphaFields(NumAlphas))
cAlphaFields=' '
ALLOCATE(cNumericFields(NumNumbers))
cNumericFields=' '
ALLOCATE(lAlphaBlanks(NumAlphas))
lAlphaBlanks=.TRUE.
ALLOCATE(lNumericBlanks(NumNumbers))
lNumericBlanks=.TRUE.
! Allocate the local derived type and do one-time initializations for all parts of it
IF (NumOfUnitHeats .GT. 0) THEN
ALLOCATE(UnitHeat(NumOfUnitHeats))
ALLOCATE(CheckEquipName(NumOfUnitHeats))
ENDIF
CheckEquipName=.true.
DO UnitHeatNum = 1, NumOfUnitHeats ! Begin looping over all of the unit heaters found in the input file...
CALL GetObjectItem(CurrentModuleObject,UnitHeatNum,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(Alphas(1),UnitHeat%Name,UnitHeatNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
END IF
UnitHeat(UnitHeatNum)%Name = Alphas(1)
UnitHeat(UnitHeatNum)%SchedName = Alphas(2)
IF (lAlphaBlanks(2)) THEN
UnitHeat(UnitHeatNum)%SchedPtr = ScheduleAlwaysOn
ELSE
UnitHeat(UnitHeatNum)%SchedPtr = GetScheduleIndex(Alphas(2)) ! convert schedule name to pointer
IF (UnitHeat(UnitHeatNum)%SchedPtr == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//': invalid '//TRIM(cAlphaFields(2))// &
' entered ='//TRIM(Alphas(2))// &
' for '//TRIM(cAlphaFields(1))//'='//TRIM(Alphas(1)))
ErrorsFound=.TRUE.
END IF
END IF
! Main air nodes (except outside air node):
UnitHeat(UnitHeatNum)%AirInNode = &
GetOnlySingleNode(Alphas(3),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsParent)
UnitHeat(UnitHeatNum)%AirOutNode = &
GetOnlySingleNode(Alphas(4),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsParent)
! Fan information:
UnitHeat(UnitHeatNum)%FanType = Alphas(5)
UnitHeat(UnitHeatNum)%FanName = Alphas(6)
UnitHeat(UnitHeatNum)%FanControlType = Alphas(7)
UnitHeat(UnitHeatNum)%MaxAirVolFlow = Numbers(1)
IF ( (.NOT.SameString(UnitHeat(UnitHeatNum)%FanControlType,OnOffCtrl)) .AND. &
(.NOT.SameString(UnitHeat(UnitHeatNum)%FanControlType,ContinuousCtrl)) ) THEN
ErrorsFound=.TRUE.
CALL ShowSevereError('Illegal '//TRIM(cAlphaFields(7))//' = '//TRIM(Alphas(7)))
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//'='//TRIM(UnitHeat(UnitHeatNum)%Name))
ELSEIF ( SameString(UnitHeat(UnitHeatNum)%FanControlType,OnOffCtrl)) THEN
UnitHeat(UnitHeatNum)%FanControlTypeOnOff = .TRUE.
END IF
ErrFlag = .FALSE.
CALL ValidateComponent(UnitHeat(UnitHeatNum)%FanType,UnitHeat(UnitHeatNum)%FanName,ErrFlag,TRIM(CurrentModuleObject))
IF (ErrFlag) THEN
CALL ShowContinueError('specified in '//TRIM(CurrentModuleObject)//' = "'//TRIM(UnitHeat(UnitHeatNum)%Name)//'".')
ErrorsFound=.TRUE.
ELSE
CALL GetFanType(UnitHeat(UnitHeatNum)%FanName,UnitHeat(UnitHeatNum)%FanType_Num, &
ErrFlag,CurrentModuleObject,UnitHeat(UnitHeatNum)%Name)
SELECT CASE (UnitHeat(UnitHeatNum)%FanType_Num)
CASE (FanType_SimpleConstVolume,FanType_SimpleVAV)
! Get fan outlet node
UnitHeat(UnitHeatNum)%FanOutletNode = GetFanOutletNode(UnitHeat(UnitHeatNum)%FanType,&
UnitHeat(UnitHeatNum)%FanName,Errflag)
IF(ErrFlag)THEN
CALL ShowContinueError('specified in '//TRIM(CurrentModuleObject)//' = "' // TRIM(UnitHeat(UnitHeatNum)%Name)//'".')
ErrorsFound = .TRUE.
ENDIF
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = "'//TRIM(Alphas(1))//'"')
CALL ShowContinueError('Fan Type must be Fan:ConstantVolume or Fan:VariableVolume')
ErrorsFound=.TRUE.
END SELECT
CALL GetFanIndex(UnitHeat(UnitHeatNum)%FanName,UnitHeat(UnitHeatNum)%Fan_Index,ErrFlag,TRIM(CurrentModuleObject))
IF (ErrFlag) THEN
ErrorsFound = .TRUE.
ELSE
CALL GetFanVolFlow(UnitHeat(UnitHeatNum)%Fan_Index,FanVolFlow)
IF(FanVolFlow .NE. AutoSize .AND. UnitHeat(UnitHeatNum)%MaxAirVolFlow .NE. AutoSize .AND. &
FanVolFlow .LT. UnitHeat(UnitHeatNum)%MaxAirVolFlow)THEN
CALL ShowSevereError('Specified in '//TRIM(CurrentModuleObject)//' = '//TRIM(UnitHeat(UnitHeatNum)%Name))
CALL ShowContinueError('...air flow rate ('//TRIM(TrimSigDigits(FanVolFlow,7))//') in'// &
' fan object '//TRIM(UnitHeat(UnitHeatNum)%FanName)//' is less than the unit heater maximum supply air'// &
' flow rate ('//TRIM(TrimSigDigits(UnitHeat(UnitHeatNum)%MaxAirVolFlow,7))//').')
CALL ShowContinueError('...the fan flow rate must be greater than or equal to the unit heater maximum'// &
' supply air flow rate.')
ErrorsFound = .TRUE.
ELSEIF(FanVolFlow .EQ. AutoSize .AND. UnitHeat(UnitHeatNum)%MaxAirVolFlow .NE. AutoSize)THEN
CALL ShowWarningError('Specified in '//TRIM(CurrentModuleObject)//' = '//TRIM(UnitHeat(UnitHeatNum)%Name))
CALL ShowContinueError('...the fan flow rate is autosized while the unit heater flow rate is not.')
CALL ShowContinueError('...this can lead to unexpected results where the fan flow rate is less than required.')
ELSEIF(FanVolFlow .NE. AutoSize .AND. UnitHeat(UnitHeatNum)%MaxAirVolFlow .EQ. AutoSize)THEN
CALL ShowWarningError('Specified in '//TRIM(CurrentModuleObject)//' = '//TRIM(UnitHeat(UnitHeatNum)%Name))
CALL ShowContinueError('...the unit heater flow rate is autosized while the fan flow rate is not.')
CALL ShowContinueError('...this can lead to unexpected results where the fan flow rate is less than required.')
ENDIF
UnitHeat(UnitHeatNum)%FanAvailSchedPtr = GetFanAvailSchPtr(UnitHeat(UnitHeatNum)%FanType, &
UnitHeat(UnitHeatNum)%FanName,ErrFlag)
ENDIF
ENDIF
! Heating coil information:
SELECT CASE (Alphas(8))
CASE ('COIL:HEATING:WATER')
UnitHeat(UnitHeatNum)%HCoilType = WaterCoil
UnitHeat(UnitHeatNum)%HCoil_PlantTypeNum = TypeOf_CoilWaterSimpleHeating
CASE ('COIL:HEATING:STEAM')
UnitHeat(UnitHeatNum)%HCoilType = SteamCoil
UnitHeat(UnitHeatNum)%HCoil_PlantTypeNum = TypeOf_CoilSteamAirHeating
CASE ('COIL:HEATING:ELECTRIC')
UnitHeat(UnitHeatNum)%HCoilType = ElectricCoil
CASE ('COIL:HEATING:GAS')
UnitHeat(UnitHeatNum)%HCoilType = GasCoil
CASE DEFAULT
CALL ShowSevereError('Illegal '//TRIM(cAlphaFields(8))//' = '//TRIM(Alphas(8)))
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//'='//TRIM(UnitHeat(UnitHeatNum)%Name))
ErrorsFound = .TRUE.
ErrFlag = .TRUE.
END SELECT
IF (.NOT. ErrFlag) THEN
UnitHeat(UnitHeatNum)%HCoilTypeCh = Alphas(8)
UnitHeat(UnitHeatNum)%HCoilName = Alphas(9)
CALL ValidateComponent(Alphas(8),UnitHeat(UnitHeatNum)%HCoilName,IsNotOK,TRIM(CurrentModuleObject))
IF (IsNotOK) THEN
CALL ShowContinueError('specified in '//TRIM(CurrentModuleObject)//' = "' // &
TRIM(UnitHeat(UnitHeatNum)%Name)//'"')
ErrorsFound = .TRUE.
ELSE
! The heating coil control node is necessary for hot water and steam coils, but not necessary for an
! electric or gas coil.
IF (UnitHeat(UnitHeatNum)%HCoilType .EQ. WaterCoil .OR. &
UnitHeat(UnitHeatNum)%HCoilType .EQ. SteamCoil) THEN
! mine the hot water or steam node from the coil object
ErrFlag = .FALSE.
IF(UnitHeat(UnitHeatNum)%HCoilType .EQ. WaterCoil)THEN
UnitHeat(UnitHeatNum)%HotControlNode = GetCoilWaterInletNode('Coil:Heating:Water', &
UnitHeat(UnitHeatNum)%HCoilName,ErrFlag)
ELSE ! its a steam coil
UnitHeat(UnitHeatNum)%HCoil_Index = GetSteamCoilIndex('COIL:HEATING:STEAM',UnitHeat(UnitHeatNum)%HCoilName,ErrFlag)
UnitHeat(UnitHeatNum)%HotControlNode = GetSteamCoilSteamInletNode(UnitHeat(UnitHeatNum)%HCoil_Index, &
UnitHeat(UnitHeatNum)%HCoilName,ErrFlag)
END IF
! Other error checks should trap before it gets to this point in the code, but including just in case.
IF (ErrFlag) THEN
CALL ShowContinueError('that was specified in '//TRIM(CurrentModuleObject)//' = "' // &
TRIM(UnitHeat(UnitHeatNum)%Name)//'"')
ErrorsFound = .TRUE.
END IF
END IF
END IF
ENDIF
UnitHeat(UnitHeatNum)%MaxVolHotWaterFlow = Numbers(2)
UnitHeat(UnitHeatNum)%MinVolHotWaterFlow = Numbers(3)
UnitHeat(UnitHeatNum)%MaxVolHotSteamFlow = Numbers(2)
UnitHeat(UnitHeatNum)%MinVolHotSteamFlow = Numbers(3)
UnitHeat(UnitHeatNum)%HotControlOffset = Numbers(4)
! Set default convergence tolerance
IF (UnitHeat(UnitHeatNum)%HotControlOffset .LE. 0.0d0) THEN
UnitHeat(UnitHeatNum)%HotControlOffset = 0.001d0
END IF
IF (.NOT. lAlphaBlanks(10)) THEN
UnitHeat(UnitHeatNum)%AvailManagerListName = Alphas(10)
ZoneComp(UnitHeater_Num)%ZoneCompAvailMgrs(UnitHeatNum)%AvailManagerListName = Alphas(10)
ENDIF
! check that unit heater air inlet node must be the same as a zone exhaust node
ZoneNodeNotFound = .TRUE.
DO CtrlZone = 1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZone)%IsControlled) CYCLE
DO NodeNum = 1,ZoneEquipConfig(CtrlZone)%NumExhaustNodes
IF (UnitHeat(UnitHeatNum)%AirInNode .EQ. ZoneEquipConfig(CtrlZone)%ExhaustNode(NodeNum)) THEN
ZoneNodeNotFound = .FALSE.
EXIT
END IF
END DO
END DO
IF(ZoneNodeNotFound)THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(UnitHeat(UnitHeatNum)%Name)//'".'// &
' Unit heater 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('..Unit heater air inlet node name = '//TRIM(NodeID(UnitHeat(UnitHeatNum)%AirInNode)))
ErrorsFound=.TRUE.
END IF
! check that unit heater air outlet node is a zone inlet node.
ZoneNodeNotFound = .TRUE.
DO CtrlZone = 1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZone)%IsControlled) CYCLE
DO NodeNum = 1,ZoneEquipConfig(CtrlZone)%NumInletNodes
IF (UnitHeat(UnitHeatNum)%AirOutNode .EQ. ZoneEquipConfig(CtrlZone)%InletNode(NodeNum)) THEN
ZoneNodeNotFound = .FALSE.
EXIT
END IF
END DO
END DO
IF(ZoneNodeNotFound)THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(UnitHeat(UnitHeatNum)%Name)//'".'// &
' Unit heater 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('..Unit heater air outlet node name = '//TRIM(NodeID(UnitHeat(UnitHeatNum)%AirOutNode)))
ErrorsFound=.TRUE.
END IF
! Add fan to component sets array
CALL SetUpCompSets(TRIM(CurrentModuleObject), UnitHeat(UnitHeatNum)%Name, &
UnitHeat(UnitHeatNum)%FanType,UnitHeat(UnitHeatNum)%FanName, &
NodeID(UnitHeat(UnitHeatNum)%AirInNode),NodeID(UnitHeat(UnitHeatNum)%FanOutletNode))
! Add heating coil to component sets array
CALL SetUpCompSets(TRIM(CurrentModuleObject), UnitHeat(UnitHeatNum)%Name, &
UnitHeat(UnitHeatNum)%HCoilTypeCh,UnitHeat(UnitHeatNum)%HCoilName, &
NodeID(UnitHeat(UnitHeatNum)%FanOutletNode),NodeID(UnitHeat(UnitHeatNum)%AirOutNode))
END DO ! ...loop over all of the unit heaters found in the input file
DEALLOCATE(Alphas)
DEALLOCATE(Numbers)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
IF (ErrorsFound) CALL ShowFatalError(RoutineName//'Errors found in input')
! Setup Report variables for the Unit Heaters, CurrentModuleObject='ZoneHVAC:UnitHeater'
DO UnitHeatNum = 1, NumOfUnitHeats
CALL SetupOutputVariable('Zone Unit Heater Heating Rate [W]',UnitHeat(UnitHeatNum)%HeatPower, &
'System','Average',UnitHeat(UnitHeatNum)%Name)
CALL SetupOutputVariable('Zone Unit Heater Heating Energy [J]',UnitHeat(UnitHeatNum)%HeatEnergy, &
'System','Sum',UnitHeat(UnitHeatNum)%Name)
CALL SetupOutputVariable('Zone Unit Heater Fan Electric Power [W]',UnitHeat(UnitHeatNum)%ElecPower, &
'System','Average',UnitHeat(UnitHeatNum)%Name)
! Note that the unit heater fan electric is NOT metered because this value is already metered through the fan component
CALL SetupOutputVariable('Zone Unit Heater Fan Electric Energy [J]',UnitHeat(UnitHeatNum)%ElecEnergy, &
'System','Sum',UnitHeat(UnitHeatNum)%Name)
CALL SetupOutputVariable('Zone Unit Heater Fan Availability Status []', UnitHeat(UnitHeatNum)%AvailStatus,&
'System','Average',UnitHeat(UnitHeatNum)%Name)
END DO
RETURN
END SUBROUTINE GetUnitHeaterInput