SUBROUTINE GetUserDefinedComponents
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN Jan 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! <description>
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectDefMaxArgs, GetObjectItem, &
FindItemInList, VerifyName
USE General, ONLY: RoundSigDigits
USE NodeInputManager, ONLY: GetOnlySingleNode
USE BranchNodeConnections, ONLY: TestCompSet
USE DataHeatBalance, ONLY: Zone, IntGainTypeOf_PlantComponentUserDefined, &
IntGainTypeOf_CoilUserDefined, IntGainTypeOf_ZoneHVACForcedAirUserDefined, &
IntGainTypeOf_AirTerminalUserDefined
USE WaterManager, ONLY: SetupTankDemandComponent, SetupTankSupplyComponent
USE DataZoneEquipment, ONLY: ZoneEquipConfig
USE GlobalNames, ONLY: VerifyUniqueCoilName
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.
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNums ! Number of elements in the numeric array
INTEGER :: IOStat ! IO Status when calling get input subroutine
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
INTEGER :: MaxNumAlphas = 0 !argument for call to GetObjectDefMaxArgs
INTEGER :: MaxNumNumbers = 0 !argument for call to GetObjectDefMaxArgs
INTEGER :: TotalArgs = 0 !argument for call to GetObjectDefMaxArgs
CHARACTER(len=MaxNameLength+40),ALLOCATABLE, DIMENSION(:) :: cAlphaFieldNames
CHARACTER(len=MaxNameLength+40),ALLOCATABLE, DIMENSION(:) :: cNumericFieldNames
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericFieldBlanks
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaFieldBlanks
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: cAlphaArgs
REAL(r64),ALLOCATABLE, DIMENSION(:) :: rNumericArgs
CHARACTER(len=MaxNameLength) :: cCurrentModuleObject
INTEGER :: CompLoop
INTEGER :: ConnectionLoop
INTEGER :: NumPlantConnections
INTEGER :: NumAirConnections
CHARACTER(len=20) :: LoopStr
INTEGER :: aArgCount
INTEGER :: StackMngrNum
LOGICAL :: lDummy
! INTEGER :: alphaNum
! INTEGER :: Loop
INTEGER :: MgrCountTest
INTEGER :: CtrlZone ! controlled zone do loop index
INTEGER :: SupAirIn ! controlled zone supply air inlet index
LOGICAL :: errflag
cCurrentModuleObject = 'PlantComponent:UserDefined'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNums)
MaxNumNumbers=NumNums
MaxNumAlphas=NumAlphas
ALLOCATE(cAlphaFieldNames(MaxNumAlphas))
cAlphaFieldNames=' '
ALLOCATE(cAlphaArgs(MaxNumAlphas))
cAlphaArgs=' '
ALLOCATE(lAlphaFieldBlanks(MaxNumAlphas))
lAlphaFieldBlanks=.false.
ALLOCATE(cNumericFieldNames(MaxNumNumbers))
cNumericFieldNames=' '
ALLOCATE(rNumericArgs(MaxNumNumbers))
rNumericArgs=0.0d0
ALLOCATE(lNumericFieldBlanks(MaxNumNumbers))
lNumericFieldBlanks=.false.
!need to make sure GetEMSInput has run...
cCurrentModuleObject = 'PlantComponent:UserDefined'
NumUserPlantComps = GetNumObjectsFound(cCurrentModuleObject)
IF (NumUserPlantComps > 0) THEN
ALLOCATE(UserPlantComp(NumUserPlantComps))
ALLOCATE(CheckUserPlantCompName(NumUserPlantComps))
CheckUserPlantCompName = .TRUE.
DO CompLoop =1, NumUserPlantComps
CALL GetObjectItem(cCurrentModuleObject, CompLoop, cAlphaArgs, NumAlphas, rNumericArgs, &
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1), UserPlantComp%Name, CompLoop - 1, IsNotOK, IsBlank, TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
UserPlantComp(CompLoop)%Name = cAlphaArgs(1)
! now get program manager for model simulations
IF (.NOT. lAlphaFieldBlanks(2)) THEN
StackMngrNum = FindItemInList(cAlphaArgs(2), EMSProgramCallManager%Name, NumProgramCallManagers)
IF (StackMngrNum > 0) THEN ! found it
UserPlantComp(CompLoop)%ErlSimProgramMngr = StackMngrNum
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Program Manager Name not found.')
ErrorsFound = .TRUE.
ENDIF
ENDIF
NumPlantConnections = FLOOR(rNumericArgs(1))
IF ((NumPlantConnections >= 1) .AND. (NumPlantConnections <= 4)) THEN
ALLOCATE(UserPlantComp(CompLoop)%Loop(NumPlantConnections))
UserPlantComp(CompLoop)%NumPlantConnections = NumPlantConnections
DO ConnectionLoop = 1, NumPlantConnections
LoopStr=RoundSigDigits(ConnectionLoop)
aArgCount = (ConnectionLoop-1) * 6 + 3
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(aArgCount),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Inlet, ConnectionLoop, ObjectIsNotParent)
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(aArgCount + 1),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Outlet, ConnectionLoop, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(aArgCount),cAlphaArgs(aArgCount + 1), &
'Plant Nodes '//LoopStr)
SELECT CASE (TRIM(cAlphaArgs(aArgCount + 2)))
CASE ('DEMANDSLOAD')
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%HowLoadServed = HowMet_NoneDemand
CASE ('MEETSLOADWITHPASSIVECAPACITY')
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%HowLoadServed = HowMet_PassiveCap
CASE ('MEETSLOADWITHNOMINALCAPACITY')
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%HowLoadServed = HowMet_ByNominalCap
CASE ('MEETSLOADWITHNOMINALCAPACITYLOWOUTLIMIT')
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%HowLoadServed = HowMet_ByNominalCapLowOutLimit
! actuator for low out limit
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserPlantComp(CompLoop)%Name, &
'Low Outlet Temperature Limit', '[C]', lDummy, &
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%LowOutTempLimit)
CASE ('MEETSLOADWITHNOMINALCAPACITYHIOUTLIMIT')
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%HowLoadServed = HowMet_ByNominalCapHiOutLimit
! actuator for hi out limit
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserPlantComp(CompLoop)%Name, &
'High Outlet Temperature Limit', '[C]', lDummy, &
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%HiOutTempLimit)
END SELECT
SELECT CASE (TRIM(cAlphaArgs(aArgCount + 3)))
CASE ('NEEDSFLOWIFLOOPON' )
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%FlowPriority = LoopFlowStatus_NeedyIfLoopOn
CASE ('NEEDSFLOWANDTURNSLOOPON')
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%FlowPriority = LoopFlowStatus_NeedyAndTurnsLoopOn
CASE ('RECEIVESWHATEVERFLOWAVAILABLE' )
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%FlowPriority = LoopFlowStatus_TakesWhatGets
END SELECT
! find program manager for initial setup, begin environment and sizing of this plant connection
IF (.NOT. lAlphaFieldBlanks(aArgCount + 4)) THEN
StackMngrNum = FindItemInList(cAlphaArgs(aArgCount + 4), EMSProgramCallManager%Name, NumProgramCallManagers)
IF (StackMngrNum > 0) THEN ! found it
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%ErlInitProgramMngr = StackMngrNum
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(aArgCount + 4))//'='//TRIM(cAlphaArgs(aArgCount + 4)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Program Manager Name not found.')
ErrorsFound = .TRUE.
ENDIF
ENDIF
! find program to call for model simulations for just this plant connection
IF (.NOT. lAlphaFieldBlanks(aArgCount + 5)) THEN
StackMngrNum = FindItemInList(cAlphaArgs(aArgCount + 5), EMSProgramCallManager%Name, NumProgramCallManagers)
IF (StackMngrNum > 0) THEN ! found it
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%ErlSimProgramMngr = StackMngrNum
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(aArgCount + 4))//'='//TRIM(cAlphaArgs(aArgCount + 4)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Program Manager Name not found.')
ErrorsFound = .TRUE.
ENDIF
ENDIF
!Setup Internal Variables
!model input related internal variables
CALL SetupEMSInternalVariable( 'Inlet Temperature for Plant Connection '//TRIM(LoopStr) , &
UserPlantComp(CompLoop)%Name, '[C]', &
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%InletTemp )
CALL SetupEMSInternalVariable( 'Inlet Mass Flow Rate for Plant Connection '//TRIM(LoopStr) , &
UserPlantComp(CompLoop)%Name, '[kg/s]', &
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%InletMassFlowRate )
IF (UserPlantComp(CompLoop)%Loop(ConnectionLoop)%HowLoadServed /= HowMet_NoneDemand) THEN
CALL SetupEMSInternalVariable( 'Load Request for Plant Connection '//TRIM(LoopStr) , &
UserPlantComp(CompLoop)%Name, '[W]', &
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%MyLoad )
ENDIF
CALL SetupEMSInternalVariable( 'Inlet Density for Plant Connection '//TRIM(LoopStr) , &
UserPlantComp(CompLoop)%Name, '[kg/m3]', &
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%InletRho )
CALL SetupEMSInternalVariable( 'Inlet Specific Heat for Plant Connection '//TRIM(LoopStr) , &
UserPlantComp(CompLoop)%Name, '[J/kg-C]', &
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%InletCp )
! model results related actuators
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserPlantComp(CompLoop)%Name, &
'Outlet Temperature', '[C]', lDummy, &
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%OutletTemp )
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserPlantComp(CompLoop)%Name, &
'Mass Flow Rate', '[kg/s]', lDummy, &
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%MassFlowRateRequest)
! model initialization and sizing related actuators
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserPlantComp(CompLoop)%Name, &
'Minimum Mass Flow Rate', '[kg/s]', lDummy, &
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%MassFlowRateMin)
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserPlantComp(CompLoop)%Name, &
'Maximum Mass Flow Rate', '[kg/s]', lDummy, &
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%MassFlowRateMax)
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserPlantComp(CompLoop)%Name, &
'Design Volume Flow Rate', '[m3/s]', lDummy, &
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%DesignVolumeFlowRate)
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserPlantComp(CompLoop)%Name, &
'Minimum Loading Capacity', '[W]', lDummy, &
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%MinLoad )
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserPlantComp(CompLoop)%Name, &
'Maximum Loading Capacity', '[W]', lDummy, &
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%MaxLoad )
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserPlantComp(CompLoop)%Name, &
'Optimal Loading Capacity', '[W]', lDummy, &
UserPlantComp(CompLoop)%Loop(ConnectionLoop)%OptLoad )
ENDDO
ENDIF
IF (.NOT. lAlphaFieldBlanks(27) ) THEN
UserPlantComp(CompLoop)%Air%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(27),ErrorsFound,TRIM(cCurrentModuleObject),UserPlantComp(CompLoop)%Name, &
NodeType_Air,NodeConnectionType_OutsideAirReference,1,ObjectIsNotParent)
!model input related internal variables
CALL SetupEMSInternalVariable( 'Inlet Temperature for Air Connection' , UserPlantComp(CompLoop)%Name, '[C]', &
UserPlantComp(CompLoop)%Air%InletTemp )
CALL SetupEMSInternalVariable( 'Inlet Mass Flow Rate for Air Connection' , UserPlantComp(CompLoop)%Name, '[kg/s]', &
UserPlantComp(CompLoop)%Air%InletMassFlowRate )
CALL SetupEMSInternalVariable( 'Inlet Humidity Ratio for Air Connection' , UserPlantComp(CompLoop)%Name, &
'[kgWater/kgDryAir]', &
UserPlantComp(CompLoop)%Air%InletHumRat )
CALL SetupEMSInternalVariable( 'Inlet Density for Air Connection' , UserPlantComp(CompLoop)%Name, '[kg/m3]', &
UserPlantComp(CompLoop)%Air%InletRho )
CALL SetupEMSInternalVariable( 'Inlet Specific Heat for Air Connection' , UserPlantComp(CompLoop)%Name, '[J/kg-C]', &
UserPlantComp(CompLoop)%Air%InletCp )
ENDIF
IF (.NOT. lAlphaFieldBlanks(28) ) THEN
UserPlantComp(CompLoop)%Air%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(28),ErrorsFound,TRIM(cCurrentModuleObject),UserPlantComp(CompLoop)%Name, &
NodeType_Air,NodeConnectionType_ReliefAir,1,ObjectIsNotParent)
!outlet air node results
CALL SetupEMSActuator('Air Connection', UserPlantComp(CompLoop)%Name, &
'Outlet Temperature', '[C]', lDummy, &
UserPlantComp(CompLoop)%Air%OutletTemp )
CALL SetupEMSActuator('Air Connection', UserPlantComp(CompLoop)%Name, &
'Outlet Humidity Ratio', '[kgWater/kgDryAir]', lDummy, &
UserPlantComp(CompLoop)%Air%OutletHumRat )
CALL SetupEMSActuator('Air Connection', UserPlantComp(CompLoop)%Name, &
'Mass Flow Rate', '[kg/s]', lDummy, &
UserPlantComp(CompLoop)%Air%OutletMassFlowRate)
ENDIF
IF (.NOT. lAlphaFieldBlanks(29) ) THEN
CALL SetupTankDemandComponent(cAlphaArgs(1), TRIM(cCurrentModuleObject), cAlphaArgs(29), ErrorsFound, &
UserPlantComp(CompLoop)%Water%SupplyTankID, UserPlantComp(CompLoop)%Water%SupplyTankDemandARRID)
UserPlantComp(CompLoop)%Water%SuppliedByWaterSystem = .TRUE.
CALL SetupEMSActuator('Water System', UserPlantComp(CompLoop)%Name, &
'Supplied Volume Flow Rate', '[m3/s]', lDummy, &
UserPlantComp(CompLoop)%Water%SupplyVdotRequest )
ENDIF
IF (.NOT. lAlphaFieldBlanks(30) ) THEN
CALL SetupTankSupplyComponent(cAlphaArgs(1), TRIM(cCurrentModuleObject), cAlphaArgs(30), ErrorsFound, &
UserPlantComp(CompLoop)%Water%CollectionTankID, &
UserPlantComp(CompLoop)%Water%CollectionTankSupplyARRID)
UserPlantComp(CompLoop)%Water%CollectsToWaterSystem = .TRUE.
CALL SetupEMSActuator('Water System', UserPlantComp(CompLoop)%Name, &
'Collected Volume Flow Rate', '[m3/s]', lDummy, &
UserPlantComp(CompLoop)%Water%CollectedVdot )
ENDIF
IF (.NOT. lAlphaFieldBlanks(31) ) THEN
UserPlantComp(CompLoop)%Zone%ZoneNum = FindItemInList(cAlphaArgs(31),Zone%Name,NumOfZones)
IF (UserPlantComp(CompLoop)%Zone%ZoneNum == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Ambient Zone Name not found = '//TRIM(cAlphaArgs(31)))
ErrorsFound = .TRUE.
ELSE
UserPlantComp(CompLoop)%Zone%DeviceHasInternalGains = .TRUE.
CALL SetupZoneInternalGain(UserPlantComp(CompLoop)%Zone%ZoneNum, &
TRIM(cCurrentModuleObject), &
TRIM(cAlphaArgs(1)), &
IntGainTypeOf_PlantComponentUserDefined, &
ConvectionGainRate = UserPlantComp(CompLoop)%Zone%ConvectionGainRate, &
ReturnAirConvectionGainRate = UserPlantComp(CompLoop)%Zone%ReturnAirConvectionGainRate, &
ThermalRadiationGainRate = UserPlantComp(CompLoop)%Zone%ThermalRadiationGainRate, &
LatentGainRate = UserPlantComp(CompLoop)%Zone%LatentGainRate, &
ReturnAirLatentGainRate = UserPlantComp(CompLoop)%Zone%ReturnAirLatentGainRate, &
CarbonDioxideGainRate = UserPlantComp(CompLoop)%Zone%CarbonDioxideGainRate, &
GenericContamGainRate = UserPlantComp(CompLoop)%Zone%GenericContamGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserPlantComp(CompLoop)%Name, &
'Sensible Heat Gain Rate', '[W]', lDummy, &
UserPlantComp(CompLoop)%Zone%ConvectionGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserPlantComp(CompLoop)%Name, &
'Return Air Heat Sensible Gain Rate', '[W]', lDummy, &
UserPlantComp(CompLoop)%Zone%ReturnAirConvectionGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserPlantComp(CompLoop)%Name, &
'Thermal Radiation Heat Gain Rate', '[W]', lDummy, &
UserPlantComp(CompLoop)%Zone%ThermalRadiationGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserPlantComp(CompLoop)%Name, &
'Latent Heat Gain Rate', '[W]', lDummy, &
UserPlantComp(CompLoop)%Zone%LatentGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserPlantComp(CompLoop)%Name, &
'Return Air Latent Heat Gain Rate', '[W]', lDummy, &
UserPlantComp(CompLoop)%Zone%ReturnAirLatentGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserPlantComp(CompLoop)%Name, &
'Carbon Dioxide Gain Rate', '[W]', lDummy, &
UserPlantComp(CompLoop)%Zone%CarbonDioxideGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserPlantComp(CompLoop)%Name, &
'Gaseous Contaminant Gain Rate', '[W]', lDummy, &
UserPlantComp(CompLoop)%Zone%GenericContamGainRate )
ENDIF
ENDIF
! make sure user has entered at least some erl program managers to actually calculate something
MgrCountTest = 0
IF (UserPlantComp(CompLoop)%ErlSimProgramMngr > 0) MgrCountTest = 1
DO ConnectionLoop = 1, NumPlantConnections
IF (UserPlantComp(CompLoop)%Loop(ConnectionLoop)%ErlInitProgramMngr > 0) MgrCountTest = MgrCountTest + 1
IF (UserPlantComp(CompLoop)%Loop(ConnectionLoop)%ErlSimProgramMngr > 0) MgrCountTest = MgrCountTest + 1
ENDDO
IF (MgrCountTest == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('At least one program calling manager is needed.')
ErrorsFound = .TRUE.
ENDIF
ENDDO
ENDIF !NumUserPlantComps > 0
IF (ErrorsFound) THEN
CALL ShowFatalError('GetUserDefinedComponents: Errors found in processing '//TRIM(cCurrentModuleObject)//' input.')
ENDIF
cCurrentModuleObject = 'Coil:UserDefined'
NumUserCoils = GetNumObjectsFound(cCurrentModuleObject)
IF (NumUserCoils > 0) THEN
ALLOCATE(UserCoil(NumUserCoils))
ALLOCATE(CheckUserCoilName(NumUserCoils))
CheckUserCoilName = .TRUE.
DO CompLoop = 1, NumUserCoils
CALL GetObjectItem(cCurrentModuleObject, CompLoop, cAlphaArgs, NumAlphas, rNumericArgs, &
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1), UserCoil%Name, CompLoop - 1, IsNotOK, IsBlank, TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
CALL VerifyUniqueCoilName(cCurrentModuleObject,cAlphaArgs(1),errflag,TRIM(cCurrentModuleObject)//' Name')
IF (errflag) THEN
ErrorsFound=.true.
ENDIF
UserCoil(CompLoop)%Name = cAlphaArgs(1)
! now get program manager for model simulations
IF (.NOT. lAlphaFieldBlanks(2)) THEN
StackMngrNum = FindItemInList(cAlphaArgs(2), EMSProgramCallManager%Name, NumProgramCallManagers)
IF (StackMngrNum > 0) THEN ! found it
UserCoil(CompLoop)%ErlSimProgramMngr = StackMngrNum
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Program Manager Name not found.')
ErrorsFound = .TRUE.
ENDIF
ENDIF
! now get program manager for model initializations
IF (.NOT. lAlphaFieldBlanks(3)) THEN
StackMngrNum = FindItemInList(cAlphaArgs(3), EMSProgramCallManager%Name, NumProgramCallManagers)
IF (StackMngrNum > 0) THEN ! found it
UserCoil(CompLoop)%ErlInitProgramMngr = StackMngrNum
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(3))//'='//TRIM(cAlphaArgs(3)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Program Manager Name not found.')
ErrorsFound = .TRUE.
ENDIF
ENDIF
NumAirConnections = FLOOR(rNumericArgs(1))
IF ((NumAirConnections >= 1) .AND. (NumAirConnections <= 2)) THEN
ALLOCATE(UserCoil(CompLoop)%Air(NumAirConnections))
UserCoil(CompLoop)%NumAirConnections = NumAirConnections
DO ConnectionLoop = 1, NumAirConnections
aArgCount = (ConnectionLoop - 1) * 2 + 4
UserCoil(CompLoop)%Air(ConnectionLoop)%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(aArgCount),ErrorsFound,TRIM(cCurrentModuleObject),UserCoil(CompLoop)%Name, &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
LoopStr=RoundSigDigits(ConnectionLoop)
!model input related internal variables
CALL SetupEMSInternalVariable( 'Inlet Temperature for Air Connection '//TRIM(LoopStr) , UserCoil(CompLoop)%Name, &
'[C]', UserCoil(CompLoop)%Air(ConnectionLoop)%InletTemp )
CALL SetupEMSInternalVariable( 'Inlet Mass Flow Rate for Air Connection '//TRIM(LoopStr) , UserCoil(CompLoop)%Name, &
'[kg/s]', UserCoil(CompLoop)%Air(ConnectionLoop)%InletMassFlowRate )
CALL SetupEMSInternalVariable( 'Inlet Humidity Ratio for Air Connection '//TRIM(LoopStr) , UserCoil(CompLoop)%Name, &
'[kgWater/kgDryAir]', UserCoil(CompLoop)%Air(ConnectionLoop)%InletHumRat )
CALL SetupEMSInternalVariable( 'Inlet Density for Air Connection '//TRIM(LoopStr) , UserCoil(CompLoop)%Name, &
'[kg/m3]', UserCoil(CompLoop)%Air(ConnectionLoop)%InletRho )
CALL SetupEMSInternalVariable( 'Inlet Specific Heat for Air Connection '//TRIM(LoopStr) , UserCoil(CompLoop)%Name, &
'[J/kg-C]', UserCoil(CompLoop)%Air(ConnectionLoop)%InletCp )
UserCoil(CompLoop)%Air(ConnectionLoop)%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(aArgCount + 1),ErrorsFound,TRIM(cCurrentModuleObject),UserCoil(CompLoop)%Name, &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
CALL SetupEMSActuator('Air Connection '//TRIM(LoopStr), UserCoil(CompLoop)%Name, &
'Outlet Temperature', '[C]', lDummy, &
UserCoil(CompLoop)%Air(ConnectionLoop)%OutletTemp )
CALL SetupEMSActuator('Air Connection '//TRIM(LoopStr), UserCoil(CompLoop)%Name, &
'Outlet Humidity Ratio', '[kgWater/kgDryAir]', lDummy, &
UserCoil(CompLoop)%Air(ConnectionLoop)%OutletHumRat )
CALL SetupEMSActuator('Air Connection '//TRIM(LoopStr), UserCoil(CompLoop)%Name, &
'Mass Flow Rate', '[kg/s]', lDummy, &
UserCoil(CompLoop)%Air(ConnectionLoop)%OutletMassFlowRate)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(aArgCount),cAlphaArgs(aArgCount + 1), &
'Air Nodes '//LoopStr)
ENDDO
IF (.NOT. lAlphaFieldBlanks(8) ) THEN
SELECT CASE (cAlphaArgs(8) )
CASE ('YES')
UserCoil(CompLoop)%PlantIsConnected = .TRUE.
CASE ('NO')
UserCoil(CompLoop)%PlantIsConnected = .FALSE.
END SELECT
ELSE
UserCoil(CompLoop)%PlantIsConnected = .FALSE.
ENDIF
IF (UserCoil(CompLoop)%PlantIsConnected) THEN ! get input
UserCoil(CompLoop)%Loop%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(9),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Inlet, 2, ObjectIsNotParent)
UserCoil(CompLoop)%Loop%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(10),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Outlet, 2, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(9),cAlphaArgs(10),'Plant Nodes')
! this model is only for plant connections that are "Demand"
UserCoil(CompLoop)%Loop%HowLoadServed = HowMet_NoneDemand
! this model is only for plant connections that are needy and turn loop on
UserCoil(CompLoop)%Loop%FlowPriority = LoopFlowStatus_NeedyAndTurnsLoopOn
!Setup Internal Variables
!model input related internal variables
CALL SetupEMSInternalVariable( 'Inlet Temperature for Plant Connection' , UserCoil(CompLoop)%Name, '[C]', &
UserCoil(CompLoop)%Loop%InletTemp )
CALL SetupEMSInternalVariable( 'Inlet Mass Flow Rate for Plant Connection' , UserCoil(CompLoop)%Name, '[kg/s]', &
UserCoil(CompLoop)%Loop%InletMassFlowRate )
CALL SetupEMSInternalVariable( 'Inlet Density for Plant Connection' , UserCoil(CompLoop)%Name, '[kg/m3]', &
UserCoil(CompLoop)%Loop%InletRho )
CALL SetupEMSInternalVariable( 'Inlet Specific Heat for Plant Connection' , UserCoil(CompLoop)%Name, '[J/kg-C]', &
UserCoil(CompLoop)%Loop%InletCp )
! model results related actuators
CALL SetupEMSActuator('Plant Connection', UserCoil(CompLoop)%Name, &
'Outlet Temperature', '[C]', lDummy, &
UserCoil(CompLoop)%Loop%OutletTemp )
CALL SetupEMSActuator('Plant Connection', UserCoil(CompLoop)%Name, &
'Mass Flow Rate', '[kg/s]', lDummy, &
UserCoil(CompLoop)%Loop%MassFlowRateRequest)
! model initialization and sizing related actuators
CALL SetupEMSActuator('Plant Connection ', UserCoil(CompLoop)%Name, &
'Design Volume Flow Rate', '[m3/s]', lDummy, &
UserCoil(CompLoop)%Loop%DesignVolumeFlowRate)
CALL SetupEMSActuator('Plant Connection', UserCoil(CompLoop)%Name, &
'Minimum Mass Flow Rate', '[kg/s]', lDummy, &
UserCoil(CompLoop)%Loop%MassFlowRateMin)
CALL SetupEMSActuator('Plant Connection', UserCoil(CompLoop)%Name, &
'Maximum Mass Flow Rate', '[kg/s]', lDummy, &
UserCoil(CompLoop)%Loop%MassFlowRateMax)
ENDIF
IF (.NOT. lAlphaFieldBlanks(11) ) THEN
CALL SetupTankDemandComponent(cAlphaArgs(1), TRIM(cCurrentModuleObject), cAlphaArgs(11), ErrorsFound, &
UserCoil(CompLoop)%Water%SupplyTankID, UserCoil(CompLoop)%Water%SupplyTankDemandARRID)
UserCoil(CompLoop)%Water%SuppliedByWaterSystem = .TRUE.
CALL SetupEMSActuator('Water System', UserCoil(CompLoop)%Name, &
'Supplied Volume Flow Rate', '[m3/s]', lDummy, &
UserCoil(CompLoop)%Water%SupplyVdotRequest )
ENDIF
IF (.NOT. lAlphaFieldBlanks(12) ) THEN
CALL SetupTankSupplyComponent(cAlphaArgs(1), TRIM(cCurrentModuleObject), cAlphaArgs(12), ErrorsFound, &
UserCoil(CompLoop)%Water%CollectionTankID, UserCoil(CompLoop)%Water%CollectionTankSupplyARRID)
UserCoil(CompLoop)%Water%CollectsToWaterSystem = .TRUE.
CALL SetupEMSActuator('Water System', UserCoil(CompLoop)%Name, &
'Collected Volume Flow Rate', '[m3/s]', lDummy, &
UserCoil(CompLoop)%Water%CollectedVdot )
ENDIF
IF (.NOT. lAlphaFieldBlanks(13) ) THEN
UserCoil(CompLoop)%Zone%ZoneNum = FindItemInList(cAlphaArgs(13),Zone%Name,NumOfZones)
IF (UserCoil(CompLoop)%Zone%ZoneNum == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Ambient Zone Name not found = '//TRIM(cAlphaArgs(13)))
ErrorsFound = .TRUE.
ELSE
UserCoil(CompLoop)%Zone%DeviceHasInternalGains = .TRUE.
CALL SetupZoneInternalGain(UserCoil(CompLoop)%Zone%ZoneNum, &
TRIM(cCurrentModuleObject), &
TRIM(cAlphaArgs(1)), &
IntGainTypeOf_CoilUserDefined, &
ConvectionGainRate = UserCoil(CompLoop)%Zone%ConvectionGainRate, &
ReturnAirConvectionGainRate = UserCoil(CompLoop)%Zone%ReturnAirConvectionGainRate, &
ThermalRadiationGainRate = UserCoil(CompLoop)%Zone%ThermalRadiationGainRate, &
LatentGainRate = UserCoil(CompLoop)%Zone%LatentGainRate, &
ReturnAirLatentGainRate = UserCoil(CompLoop)%Zone%ReturnAirLatentGainRate, &
CarbonDioxideGainRate = UserCoil(CompLoop)%Zone%CarbonDioxideGainRate, &
GenericContamGainRate = UserCoil(CompLoop)%Zone%GenericContamGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserCoil(CompLoop)%Name, &
'Sensible Heat Gain Rate', '[W]', lDummy, &
UserCoil(CompLoop)%Zone%ConvectionGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserCoil(CompLoop)%Name, &
'Return Air Heat Sensible Gain Rate', '[W]', lDummy, &
UserCoil(CompLoop)%Zone%ReturnAirConvectionGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserCoil(CompLoop)%Name, &
'Thermal Radiation Heat Gain Rate', '[W]', lDummy, &
UserCoil(CompLoop)%Zone%ThermalRadiationGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserCoil(CompLoop)%Name, &
'Latent Heat Gain Rate', '[W]', lDummy, &
UserCoil(CompLoop)%Zone%LatentGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserCoil(CompLoop)%Name, &
'Return Air Latent Heat Gain Rate', '[W]', lDummy, &
UserCoil(CompLoop)%Zone%ReturnAirLatentGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserCoil(CompLoop)%Name, &
'Carbon Dioxide Gain Rate', '[W]', lDummy, &
UserCoil(CompLoop)%Zone%CarbonDioxideGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserCoil(CompLoop)%Name, &
'Gaseous Contaminant Gain Rate', '[W]', lDummy, &
UserCoil(CompLoop)%Zone%GenericContamGainRate )
ENDIF
ENDIF
ENDIF
ENDDO
ENDIF !NumUserCoils > 0
IF (ErrorsFound) THEN
CALL ShowFatalError('GetUserDefinedComponents: Errors found in processing '//TRIM(cCurrentModuleObject)//' input.')
ENDIF
cCurrentModuleObject = 'ZoneHVAC:ForcedAir:UserDefined'
NumUserZoneAir = GetNumObjectsFound(cCurrentModuleObject)
IF (NumUserZoneAir > 0) THEN
ALLOCATE(UserZoneAirHVAC(NumUserZoneAir))
ALLOCATE(CheckUserZoneAirName(NumUserZoneAir))
CheckUserZoneAirName = .TRUE.
DO CompLoop=1, NumUserZoneAir
CALL GetObjectItem(cCurrentModuleObject, CompLoop, cAlphaArgs, NumAlphas, rNumericArgs, &
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1), UserZoneAirHVAC%Name, CompLoop - 1, IsNotOK, IsBlank, TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
UserZoneAirHVAC(CompLoop)%Name = cAlphaArgs(1)
! now get program manager for model simulations
IF (.NOT. lAlphaFieldBlanks(2)) THEN
StackMngrNum = FindItemInList(cAlphaArgs(2), EMSProgramCallManager%Name, NumProgramCallManagers)
IF (StackMngrNum > 0) THEN ! found it
UserZoneAirHVAC(CompLoop)%ErlSimProgramMngr = StackMngrNum
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Program Manager Name not found.')
ErrorsFound = .TRUE.
ENDIF
ENDIF
! now get program manager for model initializations
IF (.NOT. lAlphaFieldBlanks(3)) THEN
StackMngrNum = FindItemInList(cAlphaArgs(3), EMSProgramCallManager%Name, NumProgramCallManagers)
IF (StackMngrNum > 0) THEN ! found it
UserZoneAirHVAC(CompLoop)%ErlInitProgramMngr = StackMngrNum
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(3))//'='//TRIM(cAlphaArgs(3)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Program Manager Name not found.')
ErrorsFound = .TRUE.
ENDIF
ENDIF
UserZoneAirHVAC(CompLoop)%ZoneAir%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),UserZoneAirHVAC(CompLoop)%Name, &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
!model input related internal variables
CALL SetupEMSInternalVariable( 'Inlet Temperature for Primary Air Connection' , UserZoneAirHVAC(CompLoop)%Name, &
'[C]', UserZoneAirHVAC(CompLoop)%ZoneAir%InletTemp )
CALL SetupEMSInternalVariable( 'Inlet Humidity Ratio for Primary Air Connection' , UserZoneAirHVAC(CompLoop)%Name, &
'[kgWater/kgDryAir]', UserZoneAirHVAC(CompLoop)%ZoneAir%InletHumRat )
CALL SetupEMSInternalVariable( 'Inlet Density for Primary Air Connection', UserZoneAirHVAC(CompLoop)%Name, &
'[kg/m3]', UserZoneAirHVAC(CompLoop)%ZoneAir%InletRho )
CALL SetupEMSInternalVariable( 'Inlet Specific Heat for Primary Air Connection' , UserZoneAirHVAC(CompLoop)%Name, &
'[J/kg-C]', UserZoneAirHVAC(CompLoop)%ZoneAir%InletCp )
CALL SetupEMSInternalVariable( 'Remaining Sensible Load to Heating Setpoint' , UserZoneAirHVAC(CompLoop)%Name, &
'[W]', UserZoneAirHVAC(CompLoop)%RemainingOutputToHeatingSP )
CALL SetupEMSInternalVariable( 'Remaining Sensible Load to Cooling Setpoint' , UserZoneAirHVAC(CompLoop)%Name, &
'[W]', UserZoneAirHVAC(CompLoop)%RemainingOutputToCoolingSP )
CALL SetupEMSInternalVariable( 'Remaining Latent Load to Humidifying Setpoint' , UserZoneAirHVAC(CompLoop)%Name, &
'[kg/s]', UserZoneAirHVAC(CompLoop)%RemainingOutputReqToHumidSP )
CALL SetupEMSInternalVariable( 'Remaining Latent Load to Dehumidifying Setpoint' , UserZoneAirHVAC(CompLoop)%Name, &
'[kg/s]', UserZoneAirHVAC(CompLoop)%RemainingOutputReqToDehumidSP )
CALL SetupEMSActuator('Primary Air Connection', UserZoneAirHVAC(CompLoop)%Name, &
'Inlet Mass Flow Rate', '[kg/s]', lDummy, &
UserZoneAirHVAC(CompLoop)%ZoneAir%InletMassFlowRate)
UserZoneAirHVAC(CompLoop)%ZoneAir%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),UserZoneAirHVAC(CompLoop)%Name, &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
CALL SetupEMSActuator('Primary Air Connection', UserZoneAirHVAC(CompLoop)%Name, &
'Outlet Temperature', '[C]', lDummy, &
UserZoneAirHVAC(CompLoop)%ZoneAir%OutletTemp )
CALL SetupEMSActuator('Primary Air Connection', UserZoneAirHVAC(CompLoop)%Name, &
'Outlet Humidity Ratio', '[kgWater/kgDryAir]', lDummy, &
UserZoneAirHVAC(CompLoop)%ZoneAir%OutletHumRat )
CALL SetupEMSActuator('Primary Air Connection', UserZoneAirHVAC(CompLoop)%Name, &
'Outlet Mass Flow Rate', '[kg/s]', lDummy, &
UserZoneAirHVAC(CompLoop)%ZoneAir%OutletMassFlowRate)
IF (.NOT. lAlphaFieldBlanks(6) ) THEN
UserZoneAirHVAC(CompLoop)%SourceAir%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(6),ErrorsFound,TRIM(cCurrentModuleObject),UserZoneAirHVAC(CompLoop)%Name, &
NodeType_Air,NodeConnectionType_Inlet,2,ObjectIsNotParent)
!model input related internal variables
CALL SetupEMSInternalVariable( 'Inlet Temperature for Secondary Air Connection' , UserZoneAirHVAC(CompLoop)%Name, &
'[C]', UserZoneAirHVAC(CompLoop)%SourceAir%InletTemp )
CALL SetupEMSInternalVariable( 'Inlet Humidity Ratio for Secondary Air Connection' , UserZoneAirHVAC(CompLoop)%Name, &
'[kgWater/kgDryAir]', UserZoneAirHVAC(CompLoop)%SourceAir%InletHumRat )
CALL SetupEMSInternalVariable( 'Inlet Density for Secondary Air Connection', UserZoneAirHVAC(CompLoop)%Name, &
'[kg/m3]', UserZoneAirHVAC(CompLoop)%SourceAir%InletRho )
CALL SetupEMSInternalVariable( 'Inlet Specific Heat for Secondary Air Connection' , UserZoneAirHVAC(CompLoop)%Name, &
'[J/kg-C]', UserZoneAirHVAC(CompLoop)%SourceAir%InletCp )
CALL SetupEMSActuator('Secondary Air Connection', UserZoneAirHVAC(CompLoop)%Name, &
'Inlet Mass Flow Rate', '[kg/s]', lDummy, &
UserZoneAirHVAC(CompLoop)%SourceAir%InletMassFlowRate)
ENDIF
IF (.NOT. lAlphaFieldBlanks(7) ) THEN
UserZoneAirHVAC(CompLoop)%SourceAir%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(7),ErrorsFound,TRIM(cCurrentModuleObject),UserZoneAirHVAC(CompLoop)%Name, &
NodeType_Air,NodeConnectionType_Outlet,2,ObjectIsNotParent)
CALL SetupEMSActuator('Secondary Air Connection', UserZoneAirHVAC(CompLoop)%Name, &
'Outlet Temperature', '[C]', lDummy, &
UserZoneAirHVAC(CompLoop)%SourceAir%OutletTemp )
CALL SetupEMSActuator('Secondary Air Connection', UserZoneAirHVAC(CompLoop)%Name, &
'Outlet Humidity Ratio', '[kgWater/kgDryAir]', lDummy, &
UserZoneAirHVAC(CompLoop)%SourceAir%OutletHumRat )
CALL SetupEMSActuator('Secondary Air Connection', UserZoneAirHVAC(CompLoop)%Name, &
'Mass Flow Rate', '[kg/s]', lDummy, &
UserZoneAirHVAC(CompLoop)%SourceAir%OutletMassFlowRate)
ENDIF
IF ((UserZoneAirHVAC(CompLoop)%SourceAir%InletNodeNum > 0) .and. &
(UserZoneAirHVAC(CompLoop)%SourceAir%OutletNodeNum > 0) ) THEN
! CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(6),cAlphaArgs(7),'Air Nodes')
ENDIF
NumPlantConnections = FLOOR(rNumericArgs(1))
UserZoneAirHVAC(CompLoop)%NumPlantConnections =NumPlantConnections
IF ((NumPlantConnections >= 1) .AND. (NumPlantConnections <= 3)) THEN
ALLOCATE(UserZoneAirHVAC(CompLoop)%Loop(NumPlantConnections))
DO ConnectionLoop = 1, NumPlantConnections
aArgCount = (ConnectionLoop-1) * 2 + 8
UserZoneAirHVAC(CompLoop)%Loop(ConnectionLoop)%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(aArgCount),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Inlet, (ConnectionLoop+2), ObjectIsNotParent)
UserZoneAirHVAC(CompLoop)%Loop(ConnectionLoop)%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(aArgCount + 1),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Outlet, (ConnectionLoop+2), ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(aArgCount),cAlphaArgs(aArgCount + 1),'Plant Nodes')
UserZoneAirHVAC(CompLoop)%Loop(ConnectionLoop)%HowLoadServed = HowMet_NoneDemand
UserZoneAirHVAC(CompLoop)%Loop(ConnectionLoop)%FlowPriority = LoopFlowStatus_NeedyAndTurnsLoopOn
!Setup Internal Variables
WRITE(LoopStr,*) ConnectionLoop
LoopStr = ADJUSTL(LoopStr)
!model input related internal variables
CALL SetupEMSInternalVariable( 'Inlet Temperature for Plant Connection '//TRIM(LoopStr) , &
UserZoneAirHVAC(CompLoop)%Name, '[C]', &
UserZoneAirHVAC(CompLoop)%Loop(ConnectionLoop)%InletTemp )
CALL SetupEMSInternalVariable( 'Inlet Mass Flow Rate for Plant Connection '//TRIM(LoopStr) , &
UserZoneAirHVAC(CompLoop)%Name, '[kg/s]', &
UserZoneAirHVAC(CompLoop)%Loop(ConnectionLoop)%InletMassFlowRate )
CALL SetupEMSInternalVariable( 'Inlet Density for Plant Connection '//TRIM(LoopStr) , &
UserZoneAirHVAC(CompLoop)%Name, '[kg/m3]', &
UserZoneAirHVAC(CompLoop)%Loop(ConnectionLoop)%InletRho )
CALL SetupEMSInternalVariable( 'Inlet Specific Heat for Plant Connection '//TRIM(LoopStr) , &
UserZoneAirHVAC(CompLoop)%Name, '[J/kg-C]', &
UserZoneAirHVAC(CompLoop)%Loop(ConnectionLoop)%InletCp )
! model results related actuators
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserZoneAirHVAC(CompLoop)%Name, &
'Outlet Temperature', '[C]', lDummy, &
UserZoneAirHVAC(CompLoop)%Loop(ConnectionLoop)%OutletTemp )
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserZoneAirHVAC(CompLoop)%Name, &
'Mass Flow Rate', '[kg/s]', lDummy, &
UserZoneAirHVAC(CompLoop)%Loop(ConnectionLoop)%MassFlowRateRequest)
! model initialization and sizing related actuators
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserZoneAirHVAC(CompLoop)%Name, &
'Minimum Mass Flow Rate', '[kg/s]', lDummy, &
UserZoneAirHVAC(CompLoop)%Loop(ConnectionLoop)%MassFlowRateMin)
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserZoneAirHVAC(CompLoop)%Name, &
'Maximum Mass Flow Rate', '[kg/s]', lDummy, &
UserZoneAirHVAC(CompLoop)%Loop(ConnectionLoop)%MassFlowRateMax)
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserZoneAirHVAC(CompLoop)%Name, &
'Design Volume Flow Rate', '[m3/s]', lDummy, &
UserZoneAirHVAC(CompLoop)%Loop(ConnectionLoop)%DesignVolumeFlowRate)
ENDDO
ENDIF
IF (.NOT. lAlphaFieldBlanks(14) ) THEN
CALL SetupTankDemandComponent(cAlphaArgs(1), TRIM(cCurrentModuleObject), cAlphaArgs(14), ErrorsFound, &
UserZoneAirHVAC(CompLoop)%Water%SupplyTankID, UserZoneAirHVAC(CompLoop)%Water%SupplyTankDemandARRID)
UserZoneAirHVAC(CompLoop)%Water%SuppliedByWaterSystem = .TRUE.
CALL SetupEMSActuator('Water System', UserZoneAirHVAC(CompLoop)%Name, &
'Supplied Volume Flow Rate', '[m3/s]', lDummy, &
UserZoneAirHVAC(CompLoop)%Water%SupplyVdotRequest )
ENDIF
IF (.NOT. lAlphaFieldBlanks(15) ) THEN
CALL SetupTankSupplyComponent(cAlphaArgs(1), TRIM(cCurrentModuleObject), cAlphaArgs(15), ErrorsFound, &
UserZoneAirHVAC(CompLoop)%Water%CollectionTankID, &
UserZoneAirHVAC(CompLoop)%Water%CollectionTankSupplyARRID)
UserZoneAirHVAC(CompLoop)%Water%CollectsToWaterSystem = .TRUE.
CALL SetupEMSActuator('Water System', UserZoneAirHVAC(CompLoop)%Name, &
'Collected Volume Flow Rate', '[m3/s]', lDummy, &
UserZoneAirHVAC(CompLoop)%Water%CollectedVdot )
ENDIF
IF (.NOT. lAlphaFieldBlanks(16) ) THEN
UserZoneAirHVAC(CompLoop)%Zone%ZoneNum = FindItemInList(cAlphaArgs(16),Zone%Name,NumOfZones)
IF (UserZoneAirHVAC(CompLoop)%Zone%ZoneNum == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Ambient Zone Name not found = '//TRIM(cAlphaArgs(16)))
ErrorsFound = .TRUE.
ELSE
UserZoneAirHVAC(CompLoop)%Zone%DeviceHasInternalGains = .TRUE.
CALL SetupZoneInternalGain(UserZoneAirHVAC(CompLoop)%Zone%ZoneNum, &
TRIM(cCurrentModuleObject), &
TRIM(cAlphaArgs(1)), &
IntGainTypeOf_ZoneHVACForcedAirUserDefined, &
ConvectionGainRate = UserZoneAirHVAC(CompLoop)%Zone%ConvectionGainRate, &
ReturnAirConvectionGainRate = UserZoneAirHVAC(CompLoop)%Zone%ReturnAirConvectionGainRate, &
ThermalRadiationGainRate = UserZoneAirHVAC(CompLoop)%Zone%ThermalRadiationGainRate, &
LatentGainRate = UserZoneAirHVAC(CompLoop)%Zone%LatentGainRate, &
ReturnAirLatentGainRate = UserZoneAirHVAC(CompLoop)%Zone%ReturnAirLatentGainRate, &
CarbonDioxideGainRate = UserZoneAirHVAC(CompLoop)%Zone%CarbonDioxideGainRate, &
GenericContamGainRate = UserZoneAirHVAC(CompLoop)%Zone%GenericContamGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserZoneAirHVAC(CompLoop)%Name, &
'Sensible Heat Gain Rate', '[W]', lDummy, &
UserZoneAirHVAC(CompLoop)%Zone%ConvectionGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserZoneAirHVAC(CompLoop)%Name, &
'Return Air Heat Sensible Gain Rate', '[W]', lDummy, &
UserZoneAirHVAC(CompLoop)%Zone%ReturnAirConvectionGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserZoneAirHVAC(CompLoop)%Name, &
'Thermal Radiation Heat Gain Rate', '[W]', lDummy, &
UserZoneAirHVAC(CompLoop)%Zone%ThermalRadiationGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserZoneAirHVAC(CompLoop)%Name, &
'Latent Heat Gain Rate', '[W]', lDummy, &
UserZoneAirHVAC(CompLoop)%Zone%LatentGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserZoneAirHVAC(CompLoop)%Name, &
'Return Air Latent Heat Gain Rate', '[W]', lDummy, &
UserZoneAirHVAC(CompLoop)%Zone%ReturnAirLatentGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserZoneAirHVAC(CompLoop)%Name, &
'Carbon Dioxide Gain Rate', '[m3/s]', lDummy, &
UserZoneAirHVAC(CompLoop)%Zone%CarbonDioxideGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserZoneAirHVAC(CompLoop)%Name, &
'Gaseous Contaminant Gain Rate', '[m3/s]', lDummy, &
UserZoneAirHVAC(CompLoop)%Zone%GenericContamGainRate )
ENDIF
ENDIF
ENDDO
ENDIF !NumUserZoneAir > 0
IF (ErrorsFound) THEN
CALL ShowFatalError('GetUserDefinedComponents: Errors found in processing '//TRIM(cCurrentModuleObject)//' input.')
ENDIF
cCurrentModuleObject = 'AirTerminal:SingleDuct:UserDefined'
NumUserAirTerminals = GetNumObjectsFound(cCurrentModuleObject)
IF (NumUserAirTerminals > 0) THEN
ALLOCATE(UserAirTerminal(NumUserAirTerminals))
ALLOCATE(CheckUserAirTerminal(NumUserAirTerminals))
CheckUserAirTerminal = .TRUE.
DO CompLoop=1, NumUserAirTerminals
CALL GetObjectItem(cCurrentModuleObject, CompLoop, cAlphaArgs, NumAlphas, rNumericArgs, &
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1), UserAirTerminal%Name, CompLoop - 1, IsNotOK, IsBlank, TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
UserAirTerminal(CompLoop)%Name = cAlphaArgs(1)
! now get program manager for model simulations
IF (.NOT. lAlphaFieldBlanks(2)) THEN
StackMngrNum = FindItemInList(cAlphaArgs(2), EMSProgramCallManager%Name, NumProgramCallManagers)
IF (StackMngrNum > 0) THEN ! found it
UserAirTerminal(CompLoop)%ErlSimProgramMngr = StackMngrNum
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Program Manager Name not found.')
ErrorsFound = .TRUE.
ENDIF
ENDIF
! now get program manager for model initializations
IF (.NOT. lAlphaFieldBlanks(3)) THEN
StackMngrNum = FindItemInList(cAlphaArgs(3), EMSProgramCallManager%Name, NumProgramCallManagers)
IF (StackMngrNum > 0) THEN ! found it
UserAirTerminal(CompLoop)%ErlInitProgramMngr = StackMngrNum
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(3))//'='//TRIM(cAlphaArgs(3)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Program Manager Name not found.')
ErrorsFound = .TRUE.
ENDIF
ENDIF
UserAirTerminal(CompLoop)%AirLoop%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),UserAirTerminal(CompLoop)%Name, &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent,cAlphaFieldNames(4))
!model input related internal variables
CALL SetupEMSInternalVariable( 'Inlet Temperature for Primary Air Connection' , UserAirTerminal(CompLoop)%Name, &
'[C]', UserAirTerminal(CompLoop)%AirLoop%InletTemp )
CALL SetupEMSInternalVariable( 'Inlet Humidity Ratio for Primary Air Connection' , UserAirTerminal(CompLoop)%Name, &
'[kgWater/kgDryAir]', UserAirTerminal(CompLoop)%AirLoop%InletHumRat )
CALL SetupEMSInternalVariable( 'Inlet Density for Primary Air Connection', UserAirTerminal(CompLoop)%Name, &
'[kg/m3]', UserAirTerminal(CompLoop)%AirLoop%InletRho )
CALL SetupEMSInternalVariable( 'Inlet Specific Heat for Primary Air Connection' , UserAirTerminal(CompLoop)%Name, &
'[J/kg-C]', UserAirTerminal(CompLoop)%AirLoop%InletCp )
CALL SetupEMSInternalVariable( 'Remaining Sensible Load to Heating Setpoint' , UserAirTerminal(CompLoop)%Name, &
'[W]', UserAirTerminal(CompLoop)%RemainingOutputToHeatingSP )
CALL SetupEMSInternalVariable( 'Remaining Sensible Load to Cooling Setpoint' , UserAirTerminal(CompLoop)%Name, &
'[W]', UserAirTerminal(CompLoop)%RemainingOutputToCoolingSP )
CALL SetupEMSInternalVariable( 'Remaining Latent Load to Humidifying Setpoint' , UserAirTerminal(CompLoop)%Name, &
'[kg/s]', UserAirTerminal(CompLoop)%RemainingOutputReqToHumidSP )
CALL SetupEMSInternalVariable( 'Remaining Latent Load to Dehumidifying Setpoint' , UserAirTerminal(CompLoop)%Name, &
'[kg/s]', UserAirTerminal(CompLoop)%RemainingOutputReqToDehumidSP )
CALL SetupEMSActuator('Primary Air Connection', UserAirTerminal(CompLoop)%Name, &
'Inlet Mass Flow Rate', '[kg/s]', lDummy, &
UserAirTerminal(CompLoop)%AirLoop%InletMassFlowRate)
UserAirTerminal(CompLoop)%AirLoop%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),UserAirTerminal(CompLoop)%Name, &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent,cAlphaFieldNames(5))
CALL SetupEMSActuator('Primary Air Connection', UserAirTerminal(CompLoop)%Name, &
'Outlet Temperature', '[C]', lDummy, &
UserAirTerminal(CompLoop)%AirLoop%OutletTemp )
CALL SetupEMSActuator('Primary Air Connection', UserAirTerminal(CompLoop)%Name, &
'Outlet Humidity Ratio', '[kgWater/kgDryAir]', lDummy, &
UserAirTerminal(CompLoop)%AirLoop%OutletHumRat )
CALL SetupEMSActuator('Primary Air Connection', UserAirTerminal(CompLoop)%Name, &
'Outlet Mass Flow Rate', '[kg/s]', lDummy, &
UserAirTerminal(CompLoop)%AirLoop%OutletMassFlowRate)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(4),cAlphaArgs(5),'Air Nodes')
! Fill the Zone Equipment data with the inlet node number of this unit.
DO CtrlZone = 1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZone)%IsControlled) CYCLE
DO SupAirIn = 1,ZoneEquipConfig(CtrlZone)%NumInletNodes
IF (UserAirTerminal(CompLoop)%AirLoop%OutletNodeNum == 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(UserAirTerminal(CompLoop)%AirLoop%OutletNodeNum)) &
//' already connects to another zone')
CALL ShowContinueError('Occurs for terminal unit '//TRIM(cCurrentModuleObject)//' = ' &
//TRIM(UserAirTerminal(CompLoop)%Name))
CALL ShowContinueError('Check terminal unit node names for errors')
ErrorsFound = .true.
ELSE
ZoneEquipConfig(CtrlZone)%AirDistUnitCool(SupAirIn)%InNode = UserAirTerminal(CompLoop)%AirLoop%InletNodeNum
ZoneEquipConfig(CtrlZone)%AirDistUnitCool(SupAirIn)%OutNode = UserAirTerminal(CompLoop)%AirLoop%OutletNodeNum
END IF
UserAirTerminal(CompLoop)%ActualCtrlZoneNum = CtrlZone
END IF
END DO
END DO
IF (.NOT. lAlphaFieldBlanks(6) ) THEN
UserAirTerminal(CompLoop)%SourceAir%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(6),ErrorsFound,TRIM(cCurrentModuleObject),UserAirTerminal(CompLoop)%Name, &
NodeType_Air,NodeConnectionType_Inlet,2,ObjectIsNotParent,cAlphaFieldNames(6))
!model input related internal variables
CALL SetupEMSInternalVariable( 'Inlet Temperature for Secondary Air Connection' , UserAirTerminal(CompLoop)%Name, &
'[C]', UserAirTerminal(CompLoop)%SourceAir%InletTemp )
CALL SetupEMSInternalVariable( 'Inlet Humidity Ratio for Secondary Air Connection' , UserAirTerminal(CompLoop)%Name, &
'[kgWater/kgDryAir]', UserAirTerminal(CompLoop)%SourceAir%InletHumRat )
CALL SetupEMSInternalVariable( 'Inlet Density for Secondary Air Connection', UserAirTerminal(CompLoop)%Name, &
'[kg/m3]', UserAirTerminal(CompLoop)%SourceAir%InletRho )
CALL SetupEMSInternalVariable( 'Inlet Specific Heat for Secondary Air Connection' , UserAirTerminal(CompLoop)%Name, &
'[J/kg-C]', UserAirTerminal(CompLoop)%SourceAir%InletCp )
CALL SetupEMSActuator('Secondary Air Connection', UserAirTerminal(CompLoop)%Name, &
'Inlet Mass Flow Rate', '[kg/s]', lDummy, &
UserAirTerminal(CompLoop)%SourceAir%InletMassFlowRate)
ENDIF
IF (.NOT. lAlphaFieldBlanks(7) ) THEN
UserAirTerminal(CompLoop)%SourceAir%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(7),ErrorsFound,TRIM(cCurrentModuleObject),UserAirTerminal(CompLoop)%Name, &
NodeType_Air,NodeConnectionType_Outlet,2,ObjectIsNotParent,cAlphaFieldNames(7))
CALL SetupEMSActuator('Secondary Air Connection', UserAirTerminal(CompLoop)%Name, &
'Outlet Temperature', '[C]', lDummy, &
UserAirTerminal(CompLoop)%SourceAir%OutletTemp )
CALL SetupEMSActuator('Secondary Air Connection', UserAirTerminal(CompLoop)%Name, &
'Outlet Humidity Ratio', '[kgWater/kgDryAir]', lDummy, &
UserAirTerminal(CompLoop)%SourceAir%OutletHumRat )
CALL SetupEMSActuator('Secondary Air Connection', UserAirTerminal(CompLoop)%Name, &
'Mass Flow Rate', '[kg/s]', lDummy, &
UserAirTerminal(CompLoop)%SourceAir%OutletMassFlowRate)
ENDIF
IF ((UserAirTerminal(CompLoop)%SourceAir%InletNodeNum > 0) .and. &
(UserAirTerminal(CompLoop)%SourceAir%OutletNodeNum > 0) ) THEN
! CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(6),cAlphaArgs(7),'Air Nodes')
ENDIF
NumPlantConnections = FLOOR(rNumericArgs(1))
UserAirTerminal(CompLoop)%NumPlantConnections =NumPlantConnections
IF ((NumPlantConnections >= 1) .AND. (NumPlantConnections <= 2)) THEN
ALLOCATE(UserAirTerminal(CompLoop)%Loop(NumPlantConnections))
DO ConnectionLoop = 1, NumPlantConnections
aArgCount = (ConnectionLoop-1) * 2 + 8
UserAirTerminal(CompLoop)%Loop(ConnectionLoop)%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(aArgCount),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Inlet, (ConnectionLoop+2), ObjectIsNotParent,cAlphaFieldNames(aArgCount))
UserAirTerminal(CompLoop)%Loop(ConnectionLoop)%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(aArgCount + 1),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Outlet, (ConnectionLoop+2), ObjectIsNotParent,cAlphaFieldNames(aArgCount+1))
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(aArgCount),cAlphaArgs(aArgCount + 1),'Plant Nodes')
UserAirTerminal(CompLoop)%Loop(ConnectionLoop)%HowLoadServed = HowMet_NoneDemand
UserAirTerminal(CompLoop)%Loop(ConnectionLoop)%FlowPriority = LoopFlowStatus_NeedyAndTurnsLoopOn
!Setup Internal Variables
LoopStr = RoundSigDigits(ConnectionLoop)
!model input related internal variables
CALL SetupEMSInternalVariable( 'Inlet Temperature for Plant Connection '//TRIM(LoopStr) , &
UserAirTerminal(CompLoop)%Name, '[C]', &
UserAirTerminal(CompLoop)%Loop(ConnectionLoop)%InletTemp )
CALL SetupEMSInternalVariable( 'Inlet Mass Flow Rate for Plant Connection '//TRIM(LoopStr) , &
UserAirTerminal(CompLoop)%Name, '[kg/s]', &
UserAirTerminal(CompLoop)%Loop(ConnectionLoop)%InletMassFlowRate )
CALL SetupEMSInternalVariable( 'Inlet Density for Plant Connection '//TRIM(LoopStr) , &
UserAirTerminal(CompLoop)%Name, '[kg/m3]', &
UserAirTerminal(CompLoop)%Loop(ConnectionLoop)%InletRho )
CALL SetupEMSInternalVariable( 'Inlet Specific Heat for Plant Connection '//TRIM(LoopStr) , &
UserAirTerminal(CompLoop)%Name, '[J/kg-C]', &
UserAirTerminal(CompLoop)%Loop(ConnectionLoop)%InletCp )
! model results related actuators
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserAirTerminal(CompLoop)%Name, &
'Outlet Temperature', '[C]', lDummy, &
UserAirTerminal(CompLoop)%Loop(ConnectionLoop)%OutletTemp )
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserAirTerminal(CompLoop)%Name, &
'Mass Flow Rate', '[kg/s]', lDummy, &
UserAirTerminal(CompLoop)%Loop(ConnectionLoop)%MassFlowRateRequest)
! model initialization and sizing related actuators
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserAirTerminal(CompLoop)%Name, &
'Minimum Mass Flow Rate', '[kg/s]', lDummy, &
UserAirTerminal(CompLoop)%Loop(ConnectionLoop)%MassFlowRateMin)
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserAirTerminal(CompLoop)%Name, &
'Maximum Mass Flow Rate', '[kg/s]', lDummy, &
UserAirTerminal(CompLoop)%Loop(ConnectionLoop)%MassFlowRateMax)
CALL SetupEMSActuator('Plant Connection '//TRIM(LoopStr), UserAirTerminal(CompLoop)%Name, &
'Design Volume Flow Rate', '[m3/s]', lDummy, &
UserAirTerminal(CompLoop)%Loop(ConnectionLoop)%DesignVolumeFlowRate)
ENDDO
ENDIF
IF (.NOT. lAlphaFieldBlanks(12) ) THEN
CALL SetupTankDemandComponent(cAlphaArgs(1), TRIM(cCurrentModuleObject), cAlphaArgs(12), ErrorsFound, &
UserAirTerminal(CompLoop)%Water%SupplyTankID, UserAirTerminal(CompLoop)%Water%SupplyTankDemandARRID)
UserAirTerminal(CompLoop)%Water%SuppliedByWaterSystem = .TRUE.
CALL SetupEMSActuator('Water System', UserAirTerminal(CompLoop)%Name, &
'Supplied Volume Flow Rate', '[m3/s]', lDummy, &
UserAirTerminal(CompLoop)%Water%SupplyVdotRequest )
ENDIF
IF (.NOT. lAlphaFieldBlanks(13) ) THEN
CALL SetupTankSupplyComponent(cAlphaArgs(1), TRIM(cCurrentModuleObject), cAlphaArgs(13), ErrorsFound, &
UserAirTerminal(CompLoop)%Water%CollectionTankID, &
UserAirTerminal(CompLoop)%Water%CollectionTankSupplyARRID)
UserAirTerminal(CompLoop)%Water%CollectsToWaterSystem = .TRUE.
CALL SetupEMSActuator('Water System', UserAirTerminal(CompLoop)%Name, &
'Collected Volume Flow Rate', '[m3/s]', lDummy, &
UserAirTerminal(CompLoop)%Water%CollectedVdot )
ENDIF
IF (.NOT. lAlphaFieldBlanks(14) ) THEN
UserAirTerminal(CompLoop)%Zone%ZoneNum = FindItemInList(cAlphaArgs(14),Zone%Name,NumOfZones)
IF (UserZoneAirHVAC(CompLoop)%Zone%ZoneNum == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Ambient Zone Name not found = '//TRIM(cAlphaArgs(16)))
ErrorsFound = .TRUE.
ELSE
UserAirTerminal(CompLoop)%Zone%DeviceHasInternalGains = .TRUE.
CALL SetupZoneInternalGain(UserAirTerminal(CompLoop)%Zone%ZoneNum, &
TRIM(cCurrentModuleObject), &
TRIM(cAlphaArgs(1)), &
IntGainTypeOf_AirTerminalUserDefined, &
ConvectionGainRate = UserAirTerminal(CompLoop)%Zone%ConvectionGainRate, &
ReturnAirConvectionGainRate = UserAirTerminal(CompLoop)%Zone%ReturnAirConvectionGainRate, &
ThermalRadiationGainRate = UserAirTerminal(CompLoop)%Zone%ThermalRadiationGainRate, &
LatentGainRate = UserAirTerminal(CompLoop)%Zone%LatentGainRate, &
ReturnAirLatentGainRate = UserAirTerminal(CompLoop)%Zone%ReturnAirLatentGainRate, &
CarbonDioxideGainRate = UserAirTerminal(CompLoop)%Zone%CarbonDioxideGainRate, &
GenericContamGainRate = UserAirTerminal(CompLoop)%Zone%GenericContamGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserAirTerminal(CompLoop)%Name, &
'Sensible Heat Gain Rate', '[W]', lDummy, &
UserAirTerminal(CompLoop)%Zone%ConvectionGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserAirTerminal(CompLoop)%Name, &
'Return Air Heat Sensible Gain Rate', '[W]', lDummy, &
UserZoneAirHVAC(CompLoop)%Zone%ReturnAirConvectionGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserAirTerminal(CompLoop)%Name, &
'Thermal Radiation Heat Gain Rate', '[W]', lDummy, &
UserAirTerminal(CompLoop)%Zone%ThermalRadiationGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserAirTerminal(CompLoop)%Name, &
'Latent Heat Gain Rate', '[W]', lDummy, &
UserAirTerminal(CompLoop)%Zone%LatentGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserAirTerminal(CompLoop)%Name, &
'Return Air Latent Heat Gain Rate', '[W]', lDummy, &
UserAirTerminal(CompLoop)%Zone%ReturnAirLatentGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserAirTerminal(CompLoop)%Name, &
'Carbon Dioxide Gain Rate', '[W]', lDummy, &
UserAirTerminal(CompLoop)%Zone%CarbonDioxideGainRate )
CALL SetupEMSActuator('Component Zone Internal Gain', UserAirTerminal(CompLoop)%Name, &
'Gaseous Contaminant Gain Rate', '[W]', lDummy, &
UserAirTerminal(CompLoop)%Zone%GenericContamGainRate )
ENDIF
ENDIF
ENDDO
ENDIF !NumUserZoneAir > 0
IF (ErrorsFound) THEN
CALL ShowFatalError('GetUserDefinedComponents: Errors found in processing '//TRIM(cCurrentModuleObject)//' input.')
ENDIF
RETURN
END SUBROUTINE GetUserDefinedComponents