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.
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 GetConstCOPChillerInput
! SUBROUTINE INFORMATION:
! AUTHOR: Dan Fisher
! DATE WRITTEN: April 1998
! PURPOSE OF THIS SUBROUTINE:!This routine will get the input
!required by the PrimaryPlantLoopManager. As such
!it will interact with the Input Scanner to retrieve
!information from the input file, count the number of
!heating and cooling loops and begin to fill the
!arrays associated with the type PlantLoopProps.
! METHODOLOGY EMPLOYED: to be determined...
! REFERENCES:
! USE STATEMENTS:
USE InputProcessor, ONLY : GetNumObjectsFound, GetObjectItem, VerifyName
USE DataIPShortCuts ! Data for field names, blank numerics
USE BranchNodeConnections, ONLY: TestCompSet
USE NodeInputManager, ONLY: GetOnlySingleNode
USE GlobalNames, ONLY: VerifyUniqueChillerName
USE OutputReportPredefined
USE OutAirNodeManager, ONLY: CheckAndAddAirNodeNumber
USE General, ONLY: RoundSigDigits
USE ScheduleManager, ONLY: GetScheduleIndex
USE DataGlobals, ONLY: AnyEnergyManagementSystemInModel
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetConstCOPChillerInput: ' ! include trailing blank space
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ChillerNum
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNums ! Number of elements in the numeric array
INTEGER :: IOStat ! IO Status when calling get input subroutine
LOGICAL, SAVE :: ErrorsFound=.false.
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: errflag
LOGICAL :: Okay
!GET NUMBER OF ALL EQUIPMENT TYPES
cCurrentModuleObject = 'Chiller:ConstantCOP'
NumConstCOPChillers = GetNumObjectsFound(cCurrentModuleObject)
IF (NumConstCOPChillers <= 0) THEN
CALL ShowSevereError('No '//TRIM(cCurrentModuleObject)//' equipment specified in input file')
ErrorsFound=.true.
ENDIF
!See if load distribution manager has already gotten the input
IF (ALLOCATED(ConstCOPChiller))RETURN
ALLOCATE (ConstCOPChiller(NumConstCOPChillers))
ALLOCATE (ConstCOPChillerReport(NumConstCOPChillers))
!LOAD ARRAYS WITH BLAST ConstCOP CHILLER DATA
DO ChillerNum = 1 , NumConstCOPChillers
CALL GetObjectItem(cCurrentModuleObject,ChillerNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),ConstCOPChiller%Base%Name,ChillerNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
CALL VerifyUniqueChillerName(TRIM(cCurrentModuleObject),cAlphaArgs(1),errflag,TRIM(cCurrentModuleObject)//' Name')
IF (errflag) THEN
ErrorsFound=.true.
ENDIF
ConstCOPChiller(ChillerNum)%Base%Name = cAlphaArgs(1)
ConstCOPChiller(ChillerNum)%Base%NomCap = rNumericArgs(1)
IF (rNumericArgs(1) == 0.0d0) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(1))//'='//TRIM(RoundSigDigits(rNumericArgs(1),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
ENDIF
ConstCOPChiller(ChillerNum)%Base%COP = rNumericArgs(2)
IF (rNumericArgs(2) == 0.0d0) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(2))//'='//TRIM(RoundSigDigits(rNumericArgs(2),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
ENDIF
!Set the Condenser Type from input
IF (cAlphaArgs(6) == 'AIRCOOLED' ) THEN
ConstCOPChiller(ChillerNum)%Base%CondenserType = AirCooled
ELSEIF (cAlphaArgs(6) == 'EVAPORATIVELYCOOLED') THEN
ConstCOPChiller(ChillerNum)%Base%CondenserType = EvapCooled
ELSEIF (cAlphaArgs(6) == 'WATERCOOLED' ) THEN
ConstCOPChiller(ChillerNum)%Base%CondenserType = WaterCooled
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(6))//'='//TRIM(cAlphaArgs(6)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
ENDIF
ConstCOPChiller(ChillerNum)%Base%EvapVolFlowRate = rNumericArgs(3)
IF (ConstCOPChiller(ChillerNum)%Base%CondenserType == AirCooled .OR. &
ConstCOPChiller(ChillerNum)%Base%CondenserType == EvapCooled) THEN ! Condenser flow rate not used for these cond types
ConstCOPChiller(ChillerNum)%Base%CondVolFlowRate = 0.0011d0
ELSE
ConstCOPChiller(ChillerNum)%Base%CondVolFlowRate = rNumericArgs(4)
ENDIF
ConstCOPChiller(ChillerNum)%Base%SizFac = rNumericArgs(5)
ConstCOPChiller(ChillerNum)%Base%EvapInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(2),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
ConstCOPChiller(ChillerNum)%Base%EvapOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(2),cAlphaArgs(3),'Chilled Water Nodes')
IF (ConstCOPChiller(ChillerNum)%Base%CondenserType == AirCooled .or. &
ConstCOPChiller(ChillerNum)%Base%CondenserType == EvapCooled) THEN
! Connection not required for air or evap cooled condenser
!If the condenser inlet is blank for air cooled and evap cooled condensers then supply a generic name
! since it is not used elsewhere for connection
IF(lAlphaFieldBlanks(4))THEN
IF (LEN_TRIM(cAlphaArgs(1)) < (MaxNameLength - 21) ) THEN ! protect against long name leading to > 100 chars
cAlphaArgs(4) = TRIM(cAlphaArgs(1))//' CONDENSER INLET NODE'
ELSE
cAlphaArgs(4) = TRIM(cAlphaArgs(1)(1:79))//' CONDENSER INLET NODE'
ENDIF
End If
IF(lAlphaFieldBlanks(5) )THEN
IF (LEN_TRIM(cAlphaArgs(1)) < (MaxNameLength - 22) ) THEN ! protect against long name leading to > 100 chars
cAlphaArgs(5) = TRIM(cAlphaArgs(1))//' CONDENSER OUTLET NODE'
ELSE
cAlphaArgs(5) = TRIM(cAlphaArgs(1)(1:78))//' CONDENSER OUTLET NODE'
ENDIF
END IF
ConstCOPChiller(ChillerNum)%Base%CondInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_OutsideAirReference, 2, ObjectIsNotParent)
CALL CheckAndAddAirNodeNumber(ConstCOPChiller(ChillerNum)%Base%CondInletNodeNum,Okay)
IF (.not. Okay) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', Adding OutdoorAir:Node='//TRIM(cAlphaArgs(4)))
ENDIF
ConstCOPChiller(ChillerNum)%Base%CondOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet, 2, ObjectIsNotParent)
ELSEIF (ConstCOPChiller(ChillerNum)%Base%CondenserType == WaterCooled) THEN
ConstCOPChiller(ChillerNum)%Base%CondInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 2, ObjectIsNotParent)
ConstCOPChiller(ChillerNum)%Base%CondOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 2, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(4),cAlphaArgs(5),'Condenser Water Nodes')
!Condenser Inlet node name is necessary for Water Cooled
IF (lAlphaFieldBlanks(4) ) THEN
CALL ShowSevereError('Invalid, '//TRIM(cAlphaFieldNames(4))//'is blank ')
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
ELSEIF ( lAlphaFieldBlanks(5) ) THEN
CALL ShowSevereError('Invalid, '//TRIM(cAlphaFieldNames(5))//'is blank ')
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
ENDIF
ELSE
ConstCOPChiller(ChillerNum)%Base%CondInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Unknown,NodeConnectionType_Inlet, 2, ObjectIsNotParent)
ConstCOPChiller(ChillerNum)%Base%CondOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Unknown,NodeConnectionType_Outlet, 2, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(4),cAlphaArgs(5),'Condenser (unknown?) Nodes')
!Condenser Inlet node name is necessary for Water Cooled
IF (lAlphaFieldBlanks(4) ) THEN
CALL ShowSevereError('Invalid, '//TRIM(cAlphaFieldNames(4))//'is blank ')
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
ELSEIF ( lAlphaFieldBlanks(5) ) THEN
CALL ShowSevereError('Invalid, '//TRIM(cAlphaFieldNames(5))//'is blank ')
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
ENDIF
ENDIF
SELECT CASE (TRIM(cAlphaArgs(7)))
CASE ( 'CONSTANTFLOW' )
ConstCOPChiller(ChillerNum)%Base%FlowMode = ConstantFlow
CASE ( 'VARIABLEFLOW' )
ConstCOPChiller(ChillerNum)%Base%FlowMode = LeavingSetpointModulated
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(7))//'='//TRIM(cAlphaArgs(7)))
CALL ShowContinueError('Key choice is now called "LeavingSetpointModulated" and the simulation continues')
CASE ('LEAVINGSETPOINTMODULATED')
ConstCOPChiller(ChillerNum)%Base%FlowMode = LeavingSetpointModulated
CASE ('NOTMODULATED')
ConstCOPChiller(ChillerNum)%Base%FlowMode = NotModulated
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(7))//'='//TRIM(cAlphaArgs(7)))
CALL ShowContinueError('Available choices are ConstantFlow, NotModulated, or LeavingSetpointModulated')
CALL ShowContinueError('Flow mode NotModulated is assumed and the simulation continues.')
ConstCOPChiller(ChillerNum)%Base%FlowMode = NotModulated
END SELECT
! Basin heater power as a function of temperature must be greater than or equal to 0
ConstCOPChiller(ChillerNum)%Base%BasinHeaterPowerFTempDiff = rNumericArgs(6)
IF(rNumericArgs(6) .LT. 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(ConstCOPChiller(ChillerNum)%Base%Name)//&
'" TRIM(cNumericFieldNames(6)) must be >= 0')
ErrorsFound = .TRUE.
END IF
ConstCOPChiller(ChillerNum)%Base%BasinHeaterSetPointTemp = rNumericArgs(7)
IF(ConstCOPChiller(ChillerNum)%Base%BasinHeaterPowerFTempDiff .GT. 0.0d0) THEN
IF(NumNums .LT. 7) THEN
ConstCOPChiller(ChillerNum)%Base%BasinHeaterSetPointTemp = 2.0d0
ENDIF
IF(ConstCOPChiller(ChillerNum)%Base%BasinHeaterSetPointTemp < 2.0d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//':"'//TRIM(ConstCOPChiller(ChillerNum)%Base%Name)//&
'", '//TRIM(cNumericFieldNames(7))//' is less than 2 deg C. Freezing could occur.')
END IF
END IF
IF(.NOT. lAlphaFieldBlanks(8))THEN
ConstCOPChiller(ChillerNum)%Base%BasinHeaterSchedulePtr = GetScheduleIndex(cAlphaArgs(8))
IF(ConstCOPChiller(ChillerNum)%Base%BasinHeaterSchedulePtr .EQ. 0)THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', "'//TRIM(ConstCOPChiller(ChillerNum)%Base%Name)//&
'" TRIM(cAlphaFieldNames(8)) "'//TRIM(cAlphaArgs(8)) &
//'" was not found. Basin heater operation will not be modeled and the simulation continues')
END IF
END IF
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing input for '//TRIM(cCurrentModuleObject))
ENDIF
DO ChillerNum = 1, NumConstCOPChillers
CALL SetupOutputVariable('Chiller Electric Power [W]', &
ConstCOPChillerReport(ChillerNum)%Base%Power,'System','Average',ConstCOPChiller(ChillerNum)%Base%Name)
CALL SetupOutputVariable('Chiller Electric Energy [J]', &
ConstCOPChillerReport(ChillerNum)%Base%Energy,'System','Sum',ConstCOPChiller(ChillerNum)%Base%Name, &
ResourceTypeKey='ELECTRICITY',EndUseKey='Cooling',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Evaporator Cooling Rate [W]', &
ConstCOPChillerReport(ChillerNum)%Base%QEvap,'System','Average',ConstCOPChiller(ChillerNum)%Base%Name)
CALL SetupOutputVariable('Chiller Evaporator Cooling Energy [J]', &
ConstCOPChillerReport(ChillerNum)%Base%EvapEnergy,'System','Sum',ConstCOPChiller(ChillerNum)%Base%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='CHILLERS',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Evaporator Inlet Temperature [C]', &
ConstCOPChillerReport(ChillerNum)%Base%EvapInletTemp,'System','Average',ConstCOPChiller(ChillerNum)%Base%Name)
CALL SetupOutputVariable('Chiller Evaporator Outlet Temperature [C]', &
ConstCOPChillerReport(ChillerNum)%Base%EvapOutletTemp,'System','Average',ConstCOPChiller(ChillerNum)%Base%Name)
CALL SetupOutputVariable('Chiller Evaporator Mass Flow Rate [kg/s]', &
ConstCOPChillerReport(ChillerNum)%Base%Evapmdot,'System','Average',ConstCOPChiller(ChillerNum)%Base%Name)
CALL SetupOutputVariable('Chiller COP [W/W]', &
ConstCOPChillerReport(ChillerNum)%ActualCOP,'System','Average',ConstCOPChiller(ChillerNum)%Base%Name)
CALL SetupOutputVariable('Chiller Condenser Heat Transfer Rate [W]', &
ConstCOPChillerReport(ChillerNum)%Base%QCond,'System','Average',ConstCOPChiller(ChillerNum)%Base%Name)
CALL SetupOutputVariable('Chiller Condenser Heat Transfer Energy [J]', &
ConstCOPChillerReport(ChillerNum)%Base%CondEnergy,'System','Sum',ConstCOPChiller(ChillerNum)%Base%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='HEATREJECTION',GroupKey='Plant')
!Condenser mass flow and outlet temp are valid for water cooled
IF (ConstCOPChiller(ChillerNum)%Base%CondenserType == WaterCooled)THEN
CALL SetupOutputVariable('Chiller Condenser Inlet Temperature [C]', &
ConstCOPChillerReport(ChillerNum)%Base%CondInletTemp,'System','Average',ConstCOPChiller(ChillerNum)%Base%Name)
CALL SetupOutputVariable('Chiller Condenser Outlet Temperature [C]', &
ConstCOPChillerReport(ChillerNum)%Base%CondOutletTemp,'System','Average',ConstCOPChiller(ChillerNum)%Base%Name)
CALL SetupOutputVariable('Chiller Condenser Mass Flow Rate [kg/s]', &
ConstCOPChillerReport(ChillerNum)%Base%Condmdot,'System','Average',ConstCOPChiller(ChillerNum)%Base%Name)
ELSEIF (ConstCOPChiller(ChillerNum)%Base%CondenserType == AirCooled) THEN
CALL SetupOutputVariable('Chiller Condenser Inlet Temperature [C]', &
ConstCOPChillerReport(ChillerNum)%Base%CondInletTemp,'System','Average',ConstCOPChiller(ChillerNum)%Base%Name)
ELSEIF (ConstCOPChiller(ChillerNum)%Base%CondenserType == EvapCooled) THEN
CALL SetupOutputVariable('Chiller Condenser Inlet Temperature [C]', &
ConstCOPChillerReport(ChillerNum)%Base%CondInletTemp,'System','Average',ConstCOPChiller(ChillerNum)%Base%Name)
IF(ConstCOPChiller(ChillerNum)%Base%BasinHeaterPowerFTempDiff .GT. 0.0d0)THEN
CALL SetupOutputVariable('Chiller Basin Heater Electric Power [W]', &
ConstCOPChillerReport(ChillerNum)%Base%BasinHeaterPower,'System','Average',ConstCOPChiller(ChillerNum)%Base%Name)
CALL SetupOutputVariable('Chiller Basin Heater Electric Energy [J]', &
ConstCOPChillerReport(ChillerNum)%Base%BasinHeaterConsumption,'System','Sum',ConstCOPChiller(ChillerNum)%Base%Name, &
ResourceTypeKey='Electric',EndUseKey='CHILLERS',GroupKey='Plant')
END IF
ENDIF
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupEMSInternalVariable('Chiller Nominal Capacity', ConstCOPChiller(ChillerNum)%Base%Name, '[W]', &
ConstCOPChiller(ChillerNum)%Base%NomCap )
ENDIF
END DO
RETURN
END SUBROUTINE GetConstCOPChillerInput