T1000717-v6
ETM HWS imaging solution - (distances pulled from G1100873). Full ETM distancs

Data from T0900385 - v06 and G1100873. [Lab book 13 - page 5 & page 10]
Telescope parabolic T1 RoC 			4000 mm 
Telescope parabolic T2 RoC			-200 mm

Telescope M1 to M2					1902.6 mm
Distance from ETM to Telescope		1429 mm

ETM curvature						2245 m
ETM thickness						20cm
ITM curvature						1934 m
Arm Length							3995 m
Lambda								532 nm
ETM substrate: Fused silica: 		n = 1.46089


Imaging solution
M2 to f0	(distance)				[5273, 4314]mm
   [M2 to in-vac PM]						= 762mm + 604mm = 1366mm (D1002460)
   [in-vac periscope mirror to ALS table] 	= 1858mm (D0900435, D0902168, D0900436, D0902163)
   [ALS input to top periscope] 			= 101mm (D1201448)
   [top periscope mirror to bottom] 		= 419mm (D1201448)
   [BPM to f0] - X 							= 1529mm (D1201448)
   [BPM to f0] - Y 							= 570mm (D1100607)
   
f0 			(focal length)			2236.1 mm 	[CVI PLCX-50.8-1030.2-UV-532]
f0 to f1: 	(distance)				610 mm
f1			(focal length)			2236.1 mm 	[CVI PLCX-25.4-1030.2-UV-532]
f1 to f2	(distance)				[928.3, 1079.0] mm
f2			(focal length)			-0.5589 mm 	[CVI PLCC-25.4-257.2-UV-532]
f2 to HWS	(distance)				[1308, 903.6] mm

-v6 notes: added the fiber launching model

Y - Arm

Start with the CVI Lenses and determine all solutions based on the nominal lens positions : Y

XorYDist =  4.314
L0Dist = 0.61

Load CVI Lenses

CVILenses1 = {-279.6,-335.4,-391.3,-448.4,-558.9,-670.9,-1118.1,-1677,670.9,782.7,1118.1,1677,2236.1,3353.5,4471.4,5589.2,8384.9,11180.6}/1000.;

(*CVILenses1 ={-1000,-600,-625,-500,-400,-350,-300,-250,-175,-175,-150,-125,-125,-125,-100,-100,-100,-75,-75,-75,-62.5,-50,-50,-40,-37.5,-30,-25,-25,-20,-15,-12.5,-10,10,10,10,12.5,12.5,15,15,20,20,25,25,25,25,30,30,37.5,37.5,40,40,50,50,50,50,50,50,62.5,62.5,75,75,75,75,100,100,100,125,125,125,150,150,175,175,175,200,200,250,250,250,250,300,300,350,375,500,500,600,625,750,800,1000,1000,1500,1500,2000,2000}/1000.0;*)

Length[CVILenses1]

Determine ABCD matrices

ABCDList =(({{1, L2}, {0, 1}})).(({{1, 0}, {-1/f2, 1}})).(({{1, L1}, {0, 1}})).(({{1, 0}, {-1/f1, 1}})).(({{1, L0}, {0, 1}})).(({{1, 0}, {-1/f0, 1}})). (({{1, T2toISCT}, {0, 1}})).(({{1, 0}, {-2/T2RoC, 1}})).(({{1, T1toT2}, {0, 1}})).(({{1, 0}, {-2/T1RoC, 1}})).(({{1, ETMtoT1}, {0, 1}})) ;

ABCD with distances substituted in

CVILenses2 = Union[CVILenses1,CVILenses1];
ABCDSub = Simplify[ABCDList/. {ETMtoT1-> 1.429, T1RoC-> 4.0, T1toT2-> 1.9026, T2RoC-> -0.2, T2toISCT-> XorYDist, L0-> L0Dist}];

s1 = Solve[{ABCDSub[[1]][[2]] == 0},  L2];
ABCDSub2 = Simplify[ABCDSub/. s1[[1]]];
s2 =  Solve[{ABCDSub2[[2]][[2]] == -20.5},  L1];
ABCDSub3 = Simplify[ABCDSub2/. s2[[1]]];


resultN = Table[0, {ii, Length[CVILenses2]^3}];
countN = 1;
resultGood = {};
For[ii=1, ii≤ Length[CVILenses2], ii++, {

For[jj=1, jj≤ Length[CVILenses2], jj++, {
For[kk=1, kk≤ Length[CVILenses2], kk++, {
For[mm =1, mm≤ 1, mm++, {
f0A = CVILenses2[[ii]];
f1A =  CVILenses2[[jj]];
f2A =   CVILenses2[[kk]];


ABCDOut = ABCDSub/. {f0-> f0A, f1-> f1A, f2-> f2A};
ABCDSub3A = ABCDSub3/. {f0-> f0A, f1-> f1A, f2-> f2A};


L2A = ((L2/. s1[[1]])/. s2[[1]])/.  {f0-> f0A, f1-> f1A, f2-> f2A};
L1A = (L1/. s2[[1]])/. {f0-> f0A, f1-> f1A, f2-> f2A};

If[(L1A > 0.7)  && (L2A>0.7) &&(L1A<1.5)&&(L2A< 1.5), {
resultGood = Append[resultGood, {ii,jj,kk,L1A, L2A, ABCDSub3A[[2]][[1]]}];
}];
countN = countN+ 1;




}];
}];

}];
Print[{ii, Length[CVILenses2], Length[resultGood]}]
}];

