(*^
::[	Information =

	"This is a Mathematica Notebook file.  It contains ASCII text, and can be
	transferred by email, ftp, or other text-file transfer utility.  It should
	be read or edited using a copy of Mathematica or MathReader.  If you 
	received this as email, use your mail application or copy/paste to save 
	everything from the line containing (*^ down to the line containing ^*)
	into a plain text file.  On some systems you may have to give the file a 
	name ending with ".ma" to allow Mathematica to recognize it as a Notebook.
	The line below identifies what version of Mathematica created this file,
	but it can be opened using any other version as well.";

	FrontEndVersion = "Macintosh Mathematica Notebook Front End Version 2.2";

	MacintoshStandardFontEncoding; 
	
	fontset = title, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e8,  24, "Times"; 
	fontset = subtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6,  18, "Times"; 
	fontset = subsubtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, e6,  14, "Times"; 
	fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, a20,  18, "Times"; 
	fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, a15,  14, "Times"; 
	fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, a12,  12, "Times"; 
	fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  10, "Times"; 
	fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L-5,  12, "Courier"; 
	fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5,  12, "Courier"; 
	fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, R65535, L-5,  12, "Courier"; 
	fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5,  12, "Courier"; 
	fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, B65535, L-5,  12, "Courier"; 
	fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287,  12, "Courier"; 
	fontset = name, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic,  10, "Geneva"; 
	fontset = header, inactive, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = leftheader, inactive, L2,  12, "Times"; 
	fontset = footer, inactive, noKeepOnOnePage, preserveAspect, center, M7,  12, "Times"; 
	fontset = leftfooter, inactive, L2,  12, "Times"; 
	fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  10, "Times"; 
	fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	paletteColors = 128; currentKernel; 
]
:[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup]
Legal Notice, Disclaimer, and Book Ordering Information:
:[font = input; inactive; preserveAspect; endGroup]
(* Legal Notice, Disclaimer, and Book Ordering Information:

Last Modified: FIO January 1, 1995

Mathematica For Physics
Robert L. Zimmerman and Fredrick I. Olness
MathSource Number: 0206-862 

ISBN 0-201-53796-6
For ordering information, call 1-800-822-6339
Addison-Wesley Publishing Company

Communication with the authors:
Fredrick I. Olness:  olness@mail.physics.smu.edu
Robert L. Zimmerman: bob@zim.uoregon.edu

Copyright 1995, Addison-Wesley Publishing Company, Inc. The material in
this file may be distributed freely  so long as the content remains
unchanged, and the copyright and  reference notices are included. The
publisher grants permission for the noncommercial use of these programs
and program segments.  All other uses require the prior written consent
of the publisher.    

All rights are reserved with regard to the  material in the
"Mathematica For Physics" text, and may not be reproduced, stored in a
retrieval system, or transmitted,  in any form or by any means,
electronic, mechanical, photocopying,  recording, or otherwise, without
the prior written permission  of the publisher. 

The programs and applications presented in this book have been included
for  their instructional value. They have been tested with care but are
not  guaranteed for any particular purpose. The publisher does not
offer any  warranties or representations, nor does it accept any
liabilities with  respect to the programs or applications. 

 *)

:[font = title; inactive; preserveAspect]
6. Quantum Mechanics
:[font = input; initialization; preserveAspect]
*)
(* Some "Mathematica for Physics" Initializations *)
$DefaultFont={"Courier",8};
Off[General::spell];
Off[General::spell1];
PageWidth->70;
(*
:[font = input; initialization; preserveAspect]
*)
Off[General::spell ]; 
Off[General::spell1];
(*
:[font = input; initialization; preserveAspect]
*)
Needs["Algebra`Trigonometry`"]
Needs["Calculus`VectorAnalysis`"]
Needs["Graphics`ParametricPlot3D`"]
(*
:[font = subsection; inactive; initialization; preserveAspect; startGroup]
User-defined Procedures and Rules
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
1 Change of Variables  Procedure    
:[font = input; initialization; preserveAspect; endGroup]
*)
vChange::usage=
 "vChange[dEq,psi,x,z,f] changes the variables in a differential 
 equation.  When this operator is applied to a differential 
 equation dEq of function psi[x], it will change the variables 
 from x to z where x=f[z]";

