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 | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | I | |||
real(kind=r64), | intent(out) | :: | OpenFactor |
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 AirflowNetworkVentingControl (I,OpenFactor)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN April 2003
! MODIFIED Feb 2004, FCW: allow venting control of interior window/door
! MODIFIED Nov. 2005, LG: to fit the requirement for AirflowNetwork Model
! RE-ENGINEERED
! PURPOSE OF THIS SUBROUTINE:
! Determines the venting opening factor for an exterior or interior window or door
! as determined by the venting control method.
! METHODOLOGY EMPLOYED:na
! REFERENCES:na
! USE STATEMENTS:
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE DataSurfaces, ONLY: SurfaceWindow
USE ThermalComfort, ONLY: ThermalComfortData
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: I ! AirflowNetwork surface number
REAL(r64), INTENT(OUT) :: OpenFactor ! Window or door opening factor (used to calculate airflow)
! SUBROUTINE PARAMETER DEFINITIONS:na
! INTERFACE BLOCK SPECIFICATIONS:na
! DERIVED TYPE DEFINITIONS:na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) VentTemp ! Venting temperature (C)
REAL(r64) ZoneAirEnthalpy ! Enthalpy of zone air (J/kg)
REAL(r64) OpenFactorMult ! Window/door opening modulation multiplier on venting open factor
REAL(r64) DelTemp ! Inside-outside air temperature difference (K)
REAL(r64) DelEnthal ! Inside-outsdie air enthalpy difference (J/kg)
INTEGER IZ ! AirflowNetwork zone number
INTEGER ZoneNum ! EnergyPlus zone number
INTEGER SurfNum ! Heat transfer surface number
REAL(r64) LimValVentOpenFacMult ! Limiting value of venting opening factor multiplier
REAL(r64) LowerValInOutTempDiff ! Lower value of inside/outside temperature difference for opening factor modulation
REAL(r64) UpperValInOutTempDiff ! Upper value of inside/outside temperature difference for opening factor modulation
REAL(r64) LowerValInOutEnthalDiff ! Lower value of inside/outside enthalpy difference for opening factor modulation
REAL(r64) UpperValInOutEnthalDiff ! Upper value of inside/outside enthalpy difference for opening factor modulation
LOGICAL VentingAllowed ! True if venting schedule allows venting
INTEGER VentCtrlNum ! Venting control strategy 1: Temperature contro; 2: Enthalpy control
REAL(r64) VentingSchVal ! Current time step value of venting schedule
REAL(r64) Tamb ! Outdoor dry bulb temperature at surface centroid height
INTEGER PeopleInd
IF (MultizoneSurfaceData(I)%EMSOpenFactorActuated) Then ! EMS sets value to use
OpenFactor = MultizoneSurfaceData(I)%EMSOpenFactor
SurfNum = MultizoneSurfaceData(I)%SurfNum
If (MultizoneSurfaceData(i)%Factor > 0.0D0) THEN
SurfaceWindow(SurfNum)%VentingOpenFactorMultRep = OpenFactor / MultizoneSurfaceData(i)%Factor
ELSE
SurfaceWindow(SurfNum)%VentingOpenFactorMultRep = OpenFactor
ENDIF
RETURN
ENDIF
SurfNum = MultizoneSurfaceData(I)%SurfNum
SurfaceWindow(SurfNum)%VentingOpenFactorMultRep = -1.0d0
! Get venting temperature and venting strategy for exterior window or door
! and determine whether venting is allowed
SurfaceWindow(SurfNum)%VentingAvailabilityRep = 1.0d0
VentingAllowed = .TRUE.
IZ = MultizoneSurfaceData(I)%NodeNums(1)
ZoneNum = MultizoneZoneData(IZ)%ZoneNum
! Note in the following that individual venting control for a window/door takes
! precedence over zone-level control
If (MultizoneSurfaceData(I)%IndVentControl) then
VentTemp = GetCurrentScheduleValue(MultizoneSurfaceData(I)%VentSchNum)
VentCtrlNum = MultizoneSurfaceData(I)%VentSurfCtrNum
If (MultizoneSurfaceData(I)%VentingSchNum > 0) then
VentingSchVal = GetCurrentScheduleValue(MultizoneSurfaceData(I)%VentingSchNum)
If (VentingSchVal <= 0.0d0) then
VentingAllowed = .FALSE.
SurfaceWindow(SurfNum)%VentingAvailabilityRep = 0.0d0
End If
End If
Else
! Zone level only by Gu on Nov. 8, 2005
VentTemp = GetCurrentScheduleValue(MultizoneZoneData(IZ)%VentSchNum)
VentCtrlNum = MultizoneZoneData(Iz)%VentCtrNum
If (MultizoneZoneData(IZ)%VentingSchNum > 0) then
VentingSchVal = GetCurrentScheduleValue(MultizoneZoneData(IZ)%VentingSchNum)
If (VentingSchVal <= 0.0d0) then
VentingAllowed = .FALSE.
SurfaceWindow(SurfNum)%VentingAvailabilityRep = 0.0d0
End If
End If
End If
SurfaceWindow(SurfNum)%InsideTempForVentingRep = VentTemp
OpenFactor = 0.0d0
! Venting based on inside-outside air temperature difference
if ((VentCtrlNum == VentCtrNum_Temp .or. VentCtrlNum == VentCtrNum_AdjTemp) .AND. VentingAllowed) then
Tamb = Surface(SurfNum)%OutDryBulbTemp
! Check whether this surface is an interior wall or not. If Yes, use adjacent zone conditions
If (VentCtrlNum == VentCtrNum_AdjTemp .and. MultizoneSurfaceData(I)%IndVentControl) then
Tamb = ANZT(MultizoneZoneData(MultizoneSurfaceData(I)%NodeNums(2))%ZoneNum)
End If
if (ANZT(ZoneNum) > Tamb .AND. ANZT(ZoneNum) > VentTemp) then
OpenFactor = MultizoneSurfaceData(i)%Factor
SurfaceWindow(SurfNum)%VentingOpenFactorMultRep = 1.0d0
! Modulation of OpenFactor
If (MultizoneSurfaceData(I)%IndVentControl) then
LimValVentOpenFacMult = MultizoneSurfaceData(i)%ModulateFactor
LowerValInOutTempDiff = MultizoneSurfaceData(i)%LowValueTemp
UpperValInOutTempDiff = MultizoneSurfaceData(i)%UpValueTemp
Else
LimValVentOpenFacMult = MultizoneZoneData(IZ)%OpenFactor
LowerValInOutTempDiff = MultizoneZoneData(IZ)%LowValueTemp
UpperValInOutTempDiff = MultizoneZoneData(IZ)%UpValueTemp
End If
if(LimValVentOpenFacMult /= 1.0d0) then
DelTemp = ANZT(ZoneNum)-Tamb
if(DelTemp <= LowerValInOutTempDiff) then
OpenFactorMult = 1.0d0
else if (DelTemp >= UpperValInOutTempDiff) then
OpenFactorMult = LimValVentOpenFacMult
else
OpenFactorMult = LimValVentOpenFacMult + &
((UpperValInOutTempDiff-DelTemp)/(UpperValInOutTempDiff-LowerValInOutTempDiff))* &
(1-LimValVentOpenFacMult)
endif
OpenFactor = OpenFactorMult * OpenFactor
SurfaceWindow(SurfNum)%VentingOpenFactorMultRep = OpenFactorMult
end if
else
OpenFactor = 0.0d0
SurfaceWindow(SurfNum)%VentingOpenFactorMultRep = -1.0d0
endif
endif
! Venting based on inside-outside air enthalpy difference
if ((VentCtrlNum == VentCtrNum_Enth .or. VentCtrlNum == VentCtrNum_AdjEnth) .AND. VentingAllowed) then
ZoneAirEnthalpy = PsyHFnTdbW(ANZT(ZoneNum),ANZW(ZoneNum))
! Check whether this surface is an interior wall or not. If Yes, use adjacent zone conditions
If (VentCtrlNum == VentCtrNum_AdjEnth .AND. MultizoneSurfaceData(I)%IndVentControl) then
OutEnthalpy = PsyHFnTdbW(ANZT(MultizoneZoneData(MultizoneSurfaceData(I)%NodeNums(2))%ZoneNum), &
ANZW(MultizoneZoneData(MultizoneSurfaceData(I)%NodeNums(2))%ZoneNum))
End If
if (ZoneAirEnthalpy > OutEnthalpy .AND. ANZT(ZoneNum) > VentTemp) then
OpenFactor = MultizoneSurfaceData(i)%Factor
! Modulation of OpenFactor
If (MultizoneSurfaceData(I)%IndVentControl) then
LimValVentOpenFacMult = MultizoneSurfaceData(i)%ModulateFactor
LowerValInOutEnthalDiff = MultizoneSurfaceData(i)%LowValueEnth
UpperValInOutEnthalDiff = MultizoneSurfaceData(i)%UpValueEnth
Else
LimValVentOpenFacMult = MultizoneZoneData(IZ)%OpenFactor
LowerValInOutEnthalDiff = MultizoneZoneData(IZ)%LowValueEnth
UpperValInOutEnthalDiff = MultizoneZoneData(IZ)%UpValueEnth
End If
SurfaceWindow(SurfNum)%VentingOpenFactorMultRep = 1.0d0
if (LimValVentOpenFacMult /= 1.0d0) then
DelEnthal = ZoneAirEnthalpy - OutEnthalpy
if (DelEnthal <= LowerValInOutEnthalDiff) then
OpenFactorMult = 1.0d0
else if (DelEnthal >= UpperValInOutEnthalDiff) then
OpenFactorMult = LimValVentOpenFacMult
else
OpenFactorMult = LimValVentOpenFacMult + &
((UpperValInOutEnthalDiff-DelEnthal)/(UpperValInOutEnthalDiff-LowerValInOutEnthalDiff))* &
(1-LimValVentOpenFacMult)
endif
OpenFactor = OpenFactorMult * OpenFactor
SurfaceWindow(SurfNum)%VentingOpenFactorMultRep = OpenFactorMult
end if
else
OpenFactor = 0.0d0
SurfaceWindow(SurfNum)%VentingOpenFactorMultRep = -1.0d0
endif
endif
! Constant venting (opening factor as specified in IDF) - C-PH - added by Philip Haves 3/8/01
! subject to venting availability
if (VentCtrlNum == VentCtrNum_Const .AND. VentingAllowed) then ! Constant
OpenFactor = MultizoneSurfaceData(i)%Factor
SurfaceWindow(SurfNum)%VentingOpenFactorMultRep = 1.0d0
endif
IF (VentCtrlNum == VentCtrNum_ASH55) THEN
IF (VentingAllowed .AND. (.NOT. BeginEnvrnFlag) .AND. (.NOT. WarmupFlag)) THEN
PeopleInd = MultizoneZoneData(IZ)%ASH55PeopleInd
IF (PeopleInd > 0 .AND. ThermalComfortData(PeopleInd)%ThermalComfortAdaptiveASH5590 /= -1 ) THEN
IF (ThermalComfortData(PeopleInd)%ThermalComfortOpTemp > ThermalComfortData(PeopleInd)%TComfASH55) THEN
OpenFactor = MultizoneSurfaceData(i)%Factor
SurfaceWindow(SurfNum)%VentingOpenFactorMultRep = 1.0d0
ELSE
OpenFactor = 0.0d0
END IF
ELSE
OpenFactor = 0.0d0
END IF
ELSE
OpenFactor = 0.0d0
END IF
END IF
IF (VentCtrlNum == VentCtrNum_CEN15251) THEN
IF (VentingAllowed .AND. (.NOT. BeginEnvrnFlag) .AND. (.NOT. WarmupFlag)) THEN
PeopleInd = MultizoneZoneData(IZ)%CEN15251PeopleInd
IF (PeopleInd > 0 .AND. ThermalComfortData(PeopleInd)%ThermalComfortAdaptiveCEN15251CatI /= -1 ) THEN
IF (ThermalComfortData(PeopleInd)%ThermalComfortOpTemp > ThermalComfortData(PeopleInd)%TComfCEN15251) THEN
OpenFactor = MultizoneSurfaceData(i)%Factor
SurfaceWindow(SurfNum)%VentingOpenFactorMultRep = 1.0d0
ELSE
OpenFactor = 0.0d0
END IF
ELSE
OpenFactor = 0.0d0
END IF
ELSE
OpenFactor = 0.0d0
END IF
END IF
! No venting, i.e, window/door always closed - added YJH 8 Aug 02
if (VentCtrlNum == VentCtrNum_Novent ) then ! Novent
OpenFactor = 0.0d0
SurfaceWindow(SurfNum)%VentingOpenFactorMultRep = -1.0d0
endif
RETURN
END SUBROUTINE AirflowNetworkVentingControl