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) | :: | DirectAirNum | |||
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 InitDirectAir(DirectAirNum,FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Richard J. Liesen
! DATE WRITTEN January 2001
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the Direct Air Components.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger events.
! REFERENCES:
! na
! USE STATEMENTS:
Use DataEnvironment, ONLY: StdBAROPRESS
Use Psychrometrics, ONLY:PsyRhoAirFnPbTdbW
USE DataAirflowNetwork, ONLY: SimulateAirflowNetwork,AirflowNetworkFanActivated,AirflowNetworkControlMultizone
USE DataZoneEquipment, ONLY: ZoneEquipInputsFilled,CheckZoneEquipmentList
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT (IN):: FirstHVACIteration
INTEGER, INTENT(IN) :: DirectAirNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
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 :: ZoneNode
Integer :: Loop
! FLOW:
! Do the Begin Simulation initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyEnvrnFlag(NumDirectAir))
ALLOCATE(MySizeFlag(NumDirectAir))
MyEnvrnFlag = .TRUE.
MySizeFlag = .TRUE.
MyOneTimeFlag = .false.
END IF
! need to check all direct air units to see if they are on Zone Equipment List or issue warning
IF (.not. ZoneEquipmentListChecked .and. ZoneEquipInputsFilled) THEN
ZoneEquipmentListChecked=.true.
DO Loop=1,NumDirectAir
IF (CheckZoneEquipmentList(DirectAir(DirectAirNum)%cObjectName,DirectAir(Loop)%EquipID)) CYCLE
CALL ShowWarningError('InitDirectAir: ['//TRIM(DirectAir(DirectAirNum)%cObjectName)//' = '//TRIM(DirectAir(Loop)%EquipID)// &
'] is not on any ZoneHVAC:EquipmentList. It will not be simulated.')
ENDDO
ENDIF
IF ( .NOT. SysSizingCalc .AND. MySizeFlag(DirectAirNum) ) THEN
CALL SizeDirectAir(DirectAirNum)
MySizeFlag(DirectAirNum) = .FALSE.
END IF
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .and. MyEnvrnFlag(DirectAirNum)) THEN
! Calculate the Max Mass flow rate using the air density at Standard Conditions
DirectAir(DirectAirNum)%AirMassFlowRateMax = DirectAir(DirectAirNum)%MaxAirVolFlowRate * StdRhoAir
Node(DirectAir(DirectAirNum)%ZoneSupplyAirNode)%MassFlowRateMax = &
DirectAir(DirectAirNum)%AirMassFlowRateMax
Node(DirectAir(DirectAirNum)%ZoneSupplyAirNode)%MassFlowRateMin = 0.0d0
MyEnvrnFlag(DirectAirNum) = .FALSE.
END IF
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(DirectAirNum) = .true.
ENDIF
! Set the ZoneNode number
ZoneNode = DirectAir(DirectAirNum)%ZoneSupplyAirNode
IF (FirstHVACIteration) THEN
!The first time through set the mass flow rate to the Max
IF ((Node(ZoneNode)%MassFlowRateMaxAvail > 0.0d0) .AND. &
(GetCurrentScheduleValue(DirectAir(DirectAirNum)%SchedPtr) .gt. 0.0d0)) THEN
IF (.NOT. (SimulateAirflowNetwork .GT. AirflowNetworkControlMultizone .AND. AirflowNetworkFanActivated)) THEN
Node(ZoneNode)%MassFlowRate = DirectAir(DirectAirNum)%AirMassFlowRateMax
Node(ZoneNode)%MassFlowRateMaxAvail = DirectAir(DirectAirNum)%AirMassFlowRateMax
IF (DirectAir(DirectAirNum)%EMSOverrideAirFlow) &
Node(ZoneNode)%MassFlowRate = DirectAir(DirectAirNum)%EMSMassFlowRateValue
ENDIF
Node(ZoneNode)%MassFlowRateMinAvail = 0.0d0
ELSE
Node(ZoneNode)%MassFlowRate = 0.0d0
Node(ZoneNode)%MassFlowRateMaxAvail = 0.0d0
END IF
ELSE
!When not FirstHCAVIteration
IF (.NOT. DirectAir(DirectAirNum)%EMSOverrideAirFlow) THEN
IF ((Node(ZoneNode)%MassFlowRateMaxAvail > 0.0d0) .AND. &
(GetCurrentScheduleValue(DirectAir(DirectAirNum)%SchedPtr) > 0.0d0)) THEN
IF (Node(ZoneNode)%MassFlowRateMaxAvail < Node(ZoneNode)%MassFlowRateMax) THEN
Node(ZoneNode)%MassFlowRate = Node(ZoneNode)%MassFlowRateMaxAvail
ELSE IF (Node(ZoneNode)%MassFlowRateMinAvail > Node(ZoneNode)%MassFlowRateMin) THEN
Node(ZoneNode)%MassFlowRate = Node(ZoneNode)%MassFlowRateMinAvail
ELSE
Node(ZoneNode)%MassFlowRate = Node(ZoneNode)%MassFlowRateMaxAvail
END IF
ELSE
Node(ZoneNode)%MassFlowRate = 0.0d0
Node(ZoneNode)%MassFlowRateMaxAvail = 0.0d0
END IF
ELSE ! EMS override on
Node(ZoneNode)%MassFlowRate = DirectAir(DirectAirNum)%EMSMassFlowRateValue
! but also apply constraints
Node(ZoneNode)%MassFlowRate = MIN(Node(ZoneNode)%MassFlowRate , Node(ZoneNode)%MassFlowRateMaxAvail)
Node(ZoneNode)%MassFlowRate = MIN(Node(ZoneNode)%MassFlowRate , Node(ZoneNode)%MassFlowRateMax)
Node(ZoneNode)%MassFlowRate = MAX(Node(ZoneNode)%MassFlowRate , Node(ZoneNode)%MassFlowRateMinAvail)
Node(ZoneNode)%MassFlowRate = MAX(Node(ZoneNode)%MassFlowRate , Node(ZoneNode)%MassFlowRateMin)
ENDIF
END IF
!Set reporting varialbes to zero for the Direct Air Output
DirectAir(DirectAirNum)%HeatRate = 0.0d0
DirectAir(DirectAirNum)%CoolRate = 0.0d0
DirectAir(DirectAirNum)%HeatEnergy = 0.0d0
DirectAir(DirectAirNum)%CoolEnergy = 0.0d0
RETURN
END SUBROUTINE InitDirectAir