Re: Hold, HoldForm, ReleaseHold when Plotting multiple functions
- To: mathgroup at smc.vnet.net
- Subject: [mg25514] Re: [mg25481] Hold, HoldForm, ReleaseHold when Plotting multiple functions
- From: Ross Sean Civ AFRL/DELO <Sean.Ross at kirtland.af.mil>
- Date: Thu, 5 Oct 2000 23:50:34 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
Ok, I have attached the notebook showing an example of when
Plot[Evaluate[...]..] does not work the same as explicitly listing each
function you want to plot. The error messages all come from FindRoot, one
of the functions called by the functions I am trying to Plot. One of the
resondents to my message said that the only thing he could think of was
"some weird interaction with another HoldAll function, like FindRoot". That
is exactly the case and this "weird interaction" has stalled several
programming projects for me. In one particular case using functions far
more nested than the ones in this notebook, the result is that a certain set
of functions gives different results when called within another function
compared to what they give when called directly, so this "weird interaction"
is a matter of some concern to me and has plagued me for a couple of years
now. If anyone has any light to shed on the matter, please respond to:
Sean.Ross at kirtland.af.mil
<<FPOPO_tuningcurves.mathgroup.nb>>
Dr. Sean Ross
AFRL/DELO
3550 Aberdeen Ave. Building 761
Kirtland AFB, NM 87117
Office: (505) 846-9148
Labs: (505) 853-6440/846-9289
Fax: (505) 853-0485
Email: sean.ross at kirtland.af.mil
(***********************************************************************
Mathematica-Compatible Notebook
This notebook can be used on any computer system with Mathematica 4.0,
MathReader 4.0, or any compatible application. The data for the
notebook
starts with the line containing stars above.
To get the notebook into a Mathematica-compatible application, do one
of
the following:
* Save the data starting with the line of stars above into a file
with a name ending in .nb, then open the file inside the application;
* Copy the data starting with the line of stars above to the
clipboard, then use the Paste menu command inside the application.
Data for notebooks contains only printable 7-bit ASCII and can be
sent directly in email or through ftp in text mode. Newlines can be
CR, LF or CRLF (Unix, Macintosh or MS-DOS style).
NOTE: If you modify the data for this notebook not in a Mathematica-
compatible application, you must delete the line below containing the
word CacheID, otherwise Mathematica-compatible applications may try to
use invalid cache data.
For more information on notebooks and Mathematica-compatible
applications, contact Wolfram Research:
web: http://www.wolfram.com
email: info at wolfram.com
phone: +1-217-398-0700 (U.S.)
Notebook reader applications are available free of charge from
Wolfram Research.
***********************************************************************)
(*CacheID: 232*)
(*NotebookFileLineBreakTest
NotebookFileLineBreakTest*)
(*NotebookOptionsPosition[ 8295, 211]*)
(*NotebookOutlinePosition[ 9093, 239]*)
(* CellTagsIndexPosition[ 9049, 235]*)
(*WindowFrame->Normal*)
Notebook[{
Cell["\<\
The purpose of this file is to generate tuning curves for PPLN and then
pump \
wavelength acceptance bandwidth curves. \
\>", "Text"],
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"]
}, Closed]],
Cell[CellGroupData[{
Cell["Tuning Curves", "Subsubsection"],
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][\[Capital
Lambda]\
0,T]]==0.0,{x,3.5,3.8}];
\[Lambda]s=1/(1/\[Lambda]p-1/\[Lambda]i);
Return[{\[Lambda]s,\[Lambda]i}]
];\
\>", "Input"]
}, Closed]],
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_,\[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;
Return[{\[CapitalDelta]\[Lambda]p*1000(*nm*),\[CapitalDelta]\[Nu]p/1000(
*GHz*)\
}]
]\
\>", "Input"],
Cell["bandwidth[29.1,150]", "Input"],
Cell["\<\
Map[HoldForm[InputForm[bandwidth[#,x][[1]]]]&,{28.5,28.7,28.9,29.1,29.3,
29.5,\
29.7,29.9}]\
\>", "Input"],
Cell["\<\
Plot[Evaluate[Map[bandwidth[#,x][[1]]&,{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"],
Cell["\<\
plotting=Plot[{bandwidth[28.5, x][[1]],
\tbandwidth[28.7, x][[1]],
\tbandwidth[28.9, x][[1]],
\tbandwidth[29.1, x][[1]],
\tbandwidth[29.3, x][[1]],
\tbandwidth[29.5, x][[1]],
\tbandwidth[29.7, x][[1]],
\tbandwidth[29.9, x][[1]]},{x,140,200},
PlotRange->{-5,5},
TextStyle->FontSize->14,
Prolog->Thickness[.006],
PlotStyle->Array[Hue[#/8.]&,8],
Frame->True,
FrameLabel->{\"Grating Temperature, \[Degree]C\",\"Pump acceptance \
bandwidth, nm\",\"PPLN bandwidth curves\",None}]\
\>", "Input"]
}, Closed]]
},
FrontEndVersion->"4.0 for Microsoft Windows",
ScreenRectangle->{{0, 1024}, {0, 723}},
WindowToolbars->{"RulerBar", "EditBar"},
CellGrouping->Manual,
WindowSize->{783, 627},
WindowMargins->{{18, Automatic}, {26, Automatic}},
PrintingCopies->1,
PrintingPageRange->{Automatic, Automatic},
Magnification->1
]
(***********************************************************************
Cached data follows. If you edit this Notebook file directly, not
using
Mathematica, you must remove the line containing CacheID at the top of
the file. The cache data will then be recreated when you save this
file
from within Mathematica.
***********************************************************************)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[1717, 49, 144, 3, 33, "Text"],
Cell[CellGroupData[{
Cell[1886, 56, 65, 0, 43, "Subsubsection"],
Cell[1954, 58, 298, 5, 52, "Text"],
Cell[2255, 65, 3390, 55, 990, "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell[5682, 125, 38, 0, 29, "Subsubsection"],
Cell[5723, 127, 568, 17, 264, "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell[6328, 149, 50, 0, 29, "Subsubsection"],
Cell[6381, 151, 849, 20, 300, "Input"],
Cell[7233, 173, 36, 0, 30, "Input"],
Cell[7272, 175, 115, 3, 30, "Input"],
Cell[7390, 180, 366, 10, 156, "Input"],
Cell[7759, 192, 520, 16, 282, "Input"]
}, Closed]]
}
]
*)
(***********************************************************************
End of Mathematica Notebook file.
***********************************************************************)