Entrance Pupil

Problem

An object 4 cm high is placed with one end on the axis of an optical system consisting of a 2 cm aperture stop and a thin convex lens of 6 cm focal length and 5 cm aperture. The object is positioned 14 cm in front of the lens, and the stop is 2.5 cm behind the lens. Find the position and size of the entrance and exit pupils, and the image. Also draw the principal ray.

Reference: Pedrotti, F. and Pedrotti, L. Introduction To Optics, 2 ed. Prentice-Hall, 1993.

Solution

This problem can be solved by ray-tracing. The package Optica, a Mathematica application, is used here, along with ExtendGraphics (available from MathSource) and the standard package Graphics`Arrow`.

Needs["ExtendGraphics`Geometry`"]
Needs["Graphics`Arrow`"]
Needs["Optica`Optica`"]

In Optica, a ray which touches the edge of a hole is terminated, and one which touches the edge of a lens is not refracted.  In this case, that is undesirable, so an increment Epsilon is added to apertures.

ε = (10^(-6));

Define the Aperture Stop as a washer-shaped object.

apertureStop = 2. ;            
pinholeOuterDiameter = lensAperture;      
stopPosition = 16.5;

Define the Lens (thin, biconvex).

lensAperture = 5. ;
focalLength = 6. ;
lensPosition = 14. ;

Define an object.  The object must be in the horizontal plane, because in Optica a thin lens refracts in two dimensions only.

objectSize = 4. ;
objectPosition = 0. ;
objectStem = 
        CylinderGraphic[objectSize/15, objectSize/2];
objectBall = SphereGraphic[objectSize/2];

      
object = 
        Block[{$DisplayFunction = Identity}, 
          DrawSystem[{
Move[
                objectStem, {0, 0, 90}], 
Move[
                objectBall, {0, objectSize* .75, 
                  0}]
}]
];

Define the image components. Since we don't know the size and position yet, we will draw the image later.

imageSize = Abs[magnification] * objectSize;
imageStem = CylinderGraphic[imageSize/15, imageSize/2];
imageBall = SphereGraphic[imageSize/2];

The exit pupil is the image of the aperture stop formed by the elements following it. In this case, the exit pupil is the aperture stop itself.
    The entrance pupil is the image of the aperture stop formed by the elements preceding it (i.e. the lens.) To locate this image, we have to find rays from the top and bottom of the object which are refracted by the lens so that they touch the top and bottom edges of the aperture. 
    The principal ray is that ray from the object which (if extended) intersects the system axis in the plane of the entrance pupil. In this case, the refracted principal ray intersects the axis at the centre of the aperture.
    The three desired rays from the top of the object, and the three from the bottom, can be determined with ABCD matrices. The ray-transfer matrix is the product of the translation matrix between the object and the lens, the thin-lens refraction matrix, and the translation matrix between the lens and aperture. Given the ray-transfer matrix, we can use it to solve for the tangent of the angle between a particular ray and the system axis, and thence the angle itself.

transferMatrix=(({{1, stopPosition - lensPosition}, {0, 1}})).(({{1, 0}, {-(1/focalLength), 1}})).(({{1, lensPosition - objectPosition}, {0, 1}}))

αTopToCentre = 
      ArcTan[First[
            Tan[α0] /. 
Solve[
                transferMatrix . {objectSize, Tan[α0]} == {0, 
                    Tan[α1]}]]]/°

αTopToTop = 
      ArcTan[First[
            Tan[α0] /. 
Solve[
                transferMatrix . {objectSize, 
                      Tan[α0]} == {apertureStop/2, 
                    Tan[α1]}]]]/°

αTopToBottom = 
      ArcTan[First[
            Tan[α0] /. 
Solve[
                transferMatrix . {objectSize, 
                      Tan[α0]} == {-apertureStop/2, 
                    Tan[α1]}]]]/°

αBottomToCentre  =  0. ;

αBottomToTop = 
      ArcTan[First[
            Tan[α0] /. 
Solve[
                transferMatrix . {0, Tan[α0]} == {apertureStop/
                      2, Tan[α1]}]]]/°

αBottomToBottom = 
      ArcTan[First[
            Tan[α0] /. 
Solve[
                transferMatrix . {0, 
                      Tan[α0]} == {-apertureStop/2, 
                    Tan[α1]}]]]/°

