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) | :: | ChillNum | 
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 SizeIndirectAbsorpChiller(ChillNum)
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         R. Raustad (FSEC)
          !       DATE WRITTEN   May 2008
          !       MODIFIED       na
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine is for sizing Indirect Absorption Chiller Components for which capacities and flow rates
          ! have not been specified in the input.
          ! METHODOLOGY EMPLOYED:
          ! Obtains evaporator flow rate from the plant sizing array. Calculates nominal capacity from
          ! the evaporator flow rate and the chilled water loop design delta T. The condenser flow rate
          ! is calculated from the nominal capacity, the COP, and the condenser loop design delta T.
          ! REFERENCES:
          ! na
          ! USE STATEMENTS:
  USE DataSizing
  USE DataPlant,    ONLY : PlantLoop, PlantSizesOkayToFinalize, MyPlantSizingIndex
  USE PlantUtilities, ONLY: RegisterPlantCompDesignFlow
  USE CurveManager, ONLY : CurveValue
  USE OutputReportPredefined
  USE FluidProperties
!  USE BranchInputManager, ONLY: MyPlantSizingIndex
  USE ReportSizingManager, ONLY: ReportSizingOutput
  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
  INTEGER, INTENT(IN) :: ChillNum
          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na
          ! INTERFACE BLOCK SPECIFICATIONS
          ! na
          ! DERIVED TYPE DEFINITIONS
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  INTEGER             :: PltSizIndex         ! Plant Sizing Do loop index
  INTEGER             :: PltSizNum           ! Plant Sizing index corresponding to CurLoopNum
  INTEGER             :: PltSizCondNum       ! Plant Sizing index for condenser loop
  INTEGER             :: PltSizSteamNum      ! Plant Sizing index for steam heating loop
  INTEGER             :: PltSizHeatingNum    ! Plant Sizing index for how water heating loop
  REAL(r64)           :: SteamInputRatNom    ! nominal energy input ratio (steam or hot water)
  REAL(r64)           :: SteamDensity        ! density of generator steam (when connected to a steam loop)
  REAL(r64)           :: EnthSteamOutDry     ! dry enthalpy of steam (quality = 1)
  REAL(r64)           :: EnthSteamOutWet     ! wet enthalpy of steam (quality = 0)
  REAL(r64)           :: HfgSteam            ! latent heat of steam at constant pressure
  REAL(r64)           :: SteamDeltaT         ! amount of sub-cooling of steam condensate
  REAL(r64)           :: SteamMassFlowRate   ! steam mass flow rate through generator
  REAL(r64)           :: CpWater             ! specific heat of generator fluid (when connected to a hot water loop)
  REAL(r64)           :: RhoWater            ! density of water (kg/m3)
  REAL(r64)           :: GeneratorOutletTemp ! outlet temperature of generator
  LOGICAL             :: ErrorsFound         ! If errors detected in input
  LOGICAL             :: LoopErrorsFound     !
  CHARACTER(len=MaxNameLength) :: equipName
  REAL(r64)           :: rho ! local fluid density
  REAL(r64)           :: Cp  ! local specific heat
  REAL(r64)           :: tmpNomCap ! local nominal capacity cooling power
  REAL(r64)           :: tmpNomPumpPower ! local nominal pump power
  REAL(r64)           :: tmpEvapVolFlowRate ! local evaporator design volume flow rate
  REAL(r64)           :: tmpCondVolFlowRate ! local condenser design volume flow rate
  REAL(r64)           :: tmpGeneratorVolFlowRate ! local generator design volume flow rate
  INTEGER             :: DummWaterIndex = 1
  PltSizNum = 0
  PltSizCondNum = 0
  PltSizHeatingNum = 0
  PltSizSteamNum = 0
  ErrorsFound = .FALSE.
    ! init local temporary version in case of partial/mixed autosizing
  tmpNomCap          = IndirectAbsorber(ChillNum)%NomCap
  tmpNomPumpPower    = IndirectAbsorber(ChillNum)%NomPumpPower
  tmpEvapVolFlowRate = IndirectAbsorber(ChillNum)%EvapVolFlowRate
  tmpCondVolFlowRate = IndirectAbsorber(ChillNum)%CondVolFlowRate
  tmpGeneratorVolFlowRate = IndirectAbsorber(ChillNum)%GeneratorVolFlowRate
  IF(IndirectAbsorber(ChillNum)%GeneratorInputCurvePtr .GT. 0)THEN
    SteamInputRatNom = CurveValue(IndirectAbsorber(ChillNum)%GeneratorInputCurvePtr,1.0d0)
  ELSE
    SteamInputRatNom = 1.0d0
  END IF
  ! find the appropriate Plant Sizing object
  IF (CurLoopNum > 0) THEN
    PltSizNum = PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%PlantSizNum
  END IF
  IF (IndirectAbsorber(ChillNum)%CondVolFlowRate == AutoSize) THEN
    PltSizCondNum = MyPlantSizingIndex('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
                                         IndirectAbsorber(ChillNum)%CondInletNodeNum, &
                                         IndirectAbsorber(ChillNum)%CondOutletNodeNum, LoopErrorsFound)
  END IF
  IF (IndirectAbsorber(ChillNum)%GenHeatSourceType == NodeType_Steam) THEN
    IF (IndirectAbsorber(ChillNum)%GeneratorInletNodeNum > 0 .AND. IndirectAbsorber(ChillNum)%GeneratorOutletNodeNum > 0) THEN
      PltSizSteamNum = MyPlantSizingIndex('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
                                          IndirectAbsorber(ChillNum)%GeneratorInletNodeNum, &
                                          IndirectAbsorber(ChillNum)%GeneratorOutletNodeNum, LoopErrorsFound)
    ELSE
      DO PltSizIndex=1,NumPltSizInput
        IF(PlantSizData(PltSizIndex)%LoopType == SteamLoop)THEN
          PltSizSteamNum = PltSizIndex
        END IF
      END DO
    END IF
  ELSE
    IF (IndirectAbsorber(ChillNum)%GeneratorInletNodeNum > 0 .AND. IndirectAbsorber(ChillNum)%GeneratorOutletNodeNum > 0) THEN
      PltSizHeatingNum = MyPlantSizingIndex('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
                                          IndirectAbsorber(ChillNum)%GeneratorInletNodeNum, &
                                          IndirectAbsorber(ChillNum)%GeneratorOutletNodeNum, LoopErrorsFound)
    ELSE
      DO PltSizIndex=1,NumPltSizInput
        IF(PlantSizData(PltSizIndex)%LoopType == HeatingLoop)THEN
          PltSizHeatingNum = PltSizIndex
        END IF
      END DO
    END IF
  END IF
  IF (IndirectAbsorber(ChillNum)%NomCap  == AutoSize) THEN
    IF (PltSizNum > 0) THEN
      IF (PlantSizData(PltSizNum)%DesVolFlowRate >= SmallWaterVolFlow) THEN
        Cp = GetSpecificHeatGlycol(PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%FluidName, &
                                   InitConvTemp, &
                                   PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%FluidIndex, &
                                   'SizeIndirectAbsorpChiller')
        rho = GetDensityGlycol(PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%FluidName, &
                                   InitConvTemp, &
                                   PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%FluidIndex, &
                                   'SizeIndirectAbsorpChiller')
        IF (PlantSizesOkayToFinalize) THEN
          IndirectAbsorber(ChillNum)%NomCap = Cp * rho * PlantSizData(PltSizNum)%DeltaT &
                                                    * PlantSizData(PltSizNum)%DesVolFlowRate * IndirectAbsorber(ChillNum)%SizFac
        ELSE
          tmpNomCap = Cp * rho * PlantSizData(PltSizNum)%DeltaT &
                                                    * PlantSizData(PltSizNum)%DesVolFlowRate * IndirectAbsorber(ChillNum)%SizFac
        ENDIF
      ELSE
        IF (PlantSizesOkayToFinalize) THEN
          IndirectAbsorber(ChillNum)%NomCap = 0.d0
        ELSE
          tmpNomCap = 0.d0
        ENDIF
      END IF
      IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
                              'Nominal Capacity [W]', IndirectAbsorber(ChillNum)%NomCap)
    ELSE
      CALL ShowSevereError('Autosizing of Absorption Chiller nominal capacity requires a loop Sizing:Plant object')
      CALL ShowContinueError('Occurs in Chiller:Absorption:Indirect object='//TRIM(IndirectAbsorber(ChillNum)%Name))
      ErrorsFound = .TRUE.
    END IF
  END IF
  IF (IndirectAbsorber(ChillNum)%NomPumpPower  == AutoSize) THEN
    IF (PlantSizesOkayToFinalize) THEN
     ! the DOE-2 EIR for single stage absorption chiller
      IndirectAbsorber(ChillNum)%NomPumpPower = 0.0045d0 * IndirectAbsorber(ChillNum)%NomCap
      CALL ReportSizingOutput('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
                              'Nominal Pumping Power [W]', IndirectAbsorber(ChillNum)%NomPumpPower)
    ELSE
      tmpNomPumpPower = 0.0045d0 * tmpNomCap
    ENDIF
  END IF
  IF (IndirectAbsorber(ChillNum)%EvapVolFlowRate == AutoSize) THEN
    IF (PltSizNum > 0) THEN
      IF (PlantSizData(PltSizNum)%DesVolFlowRate >= SmallWaterVolFlow) THEN
        IF (PlantSizesOkayToFinalize) THEN
          IndirectAbsorber(ChillNum)%EvapVolFlowRate = PlantSizData(PltSizNum)%DesVolFlowRate * IndirectAbsorber(ChillNum)%SizFac
        ELSE
          tmpEvapVolFlowRate = PlantSizData(PltSizNum)%DesVolFlowRate * IndirectAbsorber(ChillNum)%SizFac
        ENDIF
      ELSE
        IF (PlantSizesOkayToFinalize) THEN
          IndirectAbsorber(ChillNum)%EvapVolFlowRate = 0.d0
        ELSE
          tmpEvapVolFlowRate = 0.d0
        ENDIF
      END IF
      IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
                              'Design Chilled Water Flow Rate [m3/s]', &
                              IndirectAbsorber(ChillNum)%EvapVolFlowRate)
    ELSE
      CALL ShowSevereError('Autosizing of Absorption Chiller evap flow rate requires a loop Sizing:Plant object')
      CALL ShowContinueError('Occurs in Chiller:Absorption:Indirect object='//TRIM(IndirectAbsorber(ChillNum)%Name))
      ErrorsFound = .TRUE.
    END IF
  END IF
  IF (PlantSizesOkayToFinalize) THEN
    CALL RegisterPlantCompDesignFlow(IndirectAbsorber(ChillNum)%EvapInletNodeNum,IndirectAbsorber(ChillNum)%EvapVolFlowRate)
  ELSE
    CALL RegisterPlantCompDesignFlow(IndirectAbsorber(ChillNum)%EvapInletNodeNum,tmpEvapVolFlowRate)
  ENDIF
  IF (IndirectAbsorber(ChillNum)%CondVolFlowRate == AutoSize) THEN
    IF (PltSizCondNum > 0) THEN
      IF (IndirectAbsorber(ChillNum)%EvapVolFlowRate >= SmallWaterVolFlow) THEN
!       QCondenser = QEvaporator + QGenerator + PumpingPower
        Cp = GetSpecificHeatGlycol(PlantLoop(IndirectAbsorber(ChillNum)%CDLoopNum)%FluidName, &
                                   InitConvTemp, &
                                   PlantLoop(IndirectAbsorber(ChillNum)%CDLoopNum)%FluidIndex, &
                                   'SizeIndirectAbsorpChiller')
        rho = GetDensityGlycol(PlantLoop(IndirectAbsorber(ChillNum)%CDLoopNum)%FluidName, &
                                   InitConvTemp, &
                                   PlantLoop(IndirectAbsorber(ChillNum)%CDLoopNum)%FluidIndex, &
                                   'SizeIndirectAbsorpChiller')
        IF (PlantSizesOkayToFinalize) THEN
          IndirectAbsorber(ChillNum)%CondVolFlowRate = IndirectAbsorber(ChillNum)%NomCap * &
            (1.0d0 + SteamInputRatNom + IndirectAbsorber(ChillNum)%NomPumpPower/IndirectAbsorber(ChillNum)%NomCap) / &
            ( PlantSizData(PltSizCondNum)%DeltaT * Cp * rho )
        ELSE
          tmpCondVolFlowRate = tmpNomCap * &
             (1.0d0 + SteamInputRatNom + tmpNomPumpPower/tmpNomCap) / &
             ( PlantSizData(PltSizCondNum)%DeltaT * Cp * rho )
        ENDIF
      ELSE
        IF (PlantSizesOkayToFinalize) THEN
          IndirectAbsorber(ChillNum)%CondVolFlowRate = 0.0d0
        ELSE
          tmpCondVolFlowRate = 0.d0
        ENDIF
      END IF
      IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
                              'Design Condenser Water Flow Rate [m3/s]', &
                              IndirectAbsorber(ChillNum)%CondVolFlowRate)
    ELSE
      CALL ShowSevereError('Autosizing of Absorption Chiller condenser flow rate requires a condenser')
      CALL ShowContinueError('loop Sizing:Plant object')
      CALL ShowContinueError('Occurs in Chiller:Absorption:Indirect object='//TRIM(IndirectAbsorber(ChillNum)%Name))
      ErrorsFound = .TRUE.
    END IF
  END IF
  ! save the design condenser water volumetric flow rate for use by the condenser water loop sizing algorithms
  IF (PlantSizesOkayToFinalize) Then
    CALL RegisterPlantCompDesignFlow(IndirectAbsorber(ChillNum)%CondInletNodeNum,IndirectAbsorber(ChillNum)%CondVolFlowRate)
  ELSE
    CALL RegisterPlantCompDesignFlow(IndirectAbsorber(ChillNum)%CondInletNodeNum,tmpCondVolFlowRate)
  ENDIF
  IF (IndirectAbsorber(ChillNum)%GeneratorVolFlowRate == AutoSize) THEN
    IF (PltSizSteamNum > 0 .AND. IndirectAbsorber(ChillNum)%GenHeatSourceType == NodeType_Steam .OR. &
        PltSizHeatingNum > 0 .AND. IndirectAbsorber(ChillNum)%GenHeatSourceType == NodeType_Water) THEN
      IF (IndirectAbsorber(ChillNum)%EvapVolFlowRate >= SmallWaterVolFlow) THEN
        IF(IndirectAbsorber(ChillNum)%GenHeatSourceType == NodeType_Water)THEN
          CpWater = GetSpecificHeatGlycol(PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidName, &
                                   PlantSizData(PltSizHeatingNum)%ExitTemp, &
                                   PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidIndex, &
                                   'SizeIndirectAbsorpChiller')
          SteamDeltaT = MAX(0.5d0,PlantSizData(PltSizHeatingNum)%DeltaT)
          RhoWater = GetDensityGlycol(PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidName, &
                                   (PlantSizData(PltSizHeatingNum)%ExitTemp - SteamDeltaT), &
                                   PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidIndex, &
                                   'SizeIndirectAbsorpChiller')
          IF (PlantSizesOkayToFinalize) Then
            IndirectAbsorber(ChillNum)%GeneratorVolFlowRate = (IndirectAbsorber(ChillNum)%NomCap * SteamInputRatNom)/ &
                                                      (CpWater * SteamDeltaT * RhoWater)
            CALL ReportSizingOutput('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
                              'Design Generator Fluid Flow Rate [m3/s]', &
                              IndirectAbsorber(ChillNum)%GeneratorVolFlowRate)
          ELSE
            tmpGeneratorVolFlowRate = (tmpNomCap * SteamInputRatNom)/ &
                                                      (CpWater * SteamDeltaT * RhoWater)
          ENDIF
        ELSE
          SteamDensity = GetSatDensityRefrig('STEAM',PlantSizData(PltSizSteamNum)%ExitTemp,1.0d0, &
                                              IndirectAbsorber(ChillNum)%SteamFluidIndex, &
                                                  'SIZE Chiller:Absorption:Indirect'//TRIM(IndirectAbsorber(ChillNum)%Name))
          SteamDeltaT         = PlantSizData(PltSizSteamNum)%DeltaT
          GeneratorOutletTemp = PlantSizData(PltSizSteamNum)%ExitTemp - SteamDeltaT
          EnthSteamOutDry   = GetSatEnthalpyRefrig('STEAM',PlantSizData(PltSizSteamNum)%ExitTemp,1.0d0, &
                                                   IndirectAbsorber(ChillNum)%SteamFluidIndex, &
                                                  'SIZE Chiller:Absorption:Indirect'//TRIM(IndirectAbsorber(ChillNum)%Name))
          EnthSteamOutWet   = GetSatEnthalpyRefrig('STEAM',PlantSizData(PltSizSteamNum)%ExitTemp,0.0d0, &
                                                   IndirectAbsorber(ChillNum)%SteamFluidIndex, &
                                                  'SIZE Chiller:Absorption:Indirect'//TRIM(IndirectAbsorber(ChillNum)%Name))
          CpWater =  GetSpecificHeatGlycol('WATER', GeneratorOutletTemp, DummWaterIndex,  'SizeIndirectAbsorpChiller')
          HfgSteam          = EnthSteamOutDry - EnthSteamOutWet
          IF (PlantSizesOkayToFinalize) THEN
  !         calculate the mass flow rate through the generator
            SteamMassFlowRate = (IndirectAbsorber(ChillNum)%NomCap * SteamInputRatNom) / &
                                ( (HfgSteam) + (SteamDeltaT * CpWater) )
  !         calculate the steam volumetric flow rate
            IndirectAbsorber(ChillNum)%GeneratorVolFlowRate = SteamMassFlowRate / SteamDensity
            CALL ReportSizingOutput('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
                                'Design Generator Fluid Flow Rate [m3/s]', &
                                IndirectAbsorber(ChillNum)%GeneratorVolFlowRate)
          ELSE
            SteamMassFlowRate = (tmpNomCap * SteamInputRatNom) / &
                                ( (HfgSteam) + (SteamDeltaT * CpWater) )
  !         calculate the steam volumetric flow rate
            tmpGeneratorVolFlowRate = SteamMassFlowRate / SteamDensity
          ENDIF
        END IF
      ELSE
        IF (PlantSizesOkayToFinalize) THEN
          IndirectAbsorber(ChillNum)%GeneratorVolFlowRate = 0.0d0
        ELSE
          tmpGeneratorVolFlowRate = 0.d0
        ENDIF
      END IF
    ELSE
      CALL ShowSevereError('Autosizing of Absorption Chiller generator flow rate requires a loop Sizing:Plant object.')
      CALL ShowContinueError(' For steam loops, use a steam Sizing:Plant object.')
      CALL ShowContinueError(' For hot water loops, use a heating Sizing:Plant object.')
      CALL ShowContinueError('Occurs in Chiller:Absorption:Indirect object='//TRIM(IndirectAbsorber(ChillNum)%Name))
      ErrorsFound = .TRUE.
    END IF
  END IF
  ! save the design steam or hot water volumetric flow rate for use by the steam or hot water loop sizing algorithms
  IF (PlantSizesOkayToFinalize) THEN
    CALL RegisterPlantCompDesignFlow(IndirectAbsorber(ChillNum)%GeneratorInletNodeNum,  &
       IndirectAbsorber(ChillNum)%GeneratorVolFlowRate)
  ELSE
    CALL RegisterPlantCompDesignFlow(IndirectAbsorber(ChillNum)%GeneratorInletNodeNum,tmpGeneratorVolFlowRate)
  ENDIF
  IF(IndirectAbsorber(ChillNum)%GeneratorDeltaTemp == AutoSize)THEN
    IF(PltSizHeatingNum > 0 .AND. IndirectAbsorber(ChillNum)%GenHeatSourceType == NodeType_Water) THEN
      IndirectAbsorber(ChillNum)%GeneratorDeltaTemp = MAX(0.5d0,PlantSizData(PltSizHeatingNum)%DeltaT)
    ELSE IF(IndirectAbsorber(ChillNum)%GenHeatSourceType == NodeType_Water)THEN
      rho = GetDensityGlycol(PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidName, &
                                   InitConvTemp, &
                                   PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidIndex, &
                                   'SizeIndirectAbsorpChiller')
      CpWater = GetSpecificHeatGlycol(PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidName, &
                                   PlantSizData(PltSizHeatingNum)%ExitTemp, &
                                   PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidIndex, &
                                   'SizeIndirectAbsorpChiller')
      IF (PlantSizesOkayToFinalize) THEN
        IndirectAbsorber(ChillNum)%GeneratorDeltaTemp = (SteamInputRatNom * IndirectAbsorber(ChillNum)%NomCap)/ &
                (CpWater * rho * IndirectAbsorber(ChillNum)%GeneratorVolFlowRate)
      ENDIF
    END IF
  END IF
  IF (ErrorsFound) THEN
    CALL ShowFatalError('Preceding sizing errors cause program termination')
  END IF
  IF (PlantSizesOkayToFinalize) THEN
      !create predefined report
    equipName = IndirectAbsorber(ChillNum)%Name
    CALL PreDefTableEntry(pdchMechType,equipName,'Chiller:Absorption:Indirect')
    CALL PreDefTableEntry(pdchMechNomEff,equipName,'n/a')
    CALL PreDefTableEntry(pdchMechNomCap,equipName,IndirectAbsorber(ChillNum)%NomCap)
  ENDIF
  RETURN
END SUBROUTINE SizeIndirectAbsorpChiller