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) | :: | TypeOfNum | |||
integer, | intent(in) | :: | InletNodeNum | |||
integer, | intent(in) | :: | OutletNodeNum | |||
real(kind=r64), | intent(in) | :: | ModelCondenserHeatRate | |||
real(kind=r64), | intent(in) | :: | ModelInletTemp | |||
real(kind=r64), | intent(in) | :: | ModelOutletTemp | |||
real(kind=r64), | intent(in) | :: | ModelMassFlowRate | |||
logical, | intent(in) | :: | FirstHVACIteration |
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 UpdateChillerComponentCondenserSide(LoopNum, LoopSide, TypeOfNum, &
InletNodeNum, OutletNodeNum, ModelCondenserHeatRate, &
ModelInletTemp, ModelOutletTemp, ModelMassFlowRate, FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Brent Griffith
! DATE WRITTEN February 2010
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! provides reusable update routine for water cooled chiller's condenser water
! connection to plant loops
! METHODOLOGY EMPLOYED:
! check if anything changed or doesn't agree and set simulation flags.
! update outlet conditions if needed or possible
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPlant, ONLY: PlantLoop
USE DataBranchAirLoopPlant, ONLY: MassFlowTolerance
USE DataLoopNode , ONLY: Node
USE FluidProperties, ONLY: GetSpecificHeatGlycol
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER , INTENT(IN) :: LoopNum ! component's loop index
INTEGER , INTENT(IN) :: LoopSide ! component's loop side number
INTEGER , INTENT(IN) :: TypeOfNum ! Component's type index
INTEGER , INTENT(IN) :: InletNodeNum ! Component's inlet node pointer
INTEGER , INTENT(IN) :: OutletNodeNum ! Component's outlet node pointer
REAL(r64), INTENT(IN) :: ModelCondenserHeatRate ! model's heat rejection rate at condenser (W)
REAL(r64), INTENT(IN) :: ModelInletTemp ! model's inlet temperature (C)
REAL(r64), INTENT(IN) :: ModelOutletTemp ! model's outlet temperature (C)
REAL(r64), INTENT(IN) :: ModelMassFlowRate ! model's condenser water mass flow rate (kg/s)
LOGICAL , INTENT(IN) :: FirstHVACIteration
! SUBROUTINE PARAMETER DEFINITIONS:
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL :: DidAnythingChange = .FALSE. ! set to true if conditions changed
INTEGER :: OtherLoopNum ! local loop pointer for remote connected loop
INTEGER :: OtherLoopSide ! local loop side pointer for remote connected loop
INTEGER :: ConnectLoopNum ! local do loop counter
REAL(r64) :: Cp
DidAnythingChange = .FALSE.
!check if any conditions have changed
IF (Node(InletNodeNum)%MassFlowRate /= ModelMassFlowRate) DidAnythingChange = .TRUE.
IF (Node(OutletNodeNum)%MassFlowRate /= ModelMassFlowRate) DidAnythingChange = .TRUE.
IF (Node(InletNodeNum)%Temp /= ModelInletTemp) DidAnythingChange = .TRUE.
IF (Node(OutletNodeNum)%Temp /= ModelOutletTemp) DidAnythingChange = .TRUE.
! could also check heat rate agains McDeltaT from node data
IF ((Node(InletNodeNum)%MassFlowRate == 0.0D0) .AND. (ModelCondenserHeatRate > 0.0D0) ) THEN
! DSU3 TODO also send a request that condenser loop be made available, interlock message infrastructure??
DidAnythingChange = .TRUE.
ENDIF
IF (DidAnythingChange .OR. FirstHVACIteration) THEN
! use current mass flow rate and inlet temp from Node and recalculate outlet temp
IF (Node(InletNodeNum)%MassFlowRate > MassFlowTolerance) THEN
! update node outlet conditions
Cp = GetSpecificHeatGlycol(PlantLoop(LoopNum)%FluidName, ModelInletTemp, &
PlantLoop(LoopNum)%FluidIndex, 'UpdateChillerComponentCondenserSide')
Node(OutletNodeNum)%Temp = Node(InletNodeNum)%Temp + ModelCondenserHeatRate &
/(Node(InletNodeNum)%MassFlowRate*Cp)
ENDIF
! set sim flag for this loop
PlantLoop(LoopNum)%LoopSide(LoopSide)%SimLoopSideNeeded = .TRUE.
!set sim flag on connected loops to true because this side changed
IF (PlantLoop(LoopNum)%LoopSide(LoopSide)%TotalConnected > 0) THEN
DO ConnectLoopNum = 1, PlantLoop(LoopNum)%LoopSide(LoopSide)%TotalConnected
IF (PlantLoop(LoopNum)%LoopSide(LoopSide)%Connected(ConnectLoopNum)%LoopDemandsOnRemote) THEN
OtherLoopNum = PlantLoop(LoopNum)%LoopSide(LoopSide)%Connected(ConnectLoopNum)%LoopNum
OtherLoopSide = PlantLoop(LoopNum)%LoopSide(LoopSide)%Connected(ConnectLoopNum)%LoopSideNum
PlantLoop(OtherLoopNum)%LoopSide(OtherLoopSide)%SimLoopSideNeeded = .TRUE.
ENDIF
ENDDO
ENDIF
ELSE ! nothing changed so turn off sim flag
PlantLoop(LoopNum)%LoopSide(LoopSide)%SimLoopSideNeeded = .FALSE.
ENDIF
RETURN
END SUBROUTINE UpdateChillerComponentCondenserSide