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: [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
]





  • Prev by Date: Re: Re:Mapping down two lists
  • Next by Date: mathematica in batch mode?
  • Previous by thread: Re: Re: Hold, HoldForm, ReleaseHold when Plotting multiple functions
  • Next by thread: interpolation