Lens Characterization

FindLensParameters

sys =
{WedgeOfRays[10, NumberOfRays -> 5],
Move[PlanoConvexLens[{f1,100}, 50, 9, CurvatureDirection -> Back],90.5],
Move[ApertureStop[50,30],100],
Move[PlanoConvexLens[{f2,100}, 50, 9], 100.5],
Boundary[208, GraphicDesign -> Off]};

AnalyzeSystem[sys,PlotType->TopView];

FindLensParameters[sys]  Pupil Function

sys3D =
{PointOfRays[{10,10}, NumberOfRays -> 5],
Move[PlanoConvexLens[{f1,100}, 50, 9, CurvatureDirection -> Back], 90.5],
Move[ApertureStop[50,30],100],
Move[PlanoConvexLens[{f2,100}, 50, 9], 100.5],
Boundary[208, GraphicDesign -> Off]};

AnalyzeSystem[sys3D]; pupfun = PupilFunction[sys3D,Plot2D->False]; PSF[pupfun,NumberOfPoints->128]; Modulation Transfer Function

ModulationTransferFunction[sys3D, FindImagePoint->True, FocalFraction->0, NumberOfPoints->128];   Seidel Aberrations

Seidel aberrations are included in the same calculations that determine the pupil function of an imaging system. These are based on Zernike polynomials.

PupilFunction[sys3D]  Interference

Optical Flat  Fabry Perot Interferometer

TurboPlot[{
Move[GaussianBeam[1.5,.01],-50],
PlanoConcaveLens[-30,20,2,"L1",CurvatureDirection->Back],
Move[PlanoConvexLens[160,30,6.5,"L2"],110],
Resonate[{Move[Window[50,25,Transmittance->70],150],
Move[Baffle,200]}]
}, PlotType->TopView, SequentialTrace->False, GenerationLimit->16, ThresholdIntensity->.001]; In:=

FindInterference[{
Move[GaussianBeam[1.5,.01,FullForm->True],-50],
PlanoConcaveLens[-30,20,2,"L1",CurvatureDirection->Back],
Move[PlanoConvexLens[160,30,6.5,"L2"],110],
Resonate[{Move[Window[50,25,Transmittance->70],150],
Move[Baffle,90],
Move[Baffle,200]}]
}, ReportedSurfaces -> {{3,4}}, SequentialTrace->False, GenerationLimit->16,
ThresholdIntensity->.001]; Michelson Interferometer

In:=

system =
{
Move[GaussianBeam[1.5,.01,FullForm->True],-50],
PlanoConcaveLens[-30,20,2,"L1",CurvatureDirection->Back],
Move[PlanoConvexLens[160,30,6.5,"L2"],130],
Move[BeamSplitter[{70,30},50,10],175,-45],
Move[Mirror[50,10],250],
Move[Mirror[50,10],{175,50},90.01],
Move[BeamSplitter[{70,30},50,10,""],175,-45,GraphicDesign->Off],
Move[Screen,{175,-50},90]
};
AnalyzeSystem[system]; interference = FindInterference[system]; In:=

Plot3D[Evaluate[(InterferenceFunction/.interference)][x,y],{x,-13.5,6.7},{y,-10.,10.},PlotPoints->100,Mesh->False]; More Elaborate Interference Example   FindGratingFunction

Diffraction

Gaussian Beam Propagation

opticalsystemoffaxis = {
Move[GaussianBeam[{5.,5.},{.01,.01},SymbolicWaveLength->λ],{0,10}],
Move[PlanoConvexLens[{f,100},{a,50},{t,10},DesignWaveLength->.532],{d1,50}],
Move[Mirror,175,-45],
Move[Screen,{175,50},90]};
ShowSystem[opticalsystemoffaxis, ShowGaussian->True]; ShowSystem[opticalsystemoffaxis, PlotType->TopView, ShowGaussian->True]; opticalsystemreflected = {
GaussianBeam[20.,.01, NumberOfRays->6],
Move[PlanoConvexLens[100,50,10,DesignWaveLength->.532],50],
Move[Mirror,175,-45],
Move[Screen,{175,50},90]};
AnalyzeSystem[opticalsystemreflected, PlotType->TopView]; GaussianPlot[opticalsystemreflected]; GaussianPlot[opticalsystemreflected, RenderedParameters->BeamCurvature]; Here is a more elaborate example. The defining details have not been included in order to simplify the presentation. Gaussian Beam Interference   Generalized Wave Propagation    Symbolic Calculations

Symbolic ABCD Matrix Calculations

opticalsystemreflected = {
GaussianBeam[20,1/100,SymbolicWaveLength->λ,NumberOfRays->6, IntrinsicMedium->1],
Move[PlanoConvexLens[{f,100},{a,50},{t,10},ComponentMedium->3/2],{d1,50}],
Move[Mirror[{b,20}],175,-45],
Move[Screen,{175,50},90]};
AnalyzeSystem[opticalsystemreflected, PlotType->TopView]; FindABCDMatrix[opticalsystemreflected,{f>0}, MatrixForm->True, DecomposeABCD->False, NumericalResults->False, MakeFloatingPoint->False] FindABCDMatrix[opticalsystemreflected,{f>0}, MatrixForm->True, DecomposeABCD->True, NumericalResults->False, MakeFloatingPoint->False]        FindABCDMatrix[opticalsystemreflected,MatrixForm->True,DecomposeABCD->True,NumericalResults->True]        Symbolic Transfer Functions

Wave Optica can be used to calculate the symbolic solution to optical systems by taking a symbolic Taylor's series expansion about the chief ray trajectory through space. The next example shows the fifth order symbolic solution to a spherical mirror system. In this case, y  is the initial ray height from the optical axis, r is the radius of curvature for the mirror, and d is the longitudinal position of the final optical surface, S.

In:=

opticalSystem = {
Move[LineOfRays,{0,{y,0}}],
Move[SphericalMirror[{r,-100},50,10],25],
Move[Screen,{d,-25}]};
AnalyzeSystem[opticalSystem,PlotType->TopView];
SymbolicTrace[opticalSystem, {{y,0,5},{r<0}}] Out= Fifth order solution to indicated optical parameters.

In the following example, we will determine the third order symbolic solution to a spherical lens system.

opticalsystem = {
Move[LineOfRays,{-50,{y,0}}],
SphericalLens[{1/c1,35},{1/c2,-55},50,20],
Move[Screen,50]};

AnalyzeSystem[opticalsystem,PlotType->TopView]; Here we use SymbolicTrace to calculate the third-order transfer function for the system. In this case, y  is the initial ray height from the optical axis and Py is the resulting height on the final optical surface, S.

Py = (SymbolicSurfaceCoordinates/.
SymbolicTrace[opticalsystem,{{y,0,3}, {c1>0,c2<0,y∈Reals}},
SymbolicRefractiveModels->BK7->3/2])[]

Out= Third order symbolic transfer function

Symbolic Global Optimization

Next we calculate the merit function for the optical system.

In:=

meritFunction = Expand[Integrate[Expand[Py^2],{y,-5,5}]]

Out= Symbolic Merit Function

Here is a plot of the merit function space.

In:=

Plot3D[meritFunction,{c1,0,.1},{c2,-.1,0}]; Plot of merit function space.

Next we calculate the minimization roots for the system. Minimization roots to symbolic merit function.

Finally, we isolate the global minimum from the polynomial roots. Here is a plot of the globally optimized system. Plot of Optimized System

Ray Caustics Through a Lens Focus  Created by Mathematica  (September 1, 2005)