(*^
::[	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; initialization; preserveAspect]
7. Relativity and Cosmology
:[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["Graphics`ParametricPlot3D`"];
(*
:[font = subsection; inactive; initialization; preserveAspect; startGroup]
User-defined Metric, Boost and Velocity Parameters
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
1. Metric
:[font = input; initialization; preserveAspect; endGroup]
*)
eta=DiagonalMatrix[1,-1,-1,-1]; 
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
2. Rule for relativistic velocity parameters
:[font = input; initialization; preserveAspect; endGroup]
*)
gam2v[gam_, v_]= {gam ->1/Sqrt[1-v^2]};  
v2gam[v_,gam_ ]= {v   ->  Sqrt[1-1/gam^2]};
E2gam[En_,m_,gam_]=   {En-> gam  m};
p2gam[p_,m_,v_,gam_]= {p -> gam  m  v};
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
3. Boost along the x-axis
:[font = input; initialization; preserveAspect]
*)
boostx::usage= " The matrix boostx[gam,v] is the transformation matrix 
between two  coordinate systems moving with relative speed v 
along the x-axis. The symbol gam = 1/Sqrt[1-v^2], where the 
speed of light, c=1.";
(*
:[font = input; initialization; preserveAspect; endGroup; endGroup]
*)
boostx[gam_,v_]:={{ gam  ,-gam v,0,0}
                 ,{-gam v, gam  ,0,0}
                 ,{     0,     0,1,0}
                 ,{     0,     0,0,1}};
