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