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.
SUBROUTINE ReInitPlantLoopsAtFirstHVACIteration
! SUBROUTINE INFORMATION:
! AUTHOR Brent Griffith
! DATE WRITTEN Sept 2010
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! initialize node mass flow requests
! METHODOLOGY EMPLOYED:
! called from SimHVAC to reset mass flow rate requests
! this contains all the initializ
! REFERENCES:
! na
! USE STATEMENTS:
USE DataEnvironment, ONLY : OutWetBulbTemp,OutDryBulbTemp, GroundTemp_Deep, StdBaroPress
USE HVACInterfaceManager, ONLY : PlantCommonPipe
USE ScheduleManager, ONLY : GetCurrentScheduleValue
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64),PARAMETER::StartQuality = 1.0d0
REAL(r64),PARAMETER::StartHumRat = 0.0d0
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: LoopNum ! plant loop counter
INTEGER :: LoopIn
REAL(r64) :: LoopMaxMassFlowRate ! maximum allowable loop mass flow rate
REAL(r64) :: LoopSetPointTemp ! the loop control or setpoint temperature
REAL(r64) :: LoopMaxTemp ! maximum allowable loop temperature
REAL(r64) :: LoopMinTemp ! minimum allowable loop temperature
REAL(r64) :: LoopSetPointTempLo ! the loop control or setpoint temperature
REAL(r64) :: LoopSetPointTempHi ! the loop control or setpoint temperature
REAL(r64) :: SecondaryLoopSetPointTemp ! loop setpoint temperature for common pipes with different secondary setpt
INTEGER :: LoopSideNum
INTEGER :: BranchNum ! branch loop counter
INTEGER :: OpNum ! operation scheme counter
INTEGER :: CompNum ! plant side component counter
INTEGER :: BranchInlet ! branch inlet node number
INTEGER :: ComponentInlet ! component inlet node number
INTEGER :: ComponentOutlet ! component outlet node number
LOGICAL, SAVE :: MyEnvrnFlag = .TRUE.
REAL(r64) :: LoopMinMassFlowRate ! minimum allowable loop mass flow rate
REAL(r64) :: SteamDensity
REAL(r64) :: SteamTemp
REAL(r64) :: StartEnthalpy
REAL(r64) :: Cp
REAL(r64) :: rho
REAL(r64) :: LoopSetPointTemperatureHi
REAL(R64) :: LoopSetPointTemperatureLo
!*****************************************************************
!BEGIN ENVIRONMENT INITS
!*****************************************************************
IF(MyEnvrnFlag .AND. BeginEnvrnFlag) THEN
DO LoopNum = 1, TotNumLoops
DO LoopSideNum = DemandSide, SupplySide
SELECT CASE (PlantLoop(LoopNum)%LoopDemandCalcScheme)
CASE (SingleSetPoint)
LoopSetPointTemp = Node(PlantLoop(LoopNum)%TempSetPointNodeNum)%TempSetPoint
CASE (DualSetPointDeadBand)
! Get the range of setpoints
LoopSetPointTemperatureHi = Node(PlantLoop(LoopNum)%TempSetPointNodeNum)%TempSetpointHi
LoopSetPointTemperatureLo = Node(PlantLoop(LoopNum)%TempSetPointNodeNum)%TempSetpointLo
LoopSetPointTemp = (LoopSetPointTemperatureLo + LoopSetPointTemperatureHi) /2.d0
END SELECT
IF ((PlantLoop(LoopNum)%CommonPipeType == CommonPipe_TwoWay) .AND. (LoopSideNum == DemandSide) .AND. &
(PlantLoop(LoopNum)%LoopSide(DemandSide)%InletNodeSetPt)) THEN ! get a second setpoint for secondaryLoop
! if the plant loop is two common pipe configured for temperature control on secondary side inlet, then
! we want to initialize the demand side of the loop using that setpoint
LoopSetPointTemp = Node(PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNumIn)%TempSetPoint
ENDIF
! Check the Loop Setpoint and make sure it is bounded by the Loop Max and Min
LoopMaxTemp = PlantLoop(LoopNum)%MaxTemp
LoopMinTemp = PlantLoop(LoopNum)%MinTemp
! trap for -999 and set to average of limits if so
IF (LoopSetPointTemp == SensedNodeFlagValue) THEN
LoopSetPointTemp = (LoopMinTemp + LoopMaxTemp) / 2.d0
ENDIF
! Check it against the loop temperature limits
LoopSetPointTemp = Min(LoopMaxTemp, LoopSetPointTemp)
LoopSetPointTemp = Max(LoopMinTemp, LoopSetPointTemp)
!Initialize the capacitance model at the tank interface, and other loop side values
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TempInterfaceTankOutlet = LoopSetPointTemp
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%LastTempInterfaceTankOutlet = LoopSetPointTemp
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%LoopSideInlet_TankTemp = LoopSetPointTemp
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TotalPumpHeat = 0.d0
IF (ALLOCATED(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Pumps)) &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Pumps%PumpHeatToFluid = 0.d0
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%FlowRequest = 0.d0
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TimeElapsed = 0.d0
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%FlowLock = 0
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%InletNode%TemperatureHistory = 0.0d0
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%InletNode%MassFlowRateHistory = 0.0d0
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%OutletNode%TemperatureHistory = 0.0d0
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%OutletNode%MassFlowRateHistory = 0.0d0
IF(PlantLoop(LoopNum)%FluidType /= NodeType_Steam) Then
Cp = GetSpecificHeatGlycol(PlantLoop(LoopNum)%FluidName, &
LoopSetPointTemp, &
PlantLoop(LoopNum)%FluidIndex, &
'InitializeLoops')
StartEnthalpy = Cp * LoopSetPointTemp
ENDIF
! Use Min/Max flow rates to initialize loop
IF(PlantLoop(LoopNum)%FluidType==NodeType_Water) Then
rho = GetDensityGlycol(PlantLoop(LoopNum)%FluidName, &
LoopSetPointTemp, &
PlantLoop(LoopNum)%FluidIndex,&
'InitializeLoops')
LoopMaxMassFlowRate = PlantLoop(loopnum)%MaxVolFlowRate * rho
LoopMinMassFlowRate = PlantLoop(loopnum)%MinVolFlowRate * rho
END IF
!use saturated liquid of steam at the loop setpoint temp as the starting enthalpy for a water loop
IF(PlantLoop(LoopNum)%FluidType==NodeType_Steam) Then
SteamTemp = 100.d0
SteamDensity=GetSatDensityRefrig('STEAM',SteamTemp,1.0d0,PlantLoop(LoopNum)%FluidIndex,'PlantManager:InitializeLoop')
LoopMaxMassFlowRate = PlantLoop(loopnum)%MaxVolFlowRate * SteamDensity
StartEnthalpy = GetSatEnthalpyRefrig('STEAM',LoopSetPointTemp,0.0d0,PlantLoop(LoopNum)%FluidIndex, &
'PlantManager:InitializeLoop')
LoopMinMassFlowRate = PlantLoop(loopnum)%MinVolFlowRate * SteamDensity
END IF
LoopMaxMassFlowRate = MAX(0.d0, LoopMaxMassFlowRate)
LoopMinMassFlowRate = MAX(0.d0, LoopMinMassFlowRate)
!Initial all loop nodes by initializing all component inlet and outlet nodes
DO BranchNum = 1, PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TotalBranches
DO CompNum = 1, PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%TotalComponents
ComponentInlet = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%NodeNumIn
ComponentOutlet = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%NodeNumOut
BranchInlet = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%NodeNumIn
Node(ComponentInlet)%Temp = LoopSetpointTemp
Node(ComponentInlet)%TempMin = LoopMinTemp
Node(ComponentInlet)%TempMax = LoopMaxTemp
Node(ComponentInlet)%TempLastTimestep = LoopSetpointTemp
Node(ComponentInlet)%MassFlowRate = 0.0d0
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%MyLoad = 0.0d0
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%Available = .FALSE.
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%FreeCoolCntrlShutDown = .FALSE.
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%RequestedMassFlow =0.0d0
IF (Node(ComponentInlet)%MassFlowRateMin > 0.d0) THEN
Node(ComponentInlet)%MassFlowRateMinAvail = Node(ComponentInlet)%MassFlowRateMin
ELSE
Node(ComponentInlet)%MassFlowRateMin = LoopMinMassFlowRate
Node(ComponentInlet)%MassFlowRateMinAvail = LoopMinMassFlowRate
ENDIF
IF (Node(ComponentInlet)%MassFlowRateMax > 0.d0) THEN
Node(ComponentInlet)%MassFlowRateMaxAvail = Node(ComponentInlet)%MassFlowRateMax
ELSE
Node(ComponentInlet)%MassFlowRateMax = LoopMaxMassFlowRate
Node(ComponentInlet)%MassFlowRateMaxAvail = LoopMaxMassFlowRate
ENDIF
Node(ComponentInlet)%MassFlowRateRequest = 0.0d0
Node(ComponentInlet)%Quality = StartQuality
Node(ComponentInlet)%Press = StdBaroPress
Node(ComponentInlet)%Enthalpy = StartEnthalpy
Node(ComponentInlet)%HumRat = StartHumRat
Node(ComponentOutlet)%FluidType = Node(BranchInlet)%FluidType
Node(ComponentOutlet)%Temp = Node(BranchInlet)%Temp
Node(ComponentOutlet)%TempMin = Node(BranchInlet)%TempMin
Node(ComponentOutlet)%TempMax = Node(BranchInlet)%TempMax
Node(ComponentOutlet)%TempLastTimestep = Node(BranchInlet)%TempLastTimestep
Node(ComponentOutlet)%MassFlowRate = Node(BranchInlet)%MassFlowRate
Node(ComponentOutlet)%MassFlowRateMin = Node(BranchInlet)%MassFlowRateMin
Node(ComponentOutlet)%MassFlowRateMax = Node(BranchInlet)%MassFlowRateMax
Node(ComponentOutlet)%MassFlowRateMinAvail = Node(BranchInlet)%MassFlowRateMinAvail
Node(ComponentOutlet)%MassFlowRateMaxAvail = Node(BranchInlet)%MassFlowRateMaxAvail
Node(ComponentOutlet)%MassFlowRateRequest = 0.0d0
Node(ComponentOutlet)%Quality = StartQuality
Node(ComponentOutlet)%Press = StdBaroPress
Node(ComponentOutlet)%Enthalpy = StartEnthalpy
Node(ComponentOutlet)%HumRat = StartHumRat
END DO !COMPONENT LOOP
END DO !BRANCH LOOP
END DO !LOOPSIDE
END DO !PLANT LOOP
PlantReport%CoolingDemand = 0.d0
PlantReport%HeatingDemand = 0.d0
PlantReport%DemandNotDispatched = 0.d0
PlantReport%UnmetDemand = 0.d0
PlantReport%LastLoopSideSimulated = 0
PlantReport%InletNodeFlowrate = 0.d0
PlantReport%InletNodeTemperature = 0.d0
PlantReport%OutletNodeFlowrate = 0.d0
PlantReport%OutletNodeTemperature = 0.d0
MyEnvrnFlag = .FALSE.
!*****************************************************************
!END OF ENVIRONMENT INITS
!*****************************************************************
END IF
IF (.NOT. BeginEnvrnFlag) MyEnvrnFlag=.TRUE.
! FirstHVACiteration inits
DO LoopNum = 1, TotNumLoops
LoopIn = PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNumIn !DSU? Demand/Supply side inlet??
!UPDATE LOOP FLOW SETPOINT
! Node(LoopIn)%MassFlowRateSetPoint = LoopMaxMassFlowRate !DSU? this is suspect, may not be set?
!UPDATE LOOP TEMPERATURE SETPOINTS
LoopSetPointTemp = Node(PlantLoop(LoopNum)%TempSetPointNodeNum)%TempSetPoint
! Check the Loop Setpoint and make sure it is bounded by the Loop Max and Min
LoopMaxTemp = PlantLoop(LoopNum)%MaxTemp
LoopMinTemp = PlantLoop(LoopNum)%MinTemp
! Check it against the loop temperature limits
LoopSetPointTemp = Min(LoopMaxTemp, LoopSetPointTemp)
LoopSetPointTemp = Max(LoopMinTemp, LoopSetPointTemp)
!Update supply side loop setpoint in plant data structure
PlantLoop(LoopNum)%LoopSide(SupplySide)%TempSetPoint = LoopSetPointTemp
PlantLoop(LoopNum)%LoopSide(DemandSide)%TempSetPoint = LoopSetPointTemp
!Update supply side hi-lo setpoints for dual SP control
IF (PlantLoop(LoopNum)%LoopDemandCalcScheme == DualSetPointDeadBand) THEN
LoopSetPointTempHi = Node(PlantLoop(LoopNum)%TempSetPointNodeNum)%TempSetPointHi
LoopSetPointTempLo = Node(PlantLoop(LoopNum)%TempSetPointNodeNum)%TempSetPointLo
LoopSetPointTempHi = Min(LoopMaxTemp, LoopSetPointTempHi)
LoopSetPointTempHi = Max(LoopMinTemp, LoopSetPointTempHi)
LoopSetPointTempLo = Min(LoopMaxTemp, LoopSetPointTempLo)
LoopSetPointTempLo = Max(LoopMinTemp, LoopSetPointTempLo)
PlantLoop(LoopNum)%LoopSide(SupplySide)%TempSetPointHi = LoopSetPointTempHi
PlantLoop(LoopNum)%LoopSide(SupplySide)%TempSetPointLo = LoopSetPointTempLo
ENDIF
!update demand side loop setpoint in plant data structure
IF (PlantLoop(LoopNum)%CommonPipeType == CommonPipe_TwoWay) THEN ! get a second setpoint for secondaryLoop
! if the plant loop is two common pipe configured for temperature control on secondary side inlet, then
! we want to initialize the demand side of the loop using that setpoint
IF (PlantLoop(LoopNum)%LoopSide(DemandSide)%InletNodeSetPt) THEN
SecondaryLoopSetPointTemp = Node(PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNumIn)%TempSetPoint
SecondaryLoopSetPointTemp = Min(LoopMaxTemp, SecondaryLoopSetPointTemp)
SecondaryLoopSetPointTemp = Max(LoopMinTemp, SecondaryLoopSetPointTemp)
PlantLoop(LoopNum)%LoopSide(DemandSide)%TempSetPoint = SecondaryLoopSetPointTemp
!Since Dual setpoint not explicitly available for demand side, we can't do the
!bounding check on hi/lo setpoint. IF we did we would over-write
!the SensedNodeFlagValue of -999 for no dual setpoint case.
PlantLoop(LoopNum)%LoopSide(DemandSide)%TempSetPointHi = &
Node(PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNumIn)%TempSetPointHi
PlantLoop(LoopNum)%LoopSide(DemandSide)%TempSetPointLo = &
Node(PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNumIn)%TempSetPointLo
ENDIF
!initialize common pipe flows to zero.
IF (ALLOCATED(PlantCommonPipe)) THEN
PlantCommonPipe(LoopNum)%PriToSecFlow = 0.d0
PlantCommonPipe(LoopNum)%SecToPriFlow = 0.d0
PlantCommonPipe(LoopNum)%PriCPLegFlow = 0.d0
PlantCommonPipe(LoopNum)%SecCPLegFlow = 0.d0
ENDIF
ELSE !no secondary loop, so use supply side loop SP on demand side too.
PlantLoop(LoopNum)%LoopSide(DemandSide)%TempSetPoint = LoopSetPointTemp
IF (PlantLoop(LoopNum)%LoopDemandCalcScheme == DualSetPointDeadBand) THEN
PlantLoop(LoopNum)%LoopSide(DemandSide)%TempSetPointHi = LoopSetPointTempHi
PlantLoop(LoopNum)%LoopSide(DemandSide)%TempSetPointLo = LoopSetPointTempLo
ENDIF
ENDIF
DO LoopSideNum = DemandSide, SupplySide
DO BranchNum = 1, PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TotalBranches
DO CompNum = 1, PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%TotalComponents
ComponentInlet = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%NodeNumIn
ComponentOutlet = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%NodeNumOut
!reinit to node hardware limits
Node(ComponentInlet )%MassFlowRateMinAvail = Node(ComponentInlet )%MassFlowRateMin
Node(ComponentOutlet)%MassFlowRateMinAvail = Node(ComponentInlet )%MassFlowRateMin
Node(ComponentInlet )%MassFlowRateMaxAvail = Node(ComponentInlet )%MassFlowRateMax
Node(ComponentOutlet)%MassFlowRateMaxAvail = Node(ComponentInlet )%MassFlowRateMax
Node(ComponentInlet)%MassFlowRateRequest = 0.0d0
Node(ComponentOutlet)%MassFlowRateRequest = 0.0d0
END DO
END DO
END DO
DO OpNum =1, PlantLoop(LoopNum)%NumOpSchemes
! If the operating scheme is scheduled "OFF", go to next scheme
IF(GetCurrentScheduleValue(PlantLoop(LoopNum)%OpScheme(OpNum)%SchedPtr) <= 0.d0)THEN
PlantLoop(LoopNum)%OpScheme(OpNum)%Available = .FALSE.
ELSE
PlantLoop(LoopNum)%OpScheme(OpNum)%Available = .TRUE.
END IF
END DO
END DO
RETURN
END SUBROUTINE ReInitPlantLoopsAtFirstHVACIteration