1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
'Dans le code de la feuille
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("G7")) Is Nothing Then
'********* Appel de la Macro *****************
Call cond
End If
End Sub
'Dans le code module
Option Explicit
Sub cond()
Dim nb_maille As Integer, dt As Double, Tscd As Double, Tescd As Double, g As Double, rhol As Double, rhov As Double, hvap As Double, kl As Double, mul As Double, Tsat As Double, N As Integer, D As Double
Dim i As Integer, mcd As Double, Cpcd As Double, rho_eau As Double, d_i As Double, Re_eau As Double, vitesse As Double, mu_eau As Double, Pr_eau As Double, Cp_eau As Double, lambda_eau As Double, q_eau As Double, d_e As Double, S_tot As Double
Dim lambda_tube As Double, Tecd As Double, phi_cd, mf, h2, h3
Dim Tp() As Double
Dim htube() As Double
Dim DTLM() As Double
Dim Tmaille() As Double
Dim Phi() As Double
Dim U() As Double
Dim S() As Double
'Constante
nb_maille = 50
h3 = 1300
h2 = 1400
mf = 1
Tscd = 320
Tecd = 293
'mcd = 1
mcd = CDbl(Range("G7").Value)
Tsat = 325
g = 9.8
rhol = 669
rhov = 1.3
hvap = 1388
kl = 0.59
mul = 0.00022
N = 15
d_e = 0.02
d_i = 0.015
rho_eau = 1000
Cp_eau = 4.18
mu_eau = 0.0023
lambda_eau = 0.54
lambda_tube = 0.05
'Calcul du flux échangé
phi_cd = -mf * (h3 - h2)
'Calcule de la température de sortie de l'utilité du condenseur
'Tscd = phi_cd / mcd / Cp_eau + Tecd
'Découpage des températures'
dt = (Tscd - Tecd) / nb_maille
'Calcul du coeficient d'échange à l'extérieur des tubes pour chaque maille'
'calcul de la température de paroie
ReDim Tp(nb_maille)
For i = 0 To nb_maille - 1
Tp(i + 1) = (Tecd + dt / 2 + i * dt + Tsat) / 2
Next
ReDim htube(nb_maille)
For i = 1 To nb_maille
htube(i) = 0.729 * (g * rhol * (rhol - rhov) * hvap * kl ^ 3 / (mul * (Tsat - Tp(i)) * N * d_e)) ^ (1 / 4)
htube(i) = htube(i) / 1000
Next
'calcul de la surface pour chaque maille
ReDim Tmaille(nb_maille + 1)
For i = 0 To nb_maille
Tmaille(i) = Tecd + i * dt
Next
ReDim DTLM(nb_maille)
For i = 1 To nb_maille
DTLM(i) = ((Tsat - Tmaille(i - 1)) - (Tsat - Tmaille(i))) / WorksheetFunction.Ln((Tsat - Tmaille(i - 1)) / (Tsat - Tmaille(i)))
Next
ReDim Phi(nb_maille)
For i = 1 To nb_maille
Phi(i) = mcd * Cp_eau * (Tmaille(i) - Tmaille(i - 1))
Next
vitesse = mcd / rho_eau / (3.14 * d_i ^ 2 / 4)
'*************************************
'Calcul du coef de convection coté eau
'*************************************
Re_eau = rho_eau * vitesse * d_i / mu_eau
Pr_eau = mu_eau * Cp_eau * 1000 / lambda_eau
q_eau = 0.023 * Re_eau ^ 0.8 * Pr_eau ^ 0.4 * lambda_eau / d_i
q_eau = q_eau / 1000
'Coeficient d'échange moyen
'**************************
ReDim U(nb_maille)
For i = 1 To nb_maille
U(i) = (1 / htube(i) + d_e / d_i / q_eau + d_e / 2 / lambda_tube * WorksheetFunction.Ln(d_e / d_i)) ^ (-1)
Next
ReDim S_maille(nb_maille)
For i = 1 To nb_maille
S_maille(i) = Phi(i) / U(i) / DTLM(i)
Next
S_tot = 0
For i = 1 To nb_maille
S_tot = S_tot + S_maille(i)
Next
Debug.Print S_tot, htube(1), q_eau, mcd
Range("A1").Value = S_tot
End Sub
Sub solveur()
'test solveur
'SolverReset
'SolverOptions precision:=0.001
Solverok SetCell:=Range("A1"), MaxMinVal:=1, ByChange:=Range("G7"), Engine:=3
solveradd cellref:=Range("G7"), Relation:=1, FormulaText:=5
solveradd cellref:=Range("G7"), Relation:=3, FormulaText:=0.1
SolverSolve UserFinish:=False, ShowRef:="ShowTrial"
SolverSave SaveArea:=Range("A20")
SolverFinish KeepFinal:=1, ReportArray:=Array(1)
End Sub
Function ShowTrial(Reason As Integer)
MsgBox Reason
ShowTrial = 0
End Function |
