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) | :: | LoopNum | |||
integer, | intent(in) | :: | LoopSide | |||
integer, | intent(in) | :: | ChillerType | |||
character(len=*), | intent(in) | :: | ChillerName | |||
integer, | intent(in) | :: | EquipFlowCtrl | |||
integer, | intent(inout) | :: | CompIndex | |||
logical, | intent(in) | :: | RunFlag | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
logical, | intent(inout) | :: | InitLoopEquip | |||
real(kind=r64), | intent(inout) | :: | MyLoad | |||
real(kind=r64) | :: | MaxCap | ||||
real(kind=r64) | :: | MinCap | ||||
real(kind=r64) | :: | OptCap | ||||
logical, | intent(in) | :: | GetSizingFactor | |||
real(kind=r64), | intent(inout) | :: | SizingFactor | |||
real(kind=r64), | intent(inout) | :: | TempCondInDesign | |||
real(kind=r64), | intent(inout) | :: | TempEvapOutDesign |
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 SimChiller(LoopNum, LoopSide, ChillerType,ChillerName,EquipFlowCtrl,CompIndex,RunFlag,FirstHVACIteration, &
InitLoopEquip,MyLoad,MaxCap,MinCap,OptCap,GetSizingFactor,SizingFactor,TempCondInDesign, &
TempEvapOutDesign)
! SUBROUTINE INFORMATION:
! AUTHOR Dan Fisher
! DATE WRITTEN Sept. 1998
! MODIFIED April 1999, May 200-Taecheol Kim
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE: This is the Electric chiller model driver. It
! gets the input for the models, initializes simulation variables, call
! the appropriate model and sets up reporting variables.
! METHODOLOGY EMPLOYED: na
! REFERENCES: na
! USE STATEMENTS:
USE InputProcessor, ONLY: FindItemInList
USE PlantUtilities, ONLY: UpdateChillerComponentCondenserSide, UpdateComponentHeatRecoverySide
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: LoopNum ! Flow control mode for the equipment
INTEGER, INTENT(IN) :: LoopSide ! chiller number pointer
INTEGER, INTENT(IN) :: ChillerType ! type of chiller
CHARACTER(len=*), INTENT(IN) :: ChillerName ! user specified name of chiller
INTEGER, INTENT(IN) :: EquipFlowCtrl ! Flow control mode for the equipment
INTEGER, INTENT(INOUT) :: CompIndex ! chiller number pointer
LOGICAL , INTENT(IN) :: RunFlag ! simulate chiller when TRUE
LOGICAL , INTENT(IN) :: FirstHVACIteration ! initialize variables when TRUE
LOGICAL, INTENT(INOUT) :: InitLoopEquip ! If not zero, calculate the max load for operating conditions
REAL(r64), INTENT(INOUT) :: MyLoad ! loop demand component will meet
REAL(r64) :: MinCap ! W - minimum operating capacity of chiller
REAL(r64) :: MaxCap ! W - maximum operating capacity of chiller
REAL(r64) :: OptCap ! W - optimal operating capacity of chiller
LOGICAL, INTENT(IN) :: GetSizingFactor ! TRUE when just the sizing factor is requested
REAL(r64), INTENT(INOUT) :: SizingFactor ! sizing factor
REAL(r64), INTENT(INOUT) :: TempCondInDesign !design condenser inlet temperature, water side
REAL(r64), INTENT(INOUT) :: TempEvapOutDesign !design evaporator outlet temperature, water side
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ChillNum ! chiller number pointer
SELECT CASE (ChillerType)
CASE (TypeOf_Chiller_Electric)
!Get chiller data from input file
IF (GetElectricInput) THEN
CALL GetElectricChillerInput
GetElectricInput = .FALSE.
END IF
! Find the correct Chiller
IF (CompIndex == 0) THEN
ChillNum = FindItemInList(ChillerName,ElectricChiller%Base%Name,NumElectricChillers)
IF (ChillNum == 0) THEN
CALL ShowFatalError('SimElectricChiller: Specified Chiller not one of Valid Electric Chillers='//TRIM(ChillerName))
ENDIF
CompIndex=ChillNum
ELSE
ChillNum=CompIndex
IF (ChillNum > NumElectricChillers .or. ChillNum < 1) THEN
CALL ShowFatalError('SimElectricChiller: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(ChillNum))// &
', Number of Units='//TRIM(TrimSigDigits(NumElectricChillers))// &
', Entered Unit name='//TRIM(ChillerName))
ENDIF
IF (ElectricChiller(ChillNum)%Base%CheckEquipName) THEN
IF (ChillerName /= ElectricChiller(ChillNum)%Base%Name) THEN
CALL ShowFatalError('SimElectricChiller: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(ChillNum))// &
', Unit name='//TRIM(ChillerName)//', stored Unit Name for that index='// &
TRIM(ElectricChiller(ChillNum)%Base%Name))
ENDIF
ElectricChiller(ChillNum)%Base%CheckEquipName=.false.
ENDIF
ENDIF
IF (InitLoopEquip) THEN
TempEvapOutDesign = ElectricChiller(ChillNum)%TempDesEvapOut
TempCondInDesign = ElectricChiller(ChillNum)%TempDesCondIn
CALL InitElectricChiller(ChillNum,RunFlag,MyLoad)
CALL SizeElectricChiller(ChillNum)
IF (LoopNum == ElectricChiller(ChillNum)%Base%CWLoopNum) THEN ! chilled water loop
MinCap = ElectricChiller(ChillNum)%Base%NomCap*ElectricChiller(ChillNum)%MinPartLoadRat
MaxCap = ElectricChiller(ChillNum)%Base%NomCap*ElectricChiller(ChillNum)%MaxPartLoadRat
OptCap = ElectricChiller(ChillNum)%Base%NomCap*ElectricChiller(ChillNum)%OptPartLoadRat
ELSE
MinCap = 0.d0
MaxCap = 0.d0
OptCap = 0.d0
ENDIF
IF (GetSizingFactor) THEN
SizingFactor = ElectricChiller(ChillNum)%Base%SizFac
END IF
RETURN
END IF
! calculate model depending on where called from
IF (LoopNum == ElectricChiller(ChillNum)%Base%CWLoopNum) THEN ! chilled water loop
CALL InitElectricChiller(ChillNum,RunFlag,MyLoad)
CALL CalcElectricChillerModel(ChillNum,MyLoad,EquipFlowCtrl,Runflag)
CALL UpdateElectricChillerRecords(MyLoad,RunFlag,ChillNum)
ELSEIF (LoopNum == ElectricChiller(ChillNum)%Base%CDLoopNum) THEN ! condenser loop
CALL UpdateChillerComponentCondenserSide(ElectricChiller(ChillNum)%Base%CDLoopNum, &
ElectricChiller(ChillNum)%Base%CDLoopSideNum, &
TypeOf_Chiller_Electric, &
ElectricChiller(ChillNum)%Base%CondInletNodeNum, &
ElectricChiller(ChillNum)%Base%CondOutletNodeNum, &
ElectricChillerReport(ChillNum)%Base%QCond, &
ElectricChillerReport(ChillNum)%Base%CondInletTemp, &
ElectricChillerReport(ChillNum)%Base%CondOutletTemp, &
ElectricChillerReport(ChillNum)%Base%Condmdot, &
FirstHVACIteration)
ELSEIF (LoopNum == ElectricChiller(ChillNum)%HRLoopNum) THEN ! heat recovery loop
CALL UpdateComponentHeatRecoverySide(ElectricChiller(ChillNum)%HRLoopNum, &
ElectricChiller(ChillNum)%HRLoopSideNum, &
TypeOf_Chiller_Electric, &
ElectricChiller(ChillNum)%HeatRecInletNodeNum, &
ElectricChiller(ChillNum)%HeatRecOutletNodeNum, &
ElectricChillerReport(ChillNum)%QHeatRecovery, &
ElectricChillerReport(ChillNum)%HeatRecInletTemp, &
ElectricChillerReport(ChillNum)%HeatRecOutletTemp, &
ElectricChillerReport(ChillNum)%HeatRecMassFlow , &
FirstHVACIteration)
ENDIF
CASE (TypeOf_Chiller_EngineDriven)
IF (GetEngineDrivenInput) THEN
CALL GetEngineDrivenChillerInput
GetEngineDrivenInput = .FALSE.
END IF
! Find the correct Chiller
IF (CompIndex == 0) THEN
ChillNum = FindItemInList(ChillerName,EngineDrivenChiller%Base%Name,NumEngineDrivenChillers)
IF (ChillNum == 0) THEN
CALL ShowFatalError('SimEngineDrivenChiller: Specified Chiller not one of Valid EngineDriven Chillers='// &
TRIM(ChillerName))
ENDIF
CompIndex=ChillNum
ELSE
ChillNum=CompIndex
IF (ChillNum > NumEngineDrivenChillers .or. ChillNum < 1) THEN
CALL ShowFatalError('SimEngineDrivenChiller: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(ChillNum))// &
', Number of Units='//TRIM(TrimSigDigits(NumEngineDrivenChillers))// &
', Entered Unit name='//TRIM(ChillerName))
ENDIF
IF (EngineDrivenChiller(ChillNum)%Base%CheckEquipName) THEN
IF (ChillerName /= EngineDrivenChiller(ChillNum)%Base%Name) THEN
CALL ShowFatalError('SimEngineDrivenChiller: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(ChillNum))// &
', Unit name='//TRIM(ChillerName)//', stored Unit Name for that index='// &
TRIM(EngineDrivenChiller(ChillNum)%Base%Name))
ENDIF
EngineDrivenChiller(ChillNum)%Base%CheckEquipName=.false.
ENDIF
ENDIF
IF (InitLoopEquip) THEN
TempEvapOutDesign = EngineDrivenChiller(ChillNum)%TempDesEvapOut
TempCondInDesign = EngineDrivenChiller(ChillNum)%TempDesCondIn
CALL InitEngineDrivenChiller(ChillNum, RunFlag, MyLoad)
CALL SizeEngineDrivenChiller(ChillNum)
IF (LoopNum == EngineDrivenChiller(ChillNum)%Base%CWLoopNum) THEN
MinCap = EngineDrivenChiller(ChillNum)%Base%NomCap*EngineDrivenChiller(ChillNum)%MinPartLoadRat
MaxCap = EngineDrivenChiller(ChillNum)%Base%NomCap*EngineDrivenChiller(ChillNum)%MaxPartLoadRat
OptCap = EngineDrivenChiller(ChillNum)%Base%NomCap*EngineDrivenChiller(ChillNum)%OptPartLoadRat
ELSE
MinCap = 0.d0
MaxCap = 0.d0
OptCap = 0.d0
ENDIF
IF (GetSizingFactor) THEN
SizingFactor = EngineDrivenChiller(ChillNum)%Base%SizFac
END IF
RETURN
END IF
! calculate model depending on where called from
IF (LoopNum == EngineDrivenChiller(ChillNum)%Base%CWLoopNum) THEN ! chilled water loop
CALL InitEngineDrivenChiller(ChillNum, RunFlag, MyLoad)
CALL CalcEngineDrivenChillerModel(ChillNum,MyLoad,Runflag,EquipFlowCtrl)
CALL UpdateEngineDrivenChiller(MyLoad,RunFlag,ChillNum)
ELSEIF (LoopNum == EngineDrivenChiller(ChillNum)%Base%CDLoopNum) THEN ! condenser loop
CALL UpdateChillerComponentCondenserSide(EngineDrivenChiller(ChillNum)%Base%CDLoopNum, &
EngineDrivenChiller(ChillNum)%Base%CDLoopSideNum, &
TypeOf_Chiller_EngineDriven, &
EngineDrivenChiller(ChillNum)%Base%CondInletNodeNum, &
EngineDrivenChiller(ChillNum)%Base%CondOutletNodeNum, &
EngineDrivenChillerReport(ChillNum)%Base%QCond, &
EngineDrivenChillerReport(ChillNum)%Base%CondInletTemp, &
EngineDrivenChillerReport(ChillNum)%Base%CondOutletTemp, &
EngineDrivenChillerReport(ChillNum)%Base%Condmdot, &
FirstHVACIteration)
ELSEIF (LoopNum == EngineDrivenChiller(ChillNum)%HRLoopNum) THEN ! heat recovery loop
CALL UpdateComponentHeatRecoverySide(EngineDrivenChiller(ChillNum)%HRLoopNum, &
EngineDrivenChiller(ChillNum)%HRLoopSideNum, &
TypeOf_Chiller_EngineDriven, &
EngineDrivenChiller(ChillNum)%HeatRecInletNodeNum, &
EngineDrivenChiller(ChillNum)%HeatRecOutletNodeNum, &
EngineDrivenChillerReport(ChillNum)%QTotalHeatRecovered, &
EngineDrivenChillerReport(ChillNum)%HeatRecInletTemp, &
EngineDrivenChillerReport(ChillNum)%HeatRecOutletTemp, &
EngineDrivenChillerReport(ChillNum)%HeatRecMdot , &
FirstHVACIteration)
ENDIF
CASE (TypeOf_Chiller_CombTurbine)
IF (GetGasTurbineInput) THEN
CALL GetGTChillerInput
GetGasTurbineInput = .FALSE.
END IF
IF (CompIndex == 0) THEN
ChillNum = FindItemInList(ChillerName,GTChiller%Base%Name,NumGTChillers)
IF (ChillNum == 0) THEN
CALL ShowFatalError('SimGTChiller: Specified Chiller not one of Valid Gas Turbine Chillers='//TRIM(ChillerName))
ENDIF
CompIndex=ChillNum
ELSE
ChillNum=CompIndex
IF (ChillNum > NumGTChillers .or. ChillNum < 1) THEN
CALL ShowFatalError('SimGTChiller: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(ChillNum))// &
', Number of Units='//TRIM(TrimSigDigits(NumGTChillers))// &
', Entered Unit name='//TRIM(ChillerName))
ENDIF
IF (GTChiller(ChillNum)%Base%CheckEquipName) THEN
IF (ChillerName /= GTChiller(ChillNum)%Base%Name) THEN
CALL ShowFatalError('SimGTChiller: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(ChillNum))// &
', Unit name='//TRIM(ChillerName)//', stored Unit Name for that index='// &
TRIM(GTChiller(ChillNum)%Base%Name))
ENDIF
GTChiller(ChillNum)%Base%CheckEquipName=.false.
ENDIF
ENDIF
IF (InitLoopEquip) THEN
TempEvapOutDesign = GTChiller(ChillNum)%TempDesEvapOut
TempCondInDesign = GTChiller(ChillNum)%TempDesCondIn
CALL InitGTChiller(ChillNum,RunFlag, MyLoad)
CALL SizeGTChiller(ChillNum)
IF (LoopNum == GTChiller(ChillNum)%Base%CWLoopNum) THEN
MinCap = GTChiller(ChillNum)%Base%NomCap*GTChiller(ChillNum)%MinPartLoadRat
MaxCap = GTChiller(ChillNum)%Base%NomCap*GTChiller(ChillNum)%MaxPartLoadRat
OptCap = GTChiller(ChillNum)%Base%NomCap*GTChiller(ChillNum)%OptPartLoadRat
ELSE
MinCap = 0.d0
MaxCap = 0.d0
OptCap = 0.d0
ENDIF
IF (GetSizingFactor) THEN
SizingFactor = GTChiller(ChillNum)%Base%SizFac
END IF
RETURN
END IF
! calculate model depending on where called from
IF (LoopNum == GTChiller(ChillNum)%Base%CWLoopNum) THEN ! chilled water loop
CALL InitGTChiller(ChillNum,RunFlag, MyLoad)
CALL CalcGTChillerModel(ChillNum,MyLoad,Runflag,EquipFlowCtrl)
CALL UpdateGTChillerRecords(MyLoad,RunFlag,ChillNum)
ELSEIF (LoopNum == GTChiller(ChillNum)%Base%CDLoopNum) THEN ! condenser loop
CALL UpdateChillerComponentCondenserSide(GTChiller(ChillNum)%Base%CDLoopNum, &
GTChiller(ChillNum)%Base%CDLoopSideNum, &
TypeOf_Chiller_CombTurbine, &
GTChiller(ChillNum)%Base%CondInletNodeNum, &
GTChiller(ChillNum)%Base%CondOutletNodeNum, &
GTChillerReport(ChillNum)%Base%QCond, &
GTChillerReport(ChillNum)%Base%CondInletTemp, &
GTChillerReport(ChillNum)%Base%CondOutletTemp, &
GTChillerReport(ChillNum)%Base%Condmdot, &
FirstHVACIteration)
ELSEIF (LoopNum == GTChiller(ChillNum)%HRLoopNum) THEN ! heat recovery loop
CALL UpdateComponentHeatRecoverySide(GTChiller(ChillNum)%HRLoopNum, &
GTChiller(ChillNum)%HRLoopSideNum, &
TypeOf_Chiller_CombTurbine, &
GTChiller(ChillNum)%HeatRecInletNodeNum, &
GTChiller(ChillNum)%HeatRecOutletNodeNum, &
GTChillerReport(ChillNum)%HeatRecLubeRate, &
GTChillerReport(ChillNum)%HeatRecInletTemp, &
GTChillerReport(ChillNum)%HeatRecOutletTemp, &
GTChillerReport(ChillNum)%HeatRecMdot , &
FirstHVACIteration)
ENDIF
CASE (TypeOf_Chiller_ConstCOP)
!GET INPUT
IF (GetConstCOPInput) THEN
CALL GetConstCOPChillerInput
GetConstCOPInput = .FALSE.
END IF
! Find the correct Chiller
IF (CompIndex == 0) THEN
ChillNum = FindItemInList(ChillerName,ConstCOPChiller%Base%Name,NumConstCOPChillers)
IF (ChillNum == 0) THEN
CALL ShowFatalError('SimConstCOPChiller: Specified Chiller not one of Valid Constant COP Chillers='//TRIM(ChillerName))
ENDIF
CompIndex=ChillNum
ELSE
ChillNum=CompIndex
IF (ChillNum > NumConstCOPChillers .or. ChillNum < 1) THEN
CALL ShowFatalError('SimConstCOPChiller: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(ChillNum))// &
', Number of Units='//TRIM(TrimSigDigits(NumConstCOPChillers))// &
', Entered Unit name='//TRIM(ChillerName))
ENDIF
IF (ConstCOPChiller(ChillNum)%Base%CheckEquipName) THEN
IF (ChillerName /= ConstCOPChiller(ChillNum)%Base%Name) THEN
CALL ShowFatalError('SimConstCOPChiller: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(ChillNum))// &
', Unit name='//TRIM(ChillerName)//', stored Unit Name for that index='// &
TRIM(ConstCOPChiller(ChillNum)%Base%Name))
ENDIF
ConstCOPChiller(ChillNum)%Base%CheckEquipName=.false.
ENDIF
ENDIF
IF (InitLoopEquip) THEN
TempEvapOutDesign = 0.0d0
TempCondInDesign = 0.0d0
CALL InitConstCOPChiller(ChillNum,RunFlag,MyLoad)
CALL SizeConstCOPChiller(ChillNum)
IF (LoopNum == ConstCOPChiller(ChillNum)%Base%CWLoopNum) THEN
MinCap = 0.0d0
MaxCap = ConstCOPChiller(ChillNum)%Base%NomCap
OptCap = ConstCOPChiller(ChillNum)%Base%NomCap
ELSE
MinCap = 0.d0
MaxCap = 0.d0
OptCap = 0.d0
ENDIF
IF (GetSizingFactor) THEN
SizingFactor = ConstCOPChiller(ChillNum)%Base%SizFac
END IF
RETURN
END IF
IF (LoopNum == ConstCOPChiller(ChillNum)%Base%CWLoopNum) THEN
! Calculate Load
! IF MinPlr, MaxPlr, OptPlr are not defined, assume min = 0, max=opt=Nomcap
CALL InitConstCOPChiller(ChillNum,RunFlag,MyLoad)
CALL CalcConstCOPChillerModel(ChillNum,MyLoad,Runflag,EquipFlowCtrl)
CALL UpdateConstCOPChillerRecords(MyLoad,RunFlag,ChillNum)
ELSEIF (LoopNum == ConstCOPChiller(ChillNum)%Base%CDLoopNum) THEN
CALL UpdateChillerComponentCondenserSide(ConstCOPChiller(ChillNum)%Base%CDLoopNum, &
ConstCOPChiller(ChillNum)%Base%CDLoopSideNum, &
TypeOf_Chiller_ConstCOP, &
ConstCOPChiller(ChillNum)%Base%CondInletNodeNum, &
ConstCOPChiller(ChillNum)%Base%CondOutletNodeNum, &
ConstCOPChillerReport(ChillNum)%Base%QCond, &
ConstCOPChillerReport(ChillNum)%Base%CondInletTemp, &
ConstCOPChillerReport(ChillNum)%Base%CondOutletTemp, &
ConstCOPChillerReport(ChillNum)%Base%Condmdot, &
FirstHVACIteration)
ENDIF
END SELECT
RETURN
END SUBROUTINE SimChiller