SUBROUTINE GetFanInput
! SUBROUTINE INFORMATION:
! AUTHOR Richard Liesen
! DATE WRITTEN April 1998
! MODIFIED Shirey, May 2001
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Obtains input data for fans and stores it in fan data structures
! METHODOLOGY EMPLOYED:
! Uses "Get" routines to read in data.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor
USE NodeInputManager, ONLY: GetOnlySingleNode
USE CurveManager, ONLY: GetCurveIndex
USE BranchNodeConnections, ONLY: TestCompSet
! USE DataIPShortCuts
USE DataGlobals, ONLY: AnyEnergyManagementSystemInModel, ScheduleAlwaysOn
USE DataInterfaces, ONLY: SetupEMSActuator, SetupEMSInternalVariable
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: FanNum ! The fan that you are currently loading input into
INTEGER :: NumSimpFan ! The number of Simple Const Vol Fans
INTEGER :: NumVarVolFan ! The number of Simple Variable Vol Fans
INTEGER :: NumOnOff ! The number of Simple on-off Fans
INTEGER :: NumZoneExhFan
INTEGER :: SimpFanNum
INTEGER :: OnOffFanNum
INTEGER :: VarVolFanNum
INTEGER :: ExhFanNum
INTEGER :: NVPerfNum
LOGICAL :: NVPerfFanFound
INTEGER :: NumCompModelFan ! cpw22Aug2010 The number of Component Model Fans
INTEGER :: CompModelFanNum ! cpw22Aug2010 Component Model Fan index
INTEGER :: NumAlphas
INTEGER :: NumNums
INTEGER :: checkNum
INTEGER :: IOSTAT
LOGICAL :: ErrorsFound = .false. ! If errors detected in input
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
CHARACTER(len=*), PARAMETER :: RoutineName='GetFanInput: ' ! include trailing blank space
CHARACTER(len=MaxNameLength+40),ALLOCATABLE, DIMENSION(:) :: cAlphaFieldNames
CHARACTER(len=MaxNameLength+40),ALLOCATABLE, DIMENSION(:) :: cNumericFieldNames
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericFieldBlanks
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaFieldBlanks
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: cAlphaArgs
REAL(r64),ALLOCATABLE, DIMENSION(:) :: rNumericArgs
CHARACTER(len=MaxNameLength) :: cCurrentModuleObject
INTEGER :: NumParams
INTEGER :: MaxAlphas
INTEGER :: MaxNumbers
! Flow
MaxAlphas=0
MaxNumbers=0
NumSimpFan = GetNumObjectsFound('Fan:ConstantVolume')
IF (NumSimpFan > 0) THEN
CALL GetObjectDefMaxArgs('Fan:ConstantVolume',NumParams,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNumbers=MAX(MaxNumbers,NumNums)
ENDIF
NumVarVolFan = GetNumObjectsFound('Fan:VariableVolume')
IF (NumVarVolFan > 0) THEN
CALL GetObjectDefMaxArgs('Fan:VariableVolume',NumParams,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNumbers=MAX(MaxNumbers,NumNums)
ENDIF
NumOnOff = GetNumObjectsFound('Fan:OnOff')
IF (NumOnOff > 0) THEN
CALL GetObjectDefMaxArgs('Fan:OnOff',NumParams,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNumbers=MAX(MaxNumbers,NumNums)
ENDIF
NumZoneExhFan = GetNumObjectsFound('Fan:ZoneExhaust')
IF (NumZoneExhFan > 0) THEN
CALL GetObjectDefMaxArgs('Fan:ZoneExhaust',NumParams,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNumbers=MAX(MaxNumbers,NumNums)
ENDIF
NumNightVentPerf = GetNumObjectsFound('FanPerformance:NightVentilation')
IF (NumNightVentPerf > 0) THEN
CALL GetObjectDefMaxArgs('FanPerformance:NightVentilation',NumParams,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNumbers=MAX(MaxNumbers,NumNums)
ENDIF
! cpw22Aug2010 Added get max alphas and numbers for ComponentModel fan
NumCompModelFan = GetNumObjectsFound('Fan:ComponentModel')
IF (NumCompModelFan > 0) THEN
CALL GetObjectDefMaxArgs('Fan:ComponentModel',NumParams,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNumbers=MAX(MaxNumbers,NumNums)
ENDIF
ALLOCATE(cAlphaArgs(MaxAlphas))
cAlphaArgs=' '
ALLOCATE(cAlphaFieldNames(MaxAlphas))
cAlphaFieldNames=' '
ALLOCATE(lAlphaFieldBlanks(MaxAlphas))
lAlphaFieldBlanks=.false.
ALLOCATE(cNumericFieldNames(MaxNumbers))
cNumericFieldNames=' '
ALLOCATE(lNumericFieldBlanks(MaxNumbers))
lNumericFieldBlanks=.false.
ALLOCATE(rNumericArgs(MaxNumbers))
rNumericArgs=0.0d0
NumFans = NumSimpFan + NumVarVolFan + NumZoneExhFan + NumOnOff + NumCompModelFan ! cpw1Mar2010 Add NumCompModelFan
IF (NumFans > 0) THEN
ALLOCATE(Fan(NumFans))
ENDIF
ALLOCATE(CheckEquipName(NumFans))
CheckEquipName=.true.
DO SimpFanNum = 1, NumSimpFan
FanNum = SimpFanNum
cCurrentModuleObject= 'Fan:ConstantVolume'
CALL GetObjectItem(cCurrentModuleObject,SimpFanNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),Fan%FanName,FanNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
Fan(FanNum)%FanName = cAlphaArgs(1)
Fan(FanNum)%FanType = cCurrentModuleObject
Fan(FanNum)%AvailSchedName = cAlphaArgs(2)
IF (lAlphaFieldBlanks(2)) THEN
Fan(FanNum)%AvailSchedPtrNum = ScheduleAlwaysOn
ELSE
Fan(FanNum)%AvailSchedPtrNum = GetScheduleIndex(cAlphaArgs(2))
IF (Fan(FanNum)%AvailSchedPtrNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))// &
' entered ='//TRIM(cAlphaArgs(2))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
END IF
Fan(FanNum)%FanType_Num=FanType_SimpleConstVolume
Fan(FanNum)%FanEff = rNumericArgs(1)
Fan(FanNum)%DeltaPress = rNumericArgs(2)
Fan(FanNum)%MaxAirFlowRate= rNumericArgs(3)
IF (Fan(FanNum)%MaxAirFlowRate == 0.0d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(Fan(FanNum)%FanName)// &
'" has specified 0.0 max air flow rate. It will not be used in the simulation.')
ENDIF
Fan(FanNum)%MaxAirFlowRateIsAutosizable = .TRUE.
Fan(FanNum)%MotEff = rNumericArgs(4)
Fan(FanNum)%MotInAirFrac = rNumericArgs(5)
Fan(FanNum)%MinAirFlowRate= 0.0d0
Fan(FanNum)%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
Fan(FanNum)%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
IF (NumAlphas > 4) THEN
Fan(FanNum)%EndUseSubcategoryName = cAlphaArgs(5)
ELSE
Fan(FanNum)%EndUseSubcategoryName = 'General'
END IF
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(3),cAlphaArgs(4),'Air Nodes')
END DO ! end Number of Simple FAN Loop
DO VarVolFanNum = 1, NumVarVolFan
FanNum = NumSimpFan + VarVolFanNum
cCurrentModuleObject= 'Fan:VariableVolume'
CALL GetObjectItem(cCurrentModuleObject,VarVolFanNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),Fan%FanName,FanNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
Fan(FanNum)%FanName = cAlphaArgs(1)
Fan(FanNum)%FanType = cCurrentModuleObject
Fan(FanNum)%AvailSchedName = cAlphaArgs(2)
IF (lAlphaFieldBlanks(2)) THEN
Fan(FanNum)%AvailSchedPtrNum = ScheduleAlwaysOn
ELSE
Fan(FanNum)%AvailSchedPtrNum = GetScheduleIndex(cAlphaArgs(2))
IF (Fan(FanNum)%AvailSchedPtrNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))// &
' entered ='//TRIM(cAlphaArgs(2))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
END IF
Fan(FanNum)%FanType_Num=FanType_SimpleVAV
Fan(FanNum)%FanEff = rNumericArgs(1)
Fan(FanNum)%DeltaPress = rNumericArgs(2)
Fan(FanNum)%MaxAirFlowRate= rNumericArgs(3)
IF (Fan(FanNum)%MaxAirFlowRate == 0.0d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(Fan(FanNum)%FanName)// &
'" has specified 0.0 max air flow rate. It will not be used in the simulation.')
ENDIF
Fan(FanNum)%MaxAirFlowRateIsAutosizable = .TRUE.
IF (SameString(cAlphaArgs(3) , 'Fraction')) THEN
Fan(FanNum)%FanMinAirFracMethod = MinFrac
ELSEIF (SameString(cAlphaArgs(3), 'FixedFlowRate')) THEN
Fan(FanNum)%FanMinAirFracMethod = FixedMin
ELSE
CALL ShowSevereError(TRIM(cAlphaFieldNames(3))//' should be either Fraction or FixedFlowRate.')
CALL ShowContinueError('Occurs in '//trim(Fan(FanNum)%FanName)//' object.')
ErrorsFound=.true.
ENDIF
! Fan(FanNum)%MinAirFlowRate= rNumericArgs(4)
Fan(FanNum)%FanMinFrac = rNumericArgs(4)
Fan(FanNum)%FanFixedMin = rNumericArgs(5)
Fan(FanNum)%MotEff = rNumericArgs(6)
Fan(FanNum)%MotInAirFrac = rNumericArgs(7)
Fan(FanNum)%FanCoeff(1) = rNumericArgs(8)
Fan(FanNum)%FanCoeff(2) = rNumericArgs(9)
Fan(FanNum)%FanCoeff(3) = rNumericArgs(10)
Fan(FanNum)%FanCoeff(4) = rNumericArgs(11)
Fan(FanNum)%FanCoeff(5) = rNumericArgs(12)
IF (Fan(FanNum)%FanCoeff(1) == 0.0d0 .and. Fan(FanNum)%FanCoeff(2) == 0.0d0 .and. &
Fan(FanNum)%FanCoeff(3) == 0.0d0 .and. Fan(FanNum)%FanCoeff(4) == 0.0d0 .and. &
Fan(FanNum)%FanCoeff(5) == 0.0d0) THEN
CALL ShowWarningError('Fan Coefficients are all zero. No Fan power will be reported.')
CALL ShowContinueError('For '//TRIM(cCurrentModuleObject)//', Fan='//TRIM(cAlphaArgs(1)))
ENDIF
Fan(FanNum)%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
Fan(FanNum)%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
IF (NumAlphas > 5) THEN
Fan(FanNum)%EndUseSubcategoryName = cAlphaArgs(6)
ELSE
Fan(FanNum)%EndUseSubcategoryName = 'General'
END IF
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(4),cAlphaArgs(5),'Air Nodes')
END DO ! end Number of Variable Volume FAN Loop
DO ExhFanNum = 1, NumZoneExhFan
FanNum = NumSimpFan + NumVarVolFan + ExhFanNum
cCurrentModuleObject= 'Fan:ZoneExhaust'
CALL GetObjectItem(cCurrentModuleObject,ExhFanNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),Fan%FanName,FanNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
Fan(FanNum)%FanName = cAlphaArgs(1)
Fan(FanNum)%FanType = cCurrentModuleObject
Fan(FanNum)%AvailSchedName = cAlphaArgs(2)
IF (lAlphaFieldBlanks(2)) THEN
Fan(FanNum)%AvailSchedPtrNum = ScheduleAlwaysOn
ELSE
Fan(FanNum)%AvailSchedPtrNum = GetScheduleIndex(cAlphaArgs(2))
IF (Fan(FanNum)%AvailSchedPtrNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))// &
' entered ='//TRIM(cAlphaArgs(2))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
ELSE
IF (HasFractionalScheduleValue(Fan(FanNum)%AvailSchedPtrNum)) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(Fan(FanNum)%FanName)// &
'" has fractional values in Schedule='//TRIM(cAlphaArgs(2))//'. Only 0.0 in the schedule value turns the fan off.')
ENDIF
END IF
END IF
Fan(FanNum)%FanType_Num=FanType_ZoneExhaust
Fan(FanNum)%FanEff = rNumericArgs(1)
Fan(FanNum)%DeltaPress = rNumericArgs(2)
Fan(FanNum)%MaxAirFlowRate= rNumericArgs(3)
Fan(FanNum)%MaxAirFlowRateIsAutosizable = .FALSE.
Fan(FanNum)%MotEff = 1.0d0
Fan(FanNum)%MotInAirFrac = 1.0d0
Fan(FanNum)%MinAirFlowRate= 0.0d0
Fan(FanNum)%RhoAirStdInit = StdRhoAir
Fan(FanNum)%MaxAirMassFlowRate = Fan(FanNum)%MaxAirFlowRate * Fan(FanNum)%RhoAirStdInit
IF (Fan(FanNum)%MaxAirFlowRate == 0.0d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(Fan(FanNum)%FanName)// &
'" has specified 0.0 max air flow rate. It will not be used in the simulation.')
ENDIF
Fan(FanNum)%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
Fan(FanNum)%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
IF (NumAlphas > 4 .AND. .NOT. lAlphaFieldBlanks(5)) THEN
Fan(FanNum)%EndUseSubcategoryName = cAlphaArgs(5)
ELSE
Fan(FanNum)%EndUseSubcategoryName = 'General'
END IF
IF (NumAlphas > 5 .AND. .NOT. lAlphaFieldBlanks(6)) THEN
Fan(FanNum)%FlowFractSchedNum = GetScheduleIndex(cAlphaArgs(6))
IF (Fan(FanNum)%FlowFractSchedNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(6))// &
' entered ='//TRIM(cAlphaArgs(6))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
ELSEIF (Fan(FanNum)%FlowFractSchedNum > 0) THEN
IF (.NOT.CheckScheduleValueMinMax(Fan(FanNum)%FlowFractSchedNum,'>=',0.0D0,'<=',1.0D0)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(6))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Error found in '//TRIM(cAlphaFieldNames(6))//' = '//TRIM(cAlphaArgs(6)) )
CALL ShowContinueError('Schedule values must be (>=0., <=1.)')
ErrorsFound=.true.
ENDIF
ENDIF
ELSE
Fan(FanNum)%FlowFractSchedNum = ScheduleAlwaysOn
ENDIF
IF (NumAlphas > 6 .AND. .NOT. lAlphaFieldBlanks(7)) THEN
SELECT CASE ( TRIM(cAlphaArgs(7)) )
CASE ( 'COUPLED' )
Fan(FanNum)%AvailManagerMode = ExhaustFanCoupledToAvailManagers
CASE ( 'DECOUPLED')
Fan(FanNum)%AvailManagerMode = ExhaustFanDecoupledFromAvailManagers
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(7))// &
' entered ='//TRIM(cAlphaArgs(7))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END SELECT
ELSE
Fan(FanNum)%AvailManagerMode = ExhaustFanCoupledToAvailManagers
ENDIF
IF (NumAlphas > 7 .AND. .NOT. lAlphaFieldBlanks(8)) THEN
Fan(FanNum)%MinTempLimitSchedNum = GetScheduleIndex(cAlphaArgs(8))
IF (Fan(FanNum)%MinTempLimitSchedNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(8))// &
' entered ='//TRIM(cAlphaArgs(8))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
ENDIF
ELSE
Fan(FanNum)%MinTempLimitSchedNum = 0
ENDIF
IF (NumAlphas > 8 .AND. .NOT. lAlphaFieldBlanks(9)) THEN
Fan(FanNum)%BalancedFractSchedNum = GetScheduleIndex(cAlphaArgs(9))
IF (Fan(FanNum)%BalancedFractSchedNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(9))// &
' entered ='//TRIM(cAlphaArgs(9))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
ELSEIF (Fan(FanNum)%BalancedFractSchedNum > 0) THEN
IF (.NOT.CheckScheduleValueMinMax(Fan(FanNum)%BalancedFractSchedNum,'>=',0.0D0,'<=',1.0D0)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(9))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Error found in '//TRIM(cAlphaFieldNames(9))//' = '//TRIM(cAlphaArgs(9)) )
CALL ShowContinueError('Schedule values must be (>=0., <=1.)')
ErrorsFound=.true.
ENDIF
ENDIF
ELSE
Fan(FanNum)%BalancedFractSchedNum = 0
ENDIF
! Component sets not setup yet for zone equipment
! CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(3),cAlphaArgs(4),'Air Nodes')
END DO ! end of Zone Exhaust Fan loop
DO OnOffFanNum = 1, NumOnOff
FanNum = NumSimpFan + NumVarVolFan + NumZoneExhFan + OnOffFanNum
cCurrentModuleObject= 'Fan:OnOff'
CALL GetObjectItem(cCurrentModuleObject,OnOffFanNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),Fan%FanName,FanNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
Fan(FanNum)%FanName = cAlphaArgs(1)
Fan(FanNum)%FanType = cCurrentModuleObject
Fan(FanNum)%AvailSchedName = cAlphaArgs(2)
IF (lAlphaFieldBlanks(2)) THEN
Fan(FanNum)%AvailSchedPtrNum = ScheduleAlwaysOn
ELSE
Fan(FanNum)%AvailSchedPtrNum = GetScheduleIndex(cAlphaArgs(2))
IF (Fan(FanNum)%AvailSchedPtrNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))// &
' entered ='//TRIM(cAlphaArgs(2))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
END IF
Fan(FanNum)%FanType_Num=FanType_SimpleOnOff
Fan(FanNum)%FanEff = rNumericArgs(1)
Fan(FanNum)%DeltaPress = rNumericArgs(2)
Fan(FanNum)%MaxAirFlowRate= rNumericArgs(3)
IF (Fan(FanNum)%MaxAirFlowRate == 0.0d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(Fan(FanNum)%FanName)// &
'" has specified 0.0 max air flow rate. It will not be used in the simulation.')
ENDIF
Fan(FanNum)%MaxAirFlowRateIsAutosizable = .TRUE.
! the following two structure variables are set here, as well as in InitFan, for the Heat Pump:Water Heater object
! (Standard Rating procedure may be called before BeginEnvirFlag is set to TRUE, if so MaxAirMassFlowRate = 0)
Fan(FanNum)%RhoAirStdInit = StdRhoAir
Fan(FanNum)%MaxAirMassFlowRate = Fan(FanNum)%MaxAirFlowRate * Fan(FanNum)%RhoAirStdInit
Fan(FanNum)%MotEff = rNumericArgs(4)
Fan(FanNum)%MotInAirFrac = rNumericArgs(5)
Fan(FanNum)%MinAirFlowRate= 0.0d0
Fan(FanNum)%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
Fan(FanNum)%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
IF (NumAlphas > 4 .AND. .NOT. lAlphaFieldBlanks(5)) THEN
Fan(FanNum)%FanPowerRatAtSpeedRatCurveIndex = GetCurveIndex(cAlphaArgs(5))
END IF
IF (NumAlphas > 5 .AND. .NOT. lAlphaFieldBlanks(6)) THEN
Fan(FanNum)%FanEffRatioCurveIndex = GetCurveIndex(cAlphaArgs(6))
END IF
IF (NumAlphas > 6 .AND. .NOT. lAlphaFieldBlanks(7)) THEN
Fan(FanNum)%EndUseSubcategoryName = cAlphaArgs(7)
ELSE
Fan(FanNum)%EndUseSubcategoryName = 'General'
END IF
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(3),cAlphaArgs(4),'Air Nodes')
END DO ! end Number of Simple ON-OFF FAN Loop
cCurrentModuleObject= 'FanPerformance:NightVentilation'
NumNightVentPerf = GetNumObjectsFound(cCurrentModuleObject)
IF (NumNightVentPerf > 0) THEN
ALLOCATE(NightVentPerf(NumNightVentPerf))
NightVentPerf%FanName = ' '
NightVentPerf%FanEff = 0.0d0
NightVentPerf%DeltaPress = 0.0d0
NightVentPerf%MaxAirFlowRate = 0.0d0
NightVentPerf%MotEff = 0.0d0
NightVentPerf%MotInAirFrac = 0.0d0
NightVentPerf%MaxAirMassFlowRate = 0.0d0
END IF
! input the night ventilation performance objects
DO NVPerfNum=1,NumNightVentPerf
CALL GetObjectItem(cCurrentModuleObject,NVPerfNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),NightVentPerf%FanName,NVPerfNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
NightVentPerf(NVPerfNum)%FanName = cAlphaArgs(1)
NightVentPerf(NVPerfNum)%FanEff = rNumericArgs(1)
NightVentPerf(NVPerfNum)%DeltaPress = rNumericArgs(2)
NightVentPerf(NVPerfNum)%MaxAirFlowRate = rNumericArgs(3)
NightVentPerf(NVPerfNum)%MotEff = rNumericArgs(4)
NightVentPerf(NVPerfNum)%MotInAirFrac = rNumericArgs(5)
! find the corresponding fan
NVPerfFanFound = .FALSE.
DO FanNum=1,NumFans
IF (NightVentPerf(NVPerfNum)%FanName == Fan(FanNum)%FanName) THEN
NVPerfFanFound = .TRUE.
Fan(FanNum)%NVPerfNum = NVPerfNum
EXIT
END IF
END DO
IF ( .NOT. NVPerfFanFound) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', fan name not found='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
END DO
!cpw22Aug2010 Added get input for Component Fan Model
DO CompModelFanNum = 1, NumCompModelFan
FanNum = NumSimpFan + NumVarVolFan + NumZoneExhFan + NumOnOff + CompModelFanNum
cCurrentModuleObject= 'Fan:ComponentModel'
CALL GetObjectItem(cCurrentModuleObject,CompModelFanNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),Fan%FanName,FanNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
Fan(FanNum)%FanName = cAlphaArgs(1) ! Fan name
Fan(FanNum)%FanType = cCurrentModuleObject
Fan(FanNum)%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(2),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent) ! Air inlet node name
Fan(FanNum)%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent) ! Air outlet node name
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(2),cAlphaArgs(3),'Air Nodes')
Fan(FanNum)%AvailSchedName = cAlphaArgs(4) ! Availability schedule name
IF (lAlphaFieldBlanks(4)) THEN
Fan(FanNum)%AvailSchedPtrNum =0
ELSE
Fan(FanNum)%AvailSchedPtrNum =GetScheduleIndex(cAlphaArgs(4))
IF (Fan(FanNum)%AvailSchedPtrNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(4))// &
' entered ='//TRIM(cAlphaArgs(4))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
ENDIF
Fan(FanNum)%FanType_Num=FanType_ComponentModel
Fan(FanNum)%MaxAirFlowRate= rNumericArgs(1)
IF (Fan(FanNum)%MaxAirFlowRate == 0.0d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(Fan(FanNum)%FanName)// &
'" has specified 0.0 max air flow rate. It will not be used in the simulation.')
ENDIF
Fan(FanNum)%MaxAirFlowRateIsAutosizable = .TRUE.
Fan(FanNum)%MinAirFlowRate= rNumericArgs(2)
Fan(FanNum)%FanSizingFactor = rNumericArgs(3) ! Fan max airflow sizing factor [-] cpw31Aug2010
Fan(FanNum)%FanWheelDia = rNumericArgs(4) ! Fan wheel outer diameter [m]
Fan(FanNum)%FanOutletArea = rNumericArgs(5) ! Fan outlet area [m2]
Fan(FanNum)%FanMaxEff = rNumericArgs(6) ! Fan maximum static efficiency [-]
Fan(FanNum)%EuMaxEff = rNumericArgs(7) ! Euler number at Fan maximum static efficiency [-]
Fan(FanNum)%FanMaxDimFlow = rNumericArgs(8) ! Fan maximum dimensionless airflow [-]
Fan(FanNum)%PulleyDiaRatio = rNumericArgs(9) ! Motor/fan pulley diameter ratio [-]
Fan(FanNum)%BeltMaxTorque = rNumericArgs(10) ! Belt maximum torque [N-m, autosizable]
Fan(FanNum)%BeltSizingFactor = rNumericArgs(11) ! Belt sizing factor [-]
Fan(FanNum)%BeltTorqueTrans = rNumericArgs(12) ! Belt fractional torque transition Region 1-2 [-]
Fan(FanNum)%MotorMaxSpd = rNumericArgs(13) ! Motor maximum speed [rpm]
Fan(FanNum)%MotorMaxOutPwr = rNumericArgs(14) ! Motor maximum output power [W, autosizable]
Fan(FanNum)%MotorSizingFactor = rNumericArgs(15) ! Motor sizing factor [-]
Fan(FanNum)%MotInAirFrac = rNumericArgs(16) ! Fraction of fan and motor losses to airstream [-]
Fan(FanNum)%VFDEffType = cAlphaArgs(5) ! VFD efficiency type [Speed or Power]
Fan(FanNum)%VFDMaxOutPwr = rNumericArgs(17) ! VFD maximum output power [W, autosizable]
Fan(FanNum)%VFDSizingFactor = rNumericArgs(18) ! VFD sizing factor [-] cpw31Aug2010
Fan(FanNum)%PressRiseCurveIndex = GetCurveIndex(cAlphaArgs(6)) ! Fan pressure rise curve
Fan(FanNum)%PressResetCurveIndex = GetCurveIndex(cAlphaArgs(7)) ! Duct static pressure reset curve
Fan(FanNum)%PLFanEffNormCurveIndex = GetCurveIndex(cAlphaArgs(8)) ! Fan part-load eff (normal) curve
Fan(FanNum)%PLFanEffStallCurveIndex = GetCurveIndex(cAlphaArgs(9)) ! Fan part-load eff (stall) curve
Fan(FanNum)%DimFlowNormCurveIndex = GetCurveIndex(cAlphaArgs(10)) ! Fan dim airflow (normal) curve
Fan(FanNum)%DimFlowStallCurveIndex = GetCurveIndex(cAlphaArgs(11)) ! Fan dim airflow (stall) curve
Fan(FanNum)%BeltMaxEffCurveIndex = GetCurveIndex(cAlphaArgs(12)) ! Belt max eff curve
Fan(FanNum)%PLBeltEffReg1CurveIndex = GetCurveIndex(cAlphaArgs(13)) ! Belt part-load eff Region 1 curve
Fan(FanNum)%PLBeltEffReg2CurveIndex = GetCurveIndex(cAlphaArgs(14)) ! Belt part-load eff Region 2 curve
Fan(FanNum)%PLBeltEffReg3CurveIndex = GetCurveIndex(cAlphaArgs(15)) ! Belt part-load eff Region 3 curve
Fan(FanNum)%MotorMaxEffCurveIndex = GetCurveIndex(cAlphaArgs(16)) ! Motor max eff curve
Fan(FanNum)%PLMotorEffCurveIndex = GetCurveIndex(cAlphaArgs(17)) ! Motor part-load eff curve
Fan(FanNum)%VFDEffCurveIndex = GetCurveIndex(cAlphaArgs(18)) ! VFD eff curve
IF (NumAlphas > 18) THEN
Fan(FanNum)%EndUseSubcategoryName = cAlphaArgs(19)
ELSE
Fan(FanNum)%EndUseSubcategoryName = 'General'
END IF
END DO ! end Number of Component Model FAN Loop
DEALLOCATE(cAlphaArgs)
DEALLOCATE(cAlphaFieldNames)
DEALLOCATE(lAlphaFieldBlanks)
DEALLOCATE(cNumericFieldNames)
DEALLOCATE(lNumericFieldBlanks)
DEALLOCATE(rNumericArgs)
! Check Fans
DO FanNum=1,NumFans
DO checkNum=FanNum+1,NumFans
IF (Fan(FanNum)%InletNodeNum == Fan(checkNum)%InletNodeNum) THEN
ErrorsFound=.true.
CALL ShowSevereError('GetFanInput, duplicate fan inlet node names, must be unique for fans.')
CALL ShowContinueError('Fan='//trim(Fan(FanNum)%FanType)//':'//trim(Fan(FanNum)%FanName)// &
' and Fan='//trim(Fan(checkNum)%FanType)//':'//trim(Fan(checkNum)%FanName)//'.')
CALL ShowContinueError('Inlet Node Name="'//trim(NodeID(Fan(FanNum)%InletNodeNum))//'".')
ENDIF
IF (Fan(FanNum)%OutletNodeNum == Fan(checkNum)%OutletNodeNum) THEN
ErrorsFound=.true.
CALL ShowSevereError('GetFanInput, duplicate fan outlet node names, must be unique for fans.')
CALL ShowContinueError('Fan='//trim(Fan(FanNum)%FanType)//':'//trim(Fan(FanNum)%FanName)// &
' and Fan='//trim(Fan(checkNum)%FanType)//':'//trim(Fan(checkNum)%FanName)//'.')
CALL ShowContinueError('Outlet Node Name="'//trim(NodeID(Fan(FanNum)%OutletNodeNum))//'".')
ENDIF
ENDDO
ENDDO
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in input. Program terminates.')
ENDIF
Do FanNum=1,NumFans
! Setup Report variables for the Fans CurrentModuleObject='Fans'
CALL SetupOutputVariable('Fan Electric Power [W]', Fan(FanNum)%FanPower, 'System','Average',Fan(FanNum)%FanName)
CALL SetupOutputVariable('Fan Rise in Air Temperature [deltaC]', Fan(FanNum)%DeltaTemp, &
'System','Average',Fan(FanNum)%FanName)
CALL SetupOutputVariable('Fan Electric Energy [J]', Fan(FanNum)%FanEnergy, 'System','Sum',Fan(FanNum)%FanName, &
ResourceTypeKey='Electric',GroupKey='System', &
EndUseKey='Fans',EndUseSubKey=Fan(FanNum)%EndUseSubcategoryName)
IF ((Fan(FanNum)%FanType_Num == FanType_ZoneExhaust) .and. (Fan(FanNum)%BalancedFractSchedNum > 0)) THEN
CALL SetupOutputVariable('Fan Unbalanced Air Mass Flow Rate [kg/s]', &
Fan(FanNum)%UnbalancedOutletMassFlowRate, 'System','Average',Fan(FanNum)%FanName)
CALL SetupOutputVariable('Fan Balanced Air Mass Flow Rate [kg/s]', &
Fan(FanNum)%BalancedOutletMassFlowRate, 'System','Average',Fan(FanNum)%FanName)
ENDIF
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupEMSInternalVariable('Fan Maximum Mass Flow Rate', Fan(FanNum)%FanName, '[kg/s]', &
Fan(FanNum)%MaxAirMassFlowRate )
CALL SetupEMSActuator('Fan', Fan(FanNum)%FanName, 'Fan Air Mass Flow Rate' , '[kg/s]', &
Fan(FanNum)%EMSMaxMassFlowOverrideOn, Fan(FanNum)%EMSAirMassFlowValue )
CALL SetupEMSInternalVariable('Fan Nominal Pressure Rise', Fan(FanNum)%FanName, '[Pa]', &
Fan(FanNum)%DeltaPress )
CALL SetupEMSActuator('Fan', Fan(FanNum)%FanName, 'Fan Pressure Rise' , '[Pa]', &
Fan(FanNum)%EMSFanPressureOverrideON, Fan(FanNum)%EMSFanPressureValue )
CALL SetupEMSInternalVariable('Fan Nominal Total Efficiency', Fan(FanNum)%FanName, '[fraction]', &
Fan(FanNum)%FanEff )
CALL SetupEMSActuator('Fan', Fan(FanNum)%FanName, 'Fan Total Efficiency' , '[fraction]', &
Fan(FanNum)%EMSFanEffOverrideOn, Fan(FanNum)%EMSFanEffValue )
CALL SetupEMSActuator('Fan', Fan(FanNum)%FanName, 'Fan Autosized Air Flow Rate' , '[m3/s]', &
Fan(FanNum)%MaxAirFlowRateEMSOverrideOn, Fan(FanNum)%MaxAirFlowRateEMSOverrideValue )
ENDIF
END DO
DO OnOffFanNum = 1, NumOnOff
FanNum = NumSimpFan + NumVarVolFan + NumZoneExhFan + OnOffFanNum
CALL SetupOutputVariable('Fan Runtime Fraction []', Fan(FanNum)%FanRuntimeFraction, 'System','Average', &
Fan(FanNum)%FanName)
END DO
CALL ManageEMS(emsCallFromComponentGetInput)
RETURN
END SUBROUTINE GetFanInput