0
$\begingroup$

I have the following code:

code 1

In[193]:= ClearAll["Global`*"]

nmax = 5;

(*3d oscillator basis (l=0)*)
Psi[r_, n_] := (-1)^n *Exp[-1/2 *r^2] *Sqrt[2 *n!/Gamma[n + 3/2]]* 
   LaguerreL[n, 1/2, r^2];
(*kinetic energy*)
Kk[r_, n1_, n2_] := 
  FullSimplify[
   Psi[r, n2]*
    Laplacian[Psi[r, n1], {r, \[Theta], \[Phi]}, "Spherical"]];
Kx[n1_, n2_] := -1/2*Integrate[Kk[r, n1, n2]*r^2, {r, 0, \[Infinity]}];
KK = Table[Kx[n1, n2], {n1, 0, nmax}, {n2, 0, nmax}];

(*potential energy*)
VH1[r_] := -1/r;
VH2[r_] := -(1/(2*r))*Exp[-r*1.5];
Px1[n1_, n2_] := 
  Integrate[Psi[r, n2]*VH1[r]*Psi[r, n1]*r^2, {r, 0, \[Infinity]}];
Px2[n1_, n2_] := 
  Integrate[
   Psi[r, n2]*FullSimplify[VH2[r]]*Psi[r, n1]*r^2, {r, 
    0, \[Infinity]}];
Px[n1_, n2_] := Px1[n1, n2] + Px2[n1, n2];

PP = Table[Px[n1, n2], {n1, 0, nmax}, {n2, 0, nmax}];
EE = Min[Eigenvalues[KK + PP]]

Out[205]= -0.675029

But Mathematica calculates the code 1 slowly, therefore I have rewritten it and receive the code 2. Mathematica calculates the code 2 much faster so I can use a lot of basis functions.

If I use 25 basis functions (nmax=24) EE = -0.712228, but if I put nmax=25 value of EE become -13.236, and this value is unrealistic because from general theory we know that with increase of basis functions number the minimal eigenvalue should be change less and less.

Why occur such giant increasing of absolute value of EE? What wrong in the code2?

code 2

In[207]:= ClearAll["Global`*"]

nmax = 5;

(*3d oscillator basis*)
(*Psi[r_,n_]:=(-1)^n *Exp[-1/2 *r^2] *Sqrt[2 *n!/Gamma[n+3/2]]* \
LaguerreL[n,1/2,r^2];*)

(*kinetic energy*)
nmx = nmax;
hm = ConstantArray[0, {nmx + 1, nmx + 1}];
Do[hm[[1 + n1, 1 + n2]] = 
  KroneckerDelta[n1 - n2]*(n1 + 3/4) - 
   Sqrt[(2 (n1)^2 + (n1))/8] KroneckerDelta[n1 - n2 - 1];
 hm[[1 + n2, 1 + n1]] = hm[[1 + n1, 1 + n2]];, {n1, 0, nmx}, {n2, 0, 
  n1}]
KK = N[hm];

(*potential energy*)

f0[a_, n_] = 
  Integrate[r^n*Exp[-r^2]*Exp[-a*r], {r, 0, Infinity}, 
   Assumptions -> {a > 0, n > 0}];
f[a_, n_] := f[a, n] = N[f0[a, n], 100];
coeff[n_] := (-1)^n*Sqrt[2*n!/Gamma[n + 3/2]];
(*Coulomb part VH1[r]*)
Px1[n1_, n2_] := 
  Px1[n1, n2] = 
   If[n1 > n2, Px1[n2, n1], 
    coeff[n1]*coeff[n2]*(-1)*
      Total[Map[Function[{x}, f[0, x[[1, 1]] + 1]*x[[2]]], 
        CoefficientRules[
         LaguerreL[n1, 1/2, r^2]*LaguerreL[n2, 1/2, r^2], r]]] // N];

(*VH2[r]*)
Px2[n1_, n2_] := 
  Px2[n1, n2] = 
   If[n1 > n2, Px2[n2, n1], 
    coeff[n1]*coeff[n2]*(-(1/2))*
      Total[Map[Function[{x}, f[-1.5, x[[1, 1]] + 1]*x[[2]]], 
        CoefficientRules[
         LaguerreL[n1, 1/2, r^2]*LaguerreL[n2, 1/2, r^2], r]]] // N];

Px[n1_, n2_] := Px1[n1, n2] + Px2[n1, n2];
PP = Table[Re[Px[n1, n2]], {n1, 0, nmax}, {n2, 0, nmax}];
EE = Min[Eigenvalues[KK + PP]]

Out[220]= -0.675029
$\endgroup$

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy