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