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 InitConstCOPChiller(ChillNum,RunFlag, MyLoad)
! SUBROUTINE INFORMATION:
! AUTHOR Chandan Sharma
! DATE WRITTEN September 2010
! 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:
! Based on InitElectricChiller from Fred Buhl
! USE STATEMENTS:
USE DataGlobals, ONLY : BeginEnvrnFlag, AnyEnergyManagementSystemInModel
USE DataPlant, ONLY : PlantLoop, ScanPlantLoopsForObject, &
PlantSizeNotComplete, PlantSizesOkayToFinalize, LoopFlowStatus_NeedyIfLoopOn
USE DataEnvironment, ONLY : StdBaroPress
USE Psychrometrics, ONLY : PsyRhoAirFnPbTdbW
USE PlantUtilities, ONLY : InterConnectTwoPlantLoopSides, InitComponentNodes, SetComponentFlowRate
USE FluidProperties, ONLY : GetDensityGlycol
USE EMSManager, ONLY : iTemperatureSetpoint, CheckIfNodeSetpointManagedByEMS
USE DataInterfaces, ONLY : ShowFatalError, ShowSevereError, ShowContinueError
! na
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:
CHARACTER(len=*), PARAMETER :: RoutineName='InitConstCOPChiller'
REAL(r64), parameter :: TempDesCondIn = 25.d0 ! Design condenser inlet temp. C
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL,SAVE :: OneTimeFlag = .true.
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyFlag
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyEnvironFlag
INTEGER :: CondInletNode ! node number of water inlet node to the condenser
INTEGER :: CondOutletNode ! node number of water outlet node from the condenser
INTEGER :: EvapInletNode
INTEGER :: EvapOutletNode
REAL(r64) :: rho ! local fluid density
REAL(r64) :: mdot ! local mass flow rate
REAL(r64) :: mdotCond ! local mass flow rate for condenser
LOGICAL :: FatalError
LOGICAL :: errFlag
!FLOW
! Do the one time initializations
IF (OneTimeFlag) THEN
ALLOCATE(MyFlag(NumConstCOPChillers))
ALLOCATE(MyEnvironFlag(NumConstCOPChillers))
MyFlag = .TRUE.
MyEnvironFlag = .TRUE.
OneTimeFlag = .false.
END IF
EvapInletNode = ConstCOPChiller(ChillNum)%Base%EvapInletNodeNum
EvapOutletNode = ConstCOPChiller(ChillNum)%Base%EvapOutletNodeNum
CondInletNode = ConstCOPChiller(ChillNum)%Base%CondInletNodeNum
CondOutletNode = ConstCOPChiller(ChillNum)%Base%CondOutletNodeNum
! Init more variables
IF (MyFlag(ChillNum)) THEN
! Locate the chillers on the plant loops for later usage
errFlag=.false.
CALL ScanPlantLoopsForObject(ConstCOPChiller(ChillNum)%Base%Name, &
TypeOf_Chiller_ConstCOP, &
ConstCOPChiller(ChillNum)%Base%CWLoopNum, &
ConstCOPChiller(ChillNum)%Base%CWLoopSideNum, &
ConstCOPChiller(ChillNum)%Base%CWBranchNum, &
ConstCOPChiller(ChillNum)%Base%CWCompNum, &
InletNodeNumber = ConstCOPChiller(ChillNum)%Base%EvapInletNodeNum, &
errFlag=errFlag)
IF (ConstCOPChiller(ChillNum)%Base%CondenserType /= AirCooled .AND. &
ConstCOPChiller(ChillNum)%Base%CondenserType /= EvapCooled) THEN
CALL ScanPlantLoopsForObject(ConstCOPChiller(ChillNum)%Base%Name, &
TypeOf_Chiller_ConstCOP, &
ConstCOPChiller(ChillNum)%Base%CDLoopNum, &
ConstCOPChiller(ChillNum)%Base%CDLoopSideNum, &
ConstCOPChiller(ChillNum)%Base%CDBranchNum, &
ConstCOPChiller(ChillNum)%Base%CDCompNum, &
InletNodeNumber = ConstCOPChiller(ChillNum)%Base%CondInletNodeNum, &
errFlag=errFlag)
CALL InterConnectTwoPlantLoopSides( ConstCOPChiller(ChillNum)%Base%CWLoopNum, &
ConstCOPChiller(ChillNum)%Base%CWLoopSideNum, &
ConstCOPChiller(ChillNum)%Base%CDLoopNum, &
ConstCOPChiller(ChillNum)%Base%CDLoopSideNum, &
TypeOf_Chiller_ConstCOP, .TRUE. )
ENDIF
IF (errFlag) THEN
CALL ShowFatalError('CalcConstCOPChillerModel: Program terminated due to previous condition(s).')
ENDIF
IF (ConstCOPChiller(ChillNum)%Base%FlowMode == ConstantFlow ) THEN
! reset flow priority
PlantLoop(ConstCOPChiller(ChillNum)%Base%CWLoopNum)%LoopSide(ConstCOPChiller(ChillNum)%Base%CWLoopSideNum)% &
Branch(ConstCOPChiller(ChillNum)%Base%CWBranchNum)%Comp(ConstCOPChiller(ChillNum)%Base%CWCompNum)%FlowPriority &
= LoopFlowStatus_NeedyIfLoopOn
ENDIF
IF (ConstCOPChiller(ChillNum)%Base%FlowMode == LeavingSetpointModulated ) THEN
! reset flow priority
PlantLoop(ConstCOPChiller(ChillNum)%Base%CWLoopNum)%LoopSide(ConstCOPChiller(ChillNum)%Base%CWLoopSideNum)% &
Branch(ConstCOPChiller(ChillNum)%Base%CWBranchNum)%Comp(ConstCOPChiller(ChillNum)%Base%CWCompNum)%FlowPriority &
= LoopFlowStatus_NeedyIfLoopOn
! check if setpoint on outlet node
IF ((Node(ConstCOPChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPoint == SensedNodeFlagValue) .AND. &
(Node(ConstCOPChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPointHi == SensedNodeFlagValue)) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
IF (.NOT. ConstCOPChiller(ChillNum)%Base%ModulatedFlowErrDone) THEN
CALL ShowWarningError('Missing temperature setpoint for LeavingSetpointModulated mode chiller named ' // &
TRIM(ConstCOPChiller(ChillNum)%Base%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 ... ')
ConstCOPChiller(ChillNum)%Base%ModulatedFlowErrDone = .TRUE.
ENDIF
ELSE
! need call to EMS to check node
FatalError = .FALSE. ! but not really fatal yet, but should be.
CALL CheckIfNodeSetpointManagedByEMS(ConstCOPChiller(ChillNum)%Base%EvapOutletNodeNum,iTemperatureSetpoint, FatalError)
IF (FatalError) THEN
IF (.NOT. ConstCOPChiller(ChillNum)%Base%ModulatedFlowErrDone) THEN
CALL ShowWarningError('Missing temperature setpoint for LeavingSetpointModulated mode chiller named ' // &
TRIM(ConstCOPChiller(ChillNum)%Base%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 ... ')
ConstCOPChiller(ChillNum)%Base%ModulatedFlowErrDone = .TRUE.
ENDIF
ENDIF
ENDIF
ConstCOPChiller(ChillNum)%Base%ModulatedFlowSetToLoop = .TRUE.
Node(ConstCOPChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPoint = &
Node(PlantLoop(ConstCOPChiller(ChillNum)%Base%CWLoopNum)%TempSetPointNodeNum)%TempSetPoint
Node(ConstCOPChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPointHi = &
Node(PlantLoop(ConstCOPChiller(ChillNum)%Base%CWLoopNum)%TempSetPointNodeNum)%TempSetPointHi
ENDIF
ENDIF
MyFlag(ChillNum)=.FALSE.
ENDIF
!Initialize critical Demand Side Variables at the beginning of each environment
IF(MyEnvironFlag(ChillNum) .and. BeginEnvrnFlag .AND. (PlantSizesOkayToFinalize))Then
IF (PlantSizeNotComplete) CALL SizeConstCOPChiller(ChillNum)
rho = GetDensityGlycol(PlantLoop(ConstCOPChiller(ChillNum)%Base%CWLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(ConstCOPChiller(ChillNum)%Base%CWLoopNum)%FluidIndex,&
RoutineName)
ConstCOPChiller(ChillNum)%Base%EvapMassFlowRateMax = ConstCOPChiller(ChillNum)%Base%EvapVolFlowRate * rho
CALL InitComponentNodes(0.0D0,ConstCOPChiller(ChillNum)%Base%EvapMassFlowRateMax, &
EvapInletNode, &
EvapOutletNode, &
ConstCOPChiller(ChillNum)%Base%CWLoopNum, &
ConstCOPChiller(ChillNum)%Base%CWLoopSideNum, &
ConstCOPChiller(ChillNum)%Base%CWBranchNum, &
ConstCOPChiller(ChillNum)%Base%CWCompNum)
!init maximum available condenser flow rate
IF (ConstCOPChiller(ChillNum)%Base%CondenserType == WaterCooled) THEN
Node(CondInletNode)%Temp = TempDesCondIn
rho = GetDensityGlycol(PlantLoop(ConstCOPChiller(ChillNum)%Base%CDLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(ConstCOPChiller(ChillNum)%Base%CDLoopNum)%FluidIndex,&
RoutineName)
ConstCOPChiller(ChillNum)%Base%CondMassFlowRateMax = rho * ConstCOPChiller(ChillNum)%Base%CondVolFlowRate
CALL InitComponentNodes(0.0D0, ConstCOPChiller(ChillNum)%Base%CondMassFlowRateMax, &
CondInletNode, &
CondOutletNode, &
ConstCOPChiller(ChillNum)%Base%CDLoopNum, &
ConstCOPChiller(ChillNum)%Base%CDLoopSideNum, &
ConstCOPChiller(ChillNum)%Base%CDBranchNum, &
ConstCOPChiller(ChillNum)%Base%CDCompNum)
ELSE ! air or evap-air
Node(CondInletNode)%MassFlowRate = ConstCOPChiller(ChillNum)%Base%CondVolFlowRate * &
PsyRhoAirFnPbTdbW(StdBaroPress,TempDesCondIn,0.0D0,RoutineName)
Node(CondOutletNode)%MassFlowrate = Node(CondInletNode)%MassFlowrate
Node(CondInletNode)%MassFlowRateMaxAvail = Node(CondInletNode)%MassFlowrate
Node(CondInletNode)%MassFlowRateMax = Node(CondInletNode)%MassFlowrate
Node(CondOutletNode)%MassFlowRateMax = Node(CondInletNode)%MassFlowrate
Node(CondInletNode)%MassFlowRateMinAvail = 0.0d0
Node(CondInletNode)%MassFlowRateMin = 0.0d0
Node(CondOutletNode)%MassFlowRateMinAvail = 0.0d0
Node(CondOutletNode)%MassFlowRateMin = 0.0d0
END IF
MyEnvironFlag(ChillNum) = .FALSE.
END IF
IF (.not. BeginEnvrnFlag) THEN
MyEnvironFlag(ChillNum)=.true.
ENDIF
IF ((ConstCOPChiller(ChillNum)%Base%FlowMode == LeavingSetpointModulated) &
.AND. (ConstCOPChiller(ChillNum)%Base%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(ConstCOPChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPoint = &
Node(PlantLoop(ConstCOPChiller(ChillNum)%Base%CWLoopNum)%TempSetPointNodeNum)%TempSetPoint
Node(ConstCOPChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPointHi = &
Node(PlantLoop(ConstCOPChiller(ChillNum)%Base%CWLoopNum)%TempSetPointNodeNum)%TempSetPointHi
ENDIF
IF ((MyLoad < 0.d0) .AND. RunFlag) THEN
mdot = ConstCOPChiller(ChillNum)%Base%EvapMassFlowRateMax
mdotCond = ConstCOPChiller(ChillNum)%Base%CondMassFlowRateMax
ELSE
mdot = 0.d0
mdotCond = 0.d0
ENDIF
CALL SetComponentFlowRate( mdot, EvapInletNode, EvapOutletNode, &
ConstCOPChiller(ChillNum)%Base%CWLoopNum, &
ConstCOPChiller(ChillNum)%Base%CWLoopSideNum, &
ConstCOPChiller(ChillNum)%Base%CWBranchNum, &
ConstCOPChiller(ChillNum)%Base%CWCompNum)
IF (ConstCOPChiller(ChillNum)%Base%CondenserType == WaterCooled) THEN
CALL SetComponentFlowRate( mdotCond, CondInletNode, CondOutletNode, &
ConstCOPChiller(ChillNum)%Base%CDLoopNum, &
ConstCOPChiller(ChillNum)%Base%CDLoopSideNum, &
ConstCOPChiller(ChillNum)%Base%CDBranchNum, &
ConstCOPChiller(ChillNum)%Base%CDCompNum)
ENDIF
IF (ConstCOPChiller(ChillNum)%Base%CondenserType == EvapCooled) THEN
BasinHeaterPower = 0.0d0
ENDIF
END SUBROUTINE InitConstCOPChiller