smooth eigenvalues and eigenvectors as a function of frequency
- To: mathgroup at smc.vnet.net
- Subject: [mg60312] smooth eigenvalues and eigenvectors as a function of frequency
- From: "Antonio Carlos Siqueira" <acsl at dee.ufrj.br>
- Date: Sat, 10 Sep 2005 22:36:35 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
Dear MathGroup
I am posting this message hoping that someone may have a better idea
than me and point me in some direction to the solution. I have to fit a
complex based function using a state-space approach and thus smooth
eigenvectors and eigenfunctions are needed. Using Eigensystem I
experienced some eigenvector/eigenvalues switchovers (from one
frequency step to the next).
I was wondering whether some sort of MapIndexed or some Sort can do the
trick to switch the eigenvector back. I know that if I can track the
direction of the eigenvalue.eigenvector dot product I might probably
identify the switchover.
Below I show the code I am using and a graph as an example of the
switchover.
Any help/comment is more than welcome!
Thanks in advance
Regards
Antonio
Here comes the code
evalues = Table[0, {n, 1, nf}];
evectors= evects1;
xc={-9.5, -9.5, -9.5, 9.5, 9.5, 9.5};
yc={26., 38.7, 51.4, 26., 38.7, 51.4};
nc=Length[xc];
compr = 25*10^3;
rf = 0.0203454;
rhoc = 4.169134020401465*^-8;
rhosolo=100.0;
mu = (4.*Pi)/10^7;
epsilon = 8.854/10^12;
freqlog[i_, f_, n_] := Table[N[10^(i + (x*(f - i))/(Floor[n] - 1))],
{x, 0, n - 1}]
length = 25000;
npontos = 20;
d1 = 0; d2 = 6;
ndecadas = d2 - d1;
nfd = ndecadas*npontos;
f = freqlog[d1, d2, nfd];
nf = Length[f];
Do[{w = 2*Pi*f[[nm]],
p = Sqrt[rhosolo/(I*w*µ)],
etac = Sqrt[(I*w*µ)/rhoc],
Z = Table[If[i != j, ((I*w*mu)*
Log[Sqrt[(xc[[i]] - xc[[j]])^2 + (2*p + yc[[i]] + yc[[j]])^2]/
Sqrt[(xc[[i]] - xc[[j]])^2 + (yc[[i]] - yc[[j]])^2]])/(2*Pi),
((etac*rhoc)*BesselI[0, etac*rf])/((2*Pi*rf)*BesselI[1,
etac*rf]) +
((I*w*mu)*Log[(2*p + 2*yc[[i]])/rf])/(2*Pi)],
{i, 1, ncond}, {j, 1, ncond}],
P = Table[If[i != j,
Log[Sqrt[(xc[[i]] - xc[[j]])^2 + (yc[[i]] + yc[[j]])^2]/
Sqrt[(xc[[i]] - xc[[j]])^2 + (yc[[i]] - yc[[j]])^2]],
Log[(2.*yc[[i]])/rf]], {i, 1, ncond}, {j, 1, ncond}],
Y = I*w*2*Pi*epsilon*Inverse[P],
{ll, T} = Eigensystem[Z . Y],
{evalues[[nm]], evectors[[nm]]} =
Transpose[Sort[Transpose[{ll, T}]]]}, {nm, 1, nf}]]
DisplayTogether[
LogLinearListPlot[Transpose[{f, Re[evectors[[All,3,1]]]}]],
LogLinearListPlot[Transpose[{f, Re[evectors[[All,3,2]]]}]],
LogLinearListPlot[Transpose[{f, Re[evectors[[All,3,3]]]}]],
LogLinearListPlot[Transpose[{f, Re[evectors[[All,3,4]]]}]]