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 SimSimpleFan(FanNum)
! SUBROUTINE INFORMATION:
! AUTHOR Unknown
! DATE WRITTEN Unknown
! MODIFIED Brent Griffith, May 2009, added EMS override
! Chandan Sharma, March 2011, FSEC: Added LocalTurnFansOn and LocalTurnFansOff
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine simulates the simple constant volume 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) MotInAirFrac
REAL(r64) MotEff
REAL(r64) MassFlow ! [kg/sec]
!unused0909 REAL(r64) Tin ! [C]
!unused0909 REAL(r64) Win
REAL(r64) FanShaftPower ! power delivered to fan shaft
REAL(r64) PowerLossToAir ! fan and motor loss to air stream (watts)
Integer NVPerfNum
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
ELSE
DeltaPress = Fan(FanNum)%DeltaPress
FanEff = Fan(FanNum)%FanEff
MotEff = Fan(FanNum)%MotEff
MotInAirFrac = Fan(FanNum)%MotInAirFrac
END IF
IF (Fan(FanNum)%EMSFanPressureOverrideOn) DeltaPress = Fan(FanNum)%EMSFanPressureValue
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
!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)
!
!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
Fan(FanNum)%FanPower = MassFlow*DeltaPress/(FanEff*RhoAir) ! total fan power
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)
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 SimSimpleFan