Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(in) | :: | NTU | |||
real(kind=r64), | intent(in) | :: | Z | |||
integer, | intent(in) | :: | FlowArr | |||
real(kind=r64), | intent(out) | :: | Eps |
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 CalculateEpsFromNTUandZ(NTU, Z, FlowArr, Eps)
! SUBROUTINE INFORMATION:
! AUTHOR Michael Wetter
! DATE WRITTEN March 1999
! MODIFIED Fred Buhl November 2000
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates eps, the exchanger effectiveness,
! from NTU, the number of transfer units,
! from Z, the capacity rate ratio, and
! from the flow arrangement
! METHODOLOGY EMPLOYED:
! Uses the effectiveness - NTU heat exchanger formulas
! REFERENCES:
! M. Wetter, Simulation Model Air-to-Air Plate Heat Exchanger
! LBNL Report 42354, 1999.
! Also see:
! ASHRAE HVAC 2 Toolkit, pages 4-3 through 4-5
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64), INTENT(IN) :: NTU ! number of transfer units
REAL(r64), INTENT(IN) :: Z ! capacity rate ratio
INTEGER, INTENT(IN) :: FlowArr ! flow arrangement
! 1: COUNTER FLOW
! 2: PARALLEL FLOW
! 3: CROSS FLOW BOTH UNMIXED
! 4: CROSS FLOW, Cmax MIXED, Cmin UNMIXED
! (coil with one row)
REAL(r64), INTENT(OUT) :: Eps ! heat exchanger effectiveness
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: Temp ! temporary variable
! check input validity
IF (Z .LT. 0.0d0 .OR. Z.GT.1.0d0) THEN
CALL ShowFatalError('Variable Z ('//TRIM(RoundSigDigits(Z,2))//') out of range [0.0,1.0] in CalculateEpsFromNTUandZ')
END IF
! effectiveness
IF (NTU < SMALL) THEN
Eps = 0.0d0
ELSE IF (Z < SMALL) THEN ! Eps independent of flow arrangement
Eps = 1.d0 - exp(-NTU)
ELSE
SELECT CASE (FlowArr)
CASE (Counter_Flow) ! COUNTER FLOW
IF (ABS(Z - 1.0d0) < SMALL) THEN
Eps = NTU/(NTU+1.0d0)
ELSE
Temp = EXP(-NTU*(1.d0-Z))
Eps = (1.d0-Temp) / (1.d0-Z*Temp)
END IF
CASE (Parallel_Flow) ! PARALLEL FLOW
Temp = (1.d0+Z)
Eps = (1.d0 - EXP(-NTU*Temp)) / Temp
CASE (Cross_Flow_Both_Unmixed) ! CROSS FLOW BOTH UNMIXED
Temp = Z * NTU**(-0.22d0)
Eps = 1.d0 - EXP( ( EXP(-NTU*Temp) -1.0d0)/Temp )
CASE (Cross_Flow_Other) ! CROSS FLOW, Cmax MIXED, Cmin UNMIXED
Eps = (1.d0 - EXP(-Z * (1.d0-EXP(-NTU)) ) ) / Z
CASE DEFAULT
CALL ShowFatalError('HeatRecovery: Illegal flow arrangement in CalculateEpsFromNTUandZ, Value='// &
TRIM(RoundSigDigits(FlowArr)))
END SELECT
END IF
RETURN
END SUBROUTINE CalculateEpsFromNTUandZ