Assemble the system of rays and components. For convenience, the rays are colour-coded according to their intersection with the aperture. Those at the top are red, those at the centre are green, and those at the bottom are blue. It is necessary to define the rays before placing the components, otherwise the rays are not drawn. Also, the components must be placed in order of distance from the ray source, otherwise the rays are not refracted correctly.

sys = 
DrawSystem[{

 (* 
              Rays from top of object *) 
 (* 
              Principal ray,  
              to centre of aperture *) 
Move[
              Ray[], {objectPosition, 
                objectSize, αTopToCentre}], 
 (* 
              Ray to top of aperture *) 
Move[
              Ray[RayLineRGB -> {1, 0, 0}], {objectPosition, 
                objectSize, αTopToTop}], 
 (* 
              Ray to bottom of aperture *) 
Move[
              Ray[RayLineRGB -> {0, 0, 1}], {objectPosition, 
                objectSize, αTopToBottom}], 

 (* 
              Rays from bottom of object *) 
 (* 
              Principal ray,  
              to centre of aperture *) 
Move[
              Ray[], {objectPosition, 
                0. , αBottomToCentre}], 
 (* 
              Ray to top of aperture *) 
Move[
              Ray[RayLineRGB -> {1, 0, 0}], {objectPosition, 
                0. ,  αBottomToTop}], 
 (* 
              Ray to bottom of aperture *) 
Move[
              Ray[RayLineRGB -> {0, 0, 1}], {objectPosition, 
                0. ,  αBottomToBottom}], 

 (* 
              Place the object. *) 
Move[
              object, {objectPosition, 0. , 
                0. }], 

 (* 
              Lens *) 
Move[
              ThinLens[focalLength, 
                lensAperture + ε], {lensPosition, 0. , 
                0. }], 

 (* 
              Aperture Stop *) 
Move[
              PinHole[pinholeOuterDiameter, 
                apertureStop + ε], {stopPosition, 0. , 
                0. }], 

 (* 
              System boundaries *) 
Boundary[{0. , (-lensAperture/2. )*1.5, (-lensAperture/
                      2. )*1.5}, {(lensPosition + 
                      2*focalLength)*1.1, (lensAperture/
                      2)*1.5, (lensAperture/
                      
                      2)*1.5}]}, 

Axes -> True];

The object image position and magnification can be calculated with the formulae  (1/s)+(1/s)'=(1/f) and  m = -\(TraditionalForm\`s'\/s\).

imagePosition = 
      First[imagePosition /. 
          Solve[1/(lensPosition - objectPosition) + 
                1/(imagePosition - lensPosition) == 
              1/focalLength]]

magnification = -(imagePosition - 
              lensPosition)/(lensPosition - 
            objectPosition)

The block diagram appears to agree with these results. This can be seen more clearly in a two-dimensional view. But first, let's add the image.

image = 
        Block[{$DisplayFunction = Identity}, 
          DrawSystem[{
Move[
                imageStem, {0, 0, 
                  Sign[magnification]*90}], 
Move[
                imageBall, {0, Sign[magnification]*imageSize* .75, 
                  0}]
}]
];

sys = 
        Block[{$DisplayFunction = Identity}, 
          DrawSystem[{sys, 
              Move[image, {imagePosition, 0. , 
                  0. }]}
]];
planView = 
        ShowSystem[
          sys, {PlotType -> TopView, Frame -> True, 
            Axes -> True, DisplayFunction -> Identity}, 
          OutputType -> StandardGraphics];

The Aperture Stop is drawn as a solid line because the outer rim is shown. We can show the hole by drawing a suitably gray line over it.

stopHole = {
GrayLevel[ .85], 
Line[{{stopPosition, 
                apertureStop/2}, {stopPosition, - apertureStop/
                  2}}]};

Here is the system in a two-dimensional view.

Show[planView, Graphics[stopHole], 
        DisplayFunction -> $DisplayFunction];

The entrance pupil in this case is the image of the aperture stop, looking through the lens from the object side. The image position and size can be calculated in the same manner as for the object image.

stopImagePosition = 
      First[stopImagePosition /. 
          Solve[1/(lensPosition - stopPosition) + 
                1/(stopImagePosition - lensPosition) == 
              1/-focalLength]]

stopMagnification = -(stopImagePosition - 
              lensPosition)/(lensPosition - stopPosition)

These can be verified by finding the intersections of rays coming from the top and bottom of the object. The red rays pass through the top of the aperture stop. (One originated at the top of the object and the other at the bottom.) We want the ray segments before the lens. These segments begin at the object and end at the lens.

