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 GetIndUnits
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN June 15 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Obtains input data for passive induction air terminal units and stores it in the
! induction terminal unit data structures
! METHODOLOGY EMPLOYED:
! Uses "Get" routines to read in data.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, SameString, GetObjectDefMaxArgs
USE NodeInputManager, ONLY: GetOnlySingleNode
USE BranchNodeConnections, ONLY: TestCompSet, SetUpCompSets
USE DataZoneEquipment, ONLY: ZoneEquipConfig
USE DataSizing
USE DataDefineEquip, ONLY: AirDistUnit, NumAirDistUnits
USE WaterCoils, ONLY: GetCoilWaterInletNode
USE DataIPShortCuts
USE DataPlant, ONLY: TypeOf_CoilWaterSimpleHeating, TypeOf_CoilWaterCooling, TypeOf_CoilWaterDetailedFlatCooling
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER (len=*), PARAMETER :: RoutineName='GetIndUnits ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! na
INTEGER :: IUIndex ! loop index
INTEGER :: IUNum ! current fan coil number
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! for ease in getting objects
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 :: NumAlphas=0 ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers=0 ! Number of Numbers for each GetObjectItem call
INTEGER :: TotalArgs=0 ! Total number of alpha and numeric arguments (max) for a
! certain object in the input file
INTEGER :: IOStatus ! Used in GetObjectItem
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input, fatal at end of routine
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
INTEGER :: CtrlZone ! controlled zome do loop index
INTEGER :: SupAirIn ! controlled zone supply air inlet index
LOGICAL :: AirNodeFound
INTEGER :: ADUNum
! find the number of each type of induction unit
CurrentModuleObject = 'AirTerminal:SingleDuct:ConstantVolume:FourPipeInduction'
NumFourPipes = GetNumObjectsFound(CurrentModuleObject)
NumIndUnits = NumFourPipes
! allocate the data structures
ALLOCATE(IndUnit(NumIndUnits))
ALLOCATE(CheckEquipName(NumIndUnits))
CheckEquipName=.true.
CALL GetObjectDefMaxArgs(CurrentModuleObject,TotalArgs,NumAlphas,NumNumbers)
ALLOCATE(Alphas(NumAlphas))
Alphas=' '
ALLOCATE(cAlphaFields(NumAlphas))
cAlphaFields=' '
ALLOCATE(cNumericFields(NumNumbers))
cNumericFields=' '
ALLOCATE(Numbers(NumNumbers))
Numbers=0.0d0
ALLOCATE(lAlphaBlanks(NumAlphas))
lAlphaBlanks=.true.
ALLOCATE(lNumericBlanks(NumNumbers))
lNumericBlanks=.true.
! loop over Series PIUs; get and load the input data
DO IUIndex = 1,NumFourPipes
CALL GetObjectItem(CurrentModuleObject,IUIndex,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IUNum = IUIndex
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(Alphas(1),IndUnit%Name,IUNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
IndUnit(IUNum)%Name = Alphas(1)
IndUnit(IUNum)%UnitType = TRIM(CurrentModuleObject)
IndUnit(IUNum)%UnitType_Num = SingleDuct_CV_FourPipeInduc
IndUnit(IUNum)%Sched = Alphas(2)
IF (lAlphaBlanks(2)) THEN
IndUnit(IUNum)%SchedPtr = ScheduleAlwaysOn
ELSE
IndUnit(IUNum)%SchedPtr = GetScheduleIndex(Alphas(2)) ! convert schedule name to pointer
IF (IndUnit(IUNum)%SchedPtr .EQ. 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
IndUnit(IUNum)%MaxTotAirVolFlow = Numbers(1)
IndUnit(IUNum)%InducRatio = Numbers(2)
IF (lNumericBlanks(2)) IndUnit(IUNum)%InducRatio = 2.5d0
IndUnit(IUNum)%PriAirInNode = &
GetOnlySingleNode(Alphas(3),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsParent,cAlphaFields(3))
IndUnit(IUNum)%SecAirInNode = &
GetOnlySingleNode(Alphas(4),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsParent,cAlphaFields(4))
IndUnit(IUNum)%OutAirNode = &
GetOnlySingleNode(Alphas(5),ErrorsFound,TRIM(CurrentModuleObject),Alphas(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsParent,cAlphaFields(5))
IndUnit(IUNum)%HCoilType = Alphas(8) ! type (key) of heating coil
IF (SameString(IndUnit(IUNum)%HCoilType,'Coil:Heating:Water')) THEN
IndUnit(IUNum)%HCoil_PlantTypeNum = TypeOf_CoilWaterSimpleHeating
ENDIF
IndUnit(IUNum)%HCoil = Alphas(9) ! name of heating coil object
IsNotOK=.false.
IndUnit(IUNum)%HWControlNode = GetCoilWaterInletNode(IndUnit(IUNum)%HCoilType,IndUnit(IUNum)%HCoil,IsNotOK)
IF (IsNotOK) THEN
CALL ShowContinueError('In '//TRIM(CurrentModuleObject)//' = '//TRIM(IndUnit(IUNum)%Name))
CALL ShowContinueError('..Only Coil:Heating:Water is allowed.')
ErrorsFound=.true.
ENDIF
! GetOnlySingleNode(Alphas(6),ErrorsFound,'AirTerminal:SingleDuct:ConstantVolume:FourPipeInduction',Alphas(1), &
! NodeType_Water,NodeConnectionType_Actuator,1,ObjectIsParent)
IndUnit(IUNum)%MaxVolHotWaterFlow = Numbers(3)
IndUnit(IUNum)%MinVolHotWaterFlow = Numbers(4)
IndUnit(IUNum)%HotControlOffset = Numbers(5)
IndUnit(IUNum)%CCoilType = Alphas(10) ! type (key) of cooling coil
IF (SameString(IndUnit(IUNum)%CCoilType , 'Coil:Cooling:Water')) THEN
IndUnit(IUNum)%CCoil_PlantTypeNum = TypeOf_CoilWaterCooling
ELSEIF (SameString(IndUnit(IUNum)%CCoilType , 'Coil:Cooling:Water:DetailedGeometry')) THEN
IndUnit(IUNum)%CCoil_PlantTypeNum = TypeOf_CoilWaterDetailedFlatCooling
ENDIF
IndUnit(IUNum)%CCoil = Alphas(11) ! name of cooling coil object
IsNotOK=.false.
IndUnit(IUNum)%CWControlNode = GetCoilWaterInletNode(IndUnit(IUNum)%CCoilType,IndUnit(IUNum)%CCoil,IsNotOK)
IF (IsNotOK) THEN
CALL ShowContinueError('In '//TRIM(CurrentModuleObject)//' = '//TRIM(IndUnit(IUNum)%Name))
CALL ShowContinueError('..Only Coil:Cooling:Water or Coil:Cooling:Water:DetailedGeometry is allowed.')
ErrorsFound=.true.
ENDIF
! GetOnlySingleNode(Alphas(7),ErrorsFound,'AirTerminal:SingleDuct:ConstantVolume:FourPipeInduction',Alphas(1), &
! NodeType_Water,NodeConnectionType_Actuator,1,ObjectIsParent)
IndUnit(IUNum)%MaxVolColdWaterFlow = Numbers(6)
IndUnit(IUNum)%MinVolColdWaterFlow = Numbers(7)
IndUnit(IUNum)%ColdControlOffset = Numbers(8)
IndUnit(IUNum)%MixerName = Alphas(12)
! Add heating coil to component sets array
CALL SetUpCompSets(IndUnit(IUNum)%UnitType, IndUnit(IUNum)%Name, IndUnit(IUNum)%HCoilType, &
IndUnit(IUNum)%HCoil, Alphas(4), 'UNDEFINED')
! Add cooling coil to component sets array
CALL SetUpCompSets(IndUnit(IUNum)%UnitType, IndUnit(IUNum)%Name, IndUnit(IUNum)%CCoilType, &
IndUnit(IUNum)%CCoil, 'UNDEFINED', 'UNDEFINED')
! Register component set data
CALL TestCompSet(IndUnit(IUNum)%UnitType,IndUnit(IUNum)%Name, &
NodeID(IndUnit(IUNum)%PriAirInNode),NodeID(IndUnit(IUNum)%OutAirNode),'Air Nodes')
! Fill the Zone Equipment data with the supply air inlet node number of this unit.
AirNodeFound=.false.
DO CtrlZone = 1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZone)%IsControlled) CYCLE
DO SupAirIn = 1,ZoneEquipConfig(CtrlZone)%NumInletNodes
IF (IndUnit(IUNum)%OutAirNode .EQ. ZoneEquipConfig(CtrlZone)%InletNode(SupAirIn)) THEN
IF (ZoneEquipConfig(CtrlZone)%AirDistUnitCool(SupAirIn)%OutNode > 0) THEN
CALL ShowSevereError('Error in connecting a terminal unit to a zone')
CALL ShowContinueError(TRIM(NodeID(IndUnit(IUNum)%OutAirNode))//' already connects to another zone')
CALL ShowContinueError('Occurs for terminal unit '//TRIM(IndUnit(IUNum)%UnitType)//' = '//TRIM(IndUnit(IUNum)%Name))
CALL ShowContinueError('Check terminal unit node names for errors')
ErrorsFound = .true.
ELSE
ZoneEquipConfig(CtrlZone)%AirDistUnitCool(SupAirIn)%InNode = IndUnit(IUNum)%PriAirInNode
ZoneEquipConfig(CtrlZone)%AirDistUnitCool(SupAirIn)%OutNode = IndUnit(IUNum)%OutAirNode
END IF
AirNodeFound=.true.
! save the induction ratio in the term unit sizing array for use in the system sizing calculation
IF (ZoneSizingRunDone) THEN
TermUnitSizing(CtrlZone)%InducRat = IndUnit(IUNum)%InducRatio
END IF
EXIT
END IF
END DO
END DO
IF (.not. AirNodeFound) THEN
CALL ShowSevereError('The outlet air node from the '//TRIM(CurrentModuleObject)//' = ' &
//TRIM(IndUnit(IUNum)%Name))
CALL ShowContinueError('did not have a matching Zone Equipment Inlet Node, Node ='//TRIM(Alphas(3)))
ErrorsFound=.true.
ENDIF
END DO
DO IUNum=1,NumIndUnits
DO ADUNum = 1,NumAirDistUnits
IF (IndUnit(IUNum)%OutAirNode == AirDistUnit(ADUNum)%OutletNodeNum) THEN
! AirDistUnit(ADUNum)%InletNodeNum = IndUnitIUNum)%InletNodeNum
IndUnit(IUNum)%ADUNum = ADUNum
END IF
END DO
! one assumes if there isn't one assigned, it's an error?
IF (IndUnit(IUNum)%ADUNum == 0) THEN
CALL ShowSevereError(RoutineName//'No matching Air Distribution Unit, for Unit = ['// &
TRIM(IndUnit(IUNum)%UnitType)//','//TRIM(IndUnit(IUNum)%Name)//'].')
CALL ShowContinueError('...should have outlet node='//TRIM(NodeID(IndUnit(IUNum)%OutAirNode)))
! ErrorsFound=.true.
ENDIF
END DO
DEALLOCATE(Alphas)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
DEALLOCATE(Numbers)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in getting input. Preceding conditions cause termination.')
END IF
RETURN
END SUBROUTINE GetIndUnits