Re: Hold, HoldForm, ReleaseHold when Plotting multiple functions
- To: mathgroup at smc.vnet.net
- Subject: [mg25552] Re: [mg25481] Hold, HoldForm, ReleaseHold when Plotting multiple functions
- From: "Allan Hayes" <hay at haystack.demon.co.uk>
- Date: Sat, 7 Oct 2000 03:35:56 -0400 (EDT)
- References: <8rjk0h$ohc@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Ross,
Lets follow what happens with a simplified version of the plot that does not
work, and try to correct the problems.
(I append an corrected version of your notebook - typos also corrects -
please not also that Return[ ] is not needed at the end of Module[ ])
Plot[Evaluate[Map[bandwidth[#, x][[1]] &, {28.5, 28.7}]], {x, 140, 200}]
Evalute[...] becomes
{bandwidth[#, x][[1]] &[28.5], bandwidth[#, x][[1]] &[28.7]}
{bandwidth[28.5, x][[1]], bandwidth[#, x][[28.7]] },
Now bandwidth[28.5, x] tries to evaluates, but does succeed because deep in
its definition FindRoot needs x to be a number, not a symbol.
We can fix this by starting the definition of bandwidth with (writing lamba)
bandwidth[lambda0_,T_Real ..]:= ..
With this change bandwidth[28.5, x] does not evaluate.
However, part extraction does proceed and we get
{28.5, 28.7 }
and we get horizontal lines plotted.
Here are two ways round this
(1) Define
fst[{x_Real, y_}] := x
then use
Plot[Evaluate[Map[fst[bandwidth[#, x]] &, {28.5, 28.7}]], {x, 140, 200}]
(2) Define
bandwidth1[lambd0_,T_Real ..]:= bandwidth[lambd0,T ..][[1]]
then use
Plot[Evaluate[Map[bandwidth1[#, x] &, {28.5, 28.7}]], {x, 140, 200}]
--
Allan
---------------------
Allan Hayes
Mathematica Training and Consulting
Leicester UK
www.haystack.demon.co.uk
hay at haystack.demon.co.uk
Voice: +44 (0)116 271 4198
Fax: +44 (0)870 164 0565
Notebook[{
Cell["\<\
The purpose of this file is to generate tuning curves for PPLN and then
pump wavelength acceptance bandwidth curves. \
\>", "Text"],
Cell[BoxData[
\(Remove["\<`*\>"]\)], "Input"],
Cell[CellGroupData[{
Cell["Lithium Niobate Sellmeiers-Jundt formula", "Subsubsection"],
Cell["\<\
This version is used in the snlo.exe code and agrees very well with our
fiber pumped OPO. Reference: Dieter H. Jundt, Temperature-dependent
Sellmeiers equation for the index of refraction, ne, in congruent lithium \
niobate.
Optics Letters 15 October 1997, page 1553.\
\>", "Text"],
Cell[BoxData[{
\(\(nextLiNbO3::usage = "\<nextLiNbO3[\[Lambda]
(\[Mu]m),temperature (\[Degree]C)] returns the temperature dependent \
extraordinary index of refraction for Lithium Niobate. Wavelength is \
restricted to
{.3\[Mu]m,10.1\[Mu]m}\>";\)\n\), "\n",
\(\(nextLiNbO3[\[Lambda]_ /; \((\[Lambda] >= .3 && \[Lambda] <=
10.1)\) (*microns*) , \n\t
T_ (*degrees\ C*) ] := \n\t (*Temperature\ Dependent\ Sellmeier\ \
equations\ for\ Lithium\ Niobate*) \n\t
Module[{\n\t\tTo = 24.5, \n\t\ \ \ \ A1 = 5.35583, \n\t\ \ \ \ A2 =
0.100473, \n\t\ \ \ \ A3 = 0.20692, \n\t\ \ \ \ A4 =
100. , \n\t\ \ \ \ A5 = 11.34927, \n\t\ \ \ \ A6 =
1.5334*^-2, \n\t\ \ \ \ B1 = 4.629*^-7, \n\t\ \ \ \ B2 =
3.862*^-8, \n\t\ \ \ \ B3 = \(- .89*^-8\), \n\t\ \ \ \ B4 =
2.657*^-5}, \n\t\tF = \((T\ - \ To)\)*\((T + \ 570.82)\);
Sqrt[\((A1 +
B1\ F + \((A4 + B4\ F)\)/\((\[Lambda]^2 - A5^2)\) + \((A2 +
B2\ F)\)/\((\[Lambda]^2 - \((A3 + B3\ F)\)^2)\) -
A6\ \[Lambda]^2)\)]];\)\[IndentingNewLine]\), "\
\[IndentingNewLine]",
\(\(d\[Lambda]nextLiNbO3::usage = "\<d\[Lambda]nextLiNbO3[\[Lambda] \
(\[Mu]m),temperature (\[Degree]C)] returns the temperature dependent \
wavelength dispersion of the extraordinary index of refraction for
Lithium Niobate. Wavelength is restricted to {.3\[Mu]m,10.1\[Mu]m}\>";\)\
\[IndentingNewLine]\), "\[IndentingNewLine]",
\(\(d\[Lambda]nextLiNbO3[\[Lambda]_ /; \((\[Lambda] >= .3 && \[Lambda]
<
10.1)\) (*microns*) , \n\t
T_ (*degrees\ C*) ] := \[IndentingNewLine] (*Wavelength\
dispersion\
\ of\ Sellmeier\ equations\ for\ Lithium\ \
Niobate*) \[IndentingNewLine]Module[{\n\t\tTo = 24.5, \n\t\ \ \ \ A1 =
5.35583, \n\t\ \ \ \ A2 = 0.100473, \n\t\ \ \ \ A3 =
0.20692, \n\t\ \ \ \ A4 = 100. , \n\t\ \ \ \ A5 =
11.34927, \n\t\ \ \ \ A6 = 1.5334*^-2, \n\t\ \ \ \ B1 =
4.629*^-7, \n\t\ \ \ \ B2 =
3.862*^-8, \n\t\ \ \ \ B3 = \(- .89*^-8\), \n\t\ \ \ \ B4 =
2.657*^-5}, \n\t\tF = \((T\ - \ To)\)*\((T +
570.82)\); \((\(-2\)*
A6*\[Lambda] - \((2*\((A4 +
B4*F)\)*\[Lambda])\)/\((\(-A5^2\) + \
\[Lambda]^2)\)^2 - \((2*\((A2 +
B2*F)\)*\[Lambda])\)/\((\(-\((A3 +
B3*F)\)^2\) + \[Lambda]^2)\)^2)\)/\((2*
Sqrt[A1 + B1*F -
A6*\[Lambda]^2 + \((A4 +
B4*F)\)/\((\(-A5^2\) + \[Lambda]^2)\) + \((A2 +
B2*F)\)/\((\(-\((A3 +
B3*F)\)^2\) + \[Lambda]^2)\)])\)];\)\), "\
\[IndentingNewLine]",
\(\(\[CapitalLambda]::usage = "\<\[CapitalLambda][\[CapitalLambda]0, \
T(degrees C)] returns the expanded or contracted length of Lithium
Niobate based on temperature. In practice, this is used for the change in
grating period with temperature\>";\)\), "\[IndentingNewLine]",
\(\(\[CapitalLambda][\[CapitalLambda]0_, T_] :=
Module[{\[Alpha] = 1.54*^-5, \[Beta] = 5.3*^-9,
T0 = 25}, \[CapitalLambda]0 \((1 + \[Alpha] \((T -
T0)\) + \[Beta] \((T - T0)\)^2)\)];\)\)}], "Input"]
}, Open ]],
Cell[CellGroupData[{
Cell["Tuning Curves", "Subsubsection"],
Cell[CellGroupData[{
Cell["\<\
\[CapitalDelta]k[\[Lambda]i_,T_,\[CapitalLambda]_]:=Module[{\[Lambda]s,\
\[Lambda]p=1.067},
np=nextLiNbO3[\[Lambda]p,T];
ni=nextLiNbO3[\[Lambda]i,T];
\[Lambda]s=1/(1/\[Lambda]p-1/\[Lambda]i);
ns=nextLiNbO3[\[Lambda]s,T];
2*\[Pi] (np/\[Lambda]p-ns/\[Lambda]s-ni/\[Lambda]i-1/\[CapitalLambda])
];
\[Lambda]pm[\[CapitalLambda]0_,T_,\[Lambda]p_:1.067]:=
Module[{x},
\[Lambda]i=x/.FindRoot[\[CapitalDelta]k[x,T,\[CapitalLambda][\\[CapitalLambd
a]\
0,T]]==0.0,{x,3.5,3.8}];
\[Lambda]s=1/(1/\[Lambda]p-1/\[Lambda]i);
Return[{\[Lambda]s,\[Lambda]i}]
];\
\>", "Input"],
Cell[BoxData[
\(General::"spell" \(\(:\)\(\ \)\)
"Possible spelling error: new symbol name \"\!\(\[Lambda]s\)\" is \
similar to existing symbols \!\({\[Lambda], \[Lambda]i}\)."\)], "Message"],
Cell[BoxData[
\(General::"spell" \(\(:\)\(\ \)\)
"Possible spelling error: new symbol name \"\!\(\[Lambda]p\)\" is \
similar to existing symbols \!\({\[Lambda], \[Lambda]i, \[Lambda]s}\)."\)],
\
"Message"],
Cell[BoxData[
\(General::"spell1" \(\(:\)\(\ \)\)
"Possible spelling error: new symbol name \"\!\(\[Lambda]pm\)\" is \
similar to existing symbol \"\!\(\[Lambda]p\)\"."\)], "Message"]
}, Open ]]
}, Open ]],
Cell[CellGroupData[{
Cell["Pump acceptance bandwidth", "Subsubsection"],
Cell["\<\
Clear[bandwidth];
bandwidth::usage=\"bandwidth[\[CapitalLambda]0(\[Mu]m),
T(\[Degree]C)] gives the calculated pump acceptance bandwidth in {nm, GHz} \
for a given
grating period and temperature for PPLN.\";
bandwidth[\[CapitalLambda]0_,T_Real,\[CapitalDelta]kl_:\[Pi]/4]:=
Module[{\[Lambda]p=1.067,np,npp,\[Lambda]i,c=3*^8,l=50000(*\[Mu]m*)},
npp=d\[Lambda]nextLiNbO3[\[Lambda]p,T];
np=nextLiNbO3[\[Lambda]p,T];
\[Lambda]i=\[Lambda]pm[\[CapitalLambda]0,T][[2]];
npi=d\[Lambda]nextLiNbO3[\[Lambda]i,T];
ni=nextLiNbO3[\[Lambda]i,T];
\[CapitalDelta]\[Lambda]p=1/((\[Pi] l / \[CapitalDelta]kl)
(npp/\[Lambda]p - np/\[Lambda]p^2 -npi* \[Lambda]i/\[Lambda]p^2 \
+ni/\[Lambda]p^2));
\[CapitalDelta]\[Nu]p=c \[CapitalDelta]\[Lambda]p/\[Lambda]p^2;
{\[CapitalDelta]\[Lambda]p*1000(*nm*),\[CapitalDelta]\[Nu]p/1000(*GHz*)}
]\
\>", "Input"],
Cell["\<\
Two ways of proceeding:
(1)\
\>", "Text"],
Cell[BoxData[
StyleBox[\(fst[{x_Real, \ y_}]\ := \ x\),
FormatType->StandardForm]], "Input"],
Cell["\<\
Plot[Evaluate[Map[fst[bandwidth[#,x]]&,{28.5,28.7,28.9,29.1,29.3,29.5,29
.7,29.9}]],{x,140,200},
PlotRange->{-5,5},
TextStyle->FontSize->14,
Prolog->Thickness[.006],
PlotStyle->Array[Hue[#/9.]&,9],
Frame->True,
FrameLabel->{\"Grating Temperature, \[Degree]C\",\"Pump acceptance \
bandwidth, nm\",\"PPLN bandwidth curves\",None}];\
\>", "Input"]
}, Open ]],
Cell["(2)", "Text"],
Cell[BoxData[
\(bandwidth1[\[CapitalLambda]0_,
T_Real, \[CapitalDelta]kl_: \[Pi]/
4] := \(bandwidth[\[CapitalLambda]0,
T, \[CapitalDelta]kl]\)[\([1]\)]\)], "Input"],
Cell["\<\
Plot[Evaluate[Map[bandwidth1[#,x]&,{28.5,28.7,28.9,29.1,29.3,29.5,29
.7,29.9}]],{x,140,200},
PlotRange->{-5,5},
TextStyle->FontSize->14,
Prolog->Thickness[.006],
PlotStyle->Array[Hue[#/9.]&,9],
Frame->True,
FrameLabel->{\"Grating Temperature, \[Degree]C\",\"Pump acceptance \
bandwidth, nm\",\"PPLN bandwidth curves\",None}];\
\>", "Input"]
},
FrontEndVersion->"4.0 for Microsoft Windows",
ScreenRectangle->{{0, 1280}, {0, 951}},
WindowToolbars->{"RulerBar", "EditBar"},
CellGrouping->Manual,
WindowSize->{783, 627},
WindowMargins->{{Automatic, 193}, {Automatic, 127}},
PrintingCopies->1,
PrintingPageRange->{Automatic, Automatic},
Magnification->1
]