segmentStartPoints = {{objectPosition,  
          objectSize}, {objectPosition,  0. }}

segmentEndPoints = {{lensPosition, 
          objectSize + (lensPosition - objectPosition) 
              Tan[αTopToTop °] }, {lensPosition, (lensPosition - objectPosition) 
            Tan[αBottomToTop °]}}

The intersection of the two ray segments, extended forward, is the top of the entrance pupil.

raySegment1 = 
      Line[{segmentStartPoints[[1]], 
          segmentEndPoints[[1]]}]

The function IntersectionPoint requires that the second line be implicit.

raySegment2 = 
      ToImplicit[
        Line[{segmentStartPoints[[2]], 
            segmentEndPoints[[2]]}]]

topOfEntrancePupil = 
      IntersectionPoint[raySegment1, raySegment2]

extendedRaySegment1 = {
Dashing[{ .015}], 
          RGBColor[1, 0, 
            0], 
Line[{segmentEndPoints[[1]], 
              topOfEntrancePupil}]};
extendedRaySegment2 = {
Dashing[{ .015}], 
          RGBColor[1, 0, 
            0], 
Line[{segmentEndPoints[[2]], 
              topOfEntrancePupil}]};

The blue rays pass through the bottom of the aperture stop. Again, we want the segments before the lens. The start points are the same as those of the red rays.

segmentEndPoints = {{lensPosition, 
          objectSize + (lensPosition - objectPosition) 
              Tan[αTopToBottom °] }, {lensPosition, (lensPosition - objectPosition) 
            Tan[αBottomToBottom °]}}

The intersection of the two ray segments, extended forward, is the bottom of the entrance pupil.

raySegment3 = 
      Line[{segmentStartPoints[[1]], 
          segmentEndPoints[[1]]}]

raySegment4 = 
      ToImplicit[
        Line[{segmentStartPoints[[2]], 
            segmentEndPoints[[2]]}]]

bottomOfEntrancePupil = 
      IntersectionPoint[raySegment3, raySegment4]

extendedRaySegment3 = {
Dashing[{ .015}], 
          RGBColor[0, 0, 
            1], 
Line[{segmentEndPoints[[1]], 
              bottomOfEntrancePupil}]};
extendedRaySegment4 = {
Dashing[{ .015}], 
          RGBColor[0, 0, 
            1], 
Line[{segmentEndPoints[[2]], 
              bottomOfEntrancePupil}]};

The position of the exit pupil is 4.29 cm in front of the lens, and its diameter is 3.43 cm., which agrees with the results calculated above. Now we can extend the principal ray, to check that it intersects the system axis at the centre of the entrance pupil.

segmentEndPoints = {{lensPosition, 
          objectSize + (lensPosition - objectPosition) 
              Tan[αTopToCentre °]}, {lensPosition, (lensPosition - objectPosition) 
            Tan[αBottomToCentre °]}}

raySegment5 = 
      Line[{segmentStartPoints[[1]], 
          segmentEndPoints[[1]]}]

raySegment6 = 
      ToImplicit[
        Line[{segmentStartPoints[[2]], 
            segmentEndPoints[[2]]}]]

centreOfEntrancePupil = 
      IntersectionPoint[raySegment5, raySegment6]

extendedRaySegment5 = {
Dashing[{ .015}], 
          RGBColor[0, 1, 
            0], 
Line[{segmentEndPoints[[1]], 
              centreOfEntrancePupil}]};

Here is the complete diagram.

\(\(Show[planView, 
        Graphics[{stopHole, extendedRaySegment1, extendedRaySegment2, 
            extendedRaySegment3, extendedRaySegment4, extendedRaySegment5, 
            Arrow[{topOfEntrancePupil[\([1]\)], \((lensAperture/2)\)*1.5}, 
              topOfEntrancePupil, 
              HeadLength ->  .02], 
Arrow[{bottomOfEntrancePupil[\([1]\)], \((\(-lensAperture\)/2)\)*1.5}, bottomOfEntrancePupil, 
              HeadLength ->  .02], 
Text["Entrance
 Pupil
", {First[topOfEntrancePupil], 
                4.5}, {0, \(-1\)}], 
Text["Aperture
  Stop", {stopPosition, 
                3}, {0, \(-1\)}], 
Text["Lens", {lensPosition, 
                3}, {0, \(-1\)}]}], 
DisplayFunction -> $DisplayFunction];\)\)