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 GetATMixers
! SUBROUTINE INFORMATION:
! AUTHOR
! DATE WRITTEN March 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE
! Get input for inlet side air temrinal mixers and store it in the inlet side air terminal mixer array
! METHODOLOGY EMPLOYED:
! Use the Get routines from the InputProcessor module.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, FindItemInList
USE NodeInputManager, ONLY: GetOnlySingleNode
USE DataInterfaces, ONLY: SetupOutputVariable
USE DataZoneEquipment, ONLY: ZoneEquipConfig, ZoneEquipList, EquipmentData, SubEquipmentData
USE DataLoopNode
USE DataIPShortCuts
USE BranchNodeConnections, ONLY: TestCompSet, SetUpCompSets
USE DataGlobals, ONLY: NumOfZones
! USE DataDefineEquip, ONLY: AirDistUnit, NumAirDistUnits
! USE PackagedTerminalHeatPump, ONLY: GetPTUnitZoneInletAirNode, GetPTUnitIndex, GetPTUnitInletAirNode
! USE FanCoilUnits, ONLY: GetFanCoilIndex, GetFanCoilZoneInletAirNode, GetFanCoilInletAirNode
IMPLICIT NONE
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NumNums ! Number of REAL(r64) numbers returned by GetObjectItem
INTEGER :: NumAlphas ! Number of alphanumerics returned by GetObjectItem
INTEGER :: InletATMixerNum ! Index of inlet side mixer air terminal unit
INTEGER :: SupplyATMixerNum ! Index of supply side mixer air terminal unit
INTEGER :: NumInletATMixers ! Number of inlet side mixer air terminal units
INTEGER :: NumSupplyATMixers ! Number of supply side mixer air terminal units
INTEGER :: IOSTAT
CHARACTER(len=*), PARAMETER :: RoutineName='GetATMixers: ' ! include trailing blank space
LOGICAL :: ErrorsFound=.false. ! Error flag
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
INTEGER :: NodeNum ! Index to node number
INTEGER :: CtrlZone ! Index to control zone
LOGICAL :: ZoneNodeNotFound ! Flag for error checking
LOGICAL :: ZoneEquipNodeNotFound ! Flag for error checking
INTEGER :: ADUNum ! Air distribution unit index
INTEGER :: SupAirIn ! Supply air inlet node index
LOGICAL :: ErrFlag ! error flag from component validation
NumInletATMixers = GetNumObjectsFound('AirTerminal:SingleDuct:InletSideMixer')
NumSupplyATMixers = GetNumObjectsFound('AirTerminal:SingleDuct:SupplySideMixer')
NumATMixers = NumInletATMixers + NumSupplyATMixers
ALLOCATE(SysATMixer(NumATMixers))
cCurrentModuleObject='AirTerminal:SingleDuct:InletSideMixer'
DO InletATMixerNum=1,NumInletATMixers
CALL GetObjectItem(TRIM(cCurrentModuleObject),InletATMixerNum,cAlphaArgs,NumAlphas,&
rNumericArgs,NumNums,IOSTAT,NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),SysATMixer%Name,InletATMixerNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxxxxx'
ENDIF
SysATMixer(InletATMixerNum)%Name = TRIM(cAlphaArgs(1))
SysATMixer(InletATMixerNum)%MixerType = 1 ! inlet side mixer
IF (TRIM(cAlphaArgs(2)) == 'ZONEHVAC:WATERTOAIRHEATPUMP') THEN
SysATMixer(InletATMixerNum)%ZoneHVACUnitType = 1
ELSE IF (TRIM(cAlphaArgs(2)) == 'ZONEHVAC:FOURPIPEFANCOIL') THEN
SysATMixer(InletATMixerNum)%ZoneHVACUnitType = 2
END IF
SysATMixer(InletATMixerNum)%ZoneHVACUnitName = TRIM(cAlphaArgs(3))
CALL ValidateComponent(cAlphaArgs(2),SysATMixer(InletATMixerNum)%ZoneHVACUnitName, &
ErrFlag,TRIM(cCurrentModuleObject))
SysATMixer(InletATMixerNum)%MixedAirOutNode = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent,cAlphaFieldNames(4))
SysATMixer(InletATMixerNum)%PriInNode = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent,cAlphaFieldNames(5))
SysATMixer(InletATMixerNum)%SecInNode = &
GetOnlySingleNode(cAlphaArgs(6),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent,cAlphaFieldNames(6))
! Check for dupes in the three nodes.
IF (SysATMixer(InletATMixerNum)%SecInNode == SysATMixer(InletATMixerNum)%PriInNode) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(SysATMixer(InletATMixerNum)%Name)// &
' '//TRIM(cAlphaArgs(5))//' = '//TRIM(NodeID(SysATMixer(InletATMixerNum)%PriInNode))// &
' duplicates the '//TRIM(cAlphaArgs(4))//'.')
ErrorsFound=.true.
ELSEIF (SysATMixer(InletATMixerNum)%SecInNode == SysATMixer(InletATMixerNum)%MixedAirOutNode) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(SysATMixer(InletATMixerNum)%Name)// &
' '//TRIM(cAlphaArgs(6))//' = '//TRIM(NodeID(SysATMixer(InletATMixerNum)%MixedAirOutNode))// &
' duplicates the '//TRIM(cAlphaArgs(4))//'.')
ErrorsFound=.true.
ENDIF
IF (SysATMixer(InletATMixerNum)%PriInNode == SysATMixer(InletATMixerNum)%MixedAirOutNode) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(SysATMixer(InletATMixerNum)%Name)// &
' '//TRIM(cAlphaArgs(6))//' = '//TRIM(NodeID(SysATMixer(InletATMixerNum)%MixedAirOutNode))// &
' duplicates the '//TRIM(cAlphaArgs(5))//'.')
ErrorsFound=.true.
ENDIF
! Air Terminal inlet node must be the same as a zone exhaust node
ZoneNodeNotFound = .TRUE.
ControlledZoneLoop: DO CtrlZone = 1,NumOfZones
IF (.NOT. ZoneEquipConfig(CtrlZone)%IsControlled) CYCLE
DO NodeNum = 1,ZoneEquipConfig(CtrlZone)%NumExhaustNodes
IF (SysATMixer(InletATMixerNum)%SecInNode .EQ. ZoneEquipConfig(CtrlZone)%ExhaustNode(NodeNum)) THEN
ZoneNodeNotFound = .FALSE.
DO SupAirIn = 1,ZoneEquipConfig(CtrlZone)%NumInletNodes
IF (SysATMixer(InletATMixerNum)%SecInNode .EQ. ZoneEquipConfig(CtrlZone)%ExhaustNode(SupAirIn)) THEN
ZoneEquipConfig(CtrlZone)%AirDistUnitCool(SupAirIn)%InNode = SysATMixer(InletATMixerNum)%PriInNode
ZoneEquipConfig(CtrlZone)%AirDistUnitCool(SupAirIn)%OutNode = SysATMixer(InletATMixerNum)%MixedAirOutNode
ZoneEquipConfig(CtrlZone)%AirDistUnitHeat(SupAirIn)%InNode = SysATMixer(InletATMixerNum)%PriInNode
ZoneEquipConfig(CtrlZone)%AirDistUnitHeat(SupAirIn)%OutNode = SysATMixer(InletATMixerNum)%MixedAirOutNode
END IF
END DO
EXIT ControlledZoneLoop
END IF
END DO
END DO ControlledZoneLoop
IF(ZoneNodeNotFound)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = "'//TRIM(SysATMixer(InletATMixerNum)%Name)//'".'// &
' Inlet Side Air Terminal Mixer 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('..Inlet Side Air Terminal Mixer inlet node name = '// &
TRIM(NodeID(SysATMixer(InletATMixerNum)%SecInNode)))
ErrorsFound=.TRUE.
END IF
CALL TestCompSet(TRIM(cCurrentModuleObject),SysATMixer(InletATMixerNum)%Name,cAlphaArgs(5), &
cAlphaArgs(4),'Air Nodes')
END DO
cCurrentModuleObject='AirTerminal:SingleDuct:SupplySideMixer'
DO SupplyATMixerNum=NumInletATMixers+1,NumInletATMixers+NumSupplyATMixers
CALL GetObjectItem(TRIM(cCurrentModuleObject),SupplyATMixerNum,cAlphaArgs,NumAlphas,&
rNumericArgs,NumNums,IOSTAT,NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),SysATMixer%Name,SupplyATMixerNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxxxxx'
ENDIF
SysATMixer(SupplyATMixerNum)%Name = TRIM(cAlphaArgs(1))
SysATMixer(SupplyATMixerNum)%MixerType = 2 ! supply side mixer
IF (TRIM(cAlphaArgs(2)) == 'ZONEHVAC:WATERTOAIRHEATPUMP') THEN
SysATMixer(SupplyATMixerNum)%ZoneHVACUnitType = 1
ELSE IF (TRIM(cAlphaArgs(2)) == 'ZONEHVAC:FOURPIPEFANCOIL') THEN
SysATMixer(SupplyATMixerNum)%ZoneHVACUnitType = 2
END IF
SysATMixer(SupplyATMixerNum)%ZoneHVACUnitName = TRIM(cAlphaArgs(3))
CALL ValidateComponent(cAlphaArgs(2),SysATMixer(SupplyATMixerNum)%ZoneHVACUnitName, &
ErrFlag,TRIM(cCurrentModuleObject))
SysATMixer(SupplyATMixerNum)%MixedAirOutNode = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent,cAlphaFieldNames(4))
SysATMixer(SupplyATMixerNum)%PriInNode = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent,cAlphaFieldNames(5))
SysATMixer(SupplyATMixerNum)%SecInNode = &
GetOnlySingleNode(cAlphaArgs(6),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent,cAlphaFieldNames(6))
! Check for dupes in the three nodes.
IF (SysATMixer(SupplyATMixerNum)%SecInNode == SysATMixer(SupplyATMixerNum)%PriInNode) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(SysATMixer(SupplyATMixerNum)%Name)// &
' '//TRIM(cAlphaArgs(5))//' = '//TRIM(NodeID(SysATMixer(SupplyATMixerNum)%PriInNode))// &
' duplicates the '//TRIM(cAlphaArgs(4))//'.')
ErrorsFound=.true.
ELSEIF (SysATMixer(SupplyATMixerNum)%SecInNode == SysATMixer(SupplyATMixerNum)%MixedAirOutNode) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(SysATMixer(SupplyATMixerNum)%Name)// &
' '//TRIM(cAlphaArgs(6))//' = '//TRIM(NodeID(SysATMixer(SupplyATMixerNum)%MixedAirOutNode))// &
' duplicates the '//TRIM(cAlphaArgs(4))//'.')
ErrorsFound=.true.
ENDIF
IF (SysATMixer(SupplyATMixerNum)%PriInNode == SysATMixer(SupplyATMixerNum)%MixedAirOutNode) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(SysATMixer(SupplyATMixerNum)%Name)// &
' '//TRIM(cAlphaArgs(6))//' = '//TRIM(NodeID(SysATMixer(SupplyATMixerNum)%MixedAirOutNode))// &
' duplicates the '//TRIM(cAlphaArgs(5))//'.')
ErrorsFound=.true.
ENDIF
CALL TestCompSet(TRIM(cCurrentModuleObject),SysATMixer(SupplyATMixerNum)%Name,cAlphaArgs(5), &
cAlphaArgs(4),'Air Nodes')
! Air Terminal outlet node must be the same as a zone inlet node
ZoneNodeNotFound = .TRUE.
ControlZoneLoop: DO CtrlZone = 1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZone)%IsControlled) CYCLE
DO NodeNum = 1,ZoneEquipConfig(CtrlZone)%NumInletNodes
IF (SysATMixer(SupplyATMixerNum)%MixedAirOutNode .EQ. ZoneEquipConfig(CtrlZone)%InletNode(NodeNum)) THEN
ZoneNodeNotFound = .FALSE.
DO SupAirIn = 1,ZoneEquipConfig(CtrlZone)%NumInletNodes
IF (SysATMixer(SupplyATMixerNum)%MixedAirOutNode .EQ. ZoneEquipConfig(CtrlZone)%InletNode(SupAirIn)) THEN
ZoneEquipConfig(CtrlZone)%AirDistUnitCool(SupAirIn)%InNode = SysATMixer(SupplyATMixerNum)%PriInNode
ZoneEquipConfig(CtrlZone)%AirDistUnitCool(SupAirIn)%OutNode = SysATMixer(SupplyATMixerNum)%MixedAirOutNode
ZoneEquipConfig(CtrlZone)%AirDistUnitHeat(SupAirIn)%InNode = SysATMixer(SupplyATMixerNum)%PriInNode
ZoneEquipConfig(CtrlZone)%AirDistUnitHeat(SupAirIn)%OutNode = SysATMixer(SupplyATMixerNum)%MixedAirOutNode
END IF
END DO
EXIT ControlZoneLoop
END IF
END DO
END DO ControlZoneLoop
IF(ZoneNodeNotFound)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = "'//TRIM(SysATMixer(SupplyATMixerNum)%Name)//'".'// &
' Supply Side Air Terminal Mixer air outlet node name must be the same as a zone inlet node name.')
CALL ShowContinueError('..Zone exhaust node name is specified in ZoneHVAC:EquipmentConnections object.')
CALL ShowContinueError('..Inlet Side Air Terminal Mixer inlet node name = '// &
TRIM(NodeID(SysATMixer(SupplyATMixerNum)%SecInNode)))
ErrorsFound=.TRUE.
END IF
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in input. Program terminates.')
ENDIF
RETURN
END SUBROUTINE GetATMixers