Guide for Module Developers — EnergyPlus 8.3

<< Prev | Table of Contents | Next >>

Module Example[LINK]

This example can be used as a template for new HVAC component modules. In particular, the commenting structure in the module and within the subroutines should be followed closely. Of course, there is no perfect example module - this one is particularly simple. Some others that might be examined are in files Humidifiers.f90, HVACHeatingCoils.f90 and PlantChillers.f90. Templates are also available as separate files.

In particular, the module template with routines contains structure and information pertinent to module development.

Note that in the following module, the “Data IPShortcuts” is not used - rather those variables are allocated within this module - likely because another module calls this one during input.

Module Fans
  ! Module containing the fan simulation routines

  ! MODULE INFORMATION:
  !       AUTHOR         Richard J. Liesen
  !       DATE WRITTEN   April 1998
  !       MODIFIED       Shirey, May 2001
  !       RE-ENGINEERED  na

  ! PURPOSE OF THIS MODULE:
  ! To encapsulate the data and algorithms required to
  ! manage the Fan System Component

  ! REFERENCES: none

  ! OTHER NOTES: none

  ! USE STATEMENTS:
  ! Use statements for data only modules
USE DataPrecisionGlobals
USE DataLoopNode
USE DataHVACGlobals, ONLY: TurnFansOn, TurnFansOff, Main, Cooling, Heating, Other, &
          OnOffFanPartLoadFraction, SmallAirVolFlow, UnbalExhMassFlow, NightVentOn, cFanTypes, &
          FanType_SimpleConstVolume, FanType_SimpleVAV, FanType_SimpleOnOff, FanType_ZoneExhaust
USE DataGlobals,     ONLY: SetupOutputVariable, BeginEnvrnFlag, BeginDayFlag, MaxNameLength, &
       ShowWarningError, ShowFatalError, ShowSevereError, HourofDay, SysSizingCalc, CurrentTime, &
       OutputFileDebug, ShowContinueError, ShowRecurringWarningErrorAtEnd, WarmupFlag, &
                           ShowContinueErrorTimeStamp
Use DataEnvironment, ONLY: StdBaroPress, DayofMonth, Month, StdRhoAir
USE Psychrometrics,  ONLY:PsyRhoAirFnPbTdbW, PsyTdbFnHW, PsyCpAirFnWTdb

  ! Use statements for access to subroutines in other modules
USE ScheduleManager

IMPLICIT NONE         ! Enforce explicit typing of all variables

PRIVATE ! Everything private unless explicitly made public


  !MODULE PARAMETER DEFINITIONS
  !na

  ! DERIVED TYPE DEFINITIONS
TYPE FanEquipConditions
  CHARACTER(len=MaxNameLength) :: FanName  =' '  ! Name of the fan
  CHARACTER(len=MaxNameLength) :: FanType  =' '  ! Type of Fan ie. Simple, Vane axial, Centrifugal, etc.
  CHARACTER(len=MaxNameLength) :: Schedule =' '  ! Fan Operation Schedule
  INTEGER      :: FanType_Num              =0    ! DataHVACGlobals fan type
  Integer      :: SchedPtr                 =0    ! Pointer to the correct schedule
  REAL(r64)    :: InletAirMassFlowRate     =0.0  !MassFlow through the Fan being Simulated [kg/Sec]
  REAL(r64)    :: OutletAirMassFlowRate    =0.0
  REAL(r64)    :: MaxAirFlowRate           =0.0  !Max Specified Volume Flow Rate of Fan [m3/sec]
  REAL(r64)    :: MinAirFlowRate           =0.0  !Min Specified Volume Flow Rate of Fan [m3/sec]
  REAL(r64)    :: MaxAirMassFlowRate       =0.0  ! Max flow rate of fan in kg/sec
  REAL(r64)    :: MinAirMassFlowRate       =0.0  ! Min flow rate of fan in kg/sec
  REAL(r64)    :: InletAirTemp             =0.0
  REAL(r64)    :: OutletAirTemp            =0.0
  REAL(r64)    :: InletAirHumRat           =0.0
  REAL(r64)    :: OutletAirHumRat          =0.0
  REAL(r64)    :: InletAirEnthalpy         =0.0
  REAL(r64)    :: OutletAirEnthalpy        =0.0
  REAL(r64)    :: FanPower                 =0.0  !Power of the Fan being Simulated [kW]
  REAL(r64)    :: FanEnergy                =0.0  !Fan energy in [kJ]
  REAL(r64)    :: FanRuntimeFraction       =0.0  !Fraction of the timestep that the fan operates
  REAL(r64)    :: DeltaTemp                =0.0  !Temp Rise across the Fan [C]
  REAL(r64)    :: DeltaPress               =0.0  !Delta Pressure Across the Fan [N/m2]
  REAL(r64)    :: FanEff                   =0.0  !Fan total efficiency; motor and mechanical
  REAL(r64)    :: MotEff                   =0.0  !Fan motor efficiency
  REAL(r64)    :: MotInAirFrac             =0.0  !Fraction of motor heat entering air stream
  REAL(r64), Dimension(5):: FanCoeff            =0.0  !Fan Part Load Coefficients to match fan type
  ! Mass Flow Rate Control Variables
  REAL(r64)    :: MassFlowRateMaxAvail     =0.0
  REAL(r64)    :: MassFlowRateMinAvail     =0.0
  REAL(r64)    :: RhoAirStdInit            =0.0
  INTEGER      :: InletNodeNum             =0
  INTEGER      :: OutletNodeNum            =0
  INTEGER      :: NVPerfNum                =0
  INTEGER      :: FanPowerRatAtSpeedRatCurveIndex  =0
  INTEGER      :: FanEffRatioCurveIndex    =0
  CHARACTER(len=MaxNameLength) :: EndUseSubcategoryName=' '
  LOGICAL      :: OneTimePowerRatioCheck = .TRUE. ! one time flag used for error message
  LOGICAL      :: OneTimeEffRatioCheck = .TRUE.   ! one time flag used for error message
END TYPE FanEquipConditions

TYPE NightVentPerfData
  CHARACTER(len=MaxNameLength) :: FanName  =' ' ! Name of the fan that will use this data
  REAL(r64)    :: FanEff                   =0.0 !Fan total efficiency; motor and mechanical
  REAL(r64)    :: DeltaPress               =0.0 !Delta Pressure Across the Fan [N/m2]
  REAL(r64)    :: MaxAirFlowRate           =0.0 !Max Specified Volume Flow Rate of Fan [m3/s]
  REAL(r64)    :: MaxAirMassFlowRate       =0.0 ! Max flow rate of fan in kg/sec
  REAL(r64)    :: MotEff                   =0.0 !Fan motor efficiency
  REAL(r64)    :: MotInAirFrac             =0.0 !Fraction of motor heat entering air stream
