Evaluation of Accelerator Physics Experiments for P456/656

Parameters

Off[General::"spell1"]
Clear[eV, S, M]
energy = 1.89 GeV;
length = 0.6  M;
GeV = (10^9) eV; Hz = (1/S); 
    kHz = (10^3) Hz; μrad = (10^(-6)); 
    mM = (10^(-3)) M;
On[General::"spell1"]

Beta function measurement

Quad Q10W

Off[General::"spell1"]
Clear[βx, βy, Δνx, Δνy, Δkl, Δfx, Δfy, Δcu]
Clear[βx, βy]
βx = 
      4  π Δν(x/Δ)kl; βy = -4 π Δν(y/Δ)kl;
Δνx = Δ(fx/f0); Δνy = Δ(fy/f0); f0 = 390130 Hz;
Δkl = Δcu (GeV/energy) 
          6.75 (10^(-5)) (length/(M^2));
focus = 1;
On[General::"spell1"]

Data

flis = {{6902, 202.8, 232.0}, {6976, 203.8, 231.8}, {7030, 204.6, 
            231.6}, {7113, 205.6, 231.4}};

Show[
      GraphicsArray[{Graphics[{RGBColor[1, 0, 0], 
              Line[Map[#[[{1, 2}]] &, flis]], RGBColor[0, 1, 0], 
              PointSize[0.025], Map[Point[#[[{1, 2}]]] &, flis]}, 
            Frame -> True], 
          Graphics[{RGBColor[1, 0, 0], Line[Map[#[[{1, 3}]] &, flis]], 
              RGBColor[0, 1, 0], PointSize[0.025], 
              Map[Point[#[[{1, 3}]]] &, flis]}, Frame -> True]}], 
      ImageSize -> {700, 230}]

Result

Δfx = 
      focus Fit[
            Map[#[[{1, 2}]] &, 
              flis], {1, Δcu}, Δcu][[2]] 
        kHz

Δfy = 
      focus Fit[
            Map[#[[{1, 3}]] &, 
              flis], {1, Δcu}, Δcu][[2]] 
        kHz

Print["βx(Q10W) = ", βx]
Print["βy(Q10W) = ", βy]

Quad Q11E

Off[General::"spell1"]
Clear[βx, βy, Δνx, Δνy, Δkl, Δfx, Δfy, Δcu]
βx = 
      4  π Δν(x/Δ)kl; βy = -4 π Δν(y/Δ)kl;
Δνx = Δ(fx/f0); Δνy = Δ(fy/f0); f0 = 390130 Hz;
Δkl = Δcu (GeV/energy) 
          6.75 (10^(-5)) (length/(M^2));
defocus = -1;
On[General::"spell1"]

Data

flis = {{5025, 203.1, 232.0}, {5075, 202.8, 233.1}, {5125, 202.6, 
            234.4}, {5175, 202.5, 235.4}};

Show[
      GraphicsArray[{Graphics[{RGBColor[1, 0, 0], 
              Line[Map[#[[{1, 2}]] &, flis]], RGBColor[0, 1, 0], 
              PointSize[0.025], Map[Point[#[[{1, 2}]]] &, flis]}, 
            Frame -> True], 
          Graphics[{RGBColor[1, 0, 0], Line[Map[#[[{1, 3}]] &, flis]], 
              RGBColor[0, 1, 0], PointSize[0.025], 
              Map[Point[#[[{1, 3}]]] &, flis]}, Frame -> True]}], 
      ImageSize -> {700, 230}]

Result

Δfx = 
      defocus Fit[
            Map[#[[{1, 2}]] &, 
              flis], {1, Δcu}, Δcu][[2]] 
        kHz

Δfy = 
      defocus Fit[
            Map[#[[{1, 3}]] &, 
              flis], {1, Δcu}, Δcu][[2]] 
        kHz

Print["βx(Q11E) = ", βx]
Print["βy(Q11E) = ", βy]

Optic file

datap = 
        ReadList["optics1.dat", 
          Flatten[{Word, Word, Table[Number, {i, 11}]}]];

Design values for the vertical beta function around the ring:

Show[Graphics[Line[Map[#[[{3, 4}]] &, datap]], Frame -> True], 
      ImageSize -> {700, 350}]

Design values for the horizontal beta function around the ring:

Show[Graphics[Line[Map[#[[{3, 5}]] &, datap]], Frame -> True], 
      ImageSize -> {700, 350}]

Do[If[datap[[n, 1]] == "Q10W", nloc = n; 
        Exit], {n, Length[datap]}]
Print["βx(Q10W) = ", datap[[nloc, 5]]]
Print["βy(Q10W) = ", 
      datap[[nloc, 4]]]

Do[If[datap[[n, 1]] == "Q11E", nloc = n; 
        Exit], {n, Length[datap]}]
Print["βx(Q11E) = ", datap[[nloc, 5]]]
Print["βy(Q11E) = ", 
      datap[[nloc, 4]]]

Closed orbit change

Data

Off[General::"spell1"]
νy = 0.5234;
On[General::"spell1"]

datap = 
        ReadList["optics1.dat", 
          Flatten[{Word, Word, Table[Number, {i, 11}]}]];

Design values for the vertical betatron phase around the ring:

Show[
      Graphics[Line[Map[#[[{3, 12}]] &, datap]], Frame -> True], 
      ImageSize -> {700, 350}]

Off[General::"spell"]
Δy[k_, 
        m_] := ((Sqrt[datap[[k, 4]] datap[[m, 4]]])/(2 
               Sin[π νy])) 
        Cos[Abs[datap[[k, 12]] - 
                datap[[m, 
                    12]]] - π νy]
On[General::"spell"]

Off[General::"spell1"]
m = 0; 
    Do[If[StringMatchQ[datap[[n, 1]], "DET*"], m = m + 1; 
        mloc[m] = n], {n, Length[datap]}]
On[General::"spell1"]

Δθ[cu_] := 
      cu ((1.85  GeV)/energy) μrad

orb693 = 
        ReadList["ORB.95693.dat", 
          Flatten[{Table[Number, {i, 7}], Word, Word}]];

orb696 = 
        ReadList["ORB.95696.dat", 
          Flatten[{Table[Number, {i, 7}], Word, Word}]];

orb697 = 
        ReadList["ORB.95697.dat", 
          Flatten[{Table[Number, {i, 7}], Word, Word}]];

V17W

Do[If[datap[[n, 1]] == "SEX_17W", nloc = n; 
        Exit], {n, Length[datap]}]
Print["βx(Q11E) = ", datap[[nloc, 5]]]
Print["βy(Q11E) = ", 
      datap[[nloc, 4]]]
Print["ψx(Q11E) = ", datap[[nloc, 13]]]
Print["ψy(Q11E) = ", datap[[nloc, 12]]]

Comparison of the three measurements and the theoretical orbit change:

Show[
      Graphics[{Line[
            Table[{datap[[i, 3]], Δy[nloc, i]}, {i, 
                Length[datap]}]], RGBColor[1, 0, 0], PointSize[0.01], 
          Table[Point[{datap[[mloc[i], 
                    3]], ((orb696[[i, 3]] - 
                        orb693[[i, 3]])/Δ)θ[
                        35 + 181] (mM/M)}], {i, Length[orb693]}], 
          RGBColor[1, 0, 1], PointSize[0.01], 
          Table[Point[{datap[[mloc[i], 
                    3]], ((orb697[[i, 3]] - 
                        orb693[[i, 3]])/Δ)θ[
                        202 + 181] (mM/M)}], {i, Length[orb693]}], 
          RGBColor[0, 0, 1], PointSize[0.01], 
          Table[Point[{datap[[mloc[i], 
                    3]], ((orb697[[i, 3]] - 
                        orb696[[i, 3]])/Δ)θ[
                        202 - 35] (mM/M)}], {i, Length[orb696]}], 
          RGBColor[0, 1, 0], PointSize[0.015], 
          Point[{datap[[nloc, 3]], Δy[nloc, nloc]}]}, 
        Frame -> True], ImageSize -> {700, 350}, 
      PlotRange -> All]

V33W

Do[If[datap[[n, 1]] == "SEX_33W", nloc = n; 
        Exit], {n, Length[datap]}]
Print["βx(Q11E) = ", datap[[nloc, 5]]]
Print["βy(Q11E) = ", 
      datap[[nloc, 4]]]
Print["ψx(Q11E) = ", datap[[nloc, 13]]]
Print["ψy(Q11E) = ", datap[[nloc, 12]]]

\(For\ this\ corrector\ no\ orbits\ were\ taken . \ \ Since\ the\ fractional\ part\ of\ the\ vertical\ betatron\ phase\ is\ 0.15, \ 
    while\ it\ was\ 0.18\ above\ 1\/2\ in\ the\ previous\ case, \ 
    the\ two\ orbits\ agree\ relatively\ well, \ 
    except\ for\ a\ minus\ sign\ and\ except\ for\ the\ region\ between\ the\ \(\(correctors\)\(.\)\)\)

Comparison of the three measurements  at V17W and the theoretical orbit change due to V33W:

Show[
      Graphics[{Line[
            Table[{datap[[i, 3]], Δy[nloc, i]}, {i, 
                Length[datap]}]], RGBColor[1, 0, 0], PointSize[0.01], 
          Table[Point[{datap[[mloc[i], 
                    3]], ((orb696[[i, 3]] - 
                        orb693[[i, 3]])/(-Δθ[
                          35 + 181])) (mM/M)}], {i, Length[orb693]}], 
          RGBColor[1, 0, 1], PointSize[0.01], 
          Table[Point[{datap[[mloc[i], 
                    3]], ((orb697[[i, 3]] - 
                        orb693[[i, 3]])/(-Δθ[
                          202 + 181])) (mM/M)}], {i, Length[orb693]}], 
          RGBColor[0, 0, 1], PointSize[0.01], 
          Table[Point[{datap[[mloc[i], 
                    3]], ((orb697[[i, 3]] - 
                        orb696[[i, 3]])/(-Δθ[
                          202 - 35])) (mM/M)}], {i, Length[orb696]}], 
          RGBColor[0, 1, 0], PointSize[0.015], 
          Point[{datap[[nloc, 3]], Δy[nloc, nloc]}]}, 
        Frame -> True], ImageSize -> {700, 350}, 
      PlotRange -> All]

Dispersion

αp = 0.01130;

orb698 = 
      ReadList["ORB.95698.dat", 
        Flatten[{Table[Number, {i, 7}], Word, Word}]]; 
    orb700 = ReadList["ORB.95700.dat", 
        Flatten[{Table[Number, {i, 7}], Word, Word}]]; 
    orb702 = ReadList["ORB.95702.dat", 
        Flatten[{Table[Number, {i, 7}], Word, Word}]]; 
    orb703 = ReadList["ORB.95703.dat", 
        Flatten[{Table[Number, {i, 7}], Word, Word}]]; 
    orb704 = ReadList["ORB.95704.dat", 
        Flatten[{Table[Number, {i, 7}], Word, Word}]]; 
    orb705 = ReadList["ORB.95705.dat", 
        Flatten[{Table[Number, {i, 7}], Word, Word}]];

Do[dxdf[i] = 
        Fit[{{499.758433, orb705[[i, 2]]}, {499.759490, 
              orb704[[i, 2]]}, {499.760600, 
              orb703[[i, 2]]}, {499.761630, 
              orb698[[i, 2]]}, {499.762760, 
              orb700[[i, 2]]}, {499.764670, 
              orb702[[i, 
                  2]]}}, {1, Δfrf}, Δfrf], {i, 
        Length[orb698]}]

Display of the dispersion fit at all detectors for quality control:

Do[Show[
        Graphics[{PointSize[0.015], RGBColor[1, 0, 0], 
            Map[Point[#] &, {{499.758433, orb705[[i, 2]]}, {499.759490, 
                  orb704[[i, 2]]}, {499.760600, 
                  orb703[[i, 2]]}, {499.761630, 
                  orb698[[i, 2]]}, {499.762760, 
                  orb700[[i, 2]]}, {499.764670, orb702[[i, 2]]}}], 
            RGBColor[0, 1, 0], 
            Line[{{499.758433, 
                  dxdf[i] /. Δfrf -> 499.758433}, {499.764670, 
                  dxdf[i] /. Δfrf -> 499.764670}}]}, 
          Frame -> True, Axes -> False, 
          ImageSize -> {600, 300}]], {i, Length[orb698]}]

Comparison of measured dispersion and theoretical dispersion:

Show[
      Graphics[{Line[
            Table[{datap[[i, 3]], datap[[i, 9]]}, {i, 
                Length[datap]}]], PointSize[0.01], RGBColor[1, 0, 0], 
          Table[Point[{datap[[mloc[i], 
                    3]], -(mM/M) αp dxdf[
                        i][[2]] /. Δfrf -> 
                    499.760600}], {i, Length[orb698]}]}, Frame -> True], 
      ImageSize -> {700, 350}, PlotRange -> All]