CList = Table[{Abs[resultGood[[ii]][[6]]], resultGood[[ii]][[4]],resultGood[[ii]][[5]],  CVILenses2[[resultGood[[ii]][[1]]]], CVILenses2[[resultGood[[ii]][[2]]]], CVILenses2[[resultGood[[ii]][[3]]]]}, {ii, Length[resultGood]}];
CList2 = Sort[CList];
CList3 = Table[{Abs[If[CVILenses2[[resultGood[[ii]][[1]]]]==CVILenses2[[resultGood[[ii]][[2]]]] ||CVILenses2[[resultGood[[ii]][[3]]]]==CVILenses2[[resultGood[[ii]][[2]]]]||CVILenses2[[resultGood[[ii]][[1]]]]==CVILenses2[[resultGood[[ii]][[3]]]], 25,1]*(1/Abs[resultGood[[ii]][[6]]])* CVILenses2[[resultGood[[ii]][[1]]]]* CVILenses2[[resultGood[[ii]][[2]]]]* CVILenses2[[resultGood[[ii]][[3]]]]],resultGood[[ii]][[6]], resultGood[[ii]][[4]],resultGood[[ii]][[5]],  CVILenses2[[resultGood[[ii]][[1]]]], CVILenses2[[resultGood[[ii]][[2]]]], CVILenses2[[resultGood[[ii]][[3]]]]}, {ii, Length[resultGood]}];
CList4 = Sort[CList3];

solnF = CList4[[Length[CList4]-1]]
L1S = solnF[[3]];
L2S = solnF[[4]];
f0S = solnF[[5]];
f1S = solnF[[6]];
f2S = solnF[[7]];

solnSimple = {f0-> f0S, f1-> f1S, f2-> f2S, L0->L0Dist, L1-> L1S, L2-> L2S, M2tof0-> 4.314}
solnSimpleY = solnSimple

MatrixForm[CList4]

Rest

Create Function to Determine Output Radius and Beam Size and to plot the Beam

OutRW[wIN_, RIN_, λIN_,ABCD_]:= Module[{},
Q1Inv = (1/RIN)- ((I λIN)/(Pi wIN^2));
Q1a = 1/Q1Inv;
Q2temp = ((ABCD[[1]][[1]]Q1a + ABCD[[1]][[2]])/(ABCD[[2]][[1]]Q1a + ABCD[[2]][[2]]));
Q2Inv = 1/Q2temp;
ROut = Re[Q2Inv]^-1;
wOut = Sqrt[((-λIN)/(Pi Im[Q2Inv]))];
Return[{ROut, wOut}];
];
FindNearestWaist[wIN_, RIN_, λIN_]:= Module[{},
Q1Inv = (1/RIN)- ((I λIN)/(Pi wIN^2));
Q1a = 1/Q1Inv;


Q2temp = Q1a;
Q2tempR = Re[Q2temp]+x0;
Q2tempI = Im[Q2temp];
Q2InvR = (Q2tempR/(Q2tempR^2 + Q2tempI^2));


ROut = Q2InvR^(-1);

solnIN = Solve[1/ROut == 0, x0];


Return[x0/.solnIN[[1]]];
];

