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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | IUNum |
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 SizeIndUnit(IUNum)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN June 22 2004
! MODIFIED August 2013 Daeho Kang, add component sizing table entries
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for sizing induction terminal units for which flow rates have not been
! specified in the input
! METHODOLOGY EMPLOYED:
! Accesses zone sizing array for air flow rates and zone and plant sizing arrays to
! calculate coil water flow rates.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSizing
USE InputProcessor
USE WaterCoils, ONLY: SetCoilDesFlow, GetCoilWaterInletNode, GetCoilWaterOutletNode
! USE BranchInputManager, ONLY: MyPlantSizingIndex
USE ReportSizingManager, ONLY: ReportSizingOutput
USE FluidProperties, ONLY: GetDensityGlycol, GetSpecificHeatGlycol
USE DataPlant, ONLY: PlantLoop, MyPlantSizingIndex
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
Integer, Intent(IN) :: IUNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: PltSizHeatNum ! index of plant sizing object for 1st heating loop
INTEGER :: PltSizCoolNum ! index of plant sizing object for 1st cooling loop
REAL(r64) :: DesCoilLoad
REAL(r64) :: DesPriVolFlow
REAL(r64) :: RhoAir
REAL(r64) :: CpAir
INTEGER :: CoilWaterInletNode=0
INTEGER :: CoilWaterOutletNode=0
LOGICAL :: ErrorsFound
REAL(r64) :: Cp ! local fluid specific heat
REAL(r64) :: rho ! local fluid density
LOGICAL :: IsAutosize
REAL(r64) :: MaxTotAirVolFlowDes ! Desing size maximum air volume flow for reproting
REAL(r64) :: MaxTotAirVolFlowUser ! User hard-sized maximum air volume flow for reporting
REAL(r64) :: MaxVolHotWaterFlowDes ! Desing size maximum hot water flow for reproting
REAL(r64) :: MaxVolHotWaterFlowUser ! User hard-sized maximum hot water flow for reporting
REAL(r64) :: MaxVolColdWaterFlowDes ! Desing size maximum cold water flow for reproting
REAL(r64) :: MaxVolColdWaterFlowUser ! User hard-sized maximum cold water flow for reporting
PltSizHeatNum = 0
PltSizCoolNum = 0
DesPriVolFlow = 0.0d0
CpAir = 0.0d0
RhoAir = StdRhoAir
ErrorsFound = .FALSE.
IsAutosize = .FALSE.
MaxTotAirVolFlowDes = 0.0d0
MaxTotAirVolFlowUser = 0.0d0
MaxVolHotWaterFlowDes = 0.0d0
MaxVolHotWaterFlowUser = 0.0d0
MaxVolColdWaterFlowDes = 0.0d0
MaxVolColdWaterFlowUser = 0.0d0
IF (IndUnit(IUNum)%MaxTotAirVolFlow == AutoSize) THEN
IsAutosize = .TRUE.
END IF
IF (CurZoneEqNum > 0) THEN
IF (.NOT. IsAutosize .AND. .NOT. ZoneSizingRunDone) THEN ! simulation continue
IF (IndUnit(IUNum)%MaxTotAirVolFlow > 0.0d0) THEN
CALL ReportSizingOutput(IndUnit(IUNum)%UnitType, IndUnit(IUNum)%Name, &
'User-Specified Maximum Total Air Flow Rate [m3/s]', IndUnit(IUNum)%MaxTotAirVolFlow)
END IF
ELSE
CALL CheckZoneSizing(IndUnit(IUNum)%UnitType, IndUnit(IUNum)%Name)
MaxTotAirVolFlowDes = MAX(TermUnitFinalZoneSizing(CurZoneEqNum)%DesCoolVolFlow, &
TermUnitFinalZoneSizing(CurZoneEqNum)%DesHeatVolFlow)
IF (MaxTotAirVolFlowDes < SmallAirVolFlow) THEN
MaxTotAirVolFlowDes = 0.0d0
END IF
IF (IsAutosize) THEN
IndUnit(IUNum)%MaxTotAirVolFlow = MaxTotAirVolFlowDes
CALL ReportSizingOutput(IndUnit(IUNum)%UnitType, IndUnit(IUNum)%Name, &
'Design Size Maximum Total Air Flow Rate [m3/s]', MaxTotAirVolFlowDes)
ELSE
IF (IndUnit(IUNum)%MaxTotAirVolFlow > 0.0d0 .AND. MaxTotAirVolFlowDes > 0.0d0) THEN
MaxTotAirVolFlowUser = IndUnit(IUNum)%MaxTotAirVolFlow
CALL ReportSizingOutput(IndUnit(IUNum)%UnitType, IndUnit(IUNum)%Name, &
'Design Size Maximum Total Air Flow Rate [m3/s]', MaxTotAirVolFlowDes, &
'User-Specified Maximum Total Air Flow Rate [m3/s]', MaxTotAirVolFlowUser)
IF (DisplayExtraWarnings) THEN
IF ((ABS(MaxTotAirVolFlowDes - MaxTotAirVolFlowUser)/MaxTotAirVolFlowUser) > AutoVsHardSizingThreshold) THEN
CALL ShowMessage('SizeHVACSingleDuctInduction: Potential issue with equipment sizing for ' &
// TRIM(IndUnit(IUNum)%UnitType)//' = "'//TRIM(IndUnit(IUNum)%Name)//'".')
CALL ShowContinueError('User-Specified Maximum Total Air Flow Rate of '// &
TRIM(RoundSigDigits(MaxTotAirVolFlowUser,5))// ' [m3/s]')
CALL ShowContinueError('differs from Design Size Maximum Total Air Flow Rate of ' // &
TRIM(RoundSigDigits(MaxTotAirVolFlowDes,5))// ' [m3/s]')
CALL ShowContinueError('This may, or may not, indicate mismatched component sizes.')
CALL ShowContinueError('Verify that the value entered is intended and is consistent with other components.')
END IF
ENDIF
END IF
END IF
END IF
END IF
IsAutosize = .FALSE.
IF (IndUnit(IUNum)%MaxVolHotWaterFlow == AutoSize) THEN
IsAutosize = .TRUE.
END IF
IF (CurZoneEqNum > 0) THEN
IF (.NOT. IsAutosize .AND. .NOT. ZoneSizingRunDone) THEN ! simulation continue
IF (IndUnit(IUNum)%MaxVolHotWaterFlow > 0.0d0) THEN
CALL ReportSizingOutput(IndUnit(IUNum)%UnitType, IndUnit(IUNum)%Name, &
'User-Specified Maximum Hot Water Flow Rate [m3/s]', IndUnit(IUNum)%MaxVolHotWaterFlow)
END IF
ELSE
CALL CheckZoneSizing(IndUnit(IUNum)%UnitType, IndUnit(IUNum)%Name)
IF (SameString(IndUnit(IUNum)%HCoilType,'Coil:Heating:Water')) THEN
CoilWaterInletNode = GetCoilWaterInletNode('Coil:Heating:Water',IndUnit(IUNum)%HCoil,ErrorsFound)
CoilWaterOutletNode = GetCoilWaterOutletNode('Coil:Heating:Water',IndUnit(IUNum)%HCoil,ErrorsFound)
IF (IsAutosize) THEN
PltSizHeatNum = MyPlantSizingIndex('Coil:Heating:Water', IndUnit(IUNum)%HCoil, CoilWaterInletNode, &
CoilWaterOutletNode, ErrorsFound)
IF (PltSizHeatNum > 0) THEN
IF (TermUnitFinalZoneSizing(CurZoneEqNum)%DesHeatMassFlow >= SmallAirVolFlow) THEN
DesPriVolFlow = IndUnit(IUNum)%MaxTotAirVolFlow / (1.d0+IndUnit(IUNum)%InducRatio)
CpAir = PsyCpAirFnWTdb(TermUnitFinalZoneSizing(CurZoneEqNum)%HeatDesHumRat, &
TermUnitFinalZoneSizing(CurZoneEqNum)%HeatDesTemp)
! the design heating coil load is the zone load minus whatever the central system does. Note that
! DesHeatCoilInTempTU is really the primary air inlet temperature for the unit.
IF (TermUnitFinalZoneSizing(CurZoneEqNum)%ZoneTempAtHeatPeak > 0.0d0) THEN
DesCoilLoad = CalcFinalZoneSizing(CurZoneEqNum)%DesHeatLoad * CalcFinalZoneSizing(CurZoneEqNum)%HeatSizingFactor - &
CpAir*RhoAir*DesPriVolFlow* &
(TermUnitFinalZoneSizing(CurZoneEqNum)%DesHeatCoilInTempTU - &
TermUnitFinalZoneSizing(CurZoneEqNum)%ZoneTempAtHeatPeak)
ELSE
DesCoilLoad = CpAir*RhoAir*DesPriVolFlow*(ZoneSizThermSetPtLo(CurZoneEqNum) - &
TermUnitFinalZoneSizing(CurZoneEqNum)%DesHeatCoilInTempTU)
END IF
IndUnit(IUNum)%DesHeatingLoad = DesCoilLoad
Cp = GetSpecificHeatGlycol(PlantLoop(IndUnit(IUNum)%HWLoopNum)%FluidName, &
60.d0, &
PlantLoop(IndUnit(IUNum)%HWLoopNum)%FluidIndex, &
'SizeIndUnit' )
rho = GetDensityGlycol( PlantLoop(IndUnit(IUNum)%HWLoopNum)%FluidName, &
60.d0, &
PlantLoop(IndUnit(IUNum)%HWLoopNum)%FluidIndex, &
'SizeIndUnit' )
MaxVolHotWaterFlowDes = DesCoilLoad / &
( PlantSizData(PltSizHeatNum)%DeltaT * &
Cp * rho )
MaxVolHotWaterFlowDes = MAX(MaxVolHotWaterFlowDes,0.0d0)
ELSE
MaxVolHotWaterFlowDes = 0.0d0
END IF
ELSE
CALL ShowSevereError('Autosizing of water flow requires a heating loop Sizing:Plant object')
CALL ShowContinueError('Occurs in' // TRIM(IndUnit(IUNum)%UnitType) // ' Object='//TRIM(IndUnit(IUNum)%Name))
ErrorsFound = .TRUE.
END IF
END IF
IF (IsAutosize) THEN
IndUnit(IUNum)%MaxVolHotWaterFlow = MaxVolHotWaterFlowDes
CALL ReportSizingOutput(IndUnit(IUNum)%UnitType, IndUnit(IUNum)%Name, &
'Design Size Maximum Hot Water Flow Rate [m3/s]', MaxVolHotWaterFlowDes)
ELSE
IF (IndUnit(IUNum)%MaxVolHotWaterFlow > 0.0d0 .AND. MaxVolHotWaterFlowDes > 0.0d0) THEN
MaxVolHotWaterFlowUser = IndUnit(IUNum)%MaxVolHotWaterFlow
CALL ReportSizingOutput(IndUnit(IUNum)%UnitType, IndUnit(IUNum)%Name, &
'Design Size Maximum Hot Water Flow Rate [m3/s]', MaxVolHotWaterFlowDes, &
'User-Specified Maximum Hot Water Flow Rate [m3/s]', MaxVolHotWaterFlowUser)
IF (DisplayExtraWarnings) THEN
IF ((ABS(MaxVolHotWaterFlowDes - MaxVolHotWaterFlowUser)/MaxVolHotWaterFlowUser) > AutoVsHardSizingThreshold) THEN
CALL ShowMessage('SizeHVACSingleDuctInduction: Potential issue with equipment sizing for '// &
TRIM(IndUnit(IUNum)%UnitType)//' = "'//TRIM(IndUnit(IUNum)%Name)//'".')
CALL ShowContinueError('User-Specified Maximum Hot Water Flow Rate of '// &
TRIM(RoundSigDigits(MaxVolHotWaterFlowUser,5))// ' [m3/s]')
CALL ShowContinueError('differs from Design Size Maximum Hot Water Flow Rate of ' // &
TRIM(RoundSigDigits(MaxVolHotWaterFlowDes,5))// ' [m3/s]')
CALL ShowContinueError('This may, or may not, indicate mismatched component sizes.')
CALL ShowContinueError('Verify that the value entered is intended and is consistent with other components.')
END IF
ENDIF
END IF
END IF
ELSE
IndUnit(IUNum)%MaxVolHotWaterFlow = 0.0d0
END IF
END IF
END IF
IsAutosize = .FALSE.
IF (IndUnit(IUNum)%MaxVolColdWaterFlow == AutoSize) THEN
IsAutosize = .TRUE.
END IF
IF (CurZoneEqNum > 0) THEN
IF (.NOT. IsAutosize .AND. .NOT. ZoneSizingRunDone) THEN ! simulation continue
IF (IndUnit(IUNum)%MaxVolColdWaterFlow > 0.0d0) THEN
CALL ReportSizingOutput(IndUnit(IUNum)%UnitType, IndUnit(IUNum)%Name, &
'User-Specified Maximum Cold Water Flow Rate [m3/s]', IndUnit(IUNum)%MaxVolColdWaterFlow)
END IF
ELSE
CALL CheckZoneSizing(IndUnit(IUNum)%UnitType, IndUnit(IUNum)%Name)
IF (SameString(IndUnit(IUNum)%CCoilType,'Coil:Cooling:Water') .or. &
SameString(IndUnit(IUNum)%CCoilType,'Coil:Cooling:Water:DetailedGeometry')) THEN
CoilWaterInletNode = GetCoilWaterInletNode(IndUnit(IUNum)%CCoilType,IndUnit(IUNum)%CCoil,ErrorsFound)
CoilWaterOutletNode = GetCoilWaterOutletNode(IndUnit(IUNum)%CCoilType,IndUnit(IUNum)%CCoil,ErrorsFound)
IF (IsAutosize) THEN
PltSizCoolNum = MyPlantSizingIndex(IndUnit(IUNum)%CCoilType, IndUnit(IUNum)%CCoil, CoilWaterInletNode, &
CoilWaterOutletNode, ErrorsFound)
IF (PltSizCoolNum > 0) THEN
IF (TermUnitFinalZoneSizing(CurZoneEqNum)%DesCoolMassFlow >= SmallAirVolFlow) THEN
DesPriVolFlow = IndUnit(IUNum)%MaxTotAirVolFlow / (1.d0+IndUnit(IUNum)%InducRatio)
CpAir = PsyCpAirFnWTdb(TermUnitFinalZoneSizing(CurZoneEqNum)%CoolDesHumRat, &
TermUnitFinalZoneSizing(CurZoneEqNum)%CoolDesTemp)
! the design cooling coil load is the zone load minus whatever the central system does. Note that
! DesCoolCoilInTempTU is really the primary air inlet temperature for the unit.
IF (TermUnitFinalZoneSizing(CurZoneEqNum)%ZoneTempAtCoolPeak > 0.0d0) THEN
DesCoilLoad = CalcFinalZoneSizing(CurZoneEqNum)%DesCoolLoad * CalcFinalZoneSizing(CurZoneEqNum)%CoolSizingFactor - &
CpAir*RhoAir*DesPriVolFlow* &
(TermUnitFinalZoneSizing(CurZoneEqNum)%ZoneTempAtCoolPeak - &
TermUnitFinalZoneSizing(CurZoneEqNum)%DesCoolCoilInTempTU)
ELSE
DesCoilLoad = CpAir*RhoAir*DesPriVolFlow*(TermUnitFinalZoneSizing(CurZoneEqNum)%DesCoolCoilInTempTU &
- ZoneSizThermSetPtHi(CurZoneEqNum))
END IF
IndUnit(IUNum)%DesCoolingLoad = DesCoilLoad
Cp = GetSpecificHeatGlycol(PlantLoop(IndUnit(IUNum)%CWLoopNum)%FluidName, &
5.0d0, &
PlantLoop(IndUnit(IUNum)%CWLoopNum)%FluidIndex, &
'SizeIndUnit' )
rho = GetDensityGlycol( PlantLoop(IndUnit(IUNum)%CWLoopNum)%FluidName, &
5.0d0, &
PlantLoop(IndUnit(IUNum)%CWLoopNum)%FluidIndex, &
'SizeIndUnit' )
MaxVolColdWaterFlowDes = DesCoilLoad / &
( PlantSizData(PltSizCoolNum)%DeltaT * &
Cp * rho )
MaxVolColdWaterFlowDes = MAX(MaxVolColdWaterFlowDes,0.0d0)
ELSE
MaxVolColdWaterFlowDes = 0.0d0
END IF
ELSE
CALL ShowSevereError('Autosizing of water flow requires a cooling loop Sizing:Plant object')
CALL ShowContinueError('Occurs in' // TRIM(IndUnit(IUNum)%UnitType) // ' Object='//TRIM(IndUnit(IUNum)%Name))
ErrorsFound = .TRUE.
END IF
END IF
IF (IsAutosize) THEN
IndUnit(IUNum)%MaxVolColdWaterFlow = MaxVolColdWaterFlowDes
CALL ReportSizingOutput(IndUnit(IUNum)%UnitType, IndUnit(IUNum)%Name, &
'Design Size Maximum Cold Water Flow Rate [m3/s]', MaxVolColdWaterFlowDes)
ELSE
IF (IndUnit(IUNum)%MaxVolColdWaterFlow > 0.0d0 .AND. MaxVolColdWaterFlowDes > 0.0d0) THEN
MaxVolColdWaterFlowUser = IndUnit(IUNum)%MaxVolColdWaterFlow
CALL ReportSizingOutput(IndUnit(IUNum)%UnitType, IndUnit(IUNum)%Name, &
'Design Size Maximum Cold Water Flow Rate [m3/s]', MaxVolColdWaterFlowDes, &
'User-Specified Maximum Cold Water Flow Rate [m3/s]', MaxVolColdWaterFlowUser)
IF (DisplayExtraWarnings) THEN
IF ((ABS(MaxVolColdWaterFlowDes - MaxVolColdWaterFlowUser)/MaxVolColdWaterFlowUser) > AutoVsHardSizingThreshold) THEN
CALL ShowMessage('SizeHVACSingleDuctInduction: Potential issue with equipment sizing for '// &
TRIM(IndUnit(IUNum)%UnitType)//' = "'//TRIM(IndUnit(IUNum)%Name)//'".')
CALL ShowContinueError('User-Specified Maximum Cold Water Flow Rate of '// &
TRIM(RoundSigDigits(MaxVolColdWaterFlowUser,5))// ' [m3/s]')
CALL ShowContinueError('differs from Design Size Maximum Cold Water Flow Rate of ' // &
TRIM(RoundSigDigits(MaxVolColdWaterFlowDes,5))// ' [m3/s]')
CALL ShowContinueError('This may, or may not, indicate mismatched component sizes.')
CALL ShowContinueError('Verify that the value entered is intended and is consistent with other components.')
END IF
ENDIF
END IF
END IF
ELSE
IndUnit(IUNum)%MaxVolColdWaterFlow = 0.0d0
END IF
END IF
END IF
IF (CurZoneEqNum > 0) THEN
! note we save the induced air flow for use by the hw and cw coil sizing routines
TermUnitSizing(CurZoneEqNum)%AirVolFlow = IndUnit(IUNum)%MaxTotAirVolFlow * &
IndUnit(IUNum)%InducRatio / (1.d0+ IndUnit(IUNum)%InducRatio)
! save the max hot and cold water flows for use in coil sizing
TermUnitSizing(CurZoneEqNum)%MaxHWVolFlow = IndUnit(IUNum)%MaxVolHotWaterFlow
TermUnitSizing(CurZoneEqNum)%MaxCWVolFlow = IndUnit(IUNum)%MaxVolColdWaterFlow
! save the design load used for reporting
TermUnitSizing(CurZoneEqNum)%DesCoolingLoad = IndUnit(IUNum)%DesCoolingLoad
TermUnitSizing(CurZoneEqNum)%DesHeatingLoad = IndUnit(IUNum)%DesHeatingLoad
! save the induction ratio for use in subsequent sizing calcs
TermUnitSizing(CurZoneEqNum)%InducRat = IndUnit(IUNum)%InducRatio
IF (SameString(IndUnit(IUNum)%HCoilType,'Coil:Heating:Water')) THEN
CALL SetCoilDesFlow(IndUnit(IUNum)%HCoilType,IndUnit(IUNum)%HCoil,TermUnitSizing(CurZoneEqNum)%AirVolFlow,&
ErrorsFound)
END IF
IF (SameString(IndUnit(IUNum)%CCoilType,'Coil:Cooling:Water:DetailedGeometry')) THEN
CALL SetCoilDesFlow(IndUnit(IUNum)%CCoilType,IndUnit(IUNum)%CCoil,TermUnitSizing(CurZoneEqNum)%AirVolFlow,&
ErrorsFound)
END IF
END IF
RETURN
END SUBROUTINE SizeIndUnit