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 AFEHOP(J,LFLAG,PDROP,I,N,M,F,DF,NF)
!
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN Apr. 2009
! MODIFIED na
! MODIFIED na
!
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine solves airflow for a horizontal opening component. The subroutine was
! developed based on the subroutine AFEPLR of AIRNET.
! METHODOLOGY EMPLOYED:
! Combine forced and buyancy airflows together with a cap
! REFERENCES:
! Cooper, L., 1989, "Calculation of the Flow Through a Horizontal Ceiling/Floor Vent,"
! NISTIR 89-4052, National Institute of Standards and Technology, Gaithersburg, MD
! USE STATEMENTS:
! na
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:
REAL(r64), PARAMETER :: PI = 3.14159265358979323846d0
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) RhozAver, expn, coef
INTEGER CompNum
REAL(r64) Width ! Opening width
REAL(r64) Height ! Opening height
REAL(r64) Fact ! Opening factor
REAL(r64) Slope ! Opening slope
REAL(r64) DischCoeff ! Discharge coefficient
REAL(r64) fma12 ! massflow in direction "from-to" [kg/s]
REAL(r64) fma21 ! massflow in direction "to-from" [kg/s]
REAL(r64) dp1fma12 ! derivative d fma12 / d Dp [kg/s/Pa]
REAL(r64) dp1fma21 ! derivative d fma21 / d Dp [kg/s/Pa]
REAL(r64) PurgedP ! Purge pressure [Pa]
REAL(r64) BuoFlow ! Buoyancy flow rate [Pa]
REAL(r64) BuoFlowMax ! Maximum buoyancy flow rate [Pa]
REAL(r64) dPBuoFlow ! Derivative of buoyancy flow rate [kg/s/Pa]
REAL(r64) DH ! Hydraulic diameter [m]
REAL(r64) Cshape ! Shape factor [dimensionless]
REAL(r64) OpenArea ! Opening area [m2]
! FLOW:
! Get information on the horizontal opening
CompNum = AirflowNetworkCompData(J)%TypeNum
RhozAver = (RHOZ(N)+RHOZ(M))/2.0d0
Width = MultizoneSurfaceData(I)%Width
Height = MultizoneSurfaceData(I)%Height
fact = MultizoneSurfaceData(I)%OpenFactor
expn = MultizoneCompHorOpeningData(CompNum)%FlowExpo
coef = MultizoneCompHorOpeningData(CompNum)%FlowCoef
slope = MultizoneCompHorOpeningData(CompNum)%slope
DischCoeff = MultizoneCompHorOpeningData(CompNum)%DischCoeff
Cshape = 0.942d0*Width/Height
OpenArea = Width*Height*fact*sin(slope*PI/180.0d0)*(1.0d0+cos(slope*PI/180.0d0))
DH = 4.0d0*(Width*Height)/2.0/(Width+Height)*fact
! Check which zone is higher
IF(fact .eq. 0.0d0) THEN
CALL GenericCrack(coef,expn,LFLAG,PDROP,N,M,F,DF,NF)
Return
end if
fma12 = 0.0d0
fma21 = 0.0d0
dp1fma12 = 0.0d0
dp1fma21 = 0.0d0
BuoFlow = 0.0d0
dPBuoFlow = 0.0d0
If (AirflowNetworkLinkageData(I)%NodeHeights(1) > AirflowNetworkLinkageData(I)%NodeHeights(2)) Then
! Node N is upper zone
If (RHOZ(N) > RHOZ(M)) Then
BuoFlowMax = RhozAver*0.055d0*SQRT(9.81*abs(RHOZ(N)-RHOZ(M))*DH**5/RhozAver)
PurgedP = Cshape*Cshape*9.81d0*ABS(RHOZ(N)-RHOZ(M))*DH**5/(2.0d0*(OpenArea)**2)
If (abs(PDROP) .LE. PurgedP) Then
BuoFlow = BuoFlowMax*(1.0d0-abs(PDROP)/PurgedP)
dPBuoFlow = BuoFlowMax/PurgedP
End If
End If
Else
! Node M is upper zone
If (RHOZ(N) < RHOZ(M)) Then
BuoFlowMax = RhozAver*0.055d0*SQRT(9.81d0*abs(RHOZ(N)-RHOZ(M))*DH**5/RhozAver)
PurgedP = Cshape*Cshape*9.81d0*ABS(RHOZ(N)-RHOZ(M))*DH**5/(2.0d0*(OpenArea)**2)
If (abs(PDROP) .LE. PurgedP) Then
BuoFlow = BuoFlowMax*(1.0d0-abs(PDROP)/PurgedP)
dPBuoFlow = BuoFlowMax/PurgedP
End If
End If
End If
IF(PDROP.EQ.0.0d0) THEN
fma12 = BuoFlow
fma21 = BuoFlow
dp1fma12 = 0.0d0
dp1fma21 = 0.0d0
ELSE IF (PDROP.GT.0.0d0) THEN
fma12 = RHOZ(N)*OpenArea*fact*DischCoeff*SQRT(2.0d0*PDROP/RhozAver)+BuoFlow
dp1fma12 = RHOZ(N)*OpenArea*DischCoeff/SQRT(2.0d0*PDROP*RhozAver)+dPBuoFlow
If (BuoFlow .gt. 0.0d0) Then
fma21 = BuoFlow
dp1fma21 = dPBuoFlow
End If
ELSE ! PDROP.LT.0.0
fma21 = RHOZ(M)*OpenArea*fact*DischCoeff*SQRT(2.0d0*ABS(PDROP)/RhozAver)+BuoFlow
dp1fma21 = -RHOZ(M)*OpenArea*DischCoeff/SQRT(2.0d0*ABS(PDROP)*RhozAver)+dPBuoFlow
If (BuoFlow .gt. 0.0d0) Then
fma12 = BuoFlow
dp1fma12 = dPBuoFlow
End If
END IF
F(1) = fma12-fma21
DF(1) = dp1fma12-dp1fma21
F(2) = 0.0d0
if (fma12 .NE. 0.0d0 .and. fma21 .NE. 0.0d0) then
F(2) = fma21
End if
DF(2) = 0.0d0
RETURN
END SUBROUTINE AFEHOP