%==========================================================================%
% GRGgrav.sl Gravitation %
%==========================================================================%
% GRG 3.2 Standard Lisp Source Code (C) 1988-96 Vadim V. Zhytnikov %
%==========================================================================%
% This file is distributed without any warranty. You may modify it but you %
% are not allowed to remove author's name and/or distribute modified file. %
%==========================================================================%
% Various constants of Physics Equations ...
(de aconst!> nil
(setq !#!A!C!O!N!S!T (copy '( !A!C0 ))))
(de mconst!> nil
(setq !#!M!C!O!N!S!T (copy '(nil !M!C1 !M!C2 !M!C3 ))))
(de lconst!> nil
(setq !#!L!C!O!N!S!T
(copy '( !L!C0 !L!C1 !L!C2 !L!C3 !L!C4 !L!C5 !L!C6 ))))
%---- Irreducible Torsion 2-forms in general case 10.96 -------------------
(de qtfcomp!> nil
(prog (w)
(makebox!> '!#!T!H!Q!T)
(setq w (list 'quotient -1 ![dim1!]))
(fordim!> a do
(putel1!> (evalform!> (fndfpr!> w (dfprod2!> (getframe!> a)
(car !#!Q!Q))))
!#!T!H!Q!T a)) ))
(de qafcomp!> nil
(prog (w)
(makebox!> '!#!T!H!Q!A)
(setq w (list 'quotient 1 3))
(fordim!> a do
(putel1!> (evalform!> (fndfpr!> w (vform!> (getup!> !#!D a)
(car !#!Q!Q!A))))
!#!T!H!Q!A a)) ))
(de qcfcomp!> nil
(prog (w)
(makebox!> '!#!T!H!Q!C)
(fordim!> a do
(putel1!> (evalform!> (dfsum!> (list
(getel1!> !#!T!H!E!T!A a)
(chsign!> t (getel1!> !#!T!H!Q!A a))
(chsign!> t (getel1!> !#!T!H!Q!T a)) )))
!#!T!H!Q!C a)) ))
%----- Irreducible Nonmetricity 1-forms. 10.96 ----------------------------
(de compnnw!> nil
(prog (w)
(fordim!> a do
(setq w (cons (getm!> '!#!N nil (list2 a a) '(1 nil)) w)))
(setq !#!N!N!W (ncons (evalform!> (dfsum!> w))))))
(de compnnt!> nil
(prog (w)
(fordim!> a do (fordim!> m do
(setq w (cons (fndfpr!> (vform1!> (getup!> !#!D m)
(getel2s!> !#!N a m))
(getframe!> a)) w))))
(setq w (cons (fndfpr!> (list 'quotient -1 ![dim!])
(car !#!N!N!W)) w))
(setq !#!N!N!T (ncons (evalform!> (dfsum!> w))))))
(de compnw!> nil
(prog (w)
(setq !#!N!W (mkt!> 2))
(setq w (list 'quotient 1 ![dim!]))
(fordim!> a do (fordim!> b do (cond ((leq a b)
(putel!> (evalform!> (fndfpr!> (list 'times w (getmetr!> a b))
(car !#!N!N!W)))
!#!N!W (list2 a b)))))) ))
(de compnt!> nil
(prog (w ww)
(setq !#!N!T (mkt!> 2))
(setq w (list 'quotient ![dim!] (times (sub1 ![dim!])
(add1 (add1 ![dim!])))))
(setq ww (list 'quotient -2 ![dim!]))
(fordim!> a do (fordim!> b do (cond ((leq a b)
(putel!> (evalform!> (fndfpr!> w (dfsum!> (list
(fndfpr!> (vform1!> (getiframe!> a) (car !#!N!N!T))
(getlo!> !#!T b))
(fndfpr!> (vform1!> (getiframe!> b) (car !#!N!N!T))
(getlo!> !#!T a))
(fndfpr!> (list 'times ww (getmetr!> a b))
(car !#!N!N!T))))))
!#!N!T (list2 a b)))))) ))
(de compna!> nil
(prog (w wa)
(setq !#!N!A (mkt!> 2))
(setq wa (mkt!> 1))
(fordim!> a do (progn
(setq w nil)
(fordim!> m do
(setq w (cons (dfprod2!> (getframe!> m)
(dfsum!> (list
(getel2s!> !#!N a m)
(chsign!> t (getel2s!> !#!N!W a m))
(chsign!> t (getel2s!> !#!N!T a m)))))
w)))
(putel1!> (dfsum!> w) wa a)))
(fordim!> a do (fordim!> b do (cond ((leq a b)
(putel!> (evalform!> (fndfpr!> (list 'quotient 1 3)
(dfsum!> (list (vform!> (getiframe!> a) (getel1!> wa b))
(vform!> (getiframe!> b) (getel1!> wa a))))))
!#!N!A (list2 a b)))))) ))
(de compnc!> nil
(prog (w)
(setq !#!N!C (mkt!> 2))
(setq w (list 'quotient 1 ![dim!]))
(fordim!> a do (fordim!> b do (cond ((leq a b)
(putel!> (evalform!> (dfsum!> (list
(getel2s!> !#!N a b)
(cond ((geq ![dim!] 3)
(chsign!> t (getel2s!> !#!N!A a b)) )
(t nil))
(chsign!> t (getel2s!> !#!N!W a b))
(chsign!> t (getel2s!> !#!N!T a b)) )))
!#!N!C (list2 a b)))))) ))
%----- Irreducible Curvature 2-forms. 10.96 -------------------------------
% OMEGA[.a.b]
(de getoma!> (wa wb)
(cond (!*nonmetr (fndfpr!> '(quotient 1 2) (dfsum!> (list2
(getm!> '!#!O!M!E!G!A nil (list2 wa wb) '(2 nil))
(chsign!> t
(getm!> '!#!O!M!E!G!A nil (list2 wb wa) '(2 nil))) ))))
(t (getm!> '!#!O!M!E!G!A nil (list2 wa wb) '(2 nil)))))
% OMEGA(.a.b)
(de getoms!> (wa wb)
(cond (!*nonmetr (fndfpr!> '(quotient 1 2) (dfsum!> (list2
(getm!> '!#!O!M!E!G!A nil (list2 wa wb) '(2 nil))
(getm!> '!#!O!M!E!G!A nil (list2 wb wa) '(2 nil)) ))))
(t nil)))
(de getomao!> (wa wb)
(dfsum!> (list (getoma!> wa wb)
(chsign!> t (getasy2!> !#!O!M!C wa wb t))
(chsign!> t (getasy2!> !#!O!M!R wa wb t))
(chsign!> t (getasy2!> !#!O!M!A wa wb t))
(chsign!> t (getasy2!> !#!O!M!D wa wb t)) )))
(de getomso!> (wa wb)
(dfsum!> (list (getoms!> wa wb)
(chsign!> t (getel2s!> !#!O!S!H wa wb))
(chsign!> t (getel2s!> !#!O!S!C wa wb))
(chsign!> t (getel2s!> !#!O!S!A wa wb)) )))
% Ricci Tensor ...
(de riccio!> nil
(prog (w woo)
(setq !#!R!I!C (mkt!> 2))
(setq woo (mkt!> 1))
(fordim!> b do (progn
(setq w nil)
(fordim!> m do
(setq w (cons (vform!> (getiframe!> m)
(getel2!> !#!O!M!E!G!A m b)) w)))
(putel1!> (dfsum!> w) woo b)))
(fordim!> a do (fordim!> b do
(cond ((or !*torsion !*nonmetr (leq a b))
(putel!> (evalalg!> (vform1!> (getiframe!> b) (getel1!> woo a)))
!#!R!I!C (list2 a b))))))))
% A-Ricci Tensor ...
(de riccioa!> nil
(prog (w woo)
(setq !#!R!I!C!A (mkt!> 2))
(setq woo (mkt!> 1))
(fordim!> b do (progn
(setq w nil)
(fordim!> m do
(setq w (cons (vform!> (getup!> !#!D m) (getoma!> m b)) w)))
(putel1!> (dfsum!> w) woo b)))
(fordim!> a do (fordim!> b do
(putel!> (evalalg!> (vform1!> (getiframe!> b) (getel1!> woo a)))
!#!R!I!C!A (list2 a b))))))
% S-Ricci Tensor ...
(de riccios!> nil
(prog (w woo)
(setq !#!R!I!C!S (mkt!> 2))
(setq woo (mkt!> 1))
(fordim!> b do (progn
(setq w nil)
(fordim!> m do
(setq w (cons (vform!> (getup!> !#!D m) (getoms!> m b)) w)))
(putel1!> (dfsum!> w) woo b)))
(fordim!> a do (fordim!> b do
(putel!> (evalalg!> (vform1!> (getiframe!> b) (getel1!> woo a)))
!#!R!I!C!S (list2 a b))))))
% RR from ARIC
(de rscalara!> nil
(prog (w)
(fordim!> wa do (fordim!> wb do
(setq w (cons (multa!> (getimetr!> wa wb)
(getel2!> !#!R!I!C!A wa wb))
w))))
(setq w (summa!> w))
(setq !#!R!R (ncons w)) ))
(de mkrrf!> nil
(prog (wc)
(setq !#!O!M!R (mkt!> 2))
(setq wc (list 'quotient 1 (times ![dim!] (sub1 ![dim!]))))
(fordim!> a do (fordim!> b do (cond ((lessp a b)
(putel!> (evalform!> (fndfpr!> (list 'times wc (car !#!R!R))
(getm!> '!#!S nil (list2 a b) '(2 2))))
!#!O!M!R (list2 a b))))))))
(de getra!> (wa wb)
(cond (!*nonmetr (list 'times '(quotient 1 2)
(list 'difference (getel2!> !#!R!I!C!A wa wb)
(getel2!> !#!R!I!C!A wb wa))))
(t (list 'times '(quotient 1 2)
(list 'difference (getel2!> !#!R!I!C wa wb)
(getel2!> !#!R!I!C wb wa)))) ))
(de getrsa!> (wa wb)
(list 'difference
(list 'times '(quotient 1 2)
(list 'difference (getel2!> !#!R!I!C!S wa wb)
(getel2!> !#!R!I!C!S wb wa)))
(list 'times (list 'quotient 1 ![dim!])
(vform1!> (getiframe!> wb)
(vform!> (getiframe!> wa)
(car !#!O!M!E!G!A!H))))))
%(de getrsa!> (wa wb)
% (list 'times '(quotient 1 2)
% (list 'difference (getel2!> !#!R!I!C!S wa wb)
% (getel2!> !#!R!I!C!S wb wa))))
(de getrsc!> (wa wb)
(list 'times '(quotient 1 2)
(list 'plus (getel2!> !#!R!I!C!S wa wb)
(getel2!> !#!R!I!C!S wb wa))))
(de getrc!> (wa wb)
(cond (!*nonmetr (list 'times '(quotient 1 2)
(list 'plus (getel2!> !#!R!I!C!A wa wb)
(getel2!> !#!R!I!C!A wb wa)
(list 'times (list 'quotient -2 ![dim!])
(getmetr!> wa wb)
(car !#!R!R)))))
(!*torsion (list 'times '(quotient 1 2)
(list 'plus (getel2!> !#!R!I!C wa wb)
(getel2!> !#!R!I!C wb wa)
(list 'times (list 'quotient -2 ![dim!])
(getmetr!> wa wb)
(car !#!R!R)))))
(t (list 'plus (getel2s!> !#!R!I!C wa wb)
(list 'times (list 'quotient -1 ![dim!])
(getmetr!> wa wb)
(car !#!R!R))))))
(de mkrcf!> nil
(prog (wc wx w)
(setq !#!O!M!C (mkt!> 2))
(setq wx (mkt!> 1))
(fordim!> a do (progn
(setq w nil)
(fordim!> m do
(setq w (cons (fndfpr!> (getrc!> a m) (getframe!> m)) w)))
(putel1!> (dfsum!> w) wx a)))
(setq wc (list 'quotient 1 (sub1(sub1 ![dim!]))))
(fordim!> a do (fordim!> b do (cond ((lessp a b)
(putel!> (evalform!> (fndfpr!> wc (dfsum!> (list
(dfprod2!> (getel1!> wx a) (getlo!> !#!T b))
(chsign!> t
(dfprod2!> (getel1!> wx b) (getlo!> !#!T a)))))))
!#!O!M!C (list2 a b))))))))
(de mkraf!> nil
(prog (wc wx w)
(setq !#!O!M!A (mkt!> 2))
(setq wx (mkt!> 1))
(fordim!> a do (progn
(setq w nil)
(fordim!> m do
(setq w (cons (fndfpr!> (getra!> a m) (getframe!> m)) w)))
(putel1!> (dfsum!> w) wx a)))
(setq wc (list 'quotient 1 (sub1(sub1 ![dim!]))))
(fordim!> a do (fordim!> b do (cond ((lessp a b)
(putel!> (evalform!> (fndfpr!> wc (dfsum!> (list
(dfprod2!> (getel1!> wx a) (getlo!> !#!T b))
(chsign!> t
(dfprod2!> (getel1!> wx b) (getlo!> !#!T a)))))))
!#!O!M!A (list2 a b))))))))
(de mkrdf!> nil
(prog (wc w)
(setq !#!O!M!D (mkt!> 2))
(fordim!> m do (fordim!> n do (cond ((lessp m n)
(setq w (cons (dfprod2!> (getoma!> m n) (getel2!> !#!S m n)) w))))))
(setq w (evalform!>(dfsum!> w)))
(setq wc (list 'quotient 1 6))
(fordim!> a do (fordim!> b do (cond ((lessp a b)
(putel!> (evalform!> (fndfpr!> wc
(vform!> (getiframe!> b) (vform!> (getiframe!> a) w))))
!#!O!M!D (list2 a b))))))))
(de mkrbf!> nil
(prog (wc wx w)
(setq !#!O!M!B (mkt!> 2))
(setq wx (mkt!> 1))
(fordim!> a do (progn
(setq w nil)
(fordim!> m do
(setq w (cons (dfprod2!> (getomao!> a m) (getframe!> m)) w)))
(putel1!> (dfsum!> w) wx a)))
(setq wc (list 'quotient 1 2))
(fordim!> a do (fordim!> b do (cond ((lessp a b)
(putel!> (evalform!> (fndfpr!> wc (dfsum!> (list
(vform!> (getiframe!> b) (getel1!> wx a))
(chsign!> t (vform!> (getiframe!> a) (getel1!> wx b)))))))
!#!O!M!B (list2 a b))))))))
(de mkrwf!> nil
(prog nil
(setq !#!O!M!W (mkt!> 2))
(fordim!> a do (fordim!> b do (cond ((lessp a b)
(putel!> (evalform!> (dfsum!> (list
(getoma!> a b)
(chsign!> t (getel2!> !#!O!M!C a b))
(chsign!> t (getel2!> !#!O!M!R a b))
(cond ((or !*torsion !*nonmetr)
(chsign!> t (getel2!> !#!O!M!A a b))) (t nil))
(cond ((or !*torsion !*nonmetr)
(chsign!> t (getel2!> !#!O!M!B a b))) (t nil))
(cond ((or !*torsion !*nonmetr)
(chsign!> t (getel2!> !#!O!M!D a b))) (t nil))
)))
!#!O!M!W (list2 a b))))))))
(de mkomegah!> nil
(prog (w)
(fordim!> m do
(setq w (cons (getel2!> !#!O!M!E!G!A m m) w)))
(setq !#!O!M!E!G!A!H (ncons (evalform!> (dfsum!> w))))))
(de mkrshf!> nil
(prog (wc wcc w)
(setq !#!O!S!H (mkt!> 2))
(setq wc (list 'quotient 1 ![dim!]))
(fordim!> a do (fordim!> b do (cond ((leq a b)
(putel!> (evalform!> (fndfpr!> (list 'times wc (getmetr!> a b))
(car !#!O!M!E!G!A!H)))
!#!O!S!H (list2 a b))))))))
%(de mkrshf!> nil
% (prog (wc wcc w)
% (setq !#!O!S!H (mkt!> 2))
% (setq wc (list 'quotient -1 (difference (expt ![dim!] 2) 4)))
% (setq wcc (minus ![dim!]))
% (fordim!> a do (fordim!> b do (cond ((leq a b)
% (putel!> (evalform!> (fndfpr!> wc (dfsum!> (list
% (dfprod2!> (getlo!> !#!T a)
% (vform!> (getiframe!> b) (car !#!O!M!E!G!A!H)))
% (dfprod2!> (getlo!> !#!T b)
% (vform!> (getiframe!> a) (car !#!O!M!E!G!A!H)))
% (fndfpr!> (list 'times wcc (getmetr!> a b))
% (car !#!O!M!E!G!A!H) )))))
% !#!O!S!H (list2 a b))))))))
(de mkrscf!> nil
(prog (wc wx w)
(setq !#!O!S!C (mkt!> 2))
(setq wx (mkt!> 1))
(fordim!> a do (progn
(setq w nil)
(fordim!> m do
(setq w (cons (fndfpr!> (getrsc!> a m) (getframe!> m)) w)))
(putel1!> (dfsum!> w) wx a)))
(setq wc (list 'quotient 1 ![dim!]))
(fordim!> a do (fordim!> b do (cond ((leq a b)
(putel!> (evalform!> (fndfpr!> wc (dfsum!> (list
(dfprod2!> (getlo!> !#!T a) (getel1!> wx b))
(dfprod2!> (getlo!> !#!T b) (getel1!> wx a))))))
!#!O!S!C (list2 a b))))))))
(de mkrshf2!> nil
(prog (wc wx w)
(setq !#!O!S!H (mkt!> 2))
(fordim!> a do (fordim!> b do (cond ((leq a b)
(putel!> (evalform!> (dfsum!> (list
(getoms!> a b)
(chsign!> t (getel2!> !#!O!S!C a b)))))
!#!O!S!H (list2 a b))))))))
(de mkrsaf!> nil
(prog (wc wx wxx wcc w)
(setq !#!O!S!A (mkt!> 2))
(setq wx (mkt!> 1))
(fordim!> a do (progn
(setq w nil)
(fordim!> m do
(setq w (cons (fndfpr!> (getrsa!> a m) (getframe!> m)) w)))
(putel1!> (dfsum!> w) wx a)))
(setq w nil)
(fordim!> m do
(setq w (cons (dfprod2!> (getframe!> m) (getel1!> wx m)) w)))
(setq wxx (dfsum!> w))
(setq w nil)
(setq wc (list 'quotient 1 ![dim!]))
(setq wc (list 'quotient ![dim!] (difference (expt ![dim!] 2) 4)))
(setq wcc (list 'quotient -2 ![dim!]))
(fordim!> a do (fordim!> b do (cond ((leq a b)
(putel!> (evalform!> (fndfpr!> wc (dfsum!> (list
(dfprod2!> (getlo!> !#!T a) (getel1!> wx b))
(dfprod2!> (getlo!> !#!T b) (getel1!> wx a))
(fndfpr!> (list 'times wcc (getmetr!> a b)) wxx)
))))
!#!O!S!A (list2 a b))))))))
(de mkrsvf!> nil
(prog (wc wx w)
(setq !#!O!S!V (mkt!> 2))
(setq wx (mkt!> 1))
(fordim!> a do (progn
(setq w nil)
(fordim!> m do
(setq w (cons (dfprod2!> (getomso!> a m) (getframe!> m)) w)))
(putel1!> (dfsum!> w) wx a)))
(setq wc (list 'quotient 1 4))
(fordim!> a do (fordim!> b do (cond ((leq a b)
(putel!> (evalform!> (fndfpr!> wc (dfsum!> (list
(vform!> (getiframe!> b) (getel1!> wx a))
(vform!> (getiframe!> a) (getel1!> wx b))))))
!#!O!S!V (list2 a b))))))))
(de mkrsuf!> nil
(prog nil
(setq !#!O!S!U (mkt!> 2))
(fordim!> a do (fordim!> b do (cond ((leq a b)
(putel!> (evalform!> (dfsum!> (list
(getoms!> a b)
(chsign!> t (getel2!> !#!O!S!H a b))
(chsign!> t (getel2!> !#!O!S!A a b))
(chsign!> t (getel2!> !#!O!S!C a b))
(cond
((geq ![dim!] 4) (chsign!> t (getel2!> !#!O!S!V a b)))
(t nil))
)))
!#!O!S!U (list2 a b))))))))
%------- Einstein Equations. 10.96 ----------------------------------------
(de einstein!> nil
(prog (wl wr)
(setq !#!E!E!q (mkt!> 2))
(fordim!> wa do (fordim!> wb do (cond ((leq wa wb)
(setq wl (list (getel2!> !#!R!I!C wa wb)
(list 'times '(quotient -1 2) (getmetr!> wa wb)
(car !#!R!R))
(cond (!*cconst
(list 'times (getmetr!> wa wb) '!C!C!O!N!S!T)))))
(setq wr (list 'times 8 'pi '!G!C!O!N!S!T
(getel2!> !#!T!E!N!M!O!M wa wb)))
(putel!> (equation!> (summa!> wl) (evalalg!> wr))
!#!E!E!q (list2 wa wb))))))))
(de einsteint!> nil
(setq !#!T!E!E!q (ncons (equation!>
(evalalg!> (cond (!*cconst (list 'plus (car !#!R!R)
(list 'times -4 '!C!C!O!N!S!T)))
(t (car !#!R!R))))
(evalalg!> (list 'times -8 'pi '!G!C!O!N!S!T
(car !#!T!E!N!M!O!M!T)))))))
(de einsteinc!> nil
(prog (wl wr)
(makebox!> '!#!C!E!E!q)
(for!> wa (0 1 2) do (for!> wb (0 1 2) do (cond ((leq wa wb)
(setq wl (getel2!> !#!R!C wa wb))
(setq wr (list 'times 8 'pi '!G!C!O!N!S!T
(getel2!> !#!T!E!N!M!O!M!S wa wb)))
(putel!> (equation!> (evalalg!> wl) (evalalg!> wr))
!#!C!E!E!q (list2 wa wb))))))))
%------ Gravitational Equations -------------------------------------------
% Curvature Momentum ...
(de pomegau!> nil
(prog (wc objlst finlst w w0 w1 w2 obj)
% we are trying to calculate required parts ...
(setq wc 0)
(setq objlst (cond
(!*torsion '( !#!O!M!W!U !#!O!M!C!U !#!O!M!R!U
!#!O!M!A!U !#!O!M!B!U !#!O!M!D!U ))
(t '( !#!O!M!W!U !#!O!M!C!U !#!O!M!R!U ))))
(foreach!> obj in objlst do (progn
(setq wc (add1 wc))
(cond
((evalalg!> (getel1!> !#!L!C!O!N!S!T wc))
(setq finlst (cons (cons wc obj) finlst))
(setq ![chain!] nil)
(setq w (request!> obj))
(cond ((eq w !!er!!) (setq finlst (cons !!er!! finlst))
%(return !!er!!)
)
((null w) (setq ![er!] 6046)
(setq finlst (cons !!er!! finlst))
(trsf!> obj)
%(return !!er!!)
) )))))
% (foreach!> obj in objlst do (progn
% (setq wc (add1 wc))
% (cond
% ((evalalg!> (getel1!> !#!L!C!O!N!S!T wc))
% (setq finlst (cons (cons wc obj) finlst))
% (setq ![chain!] nil)
% (setq w (request!> obj))
% (cond ((eq w !!er!!) (setq finlst (cons !!er!! finlst))
% (return !!er!!) )
% ((null w) (setq ![er!] 6046)
% (setq finlst (cons !!er!! finlst))
% (trsf!> obj)
% (return !!er!!) ) )))))
(cond ((memq !!er!! finlst) (return !!er!!)))
% now we go on ...
(makebox!> '!#!P!O!M!E!G!A!U)
(foreach!> obj in finlst do (progn
(setq wc (cond ((memq (car obj) '(1 3 4 6)) 'i)
(t '(minus i))))
(setq w0 (cons (fndfpr!>
(list 'times wc (getel1!> !#!L!C!O!N!S!T (car obj)))
(getel1!> (eval(cdr obj)) 0)) w0))
(setq w1 (cons (fndfpr!>
(list 'times wc (getel1!> !#!L!C!O!N!S!T (car obj)))
(getel1!> (eval(cdr obj)) 1)) w1))
(setq w2 (cons (fndfpr!>
(list 'times wc (getel1!> !#!L!C!O!N!S!T (car obj)))
(getel1!> (eval(cdr obj)) 2)) w2))
))
(setq wc (list 'times 'i
(list 'plus (getel1!> !#!L!C!O!N!S!T 0)
(cond (!*nonmin (list 'times
(mp!> 8) 'pi
'!G!C!O!N!S!T
(getel1!> !#!A!C!O!N!S!T 0)
(car !#!F!I) (car !#!F!I)
))))))
(setq w0 (cons (fndfpr!> wc (getel1!> !#!S!U 0)) w0))
(setq w1 (cons (fndfpr!> wc (getel1!> !#!S!U 1)) w1))
(setq w2 (cons (fndfpr!> wc (getel1!> !#!S!U 2)) w2))
(putel1!> (evalform!>(dfsum!> w0)) !#!P!O!M!E!G!A!U 0) (setq w0 nil)
(putel1!> (evalform!>(dfsum!> w1)) !#!P!O!M!E!G!A!U 1) (setq w1 nil)
(putel1!> (evalform!>(dfsum!> w2)) !#!P!O!M!E!G!A!U 2) (setq w2 nil)
(return t)))
% Torsion Momentum ...
(de ptheta!> nil
(prog (wc objlst finlst w w0 w1 w2 w3)
% we are trying to calculate required parts ...
(setq wc 0)
(setq objlst '( !#!T!H!Q!C!U !#!T!H!Q!T!U !#!T!H!Q!A!U ))
(foreach!> obj in objlst do (progn
(setq wc (add1 wc))
(cond
((evalalg!> (getel1!> !#!M!C!O!N!S!T wc))
(setq finlst (cons (cons wc obj) finlst))
(setq ![chain!] nil)
(setq w (request!> obj))
(cond ((eq w !!er!!) (setq finlst (cons !!er!! finlst))
%(return !!er!!)
)
((null w) (setq ![er!] 6046)
(setq finlst (cons !!er!! finlst))
(trsf!> obj)
%(return !!er!!)
) )))))
% (foreach!> obj in objlst do (progn
% (setq wc (add1 wc))
% (cond
% ((evalalg!> (getel1!> !#!M!C!O!N!S!T wc))
% (setq finlst (cons (cons wc obj) finlst))
% (setq ![chain!] nil)
% (setq w (request!> obj))
% (cond ((eq w !!er!!) (setq finlst (cons !!er!! finlst))
% (return !!er!!))
% ((null w) (setq ![er!] 6046)
% (setq finlst (cons !!er!! finlst))
% (trsf!> obj)
% (return !!er!!)) )))))
(cond ((memq !!er!! finlst) (return !!er!!)))
% now we go on ...
(makebox!> '!#!P!T!H!E!T!A)
(foreach!> obj in finlst do (progn
(setq wc 'i)
(setq w0 (cons (fndfpr!>
(list 'times wc (getel1!> !#!M!C!O!N!S!T (car obj)))
(getel1!> (eval(cdr obj)) 0)) w0))
(setq w1 (cons (fndfpr!>
(list 'times wc (getel1!> !#!M!C!O!N!S!T (car obj)))
(getel1!> (eval(cdr obj)) 1)) w1))
(setq w2 (cons (fndfpr!>
(list 'times wc (getel1!> !#!M!C!O!N!S!T (car obj)))
(getel1!> (eval(cdr obj)) 2)) w2))
(setq w3 (cons (fndfpr!>
(list 'times wc (getel1!> !#!M!C!O!N!S!T (car obj)))
(getel1!> (eval(cdr obj)) 3)) w3))
))
(setq w0 (ncons (evalform!> (dfsum!> w0))))
(setq w1 (ncons (evalform!> (dfsum!> w1))))
(setq w2 (ncons (evalform!> (dfsum!> w2))))
(setq w3 (ncons (evalform!> (dfsum!> w3))))
(setq w0 (append w0 (mapcar w0 'coform!>)))
(setq w1 (append w1 (mapcar w1 'coform!>)))
(setq w2 (append w2 (mapcar w3 'coform!>)))
(setq w3 (mapcar w2 'coform!>))
(putel1!> (evalform!>(dfsum!> w0)) !#!P!T!H!E!T!A 0) (setq w0 nil)
(putel1!> (evalform!>(dfsum!> w1)) !#!P!T!H!E!T!A 1) (setq w1 nil)
(putel1!> (evalform!>(dfsum!> w2)) !#!P!T!H!E!T!A 2) (setq w2 nil)
(putel1!> (evalform!>(dfsum!> w3)) !#!P!T!H!E!T!A 3) (setq w3 nil)
(return t)))
%----- Gravitational action 4-form. 12.90 ---------------------------------
(de lact!> nil
(prog (w)
(setq w (list
(dfprod2!> (getel1!> !#!P!O!M!E!G!A!U 0)
(getel1!> !#!O!M!E!G!A!U 2))
(dfprod2!> (getel1!> !#!P!O!M!E!G!A!U 2)
(getel1!> !#!O!M!E!G!A!U 0))
(fndfpr!> -2 (dfprod2!> (getel1!> !#!P!O!M!E!G!A!U 1)
(getel1!> !#!O!M!E!G!A!U 1)))
))
(setq w (ncons (evalform!> (dfsum!> w))))
(setq w (append w (mapcar w 'coform!>)))
(cond (!*cconst
(setq w (cons
(fndfpr!> (list 'times -2 '!C!C!O!N!S!T) (car !#!V!O!L)) w))))
(cond (!*torsion (setq w (append w (list
(fndfpr!> (list 'quotient (mp!> 1) 2)
(dfprod2!> (getel1!> !#!P!T!H!E!T!A 0)
(getel1!> !#!T!H!E!T!A 1)))
(fndfpr!> (list 'quotient (mp!> 1) 2)
(dfprod2!> (getel1!> !#!P!T!H!E!T!A 1)
(getel1!> !#!T!H!E!T!A 0)))
(fndfpr!> (list 'quotient (pm!> 1) 2)
(dfprod2!> (getel1!> !#!P!T!H!E!T!A 2)
(getel1!> !#!T!H!E!T!A 3)))
(fndfpr!> (list 'quotient (pm!> 1) 2)
(dfprod2!> (getel1!> !#!P!T!H!E!T!A 3)
(getel1!> !#!T!H!E!T!A 2)))
)))))
(setq w (cons
(fndfpr!> (list 'plus
(list 'quotient (getel1!> !#!L!C!O!N!S!T 0) 2)
(cond (!*nonmin
(list 'times (mp!> 4) 'pi '!G!C!O!N!S!T
(getel1!> !#!A!C!O!N!S!T 0)
(car !#!F!I) (car !#!F!I)))
(t nil)))
(fndfpr!> (car !#!R!R) (car !#!V!O!L))) w))
(setq !#!L!A!C!T (ncons (evalform!> (dfsum!> w))))
(return t)))
% Torsion equation. 01.91
(de torsequation!> nil
(prog (wc)
(setq wc '(times -16 pi !G!C!O!N!S!T))
(makebox!> '!#!T!O!R!S!q)
(putel1!> (equation!> (evalform!> (chsign!> t (dfsum!> (list
(dex!> (getel1!> !#!P!O!M!E!G!A!U 0 ))
(fndfpr!> -2 (dfprod2!> (connecu!> 1)
(getel1!> !#!P!O!M!E!G!A!U 0 )))
(fndfpr!> 2 (dfprod2!> (connecu!> 0)
(getel1!> !#!P!O!M!E!G!A!U 1 )))
(fndfpr!> '(quotient -1 2) (dfprod2!> (getframe!> 0)
(getel1!> !#!P!T!H!E!T!A 2)))
(fndfpr!> '(quotient 1 2) (dfprod2!> (getframe!> 2)
(getel1!> !#!P!T!H!E!T!A 0)))
))))
(evalform!> (fndfpr!> wc (getel1!> !#!S!P!I!N!U 0))))
!#!T!O!R!S!q 0)
(putel1!> (equation!> (evalform!> (chsign!> t (dfsum!> (list
(dex!> (getel1!> !#!P!O!M!E!G!A!U 1 ))
(fndfpr!> -1 (dfprod2!> (connecu!> 2)
(getel1!> !#!P!O!M!E!G!A!U 0 )))
(dfprod2!> (connecu!> 0)
(getel1!> !#!P!O!M!E!G!A!U 2 ))
(fndfpr!> '(quotient -1 4) (dfprod2!> (getframe!> 1)
(getel1!> !#!P!T!H!E!T!A 0)))
(fndfpr!> '(quotient 1 4) (dfprod2!> (getframe!> 0)
(getel1!> !#!P!T!H!E!T!A 1)))
(fndfpr!> '(quotient 1 4) (dfprod2!> (getframe!> 3)
(getel1!> !#!P!T!H!E!T!A 2)))
(fndfpr!> '(quotient -1 4) (dfprod2!> (getframe!> 2)
(getel1!> !#!P!T!H!E!T!A 3)))
))))
(evalform!> (fndfpr!> wc (getel1!> !#!S!P!I!N!U 1))))
!#!T!O!R!S!q 1)
(putel1!> (equation!> (evalform!> (chsign!> t (dfsum!>( list
(dex!> (getel1!> !#!P!O!M!E!G!A!U 2 ))
(fndfpr!> 2 (dfprod2!> (connecu!> 1)
(getel1!> !#!P!O!M!E!G!A!U 2 )))
(fndfpr!> -2 (dfprod2!> (connecu!> 2)
(getel1!> !#!P!O!M!E!G!A!U 1 )))
(fndfpr!> '(quotient 1 2) (dfprod2!> (getframe!> 1)
(getel1!> !#!P!T!H!E!T!A 3)))
(fndfpr!> '(quotient -1 2) (dfprod2!> (getframe!> 3)
(getel1!> !#!P!T!H!E!T!A 1)))
))))
(evalform!> (fndfpr!> wc (getel1!> !#!S!P!I!N!U 2))))
!#!T!O!R!S!q 2)
))
(de connecu!> (w)
(pmf!> (getel1!> !#!o!m!e!g!a!u w)))
% Metric Equation. 01.91
(de metrequation!> nil
(prog (wc woo wcc wtt wtheta wa wb)
(setq wc '(times 8 pi !G!C!O!N!S!T))
(setq woo (mkt!> 1))
% OMEGAU/\POMEGAU
(for!> x (0 1 3) do
(putel1!> (evalform!>(dfsum!>(list
(fndfpr!> 2 (dfprod2!> (vform!> (getiframe!> x)
(getel1!> !#!O!M!E!G!A!U 0 ))
(getel1!> !#!P!O!M!E!G!A!U 2 )))
(fndfpr!> 2 (dfprod2!> (vform!> (getiframe!> x)
(getel1!> !#!O!M!E!G!A!U 2 ))
(getel1!> !#!P!O!M!E!G!A!U 0 )))
(fndfpr!> -4 (dfprod2!> (vform!> (getiframe!> x)
(getel1!> !#!O!M!E!G!A!U 1 ))
(getel1!> !#!P!O!M!E!G!A!U 1 ))) )))
woo x))
(setq wcc (mkt!> 1))
% OMEGAU/\POMEGAU + cc
(for!> x (0 1 3) do
(putel1!> (list2 (getel1!> woo x)
(coform!> (getel1!> woo (ccin!> x))))
wcc x))
(setq woo nil)
(setq wtt (mkt!> 1))
% Effective PTHETA
(cond
% If TORSION is On then wtheta = PTHETA
(!*torsion (setq wtheta !#!P!T!H!E!T!A))
% If TORSION is Off then wtheta = D POMEGA
(t (setq wa (mkt!> 1))
(dcpomega!> wa) % wa - D POMEGA
(setq wb (mkt!> 1))
(crsigma!> wb wa) % wb - SIGMAi
(setq wa
(list
(vform!> (getiframe!> 2) (getel1!> wb 2))
(vform!> (getiframe!> 0) (getel1!> wb 0))
(vform!> (getiframe!> 1) (getel1!> wb 1)) ))
(setq wa (cons (coform!> (car wa)) wa))
(setq wa (dfsum!> wa)) % wa - SIGMA
(setq wtheta (mkt!> 1))
(for!> x (0 1 2) do
(putel1!> (evalform!> (dfsum!> (list
(fndfpr!> 2 (getel1!> wb x))
(fndfpr!> '(quotient -1 2) (dfprod2!> (getframe!> x) wa)) )))
wtheta x)) % wtheta - THETAeff
(putel1!> (coform!>(getel1!> wtheta 2)) wtheta 3)
(setq wa nil)
(setq wb nil)
))
(for!> x (0 1 3) do (putel1!> (evalform!> (dfsum!> (append
(cons (dctheta!> x wtheta) (getel1!> wcc x) ) % D PTHETA
(list
(chsign!> t (vform!> (getiframe!> x) % LACT
(car !#!L!A!C!T)))
% THETA/\PTHETA iff TORSION is On
(cond (!*torsion (dfprod2!> (vform!> (getdsgn!> x)
(getel1!> !#!T!H!E!T!A 0))
(getel1!> !#!P!T!H!E!T!A 1))))
(cond (!*torsion (dfprod2!> (vform!> (getdsgn!> x)
(getel1!> !#!T!H!E!T!A 1))
(getel1!> !#!P!T!H!E!T!A 0))))
(cond (!*torsion (chsign!> t
(dfprod2!> (vform!> (getdsgn!> x)
(getel1!> !#!T!H!E!T!A 2))
(getel1!> !#!P!T!H!E!T!A 3))) ))
(cond (!*torsion (chsign!> t
(dfprod2!> (vform!> (getdsgn!> x)
(getel1!> !#!T!H!E!T!A 3))
(getel1!> !#!P!T!H!E!T!A 2)))) )))))
wtt x))
(setq wcc nil)
(setq !#!M!E!T!R!q (mkt!> 2))
(for!> x (0 1 3) do (for!> y (0 1 3) do
(cond ((and (leq x y) (or !*full (member (list2 x y)
'((0 0)(0 1)(0 2)(1 1)(1 2)(2 2)(2 3)))))
(putel!> (equation!> (evalalg!> (makezz!> x y wtt))
(evalalg!> (list 'times wc
(getel2s!> !#!T!E!N!M!O!M x y))))
!#!M!E!T!R!q (list2 x y))))))
(return t)))
(de getdsgn!> (wa) (mpf!> (getiframe!> wa)))
(de makezz!> (wa wb wss)
(prog (waa wbb)
(setq waa (getel1!> wss wa))
(setq wbb (getel1!> wss wb))
(return (duald!> (fndfpr!> '(quotient -1 4) (dfsum!> (list
(dfprod2!> (getlo!> !#!T wa) wbb)
(dfprod2!> (getlo!> !#!T wb) waa) )))))))
(de dctheta!> (x wth)
(cond ((eqn x 3) (coform!> (evalform!> (dfsum!> (dctheta0!> 2 wth)))))
(t (evalform!> (dfsum!> (dctheta0!> x wth))))))
(de dctheta0!> (x wth)
(cond
((eqn x 0) (list
(dexsgn!> (getel1!> wth 1))
(chsign!> t
(dfprod2!> (dfsum!> (list2 (getel1!> !#!o!m!e!g!a!u 1)
(getel1!> !#!o!m!e!g!a!d 1)))
(getel1!> wth 1)) )
(chsign!> t
(dfprod2!> (getel1!> !#!o!m!e!g!a!u 2)
(getel1!> wth 2)) )
(chsign!> t
(dfprod2!> (getel1!> !#!o!m!e!g!a!d 2)
(getel1!> wth 3)) ) ))
((eqn x 1) (list
(dexsgn!> (getel1!> wth 0))
(dfprod2!> (dfsum!> (list2 (getel1!> !#!o!m!e!g!a!u 1 )
(getel1!> !#!o!m!e!g!a!d 1 )))
(getel1!> wth 0))
(dfprod2!> (getel1!> !#!o!m!e!g!a!u 0 )
(getel1!> wth 3))
(dfprod2!> (getel1!> !#!o!m!e!g!a!d 0 )
(getel1!> wth 2)) ))
((eqn x 2) (list
(chsign!> t (dexsgn!> (getel1!> wth 3)))
(chsign!> t
(dfprod2!> (dfsum!> (list2 (chsign!> t (getel1!> !#!o!m!e!g!a!u 1 ))
(getel1!> !#!o!m!e!g!a!d 1 )))
(getel1!> wth 3)) )
(dfprod2!> (getel1!> !#!o!m!e!g!a!u 2 )
(getel1!> wth 0))
(chsign!> t
(dfprod2!> (getel1!> !#!o!m!e!g!a!d 0 )
(getel1!> wth 1))) ))
((eqn x 3) (mapcar (dctheta!> 2 wth) 'coform!>))
))
(de dexsgn!> (lst) (mpf!> (dex!> lst)))
(de dcpomega!> (w)
(progn
(putel1!> (dfsum!> (list
(dex!> (getel1!> !#!P!O!M!E!G!A!U 0))
(fndfpr!> -2 (dfprod2!> (connecu!> 1)
(getel1!> !#!P!O!M!E!G!A!U 0)))
(fndfpr!> 2 (dfprod2!> (connecu!> 0)
(getel1!> !#!P!O!M!E!G!A!U 1)))))
w 0)
(putel1!> (dfsum!> (list
(dex!>(getel1!> !#!P!O!M!E!G!A!U 1))
(fndfpr!> -1 (dfprod2!> (connecu!> 2)
(getel1!> !#!P!O!M!E!G!A!U 0)))
(dfprod2!> (connecu!> 0)
(getel1!> !#!P!O!M!E!G!A!U 2)) ))
w 1)
(putel1!> (dfsum!> (list
(dex!>(getel1!> !#!P!O!M!E!G!A!U 2))
(fndfpr!> 2 (dfprod2!> (connecu!> 1)
(getel1!> !#!P!O!M!E!G!A!U 2)))
(fndfpr!> -2 (dfprod2!> (connecu!> 2)
(getel1!> !#!P!O!M!E!G!A!U 1))) ))
w 2) ))
(de crsigma!> (lst w)
(prog (wa wb)
(setq wa(vform!>(getiframe!> 1)(getel1!> w 1)))
(setq wb(chsign!> t(vform!>(getiframe!> 2)(getel1!> w 0))))
(putel1!>(dfsum!>(list wa wb (coform!> wa)(coform!> wb))) lst 0)
(setq wa(vform!>(getiframe!> 3)(getel1!> w 2)))
(setq wb(chsign!> t(vform!>(getiframe!> 0)(getel1!> w 1))))
(putel1!>(dfsum!>(list wa wb (coform!> wa)(coform!> wb))) lst 1)
(putel1!>(evalform!>(dfsum!>(list
(vform!>(getiframe!> 0)(getel1!> w 0))
(chsign!> t(vform!>(getiframe!> 1)(coform!>(getel1!> w 2))))
(vform!>(getiframe!> 3)(coform!>(getel1!> w 1)))
(chsign!> t(vform!>(getiframe!> 3)(getel1!> w 1))) )))
lst 2) ))
%========= End of GRGgrav.sl ==============================================%