Example Problem 2 - Cardinal Points

A thick lens has the following specifications: (Subscript[R, 1]) = +2.50 cm, (Subscript[R, 2]) = +4.50 cm, t (thickness) = 2.90 cm, (Subscript[n, 1]) = 1.00, (Subscript[n, 2]) = 1.630, (Subscript[n, 3]) = 1.00. Find the cardinal points using the matrix method.

We will need 3 matrices :
    1) A refraction matrix through the front lens surface, from the air to the glass.
    2) A translation matrix from the front surface to the back surface.
    3) A refraction matrix through the back lens surface, from the glass to the air.

First Matrix, (Subscript[M, 1]): Refraction Matrix
(Subscript[n, 1])=1.00, (Subscript[n, 2])=1.63, (Subscript[R, 1])=+2.50 cm

Second Matrix, (Subscript[M, 2]): Translation Matrix
 (Subscript[L, 1])=+2.90 cm

Third Matrix, (Subscript[M, 3]): Refraction Matrix
(Subscript[n, 2])=1.63, (Subscript[n, 3])=1.00, (Subscript[R, 2])=+4.50 cm

n1=1.00;n2=1.63;n3=1.00;

R1=2.50;R2=4.50;

L1=2.90;

M1=(({{1, 0}, {(1/R1)((n1/n2)-1), (n1/n2)}}));M2=(({{1, L1}, {0, 1}}));M3=(({{1, 0}, {(1/R2)((n2/n3)-1), (n2/n3)}}));

Calculate the system matrix, M, by multiplying the 3 matrices together in reverse order.
M=(Subscript[M, 3])•(Subscript[M, 2])•(Subscript[M, 1])
(remember to use . (period) when multiplying matrices instead of * (asterisk))

TraditionalForm[{MatrixForm[M3],MatrixForm[M2],MatrixForm[M1]}]

TraditionalForm[Simplify[MatrixForm[M=M3.M2.M1]]]

For convenience, let's assign A, B, C,& D to each matrix element.
(C & D are protected symbols in Mathematica, so we'll have to use lower case letters).
Also, find the ratio of the input and output indices of refraction by calculating the determinate of the matrix M.

a=M[[1,1]];b=M[[1,2]];c=M[[2,1]];d=M[[2,2]];nR=Det[M]

Find the location of the first and second focal points (relative to the input/output planes).

TraditionalForm[{p=(d/c),q=-(a/c)}]

Find the location of the first and second principal points (relative to the input/output planes).

TraditionalForm[{r=((d-nR)/c),s=((1-a)/c)}]

Find the location of the first and second nodal points (relative to the input/output planes).

TraditionalForm[{v=((d-1)/c),w=((nR-a)/c)}]

Find the location of the first and second focal points (relative to the principle planes).

TraditionalForm[{f1=(nR/c),f2=-(1/c)}]

Manipulate[
op=ip+L1;
Show[
ListPlot[
{{p+ip,0},{q+op,0}},
PlotRange->{{xl,xr},{-1,1}},
PlotStyle->Directive[PointSize[0.010],RGBColor[0,0.4,0]],
Axes->{True,False},
ImageSize->800,
AspectRatio->.5,
Epilog->{
Rotate[Text[Style["F1",{FontSize->12,FontFamily->"Times"}],{p+ip,0.07}],0°],
Rotate[Text[Style["F2",{FontSize->12,FontFamily->"Times"}],{q+op,0.07}],0°],
Rotate[Text[Style["PP1",{FontSize->12,FontFamily->"Times"}],{r+ip,0.82}],0°],
Rotate[Text[Style["PP2",{FontSize->12,FontFamily->"Times"}],{s+op,-0.82}],0°],
Rotate[Text[Style["N1",{FontSize->12,FontFamily->"Times"}],{v+ip,0.06}],0°],
Rotate[Text[Style["N2",{FontSize->12,FontFamily->"Times"}],{w+op,-0.07}],0°],
Rotate[Text[Style["IP",{FontSize->12,FontFamily->"Times"}],{ip,-0.82}],0°],
Rotate[Text[Style["OP",{FontSize->12,FontFamily->"Times"}],{op,-0.82}],0°]
}
],
ListLinePlot[
{{r+ip,-0.75},{r+ip,0.00}},
PlotStyle->Directive[RGBColor[0,0,1.0],AbsoluteThickness[2]]
],
ListLinePlot[
{{r+ip,0.12},{r+ip,0.75}},
PlotStyle->Directive[RGBColor[0,0,1.0],AbsoluteThickness[2]]
],
ListLinePlot[
{{s+op,-0.75},{s+op,-0.12}},
PlotStyle->Directive[RGBColor[0,0,1.0],AbsoluteThickness[2]]
],
ListLinePlot[
{{s+op,0.00},{s+op,0.75}},
PlotStyle->Directive[RGBColor[0,0,1.0],AbsoluteThickness[2]]
],
ListPlot[
{{v+ip,0},{w+op,0}},
PlotStyle->Directive[PointSize[0.010],Red]
],
ListLinePlot[
{{ip,-0.75},{ip,0.75}},
PlotStyle->Directive[RGBColor[1.0,0.4,0],AbsoluteThickness[2],Dotted]
],
ListLinePlot[
{{op,-0.75},{op,0.75}},
PlotStyle->Directive[RGBColor[1.0,0.4,0],AbsoluteThickness[2],Dotted]
]
],
{{ip,0,"Input Plane"},-200,200,0.1,Appearance->"Labeled"},{{xl,-100,"x-left"},-200,xr-1,0.1,Appearance->"Labeled"},
{{xr,100,"x-right"},xl+1,200,0.1,Appearance->"Labeled"}
]