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) | :: | SysAvailNum | |||
integer, | intent(in) | :: | PriAirSysNum | |||
integer, | intent(out) | :: | AvailStatus | |||
integer, | intent(in), | optional | :: | ZoneEquipType |
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 CalcNVentSysAvailMgr(SysAvailNum,PriAirSysNum,AvailStatus,ZoneEquipType)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN December 2004
! MODIFIED March 2011, Chandan Sharma - FSEC: Allowed night ventilation
! availability manager to work for zone component
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Set AvailStatus indicator for a primary air loop and ZoneHVAC component and sets a specified flow
! rate fraction for the air loop for use during night ventilation.
! METHODOLOGY EMPLOYED:
! Looks at outside and indoor conditions to determine if night ventilation
! is beneficial. If it is and it is scheduled on the AvailStatus is set to cycle
! on and the loop flow rate fractionis set to the specified night ventilation
! value.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataAirLoop
USE DataZoneEquipment, ONLY: ZoneEquipConfig
USE DataHeatBalFanSys, ONLY: TempZoneThermostatSetpoint, ZoneThermostatSetPointHi, &
ZoneThermostatSetPointLo, TempControlType, TempTstatAir
USE DataEnvironment, ONLY: OutDryBulbTemp
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: SysAvailNum ! number of the current scheduled system availability manager
INTEGER, INTENT (IN) :: PriAirSysNum ! number of the primary air system affected by this Avail. Manager
INTEGER, INTENT (OUT) :: AvailStatus ! System status indicator
INTEGER, OPTIONAL, INTENT(IN) :: ZoneEquipType ! Type of zone equipment component
! SUBROUTINE PARAMETER DEFINITIONS:
! INTERFACE BLOCK SPECIFICATIONS:
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ZoneInSysNum
INTEGER :: CtrldZoneNum
INTEGER :: ZoneNum
LOGICAL :: TempCheck ! TRUE if one zone's temperature is above the value of the vent temp sched
LOGICAL :: DelTCheck ! TRUE if the control zone temperature - outside temperature > VentDelT
LOGICAL :: LowLimCheck ! TRUE if one zones's air temperature is below this value
REAL(r64) :: VentTemp ! value of the ventilation temperature schedule
INTEGER :: ControlZoneNum ! actual zone number of the control zone
TempCheck = .FALSE.
DelTCheck = .FALSE.
LowLimCheck = .FALSE.
! check if night venting allowed: not allowed if avail sched is off or fan sched is on
! CR 7913 changed to allow during warmup
IF ( (GetCurrentScheduleValue(NVentSysAvailMgrData(SysAvailNum)%SchedPtr) <= 0.0d0) .OR. &
(GetCurrentScheduleValue(NVentSysAvailMgrData(SysAvailNum)%FanSchedPtr) > 0.0d0) ) THEN
AvailStatus = NoAction
ELSE
VentTemp = GetCurrentScheduleValue(NVentSysAvailMgrData(SysAvailNum)%VentTempSchedPtr)
ControlZoneNum = NVentSysAvailMgrData(SysAvailNum)%ZoneNum
IF (PRESENT(ZoneEquipType)) THEN
! if the room temperature is greater than the vent temp sched value, set the vent temp check to TRUE
IF (TempTstatAir(ControlZoneNum) > VentTemp) THEN
TempCheck = .TRUE.
END IF
! if the room temperature is less than the low limit set the low limit check to TRUE
IF (TempTstatAir(ControlZoneNum) < NVentSysAvailMgrData(SysAvailNum)%VentTempLowLim) THEN
LowLimCheck = .TRUE.
END IF
ELSE
DO ZoneInSysNum=1,AirToZoneNodeInfo(PriAirSysNum)%NumZonesCooled ! loop over zones in system
CtrldZoneNum = AirToZoneNodeInfo(PriAirSysNum)%CoolCtrlZoneNums(ZoneInSysNum)
ZoneNum = ZoneEquipConfig(CtrldZoneNum)%ActualZoneNum
! if the room temperature is greater than the vent temp sched value, set the vent temp check to TRUE
IF (TempTstatAir(ZoneNum) > VentTemp) THEN
TempCheck = .TRUE.
END IF
! if the room temperature is less than the low limit set the low limit check to TRUE
IF (TempTstatAir(ZoneNum) < NVentSysAvailMgrData(SysAvailNum)%VentTempLowLim) THEN
LowLimCheck = .TRUE.
END IF
END DO
ENDIF
! If the difference between the control zone temperature and the outside temperature is greater than
! the specified night venting delta T then set the delta T check to TRUE
IF ( (TempTstatAir(ControlZoneNum) - OutDryBulbTemp) > NVentSysAvailMgrData(SysAvailNum)%VentDelT ) THEN
DelTCheck = .TRUE.
END IF
! If the limit requirements are met turn on night ventilation
IF (TempCheck .AND. DelTCheck .AND. .NOT. LowLimCheck) THEN
AvailStatus = CycleOn
ELSE
AvailStatus = NoAction
END IF
END IF
IF (.NOT. PRESENT(ZoneEquipType)) THEN
IF (AvailStatus == CycleOn) THEN
AirLoopControlInfo(PriAirSysNum)%LoopFlowRateSet = .TRUE.
AirLoopControlInfo(PriAirSysNum)%NightVent = .TRUE.
AirLoopFlow(PriAirSysNum)%ReqSupplyFrac = NVentSysAvailMgrData(SysAvailNum)%VentFlowFrac
END IF
ENDIF
NVentSysAvailMgrData(SysAvailNum)%AvailStatus = AvailStatus
RETURN
END SUBROUTINE CalcNVentSysAvailMgr