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) | :: | SysType | |||
| character(len=*), | intent(in) | :: | CompName | |||
| integer, | intent(inout) | :: | CompIndex | |||
| logical, | intent(in) | :: | FirstHVACIteration | |||
| logical, | intent(in) | :: | InitLoopEquip | 
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 SimRefrigCondenser(SysType, CompName, CompIndex, FirstHVACIteration, InitLoopEquip )
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Randy Hudson, ORNL
          !       DATE WRITTEN   July 2007
          !       MODIFIED       Therese Stovall, ORNL May 2008
          !                      Brent Griffith, NREL Oct 2010, generalize fluid properties
          !                        plant upgrades, moved where called from to SimPlantEquip from ManageNonZoneEquipment
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          ! Simulates the water-cooled refrigeration condenser object.
          ! Modified to add condensers for detailed refrigeration systems and to
          ! avoid double-counting heat rejection that has been used in desuperheater
          ! hvac coils or water heaters.
          ! METHODOLOGY EMPLOYED:
          ! Called from SimPlantEquip in PlantLoopEquipment , previously was called from Non-Zone Equipment Manager
          ! Flow is requested and the actual available flow is set.  The outlet temperature is calculated.
          ! USE STATEMENTS:
  USE PlantUtilities,  ONLY : SetComponentFlowRate
  USE FluidProperties, ONLY : GetDensityGlycol, GetSpecificHeatGlycol
  USE InputProcessor,  ONLY : FindItemInList
  USE General       ,  ONLY : TrimSigDigits
  USE DataPlant,       ONLY : TypeOf_RefrigSystemWaterCondenser, TypeOf_RefrigerationWaterCoolRack, PlantLoop
  IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
  CHARACTER(len=*), INTENT(IN) :: CompName
  INTEGER, INTENT(IN)    :: SysType
  INTEGER, INTENT(INOUT) :: CompIndex
  LOGICAL, INTENT(IN) :: FirstHVACIteration
  LOGICAL, INTENT(IN) :: InitLoopEquip
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  REAL(r64) :: DeltaT = 0.0d0
  REAL(r64) :: InletTemp = 0.0d0
  REAL(r64) :: DesVolFlowRate = 0.0d0
  REAL(r64) :: MassFlowRate = 0.0d0
  REAL(r64) :: MassFlowRateMax = 0.0d0
  REAL(r64) :: OutletTempMax = 0.0d0
  REAL(r64) :: VolFlowRate = 0.0d0
  REAL(r64) :: OutletTemp = 0.0d0
  INTEGER   :: FlowType = 0
  ! INTEGER   :: HighFlowWarn = 0
  ! INTEGER   :: HighTempWarn = 0
  INTEGER   :: NoFlowWarnIndex   = 0
  INTEGER   :: HighFlowWarnIndex = 0
  INTEGER   :: HighInletWarnIndex = 0
  INTEGER   :: HighTempWarnIndex = 0
  CHARACTER(len=MaxNameLength) :: Name = ' '
  CHARACTER(len=MaxNameLength) :: TypeName = ' '
  CHARACTER(len=MaxNameLength) :: ErrIntro = ' '
  INTEGER   :: PlantInletNode
  INTEGER   :: PlantOutletNode
  INTEGER   :: PlantLoopIndex
  INTEGER   :: PlantLoopSideIndex
  INTEGER   :: PlantBranchIndex
  INTEGER   :: PlantCompIndex
  INTEGER   :: Num ! local index
  REAL(r64) :: rho ! local fluid density
  REAL(r64) :: Cp  ! local fluid specific heat
  IF (CompIndex == 0) THEN
    SELECT CASE (SysType)
      CASE (TypeOf_RefrigerationWaterCoolRack)
        Num = FindItemInList(CompName, RefrigRack%Name, NumRefrigeratedRacks)
      CASE (TypeOf_RefrigSystemWaterCondenser)
        Num = FindItemInList(CompName, Condenser%Name,  NumRefrigCondensers)
      CASE DEFAULT
        CALL ShowFatalError('SimRefrigCondenser: invalid system type passed')
    END SELECT
    IF (Num == 0) THEN
      CALL ShowFatalError('SimRefrigCondenser: Specified refrigeration condenser not Valid ='//TRIM(CompName))
    ENDIF
    CompIndex = Num
  ELSE
    Num = CompIndex
    SELECT CASE (SysType)
     CASE (TypeOf_RefrigerationWaterCoolRack)
       IF( Num > NumRefrigeratedRacks .OR. Num < 1) THEN
         CALL ShowFatalError('SimRefrigCondenser: Invalid CompIndex passed='//  &
                          TRIM(TrimSigDigits(Num))// &
                          ', Number of Units='//TRIM(TrimSigDigits(NumRefrigeratedRacks))//  &
                          ', Entered Unit name='//TRIM(CompName))
       ENDIF
       IF (CheckEquipNameRackWaterCondenser(Num)) THEN
         IF (CompName /= RefrigRack(Num)%Name) THEN
           CALL ShowFatalError('SimRefrigCondenser: Invalid CompIndex passed='//  &
                          TRIM(TrimSigDigits(Num))// &
                          ', Entered Unit name='//TRIM(CompName)//', stored Unit name for that index='// &
                          TRIM(RefrigRack(Num)%Name) )
         ENDIF
         CheckEquipNameRackWaterCondenser(Num) = .FALSE.
       ENDIF
     CASE (TypeOf_RefrigSystemWaterCondenser)
       IF (Num > NumRefrigCondensers .OR. Num < 1) THEN
         CALL ShowFatalError('SimRefrigCondenser: Invalid CompIndex passed='//  &
                          TRIM(TrimSigDigits(Num))// &
                          ', Number of Units='//TRIM(TrimSigDigits(NumRefrigCondensers))//  &
                          ', Entered Unit name='//TRIM(CompName))
       ENDIF
       IF (CheckEquipNameWaterCondenser(Num)) THEN
         IF (CompName /= Condenser(Num)%Name) THEN
           CALL ShowFatalError('SimRefrigCondenser: Invalid CompIndex passed='//  &
                          TRIM(TrimSigDigits(Num))// &
                          ', Entered Unit name='//TRIM(CompName)//', stored Unit name for that index='// &
                          TRIM(Condenser(Num)%Name) )
         ENDIF
         CheckEquipNameWaterCondenser(Num) = .FALSE.
       ENDIF
    END SELECT
  ENDIF
! this next block may not be necessary, should only get called from plant now.
!  SELECT CASE (SysType)
!   CASE (TypeOf_RefrigerationWaterCoolRack)
!       IF(RefrigRack(Num)%CondenserType/=RefrigCondenserTypeWater) RETURN
!   CASE (TypeOf_RefrigSystemWaterCondenser)
!       IF(Condenser(Num)%CondenserType/=RefrigCondenserTypeWater) RETURN
!  END SELECT
  ! Return if not water cooled condenser
  IF (InitLoopEquip) THEN
    CALL InitRefrigeration
    CALL InitRefrigerationPlantConnections
    RETURN
  ENDIF
  CALL InitRefrigerationPlantConnections
 !set variables depending upon system type
  SELECT CASE (SysType)
   CASE (TypeOf_RefrigerationWaterCoolRack)
     PlantInletNode     = RefrigRack(Num)%InletNode
     PlantOutletNode    = RefrigRack(Num)%OutletNode
     PlantLoopIndex     = RefrigRack(Num)%PlantLoopNum
     PlantLoopSideIndex = RefrigRack(Num)%PlantLoopSideNum
     PlantBranchIndex   = RefrigRack(Num)%PlantBranchNum
     PlantCompIndex     = RefrigRack(Num)%PlantCompNum
     TotalCondenserHeat = HeatReclaimRefrigeratedRack(Num)%AvailCapacity - &
                          RefrigRack(Num)%LaggedUsedWaterHeater - &
                          RefrigRack(Num)%LaggedUsedHVACCoil
     FlowType = RefrigRack(Num)%FlowType
     InletTemp = RefrigRack(Num)%InletTemp
     ! HighFlowWarn = RefrigRack(Num)%HighFlowWarn
     ! HighTempWarn = RefrigRack(Num)%HighTempWarn
     DesVolFlowRate = RefrigRack(Num)%DesVolFlowRate
     !DSU? init mass flow here?
!     MassFlowRate = RefrigRack(Num)%MassFlowRate
     MassFlowRateMax = RefrigRack(Num)%MassFlowRateMax
     OutletTempMax = RefrigRack(Num)%OutletTempMax
     Name = RefrigRack(Num)%Name
     TypeName = 'Refrigeration:CompressorRack:'
     ErrIntro = 'Condenser for refrigeration rack '
     NoFlowWarnIndex   = RefrigRack(Num)%NoFlowWarnIndex
     HighFlowWarnIndex = RefrigRack(Num)%HighFlowWarnIndex
     HighTempWarnIndex = RefrigRack(Num)%HighTempWarnIndex
     HighInletWarnIndex = RefrigRack(Num)%HighInletWarnIndex
   CASE (TypeOf_RefrigSystemWaterCondenser)
    !InletNode = Condenser(Num)%InletNode
     PlantInletNode     = Condenser(Num)%InletNode
     PlantOutletNode    = Condenser(Num)%OutletNode
     PlantLoopIndex     = Condenser(Num)%PlantLoopNum
     PlantLoopSideIndex = Condenser(Num)%PlantLoopSideNum
     PlantBranchIndex   = Condenser(Num)%PlantBranchNum
     PlantCompIndex     = Condenser(Num)%PlantCompNum
     TotalCondenserHeat = Condenser(Num)%CondLoad
     FlowType = Condenser(Num)%FlowType
     InletTemp = Condenser(Num)%InletTemp
     ! HighFlowWarn = Condenser(Num)%HighFlowWarn
     ! HighTempWarn = Condenser(Num)%HighTempWarn
     DesVolFlowRate = Condenser(Num)%DesVolFlowRate
!     MassFlowRate = Condenser(Num)%MassFlowRate
     MassFlowRateMax = Condenser(Num)%MassFlowRateMax
     OutletTempMax = Condenser(Num)%OutletTempMax
     Name = Condenser(Num)%Name
     TypeName = 'Refrigeration:Condenser:WaterCooled'
     ErrIntro = 'Condenser for refrigeration system '
     NoFlowWarnIndex = Condenser(Num)%NoFlowWarnIndex
     HighFlowWarnIndex = Condenser(Num)%HighFlowWarnIndex
     HighTempWarnIndex = Condenser(Num)%HighTempWarnIndex
     HighInletWarnIndex = Condenser(Num)%HighInletWarnIndex
  END SELECT
  ! Current condenser is water cooled
  ! Make demand request on first HVAC iteration
  !get cooling fluid properties
  rho =GetDensityGlycol(PlantLoop(PlantLoopIndex)%FluidName, &
                        InletTemp, &
                        PlantLoop(PlantLoopIndex)%FluidIndex, &
                        'SimRefrigCondenser')
  Cp = GetSpecificHeatGlycol(PlantLoop(PlantLoopIndex)%FluidName, &
                        InletTemp, &
                        PlantLoop(PlantLoopIndex)%FluidIndex, &
                        'SimRefrigCondenser')
! first determine desired flow
  IF (FlowType == VariableFlow .AND. TotalCondenserHeat > 0.d0 ) THEN
    IF (SysType == TypeOf_RefrigerationWaterCoolRack) THEN
       OutletTemp = GetCurrentScheduleValue(RefrigRack(Num)%OutletTempSchedPtr)
    ELSEIF (SysType == TypeOf_RefrigSystemWaterCondenser) THEN
       OutletTemp = GetCurrentScheduleValue(Condenser(Num)%OutletTempSchedPtr)
    END IF
    IF (OutletTemp == InletTemp) THEN
      IF (HighInletWarnIndex == 0) THEN
        CALL ShowSevereError(ErrIntro//', "'//TRIM(Name)// &
                      '" : has inlet water temp equal to desired outlet temp. Excessive flow resulting. ')
        CALL ShowContinueError('cooling water is not cold enough to reach desired outlet temperature')
      ENDIF
      CALL ShowRecurringWarningErrorAtEnd(ErrIntro//', "'//TRIM(Name)// &
                      '" : has inlet water temp equal to desired outlet temp.... continues. ', &
                       HighInletWarnIndex)
      VolFlowRate = 9999.d0
      MassFlowRate =  VolFlowRate * rho
    ELSE
      DeltaT = OutletTemp - InletTemp
      MassFlowRate = TotalCondenserHeat/Cp/DeltaT
       ! Check for maximum flow in the component
      IF (MassFlowRate > MassFlowRateMax) THEN
          !HighFlowWarn = HighFlowWarn +1
        IF (HighFlowWarnIndex == 0) THEN
          CALL ShowWarningMessage(TypeName//TRIM(Name))
          CALL ShowContinueError('Requested condenser water mass flow rate greater than maximum allowed value. ')
          CALL ShowContinueError('Flow reset to maximum value.')
        END IF !HighFlowWarnIndex
        CALL ShowRecurringWarningErrorAtEnd(ErrIntro// TRIM(Name) // &
            ' - Flow rate higher than maximum allowed ... continues',HighFlowWarnIndex)
          !END IF
        MassFlowRate = MassFlowRateMax
      END IF
    END IF  !compare outlet T to inlet T
  ELSEIF(FlowType == ConstantFlow .AND. TotalCondenserHeat > 0.d0 ) THEN
           ! this part for constant flow condition
    VolFlowRate = DesVolFlowRate
    MassFlowRate =  VolFlowRate * rho
  ELSEIF (TotalCondenserHeat == 0.d0) THEN
    MassFlowRate =  0.d0
  END IF  !on flow type
  ! check against plant, might get changed.
  CALL SetComponentFlowRate(MassFlowRate, &
                             PlantInletNode, PlantOutletNode, &
                             PlantLoopIndex, PlantLoopSideIndex, &
                             PlantBranchIndex, PlantCompIndex )
  VolFlowRate = MassFlowRate / rho
  IF (MassFlowRate > 0) THEN
    OutletTemp = TotalCondenserHeat/(MassFlowRate*Cp) &
        + Node(PlantInletNode)%Temp
  ELSE
    OutletTemp = InletTemp
    IF ((TotalCondenserHeat > 0.0d0) .AND. (.NOT. FirstHVACIteration)) THEN
      CALL ShowRecurringWarningErrorAtEnd(TypeName//TRIM(Name)//&
            'Water-cooled condenser has no cooling water flow. '// &
            'Heat is not being rejected from compressor rack condenser.',NoFlowWarnIndex)
    END IF
  END IF
  ! Check outlet water temp for max value
  IF (OutletTemp > OutletTempMax) THEN
    ! HighTempWarn = HighTempWarn +1
    IF (HighTempWarnIndex == 0) THEN
      CALL ShowWarningMessage(TypeName//TRIM(Name))
      CALL ShowContinueError('Water-cooled condenser outlet temp higher than maximum allowed temp. '// &
            'Check flow rates and/or temperature setpoints.')
    END IF
    CALL ShowRecurringWarningErrorAtEnd(ErrIntro// TRIM(Name) // &
        ' - Condenser outlet temp higher than maximum allowed ... continues',&
            HighTempWarnIndex)
  END IF
 !set up output variables
 SELECT CASE (SysType)
   CASE (TypeOf_RefrigerationWaterCoolRack)
     !RefrigRack(Num)%HighFlowWarn = HighFlowWarn
     !RefrigRack(Num)%HighTempWarn = HighTempWarn
     RefrigRack(Num)%MassFlowRate = MassFlowRate
     RefrigRack(Num)%VolFlowRate = VolFlowRate
     RefrigRack(Num)%OutletTemp = OutletTemp
     RefrigRack(Num)%HighFlowWarnIndex = HighFlowWarnIndex
     RefrigRack(Num)%HighTempWarnIndex = HighTempWarnIndex
     RefrigRack(Num)%HighInletWarnIndex = HighInletWarnIndex
     RefrigRack(Num)%NoFlowWarnIndex = NoFlowWarnIndex
   CASE (TypeOf_RefrigSystemWaterCondenser)
     !Condenser(Num)%HighFlowWarn = HighFlowWarn
     !Condenser(Num)%HighTempWarn = HighTempWarn
     Condenser(Num)%MassFlowRate = MassFlowRate
     Condenser(Num)%VolFlowRate = VolFlowRate
     Condenser(Num)%OutletTemp = OutletTemp
     Condenser(Num)%HighFlowWarnIndex = HighFlowWarnIndex
     Condenser(Num)%HighTempWarnIndex = HighTempWarnIndex
     Condenser(Num)%NoFlowWarnIndex = NoFlowWarnIndex
     Condenser(Num)%HighInletWarnIndex = HighInletWarnIndex
  END SELECT
  CALL UpdateRefrigCondenser(Num,SysType)
  RETURN
END SUBROUTINE SimRefrigCondenser