2
/* load of packg removed */
4
define_variable(dim,4,fixnum,"the dimension of the problem.")$
5
define_variable(diagmetric,false,boolean,
6
"true if the metric entered is a diagonal matrix.")$
8
readvalue(message,pred,[badboy]):=
12
if apply(pred,[value])=true then return(value),
13
if badboy#[] then apply('print,badboy),
16
modedeclare(function(yesp),boolean)$
21
reply:apply('read,messages),
22
if member(reply,['yes,'ye,'y]) then return(true),
23
if member(reply,['no,'n]) then return(false),
24
print("please reply yes or no."),
27
swapout(file,[functions]):=apply('kill,functions)$
28
/* temporary until swapout is written by gjc */
30
resimp(exp):=apply('ev,[exp,'noeval,'simp])$
32
/* 62 lines between ^l's can be used with gacha10 ,68 with gacha9 */
34
/* the convention for the sign of the riemann tensor is the same as in
35
landau-lifshits, misner-thorne-wheeler */
37
/* kronecker delta function */
39
kdelt(i,j):=(modedeclare([i,j],fixnum),if i = j then 1 else 0)$
41
/* ttransform transforms second rank covariant tensors given the components and
42
the transformation law. the latter is in the form yi=yi(x1,...,xdim) */
44
ttransform(qxyz):=block([],local(ttemp,omtemp,vartemp,newtemp),
47
(ttemp[i,j]:qxyz[i,j],
49
ttemp[i,j]:subst(omtemp[k],omega[k],ttemp[i,j]))),
50
for i thru dim do vartemp[i]:read("transform #",i),
54
ttemp[i,j]:subst(vartemp[k],omtemp[k],ttemp[i,j]))),
57
newtemp[a,b]:txyzsum(vartemp,omega,a,b,ttemp)),
58
genmatrix(newtemp,dim,dim))$
60
txyzsum(vartemp,omega,a,b,ttemp):=block([temp:0],for i from 1 thru dim do
61
for j from 1 thru dim do
62
temp:temp+diff(vartemp[i],omega[a])*
63
diff(vartemp[j],omega[b])*
68
define_variable(derivabbrev,true,boolean)$
69
define_variable(tetradcaleq,false,boolean)$
70
define_variable(tayswitch,false,boolean)$
71
define_variable(ratchristof,true,boolean)$
72
define_variable(rateinstein,true,boolean)$
73
define_variable(ratrieman,true,boolean)$
74
define_variable(ratweyl,true,boolean)$
76
setflags():=(derivabbrev:true,tetradcaleq:false,tayswitch:false,
77
ratchristof:true,rateinstein:true,ratrieman:true,ratweyl:true)$
79
tsetup():=block([],if tensorkill # true then
80
error("type kill(all)\; and then tensorkill:true\; before you enter a new metric."),
83
dim:mode_identity(fixnum,
84
readvalue("enter the dimension of the coordinate system:",
87
block([u:v],modedeclare(u,fixnum),
89
"must be a positive integer!")),
91
omega:if dim = 2 then [x,y]
92
else (if dim = 3 then [x,y,z]
93
else (if dim = 4 then [x,y,z,t]
94
else read("enter a list containing the names of the coordinates in order"))),
96
if yesp("do you wish to change the coordinate names?")
98
omega:read("enter a list containing the names of the coordinates in order"),
99
if length(omega) # dim
100
then error("length of the coordinate list is not equal to the dimension"),
102
readvalue("do you want to
103
1. enter a new metric?
104
2. enter a metric from a file?
105
3. approximate a metric with a taylor series?",
107
if opt = 1 then(newmet(),true)
108
else if opt = 2 then(filemet(),true)
109
else if opt = 3 then(sermet(),true)
111
"invalid option, please enter 1, 2, or 3."),
114
/* enter a new metric */
116
newmet():=block([],lg:entermatrix(dim,dim),
117
read("enter functional dependencies with the depends function or 'n' if none"),
118
if yesp("do you wish to see the metric?")
119
then disp(lg),metric())$
121
/* enter a metric from a file */
123
filemet():=block([file,fpos],
124
file:read("specify the file as [filename1,filename2,directory]?"),
125
fpos:(print("what is the ordinal position of the metric in this file?"),
126
read("(note, the name lg must be assigned to your metric in the file)")),
127
apply(batch,[file,off,fpos,fpos]),metric())$
129
/* approximate a metric with a taylor series */
131
sermet():=block([],tayswitch:true,
132
param:read("enter expansion parameter"),
133
minp:read("enter minimum power to drop"),
134
taypt:read("enter the point to expand the series around"),
135
if yesp("is the metric in a file?") then filemet()
138
/* checks diagonality of a matrix or 2d array */
140
diagmatrixp(mat,nlim):=(modedeclare(nlim,fixnum),
141
block([diagflag:true],
144
(if i # j and mat[i,j] # 0
145
then return(diagflag:false))),diagflag))$
2
/* LOAD OF PACKG REMOVED */
4
DEFINE_VARIABLE(DIM,4,FIXNUM,"The dimension of the problem.")$
5
DEFINE_VARIABLE(DIAGMETRIC,FALSE,BOOLEAN,
6
"True if the metric entered is a diagonal matrix.")$
8
READVALUE(MESSAGE,PRED,[BADBOY]):=
12
IF APPLY(PRED,[VALUE])=TRUE THEN RETURN(VALUE),
13
IF BADBOY#[] THEN APPLY('PRINT,BADBOY),
16
MODEDECLARE(FUNCTION(YESP),BOOLEAN)$
21
REPLY:APPLY('READ,MESSAGES),
22
IF MEMBER(REPLY,['YES,'YE,'Y,'Yes,'yes,'y]) THEN RETURN(TRUE),
23
IF MEMBER(REPLY,['NO,'N,'No,'no,'n]) THEN RETURN(FALSE),
24
PRINT("Please reply YES or NO."),
27
SWAPOUT(FILE,[FUNCTIONS]):=APPLY('KILL,FUNCTIONS)$
28
/* TEMPORARY UNTIL SWAPOUT IS WRITTEN BY GJC */
30
RESIMP(EXP):=APPLY('EV,[EXP,'NOEVAL,'SIMP])$
32
/* 62 LINES BETWEEN ^L'S CAN BE USED WITH GACHA10 ,68 WITH GACHA9 */
34
/* THE CONVENTION FOR THE SIGN OF THE RIEMANN TENSOR IS THE SAME AS IN
35
LANDAU-LIFSHITZ, MISNER-THORNE-WHEELER */
37
/* KRONECKER DELTA FUNCTION */
39
KDELT(I,J):=(MODEDECLARE([I,J],FIXNUM),IF I = J THEN 1 ELSE 0)$
41
/* TTRANSFORM TRANSFORMS SECOND RANK COVARIANT TENSORS GIVEN THE COMPONENTS AND
42
THE TRANSFORMATION LAW. THE LATTER IS IN THE FORM YI=YI(X1,...,XDIM) */
44
TTRANSFORM(QXYZ):=BLOCK([],LOCAL(TTEMP,OMTEMP,VARTEMP,NEWTEMP),
47
(TTEMP[I,J]:QXYZ[I,J],
49
TTEMP[I,J]:SUBST(OMTEMP[K],OMEGA[K],TTEMP[I,J]))),
50
FOR I THRU DIM DO VARTEMP[I]:READ("Transform #",I),
54
TTEMP[I,J]:SUBST(VARTEMP[K],OMTEMP[K],TTEMP[I,J]))),
57
NEWTEMP[A,B]:TXYZSUM(VARTEMP,OMEGA,A,B,TTEMP)),
58
GENMATRIX(NEWTEMP,DIM,DIM))$
60
TXYZSUM(VARTEMP,OMEGA,A,B,TTEMP):=BLOCK([TEMP:0],FOR I FROM 1 THRU DIM DO
61
FOR J FROM 1 THRU DIM DO
62
TEMP:TEMP+DIFF(VARTEMP[I],OMEGA[A])*
63
DIFF(VARTEMP[J],OMEGA[B])*
68
DEFINE_VARIABLE(DERIVABBREV,TRUE,BOOLEAN)$
69
DEFINE_VARIABLE(TETRADCALEQ,FALSE,BOOLEAN)$
70
DEFINE_VARIABLE(TAYSWITCH,FALSE,BOOLEAN)$
71
DEFINE_VARIABLE(RATCHRISTOF,TRUE,BOOLEAN)$
72
DEFINE_VARIABLE(RATEINSTEIN,TRUE,BOOLEAN)$
73
DEFINE_VARIABLE(RATRIEMAN,TRUE,BOOLEAN)$
74
DEFINE_VARIABLE(RATWEYL,TRUE,BOOLEAN)$
76
SETFLAGS():=(DERIVABBREV:TRUE,TETRADCALEQ:FALSE,TAYSWITCH:FALSE,
77
RATCHRISTOF:TRUE,RATEINSTEIN:TRUE,RATRIEMAN:TRUE,RATWEYL:TRUE)$
79
TSETUP():=BLOCK([],IF TENSORKILL # TRUE THEN
80
ERROR("Type KILL(ALL)\; and then TENSORKILL:TRUE\; before you enter a new metric."),
83
DIM:MODE_IDENTITY(FIXNUM,
84
READVALUE("Enter the dimension of the coordinate system:",
87
BLOCK([U:V],MODEDECLARE(U,FIXNUM),
89
"Must be a positive integer!")),
91
OMEGA:IF DIM = 2 THEN [X,Y]
92
ELSE (IF DIM = 3 THEN [X,Y,Z]
93
ELSE (IF DIM = 4 THEN [X,Y,Z,T]
94
ELSE READ("Enter a list containing the names of the coordinates in order"))),
96
IF YESP("Do you wish to change the coordinate names?")
98
OMEGA:READ("Enter a list containing the names of the coordinates in order"),
99
IF LENGTH(OMEGA) # DIM
100
THEN ERROR("Length of the coordinate list is not equal to the dimension"),
102
READVALUE("Do you want to
103
1. Enter a new metric?
104
2. Enter a metric from a file?
105
3. Approximate a metric with a Taylor series?",
107
IF OPT = 1 THEN(NEWMET(),TRUE)
108
ELSE IF OPT = 2 THEN(FILEMET(),TRUE)
109
ELSE IF OPT = 3 THEN(SERMET(),TRUE)
111
"Invalid option, please enter 1, 2, or 3."),
114
/* ENTER A NEW METRIC */
116
NEWMET():=BLOCK([],LG:ENTERMATRIX(DIM,DIM),
117
READ("Enter functional dependencies with the DEPENDS function or 'N' if none"),
118
IF YESP("Do you wish to see the metric?")
119
THEN DISP(LG),SETMETRIC())$
121
/* ENTER A METRIC FROM A FILE */
123
FILEMET():=BLOCK([FILE,FPOS],
124
FILE:READ("Specify the file as [filename1,filename2,directory]?"),
125
FPOS:(PRINT("What is the ordinal position of the metric in this file?"),
126
READ("(Note, the name LG must be assigned to your metric in the file)")),
127
APPLY(BATCH,[FILE,OFF,FPOS,FPOS]),SETMETRIC())$
129
/* APPROXIMATE A METRIC WITH A TAYLOR SERIES */
131
SERMET():=BLOCK([],TAYSWITCH:TRUE,
132
PARAM:READ("Enter expansion parameter"),
133
MINP:READ("Enter minimum power to drop"),
134
TAYPT:READ("Enter the point to expand the series around"),
135
IF YESP("Is the metric in a file?") THEN FILEMET()
138
/* CHECKS DIAGONALITY OF A MATRIX OR 2D ARRAY */
140
DIAGMATRIXP(MAT,NLIM):=(MODEDECLARE(NLIM,FIXNUM),
141
BLOCK([DIAGFLAG:TRUE],
144
(IF I # J AND MAT[I,J] # 0
145
THEN RETURN(DIAGFLAG:FALSE))),DIAGFLAG))$
147
/* used for taylor series approximation */
149
dlgtaylor(x):=if tayswitch then ratdisrep(taylor(x,param,taypt,minp-1)) else x$
151
/* routine for computing contravariant metric from the covariant but if the
152
metric is diagonal then no out of core files are loaded. ug is defined so
153
that for display purposes it appears with detout and is then evaluated again */
156
if length(lg) # dim or length(transpose(lg)) # dim then
157
error("the rank of the metric is not equal to the dimension of the space")
158
else (if not symmetricp(lg,dim) then error(
159
"you must be working in a new gravity theory not supported by this program")),
160
diagmetric:diagmatrixp(lg,dim),gdet:factor(determinant(lg)),
161
ug:ident(length(first(lg))),
162
if diagmetric then for ii:1 thru length(first(lg)) do
163
(ug[ii,ii]:1/lg[ii,ii]) else
164
ug:block([detout:true],lg^^(-1)),
165
if yesp("do you wish to see the metric inverse?")
166
then ldisp(ug),ug:resimp(ug),done)$
168
/* following returns true if m is an nxn symmetric matrix or array */
170
symmetricp(m,n):=(modedeclare(n,fixnum),
171
block([symflag:true],
173
then for i thru n-1 do
174
(for j from i+1 thru n do
175
(if m[j,i] # m[i,j] then symflag:false)),
147
/* USED FOR TAYLOR SERIES APPROXIMATION */
149
DLGTAYLOR(X):=IF TAYSWITCH THEN RATDISREP(TAYLOR(X,PARAM,TAYPT,MINP-1)) ELSE X$
151
/* ROUTINE FOR COMPUTING CONTRAVARIANT METRIC FROM THE COVARIANT BUT IF THE
152
METRIC IS DIAGONAL THEN NO OUT OF CORE FILES ARE LOADED. UG IS DEFINED SO
153
THAT FOR DISPLAY PURPOSES IT APPEARS WITH DETOUT AND IS THEN EVALUATED AGAIN */
155
SETMETRIC():=BLOCK([],
156
IF LENGTH(LG) # DIM OR LENGTH(TRANSPOSE(LG)) # DIM THEN
157
ERROR("The rank of the metric is not equal to the dimension of the space")
158
ELSE (IF NOT SYMMETRICP(LG,DIM) THEN ERROR(
159
"You must be working in a new gravity theory not supported by this program")),
160
DIAGMETRIC:DIAGMATRIXP(LG,DIM),GDET:FACTOR(DETERMINANT(LG)),
161
UG:IDENT(LENGTH(FIRST(LG))),
162
IF DIAGMETRIC THEN FOR II:1 THRU LENGTH(FIRST(LG)) DO
163
(UG[II,II]:1/LG[II,II]) ELSE
164
UG:BLOCK([DETOUT:TRUE],LG^^(-1)),
165
IF YESP("Do you wish to see the metric inverse?")
166
THEN LDISP(UG),UG:RESIMP(UG),DONE)$
168
/* FOLLOWING RETURNS TRUE IF M IS AN NXN SYMMETRIC MATRIX OR ARRAY */
170
SYMMETRICP(M,N):=(MODEDECLARE(N,FIXNUM),
171
BLOCK([SYMFLAG:TRUE],
173
THEN FOR I THRU N-1 DO
174
(FOR J FROM I+1 THRU N DO
175
(IF M[J,I] # M[I,J] THEN SYMFLAG:FALSE)),
178
/* computes geodesic equations of motion */
178
/* COMPUTES GEODESIC EQUATIONS OF MOTION */
180
motion(dis):=block([s],depends(omega,s),
183
then ratsimp(lg[i,i]*diff(omega[i],s,2)+
184
sum(diff(lg[i,i],omega[a])*diff(omega[i],s)*diff(omega[a],s),a,1,dim)-
185
1/2*sum( diff(lg[a,a],omega[i]) *diff(omega[a],s)^2,a,1,dim) )
186
else ratsimp( sum(lg[i,a]*diff(omega[a],s,2),a,1,dim)+
188
diff(lg[i,b],omega[a])*diff(omega[b],s)*diff(omega[a],s)
189
-1/2*diff(lg[a,b],omega[i])
190
*diff(omega[a],s)*diff(omega[b],s),a,
192
if dis#false then for i thru dim do ldisplay(em[i]),done)$
180
MOTION(DIS):=BLOCK([S],DEPENDS(OMEGA,S),
183
THEN RATSIMP(LG[I,I]*DIFF(OMEGA[I],S,2)+
184
SUM(DIFF(LG[I,I],OMEGA[A])*DIFF(OMEGA[I],S)*DIFF(OMEGA[A],S),A,1,DIM)-
185
1/2*SUM( DIFF(LG[A,A],OMEGA[I]) *DIFF(OMEGA[A],S)^2,A,1,DIM) )
186
ELSE RATSIMP( SUM(LG[I,A]*DIFF(OMEGA[A],S,2),A,1,DIM)+
188
DIFF(LG[I,B],OMEGA[A])*DIFF(OMEGA[B],S)*DIFF(OMEGA[A],S)
189
-1/2*DIFF(LG[A,B],OMEGA[I])
190
*DIFF(OMEGA[A],S)*DIFF(OMEGA[B],S),A,
192
IF DIS#FALSE THEN FOR I THRU DIM DO LDISPLAY(EM[I]),DONE)$
195
/* computes d'alembertian of a 2nd rank covariant tensor and does not work
197
/* computes covariant and contravariant gradients where the :: allows the
198
user to define the array name*/
195
/* COMPUTES D'ALEMBERTIAN OF A 2ND RANK COVARIANT TENSOR AND DOES NOT WORK
197
/* COMPUTES COVARIANT AND CONTRAVARIANT GRADIENTS WHERE THE :: ALLOWS THE
198
USER TO DEFINE THE ARRAY NAME*/
200
cograd(f,xyz):=block([],
202
(arraysetapply(xyz,[mm],ratsimp(diff(f,omega[mm])))))$
200
COGRAD(F,XYZ):=BLOCK([],
202
(ARRAYSETAPPLY(XYZ,[MM],RATSIMP(DIFF(F,OMEGA[MM])))))$
204
contragrad(f,xyz):=block([],
208
(arraysetapply(xyz,[mm],
209
ratsimp(ratsimp(ug[mm,mm]*diff(f,omega[mm])))))
212
(arraysetapply(xyz,[mm],sum(ug[m,n]*diff(f,omega[nn]),nn,1,dim))))$
204
CONTRAGRAD(F,XYZ):=BLOCK([],
208
(ARRAYSETAPPLY(XYZ,[MM],
209
RATSIMP(RATSIMP(UG[MM,MM]*DIFF(F,OMEGA[MM])))))
212
(ARRAYSETAPPLY(XYZ,[MM],SUM(UG[M,N]*DIFF(F,OMEGA[NN]),NN,1,DIM))))$
214
/* dalem(p,i,j):=if diagmetric
215
then ratsimp(sum(contragrad(cograd(p[i,j],m),m),m,1,dim)
216
+1/sqrt(-gdet)*sum(cograd(sqrt(-gdet)*ug[m,m],m)*cograd(p[i,j],m),m,1,dim))
217
else sum(contragrad(cograd(p[i,j],m),m),m,1,dim)
218
+1/sqrt(-gdet)*sum(sum(cograd(sqrt(-gdet)*ug[m,n],n)*cograd(p[i,j],m),n,1,
214
/* DALEM(P,I,J):=IF DIAGMETRIC
215
THEN RATSIMP(SUM(CONTRAGRAD(COGRAD(P[I,J],M),M),M,1,DIM)
216
+1/SQRT(-GDET)*SUM(COGRAD(SQRT(-GDET)*UG[M,M],M)*COGRAD(P[I,J],M),M,1,DIM))
217
ELSE SUM(CONTRAGRAD(COGRAD(P[I,J],M),M),M,1,DIM)
218
+1/SQRT(-GDET)*SUM(SUM(COGRAD(SQRT(-GDET)*UG[M,N],N)*COGRAD(P[I,J],M),N,1,
221
/* routine for computing the christoffel symbols
222
comment: change routine so gdet is not evaluated until the end
221
/* ROUTINE FOR COMPUTING THE CHRISTOFFEL SYMBOLS
222
COMMENT: CHANGE ROUTINE SO GDET IS NOT EVALUATED UNTIL THE END
225
christof(dis):=block([],
227
(for j from i thru dim do
229
lcs[j,i,k]:lcs[i,j,k]
230
:(diff(lg[j,k],omega[i])
231
+diff(lg[i,k],omega[j])
232
-diff(lg[i,j],omega[k]))/2,
234
(mcs[j,i,k]:mcs[i,j,k]
237
then ratsimp(ug[k,k]*lcs[i,j,k])
238
else sum(ug[k,l]*lcs[i,j,l],l,1,dim)),
241
:mcs[i,j,k]:ratsimp(mcs[i,j,k])))),
242
if dis = all or dis = lcs
243
then for i thru dim do
247
then ldisplay(lcs[i,j,k])))),
225
CHRISTOF(DIS):=BLOCK([],
227
(FOR J FROM I THRU DIM DO
229
LCS[J,I,K]:LCS[I,J,K]
230
:(DIFF(LG[J,K],OMEGA[I])
231
+DIFF(LG[I,K],OMEGA[J])
232
-DIFF(LG[I,J],OMEGA[K]))/2,
234
(MCS[J,I,K]:MCS[I,J,K]
237
THEN RATSIMP(UG[K,K]*LCS[I,J,K])
238
ELSE SUM(UG[K,L]*LCS[I,J,L],L,1,DIM)),
241
:MCS[I,J,K]:RATSIMP(MCS[I,J,K])))),
242
IF DIS = ALL OR DIS = LCS
243
THEN FOR I THRU DIM DO
247
THEN LDISPLAY(LCS[I,J,K])))),
250
if dis = mcs or dis = all
251
then for i thru dim do
255
then ldisplay(mcs[i,j,k])))),done)$
250
IF DIS = MCS OR DIS = ALL
251
THEN FOR I THRU DIM DO
255
THEN LDISPLAY(MCS[I,J,K])))),DONE)$
257
/* covariant components of the ricci tensor */
257
/* COVARIANT COMPONENTS OF THE RICCI TENSOR */
260
block([suma,sumb,flat:true],
261
modedeclare(flat,boolean),
262
if member('mcs,arrays) then (true) else (christof(false)),
264
(for j from i thru dim do
269
+(diff(mcs[i,j,k],omega[k])
270
-diff(mcs[j,k,k],omega[i])),
272
mcs[k,l,k]*mcs[i,j,l]
273
-mcs[i,k,l]*mcs[j,l,k],l,1,dim)),
274
lr[i,j]:dlgtaylor(suma+sumb),
276
then lr[i,j]:factor(dlgtaylor(ratsimp(lr[i,j]))),
279
then (for i thru dim do
280
(for j from i thru dim do
282
then (flat:false,ldisplay(lr[i,j])))),
284
then print("this spacetime is empty and/or flat")),
286
then dlgtaylor(ratsimp(sum(lr[i,i]*ug[i,i],i,1,dim)))
287
else dlgtaylor(sum(sum(lr[i,j]*ug[i,j],i,1,dim),j,1,dim)),done)$
260
BLOCK([SUMA,SUMB,FLAT:TRUE],
261
MODEDECLARE(FLAT,BOOLEAN),
262
IF MEMBER('MCS,ARRAYS) THEN (TRUE) ELSE (CHRISTOF(FALSE)),
264
(FOR J FROM I THRU DIM DO
269
+(DIFF(MCS[I,J,K],OMEGA[K])
270
-DIFF(MCS[J,K,K],OMEGA[I])),
272
MCS[K,L,K]*MCS[I,J,L]
273
-MCS[I,K,L]*MCS[J,L,K],L,1,DIM)),
274
LR[I,J]:DLGTAYLOR(SUMA+SUMB),
276
THEN LR[I,J]:FACTOR(DLGTAYLOR(RATSIMP(LR[I,J]))),
279
THEN (FOR I THRU DIM DO
280
(FOR J FROM I THRU DIM DO
282
THEN (FLAT:FALSE,LDISPLAY(LR[I,J])))),
284
THEN PRINT("THIS SPACETIME IS EMPTY AND/OR FLAT")),
286
THEN DLGTAYLOR(RATSIMP(SUM(LR[I,I]*UG[I,I],I,1,DIM)))
287
ELSE DLGTAYLOR(SUM(SUM(LR[I,J]*UG[I,J],I,1,DIM),J,1,DIM)),DONE)$
290
/* computes mixed ricci tensor where the first index is covariant */
290
/* COMPUTES MIXED RICCI TENSOR WHERE THE FIRST INDEX IS COVARIANT */
294
modedeclare(flat,boolean),
295
if member('lr,arrays)
297
else (lriccicom(false)),
298
for i thru dim do for j thru dim do (ricci[i,j]:0),
301
(ricci[i,j]:if diagmetric
302
then ratsimp(dlgtaylor(lr[i,j]*ug[j,j]))
303
else dlgtaylor(sum(lr[i,k]*ug[k,j],k,1,dim)),
306
:factor(dlgtaylor(ratsimp(ricci[i,j]))))),
308
then (for i thru dim do
311
then (flat:false,ldisplay(ricci[i,j])))),
313
then print("this spacetime is empty and/or flat")),
294
MODEDECLARE(FLAT,BOOLEAN),
295
IF MEMBER('LR,ARRAYS)
297
ELSE (LRICCICOM(FALSE)),
298
FOR I THRU DIM DO FOR J THRU DIM DO (RICCI[I,J]:0),
301
(RICCI[I,J]:IF DIAGMETRIC
302
THEN RATSIMP(DLGTAYLOR(LR[I,J]*UG[J,J]))
303
ELSE DLGTAYLOR(SUM(LR[I,K]*UG[K,J],K,1,DIM)),
306
:FACTOR(DLGTAYLOR(RATSIMP(RICCI[I,J]))))),
308
THEN (FOR I THRU DIM DO
311
THEN (FLAT:FALSE,LDISPLAY(RICCI[I,J])))),
313
THEN PRINT("THIS SPACETIME IS EMPTY AND/OR FLAT")),
316
/* computes scalar curvature */
316
/* COMPUTES SCALAR CURVATURE */
318
scurvature():=if ratfac then factor(tracer) else tracer$
318
SCURVATURE():=IF RATFAC THEN FACTOR(TRACER) ELSE TRACER$
320
/* computes mixed einstein tensor where the first index is covariant */
320
/* COMPUTES MIXED EINSTEIN TENSOR WHERE THE FIRST INDEX IS COVARIANT */
323
block([flat:true],modedeclare(flat,boolean),
324
if member('ricci,arrays) then (true) else (riccicom(false)),
327
(if i = j then g[i,j]:dlgtaylor(ricci[i,j]-tracer/2)
328
else g[i,j]:dlgtaylor(ricci[i,j]),
330
then g[i,j]:factor(ratsimp(g[i,j]))
332
then g[i,j]:ratsimp(g[i,j])),
333
if dis#false and g[i,j] # 0
334
then (flat:false,ldisplay(g[i,j])))),
335
if dis#false and flat
336
then print("this spacetime is empty and/or flat"),done)$
338
/* computes covariant riemann curvature tensor */
342
modedeclare(flat,boolean),
343
if member('mcs,arrays) then (true) else (christof(false)),
346
(for k thru dim do (for l thru dim do r[i,j,k,l]:0))),
348
(for j from i+1 thru dim do
349
(for k from i thru dim do
350
(for l from k+1 thru (if k = i then j else dim) do
323
BLOCK([FLAT:TRUE],MODEDECLARE(FLAT,BOOLEAN),
324
IF MEMBER('RICCI,ARRAYS) THEN (TRUE) ELSE (RICCICOM(FALSE)),
327
(IF I = J THEN G[I,J]:DLGTAYLOR(RICCI[I,J]-TRACER/2)
328
ELSE G[I,J]:DLGTAYLOR(RICCI[I,J]),
330
THEN G[I,J]:FACTOR(RATSIMP(G[I,J]))
332
THEN G[I,J]:RATSIMP(G[I,J])),
333
IF DIS#FALSE AND G[I,J] # 0
334
THEN (FLAT:FALSE,LDISPLAY(G[I,J])))),
335
IF DIS#FALSE AND FLAT
336
THEN PRINT("THIS SPACETIME IS EMPTY AND/OR FLAT"),DONE)$
338
/* COMPUTES COVARIANT RIEMANN CURVATURE TENSOR */
342
MODEDECLARE(FLAT,BOOLEAN),
343
IF MEMBER('MCS,ARRAYS) THEN (TRUE) ELSE (CHRISTOF(FALSE)),
346
(FOR K THRU DIM DO (FOR L THRU DIM DO R[I,J,K,L]:0))),
348
(FOR J FROM I+1 THRU DIM DO
349
(FOR K FROM I THRU DIM DO
350
(FOR L FROM K+1 THRU (IF K = I THEN J ELSE DIM) DO
354
* (diff(lg[i,l],omega[j],1,omega[k],1)
355
+diff(lg[j,k],omega[i],1,omega[l],1)
356
-diff(lg[i,k],omega[j],1,omega[l],1)
357
-diff(lg[j,l],omega[i],1,omega[k],1))
362
*(mcs[j,k,u]*mcs[i,l,u]
363
-mcs[j,l,u]*mcs[i,k,u]),u,1,
368
*(mcs[j,k,u]*mcs[i,l,v]
369
-mcs[j,l,u]*mcs[i,k,v]),v,1,
373
:factor(ratsimp(r[i,j,k,l]))
376
:ratsimp(r[i,j,k,l])),
377
r[j,i,l,k]:r[i,j,k,l],
378
r[i,j,l,k]:r[j,i,k,l]:-r[i,j,k,l],
380
then (r[k,l,i,j]:r[l,k,j,i]:r[i,j,k,l],
381
r[l,k,i,j]:r[k,l,j,i]:-r[i,j,k,l]),
382
if dis#false and r[i,j,k,l] # 0
383
then (flat:false,ldisplay(r[i,j,k,l])))))),
384
if dis#false and flat then print("this spacetime is flat"),done)$
354
* (DIFF(LG[I,L],OMEGA[J],1,OMEGA[K],1)
355
+DIFF(LG[J,K],OMEGA[I],1,OMEGA[L],1)
356
-DIFF(LG[I,K],OMEGA[J],1,OMEGA[L],1)
357
-DIFF(LG[J,L],OMEGA[I],1,OMEGA[K],1))
362
*(MCS[J,K,U]*MCS[I,L,U]
363
-MCS[J,L,U]*MCS[I,K,U]),U,1,
368
*(MCS[J,K,U]*MCS[I,L,V]
369
-MCS[J,L,U]*MCS[I,K,V]),V,1,
373
:FACTOR(RATSIMP(R[I,J,K,L]))
376
:RATSIMP(R[I,J,K,L])),
377
R[J,I,L,K]:R[I,J,K,L],
378
R[I,J,L,K]:R[J,I,K,L]:-R[I,J,K,L],
380
THEN (R[K,L,I,J]:R[L,K,J,I]:R[I,J,K,L],
381
R[L,K,I,J]:R[K,L,J,I]:-R[I,J,K,L]),
382
IF DIS#FALSE AND R[I,J,K,L] # 0
383
THEN (FLAT:FALSE,LDISPLAY(R[I,J,K,L])))))),
384
IF DIS#FALSE AND FLAT THEN PRINT("THIS SPACETIME IS FLAT"),DONE)$
386
/* computes contravariant riemann tensor from covariant form */
386
/* COMPUTES CONTRAVARIANT RIEMANN TENSOR FROM COVARIANT FORM */
390
if member('r,arrays) then (true) else (riemann(false)),
393
(for k thru dim do (for l thru dim do ur[i,j,k,l]:0))),
395
(for j from i+1 thru dim do
396
(for k from i thru dim do
397
(for l from k+1 thru (if k = i then j else dim) do
401
r[i,j,k,l]*ug[i,i]*ug[j,j]*ug[k,k]
407
r[a,b,c,d]*ug[i,a]*ug[j,b]*ug[k,c]
408
*ug[l,d],a,1,dim),b,1,
413
then ur[i,j,k,l]:ratsimp(ur[i,j,k,l]),
414
ur[j,i,l,k]:ur[i,j,k,l],
415
ur[i,j,l,k]:ur[j,i,k,l]:-ur[i,j,k,l],
418
ur[k,l,i,j]:ur[l,k,j,i]:ur[i,j,k,l],
419
ur[l,k,i,j]:ur[k,l,j,i]:-ur[i,j,k,l]),
420
if dis#false and ur[i,j,k,l] # 0
421
then ldisplay(ur[i,j,k,l]))))))$
390
IF MEMBER('R,ARRAYS) THEN (TRUE) ELSE (RIEMANN(FALSE)),
393
(FOR K THRU DIM DO (FOR L THRU DIM DO UR[I,J,K,L]:0))),
395
(FOR J FROM I+1 THRU DIM DO
396
(FOR K FROM I THRU DIM DO
397
(FOR L FROM K+1 THRU (IF K = I THEN J ELSE DIM) DO
401
R[I,J,K,L]*UG[I,I]*UG[J,J]*UG[K,K]
407
R[A,B,C,D]*UG[I,A]*UG[J,B]*UG[K,C]
408
*UG[L,D],A,1,DIM),B,1,
413
THEN UR[I,J,K,L]:RATSIMP(UR[I,J,K,L]),
414
UR[J,I,L,K]:UR[I,J,K,L],
415
UR[I,J,L,K]:UR[J,I,K,L]:-UR[I,J,K,L],
418
UR[K,L,I,J]:UR[L,K,J,I]:UR[I,J,K,L],
419
UR[L,K,I,J]:UR[K,L,J,I]:-UR[I,J,K,L]),
420
IF DIS#FALSE AND UR[I,J,K,L] # 0
421
THEN LDISPLAY(UR[I,J,K,L]))))))$
423
/* computes the kretchmann invariant r[i,j,k,l]*ur[i,j,k,l] */
425
rinvariant():=kinvariant:sum(
426
sum(sum(sum(r[i,j,k,l]*ur[i,j,k,l],i,1,dim),j,
427
1,dim),k,1,dim),l,1,dim)$
429
/* computes covariant weyl tensor */
432
block([flat:true],modedeclare(flat,boolean),
434
(print("all 2 dimensional spacetimes are conformally flat"),
436
if (member('lr,arrays),member('r,arrays)) then
437
true else (lriccicom(false),riemann(false)),
440
(for k thru dim do (for l thru dim do w[i,j,k,l]:0))),
442
(for j from i+1 thru dim do
443
(for k from i thru dim do
444
(for l from k+1 thru (if k = i then j else dim) do
445
(w[i,j,k,l]:dlgtaylor(
448
*(lg[i,l]*lr[j,k]-lg[i,k]*lr[l,j]
451
-tracer/((dim-1)*(dim-2))
452
*(lg[i,l]*lg[k,j]-lg[i,k]*lg[l,j])),
455
:factor(ratsimp(w[i,j,k,l]))
457
then w[i,j,k,l]:ratsimp(w[i,j,k,l])),
458
w[j,i,l,k]:w[i,j,k,l],
459
w[i,j,l,k]:w[j,i,k,l]:-w[i,j,k,l],
461
then (w[k,l,i,j]:w[l,k,j,i]:w[i,j,k,l],
462
w[l,k,i,j]:w[k,l,j,i]:-w[i,j,k,l]),
463
if dis#false and w[i,j,k,l] # 0
464
then (flat:false,ldisplay(w[i,j,k,l])))))),
465
if dis#false and flat then print("this spacetime is conformally flat"),done)$
467
/* number of terms per component of the array f */
469
ntermst(f):=for i thru dim do
470
(for j thru dim do print([[i,j],nterms(f[i,j])]))$
472
/* computes d'alembertian of the scalar phi */
474
dscalar(phi):=if diagmetric
475
then ratsimp(1/sqrt(-gdet)*sum(
477
ug[i,i]*sqrt(-gdet)*diff(phi,omega[i]),
479
else ratsimp(1/sqrt(-gdet)*sum(
482
ug[i,j]*sqrt(-gdet)*diff(phi,omega[j]),
483
omega[i]),i,1,dim),j,1,dim))$
485
/* computes the covariant divergence of the object gxyz which must
486
be a mixed 2nd rank tensor whose first index is covariant- a check should
487
be put in to see if gxyz has the correct dimensions apr.9,80 */
489
checkdiv(gxyz):=block(modedeclare([i,j],fixnum),
490
if diagmatrixp(gxyz,dim) then for i thru dim do
491
print(div[i]:ratsimp(dlgtaylor(1/sqrt(-gdet)
492
*diff(sqrt(-gdet)*gxyz[i,i],omega[i])
493
-sum(mcs[i,j,j]*gxyz[j,j],j,1,dim))))
494
else for i thru dim do
495
print(div[i]:ratsimp(dlgtaylor(1/sqrt(-gdet)
496
*sum(diff(sqrt(-gdet)*gxyz[i,j],omega[j]),j,1,dim)
497
-sum(sum(mcs[i,j,a]*gxyz[a,j],a,1,dim),j,1,dim)))))$
500
/* findde returns a list of the unique differential equations in the list or
501
2 or 3 dimensional array a. deindex is a global list containing the indices
502
of a corresponding to these unique differential equations. */
504
findde1(list):=block([inflag:true,deriv:nounify('derivative),l:[],l1,q],
506
for i while list # [] do
507
(l1:factor(num(first(list))),list:rest(list),
508
if not freeof(deriv,l1)
509
then (deindex:cons(i,deindex),
510
if inpart(l1,0) # "*" then l:cons(l1,l)
512
for j thru length(l1) do
513
(if not freeof(deriv,inpart(l1,j))
514
then q:q*inpart(l1,j)),
518
findde2(a):=block([inflag:true,deriv:nounify('derivative),l:[],t,q],
522
(t:factor(num(a[i,j])),
523
if not freeof(deriv,t)
524
then (deindex:cons([i,j],deindex),
525
if inpart(t,0) # "*" then l:cons(t,l)
527
for n thru length(t) do
528
(if not freeof(deriv,inpart(t,n))
529
then q:q*inpart(t,n)),
534
block([inflag:true,deriv:nounify('derivative),l:[],t,q],
539
(t:factor(num(a[i,j,k])),
540
if not freeof(deriv,t)
541
then (deindex:cons([i,j,k],deindex),
542
if inpart(t,0) # "*" then l:cons(t,l)
544
for n thru length(t) do
546
not freeof(deriv,inpart(t,n))
547
then q:q*inpart(t,n)),
551
cleanup(ll):=block([a,l:[],index:[]],
553
(a:first(ll),ll:rest(ll),
555
then (l:cons(a,l),index:cons(first(deindex),index)),
556
deindex:rest(deindex)),deindex:index,l)$
423
/* COMPUTES THE KRETCHMANN INVARIANT R[I,J,K,L]*UR[I,J,K,L] */
425
RINVARIANT():=KINVARIANT:SUM(
426
SUM(SUM(SUM(R[I,J,K,L]*UR[I,J,K,L],I,1,DIM),J,
427
1,DIM),K,1,DIM),L,1,DIM)$
429
/* COMPUTES COVARIANT WEYL TENSOR */
432
BLOCK([FLAT:TRUE],MODEDECLARE(FLAT,BOOLEAN),
434
(PRINT("ALL 2 DIMENSIONAL SPACETIMES ARE CONFORMALLY FLAT"),
436
IF (MEMBER('LR,ARRAYS),MEMBER('R,ARRAYS)) THEN
437
TRUE ELSE (LRICCICOM(FALSE),RIEMANN(FALSE)),
440
(FOR K THRU DIM DO (FOR L THRU DIM DO W[I,J,K,L]:0))),
442
(FOR J FROM I+1 THRU DIM DO
443
(FOR K FROM I THRU DIM DO
444
(FOR L FROM K+1 THRU (IF K = I THEN J ELSE DIM) DO
445
(W[I,J,K,L]:DLGTAYLOR(
448
*(LG[I,L]*LR[J,K]-LG[I,K]*LR[L,J]
451
-TRACER/((DIM-1)*(DIM-2))
452
*(LG[I,L]*LG[K,J]-LG[I,K]*LG[L,J])),
455
:FACTOR(RATSIMP(W[I,J,K,L]))
457
THEN W[I,J,K,L]:RATSIMP(W[I,J,K,L])),
458
W[J,I,L,K]:W[I,J,K,L],
459
W[I,J,L,K]:W[J,I,K,L]:-W[I,J,K,L],
461
THEN (W[K,L,I,J]:W[L,K,J,I]:W[I,J,K,L],
462
W[L,K,I,J]:W[K,L,J,I]:-W[I,J,K,L]),
463
IF DIS#FALSE AND W[I,J,K,L] # 0
464
THEN (FLAT:FALSE,LDISPLAY(W[I,J,K,L])))))),
465
IF DIS#FALSE AND FLAT THEN PRINT("THIS SPACETIME IS CONFORMALLY FLAT"),DONE)$
467
/* NUMBER OF TERMS PER COMPONENT OF THE ARRAY F */
469
NTERMST(F):=FOR I THRU DIM DO
470
(FOR J THRU DIM DO PRINT([[I,J],NTERMS(F[I,J])]))$
472
/* COMPUTES D'ALEMBERTIAN OF THE SCALAR PHI */
474
DSCALAR(PHI):=IF DIAGMETRIC
475
THEN RATSIMP(1/SQRT(-GDET)*SUM(
477
UG[I,I]*SQRT(-GDET)*DIFF(PHI,OMEGA[I]),
479
ELSE RATSIMP(1/SQRT(-GDET)*SUM(
482
UG[I,J]*SQRT(-GDET)*DIFF(PHI,OMEGA[J]),
483
OMEGA[I]),I,1,DIM),J,1,DIM))$
485
/* COMPUTES THE COVARIANT DIVERGENCE OF THE OBJECT GXYZ WHICH MUST
486
BE A MIXED 2ND RANK TENSOR WHOSE FIRST INDEX IS COVARIANT- A CHECK SHOULD
487
BE PUT IN TO SEE IF GXYZ HAS THE CORRECT DIMENSIONS APR.9,80 */
489
CHECKDIV(GXYZ):=BLOCK(MODEDECLARE([I,J],FIXNUM),
490
IF DIAGMATRIXP(GXYZ,DIM) THEN FOR I THRU DIM DO
491
PRINT(DIV[I]:RATSIMP(DLGTAYLOR(1/SQRT(-GDET)
492
*DIFF(SQRT(-GDET)*GXYZ[I,I],OMEGA[I])
493
-SUM(MCS[I,J,J]*GXYZ[J,J],J,1,DIM))))
494
ELSE FOR I THRU DIM DO
495
PRINT(DIV[I]:RATSIMP(DLGTAYLOR(1/SQRT(-GDET)
496
*SUM(DIFF(SQRT(-GDET)*GXYZ[I,J],OMEGA[J]),J,1,DIM)
497
-SUM(SUM(MCS[I,J,A]*GXYZ[A,J],A,1,DIM),J,1,DIM)))))$
500
/* FINDDE RETURNS A LIST OF THE UNIQUE DIFFERENTIAL EQUATIONS IN THE LIST OR
501
2 OR 3 DIMENSIONAL ARRAY A. DEINDEX IS A GLOBAL LIST CONTAINING THE INDICES
502
OF A CORRESPONDING TO THESE UNIQUE DIFFERENTIAL EQUATIONS. */
504
FINDDE1(LIST):=BLOCK([INFLAG:TRUE,DERIV:NOUNIFY('DERIVATIVE),L:[],L1,Q],
506
FOR I WHILE LIST # [] DO
507
(L1:FACTOR(NUM(FIRST(LIST))),LIST:REST(LIST),
508
IF NOT FREEOF(DERIV,L1)
509
THEN (DEINDEX:CONS(I,DEINDEX),
510
IF INPART(L1,0) # "*" THEN L:CONS(L1,L)
512
FOR J THRU LENGTH(L1) DO
513
(IF NOT FREEOF(DERIV,INPART(L1,J))
514
THEN Q:Q*INPART(L1,J)),
518
FINDDE2(A):=BLOCK([INFLAG:TRUE,DERIV:NOUNIFY('DERIVATIVE),L:[],T,Q],
522
(T:FACTOR(NUM(A[I,J])),
523
IF NOT FREEOF(DERIV,T)
524
THEN (DEINDEX:CONS([I,J],DEINDEX),
525
IF INPART(T,0) # "*" THEN L:CONS(T,L)
527
FOR N THRU LENGTH(T) DO
528
(IF NOT FREEOF(DERIV,INPART(T,N))
529
THEN Q:Q*INPART(T,N)),
534
BLOCK([INFLAG:TRUE,DERIV:NOUNIFY('DERIVATIVE),L:[],T,Q],
539
(T:FACTOR(NUM(A[I,J,K])),
540
IF NOT FREEOF(DERIV,T)
541
THEN (DEINDEX:CONS([I,J,K],DEINDEX),
542
IF INPART(T,0) # "*" THEN L:CONS(T,L)
544
FOR N THRU LENGTH(T) DO
546
NOT FREEOF(DERIV,INPART(T,N))
547
THEN Q:Q*INPART(T,N)),
551
CLEANUP(LL):=BLOCK([A,L:[],INDEX:[]],
553
(A:FIRST(LL),LL:REST(LL),
555
THEN (L:CONS(A,L),INDEX:CONS(FIRST(DEINDEX),INDEX)),
556
DEINDEX:REST(DEINDEX)),DEINDEX:INDEX,L)$
558
findde(a,n):=(modedeclare(n,fixnum),
559
if n = 1 then findde1(a)
560
else (if n = 2 then findde2(a)
561
else (if n = 3 then findde3(a)
562
else error("invalid dimension:",n))))$
558
FINDDE(A,N):=(MODEDECLARE(N,FIXNUM),
559
IF N = 1 THEN FINDDE1(A)
560
ELSE (IF N = 2 THEN FINDDE2(A)
561
ELSE (IF N = 3 THEN FINDDE3(A)
562
ELSE ERROR("Invalid dimension:",N))))$
564
deleten(l,n):=(modedeclare(n,fixnum),
565
block([len],modedeclare(len,fixnum),
569
then error("second argument out of range")
570
else (if n = 1 then rest(l)
573
else append(rest(l,n-len-1),
577
(maplist(lambda([u],u::false),
578
'[tayswitch,ratchristof,expandchristof,rateinstein,ratrieman,
579
halfc,chrsub,motion,dlgtaylor,tsetup,christof,riccicom,testindex,einstein,
580
ttransform,riemann,diagmatrixp,raiseriemann,rscalar,lriccicom,weyl,metric]),
582
tetradcaleq,ratweyl,niceprint,kdelt,setflags,bdvac,invariant1,invariant2,
583
tsetup,newmet,filemet,sermet,symmetricp,dl,du,dalem,scurvature,rinvariant,
584
ntermst,dscalar,checkdiv,setuptetrad,contract4,psi,petrov,findde1,findde2,
585
findde3,cleanup,findde,deleten,getrid))$
588
/* the 4 dimensional brans- dicke vacuum field equations are represented by
589
the array bd and the scalar equation is generated by setting the d'alembertian
590
of the scalar field to zero. that is one calls the function dscalar on the
594
if dim # 4 then error(" this program is restricted to 4 dimensions"),
595
zz:read("give a name to the scalar field and
564
DELETEN(L,N):=(MODEDECLARE(N,FIXNUM),
565
BLOCK([LEN],MODEDECLARE(LEN,FIXNUM),
569
THEN ERROR("Second argument out of range")
570
ELSE (IF N = 1 THEN REST(L)
573
ELSE APPEND(REST(L,N-LEN-1),
577
(MAPLIST(LAMBDA([U],U::FALSE),
578
'[TAYSWITCH,RATCHRISTOF,EXPANDCHRISTOF,RATEINSTEIN,RATRIEMAN,
579
HALFC,CHRSUB,MOTION,DLGTAYLOR,TSETUP,CHRISTOF,RICCICOM,TESTINDEX,EINSTEIN,
580
TTRANSFORM,RIEMANN,DIAGMATRIXP,RAISERIEMANN,RSCALAR,LRICCICOM,WEYL,SETMETRIC]),
582
TETRADCALEQ,RATWEYL,NICEPRINT,KDELT,SETFLAGS,BDVAC,INVARIANT1,INVARIANT2,
583
TSETUP,NEWMET,FILEMET,SERMET,SYMMETRICP,DL,DU,DALEM,SCURVATURE,RINVARIANT,
584
NTERMST,DSCALAR,CHECKDIV,SETUPTETRAD,CONTRACT4,PSI,PETROV,FINDDE1,FINDDE2,
585
FINDDE3,CLEANUP,FINDDE,DELETEN,GETRID))$
588
/* THE 4 DIMENSIONAL BRANS- DICKE VACUUM FIELD EQUATIONS ARE REPRESENTED BY
589
THE ARRAY BD AND THE SCALAR EQUATION IS GENERATED BY SETTING THE D'ALEMBERTIAN
590
OF THE SCALAR FIELD TO ZERO. THAT IS ONE CALLS THE FUNCTION DSCALAR ON THE
594
IF DIM # 4 THEN ERROR("This program is restricted to 4 dimensions"),
595
ZZ:READ("Give a name to the scalar field and
596
596
declare its functional dependencies"),
598
for i:1 thru 4 do for j:1 thru 4 do (addd[i,j]:
600
diff(zz,omega[i])*diff(zz,omega[j])-
601
lg[i,j]*sum(diff(zz,omega[kk])*diff(zz,omega[kk])*ug[kk,kk],kk,1,4)/2)+
602
(diff(diff(zz,omega[i]),omega[j])-sum(mcs[i,j,kk]*diff(zz,omega[kk]),kk,1,4)-
604
for i:1 thru 4 do for j:1 thru 4 do (bd[i,j]:ratsimp(
605
lr[i,j]-r*lg[i,j]/2-0*t[i,j]-addd[i,j])),
598
FOR I:1 THRU 4 DO FOR J:1 THRU 4 DO (ADDD[I,J]:
600
DIFF(ZZ,OMEGA[I])*DIFF(ZZ,OMEGA[J])-
601
LG[I,J]*SUM(DIFF(ZZ,OMEGA[KK])*DIFF(ZZ,OMEGA[KK])*UG[KK,KK],KK,1,4)/2)+
602
(DIFF(DIFF(ZZ,OMEGA[I]),OMEGA[J])-SUM(MCS[I,J,KK]*DIFF(ZZ,OMEGA[KK]),KK,1,4)-
604
FOR I:1 THRU 4 DO FOR J:1 THRU 4 DO (BD[I,J]:RATSIMP(
605
LR[I,J]-R*LG[I,J]/2-0*T[I,J]-ADDD[I,J])),
608
/* this gives the euler- lagrange equations for the density of the
609
invariant r^2. the form is (where d is the kronecker delta)
611
(1/2)*d r - 2 r r + 2 d []r -2 g r
613
the equations are sometimes less complex if
614
tracer is given a parametric name with dependencies corresponding
615
to those of the scalar curvature */
608
/* THIS GIVES THE EULER- LAGRANGE EQUATIONS FOR THE DENSITY OF THE
609
INVARIANT R^2. THE FORM IS (WHERE D IS THE KRONECKER DELTA)
611
(1/2)*D R - 2 R R + 2 D []R -2 G R
613
THE EQUATIONS ARE SOMETIMES LESS COMPLEX IF
614
TRACER IS GIVEN A PARAMETRIC NAME WITH DEPENDENCIES CORRESPONDING
615
TO THOSE OF THE SCALAR CURVATURE */
619
for aa thru dim do for bb thru dim do
622
for aa thru dim do for bb thru dim do
623
(inv1[aa,bb]:ratsimp(
624
kdelt(aa,bb)*tracer^2/2-
625
2*tracer*ricci[aa,bb]-
626
2*kdelt(aa,bb)*dscalar(tracer)+
628
diff(diff(tracer,omega[bb]),omega[aa])
629
-sum(mcs[bb,aa,kk]*diff(tracer,omega[kk]),kk,1,dim))))
631
for aa thru dim do for bb thru dim do
634
kdelt(aa,bb)*tracer^2/2-
635
2*tracer*ricci[aa,bb]-
636
2*kdelt(aa,bb)*dscalar(tracer)+
638
diff(diff(tracer,omega[aa]),omega[cc])
640
*diff(tracer,omega[kk]),
641
kk,1,dim)),cc,1,dim))))$
619
FOR AA THRU DIM DO FOR BB THRU DIM DO
622
FOR AA THRU DIM DO FOR BB THRU DIM DO
623
(INV1[AA,BB]:RATSIMP(
624
KDELT(AA,BB)*TRACER^2/2-
625
2*TRACER*RICCI[AA,BB]-
626
2*KDELT(AA,BB)*DSCALAR(TRACER)+
628
DIFF(DIFF(TRACER,OMEGA[BB]),OMEGA[AA])
629
-SUM(MCS[BB,AA,KK]*DIFF(TRACER,OMEGA[KK]),KK,1,DIM))))
631
FOR AA THRU DIM DO FOR BB THRU DIM DO
634
KDELT(AA,BB)*TRACER^2/2-
635
2*TRACER*RICCI[AA,BB]-
636
2*KDELT(AA,BB)*DSCALAR(TRACER)+
638
DIFF(DIFF(TRACER,OMEGA[AA]),OMEGA[CC])
640
*DIFF(TRACER,OMEGA[KK]),
641
KK,1,DIM)),CC,1,DIM))))$
643
invariant2():="not yet implemented";
644
bimetric():="not yet implemented";
643
INVARIANT2():="NOT YET IMPLEMENTED";
644
BIMETRIC():="NOT YET IMPLEMENTED";
647
/* Uncomment this to fix the "missing prompt" problem on some platforms */
added
removed
share/tensor/ctensr.mac
