Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(out) | :: | NTU | |||
integer, | intent(inout) | :: | Err | |||
real(kind=r64), | intent(in) | :: | Z | |||
integer, | intent(in) | :: | FlowArr | |||
real(kind=r64), | intent(in) | :: | 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 CalculateNTUfromEpsAndZ(NTU, Err, 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 NTU, the number of transfer units,
! based on eps, the exchanger effectiveness,
! 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) :: Eps ! heat exchanger effectiveness
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) :: NTU ! number of transfer units
INTEGER, INTENT(INOUT) :: Err ! error indicator
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
NTU = 0.0d0
! check input validity
IF (Z .LT. 0.0d0 .OR. Z.GT.1.0d0) THEN
Err = 1
RETURN
END IF
IF (FlowArr == Parallel_Flow) THEN
IF ( Eps<0.0d0 .OR. Eps>1.d0/(1.d0+Z) ) THEN
Err = 2
RETURN
END IF
ELSE IF (FlowArr == Cross_Flow_Other) THEN
IF ( Eps<0.0d0 .OR. Eps>(1.d0-EXP(-Z))/Z ) THEN
Err = 3
RETURN
END IF
! check product (Eps*Z)
IF (Eps*Z < 0.0d0 .OR. Eps*Z > 1.d0-EXP(Z*(SMALL-1.d0)) ) THEN
Err = 4
RETURN
END IF
! check product (Eps*Z)
ELSE
IF ( Eps<0.0d0 .OR. Eps>1.0d0 ) THEN
Err = 5
RETURN
END IF
END IF
IF (Eps < SMALL) THEN ! no effectiveness. Set NTU = 0
NTU = 0.0d0
ELSE IF (Z < SMALL) THEN ! Eps independent of flow arrangement
NTU = - LOG(1.d0-Eps)
ELSE
! calculate based on configuration
SELECT CASE (FlowArr)
CASE (Counter_Flow) ! COUNTER FLOW
IF (ABS(Z - 1.0d0) < SMALL) THEN
NTU = Eps / (1.d0 - Eps)
ELSE
NTU = 1.d0 / (Z-1.d0) * LOG( (1.d0-Eps)/(1.d0-Eps*Z) )
END IF
CASE (Parallel_Flow) ! PARALLEL FLOW
NTU = - LOG( -Eps - Eps * Z + 1.d0) / (Z+1.d0)
CASE (Cross_Flow_Both_Unmixed) ! CROSS FLOW BOTH UNMIXED
NTU = GetNTUforCrossFlowBothUnmixed(Eps, Z)
CASE (Cross_Flow_Other) ! CROSS FLOW, Cmax MIXED, Cmin UNMIXED
NTU = -LOG(1.d0 + LOG(1.d0-eps*Z)/Z )
CASE DEFAULT
CALL ShowFatalError('HeatRecovery: Illegal flow arrangement in CalculateNTUfromEpsAndZ, Value='// &
TRIM(RoundSigDigits(FlowArr)))
END SELECT
END IF
RETURN
END SUBROUTINE CalculateNTUfromEpsAndZ