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