Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2000
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2000

[Date Index] [Thread Index] [Author Index]

Search the Archive

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.
***********************************************************************)


  • Prev by Date: RE: Hold, HoldForm, ReleaseHold when Plotting multiple functions
  • Next by Date: Re: How to solve the system of linear equations?
  • Previous by thread: RE: Hold, HoldForm, ReleaseHold when Plotting multiple functions
  • Next by thread: RE: RE: Hold, HoldForm, ReleaseHold when Plotting multiple functions