ER/FR Calculations

SetDirectory["/Users/zachscofield/OneDrive - Wake Forest University/Research/TwoPoint"]

NOTE : I am using a data file for these computations which I will share . The directory will have to be changed to wherever you downloaded the file

<<"chifunctions5.m";

Variables

ClearAll;

xb = 1/10;

x0=(101*xb)/100

m=1;

t=0;

xc = ((-xb)/2)+Sqrt[1-(3*xb^2)/4];

f = -(1/x)*(x-xc)*(x-xb)*(x+xc+xb);

fp = D[f,x];

κb=(1/(2*xb))*(xc-xb)*(xc+(2*xb))

κc=(1/(2*xc))*(xc-xb)*((2*xc)+xb)

κN=(1/(2(xc+xb)))*((2*xc)+xb)*(xc+(2*xb))

xstar = (1/(2*κb))*Log[(x-xb)/(xc-xb)]-(1/(2*κc))*Log[-(x-xc)/(xc-xb)]+(1/(2*κN))*Log[(x+xc+xb)/(xc+(2*xb))]-(xc/(4*xb*κb))*Log[((2*xc)+xb)/(xc+(2*xb))]-(xb*xc)/(2*(xc-xb))*Log[(xb/xc)];

x1a=(((10^9)-1)*xc)/(10^9)

x1b=(9999*xc)/10000

Band 1

Length[chiR1]

ax = (11/10)*x0;

bx = (108/100)*x0;

cx = (106/100)*x0;

dx = (104/100)*x0;

ex = (102/100)*x0;

fx = (101/100)*x0;

gx = (1005/1000)*x0;

hx = (1003/1000)*x0;

ix = (1001/1000)*x0;

α1 = Table[{chi[ax]/.chiR1[[i]]},{i,1,991,1}];