vChange[dEq_,psi_,x_,z_,f_]:= 
 ( dEq /.{ Derivative[n_Integer][psi][x]:>
               Nest[ (D[#,z]/D[f,z])&, psi[z],n]
           ,psi[x] :> psi[z]
           ,x      :> f  
         } 
  )
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
2  Series Expansion Solution for  Second Order Equation:     
:[font = input; initialization; preserveAspect]
*)
diffSeriesOne::usage=" 
diffSeriesOne[eq,z,t,order,{initialList}]
eq is an equation, z is the function, t is the independent 
variable, order is the order of the Series solution, and 
{initialList} is a list of initial conditions such as
{z[0]->z0}.
This procedure assumes the solution can be written as 
a power series.";
(*
:[font = input; initialization; preserveAspect; endGroup]
*)
Clear[diffSeriesOne];
diffSeriesOne[eqin_,z_,t_,order_,initList__List]:= 
 Module[{eq,zSer,eSer,eqs,vars,sol,zSol},
   eq=eqin[[1]]-eqin[[2]]==0;
   zSer= Series[z[t],{t,0,order}];
   eSer= eq/.(z[t]->zSer)//ExpandAll;
   eqs = Thread[CoefficientList[eSer[[1]],t]==0];
   vars=(Table[D[z[t],{t,j}],{j,2,order+2}]/.t->0);     
   sol = Solve[eqs,vars][[1]];
   zSol= zSer/.sol/.initList;
   Return[ zSol]  
 ]
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
 3. HyperbolicToComplex and ComplexToHyperbolic
:[font = input; initialization; preserveAspect]
*)
HyperbolicToComplexRule={Cosh[x___]:>(Exp[x]+Exp[-x])/2,
                         Sinh[x___]:>(Exp[x]-Exp[-x])/2};
                     
ComplexToHyperbolicRule={Exp[x___]:>Cosh[x]+Sinh[x]};
(*
:[font = input; initialization; preserveAspect; endGroup]
*)
HyperbolicToComplex[expression_]:= 
           expression //.HyperbolicToComplexRule
ComplexToHyperbolic[expression_]:= 
           expression //.ComplexToHyperbolicRule
           
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
4. Complex Conjugate Rule 
:[font = input; initialization; preserveAspect; endGroup; endGroup]
*)
conjugate::usage = 
" A simple method of computing the conjugate of an object
 which is explicitly Complex";

conjugateRule     = {Complex[re_,im_]:>Complex[re,-im]};
conjugate[exp__] := exp /. conjugateRule;
(*
:[font = subsection; inactive; initialization; preserveAspect; startGroup]
User-defined Solutions of Differential Equations:
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
1. Solution: Hermite Polynomials
:[font = input; initialization; preserveAspect; endGroup]
*)
Unprotect[DSolve];