PlotTheBeamPropagation[ABCDList_, RWInputMode_, λIN_]:=Module[{},
z0 = 0;
plotList = {};
count1 = 0;
For[ii=1, ii≤ Length[ABCDList], ii++, {
M1IN = ABCDList[[ii]];

plotAll = Plot[0*x, {x, 0, 0.00001}];
If[M1IN[[1]][[2]]≠ 0, {
MOut = (({{1, 0}, {0, 1}}));
For[jj=1, jj≤ ii-1, jj++, {
MOut = ABCDList[[jj]].MOut;
}];
MOut = (({{1, zIN-z0}, {0, 1}})).MOut;

eqOut = OutRW[RWInputMode[[2]], RWInputMode[[1]], λIN, MOut];

plotA = Plot[eqOut[[2]]*1000, {zIN, z0, ABCDList[[ii]][[1]][[2]]+z0}, PlotRange-> {{0, ABCDList[[ii]][[1]][[2]]+z0}, {0, Automatic}}, Frame->True, FrameLabel-> {"Propagation Distance (m)", "Beam Size (mm)"}, PlotStyle-> If[Mod[count1, 2]==0, Blue, Red]];

plotList = Append[plotList, plotA];
count1 = count1 + 1;

z0 = ABCDList[[ii]][[1]][[2]]+z0;

plotAll = Show[plotA,plotAll];
 
}];
}];
plotAll = plotList[[1]];
For[ii=2, ii≤ Length[plotList], ii++, {
plotAll = Show[plotList[[ii]],plotAll];
}];
Show[plotAll, PlotRange-> {{0,z0}, {0, Automatic}}]
];
LogPlotTheBeamPropagation[ABCDList_, RWInputMode_, λIN_]:=Module[{},
z0 = 0;
plotList = {};
count1 = 0;

tableOut = {};
For[ii=1, ii≤ Length[ABCDList], ii++, {
M1IN = ABCDList[[ii]];

plotAll = Plot[0*x, {x, 0, 0.00001}];

If[M1IN[[1]][[2]]≠ 0, {
MOut = (({{1, 0}, {0, 1}}));
For[jj=1, jj≤ ii-1, jj++, {
MOut = ABCDList[[jj]].MOut;
}];
MOut = (({{1, zIN-z0}, {0, 1}})).MOut;

eqOut = OutRW[RWInputMode[[2]], RWInputMode[[1]], λIN, MOut];
For[kk = z0*1000, kk≤ ( ABCDList[[ii]][[1]][[2]]+z0)*1000, kk++, {
tableOut = Append[tableOut, {kk, eqOut[[2]]*1000/. zIN-> kk/1000}];
}];


plotA = LogPlot[eqOut[[2]]*1000, {zIN, z0, ABCDList[[ii]][[1]][[2]]+z0}, PlotRange-> {{0, ABCDList[[ii]][[1]][[2]]+z0}, Automatic},Frame-> True,PlotStyle-> If[Mod[count1, 2]==0, Blue, Red]];

plotList = Append[plotList, plotA];
count1 = count1 + 1;

z0 = ABCDList[[ii]][[1]][[2]]+z0;

plotAll = Show[plotA,plotAll];
 
}];
}];
plotAll = plotList[[1]];
For[ii=2, ii≤ Length[plotList], ii++, {
plotAll = Show[plotList[[ii]],plotAll];
}];
Show[plotAll, PlotRange-> {{0,z0}, Automatic}]
];
PlotTheBeamPropagation[{(({{1, 1.0}, {0, 1}})), (({{1, 0}, {-1/1.5, 1}})), (({{1, 1.7}, {0, 1}})), (({{1, 0}, {-1/0.5, 1}})), (({{1, 0.7}, {0, 1}}))}, {1000, 0.001}]

Arm cavity parameters

Arm Cavity parameters

λg = 532*10^-9.0;
ArmLength = 3995;
RETM = 2307;
RITM = 2312;

nFusedSilica532 = 1.46071;
ETMthick = 0.2;

T1RoC = 4.0;
T2RoC = -0.2;
T1toT2 = 1.9026;
ETMtoT1 = 1.429;
T2toISCT = 4.680;


gETM = 1 - (ArmLength/RETM);
gITM = 1 - (ArmLength/RITM);

wETM = Sqrt[((ArmLength λg)/Pi) Sqrt[(gITM/(gETM(1- gITM gETM)))]]
wETM1064 = Sqrt[((ArmLength 1064*10^-9.)/Pi) Sqrt[(gITM/(gETM(1- gITM gETM)))]]

Cavity Mode - and snippet to show that the beam size is increasing as we propagate out from cavity past ETM

OutModeFromCavityRW = {RETM, wETM}
OutRW[OutModeFromCavityRW[[2]], OutModeFromCavityRW[[1]], λg, (({{1, 10.0}, {0, 1}}))]

ETM as a Lens

ETMOutmatrix = (({{1, 0}, {0 , (nFusedSilica532/1)}})).(({{1, ETMthick}, {0 , 1}})).(({{1, 0}, {((1 -nFusedSilica532)/(-RETM nFusedSilica532)) , (1/nFusedSilica532)}}));
RETMn = -RETM/nFusedSilica532;
ETMAsMirror = (({{1, 0}, {-2/RETMn , 1}}));
OutRW[OutModeFromCavityRW[[2]], OutModeFromCavityRW[[1]], λg, (({{1, 100.0}, {0, 1}})).ETMOutmatrix];
OutModeFromETMRW = OutRW[OutModeFromCavityRW[[2]], OutModeFromCavityRW[[1]], λg, ETMOutmatrix]

Plot the output

ABCDList =Reverse[ {(({{1, L2}, {0, 1}})),(({{1, 0}, {-1/f2, 1}})),(({{1, L1}, {0, 1}})),(({{1, 0}, {-1/f1, 1}})),(({{1, L0}, {0, 1}})),(({{1, 0}, {-1/f0, 1}})), (({{1, T2toISCT}, {0, 1}})),(({{1, 0}, {-2/T2RoC, 1}})),(({{1, T1toT2}, {0, 1}})),(({{1, 0}, {-2/T1RoC, 1}})),(({{1, ETMtoT1}, {0, 1}}))}]/.solnSimple ;

plot1 = PlotTheBeamPropagation[ABCDList, OutModeFromETMRW, λg]
plot2 = LogPlotTheBeamPropagation[ABCDList, OutModeFromETMRW, λg]

