Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2001
*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 2001

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

Search the Archive

Dimensional analysis, Infinite sums

  • To: mathgroup at smc.vnet.net
  • Subject: [mg31581] Dimensional analysis, Infinite sums
  • From: vishnumohan jejjala <jejjala at ux12.cso.uiuc.edu>
  • Date: Wed, 14 Nov 2001 03:42:00 -0500 (EST)
  • Organization: University of Illinois at Urbana-Champaign
  • Sender: owner-wri-mathgroup at wolfram.com

I'm trying to do some integrals of Hermite polynomials with Mathematica.
The result of the integrals is expressed in terms of associated Laguerre
polynomials, and is then summed over the indices of the associated
Laguerre polynomials.  I am only interested in the leading terms in
the expression.  My question is two-fold:

1.  I only want lowest order terms in mtm, say the first three
non-vanishing powers.  How does one tell Mathematica to ignore higher
powers of mtm and thereby minimize computation time?  I.e., how do I
put mtm^k = 0 when k > 3, for example?

2.  My sums come in two forms:  sums from 0 to p-1 and p to infinity.
Below, l and m are sums of the second type, and n is a sum of the first
type.  I am isolating the relevant terms by hand using the Skipp function.
Is there a way to teach Mathematica to ignore terms above a certain
order in the Taylor expansion in mtm, and do the infinite sums explicitly?

The relevant parts of my code are below.  I have something like 600
similar calculations to perform, and want to address them efficiently.

Thanks for any help you can offer.

--Vishnu Jejjala
  High Energy Physics Group
  University of Illinois



Theta[x_] := If[x > 0, 1, 0]
Theta[0] := 1/2

L[0, m_, x_, y_] := 1 - m*(x^2 + y^2)/2
L[1, m_, x_, y_] := (m + 1) - ((m + 1)m/2)*(x^2 + y^2)/2
L[2, m_, x_, y_] := (m + 2)(m + 1)/2
L[3, m_, x_, y_] := (m + 3)(m + 2)(m + 1)/6

No[m_] := 1/(2^m * m!)^(1/2)

omega[p_] := omeff(p + 1/2)

roots = {Sqrt[a_]Sqrt[b_] -> Sqrt[a b],
    Sqrt[a_]/Sqrt[b_] -> Sqrt[a/b],
    Sqrt[2^a_ (b_)!]*Sqrt[2^c_ (d_)!] -> 2^((a + c)/2) Sqrt[b!d!],
    Sqrt[(a_^2)b_] -> a*Sqrt[b],
    Sqrt[(1/a_^2)b_] -> 1/a*Sqrt[b],
    2^a_ Sqrt[b_]Sqrt[c_]/Sqrt[d_] -> 2^a Sqrt[b c/d]}

integration1 =
  Phi1[a_, u_, v_]Phi2[b_, u_, v_] ->
    No[a]*No[b]*{Theta[a - b]*2^a*b!*(-(u + I*v)/2)^{a - b}*
            L[a - b, b, u, v] +
          Theta[b - a]*2^b*a!*((u - I*v)/2)^{b - a}*L[b - a, a, u, v]}
integration2 =
  Phi1[a_, u_, v_]Phi2[a_, u_, v_] -> No[a]^2*{2^a*a!*L[0, a, u, v]}

Skipp[l_, m_, n_] :=
  Block[{s, t}, s = l - m; t = l - (p + 1);
    If[s == 0, If[t == 0, Return[-1]], If[n == p - 2, Return[-1]]]; Return[0]]

Eppm[l_, m_, n_] :=

  Block[{AA, BB, CC, AA1, BB1, CC1, denom, den1, den2, A1},
    If[Skipp[l, m, n] == -1, Return[0]];
    AA = Sqrt[l + 1]Phi1[l + 1, Q1*mtm, Q2*mtm]*Phi2[n, Q1*mtm, Q2*mtm] +
            Sqrt[l]Phi1[l - 1, Q1*mtm, Q2*mtm]*Phi2[n, Q1*mtm, Q2*mtm] /.
          integration2 /. integration1;
    BB = Sqrt[m + 1]Phi1[m + 1, P1*mtm, P2*mtm]*Phi2[l, P1*mtm, P2*mtm] -
            Sqrt[m]Phi1[m - 1, P1*mtm, P2*mtm]*Phi2[l, P1*mtm, P2*mtm] /.
          integration2 /. integration1;
    CC = Sqrt[n + 1]Phi1[n + 1, R1*mtm, R2*mtm]*Phi2[m, R1*mtm, R2*mtm] -
            Sqrt[n]Phi1[n - 1, R1*mtm, R2*mtm]*Phi2[m, R1*mtm, R2*mtm] /.
          integration2 /. integration1;
    AA1 = PowerExpand[AA] //. roots;
    BB1 = PowerExpand[BB] //. roots;
    CC1 = PowerExpand[CC] //. roots;
    denom =
      Series[1/(Q0*mtm - (omega[l] - omega[n])), {Q0, 0, 3}]*
          Series[1/(R0*mtm + (omega[m] - omega[n])), {R0, 0, 3}]*-1 //
        Simplify;
    den1 = denom*mtm;
    den2 =
      Coefficient[den1, mtm] + Coefficient[den1, mtm^2]*mtm +
        Coefficient[den1, mtm^3]*mtm^2 + Coefficient[den1, mtm^4]*mtm^3;
    A1 = AA1*BB1*CC1*den2 // ExpandAll;
    Return[A1]]

Answer1 = 0;
Do[Answer1 = Answer1 + Eppm[l, m, n];
  Print[{l, m, n, Skipp[l, m, n], Eppm[l, m, n], Answer1}],
    {l, p, p + 1}, {m, p, p + 1}, {n, p - 1, p - 1}]


  • Prev by Date: Zero does not equal zero et al.
  • Next by Date: Re: Spherical Harmonics
  • Previous by thread: Re: Re: Zero does not equal zero et al.
  • Next by thread: Re: Dimensional analysis, Infinite sums