1/* Copyright (C) 2004 Viktor T. Toth <http://www.vttoth.com/> 2 * 3 * This program is free software; you can redistribute it and/or 4 * modify it under the terms of the GNU General Public License as 5 * published by the Free Software Foundation; either version 2 of 6 * the License, or (at your option) any later version. 7 * 8 * This program is distributed in the hope that it will be 9 * useful, but WITHOUT ANY WARRANTY; without even the implied 10 * warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 11 * PURPOSE. See the GNU General Public License for more details. 12 * 13 * Supplement to itensor.lisp: implementation of frames and torsion 14 * 15 */ 16 17inonmet_flag:false; 18iframe_bracket_form:true; 19defcon(ifr,ifri,ifg); 20defcon(ifg,ifg,kdelta); 21SYM; /* So that 5.9.1 knows about this as a case-insensitive symbol */ 22 23/* Helper function to get the metric tensor or return an error */ 24_g([l]):=if iframe_flag then apply(nounify(ifg), l) 25 else if (?boundp)('imetric) then 26 apply(nounify(if true then imetric),l) 27 else error("Name of metric must be specified"); 28 29/* Helper functions to conditionally apply the nonmetricity and 30 torsion tensors only if itorsion_flag:true */ 31_inm([l]):=if inonmet_flag then apply('inm,l) else 0; 32_itr([l]):=if itorsion_flag then apply('itr,l) else 0; 33 34/* Coefficient used internally when computing the rotation coefficients */ 35/*%icc1(l):=block([i:idummy()],'ifr([l[1]],[i])*_g([l[2],l[3]],[],i)+ 36 * _inm([l[1]],[])*_g([l[2],l[3]],[])-_itr([l[1],l[2],l[3]])- 37 * 'ifb([l[1],l[2]],[i])*_g([i,l[3]],[]))/2; */ 38 39/* The frame bracket */ 40ifb(l,[ld]):=if length(ld)>0 and rest(ld)#[] then 41 apply('idiff,cons(ifb(l),rest((?putinones)(rest(ld))))) 42 else if length(ld)>0 and length(ld[1])>0 then 43 block([e:idummy()], 44 _g([],[e,ld[1][1]])*funmake(ifb,[append(l,[e]),rest(ld[1])]) 45 ) 46 else block([e:idummy(),f:idummy()], 47 if iframe_bracket_form or itorsion_flag then 48 'ifr([l[2]],[e])*'ifr([l[3]],[f])* 49 ('ifri([l[1],e],[],f)-'ifri([l[1],f],[],e)- 50 _itr([e,f],[m])*ifri([l[1],m],[]) 51 ) 52 else 'ifri([l[1],e],[])*('ifr([l[2]],[f])*'ifr([l[3]],[e],f)- 53 'ifr([l[2]],[e],f)*'ifr([l[3]],[f])) 54); 55 56/* The connection coefficients */ 57icc1(l,[ld]):=if length(ld)>0 and rest(ld)#[] then 58 apply('idiff,cons(icc1(l),rest((?putinones)(rest(ld))))) 59 else 60 (if iframe_flag then 'ifc1(l,[]) 61 else 'ichr1(l,if length(ld)>0 then ld[1] else []))+ 62 (if itorsion_flag and not iframe_flag then -'ikt1(l,[]) else 0)+ 63 (if inonmet_flag then -'inmc1(l,[]) else 0); 64icc2(l1,l2,[ld]):= 65 if ld#[] then apply('idiff,cons(icc2(l1,l2),rest((?putinones)(ld)))) 66/*else block([d:idummy()],_g([],[l2[1],d])*(%icc1([l1[1],d,l1[2]])- 67 %icc1([d,l1[2],l1[1]])+%icc1([l1[2],l1[1],d]))/2);*/ 68 else 69 (if iframe_flag then 'ifc2(l1,l2) else 'ichr2(l1,l2))+ 70 (if itorsion_flag and not iframe_flag then -'ikt2(l1,l2) else 0)+ 71 (if inonmet_flag then -'inmc2(l1,l2) else 0); 72 73/* The frame coefficients */ 74ifc1(l,[ld]):=if length(ld)>0 and rest(ld)#[] then 75 apply('idiff,cons(ifc1(l),rest((?putinones)(rest(ld))))) 76 else ('ifb(l)+'ifb([l[2],l[3],l[1]])-'ifb([l[3],l[1],l[2]]))/2; 77ifc2(l1,l2,[ld]):=if length(ld)>0 then 78 apply('idiff,cons(ifc2(l1,l2),rest((?putinones)(ld)))) 79 else block([d:idummy()],_g([],[l2[1],d])*'ifc1([l1[1],l1[2],d])); 80 81 82/* The nonmetricity coefficients */ 83inmc1(l,[ld]):=if not inonmet_flag then 0 84 else if length(ld)>0 and rest(ld)#[] then 85 apply('idiff,cons(inmc1(l),rest((?putinones)(rest(ld))))) 86 else (-_inm([l[1]])*_g([l[2],l[3]])-_inm([l[2]])*_g([l[1],l[3]])+ 87 _inm([l[3]])*_g([l[1],l[2]]))/2; 88inmc2(l1,l2,[ld]):=if not inonmet_flag then 0 89 else if ld#[] then apply('idiff,cons(inmc2(l1,l2),rest((?putinones)(ld)))) 90 else block([m:idummy()],(-_inm([l1[1]])*'kdelta([l1[2]],[l2[1]])- 91 _inm([l1[2]])*'kdelta([l1[1]],[l2[1]])+ 92 _g([],[l2[1],m])*_inm([m])*_g([l1[1],l1[2]]))/2); 93 94/* Contortion */ 95ikt1(l,[ld]):=if not itorsion_flag then 0 96 else if length(ld)>0 and rest(ld)#[] then 97 apply('idiff,cons(ikt1(l),rest((?putinones)(rest(ld))))) 98 else block([d:idummy()],(-_g([l[3],d])*_itr([l[1],l[2]],[d])-_g([l[2],d])* 99 _itr([l[3],l[1]],[d])-_g([l[1],d])*_itr([l[3],l[2]],[d]))/2); 100ikt2(l1,l2,[ld]):=if not itorsion_flag then 0 101 else if ld#[] then apply('idiff,cons(ikt2(l1,l2),rest((?putinones)(ld)))) 102 else block([e:idummy()],_g([],[l2[1],e])*'ikt1([l1[1],l1[2],e])); 103 104/* Simplify expressions containing the metric tensor's derivatives */ 105/* v1 106simpmetderiv(exp):= 107( 108 if atom(exp) then exp 109 else if op(exp)="-" then -simpmetderiv(-exp) 110 else if op(exp)="+" then funmake("+", map(simpmetderiv, args(exp))) 111 else if op(exp)="/" then 112 simpmetderiv(part(exp,1))/simpmetderiv(part(exp,2)) 113 else if op(exp)="*" then 114 block([sign:1,args:args(exp)], 115 for i thru length(args) do 116 for j thru length(args) do 117 ( 118 if i#j and ?rpobj(args[i]) and ?rpobj(args[j]) and 119 op(args[i])=imetric and op(args[j])=imetric then 120 block( 121 [a:if length(covi(args[i]))>0 then args[i] else args[j], 122 b:if length(covi(args[i]))>0 then args[j] else args[i]], 123 if length(covi(a)) = 2 and length(conti(a)) = 0 and 124 length(covi(b)) = 0 and length(conti(b)) = 2 and 125 length(?intersect(covi(a),conti(b))) = 1 then 126 ( 127 if (flipflag and length(deri(a)) = 1 and 128 length(deri(b)) = 0) or 129 (not flipflag and length(deri(a)) = 0 and 130 length(deri(b)) = 1) then 131 block( 132 [tmp:deri(a)], 133 args[i]:funmake(op(a), 134 append([covi(a),conti(a)],deri(b))), 135 args[j]:funmake(op(b),append([covi(b),conti(b)],tmp)), 136 sign:-sign 137 ) 138 ) 139 ) 140 ), 141 sign*funmake("*",args) 142 ) 143 else exp 144); */ 145 146simpmetderiv(exp,[stop]):= 147( 148 if atom(exp) then exp 149 else if op(exp)="-" then -apply(simpmetderiv,cons(-exp,stop)) 150 else if op(exp)="+" then 151 funmake("+", map(lambda([x],apply(simpmetderiv,cons(x,stop))), args(exp))) 152 else if op(exp)="/" then apply(simpmetderiv,cons(part(exp,1),stop))/ 153 apply(simpmetderiv,cons(part(exp,2),stop)) 154 else if op(exp)="*" then 155 block([sign:1,args:args(exp)], 156 for i thru length(args) do 157 for j thru length(args) do 158 ( 159 if i#j and ?rpobj(args[i]) and ?rpobj(args[j]) and 160 op(args[i])=imetric and op(args[j])=imetric then 161 block( 162 [a:if length(covi(args[i]))>0 then args[i] else args[j], 163 b:if length(covi(args[i]))>0 then args[j] else args[i]], 164 if length(covi(a)) = 2 and length(conti(a)) = 0 and 165 length(covi(b)) = 0 and length(conti(b)) = 2 and 166 ( 167 ( 168 sort(covi(a)) = sort(conti(b)) and 169 length(deri(a)) = 1 and length(deri(b)) = 1 and 170 ( 171 (flipflag and 172 ordergreatp(deri(a)[1], deri(b)[1])) or 173 (not flipflag and 174 ordergreatp(deri(b)[1], deri(a)[1])) 175 ) 176 ) or 177 ( 178 length(covi(a)) = 2 and length(conti(a)) = 0 and 179 length(covi(b)) = 0 and length(conti(b)) = 2 and 180 length(?intersect(covi(a),conti(b))) >= 1 and 181 ( 182 (flipflag and length(deri(a)) = 1 and 183 length(deri(b)) = 0) or 184 (not flipflag and length(deri(a)) = 0 and 185 length(deri(b)) = 1) 186 ) and (sign:-sign) # 0 187 ) 188 ) then 189 190 block( 191 [tmp:deri(a)], 192 args[i]:funmake(op(a), 193 append([covi(a),conti(a)],deri(b))), 194 args[j]:funmake(op(b),append([covi(b),conti(b)],tmp)), 195 if stop#[] then i:j:length(args) 196 ) 197 ) 198 ), 199 sign*funmake("*",args) 200 ) 201 else exp 202); 203 204 205/* Always true symmetries */ 206decsym(ichr1,3,0,[sym(1,2)],[]); 207decsym(ichr2,2,1,[sym(all)],[]); 208decsym(icurvature,3,1,[anti(2,3)],[]); 209/* decsym(ifb,3,0,[anti(2,3)],[]); <-- not valid with torsion 210 * decsym(icc1,3,0,[sym(1,2)],[]); 211 * decsym(icc2,2,1,[sym(all)],[]); 212 * decsym(ifc1,3,0,[sym(1,2)],[]); 213 * decsym(ifc2,2,1,[sym(all)],[]); 214 * decsym(ikt1,3,0,[sym(1,2)],[]); 215 * decsym(ikt2,2,1,[sym(all)],[]);*/ 216