DSolve[0 == +2 n_ h_[z_] - 2 z_ h_'[z_] + h_''[z_], {h_}, z_] :=
          {{h->(HermiteH[n, #]&)}}   /; IntegerQ[n];
         
DSolve[h_''[z_] == h_[z_]-(1+2 n_) h_[z_] + 2 z_ h_'[z_], {h_}, z_] := 
          {{h->(HermiteH[n, #]&)}}   /; IntegerQ[n];

Protect[DSolve];
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
2. Solution: Legendre Polynomials
:[font = input; initialization; preserveAspect; endGroup; endGroup]
*)

Unprotect[DSolve];

DSolve[ (n_ h_[z_] + n_^2 h_[z_] + m_^2/(-1+z_^2) h_[z_] 
         - 2 z_ h_'[z_] + (1-z_^2) h_''[z_]) ==0, {h_}, z_]:= 
  {{h->((LegendreP[n,m,#])&)}}  /; (IntegerQ[n]&&IntegerQ[m]);

DSolve[ (n_ h_[z_] + n_^2 h_[z_] + m_^2/(-1+z_^2) h_[z_] 
         - 2 z_ h_'[z_] + (1-z_^2) h_''[z_]) ==0, {h_[z_]}, z_]:= 
  {{h->(LegendreP[n,m,z])}}     /;  (IntegerQ[n]&&IntegerQ[m]);
 
Protect[DSolve];
(*
:[font = subsection; inactive; initialization; preserveAspect; startGroup]
User-Defined One-Dimensional Wave Properties
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
1 One-Dimensional Wave Function with Constant potential
:[font = input; initialization; preserveAspect; endGroup; endGroup]
*)
waveExp::usage=" waveExp[x,k,c1,c2] yields the solution to the 
Schrodinger equation in a constant potential as a function of
position x and wave number k. c1 and c2 are the coefficients 
of the right and left moving components, respectively.";

waveExp[x_,k_,c1_,c2_] := c1 Exp[+I k x] + c2 Exp[-I k x] 

waveTrig::usage=" waveTrig[x,k,c1,c2] yields the solution to the 
Schrodinger equation in a constant potential as a function of
position x and wave number k. c1 and c2 are the coefficients of 
the Sin and Cos components, respectively.";

waveTrig[x_,k_,c1_,c2_] := c1 Sin[k x] + c2 Cos[k x]
(*
:[font = subsection; inactive; initialization; preserveAspect; startGroup]
User-Defined Three-Dimensional Quantum Equations 
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
1 Operator:  schrodinger     
:[font = input; initialization; preserveAspect]
*)
schrodinger::usage = "schrodinger[V,Energy] is an operator to be 
applied to a wave function. The Schrodinger operator uses the 
default coordinates set by SetCoordinates. \n\n Example: \n\n 
SetCoordinates[Cartesian}];\n schrodinger[V[x,y,z],En]@psi[x,y,z]==0"; 
(*
:[font = input; initialization; preserveAspect; endGroup]
*)
schrodinger[V_,En_]:= (-hbar^2/(2m) Laplacian[#] + (V-En)#)&    
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
2 Operator:  hamiltonian     
:[font = input; initialization; preserveAspect]
*)
hamiltonian::usage = "hamiltonian[V] is an operator to be applied 
to a wave function. The Hamiltonian operator uses the default 
coordinates set by SetCoordinates. \n\n Example: \n\n 
SetCoordinates[Cartesian}];\n 
hamiltonian[V[x,y,z]]@psi[x,y,z]==En psi[x,y,z]"; 
(*
:[font = input; initialization; preserveAspect; endGroup]
*)
hamiltonian[V_]:= (-hbar^2/(2m) Laplacian[#] + V #)& 
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
3 Operator:  flux     
:[font = input; initialization; preserveAspect; endGroup; endGroup]
*)
flux::usage= "flux[psi] returns the directed flux. 
Coordinates are taken to be the default coordinate. 
All complex quantities are assumed to be explicit.";

 flux[psi_]:= 
 ( hbar/(2 I m) 
   ( (psi//conjugate) Grad[psi] - Grad[psi//conjugate] (psi) ) 
 )
(*
:[font = subsection; inactive; initialization; preserveAspect; startGroup]
Protect User-Defined  Operators
:[font = input; initialization; preserveAspect; endGroup]
*)
Protect[{ComplexToHyperbolic ,ComplexToHyperbolicRule
,HyperbolicToComplex ,HyperbolicToComplexRule
,conjugate ,conjugateRule, schrodinger, hamiltonian
,diffSeriesOne, vChange, flux, waveExp, waveTrig}];
(*
^*)