ListLogPlot[tableOut, Joined-> True, Frame-> True, GridLines-> Automatic,FrameLabel-> {"Propagation Distance (mm)", "Beam radius (mm)", "Hartmann probe beam from ETM_HR to HWS"}]
ListLogPlot[tableOut, Joined-> True, Frame-> True, GridLines-> Automatic,FrameLabel-> {"Propagation Distance (mm)", "Beam radius (mm)", "Hartmann probe beam from periscope to HWS"}, PlotRange-> {{4000, 11000}, {0.1, 4}}]

M1 = (({{1, L2}, {0, 1}})).(({{1, 0}, {-1/f2, 1}})).(({{1, L1}, {0, 1}})).(({{1, 0}, {-1/f1, 1}})).(({{1, L0}, {0, 1}})).(({{1, 0}, {-1/f0, 1}})). (({{1, T2toISCT}, {0, 1}})).(({{1, 0}, {-2/T2RoC, 1}})).(({{1, T1toT2}, {0, 1}})).(({{1, 0}, {-2/T1RoC, 1}})).(({{1, ETMtoT1}, {0, 1}}))/.solnSimple ;
MatrixForm[Simplify[M1]]

ETMY fiber launcher plot

Plot the output for ETMY

solnSimple = solnSimpleY

ABCDList =Reverse[ {(({{1, L2}, {0, 1}})),(({{1, 0}, {-1/f2, 1}})),(({{1, L1}, {0, 1}})),(({{1, 0}, {-1/f1, 1}})),(({{1, L0}, {0, 1}})),(({{1, 0}, {-1/f0, 1}})), (({{1, M2tof0}, {0, 1}})),(({{1, 0}, {-2/T2RoC, 1}})),(({{1, T1toT2}, {0, 1}})),(({{1, 0}, {-2/T1RoC, 1}})),(({{1, ETMtoT1}, {0, 1}}))}]/.solnSimple ;
OutModeFromETMRW = {1579.4958047124749`,0.08141979105529595`}
plot1 = PlotTheBeamPropagation[ABCDList, OutModeFromETMRW, λg]
plot2 = LogPlotTheBeamPropagation[ABCDList, OutModeFromETMRW, λg]

ListLogPlot[tableOut, Joined-> True, Frame-> True, GridLines-> Automatic,FrameLabel-> {"Propagation Distance (mm)", "Beam radius (mm)", "Hartmann probe beam from ETM_HR to HWS"}]
ListLogPlot[tableOut, Joined-> True, Frame-> True, GridLines-> Automatic,FrameLabel-> {"Propagation Distance (mm)", "Beam radius (mm)", "Hartmann probe beam from periscope to HWS"}, PlotRange-> {{4000, 11000}, {0.1, 4}}]
ListPlot[tableOut, Joined-> True, Frame-> True, GridLines-> Automatic,FrameLabel-> {"Propagation Distance (mm)", "Beam radius (mm)", "Hartmann probe beam from periscope to HWS"}, PlotRange-> {{4000, 11000}, {0.1, 4}}]

solnSimple

M1 = (({{1, L2}, {0, 1}})).(({{1, 0}, {-1/f2, 1}})).(({{1, L1}, {0, 1}})).(({{1, 0}, {-1/f1, 1}})).(({{1, L0}, {0, 1}})).(({{1, 0}, {-1/f0, 1}})). (({{1, M2tof0}, {0, 1}})).(({{1, 0}, {-2/T2RoC, 1}})).(({{1, T1toT2}, {0, 1}})).(({{1, 0}, {-2/T1RoC, 1}})).(({{1, ETMtoT1}, {0, 1}}))/.solnSimple 
MatrixForm[Chop[Simplify[M1]]]

solnSimple

Plot the output from Fiber Launcher - ETMY

solnSimple

ABCDList = {(({{1, L2}, {0, 1}})),(({{1, 0}, {-1/f2, 1}})),(({{1, L1}, {0, 1}})),(({{1, 0}, {-1/f1, 1}})),(({{1, L0}, {0, 1}})),(({{1, 0}, {-1/f0, 1}})), (({{1, M2tof0}, {0, 1}})),(({{1, 0}, {-2/T2RoC, 1}})),(({{1, T1toT2}, {0, 1}})),(({{1, 0}, {-2/T1RoC, 1}})),(({{1, ETMtoT1}, {0, 1}}))}/.solnSimple ;
OutModeFromFiberRW = {-1.3+0.0, 3.8*^-3}
plot1 = PlotTheBeamPropagation[ABCDList, OutModeFromFiberRW, λg]
plot2 = LogPlotTheBeamPropagation[ABCDList, OutModeFromFiberRW, λg]

Show[plot1, GridLines-> {Automatic, Table[ii*5, {ii, 12}]}, PlotRange-> {{0,2}, {0, 5}}]

Real System Analysis

