Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | FanNum |
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 SimZoneExhaustFan(FanNum)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN Jan 2000
! MODIFIED Brent Griffith, May 2009 for EMS
! Brent Griffith, Feb 2013 controls upgrade
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine simulates the Zone Exhaust Fan
! METHODOLOGY EMPLOYED:
! Converts design pressure rise and efficiency into fan power and temperature rise
! Constant fan pressure rise is assumed.
! REFERENCES:
! ASHRAE HVAC 2 Toolkit, page 2-3 (FANSIM)
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
Integer, Intent(IN) :: FanNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: RhoAir
REAL(r64) :: DeltaPress ! [N/m2]
REAL(r64) :: FanEff
REAL(r64) :: MassFlow ! [kg/sec]
REAL(r64) :: Tin ! [C]
REAL(r64) :: PowerLossToAir ! fan and motor loss to air stream (watts)
LOGICAL :: FanIsRunning
DeltaPress = Fan(FanNum)%DeltaPress
IF (Fan(FanNum)%EMSFanPressureOverrideOn) DeltaPress = Fan(FanNum)%EMSFanPressureValue
FanEff = Fan(FanNum)%FanEff
IF (Fan(FanNum)%EMSFanEffOverrideOn) FanEff = Fan(FanNum)%EMSFanEffValue
! For a Constant Volume Simple Fan the Max Flow Rate is the Flow Rate for the fan
Tin = Fan(FanNum)%InletAirTemp
RhoAir = Fan(FanNum)%RhoAirStdInit
MassFlow = Fan(FanNum)%InletAirMassFlowRate
! When the AvailManagerMode == ExhaustFanCoupledToAvailManagers then the
! Exhaust Fan is interlocked with air loop availability via global TurnFansOn and TurnFansOff variables.
! There is now the option to control if user wants to decouple air loop operation and exhaust fan operation
! (zone air mass balance issues). If in the future want to allow for zone level local availability manager
! then the optional arguments ZoneCompTurnFansOn and ZoneCompTurnFansOff will need
! to be passed to SimulateFanComponents, and TurnFansOn must be changed to LocalTurnFansOn
! and TurnFansOff to LocalTurnFansOff in the IF statement below.
! apply controls to determine if operating
IF (Fan(FanNum)%AvailManagerMode == ExhaustFanCoupledToAvailManagers) THEN
IF ( (( GetCurrentScheduleValue(Fan(FanNum)%AvailSchedPtrNum) > 0.0d0) .OR. TurnFansOn ) &
.AND. .NOT. TurnFansOff .AND. MassFlow > 0.0d0 ) THEN ! available
IF (Fan(FanNum)%MinTempLimitSchedNum > 0) THEN
IF (Tin >= GetCurrentScheduleValue(Fan(FanNum)%MinTempLimitSchedNum)) THEN
FanIsRunning = .TRUE.
ELSE
FanIsRunning = .FALSE.
ENDIF
ELSE
FanIsRunning = .TRUE.
ENDIF
ELSE
FanIsRunning = .FALSE.
ENDIF
ELSEIF (Fan(FanNum)%AvailManagerMode == ExhaustFanDecoupledFromAvailManagers) THEN
IF ( GetCurrentScheduleValue(Fan(FanNum)%AvailSchedPtrNum) > 0.0d0 .AND. MassFlow > 0.0d0 ) THEN
IF (Fan(FanNum)%MinTempLimitSchedNum > 0) THEN
IF (Tin >= GetCurrentScheduleValue(Fan(FanNum)%MinTempLimitSchedNum)) THEN
FanIsRunning = .TRUE.
ELSE
FanIsRunning = .FALSE.
ENDIF
ELSE
FanIsRunning = .TRUE.
ENDIF
ELSE
FanIsRunning = .FALSE.
ENDIF
ENDIF
IF ( FanIsRunning ) THEN
!Fan is operating
Fan(FanNum)%FanPower = MassFlow*DeltaPress/(FanEff*RhoAir) ! total fan power
PowerLossToAir = Fan(FanNum)%FanPower
Fan(FanNum)%OutletAirEnthalpy = Fan(FanNum)%InletAirEnthalpy + PowerLossToAir/MassFlow
! This fan does not change the moisture or Mass Flow across the component
Fan(FanNum)%OutletAirHumRat = Fan(FanNum)%InletAirHumRat
Fan(FanNum)%OutletAirMassFlowRate = MassFlow
Fan(FanNum)%OutletAirTemp = PsyTdbFnHW(Fan(FanNum)%OutletAirEnthalpy,Fan(FanNum)%OutletAirHumRat)
ELSE
!Fan is off and not operating no power consumed and mass flow rate.
Fan(FanNum)%FanPower = 0.0d0
PowerLossToAir = 0.0d0
Fan(FanNum)%OutletAirMassFlowRate = 0.0d0
Fan(FanNum)%OutletAirHumRat = Fan(FanNum)%InletAirHumRat
Fan(FanNum)%OutletAirEnthalpy = Fan(FanNum)%InletAirEnthalpy
Fan(FanNum)%OutletAirTemp = Fan(FanNum)%InletAirTemp
! Set the Control Flow variables to 0.0 flow when OFF.
Fan(FanNum)%MassFlowRateMaxAvail = 0.0d0
Fan(FanNum)%MassFlowRateMinAvail = 0.0d0
Fan(FanNum)%InletAirMassFlowRate = 0.0d0
END IF
RETURN
END SUBROUTINE SimZoneExhaustFan