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 | :: | SimAirLoops | ||||
logical | :: | SimZoneEquipment | ||||
logical | :: | SimNonZoneEquipment | ||||
logical | :: | SimPlantLoops | ||||
logical | :: | SimElecCircuits | ||||
logical | :: | FirstHVACIteration | ||||
logical, | intent(in) | :: | LockPlantFlows |
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 SimSelectedEquipment(SimAirLoops, SimZoneEquipment, SimNonZoneEquipment, SimPlantLoops, &
SimElecCircuits, FirstHVACIteration, LockPlantFlows)
! SUBROUTINE INFORMATION:
! AUTHOR Russ Taylor, Rick Strand
! DATE WRITTEN May 1998
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine receives the flags from SimHVAC which determines
! which middle-level managers must be called.
! METHODOLOGY EMPLOYED:
! Each flag is checked and the appropriate manager is then called.
! REFERENCES:
! na
! USE STATEMENTS:
USE ZoneEquipmentManager, ONLY: ManageZoneEquipment
USE NonZoneEquipmentManager, ONLY: ManageNonZoneEquipment
USE SimAirServingZones, ONLY: ManageAirLoops
USE PlantManager, ONLY: ManagePlantLoops
USE ManageElectricPower, ONLY: ManageElectricLoadCenters
USE AirflowNetworkBalanceManager, ONLY: ManageAirflowNetworkBalance
USE DataErrorTracking, ONLY: AskForPlantCheckOnAbort
USE PlantUtilities, ONLY: SetAllFlowLocks, ResetAllPlantInterConnectFlags
USE DataPlant, ONLY: FlowUnlocked, FlowLocked, AnyPlantLoopSidesNeedSim
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL :: SimAirLoops ! True when the air loops need to be (re)simulated
LOGICAL :: SimZoneEquipment ! True when zone equipment components need to be (re)simulated
LOGICAL :: SimNonZoneEquipment ! True when non-zone equipment components need to be (re)simulated
LOGICAL :: SimPlantLoops ! True when the main plant loops need to be (re)simulated
LOGICAL :: SimElecCircuits ! True when electic circuits need to be (re)simulated
LOGICAL :: FirstHVACIteration ! True when solution technique on first iteration
LOGICAL :: ResimulateAirZone ! True when solution technique on third iteration used in AirflowNetwork
LOGICAL, INTENT(IN) :: LockPlantFlows
! SUBROUTINE PARAMETER DEFINITIONS:
Integer, PARAMETER :: MaxAir = 5 ! Iteration Max for Air Simulation Iterations
Integer, PARAMETER :: MaxPlant = 3 ! Iteration Max for Plant Simulation Iteration
Integer, PARAMETER :: MaxCond = 3 ! Iteration Max for Plant Simulation Iteration
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: IterAir ! counts iterations to enforce maximum iteration limit
LOGICAL,SAVE :: MyEnvrnFlag = .true.
LOGICAL,SAVE :: FlowMaxAvailAlreadyReset = .FALSE.
LOGICAL :: FlowResolutionNeeded = .FALSE.
! FLOW:
IterAir = 0
! Set all plant flow locks to UNLOCKED to allow air side components to operate properly
! This requires that the plant flow resolver carefully set the min/max avail limits on
! air side components to ensure they request within bounds.
IF (LockPlantFlows) THEN
CALL SetAllFlowLocks(FlowLocked)
ELSE
CALL SetAllFlowLocks(FlowUnlocked)
ENDIF
CALL ResetAllPlantInterConnectFlags()
IF (BeginEnvrnFlag .and. MyEnvrnFlag) THEN
! Following comment is incorrect! (LKL) Even the first time through this does more than read in data.
! Zone equipment data needs to be read in before air loop data to allow the
! determination of which zones are connected to which air loops.
! This call of ManageZoneEquipment does nothing except force the
! zone equipment data to be read in.
CALL ManageZoneEquipment(FirstHVACIteration,SimZoneEquipment,SimAirLoops)
MyEnvrnFlag = .false.
END IF
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag=.true.
ENDIF
IF (FirstHVACIteration) THEN
RepIterAir = 0
! Call AirflowNetwork simulation to calculate air flows and pressures
if (SimulateAirflowNetwork .gt. AirflowNetworkControlSimple) then
CALL ManageAirflowNetworkBalance(FirstHVACIteration)
end if
CALL ManageAirLoops(FirstHVACIteration,SimAirLoops,SimZoneEquipment)
AirLoopInputsFilled = .True. ! all air loop inputs have been read in
SimAirLoops = .True. !Need to make sure that SimAirLoop is simulated at min twice to calculate PLR in some air loop equipment
AirLoopsSimOnce = .True. ! air loops simulated once for this environment
CALL ResetTerminalUnitFlowLimits
FlowMaxAvailAlreadyReset = .TRUE.
CALL ManageZoneEquipment(FirstHVACIteration,SimZoneEquipment,SimAirLoops)
SimZoneEquipment = .True. !needs to be simulated at least twice for flow resolution to propagate to this routine
CALL ManageNonZoneEquipment(FirstHVACIteration,SimNonZoneEquipment)
CALL ManageElectricLoadCenters(FirstHVACIteration,SimElecCircuits, .FALSE.)
CALL ManagePlantLoops(FirstHVACIteration,SimAirLoops,SimZoneEquipment,SimNonZoneEquipment, &
SimPlantLoops,SimElecCircuits)
AskForPlantCheckOnAbort = .true. ! need to make a first pass through plant calcs before this check make sense
CALL ManageElectricLoadCenters(FirstHVACIteration,SimElecCircuits, .FALSE.)
ELSE
FlowResolutionNeeded = .FALSE.
DO WHILE ((SimAirLoops .OR. SimZoneEquipment) .AND. (IterAir.LE.MaxAir) )
IterAir = IterAir + 1 ! Increment the iteration counter
! Call AirflowNetwork simulation to calculate air flows and pressures
ResimulateAirZone = .FALSE.
if (SimulateAirflowNetwork .gt. AirflowNetworkControlSimple) then
CALL ManageAirflowNetworkBalance(FirstHVACIteration,IterAir,ResimulateAirZone)
end if
IF (SimAirLoops) THEN
CALL ManageAirLoops(FirstHVACIteration,SimAirLoops,SimZoneEquipment)
SimElecCircuits =.TRUE. !If this was simulated there are possible electric changes that need to be simulated
END IF
! make sure flow resolution gets done
IF (FlowResolutionNeeded) THEN
SimZoneEquipment = .TRUE.
END IF
IF (SimZoneEquipment) THEN
If ((IterAir == 1) .and. (.not. FlowMaxAvailAlreadyReset)) THEN ! don't do reset if already done in FirstHVACIteration
CALL ResetTerminalUnitFlowLimits
FlowResolutionNeeded = .TRUE.
ELSE
CALL ResolveAirLoopFlowLimits
FlowResolutionNeeded = .FALSE.
END IF
CALL ManageZoneEquipment(FirstHVACIteration,SimZoneEquipment,SimAirLoops)
SimElecCircuits =.TRUE. ! If this was simulated there are possible electric changes that need to be simulated
END IF
FlowMaxAvailAlreadyReset = .FALSE.
! IterAir = IterAir + 1 ! Increment the iteration counter
IF (SimulateAirflowNetwork .gt. AirflowNetworkControlSimple) THEN
If (ResimulateAirZone) then ! Need to make sure that SimAirLoop and SimZoneEquipment are simulated
SimAirLoops = .TRUE. ! at min three times using ONOFF fan with the AirflowNetwork model
SimZoneEquipment = .TRUE.
End If
END IF
END DO
RepIterAir = RepIterAir + IterAir
IF (IterAir > MaxAir) THEN
AirLoopConvergFail = 1
ELSE
AirLoopConvergFail = 0
END IF
! Check to see if any components have been locked out. If so, SimAirLoops will be reset to TRUE.
CALL ResolveLockoutFlags(SimAirLoops)
IF (SimNonZoneEquipment) THEN
CALL ManageNonZoneEquipment(FirstHVACIteration,SimNonZoneEquipment)
SimElecCircuits =.TRUE. ! If this was simulated there are possible electric changes that need to be simulated
END IF
IF (SimElecCircuits) THEN
CALL ManageElectricLoadCenters(FirstHVACIteration,SimElecCircuits, .FALSE.)
END IF
IF (.NOT. SimPlantLoops) THEN
! check to see if any air side component may have requested plant resim
IF (AnyPlantLoopSidesNeedSim()) THEN
SimPlantLoops = .TRUE.
ENDIF
ENDIF
IF (SimPlantLoops) THEN
CALL ManagePlantLoops(FirstHVACIteration,SimAirLoops,SimZoneEquipment,SimNonZoneEquipment, &
SimPlantLoops,SimElecCircuits)
ENDIF
IF (SimElecCircuits) THEN
CALL ManageElectricLoadCenters(FirstHVACIteration,SimElecCircuits, .FALSE.)
END IF
END IF
RETURN
END SUBROUTINE SimSelectedEquipment