ShankPaperResults.nb

Needs["Wavica`Wavica`"]

Clear[prismpair1,prismpair2,prismsys];

prismsys[medium_,angle_,shift_,space_,size_] := {prismpair1[medium,angle,shift,size],
Move[Rotate[prismpair2[medium,angle,shift,size],180,{0,1,0},{60,0,0}],space-20]};

prismpair1[medium_,angle_,shift_,size_] := Move[
        {Move[Prism[{60,size,60},10,ComponentMedium->medium],{0,5},180],
        Move[Prism[{60,size,60},10,ComponentMedium->medium],{{lp,710.},shift}]},
        0,angle];
prismpair2[medium_,angle_,shift_,size_] := Move[
        {Move[Prism[{60,size,60},10,ComponentMedium->medium],{{lp,710.},shift}],
        Move[Prism[{60,size,60},10,ComponentMedium->medium],{0,5},180]},
        0,angle];

sys = {
    SingleRay[WaveLength->.625,SymbolicWaveLength->λ,IntrinsicMedium->Vacuum],
    Move[Window[10,12.5,ComponentMedium->SF11],20],
    Move[Window[10,9,ComponentMedium->Quartz],35],
    Move[{GratingMirror[500,{5,5}, DiffractedOrders->{{-1,0},{0,0},{1,.5}}],
    Move[GratingMirror[500,{10,5}, DiffractedOrders->{{-1,.5},{0,0},{1,0}}],{{lg,5},0}]},75,135],
    Move[{Move[GratingMirror[500,{10,5}, DiffractedOrders->{{-1,0},{0,0},{1,.5}}],{{lg,5},0}],
    GratingMirror[500,{5,5}, DiffractedOrders->{{-1,.5},{0,0},{1,0}}]},100,45],
    Move[prismsys[BK7,30,120,1200,10],200],
    Move[Boundary[1600,600],{0,200}]};

Last[ReadRays[AnalyzeSystem[sys,PlotType->TopView],OpticalLength]]

[Graphics:HTMLFiles/index_1.gif]

res = TurboTrace[sys,OpticalLength,OutputType->RayTraceFunction,SequentialTrace->True]

rayfunc = (RayTraceFunction/.res)

plot0 = Plot[First[rayfunc[λ,6,710]],{λ,.6,.65},PlotRange->All];

[Graphics:HTMLFiles/index_5.gif]

Plot[(First[rayfunc[λ,6,710]]-First[rayfunc[.625,6,710]]),{λ,.6,.65},PlotRange->All];

[Graphics:HTMLFiles/index_6.gif]

symtrace = SymbolicTrace[sys,{λ>0,lg>0,lp>0}, SeriesOrder->6, MakeFloatingPoint->All, ReportedParameters->{SymbolicOpticalLength}, IncludeUserTerms->{λ}, LocalCoordinateExpansions->None, RunningCommentary->True];

ol = (SymbolicOpticalLength/.symtrace)

$RowBox[{RowBox[{1918.1, }], +, RowBox[{2.82654, , lg}], +, RowBox[{0.0479552, , lp}] ... λ^6}], +, RowBox[{0.0337845, , lg, , λ^6}], -, RowBox[{1.0293, , lp, , λ^6}]}]$

cent = (ol/.{lg->5.40333,lp->705.,λ->.625})

plot1 = Plot[(ol/.{lg->6,lp->710.}),{λ,.6,.65}];

[Graphics:HTMLFiles/index_476.gif]

Show[plot0,plot1];

[Graphics:HTMLFiles/index_477.gif]

plot1 = Plot[((ol/.{lg->6,lp->710.})-First[rayfunc[λ,6,710]]),{λ,.6,.65},PlotRange->All];

[Graphics:HTMLFiles/index_478.gif]

Created by Mathematica (July 29, 2005)