(*
:[font = subsection; inactive; initialization; preserveAspect; startGroup]
User-defined Geometric Procedures  
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
 1. Christoffel Symbols:  
:[font = input; initialization; preserveAspect]
*)
christ::usage= "When christ[metric,variables] is applied
to a metric, it returns the Christoffel
symbols in the coordinate system given by variables. The
Christoffel symbols are defined in terms of the
derivatives of the metric. 
We have chosen spherical coordinates to be the 
default coordinates.";
(*
:[font = input; initialization; preserveAspect; endGroup]
*)
christ[met_,var_:{t,r,theta,phi}]:=
 Module[{imet,temp1,temp2,i,s,j,k},    
   temp1= Table[D[met[[i ,j ]],#] ,{i,4},{j,4}]& /@ var;
   imet = Inverse[met]//Simplify;
   temp2=(Table[ (1/2)
            *Sum[ imet[[i,s]] (temp1[[j,s,k]]+temp1[[k,s,j]]
                                             -temp1[[s,j,k]])
                ,{s,4}]
            ,{i,4},{j,4},{k,4}] 
          //ExpandAll //Simplify );
   Return[temp2]
 ];
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
2.  Curvature Tensor:
:[font = input; initialization; preserveAspect]
*)
curvR::usage= "The curvature tensor components are returned 
when curvR[christ ,var] is applied to the Christoffel 
symbols christ with variables given by var.
We have chosen Spherical variables as the defaults.";
(*
:[font = input; initialization; preserveAspect; endGroup]
*)
 curvR[christ_,var_:{t,r,theta,phi}]:=
 Module[{temp1,temp2,i,j,k,s,l},    
   temp1= Table[D[christ[[i,j,k]],#],{i,4},{j,4},{k,4}]& /@ var;
   temp2[i_,j_,k_,l_]:= ( temp1[[l,i,k,j]]- temp1[[k,i,j,l]]
                        +Sum[(christ[[i,s,l]] christ[[s,k,j]]
                             -christ[[i,s,k]] christ[[s,l,j]]),{s,4}]);
   Return[ Table[ temp2[i,j,k,l],{i,4},{j,4},{k,4},{l,4}] ]  
 ];
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
3.   Ricci Tensor:
:[font = input; initialization; preserveAspect]
*)
ricciR::usage= "The Ricci tensor is returned when 
ricciR[curv ] is applied to the curvature tensor 
called curv. The Christoffel symbols and curvature
tensor must be computed first.";
(*
:[font = input; initialization; preserveAspect; endGroup]
*)
ricciR[curv_] := Table[
                     Sum[curv[[k,i,k,j]],{k,4}]
                  ,{i,4},{j,4}] //ExpandAll //Simplify
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
 4.  Killing Equations      
:[font = input; initialization; preserveAspect]
*)
killingEq::usage="Killing's equations are computed
when killingEq[ContraV,metric,christ,var] is applied 
to the contravariant vector ContraV. The operator returns 
only the nontrivial equations. The Christoffel symbols
must be computed first.";
(*
:[font = input; initialization; preserveAspect; endGroup]
*)
killingEq[ContraV_,metric_,christ_,var_:{t,r,theta,phi}]:=
Module[{temp1,temp2,i,j,s},
     temp1=metric.ContraV;
     temp2=( Table[ D[temp1[[i]],var[[j]]],{i,4},{j,4}]
            -Sum[christ[[s]]temp1[[s]],{s,4}]);
     table=  Table[If[ i>j ,True,temp2[[i,j]]+temp2[[j,i]]==0]
                ,{i,1,4},{j,1,4}] 
              //Flatten 
              //Simplify;
     Return[ Select[ table, FreeQ[#,True]&] ]
];
     
(*
:[font = subsubsection; inactive; initialization; preserveAspect]
5. Einstein Tensor
:[font = input; initialization; preserveAspect]
*)
einstein::usage=" The Einstein tensor is returned
when einstein[curvature,metric] is applied to the curvature 
tensor and metric.";
(*
:[font = input; initialization; preserveAspect]
*)
einstein[curv_,met_] :=
Module[{temp1,temp2,i,j,s}, 
  temp1= Table[ Sum[curv[[s,i,s,j]],{s,4}]
           ,{i,4},{j,4}] //ExpandAll //Simplify;
  temp2= Sum[ Inverse[met][[j,i]] curv[[s,i,s,j]]
           ,{s,4},{i,4},{j,4}] //ExpandAll //Simplify;
  temp3=  Table[ temp1[[i,j]]- (1/2) met[[i,j]] temp2
           ,{i,4},{j,4}] //ExpandAll //Simplify;
  Return[temp3]
 ];
(*
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
  6.  Geodesic Equations:
:[font = input; initialization; preserveAspect]
*)
geodesic::usage="Four geodesic equations are returned 
for the variables when  geodesic[metric,variables,parameter:s]
is applied to the metric.";
(*
:[font = input; initialization; preserveAspect; endGroup; endGroup]
*)
geodesic[met_,var_,parameter_:s] := 
Module[{met1,temp1,vel1,var1},
  vel1= D[ Through[var[parameter]] ,parameter];
  var1= Through[var[parameter]];
  met1= met /.Thread[var-> Through[var[parameter]]];
  temp1= ( D[ met1 .vel1,parameter]  
          -(1/2 D[met1,#].vel1.vel1& /@ var1)
          == {0,0,0,0} )//Thread;
  Return[temp1]
 ]   
(*
:[font = subsection; inactive; initialization; preserveAspect; startGroup]
User-defined Metrics and Christoffel Symbols
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
 1. Schwarzschild Metric:  
:[font = input; initialization; preserveAspect]
*)
ssMet::usage="Gives the Schwarzschild metric";

ssMet=DiagonalMatrix[g00[r],g11[r],-r^2,-r^2 Sin[theta]^2];
(*
:[font = input; initialization; preserveAspect]
*)
ssComp::usage="Gives a rule to evaluate the components of 
the Schwarzschild metric";

ssComp={ g00->((    1- 2 m/# )&)
       , g11->((-1/(1- 2 m/#))&)};
(*
:[font = input; initialization; preserveAspect; startGroup]
*)
ssChrist::usage="Gives the Christoffel symbols for 
the Schwarzschild metric";

ssChrist=christ[ssMet] //.ssComp //Simplify
(*
:[font = output; output; inactive; initialization; preserveAspect; endGroup; endGroup]
{{{0, m/(-2*m*r + r^2), 0, 0}, {m/(-2*m*r + r^2), 0, 0, 0}, 
   {0, 0, 0, 0}, {0, 0, 0, 0}}, 
  {{(m*(-2*m + r))/r^3, 0, 0, 0}, {0, m/(2*m*r - r^2), 0, 0}, 
   {0, 0, 2*m - r, 0}, {0, 0, 0, (2*m - r)*Sin[theta]^2}}, 
  {{0, 0, 0, 0}, {0, 0, r^(-1), 0}, {0, r^(-1), 0, 0}, 
   {0, 0, 0, -Sin[2*theta]/2}}, 
  {{0, 0, 0, 0}, {0, 0, 0, r^(-1)}, {0, 0, 0, Cot[theta]}, 
   {0, r^(-1), Cot[theta], 0}}}
;[o]
           m                    m
{{{0, -----------, 0, 0}, {-----------, 0, 0, 0}, {0, 0, 0, 0}, 
                2                    2
      -2 m r + r           -2 m r + r
 
                    m (-2 m + r)                    m
   {0, 0, 0, 0}}, {{------------, 0, 0, 0}, {0, ----------, 0, 0}, 
                          3                              2
                         r                      2 m r - r
 
                                                     2
   {0, 0, 2 m - r, 0}, {0, 0, 0, (2 m - r) Sin[theta] }}, 
 
                        1          1
  {{0, 0, 0, 0}, {0, 0, -, 0}, {0, -, 0, 0}, 
                        r          r
 
             -Sin[2 theta]
   {0, 0, 0, -------------}}, 
                   2
 
                           1
  {{0, 0, 0, 0}, {0, 0, 0, -}, {0, 0, 0, Cot[theta]}, 
                           r
 
       1
   {0, -, Cot[theta], 0}}}
       r
:[font = subsubsection; inactive; initialization; preserveAspect; startGroup]
 2. Kerr Metric:  
:[font = input; initialization; preserveAspect]
*)
kMet::usage="Gives the Kerr metric";

kMet ={{g00[r,theta],0           ,0           ,g03[r,theta]}
      ,{0           ,g11[r,theta],0           ,0           }
      ,{0           ,0           ,g22[r,theta],0           }
      ,{g03[r,theta],0           ,0           ,g33[r,theta]}};
(*
:[font = input; initialization; preserveAspect]
*)
kComp::usage="Gives a rule to evaluate the components of 
the Kerr metric";

kComp={

 g00->(( (#1^2-2 m #1 +a^2)/( #1^2+ a^2 Cos[#2]^2)-
              a^2 Sin[#2]^2/( #1^2+ a^2 Cos[#2]^2))&)

,g03 -> ((-(#1^2-2 m #1 +a^2)/
         (#1^2+ a^2 Cos[#2]^2) a Sin[#2]^2+
         Sin[#2]^2/( #1^2+ a^2 Cos[#2]^2)(#1^2+a^2) a)&)
         
,g11 ->((-( #1^2+ a^2 Cos[#2]^2)/(#1^2-2 m #1 +a^2))&)

,g22 ->  ((-( #1^2+ a^2 Cos[#2]^2))&)

,g33 ->(((#1^2-2 m #1 +a^2)/
        ( #1^2+ a^2 Cos[#2]^2) a^2 Sin[#2]^4-
           Sin[#2]^2/( #1^2+ a^2 Cos[#2]^2) (#1^2+a^2)^2)&)
};
(*
:[font = input; initialization; preserveAspect; endGroup; endGroup]
*)
kChrist::usage="Gives the Christoffel symbols for 
the Kerr metric";

kChrist=christ[kMet];
(*
:[font = subsection; inactive; initialization; preserveAspect]
Protect User-defined Operators:
:[font = input; initialization; preserveAspect]
*)
Protect[boostx,christ,ContraV,curvR,einstein,eta
,E2gam,gam2v,geodesic,kComp,kMet,kChrist,killingEq
,p2gam,ricciR,ssComp,ssMet,ssChrist,v2gam];
(*
^*)
