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 | :: | ChillNum | ||||
real(kind=r64) | :: | MyLoad | ||||
logical, | intent(in) | :: | RunFlag | |||
logical | :: | FirstIteration | ||||
integer, | intent(in) | :: | EquipFlowCtrl |
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 CalcBLASTAbsorberModel(ChillNum,MyLoad,Runflag,FirstIteration,EquipFlowCtrl)
! SUBROUTINE INFORMATION:
! AUTHOR Dan Fisher
! DATE WRITTEN Sept. 1998
! MODIFIED April 1999, May 2000- Taecheol Kim
! May 2008 - R. Raustad, added generator nodes
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! simulate a vapor compression Absorber using the BLAST model
! METHODOLOGY EMPLOYED:
! curve fit of performance data:
! REFERENCES:
! 1. BLAST User Manual
! 2. Absorber User Manual
! USE STATEMENTS:
USE DataGlobals, ONLY : BeginEnvrnFlag, SecInHour, WarmupFlag
USE DataHVACGlobals, ONLY : FirstTimeStepSysFlag, TimeStepSys
USE DataPlant, ONLY : DeltaTemptol, PlantLoop, CompSetPtBasedSchemeType, &
SingleSetpoint, DualSetpointDeadband
USE DataBranchAirLoopPlant, ONLY : ControlType_SeriesActive, MassFlowTolerance
USE FluidProperties
USE General, ONLY : TrimSigDigits
USE PlantUtilities, ONLY : SetComponentFlowRate
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER :: ChillNum ! Absorber number
REAL(r64) :: MyLoad ! operating load
LOGICAL :: FirstIteration ! TRUE when first iteration of timestep !unused1208
LOGICAL, INTENT(IN) :: RunFlag ! TRUE when Absorber operating
INTEGER, INTENT(IN) :: EquipFlowCtrl ! Flow control mode for the equipment
! SUBROUTINE PARAMETER DEFINITIONS:
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64), DIMENSION(3) :: SteamLoadFactor ! coefficients to poly curve fit
REAL(r64), DIMENSION(3) :: ElectricLoadFactor ! coefficients to poly curve fit
REAL(r64) :: MinPartLoadRat ! min allowed operating frac full load
REAL(r64) :: MaxPartLoadRat ! max allowed operating frac full load
REAL(r64) :: TempCondIn ! C - (BLAST ADJTC(1)The design secondary loop fluid
REAL(r64) :: TempCondInDesign ! C - (BLAST ADJTC(1)The design secondary loop fluid
REAL(r64) :: EvapInletTemp ! C - evaporator inlet temperature, water side
REAL(r64) :: CondInletTemp ! C - condenser inlet temperature, water side
REAL(r64) :: TempEvapOut ! C - evaporator outlet temperature, water side
REAL(r64) :: TempEvapOutSetpoint ! C - evaporator outlet temperature setpoint
REAL(r64) :: AbsorberNomCap ! Absorber nominal capacity
REAL(r64) :: NomPumpPower ! Absorber nominal pumping power
REAL(r64) :: PartLoadRat ! part load ratio for efficiency calc
REAL(r64) :: OperPartLoadRat ! Operating part load ratio
REAL(r64) :: EvapDeltaTemp ! C - evaporator temperature difference, water side
REAL(r64) :: TempLowLimitEout ! C - Evaporator low temp. limit cut off
REAL(r64) :: SteamInputRat ! energy input ratio
REAL(r64) :: ElectricInputRat ! energy input ratio
INTEGER :: EvapInletNode ! evaporator inlet node number, water side
INTEGER :: EvapOutletNode ! evaporator outlet node number, water side
INTEGER :: CondInletNode ! condenser inlet node number, water side
INTEGER :: CondOutletNode ! condenser outlet node number, water side
INTEGER :: GeneratorInletNode ! generator inlet node number, steam/water side
INTEGER :: GeneratorOutletNode ! generator outlet node number, steam/water side
REAL(r64) :: EnthSteamOutDry ! enthalpy of dry steam at generator inlet
REAL(r64) :: EnthSteamOutWet ! enthalpy of wet steam at generator inlet
REAL(r64) :: HfgSteam ! heat of vaporization of steam
LOGICAL,ALLOCATABLE,DIMENSION(:),SAVE :: MyEnvironFlag
LOGICAL,ALLOCATABLE,DIMENSION(:),SAVE :: MyEnvironSteamFlag
LOGICAL, SAVE :: OneTimeFlag = .true.
REAL(r64) :: FRAC
! LOGICAL,SAVE :: PossibleSubCooling
REAL(r64) :: CpFluid ! local specific heat of fluid
REAL(r64) :: SteamDeltaT
REAL(r64) :: SteamDensity
REAL(r64) :: SteamOutletTemp
INTEGER :: LoopNum
INTEGER :: LoopSideNum
INTEGER :: DummyWaterIndex = 1
!set module level inlet and outlet nodes
EvapMassFlowRate = 0.0d0
CondMassFlowRate = 0.0d0
SteamMassFlowRate = 0.0d0
QCondenser = 0.0d0
QEvaporator = 0.0d0
QGenerator = 0.0d0
PumpingEnergy = 0.0d0
CondenserEnergy = 0.0d0
EvaporatorEnergy = 0.0d0
GeneratorEnergy = 0.0d0
PumpingPower = 0.0d0
FRAC = 1.0d0
EvapInletNode = BLASTAbsorber(ChillNum)%EvapInletNodeNum
EvapOutletNode = BLASTAbsorber(ChillNum)%EvapOutletNodeNum
CondInletNode = BLASTAbsorber(ChillNum)%CondInletNodeNum
CondOutletNode = BLASTAbsorber(ChillNum)%CondOutletNodeNum
GeneratorInletNode = BLASTAbsorber(ChillNum)%GeneratorInletNodeNum
GeneratorOutletNode = BLASTAbsorber(ChillNum)%GeneratorOutletNodeNum
!If no loop demand or Absorber OFF, return
IF(MyLoad >= 0.0d0 .OR. .NOT. RunFlag) THEN !off or heating
IF(EquipFlowCtrl == ControlType_SeriesActive) EvapMassFlowRate = Node(EvapInletNode)%MassFlowrate
RETURN
END IF
!set module level Absorber inlet and temperature variables
EvapInletTemp = Node(EvapInletNode)%Temp
CondInletTemp = Node(CondInletNode)%Temp
!Set the condenser mass flow rates
CondMassFlowRate = Node(CondInletNode)%MassFlowRate
! LOAD LOCAL VARIABLES FROM DATA STRUCTURE (for code readability)
SteamLoadFactor = BLASTAbsorber(ChillNum)%SteamLoadCoef
ElectricLoadFactor = BLASTAbsorber(ChillNum)%PumpPowerCoef
MinPartLoadRat = BLASTAbsorber(ChillNum)%MinPartLoadRat
MaxPartLoadRat = BLASTAbsorber(ChillNum)%MaxPartLoadRat
TempCondInDesign = BLASTAbsorber(ChillNum)%TempDesCondIn
AbsorberNomCap = BLASTAbsorber(ChillNum)%NomCap
NomPumpPower = BLASTAbsorber(ChillNum)%NomPumpPower
TempCondIn = Node(BLASTAbsorber(ChillNum)%CondInletNodeNum)%Temp
TempEvapOut = Node(BLASTAbsorber(ChillNum)%EvapOutletNodeNum)%Temp
TempLowLimitEout = BLASTAbsorber(ChillNum)%TempLowLimitEvapOut
LoopNum = BLASTAbsorber(ChillNum)%CWLoopNum
LoopSideNum = BLASTAbsorber(ChillNum)%CWLoopSideNum
CpFluid = GetSpecificHeatGlycol(PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%FluidName, &
EvapInletTemp, &
PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%FluidIndex, &
'CalcBLASTAbsorberModel')
! If FlowLock is True, the new resolved mdot is used to update Power, QEvap, Qcond, and
! condenser side outlet temperature.
IF (PlantLoop(LoopNum)%Loopside(LoopSideNum)%FlowLock==0) THEN
BLASTAbsorber(ChillNum)%PossibleSubCooling = .FALSE.
QEvaporator = ABS(MyLoad)
! limit by max capacity
QEvaporator = MIN(QEvaporator, (BLASTAbsorber(ChillNum)%MaxPartLoadRat * BLASTAbsorber(ChillNum)%NomCap) )
! Either set the flow to the Constant value or caluclate the flow for the variable volume
IF ((BLASTAbsorber(ChillNum)%FlowMode == ConstantFlow) &
.OR. (BLASTAbsorber(ChillNum)%FlowMode == NotModulated))Then
EvapMassFlowRate = Node(EvapInletNode)%MassFlowRate
IF (EvapMassFlowRate /= 0.0D0) THEN
EvapDeltaTemp = QEvaporator/EvapMassFlowRate / CpFluid
ELSE
EvapDeltaTemp = 0.0D0
ENDIF
EvapOutletTemp = EvapInletTemp - EvapDeltaTemp
ELSE IF (BLASTAbsorber(ChillNum)%FlowMode == LeavingSetpointModulated) THEN
! Calculate the Delta Temp from the inlet temp to the chiller outlet setpoint
SELECT CASE (PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%LoopDemandCalcScheme)
CASE (SingleSetpoint)
EvapDeltaTemp = Node(EvapInletNode)%Temp - Node(EvapOutletNode)%TempSetPoint
CASE (DualSetpointDeadband)
EvapDeltaTemp = Node(EvapInletNode)%Temp - Node(EvapOutletNode)%TempSetPointHi
END SELECT
IF (EvapDeltaTemp /= 0) THEN
EvapMassFlowRate = ABS(QEvaporator/CpFluid/EvapDeltaTemp)
IF((EvapMassFlowRate - BLASTAbsorber(ChillNum)%EvapMassFlowRateMax) .GT. MassFlowTolerance) &
BLASTAbsorber(ChillNum)%PossibleSubCooling = .TRUE.
!Check to see if the Maximum is exceeded, if so set to maximum
EvapMassFlowRate = MIN(BLASTAbsorber(ChillNum)%EvapMassFlowRateMax, EvapMassFlowRate)
CALL SetComponentFlowRate(EvapMassFlowRate, &
BLASTAbsorber(ChillNum)%EvapInletNodeNum, &
BLASTAbsorber(ChillNum)%EvapOutletNodeNum,&
BLASTAbsorber(ChillNum)%CWLoopNum, &
BLASTAbsorber(ChillNum)%CWLoopSideNum, &
BLASTAbsorber(ChillNum)%CWBranchNum, &
BLASTAbsorber(ChillNum)%CWCompNum)
SELECT CASE (PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%LoopDemandCalcScheme )
CASE (SingleSetpoint)
EvapOutletTemp = Node(EvapOutletNode)%TempSetPoint
CASE (DualSetpointDeadband)
EvapOutletTemp = Node(EvapOutletNode)%TempSetPointHi
END SELECT
ELSE
EvapMassFlowRate=0.0d0
EvapOutletTemp = Node(EvapInletNode)%Temp
CALL ShowRecurringWarningErrorAtEnd('CalcBLASTAbsorberModel: Name="'// &
TRIM(BLASTAbsorber(ChillNum)%Name)// &
'" Evaporative Condenser Delta Temperature = 0 in mass flow calculation.', &
BLASTAbsorber(ChillNum)%ErrCount2)
END IF
END IF !End of Constant Variable Flow If Block
ELSE ! If FlowLock is True
EvapMassFlowRate = Node(EvapInletNode)%MassFlowRate
IF(BLASTAbsorber(ChillNum)%PossibleSubCooling) THEN
QEvaporator = ABS(MyLoad)
EvapDeltaTemp = QEvaporator/EvapMassFlowRate/CpFluid
EvapOutletTemp = Node(EvapInletNode)%Temp - EvapDeltaTemp
ELSE
SELECT CASE (PlantLoop(LoopNum)%LoopDemandCalcScheme)
CASE (SingleSetpoint)
IF ((BLASTAbsorber(ChillNum)%FlowMode == LeavingSetpointModulated) .OR. &
(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BLASTAbsorber(ChillNum)%CWBranchNum) &
%Comp(BLASTAbsorber(ChillNum)%CWCompNum)%CurOpSchemeType &
== CompSetPtBasedSchemeType) .OR. &
(Node(EvapOutletNode)%TempSetPoint /= SensedNodeFlagValue) ) THEN
TempEvapOutSetpoint = Node(EvapOutletNode)%TempSetPoint
ELSE
TempEvapOutSetpoint = Node(PlantLoop(LoopNum)%TempSetPointNodeNum)%TempSetPoint
ENDIF
CASE (DualSetpointDeadband)
IF ((BLASTAbsorber(ChillNum)%FlowMode == LeavingSetpointModulated) .OR. &
(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BLASTAbsorber(ChillNum)%CWBranchNum) &
%Comp(BLASTAbsorber(ChillNum)%CWCompNum)%CurOpSchemeType &
== CompSetPtBasedSchemeType) .OR. &
(Node(EvapOutletNode)%TempSetPointHi /= SensedNodeFlagValue) ) THEN
TempEvapOutSetpoint = Node(EvapOutletNode)%TempSetPointHi
ELSE
TempEvapOutSetpoint = Node(PlantLoop(LoopNum)%TempSetPointNodeNum)%TempSetPointHi
ENDIF
END SELECT
EvapDeltaTemp = Node(EvapInletNode)%Temp - TempEvapOutSetpoint
QEvaporator = ABS(EvapMassFlowRate*CpFluid*EvapDeltaTemp)
EvapOutletTemp = TempEvapOutSetpoint
END IF
!Check that the Evap outlet temp honors both plant loop temp low limit and also the chiller low limit
IF(EvapOutletTemp .LT. TempLowLimitEout) THEN
IF((Node(EvapInletNode)%Temp - TempLowLimitEout) .GT. DeltaTemptol) THEN
EvapOutletTemp = TempLowLimitEout
EvapDeltaTemp = Node(EvapInletNode)%Temp - EvapOutletTemp
QEvaporator = EvapMassFlowRate*CpFluid*EvapDeltaTemp
ELSE
EvapOutletTemp = Node(EvapInletNode)%Temp
EvapDeltaTemp = Node(EvapInletNode)%Temp - EvapOutletTemp
QEvaporator = EvapMassFlowRate*CpFluid*EvapDeltaTemp
END IF
END IF
IF(EvapOutletTemp .LT. Node(EvapOutletNode)%TempMin) THEN
IF((Node(EvapInletNode)%Temp - Node(EvapOutletNode)%TempMin) .GT. DeltaTemptol) THEN
EvapOutletTemp = Node(EvapOutletNode)%TempMin
EvapDeltaTemp = Node(EvapInletNode)%Temp - EvapOutletTemp
QEvaporator = EvapMassFlowRate*CpFluid*EvapDeltaTemp
ELSE
EvapOutletTemp = Node(EvapInletNode)%Temp
EvapDeltaTemp = Node(EvapInletNode)%Temp - EvapOutletTemp
QEvaporator = EvapMassFlowRate*CpFluid*EvapDeltaTemp
END IF
END IF
! Checks QEvaporator on the basis of the machine limits.
If(QEvaporator > ABS(MyLoad)) Then
If(EvapMassFlowRate > MassFlowTolerance) THEN
QEvaporator = ABS(MyLoad)
EvapDeltaTemp = QEvaporator/EvapMassFlowRate/CpFluid
EvapOutletTemp = Node(EvapInletNode)%Temp - EvapDeltaTemp
Else
QEvaporator = 0.0d0
EvapOutletTemp = Node(EvapInletNode)%Temp
End If
End If
END IF !This is the end of the FlowLock Block
!Calculate part load ratio for efficiency calcs. If this part load ratio is greater than
!Min PLR it will be used for calculations too.
PartLoadRat = MAX(MinPartLoadRat,MIN(QEvaporator / AbsorberNomCap,MaxPartLoadRat))
!In case myload is less than the Min PLR load, the power and steam input should be adjusted
!for cycling. The ratios used however are based on MinPLR.
OperPartLoadRat = QEvaporator/AbsorberNomCap
IF(OperPartLoadRat .LT. PartLoadRat) THEN
FRAC = MIN(1.0d0,OperPartLoadRat/MinPartLoadRat)
ELSE
FRAC = 1.0d0
END IF
!Calculate steam input ratio
SteamInputRat = SteamLoadFactor(1)/PartLoadRat + SteamLoadFactor(2) + SteamLoadFactor(3) * PartLoadRat
!Calculate electric input ratio
ElectricInputRat = ElectricLoadFactor(1) + ElectricLoadFactor(2)*PartLoadRat + ElectricLoadFactor(3) * PartLoadRat**2
!Calculate electric energy input
PumpingPower = ElectricInputRat * NomPumpPower * FRAC
!Calculate steam load
QGenerator = SteamInputRat * QEvaporator * FRAC
IF(EvapMassFlowRate == 0.0d0) THEN
QGenerator = 0.0d0
EvapOutletTemp = Node(EvapInletNode)%Temp
PumpingPower = 0.0d0
END IF
QCondenser = QEvaporator + QGenerator + PumpingPower
CpFluid = GetSpecificHeatGlycol(PlantLoop(BLASTAbsorber(ChillNum)%CDLoopNum)%FluidName, &
CondInletTemp, &
PlantLoop(BLASTAbsorber(ChillNum)%CDLoopNum)%FluidIndex, &
'CalcBLASTAbsorberModel')
IF (CondMassFlowRate > MassFlowTolerance) THEN
CondOutletTemp = QCondenser/CondMassFlowRate/CpFluid + CondInletTemp
ELSE
CondOutletTemp = CondInletTemp
CondMassFlowRate = 0.d0
QCondenser = 0.d0
RETURN
! V7 plant upgrade, no longer fatal here anymore, set some things and return
END IF
IF (GeneratorInletNode .GT. 0) THEN
! Hot water plant is used for the generator
IF(BLASTAbsorber(ChillNum)%GenHeatSourceType == NodeType_Water)THEN
CpFluid = GetSpecificHeatGlycol(PlantLoop(BLASTAbsorber(ChillNum)%GenLoopNum)%FluidName, &
Node(GeneratorInletNode)%Temp, &
PlantLoop(BLASTAbsorber(ChillNum)%GenLoopNum)%FluidIndex, &
'CalcBLASTAbsorberModel')
IF ((BLASTAbsorber(ChillNum)%FlowMode == ConstantFlow) &
.OR. (BLASTAbsorber(ChillNum)%FlowMode == NotModulated )) THEN
SteamMassFlowRate = BLASTAbsorber(ChillNum)%GenMassFlowRateMax
ELSE
SteamMassFlowRate = QGenerator/CpFluid/BLASTAbsorber(ChillNum)%GeneratorDeltaTemp
END IF
Call SetComponentFlowRate(SteamMassFlowRate, &
GeneratorInletNode, GeneratorOutletNode, &
BLASTAbsorber(ChillNum)%GenLoopNum, &
BLASTAbsorber(ChillNum)%GenLoopSideNum, &
BLASTAbsorber(ChillNum)%GenBranchNum, &
BLASTAbsorber(ChillNum)%GenCompNum)
IF(SteamMassFlowRate .LE. 0.0d0)THEN
GenOutletTemp = Node(GeneratorInletNode)%Temp
SteamOutletEnthalpy = Node(GeneratorInletNode)%Enthalpy
ELSE
GenOutletTemp = Node(GeneratorInletNode)%Temp - QGenerator/(CpFluid*SteamMassFlowRate)
SteamOutletEnthalpy = Node(GeneratorInletNode)%Enthalpy - QGenerator/SteamMassFlowRate
END IF
ELSE ! using a steam plant for the generator
EnthSteamOutDry = GetSatEnthalpyRefrig('STEAM',Node(GeneratorInletNode)%Temp,1.0d0, &
BLASTAbsorber(ChillNum)%SteamFluidIndex, &
'CALC Chiller:Absorption '//TRIM(BLASTAbsorber(ChillNum)%Name))
EnthSteamOutWet = GetSatEnthalpyRefrig('STEAM',Node(GeneratorInletNode)%Temp,0.0d0, &
BLASTAbsorber(ChillNum)%SteamFluidIndex, &
'CALC Chiller:Absorption '//TRIM(BLASTAbsorber(ChillNum)%Name))
SteamDeltaT = BLASTAbsorber(ChillNum)%GeneratorSubCool
SteamOutletTemp = Node(GeneratorInletNode)%Temp - SteamDeltaT
HfgSteam = EnthSteamOutDry - EnthSteamOutWet
CpFluid = GetSpecificHeatGlycol('WATER', SteamOutletTemp, DummyWaterIndex, &
'CALC Chiller:Absorption '//TRIM(BLASTAbsorber(ChillNum)%Name) )
SteamMassFlowRate = QGenerator/(HfgSteam+CpFluid *SteamDeltaT)
Call SetComponentFlowRate(SteamMassFlowRate, &
GeneratorInletNode, GeneratorOutletNode, &
BLASTAbsorber(ChillNum)%GenLoopNum, &
BLASTAbsorber(ChillNum)%GenLoopSideNum, &
BLASTAbsorber(ChillNum)%GenBranchNum, &
BLASTAbsorber(ChillNum)%GenCompNum)
IF(SteamMassFlowRate .LE. 0.0d0)THEN
GenOutletTemp = Node(GeneratorInletNode)%Temp
SteamOutletEnthalpy = Node(GeneratorInletNode)%Enthalpy
ELSE
GenOutletTemp = Node(GeneratorInletNode)%Temp - SteamDeltaT
SteamOutletEnthalpy = GetSatEnthalpyRefrig('STEAM',GenOutletTemp,0.0d0, &
BLASTAbsorber(ChillNum)%SteamFluidIndex, &
'Chiller:Absorption'//TRIM(BLASTAbsorber(ChillNum)%Name))
SteamOutletEnthalpy = SteamOutletEnthalpy - CpFluid*SteamDeltaT
END IF
END IF
END IF ! IF(GeneratorInletNode .GT. 0)THEN
!convert power to energy
GeneratorEnergy = QGenerator*TimeStepSys*SecInHour
EvaporatorEnergy = QEvaporator*TimeStepSys*SecInHour
CondenserEnergy = QCondenser*TimeStepSys*SecInHour
PumpingEnergy = PumpingPower*TimeStepSys*SecInHour
RETURN
END SUBROUTINE CalcBLASTAbsorberModel