END TYPE NightVentPerfData

  !MODULE VARIABLE DECLARATIONS:
  INTEGER :: NumFans     =0 ! The Number of Fans found in the Input
  INTEGER :: NumNightVentPerf =0 ! number of FAN:NIGHT VENT PERFORMANCE objects found in the input
  TYPE (FanEquipConditions), ALLOCATABLE, DIMENSION(:) :: Fan
  TYPE (NightVentPerfData), ALLOCATABLE, DIMENSION(:)  :: NightVentPerf
  LOGICAL :: GetFanInputFlag = .True.  ! Flag set to make sure you get input once

! Subroutine Specifications for the Module
          ! Driver/Manager Routines
Public  SimulateFanComponents

          ! Get Input routines for module
PRIVATE GetFanInput

          ! Initialization routines for module
PRIVATE InitFan
PRIVATE SizeFan

          ! Algorithms for the module
Private SimSimpleFan
PRIVATE SimVariableVolumeFan
PRIVATE SimZoneExhaustFan

          ! Update routine to check convergence and update nodes
Private UpdateFan

          ! Reporting routines for module
Private ReportFan

CONTAINS

! MODULE SUBROUTINES:
!*************************************************************************
SUBROUTINE SimulateFanComponents(CompName,FirstHVACIteration)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Richard Liesen
          !       DATE WRITTEN   February 1998
          !       MODIFIED       na
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine manages Fan component simulation.

          ! METHODOLOGY EMPLOYED:
          ! na

          ! REFERENCES:
          ! na

          ! USE STATEMENTS:
  USE InputProcessor, ONLY: FindItemInList

  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine

          ! SUBROUTINE ARGUMENT DEFINITIONS:
  CHARACTER(len=*), INTENT(IN) :: CompName
  LOGICAL,      INTENT (IN):: FirstHVACIteration

          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na

          ! INTERFACE BLOCK SPECIFICATIONS

          ! DERIVED TYPE DEFINITIONS
          ! na

          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  INTEGER             :: FanNum     ! current fan number
  LOGICAL,SAVE        :: GetInputFlag = .True.  ! Flag set to make sure you get input once

          ! FLOW:

  ! Obtains and Allocates fan related parameters from input file
  IF (GetInputFlag) THEN  !First time subroutine has been entered
    CALL GetFanInput
    GetInputFlag=.false.
  End If

  ! Find the correct FanNumber with the AirLoop & CompNum from AirLoop Derived Type
  !FanNum = AirLoopEquip(AirLoopNum)%ComponentOfTypeNum(CompNum)
  ! Determine which Fan given the Fan Name
  FanNum =   FindItemInList(CompName,Fan%FanName,NumFans)
  IF (FanNum == 0) THEN
    CALL ShowFatalError('Fan not found='//TRIM(CompName))
  ENDIF

  ! With the correct FanNum Initialize
  CALL InitFan(FanNum,FirstHVACIteration)  ! Initialize all fan related parameters

  ! Calculate the Correct Fan Model with the current FanNum
  IF (Fan(FanNum)%FanType_Num == FanType_SimpleConstVolume) THEN
    Call SimSimpleFan(FanNum)
  Else IF (Fan(FanNum)%FanType_Num == FanType_SimpleVAV) THEN
    Call SimVariableVolumeFan(FanNum)
  Else If (Fan(FanNum)%FanType_Num == FanType_SimpleOnOff) THEN
    Call SimOnOffFan(FanNum)
  Else If (Fan(FanNum)%FanType_Num == FanType_ZoneExhaust) THEN
    Call SimZoneExhaustFan(FanNum)
  End If
  ! Update the current fan to the outlet nodes
  Call UpdateFan(FanNum)

  ! Report the current fan
  Call ReportFan(FanNum)

  RETURN

END SUBROUTINE SimulateFanComponents

! Get Input Section of the Module
!******************************************************************************
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

  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 :: NumAlphas
    INTEGER :: NumNums
    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
    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.0

    NumFans = NumSimpFan + NumVarVolFan + NumZoneExhFan+NumOnOff
    IF (NumFans > 0) THEN
      ALLOCATE(Fan(NumFans))
    ENDIF

      DO SimpFanNum = 1,  NumSimpFan
        FanNum = SimpFanNum
        cCurrentModuleObject= 'Fan:ConstantVolume'
        CALL GetObjectItem(TRIM(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)%Schedule = cAlphaArgs(2)
        Fan(FanNum)%SchedPtr = GetScheduleIndex(cAlphaArgs(2))
        IF (Fan(FanNum)%SchedPtr == 0) THEN
          IF (lAlphaFieldBlanks(2)) THEN
            CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': '//TRIM(cAlphaFieldNames(2))//  &
                 ' is required, missing for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
          ELSE
            CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))//  &
               ' entered ='//TRIM(cAlphaArgs(2))// &
               ' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
          END IF
          ErrorsFound=.true.
        END IF
!        Fan(FanNum)%Control = 'CONSTVOLUME'
        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.0) 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)%MotEff        = rNumericArgs(4)
        Fan(FanNum)%MotInAirFrac  = rNumericArgs(5)
        Fan(FanNum)%MinAirFlowRate= 0.0

        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(TRIM(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)%Schedule = cAlphaArgs(2)
        Fan(FanNum)%SchedPtr =GetScheduleIndex(cAlphaArgs(2))
        IF (Fan(FanNum)%SchedPtr == 0) THEN
          IF (lAlphaFieldBlanks(2)) THEN
            CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': '//TRIM(cAlphaFieldNames(2))//  &
                 ' is required, missing for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
          ELSE
            CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))//  &
               ' entered ='//TRIM(cAlphaArgs(2))// &
               ' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
          END IF
          ErrorsFound=.true.
        ENDIF
