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 ManageSystemAvailability
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN August 2001
! MODIFIED L. Gu, April, 2007. Added hybrid ventilation control
! Chandan Sharma, March 2011/July 2012 - FSEC: Added zone sys avail managers
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Manage the simulation of the System Availability Managers
! METHODOLOGY EMPLOYED:
! NA
! REFERENCES:
! NA
! USE STATEMENTS:
USE DataZoneEquipment, ONLY: ZoneEquipAvail, NumValidSysAvailZoneComponents
USE DataLoopNode
USE DataAirLoop
USE DataPlant
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! None
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: PriAirSysNum ! Primary Air System index
INTEGER :: PriAirSysAvailMgrNum ! Index of Sys Avail Manager in a Primary Air System
INTEGER :: PlantNum ! Plant Loop index
INTEGER :: PlantAvailMgrNum ! Index of Plant Avail Manager in a Plant Loop
INTEGER :: AvailStatus
INTEGER :: PreviousStatus
INTEGER :: ZoneInSysNum
INTEGER :: CtrldZoneNum
INTEGER :: HybridVentNum ! Hybrid ventilation control number
INTEGER :: ZoneEquipType ! Type of ZoneHVAC:* component
INTEGER :: CompNum ! Index of ZoneHVAC:* component
INTEGER :: ZoneCompAvailMgrNum ! Index of availability manager associated with the ZoneHVAC:* component
INTEGER :: DummyArgument=1 ! This variable is used when SimSysAvailManager is called for a ZoneHVAC:* component
IF (GetAvailMgrInputFlag) THEN
CALL GetSysAvailManagerInputs
GetAvailMgrInputFlag=.FALSE.
RETURN
ENDIF
CALL InitSysAvailManagers
DO PriAirSysNum=1,NumPrimaryAirSys ! loop over the primary air systems
PreviousStatus = PriAirSysAvailMgr(PriAirSysNum)%AvailStatus ! Save the previous status for differential thermostat
PriAirSysAvailMgr(PriAirSysNum)%AvailStatus = NoAction ! initialize the availability to "take no action"
DO PriAirSysAvailMgrNum=1,PriAirSysAvailMgr(PriAirSysNum)%NumAvailManagers ! loop over the avail managers in system
CALL SimSysAvailManager(PriAirSysAvailMgr(PriAirSysNum)%AvailManagerType(PriAirSysAvailMgrNum), &
PriAirSysAvailMgr(PriAirSysNum)%AvailManagerName(PriAirSysAvailMgrNum), &
PriAirSysAvailMgr(PriAirSysNum)%AvailManagerNum(PriAirSysAvailMgrNum), &
PriAirSysNum, PreviousStatus, AvailStatus)
IF (AvailStatus .EQ. Forceoff) THEN
PriAirSysAvailMgr(PriAirSysNum)%AvailStatus = ForceOff
EXIT ! Fans forced off takes precedence
ELSE IF (AvailStatus .EQ. CycleOnZoneFansOnly) THEN
PriAirSysAvailMgr(PriAirSysNum)%AvailStatus = CycleOnZoneFansOnly ! zone fans only takes next precedence
ELSE IF ( (AvailStatus .EQ. CycleOn) .AND. &
(PriAirSysAvailMgr(PriAirSysNum)%AvailStatus .EQ. NoAction) ) THEN
PriAirSysAvailMgr(PriAirSysNum)%AvailStatus = CycleOn ! cycle on is lowest precedence
END IF
END DO ! end of availability manager loop
! Add hybrid ventilation control
IF (NumHybridVentSysAvailMgrs > 0) THEN
DO HybridVentNum = 1, NumHybridVentSysAvailMgrs
IF (HybridVentSysAvailMgrData(HybridVentNum)%AirLoopNum == PriAirSysNum .AND. &
HybridVentSysAvailMgrData(HybridVentNum)%VentilationCtrl == HybridVentCtrl_Open) THEN
PriAirSysAvailMgr(PriAirSysNum)%AvailStatus = ForceOff ! Force the system off
END IF
END DO
END IF
! loop over the zones served by the system and set the zone equipment availability
DO ZoneInSysNum=1,AirToZoneNodeInfo(PriAirSysNum)%NumZonesCooled
CtrldZoneNum = AirToZoneNodeInfo(PriAirSysNum)%CoolCtrlZoneNums(ZoneInSysNum)
ZoneEquipAvail(CtrldZoneNum) = PriAirSysAvailMgr(PriAirSysNum)%AvailStatus
END DO
END DO ! end of primary air system loop
DO PlantNum=1,NumPlantLoops
PreviousStatus = PlantAvailMgr(PlantNum)%AvailStatus ! Save the previous status for differential thermostat
PlantAvailMgr(PlantNum)%AvailStatus = NoAction ! Initialize the availability to "take no action"
DO PlantAvailMgrNum=1,PlantAvailMgr(PlantNum)%NumAvailManagers ! loop over the avail managers in plant
CALL SimSysAvailManager(PlantAvailMgr(PlantNum)%AvailManagerType(PlantAvailMgrNum), &
PlantAvailMgr(PlantNum)%AvailManagerName(PlantAvailMgrNum), &
PlantAvailMgr(PlantNum)%AvailManagerNum(PlantAvailMgrNum), &
PlantNum, PreviousStatus, AvailStatus)
IF (AvailStatus /= NoAction) THEN
PlantAvailMgr(PlantNum)%AvailStatus = AvailStatus
EXIT ! First manager to do anything other than "NoAction" gets to set the availability
END IF
END DO ! end of availability manager loop
END DO ! end of plant loop
DO ZoneEquipType = 1,NumValidSysAvailZoneComponents ! loop over the zone equipment types which allow system avail managers
IF(ALLOCATED(ZoneComp))THEN
IF(ZoneComp(ZoneEquipType)%TotalNumComp .GT. 0)THEN
DO CompNum = 1, ZoneComp(ZoneEquipType)%TotalNumComp
IF(ALLOCATED(ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs)) THEN
IF(ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(CompNum)%NumAvailManagers .GT. 0)THEN
! Save the previous status for differential thermostat
PreviousStatus = ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(CompNum)%AvailStatus
! initialize the availability to "take no action"
ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(CompNum)%AvailStatus = NoAction
DO ZoneCompAvailMgrNum=1,ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(CompNum)%NumAvailManagers
! loop over the avail managers in ZoneHVAC:* components
CALL SimSysAvailManager(ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(CompNum)%AvailManagerType(ZoneCompAvailMgrNum), &
ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(CompNum)%AvailManagerName(ZoneCompAvailMgrNum), &
ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(CompNum)%AvailManagerNum(ZoneCompAvailMgrNum), &
DummyArgument, PreviousStatus, AvailStatus, ZoneEquipType, CompNum)
IF (AvailStatus .EQ. Forceoff) THEN
ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(CompNum)%AvailStatus = ForceOff
EXIT ! Fans forced off takes precedence
ELSE IF ( (AvailStatus .EQ. CycleOn) .AND. &
(ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(CompNum)%AvailStatus .EQ. NoAction) ) THEN
! cycle on is next precedence
ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(CompNum)%AvailStatus = CycleOn
END IF
END DO ! end of availability manager loop
ENDIF
ELSE
ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(CompNum)%AvailStatus = NoAction
ENDIF
IF (ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(CompNum)%ZoneNum .GT. 0) THEN
IF (NumHybridVentSysAvailMgrs > 0) THEN
DO HybridVentNum = 1, NumHybridVentSysAvailMgrs
IF (.NOT. HybridVentSysAvailMgrData(HybridVentNum)%HybridVentMgrConnectedToAirLoop) THEN
IF (HybridVentSysAvailMgrData(HybridVentNum)%ActualZoneNum == &
ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(CompNum)%ZoneNum) THEN
IF (HybridVentSysAvailMgrData(HybridVentNum)%VentilationCtrl == HybridVentCtrl_Open) THEN
ZoneComp(ZoneEquipType)%ZoneCompAvailMgrs(CompNum)%AvailStatus = ForceOff
END IF
END IF
ENDIF
END DO
END IF
ENDIF
END DO
ENDIF
ENDIF
END DO ! end of zone equip types
RETURN
END SUBROUTINE ManageSystemAvailability