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 InitIndirectAbsorpChiller(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 Indirect Absorption 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_Indirect_Absorption, ScanPlantLoopsForObject, &
PlantSizeNotComplete, PlantSizesOkayToFinalize, LoopFlowStatus_NeedyIfLoopOn
USE InputProcessor, ONLY : SameString
USE PlantUtilities, ONLY : InterConnectTwoPlantLoopSides, InitComponentNodes, SetComponentFlowRate
USE EMSManager, ONLY : iTemperatureSetpoint, CheckIfNodeSetpointManagedByEMS
USE FluidProperties, ONLY : GetDensityGlycol, GetSatDensityRefrig
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 ! requested load
! 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(NumIndirectAbsorbers))
ALLOCATE(MyEnvrnFlag(NumIndirectAbsorbers))
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(IndirectAbsorber(ChillNum)%Name, &
TypeOf_Chiller_Indirect_Absorption, &
IndirectAbsorber(ChillNum)%CWLoopNum, &
IndirectAbsorber(ChillNum)%CWLoopSideNum, &
IndirectAbsorber(ChillNum)%CWBranchNum, &
IndirectAbsorber(ChillNum)%CWCompNum, &
LowLimitTemp = IndirectAbsorber(ChillNum)%TempLowLimitEvapOut, &
InletNodeNumber = IndirectAbsorber(ChillNum)%EvapInletNodeNum, &
errFlag=errFlag)
CALL ScanPlantLoopsForObject(IndirectAbsorber(ChillNum)%Name, &
TypeOf_Chiller_Indirect_Absorption, &
IndirectAbsorber(ChillNum)%CDLoopNum, &
IndirectAbsorber(ChillNum)%CDLoopSideNum, &
IndirectAbsorber(ChillNum)%CDBranchNum, &
IndirectAbsorber(ChillNum)%CDCompNum, &
InletNodeNumber = IndirectAbsorber(ChillNum)%CondInletNodeNum, &
errFlag=errFlag)
CALL InterConnectTwoPlantLoopSides( IndirectAbsorber(ChillNum)%CWLoopNum, &
IndirectAbsorber(ChillNum)%CWLoopSideNum, &
IndirectAbsorber(ChillNum)%CDLoopNum, &
IndirectAbsorber(ChillNum)%CDLoopSideNum, &
TypeOf_Chiller_Indirect_Absorption, .TRUE. )
IF (IndirectAbsorber(ChillNum)%GeneratorInletNodeNum > 0 ) THEN
CALL ScanPlantLoopsForObject(IndirectAbsorber(ChillNum)%Name, &
TypeOf_Chiller_Indirect_Absorption, &
IndirectAbsorber(ChillNum)%GenLoopNum, &
IndirectAbsorber(ChillNum)%GenLoopSideNum, &
IndirectAbsorber(ChillNum)%GenBranchNum, &
IndirectAbsorber(ChillNum)%GenCompNum, &
InletNodeNumber = IndirectAbsorber(ChillNum)%GeneratorInletNodeNum, &
errFlag=errFlag)
CALL InterConnectTwoPlantLoopSides( IndirectAbsorber(ChillNum)%CWLoopNum, &
IndirectAbsorber(ChillNum)%CWLoopSideNum, &
IndirectAbsorber(ChillNum)%GenLoopNum, &
IndirectAbsorber(ChillNum)%GenCompNum, &
TypeOf_Chiller_Indirect_Absorption, .TRUE. )
ENDIF
IF ((IndirectAbsorber(ChillNum)%CondInletNodeNum > 0 ) .AND. &
(IndirectAbsorber(ChillNum)%GeneratorInletNodeNum > 0 ) ) THEN
CALL InterConnectTwoPlantLoopSides( IndirectAbsorber(ChillNum)%CDLoopNum, &
IndirectAbsorber(ChillNum)%CDLoopSideNum, &
IndirectAbsorber(ChillNum)%GenLoopNum, &
IndirectAbsorber(ChillNum)%GenCompNum, &
TypeOf_Chiller_Indirect_Absorption , .FALSE.)
ENDIF
IF (errFlag) THEN
CALL ShowFatalError('InitIndirectAbsorpChiller: Program terminated due to previous condition(s).')
ENDIF
IF (IndirectAbsorber(ChillNum)%FlowMode == ConstantFlow ) THEN
! reset flow priority
PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%LoopSide(IndirectAbsorber(ChillNum)%CWLoopSideNum)% &
Branch(IndirectAbsorber(ChillNum)%CWBranchNum)%Comp(IndirectAbsorber(ChillNum)%CWCompNum)%FlowPriority &
= LoopFlowStatus_NeedyIfLoopOn
ENDIF
IF (IndirectAbsorber(ChillNum)%FlowMode == LeavingSetpointModulated ) THEN
! reset flow priority
PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%LoopSide(IndirectAbsorber(ChillNum)%CWLoopSideNum)% &
Branch(IndirectAbsorber(ChillNum)%CWBranchNum)%Comp(IndirectAbsorber(ChillNum)%CWCompNum)%FlowPriority &
= LoopFlowStatus_NeedyIfLoopOn
IF ((Node(IndirectAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPoint == SensedNodeFlagValue) .AND. &
(Node(IndirectAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPointHi == SensedNodeFlagValue)) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
IF (.NOT. IndirectAbsorber(ChillNum)%ModulatedFlowErrDone) THEN
CALL ShowWarningError('Missing temperature setpoint for LeavingSetpointModulated mode chiller named ' // &
TRIM(IndirectAbsorber(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 ... ')
IndirectAbsorber(ChillNum)%ModulatedFlowErrDone = .TRUE.
ENDIF
ELSE
! need call to EMS to check node
FatalError = .FALSE. ! but not really fatal yet, but should be.
CALL CheckIfNodeSetpointManagedByEMS(IndirectAbsorber(ChillNum)%EvapOutletNodeNum,iTemperatureSetpoint, FatalError)
IF (FatalError) THEN
IF (.NOT. IndirectAbsorber(ChillNum)%ModulatedFlowErrDone) THEN
CALL ShowWarningError('Missing temperature setpoint for LeavingSetpointModulated mode chiller named ' // &
TRIM(IndirectAbsorber(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 ... ')
IndirectAbsorber(ChillNum)%ModulatedFlowErrDone = .TRUE.
ENDIF
ENDIF
ENDIF
IndirectAbsorber(ChillNum)%ModulatedFlowSetToLoop = .TRUE.
Node(IndirectAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPoint = &
Node(PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%TempSetPointNodeNum)%TempSetPoint
Node(IndirectAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPointHi = &
Node(PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%TempSetPointNodeNum)%TempSetPointHi
ENDIF
ENDIF
MyFlag(ChillNum)=.FALSE.
ENDIF
CondInletNode = IndirectAbsorber(ChillNum)%CondInletNodeNum
CondOutletNode = IndirectAbsorber(ChillNum)%CondOutletNodeNum
!Initialize Supply Side Variables
IF(MyEnvrnFlag(ChillNum) .and. BeginEnvrnFlag .AND. (PlantSizesOkayToFinalize) )Then
IF (PlantSizeNotComplete) CALL SizeIndirectAbsorpChiller(ChillNum)
rho = GetDensityGlycol(PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%FluidIndex, &
'InitIndirectAbsorpChiller')
IndirectAbsorber(ChillNum)%EvapMassFlowRateMax = IndirectAbsorber(ChillNum)%EvapVolFlowRate * rho
CALL InitComponentNodes(0.d0, IndirectAbsorber(ChillNum)%EvapMassFlowRateMax, &
IndirectAbsorber(ChillNum)%EvapInletNodeNum, &
IndirectAbsorber(ChillNum)%EvapOutletNodeNum, &
IndirectAbsorber(ChillNum)%CWLoopNum, &
IndirectAbsorber(ChillNum)%CWLoopSideNum, &
IndirectAbsorber(ChillNum)%CWBranchNum, &
IndirectAbsorber(ChillNum)%CWCompNum)
rho = GetDensityGlycol(PlantLoop(IndirectAbsorber(ChillNum)%CDLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(IndirectAbsorber(ChillNum)%CDLoopNum)%FluidIndex, &
'InitIndirectAbsorpChiller')
IndirectAbsorber(ChillNum)%CondMassFlowRateMax = rho * IndirectAbsorber(ChillNum)%CondVolFlowRate
CALL InitComponentNodes(0.d0, IndirectAbsorber(ChillNum)%CondMassFlowRateMax, &
CondInletNode, CondOutletNode, &
IndirectAbsorber(ChillNum)%CDLoopNum, &
IndirectAbsorber(ChillNum)%CDLoopSideNum, &
IndirectAbsorber(ChillNum)%CDBranchNum, &
IndirectAbsorber(ChillNum)%CDCompNum)
Node(CondInletNode)%Temp = IndirectAbsorber(ChillNum)%TempDesCondIn
IF (IndirectAbsorber(ChillNum)%GeneratorInletNodeNum > 0 ) THEN
IF(IndirectAbsorber(ChillNum)%GenHeatSourceType == NodeType_Water)THEN
rho = GetDensityGlycol(PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidIndex, &
'InitIndirectAbsorpChiller')
IndirectAbsorber(ChillNum)%GenMassFlowRateMax = rho * IndirectAbsorber(ChillNum)%GeneratorVolFlowRate
ELSE
SteamDensity = GetSatDensityRefrig('STEAM',Node(IndirectAbsorber(ChillNum)%GeneratorInletNodeNum)%Temp,1.0d0, &
IndirectAbsorber(ChillNum)%SteamFluidIndex, &
'CALC Chiller:Absorption:Indirect '//TRIM(IndirectAbsorber(ChillNum)%Name))
IndirectAbsorber(ChillNum)%GenMassFlowRateMax = SteamDensity*IndirectAbsorber(ChillNum)%GeneratorVolFlowRate
END IF
CALL InitComponentNodes(0.d0, IndirectAbsorber(ChillNum)%GenMassFlowRateMax, &
IndirectAbsorber(ChillNum)%GeneratorInletNodeNum, &
IndirectAbsorber(ChillNum)%GeneratorOutletNodeNum, &
IndirectAbsorber(ChillNum)%GenLoopNum, &
IndirectAbsorber(ChillNum)%GenLoopSideNum, &
IndirectAbsorber(ChillNum)%GenBranchNum, &
IndirectAbsorber(ChillNum)%GenCompNum)
ENDIF
MyEnvrnFlag(ChillNum) = .FALSE.
END IF
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(ChillNum)=.TRUE.
ENDIF
IF ((IndirectAbsorber(ChillNum)%FlowMode == LeavingSetpointModulated) &
.AND. IndirectAbsorber(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(IndirectAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPoint = &
Node(PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%TempSetPointNodeNum)%TempSetPoint
Node(IndirectAbsorber(ChillNum)%EvapOutletNodeNum)%TempSetPointHi = &
Node(PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%TempSetPointNodeNum)%TempSetPointHi
ENDIF
IF ((MyLoad < 0.d0) .AND. RunFlag) THEN
mdotEvap = IndirectAbsorber(ChillNum)%EvapMassFlowRateMax
mdotCond = IndirectAbsorber(ChillNum)%CondMassFlowRateMax
mdotGen = IndirectAbsorber(ChillNum)%GenMassFlowRateMax
ELSE
mdotEvap = 0.d0
mdotCond = 0.d0
mdotGen = 0.d0
ENDIF
CALL SetComponentFlowRate( mdotEvap, &
IndirectAbsorber(ChillNum)%EvapInletNodeNum, &
IndirectAbsorber(ChillNum)%EvapOutletNodeNum,&
IndirectAbsorber(ChillNum)%CWLoopNum, &
IndirectAbsorber(ChillNum)%CWLoopSideNum, &
IndirectAbsorber(ChillNum)%CWBranchNum, &
IndirectAbsorber(ChillNum)%CWCompNum)
CALL SetComponentFlowRate( mdotCond, CondInletNode, CondOutletNode, &
IndirectAbsorber(ChillNum)%CDLoopNum, &
IndirectAbsorber(ChillNum)%CDLoopSideNum, &
IndirectAbsorber(ChillNum)%CDBranchNum, &
IndirectAbsorber(ChillNum)%CDCompNum)
IF (IndirectAbsorber(ChillNum)%GeneratorInletNodeNum > 0 ) THEN
CALL SetComponentFlowRate( mdotGen, &
IndirectAbsorber(ChillNum)%GeneratorInletNodeNum, &
IndirectAbsorber(ChillNum)%GeneratorOutletNodeNum, &
IndirectAbsorber(ChillNum)%GenLoopNum, &
IndirectAbsorber(ChillNum)%GenLoopSideNum, &
IndirectAbsorber(ChillNum)%GenBranchNum, &
IndirectAbsorber(ChillNum)%GenCompNum)
ENDIF
RETURN
END SUBROUTINE InitIndirectAbsorpChiller