M1 =Simplify[(({{1, dImage}, {0, 1}})). (({{1, L2}, {0, 1}})).(({{1, 0}, {-1/f2, 1}})).(({{1, L1-dF1}, {0, 1}})).(({{1, 0}, {-1/f1, 1}})).(({{1, L0+dF1}, {0, 1}})).(({{1, 0}, {-1/f0, 1}})). (({{1, T2toISCT+dPeriscopeR}, {0, 1}})).(({{1, 0}, {-2/T2RoC, 1}})).(({{1, T1toT2}, {0, 1}})).(({{1, 0}, {-2/T1RoC, 1}})).(({{1, ETMtoT1}, {0, 1}}))/.solnSimple ];

Solve[M1[[1]][[2]]==0/. {dF1-> 0, dPeriscopeR-> 0}]

magnification = 1/M1[[1]][[1]]/. {dF1-> 0, dPeriscopeR-> 0, dImage-> 0}

Model actual system [Image plane is 88mm further away]

Solve[M1[[1]][[2]]==0/. {dF1-> 0, dPeriscopeR-> -0.09}]

M2 = M1/.  dPeriscopeR-> -0.09;

How much to add to F0toF1 distance?

Solve[M2[[1]][[2]]==0/.dImage-> 0]

Move lens F1 3.55 mm further from F0

M2/. {dImage-> 0, dF1-> 0.00355689}

3.0/20.04

X - Arm

Start with the CVI Lenses and determine all solutions based on the nominal lens positions : X

XorYDist =  5.273
L0Dist = 0.61

Load CVI Lenses

CVILenses1 = {-279.6,-335.4,-391.3,-448.4,-558.9,-670.9,-1118.1,-1677,670.9,782.7,1118.1,1677,2236.1,3353.5,4471.4,5589.2,8384.9,11180.6}/1000.;

(*CVILenses1 ={-1000,-600,-625,-500,-400,-350,-300,-250,-175,-175,-150,-125,-125,-125,-100,-100,-100,-75,-75,-75,-62.5,-50,-50,-40,-37.5,-30,-25,-25,-20,-15,-12.5,-10,10,10,10,12.5,12.5,15,15,20,20,25,25,25,25,30,30,37.5,37.5,40,40,50,50,50,50,50,50,62.5,62.5,75,75,75,75,100,100,100,125,125,125,150,150,175,175,175,200,200,250,250,250,250,300,300,350,375,500,500,600,625,750,800,1000,1000,1500,1500,2000,2000}/1000.0;*)

Length[CVILenses1]

Determine ABCD matrices

ABCDList =(({{1, L2}, {0, 1}})).(({{1, 0}, {-1/f2, 1}})).(({{1, L1}, {0, 1}})).(({{1, 0}, {-1/f1, 1}})).(({{1, L0}, {0, 1}})).(({{1, 0}, {-1/f0, 1}})). (({{1, T2toISCT}, {0, 1}})).(({{1, 0}, {-2/T2RoC, 1}})).(({{1, T1toT2}, {0, 1}})).(({{1, 0}, {-2/T1RoC, 1}})).(({{1, ETMtoT1}, {0, 1}})) ;

ABCD with distances substituted in

CVILenses2 = Union[CVILenses1,CVILenses1];
ABCDSub = Simplify[ABCDList/. {ETMtoT1-> 1.429, T1RoC-> 4.0, T1toT2-> 1.9026, T2RoC-> -0.2, T2toISCT-> XorYDist, L0-> L0Dist}];

s1 = Solve[{ABCDSub[[1]][[2]] == 0},  L2];
ABCDSub2 = Simplify[ABCDSub/. s1[[1]]];
s2 =  Solve[{ABCDSub2[[2]][[2]] == -20.5},  L1];
ABCDSub3 = Simplify[ABCDSub2/. s2[[1]]];


resultN = Table[0, {ii, Length[CVILenses2]^3}];
countN = 1;
resultGood = {};
For[ii=1, ii≤ Length[CVILenses2], ii++, {

For[jj=1, jj≤ Length[CVILenses2], jj++, {
For[kk=1, kk≤ Length[CVILenses2], kk++, {
For[mm =1, mm≤ 1, mm++, {
f0A = CVILenses2[[ii]];
f1A =  CVILenses2[[jj]];
f2A =   CVILenses2[[kk]];


ABCDOut = ABCDSub/. {f0-> f0A, f1-> f1A, f2-> f2A};
ABCDSub3A = ABCDSub3/. {f0-> f0A, f1-> f1A, f2-> f2A};


L2A = ((L2/. s1[[1]])/. s2[[1]])/.  {f0-> f0A, f1-> f1A, f2-> f2A};
L1A = (L1/. s2[[1]])/. {f0-> f0A, f1-> f1A, f2-> f2A};

If[(L1A > 0.7)  && (L2A>0.7) &&(L1A<1.5)&&(L2A< 1.5), {
resultGood = Append[resultGood, {ii,jj,kk,L1A, L2A,  ABCDSub3A[[2]][[1]]}];
}];
countN = countN+ 1;




}];
}];

}];
Print[{ii, Length[CVILenses2], Length[resultGood]}]
}];

