Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | FanNum | |||
real(kind=r64), | intent(in), | optional | :: | PressureRise |
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 SimVariableVolumeFan(FanNum, PressureRise)
! SUBROUTINE INFORMATION:
! AUTHOR Unknown
! DATE WRITTEN Unknown
! MODIFIED Phil Haves
! 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 variable volume 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.
! 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
REAL(r64), INTENT(IN), OPTIONAL :: PressureRise
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) RhoAir
REAL(r64) DeltaPress ! [N/m2 = Pa]
REAL(r64) FanEff ! Total fan efficiency - combined efficiency of fan, drive train,
! motor and variable speed controller (if any)
REAL(r64) MaxAirMassFlowRate
REAL(r64) MotInAirFrac
REAL(r64) MotEff
REAL(r64) MassFlow ! [kg/sec]
!unused0909 REAL(r64) Tin ! [C]
!unused0909 REAL(r64) Win
REAL(r64) PartLoadFrac
!unused0909 REAL(r64) MaxFlowFrac !Variable Volume Fan Max Flow Fraction [-]
REAL(r64) MinFlowFrac !Variable Volume Fan Min Flow Fraction [-]
REAL(r64) :: FlowFracForPower = 0.d0 !Variable Volume Fan Flow Fraction for power calcs[-]
REAL(r64) :: FlowFracActual = 0.d0 ! actual VAV fan flow fraction
REAL(r64) FanShaftPower ! power delivered to fan shaft
REAL(r64) PowerLossToAir ! fan and motor loss to air stream (watts)
Integer NVPerfNum
! added to address the fan heat issue during low air flow conditions
REAL(r64) MinFlowFracLimitFanHeat ! Minimum Fan Flow Fraction Limit for Fan Heat at Low Airflow [-]
REAL(r64) FanPoweratLowMinimum ! Fan Power at Low Minimum Airflow [W]
REAL(r64) PartLoadFracatLowMin
REAL(r64) DeltaTAcrossFan ! Air temperature rise across the fan due to fan heat [C]
! Simple Variable Volume Fan - default values from DOE-2
! Type of Fan Coeff1 Coeff2 Coeff3 Coeff4 Coeff5
! INLET VANE DAMPERS 0.35071223 0.30850535 -0.54137364 0.87198823 0.000
! DISCHARGE DAMPERS 0.37073425 0.97250253 -0.34240761 0.000 0.000
! VARIABLE SPEED MOTOR 0.0015302446 0.0052080574 1.1086242 -0.11635563 0.000
NVPerfNum = Fan(FanNum)%NVPerfNum
IF (NightVentOn .AND. NVPerfNum > 0) THEN
DeltaPress = NightVentPerf(NVPerfNum)%DeltaPress
FanEff = NightVentPerf(NVPerfNum)%FanEff
MotEff = NightVentPerf(NVPerfNum)%MotEff
MotInAirFrac = NightVentPerf(NVPerfNum)%MotInAirFrac
MaxAirMassFlowRate = NightVentPerf(NVPerfNum)%MaxAirMassFlowRate
ELSE
IF (PRESENT(PressureRise)) THEN
DeltaPress = PressureRise
ELSE
DeltaPress = Fan(FanNum)%DeltaPress
ENDIF
FanEff = Fan(FanNum)%FanEff
MotEff = Fan(FanNum)%MotEff
MotInAirFrac = Fan(FanNum)%MotInAirFrac
MaxAirMassFlowRate = Fan(FanNum)%MaxAirMassFlowRate
END IF
IF (Fan(FanNum)%EMSFanPressureOverrideOn) DeltaPress = Fan(FanNum)%EMSFanPressureValue
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)
!Determine the Fan Schedule for the Time step
If( ( GetCurrentScheduleValue(Fan(FanNum)%AvailSchedPtrNum)>0.0d0 .or. LocalTurnFansOn) &
.and. .NOT. LocalTurnFansOff .and. Massflow>0.0d0) Then
!Fan is operating - calculate power loss and enthalpy rise
! Fan(FanNum)%FanPower = PartLoadFrac*FullMassFlow*DeltaPress/(FanEff*RhoAir) ! total fan power
! Calculate and check limits on fraction of system flow
!unused0909 MaxFlowFrac = 1.0
! MinFlowFrac is calculated from the ration of the volume flows and is non-dimensional
MinFlowFrac = Fan(FanNum)%MinAirFlowRate/Fan(FanNum)%MaxAirFlowRate
! The actual flow fraction is calculated from MassFlow and the MaxVolumeFlow * AirDensity
FlowFracActual = MassFlow/(Fan(FanNum)%MaxAirMassFlowRate)
! Calculate the part Load Fraction (PH 7/13/03)
FlowFracForPower = MAX(MinFlowFrac,MIN(FlowFracActual,1.0d0)) ! limit flow fraction to allowed range
IF (NightVentOn .AND. NVPerfNum > 0) THEN
PartLoadFrac = 1.0d0
ELSE
PartLoadFrac=Fan(FanNum)%FanCoeff(1) + Fan(FanNum)%FanCoeff(2)*FlowFracForPower + &
Fan(FanNum)%FanCoeff(3)*FlowFracForPower**2 + Fan(FanNum)%FanCoeff(4)*FlowFracForPower**3 + &
Fan(FanNum)%FanCoeff(5)*FlowFracForPower**4
END IF
Fan(FanNum)%FanPower = PartLoadFrac*MaxAirMassFlowRate*DeltaPress/(FanEff*RhoAir) ! total fan power (PH 7/13/03)
FanShaftPower = MotEff * Fan(FanNum)%FanPower ! power delivered to shaft
PowerLossToAir = FanShaftPower + (Fan(FanNum)%FanPower - FanShaftPower) * 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 = PsyTdbFnHW(Fan(FanNum)%OutletAirEnthalpy,Fan(FanNum)%OutletAirHumRat)
! KHL/FB, 2/10/2011. NFP implemented as CR 8338.
! When fan air flow is less than 10%, the fan power curve is linearized between the 10% to 0% to
! avoid the unrealistic high temperature rise across the fan.
! TH, 2/15/2011
! This change caused diffs for VAV systems when fan runs at less than 10% flow conditions.
! A potential way to improve is to check the temperature rise across the fan first,
! if it is too high (say > 20C) then applies the code.
DeltaTAcrossFan = Fan(FanNum)%OutletAirTemp - Fan(FanNum)%InletAirTemp
IF (DeltaTAcrossFan > 20.0d0) THEN
MinFlowFracLimitFanHeat = 0.10d0
IF (FlowFracForPower < MinFlowFracLimitFanHeat) THEN
PartLoadFracatLowMin=Fan(FanNum)%FanCoeff(1) + Fan(FanNum)%FanCoeff(2)*MinFlowFracLimitFanHeat + &
Fan(FanNum)%FanCoeff(3)*MinFlowFracLimitFanHeat**2 + Fan(FanNum)%FanCoeff(4)*MinFlowFracLimitFanHeat**3 + &
Fan(FanNum)%FanCoeff(5)*MinFlowFracLimitFanHeat**4
FanPoweratLowMinimum = PartLoadFracatLowMin*MaxAirMassFlowRate*DeltaPress/(FanEff*RhoAir)
Fan(FanNum)%FanPower = FlowFracForPower * FanPoweratLowMinimum / MinFlowFracLimitFanHeat
ELSEIF (FlowFracActual < MinFlowFracLimitFanHeat) THEN
PartLoadFracatLowMin=Fan(FanNum)%FanCoeff(1) + Fan(FanNum)%FanCoeff(2)*MinFlowFracLimitFanHeat + &
Fan(FanNum)%FanCoeff(3)*MinFlowFracLimitFanHeat**2 + Fan(FanNum)%FanCoeff(4)*MinFlowFracLimitFanHeat**3 + &
Fan(FanNum)%FanCoeff(5)*MinFlowFracLimitFanHeat**4
FanPoweratLowMinimum = PartLoadFracatLowMin*MaxAirMassFlowRate*DeltaPress/(FanEff*RhoAir)
Fan(FanNum)%FanPower = FlowFracActual * FanPoweratLowMinimum / MinFlowFracLimitFanHeat
END IF
FanShaftPower = MotEff * Fan(FanNum)%FanPower ! power delivered to shaft
PowerLossToAir = FanShaftPower + (Fan(FanNum)%FanPower - FanShaftPower) * 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 = PsyTdbFnHW(Fan(FanNum)%OutletAirEnthalpy,Fan(FanNum)%OutletAirHumRat)
ENDIF
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 SimVariableVolumeFan