!        Fan(FanNum)%Control = 'VARIABLEVOLUME'
        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.0) 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)%MinAirFlowRate= rNumericArgs(4)
        Fan(FanNum)%MotEff        = rNumericArgs(5)
        Fan(FanNum)%MotInAirFrac  = rNumericArgs(6)
        Fan(FanNum)%FanCoeff(1)   = rNumericArgs(7)
        Fan(FanNum)%FanCoeff(2)   = rNumericArgs(8)
        Fan(FanNum)%FanCoeff(3)   = rNumericArgs(9)
        Fan(FanNum)%FanCoeff(4)   = rNumericArgs(10)
        Fan(FanNum)%FanCoeff(5)   = rNumericArgs(11)
        IF (Fan(FanNum)%FanCoeff(1) == 0.0 .and. Fan(FanNum)%FanCoeff(2) == 0.0 .and.  &
            Fan(FanNum)%FanCoeff(3) == 0.0 .and. Fan(FanNum)%FanCoeff(4) == 0.0 .and.  &
            Fan(FanNum)%FanCoeff(5) == 0.0)  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(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 Variable Volume FAN Loop

      DO ExhFanNum = 1,  NumZoneExhFan
        FanNum = NumSimpFan + NumVarVolFan + ExhFanNum
        cCurrentModuleObject= 'Fan:ZoneExhaust'
        CALL GetObjectItem(TRIM(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)%Schedule = cAlphaArgs(2)
        Fan(FanNum)%SchedPtr =GetScheduleIndex(cAlphaArgs(2))
        IF (Fan(FanNum)%SchedPtr == 0) THEN
          IF (lAlphaFieldBlanks(2)) THEN
            CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': '//TRIM(cAlphaFieldNames(2))//  &
                 ' is required, missing for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
          ELSE
            CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))//  &
               ' entered ='//TRIM(cAlphaArgs(2))// &
               ' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
          END IF
          ErrorsFound=.true.
        ELSE
          IF (HasFractionalScheduleValue(Fan(FanNum)%SchedPtr)) 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
        ENDIF
!        Fan(FanNum)%Control = 'CONSTVOLUME'
        Fan(FanNum)%FanType_Num=FanType_ZoneExhaust

        Fan(FanNum)%FanEff        = rNumericArgs(1)
        Fan(FanNum)%DeltaPress    = rNumericArgs(2)
        Fan(FanNum)%MaxAirFlowRate= rNumericArgs(3)
        Fan(FanNum)%MotEff        = 1.0
        Fan(FanNum)%MotInAirFrac  = 1.0
        Fan(FanNum)%MinAirFlowRate= 0.0
        Fan(FanNum)%RhoAirStdInit = StdRhoAir
        Fan(FanNum)%MaxAirMassFlowRate = Fan(FanNum)%MaxAirFlowRate * Fan(FanNum)%RhoAirStdInit

        IF (Fan(FanNum)%MaxAirFlowRate == 0.0) 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) THEN
          Fan(FanNum)%EndUseSubcategoryName = cAlphaArgs(5)
        ELSE
          Fan(FanNum)%EndUseSubcategoryName = 'General'
        END IF

        ! 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(TRIM(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)%Schedule = cAlphaArgs(2)
        Fan(FanNum)%SchedPtr = GetScheduleIndex(cAlphaArgs(2))
        IF (Fan(FanNum)%SchedPtr == 0) THEN
          IF (lAlphaFieldBlanks(2)) THEN
            CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': '//TRIM(cAlphaFieldNames(2))//  &
                 ' is required, missing for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
          ELSE
            CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))//  &
               ' entered ='//TRIM(cAlphaArgs(2))// &
               ' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
          END IF
          ErrorsFound=.true.
        ENDIF
!        Fan(FanNum)%Control = 'ONOFF'
        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.0) 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

