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) | :: | J | |||
integer, | intent(in) | :: | LFLAG | |||
real(kind=r64), | intent(in) | :: | PDROP | |||
integer, | intent(in) | :: | I | |||
integer, | intent(in) | :: | N | |||
integer, | intent(in) | :: | M | |||
real(kind=r64), | intent(out) | :: | F(2) | |||
real(kind=r64), | intent(out) | :: | DF(2) | |||
integer, | intent(out) | :: | NF |
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 AFECFR(J,LFLAG,PDROP,I,N,M,F,DF,NF)
! SUBROUTINE INFORMATION:
! AUTHOR George Walton
! DATE WRITTEN Extracted from AIRNET
! MODIFIED Lixing Gu, 2/1/04
! Revised the subroutine to meet E+ needs
! MODIFIED Lixing Gu, 6/8/05
!
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine solves airflow for a constant flow rate airflow component -- using standard interface.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataLoopNode, ONLY: Node
USE DataAirLoop, ONLY: LoopSystemOnMassFlowrate,LoopSystemOffMassFlowrate,LoopFanOperationMode,LoopCompCycRatio
USE DataHVACGlobals, ONLY: FanType_SimpleOnOff, FanType_SimpleConstVolume, FanType_SimpleVAV
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: J ! Component number
INTEGER, INTENT(IN) :: LFLAG ! Initialization flag.If = 1, use laminar relationship
REAL(r64), INTENT(IN) :: PDROP ! Total pressure drop across a component (P1 - P2) [Pa]
INTEGER, INTENT(IN) :: I ! Linkage number
INTEGER, INTENT(IN) :: N ! Node 1 number
INTEGER, INTENT(IN) :: M ! Node 2 number
INTEGER, INTENT(OUT) :: NF ! Number of flows, either 1 or 2
REAL(r64), INTENT(OUT) :: F(2) ! Airflow through the component [kg/s]
REAL(r64), INTENT(OUT) :: DF(2) ! Partial derivative: DF/DP
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: CycFanCycComp = 1 ! fan cycles with compressor operation
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER CompNum, k,k1
REAL(r64) :: SumTermFlow ! Sum of all Terminal flows [kg/s]
REAL(r64) :: SumFracSuppLeak ! Sum of all supply leaks as a fraction of supply fan flow rate
Integer Node1, Node2
! FLOW:
CompNum = AirflowNetworkCompData(J)%TypeNum
NF = 1
If (DisSysCompCVFData(CompNum)%FanTypeNum .eq. FanType_SimpleOnOff) then
If (LoopFanOperationMode .EQ. CycFanCycComp .and. LoopSystemOnMassFlowrate .GT. 0.0d0) then
F(1) = LoopSystemOnMassFlowrate
else
F(1) = Node(DisSysCompCVFData(CompNum)%InletNode)%MassFlowrate*DisSysCompCVFData(CompNum)%Ctrl
If (MultiSpeedHPIndicator .EQ. 2) Then
F(1) = LoopSystemOnMassFlowrate*LoopCompCycRatio+LoopSystemOffMassFlowrate*(1.0d0-LoopCompCycRatio)
End If
End If
Else If (DisSysCompCVFData(CompNum)%FanTypeNum .eq. FanType_SimpleConstVolume) Then
If (DisSysCompCVFData(CompNum)%FlowRate > 0) Then
F(1) = DisSysCompCVFData(CompNum)%FlowRate*DisSysCompCVFData(CompNum)%Ctrl
Else
F(1) = Node(DisSysCompCVFData(CompNum)%InletNode)%MassFlowrate*DisSysCompCVFData(CompNum)%Ctrl
End If
If (MultiSpeedHPIndicator .EQ. 2) Then
F(1) = LoopSystemOnMassFlowrate
End If
Else If (DisSysCompCVFData(CompNum)%FanTypeNum .eq. FanType_SimpleVAV) Then
! Check VAV termals with a damper
SumTermFlow = 0.d0
SumFracSuppLeak = 0.d0
Do k=1,NetworkNumOfLinks
If (AirflowNetworkLinkageData(k)%VAVTermDamper) Then
k1 = AirflowNetworkNodeData(AirflowNetworkLinkageData(k)%NodeNums(1))%EPlusNodeNum
If (Node(k1)%MassFlowRate .GT. 0.0d0) Then
SumTermFlow = SumTermFlow + Node(k1)%MassFlowRate
End If
End If
If (AirflowNetworkCompData(AirflowNetworkLinkageData(k)%CompNum)%CompTypeNum == CompTypeNum_ELR) then
! Calculate supply leak sensible losses
Node1 = AirflowNetworkLinkageData(k)%NodeNums(1)
Node2 = AirflowNetworkLinkageData(k)%NodeNums(2)
if ((AirflowNetworkNodeData(Node2)%EPlusZoneNum > 0) .AND. (AirflowNetworkNodeData(Node1)%EPlusNodeNum == 0)) Then
SumFracSuppLeak = SumFracSuppLeak + &
DisSysCompELRData(AirflowNetworkCompData(AirflowNetworkLinkageData(k)%CompNum)%TypeNum)%ELR
End If
End If
End Do
F(1) = SumTermFlow/(1.d0-SumFracSuppLeak)
VAVTerminalRatio = 0.d0
If (F(1) .GT. DisSysCompCVFData(CompNum)%MaxAirMassFlowRate) Then
VAVTerminalRatio = DisSysCompCVFData(CompNum)%MaxAirMassFlowRate/F(1)
F(1) = DisSysCompCVFData(CompNum)%MaxAirMassFlowRate
End If
End If
DF(1) = 0.0d0
RETURN
END SUBROUTINE AFECFR