Nonlinearregress with symbolic partial differential equation and integration
- To: mathgroup at smc.vnet.net
- Subject: [mg121447] Nonlinearregress with symbolic partial differential equation and integration
- From: Jiwan Kim <hwoarang.kim at gmail.com>
- Date: Thu, 15 Sep 2011 04:41:08 -0400 (EDT)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
Bonjour~ mathgroup.
I ask you help for the mathematica code.
I have a experimental data and want to fit it using model equations.
To explain briefly....
First, I have used NDSolve to get the Te[z,t] and Tl[z,t], which includes
unknown parameters Cl, g, and K (that have to be determined by fitting.)
Second, from Tl[z,t], I have to get Eta (that is function of Cl, g, K, z,
and t) using a symbolic integration.
Third, I have to integrate Eta to get a response function,
modelReflAcousNorm which includes unknown parameters A1, Cl, g, and K.
Then, finally, I want to fit the experimental data with the summation
function of modelTe(Ampl*Te[z,t]) and modelReflAcousNorm, and I want to get
the unknown parameters.
This is the story. But, I think that it can be too much complex because
symbolic differential equations, symbolic integrations are not easy to
handle for me.. -_-a
I couldn't proceed further.. -_-a
Could you help me.. ?
Thank you in advance.
The code is following...
Remove["Global`*"];
<< Statistics`NonlinearFit`
$RecursionLimit = \[Infinity];
\[Rho] = 8910;(* mass density : kg/m^3 *)
v = 4.08;(* sound velocity : nm/ps *)
\[Beta] = 1.3 10^-5;(* linear expansion : /K *)
B = 1.8 10^11; (* bulk modulus : Pa *)
c = 3 10^5; (* light speed : nm/ps *)
\[Lambda] = 800; \[Omega] =
2 \[Pi] c/\[Lambda]; (* light wavelength : nm *)
\[Gamma] =
1.065 10^3; (* electron heat cap. at 300 K : 3.19 10^5 J/m^3K *)
\[Xi]1 = 13.5; (* pump absorption depth: nm *)
n = 2.48; k = 4.38 ;(* reflectivity index at 800 nm *)
R = 0.4; (* reflection at interface *)
I0 = 1.05 10^10; (* 2.77 10^13 J/m^2.pulse(ps) -> 2.77 10^22 *)
PulseWidth = 0.2 ; (* 200 fs *)
S[t_] := I0 Exp[-t^2/(PulseWidth)^2];
pow[z_, t_] := 1/\[Xi]1 S[t] Exp[-z/\[Xi]1]; (* W/m^3 *)
L = 700; (* sample thickness : nm *)
Ampl = 3 10^-3; (* 10^3 times, proportion factor to thermal \
reflectivity *)
ReflNormdat =
{{-2, 0}, {-1.9, 0}, {-1.8, 0}, {-1.7, 0}, {-1.6, 0}, {-1.5,
0}, {-1.4, 0}, {-1.3, 0}, {-1.2, 0}, {-1.1, 0}, {-1, 0}, {-0.9,
0}, {-0.8, 0}, {-0.7, 0}, {-0.6, 0}, {-0.5, 0}, {-0.4, 0}, {-0.3,
0}, {-0.2, 0}, {-0.1, 0}, {0,
0}, {0.1, -0.108798}, {0.2, -0.341512}, {0.3, -0.936046}, {0.4, \
-1.03407}, {0.5, -0.327209}, {0.6, 0.255078}, {0.7, 0.511085}, {0.8,
0.527326}, {0.9, 0.494031}, {1, 0.43624}, {1.1, 0.398295}, {1.2,
0.384961}, {1.3, 0.42593}, {1.4, 0.436008}, {1.5, 0.501163}, {1.6,
0.571124}, {1.7, 0.608992}, {1.8, 0.687403}, {1.9, 0.738411}, {2,
0.807558}, {2.1, 0.860853}, {2.2, 0.903682}, {2.3, 0.943295}, {2.4,
0.980969}, {2.5, 1.05578}, {2.6, 1.08047}, {2.7, 1.1088}, {2.8,
1.17833}, {2.9, 1.19934}, {3, 1.26264}, {3.1, 1.28182}, {3.2,
1.32671}, {3.3, 1.35814}, {3.4, 1.38911}, {3.5, 1.44372}, {3.6,
1.46043}, {3.7, 1.48857}, {3.8, 1.50333}, {3.9, 1.53698}, {4,
1.56426}, {4.1, 1.5945}, {4.2, 1.61407}, {4.3, 1.60399}, {4.4,
1.59364}, {4.5, 1.63054}, {4.6, 1.65798}, {4.7, 1.68922}, {4.8,
1.69225}, {4.9, 1.6962}, {5, 1.73081}, {5.1, 1.74109}, {5.2,
1.73899}, {5.3, 1.74016}, {5.4, 1.75593}, {5.5, 1.76128}, {5.6,
1.77302}, {5.7, 1.79349}, {5.8, 1.8086}, {5.9, 1.80481}, {6,
1.81205}, {6.1, 1.80837}, {6.2, 1.81651}, {6.3, 1.83837}, {6.4,
1.84062}, {6.5, 1.83802}, {6.6, 1.82853}, {6.7, 1.81798}, {6.8,
1.83864}, {6.9, 1.84709}, {7, 1.83012}, {7.1, 1.8469}, {7.2,
1.82516}, {7.3, 1.83829}, {7.4, 1.83205}, {7.5, 1.82849}, {7.6,
1.82729}, {7.7, 1.83674}, {7.8, 1.82752}, {7.9, 1.81388}, {8,
1.83535}, {8.1, 1.84314}, {8.2, 1.83802}, {8.3, 1.83244}, {8.4,
1.8314}, {8.5, 1.82667}, {8.6, 1.81632}, {8.7, 1.81531}, {8.8,
1.77903}, {8.9, 1.7974}, {9, 1.81202}, {9.1, 1.78426}, {9.2,
1.7786}, {9.3, 1.77566}, {9.4, 1.76469}, {9.5, 1.77322}, {9.6,
1.77333}, {9.7, 1.77702}, {9.8, 1.78264}, {9.9, 1.78217}, {10,
1.77667}, {10.1, 1.77128}, {10.2, 1.75841}, {10.3, 1.77329}, {10.4,
1.76802}, {10.5, 1.75469}, {10.6, 1.75981}, {10.7, 1.73907}, {10.8,
1.7276}, {10.9, 1.73934}, {11, 1.72233}, {11.1, 1.70488}, {11.2,
1.70314}, {11.3, 1.70655}, {11.4, 1.70093}, {11.5, 1.71523}, {11.6,
1.69519}, {11.7, 1.70159}, {11.8, 1.71105}, {11.9, 1.71601}, {12,
1.70767}, {12.1, 1.69279}, {12.2, 1.67992}, {12.3, 1.69519}, {12.4,
1.67795}, {12.5, 1.67376}, {12.6, 1.67957}, {12.7, 1.66182}, {12.8,
1.66062}, {12.9, 1.66593}, {13, 1.66574}, {13.1, 1.64167}, {13.2,
1.64066}, {13.3, 1.62748}, {13.4, 1.63601}, {13.5, 1.63306}, {13.6,
1.63233}, {13.7, 1.6445}, {13.8, 1.6486}, {13.9, 1.63337}, {14,
1.63566}, {14.1, 1.6376}, {14.2, 1.62016}, {14.3, 1.63748}, {14.4,
1.63159}, {14.5, 1.63318}, {14.6, 1.63403}, {14.7, 1.62868}, {14.8,
1.62434}, {14.9, 1.62306}, {15, 1.62798}, {15.1, 1.63186}, {15.2,
1.63988}, {15.3, 1.63105}, {15.4, 1.63826}, {15.5, 1.62717}, {15.6,
1.61857}, {15.7, 1.61899}, {15.8, 1.63395}, {15.9, 1.62349}, {16,
1.62411}, {16.1, 1.62469}, {16.2, 1.61081}, {16.3, 1.61496}, {16.4,
1.62078}, {16.5, 1.61205}, {16.6, 1.61767}, {16.7, 1.60519}, {16.8,
1.61953}, {16.9, 1.62876}, {17, 1.62419}, {17.1, 1.60446}, {17.2,
1.61729}, {17.3, 1.62217}, {17.4, 1.61705}, {17.5, 1.60783}, {17.6,
1.60605}, {17.7, 1.62008}, {17.8, 1.62601}, {17.9, 1.63903}, {18,
1.61345}};
modelTe[Cl_?NumericQ, g_?NumericQ, K_?NumericQ, z_?NumericQ,
t_?NumericQ] := Ampl Te[z, t] /.
NDSolve[{\[Gamma] Te[z, t] D[Te[z, t], t] ==
K D[Te[z, t], z, z] - g (Te[z, t] - Tl[z, t]) + pow[z, t],
Cl D[Tl[z, t], t] == g (Te[z, t] - Tl[z, t]),
Te[z, -2] == Tl[z, -2] == 300,
Te[L, t] == Tl[L, t] == 300, (D[Te[z, t], z] /. z -> L) ==
0, (D[Te[z, t], z] /. z -> 0) == 0}, {Te, Tl}, {z, 0,
L}, {t, -2, 18}, MaxSteps -> Infinity,
MaxStepSize -> {1, 0.1}][[1]]
modelTl[Cl_?NumericQ, g_?NumericQ, K_?NumericQ, z_?NumericQ,
t_?NumericQ] := Tl[z, t] /.
NDSolve[{\[Gamma] Te[z, t] D[Te[z, t], t] ==
K D[Te[z, t], z, z] - g (Te[z, t] - Tl[z, t]) + pow[z, t],
Cl D[Tl[z, t], t] == g (Te[z, t] - Tl[z, t]),
Te[z, -2] == Tl[z, -2] == 300,
Te[L, t] == Tl[L, t] == 300, (D[Te[z, t], z] /. z -> L) ==
0, (D[Te[z, t], z] /. z -> 0) == 0}, {Te, Tl}, {z, 0,
L}, {t, -2, 18}, MaxSteps -> Infinity,
MaxStepSize -> {1, 0.1}][[1]]
dTl[Cl_, g_, K_, zz_, t1_,
t2_] = (D[modelTl[Cl, g, K, z, t],
t] /. {z -> Abs[zz - v (t1 - t2)], t -> t2});
\[Eta][Cl_, g_, K_, z_,
t_] = -((3 B \[Beta])/(2 \[Rho] v^2)) 10^-3 NIntegrate[
Sign[zz - v (t1 - t2)] dTl[Cl, g, K, zz, t1, t2] /. {zz -> z,
t1 -> t}, {t2, -70, 70}, AccuracyGoal -> 4,
Exclusions -> {t2 == 0}, PrecisionGoal -> 4, MaxRecursion -> 20,
Method -> {"SymbolicPreprocessing",
"InterpolationPointsSubdivision" -> False}];
modelReflAcousNorm[A1_?NumericQ, Cl_?NumericQ, g_?NumericQ,
K_?NumericQ,
t_?NumericQ] := -2 Re[(
8 \[Pi] (n + I k))/(\[Lambda] (1 - (n + I k)^2)) (I -
0.9 ) A1 NIntegrate[\[Eta][Cl, g, K, z, t] Exp[
4 \[Pi] I (n + I k)/\[Lambda] z], {z, 0, 50},
Method -> {"SymbolicPreprocessing",
"InterpolationPointsSubdivision" -> False}]]
NonlinearRegress[ReflNormdat,
modelTe[Cl, g, K, t] +
modelReflAcousNorm[A1, Cl, g, K, t], t, {{A1, 1}, {Cl, 3 10^-6}, {g,
10^5}, {K, 10^6}}, ShowProgress -> True]
------------------------------------------------------------------------------
Institute of Physics and Chemistry of Materials Strasbourg (IPCMS)
Department of Ultrafast Optics and Nanophotonics (DON)
23 rue du Loess, B.P. 43,
67034 STRASBOURG Cedex 2, France