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.
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 SetHeatToReturnAirFlag
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN February 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This sets some flags at the air loop and zone level: these flags indicate
! whether an air loop represents a "unitary" system, and whether the system is operating
! in a on/off (cycling fan) mode. At the zone level flags are set to indicate whether
! the zone is served by a zonal system only, and whether the air loop serving the zone (idf any)
! is in cycling fan mode. Using this information, the subroutine sets a flag at the zone level
! to tell ManageZoneAirUpdates (predict and correct) what to do with the heat to return air.
! METHODOLOGY EMPLOYED:
! Uses program data structures AirLoopControlInfo and ZoneEquipInfo
! REFERENCES:
! na
! USE STATEMENTS:
USE DataHVACGlobals, ONLY : NumPrimaryAirSys
USE DataZoneEquipment, ONLY : ZoneEquipConfig
USE DataHeatBalance, ONLY: Zone, Lights, TotLights
USE ScheduleManager, ONLY: CheckScheduleValue, GetCurrentScheduleValue, GetScheduleMaxValue
USE DataSurfaces, ONLY: SurfaceWindow, AirFlowWindow_Destination_ReturnAir
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENTS:
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: AirLoopNum=0 ! the air loop index
INTEGER :: ControlledZoneNum ! controlled zone index
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL :: CyclingFan = .false. ! TRUE means air loop operates in cycling fan mode at some point
INTEGER :: ZoneNum=0 ! zone index
INTEGER :: LightNum ! Lights object index
INTEGER :: SurfNum ! Surface index
REAL(r64) :: CycFanMaxVal = 0.0d0 ! max value of cycling fan schedule
IF (.not. AirLoopsSimOnce) RETURN
IF (MyOneTimeFlag) THEN
! set the air loop Any Continuous Fan flag
DO AirLoopNum=1,NumPrimaryAirSys
IF (AirLoopControlInfo(AirLoopNum)%UnitarySys) THEN ! for unitary systems check the cycling fan schedule
IF (AirLoopControlInfo(AirLoopNum)%CycFanSchedPtr > 0) THEN
CycFanMaxVal = GetScheduleMaxValue(AirLoopControlInfo(AirLoopNum)%CycFanSchedPtr)
IF (CycFanMaxVal > 0.0d0) THEN
AirLoopControlInfo(AirLoopNum)%AnyContFan = .TRUE.
ELSE
AirLoopControlInfo(AirLoopNum)%AnyContFan = .FALSE.
END IF
ELSE ! no schedule means always cycling fan
AirLoopControlInfo(AirLoopNum)%AnyContFan = .FALSE.
END IF
ELSE ! for nonunitary (central) all systems are continuous fan
AirLoopControlInfo(AirLoopNum)%AnyContFan = .TRUE.
END IF
END DO
! check to see if a controlled zone is served exclusively by a zonal system
DO ControlledZoneNum = 1, NumOfZones
ZoneNum = ZoneEquipConfig(ControlledZoneNum)%ActualZoneNum
IF (ZoneEquipConfig(ControlledZoneNum)%AirLoopNum == 0 .AND. &
ZoneEquipConfig(ControlledZoneNum)%NumInletNodes == ZoneEquipConfig(ControlledZoneNum)%NumExhaustNodes) THEN
ZoneEquipConfig(ControlledZoneNum)%ZonalSystemOnly = .TRUE.
END IF
END DO
! issue warning messages if zone is served by a zonal system or a cycling system and the input calls for
! heat gain to return air
DO ControlledZoneNum = 1, NumOfZones
IF (.not. ZoneEquipConfig(ControlledZoneNum)%IsControlled) CYCLE
ZoneNum = ZoneEquipConfig(ControlledZoneNum)%ActualZoneNum
CyclingFan = .FALSE.
AirLoopNum = ZoneEquipConfig(ControlledZoneNum)%AirLoopNum
IF (AirLoopNum > 0) THEN
IF (AirLoopControlInfo(AirLoopNum)%CycFanSchedPtr > 0) THEN
CyclingFan = CheckScheduleValue(AirLoopControlInfo(AirLoopNum)%CycFanSchedPtr,0.0d0)
END IF
END IF
IF (ZoneEquipConfig(ControlledZoneNum)%ZonalSystemOnly .OR. CyclingFan) THEN
IF (Zone(ZoneNum)%RefrigCaseRA) THEN
CALL ShowWarningError('For zone='//TRIM(Zone(ZoneNum)%Name) // ' return air cooling by refrigerated cases will be' // &
' applied to the zone air.')
CALL ShowContinueError(' This zone has no return air or is served by an on/off HVAC system.')
END IF
DO LightNum=1,TotLights
IF (Lights(LightNum)%ZonePtr /= ZoneNum) CYCLE
IF (Lights(LightNum)%FractionReturnAir > 0.0d0) THEN
CALL ShowWarningError('For zone='//TRIM(Zone(ZoneNum)%Name) // ' return air heat gain from lights will be' // &
' applied to the zone air.')
CALL ShowContinueError(' This zone has no return air or is served by an on/off HVAC system.')
EXIT
END IF
ENDDO
DO SurfNum = Zone(ZoneNum)%SurfaceFirst,Zone(ZoneNum)%SurfaceLast
IF (SurfaceWindow(SurfNum)%AirflowDestination == AirFlowWindow_Destination_ReturnAir) THEN
CALL ShowWarningError('For zone='//TRIM(Zone(ZoneNum)%Name)// &
' return air heat gain from air flow windows will be applied to the zone air.')
CALL ShowContinueError(' This zone has no return air or is served by an on/off HVAC system.')
END IF
END DO
END IF
END DO
MyOneTimeFlag = .FALSE.
END IF
! set the air loop fan operation mode
DO AirLoopNum=1,NumPrimaryAirSys
IF (AirLoopControlInfo(AirLoopNum)%CycFanSchedPtr > 0) THEN
IF (GetCurrentScheduleValue(AirLoopControlInfo(AirLoopNum)%CycFanSchedPtr) .EQ. 0.0d0) THEN
AirLoopControlInfo(AirLoopNum)%FanOpMode = CycFanCycCoil
ELSE
AirLoopControlInfo(AirLoopNum)%FanOpMode = ContFanCycCoil
END IF
END IF
END DO
! set the zone level NoHeatToReturnAir flag and the ZoneEquip fan operation mode
DO ControlledZoneNum = 1, NumOfZones
IF (.not. ZoneEquipConfig(ControlledZoneNum)%IsControlled) CYCLE
ZoneNum = ZoneEquipConfig(ControlledZoneNum)%ActualZoneNum
AirLoopNum = ZoneEquipConfig(ControlledZoneNum)%AirLoopNum
IF (AirLoopNum > 0) THEN
ZoneEquipConfig(ControlledZoneNum)%FanOpMode = AirLoopControlInfo(AirLoopNum)%FanOpMode
ELSE
ZoneEquipConfig(ControlledZoneNum)%FanOpMode = 0
END IF
IF (ZoneEquipConfig(ControlledZoneNum)%FanOpMode == CycFanCycCoil .or. ZoneEquipConfig(ControlledZoneNum)%ZonalSystemOnly) THEN
Zone(ZoneNum)%NoHeatToReturnAir = .TRUE.
ELSE
Zone(ZoneNum)%NoHeatToReturnAir = .FALSE.
END IF
END DO
RETURN
END SUBROUTINE SetHeatToReturnAirFlag