!       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.0

        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(TRIM(cCurrentModuleObject))

      IF (NumNightVentPerf > 0) THEN
        ALLOCATE(NightVentPerf(NumNightVentPerf))
        NightVentPerf%FanName = ' '
        NightVentPerf%FanEff = 0.0
        NightVentPerf%DeltaPress = 0.0
        NightVentPerf%MaxAirFlowRate = 0.0
        NightVentPerf%MotEff = 0.0
        NightVentPerf%MotInAirFrac = 0.0
        NightVentPerf%MaxAirMassFlowRate = 0.0
      END IF
      ! input the night ventilation performance objects
      DO NVPerfNum=1,NumNightVentPerf
         CALL GetObjectItem(TRIM(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

      DEALLOCATE(cAlphaArgs)
      DEALLOCATE(cAlphaFieldNames)
      DEALLOCATE(lAlphaFieldBlanks)
      DEALLOCATE(cNumericFieldNames)
      DEALLOCATE(lNumericFieldBlanks)
      DEALLOCATE(rNumericArgs)

      IF (ErrorsFound) THEN
            CALL ShowFatalError(RoutineName//'Errors found in input.  Program terminates.')
      ENDIF

      Do FanNum=1,NumFans
             ! Setup Report variables for the Fans
       CALL SetupOutputVariable('Fan Electric Power[W]', Fan(FanNum)%FanPower, 'System','Average',Fan(FanNum)%FanName)
       CALL SetupOutputVariable('Fan Delta Temp[C]', Fan(FanNum)%DeltaTemp, 'System','Average',Fan(FanNum)%FanName)
       CALL SetupOutputVariable('Fan Electric Consumption[J]', Fan(FanNum)%FanEnergy, 'System','Sum',Fan(FanNum)%FanName, &
                                 ResourceTypeKey='Electric',GroupKey='System', &
                                 EndUseKey='Fans',EndUseSubKey=Fan(FanNum)%EndUseSubcategoryName)
      END DO

      DO OnOffFanNum = 1,  NumOnOff
       FanNum = NumSimpFan + NumVarVolFan + NumZoneExhFan + OnOffFanNum
       CALL SetupOutputVariable('On/Off Fan Runtime Fraction', Fan(FanNum)%FanRuntimeFraction, 'System','Average', &
                                 Fan(FanNum)%FanName)
      END DO
  RETURN

END SUBROUTINE GetFanInput

! End of Get Input subroutines for the HB Module
!******************************************************************************

! Beginning Initialization Section of the Module
!******************************************************************************

SUBROUTINE InitFan(FanNum,FirstHVACIteration)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Richard J. Liesen
          !       DATE WRITTEN   February 1998
          !       MODIFIED       na
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine is for initializations of the Fan Components.

          ! METHODOLOGY EMPLOYED:
          ! Uses the status flags to trigger initializations.

          ! REFERENCES:
          ! na

          ! USE STATEMENTS:
  USE DataSizing, ONLY: CurSysNum
  USE DataAirLoop, ONLY: AirLoopControlInfo

  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine

          ! SUBROUTINE ARGUMENT DEFINITIONS:
  LOGICAL, INTENT (IN):: FirstHVACIteration
  Integer, Intent(IN) :: FanNum

          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na

          ! INTERFACE BLOCK SPECIFICATIONS
          ! na

          ! DERIVED TYPE DEFINITIONS
          ! na

          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  Integer             :: InletNode
  Integer             :: OutletNode
  Integer             :: InNode
  Integer             :: OutNode
  LOGICAL,SAVE        :: MyOneTimeFlag = .true.
  LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag
  LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MySizeFlag

          ! FLOW:

  IF (MyOneTimeFlag) THEN

    ALLOCATE(MyEnvrnFlag(NumFans))
    ALLOCATE(MySizeFlag(NumFans))
    MyEnvrnFlag = .TRUE.
    MySizeFlag = .TRUE.

    MyOneTimeFlag = .false.

  END IF

  IF ( .NOT. SysSizingCalc .AND. MySizeFlag(FanNum)) THEN

    CALL SizeFan(FanNum)
    ! Set the loop cycling flag
    IF (Fan(FanNum)%Control == 'ONOFF') THEN
      IF (CurSysNum > 0) THEN
        AirLoopControlInfo(CurSysNum)%CyclingFan = .TRUE.
      END IF
    END IF

    MySizeFlag(FanNum) = .FALSE.
  END IF

! Do the Begin Environment initializations
  IF (BeginEnvrnFlag .and. MyEnvrnFlag(FanNum)) THEN

    !For all Fan inlet nodes convert the Volume flow to a mass flow
    InNode = Fan(FanNum)%InletNodeNum
    OutNode = Fan(FanNum)%OutletNodeNum
    Fan(FanNum)%RhoAirStdInit = PsyRhoAirFnPbTdbW(StdBaroPress,20.0,0.0)

    !Change the Volume Flow Rates to Mass Flow Rates

    Fan(FanNum)%MaxAirMassFlowRate = Fan(FanNum)%MaxAirFlowRate *  Fan(FanNum)%RhoAirStdInit
    Fan(FanNum)%MinAirMassFlowRate = Fan(FanNum)%MinAirFlowRate *  Fan(FanNum)%RhoAirStdInit

    !Init the Node Control variables
    Node(OutNode)%MassFlowRateMax      = Fan(FanNum)%MaxAirMassFlowRate
    Node(OutNode)%MassFlowRateMin      = Fan(FanNum)%MinAirMassFlowRate

    !Initialize all report variables to a known state at beginning of simulation
    Fan(FanNum)%FanPower = 0.0
    Fan(FanNum)%DeltaTemp = 0.0
    Fan(FanNum)%FanEnergy = 0.0

    MyEnvrnFlag(FanNum) = .FALSE.
  END IF

  IF (.not. BeginEnvrnFlag) THEN
    MyEnvrnFlag(FanNum) = .true.
  ENDIF

  ! Do the Begin Day initializations
    ! none

  ! Do the begin HVAC time step initializations
    ! none

  ! Do the following initializations (every time step): This should be the info from
  ! the previous components outlets or the node data in this section.

  ! Do a check and make sure that the max and min available(control) flow is
  ! between the physical max and min for the Fan while operating.

  InletNode = Fan(FanNum)%InletNodeNum
  OutletNode = Fan(FanNum)%OutletNodeNum

  Fan(FanNum)%MassFlowRateMaxAvail = MIN(Node(OutletNode)%MassFlowRateMax, &
                                              Node(InletNode)%MassFlowRateMaxAvail)
  Fan(FanNum)%MassFlowRateMinAvail = MIN(MAX(Node(OutletNode)%MassFlowRateMin, &
                                             Node(InletNode)%MassFlowRateMinAvail), &
                                             Node(InletNode)%MassFlowRateMaxAvail)

  ! Load the node data in this section for the component simulation
  !
  !First need to make sure that the massflowrate is between the max and min avail.
  IF (Fan(FanNum)%FanType .NE. 'ZONE EXHAUST FAN') THEN
    Fan(FanNum)%InletAirMassFlowRate = Min(Node(InletNode)%MassFlowRate, &
                                           Fan(FanNum)%MassFlowRateMaxAvail)
    Fan(FanNum)%InletAirMassFlowRate = Max(Fan(FanNum)%InletAirMassFlowRate, &
                                           Fan(FanNum)%MassFlowRateMinAvail)
  ELSE  ! zone exhaust fans - always run at the max
    Fan(FanNum)%MassFlowRateMaxAvail = Fan(FanNum)%MaxAirMassFlowRate
    Fan(FanNum)%MassFlowRateMinAvail = 0.0
    Fan(FanNum)%InletAirMassFlowRate = Fan(FanNum)%MassFlowRateMaxAvail
  END IF

  !Then set the other conditions
  Fan(FanNum)%InletAirTemp         = Node(InletNode)%Temp
  Fan(FanNum)%InletAirHumRat       = Node(InletNode)%HumRat
  Fan(FanNum)%InletAirEnthalpy     = Node(InletNode)%Enthalpy

  RETURN

END SUBROUTINE InitFan

SUBROUTINE SizeFan(FanNum)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Fred Buhl
          !       DATE WRITTEN   September 2001
          !       MODIFIED       na
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine is for sizing Fan Components for which flow rates have not been
          ! specified in the input.

          ! METHODOLOGY EMPLOYED:
          ! Obtains flow rates from the zone or system sizing arrays.

          ! REFERENCES:
          ! na

          ! USE STATEMENTS:
  USE DataSizing

  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 :: FanMinAirFlowRate
  EXTERNAL ReportSizingOutput

  FanMinAirFlowRate = 0.0
  IF (Fan(FanNum)%MaxAirFlowRate == AutoSize) THEN

    IF (CurSysNum > 0) THEN

      CALL CheckSysSizing('FAN:'//TRIM(Fan(FanNum)%FanType)// ':' // TRIM(Fan(FanNum)%Control), &
                           Fan(FanNum)%FanName)

      SELECT CASE(CurDuctType)
        CASE(Main)
          Fan(FanNum)%MaxAirFlowRate = FinalSysSizing(CurSysNum)%DesMainVolFlow
          FanMinAirFlowRate = CalcSysSizing(CurSysNum)%SysAirMinFlowRat * CalcSysSizing(CurSysNum)%DesMainVolFlow
        CASE(Cooling)
          Fan(FanNum)%MaxAirFlowRate = FinalSysSizing(CurSysNum)%DesCoolVolFlow
          FanMinAirFlowRate = CalcSysSizing(CurSysNum)%SysAirMinFlowRat * CalcSysSizing(CurSysNum)%DesCoolVolFlow
        CASE(Heating)
          Fan(FanNum)%MaxAirFlowRate = FinalSysSizing(CurSysNum)%DesHeatVolFlow
          FanMinAirFlowRate = CalcSysSizing(CurSysNum)%SysAirMinFlowRat * CalcSysSizing(CurSysNum)%DesHeatVolFlow
        CASE(Other)
          Fan(FanNum)%MaxAirFlowRate = FinalSysSizing(CurSysNum)%DesMainVolFlow
          FanMinAirFlowRate = CalcSysSizing(CurSysNum)%SysAirMinFlowRat * CalcSysSizing(CurSysNum)%DesMainVolFlow
        CASE DEFAULT
          Fan(FanNum)%MaxAirFlowRate = FinalSysSizing(CurSysNum)%DesMainVolFlow
          FanMinAirFlowRate = CalcSysSizing(CurSysNum)%SysAirMinFlowRat * CalcSysSizing(CurSysNum)%DesMainVolFlow
      END SELECT

    ELSE IF (CurZoneEqNum > 0) THEN

      CALL CheckZoneSizing('FAN:' // TRIM(Fan(FanNum)%FanType) // ':' // TRIM(Fan(FanNum)%Control), &
                           Fan(FanNum)%FanName)
      IF (.NOT. ZoneHeatingOnlyFan) THEN
        Fan(FanNum)%MaxAirFlowRate = MAX(FinalZoneSizing(CurZoneEqNum)%DesCoolVolFlow, &
                                         FinalZoneSizing(CurZoneEqNum)%DesHeatVolFlow)
      ELSE
        Fan(FanNum)%MaxAirFlowRate = FinalZoneSizing(CurZoneEqNum)%DesHeatVolFlow
      END IF

    END IF

    IF (Fan(FanNum)%MaxAirFlowRate < SmallAirVolFlow) THEN
      Fan(FanNum)%MaxAirFlowRate = 0.0
    END IF

    CALL ReportSizingOutput('FAN:' // TRIM(Fan(FanNum)%FanType) // ':' // TRIM(Fan(FanNum)%Control), &
                            Fan(FanNum)%FanName, 'Max Flow Rate [m3/s]', Fan(FanNum)%MaxAirFlowRate)

    IF (Fan(FanNum)%Control == 'VARIABLEVOLUME') THEN
      CALL CheckSysSizing('FAN:' // TRIM(Fan(FanNum)%FanType) // ':' // TRIM(Fan(FanNum)%Control), &
                           Fan(FanNum)%FanName)
      Fan(FanNum)%MinAirFlowRate = FanMinAirFlowRate
      CALL ReportSizingOutput('FAN:' // TRIM(Fan(FanNum)%FanType) // ':' // TRIM(Fan(FanNum)%Control), &
                              Fan(FanNum)%FanName, 'Min Flow Rate [m3/s]', Fan(FanNum)%MinAirFlowRate)
    END IF

  END IF

  RETURN

END SUBROUTINE SizeFan

! End Initialization Section of the Module
!******************************************************************************

! Begin Algorithm Section of the Module
!******************************************************************************
SUBROUTINE SimSimpleFan(FanNum)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Unknown
          !       DATE WRITTEN   Unknown
          !       MODIFIED       na
          !       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 RhoAir
      Real DeltaPress  ! [N/M^2]
      Real FanEff
      Real MassFlow    ! [kg/sec]
      Real Tin         ! [C]
      Real Win
      Real FanShaftPower ! power delivered to fan shaft
      Real PowerLossToAir ! fan and motor loss to air stream (watts)

   DeltaPress = Fan(FanNum)%DeltaPress
   FanEff     = Fan(FanNum)%FanEff

   ! For a Constant Volume Simple Fan the Max Flow Rate is the Flow Rate for the fan
   Tin        = Fan(FanNum)%InletAirTemp
   Win        = Fan(FanNum)%InletAirHumRat
   RhoAir     = Fan(FanNum)%RhoAirStdInit
   MassFlow   = MIN(Fan(FanNum)%InletAirMassFlowRate,Fan(FanNum)%MaxAirMassFlowRate)
   MassFlow   = MAX(MassFlow,Fan(FanNum)%MinAirMassFlowRate)
   !
   !Determine the Fan Schedule for the Time step
  If( ( GetCurrentScheduleValue(Fan(FanNum)%SchedPtr)>0.0 .and. Massflow>0.0 .or. TurnFansOn .and. Massflow>0.0) &
        .and. .NOT.TurnFansOff ) Then
   !Fan is operating
   Fan(FanNum)%FanPower = MassFlow*DeltaPress/(FanEff*RhoAir) ! total fan power
   FanShaftPower = Fan(FanNum)%MotEff * Fan(FanNum)%FanPower  ! power delivered to shaft
   PowerLossToAir = FanShaftPower + (Fan(FanNum)%FanPower - FanShaftPower) * Fan(FanNum)%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.0
   FanShaftPower = 0.0
   PowerLossToAir = 0.0
   Fan(FanNum)%OutletAirMassFlowRate = 0.0
   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.0
   Fan(FanNum)%MassFlowRateMinAvail = 0.0

 End If

 RETURN
END SUBROUTINE SimSimpleFan

SUBROUTINE SimVariableVolumeFan(FanNum)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Unknown
          !       DATE WRITTEN   Unknown
          !       MODIFIED       Phil Haves
          !       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

          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na

          ! INTERFACE BLOCK SPECIFICATIONS
          ! na

          ! DERIVED TYPE DEFINITIONS
          ! na

          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
      Real RhoAir
      Real DeltaPress  ! [N/M^2 = Pa]
      Real FanEff      ! Total fan efficiency - combined efficiency of fan, drive train,
                       ! motor and variable speed controller (if any)
      Real MassFlow    ! [kg/sec]
      Real Tin         ! [C]
      Real Win
      Real PartLoadFrac
      REAL MaxFlowFrac   !Variable Volume Fan Max Flow Fraction [-]
      REAL MinFlowFrac   !Variable Volume Fan Min Flow Fraction [-]
      REAL FlowFrac      !Variable Volume Fan Flow Fraction [-]
      Real FanShaftPower ! power delivered to fan shaft
      Real PowerLossToAir ! fan and motor loss to air stream (watts)

! 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

   DeltaPress  = Fan(FanNum)%DeltaPress
   FanEff      = Fan(FanNum)%FanEff

   Tin         = Fan(FanNum)%InletAirTemp
   Win         = Fan(FanNum)%InletAirHumRat
   RhoAir      = Fan(FanNum)%RhoAirStdInit
   MassFlow    = MIN(Fan(FanNum)%InletAirMassFlowRate,Fan(FanNum)%MaxAirMassFlowRate)
   ! MassFlow    = MAX(MassFlow,Fan(FanNum)%MinAirMassFlowRate)

  ! Calculate and check limits on fraction of system flow
  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
  FlowFrac = MassFlow/(Fan(FanNum)%MaxAirMassFlowRate)

! Calculate the part Load Fraction             (PH 7/13/03)

  FlowFrac = MAX(MinFlowFrac,MIN(FlowFrac,1.0))  ! limit flow fraction to allowed range

  PartLoadFrac=Fan(FanNum)%FanCoeff(1) + Fan(FanNum)%FanCoeff(2)*FlowFrac +  &
                  Fan(FanNum)%FanCoeff(3)*FlowFrac**2 + Fan(FanNum)%FanCoeff(4)*FlowFrac**3 + &
                  Fan(FanNum)%FanCoeff(5)*FlowFrac**4

   !Determine the Fan Schedule for the Time step
  If( ( GetCurrentScheduleValue(Fan(FanNum)%SchedPtr)>0.0 .and. Massflow>0.0 .or. TurnFansOn .and. Massflow>0.0) &
        .and. .NOT.TurnFansOff ) Then
   !Fan is operating - calculate power loss and enthalpy rise
!   Fan(FanNum)%FanPower = PartLoadFrac*FullMassFlow*DeltaPress/(FanEff*RhoAir) ! total fan power
   Fan(FanNum)%FanPower = PartLoadFrac*Fan(FanNum)%MaxAirMassFlowRate*DeltaPress/(FanEff*RhoAir) ! total fan power (PH 7/13/03)
   FanShaftPower = Fan(FanNum)%MotEff * Fan(FanNum)%FanPower  ! power delivered to shaft
   PowerLossToAir = FanShaftPower + (Fan(FanNum)%FanPower - FanShaftPower) * Fan(FanNum)%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.0
   FanShaftPower = 0.0
   PowerLossToAir = 0.0
   Fan(FanNum)%OutletAirMassFlowRate = 0.0
   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.0
   Fan(FanNum)%MassFlowRateMinAvail = 0.0
  End If

  RETURN
END SUBROUTINE SimVariableVolumeFan

SUBROUTINE SimOnOffFan(FanNum)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Unknown
          !       DATE WRITTEN   Unknown
          !       MODIFIED       Shirey, May 2001
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine simulates the simple on/off 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.
          ! Same as simple (constant volume) fan, except added part-load curve input

          ! REFERENCES:
          ! ASHRAE HVAC 2 Toolkit, page 2-3 (FANSIM)

          ! USE STATEMENTS:
  USE CurveManager, ONLY: CurveValue

  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 RhoAir
      Real DeltaPress  ! [N/M^2]
      Real FanEff
      Real MassFlow    ! [kg/sec]
      Real Tin         ! [C]
      Real Win
      Real PartLoadRatio !Ratio of actual mass flow rate to max mass flow rate
      REAL FlowFrac      !Actual Fan Flow Fraction = actual mass flow rate / max air mass flow rate
      Real FanShaftPower ! power delivered to fan shaft
      Real PowerLossToAir ! fan and motor loss to air stream (watts)

   DeltaPress = Fan(FanNum)%DeltaPress
   FanEff     = Fan(FanNum)%FanEff

   Tin        = Fan(FanNum)%InletAirTemp
   Win        = Fan(FanNum)%InletAirHumRat
   RhoAir     = Fan(FanNum)%RhoAirStdInit
   MassFlow   = MIN(Fan(FanNum)%InletAirMassFlowRate,Fan(FanNum)%MaxAirMassFlowRate)
   MassFlow   = MAX(MassFlow,Fan(FanNum)%MinAirMassFlowRate)
   Fan(FanNum)%FanRuntimeFraction = 0.0

  ! The actual flow fraction is calculated from MassFlow and the MaxVolumeFlow * AirDensity
  FlowFrac = MassFlow/(Fan(FanNum)%MaxAirMassFlowRate)

  ! Calculate the part load ratio, can't be greater than 1
  PartLoadRatio= MIN(1.0,FlowFrac)
  ! Determine the Fan Schedule for the Time step
  IF( ( GetCurrentScheduleValue(Fan(FanNum)%SchedPtr)>0.0 .and. Massflow>0.0 .or. TurnFansOn .and. Massflow>0.0) &
        .and. .NOT.TurnFansOff ) THEN
   ! Fan is operating
   IF (OnOffFanPartLoadFraction <= 0.0) THEN
     CALL ShowWarningError('FAN:SIMPLE:ONOFF, OnOffFanPartLoadFraction <= 0.0, Reset to 1.0')
     OnOffFanPartLoadFraction = 1.0 ! avoid divide by zero or negative PLF
   END IF

   IF (OnOffFanPartLoadFraction < 0.7) THEN
        OnOffFanPartLoadFraction = 0.7 ! a warning message is already issued from the DX coils or gas heating coil
   END IF
   ! Keep fan runtime fraction between 0.0 and 1.0
   Fan(FanNum)%FanRuntimeFraction = MAX(0.0,MIN(1.0,PartLoadRatio/OnOffFanPartLoadFraction))
   ! Fan(FanNum)%FanPower = MassFlow*DeltaPress/(FanEff*RhoAir*OnOffFanPartLoadFraction)! total fan power
   Fan(FanNum)%FanPower = Fan(FanNum)%MaxAirMassFlowRate*Fan(FanNum)%FanRuntimeFraction*DeltaPress/(FanEff*RhoAir)!total fan power
   ! OnOffFanPartLoadFraction is passed via DataHVACGlobals from the cooling or heating coil that is
   !   requesting the fan to operate in cycling fan/cycling coil mode
   OnOffFanPartLoadFraction = 1.0 ! reset to 1 in case other on/off fan is called without a part load curve
   FanShaftPower = Fan(FanNum)%MotEff * Fan(FanNum)%FanPower  ! power delivered to shaft
   PowerLossToAir = FanShaftPower + (Fan(FanNum)%FanPower - FanShaftPower) * Fan(FanNum)%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 = Tin + PowerLossToAir/(MassFlow*PsyCpAirFnWTdb(Win,Tin))
   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.0
   FanShaftPower = 0.0
   PowerLossToAir = 0.0
   Fan(FanNum)%OutletAirMassFlowRate = 0.0
   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.0
   Fan(FanNum)%MassFlowRateMinAvail = 0.0
  END IF

  RETURN
END SUBROUTINE SimOnOffFan

SUBROUTINE SimZoneExhaustFan(FanNum)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Fred Buhl
          !       DATE WRITTEN   Jan 2000
          !       MODIFIED       na
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine simulates the Zone Exhaust 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 RhoAir
      Real DeltaPress  ! [N/M^2]
      Real FanEff
      Real MassFlow    ! [kg/sec]
      Real Tin         ! [C]
      Real Win
      Real PowerLossToAir ! fan and motor loss to air stream (watts)

   DeltaPress = Fan(FanNum)%DeltaPress
   FanEff     = Fan(FanNum)%FanEff

   ! For a Constant Volume Simple Fan the Max Flow Rate is the Flow Rate for the fan
   Tin        = Fan(FanNum)%InletAirTemp
   Win        = Fan(FanNum)%InletAirHumRat
   RhoAir     = Fan(FanNum)%RhoAirStdInit
   MassFlow   = Fan(FanNum)%InletAirMassFlowRate
   !
   !Determine the Fan Schedule for the Time step
  If( ( GetCurrentScheduleValue(Fan(FanNum)%SchedPtr)>0.0 .or. TurnFansOn ) &
        .and. .NOT.TurnFansOff ) Then
   !Fan is operating
   Fan(FanNum)%FanPower = MassFlow*DeltaPress/(FanEff*RhoAir) ! total fan power
   PowerLossToAir = Fan(FanNum)%FanPower
   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.0
   PowerLossToAir = 0.0
   Fan(FanNum)%OutletAirMassFlowRate = 0.0
   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.0
   Fan(FanNum)%MassFlowRateMinAvail = 0.0
   Fan(FanNum)%InletAirMassFlowRate = 0.0

 End If

 RETURN
END SUBROUTINE SimZoneExhaustFan

! End Algorithm Section of the Module
! *****************************************************************************

! Beginning of Update subroutines for the Fan Module
! *****************************************************************************

SUBROUTINE UpdateFan(FanNum)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Richard Liesen
          !       DATE WRITTEN   April 1998
          !       MODIFIED       na
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine updates the fan outlet nodes.

          ! METHODOLOGY EMPLOYED:
          ! Data is moved from the fan data structure to the fan outlet nodes.

          ! REFERENCES:
          ! na

          ! 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:
  Integer             :: OutletNode
  Integer             :: InletNode

   OutletNode = Fan(FanNum)%OutletNodeNum
   InletNode = Fan(FanNum)%InletNodeNum

   ! Set the outlet air nodes of the fan
   Node(OutletNode)%MassFlowRate  = Fan(FanNum)%OutletAirMassFlowRate
   Node(OutletNode)%Temp          = Fan(FanNum)%OutletAirTemp
   Node(OutletNode)%HumRat        = Fan(FanNum)%OutletAirHumRat
   Node(OutletNode)%Enthalpy      = Fan(FanNum)%OutletAirEnthalpy
   ! Set the outlet nodes for properties that just pass through & not used
   Node(OutletNode)%Quality         = Node(InletNode)%Quality
   Node(OutletNode)%Press           = Node(InletNode)%Press

   ! Set the Node Flow Control Variables from the Fan Control Variables
   Node(OutletNode)%MassFlowRateMaxAvail = Fan(FanNum)%MassFlowRateMaxAvail
   Node(OutletNode)%MassFlowRateMinAvail = Fan(FanNum)%MassFlowRateMinAvail

   IF (Fan(FanNum)%FanType .EQ. 'ZONE EXHAUST FAN') THEN
     Node(InletNode)%MassFlowRate = Fan(FanNum)%InletAirMassFlowRate
   END IF

  RETURN
END Subroutine UpdateFan

!        End of Update subroutines for the Fan Module
! *****************************************************************************

! Beginning of Reporting subroutines for the Fan Module
! *****************************************************************************

SUBROUTINE ReportFan(FanNum)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Richard Liesen
          !       DATE WRITTEN   April 1998
          !       MODIFIED       na
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine updates the report variables for the fans.

          ! METHODOLOGY EMPLOYED:
          ! na

          ! REFERENCES:
          ! na

          ! USE STATEMENTS:
  Use DataHVACGlobals, ONLY: TimeStepSys, FanElecPower

  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:
          ! na

    Fan(FanNum)%FanEnergy=Fan(FanNum)%FanPower*TimeStepSys*3600
    Fan(FanNum)%DeltaTemp=Fan(FanNum)%OutletAirTemp - Fan(FanNum)%InletAirTemp
    FanElecPower = Fan(FanNum)%FanPower

  RETURN
END Subroutine ReportFan

!        End of Reporting subroutines for the Fan Module
! *****************************************************************************
! Beginning of Utility subroutines for the Fan Module
! *****************************************************************************
FUNCTION GetFanDesignVolumeFlowRate(FanType,FanName,ErrorsFound) RESULT(DesignVolumeFlowRate)

          ! FUNCTION INFORMATION:
          !       AUTHOR         Linda Lawrie
          !       DATE WRITTEN   February 2006
          !       MODIFIED       na
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS FUNCTION:
          ! This function looks up the design volume flow rate for the given fan and returns it.  If
          ! incorrect fan type or name is given, errorsfound is returned as true and value is returned
          ! as negative.

          ! METHODOLOGY EMPLOYED:
          ! na

          ! REFERENCES:
          ! na

          ! USE STATEMENTS:
  USE InputProcessor,  ONLY: FindItemInList

  IMPLICIT NONE ! Enforce explicit typing of all variables in this routine

          ! FUNCTION ARGUMENT DEFINITIONS:
  CHARACTER(len=*), INTENT(IN) :: FanType      ! must match fan types in this module
  CHARACTER(len=*), INTENT(IN) :: FanName      ! must match fan names for the fan type
  LOGICAL, INTENT(INOUT)       :: ErrorsFound  ! set to true if problem
  REAL                         :: DesignVolumeFlowRate ! returned flow rate of matched fan

          ! FUNCTION PARAMETER DEFINITIONS:
          ! na

          ! INTERFACE BLOCK SPECIFICATIONS:
          ! na

          ! DERIVED TYPE DEFINITIONS:
          ! na

          ! FUNCTION LOCAL VARIABLE DECLARATIONS:
  INTEGER :: WhichFan

  ! Obtains and Allocates fan related parameters from input file
  IF (GetFanInputFlag) THEN  !First time subroutine has been entered
    CALL GetFanInput
    GetFanInputFlag=.false.
  End If

  WhichFan=FindItemInList(FanName,Fan%FanName,NumFans)
  IF (WhichFan /= 0) THEN
    DesignVolumeFlowRate=Fan(WhichFan)%MaxAirFlowRate
  ENDIF

  IF (WhichFan == 0) THEN
    CALL ShowSevereError('Could not find FanType="'//TRIM(FanType)//'" with Name="'//TRIM(FanName)//'"')
    ErrorsFound=.true.
    DesignVolumeFlowRate=-1000.
  ENDIF

  RETURN

END FUNCTION GetFanDesignVolumeFlowRate

FUNCTION GetFanInletNode(FanType,FanName,ErrorsFound) RESULT(NodeNumber)

          ! FUNCTION INFORMATION:
          !       AUTHOR         Linda Lawrie
          !       DATE WRITTEN   February 2006
          !       MODIFIED       na
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS FUNCTION:
          ! This function looks up the given fan and returns the inlet node.  If
          ! incorrect fan type or name is given, errorsfound is returned as true and value is returned
          ! as zero.

          ! METHODOLOGY EMPLOYED:
          ! na

          ! REFERENCES:
          ! na

          ! USE STATEMENTS:
  USE InputProcessor,  ONLY: FindItemInList

  IMPLICIT NONE ! Enforce explicit typing of all variables in this routine

          ! FUNCTION ARGUMENT DEFINITIONS:
  CHARACTER(len=*), INTENT(IN) :: FanType      ! must match fan types in this module
  CHARACTER(len=*), INTENT(IN) :: FanName      ! must match fan names for the fan type
  LOGICAL, INTENT(INOUT)       :: ErrorsFound  ! set to true if problem
  INTEGER                      :: NodeNumber   ! returned outlet node of matched fan

          ! FUNCTION PARAMETER DEFINITIONS:
          ! na

          ! INTERFACE BLOCK SPECIFICATIONS:
          ! na

          ! DERIVED TYPE DEFINITIONS:
          ! na

          ! FUNCTION LOCAL VARIABLE DECLARATIONS:
  INTEGER :: WhichFan

  ! Obtains and Allocates fan related parameters from input file
  IF (GetFanInputFlag) THEN  !First time subroutine has been entered
    CALL GetFanInput
    GetFanInputFlag=.false.
  End If

  WhichFan=FindItemInList(FanName,Fan%FanName,NumFans)
  IF (WhichFan /= 0) THEN
    NodeNumber=Fan(WhichFan)%InletNodeNum
  ENDIF

  IF (WhichFan == 0) THEN
    CALL ShowSevereError('Could not find FanType="'//TRIM(FanType)//'" with Name="'//TRIM(FanName)//'"')
    ErrorsFound=.true.
    NodeNumber=0
  ENDIF

  RETURN

END FUNCTION GetFanInletNode

FUNCTION GetFanOutletNode(FanType,FanName,ErrorsFound) RESULT(NodeNumber)

          ! FUNCTION INFORMATION:
          !       AUTHOR         Linda Lawrie
          !       DATE WRITTEN   February 2006
          !       MODIFIED       na
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS FUNCTION:
          ! This function looks up the given fan and returns the outlet node.  If
          ! incorrect fan type or name is given, errorsfound is returned as true and value is returned
          ! as zero.

          ! METHODOLOGY EMPLOYED:
          ! na

          ! REFERENCES:
          ! na

          ! USE STATEMENTS:
  USE InputProcessor,  ONLY: FindItemInList

  IMPLICIT NONE ! Enforce explicit typing of all variables in this routine

          ! FUNCTION ARGUMENT DEFINITIONS:
  CHARACTER(len=*), INTENT(IN) :: FanType      ! must match fan types in this module
  CHARACTER(len=*), INTENT(IN) :: FanName      ! must match fan names for the fan type
  LOGICAL, INTENT(INOUT)       :: ErrorsFound  ! set to true if problem
  INTEGER                      :: NodeNumber   ! returned outlet node of matched fan

          ! FUNCTION PARAMETER DEFINITIONS:
          ! na

          ! INTERFACE BLOCK SPECIFICATIONS:
          ! na

          ! DERIVED TYPE DEFINITIONS:
          ! na

          ! FUNCTION LOCAL VARIABLE DECLARATIONS:
  INTEGER :: WhichFan

  ! Obtains and Allocates fan related parameters from input file
  IF (GetFanInputFlag) THEN  !First time subroutine has been entered
    CALL GetFanInput
    GetFanInputFlag=.false.
  End If

  WhichFan=FindItemInList(FanName,Fan%FanName,NumFans)
  IF (WhichFan /= 0) THEN
    NodeNumber=Fan(WhichFan)%OutletNodeNum
  ENDIF

  IF (WhichFan == 0) THEN
    CALL ShowSevereError('Could not find FanType="'//TRIM(FanType)//'" with Name="'//TRIM(FanName)//'"')
    ErrorsFound=.true.
    NodeNumber=0
  ENDIF

  RETURN

END FUNCTION GetFanOutletNode

! End of Utility subroutines for the Fan Module
! *****************************************************************************

!     NOTICE
!
!     Copyright © 1996-xxxx The Board of Trustees of the University of Illinois
!     and The Regents of the University of California through Ernest Orlando Lawrence
!     Berkeley National Laboratory.  All rights reserved.
!
!     Portions of the EnergyPlus software package have been developed and copyrighted
!     by other individuals, companies and institutions.  These portions have been
!     incorporated into the EnergyPlus software package under license.   For a complete
!     list of contributors, see "Notice" located in EnergyPlus.f90.
!
!     NOTICE: The U.S. Government is granted for itself and others acting on its
!     behalf a paid-up, nonexclusive, irrevocable, worldwide license in this data to
!     reproduce, prepare derivative works, and perform publicly and display publicly.
!     Beginning five (5) years after permission to assert copyright is granted,
!     subject to two possible five year renewals, the U.S. Government is granted for
!     itself and others acting on its behalf a paid-up, non-exclusive, irrevocable
!     worldwide license in this data to reproduce, prepare derivative works,
!     distribute copies to the public, perform publicly and display publicly, and to
!     permit others to do so.
!
!     TRADEMARKS: EnergyPlus is a trademark of the US Department of Energy.
!

End Module Fans