CList = Table[{Abs[resultGood[[ii]][[6]]], resultGood[[ii]][[4]],resultGood[[ii]][[5]],  CVILenses2[[resultGood[[ii]][[1]]]], CVILenses2[[resultGood[[ii]][[2]]]], CVILenses2[[resultGood[[ii]][[3]]]]}, {ii, Length[resultGood]}];
CList2 = Sort[CList];
CList3 = Table[{Abs[If[CVILenses2[[resultGood[[ii]][[1]]]]==CVILenses2[[resultGood[[ii]][[2]]]] ||CVILenses2[[resultGood[[ii]][[3]]]]==CVILenses2[[resultGood[[ii]][[2]]]]||CVILenses2[[resultGood[[ii]][[1]]]]==CVILenses2[[resultGood[[ii]][[3]]]], 25,1]*(1/Abs[resultGood[[ii]][[6]]])* CVILenses2[[resultGood[[ii]][[1]]]]* CVILenses2[[resultGood[[ii]][[2]]]]* CVILenses2[[resultGood[[ii]][[3]]]]],resultGood[[ii]][[6]], resultGood[[ii]][[4]],resultGood[[ii]][[5]],  CVILenses2[[resultGood[[ii]][[1]]]], CVILenses2[[resultGood[[ii]][[2]]]], CVILenses2[[resultGood[[ii]][[3]]]]}, {ii, Length[resultGood]}];
CList4 = Sort[CList3];

solnF = CList4[[Length[CList4]]]
L1S = solnF[[3]];
L2S = solnF[[4]];
f0S = solnF[[5]];
f1S = solnF[[6]];
f2S = solnF[[7]];

solnSimple = {f0-> f0S, f1-> f1S, f2-> f2S, L0->L0Dist, L1-> L1S, L2-> L2S, M2tof0-> 5.273}
solnSimpleX = solnSimple

Rest

Create Function to Determine Output Radius and Beam Size and to plot the Beam

OutRW[wIN_, RIN_, λIN_,ABCD_]:= Module[{},
Q1Inv = (1/RIN)- ((I λIN)/(Pi wIN^2));
Q1a = 1/Q1Inv;
Q2temp = ((ABCD[[1]][[1]]Q1a + ABCD[[1]][[2]])/(ABCD[[2]][[1]]Q1a + ABCD[[2]][[2]]));
Q2Inv = 1/Q2temp;
ROut = Re[Q2Inv]^-1;
wOut = Sqrt[((-λIN)/(Pi Im[Q2Inv]))];
Return[{ROut, wOut}];
];
FindNearestWaist[wIN_, RIN_, λIN_]:= Module[{},
Q1Inv = (1/RIN)- ((I λIN)/(Pi wIN^2));
Q1a = 1/Q1Inv;


Q2temp = Q1a;
Q2tempR = Re[Q2temp]+x0;
Q2tempI = Im[Q2temp];
Q2InvR = (Q2tempR/(Q2tempR^2 + Q2tempI^2));


ROut = Q2InvR^(-1);

solnIN = Solve[1/ROut == 0, x0];


Return[x0/.solnIN[[1]]];
];

