share/tensor/iframe.mac

   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
  17 inonmet_flag:false;
  18 iframe_bracket_form:true;
  19 defcon(ifr,ifri,ifg);
  20 defcon(ifg,ifg,kdelta);
  21 SYM;            /* 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 */
  40 ifb(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 */
  57 icc1(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);
  64 icc2(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 */
  74 ifc1(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;
  77 ifc2(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 */
  83 inmc1(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;
  88 inmc2(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 */
  95 ikt1(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);
 100 ikt2(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
 106 simpmetderiv(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
 146 simpmetderiv(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(setify(covi(a)),setify(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 */
 206 decsym(ichr1,3,0,[sym(1,2)],[]);
 207 decsym(ichr2,2,1,[sym(all)],[]);
 208 decsym(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)],[]);*/