Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | FanNum | |||
logical, | intent(in) | :: | FirstHVACIteration |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE 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
USE DataZoneEquipment, ONLY: ZoneEquipInputsFilled,CheckZoneEquipmentList
USE InputProcessor, ONLY: SameString
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT (IN):: FirstHVACIteration !unused1208
Integer, Intent(IN) :: FanNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
Integer :: InletNode
Integer :: OutletNode
!unused0909 Integer :: InNode
Integer :: OutNode
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL,SAVE :: ZoneEquipmentListChecked = .false. ! True after the Zone Equipment List has been checked for items
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MySizeFlag
INTEGER :: Loop
! FLOW:
IF (MyOneTimeFlag) THEN
ALLOCATE(MyEnvrnFlag(NumFans))
ALLOCATE(MySizeFlag(NumFans))
MyEnvrnFlag = .TRUE.
MySizeFlag = .TRUE.
MyOneTimeFlag = .false.
END IF
! need to check all fans to see if they are on Zone Equipment List or issue warning
IF (.not. ZoneEquipmentListChecked .and. ZoneEquipInputsFilled) THEN
ZoneEquipmentListChecked=.true.
DO Loop=1,NumFans
IF (.NOT. SameString(Fan(Loop)%FanType , 'Fan:ZoneExhaust')) CYCLE
IF (CheckZoneEquipmentList(Fan(Loop)%FanType,Fan(Loop)%FanName)) CYCLE
CALL ShowSevereError('InitFans: Fan=['//TRIM(Fan(Loop)%FanType)//','//TRIM(Fan(Loop)%FanName)// &
'] is not on any ZoneHVAC:EquipmentList. It will not be simulated.')
ENDDO
ENDIF
IF ( .NOT. SysSizingCalc .AND. MySizeFlag(FanNum)) THEN
CALL SizeFan(FanNum)
! Set the loop cycling flag
IF (Fan(FanNum)%FanType_Num == FanType_SimpleOnOff) 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
!unused0909 InNode = Fan(FanNum)%InletNodeNum
OutNode = Fan(FanNum)%OutletNodeNum
Fan(FanNum)%RhoAirStdInit = StdRhoAir
!Change the Volume Flow Rates to Mass Flow Rates
Fan(FanNum)%MaxAirMassFlowRate = Fan(FanNum)%MaxAirFlowRate * Fan(FanNum)%RhoAirStdInit
If (Fan(FanNum)%FanMinAirFracMethod == MinFrac) Then
Fan(FanNum)%MinAirFlowRate = Fan(FanNum)%MaxAirFlowRate * Fan(FanNum)%FanMinFrac
Fan(FanNum)%MinAirMassFlowRate = Fan(FanNum)%MinAirFlowRate * Fan(FanNum)%RhoAirStdInit
ELSE IF (Fan(FanNum)%FanMinAirFracMethod == FixedMin) Then
Fan(FanNum)%MinAirFlowRate = Fan(FanNum)%FanFixedMin
Fan(FanNum)%MinAirMassFlowRate = Fan(FanNum)%MinAirFlowRate * Fan(FanNum)%RhoAirStdInit
END IF
IF (Fan(FanNum)%NVPerfNum > 0) THEN
NightVentPerf(Fan(FanNum)%NVPerfNum)%MaxAirMassFlowRate = NightVentPerf(Fan(FanNum)%NVPerfNum)%MaxAirFlowRate &
* Fan(FanNum)%RhoAirStdInit
END IF
!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.0d0
Fan(FanNum)%DeltaTemp = 0.0d0
Fan(FanNum)%FanEnergy = 0.0d0
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_Num /= FanType_ZoneExhaust ) 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
Fan(FanNum)%MassFlowRateMaxAvail = Fan(FanNum)%MaxAirMassFlowRate
Fan(FanNum)%MassFlowRateMinAvail = 0.0d0
IF (Fan(FanNum)%FlowFractSchedNum > 0) THEN ! modulate flow
Fan(FanNum)%InletAirMassFlowRate = Fan(FanNum)%MassFlowRateMaxAvail &
* GetCurrentScheduleValue(Fan(FanNum)%FlowFractSchedNum)
Fan(FanNum)%InletAirMassFlowRate = MAX(0.d0, Fan(FanNum)%InletAirMassFlowRate)
ELSE ! always run at max
Fan(FanNum)%InletAirMassFlowRate = Fan(FanNum)%MassFlowRateMaxAvail
ENDIF
IF (Fan(FanNum)%EMSMaxMassFlowOverrideOn) Fan(FanNum)%InletAirMassFlowRate = &
MIN(Fan(FanNum)%EMSAirMassFlowValue,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