PlotTheBeamPropagation[ABCDList_, RWInputMode_, λIN_]:=Module[{},
z0 = 0;
plotList = {};
count1 = 0;
For[ii=1, ii≤ Length[ABCDList], ii++, {
M1IN = ABCDList[[ii]];

plotAll = Plot[0*x, {x, 0, 0.00001}];
If[M1IN[[1]][[2]]≠ 0, {
MOut = (({{1, 0}, {0, 1}}));
For[jj=1, jj≤ ii-1, jj++, {
MOut = ABCDList[[jj]].MOut;
}];
MOut = (({{1, zIN-z0}, {0, 1}})).MOut;

eqOut = OutRW[RWInputMode[[2]], RWInputMode[[1]], λIN, MOut];

plotA = Plot[eqOut[[2]]*1000, {zIN, z0, ABCDList[[ii]][[1]][[2]]+z0}, PlotRange-> {{0, ABCDList[[ii]][[1]][[2]]+z0}, {0, Automatic}}, Frame->True, FrameLabel-> {"Propagation Distance (m)", "Beam Size (mm)"}, PlotStyle-> If[Mod[count1, 2]==0, Blue, Red]];

plotList = Append[plotList, plotA];
count1 = count1 + 1;

z0 = ABCDList[[ii]][[1]][[2]]+z0;

plotAll = Show[plotA,plotAll];
 
}];
}];
plotAll = plotList[[1]];
For[ii=2, ii≤ Length[plotList], ii++, {
plotAll = Show[plotList[[ii]],plotAll];
}];
Show[plotAll, PlotRange-> {{0,z0}, {0, Automatic}}]
];
LogPlotTheBeamPropagation[ABCDList_, RWInputMode_, λIN_]:=Module[{},
z0 = 0;
plotList = {};
count1 = 0;

tableOut = {};
For[ii=1, ii≤ Length[ABCDList], ii++, {
M1IN = ABCDList[[ii]];

plotAll = Plot[0*x, {x, 0, 0.00001}];

If[M1IN[[1]][[2]]≠ 0, {
MOut = (({{1, 0}, {0, 1}}));
For[jj=1, jj≤ ii-1, jj++, {
MOut = ABCDList[[jj]].MOut;
}];
MOut = (({{1, zIN-z0}, {0, 1}})).MOut;

eqOut = OutRW[RWInputMode[[2]], RWInputMode[[1]], λIN, MOut];
For[kk = z0*1000, kk≤ ( ABCDList[[ii]][[1]][[2]]+z0)*1000, kk++, {
tableOut = Append[tableOut, {kk, eqOut[[2]]*1000/. zIN-> kk/1000}];
}];


plotA = LogPlot[eqOut[[2]]*1000, {zIN, z0, ABCDList[[ii]][[1]][[2]]+z0}, PlotRange-> {{0, ABCDList[[ii]][[1]][[2]]+z0}, Automatic},Frame-> True,PlotStyle-> If[Mod[count1, 2]==0, Blue, Red]];

plotList = Append[plotList, plotA];
count1 = count1 + 1;

z0 = ABCDList[[ii]][[1]][[2]]+z0;

plotAll = Show[plotA,plotAll];
 
}];
}];
plotAll = plotList[[1]];
For[ii=2, ii≤ Length[plotList], ii++, {
plotAll = Show[plotList[[ii]],plotAll];
}];
Show[plotAll, PlotRange-> {{0,z0}, Automatic}]
];
PlotTheBeamPropagation[{(({{1, 1.0}, {0, 1}})), (({{1, 0}, {-1/1.5, 1}})), (({{1, 1.7}, {0, 1}})), (({{1, 0}, {-1/0.5, 1}})), (({{1, 0.7}, {0, 1}}))}, {1000, 0.001}]

Arm cavity parameters

Arm Cavity parameters

λg = 532*10^-9.0;
ArmLength = 3995;
RETM = 2307;
RITM = 2312;

nFusedSilica532 = 1.46071;
ETMthick = 0.2;

T1RoC = 4.0;
T2RoC = -0.2;
T1toT2 = 1.9026;
ETMtoT1 = 1.429;
T2toISCT = 4.680;


gETM = 1 - (ArmLength/RETM);
gITM = 1 - (ArmLength/RITM);

wETM = Sqrt[((ArmLength λg)/Pi) Sqrt[(gITM/(gETM(1- gITM gETM)))]]
wETM1064 = Sqrt[((ArmLength 1064*10^-9.)/Pi) Sqrt[(gITM/(gETM(1- gITM gETM)))]]

Cavity Mode - and snippet to show that the beam size is increasing as we propagate out from cavity past ETM

OutModeFromCavityRW = {RETM, wETM}
OutRW[OutModeFromCavityRW[[2]], OutModeFromCavityRW[[1]], λg, (({{1, 10.0}, {0, 1}}))]

ETM as a Lens

ETMOutmatrix = (({{1, 0}, {0 , (nFusedSilica532/1)}})).(({{1, ETMthick}, {0 , 1}})).(({{1, 0}, {((1 -nFusedSilica532)/(-RETM nFusedSilica532)) , (1/nFusedSilica532)}}));
RETMn = -RETM/nFusedSilica532;
ETMAsMirror = (({{1, 0}, {-2/RETMn , 1}}));
OutRW[OutModeFromCavityRW[[2]], OutModeFromCavityRW[[1]], λg, (({{1, 100.0}, {0, 1}})).ETMOutmatrix];
OutModeFromETMRW = OutRW[OutModeFromCavityRW[[2]], OutModeFromCavityRW[[1]], λg, ETMOutmatrix]

ETMX fiber launcher plot

Plot the output for ETMX

solnSimple

ABCDList =Reverse[ {(({{1, L2}, {0, 1}})),(({{1, 0}, {-1/f2, 1}})),(({{1, L1}, {0, 1}})),(({{1, 0}, {-1/f1, 1}})),(({{1, L0}, {0, 1}})),(({{1, 0}, {-1/f0, 1}})), (({{1, M2tof0}, {0, 1}})),(({{1, 0}, {-2/T2RoC, 1}})),(({{1, T1toT2}, {0, 1}})),(({{1, 0}, {-2/T1RoC, 1}})),(({{1, ETMtoT1}, {0, 1}}))}]/.solnSimple ;
OutModeFromETMRW = {1579.4958047124749`,0.08141979105529595`}
plot1 = PlotTheBeamPropagation[ABCDList, OutModeFromETMRW, λg]
plot2 = LogPlotTheBeamPropagation[ABCDList, OutModeFromETMRW, λg]

