Group Abstract Group Abstract

Message Boards Message Boards

Hydrogen Atom Quantum Mechanics Done With Optimization

In[5]:= sphcmpt[pefunc, nInteger, d_] := Block[{i, vars, psi, vwb, ener, enres, psires, varres, cons1, cons2, sln, wavefunctions}, (* define variables *) vars = Table[psi[r], {r, 0, 1, d}];

  (* add bounds to variables *)
  vwb = {#, -1000, 1000} & /@ vars;

  (* calculate expectation values of energy for a radial function \
using finite differences with spacing d for derivatives *)
  ener = d Sum[-psi[
         r] (2/r ((psi[r + d] - psi[r - d])/(2 d)) + ((
          psi[r + d] - 2*psi[r] + psi[r - d])/d^2)) 4 \[Pi] r^2 + 
      psi[r] pefunc psi[r] 4 \[Pi] r^2, {r, d, 1 - d, d}]; 

  (* allocate variables for results *)
  enres = Table[0, n];
  wavefunctions = Table[0, n];

  (* boundary condition and normalization condition *)
  cons1 = {psi[1] == 0, 
    4  \[Pi] Sum[r^2 psi[r]^2, {r, d, 1, d}] == d^-1};

  (* calculate lowest n energy levels *)
  Do[
   (* orthogonality constraints *)
   cons2 = 
    Table[Sum[
       psi[r]*(psi[r] /. wavefunctions[[j]])*r^2, {r, 0, 1, d}] == 
      0, {j, i - 1}];

   (* use ParametricIPOPTMinimize to solve problem, 
   using 10 random searches, seed 0 *)
   sln = iMin[ener, Join[cons1, cons2], vwb, 10, 0];

   (* save results *)
   enres[[i]] = sln[[1]];
   wavefunctions[[i]] = sln[[2]],
   {i, n}
   ]; {enres, wavefunctions}
  ]

In[6]:= (* perform calculation *)
hatom = sphcmpt[(-100)/r, 5, 10^-3];

During evaluation of In[6]:= {{Solve_Succeeded,10}}

During evaluation of In[6]:= {{Solve_Succeeded,10}}

During evaluation of In[6]:= {{Solve_Succeeded,10}}

During evaluation of In[6]:= {{Solve_Succeeded,10}}

During evaluation of In[6]:= {{Solve_Succeeded,10}}

In[7]:= (* look at energy levels *)
hatom[[1]]

Out[7]= {-2498.44, -624.902, -277.758, -156.015, -89.3199}

In[8]:= (* check that energy levels go as 1/n^2 *)
Table[hatom[[1, i]]*i^2, {i, 5}]

Out[8]= {-2498.44, -2499.61, -2499.83, -2496.25, -2233.}

In[9]:= (* Plot wavefunctions *)
Table[ListPlot[Table[{r, psi[r]}, {r, 0, 1, 1/100}] /. hatom[[2, n]], 
  Joined -> True, PlotRange -> All], {n, 5}]

enter image description here

(* Verify that lowest state is exponential in r *)
ListPlot[Table[{r, Log @ psi[r]}, {r, 0, 1, 1/100}] /. hatom[[2, 1]]]

enter image description here

POSTED BY: Frank Kampas
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard