Exit Pupil

Problem

An object 1.5 cm high is placed with one end on the axis of an optical system consisting of a 1.8 cm aperture stop and a thin convex lens of 5 cm focal length and 3 cm aperture. The object is positioned 10 cm in front of the lens, and the stop is 2 cm in front of the lens. Find the position and size of the entrance and exit pupils.

Solution

This problem can be solved by ray-tracing. The package Optica, an application of Mathematica, 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 = 1.8;            
pinholeOuterDiameter = lensAperture;      
stopPosition = 
      8. ;

Define the Lens (thin, biconvex).

lensAperture = 3. ;
focalLength = 5. ;
lensPosition = 10. ;

Define an object.  The object must be in the horizontal plane, because in Optica a thin lens does not refract in three dimensions.

objectSize = 1.5;
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];

Assemble the system of rays and components. Three rays are drawn from the top of the object: one to the top of the aperture, one to the centre (which is the principal ray, as the aperture is the entrance pupil in this case), and one to the bottom. Likewise, three rays are drawn from the bottom of the object to the same points in the aperture. 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.

sys = 
DrawSystem[{

 (* 
              Rays from top of object *) 
 (* 
              Principal ray,  
              to centre of aperture *) 
Move[
              Ray[], {objectPosition, objectSize, 
                ArcTan[-objectSize/
                      stopPosition]/°}], 
 (* 
              Ray to top of aperture *) 
Move[
              Ray[RayLineRGB -> {1, 0, 0}], {objectPosition, objectSize, 
                ArcTan[(-objectSize + apertureStop/2)/
                      stopPosition]/°}], 
 (* 
              Ray to bottom of aperture *) 
Move[
              Ray[RayLineRGB -> {0, 0, 1}], {objectPosition, objectSize, 
                ArcTan[(-objectSize - apertureStop/2)/
                      stopPosition]/°}], 

 (* 
              Rays from bottom of object *) 
 (* 
              Principal ray,  
              to centre of aperture *) 
Move[
              Ray[], {objectPosition, 0. , 0. }], 
 (* 
              Ray to top of aperture *) 
Move[
              Ray[RayLineRGB -> {1, 0, 0}], {objectPosition, 0. , 
                ArcTan[(apertureStop/2)/
                      stopPosition]/°}], 
 (* 
              Ray to bottom of aperture *) 
Move[
              Ray[RayLineRGB -> {0, 0, 1}], {objectPosition, 0. , 
                ArcTan[(-apertureStop/2)/
                      stopPosition]/°}], 

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

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

 (* 
              Lens *) 
Move[
              ThinLens[focalLength, 
                lensAperture + ε], {lensPosition, 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];

From the block diagram, it appears that the image is formed 10 cm (i.e. 2f) behind the lens, is inverted, and is the same size as the object (i.e. 1.5 cm.) This can be seen more clearly in a two-dimensional view. But first, let's add the image.

magnification = -1. ;
image = 
        Block[{$DisplayFunction = Identity}, 
          DrawSystem[{
Move[
                imageStem, {0, 0, 
                  Sign[magnification]*90}], 
Move[
                imageBall, {0, Sign[magnification]*imageSize* .75, 
                  0}]
}]
];
imagePosition = lensPosition + 2*focalLength

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. The estimates of the image magnification and position given above are correct.

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

The entrance pupil in this case is the aperture stop. The image position and size could be checked by finding the intersections of rays coming from the top and bottom of the object. A similar method is used to find the exit pupil.
    
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 after the lens.

raysFromTopOfAperture = 
      RaySelect[
        sys, {IntersectionNumber -> 3, 
          RayLineRGB -> {1, 0, 0}}]

The segments begin at the lens and end at the system boundary.

segmentStartPoints = 
      Take[Map[
RayStart /. # &, 
          raysFromTopOfAperture], {1, 2}, 2]

segmentEndPoints = 
      Take[Map[
RayEnd /. # &, raysFromTopOfAperture], {1, 
          2}, 2]

The intersection of the two ray segments, extended backwards, is the top of the exit pupil.

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

The function IntersectionPoint requires that the second line be implicit.

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

topOfExitPupil = IntersectionPoint[raySegment1, raySegment2]

extendedRaySegment1 = {
Dashing[{ .01}], 
          RGBColor[1, 0, 
            0], 
Line[{segmentStartPoints[[1]], 
              topOfExitPupil}]};
extendedRaySegment2 = {
Dashing[{ .01}], 
          RGBColor[1, 0, 
            0], 
Line[{segmentStartPoints[[2]], 
              topOfExitPupil}]};

The blue rays pass through the bottom of the aperture stop. Again, we want the segments after the lens.

raysFromBottomOfAperture = 
      RaySelect[
        sys, {IntersectionNumber -> 3, 
          RayLineRGB -> {0, 0, 1}}]

The segments begin at the lens and end at the system boundary.

segmentStartPoints = 
      Take[Map[
RayStart /. # &, 
          raysFromBottomOfAperture], {1, 2}, 2]

segmentEndPoints = 
      Take[Map[
RayEnd /. # &, 
          raysFromBottomOfAperture], {1, 2}, 2]

The intersection of the two ray segments, extended backwards, is the bottom of the exit pupil.

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

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

bottomOfExitPupil = 
      IntersectionPoint[raySegment3, raySegment4]

extendedRaySegment3 = {
Dashing[{ .01}], 
          RGBColor[0, 0, 
            1], 
Line[{segmentStartPoints[[1]], 
              bottomOfExitPupil}]};
extendedRaySegment4 = {
Dashing[{ .01}], 
          RGBColor[0, 0, 
            1], 
Line[{segmentStartPoints[[2]], 
              bottomOfExitPupil}]};

The position of the exit pupil is 3.33 cm in front of the lens, and its diameter is 3.00 cm. Here is the diagram with the exit pupil.

\(\(Show[planView, Graphics[stopHole], 
        Graphics[{extendedRaySegment1, extendedRaySegment2, 
            extendedRaySegment3, extendedRaySegment4, 
            Arrow[{topOfExitPupil[\([1]\)], \((lensAperture/2)\)*1.5}, 
              topOfExitPupil, 
              HeadLength ->  .01], 
Arrow[{bottomOfExitPupil[\([1]\)], \((\(-lensAperture\)/
                      2)\)*1.5}, bottomOfExitPupil, 
              HeadLength ->  .01], 
Text["ExitPupil", {6, 
                3}, {0, \(-1\)}], 
Text["Aperture
  Stop", {8, 2}, {0, \(-1\)}], 
Text["Lens", {10, 
                3}, {0, \(-1\)}]}], 
DisplayFunction -> $DisplayFunction];\)\)