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 | |||
logical, | intent(in) | :: | RunFlag | |||
real(kind=r64), | intent(in) | :: | MyLoad |
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 InitBLASTAbsorberModel(ChillNum,RunFlag, MyLoad)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad
! DATE WRITTEN September 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the Electric Chiller components
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY : BeginEnvrnFlag, AnyEnergyManagementSystemInModel
USE DataPlant, ONLY : PlantLoop, TypeOf_Chiller_Absorption, ScanPlantLoopsForObject, &
PlantSizeNotComplete, PlantSizesOkayToFinalize, LoopFlowStatus_NeedyIfLoopOn
USE InputProcessor, ONLY : SameString
USE PlantUtilities, ONLY : InterConnectTwoPlantLoopSides, InitComponentNodes, SetComponentFlowRate
Use FluidProperties, ONLY : GetDensityGlycol, GetSatEnthalpyRefrig, GetSatDensityRefrig
USE EMSManager, ONLY : iTemperatureSetpoint, CheckIfNodeSetpointManagedByEMS
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: ChillNum ! number of the current electric chiller being simulated
LOGICAL, INTENT(IN) :: RunFlag ! TRUE when chiller operating
REAL(r64), INTENT(IN):: MyLoad
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyFlag
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyEnvrnFlag
INTEGER :: CondInletNode ! node number of water inlet node to the condenser
INTEGER :: CondOutletNode ! node number of water outlet node from the condenser
INTEGER :: LoopCtr ! Plant loop counter
INTEGER :: LoopSideCtr ! Loop side counter
INTEGER :: BranchCtr ! Plant branch counter
INTEGER :: CompCtr ! Component counter
LOGICAL :: errFlag
LOGICAL :: FatalError
REAL(r64) :: rho ! local fluid density
REAL(r64) :: CpWater ! local specific heat
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
INTEGER :: GeneratorInletNode ! generator inlet node number, steam/water side
REAL(r64) :: SteamOutletTemp
INTEGER :: DummyWaterIndex = 1
REAL(r64) :: mdotEvap ! local fluid mass flow rate thru evaporator
REAL(r64) :: mdotCond ! local fluid mass flow rate thru condenser
REAL(r64) :: mdotGen ! local fluid mass flow rate thru generator
! FLOW:
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyFlag(NumBLASTAbsorbers))
ALLOCATE(MyEnvrnFlag(NumBLASTAbsorbers))
MyFlag = .TRUE.
MyEnvrnFlag = .TRUE.
MyOneTimeFlag = .false.
END IF
! Init more variables
IF (MyFlag(ChillNum)) THEN
! Locate the chillers on the plant loops for later usage
errFlag=.false.
CALL ScanPlantLoopsForObject(BLASTAbsorber(ChillNum)%Name, &
TypeOf_Chiller_Absorption, &
BLASTAbsorber(ChillNum)%CWLoopNum, &
BLASTAbsorber(ChillNum)%CWLoopSideNum, &
BLASTAbsorber(ChillNum)%CWBranchNum, &
BLASTAbsorber(ChillNum)%CWCompNum, &
LowLimitTemp = BLASTAbsorber(ChillNum)%TempLowLimitEvapOut, &
InletNodeNumber = BLASTAbsorber(ChillNum)%EvapInletNodeNum, &
errFlag=errFlag)
IF (BLASTAbsorber(ChillNum)%CondInletNodeNum > 0) THEN
CALL ScanPlantLoopsForObject(BLASTAbsorber(ChillNum)%Name, &
TypeOf_Chiller_Absorption, &
BLASTAbsorber(ChillNum)%CDLoopNum, &
BLASTAbsorber(ChillNum)%CDLoopSideNum, &
BLASTAbsorber(ChillNum)%CDBranchNum, &
BLASTAbsorber(ChillNum)%CDCompNum, &
InletNodeNumber = BLASTAbsorber(ChillNum)%CondInletNodeNum, &
errFlag=errFlag)
CALL InterConnectTwoPlantLoopSides( BLASTAbsorber(ChillNum)%CWLoopNum, &
BLASTAbsorber(ChillNum)%CWLoopSideNum, &
BLASTAbsorber(ChillNum)%CDLoopNum, &
BLASTAbsorber(ChillNum)%CDLoopSideNum, &
TypeOf_Chiller_Absorption, .TRUE. )
ENDIF
IF (BLASTAbsorber(ChillNum)%GeneratorInletNodeNum > 0 ) THEN
CALL ScanPlantLoopsForObject(BLASTAbsorber(ChillNum)%Name, &
TypeOf_Chiller_Absorption, &
BLASTAbsorber(ChillNum)%GenLoopNum, &
BLASTAbsorber(ChillNum)%GenLoopSideNum, &
BLASTAbsorber(ChillNum)%GenBranchNum, &
BLASTAbsorber(ChillNum)%GenCompNum, &
InletNodeNumber = BLASTAbsorber(ChillNum)%GeneratorInletNodeNum, &
errFlag=errFlag)
CALL InterConnectTwoPlantLoopSides( BLASTAbsorber(ChillNum)%CWLoopNum, &
BLASTAbsorber(ChillNum)%CWLoopSideNum, &
BLASTAbsorber(ChillNum)%GenLoopNum, &
BLASTAbsorber(ChillNum)%GenCompNum, &
TypeOf_Chiller_Absorption, .TRUE. )
ENDIF
!Fill in connection data
IF ( (BLASTAbsorber(ChillNum)%CondInletNodeNum > 0) .AND. &
(BLASTAbsorber(ChillNum)%GeneratorInletNodeNum > 0 ) ) THEN
CALL InterConnectTwoPlantLoopSides( BLASTAbsorber(ChillNum)%CDLoopNum, &
BLASTAbsorber(ChillNum)%CDLoopSideNum, &
BLASTAbsorber(ChillNum)%GenLoopNum, &
BLASTAbsorber(ChillNum)%GenCompNum, &
TypeOf_Chiller_Absorption, .FALSE. )
ENDIF
IF (errFlag) THEN
CALL ShowFatalError('InitBLASTAbsorberModel: Program terminated due to previous condition(s).')
ENDIF
IF (BLASTAbsorber(ChillNum)%FlowMode == ConstantFlow) THEN
PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%LoopSide(BLASTAbsorber(ChillNum)%CWLoopSideNum)% &
Branch(BLASTAbsorber(ChillNum)%CWBranchNum)%Comp(BLASTAbsorber(ChillNum)%CWCompNum)%FlowPriority &
= LoopFlowStatus_NeedyIfLoopOn
ENDIF
IF (BLASTAbsorber(ChillNum)%FlowMode == LeavingSetpointModulated) THEN
PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%LoopSide(BLASTAbsorber(ChillNum)%CWLoopSideNum)% &
Branch(BLASTAbsorber(ChillNum)%CWBranchNum)%Comp(BLASTAbsorber(ChillNum)%CWCompNum)%FlowPriority &
= LoopFlowStatus_NeedyIfLoopOn
IF ((Node(BLASTAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPoint == SensedNodeFlagValue) .AND. &
(Node(BLASTAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPointHi == SensedNodeFlagValue)) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
IF (.NOT. BLASTAbsorber(ChillNum)%ModulatedFlowErrDone) THEN
CALL ShowWarningError('Missing temperature setpoint for LeavingSetpointModulated mode chiller named ' // &
TRIM(BLASTAbsorber(ChillNum)%Name) )
CALL ShowContinueError(' A temperature setpoint is needed at the outlet node of a chiller ' // &
'in variable flow mode, use a SetpointManager')
CALL ShowContinueError(' The overall loop setpoint will be assumed for chiller. The simulation continues ... ')
BLASTAbsorber(ChillNum)%ModulatedFlowErrDone = .TRUE.
ENDIF
ELSE
! need call to EMS to check node
FatalError = .FALSE. ! but not really fatal yet, but should be.
CALL CheckIfNodeSetpointManagedByEMS(BLASTAbsorber(ChillNum)%EvapOutletNodeNum,iTemperatureSetpoint, FatalError)
IF (FatalError) THEN
IF (.NOT. BLASTAbsorber(ChillNum)%ModulatedFlowErrDone) THEN
CALL ShowWarningError('Missing temperature setpoint for LeavingSetpointModulated mode chiller named ' // &
TRIM(BLASTAbsorber(ChillNum)%Name) )
CALL ShowContinueError(' A temperature setpoint is needed at the outlet node of a chiller evaporator ' // &
'in variable flow mode')
CALL ShowContinueError(' use a Setpoint Manager to establish a setpoint at the chiller evaporator outlet node ')
CALL ShowContinueError(' or use an EMS actuator to establish a setpoint at the outlet node ')
CALL ShowContinueError(' The overall loop setpoint will be assumed for chiller. The simulation continues ... ')
BLASTAbsorber(ChillNum)%ModulatedFlowErrDone = .TRUE.
ENDIF
ENDIF
ENDIF
BLASTAbsorber(ChillNum)%ModulatedFlowSetToLoop = .TRUE.
Node(BLASTAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPoint = &
Node(PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%TempSetPointNodeNum)%TempSetPoint
Node(BLASTAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPointHi = &
Node(PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%TempSetPointNodeNum)%TempSetPointHi
ENDIF
ENDIF
MyFlag(ChillNum)=.FALSE.
ENDIF
CondInletNode = BLASTAbsorber(ChillNum)%CondInletNodeNum
CondOutletNode = BLASTAbsorber(ChillNum)%CondOutletNodeNum
!Initialize critical Demand Side Variables
! IF((MyEnvrnFlag(ChillNum) .and. BeginEnvrnFlag) &
! .OR. (Node(CondInletNode)%MassFlowrate <= 0.0 .AND. RunFlag)) THEN
IF (MyEnvrnFlag(ChillNum) .AND. BeginEnvrnFlag .AND. (PlantSizesOkayToFinalize)) THEN
IF (PlantSizeNotComplete) CALL SizeAbsorpChiller(ChillNum)
rho = GetDensityGlycol(PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%FluidIndex, &
'InitBLASTAbsorberModel')
BLASTAbsorber(ChillNum)%EvapMassFlowRateMax = BLASTAbsorber(ChillNum)%EvapVolFlowRate * rho
CALL InitComponentNodes(0.d0, BLASTAbsorber(ChillNum)%EvapMassFlowRateMax, &
BLASTAbsorber(ChillNum)%EvapInletNodeNum, &
BLASTAbsorber(ChillNum)%EvapOutletNodeNum, &
BLASTAbsorber(ChillNum)%CWLoopNum, &
BLASTAbsorber(ChillNum)%CWLoopSideNum, &
BLASTAbsorber(ChillNum)%CWBranchNum, &
BLASTAbsorber(ChillNum)%CWCompNum)
rho = GetDensityGlycol(PlantLoop(BLASTAbsorber(ChillNum)%CDLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(BLASTAbsorber(ChillNum)%CDLoopNum)%FluidIndex, &
'InitBLASTAbsorberModel')
BLASTAbsorber(ChillNum)%CondMassFlowRateMax = rho * BLASTAbsorber(ChillNum)%CondVolFlowRate
CALL InitComponentNodes(0.d0, BLASTAbsorber(ChillNum)%CondMassFlowRateMax, &
CondInletNode, CondOutletNode, &
BLASTAbsorber(ChillNum)%CDLoopNum, &
BLASTAbsorber(ChillNum)%CDLoopSideNum, &
BLASTAbsorber(ChillNum)%CDBranchNum, &
BLASTAbsorber(ChillNum)%CDCompNum)
Node(CondInletNode)%Temp = BLASTAbsorber(ChillNum)%TempDesCondIn
IF (BLASTAbsorber(ChillNum)%GeneratorInletNodeNum > 0 ) THEN
IF(BLASTAbsorber(ChillNum)%GenHeatSourceType == NodeType_Water)THEN
rho = GetDensityGlycol(PlantLoop(BLASTAbsorber(ChillNum)%GenLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(BLASTAbsorber(ChillNum)%GenLoopNum)%FluidIndex, &
'InitBLASTAbsorberModel')
BLASTAbsorber(ChillNum)%GenMassFlowRateMax = rho * BLASTAbsorber(ChillNum)%GeneratorVolFlowRate
ELSEIF (BLASTAbsorber(ChillNum)%GenHeatSourceType == NodeType_Steam ) THEN
QGenerator = (BLASTAbsorber(ChillNum)%SteamLoadCoef(1) + BLASTAbsorber(ChillNum)%SteamLoadCoef(2) + &
BLASTAbsorber(ChillNum)%SteamLoadCoef(3)) * BLASTAbsorber(ChillNum)%NomCap
GeneratorInletNode = BLASTAbsorber(ChillNum)%GeneratorInletNodeNum
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
SteamDensity = GetSatDensityRefrig('STEAM',Node(GeneratorInletNode)%Temp,1.0d0, &
BLASTAbsorber(ChillNum)%SteamFluidIndex, &
'CALC Chiller:Absorption '//TRIM(BLASTAbsorber(ChillNum)%Name))
CpWater = GetDensityGlycol('WATER', SteamOutletTemp, DummyWaterIndex, &
'CALC Chiller:Absorption '//TRIM(BLASTAbsorber(ChillNum)%Name))
BLASTAbsorber(ChillNum)%GenMassFlowRateMax = QGenerator/(HfgSteam+CpWater*SteamDeltaT)
ENDIF
CALL InitComponentNodes(0.d0, BLASTAbsorber(ChillNum)%GenMassFlowRateMax, &
BLASTAbsorber(ChillNum)%GeneratorInletNodeNum, &
BLASTAbsorber(ChillNum)%GeneratorOutletNodeNum, &
BLASTAbsorber(ChillNum)%GenLoopNum, &
BLASTAbsorber(ChillNum)%GenLoopSideNum, &
BLASTAbsorber(ChillNum)%GenBranchNum, &
BLASTAbsorber(ChillNum)%GenCompNum)
ENDIF
MyEnvrnFlag(ChillNum) = .FALSE.
END IF
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(ChillNum)=.true.
ENDIF
! every time inits
IF ((BLASTAbsorber(ChillNum)%FlowMode == LeavingSetpointModulated) &
.AND. BLASTAbsorber(ChillNum)%ModulatedFlowSetToLoop) THEN
! fix for clumsy old input that worked because loop setpoint was spread.
! could be removed with transition, testing , model change, period of being obsolete.
Node(BLASTAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPoint = &
Node(PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%TempSetPointNodeNum)%TempSetPoint
Node(BLASTAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPointHi = &
Node(PlantLoop(BLASTAbsorber(ChillNum)%CWLoopNum)%TempSetPointNodeNum)%TempSetPointHi
ENDIF
IF ((MyLoad < 0.d0) .AND. RunFlag) THEN
mdotEvap = BLASTAbsorber(ChillNum)%EvapMassFlowRateMax
mdotCond = BLASTAbsorber(ChillNum)%CondMassFlowRateMax
mdotGen = BLASTAbsorber(ChillNum)%GenMassFlowRateMax
ELSE
mdotEvap = 0.d0
mdotCond = 0.d0
mdotGen = 0.d0
ENDIF
CALL SetComponentFlowRate( mdotEvap, &
BLASTAbsorber(ChillNum)%EvapInletNodeNum, &
BLASTAbsorber(ChillNum)%EvapOutletNodeNum,&
BLASTAbsorber(ChillNum)%CWLoopNum, &
BLASTAbsorber(ChillNum)%CWLoopSideNum, &
BLASTAbsorber(ChillNum)%CWBranchNum, &
BLASTAbsorber(ChillNum)%CWCompNum)
CALL SetComponentFlowRate( mdotCond, CondInletNode, CondOutletNode, &
BLASTAbsorber(ChillNum)%CDLoopNum, &
BLASTAbsorber(ChillNum)%CDLoopSideNum, &
BLASTAbsorber(ChillNum)%CDBranchNum, &
BLASTAbsorber(ChillNum)%CDCompNum)
IF (BLASTAbsorber(ChillNum)%GeneratorInletNodeNum > 0 ) THEN
CALL SetComponentFlowRate( mdotGen, &
BLASTAbsorber(ChillNum)%GeneratorInletNodeNum, &
BLASTAbsorber(ChillNum)%GeneratorOutletNodeNum, &
BLASTAbsorber(ChillNum)%GenLoopNum, &
BLASTAbsorber(ChillNum)%GenLoopSideNum, &
BLASTAbsorber(ChillNum)%GenBranchNum, &
BLASTAbsorber(ChillNum)%GenCompNum)
ENDIF
RETURN
END SUBROUTINE InitBLASTAbsorberModel