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 |
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 SimComponentModelFan(FanNum)
! SUBROUTINE INFORMATION:
! AUTHOR Craig Wray, LBNL
! DATE WRITTEN Feb 2010
! MODIFIED Chandan Sharma, March 2011, FSEC: Added LocalTurnFansOn and LocalTurnFansOff
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine simulates the component model fan.
! METHODOLOGY EMPLOYED:
! Calculate fan volumetric flow and corresponding fan static pressure rise,
! using air-handling system characteristics and Sherman-Wray system curve model
! Calculate fan air power using volumetric flow and fan static pressure rise
! Calculate fan wheel efficiency using fan volumetric flow, fan static pressure rise,
! fan characteristics, and Wray dimensionless fan static efficiency model
! Calculate fan shaft power using fan air power and fan static efficiency
! Calculate fan shaft speed and torque using Wray dimensionless fan airflow model
! Calculate belt part-load efficiency using correlations and coefficients based on ACEEE data
! Calculate belt input power using fan shaft power and belt efficiency
! Calculate motor part-load efficiency using correlations and coefficients based on MotorMaster+ data
! Calculate motor input power using belt input power and motor efficiency
! Calculate VFD efficiency using correlations and coefficients based on DOE data
! Calculate VFD input power using motor input power and VFD efficiency
! Calculate combined efficiency of fan, belt, motor, and VFD
! Calculate air temperature rise due to fan (and belt+motor if in airstream) power entering air-handler airflow
! Calculate output node conditions
! REFERENCES:
! TBD
! USE STATEMENTS:
USE CurveManager, ONLY: CurveValue
USE CurveManager, ONLY: GetCurveIndex
USE OutputReportPredefined
USE General, ONLY: CreateSysTimeIntervalString,RoundSigDigits
USE DataEnvironment, ONLY : EnvironmentName,CurMnDy
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:
INTEGER NVPerfNum
REAL(r64) MaxAirMassFlowRate ! Fan Max mass airflow [kg/s]
!unused062011 REAL(r64) MinFlowFrac ! Fan Min Volumetric airflow Fraction [-]
!unused062011 REAL(r64) FlowFrac ! Fan Volumetric airflow Fraction [-]
!unused062011 REAL(r64) DeltaPress ! Delta Pressure Across the Fan (Fan Static Pressure Rise) [N/m2 = Pa]
!unused062011 REAL(r64) FanAirPower ! Air power for Fan being Simulated [W]
!unused062011 REAL(r64) FanSpd ! Fan shaft rotational speed [rpm]
!unused062011 REAL(r64) FanTrq ! Fan shaft torque [N-m]
!unused062011 REAL(r64) FanWheelEff ! Fan efficiency (mechanical) [-]
!unused062011 REAL(r64) FanShaftPower ! Shaft input power for Fan being Simulated [W]
!unused062011 REAL(r64) BeltEff ! Belt efficiency (mechanical) [-]
!unused062011 REAL(r64) BeltInputPower ! Belt input power for Fan being Simulated [W]
!unused062011 REAL(r64) MotEff ! Fan motor efficiency [-]
!unused062011 REAL(r64) MotorInputPower ! Motor input power for Fan being Simulated [W]
!unused062011 REAL(r64) VFDEff ! VFD efficiency (electrical) [-]
!unused062011 REAL(r64) VFDInputPower ! VFD input power for Fan being Simulated [W]
!unused062011 REAL(r64) FanEff ! Fan total system efficiency (fan*belt*motor*VFD) [-]
REAL(r64) MotInAirFrac ! Fraction of fan power input to airstream
! Local variables
REAL(r64) RhoAir ! Air density [kg/m3]
REAL(r64) MassFlow ! Fan mass airflow [kg/s]
REAL(r64) FanVolFlow ! Fan volumetric airflow [m3/s]
REAL(r64) DuctStaticPress ! Duct static pressure setpoint [Pa]
REAL(r64) DeltaPressTot ! Total pressure rise across fan [N/m2 = Pa]
REAL(r64) FanOutletVelPress ! Fan outlet velocity pressure [Pa]
REAL(r64) EulerNum ! Fan Euler number [-]
REAL(r64) NormalizedEulerNum ! Normalized Fan Euler number [-]
REAL(r64) FanDimFlow ! Fan dimensionless airflow [-]
REAL(r64) FanSpdRadS ! Fan shaft rotational speed [rad/s]
REAL(r64) MotorSpeed ! Motor shaft rotational speed [rpm]
REAL(r64) FanTrqRatio ! Ratio of fan torque to max fan torque [-]
REAL(r64) BeltPLEff ! Belt normalized (part-load) efficiency [-]
REAL(r64) MotorOutPwrRatio ! Ratio of motor output power to max motor output power [-]
REAL(r64) MotorPLEff ! Motor normalized (part-load) efficiency [-]
REAL(r64) :: VFDSpdRatio = 0.d0 ! Ratio of motor speed to motor max speed [-]
REAL(r64) :: VFDOutPwrRatio = 0.d0 ! Ratio of VFD output power to max VFD output power [-]
REAL(r64) PowerLossToAir ! Energy input to air stream (W)
REAL(r64) FanEnthalpyChange ! Air enthalpy change due to fan, belt, and motor losses [kJ/kg]
! Get inputs for night ventilation option
NVPerfNum = Fan(FanNum)%NVPerfNum
IF (NightVentOn .AND. NVPerfNum > 0) THEN
MotInAirFrac = NightVentPerf(NVPerfNum)%MotInAirFrac
MaxAirMassFlowRate = NightVentPerf(NVPerfNum)%MaxAirMassFlowRate
ELSE
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
! Get air density at standard conditions and get mass airflow through fan
! From WeatherManager:
! StdBaroPress=(101.325d0*(1.d0-2.25577d-05*WeatherFileElevation)**5.2559d0)*1000.d0
! StdRhoAir=PsyRhoAirFnPbTdbW(StdBaroPress,20,0)
! From PsychRoutines:
! w=MAX(dw,1.0d-5)
! rhoair = pb/(287.d0*(tdb+KelvinConv)*(1.d0+1.6077687d0*w))
RhoAir = Fan(FanNum)%RhoAirStdInit
MassFlow = MIN(Fan(FanNum)%InletAirMassFlowRate,Fan(FanNum)%MaxAirMassFlowRate)
! IF (Fan(FanNum)%EMSMaxMassFlowOverrideOn) MassFlow = Fan(FanNum)%EMSAirMassFlowValue
!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 fan pressure rise, component efficiencies and power, and also air enthalpy rise
! Calculate fan static pressure rise using fan volumetric flow, std air density, air-handling system characteristics,
! and Sherman-Wray system curve model (assumes static pressure surrounding air distribution system is zero)
FanVolFlow = MassFlow / RhoAir ![m3/s at standard conditions]
DuctStaticPress = CurveValue(Fan(FanNum)%PressResetCurveIndex,FanVolFlow) !Duct static pressure setpoint [Pa]
DeltaPressTot = CurveValue(Fan(FanNum)%PressRiseCurveIndex,FanVolFlow,DuctStaticPress) !Fan total pressure rise [Pa]
FanOutletVelPress = 0.5d0 * RhoAir * (FanVolFlow / Fan(FanNum)%FanOutletArea)**2 !Fan outlet velocity pressure [Pa]
!Outlet velocity pressure cannot exceed total pressure rise
FanOutletVelPress = MIN(FanOutletVelPress, DeltaPressTot)
Fan(FanNum)%DeltaPress = DeltaPressTot - FanOutletVelPress !Fan static pressure rise [Pa]
! IF (Fan(FanNum)%EMSFanPressureOverrideOn) DeltaPress = Fan(FanNum)%EMSFanPressureValue
! Calculate fan static air power using volumetric flow and fan static pressure rise
Fan(FanNum)%FanAirPower = FanVolFlow * Fan(FanNum)%DeltaPress ![W]
! Calculate fan wheel efficiency using fan volumetric flow, fan static pressure rise,
! fan characteristics, and Wray dimensionless fan static efficiency model
EulerNum = (Fan(FanNum)%DeltaPress * Fan(FanNum)%FanWheelDia**4) / (RhoAir * FanVolFlow**2) ![-]
NormalizedEulerNum = LOG10(EulerNum / Fan(FanNum)%EuMaxEff)
IF (NormalizedEulerNum <= 0.d0) THEN
Fan(FanNum)%FanWheelEff = CurveValue(Fan(FanNum)%PLFanEffNormCurveIndex,NormalizedEulerNum)
ELSE
Fan(FanNum)%FanWheelEff = CurveValue(Fan(FanNum)%PLFanEffStallCurveIndex,NormalizedEulerNum)
END IF
Fan(FanNum)%FanWheelEff = Fan(FanNum)%FanWheelEff * Fan(FanNum)%FanMaxEff ! [-]
Fan(FanNum)%FanWheelEff = MAX(Fan(FanNum)%FanWheelEff,0.01d0) !Minimum efficiency is 1% to avoid numerical errors
! Calculate fan shaft power using fan static air power and fan static efficiency
Fan(FanNum)%FanShaftPower = Fan(FanNum)%FanAirPower / Fan(FanNum)%FanWheelEff ![W]
! Calculate fan shaft speed, fan torque, and motor speed using Wray dimensionless fan airflow model
IF (NormalizedEulerNum <= 0.d0) THEN
FanDimFlow = CurveValue(Fan(FanNum)%DimFlowNormCurveIndex,NormalizedEulerNum) ![-]
ELSE
FanDimFlow = CurveValue(Fan(FanNum)%DimFlowStallCurveIndex,NormalizedEulerNum) ![-]
END IF
FanSpdRadS = FanVolFlow / &
(FanDimFlow * Fan(FanNum)%FanMaxDimFlow * Fan(FanNum)%FanWheelDia**3) ![rad/s]
Fan(FanNum)%FanTrq = Fan(FanNum)%FanShaftPower / FanSpdRadS ![N-m]
Fan(FanNum)%FanSpd = FanSpdRadS * 9.549296586d0 ![rpm, conversion factor is 30/PI]
MotorSpeed = Fan(FanNum)%FanSpd * Fan(FanNum)%PulleyDiaRatio ![rpm]
! Calculate belt part-load drive efficiency using correlations and coefficients based on ACEEE data
! Direct-drive is represented using curve coefficients such that "belt" max eff and PL eff = 1.0
FanTrqRatio = Fan(FanNum)%FanTrq / Fan(FanNum)%BeltMaxTorque ![-]
IF ((FanTrqRatio <= Fan(FanNum)%BeltTorqueTrans).AND.(Fan(FanNum)%PLBeltEffReg1CurveIndex /= 0)) THEN
BeltPLEff = CurveValue(Fan(FanNum)%PLBeltEffReg1CurveIndex,FanTrqRatio) ![-]
ELSE
IF ((FanTrqRatio > Fan(FanNum)%BeltTorqueTrans).AND.(FanTrqRatio <= 1.d0) &
.AND.(Fan(FanNum)%PLBeltEffReg2CurveIndex /= 0)) THEN
BeltPLEff = CurveValue(Fan(FanNum)%PLBeltEffReg2CurveIndex,FanTrqRatio) ![-]
ELSE
IF ((FanTrqRatio > 1.d0).AND.(Fan(FanNum)%PLBeltEffReg3CurveIndex /= 0)) THEN
BeltPLEff = CurveValue(Fan(FanNum)%PLBeltEffReg3CurveIndex,FanTrqRatio) ![-]
ELSE
BeltPLEff = 1.d0 !Direct drive or no curve specified - use constant efficiency
END IF
END IF
END IF
Fan(FanNum)%BeltEff = Fan(FanNum)%BeltMaxEff * BeltPLEff ![-]
Fan(FanNum)%BeltEff = MAX(Fan(FanNum)%BeltEff,0.01d0)!Minimum efficiency is 1% to avoid numerical errors
! Calculate belt input power using fan shaft power and belt efficiency
Fan(FanNum)%BeltInputPower = Fan(FanNum)%FanShaftPower/Fan(FanNum)%BeltEff ![W]
! Calculate motor part-load efficiency using correlations and coefficients based on MotorMaster+ data
MotorOutPwrRatio = Fan(FanNum)%BeltInputPower / Fan(FanNum)%MotorMaxOutPwr ![-]
IF (Fan(FanNum)%PLMotorEffCurveIndex /= 0) THEN
MotorPLEff = CurveValue(Fan(FanNum)%PLMotorEffCurveIndex,MotorOutPwrRatio) ![-]
ELSE
MotorPLEff = 1.d0 !No curve specified - use constant efficiency
END IF
Fan(FanNum)%MotEff = Fan(FanNum)%MotorMaxEff * MotorPLEff ![-]
Fan(FanNum)%MotEff = MAX(Fan(FanNum)%MotEff,0.01d0)!Minimum efficiency is 1% to avoid numerical errors
! Calculate motor input power using belt input power and motor efficiency
Fan(FanNum)%MotorInputPower = Fan(FanNum)%BeltInputPower / Fan(FanNum)%MotEff ![W]
! Calculate VFD efficiency using correlations and coefficients based on VFD type
IF ((TRIM(Fan(FanNum)%VFDEffType) == 'SPEED').AND.(Fan(FanNum)%VFDEffCurveIndex /= 0)) THEN
VFDSpdRatio = MotorSpeed / Fan(FanNum)%MotorMaxSpd ![-]
Fan(FanNum)%VFDEff = CurveValue(Fan(FanNum)%VFDEffCurveIndex,VFDSpdRatio) ![-]
ELSE
IF ((TRIM(Fan(FanNum)%VFDEffType) == 'POWER').AND.(Fan(FanNum)%VFDEffCurveIndex /= 0)) THEN
VFDOutPwrRatio = Fan(FanNum)%MotorInputPower / Fan(FanNum)%VFDMaxOutPwr ![-]
Fan(FanNum)%VFDEff = CurveValue(Fan(FanNum)%VFDEffCurveIndex,VFDOutPwrRatio) ![-]
ELSE
! No curve specified - use constant efficiency
Fan(FanNum)%VFDMaxOutPwr = 0.d0
Fan(FanNum)%VFDEff = 0.97d0
END IF
ENDIF
Fan(FanNum)%VFDEff = MAX(Fan(FanNum)%VFDEff,0.01d0)!Minimum efficiency is 1% to avoid numerical errors
! Calculate VFD input power using motor input power and VFD efficiency
Fan(FanNum)%VFDInputPower = Fan(FanNum)%MotorInputPower / Fan(FanNum)%VFDEff ![W]
Fan(FanNum)%FanPower = Fan(FanNum)%VFDInputPower ![W]
! Calculate combined fan system efficiency: includes fan, belt, motor, and VFD
! Equivalent to Fan(FanNum)%FanAirPower / Fan(FanNum)%FanPower
Fan(FanNum)%FanEff = Fan(FanNum)%FanWheelEff * Fan(FanNum)%BeltEff * Fan(FanNum)%MotEff * Fan(FanNum)%VFDEff
! IF (Fan(FanNum)%EMSFanEffOverrideOn) FanEff = Fan(FanNum)%EMSFanEffValue
! Calculate air enthalpy and temperature rise from power entering air stream from fan wheel, belt, and motor
! Assumes MotInAirFrac applies to belt and motor but NOT to VFD
PowerLossToAir = Fan(FanNum)%FanShaftPower &
+ (Fan(FanNum)%MotorInputPower - Fan(FanNum)%FanShaftPower) * Fan(FanNum)%MotInAirFrac ![W]
FanEnthalpyChange = PowerLossToAir / MassFlow ![kJ/kg]
Fan(FanNum)%OutletAirEnthalpy = Fan(FanNum)%InletAirEnthalpy + FanEnthalpyChange ![kJ/kg]
! This fan does not change the moisture or mass flow across the component
Fan(FanNum)%OutletAirHumRat = Fan(FanNum)%InletAirHumRat ![-]
Fan(FanNum)%OutletAirMassFlowRate = MassFlow ![kg/s]
Fan(FanNum)%OutletAirTemp = PsyTdbFnHW(Fan(FanNum)%OutletAirEnthalpy,Fan(FanNum)%OutletAirHumRat)
!cpw31Aug2010 Temporary code for debugging fan component model
! WRITE(300,*) TRIM(RoundSigDigits(Fan(FanNum)%RhoAirStdInit,4))//','//TRIM(RoundSigDigits(FanVolFlow,4)) &
! //','//TRIM(RoundSigDigits(FanOutletVelPress,4))//','//TRIM(RoundSigDigits(Fan(FanNum)%DeltaPress,4)) &
! //','//TRIM(RoundSigDigits(Fan(FanNum)%FanAirPower,4))//','//TRIM(RoundSigDigits(EulerNum,4)) &
! //','//TRIM(RoundSigDigits(NormalizedEulerNum,4))//','//TRIM(RoundSigDigits(Fan(FanNum)%FanWheelEff,4))
! WRITE(301,*) TRIM(RoundSigDigits(Fan(FanNum)%FanShaftPower,4))//','//TRIM(RoundSigDigits(FanDimFlow,4)) &
! //','//TRIM(RoundSigDigits(Fan(FanNum)%FanTrq,4))//','//TRIM(RoundSigDigits(Fan(FanNum)%FanSpd,4)) &
! //','//TRIM(RoundSigDigits(Fan(FanNum)%FanShaftPwrMax,4))//','//TRIM(" ") &
! //','//TRIM(RoundSigDigits(Fan(FanNum)%BeltMaxEff,4))//','//TRIM(RoundSigDigits(FanTrqRatio,4))
! WRITE(302,*) TRIM(RoundSigDigits(BeltPLEff,4))//','//TRIM(RoundSigDigits(Fan(FanNum)%BeltEff,4)) &
! //','//TRIM(RoundSigDigits(Fan(FanNum)%BeltInputPower,4))//','//TRIM(RoundSigDigits(Fan(FanNum)%MotorMaxOutPwr,4)) &
! //','//TRIM(" ")//','//TRIM(RoundSigDigits(Fan(FanNum)%MotorMaxEff,4)) &
! //','//TRIM(RoundSigDigits(MotorOutPwrRatio,4))//','//TRIM(RoundSigDigits(MotorPLEff,4))
! WRITE(303,*) TRIM(RoundSigDigits(Fan(FanNum)%MotEff,4))//','//TRIM(RoundSigDigits(Fan(FanNum)%MotorInputPower,4)) &
! //','//TRIM(RoundSigDigits(VFDOutPwrRatio,4))//','//TRIM(RoundSigDigits(Fan(FanNum)%VFDEff,4)) &
! //','//TRIM(RoundSigDigits(Fan(FanNum)%FanPower,4))//','//TRIM(RoundSigDigits(Fan(FanNum)%FanEff,4)) &
! //','//TRIM(RoundSigDigits(PowerLossToAir,4))//','//TRIM(RoundSigDigits(FanEnthalpyChange,4))
! WRITE(304,*) TRIM(CurMnDy)//','//TRIM(CreateSysTimeIntervalString())
Else
!Fan is OFF and not operating -- no power consumed and zero mass flow rate
Fan(FanNum)%FanPower = 0.0d0
Fan(FanNum)%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
Fan(FanNum)%DeltaPress = 0.0d0
Fan(FanNum)%FanAirPower = 0.0d0
Fan(FanNum)%FanWheelEff = 0.0d0
Fan(FanNum)%FanSpd = 0.0d0
Fan(FanNum)%FanTrq = 0.0d0
Fan(FanNum)%BeltEff = 0.0d0
Fan(FanNum)%BeltInputPower = 0.0d0
Fan(FanNum)%MotEff = 0.0d0
Fan(FanNum)%MotorInputPower = 0.0d0
Fan(FanNum)%VFDEff = 0.0d0
Fan(FanNum)%VFDInputPower = 0.0d0
Fan(FanNum)%FanEff = 0.0d0
END IF
RETURN
END SUBROUTINE SimComponentModelFan