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 SizeFan(FanNum)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN September 2001
! MODIFIED Craig Wray August 2010 - added fan, belt, motor, and VFD component sizing
! August 2013 Daeho Kang, add component sizing table entries
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for sizing fans for which flow rates have not been
! specified in the input, or when fan component sizes have not been specified
! METHODOLOGY EMPLOYED:
! Obtains flow rates from the zone or system sizing arrays.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSizing
USE OutputReportPredefined
USE CurveManager, ONLY: CurveValue
USE CurveManager, ONLY: GetCurveIndex
USE General, ONLY: RoundSigDigits
USE ReportSizingManager, ONLY: ReportSizingOutput
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) :: FanMinAirFlowRate ! minimum air flow rate [m3/s]
Integer :: NVPerfNum ! Index to night ventialation performance object
CHARACTER(len=MaxNameLength) :: equipName ! Equipment name
REAL(r64) :: RatedPower ! Rated fan power [W]
REAL(r64) :: RhoAir ! Air density [kg/m3]
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) :: XbeltMax ! Factor for belt max eff curve [ln hp]
REAL(r64) :: FanTrqRatio ! Ratio of fan torque to max fan torque [-]
REAL(r64) :: BeltPLEff ! Belt normalized (part-load) efficiency [-]
REAL(r64) :: XmotorMax ! Factor for motor max eff curve [ln hp]
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 [-]
LOGICAL :: OASysFlag ! Logical flag determines if parent object set OA Sys coil property
LOGICAL :: AirLoopSysFlag ! Logical flag determines if parent object set air loop coil property
REAL(r64) :: MaxAirFlowRateDes ! Design maximum air flow rate for reporting
REAL(r64) :: MaxAirFlowRateUser ! User hard-sized maximum air flow rate for reproting
REAL(r64) :: MinAirFlowRateDes ! Design minimum air flow rate for reporting
REAL(r64) :: MinAirFlowRateUser ! User hard-sized minimum air flow rate for reproting
LOGICAL :: IsAutosize ! Indicator to autosize
LOGICAL :: HardSizeNoDesRun ! Indicator to hardsize with no disign run
LOGICAL :: SizingDesRunThisAirSys ! true if a particular air system had a Sizing:System object and system sizing done
LOGICAL :: SizingDesRunThisZone ! true if a particular zone had a Sizing:Zone object and zone sizing was done
FanMinAirFlowRate = 0.0d0
NVPerfNum = Fan(FanNum)%NVPerfNum
MaxAirFlowRateDes = 0.0d0
MaxAirFlowRateUser = 0.0d0
IsAutosize = .FALSE.
IF (SysSizingRunDone .OR. ZoneSizingRunDone) THEN
HardSizeNoDesRun = .FALSE.
ELSE
HardSizeNoDesRun = .TRUE.
ENDIF
IF (CurSysNum > 0) THEN
CALL CheckThisAirSystemForSizing(CurSysNum, SizingDesRunThisAirSys )
ELSE
SizingDesRunThisAirSys = .FALSE.
ENDIF
IF (CurZoneEqNum > 0) THEN
CALL CheckThisZoneForSizing(CurZoneEqNum, SizingDesRunThisZone)
ELSE
SizingDesRunThisZone = .FALSE.
ENDIF
IF (Fan(FanNum)%MaxAirFlowRate == AutoSize) THEN
IsAutosize = .TRUE.
END IF
IF (CurSysNum > 0) THEN
IF (.NOT. IsAutosize .AND. .NOT. SizingDesRunThisAirSys) THEN ! Simulation continue
HardSizeNoDesRun = .TRUE.
IF (Fan(FanNum)%MaxAirFlowRate > 0.0d0) THEN
CALL ReportSizingOutput(Fan(FanNum)%FanType, Fan(FanNum)%FanName, &
'User-Specified Maximum Flow Rate [m3/s]', Fan(FanNum)%MaxAirFlowRate)
END IF
ELSE ! Autosize or hardsize with sizing run
OASysFlag = .FALSE.
AirLoopSysFlag = .FALSE.
! logicals used when parent sizes fan
IF (CurOASysNum > 0)OASysFlag = OASysEqSizing(CurOASysNum)%AirFlow
IF (CurSysNum > 0)AirLoopSysFlag = UnitarySysEqSizing(CurSysNum)%AirFlow
CALL CheckSysSizing(TRIM(Fan(FanNum)%FanType) , &
Fan(FanNum)%FanName)
IF(OASysFlag)THEN
MaxAirFlowRateDes = OASysEqSizing(CurOASysNum)%AirVolFlow
ELSE IF(AirLoopSysFlag)THEN
MaxAirFlowRateDes = UnitarySysEqSizing(CurSysNum)%AirVolFlow
ELSE
SELECT CASE(CurDuctType)
CASE(Main)
MaxAirFlowRateDes = FinalSysSizing(CurSysNum)%DesMainVolFlow
CASE(Cooling)
! MaxAirFlowRateDes = FinalSysSizing(CurSysNum)%DesCoolVolFlow
MaxAirFlowRateDes = FinalSysSizing(CurSysNum)%DesMainVolFlow
CASE(Heating)
! MaxAirFlowRateDes = FinalSysSizing(CurSysNum)%DesHeatVolFlow
MaxAirFlowRateDes = FinalSysSizing(CurSysNum)%DesMainVolFlow
CASE(Other)
MaxAirFlowRateDes = FinalSysSizing(CurSysNum)%DesMainVolFlow
CASE DEFAULT
MaxAirFlowRateDes = FinalSysSizing(CurSysNum)%DesMainVolFlow
END SELECT
END IF
FanMinAirFlowRate = Fan(FanNum)%MinAirFlowRate
END IF
ELSE IF (CurZoneEqNum > 0) THEN
IF (.NOT. IsAutosize .AND. .NOT. SizingDesRunThisZone) THEN ! Simulation continue
HardSizeNoDesRun = .TRUE.
IF (Fan(FanNum)%MaxAirFlowRate > 0.0d0) THEN
CALL ReportSizingOutput(Fan(FanNum)%FanType, Fan(FanNum)%FanName, &
'User-Specified Maximum Flow Rate [m3/s]', Fan(FanNum)%MaxAirFlowRate)
END IF
ELSE ! Autosize or hardsize with sizing run
CALL CheckZoneSizing(TRIM(Fan(FanNum)%FanType) , &
Fan(FanNum)%FanName)
IF(ZoneEqSizing(CurZoneEqNum)%AirFlow)THEN
MaxAirFlowRateDes = ZoneEqSizing(CurZoneEqNum)%AirVolFlow
ELSE
IF(ZoneCoolingOnlyFan)THEN
MaxAirFlowRateDes = FinalZoneSizing(CurZoneEqNum)%DesCoolVolFlow
ELSE IF (ZoneHeatingOnlyFan) THEN
MaxAirFlowRateDes = FinalZoneSizing(CurZoneEqNum)%DesHeatVolFlow
ELSE
MaxAirFlowRateDes = MAX(FinalZoneSizing(CurZoneEqNum)%DesCoolVolFlow, &
FinalZoneSizing(CurZoneEqNum)%DesHeatVolFlow)
END IF
END IF
END IF
END IF
IF (MaxAirFlowRateDes < SmallAirVolFlow) THEN
MaxAirFlowRateDes = 0.0d0
END IF
IF (Fan(FanNum)%MaxAirFlowRateEMSOverrideOn) THEN
MaxAirFlowRateDes = Fan(FanNum)%MaxAirFlowRateEMSOverrideValue
ENDIF
IF (.NOT. HardSizeNoDesRun) THEN
IF (IsAutosize) THEN
Fan(FanNum)%MaxAirFlowRate = MaxAirFlowRateDes
CALL ReportSizingOutput(Fan(FanNum)%FanType, &
Fan(FanNum)%FanName, 'Design Size Maximum Flow Rate [m3/s]', MaxAirFlowRateDes)
ELSE
IF (Fan(FanNum)%MaxAirFlowRate > 0.0d0 .AND. Fan(FanNum)%MaxAirFlowRateIsAutosizable .AND. MaxAirFlowRateDes > 0.0d0) THEN
MaxAirFlowRateUser = Fan(FanNum)%MaxAirFlowRate
CALL ReportSizingOutput(Fan(FanNum)%FanType, Fan(FanNum)%FanName, &
'Design Size Maximum Flow Rate [m3/s]', MaxAirFlowRateDes, &
'User-Specified Maximum Flow Rate [m3/s]', MaxAirFlowRateUser)
IF (DisplayExtraWarnings) THEN
IF ((ABS(MaxAirFlowRateDes - MaxAirFlowRateUser)/MaxAirFlowRateUser) > AutoVsHardSizingThreshold) THEN
CALL ShowMessage('SizeHVACFans: Potential issue with equipment sizing for '// &
TRIM(Fan(FanNum)%FanType)//' = "'//TRIM(Fan(FanNum)%FanName)//'".')
CALL ShowContinueError('User-Specified Maximum Flow Rate of '// &
TRIM(RoundSigDigits(MaxAirFlowRateUser,5))// ' [m3/s]')
CALL ShowContinueError('differs from Design Size Maximum Flow Rate of ' // &
TRIM(RoundSigDigits(MaxAirFlowRateDes,5))// ' [m3/s]')
CALL ShowContinueError('This may, or may not, indicate mismatched component sizes.')
CALL ShowContinueError('Verify that the value entered is intended and is consistent with other components.')
END IF
ENDIF
END IF
END IF
END IF
!cpw31Aug2010 Add fan, belt, motor and VFD component autosizing and maximum efficiency calculations
FanVolFlow = Fan(FanNum)%MaxAirFlowRate !Maximum volumetric airflow through fan [m3/s at standard conditions]
IF (Fan(FanNum)%FanType_Num == FanType_ComponentModel) THEN
! 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 = StdRhoAir
! Adjust max fan volumetric airflow using fan sizing factor
FanVolFlow = FanVolFlow * Fan(FanNum)%FanSizingFactor ![m3/s at standard conditions]
! Calculate max fan static pressure rise using max 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)
DuctStaticPress = CurveValue(Fan(FanNum)%PressResetCurveIndex,FanVolFlow) !Duct static pressure setpoint [Pa]
DeltaPressTot = CurveValue(Fan(FanNum)%PressRiseCurveIndex,FanVolFlow,DuctStaticPress) !Max fan total pressure rise [Pa]
FanOutletVelPress = 0.5d0 * RhoAir*(FanVolFlow / Fan(FanNum)%FanOutletArea)**2 !Max fan outlet velocity pressure [Pa]
!Outlet velocity pressure cannot exceed total pressure rise
FanOutletVelPress = MIN(FanOutletVelPress, DeltaPressTot)
Fan(FanNum)%DeltaPress = DeltaPressTot - FanOutletVelPress !Max fan static pressure rise [Pa]
! Calculate max fan air power using volumetric flow abd corresponding fan static pressure rise
Fan(FanNum)%FanAirPower = FanVolFlow * Fan(FanNum)%DeltaPress ![W]
! Calculate fan wheel efficiency at max fan volumetric flow and corresponding fan static pressure rise,
! using 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 max fan shaft power using fan air power and fan efficiency
! at max fan static pressure rise and max fan volumetric flow
Fan(FanNum)%FanShaftPower = (Fan(FanNum)%FanAirPower / Fan(FanNum)%FanWheelEff) ![W]
Fan(FanNum)%FanShaftPwrMax = Fan(FanNum)%FanShaftPower ![W]
! Calculate fan shaft speed, motor speed, and fan torque 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)%FanSpd = FanSpdRadS * 9.549296586d0 ![rpm, conversion factor is 30/PI]
IF (Fan(FanNum)%PulleyDiaRatio == AutoSize) THEN
!WRITE(*,*) 'Autosizing pulley drive ratio'
Fan(FanNum)%PulleyDiaRatio = Fan(FanNum)%FanSpd / Fan(FanNum)%MotorMaxSpd ![-]
END IF
! For direct-drive, should have PulleyDiaRatio = 1
MotorSpeed = Fan(FanNum)%FanSpd / Fan(FanNum)%PulleyDiaRatio ![rpm]
! Check for inconsistent drive ratio and motor speed, and report design fan speed with warning cpw14Sep2010
IF (MotorSpeed > (Fan(FanNum)%MotorMaxSpd + 1.d-5)) THEN
CALL ShowWarningError('Drive ratio for '//TRIM(Fan(FanNum)%FanType)//': '//TRIM(Fan(FanNum)%FanName)// &
' is too low at design conditions -- check motor speed and drive ratio inputs')
CALL ShowContinueError('...Design fan speed [rev/min]: '// &
TRIM(RoundSigDigits(Fan(FanNum)%FanSpd,2)))
END IF
Fan(FanNum)%FanTrq = Fan(FanNum)%FanShaftPower / FanSpdRadS ![N-m]
IF (Fan(FanNum)%BeltMaxTorque == AutoSize) THEN
!WRITE(*,*) 'Autosizing fan belt'
Fan(FanNum)%BeltMaxTorque = Fan(FanNum)%FanTrq ![N-m]
END IF
! Adjust max belt torque using belt sizing factor
Fan(FanNum)%BeltMaxTorque = Fan(FanNum)%BeltMaxTorque * Fan(FanNum)%BeltSizingFactor ![N-m]
! Check for undersized belt and report design size with warning cpw14Sep2010
IF (Fan(FanNum)%FanTrq > (Fan(FanNum)%BeltMaxTorque + 1.d-5)) THEN
CALL ShowWarningError('Belt for '//TRIM(Fan(FanNum)%FanType)//': '//TRIM(Fan(FanNum)%FanName)// &
' is undersized at design conditions -- check belt inputs')
CALL ShowContinueError('...Design belt output torque (without oversizing) [Nm]: '// &
TRIM(RoundSigDigits(Fan(FanNum)%FanTrq,2)))
END IF
! Calculate belt max efficiency using correlations and coefficients based on AMCA data
! Direct-drive is represented using curve coefficients such that "belt" max eff and PL eff = 1.0
XbeltMax = LOG(Fan(FanNum)%FanShaftPwrMax / 746.d0) !Natural log of belt output power in hp
IF (Fan(FanNum)%BeltMaxEffCurveIndex /= 0) THEN
Fan(FanNum)%BeltMaxEff = EXP(CurveValue(Fan(FanNum)%BeltMaxEffCurveIndex,XbeltMax)) ![-]
ELSE
Fan(FanNum)%BeltMaxEff = 1.d0 !No curve specified - use constant efficiency
END IF
! Calculate belt part-load drive efficiency and input power using correlations and coefficients based on ACEEE data
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
Fan(FanNum)%BeltInputPower = Fan(FanNum)%FanShaftPower / Fan(FanNum)%BeltEff ![W]
IF (Fan(FanNum)%MotorMaxOutPwr == AutoSize) THEN
!WRITE(*,*) 'Autosizing fan motor'
Fan(FanNum)%MotorMaxOutPwr = Fan(FanNum)%BeltInputPower
END IF
! Adjust max motor output power using motor sizing factor
Fan(FanNum)%MotorMaxOutPwr = Fan(FanNum)%MotorMaxOutPwr * Fan(FanNum)%MotorSizingFactor ![W]
! Check for undersized motor and report design size with warning cpw14Sep2010
IF (Fan(FanNum)%BeltInputPower > (Fan(FanNum)%MotorMaxOutPwr + 1.d-5)) THEN
CALL ShowWarningError('Motor for '//TRIM(Fan(FanNum)%FanType)//': '//TRIM(Fan(FanNum)%FanName)// &
' is undersized at design conditions -- check motor inputs')
CALL ShowContinueError('...Design motor output power (without oversizing) [W]: '// &
TRIM(RoundSigDigits(Fan(FanNum)%BeltInputPower,2)))
END IF
! Calculate motor max efficiency using correlations and coefficients based on MotorMaster+ data
XmotorMax = LOG(Fan(FanNum)%MotorMaxOutPwr / 746.d0) !Natural log of motor output power in hp
IF (Fan(FanNum)%MotorMaxEffCurveIndex /= 0) THEN
Fan(FanNum)%MotorMaxEff = CurveValue(Fan(FanNum)%MotorMaxEffCurveIndex,XmotorMax) ![-]
ELSE
Fan(FanNum)%MotorMaxEff = 1.d0 !No curve specified - use constant efficiency
END IF
! Calculate motor part-load efficiency and input power 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 max VFD efficiency and input power 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
IF (Fan(FanNum)%VFDMaxOutPwr == AutoSize) THEN
!WRITE(*,*) 'Autosizing fan VFD'
Fan(FanNum)%VFDMaxOutPwr = Fan(FanNum)%MotorInputPower
END IF
! Adjust max VFD output power using VFD sizing factor
Fan(FanNum)%VFDMaxOutPwr = Fan(FanNum)%VFDMaxOutPwr * Fan(FanNum)%VFDSizingFactor ![W]
! Check for undersized VFD and report design size with warning cpw14Sep2010
IF (Fan(FanNum)%MotorInputPower > (Fan(FanNum)%VFDMaxOutPwr + 1.d-5)) THEN
CALL ShowWarningError('VFD for '//TRIM(Fan(FanNum)%FanType)//': '//TRIM(Fan(FanNum)%FanName)// &
' is undersized at design conditions -- check VFD inputs')
CALL ShowContinueError('...Design VFD output power (without oversizing) [W]: '// &
TRIM(RoundSigDigits(Fan(FanNum)%MotorInputPower,2)))
END IF
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 "rated" input power using motor input power and VFD efficiency
RatedPower = Fan(FanNum)%MotorInputPower / Fan(FanNum)%VFDEff ![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
! Report fan, belt, motor, and VFD characteristics at design condition to .eio file cpw14Sep2010
CALL ReportSizingOutput(TRIM(Fan(FanNum)%FanType), &
Fan(FanNum)%FanName, 'Design Fan Airflow [m3/s]', FanVolFlow)
CALL ReportSizingOutput(TRIM(Fan(FanNum)%FanType), &
Fan(FanNum)%FanName, 'Design Fan Static Pressure Rise [Pa]', Fan(FanNum)%DeltaPress)
CALL ReportSizingOutput(TRIM(Fan(FanNum)%FanType), &
Fan(FanNum)%FanName, 'Design Fan Shaft Power [W]', Fan(FanNum)%FanShaftPower)
CALL ReportSizingOutput(TRIM(Fan(FanNum)%FanType), &
Fan(FanNum)%FanName, 'Design Motor Output Power [W]', Fan(FanNum)%MotorMaxOutPwr)
CALL ReportSizingOutput(TRIM(Fan(FanNum)%FanType), &
Fan(FanNum)%FanName, 'Design VFD Output Power [W]', Fan(FanNum)%VFDMaxOutPwr)
CALL ReportSizingOutput(TRIM(Fan(FanNum)%FanType), &
Fan(FanNum)%FanName, 'Rated Power [W]', RatedPower)
CALL ReportSizingOutput(TRIM(Fan(FanNum)%FanType), &
Fan(FanNum)%FanName, 'Drive Ratio [-]', Fan(FanNum)%PulleyDiaRatio)
CALL ReportSizingOutput(TRIM(Fan(FanNum)%FanType), &
Fan(FanNum)%FanName, 'Design Belt Output Torque [Nm]', Fan(FanNum)%BeltMaxTorque)
CALL ReportSizingOutput(TRIM(Fan(FanNum)%FanType), &
Fan(FanNum)%FanName, 'Design Fan Efficiency [-]', Fan(FanNum)%FanWheelEff)
CALL ReportSizingOutput(TRIM(Fan(FanNum)%FanType), &
Fan(FanNum)%FanName, 'Maximum Belt Efficiency [-]', Fan(FanNum)%BeltMaxEff)
CALL ReportSizingOutput(TRIM(Fan(FanNum)%FanType), &
Fan(FanNum)%FanName, 'Design Belt Efficiency [-]', Fan(FanNum)%BeltEff)
CALL ReportSizingOutput(TRIM(Fan(FanNum)%FanType), &
Fan(FanNum)%FanName, 'Maximum Motor Efficiency [-]', Fan(FanNum)%MotorMaxEff)
CALL ReportSizingOutput(TRIM(Fan(FanNum)%FanType), &
Fan(FanNum)%FanName, 'Design Motor Efficiency [-]', Fan(FanNum)%MotEff)
CALL ReportSizingOutput(TRIM(Fan(FanNum)%FanType), &
Fan(FanNum)%FanName, 'Design VFD Efficiency [-]', Fan(FanNum)%VFDEff)
CALL ReportSizingOutput(TRIM(Fan(FanNum)%FanType), &
Fan(FanNum)%FanName, 'Design Combined Efficiency [-]', Fan(FanNum)%FanEff)
!cpw31Aug2010 Temporary code for debugging fan component model
! WRITE(300,*) TRIM(RoundSigDigits(RhoAir,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(RoundSigDigits(XbeltMax,4)) &
! //','//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(RoundSigDigits(XmotorMax,4))//','//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(RatedPower,4))//','//TRIM(RoundSigDigits(Fan(FanNum)%FanEff,4)) &
! //','//TRIM(RoundSigDigits(0.d0,4))//','//TRIM(RoundSigDigits(0.d0,4))
! WRITE(304,*) TRIM("Fan")//','//TRIM("Sizing")
!cpw31Aug2010 Temporary code to write headers for component fan model debug files
! WRITE(300,*) 'Rho,VolFlow,dPvOut,dP,AirPwr,Eu,NrmEu,FWEff'
! WRITE(301,*) 'ShftPwr,DimFlow,Trq,FSpd,BPwrOut,XBmax,BMaxEff,TrqRat'
! WRITE(302,*) 'BPLEff,BEff,BPwrIn,MPwrOut,XMmax,MMaxEff,MPwrRat,MPLEff'
! WRITE(303,*) 'MEff,MPwrIn,VPwrRat,VEff,FanPwr,FanEff,PwrLoss,dEnthalpy'
! WRITE(304,*) 'Date,Period'
END IF !End fan component sizing
equipName = Fan(FanNum)%FanName
!cpw31Aug2010 Rearrange order to match table and use FanVolFlow to calculate RatedPower
!ALSO generates values if Component Model fan, for which DeltaPress and FanEff vary with flow
CALL PreDefTableEntry(pdchFanType,equipName,Fan(FanNum)%FanType)
CALL PreDefTableEntry(pdchFanTotEff,equipName,Fan(FanNum)%FanEff)
CALL PreDefTableEntry(pdchFanDeltaP,equipName,Fan(FanNum)%DeltaPress)
CALL PreDefTableEntry(pdchFanVolFlow,equipName,FanVolFlow)
RatedPower = FanVolFlow * Fan(FanNum)%DeltaPress / Fan(FanNum)%FanEff ! total fan power
CALL PreDefTableEntry(pdchFanPwr,equipName,RatedPower)
IF (FanVolFlow .NE. 0.0d0) THEN
CALL PreDefTableEntry(pdchFanPwrPerFlow,equipName,RatedPower/FanVolFlow)
END IF
CALL PreDefTableEntry(pdchFanMotorIn,equipName,Fan(FanNum)%MotInAirFrac)
CALL PreDefTableEntry(pdchFanEndUse,equipName,Fan(FanNum)%EndUseSubcategoryName)
IF (NVPerfNum > 0) THEN
IF (NightVentPerf(NVPerfNum)%MaxAirFlowRate == AutoSize) THEN
NightVentPerf(NVPerfNum)%MaxAirFlowRate = Fan(FanNum)%MaxAirFlowRate
END IF
END IF
RETURN
END SUBROUTINE SizeFan