β1 = Table[{chi'[ax]/.chiR1[[i]]},{i,1,991,1}];

α2 = Table[{chi[bx]/.chiR1[[i]]},{i,1,991,1}];

β2 = Table[{chi'[bx]/.chiR1[[i]]},{i,1,991,1}];

α3 = Table[{chi[cx]/.chiR1[[i]]},{i,1,991,1}];

β3 = Table[{chi'[cx]/.chiR1[[i]]},{i,1,991,1}];

α4 = Table[{chi[dx]/.chiR1[[i]]},{i,1,991,1}];

β4 = Table[{chi'[dx]/.chiR1[[i]]},{i,1,991,1}];

α5 = Table[{chi[ex]/.chiR1[[i]]},{i,1,991,1}];

β5 = Table[{chi'[ex]/.chiR1[[i]]},{i,1,991,1}];

α6 = Table[{chi[fx]/.chiR1[[i]]},{i,1,991,1}];

β6 = Table[{chi'[fx]/.chiR1[[i]]},{i,1,991,1}];

α7 = Table[{chi[gx]/.chiR1[[i]]},{i,1,991,1}];

β7 = Table[{chi'[gx]/.chiR1[[i]]},{i,1,991,1}];

α8 = Table[{chi[hx]/.chiR1[[i]]},{i,1,991,1}];

β8 = Table[{chi'[hx]/.chiR1[[i]]},{i,1,991,1}];

α9 = Table[{chi[ix]/.chiR1[[i]]},{i,1,991,1}];

β9 = Table[{chi'[ix]/.chiR1[[i]]},{i,1,991,1}];

α10 = Table[{chi[x0]/.chiR1[[i]]},{i,1,991,1}];

β10 = Table[{chi'[x0]/.chiR1[[i]]},{i,1,991,1}];

omegatable1 = Table[i,{i,1/10000,1/100,1/100000}];

ER1 = Table[{((α1[[i]]*I*omegatable1[[i]]+f*(β1[[i]]))/(2*I*omegatable1[[i]]*Exp[I*omegatable1[[i]]*xstar]))/.x-> ax},{i,1,991,1}];

FR1 = Table[{((α1[[i]]*I*omegatable1[[i]]-f*(β1[[i]]))/(2*I*omegatable1[[i]]*Exp[-I*omegatable1[[i]]*xstar]))/.x-> ax},{i,1,991,1}];

ER2 = Table[{((α2[[i]]*I*omegatable1[[i]]+f*(β2[[i]]))/(2*I*omegatable1[[i]]*Exp[I*omegatable1[[i]]*xstar]))/.x-> bx},{i,1,991,1}];

FR2 = Table[{((α2[[i]]*I*omegatable1[[i]]-f*(β2[[i]]))/(2*I*omegatable1[[i]]*Exp[-I*omegatable1[[i]]*xstar]))/.x-> bx},{i,1,991,1}];

ER3 = Table[{((α3[[i]]*I*omegatable1[[i]]+f*(β3[[i]]))/(2*I*omegatable1[[i]]*Exp[I*omegatable1[[i]]*xstar]))/.x-> cx},{i,1,991,1}];

FR3 = Table[{((α3[[i]]*I*omegatable1[[i]]-f*(β3[[i]]))/(2*I*omegatable1[[i]]*Exp[-I*omegatable1[[i]]*xstar]))/.x-> cx},{i,1,991,1}];

ER4 = Table[{((α4[[i]]*I*omegatable1[[i]]+f*(β4[[i]]))/(2*I*omegatable1[[i]]*Exp[I*omegatable1[[i]]*xstar]))/.x-> dx},{i,1,991,1}];

FR4 = Table[{((α4[[i]]*I*omegatable1[[i]]-f*(β4[[i]]))/(2*I*omegatable1[[i]]*Exp[-I*omegatable1[[i]]*xstar]))/.x-> dx},{i,1,991,1}];

ER5 = Table[{((α5[[i]]*I*omegatable1[[i]]+f*(β5[[i]]))/(2*I*omegatable1[[i]]*Exp[I*omegatable1[[i]]*xstar]))/.x-> ex},{i,1,991,1}];

FR5 = Table[{((α5[[i]]*I*omegatable1[[i]]-f*(β5[[i]]))/(2*I*omegatable1[[i]]*Exp[-I*omegatable1[[i]]*xstar]))/.x-> ex},{i,1,991,1}];

ER6 = Table[{((α6[[i]]*I*omegatable1[[i]]+f*(β6[[i]]))/(2*I*omegatable1[[i]]*Exp[I*omegatable1[[i]]*xstar]))/.x-> fx},{i,1,991,1}];

FR6 = Table[{((α6[[i]]*I*omegatable1[[i]]-f*(β6[[i]]))/(2*I*omegatable1[[i]]*Exp[-I*omegatable1[[i]]*xstar]))/.x-> fx},{i,1,991,1}];

ER7 = Table[{((α7[[i]]*I*omegatable1[[i]]+f*(β7[[i]]))/(2*I*omegatable1[[i]]*Exp[I*omegatable1[[i]]*xstar]))/.x-> gx},{i,1,991,1}];

FR7 = Table[{((α7[[i]]*I*omegatable1[[i]]-f*(β7[[i]]))/(2*I*omegatable1[[i]]*Exp[-I*omegatable1[[i]]*xstar]))/.x-> gx},{i,1,991,1}];

ER8 = Table[{((α8[[i]]*I*omegatable1[[i]]+f*(β8[[i]]))/(2*I*omegatable1[[i]]*Exp[I*omegatable1[[i]]*xstar]))/.x-> hx},{i,1,991,1}];

FR8 = Table[{((α8[[i]]*I*omegatable1[[i]]-f*(β8[[i]]))/(2*I*omegatable1[[i]]*Exp[-I*omegatable1[[i]]*xstar]))/.x-> hx},{i,1,991,1}];

ER9 = Table[{((α9[[i]]*I*omegatable1[[i]]+f*(β9[[i]]))/(2*I*omegatable1[[i]]*Exp[I*omegatable1[[i]]*xstar]))/.x-> ix},{i,1,991,1}];

FR9 = Table[{((α9[[i]]*I*omegatable1[[i]]-f*(β9[[i]]))/(2*I*omegatable1[[i]]*Exp[-I*omegatable1[[i]]*xstar]))/.x-> ix},{i,1,991,1}];

ER10 = Table[{((α10[[i]]*I*omegatable1[[i]]+f*(β10[[i]]))/(2*I*omegatable1[[i]]*Exp[I*omegatable1[[i]]*xstar]))/.x-> x0},{i,1,991,1}];

FR10 = Table[{((α10[[i]]*I*omegatable1[[i]]-f*(β10[[i]]))/(2*I*omegatable1[[i]]*Exp[-I*omegatable1[[i]]*xstar]))/.x-> x0},{i,1,991,1}];

Tce = Table[{{ax,Part[ER1[[i]],1]},{bx,Part[ER2[[i]],1]},{cx,Part[ER3[[i]],1]},{dx,Part[ER4[[i]],1]},{ex,Part[ER5[[i]],1]}, {fx, Part[ER6[[i]],1]}, {gx, Part[ER7[[i]],1]},{hx,Part[ER8[[i]],1]},{ix,Part[ER9[[i]],1]},{x0,Part[ER10[[i]],1]}},{i,1,991,1}];

TceCorrected= Tce/.{x_,{{{y_}}}}->{x,y};

Tre=Table[{Part[TceCorrected[[i]],j,1],Re[Part[TceCorrected[[i]],j,2]]},{i,1,991,1},{j,10}];

ERFitr = Table[Fit[Tre[[i]],{1,y,y^2,y^3},y],{i,1,991,1}];

Tie=Table[{Part[TceCorrected[[i]],j,1],Im[Part[TceCorrected[[i]],j,2]]},{i,1,991,1},{j,10}];

ERFiti = Table[Fit[Tie[[i]],{1,y,y^2,y^3},y],{i,1,991,1}];

Tcf = Table[{{ax,Part[FR1[[i]],1]},{bx,Part[FR2[[i]],1]},{cx,Part[FR3[[i]],1]},{dx,Part[FR4[[i]],1]},{ex,Part[FR5[[i]],1]}, {fx, Part[FR6[[i]],1]}, {gx, Part[FR7[[i]],1]},{hx,Part[FR8[[i]],1]},{ix,Part[FR9[[i]],1]},{x0,Part[FR10[[i]],1]}},{i,1,991,1}];

TcfCorrected= Tcf/.{x_,{{{y_}}}}->{x,y};

Trf=Table[{Part[TcfCorrected[[i]],j,1],Re[Part[TcfCorrected[[i]],j,2]]},{i,1,991,1},{j,10}];

FRFitr = Table[Fit[Trf[[i]],{1,y,y^2,y^3},y],{i,1,991,1}];

Tif=Table[{Part[TcfCorrected[[i]],j,1],Im[Part[TcfCorrected[[i]],j,2]]},{i,1,991,1},{j,10}];

FRFiti = Table[Fit[Tif[[i]],{1,y,y^2,y^3},y],{i,1,991,1}];

ReERfin = Table[{omegatable1[[i]],N[ERFitr[[i]]/.{y-> 1/10}]},{i,1,991,1}];

Length[ReERfin]

ImERfin = Table[{omegatable1[[i]],N[ERFiti[[i]]/.{y-> 1/10}]},{i,1,991,1}];

ReFRfin = Table[{omegatable1[[i]],N[FRFitr[[i]]/.{y-> 1/10}]},{i,1,991,1}];

ImFRfin = Table[{omegatable1[[i]],N[FRFiti[[i]]/.{y-> 1/10}]},{i,1,991,1}];

ER1rp = ListPlot[ReERfin]

ER1ip = ListPlot[ImERfin, PlotRange -> All]

FR1rp = ListPlot[ReFRfin]

FR1ip = ListPlot[ImFRfin, PlotRange-> All]

Band 2

Length[chiR2]

α1b = Table[{chi[ax]/.chiR2[[i]]},{i,1,991,1}];

β1b = Table[{chi'[ax]/.chiR2[[i]]},{i,1,991,1}];

α2b = Table[{chi[bx]/.chiR2[[i]]},{i,1,991,1}];

β2b = Table[{chi'[bx]/.chiR2[[i]]},{i,1,991,1}];

α3b = Table[{chi[cx]/.chiR2[[i]]},{i,1,991,1}];

β3b = Table[{chi'[cx]/.chiR2[[i]]},{i,1,991,1}];

α4b = Table[{chi[dx]/.chiR2[[i]]},{i,1,991,1}];

β4b = Table[{chi'[dx]/.chiR2[[i]]},{i,1,991,1}];

α5b = Table[{chi[ex]/.chiR2[[i]]},{i,1,991,1}];

β5b = Table[{chi'[ex]/.chiR2[[i]]},{i,1,991,1}];

α6b = Table[{chi[fx]/.chiR2[[i]]},{i,1,991,1}];

β6b = Table[{chi'[fx]/.chiR2[[i]]},{i,1,991,1}];

α7b = Table[{chi[gx]/.chiR2[[i]]},{i,1,991,1}];

β7b = Table[{chi'[gx]/.chiR2[[i]]},{i,1,991,1}];

α8b = Table[{chi[hx]/.chiR2[[i]]},{i,1,991,1}];

β8b = Table[{chi'[hx]/.chiR2[[i]]},{i,1,991,1}];

α9b = Table[{chi[ix]/.chiR2[[i]]},{i,1,991,1}];

β9b = Table[{chi'[ix]/.chiR2[[i]]},{i,1,991,1}];

α10b = Table[{chi[x0]/.chiR2[[i]]},{i,1,991,1}];

β10b = Table[{chi'[x0]/.chiR2[[i]]},{i,1,991,1}];

omegatable2 = Table[i,{i,1/100,1,1/1000}];

ER1b = Table[{((α1b[[i]]*I*omegatable2[[i]]+f*(β1b[[i]]))/(2*I*omegatable2[[i]]*Exp[I*omegatable2[[i]]*xstar]))/.x-> ax},{i,1,991,1}];

FR1b = Table[{((α1b[[i]]*I*omegatable2[[i]]-f*(β1b[[i]]))/(2*I*omegatable2[[i]]*Exp[-I*omegatable2[[i]]*xstar]))/.x-> ax},{i,1,991,1}];

ER2b = Table[{((α2b[[i]]*I*omegatable2[[i]]+f*(β2b[[i]]))/(2*I*omegatable2[[i]]*Exp[I*omegatable2[[i]]*xstar]))/.x-> bx},{i,1,991,1}];

FR2b= Table[{((α2b[[i]]*I*omegatable2[[i]]-f*(β2b[[i]]))/(2*I*omegatable2[[i]]*Exp[-I*omegatable2[[i]]*xstar]))/.x-> bx},{i,1,991,1}];

ER3b= Table[{((α3b[[i]]*I*omegatable2[[i]]+f*(β3b[[i]]))/(2*I*omegatable2[[i]]*Exp[I*omegatable2[[i]]*xstar]))/.x-> cx},{i,1,991,1}];

FR3b = Table[{((α3b[[i]]*I*omegatable2[[i]]-f*(β3b[[i]]))/(2*I*omegatable2[[i]]*Exp[-I*omegatable2[[i]]*xstar]))/.x-> cx},{i,1,991,1}];

ER4b= Table[{((α4b[[i]]*I*omegatable2[[i]]+f*(β4b[[i]]))/(2*I*omegatable2[[i]]*Exp[I*omegatable2[[i]]*xstar]))/.x-> dx},{i,1,991,1}];

FR4b = Table[{((α4b[[i]]*I*omegatable2[[i]]-f*(β4b[[i]]))/(2*I*omegatable2[[i]]*Exp[-I*omegatable2[[i]]*xstar]))/.x-> dx},{i,1,991,1}];

ER5b = Table[{((α5b[[i]]*I*omegatable2[[i]]+f*(β5b[[i]]))/(2*I*omegatable2[[i]]*Exp[I*omegatable2[[i]]*xstar]))/.x-> ex},{i,1,991,1}];

FR5b= Table[{((α5b[[i]]*I*omegatable2[[i]]-f*(β5b[[i]]))/(2*I*omegatable2[[i]]*Exp[-I*omegatable2[[i]]*xstar]))/.x-> ex},{i,1,991,1}];

ER6b = Table[{((α6b[[i]]*I*omegatable2[[i]]+f*(β6b[[i]]))/(2*I*omegatable2[[i]]*Exp[I*omegatable2[[i]]*xstar]))/.x-> fx},{i,1,991,1}];

FR6b = Table[{((α6b[[i]]*I*omegatable2[[i]]-f*(β6b[[i]]))/(2*I*omegatable2[[i]]*Exp[-I*omegatable2[[i]]*xstar]))/.x-> fx},{i,1,991,1}];

ER7b = Table[{((α7b[[i]]*I*omegatable2[[i]]+f*(β7b[[i]]))/(2*I*omegatable2[[i]]*Exp[I*omegatable2[[i]]*xstar]))/.x-> gx},{i,1,991,1}];

FR7b = Table[{((α7b[[i]]*I*omegatable2[[i]]-f*(β7b[[i]]))/(2*I*omegatable2[[i]]*Exp[-I*omegatable2[[i]]*xstar]))/.x-> gx},{i,1,991,1}];

ER8b = Table[{((α8b[[i]]*I*omegatable2[[i]]+f*(β8b[[i]]))/(2*I*omegatable2[[i]]*Exp[I*omegatable2[[i]]*xstar]))/.x-> hx},{i,1,991,1}];

FR8b = Table[{((α8b[[i]]*I*omegatable2[[i]]-f*(β8b[[i]]))/(2*I*omegatable2[[i]]*Exp[-I*omegatable2[[i]]*xstar]))/.x-> hx},{i,1,991,1}];

ER9b = Table[{((α9b[[i]]*I*omegatable2[[i]]+f*(β9b[[i]]))/(2*I*omegatable2[[i]]*Exp[I*omegatable2[[i]]*xstar]))/.x-> ix},{i,1,991,1}];

FR9b = Table[{((α9b[[i]]*I*omegatable2[[i]]-f*(β9b[[i]]))/(2*I*omegatable2[[i]]*Exp[-I*omegatable2[[i]]*xstar]))/.x-> ix},{i,1,991,1}];

ER10b = Table[{((α10b[[i]]*I*omegatable2[[i]]+f*(β10b[[i]]))/(2*I*omegatable2[[i]]*Exp[I*omegatable2[[i]]*xstar]))/.x-> x0},{i,1,991,1}];

FR10b = Table[{((α10b[[i]]*I*omegatable2[[i]]-f*(β10b[[i]]))/(2*I*omegatable2[[i]]*Exp[-I*omegatable2[[i]]*xstar]))/.x-> x0},{i,1,991,1}];

Tceb = Table[{{ax,Part[ER1b[[i]],1]},{bx,Part[ER2b[[i]],1]},{cx,Part[ER3b[[i]],1]},{dx,Part[ER4b[[i]],1]},{ex,Part[ER5b[[i]],1]}, {fx, Part[ER6b[[i]],1]}, {gx, Part[ER7b[[i]],1]},{hx,Part[ER8b[[i]],1]},{ix,Part[ER9b[[i]],1]},{x0,Part[ER10b[[i]],1]}},{i,1,991,1}];

TceCorrectedb= Tceb/.{x_,{{{y_}}}}->{x,y};

Treb=Table[{Part[TceCorrectedb[[i]],j,1],Re[Part[TceCorrectedb[[i]],j,2]]},{i,1,991,1},{j,10}];

ERFitrb = Table[Fit[Treb[[i]],{1,y,y^2,y^3},y],{i,1,991,1}];

Tieb=Table[{Part[TceCorrectedb[[i]],j,1],Im[Part[TceCorrectedb[[i]],j,2]]},{i,1,991,1},{j,10}];

ERFitib = Table[Fit[Tieb[[i]],{1,y,y^2,y^3},y],{i,1,991,1}];

Tcfb = Table[{{ax,Part[FR1b[[i]],1]},{bx,Part[FR2b[[i]],1]},{cx,Part[FR3b[[i]],1]},{dx,Part[FR4b[[i]],1]},{ex,Part[FR5b[[i]],1]}, {fx, Part[FR6b[[i]],1]}, {gx, Part[FR7b[[i]],1]},{hx,Part[FR8b[[i]],1]},{ix,Part[FR9b[[i]],1]},{x0,Part[FR10b[[i]],1]}},{i,1,991,1}];

TcfCorrectedb= Tcfb/.{x_,{{{y_}}}}->{x,y};

Trfb=Table[{Part[TcfCorrectedb[[i]],j,1],Re[Part[TcfCorrectedb[[i]],j,2]]},{i,1,991,1},{j,10}];

FRFitrb = Table[Fit[Trfb[[i]],{1,y,y^2,y^3},y],{i,1,991,1}];

Tifb=Table[{Part[TcfCorrectedb[[i]],j,1],Im[Part[TcfCorrectedb[[i]],j,2]]},{i,1,991,1},{j,10}];

FRFitib = Table[Fit[Tifb[[i]],{1,y,y^2,y^3},y],{i,1,991,1}];

ReERfinb = Table[{omegatable2[[i]],N[ERFitrb[[i]]/.{y-> 1/10}]},{i,1,991,1}];

ImERfinb = Table[{omegatable2[[i]],N[ERFitib[[i]]/.{y-> 1/10}]},{i,1,991,1}];

ReFRfinb = Table[{omegatable2[[i]],N[FRFitrb[[i]]/.{y-> 1/10}]},{i,1,991,1}];

ImFRfinb = Table[{omegatable2[[i]],N[FRFitib[[i]]/.{y-> 1/10}]},{i,1,991,1}];

ER2rp = ListPlot[ReERfinb]

ER2ip = ListPlot[ImERfinb, PlotRange -> All]

FR2rp = ListPlot[ReFRfinb]

FR2ip = ListPlot[ImFRfinb, PlotRange-> All]

Band 3

Length[chiR3]

α1c = Table[{chi[ax]/.chiR3[[i]]},{i,1,1001,1}];

β1c = Table[{chi'[ax]/.chiR3[[i]]},{i,1,1001,1}];

α2c = Table[{chi[bx]/.chiR3[[i]]},{i,1,1001,1}];

β2c = Table[{chi'[bx]/.chiR3[[i]]},{i,1,1001,1}];

α3c = Table[{chi[cx]/.chiR3[[i]]},{i,1,1001,1}];

β3c = Table[{chi'[cx]/.chiR3[[i]]},{i,1,1001,1}];

α4c = Table[{chi[dx]/.chiR3[[i]]},{i,1,1001,1}];

β4c = Table[{chi'[dx]/.chiR3[[i]]},{i,1,1001,1}];

α5c = Table[{chi[ex]/.chiR3[[i]]},{i,1,1001,1}];

β5c = Table[{chi'[ex]/.chiR3[[i]]},{i,1,1001,1}];

α6c = Table[{chi[fx]/.chiR3[[i]]},{i,1,1001,1}];

β6c = Table[{chi'[fx]/.chiR3[[i]]},{i,1,1001,1}];

α7c = Table[{chi[gx]/.chiR3[[i]]},{i,1,1001,1}];

β7c = Table[{chi'[gx]/.chiR3[[i]]},{i,1,1001,1}];

α8c = Table[{chi[hx]/.chiR3[[i]]},{i,1,1001,1}];

β8c = Table[{chi'[hx]/.chiR3[[i]]},{i,1,1001,1}];

α9c = Table[{chi[ix]/.chiR3[[i]]},{i,1,1001,1}];

β9c = Table[{chi'[ix]/.chiR3[[i]]},{i,1,1001,1}];

α10c = Table[{chi[x0]/.chiR3[[i]]},{i,1,1001,1}];

β10c = Table[{chi'[x0]/.chiR3[[i]]},{i,1,1001,1}];

omegatable3 = Table[i,{i,1,6,5/1000}];

ER1c = Table[{((α1c[[i]]*I*omegatable3[[i]]+f*(β1c[[i]]))/(2*I*omegatable3[[i]]*Exp[I*omegatable3[[i]]*xstar]))/.x-> ax},{i,1,1001,1}];

FR1c = Table[{((α1c[[i]]*I*omegatable3[[i]]-f*(β1c[[i]]))/(2*I*omegatable3[[i]]*Exp[-I*omegatable3[[i]]*xstar]))/.x-> ax},{i,1,1001,1}];

ER2c = Table[{((α2c[[i]]*I*omegatable3[[i]]+f*(β2c[[i]]))/(2*I*omegatable3[[i]]*Exp[I*omegatable3[[i]]*xstar]))/.x-> bx},{i,1,1001,1}];

FR2c = Table[{((α2c[[i]]*I*omegatable3[[i]]-f*(β2c[[i]]))/(2*I*omegatable3[[i]]*Exp[-I*omegatable3[[i]]*xstar]))/.x-> bx},{i,1,1001,1}];

ER3c = Table[{((α3c[[i]]*I*omegatable3[[i]]+f*(β3c[[i]]))/(2*I*omegatable3[[i]]*Exp[I*omegatable3[[i]]*xstar]))/.x-> cx},{i,1,1001,1}];

FR3c = Table[{((α3c[[i]]*I*omegatable3[[i]]-f*(β3c[[i]]))/(2*I*omegatable3[[i]]*Exp[-I*omegatable3[[i]]*xstar]))/.x-> cx},{i,1,1001,1}];

ER4c = Table[{((α4c[[i]]*I*omegatable3[[i]]+f*(β4c[[i]]))/(2*I*omegatable3[[i]]*Exp[I*omegatable3[[i]]*xstar]))/.x-> dx},{i,1,1001,1}];

FR4c = Table[{((α4c[[i]]*I*omegatable3[[i]]-f*(β4c[[i]]))/(2*I*omegatable3[[i]]*Exp[-I*omegatable3[[i]]*xstar]))/.x-> dx},{i,1,1001,1}];

ER5c = Table[{((α5c[[i]]*I*omegatable3[[i]]+f*(β5c[[i]]))/(2*I*omegatable3[[i]]*Exp[I*omegatable3[[i]]*xstar]))/.x-> ex},{i,1,1001,1}];

FR5c = Table[{((α5c[[i]]*I*omegatable3[[i]]-f*(β5c[[i]]))/(2*I*omegatable3[[i]]*Exp[-I*omegatable3[[i]]*xstar]))/.x-> ex},{i,1,1001,1}];

ER6c = Table[{((α6c[[i]]*I*omegatable3[[i]]+f*(β6c[[i]]))/(2*I*omegatable3[[i]]*Exp[I*omegatable3[[i]]*xstar]))/.x-> fx},{i,1,1001,1}];

FR6c = Table[{((α6c[[i]]*I*omegatable3[[i]]-f*(β6c[[i]]))/(2*I*omegatable3[[i]]*Exp[-I*omegatable3[[i]]*xstar]))/.x-> fx},{i,1,1001,1}];

ER7c = Table[{((α7c[[i]]*I*omegatable3[[i]]+f*(β7c[[i]]))/(2*I*omegatable3[[i]]*Exp[I*omegatable3[[i]]*xstar]))/.x-> gx},{i,1,1001,1}];

FR7c = Table[{((α7c[[i]]*I*omegatable3[[i]]-f*(β7c[[i]]))/(2*I*omegatable3[[i]]*Exp[-I*omegatable3[[i]]*xstar]))/.x-> gx},{i,1,1001,1}];

ER8c = Table[{((α8c[[i]]*I*omegatable3[[i]]+f*(β8c[[i]]))/(2*I*omegatable3[[i]]*Exp[I*omegatable3[[i]]*xstar]))/.x-> hx},{i,1,1001,1}];

FR8c = Table[{((α8c[[i]]*I*omegatable3[[i]]-f*(β8c[[i]]))/(2*I*omegatable3[[i]]*Exp[-I*omegatable3[[i]]*xstar]))/.x-> hx},{i,1,1001,1}];

ER9c = Table[{((α9c[[i]]*I*omegatable3[[i]]+f*(β9c[[i]]))/(2*I*omegatable3[[i]]*Exp[I*omegatable3[[i]]*xstar]))/.x-> ix},{i,1,1001,1}];

FR9c = Table[{((α9c[[i]]*I*omegatable3[[i]]-f*(β9c[[i]]))/(2*I*omegatable3[[i]]*Exp[-I*omegatable3[[i]]*xstar]))/.x-> ix},{i,1,1001,1}];

ER10c = Table[{((α10c[[i]]*I*omegatable3[[i]]+f*(β10c[[i]]))/(2*I*omegatable3[[i]]*Exp[I*omegatable3[[i]]*xstar]))/.x-> x0},{i,1,1001,1}];

FR10c = Table[{((α10c[[i]]*I*omegatable3[[i]]-f*(β10c[[i]]))/(2*I*omegatable3[[i]]*Exp[-I*omegatable3[[i]]*xstar]))/.x-> x0},{i,1,1001,1}];

Tcec = Table[{{ax,Part[ER1c[[i]],1]},{bx,Part[ER2c[[i]],1]},{cx,Part[ER3c[[i]],1]},{dx,Part[ER4c[[i]],1]},{ex,Part[ER5c[[i]],1]}, {fx, Part[ER6c[[i]],1]}, {gx, Part[ER7c[[i]],1]},{hx,Part[ER8c[[i]],1]},{ix,Part[ER9c[[i]],1]},{x0,Part[ER10c[[i]],1]}},{i,1,1001,1}];

TceCorrectedc = Tcec/.{x_,{{{y_}}}}->{x,y};

Trec =Table[{Part[TceCorrectedc[[i]],j,1],Re[Part[TceCorrectedc[[i]],j,2]]},{i,1,1001,1},{j,10}];

ERFitrc = Table[Fit[Trec[[i]],{1,y,y^2,y^3},y],{i,1,1001,1}];

Tiec =Table[{Part[TceCorrectedc[[i]],j,1],Im[Part[TceCorrectedc[[i]],j,2]]},{i,1,1001,1},{j,10}];

ERFitic = Table[Fit[Tiec[[i]],{1,y,y^2,y^3},y],{i,1,1001,1}];

Tcfc = Table[{{ax,Part[FR1c[[i]],1]},{bx,Part[FR2c[[i]],1]},{cx,Part[FR3c[[i]],1]},{dx,Part[FR4c[[i]],1]},{ex,Part[FR5c[[i]],1]}, {fx, Part[FR6c[[i]],1]}, {gx, Part[FR7c[[i]],1]},{hx,Part[FR8c[[i]],1]},{ix,Part[FR9c[[i]],1]},{x0,Part[FR10c[[i]],1]}},{i,1,1001,1}];

TcfCorrectedc = Tcfc/.{x_,{{{y_}}}}->{x,y};

Trfc =Table[{Part[TcfCorrectedc[[i]],j,1],Re[Part[TcfCorrectedc[[i]],j,2]]},{i,1,1001,1},{j,10}];

FRFitrc = Table[Fit[Trfc[[i]],{1,y,y^2,y^3},y],{i,1,1001,1}];

Tifc =Table[{Part[TcfCorrectedc[[i]],j,1],Im[Part[TcfCorrectedc[[i]],j,2]]},{i,1,1001,1},{j,10}];

FRFitic = Table[Fit[Tifc[[i]],{1,y,y^2,y^3},y],{i,1,1001,1}];

ReERfinc = Table[{omegatable3[[i]],N[ERFitrc[[i]]/.{y-> 1/10}]},{i,1,1001,1}];

ImERfinc = Table[{omegatable3[[i]],N[ERFitic[[i]]/.{y-> 1/10}]},{i,1,1001,1}];

ReFRfinc = Table[{omegatable3[[i]],N[FRFitrc[[i]]/.{y-> 1/10}]},{i,1,1001,1}];

ImFRfinc = Table[{omegatable3[[i]],N[FRFitic[[i]]/.{y-> 1/10}]},{i,1,1001,1}];

ER3rp = ListPlot[ReERfinc]

ER3ip = ListPlot[ImERfinc, PlotRange -> All]

FR3rp = ListPlot[ReFRfinc]

FR3ip = ListPlot[ImFRfinc, PlotRange-> All]

Band 4

Length[chiR4]

α1d = Table[{chi[ax]/.chiR4[[i]]},{i,1,1101,1}];

β1d = Table[{chi'[ax]/.chiR4[[i]]},{i,1,1101,1}];

α2d = Table[{chi[bx]/.chiR4[[i]]},{i,1,1101,1}];

β2d = Table[{chi'[bx]/.chiR4[[i]]},{i,1,1101,1}];

α3d = Table[{chi[cx]/.chiR4[[i]]},{i,1,1101,1}];

β3d = Table[{chi'[cx]/.chiR4[[i]]},{i,1,1101,1}];

α4d = Table[{chi[dx]/.chiR4[[i]]},{i,1,1101,1}];

β4d = Table[{chi'[dx]/.chiR4[[i]]},{i,1,1101,1}];

α5d = Table[{chi[ex]/.chiR4[[i]]},{i,1,1101,1}];

β5d = Table[{chi'[ex]/.chiR4[[i]]},{i,1,1101,1}];

α6d = Table[{chi[fx]/.chiR4[[i]]},{i,1,1101,1}];

β6d = Table[{chi'[fx]/.chiR4[[i]]},{i,1,1101,1}];

α7d = Table[{chi[gx]/.chiR4[[i]]},{i,1,1101,1}];

β7d = Table[{chi'[gx]/.chiR4[[i]]},{i,1,1101,1}];

α8d = Table[{chi[hx]/.chiR4[[i]]},{i,1,1101,1}];

β8d = Table[{chi'[hx]/.chiR4[[i]]},{i,1,1101,1}];

α9d = Table[{chi[ix]/.chiR4[[i]]},{i,1,1101,1}];

β9d = Table[{chi'[ix]/.chiR4[[i]]},{i,1,1101,1}];

α10d = Table[{chi[x0]/.chiR4[[i]]},{i,1,1101,1}];

β10d = Table[{chi'[x0]/.chiR4[[i]]},{i,1,1101,1}];

omegatable4 = Table[i,{i,6,5000/100,4/100}];

ER1d = Table[{((α1d[[i]]*I*omegatable4[[i]]+f*(β1d[[i]]))/(2*I*omegatable4[[i]]*Exp[I*omegatable4[[i]]*xstar]))/.x-> ax},{i,1,1101,1}];

FR1d = Table[{((α1d[[i]]*I*omegatable4[[i]]-f*(β1d[[i]]))/(2*I*omegatable4[[i]]*Exp[-I*omegatable4[[i]]*xstar]))/.x-> ax},{i,1,1101,1}];

ER2d = Table[{((α2d[[i]]*I*omegatable4[[i]]+f*(β2d[[i]]))/(2*I*omegatable4[[i]]*Exp[I*omegatable4[[i]]*xstar]))/.x-> bx},{i,1,1101,1}];

FR2d = Table[{((α2d[[i]]*I*omegatable4[[i]]-f*(β2d[[i]]))/(2*I*omegatable4[[i]]*Exp[-I*omegatable4[[i]]*xstar]))/.x-> bx},{i,1,1101,1}];

ER3d = Table[{((α3d[[i]]*I*omegatable4[[i]]+f*(β3d[[i]]))/(2*I*omegatable4[[i]]*Exp[I*omegatable4[[i]]*xstar]))/.x-> cx},{i,1,1101,1}];

FR3d = Table[{((α3d[[i]]*I*omegatable4[[i]]-f*(β3d[[i]]))/(2*I*omegatable4[[i]]*Exp[-I*omegatable4[[i]]*xstar]))/.x-> cx},{i,1,1101,1}];

ER4d = Table[{((α4d[[i]]*I*omegatable4[[i]]+f*(β4d[[i]]))/(2*I*omegatable4[[i]]*Exp[I*omegatable4[[i]]*xstar]))/.x-> dx},{i,1,1101,1}];

FR4d = Table[{((α4d[[i]]*I*omegatable4[[i]]-f*(β4d[[i]]))/(2*I*omegatable4[[i]]*Exp[-I*omegatable4[[i]]*xstar]))/.x-> dx},{i,1,1101,1}];

ER5d = Table[{((α5d[[i]]*I*omegatable4[[i]]+f*(β5d[[i]]))/(2*I*omegatable4[[i]]*Exp[I*omegatable4[[i]]*xstar]))/.x-> ex},{i,1,1101,1}];

FR5d = Table[{((α5d[[i]]*I*omegatable4[[i]]-f*(β5d[[i]]))/(2*I*omegatable4[[i]]*Exp[-I*omegatable4[[i]]*xstar]))/.x-> ex},{i,1,1101,1}];

ER6d = Table[{((α6d[[i]]*I*omegatable4[[i]]+f*(β6d[[i]]))/(2*I*omegatable4[[i]]*Exp[I*omegatable4[[i]]*xstar]))/.x-> fx},{i,1,1101,1}];

FR6d = Table[{((α6d[[i]]*I*omegatable4[[i]]-f*(β6d[[i]]))/(2*I*omegatable4[[i]]*Exp[-I*omegatable4[[i]]*xstar]))/.x-> fx},{i,1,1101,1}];

ER7d = Table[{((α7d[[i]]*I*omegatable4[[i]]+f*(β7d[[i]]))/(2*I*omegatable4[[i]]*Exp[I*omegatable4[[i]]*xstar]))/.x-> gx},{i,1,1101,1}];

FR7d = Table[{((α7d[[i]]*I*omegatable4[[i]]-f*(β7d[[i]]))/(2*I*omegatable4[[i]]*Exp[-I*omegatable4[[i]]*xstar]))/.x-> gx},{i,1,1101,1}];

ER8d = Table[{((α8d[[i]]*I*omegatable4[[i]]+f*(β8d[[i]]))/(2*I*omegatable4[[i]]*Exp[I*omegatable4[[i]]*xstar]))/.x-> hx},{i,1,1101,1}];

FR8d = Table[{((α8d[[i]]*I*omegatable4[[i]]-f*(β8d[[i]]))/(2*I*omegatable4[[i]]*Exp[-I*omegatable4[[i]]*xstar]))/.x-> hx},{i,1,1101,1}];

ER9d = Table[{((α9d[[i]]*I*omegatable4[[i]]+f*(β9d[[i]]))/(2*I*omegatable4[[i]]*Exp[I*omegatable4[[i]]*xstar]))/.x-> ix},{i,1,1101,1}];

FR9d = Table[{((α9d[[i]]*I*omegatable4[[i]]-f*(β9d[[i]]))/(2*I*omegatable4[[i]]*Exp[-I*omegatable4[[i]]*xstar]))/.x-> ix},{i,1,1101,1}];

ER10d = Table[{((α10d[[i]]*I*omegatable4[[i]]+f*(β10d[[i]]))/(2*I*omegatable4[[i]]*Exp[I*omegatable4[[i]]*xstar]))/.x-> x0},{i,1,1101,1}];

FR10d = Table[{((α10d[[i]]*I*omegatable4[[i]]-f*(β10d[[i]]))/(2*I*omegatable4[[i]]*Exp[-I*omegatable4[[i]]*xstar]))/.x-> x0},{i,1,1101,1}];

Tced = Table[{{ax,Part[ER1d[[i]],1]},{bx,Part[ER2d[[i]],1]},{cx,Part[ER3d[[i]],1]},{dx,Part[ER4d[[i]],1]},{ex,Part[ER5d[[i]],1]}, {fx, Part[ER6d[[i]],1]}, {gx, Part[ER7d[[i]],1]},{hx,Part[ER8d[[i]],1]},{ix,Part[ER9d[[i]],1]},{x0,Part[ER10d[[i]],1]}},{i,1,1101,1}];

TceCorrectedd = Tced/.{x_,{{{y_}}}}->{x,y};

Tred =Table[{Part[TceCorrectedd[[i]],j,1],Re[Part[TceCorrectedd[[i]],j,2]]},{i,1,1101,1},{j,10}];

ERFitrd = Table[Fit[Tred[[i]],{1,y,y^2,y^3},y],{i,1,1101,1}];

Tied =Table[{Part[TceCorrectedd[[i]],j,1],Im[Part[TceCorrectedd[[i]],j,2]]},{i,1,1101,1},{j,10}];

ERFitid = Table[Fit[Tied[[i]],{1,y,y^2,y^3},y],{i,1,1101,1}];

Tcfd = Table[{{ax,Part[FR1d[[i]],1]},{bx,Part[FR2d[[i]],1]},{cx,Part[FR3d[[i]],1]},{dx,Part[FR4d[[i]],1]},{ex,Part[FR5d[[i]],1]}, {fx, Part[FR6d[[i]],1]}, {gx, Part[FR7d[[i]],1]},{hx,Part[FR8d[[i]],1]},{ix,Part[FR9d[[i]],1]},{x0,Part[FR10d[[i]],1]}},{i,1,1101,1}];

TcfCorrectedd = Tcfd/.{x_,{{{y_}}}}->{x,y};

Trfd =Table[{Part[TcfCorrectedd[[i]],j,1],Re[Part[TcfCorrectedd[[i]],j,2]]},{i,1,1101,1},{j,10}];

FRFitrd = Table[Fit[Trfd[[i]],{1,y,y^2,y^3},y],{i,1,1101,1}];

Tifd =Table[{Part[TcfCorrectedd[[i]],j,1],Im[Part[TcfCorrectedd[[i]],j,2]]},{i,1,1101,1},{j,10}];

FRFitid = Table[Fit[Tifd[[i]],{1,y,y^2,y^3},y],{i,1,1101,1}];

ReERfind = Table[{omegatable4[[i]],N[ERFitrd[[i]]/.{y-> 1/10}]},{i,1,1101,1}];

ImERfind = Table[{omegatable4[[i]],N[ERFitid[[i]]/.{y-> 1/10}]},{i,1,1101,1}];

ReFRfind = Table[{omegatable4[[i]],N[FRFitrd[[i]]/.{y-> 1/10}]},{i,1,1101,1}];

ImFRfind = Table[{omegatable4[[i]],N[FRFitid[[i]]/.{y-> 1/10}]},{i,1,1101,1}];

ER4rp = ListPlot[ReERfind]

ER4ip = ListPlot[ImERfind, PlotRange -> All]

FR4rp = ListPlot[ReFRfind]

FR4ip = ListPlot[ImFRfind, PlotRange-> All]

Band 5

Length[chiR5]

α1e = Table[{chi[ax]/.chiR5[[i]]},{i,1,1001,1}];

β1e = Table[{chi'[ax]/.chiR5[[i]]},{i,1,1001,1}];

α2e = Table[{chi[bx]/.chiR5[[i]]},{i,1,1001,1}];

β2e = Table[{chi'[bx]/.chiR5[[i]]},{i,1,1001,1}];

α3e = Table[{chi[cx]/.chiR5[[i]]},{i,1,1001,1}];

β3e = Table[{chi'[cx]/.chiR5[[i]]},{i,1,1001,1}];

α4e = Table[{chi[dx]/.chiR5[[i]]},{i,1,1001,1}];

β4e = Table[{chi'[dx]/.chiR5[[i]]},{i,1,1001,1}];

α5e = Table[{chi[ex]/.chiR5[[i]]},{i,1,1001,1}];

β5e = Table[{chi'[ex]/.chiR5[[i]]},{i,1,1001,1}];

α6e = Table[{chi[fx]/.chiR5[[i]]},{i,1,1001,1}];

β6e = Table[{chi'[fx]/.chiR5[[i]]},{i,1,1001,1}];

α7e = Table[{chi[gx]/.chiR5[[i]]},{i,1,1001,1}];

β7e = Table[{chi'[gx]/.chiR5[[i]]},{i,1,1001,1}];

α8e = Table[{chi[hx]/.chiR5[[i]]},{i,1,1001,1}];

β8e = Table[{chi'[hx]/.chiR5[[i]]},{i,1,1001,1}];

α9e = Table[{chi[ix]/.chiR5[[i]]},{i,1,1001,1}];

β9e = Table[{chi'[ix]/.chiR5[[i]]},{i,1,1001,1}];

α10e = Table[{chi[x0]/.chiR5[[i]]},{i,1,1001,1}];

β10e = Table[{chi'[x0]/.chiR5[[i]]},{i,1,1001,1}];

omegatable5 = Table[i,{i,5000/100,10000/100,5/100}];

ER1e = Table[{((α1e[[i]]*I*omegatable5[[i]]+f*(β1e[[i]]))/(2*I*omegatable5[[i]]*Exp[I*omegatable5[[i]]*xstar]))/.x-> ax},{i,1,1001,1}];

FR1e = Table[{((α1e[[i]]*I*omegatable5[[i]]-f*(β1e[[i]]))/(2*I*omegatable5[[i]]*Exp[-I*omegatable5[[i]]*xstar]))/.x-> ax},{i,1,1001,1}];

ER2e = Table[{((α2e[[i]]*I*omegatable5[[i]]+f*(β2e[[i]]))/(2*I*omegatable5[[i]]*Exp[I*omegatable5[[i]]*xstar]))/.x-> bx},{i,1,1001,1}];

FR2e = Table[{((α2e[[i]]*I*omegatable5[[i]]-f*(β2e[[i]]))/(2*I*omegatable5[[i]]*Exp[-I*omegatable5[[i]]*xstar]))/.x-> bx},{i,1,1001,1}];

ER3e = Table[{((α3e[[i]]*I*omegatable5[[i]]+f*(β3e[[i]]))/(2*I*omegatable5[[i]]*Exp[I*omegatable5[[i]]*xstar]))/.x-> cx},{i,1,1001,1}];

FR3e = Table[{((α3e[[i]]*I*omegatable5[[i]]-f*(β3e[[i]]))/(2*I*omegatable5[[i]]*Exp[-I*omegatable5[[i]]*xstar]))/.x-> cx},{i,1,1001,1}];

ER4e = Table[{((α4e[[i]]*I*omegatable5[[i]]+f*(β4e[[i]]))/(2*I*omegatable5[[i]]*Exp[I*omegatable5[[i]]*xstar]))/.x-> dx},{i,1,1001,1}];

FR4e = Table[{((α4e[[i]]*I*omegatable5[[i]]-f*(β4e[[i]]))/(2*I*omegatable5[[i]]*Exp[-I*omegatable5[[i]]*xstar]))/.x-> dx},{i,1,1001,1}];

ER5e = Table[{((α5e[[i]]*I*omegatable5[[i]]+f*(β5e[[i]]))/(2*I*omegatable5[[i]]*Exp[I*omegatable5[[i]]*xstar]))/.x-> ex},{i,1,1001,1}];

FR5e = Table[{((α5e[[i]]*I*omegatable5[[i]]-f*(β5e[[i]]))/(2*I*omegatable5[[i]]*Exp[-I*omegatable5[[i]]*xstar]))/.x-> ex},{i,1,1001,1}];

ER6e = Table[{((α6e[[i]]*I*omegatable5[[i]]+f*(β6e[[i]]))/(2*I*omegatable5[[i]]*Exp[I*omegatable5[[i]]*xstar]))/.x-> fx},{i,1,1001,1}];

FR6e = Table[{((α6e[[i]]*I*omegatable5[[i]]-f*(β6e[[i]]))/(2*I*omegatable5[[i]]*Exp[-I*omegatable5[[i]]*xstar]))/.x-> fx},{i,1,1001,1}];

ER7e = Table[{((α7e[[i]]*I*omegatable5[[i]]+f*(β7e[[i]]))/(2*I*omegatable5[[i]]*Exp[I*omegatable5[[i]]*xstar]))/.x-> gx},{i,1,1001,1}];

FR7e = Table[{((α7e[[i]]*I*omegatable5[[i]]-f*(β7e[[i]]))/(2*I*omegatable5[[i]]*Exp[-I*omegatable5[[i]]*xstar]))/.x-> gx},{i,1,1001,1}];

ER8e = Table[{((α8e[[i]]*I*omegatable5[[i]]+f*(β8e[[i]]))/(2*I*omegatable5[[i]]*Exp[I*omegatable5[[i]]*xstar]))/.x-> hx},{i,1,1001,1}];

FR8e = Table[{((α8e[[i]]*I*omegatable5[[i]]-f*(β8e[[i]]))/(2*I*omegatable5[[i]]*Exp[-I*omegatable5[[i]]*xstar]))/.x-> hx},{i,1,1001,1}];

ER9e = Table[{((α9e[[i]]*I*omegatable5[[i]]+f*(β9e[[i]]))/(2*I*omegatable5[[i]]*Exp[I*omegatable5[[i]]*xstar]))/.x-> ix},{i,1,1001,1}];

FR9e = Table[{((α9e[[i]]*I*omegatable5[[i]]-f*(β9e[[i]]))/(2*I*omegatable5[[i]]*Exp[-I*omegatable5[[i]]*xstar]))/.x-> ix},{i,1,1001,1}];

ER10e = Table[{((α10e[[i]]*I*omegatable5[[i]]+f*(β10e[[i]]))/(2*I*omegatable5[[i]]*Exp[I*omegatable5[[i]]*xstar]))/.x-> x0},{i,1,1001,1}];

FR10e = Table[{((α10e[[i]]*I*omegatable5[[i]]-f*(β10e[[i]]))/(2*I*omegatable5[[i]]*Exp[-I*omegatable5[[i]]*xstar]))/.x-> x0},{i,1,1001,1}];

Tcee = Table[{{ax,Part[ER1e[[i]],1]},{bx,Part[ER2e[[i]],1]},{cx,Part[ER3e[[i]],1]},{dx,Part[ER4e[[i]],1]},{ex,Part[ER5e[[i]],1]}, {fx, Part[ER6e[[i]],1]}, {gx, Part[ER7e[[i]],1]},{hx,Part[ER8e[[i]],1]},{ix,Part[ER9e[[i]],1]},{x0,Part[ER10e[[i]],1]}},{i,1,1001,1}];

TceCorrectede = Tcee/.{x_,{{{y_}}}}->{x,y};

Tree =Table[{Part[TceCorrectede[[i]],j,1],Re[Part[TceCorrectede[[i]],j,2]]},{i,1,1001,1},{j,10}];

ERFitre = Table[Fit[Tree[[i]],{1,y,y^2,y^3},y],{i,1,1001,1}];

Tiee =Table[{Part[TceCorrectede[[i]],j,1],Im[Part[TceCorrectede[[i]],j,2]]},{i,1,1001,1},{j,10}];

ERFitie = Table[Fit[Tiee[[i]],{1,y,y^2,y^3},y],{i,1,1001,1}];

Tcfe = Table[{{ax,Part[FR1e[[i]],1]},{bx,Part[FR2e[[i]],1]},{cx,Part[FR3e[[i]],1]},{dx,Part[FR4e[[i]],1]},{ex,Part[FR5e[[i]],1]}, {fx, Part[FR6e[[i]],1]}, {gx, Part[FR7e[[i]],1]},{hx,Part[FR8e[[i]],1]},{ix,Part[FR9e[[i]],1]},{x0,Part[FR10e[[i]],1]}},{i,1,1001,1}];

TcfCorrectede = Tcfe/.{x_,{{{y_}}}}->{x,y};

Trfe =Table[{Part[TcfCorrectede[[i]],j,1],Re[Part[TcfCorrectede[[i]],j,2]]},{i,1,1001,1},{j,10}];

FRFitre = Table[Fit[Trfe[[i]],{1,y,y^2,y^3},y],{i,1,1001,1}];

Tife =Table[{Part[TcfCorrectede[[i]],j,1],Im[Part[TcfCorrectede[[i]],j,2]]},{i,1,1001,1},{j,10}];

FRFitie = Table[Fit[Tife[[i]],{1,y,y^2,y^3},y],{i,1,1001,1}];

ReERfine = Table[{omegatable5[[i]],N[ERFitre[[i]]/.{y-> 1/10}]},{i,1,1001,1}];

ImERfine = Table[{omegatable5[[i]],N[ERFitie[[i]]/.{y-> 1/10}]},{i,1,1001,1}];

ReFRfine = Table[{omegatable5[[i]],N[FRFitre[[i]]/.{y-> 1/10}]},{i,1,1001,1}];

ImFRfine = Table[{omegatable5[[i]],N[FRFitie[[i]]/.{y-> 1/10}]},{i,1,1001,1}];

ER5rp = ListPlot[ReERfine]

ER5ip = ListPlot[ImERfine, PlotRange -> All]

FR5rp = ListPlot[ReFRfine]

FR5ip = ListPlot[ImFRfine, PlotRange-> All]

Logarithmic Plots of All Bands

ER Real:

p1 =ListLogLinearPlot[{ReERfin,ReERfinb,ReERfinc, ReERfind,ReERfine}, PlotRange-> {0,1}, PlotStyle-> Blue, Frame ->  True,FrameLabel-> {"ω'"}, PlotLabel-> Style[Framed["Scattering Parameters Re("<>ToString[Subscript["E",R],StandardForm]<>"), Re("<>ToString[Subscript["F",R],StandardForm]<>") versus frequency"],Black], LabelStyle->Directive[Black],
PlotLabels-> Placed[Style[Subscript["E",R],Black, FontSize-> 14],Above]]

ER Imaginary:

p2 = ListLogLinearPlot[{ImERfin,ImERfinb,ImERfinc, ImERfind,ImERfine}, PlotRange-> All, PlotStyle-> Blue, Frame-> True,FrameLabel-> {"ω'"},PlotLabel-> Style[Framed["Scattering Parameters Im("<>ToString[Subscript["E",R],StandardForm]<>"), Im("<>ToString[Subscript["F",R],StandardForm]<>") versus frequency"],Black], LabelStyle->Directive[Black],PlotLabels-> Placed[Style[Subscript["E",R],Black, FontSize-> 14],Right]]

Show[p1,p2,PlotLabels-> {"ER","FR"}]

p3 = ListLogLinearPlot[{ImERfin,ImERfinb,ImERfinc, ImERfind,ImERfine},PlotRange-> {0,1},PlotStyle-> Blue]

Show[{p1,p3}, PlotRange-> {0,1}]

FR Real:

p4 = ListLogLinearPlot[{ReFRfin,ReFRfinb,ReFRfinc, ReFRfind,ReFRfine}, PlotRange-> {0,1}, PlotStyle-> Red, Frame ->  True,FrameLabel-> {"ω'"},LabelStyle->Directive[Black, Medium],PlotLabels-> Placed[Style[Subscript["F",R],Black, FontSize-> 14],Above]]

Show[{p1,p4}]

Show[%797,ImageSize->Large]

FR Imaginary:

p5 = ListLogLinearPlot[{ImFRfin,ImFRfinb,ImFRfinc, ImFRfind,ImFRfine},PlotRange-> All,PlotStyle-> Red, Frame-> True,FrameLabel-> {"ω'"}, LabelStyle->Directive[Black],PlotLabels-> Placed[Style[Subscript["F",R],Black, FontSize-> 14],Right]]

Show[p2,p5,PlotRange-> All]

Show[%824,ImageSize->Large]

(* Save["ERFRvalues.m",{ReERfin,ReERfinb,ReERfinc, ReERfind, ReERfine, ImERfin, ImERfinb,ImERfinc,ImERfind,ImERfine,ReFRfin, ReFRfinb,ReFRfinc,ReFRfind,ReFRfine,ImFRfin,ImFRfinb,ImFRfinc,ImFRfind,ImFRfine}] *)

f*m^2

Plot[f*m^2, {x, xb,xc}]