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
|
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
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
Tscd = 320
Tecd = 293
'mcd = 3
Tsat = 330
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
mcd = Range("A3").Value
'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, U(1)
Range("A1").Value = S_tot
Range("A2").Value = 5#
'test solveur
'SolverReset
'SolverOptions precision:=0.001
Solverok SetCell:=Range("A1"), MaxMinVal:=2, ByChange:=Range("A3"), Engine:=2
SolverAdd CellRef:=Range("A3"), Relation:=1, FormulaText:=5
SolverSolve UserFinish:=False, ShowRef:="ShowTrial"
SolverSave SaveArea:=Range("B5")
SolverFinish KeepFinal:=1, ReportArray:=Array(1)
End Sub
Function ShowTrial(Reason As Integer)
MsgBox Reason
ShowTrial = 0
End Function |
Partager