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) | :: | CompNum |
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 SizeFluidHeatExchanger(CompNum)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN December 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Size plant heat exchanger flow rates, UA, and max capacity
! METHODOLOGY EMPLOYED:
! the supply side flow rate is obtained from the plant sizing structure
! the demand side is sized to match the supply side
! the UA is sized for an effectiveness of 1.0 using sizing temps
! the capacity uses the full HX model
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSizing
USE DataHVACGlobals, ONLY: SmallWaterVolFlow
USE DataGlobals, ONLY: InitConvTemp
USE FluidProperties, ONLY: GetDensityGlycol, GetSpecificHeatGlycol
USE OutputReportPredefined, ONLY: pdchMechType, pdchMechNomCap, PreDefTableEntry
USE PlantUtilities, ONLY: RegisterPlantCompDesignFlow
USE ReportSizingManager, ONLY: ReportSizingOutput
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: CompNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: PltSizNumSupSide ! Plant Sizing index for Loop Supply Side
INTEGER :: PltSizNumDmdSide ! plant sizing index for Loop Demand Side
REAL(r64) :: tmpSupSideDesignVolFlowRate
REAL(r64) :: tmpDmdSideDesignVolFlowRate
REAL(r64) :: tmpUA
REAL(r64) :: tmpDeltaTSupLoop
REAL(r64) :: tmpDeltaTloopToLoop
LOGICAL :: ErrorsFound
REAL(r64) :: Cp
REAL(r64) :: rho
REAL(r64) :: tmpDesCap
REAL(r64) :: SupSideMdot
REAL(r64) :: DmdSideMdot
! first deal with Loop Supply Side
ErrorsFound = .FALSE.
PltSizNumSupSide = PlantLoop(FluidHX(CompNum)%SupplySideLoop%LoopNum)%PlantSizNum
PltSizNumDmdSide = PlantLoop(FluidHX(CompNum)%DemandSideLoop%LoopNum)%PlantSizNum
tmpSupSideDesignVolFlowRate = FluidHX(CompNum)%SupplySideLoop%DesignVolumeFlowRate
IF (FluidHX(CompNum)%SupplySideLoop%DesignVolumeFlowRate == AutoSize) THEN
IF (PltSizNumSupSide > 0) THEN
IF (PlantSizData(PltSizNumSupSide)%DesVolFlowRate >= SmallWaterVolFlow) THEN
tmpSupSideDesignVolFlowRate = PlantSizData(PltSizNumSupSide)%DesVolFlowRate * FluidHX(CompNum)%SizingFactor
IF (PlantSizesOkayToFinalize) FluidHX(CompNum)%SupplySideLoop%DesignVolumeFlowRate = tmpSupSideDesignVolFlowRate
ELSE
tmpSupSideDesignVolFlowRate = 0.d0
IF (PlantSizesOkayToFinalize) FluidHX(CompNum)%SupplySideLoop%DesignVolumeFlowRate = tmpSupSideDesignVolFlowRate
ENDIF
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput('HeatExchanger:FluidToFluid', FluidHX(CompNum)%Name, &
'Loop Supply Side Design Fluid Flow Rate [m3/s]', &
FluidHX(CompNum)%SupplySideLoop%DesignVolumeFlowRate )
ELSE
CALL ShowSevereError('SizeFluidHeatExchanger: Autosizing of requires a loop Sizing:Plant object')
CALL ShowContinueError('Occurs in heat exchanger object='//TRIM(FluidHX(CompNum)%Name))
ErrorsFound = .TRUE.
END IF
ENDIF
CALL RegisterPlantCompDesignFlow(FluidHX(CompNum)%SupplySideLoop%InletNodeNum, tmpSupSideDesignVolFlowRate)
! second deal with Loop Demand Side
tmpDmdSideDesignVolFlowRate = FluidHX(CompNum)%DemandSideLoop%DesignVolumeFlowRate
IF (FluidHX(CompNum)%DemandSideLoop%DesignVolumeFlowRate == AutoSize) THEN
IF (tmpSupSideDesignVolFlowRate > SmallWaterVolFlow) THEN
tmpDmdSideDesignVolFlowRate = tmpSupSideDesignVolFlowRate
IF (PlantSizesOkayToFinalize) FluidHX(CompNum)%DemandSideLoop%DesignVolumeFlowRate = tmpDmdSideDesignVolFlowRate
ELSE
tmpDmdSideDesignVolFlowRate = 0.d0
IF (PlantSizesOkayToFinalize) FluidHX(CompNum)%DemandSideLoop%DesignVolumeFlowRate = tmpDmdSideDesignVolFlowRate
ENDIF
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput('HeatExchanger:FluidToFluid', FluidHX(CompNum)%Name, &
'Loop Demand Side Design Fluid Flow Rate [m3/s]', &
FluidHX(CompNum)%DemandSideLoop%DesignVolumeFlowRate )
ENDIF
CALL RegisterPlantCompDesignFlow(FluidHX(CompNum)%DemandSideLoop%InletNodeNum, tmpDmdSideDesignVolFlowRate)
! size UA if needed
tmpUA = FluidHX(CompNum)%UA
IF (FluidHX(CompNum)%UA == AutoSize) THEN
! get nominal delta T between two loops
IF (PltSizNumSupSide > 0 .AND. PltSizNumDmdSide > 0) THEN
SELECT CASE (PlantSizData(PltSizNumSupSide)%LoopType)
CASE (HeatingLoop)
tmpDeltaTloopToLoop = ABS( (PlantSizData(PltSizNumSupSide)%ExitTemp - PlantSizData(PltSizNumSupSide)%DeltaT ) &
- PlantSizData(PltSizNumDmdSide)%ExitTemp )
CASE (CoolingLoop)
tmpDeltaTloopToLoop = ABS( (PlantSizData(PltSizNumSupSide)%ExitTemp + PlantSizData(PltSizNumSupSide)%DeltaT ) &
- PlantSizData(PltSizNumDmdSide)%ExitTemp )
CASE (CondenserLoop)
tmpDeltaTloopToLoop = ABS( (PlantSizData(PltSizNumSupSide)%ExitTemp + PlantSizData(PltSizNumSupSide)%DeltaT ) &
- PlantSizData(PltSizNumDmdSide)%ExitTemp )
CASE (SteamLoop)
tmpDeltaTloopToLoop = ABS( (PlantSizData(PltSizNumSupSide)%ExitTemp - PlantSizData(PltSizNumSupSide)%DeltaT ) &
- PlantSizData(PltSizNumDmdSide)%ExitTemp )
END SELECT
tmpDeltaTloopToLoop = MAX(2.d0, tmpDeltaTloopToLoop)
tmpDeltaTSupLoop = PlantSizData(PltSizNumSupSide)%DeltaT
IF (tmpSupSideDesignVolFlowRate >= SmallWaterVolFlow) THEN
Cp = GetSpecificHeatGlycol(PlantLoop(FluidHX(CompNum)%SupplySideLoop%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(FluidHX(CompNum)%SupplySideLoop%LoopNum)%FluidIndex, &
'SizeFluidHeatExchanger' )
rho = GetDensityGlycol(PlantLoop(FluidHX(CompNum)%SupplySideLoop%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(FluidHX(CompNum)%SupplySideLoop%LoopNum)%FluidIndex, &
'SizeFluidHeatExchanger' )
tmpDesCap = Cp * rho * tmpDeltaTSupLoop * tmpSupSideDesignVolFlowRate
tmpUA = tmpDesCap/tmpDeltaTloopToLoop
IF (PlantSizesOkayToFinalize) FluidHX(CompNum)%UA = tmpUA
ELSE
tmpUA = 0.d0
IF (PlantSizesOkayToFinalize) FluidHX(CompNum)%UA = tmpUA
END IF
IF (PlantSizesOkayToFinalize) THEN
CALL ReportSizingOutput('HeatExchanger:FluidToFluid', FluidHX(CompNum)%Name, &
'Heat Exchanger U-Factor Times Area Value [W/C]', FluidHX(CompNum)%UA)
CALL ReportSizingOutput('HeatExchanger:FluidToFluid', FluidHX(CompNum)%Name, &
'Loop-to-loop Temperature Difference Used to Size Heat Exchanger U-Factor Times Area Value [C]' &
,tmpDeltaTloopToLoop)
ENDIF
ELSE
CALL ShowSevereError('SizeFluidHeatExchanger: Autosizing of heat '// &
'Exchanger UA requires a loop Sizing:Plant objects for both loops')
CALL ShowContinueError('Occurs in heat exchanger object='//TRIM(FluidHX(CompNum)%Name))
ErrorsFound = .TRUE.
END IF
ENDIF
! size capacities for load range based op schemes
IF (PlantSizesOkayToFinalize ) THEN
IF (PltSizNumSupSide > 0 ) THEN
SELECT CASE (PlantSizData(PltSizNumSupSide)%LoopType)
CASE (HeatingLoop)
Node(FluidHX(CompNum)%SupplySideLoop%InletNodeNum)%Temp = &
(PlantSizData(PltSizNumSupSide)%ExitTemp - PlantSizData(PltSizNumSupSide)%DeltaT )
CASE (CoolingLoop)
Node(FluidHX(CompNum)%SupplySideLoop%InletNodeNum)%Temp = &
(PlantSizData(PltSizNumSupSide)%ExitTemp + PlantSizData(PltSizNumSupSide)%DeltaT )
CASE (CondenserLoop)
Node(FluidHX(CompNum)%SupplySideLoop%InletNodeNum)%Temp = &
(PlantSizData(PltSizNumSupSide)%ExitTemp + PlantSizData(PltSizNumSupSide)%DeltaT )
CASE (SteamLoop)
Node(FluidHX(CompNum)%SupplySideLoop%InletNodeNum)%Temp = &
(PlantSizData(PltSizNumSupSide)%ExitTemp - PlantSizData(PltSizNumSupSide)%DeltaT )
END SELECT
ELSE ! don't rely on sizing, use loop setpoints
! loop supply side
IF (PlantLoop(FluidHX(CompNum)%SupplySideLoop%LoopNum)%LoopDemandCalcScheme == SingleSetPoint ) THEN
Node(FluidHX(CompNum)%SupplySideLoop%InletNodeNum)%Temp = &
Node(PlantLoop(FluidHX(CompNum)%SupplySideLoop%LoopNum)%TempSetPointNodeNum)%TempSetPoint
ELSEIF (PlantLoop(FluidHX(CompNum)%SupplySideLoop%LoopNum)%LoopDemandCalcScheme == DualSetPointDeadBand) THEN
Node(FluidHX(CompNum)%SupplySideLoop%InletNodeNum)%Temp = &
(Node(PlantLoop(FluidHX(CompNum)%SupplySideLoop%LoopNum)%TempSetPointNodeNum)%TempSetPointHi + &
Node(PlantLoop(FluidHX(CompNum)%SupplySideLoop%LoopNum)%TempSetPointNodeNum)%TempSetPointLo) / 2.d0
ENDIF
ENDIF
IF (PltSizNumDmdSide > 0) THEN
Node(FluidHX(CompNum)%DemandSideLoop%InletNodeNum)%Temp = PlantSizData(PltSizNumDmdSide)%ExitTemp
ELSE ! don't rely on sizing, use loop setpoints
! loop demand side
IF (PlantLoop(FluidHX(CompNum)%DemandSideLoop%LoopNum)%LoopDemandCalcScheme == SingleSetPoint ) THEN
Node(FluidHX(CompNum)%DemandSideLoop%InletNodeNum)%Temp = &
Node(PlantLoop(FluidHX(CompNum)%DemandSideLoop%LoopNum)%TempSetPointNodeNum)%TempSetPoint
ELSEIF (PlantLoop(FluidHX(CompNum)%DemandSideLoop%LoopNum)%LoopDemandCalcScheme == DualSetPointDeadBand) THEN
Node(FluidHX(CompNum)%DemandSideLoop%InletNodeNum)%Temp = &
(Node(PlantLoop(FluidHX(CompNum)%DemandSideLoop%LoopNum)%TempSetPointNodeNum)%TempSetPointHi + &
Node(PlantLoop(FluidHX(CompNum)%DemandSideLoop%LoopNum)%TempSetPointNodeNum)%TempSetPointLo) / 2.d0
ENDIF
ENDIF
rho = GetDensityGlycol(PlantLoop(FluidHX(CompNum)%SupplySideLoop%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(FluidHX(CompNum)%SupplySideLoop%LoopNum)%FluidIndex, &
'SizeFluidHeatExchanger')
SupSideMdot = FluidHX(CompNum)%SupplySideLoop%DesignVolumeFlowRate * rho
rho = GetDensityGlycol(PlantLoop(FluidHX(CompNum)%DemandSideLoop%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(FluidHX(CompNum)%DemandSideLoop%LoopNum)%FluidIndex, &
'SizeFluidHeatExchanger')
DmdSideMdot = FluidHX(CompNum)%DemandSideLoop%DesignVolumeFlowRate * rho
CALL CalcFluidHeatExchanger(CompNum, SupSideMdot, DmdSideMdot)
FluidHX(CompNum)%SupplySideLoop%MaxLoad = ABS( FluidHX(CompNum)%HeatTransferRate )
ENDIF
IF (PlantSizesOkayToFinalize) THEN
CALL PreDefTableEntry(pdchMechType,FluidHX(CompNum)%Name,'HeatExchanger:FluidToFluid')
CALL PreDefTableEntry(pdchMechNomCap,FluidHX(CompNum)%Name,FluidHX(CompNum)%SupplySideLoop%MaxLoad)
ENDIF
RETURN
END SUBROUTINE SizeFluidHeatExchanger