Optimisation avec Solveur d'un résultat calculé par une subroutine

**grimgort** · 17/03/2014, 11h16

Bonjour à tous,

Pour un projet de fin d'étude au sein de mon école d'ingénieur, j'ai besoin d'optimiser un système (machine à absorption).
J'utilise excel pour pouvoir utiliser son Solveur.

Pour pouvoir calculer certaines choses, j'utilise des procédures itératives dans VBA. Par exemple, dans mon condenseur, je découpe mon élément en tranche pour évaluer les coefficients d'échanges et puis j'en déduis une surface d'échange.
Donc ma surface d'échange est calculé par une subroutine.
Le problème que j'ai, c'est que je voudrai modifier un paramètre d'entrée de ma subroutine (débit de l'utilité) pour pouvoir optimiser cette surface d'échange, à travers le solveur.

En gros, ma fonction objectif n'est pas directement une formule car elle doit passer par un certain nombre de procédures itératives.
J'éspére que je suis relativement clair... Je donne mon code ci dessous dans l'espoir que vous comprenez mieux.

Ce que je veux, c'est modifier le paramètre mcd pour minimiser S_tot. j'utilise excel 2010. Good luck :p

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**grimgort** · 19/03/2014, 10h47

Re-bonjour,

Assez silencieux dans le coin :p

Sinon j'ai trouvé une solution à mon problème (+ou-).

Il faut spécifier d’exécuter la macro au changement de la valeur de la variable d'optimisation (mcd pour moi).
En utilisant le solveur avec l'algorithme d'optimisation génétique, il va recalculer le résultat (S_tot) à chacune de ses itérations.
Cependant, lorsque j'utilise d'autre algorithme d'optimisation, il me shut down excel. Je n'est pas encore eu le temps de tester cette méthode sur des système plus compliqué, mais il semble que sa marche...

Si vous avez d'autres solutions ou que vous souhaitez commenter n'hésitez pas :p

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Optimisation avec Solveur d'un résultat calculé par une subroutine

Macros et VBA Excel

Discussions similaires

Partager

Partager