Compensation experiment (7 July 2009)

Post-processing

SC=59648;
myDATA=Import[
StringJoin[
"/Users/sterbini/Work/BBLR 2009/MD_DATA/Mathematica/BCT/",
ToString[SC],
".txt"
], "Table"
][[2]];
myFit=I0 (1-(t/T));
myFitValues=FindFit[myDATA[[200;;580]],myFit,{I0,T} ,t]
myFitValues[[2,2]]*10/1000/3600
myFit=myFit/.Join[myFitValues,{ t -> t - 200}]
Show[ListPlot[myDATA], Plot[myFit, {t,230,580}, PlotStyle->{Red,Thick}]]

myDATA[[200]]

myFit /. myFitValues

Join[myFitValues,{ t -> t - 200}]

Lifetime[SC_]:=Module[{myDATA,myFit},
myDATA=Import[
StringJoin[
"/Users/sterbini/Work/BBLR 2009/MD_DATA/Mathematica/BCT/",
ToString[SC],
".txt"
], "Table"
][[2]];
myFit=I0 (1-(t/T));
myFitValues=FindFit[myDATA[[230;;600]],myFit,{I0,T} ,t];
myFitValues[[2,2]]*10/1000/3600]

Compensation 250+250 at ≈10 σ

{.1357, .2324}
Lifetime[#]& /@ {59557,59558,59559}
p1={%%[[2]], #}&/@ %

{.1357, .2464}
Lifetime[#]& /@ {59568,59569,59570,59571}
p2={%%[[2]], #}&/@ %

{.1357, .2178}
Lifetime[#]& /@ {59572,59573}
p3={%%[[2]], #}&/@ %

{.1357, .2031}
Lifetime[#] & /@ {59577, 59578,59579}
p4={%%[[2]], #}&/@ %

{.1357, .1885}
Lifetime[#] & /@ {59582, 59583, 59580, 59581}
p5={%%[[2]], #}&/@ %

{.1357, .1748}
Lifetime[#] & /@ {59584, 59585, 59586}
p6={%%[[2]], #}&/@ %

{.1357, .1602}
Lifetime[#] & /@ {59587, 59588, 59589}
p7={%%[[2]], #}&/@ %

{.1357, .1465}
Lifetime[#] & /@ {59590}
p8={%%[[2]], #}&/@ %

{.1357, .1357}
Lifetime[#] & /@ {59591,59592,59593,59594}
p9={%%[[2]], #}&/@ %

A=ListLogPlot[Join[p1,p2,p3,p4,p5,p6,p7,p8,p9], PlotRange->Full, PlotMarkers->◆, PlotStyle->Blue]

Wire off at 10 σ

{.1356,.2441}
Lifetime[#]& /@ {59638}
p1={%%[[2]], #}&/@ %

{.1356,.2295}
Lifetime[#]& /@ {59642,59643}
p2={%%[[2]], #}&/@ %

{.1356, .2148}
Lifetime[#] & /@ {59645}
p3 = {%%[[2]], #} & /@ %

{.1356, .2012}
Lifetime[#] & /@ {59646,59647}
p4 = {%%[[2]], #} & /@ %

{.1356, .1875}
Lifetime[#] & /@ {59648,59650,59654}
p5 = {%%[[2]], #} & /@ %

{.1356, .1719}
Lifetime[#] & /@ {59655,59656,59658}
p6 = {%%[[2]], #} & /@ %

{.1356, .1592}
Lifetime[#] & /@ {59660,59661,59662}
p7 = {%%[[2]], #} & /@ %

{.1356, .1445}
Lifetime[#] & /@ {59663,59664}
p8 = {%%[[2]], #} & /@ %

B=ListLogPlot[Join[p1,p2,p3,p4,p5,p6,p7,p8], PlotRange->Full, PlotStyle->Red, GridLines->Automatic, PlotMarkers->■]

Show[B,A, Frame->True, BaseStyle->myBaseStyle, FrameLabel-> {"(Subscript[Q, V])", "Lifetime [h]"}]

W1 at 250 and W2 off at 10 σ

{.1289,.1514}
Lifetime[#] & /@ {59607,59608,59606}
p1 = {%%[[2]], #} & /@ %

{.1289,.165}
Lifetime[#] & /@ {59609}
p2 = {%%[[2]], #} & /@ %

{.1289,.1797}
Lifetime[#] & /@ {59610,59612,59614}
p3 = {%%[[2]], #} & /@ %

{.1289,.1934}
Lifetime[#] & /@ {59622,59623}
p4 = {%%[[2]], #} & /@ %

{.1289, .207}
Lifetime[#] & /@ {59624, 59625,59626}
p5 = {%%[[2]], #} & /@ %

{.1289, .2217}
Lifetime[#] & /@ {59627,59628}
p6 = {%%[[2]], #} & /@ %

{.1289, .2373}
Lifetime[#] & /@ {59629,59630,59631,59632}
p7 = {%%[[2]], #} & /@ %

{.1289, .2352}
Lifetime[#] & /@ {59633,59635,59636}
p8 = {%%[[2]], #} & /@ %

cPlot = ListLogPlot[Join[p1, p2, p3, p4, p5, p6, p7, p8], PlotRange -> Full, PlotStyle -> Black, GridLines -> Automatic, PlotMarkers->▲]

Results

CompensationPlot=Show[B,A,cPlot,
Graphics[{
{Red,Text["■", {.138,0}]},{Text[ "No excitation",{.14,0}, {-1,0}, Background->White]},
{Black,Text["▲", {.138,-.35}]},{Text[ "Excitation",{.14,-.35}, {-1,0}, Background->White]},
{Blue,Text["◆", {.138,-.7}]},{Text[ "Compensation",{.14,-.7}, {-1,0}, Background->White]}
}],
 Frame->True, BaseStyle->myBaseStyle,PlotRange->{Automatic, Automatic}, FrameLabel-> {"(Subscript[Q, V]), 10σ separation, W1@250A, W2@250A, 55 GeV/c with (Subscript[ϵ, n])≃1.5 μm rad, WP at ()", "Lifetime [h]"}]

Compensation (8 July 2009)

In the morning we studied compensation again.

Post-processing

Lifetime[#]& /@ {61039,61040,61041, 61042, 61044};
p1={250, #}&/@ %
Lifetime[#]& /@ {61046,61047,61048, 61049, 61050};
p2={200, #}&/@ %
Lifetime[#]& /@ {61051,61057,61058, 61059};
p3={150, #}&/@ %
Lifetime[#]& /@ {61060,61062,61063};
p4={100, #}&/@ %
Lifetime[#]& /@ {61066,61067,61068,61069};
p5={50, #}&/@ %
Lifetime[#]& /@ {61071,61072,61073,61074};
p6={0, #}&/@ %

w1Fixed=ListPlot[Join[p1,p2,p3,p4,p5,p6], PlotRange->{{-10,300}, Automatic}, PlotMarkers->"▲", PlotStyle->Red, FrameLabel->{"Wire current [A], WP at (0.136,0.178)", "Lifetime [h]"}]

Lifetime[#]& /@ {61039,61040,61041, 61042, 61044};
p1={250, #}&/@ %
Lifetime[#]& /@ {61091,61092,61093};
p2={200, #}&/@ %
Lifetime[#]& /@ {61096,61097,61098, 61099};
p3={150, #}&/@ %
Lifetime[#]& /@ {61112,61113,61114, 61115,61116};
p4={100, #}&/@ %
Lifetime[#]& /@ {61121,61122,61123};
p5={50, #}&/@ %
Lifetime[#]& /@ {61126,61127,61128};
p6={0, #}&/@ %

w2Fixed=ListPlot[Join[p1, p2, p3, p4, p5, p6], PlotRange -> {{-10, 300}, Automatic}, PlotMarkers -> "■", PlotStyle -> Blue, FrameLabel -> {"Wire current [A]", "Lifetime [h]"}]

Results

Show[w1Fixed,w2Fixed,
Graphics[{{Red,Text["▲",{0,.075}]}, Text["I1@250, I2 varying", {10,.075}, {-1,0}, Background->White]}],
Graphics[{{Blue,Text["■",{0,.068}]}, Text["I2@250, I1 varying", {10,.068}, {-1,0}, Background->White]}],
 PlotRange->{{-10,260}, {0,.08}},FrameLabel -> {"Wire current [A], WP at (0.136,0.178), ≈10σ separation, 55 GeV/c with (Subscript[ϵ, n])≃1.5 μm rad", "Lifetime [h]"}]

From the previous plot an asymmetry appears for I=0: this can be due to a different separation or to the differnt sign of the ΔQ. For investigating we tried to invert the polarity of one of the two wires but we did not menaged.

In the afternoon we prepared the emittance blowup (vertical damper exciting at the betatron frequency).

Excitation (9 July 2009)

Distance scan at 200 A

Lifetime[63193]

{1,2,3,4,5,6}+1

63188+Range[0,5]

Lifetime[#] & /@ (63188+Range[0,5]);
p1={11./2, #}&/@ %

Lifetime[#] & /@ (63199+Range[0,4]);
p2={12./2, #}&/@ %

Lifetime[#] & /@ (63207+Range[0,4]);
p3={13./2, #}&/@ %

Lifetime[#] & /@ (63212+Range[0,4]);
p4={14./2, #}&/@ %

Lifetime[#] & /@ (63231+Range[0,4]);
p5={15./2, #}&/@ %

Lifetime[#] & /@ (63243+{0,1,2,4,5,6});
p6={16./2, #}&/@ %

Lifetime[#] & /@ (63253+Range[0,4]);
p7={17./2, #}&/@ %

Lifetime[#] & /@ (63271 + Range[0,4]);
p8 = {18./2, #} & /@ %

Lifetime[#] & /@ (63277 + Range[0,4]);
p9 = {19./2, #} & /@ %

Lifetime[#] & /@ (63286 + Range[0,4]);
p10= {20./2, #} & /@ %

Lifetime[#] & /@ (63310 + {0,1,3,4,5,6});
p11= {20./2, #} & /@ %

Lifetime[#] & /@ (63342 +  Range[0,4]);
p12= {11./2, #} & /@ %

Lifetime[#] & /@ (63349 +  Range[0,4]);
p13= {13./2, #} & /@ %

Lifetime[#] & /@ (63358 +  {0,1,2,3,6});
p14= {15./2, #} & /@ %

Lifetime[#] & /@ (63367 +  {0,3,1,2,3});
p15= {17./2, #} & /@ %

Lifetime[#] & /@ (63375 +  Range[0,4]);
p16= {19./2, #} & /@ %

Results distance scan

Show[ListLogPlot[Join[p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p12,p13,p14,p15,p16], PlotRange->{{5,10.5}, {.06,17}}, GridLines->Automatic, PlotMarkers->●, PlotStyle->Blue],
ListLogPlot[p11, PlotMarkers->▲, PlotStyle->Red],
Graphics[{{Blue,Text["●",{5.5,2.5}]}, Text["I1@200, I2@0", {5.7,2.5}, {-1,0}, Background->White]}],
Graphics[{{Red,Text["▲",{5.5,2.}]}, Text["I1@0, I2@0", {5.7,2.}, {-1,0}, Background->White]}],
 Frame->True, BaseStyle->myBaseStyle, FrameLabel->{"Separation Beam-Wire [σ], WP at (0.31, 0.28), 55 GeV/c with (Subscript[ϵ, n])≃1.5 μm rad", "Lifetime [h]"}]

Current scan at 5 σ

Lifetime[#] & /@ (63776+Range[0,5]);
p0a={0, #}&/@ %

Lifetime[#] & /@ (63855+{0,1,4,5});
p0b={0, #}&/@ %

Lifetime[#] & /@ (63806+Range[0,4]);
p1={250, #}&/@ %

Lifetime[#] & /@ (63815+Range[0,4]);
p2={200, #}&/@ %

Lifetime[#] & /@ (63827+Range[0,4]);
p3={150, #}&/@ %

Lifetime[#] & /@ (63835+Range[0,4]);
p4={100, #}&/@ %

Lifetime[#] & /@ (63844+Range[0,4]);
p5={50, #}&/@ %

currentScan5sigma=ListLogPlot[Join[p1,p2,p3,p4,p5,p0a,p0b], Frame->True, BaseStyle->myBaseStyle, GridLines->Automatic, PlotMarkers->●, PlotStyle->Blue, FrameLabel->{"I1 [A]", "Lifetime [h]"}]

Current scan at 7 σ

Lifetime[#] & /@ (63871+Range[0,4]);
p0a={0, #}&/@ %

Lifetime[#] & /@ (63926+{1,2,3,6});
p0b={0, #}&/@ %

Lifetime[#] & /@ (63882+Range[0,4]);
p1={250, #}&/@ %

Lifetime[#] & /@ (63889+Range[0,4]);
p2={200, #}&/@ %

Lifetime[#] & /@ (63897+Range[0,4]);
p3={150, #}&/@ %

Lifetime[#] & /@ (63902+Range[0,4]);
p4={100, #}&/@ %

Lifetime[#] & /@ (63910+Range[0,4]);
p5={50, #}&/@ %

currentScan7sigma=ListLogPlot[Join[p1,p2,p3,p4,p5,p0a,p0b], Frame->True, BaseStyle->myBaseStyle, GridLines->Automatic, PlotMarkers->▲, PlotStyle->Red, FrameLabel->{"I1 [A]", "Lifetime [h]"}]

Results current scan

Show[currentScan5sigma,currentScan7sigma, mySecondScan,
Graphics[{{Red,Text["▲",{200-25,1.8}]},Text["7σ sep, (Subscript[ϵ, n])≈ 3μm rad",{208-25,1.8}, {-1,0}, Background->White] }],
Graphics[{{Blue,Text["●",{200-25,1.4}]},Text["5σ sep, (Subscript[ϵ, n])≈ 3μm rad",{208-25,1.4}, {-1,0}, Background->White] }],
Graphics[{{Black,Text["◆",{200-25,1.}]},Text["7σ sep, (Subscript[ϵ, n])≈ 2μm rad",{208-25,1.}, {-1,0}, Background->White] }],
FrameLabel->{"I1 [A], I2=0, WP at (0.31, 0.28), 55 GeV/c", "Lifetime [h]"}]

Excitation (13 July 2009): current scan at 7 sigma with WP (0.31, 0.28)

Combined in the plot above.

myData=Import["/Users/sterbini/Work/BBLR 2009/log13July.xls", "xls"];
myData=myData[[1,2;;]];
mySecondScan=ListLogPlot[myData[[All,{4,3}]], PlotRange->{{0,300}, {0,1}}, FrameLabel->{"W1 current [A], 7σ separation at (0.31, 0.28), 55 GeV/c and (Subscript[ϵ, n])≃2 μm rad", "Lifetime [h]"}, PlotMarkers->"◆", PlotStyle->Black, Frame->True,GridLines->Automatic ]