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) | :: | FanNum | |||
real(kind=r64), | intent(in), | optional | :: | SpeedRatio |
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 SimOnOffFan(FanNum, SpeedRatio)
! SUBROUTINE INFORMATION:
! AUTHOR Unknown
! DATE WRITTEN Unknown
! MODIFIED Shirey, May 2001
! R. Raustad - FSEC, Jan 2009 - added SpeedRatio for multi-speed fans
! Brent Griffith, May 2009 for EMS
! Chandan Sharma, March 2011, FSEC: Added LocalTurnFansOn and LocalTurnFansOff
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine simulates the simple on/off fan.
! METHODOLOGY EMPLOYED:
! Converts design pressure rise and efficiency into fan power and temperature rise
! Constant fan pressure rise is assumed.
! Uses curves of fan power fraction vs. fan part load to determine fan power at
! off design conditions.
! Same as simple (constant volume) fan, except added part-load curve input
! REFERENCES:
! ASHRAE HVAC 2 Toolkit, page 2-3 (FANSIM)
! USE STATEMENTS:
USE CurveManager, ONLY: CurveValue
USE General, ONLY: TrimSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
Integer, Intent(IN) :: FanNum
REAL(r64), OPTIONAL, INTENT(IN) :: SpeedRatio
! 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]
!unused0909 REAL(r64) Tin ! [C]
!unused0909 REAL(r64) Win
REAL(r64) PartLoadRatio !Ratio of actual mass flow rate to max mass flow rate
REAL(r64) FlowFrac !Actual Fan Flow Fraction = actual mass flow rate / max air mass flow rate
REAL(r64) FanShaftPower ! power delivered to fan shaft
REAL(r64) PowerLossToAir ! fan and motor loss to air stream (watts)
REAL(r64) SpeedRaisedToPower ! Result of the speed ratio raised to the power of n (Curve object)
REAL(r64) EffRatioAtSpeedRatio ! Efficeincy ratio at current speed ratio (Curve object)
Integer, SAVE :: ErrCount=0
DeltaPress = Fan(FanNum)%DeltaPress
IF (Fan(FanNum)%EMSFanPressureOverrideOn) DeltaPress = Fan(FanNum)%EMSFanPressureValue
FanEff = Fan(FanNum)%FanEff
IF (Fan(FanNum)%EMSFanEffOverrideOn) FanEff = Fan(FanNum)%EMSFanEffValue
!unused0909 Tin = Fan(FanNum)%InletAirTemp
!unused0909 Win = Fan(FanNum)%InletAirHumRat
RhoAir = Fan(FanNum)%RhoAirStdInit
MassFlow = Fan(FanNum)%InletAirMassFlowRate
IF (Fan(FanNum)%EMSMaxMassFlowOverrideOn) MassFlow = Fan(FanNum)%EMSAirMassFlowValue
MassFlow = MIN(MassFlow,Fan(FanNum)%MaxAirMassFlowRate)
MassFlow = MAX(MassFlow,Fan(FanNum)%MinAirMassFlowRate)
Fan(FanNum)%FanRuntimeFraction = 0.0d0
! Determine the Fan Schedule for the Time step
IF( ( GetCurrentScheduleValue(Fan(FanNum)%AvailSchedPtrNum)>0.0d0 .or. LocalTurnFansOn) &
.and. .NOT. LocalTurnFansOff .and. Massflow>0.0d0 .and. Fan(FanNum)%MaxAirMassFlowRate > 0.0d0) THEN
! The actual flow fraction is calculated from MassFlow and the MaxVolumeFlow * AirDensity
FlowFrac = MassFlow/(Fan(FanNum)%MaxAirMassFlowRate)
! Calculate the part load ratio, can't be greater than 1
PartLoadRatio= MIN(1.0d0,FlowFrac)
! Fan is operating
IF (OnOffFanPartLoadFraction <= 0.0d0) THEN
CALL ShowRecurringWarningErrorAtEnd('Fan:OnOff, OnOffFanPartLoadFraction <= 0.0, Reset to 1.0',ErrCount)
OnOffFanPartLoadFraction = 1.0d0 ! avoid divide by zero or negative PLF
END IF
IF (OnOffFanPartLoadFraction < 0.7d0) THEN
OnOffFanPartLoadFraction = 0.7d0 ! a warning message is already issued from the DX coils or gas heating coil
END IF
! Keep fan runtime fraction between 0.0 and 1.0, and RTF >= PLR
IF(OnOffFanPartLoadFraction .GE. 1.0d0)THEN
Fan(FanNum)%FanRuntimeFraction = PartLoadRatio
ELSE
Fan(FanNum)%FanRuntimeFraction = MAX(0.0d0,MIN(1.0d0,PartLoadRatio/OnOffFanPartLoadFraction))
END IF
! The fan speed ratio (passed from parent) determines the fan power according to fan laws
IF(PRESENT(SpeedRatio))THEN
! Fan(FanNum)%FanPower = MassFlow*DeltaPress/(FanEff*RhoAir*OnOffFanPartLoadFraction)! total fan power
Fan(FanNum)%FanPower = Fan(FanNum)%MaxAirMassFlowRate*Fan(FanNum)%FanRuntimeFraction*DeltaPress/(FanEff*RhoAir)
! Do not modify fan power calculation unless fan power vs speed ratio curve is used.
IF(Fan(FanNum)%FanPowerRatAtSpeedRatCurveIndex .GT. 0)THEN
! adjust RTF to be in line with speed ratio (i.e., MaxAirMassFlowRate is not MAX when SpeedRatio /= 1)
! PLR = Mdot/MAXFlow => Mdot/(MAXFlow * SpeedRatio), RTF = PLR/PLF => PLR/SpeedRatio/PLF = RTF / SpeedRatio
IF(SpeedRatio .GT. 0.0d0)Fan(FanNum)%FanRuntimeFraction = MIN(1.0d0,Fan(FanNum)%FanRuntimeFraction/SpeedRatio)
SpeedRaisedToPower = CurveValue(Fan(FanNum)%FanPowerRatAtSpeedRatCurveIndex,SpeedRatio)
IF(SpeedRaisedToPower .LT. 0.0d0)THEN
IF(Fan(FanNum)%OneTimePowerRatioCheck .AND. .NOT. WarmupFlag)THEN
CALL ShowSevereError(TRIM(cFanTypes(Fan(FanNum)%FanType_Num))//' = '//TRIM(Fan(FanNum)%FanName)//'"')
CALL ShowContinueError('Error in Fan Power Ratio curve. Curve output less than 0.0.')
CALL ShowContinueError('Curve output = '//TRIM(TrimSigDigits(SpeedRaisedToPower,5))// &
', fan speed ratio = '//TRIM(TrimSigDigits(SpeedRatio,5)))
CALL ShowContinueError('Check curve coefficients to ensure proper power ratio as a function of fan speed ratio.')
CALL ShowContinueError('Resetting Fan Power Ratio curve output to 0.0 and the simulation continues.')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
Fan(FanNum)%OneTimePowerRatioCheck = .FALSE.
END IF
SpeedRaisedToPower = 0.0d0
END IF
IF(Fan(FanNum)%FanEffRatioCurveIndex .GT. 0 .AND. .NOT. WarmupFlag)THEN
EffRatioAtSpeedRatio = CurveValue(Fan(FanNum)%FanEffRatioCurveIndex,SpeedRatio)
IF(EffRatioAtSpeedRatio .LT. 0.01d0)THEN
IF(Fan(FanNum)%OneTimeEffRatioCheck .AND. .NOT. WarmupFlag)THEN
CALL ShowSevereError(TRIM(cFanTypes(Fan(FanNum)%FanType_Num))//' = '//TRIM(Fan(FanNum)%FanName)//'"')
CALL ShowContinueError('Error in Fan Efficiency Ratio curve. Curve output less than 0.01.')
CALL ShowContinueError('Curve output = '//TRIM(TrimSigDigits(EffRatioAtSpeedRatio,5))// &
', fan speed ratio = '//TRIM(TrimSigDigits(SpeedRatio,5)))
CALL ShowContinueError('Check curve coefficients to ensure proper efficiency ratio as a function of fan speed ratio.')
CALL ShowContinueError('Resetting Fan Efficiency Ratio curve output to 0.01 and the simulation continues.')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
Fan(FanNum)%OneTimeEffRatioCheck = .FALSE.
END IF
EffRatioAtSpeedRatio = 0.01d0
END IF
ELSE
EffRatioAtSpeedRatio = 1.0d0
END IF
Fan(FanNum)%FanPower = Fan(FanNum)%FanPower * SpeedRaisedToPower/EffRatioAtSpeedRatio
END IF
ELSE
Fan(FanNum)%FanPower = Fan(FanNum)%MaxAirMassFlowRate*Fan(FanNum)%FanRuntimeFraction*DeltaPress/(FanEff*RhoAir)!total fan power
END IF
! OnOffFanPartLoadFraction is passed via DataHVACGlobals from the cooling or heating coil that is
! requesting the fan to operate in cycling fan/cycling coil mode
OnOffFanPartLoadFraction = 1.0d0 ! reset to 1 in case other on/off fan is called without a part load curve
FanShaftPower = Fan(FanNum)%MotEff * Fan(FanNum)%FanPower ! power delivered to shaft
PowerLossToAir = FanShaftPower + (Fan(FanNum)%FanPower - FanShaftPower) * Fan(FanNum)%MotInAirFrac
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 = Tin + PowerLossToAir/(MassFlow*PsyCpAirFnWTdb(Win,Tin))
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
FanShaftPower = 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
END IF
RETURN
END SUBROUTINE SimOnOffFan