Help with FindMinimum
- To: mathgroup at smc.vnet.net
- Subject: [mg100578] Help with FindMinimum
- From: "versianeleao at gmail.com" <versianeleao at gmail.com>
- Date: Mon, 8 Jun 2009 03:05:04 -0400 (EDT)
Dear Coleagues
I'm trying to write a code to solve an heterogeneous kinetics problem
where the effective mass transferr coefficient (Deff), the reaction
order (n) and the reaction rate (kRQ) ares simultaneously solved. In
doing that an non linear equation should be solved inside a
FindMinimum rotine where the values of "Deff", "kRQ" and "n" are
fitted to the experimental data. The problem code is presented below
but it is not working. Does anyone konw how to sort it out?
R0 = Sqrt[45*37]/2.0*10^-6
\[Rho] = 2.500 (* Kg/m^3 *)
ConNaOH = 6000. (* moles/m^3 *)
extra=E7=E3o =
ReadList["silicato NaOH-80oC.txt", Number, RecordLists -> True];
pontos = ListPlot[extra=E7=E3o, PlotStyle -> PointSize[0.012]]
X[t_] = k1*t^2 + k2 *t + k3
ajuste1 = \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(Length[extra=E7=E3o]\)]
\*SuperscriptBox[\((X[extra=E7=E3o[[i, 1]]] -
extra=E7=E3o[[i, 2]])\), \(2\)]\);
d1 = FindMinimum[ajuste1, {k1, k2, k3}]
{minimo1, argumento1} = d1
argumento1
XE = X[t] /. argumento1
extra=E7=E3o1 = extra=E7=E3o
deriv = D[XE, t]
For[j = 1, j <= Length[extra=E7=E3o], j++,
extra=E7=E3o1[[j, 2]] = XE /. t -> extra=E7=E3o[[j, 1]]]
modelo1 =
ListPlot[extra=E7=E3o1, PlotStyle -> PointSize[0.015], Joined -> True]
Show[pontos, modelo1]
F = Fa = extra=E7=E3o;
For[j = 1, j <= Length[extra=E7=E3o], j++,
Fa[[j, 2]] = -4/3*\[Pi]*R0^3*\[Rho]*deriv /. t -> extra=E7=E3o[[j, 1]] ]
Print[Fa]
alfa = Table[0, {i, 1, Length[extra=E7=E3o]}]
\[Alpha]1 =
Table[(1 - extra=E7=E3o[[i, 2]])^(2/3), {i, 1, Length[extra=E7=E3o]}]
\[Alpha]2 =
Table[(1 - extra=E7=E3o[[i, 2]])^(1/3), {i, 1, Length[extra=E7=E3o]}]
dados = Table[Fa[[i, 2]], {i, 1, Length[extra=E7=E3o]}]
\[Sigma] =
Table[FindRoot[\[Theta]/(
4 \[Pi]*kRQ*\[Alpha]1[[i]]) + (ConNaOH + \[Theta]/(4\[Pi]*Deff*\
[Alpha]1[[i]]))^n == 0, {\[Theta], 1}], {i, 1, Length[extra=E7=E3o]}]
Print[\[Sigma]]
alfa = \[Theta] /. \[Sigma]
ajuste2 = \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(Length[extra=E7=E3o]\)]
\*SuperscriptBox[\((alfa[[i]] - dados[[i]])\), \(2\)]\);
d2 = FindMinimum[ajuste2, {kRQ, 10, 20}, {Deff, 1*10^-9, 1}, {n, 1.,
2}]