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 | ||
---|---|---|---|---|---|---|
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.
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 InitializeLoops(FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Sankaranarayanan K P
! DATE WRITTEN May 2005
! MODIFIED Dan Fisher Aug. 2008
! Brent Griffith May 2009 EMS setpoint check
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine initializes the
! Plant loop nodes one time at the beginning of the simulation.
! It also reinitializes loop temperatures if loop setpoint
! temperature changes. Branch levels for all branches are also set.
! METHODOLOGY EMPLOYED:
! Needs description, as appropriate.
! REFERENCES:
! na
! USE STATEMENTS:
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE DataEnvironment, ONLY: StdBaroPress
USE DataSizing
USE PlantLoopEquip, ONLY : SimPlantEquip
USE General, ONLY: RoundSigDigits
USE EMSManager, ONLY: iTemperatureSetpoint, CheckIfNodeSetpointManagedByEMS, &
iTemperatureMaxSetpoint, iTemperatureMinSetpoint
USE PlantUtilities, ONLY: SetAllFlowLocks
USE DataHVACGlobals, ONLY : NumPlantLoops, NumCondLoops
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(IN):: FirstHVACIteration ! true if first iteration of the simulation
! 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 :: LoopSideNum
INTEGER :: BranchNum ! branch loop counter
INTEGER :: CompNum ! plant side component counter
INTEGER :: SensedNode
REAL(r64) :: LoopSetPointTemp ! the loop control or setpoint temperature
LOGICAL :: ErrorsFound=.false.
LOGICAL :: FinishSizingFlag
LOGICAL,SAVE :: SupplyEnvrnFlag = .TRUE.
! LOGICAL,SAVE :: MySizeFlag = .TRUE.
LOGICAL,SAVE :: MySetPointCheckFlag = .TRUE.
LOGICAL,SAVE,DIMENSION(:),ALLOCATABLE :: PlantLoopSetPointInitFlag
INTEGER :: HalfLoopNum
INTEGER :: passNum
IF (.NOT. ALLOCATED (PlantLoopSetPointInitFlag)) THEN
ALLOCATE ( PlantLoopSetPointInitFlag(TotNumLoops))
ENDIF
! Initialize the setpoints for Load range based schemes only as determined by the init flag
! The input already requires a loop setpoint. The plantloop object requires
! specification of a loop node and corresponding setpoint manager. Using a 'component setpoint'
! control scheme does NOT eliminate the requirement for a plant loop setpoint. So there is
! already the possibility that a component setpoint controlled object on the loop outlet
! branch would have the same setpoint node as the loop. I don't think setpoint manager traps
! for this user input error, but it might. Since both loop and component setpoints already
! peacefully coexist on the loop, we can allow the user to intentionally specify and use both.
! The only change required is to NOT smear the loop setpoint over all the loop nodes. Just
! read it from the setpoint node and use it. In the short term it will remain up to the user
! to specify the location of the loop setpoint control node and avoid conflicts with component
! setpoint nodes. Operationally, we will ignore the user specified placement of the loop setpoint
! node and assume that it is physically located at each half loop outlet for purposes of calculating loop
! demand. Long term, I recommend that we:
! 1. specify the setpointmanager:plant object name (not the node name) in the plantloop/condloop objects
! 2. write a new setpoint manager (setpointmanager:plant) that is more suitable for plant use and
! accomodates AIR and GROUND setpoints...with offsets.
!*****************************************************************
!ONE TIME LOOP NODE SETPOINT CHECK
!*****************************************************************
IF (MySetPointCheckFlag .AND. DoSetPointTest) THEN
! check for missing setpoints
DO LoopNum = 1, TotNumLoops
LoopSetPointTemp = Node(PlantLoop(LoopNum)%TempSetPointNodeNum)%TempSetPoint
SensedNode = PlantLoop(LoopNum)%TempSetPointNodeNum
IF (SensedNode > 0) THEN
IF (Node(SensedNode)%TempSetPoint == SensedNodeFlagValue) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
CALL ShowSevereError ('PlantManager: No Setpoint Manager Defined for Node='//TRIM(NodeID(SensedNode))// &
' in PlantLoop='//TRIM(PlantLoop(LoopNum)%Name))
CALL ShowContinueError('Add Temperature Setpoint Manager with Control Variable = '// &
'"Temperature" for this PlantLoop.')
SetPointErrorFlag = .TRUE.
ELSE
! need call to EMS to check node
CALL CheckIfNodeSetpointManagedByEMS(SensedNode,iTemperatureSetpoint, SetpointErrorFlag)
IF (SetpointErrorFlag) THEN
CALL ShowSevereError ('PlantManager: No Setpoint Manager Defined for Node='//TRIM(NodeID(SensedNode))// &
' in PlantLoop='//TRIM(PlantLoop(LoopNum)%Name))
CALL ShowContinueError('Add Temperature Setpoint Manager with Control Variable = '// &
'"Temperature" for this PlantLoop.')
CALL ShowContinueError('Or add EMS Actuator to provide temperature setpoint at this node')
ENDIF
ENDIF
END IF
END IF
END DO
MySetPointCheckFlag = .FALSE.
END IF
!*****************************************************************
! END ONE TIME LOOP NODE SETPOINT CHECK
!*****************************************************************
!ONE TIME PUMP AND SIZING INIT
!*****************************************************************
IF (PlantSizeNotComplete) THEN
! ! Step 1: init plant sizing numbers in main plant data structure
! moved up to HVACManager (so ready for demand side equipment)
! DO LoopNum = 1, TotNumLoops
! CALL InitOneTimePlantSizingInfo(LoopNum)
! ENDDO
CALL SetAllFlowLocks(FlowUnlocked)
FinishSizingFlag = .FALSE.
PlantSizesOkayToFinalize = .FALSE. ! set global flag for when it ready to store final sizes
Do passNum = 1, 4 !begin while loop to iterate over the next calls sequentially
InitLoopEquip = .TRUE.
! Step 2, call component models it using PlantCallingOrderInfo for sizing
DO HalfLoopNum = 1, TotNumHalfLoops
LoopNum = PlantCallingOrderInfo(HalfLoopNum)%LoopIndex
LoopSideNum = PlantCallingOrderInfo(HalfLoopNum)%LoopSide
CurLoopNum = LoopNum
DO BranchNum = 1, PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TotalBranches
DO CompNum = 1, PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%TotalComponents
CALL SimPlantEquip(LoopNum,LoopSideNum,BranchNum,CompNum,FirstHVACIteration,InitLoopEquip,GetCompSizFac)
END DO !-CompNum
END DO !-BranchNum
ENDDO
! step 3, revise calling order
! have now called each plant component model at least once with InitLoopEquip = .true.
! this means the calls to InterConnectTwoPlantLoopSides have now been made, so rework calling order
CALL RevisePlantCallingOrder
! Step 4: Simulate plant loop components so their design flows are included
DO HalfLoopNum = 1, TotNumHalfLoops
LoopNum = PlantCallingOrderInfo(HalfLoopNum)%LoopIndex
LoopSideNum = PlantCallingOrderInfo(HalfLoopNum)%LoopSide
CurLoopNum = LoopNum
CALL SizePlantLoop(LoopNum, FinishSizingFlag)
ENDDO
ENDDO ! iterative passes thru sizing related routines. end while?
!Step 5 now one more time for the final
DO HalfLoopNum = 1, TotNumHalfLoops
PlantSizesOkayToFinalize = .TRUE.
FinishSizingFlag = .TRUE.
LoopNum = PlantCallingOrderInfo(HalfLoopNum)%LoopIndex
LoopSideNum = PlantCallingOrderInfo(HalfLoopNum)%LoopSide
CurLoopNum = LoopNum
DO BranchNum = 1, PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TotalBranches
DO CompNum = 1, PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%TotalComponents
CALL SimPlantEquip(LoopNum,LoopSideNum,BranchNum,CompNum,FirstHVACIteration,InitLoopEquip,GetCompSizFac)
END DO !-CompNum
END DO !-BranchNum
IF(PlantLoop(LoopNum)%PlantSizNum .GT. 0) PlantSizData(PlantLoop(LoopNum)%PlantSizNum)%VolFlowSizingDone = .TRUE.
CALL SizePlantLoop(LoopNum, FinishSizingFlag)
ENDDO
PlantSizeNotComplete = .FALSE.
END IF
!*****************************************************************
!END ONE TIME SIZING INIT
!*****************************************************************
!*****************************************************************
!BEGIN ONE TIME ENVIRONMENT INITS
!*****************************************************************
IF(SupplyEnvrnFlag .AND. BeginEnvrnFlag) THEN
DO LoopNum = 1, TotNumLoops
DO LoopSideNum = DemandSide, SupplySide
! check if setpoints being placed on node properly
IF (PlantLoop(LoopNum)%LoopDemandCalcScheme == DualSetPointDeadBand) THEN
IF (Node(PlantLoop(LoopNum)%TempSetPointNodeNum)%TempSetpointHi == SensedNodeFlagValue) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
CALL ShowSevereError('Plant Loop: missing high temperature setpoint for dual setpoint deadband demand scheme')
CALL ShowContinueError('Node Referenced ='//TRIM(NodeID(PlantLoop(LoopNum)%TempSetPointNodeNum)))
CALL ShowContinueError('Use a SetpointManager:Scheduled:DualSetpoint to establish appropriate setpoints')
SetPointErrorFlag = .TRUE.
ELSE
CALL CheckIfNodeSetpointManagedByEMS(PlantLoop(LoopNum)%TempSetPointNodeNum,iTemperatureMaxSetpoint, &
SetpointErrorFlag)
IF (SetpointErrorFlag) Then
CALL ShowSevereError('Plant Loop: missing high temperature setpoint for dual setpoint deadband demand scheme')
CALL ShowContinueError('Node Referenced ='//TRIM(NodeID(PlantLoop(LoopNum)%TempSetPointNodeNum)))
CALL ShowContinueError('Use a SetpointManager:Scheduled:DualSetpoint to establish appropriate setpoints')
CALL ShowContinueError('Or add EMS Actuator for Temperature Maximum Setpoint')
ENDIF !SetPointErrorFlag
ENDIF !Not EMS
ENDIF !Node TSPhi = Sensed
IF (Node(PlantLoop(LoopNum)%TempSetPointNodeNum)%TempSetpointLo == SensedNodeFlagValue) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
CALL ShowSevereError('Plant Loop: missing low temperature setpoint for dual setpoint deadband demand scheme')
CALL ShowContinueError('Node Referenced ='//TRIM(NodeID(PlantLoop(LoopNum)%TempSetPointNodeNum)))
CALL ShowContinueError('Use a SetpointManager:Scheduled:DualSetpoint to establish appropriate setpoints')
SetPointErrorFlag = .TRUE.
ELSE
CALL CheckIfNodeSetpointManagedByEMS(PlantLoop(LoopNum)%TempSetPointNodeNum,iTemperatureMinSetpoint, &
SetpointErrorFlag)
IF (SetpointErrorFlag) Then
CALL ShowSevereError('Plant Loop: missing low temperature setpoint for dual setpoint deadband demand scheme')
CALL ShowContinueError('Node Referenced ='//TRIM(NodeID(PlantLoop(LoopNum)%TempSetPointNodeNum)))
CALL ShowContinueError('Use a SetpointManager:Scheduled:DualSetpoint to establish appropriate setpoints')
CALL ShowContinueError('Or add EMS Actuator for Temperature Minimum Setpoint')
ENDIF !SetPointErrorFlag
ENDIF !NOT EMS
ENDIF !Node TSPtLo = Sensed...
ENDIF !LoopDemandScheme = DualSPDB
END DO !LOOPSIDE
END DO !PLANT LOOP
!Any per-environment load distribution init should be OK here
!Just clear away any trailing MyLoad for now...
!This could likely be moved into InitLoadDistribution also...
DO LoopNum = 1, TotNumLoops
DO LoopSideNum = DemandSide,SupplySide
DO BranchNum = 1, PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TotalBranches
DO CompNum = 1, PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%TotalComponents
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%MyLoad =0.d0
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%FreeCoolCntrlShutDown = .FALSE.
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%Available = .FALSE.
ENDDO
ENDDO
ENDDO
ENDDO
SupplyEnvrnFlag = .FALSE.
!!*****************************************************************
! !END OF ONE TIME ENVIRONMENT INITS
!!*****************************************************************
END IF !END OF FIRSTHVACITERATION INITS
!
IF (.NOT. BeginEnvrnFlag) SupplyEnvrnFlag=.TRUE.
IF(ErrorsFound) CALL ShowFatalError('Preceding errors caused termination')
RETURN
END SUBROUTINE InitializeLoops