(************** Content-type: application/mathematica **************
CreatedBy='Mathematica 5.0'
Mathematica-Compatible Notebook
This notebook can be used with any Mathematica-compatible
application, such as Mathematica, MathReader or Publicon. 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@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[ 16697, 508]*)
(*NotebookOutlinePosition[ 17349, 531]*)
(* CellTagsIndexPosition[ 17305, 527]*)
(*WindowFrame->Normal*)
Notebook[{
Cell[CellGroupData[{
Cell["\<\
Derivation of Franck-Condon factors for polyatomic molecules by \
using the generating function formalism \
\>", "Title"],
Cell["\<\
Johannes Weber
Institute for Theoretical Chemistry, University of Cologne
22 Aug 2004
Contact: Johannes.Weber@uni-koeln.de
\
\>", "Text"],
Cell[TextData[{
"This Mathematica 5 notebook derives symbolic expressions for nuclear \
overlap integrals ",
StyleBox["I(m,n)",
FontSlant->"Italic"],
" [the Franck-Condon (FC) factor is the square of ",
StyleBox["I(m,n)",
FontSlant->"Italic"],
"] in terms of variables defined in the publication \"",
StyleBox["Franck-Condon factors for polyatomic molecules",
FontSlant->"Italic"],
"\" by J. Weber and G. Hohlneicher, ",
StyleBox["Mol. Phys.",
FontSlant->"Italic"],
" ",
StyleBox["101",
FontWeight->"Bold"],
", 2125 (2003) [1]. There, it was used to calculate expressions for 141 \
different overlap integrals. The ",
StyleBox["I(m,n)",
FontSlant->"Italic"],
" are useful in the calculation of intensities in vibronic molecular \
spectra. The derivation is based on the method of generating functions [2,3] \
in which a quantity is derived by equating the coefficients of identical \
polynomes occurring in polynomial expansions at both sides of an equation. \
"
}], "Text"],
Cell["Definition and initialization of variables", "Text",
CellDingbat->"\[FilledSquare]",
FontFamily->"Helvetica",
FontSize->18,
FontWeight->"Bold"],
Cell[BoxData[
\(\(\(Clear[AMat, EMat, CMat, U, T, Ut, Tt, Ti, Tj, Tk, Tl, U, Ui, Uj,
Uk, Ul, BVec, BtVec, rechts, recht, \ rech, \ links, \ Result, \ lhs\ ,
rhs, \ biggest\ ]\)\(\n\)
\)\)], "Input"],
Cell[BoxData[{
\(T := {Ti, Tj, Tk, Tl}\), "\n",
\(Tt := {Ti, Tj, Tk, Tl}\), "\n",
\(U := {Ui, Uj, Uk, Ul}\), "\n",
\(Ut := {Ui, Uj, Uk, Ul}\), "\n",
\(DVec := {Di, Dj, Dk, Dl}\), "\n",
\(BVec := {Bi, Bj, Bk, Bl}\), "\n",
\(BtVec := {Bi, Bj, Bk, Bl}\)}], "Input"],
Cell[BoxData[{
\(AMat := {{Aii, Aij, Aik, Ail}, {Aij, Ajj, Ajk, Ajl}, {Aik, Ajk, Akk,
Akl}, {Ail, Ajl, Akl, All}}\), "\n",
\(EMat := {{Eii, Eij, Eik, Eil}, {Eij, Ejj, Ejk, Ejl}, {Eik, Ejk, Ekk,
Ekl}, {Eil, Ejl, Ekl, Ell}}\), "\n",
\(CMat := {{Cii, Cij, Cik, Cil}, {Cij, Cjj, Cjk, Cjl}, {Cik, Cjk, Ckk,
Ckl}, {Cil, Cjl, Ckl, Cll}}\)}], "Input"],
Cell[TextData[{
StyleBox["HOWTO calculate an overlap integral", "Section"],
"\n",
StyleBox["0.)",
FontSize->14,
FontWeight->"Bold"],
" General information: The dummy variables ",
StyleBox["U",
FontSlant->"Italic"],
" and ",
StyleBox["T",
FontSlant->"Italic"],
" are strictly seen 3",
StyleBox["N",
FontSlant->"Italic"],
"-6 dimensional vectors, where ",
StyleBox["N",
FontSlant->"Italic"],
" is the number of nuclei that the molecule possesses. The ",
StyleBox["i",
FontSlant->"Italic"],
"-th element of the vector ",
StyleBox["T",
FontSlant->"Italic"],
" is the dummy variable corresponding to the ",
StyleBox["i",
FontSlant->"Italic"],
"-th normalmode of the initial state. Likewise, the ",
StyleBox["j",
FontSlant->"Italic"],
"-th element of the vector ",
StyleBox["U",
FontSlant->"Italic"],
" ist the dummy variable corresponding to the ",
StyleBox["j",
FontSlant->"Italic"],
"-th normalmode of the final state. The overlap integral ",
StyleBox["Imn",
FontFamily->"Courier"],
"(=",
StyleBox["I(m,n)",
FontSlant->"Italic"],
") - or more precisely the relative overlap integral ",
StyleBox["Imn/Io",
FontFamily->"Courier"],
" - results from a comparison of the coefficients occurring before \
corresponding polynomes of dummy variables in the expressions \"",
StyleBox["links",
FontFamily->"Courier"],
"\" und \"",
StyleBox["rechts",
FontFamily->"Courier"],
"\", which belong to the proper order. \"Proper order\" is existent, if the \
powers of ",
Cell[BoxData[
\(TraditionalForm\`U\_i\)]],
" and ",
Cell[BoxData[
\(TraditionalForm\`T\_j\)]],
" coincide with the quantum numbers of the normalmodes ",
StyleBox["i",
FontSlant->"Italic"],
" and ",
StyleBox["j",
FontSlant->"Italic"],
" of the initial- and the final state.\n",
StyleBox["1.)",
FontSize->14,
FontWeight->"Bold"],
" The expression \"",
StyleBox["links",
FontFamily->"Courier"],
"\" is the power series on the left side of Eq.(15) in [1], whose \
coefficients are the Imn. The sums run from 0 ... +\[Infinity], in \
principle, but as one is interested only in transitions between states with \
finite quantum number and as higher summation terms do not give contributions \
to lower orders, the summation over ",
StyleBox["j",
FontSlant->"Italic"],
" can be terminated after the maximum value of the quantum number ",
StyleBox["j",
FontSlant->"Italic"],
". As an example we look at a simple excitation from the vibrational ground \
state to the 5-th overtone of mode ",
StyleBox["j",
FontSlant->"Italic"],
" in the final state. Here the summation runs from ",
StyleBox["j",
FontSlant->"Italic"],
"=0,.. 5 . All other summations run from 0 to 0, i.e. they drop out. This \
is the reason, why the problem has not to be regarded in the full \
dimensionality of the normalmodes, but only in that dimensions where the \
quantum numbers differ from 0. Hence, the upper setup for ",
StyleBox["T",
FontFamily->"Courier"],
",",
StyleBox["U",
FontFamily->"Courier"],
", ",
StyleBox["DVec",
FontFamily->"Courier"],
", ... is suitable for multidimensional overlap integrals, where at maximum \
4 modes with quantum numbers unequal 0 are present the initial and the final \
state. For cases with more than 4 different quantum numbers, the vectors and \
matrices must be extended accordingly. From the resulting expression the \
\"proper\" terms (see 0.)) are cut out.\n",
StyleBox["2.)",
FontSize->14,
FontWeight->"Bold"],
" The expression \"",
StyleBox["rechts",
FontFamily->"Courier"],
"\" represents the power series expansion of the Exponential function \
occurring on the rhs of Eq.(15) in [1]. Also in this case, we have an \
infinite sum in principle, whose higher terms can be neglected in analogy to \
the considerations under 1.). The sum index ",
StyleBox["s",
FontSlant->"Italic"],
" runs only to a value which is the sum of the maximum quantum numbers, \
which are achieved in every mode of the initial and the final state. As an \
example we look at an excitation from the 2nd overtone of a hotband to the \
third overtone of a mode of the excited state. Then, ",
StyleBox["s",
FontSlant->"Italic"],
" must run up to 3+4=7. Second example: Excitation from the vibrational \
ground state in a combination band ",
Cell[BoxData[
FormBox[
RowBox[{"(",
RowBox[{"\[Chi]", "(",
RowBox[{
RowBox[{
RowBox[{"n",
FormBox[\(\_j\),
"TraditionalForm"]}], "=", "2"}], ",", \(n\_k\)}]}]}],
TraditionalForm]]],
"=3)). Here, ",
StyleBox["s",
FontSlant->"Italic"],
" runs from 0 ..5. It should be noted that in general terms are created by \
this, which are of higher order in ",
Cell[BoxData[
\(TraditionalForm\`U\_i\)]],
" or ",
Cell[BoxData[
\(TraditionalForm\`T\_j\)]],
" as the maximum quantum mumber in mode ",
StyleBox["i",
FontSlant->"Italic"],
" or ",
StyleBox["j",
FontSlant->"Italic"],
", respectively. This comes from the quadratic expressions ",
StyleBox["Ut.CMat.U",
FontFamily->"Courier"],
" or ",
StyleBox["Tt.AMat.T",
FontFamily->"Courier"],
", respectively. From the resulting expression for \"",
StyleBox["rechts",
FontFamily->"Courier"],
"\" again only the \"proper\" terms are cut out. \n",
StyleBox["3.)",
FontSize->14,
FontWeight->"Bold"],
" When the \"proper\" terms of \"",
StyleBox["rechts",
FontFamily->"Courier"],
"\" and \"",
StyleBox["links",
FontFamily->"Courier"],
"\" are equated, the dummy variables vanish at both sides. Now, the \
equation can be solved for ",
StyleBox["Imn",
FontFamily->"Courier"],
" or ",
StyleBox["Imn/Io",
FontFamily->"Courier"],
".\n "
}], "Text",
CellDingbat->"\[FilledSquare]"],
Cell["\<\
Here, the search string of the dummy variable has to be specified, \
for which a comparison of coefficients has to be performed. Note, that by \
factorization the dummy variables appear in lexical ordering, i.e. Ti before \
Tj and Tj before Uj. For linear variables use only their Name (e.g. \"Ui\"), \
for higher powers use the \"^\"-symbol (e.g. \"Ui^2\" ). The search string \
must be terminated by a space and a down bar.\
\>", "Text",
CellDingbat->"\[FilledSquare]",
FontSize->16],
Cell[BoxData[
\(text := \(\(Ui^2\ Uj\ _\)\(\n\)
\)\)], "Input"],
Cell[BoxData[
\(Now\ the\ left\ side\ of\ equation\ \((15)\)\ must\ be\ expanded . \
The\ sums\ have\ to\ run\ only\ over\ those\ quantum\ numbers\ which\ \
are\ different\ from\ zero\ \((e . g . \ n\_i = \(n\_j = \(n\_k = 1\)\), \
n\_l = 2,
m\_i = \(m\_j = \(m\_k = \(m\_l =
0\ \[DoubleRightArrow] \[Sum]\+\(\(n\_i\) \(n\_j\) n\_k = \
0\)\%1\(\[Sum]\+\(n\_l = 0\)\%2\(
U\_i\%\(n\_i\)\) \(U\_j\%\(n\_j\)\) \
\(U\_k\%\(n\_k\)\)
U\_l\%\(n\_l\)*\((\(\(2\^n\_i\)\_ ... \
\))\)/\((\(n\_i!\) ... )\)^\((1/2)\) Imn\)\)\)\))\)\)], "Text",
CellDingbat->"\[FilledSquare]",
FontFamily->"Times",
FontSize->14],
Cell[BoxData[
\(links\ :=
Sum[Sum[Sum[
Sum[Sum[\
Sum[\n\t\t\t\t\tTm^m\ Tn^n\ Ui^i\ Uj^j\ \ Uk^k\ Ul^
l\ \ \((2^m\ \ 2^n\ 2^i\ 2^j\ 2^
k\ 2^l/\((\(m!\)\ \(n!\)\ \ \(i!\)\ \(j!\)\ \
\(k!\)\ \(l!\))\))\)^\((1/2)\)\ Imn, {i, 0, 2}], {j, 0, 1}], {k, 0, 0}], {l,
0, 0}], {m, 0, 0}], {n, 0, 0}]\)], "Input"],
Cell[CellGroupData[{
Cell[BoxData[{
\(Factor[links]\), "\n",
\(lhs = \ \(Cases[Expand[links], \ text]\)[\([1]\)]\)}], "Input"],
Cell[BoxData[
\(Imn\ \((1 + \@2\ Ui + \@2\ Ui\^2 + \@2\ Uj + 2\ Ui\ Uj +
2\ Ui\^2\ Uj)\)\)], "Output"],
Cell[BoxData[
\(2\ Imn\ Ui\^2\ Uj\)], "Output"]
}, Open ]],
Cell[BoxData[{
\(Now\ the\ right\ side\ of\ \((15)\)\ is\ expanded . \
The\ expansion\ goes\ up\ to\ \ \ s\ = \ \(\(n\_1 +
n\_2 + ... \) + n\_N + m\_1 + m\_2 + ... \) + \(\(m\_N . \
By\)\(\ \)\(the\)\(\ \)\(substitution\)\(\ \)\(operator\)\(\ \ \)\
\)\), "\[IndentingNewLine]",
\(\(\(''\)\(/.\)\({\ }''\ all\ components\ of\ \ U\ and\ T\ are\ set\ to\ \
zero\ which\ belong\ to\ qunatum\ numbers\ that\ are\ zero . \
As\ example\ look\ at\ fourdimensional\ dummy\ vectors\)\)\ \), "\
\[IndentingNewLine]",
\(U = \(\((U\_i, U\_j, U\_k, U\_l)\)\ and\ T = \((T\_i, T\_j, T\_k,
T\_l)\)\), \
with\ corresponding\ qunatum\ numbers\ n\_i = \(n\_j = \(n\_k = 1\)\), \
n\_l = 2,
m\_i = \(m\_j = \(m\_k = \(m\_l =
0\ \[DoubleRightArrow] \ \[IndentingNewLine]'' /. {Ti \[Rule] 0,
Tj -> 0, Tk -> 0, Tl -> 0}''\)\)\)\)}], "Text",
CellDingbat->"\[FilledSquare]",
FontFamily->"Times",
FontSize->14],
Cell[CellGroupData[{
Cell[BoxData[
\(rechts =
Io\ Sum[1/\(s!\)\ \((\((Tt . AMat . T\ + \
Tt . BVec)\) + \((Ut . CMat . U\ + \
Ut . DVec)\) + \((Ut . EMat . T)\))\)^s, {s, 0,
3}]\ \ /. {Ti \[Rule] 0, Tj -> 0, Tk -> 0, Tl -> 0,
Uk \[Rule] 0, \ Ul \[Rule] 0}\)], "Input"],
Cell[BoxData[
\(Io\ \((1 + Di\ Ui + Dj\ Uj + Ui\ \((Cii\ Ui + Cij\ Uj)\) +
Uj\ \((Cij\ Ui + Cjj\ Uj)\) +
1\/2\ \((Di\ Ui + Dj\ Uj + Ui\ \((Cii\ Ui + Cij\ Uj)\) + Uj\ \((Cij\
\ Ui + Cjj\ Uj)\))\)\^2 +
1\/6\ \((Di\ Ui + Dj\ Uj + Ui\ \((Cii\ Ui + Cij\ Uj)\) + Uj\ \((Cij\
\ Ui + Cjj\ Uj)\))\)\^3)\)\)], "Output"]
}, Open ]],
Cell[CellGroupData[{
Cell[BoxData[{
\(Length[Expand[rechts]]\), "\n",
\(recht = Cases[Expand[rechts], text]\), "\n",
\(Length[Expand[recht]]\), "\n",
\(biggest = \(Dimensions[recht]\)[\([1]\)]\), "\n",
\(\(\(rhs = Factor[Sum[recht[\([i]\)], {i, 1, \ biggest}]]\)\(\n\)
\)\)}], "Input"],
Cell[BoxData[
\(56\)], "Output"],
Cell[BoxData[
\({2\ Cij\ Di\ Io\ Ui\^2\ Uj, Cii\ Dj\ Io\ Ui\^2\ Uj,
1\/2\ Di\^2\ Dj\ Io\ Ui\^2\ Uj}\)], "Output"],
Cell[BoxData[
\(3\)], "Output"],
Cell[BoxData[
\(3\)], "Output"],
Cell[BoxData[
\(1\/2\ \((4\ Cij\ Di + 2\ Cii\ Dj +
Di\^2\ Dj)\)\ Io\ Ui\^2\ Uj\)], "Output"]
}, Open ]],
Cell["\<\
Solve for the relative overlap integral Imn/Io, print the number of \
terms and simplify the expression:\
\>", "Text",
CellDingbat->"\[FilledSquare]",
FontSize->14],
Cell[CellGroupData[{
Cell[BoxData[{
\(Result = Factor[Imn/Io\ \ *\ rhs/lhs]\), "\n",
\(Length[Expand[Result]]\), "\n",
\(Final = Simplify[Result]\)}], "Input"],
Cell[BoxData[
\(1\/4\ \((4\ Cij\ Di + 2\ Cii\ Dj + Di\^2\ Dj)\)\)], "Output"],
Cell[BoxData[
\(3\)], "Output"],
Cell[BoxData[
\(1\/4\ \((4\ Cij\ Di + \((2\ Cii + Di\^2)\)\ Dj)\)\)], "Output"]
}, Open ]],
Cell["\<\
The final expression above holds the value for the relative overlap \
integral Imn/Io. For the calculation of the probability (relative FC factor) \
the squares of the overlap integrals have to be used, i.e. Imn^2/Io^2. In the \
following section the result is printed in Fortran notation. Also a more \
agressive simplification of the routines is performed.
\
\>", "Text",
CellDingbat->"\[FilledSquare]",
FontSize->14],
Cell[CellGroupData[{
Cell[BoxData[
\(\(\(FortranForm[Final]\)\(\n\)
\)\)], "Input"],
Cell["(4*Cij*Di + (2*Cii + Di**2)*Dj)/4.", "Output"]
}, Open ]],
Cell[CellGroupData[{
Cell["\<\
AllerFinalst=FullSimplify[Result]\
\>", "Input"],
Cell[BoxData[
\(Cij\ Di + 1\/4\ \((2\ Cii + Di\^2)\)\ Dj\)], "Output"]
}, Open ]],
Cell[TextData[{
StyleBox["Literature", "Section"],
"\n[1] J.Weber and G.Hohlneicher,\"",
StyleBox["Franck-Condon factors for polyatomic molecules\"",
FontSlant->"Italic"],
", ",
StyleBox["Mol. Phys.",
FontSlant->"Italic"],
" ",
StyleBox["101",
FontWeight->"Bold"],
",2125 (2003).\n[2] D. E. Knuth, ",
StyleBox["\"",
FontSlant->"Italic"],
StyleBox["The Art of Computer Programming\"",
FontSlant->"Italic"],
", Vol.1, Addison-Wesley (1969).\n[3] R. Courant and D. Hilbert, ",
StyleBox["\"Methoden der Mathematischen Physik I\"",
FontSlant->"Italic"],
",3rd ed. Vol.1, Springer (1968)."
}], "Text",
CellDingbat->"\[FilledSquare]"]
}, Open ]]
},
FrontEndVersion->"5.0 for X",
ScreenRectangle->{{0, 1280}, {0, 1024}},
WindowToolbars->{},
WindowSize->{1019, 636},
WindowMargins->{{75, Automatic}, {Automatic, 168}}
]
(*******************************************************************
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[CellGroupData[{
Cell[1776, 53, 131, 3, 211, "Title"],
Cell[1910, 58, 150, 6, 104, "Text"],
Cell[2063, 66, 1033, 26, 86, "Text"],
Cell[3099, 94, 157, 4, 39, "Text"],
Cell[3259, 100, 220, 4, 59, "Input"],
Cell[3482, 106, 296, 7, 123, "Input"],
Cell[3781, 115, 390, 6, 59, "Input"],
Cell[4174, 123, 6022, 180, 405, "Text"],
Cell[10199, 305, 500, 9, 106, "Text"],
Cell[10702, 316, 73, 2, 43, "Input"],
Cell[10778, 320, 706, 14, 90, "Text"],
Cell[11487, 336, 406, 8, 59, "Input"],
Cell[CellGroupData[{
Cell[11918, 348, 114, 2, 43, "Input"],
Cell[12035, 352, 117, 2, 37, "Output"],
Cell[12155, 356, 51, 1, 29, "Output"]
}, Open ]],
Cell[12221, 360, 1017, 19, 89, "Text"],
Cell[CellGroupData[{
Cell[13263, 383, 337, 6, 43, "Input"],
Cell[13603, 391, 346, 6, 79, "Output"]
}, Open ]],
Cell[CellGroupData[{
Cell[13986, 402, 292, 6, 107, "Input"],
Cell[14281, 410, 36, 1, 27, "Output"],
Cell[14320, 413, 124, 2, 44, "Output"],
Cell[14447, 417, 35, 1, 27, "Output"],
Cell[14485, 420, 35, 1, 27, "Output"],
Cell[14523, 423, 107, 2, 44, "Output"]
}, Open ]],
Cell[14645, 428, 178, 5, 33, "Text"],
Cell[CellGroupData[{
Cell[14848, 437, 152, 3, 59, "Input"],
Cell[15003, 442, 81, 1, 44, "Output"],
Cell[15087, 445, 35, 1, 27, "Output"],
Cell[15125, 448, 83, 1, 44, "Output"]
}, Open ]],
Cell[15223, 452, 440, 9, 90, "Text"],
Cell[CellGroupData[{
Cell[15688, 465, 70, 2, 43, "Input"],
Cell[15761, 469, 52, 0, 27, "Output"]
}, Open ]],
Cell[CellGroupData[{
Cell[15850, 474, 60, 4, 57, "Input"],
Cell[15913, 480, 74, 1, 44, "Output"]
}, Open ]],
Cell[16002, 484, 679, 21, 95, "Text"]
}, Open ]]
}
]
*)
(*******************************************************************
End of Mathematica Notebook file.
*******************************************************************)