Mathematica How Can I Fix My Mathematica Animation Code for Propagator Integration?

[axelalma]

Hello!

I need some help in Mathematica, because I'm newbie in using this program.

I've a kernel for a propagator, what i want to integrate numerically by p (because the problem hasn't got analitical solution) to receive the propagator. Next i want to use that propagator for an initial state and i want to plot the square of the absolute value of the obtained wavefunction around the pole, so that the time (in my code this is t1) will run over an interval, so it would be a running animation.

My code is here, where psi0[x] is the initial state, k1[x,x1,t,t1,p] is the kernel of the propagator and t1 runs over the interval {0,10}:

Animate[Plot[Abs[NIntegrate[psi0[x1]*k1[x, x1, 0, t1, p], {x1, -Infinity, Infinity}, {p, 0, Infinity}, MaxRecursion -> 10]]^2, {x, -1, 1}, PlotPoints -> 10, MaxRecursion -> 10], {t1, 0, 10}, AnimationRunning -> False]

It isn't working, that's why i need help.

Sorry, my language skills are low.
Thank you in anticipation

 

[Hepth]

Can you give the definitions of psi and k1?

 

[axelalma]

Can you give the definitions of psi and k1?

I send you the nb file where you can find both, because the k1 is too difficult to write in a message.View attachment blabla.nb

 

[Bill Simpson]

Discard the animation and see if it is possible to get a single plot.

In[19]:= t1 = 2; Plot[Abs[NIntegrate[psi0[x1]*k1[x, x1, 0, t1, p], {x1, -Infinity, Infinity}, {p, 0, Infinity}, MaxRecursion -> 10]]^2, {x, -1, 1}, PlotPoints -> 10, MaxRecursion -> 10]

During evaluation of In[19]:= NIntegrate::ncvb: NIntegrate failed to converge to prescribed accuracy after 20 recursive bisections in p near {x1,p} = {0.,9.53674*10^-6}. NIntegrate obtained 2.1491*10^83+3.71159*10^83 I and 4.172240692690985`*^83 for the integral and error estimates. >>

Out[19]= $Aborted

so the NIntegrate is blowing up and will likely never finish.

Can you see a way to get the code to provide a numeric integral across the domain?

 

[axelalma]

Discard the animation and see if it is possible to get a single plot.

In[19]:= t1 = 2; Plot[Abs[NIntegrate[psi0[x1]*k1[x, x1, 0, t1, p], {x1, -Infinity, Infinity}, {p, 0, Infinity}, MaxRecursion -> 10]]^2, {x, -1, 1}, PlotPoints -> 10, MaxRecursion -> 10]

During evaluation of In[19]:= NIntegrate::ncvb: NIntegrate failed to converge to prescribed accuracy after 20 recursive bisections in p near {x1,p} = {0.,9.53674*10^-6}. NIntegrate obtained 2.1491*10^83+3.71159*10^83 I and 4.172240692690985`*^83 for the integral and error estimates. >>

Out[19]= $Aborted

so the NIntegrate is blowing up and will likely never finish.

Can you see a way to get the code to provide a numeric integral across the domain?

I can't

 

[Bill Simpson]

In your blabla.nb notebook there is one typo I found

k2[x_, x1_, t_, t1_, p_] := Piecewise[{{k[x, x1, t, t1, p]*...^(-1), 0 > x 1}}]

notice there is a space between x and 1 in your last 0>x 1.

Mathematica is going to interpret that as 0>x*1 which is 0>x.

That is the only thing that looks like an obvious error that I've found thus far.

I've looked at using FullSimplify on your A[], A1[] and A2[] in an attempt to make the final result much simpler and made some progress, but not enough yet. What I really want to see is if there is some way to make your k[] substantially simpler, perhaps see if your final integral might be broken into pieces where each piece is well behaved and see if there is some way to get a well behaved result despite the ill conditioned coefficients. I looked to see if I could find an alternative to your Piecewise[] in your k2[] and k3[] but not had any success yet.

 

[Bill Simpson]

If I haven't broken something with these changes,

k2[x_, x1_, t_, t1_, p_] := k[x, x1, t, t1, p]*(p - A[t]*e/c)^(-Sign[x1])*(I*d + Sqrt[(p - A[t]*e/c)^2 - d^2]);
k3[x_, x1_, t_, t1_, p_] := k[x, x1, t, t1, p]*(p - A[t1]*e/c)^(Sign[x])*(I*d + Sqrt[(p - A[t1]*e/c)^2 - d^2]^(-Sign[x]));

And then I try a limited plot with this,

t1 = 0;
ListPlot[Table[Abs[NIntegrate[ psi0[x1]*k1[x, x1, 0, t1, p], {x1, -10, 10}, {p, 0, 10}, MaxRecursion -> 10]]^2, {x, -1, 1, 1/5}], Joined -> True]

then I do get a plot after a couple of minutes. If I change the value of t1 and repeat then I get another similar plot after a couple of minutes.

But, as you can see from the scale on the vertical axis, I suspect the plot isn't really telling you what you want to know.

If I clear the value of t1 and put that ListPlot inside your Animate[] then I get $Aborted[] instead of the ListPlot after a couple of minutes. I haven't been able to track down why that happens.

EDIT: Ah, found this:
http://reference.wolfram.com/mathematica/tutorial/AdvancedManipulateFunctionality.html
which says down about 1/4 of the way
"And beyond five seconds you will start seeing $Aborted instead of the number, because the system is protecting itself from unreasonably long evaluations, which block other activity in the front end in this situation"
so that may explain the failure of Animate to show the plot. That web page says that adding the option ContinuousAction->False to the Animate will allow arbitrarily long evaluations, but when I try this I still get the $Aborted[] instead of your plot.