SUBROUTINE GetUnitVentilatorInput
! SUBROUTINE INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN May 2000
! MODIFIED Chandan Sharma, FSEC, March 2011: Added zone sys avail manager
! Bereket Nigusse, FSEC, April 2011: eliminated input node names
! & added fan object type
!
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine obtains the input for unit ventilators and sets
! up the appropriate derived type.
! 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 OutAirNodeManager, ONLY: CheckAndAddAirNodeNumber
USE WaterCoils, ONLY :GetWaterCoilMaxFlowRate=>GetCoilMaxWaterFlowRate, GetCoilWaterInletNode
Use SteamCoils, ONLY: GetSteamCoilMaxFlowRate=>GetCoilMaxWaterFlowRate, GetSteamCoilIndex, &
GetSteamCoilSteamInletNode=>GetCoilSteamInletNode
USE HVACHXAssistedCoolingCoil, ONLY : GetHXAssistedCoilFlowRate=>GetCoilMaxWaterFlowRate, &
GetHXCoilWaterInletNode=>GetCoilWaterInletNode, GetHXCoilTypeAndName
USE Fans, ONLY: GetFanIndex, GetFanVolFlow, GetFanType, GetFanOutletNode, GetFanAvailSchPtr
USE DataHVACGlobals, ONLY: FanType_SimpleConstVolume, FanType_SimpleVAV, ZoneComp
USE DataSizing, ONLY: AutoSize
USE General, ONLY: TrimSigDigits
USE DataZoneEquipment, ONLY: UnitVentilator_Num, ZoneEquipConfig
USE DataGlobals, ONLY: NumOfZones, ScheduleAlwaysOn
USE DataPlant, ONLY: TypeOf_CoilWaterCooling, TypeOf_CoilWaterDetailedFlatCooling, &
TypeOf_CoilWaterSimpleHeating, TypeOf_CoilSteamAirHeating
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetUnitVentilatorInput: ' ! include trailing blank
! 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
INTEGER :: NumFields ! Total number of fields in object
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER :: UnitVentNum ! Item to be "gotten"
LOGICAL :: IsValid ! Set for outside air node check
LOGICAL :: Errflag=.FALSE. ! interim error flag
CHARACTER(len=MaxNameLength) :: cCoolingCoilType ! Cooling coil object type
CHARACTER(len=MaxNameLength) :: cHeatingCoilType ! Heating coil object type
INTEGER :: FanIndex ! index to fan used for flow checks
REAL(r64) :: FanVolFlow ! volumetric flow rate of fan
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 ventilators there are in the input file
CurrentModuleObject = cMO_UnitVentilator
NumOfUnitVents=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 (NumOfUnitVents .GT. 0) THEN
ALLOCATE(UnitVent(NumOfUnitVents))
ALLOCATE(CheckEquipName(NumOfUnitVents))
ENDIF
CheckEquipName=.true.
DO UnitVentNum = 1, NumOfUnitVents ! Begin looping over all of the unit ventilators found in the input file...
CALL GetObjectItem(CurrentModuleObject,UnitVentNum,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(Alphas(1),UnitVent%Name,UnitVentNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.TRUE.
IF (IsBlank) Alphas(1)='xxxxx'
END IF
UnitVent(UnitVentNum)%Name = Alphas(1)
UnitVent(UnitVentNum)%SchedName = Alphas(2)
IF (lAlphaBlanks(2)) THEN
UnitVent(UnitVentNum)%SchedPtr = ScheduleAlwaysOn
ELSE
UnitVent(UnitVentNum)%SchedPtr = GetScheduleIndex(Alphas(2)) ! convert schedule name to pointer
IF (UnitVent(UnitVentNum)%SchedPtr == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// TRIM(Alphas(1))//'", invalid')
CALL ShowContinueError('not found: '//trim(cAlphaFields(2))//'="'//trim(Alphas(2))//'".')
ErrorsFound=.TRUE.
ENDIF
END IF
UnitVent(UnitVentNum)%MaxAirVolFlow = Numbers(1)
! Outside air information:
UnitVent(UnitVentNum)%MinOutAirVolFlow = Numbers(2)
UnitVent(UnitVentNum)%MinOASchedName = Alphas(4)
UnitVent(UnitVentNum)%MinOASchedPtr = GetScheduleIndex(Alphas(4)) ! convert schedule name to pointer
IF (UnitVent(UnitVentNum)%MinOASchedPtr == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// TRIM(UnitVent(UnitVentNum)%Name)//'", invalid')
CALL ShowContinueError('not found: '//TRIM(cAlphaFields(4))//'="'//TRIM(Alphas(4))//'".')
ErrorsFound=.TRUE.
END IF
UnitVent(UnitVentNum)%OutAirVolFlow = Numbers(3)
cCoolingCoilType=' '
cHeatingCoilType=' '
SELECT CASE (Alphas(3))
CASE ('VARIABLEPERCENT')
UnitVent(UnitVentNum)%OAControlType = VariablePercent
UnitVent(UnitVentNum)%MaxOASchedName = Alphas(5)
UnitVent(UnitVentNum)%MaxOASchedPtr = GetScheduleIndex(Alphas(5)) ! convert schedule name to pointer
IF (UnitVent(UnitVentNum)%MaxOASchedPtr == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// TRIM(UnitVent(UnitVentNum)%Name)//'", invalid')
CALL ShowContinueError('not found:'//TRIM(cAlphaFields(5))//'="'//TRIM(UnitVent(UnitVentNum)%MaxOASchedName)//'".')
ErrorsFound=.TRUE.
ELSEIF (.not. CheckScheduleValueMinMax(UnitVent(UnitVentNum)%MaxOASchedPtr,'>=0',0.0d0,'<=',1.0d0)) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// TRIM(UnitVent(UnitVentNum)%Name)//'", invalid')
CALL ShowContinueError('out of range [0,1]: '//TRIM(cAlphaFields(5))//'="'// &
TRIM(UnitVent(UnitVentNum)%MaxOASchedName)//'".')
ErrorsFound=.TRUE.
END IF
CASE ('FIXEDAMOUNT')
UnitVent(UnitVentNum)%OAControlType = FixedOAControl
UnitVent(UnitVentNum)%MaxOASchedName = Alphas(5)
UnitVent(UnitVentNum)%MaxOASchedPtr = GetScheduleIndex(Alphas(5)) ! convert schedule name to pointer
IF (UnitVent(UnitVentNum)%MaxOASchedPtr == 0) THEN
CALL ShowSevereError(TRIM(cAlphaFields(5))//' not found = '//TRIM(UnitVent(UnitVentNum)%MaxOASchedName))
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(UnitVent(UnitVentNum)%Name))
ErrorsFound=.TRUE.
ELSEIF (.not. CheckScheduleValueMinMax(UnitVent(UnitVentNum)%MaxOASchedPtr,'>=0',0.0d0)) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// TRIM(UnitVent(UnitVentNum)%Name)//'", invalid')
CALL ShowContinueError('out of range [0,1]: '//TRIM(cAlphaFields(5))//'="'// &
TRIM(UnitVent(UnitVentNum)%MaxOASchedName)//'".')
ErrorsFound=.TRUE.
END IF
CASE ('FIXEDTEMPERATURE')
UnitVent(UnitVentNum)%OAControlType = FixedTemperature
UnitVent(UnitVentNum)%TempSchedName = Alphas(5)
UnitVent(UnitVentNum)%TempSchedPtr = GetScheduleIndex(Alphas(5)) ! convert schedule name to pointer
IF (UnitVent(UnitVentNum)%TempSchedPtr == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// TRIM(UnitVent(UnitVentNum)%Name)//'", invalid')
CALL ShowContinueError(' not found: '//TRIM(cAlphaFields(5))//'="'//TRIM(UnitVent(UnitVentNum)%MaxOASchedName)//'".')
ErrorsFound=.TRUE.
END IF
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// TRIM(UnitVent(UnitVentNum)%Name)//'", invalid')
CALL ShowContinueError('Illegal '//TRIM(cAlphaFields(3))//'="'//TRIM(Alphas(3))//'".')
END SELECT
! Main air nodes (except outside air node):
! For node connections, this object is both a parent and a non-parent, because the
! OA mixing box is not called out as a separate component, its nodes must be connected
! as ObjectIsNotParent. But for the fan and coils, the nodes are connected as ObjectIsParent
! To support the diagramming tool, the unit ventilator inlet node must appear both as
! an inlet to the unit ventilator parent object and as an inlet to the implied
! non-parent OA mixing box within the unit ventilator.
! Because there is overlap between the nodes that are parent and non-parent, use a different
! object type for the non parent nodes
UnitVent(UnitVentNum)%AirInNode = &
GetOnlySingleNode(Alphas(6),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsParent)
UnitVent(UnitVentNum)%AirInNode = &
GetOnlySingleNode(Alphas(6),ErrorsFound,TRIM(CurrentModuleObject)//'-OA MIXER',Alphas(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
UnitVent(UnitVentNum)%AirOutNode = &
GetOnlySingleNode(Alphas(7),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsParent)
! Fan information:
! A11, \field Supply Air Fan Object Type
! \required-field
! \type choice
! \key Fan:ConstantVolume
! \key Fan:VariableVolume
! \note Allowable fan types are Fan:ConstantVolume and
! \note Fan:VariableVolume
! A12, \field Fan Name
! \required-field
! \type object-list
! \object-list FansCVandVAV
UnitVent(UnitVentNum)%FanType = Alphas(11)
UnitVent(UnitVentNum)%FanName = Alphas(12)
ErrFlag = .FALSE.
CALL ValidateComponent(UnitVent(UnitVentNum)%FanType,UnitVent(UnitVentNum)%FanName,ErrFlag,TRIM(CurrentModuleObject))
IF (ErrFlag) THEN
CALL ShowContinueError('specified in '//TRIM(CurrentModuleObject)//' = "'//TRIM(UnitVent(UnitVentNum)%Name)//'".')
ErrorsFound=.TRUE.
ELSE
CALL GetFanType(UnitVent(UnitVentNum)%FanName,UnitVent(UnitVentNum)%FanType_Num, &
ErrFlag,CurrentModuleObject,UnitVent(UnitVentNum)%Name)
SELECT CASE (UnitVent(UnitVentNum)%FanType_Num)
CASE (FanType_SimpleConstVolume, FanType_SimpleVAV)
! Get fan outlet node
UnitVent(UnitVentNum)%FanOutletNode = GetFanOutletNode(UnitVent(UnitVentNum)%FanType,&
UnitVent(UnitVentNum)%FanName,ErrFlag)
IF(ErrFlag)THEN
CALL ShowContinueError('specified in '//TRIM(CurrentModuleObject)//' = "' // TRIM(UnitVent(UnitVentNum)%Name)//'".')
ErrorsFound = .TRUE.
ELSE
CALL GetFanIndex(UnitVent(UnitVentNum)%FanName,FanIndex,ErrFlag,TRIM(CurrentModuleObject))
! Other error checks should trap before it gets to this point in the code, but including just in case.
CALL GetFanVolFlow(FanIndex,FanVolFlow)
IF(FanVolFlow .NE. AutoSize .AND. UnitVent(UnitVentNum)%MaxAirVolFlow .NE. AutoSize .AND. &
FanVolFlow .LT. UnitVent(UnitVentNum)%MaxAirVolFlow)THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(UnitVent(UnitVentNum)%Name)//'"')
CALL ShowContinueError('...air flow rate ['//TRIM(TrimSigDigits(FanVolFlow,7))//'] in'// &
' fan object '//TRIM(UnitVent(UnitVentNum)%FanName)//' is less than the unit ventilator maximum supply air'// &
' flow rate ['//TRIM(TrimSigDigits(UnitVent(UnitVentNum)%MaxAirVolFlow,7))//'].')
CALL ShowContinueError('...the fan flow rate must be greater than or equal to the unit ventilator maximum'// &
' supply air flow rate.')
ErrorsFound = .TRUE.
ELSE IF(FanVolFlow .EQ. AutoSize .AND. UnitVent(UnitVentNum)%MaxAirVolFlow .NE. AutoSize)THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(UnitVent(UnitVentNum)%Name)//'"')
CALL ShowContinueError('...the fan flow rate is autosized while the unit ventilator flow rate is not.')
CALL ShowContinueError('...this can lead to unexpected results where the fan flow rate is less than required.')
ELSE IF(FanVolFlow .NE. AutoSize .AND. UnitVent(UnitVentNum)%MaxAirVolFlow .EQ. AutoSize)THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(UnitVent(UnitVentNum)%Name)//'"')
CALL ShowContinueError('...the unit ventilator 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.')
END IF
! Get the fan's availability schedule
ErrFlag=.FALSE.
UnitVent(UnitVentNum)%FanAvailSchedPtr = GetFanAvailSchPtr(UnitVent(UnitVentNum)%FanType, &
UnitVent(UnitVentNum)%FanName,ErrFlag)
IF (ErrFlag) THEN
CALL ShowContinueError('...specified in '//TRIM(CurrentModuleObject)//'="'//TRIM(UnitVent(UnitVentNum)%Name)//'"')
ErrorsFound=.TRUE.
ENDIF
END IF
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="' // TRIM(UnitVent(UnitVentNum)%Name)//'"')
CALL ShowContinueError('Fan Type must be Fan:ConstantVolume or Fan:VariableVolume.')
ErrorsFound = .TRUE.
END SELECT
ENDIF
! For node connections, this object is both a parent and a non-parent, because the
! OA mixing box is not called out as a separate component, its nodes must be connected
! as ObjectIsNotParent. But for the fan and coils, the nodes are connected as ObjectIsParent
! Because there is overlap between the nodes that are parent and non-parent, use a different
! object type for the non parent nodes
UnitVent(UnitVentNum)%OutsideAirNode = &
! Set connection type to 'OutdoorAir', because this is hardwired to OA conditions
GetOnlySingleNode(Alphas(8),ErrorsFound,TRIM(CurrentModuleObject)//'-OA MIXER',Alphas(1), &
NodeType_Air,NodeConnectionType_OutsideAirReference,1,ObjectIsNotParent)
IF ((.NOT. lAlphaBlanks(8))) THEN
CALL CheckAndAddAirNodeNumber(UnitVent(UnitVentNum)%OutsideAirNode,IsValid)
IF (.not. IsValid) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//', Adding '//TRIM(cAlphaFields(8))//'='//TRIM(Alphas(8)))
ENDIF
ENDIF
UnitVent(UnitVentNum)%AirReliefNode = &
GetOnlySingleNode(Alphas(9),ErrorsFound,TRIM(CurrentModuleObject)//'-OA MIXER',Alphas(1), &
NodeType_Air,NodeConnectionType_ReliefAir,1,ObjectIsNotParent)
UnitVent(UnitVentNum)%OAMixerOutNode = &
GetOnlySingleNode(Alphas(10),ErrorsFound,TRIM(CurrentModuleObject)//'-OA MIXER',Alphas(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
IF (UnitVent(UnitVentNum)%OAControlType == FixedOAControl) THEN
UnitVent(UnitVentNum)%OutAirVolFlow = UnitVent(UnitVentNum)%MinOutAirVolFlow
UnitVent(UnitVentNum)%MaxOASchedName = UnitVent(UnitVentNum)%MinOASchedName
UnitVent(UnitVentNum)%MaxOASchedPtr = GetScheduleIndex(UnitVent(UnitVentNum)%MinOASchedName)
END IF
! Add fan to component sets array
CALL SetUpCompSets(TRIM(CurrentModuleObject), UnitVent(UnitVentNum)%Name,&
UnitVent(UnitVentNum)%FanType, UnitVent(UnitVentNum)%FanName, &
NodeID(UnitVent(UnitVentNum)%OAMixerOutNode), NodeID(UnitVent(UnitVentNum)%FanOutletNode))
IF (.NOT. lAlphaBlanks(18)) THEN
UnitVent(UnitVentNum)%AvailManagerListName = Alphas(18)
ZoneComp(UnitVentilator_Num)%ZoneCompAvailMgrs(UnitVentNum)%AvailManagerListName = Alphas(18)
ENDIF
! A13, \field Coil Option
! \required-field
! \type choice
! \key None
! \key Heating
! \key Cooling
! \key HeatingAndCooling
SELECT CASE (Alphas(13))
CASE ('HEATINGANDCOOLING')
UnitVent(UnitVentNum)%CoilOption = BothOption
CASE ('HEATING')
UnitVent(UnitVentNum)%CoilOption = HeatingOption
CASE ('COOLING')
UnitVent(UnitVentNum)%CoilOption = CoolingOption
CASE ('NONE')
UnitVent(UnitVentNum)%CoilOption = NoneOption
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(UnitVent(UnitVentNum)%Name)//'", invalid')
CALL ShowContinueError('illegal value: '//TRIM(cAlphaFields(13))//'="'//TRIM(Alphas(13))//'".')
ErrorsFound = .TRUE.
END SELECT
! Get Coil information
IF (UnitVent(UnitVentNum)%CoilOption == BothOption .or. UnitVent(UnitVentNum)%CoilOption == HeatingOption) THEN
! Heating coil information:
! A14, \field Heating Coil Object Type
! \type choice
! \key Coil:Heating:Water
! \key Coil:Heating:Electric
! \key Coil:Heating:Gas
! \key Coil:Heating:Steam
! A15, \field Heating Coil Name
! \type object-list
! \object-list HeatingCoilName
IF ((.NOT. lAlphaBlanks(15))) THEN
UnitVent(UnitVentNum)%HCoilPresent = .TRUE.
errflag=.FALSE.
cHeatingCoilType=Alphas(14)
UnitVent(UnitVentNum)%HCoilTypeCh = cHeatingCoilType
SELECT CASE (cHeatingCoilType)
CASE ('COIL:HEATING:WATER')
UnitVent(UnitVentNum)%HCoilType = Heating_WaterCoilType
UnitVent(UnitVentNum)%HCoil_PlantTypeNum = TypeOf_CoilWaterSimpleHeating
CASE ('COIL:HEATING:STEAM')
UnitVent(UnitVentNum)%HCoilType = Heating_SteamCoilType
UnitVent(UnitVentNum)%HCoil_PlantTypeNum = TypeOf_CoilSteamAirHeating
CASE ('COIL:HEATING:ELECTRIC')
UnitVent(UnitVentNum)%HCoilType = Heating_ElectricCoilType
CASE ('COIL:HEATING:GAS')
UnitVent(UnitVentNum)%HCoilType = Heating_GasCoilType
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(UnitVent(UnitVentNum)%Name)//'", invalid')
CALL ShowContinueError('illegal value: '//TRIM(cAlphaFields(14))//'="'//TRIM(Alphas(14))//'".')
ErrorsFound = .TRUE.
errflag = .TRUE.
END SELECT
IF (.NOT. errflag) THEN
UnitVent(UnitVentNum)%HCoilName = Alphas(15)
CALL ValidateComponent(cHeatingCoilType,UnitVent(UnitVentNum)%HCoilName,IsNotOK,TRIM(CurrentModuleObject))
IF (IsNotOK) THEN
CALL ShowContinueError('...specified in '//TRIM(CurrentModuleObject)//'="'// &
TRIM(UnitVent(UnitVentNum)%Name)//'".')
ErrorsFound=.TRUE.
ELSE
! The heating coil control node is necessary for a hot water coil, but not necessary for an
! electric or gas coil.
IF (UnitVent(UnitVentNum)%HCoilType .EQ. Heating_WaterCoilType .OR. &
UnitVent(UnitVentNum)%HCoilType .EQ. Heating_SteamCoilType) THEN
! mine the hot water or steam node from the coil object
ErrFlag = .FALSE.
IF (UnitVent(UnitVentNum)%HCoilType == Heating_WaterCoilType) THEN
UnitVent(UnitVentNum)%HotControlNode = GetCoilWaterInletNode('Coil:Heating:Water', &
UnitVent(UnitVentNum)%HCoilName,ErrFlag)
ELSE
UnitVent(UnitVentNum)%HCoil_Index = GetSteamCoilIndex('COIL:HEATING:STEAM',UnitVent(UnitVentNum)%HCoilName,ErrFlag)
UnitVent(UnitVentNum)%HotControlNode = GetSteamCoilSteamInletNode(UnitVent(UnitVentNum)%HCoil_Index, &
UnitVent(UnitVentNum)%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('...specified in '//TRIM(CurrentModuleObject)//'="' &
//TRIM(UnitVent(UnitVentNum)%Name)//'".')
ErrorsFound = .TRUE.
END IF
END IF
ENDIF
ENDIF
UnitVent(UnitVentNum)%MinVolHotWaterFlow = 0.0d0
UnitVent(UnitVentNum)%MinVolHotSteamFlow = 0.0d0
UnitVent(UnitVentNum)%HotControlOffset = Numbers(4)
! Set default convergence tolerance
IF (UnitVent(UnitVentNum)%HotControlOffset .LE. 0.0d0) THEN
UnitVent(UnitVentNum)%HotControlOffset = 0.001d0
END IF
SELECT CASE(UnitVent(UnitVentNum)%HCoilType)
CASE(Heating_WaterCoilType)
UnitVent(UnitVentNum)%MaxVolHotWaterFlow = GetWaterCoilMaxFlowRate('Coil:Heating:Water', &
UnitVent(UnitVentNum)%HCoilName,ErrorsFound)
UnitVent(UnitVentNum)%MaxVolHotSteamFlow = UnitVent(UnitVentNum)%MaxVolHotWaterFlow
CASE(Heating_SteamCoilType)
UnitVent(UnitVentNum)%MaxVolHotWaterFlow = GetSteamCoilMaxFlowRate('Coil:Heating:Steam', &
UnitVent(UnitVentNum)%HCoilName,ErrorsFound)
UnitVent(UnitVentNum)%MaxVolHotSteamFlow = UnitVent(UnitVentNum)%MaxVolHotWaterFlow
CASE(Heating_ElectricCoilType)
CASE(Heating_GasCoilType)
CASE DEFAULT
END SELECT
ELSE ! heating coil is required for these options
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(UnitVent(UnitVentNum)%Name)// &
'", missing heating coil')
CALL ShowContinueError('a heating coil is required for '//trim(cAlphaFields(13))//'="'//trim(Alphas(13))//'".')
ErrorsFound=.true.
END IF ! IF (.NOT. lAlphaBlanks(15)) THEN - from the start of heating coil information
END IF ! is option both or heating only
IF (UnitVent(UnitVentNum)%CoilOption == BothOption .or. UnitVent(UnitVentNum)%CoilOption == CoolingOption) THEN
! Cooling coil information (if one is present):
! A16, \field Cooling Coil Object Type
! \type choice
! \key Coil:Cooling:Water
! \key Coil:Cooling:Water:DetailedGeometry
! \key CoilSystem:Cooling:Water:HeatExchangerAssisted
! A17, \field Cooling Coil Name
! \type object-list
! \object-list CoolingCoilsWater
IF (.NOT. lAlphaBlanks(17)) THEN
UnitVent(UnitVentNum)%CCoilPresent = .TRUE.
errflag=.FALSE.
cCoolingCoilType=Alphas(16)
UnitVent(UnitVentNum)%CCoilTypeCh = cCoolingCoilType
SELECT CASE (cCoolingCoilType)
CASE ('COIL:COOLING:WATER')
UnitVent(UnitVentNum)%CCoilType = Cooling_CoilWaterCooling
UnitVent(UnitVentNum)%CCoil_PlantTypeNum = TypeOf_CoilWaterCooling
UnitVent(UnitVentNum)%CCoilPlantName=Alphas(17)
CASE ('COIL:COOLING:WATER:DETAILEDGEOMETRY')
UnitVent(UnitVentNum)%CCoilType = Cooling_CoilDetailedCooling
UnitVent(UnitVentNum)%CCoil_PlantTypeNum = TypeOf_CoilWaterDetailedFlatCooling
UnitVent(UnitVentNum)%CCoilPlantName=Alphas(17)
CASE ('COILSYSTEM:COOLING:WATER:HEATEXCHANGERASSISTED')
UnitVent(UnitVentNum)%CCoilType = Cooling_CoilHXAssisted
CALL GetHXCoilTypeAndName(cCoolingCoilType,Alphas(17),ErrorsFound, &
UnitVent(UnitVentNum)%CCoilPlantType,UnitVent(UnitVentNum)%CCoilPlantName)
IF (SameString(UnitVent(UnitVentNum)%CCoilPlantType,'Coil:Cooling:Water')) THEN
UnitVent(UnitVentNum)%CCoil_PlantTypeNum=TypeOf_CoilWaterCooling
ELSEIF (SameString(UnitVent(UnitVentNum)%CCoilPlantType,'Coil:Cooling:Water:DetailedGeometry')) THEN
UnitVent(UnitVentNum)%CCoil_PlantTypeNum=TypeOf_CoilWaterDetailedFlatCooling
ELSE
CALL ShowSevereError(RoutineName//trim(CurrentModuleObject)//'="'//trim(UnitVent(UnitVentNum)%Name)//'", invalid')
CALL ShowContinueError('For: '//TRIM(cAlphaFields(16))//'="'//TRIM(Alphas(16))//'".')
CALL ShowContinueError('Invalid Coil Type='//trim(UnitVent(UnitVentNum)%CCoilPlantType)// &
', Name='//trim(UnitVent(UnitVentNum)%CCoilPlantName))
CALL ShowContinueError('must be "Coil:Cooling:Water" or "Coil:Cooling:Water:DetailedGeometry"')
ErrorsFound=.true.
ENDIF
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(UnitVent(UnitVentNum)%Name)//'", invalid')
CALL ShowContinueError('illegal value: '//TRIM(cAlphaFields(16))//'="'//TRIM(cCoolingCoilType)//'".')
ErrorsFound=.TRUE.
errflag=.TRUE.
END SELECT
IF (.NOT. errflag) THEN
UnitVent(UnitVentNum)%CCoilName = Alphas(17)
CALL ValidateComponent(cCoolingCoilType,UnitVent(UnitVentNum)%CCoilName,IsNotOK,TRIM(CurrentModuleObject))
IF (IsNotOK) THEN
CALL ShowContinueError('...specified in '//TRIM(CurrentModuleObject)//'="'// &
TRIM(UnitVent(UnitVentNum)%Name)//'".')
ErrorsFound=.TRUE.
ELSE
IF (UnitVent(UnitVentNum)%CCoilType /= Cooling_CoilHXAssisted) THEN
! mine the cold water node from the coil object
UnitVent(UnitVentNum)%ColdControlNode = GetCoilWaterInletNode(UnitVent(UnitVentNum)%CCoilTypeCh, &
UnitVent(UnitVentNum)%CCoilName,ErrFlag)
ELSE
UnitVent(UnitVentNum)%ColdControlNode = GetHXCoilWaterInletNode(UnitVent(UnitVentNum)%CCoilTypeCh, &
UnitVent(UnitVentNum)%CCoilName,ErrFlag)
ENDIF
! Other error checks should trap before it gets to this point in the code, but including just in case.
IF (ErrFlag) THEN
CALL ShowContinueError('...specified in '//TRIM(CurrentModuleObject)//'="'// &
TRIM(UnitVent(UnitVentNum)%Name)//'".')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
UnitVent(UnitVentNum)%MinVolColdWaterFlow = 0.0d0
UnitVent(UnitVentNum)%ColdControlOffset = Numbers(5)
! Set default convergence tolerance
IF (UnitVent(UnitVentNum)%ColdControlOffset .LE. 0.0d0) THEN
UnitVent(UnitVentNum)%ColdControlOffset = 0.001d0
END IF
SELECT CASE(UnitVent(UnitVentNum)%CCoilType)
CASE(Cooling_CoilWaterCooling)
UnitVent(UnitVentNum)%MaxVolColdWaterFlow = &
GetWaterCoilMaxFlowRate('Coil:Cooling:Water', &
UnitVent(UnitVentNum)%CCoilName,ErrorsFound)
CASE(Cooling_CoilDetailedCooling)
UnitVent(UnitVentNum)%MaxVolColdWaterFlow = &
GetWaterCoilMaxFlowRate('Coil:Cooling:Water:DetailedGeometry', &
UnitVent(UnitVentNum)%CCoilName,ErrorsFound)
CASE(Cooling_CoilHXAssisted)
UnitVent(UnitVentNum)%MaxVolColdWaterFlow = &
GetHXAssistedCoilFlowRate('CoilSystem:Cooling:Water:HeatExchangerAssisted', &
UnitVent(UnitVentNum)%CCoilName,ErrorsFound)
CASE DEFAULT
END SELECT
ELSE ! Cooling Coil is required for this/these options
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(UnitVent(UnitVentNum)%Name)// &
'", missing cooling coil')
CALL ShowContinueError('a cooling coil is required for '//trim(cAlphaFields(13))//'="'//trim(Alphas(13))//'".')
ErrorsFound=.true.
END IF !IF (.NOT. lAlphaBlanks(17)) THEN - from the start of cooling coil information
END IF
! check that unit ventilator air inlet node is the same as a zone exhaust node
ZoneNodeNotFound = .TRUE.
DO CtrlZone = 1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZone)%IsControlled) CYCLE
DO NodeNum = 1,ZoneEquipConfig(CtrlZone)%NumExhaustNodes
IF (UnitVent(UnitVentNum)%AirInNode .EQ. ZoneEquipConfig(CtrlZone)%ExhaustNode(NodeNum)) THEN
ZoneNodeNotFound = .FALSE.
EXIT
END IF
END DO
END DO
IF(ZoneNodeNotFound)THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(UnitVent(UnitVentNum)%Name)//'".'// &
' Unit ventilator 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 ventilator air inlet node name = '//TRIM(NodeID(UnitVent(UnitVentNum)%AirInNode)))
ErrorsFound=.TRUE.
END IF
! check that unit ventilator air outlet node is the same as a zone inlet node.
ZoneNodeNotFound = .TRUE.
DO CtrlZone = 1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZone)%IsControlled) CYCLE
DO NodeNum = 1,ZoneEquipConfig(CtrlZone)%NumInletNodes
IF (UnitVent(UnitVentNum)%AirOutNode .EQ. ZoneEquipConfig(CtrlZone)%InletNode(NodeNum)) THEN
ZoneNodeNotFound = .FALSE.
EXIT
END IF
END DO
END DO
IF(ZoneNodeNotFound)THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(UnitVent(UnitVentNum)%Name)//'".'// &
' Unit ventilator 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 ventilator air outlet node name = '//TRIM(NodeID(UnitVent(UnitVentNum)%AirOutNode)))
ErrorsFound=.TRUE.
END IF
SELECT CASE (UnitVent(UnitVentNum)%CoilOption)
CASE (BothOption) ! 'HeatingAndCooling'
! Add cooling coil to component sets array when present
CALL SetUpCompSets(TRIM(CurrentModuleObject), UnitVent(UnitVentNum)%Name, &
cCoolingCoilType,UnitVent(UnitVentNum)%CCoilName, &
NodeID(UnitVent(UnitVentNum)%FanOutletNode),'UNDEFINED')
! Add heating coil to component sets array when cooling coil present
CALL SetUpCompSets(TRIM(CurrentModuleObject), UnitVent(UnitVentNum)%Name, &
cHeatingCoilType,UnitVent(UnitVentNum)%HCoilName, &
'UNDEFINED',NodeID(UnitVent(UnitVentNum)%AirOutNode))
CASE (HeatingOption) ! 'Heating'
! Add heating coil to component sets array when no cooling coil present
CALL SetUpCompSets(TRIM(CurrentModuleObject), UnitVent(UnitVentNum)%Name, &
cHeatingCoilType,UnitVent(UnitVentNum)%HCoilName, &
NodeID(UnitVent(UnitVentNum)%FanOutletNode),NodeID(UnitVent(UnitVentNum)%AirOutNode))
CASE (CoolingOption) ! 'Cooling'
! Add cooling coil to component sets array when no heating coil present
CALL SetUpCompSets(TRIM(CurrentModuleObject), UnitVent(UnitVentNum)%Name, &
cCoolingCoilType,UnitVent(UnitVentNum)%CCoilName, &
NodeID(UnitVent(UnitVentNum)%FanOutletNode),NodeID(UnitVent(UnitVentNum)%AirOutNode))
CASE (NoneOption)
CASE DEFAULT
END SELECT
END DO ! ...loop over all of the unit ventilators 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 Ventilators, CurrentModuleObject='ZoneHVAC:UnitVentilator'
DO UnitVentNum = 1, NumOfUnitVents
CALL SetupOutputVariable('Zone Unit Ventilator Heating Rate [W]', &
UnitVent(UnitVentNum)%HeatPower,'System', &
'Average',UnitVent(UnitVentNum)%Name)
CALL SetupOutputVariable('Zone Unit Ventilator Heating Energy [J]', &
UnitVent(UnitVentNum)%HeatEnergy,'System', &
'Sum',UnitVent(UnitVentNum)%Name)
CALL SetupOutputVariable('Zone Unit Ventilator Total Cooling Rate [W]', &
UnitVent(UnitVentNum)%TotCoolPower,'System', &
'Average',UnitVent(UnitVentNum)%Name)
CALL SetupOutputVariable('Zone Unit Ventilator Total Cooling Energy [J]', &
UnitVent(UnitVentNum)%TotCoolEnergy,'System', &
'Sum',UnitVent(UnitVentNum)%Name)
CALL SetupOutputVariable('Zone Unit Ventilator Sensible Cooling Rate [W]', &
UnitVent(UnitVentNum)%SensCoolPower,'System', &
'Average',UnitVent(UnitVentNum)%Name)
CALL SetupOutputVariable('Zone Unit Ventilator Sensible Cooling Energy [J]', &
UnitVent(UnitVentNum)%SensCoolEnergy,'System', &
'Sum',UnitVent(UnitVentNum)%Name)
CALL SetupOutputVariable('Zone Unit Ventilator Fan Electric Power [W]', &
UnitVent(UnitVentNum)%ElecPower,'System', &
'Average',UnitVent(UnitVentNum)%Name)
! Note that the unit vent fan electric is NOT metered because this value is already metered through the fan component
CALL SetupOutputVariable('Zone Unit Ventilator Fan Electric Energy [J]', &
UnitVent(UnitVentNum)%ElecEnergy,'System','Sum', &
UnitVent(UnitVentNum)%Name)
CALL SetupOutputVariable('Zone Unit Ventilator Fan Availability Status []',&
UnitVent(UnitVentNum)%AvailStatus,&
'System','Average',UnitVent(UnitVentNum)%Name)
END DO
RETURN
END SUBROUTINE GetUnitVentilatorInput