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 HybridVentilationControl
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN Dec. 2006
! MODIFIED July 2012, Chandan Sharma - FSEC: Added zone hybrid ventilation managers
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine performs hybrid ventilation control
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: SameString
USE DataHVACGlobals, ONLY: NumHybridVentSysAvailMgrs,HybridVentSysAvailAirLoopNum,HybridVentSysAvailVentCtrl, &
HybridVentSysAvailANCtrlStatus,HybridVentSysAvailMaster,HybridVentSysAvailWindModifier, &
HybridVentSysAvailActualZoneNum
USE DataZoneEquipment, ONLY: ZoneEquipConfig
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: HybridVentCtrl_Close = 2 ! Open windows or doors
INTEGER, PARAMETER :: IndividualCtrlType = 0 ! Individual window or door control
INTEGER, PARAMETER :: GlobalCtrlType = 1 ! GLobal window or door control
CHARACTER (len=*), PARAMETER :: RoutineName='HybridVentilationControl: ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER SysAvailNum ! Hybrid ventilation control number
INTEGER AirLoopNum ! Airloop number
INTEGER ControlledZoneNum ! Controlled zone number
INTEGER ActualZoneNum ! Actual zone number
INTEGER ANSurfaceNum ! AirflowNetwork Surface Number
INTEGER SurfNum ! Surface number
INTEGER ControlType ! Hybrid ventilation control type: 0 individual; 1 global
LOGICAL Found ! Logical to indicate whether a master surface is found or not
INTEGER, SAVE :: HybridGlobalErrIndex = 0
INTEGER, SAVE :: HybridGlobalErrCount = 0
MultizoneSurfaceData%HybridVentClose = .FALSE.
MultizoneSurfaceData%HybridCtrlGlobal = .FALSE.
MultizoneSurfaceData%HybridCtrlMaster = .FALSE.
MultizoneSurfaceData%WindModifier = 1.0d0
ControlType = IndividualCtrlType
Do SysAvailNum=1,NumHybridVentSysAvailMgrs
AirLoopNum = HybridVentSysAvailAirLoopNum(SysAvailNum)
VentilationCtrl = HybridVentSysAvailVentCtrl(SysAvailNum)
If (HybridVentSysAvailANCtrlStatus(SysAvailNum) > 0) Then
ControlType = GetCurrentScheduleValue(HybridVentSysAvailANCtrlStatus(SysAvailNum))
End If
Found = .FALSE.
ActualZoneNum = 0
Do ControlledZoneNum=1,NumOfZones
IF (.not. ZoneEquipConfig(ControlledZoneNum)%IsControlled) CYCLE
! Ensure all the zones served by this AirLoopHVAC to be controlled by the hybrid ventilation
If (AirLoopNum .GT. 0) THEN
If (AirLoopNum == ZoneEquipConfig(ControlledZoneNum)%AirLoopNum) Then
ActualZoneNum = ZoneEquipConfig(ControlledZoneNum)%ActualZoneNum
End If
Else
If (HybridVentSysAvailActualZoneNum(SysAvailNum) == ZoneEquipConfig(ControlledZoneNum)%ActualZoneNum) THEN
ActualZoneNum = HybridVentSysAvailActualZoneNum(SysAvailNum)
Endif
Endif
If (ActualZoneNum .GT. 0) Then
Do ANSurfaceNum=1,AirflowNetworkNumOfSurfaces
SurfNum = MultizoneSurfaceData(ANSurfaceNum)%SurfNum
If (Surface(SurfNum)%Zone == ActualZoneNum) Then
If (VentilationCtrl == HybridVentCtrl_Close) Then
MultizoneSurfaceData(ANSurfaceNum)%HybridVentClose = .TRUE.
Else
If (HybridVentSysAvailWindModifier(SysAvailNum) .GE. 0) Then
MultizoneSurfaceData(ANSurfaceNum)%WindModifier = HybridVentSysAvailWindModifier(SysAvailNum)
End If
If (ControlType .eq. GlobalCtrlType) Then
MultizoneSurfaceData(ANSurfaceNum)%HybridCtrlGlobal = .TRUE.
If (HybridVentSysAvailMaster(SysAvailNum) .EQ. ActualZoneNum) Then
If ((SurfaceWindow(SurfNum)%OriginalClass == SurfaceClass_Window .OR. &
SurfaceWindow(SurfNum)%OriginalClass == SurfaceClass_Door .OR. &
SurfaceWindow(SurfNum)%OriginalClass == SurfaceClass_GlassDoor) .AND. &
Surface(SurfNum)%ExtBoundCond == ExternalEnvironment) then
MultizoneSurfaceData(ANSurfaceNum)%HybridCtrlMaster = .TRUE.
Found = .TRUE.
End If
End If
End If
End If
End If
End Do
End If
End Do
If (ControlType .eq. GlobalCtrlType .AND. .Not. Found .AND. .NOT. WarmupFlag .AND. VentilationCtrl/=HybridVentCtrl_Close) Then
HybridGlobalErrCount = HybridGlobalErrCount + 1
if (HybridGlobalErrCount < 2) then
CALL ShowWarningError(RoutineName//'The hybrid ventilation control schedule value indicates global control in the '&
//'controlled zone = '//TRIM(Zone(HybridVentSysAvailMaster(SysAvailNum))%Name))
CALL ShowContinueError('The exterior surface containing an opening component in the controlled zone is not found. ' &
//' No global control will not be modeled.')
CALL ShowContinueError('The individual control is assumed.')
CALL ShowContinueErrorTimeStamp(' ')
else
CALL ShowRecurringWarningErrorAtEnd(RoutineName//'The hybrid ventilation control requires a global control.' &
//' The individual control continues...', &
HybridGlobalErrIndex, REAL(controlType,r64), REAL(ControlType,r64))
end if
End If
End Do
END SUBROUTINE HybridVentilationControl