ListLogPlot[tableOut, Joined-> True, Frame-> True, GridLines-> Automatic,FrameLabel-> {"Propagation Distance (mm)", "Beam radius (mm)", "Hartmann probe beam from ETM_HR to HWS"}]
ListLogPlot[tableOut, Joined-> True, Frame-> True, GridLines-> Automatic,FrameLabel-> {"Propagation Distance (mm)", "Beam radius (mm)", "Hartmann probe beam from periscope to HWS"}, PlotRange-> {{4000, 11000}, {0.1, 4}}]
ListPlot[tableOut, Joined-> True, Frame-> True, GridLines-> Automatic,FrameLabel-> {"Propagation Distance (mm)", "Beam radius (mm)", "Hartmann probe beam from periscope to HWS"}, PlotRange-> {{4000, 11000}, {0.1, 4}}]

solnSimple

M1 = (({{1, L2}, {0, 1}})).(({{1, 0}, {-1/f2, 1}})).(({{1, L1}, {0, 1}})).(({{1, 0}, {-1/f1, 1}})).(({{1, L0}, {0, 1}})).(({{1, 0}, {-1/f0, 1}})). (({{1, M2tof0}, {0, 1}})).(({{1, 0}, {-2/T2RoC, 1}})).(({{1, T1toT2}, {0, 1}})).(({{1, 0}, {-2/T1RoC, 1}})).(({{1, ETMtoT1}, {0, 1}}))/.solnSimple 
MatrixForm[Chop[Simplify[M1]]]

solnSimple

Plot the output from Fiber Launcher - ETMX

solnSimple

ABCDList = {(({{1, L2}, {0, 1}})),(({{1, 0}, {-1/f2, 1}})),(({{1, L1}, {0, 1}})),(({{1, 0}, {-1/f1, 1}})),(({{1, L0}, {0, 1}})),(({{1, 0}, {-1/f0, 1}})), (({{1, M2tof0}, {0, 1}})),(({{1, 0}, {-2/T2RoC, 1}})),(({{1, T1toT2}, {0, 1}})),(({{1, 0}, {-2/T1RoC, 1}})),(({{1, ETMtoT1}, {0, 1}}))}/.solnSimple ;
OutModeFromFiberRW = {-1.3+0.0, 3.*^-3}
plot1 = PlotTheBeamPropagation[ABCDList, OutModeFromFiberRW, λg]
plot2 = LogPlotTheBeamPropagation[ABCDList, OutModeFromFiberRW, λg]

Show[plot1, GridLines-> {Automatic, Table[ii*5, {ii, 12}]}]

Real System Analysis

M1 =Simplify[(({{1, dImage}, {0, 1}})). (({{1, L2}, {0, 1}})).(({{1, 0}, {-1/f2, 1}})).(({{1, L1-dF1}, {0, 1}})).(({{1, 0}, {-1/f1, 1}})).(({{1, L0+dF1}, {0, 1}})).(({{1, 0}, {-1/f0, 1}})). (({{1, T2toISCT+dPeriscopeR}, {0, 1}})).(({{1, 0}, {-2/T2RoC, 1}})).(({{1, T1toT2}, {0, 1}})).(({{1, 0}, {-2/T1RoC, 1}})).(({{1, ETMtoT1}, {0, 1}}))/.solnSimple ];

Solve[M1[[1]][[2]]==0/. {dF1-> 0, dPeriscopeR-> 0}]

magnification = 1/M1[[1]][[1]]/. {dF1-> 0, dPeriscopeR-> 0, dImage-> 0}

Model actual system [Image plane is 88mm further away]

Solve[M1[[1]][[2]]==0/. {dF1-> 0, dPeriscopeR-> -0.09}]

M2 = M1/.  dPeriscopeR-> -0.09;

How much to add to F0toF1 distance?

Solve[M2[[1]][[2]]==0/.dImage-> 0]

Move lens F1 3.55 mm further from F0

M2/. {dImage-> 0, dF1-> 0.00355689}

3.0/20.04

Solutions

solnSimpleX
solnSimpleY

M1 = (({{1, L2}, {0, 1}})).(({{1, 0}, {-1/f2, 1}})).(({{1, L1}, {0, 1}})).(({{1, 0}, {-1/f1, 1}})).(({{1, L0}, {0, 1}})).(({{1, 0}, {-1/f0, 1}})). (({{1, 5.273}, {0, 1}})).(({{1, 0}, {-2/T2RoC, 1}})).(({{1, T1toT2}, {0, 1}})).(({{1, 0}, {-2/T1RoC, 1}})).(({{1, ETMtoT1}, {0, 1}})) /. solnSimpleX;
MatrixForm[M1]

M1 = (({{1, L2}, {0, 1}})).(({{1, 0}, {-1/f2, 1}})).(({{1, L1}, {0, 1}})).(({{1, 0}, {-1/f1, 1}})).(({{1, L0}, {0, 1}})).(({{1, 0}, {-1/f0, 1}})). (({{1, 4.314}, {0, 1}})).(({{1, 0}, {-2/T2RoC, 1}})).(({{1, T1toT2}, {0, 1}})).(({{1, 0}, {-2/T1RoC, 1}})).(({{1, ETMtoT1}, {0, 1}})) /. solnSimpleY;
MatrixForm[M1]