Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | JA | |||
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 AFEFAN(JA,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 detailed fan component -- using standard interface.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: JA ! 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:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! PRISE - pressure rise (negative of pressure drop) (Pa).
!
INTEGER J, K, L
REAL(r64) DPDF, PRISE, BX, BY, CX, CY, CCY, DX, DY, TOL
INTEGER CompNum, NumCur
REAL(r64) FlowCoef, FlowExpo
DATA TOL / 0.00001d0 /
! FLOW:
CompNum = AirflowNetworkCompData(JA)%TypeNum
NumCur = DisSysCompDetFanData(CompNum)%n
FlowCoef = DisSysCompDetFanData(CompNum)%FlowCoef
FlowExpo = DisSysCompDetFanData(CompNum)%FlowExpo
NF = 1
IF(AFECTL(I).LE.0.0d0) THEN
! Speed = 0; treat fan as resistance.
CALL GenericCrack(FlowCoef,FlowExpo,LFLAG,PDROP,N,M,F,DF,NF)
RETURN
END IF
! Pressure rise at reference fan speed.
IF(AFECTL(I).GE.DisSysCompDetFanData(CompNum)%TranRat) THEN
PRISE = -PDROP*(DisSysCompDetFanData(CompNum)%RhoAir/RHOZ(N))/AFECTL(I)**2
ELSE
PRISE = -PDROP*(DisSysCompDetFanData(CompNum)%RhoAir/RHOZ(N))/ &
(DisSysCompDetFanData(CompNum)%TranRat*AFECTL(I))
END IF
IF(LIST.GE.4) WRITE(Unit21,901) ' fan:',I,PDROP,PRISE,AFECTL(I),DisSysCompDetFanData(CompNum)%TranRat
IF(LFLAG.EQ.1) THEN
! Initialization by linear approximation.
F(1) = -DisSysCompDetFanData(CompNum)%Qfree*AFECTL(I)*(1.0d0-PRISE/DisSysCompDetFanData(CompNum)%Pshut)
DPDF = -DisSysCompDetFanData(CompNum)%Pshut/DisSysCompDetFanData(CompNum)%Qfree
IF(LIST.GE.4) WRITE(Unit21,901) ' fni:',JA,DisSysCompDetFanData(CompNum)%Qfree, &
DisSysCompDetFanData(CompNum)%Pshut
ELSE
! Solution of the fan performance curve.
! Determine curve fit range.
J = 1
K = 5*(J-1)+1
BX = DisSysCompDetFanData(CompNum)%Coeff(K)
BY = DisSysCompDetFanData(CompNum)%Coeff(K+1)+BX*(DisSysCompDetFanData(CompNum)%Coeff(K+2)+ &
BX*(DisSysCompDetFanData(CompNum)%Coeff(K+3)+BX*DisSysCompDetFanData(CompNum)%Coeff(K+4)))-PRISE
IF(BY.LT.0.0d0) CALL ShowFatalError('Out of range, too low in an AirflowNetwork detailed Fan')
DO
DX = DisSysCompDetFanData(CompNum)%Coeff(K+5)
DY = DisSysCompDetFanData(CompNum)%Coeff(K+1)+DX*(DisSysCompDetFanData(CompNum)%Coeff(K+2)+ &
DX*(DisSysCompDetFanData(CompNum)%Coeff(K+3)+DX*DisSysCompDetFanData(CompNum)%Coeff(K+5)))-PRISE
IF(LIST.GE.4) WRITE(Unit21,901) ' fp0:',J,BX,BY,DX,DY
IF(BY*DY.LE.0.0d0) EXIT
J = J+1
IF(J.GT.NumCur) &
CALL ShowFatalError('Out of range, too high (FAN) in ADS simulation')
K = K+5
BX = DX
BY = DY
END DO
! Determine reference mass flow rate by false position method.
L = 0
CY = 0.0d0
40 CONTINUE
L = L+1
IF(L.GT.100) CALL ShowFatalError('Too many iterations (FAN) in AirflowNtework simulation')
CCY = CY
CX = BX-BY*((DX-BX)/(DY-BY))
CY = DisSysCompDetFanData(CompNum)%Coeff(K+1)+CX*(DisSysCompDetFanData(CompNum)%Coeff(K+2)+ &
CX*(DisSysCompDetFanData(CompNum)%Coeff(K+3)+CX*DisSysCompDetFanData(CompNum)%Coeff(K+4)))-PRISE
IF(BY*CY .EQ. 0.0d0) GOTO 90
IF(BY*CY .GT. 0.0d0) GOTO 60
50 DX = CX
DY = CY
IF(CY*CCY.GT.0.0d0) BY = 0.5d0*BY
GO TO 70
60 BX = CX
BY = CY
IF(CY*CCY.GT.0.0d0) DY = 0.5d0*DY
70 CONTINUE
IF(LIST.GE.4) WRITE(Unit21,901) ' fpi:',J,BX,CX,DX,BY,DY
IF(DX-BX.LT.TOL*CX) GO TO 80
IF(DX-BX.LT.TOL) GO TO 80
GO TO 40
80 CX = 0.5d0*(BX+DX)
90 F(1) = CX
DPDF = DisSysCompDetFanData(CompNum)%Coeff(K+2)+CX*(2.0d0*DisSysCompDetFanData(CompNum)%Coeff(K+3)+ &
CX*3.0d0*DisSysCompDetFanData(CompNum)%Coeff(K+4))
END IF
! Convert to flow at given speed.
F(1) = F(1)*(RHOZ(N)/DisSysCompDetFanData(CompNum)%RhoAir)*AFECTL(I)
! Set derivative w/r pressure drop (-).
IF(AFECTL(I).GE.DisSysCompDetFanData(CompNum)%TranRat) THEN
DF(1) = -AFECTL(I)/DPDF
ELSE
DF(1) = -1.0d0/DPDF
END IF
901 FORMAT(A5,I3,5E14.6)
999 RETURN
END SUBROUTINE AFEFAN