123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512 |
- %==========================================================================%
- % GRGgeom.sl Geometry %
- %==========================================================================%
- % 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. %
- %==========================================================================%
- %------ Coordinate --------------------------------------------------------
- % Macro 2 for Coordinates ...
- (de x!> (wm) (getel1!> ![cord!] wm))
- %------ Dimension ---------------------------------------------------------
- % Macro 3 for dim ...
- (de dim!> nil ![dim!])
- %------ Delta symbols -----------------------------------------------------
- (de delta!> (wa wb) (cond ((equal wa wb) 1) (t nil)))
- %------ Epsilon tensors 05.96 --------------------------------------------
- (de epsilon!> (u)
- (cond
- ((issame!> u) nil)
- (t(proc (wt wp w ww wc)
- (setq w u)
- (loop!>
- (setq wp nil)
- (setq ww (ncons (car w)))
- (setq w (cdr w))
- (while!> w
- (setq wc (car w))
- (cond ((lessp wc (car ww))
- (setq ww (cons (car ww)
- (cons wc
- (cdr ww))))
- (setq wt (not wt))
- (setq wp t))
- (t (setq ww (cons wc ww))))
- (setq w (cdr w)))
- (cond ((null wp) (return (cond (wt -1) (t 1)))))
- (setq w (reversip ww)))))))
- (de issame!> (w)
- (cond ((null w) nil)
- ((memq (car w) (cdr w)) t)
- (t (issame!> (cdr w)))))
- (dm epsilf!> (w) (list 'epsilf0!> (list 'quote (cdr w))))
- (de epsilf0!> (w)
- (prog2
- (setq w (epsilon!> w))
- (cond (w (list 'times w (car !#!s!d!e!t!G)))
- (t nil))))
- (dm epsiuf!> (w) (list 'epsiuf0!> (list 'quote (cdr w))))
- (de epsiuf0!> (w)
- (prog2
- (setq w (epsilon!> w))
- (cond (w (list 'quotient (list 'times w ![sigprod!]) (car !#!s!d!e!t!G)))
- (t nil))))
- (dm epsilh!> (w) (list 'epsilh0!> (list 'quote (cdr w))))
- (de epsilh0!> (w)
- (prog2
- (setq w (epsilon!> w))
- (cond (w (list 'times w (list 'sqrt
- (list 'times ![sigprod!] (car !#!d!e!t!g)))))
- (t nil))))
- (dm epsiuh!> (w) (list 'epsiuh0!> (list 'quote (cdr w))))
- (de epsiuh0!> (w)
- (prog2
- (setq w (epsilon!> w))
- (cond (w (list 'quotient (list 'times w ![sigprod!])
- (list 'sqrt
- (list 'times ![sigprod!] (car !#!d!e!t!g)))))
- (t nil))))
- (de epss!> (wa wb)
- (cond ((equal wa wb) nil)
- ((eqn wa 0) 1)
- ((eqn wa 1) -1)
- (t nil)))
- %------ Basis and Inverse Basis 27.02.91, 05.96 --------------------------
- % Basis ...
- (de base!> nil
- (setq !#!b (copy !#!T)))
- (de base1!> nil % 05.96
- (prog (w) (setq !#!b (mkt!> 1))
- (setq w (aeval (list 'tp (list 'quotient 1 (mkmtetr!> !#!e)))))
- (mktetrm!> (cdr w) !#!b)
- (return t)))
- % Inverse Basis ...
- (de ibase!> nil
- (prog (w)
- (setq w (evalform!>(dfprod!> !#!b)))
- (cond ((null w) (prog2 (setq ![er!] 8400) (return !!er!!))))
- (setq !#!e (mkt!> 1))
- (setq w (aeval (list 'tp (list 'quotient 1 (mkmtetr!> !#!b)))))
- (mktetrm!> (cdr w) !#!e)
- (return t)))
- %------ Sigma Matrix -------------------------------------------------------
- (de sigma!> (wm wa wb)
- (prog (w)
- (setq w
- (cond
- ((and (eqn wm 0) (eqn wa 1) (eqn wb 1)) 1)
- ((and (eqn wm 1) (eqn wa 0) (eqn wb 0)) 1)
- ((and (eqn wm 2) (eqn wa 1) (eqn wb 0)) 1)
- ((and (eqn wm 3) (eqn wa 0) (eqn wb 1)) 1)
- (t nil)))
- (cond (w (setq w (car ![sgn!]))))
- (return w)))
- (de sigmai!> (wm wa wb)
- (prog (w)
- (setq w
- (cond
- ((and (eqn wm 0) (eqn wa 1) (eqn wb 1)) 1)
- ((and (eqn wm 1) (eqn wa 0) (eqn wb 0)) 1)
- ((and (eqn wm 2) (eqn wa 1) (eqn wb 0)) 1)
- ((and (eqn wm 3) (eqn wa 0) (eqn wb 1)) 1)
- (t nil)))
- (return w)))
- %------ Signature ----------------------------------------------------------
- % Signum ...
- (de signum!> (w) (cond ((lessp w 0) -1) (t 1)))
- % Signum of Product of Signature, i.e. Signum of the Metric ...
- (de sigprod!> nil (signum!> (eval (cons 'times ![sgn!]))))
- % Macros 2 Signature diagonal ...
- (de diagonal!> (w) (getel1!> ![sgn!] w))
- (de pmsgn!> nil (pm!> 1))
- (de mpsgn!> nil (mp!> 1))
- %------ S - forms ----------------------------------------------------------
- (de makesforms!> nil
- (prog nil
- (setq !#!S (mkt!> 2))
- (fordim!> x do (fordim!> y do (cond ((lessp x y)
- (putel!> (evalform!> (dfprod2!> (getframe!> x)
- (getframe!> y)))
- !#!S (list2 x y))))))
- (return t)))
- %------ Metric -------------------------------------------------------------
- (de imetr1!> nil % 05.96
- (prog (w)
- (cond ((zerop (nz!>(eval!> (list 'det (setq w (mats!> !#!G))))))
- (setq ![er!] 6800) (return !!er!!) ))
- (setq !#!G!I (mkt!> 2))
- (rmats!> !#!G!I (aeval (list 'quotient 1 w)))
- (mitype!>)
- (return t)))
- (de metr0!> nil % 05.96
- (prog nil
- (msg!> 6801)
- (setq !#!G (mkt!> 2))
- (fordim!> i do
- (putel!> (getel1!> ![sgn!] i) !#!G (list2 i i)))
- (mtype!>)
- (return t)))
- (de metr1!> nil % 05.96
- (prog (w)
- (cond ((zerop (nz!>(eval!> (list 'det (setq w (mats!> !#!G!I))))))
- (setq ![er!] 6800) (return !!er!!) ))
- (setq !#!G (mkt!> 2))
- (rmats!> !#!G (aeval (list 'quotient 1 w)))
- (mtype!>)
- (return t)))
- (de nullmetric!> nil % 05.96
- (prog nil
- (cond
- (!#!G (msg!> 6820) (return t))
- ((equal ![sgn!] '(-1 1 1 1))
- (setq !#!G (copy ![nullm!]))
- (setq ![mtype!] 1)
- (setq ![dtype!] 1)
- (return t))
- ((equal ![sgn!] '(1 -1 -1 -1))
- (setq !#!G (copy ![nullm1!]))
- (setq ![mtype!] 1)
- (setq ![dtype!] 1)
- (return t))
- (t (setq ![er!] 7910) (return !!er!!)))))
- (de detg1!> nil % 05.96
- (prog (w)
- (cond ((zerop (nz!> (setq w (eval!> (list 'det (mats!> !#!G))))))
- (setq ![er!] 6800) (return !!er!!) ))
- (setq !#!d!e!t!G (ncons w))
- (return t)))
- (de dethg1!> nil % 05.96
- (prog (w)
- (cond ((zerop (nz!> (setq w (eval!> (list 'det (matsf!> 'gmetr!>))))))
- (setq ![er!] 6800) (return !!er!!) ))
- (setq !#!d!e!t!g (ncons w))
- (return t)))
- (de sdetg1!> nil % 05.96
- (prog (w)
- (cond ((zerop (nz!> (setq w (eval!> (list 'det (mats!> !#!G))))))
- (setq ![er!] 6800) (return !!er!!) ))
- (setq !#!s!d!e!t!G (ncons (evalalg!>
- (list 'sqrt (list 'times ![sigprod!] w)))))
- (return t)))
- %------ Volume -------------------------------------------------------------
- (de vol0!> nil % 05.96
- (prog (w)
- (fordim!> i do
- (cond ((eqn i 0) (setq w (getframe!> 0)))
- (t (setq w (dfprod2!> w (getframe!> i))))))
- (setq w (evalform!> (fndfpr!> (car !#!s!d!e!t!G) w)))
- (cond ((null w) (setq ![er!] 4000) (return !!er!!)))
- (setq !#!V!O!L (ncons w))
- (return t)))
- %------ Frame --------------------------------------------------------------
- (de frame1!> nil % 05.96
- (prog (w) (setq !#!T (mkt!> 1))
- (setq w (aeval (list 'tp (list 'quotient 1 (mkmtetr!> !#!D)))))
- (mktetrm!> (cdr w) !#!T)
- (ftype!>)
- (return t)))
- (de iframe1!> nil % 05.96
- (prog (w) (setq !#!D (mkt!> 1))
- (setq w (aeval (list 'tp (list 'quotient 1 (mkmtetr!> !#!T)))))
- (mktetrm!> (cdr w) !#!D)
- (fitype!>)
- (return t)))
- (de frame0!> nil % 05.96
- (prog nil
- (msg!> 6803)
- (setq !#!T (mkt1!>))
- (fordim!> i do (putel1!> (mkdx!> i) !#!T i))
- (ftype!>)
- (return t)))
- %----- Macros Metric/Frame components -------------------------------------
- % Components of Frame/Inverse Frame ... 05.96
- (de ham!> (wa wm) % h^a_m
- (cond (![umod!] (vform1!> (getel1!> ![xv!] wm) (getel1!> !#!T wa)))
- (t (getfdx!> (getel1!> !#!T wa) wm))))
- (de hiam!> (wa wm) % h_a^m
- (cond (![umod!] (vform1!> (getel1!> !#!D wa) (getel1!> ![xf!] wm)))
- (t (getfdx!> (getel1!> !#!D wa) wm))))
- (de gmetr!> (wi wk) % g_ik
- (cond((fholop!>) % holonomic frame
- (getmetr!> wi wk))
- ((motop!>) % `diagonal' metric
- (cons 'plus
- (foreach!> a in (dimlist!> 0) collect
- (mktimes!> (list (diagm!> a)
- (ham!> a wi)
- (ham!> (ai!> a) wk))))))
- (t(prog (w wc) % general case
- (fordim!> a do
- (fordim!> b do
- (cond ((setq wc (getmetr!> a b))
- (setq w (cons (mktimes!> (list wc
- (ham!> a wi)
- (ham!> b wk)))
- w))))))
- (cond (w (return (cons 'plus w))) (t (return nil)))))))
- (de gmetr0!> (wi wk) % g_ik
- (cond((fholop!>) % holonomic frame
- (getmetr!> wi wk))
- ((motop!>) % `diagonal' metric
- (cons 'plus
- (foreach!> a in (dimlist!> 0) collect
- (mktimes!> (list (diagm!> a)
- (ham0!> a wi)
- (ham0!> (ai!> a) wk))))))
- (t(prog (w wc) % general case
- (fordim!> a do
- (fordim!> b do
- (cond ((setq wc (getmetr!> a b))
- (setq w (cons (mktimes!> (list wc
- (ham0!> a wi)
- (ham0!> b wk)))
- w))))))
- (cond (w (return (cons 'plus w))) (t (return nil)))))))
- (de gimetr!> (wi wk) % g^ik
- (cond((ifholop!>) % holonomic frame
- (getimetr!> wi wk))
- ((imotop!>) % `diagonal' metric
- (cons 'plus
- (foreach!> a in (dimlist!> 0) collect
- (mktimes!> (list (diagmi!> a)
- (hiam!> a wi)
- (hiam!> (ai!> a)wk))))))
- (t(prog (w wc)
- (fordim!> a do
- (fordim!> b do
- (cond ((setq wc (getimetr!> a b))
- (setq w (cons (mktimes!> (list wc
- (hiam!> a wi)
- (hiam!> b wk)))
- w))))))
- (cond (w (return(cons 'plus w))) (t (return nil)))))))
- (de huam!> (wa wm) % h^a^mu
- (cond ((imotop!>)
- (mktimes!> (list (diagmi!> wa) (hiam!> (ai!> wa) wm))))
- (t(cons 'plus
- (foreach!> b in (dimlist!> 0) collect
- (mktimes!> (list (getimetr!> wa b) (hiam!> b wm))))))))
- (de hlam!> (wa wm) % h_a_mu
- (cond ((motop!>)
- (mktimes!> (list (diagm!> wa) (ham!> (ai!> wa) wm))))
- (t(cons 'plus
- (foreach!> b in (dimlist!> 0) collect
- (mktimes!> (list (getmetr!> wa b) (ham!> b wm))))))))
- %---------- Spin Coefficients -------------------------------------------
- (de spcoef!> (waa wb)
- (vform1!> (getiframe!> wb) (getel1!> !#!o!m!e!g!a!u waa)))
- %---------- Line-element. 27.12.90, 05.96 ------------------------------
- (de showlinel!> nil
- (proc (w wx wy wf wm)
- (setq wm "Cannot calculate Line-Element.")
- (setq ![chain!] nil)
- (setq w (request!> '!#!G))
- (cond((eq w !!er!!) (return w))
- ((null w) (progn (trsf!> '!#!G)(prin2 wm)(terpri)
- (setq ![er!] 6046) (return !!er!!))))
- (setq ![chain!] nil)
- (setq w (request!> '!#!T))
- (cond((eq w !!er!!) (return w))
- ((null w) (progn (trsf!> '!#!T)(prin2 wm)(terpri)
- (setq ![er!] 6046) (return !!er!!))))
- (gprinreset!>)
- (cond((not(and (fancyon!>) (not !*latex))) (terpri)))
- (cond((ifmodo!>) (gprin!> "ds2"))
- (t(prog2
- (algpri!> " d" )
- (algpri!> '(expt !s 2) ))))
- (wriassign!> nil)
- (cond(!*math (gprin!> "(")))
- (fordim!> x do (fordim!> y do
- (cond((or(lessp x y)(eqn x y))(progn
- (setq w(eval!>(cond ((eqn x y) (gmetr0!> x x))
- (t(list 'times 2 (gmetr0!> x y))))))
- (setq w (nz!> w))
- (cond((and(not(ifmodo!>))(numberp w)(lessp w 0)(not(eqn w -1)))
- (setq w (list 'minus (minus w)))))
- (cond((or (null w) (eqn w 0)) nil)
- ((ifmodo!>)
- (progn
- (cond(wf (gprin!> "+")))
- (setq wx (list2 '!dx (prepdx2!> x)))
- (setq wy (list2 '!dx (prepdx2!> y)))
- (ooprin!> (list 'times w wx wy))
- (setq wf t)))
- (t(progn
- (algpri!>(cond((eqn w -1) " - ")(wf " + ")(t " ")) )
- (cond((not(memq w '(1 -1))) (progn
- (cond((pairp w)(algpri!> "(" )))
- (algpri!> (aeval w) )
- (cond((pairp w)(algpri!> ")" ))) )))
- (wridd!>)
- (setq wx (prepdx2!> x))
- (setq wy (prepdx2!> y))
- (cond
- ((eqn x y) (prog2
- (cond((and ![umod!] (fancyon!>)) (progn
- (algpri!> "(" )
- (algpri!> wx )
- (setq wx ")" ))))
- (algpri!> (list 'expt wx 2) )))
- (t(progn
- (algpri!> wx )
- (wridd!>)
- (algpri!> wy ))))
- (setq wf t)
- ))) )))))
- (cond ((null wf) (alpri!> nil)))
- (cond (!*math (gprin!> ")")))
- (grgends!>)
- (grgterpri!>)
- (terpri)
- ))
- (de prepdx2!> (wx)
- (cond
- (![umod!]
- (cond ((fancyon!>) (list 'expt '!#!#b wx))
- (t (compress (cons '!b (explode2 wx))))))
- (t (getel1!> ![cord!] wx))))
- (de wridd!> nil
- (algpri!>
- (cond (![umod!] (cond ((fancyon!>) "\,")
- (t " ")))
- (t (cond ((fancyon!>) "\,d\,")
- (t " d "))))
- ))
- %------ Spinorial S-forms 06.96 ------------------------------------------
- (de ssform!> (wn w2 w3)
- (prog (w)
- (set wn (mkbox!> wn))
- (setq wn (eval wn))
- (setq w (evalform!> (chsignf!> (dfprod2!> (getframe!> 0)
- (getframe!> w2)))))
- (putel1!> w wn 0)
- (setq w (evalform!> (fndfpr!> '(quotient 1 2) (dfsum!> (list2
- (dfprod2!> (getframe!> 0) (getframe!> 1))
- (chsignf!> (dfprod2!> (getframe!> w2) (getframe!> w3))))))))
- (putel1!> w wn 1)
- (setq w (evalform!> (dfprod2!> (getframe!> 1)
- (getframe!> w3))))
- (putel1!> w wn 2)
- (return t)))
- %------ Christoffel symbols 06.96 ---------------------------------------
- (de chrt!> (wa)
- (list 'times '(quotient 1 2)
- (list 'quotient (list 'df (car !#!d!e!t!g) (getel1!> ![cord!] wa))
- (car !#!d!e!t!g))))
- (de chrf!> (wa wb wc)
- (list 'times '(quotient 1 2)
- (list 'plus
- (list 'df (gmetr!> wa wc) (getel1!> ![cord!] wb))
- (list 'df (gmetr!> wa wb) (getel1!> ![cord!] wc))
- (chsigna!> (list 'df (gmetr!> wb wc) (getel1!> ![cord!] wa))))))
- (de chr!> (wa wb wc)
- (evalalg!> (getm!> '!#!C!H!R!F nil (list wa wb wc) '(3 nil nil))))
- %------ Tensorial Solver 06.96 -------------------------------------------
- % Genral solver for frame connection ...
- % W - result, WT = t^a, WN = n_a_b (symmetric)
- (de fsolver!> (wr wt wn)
- (prog (w ww wc)
- (setq ww (mkt!> 1))
- (setq w (mkt!> 2))
- (set wr (mkt!> 2))
- (setq wr (eval wr))
- % Creating t_a -> WT
- (cond (wt
- (fordim!> a do (putel1!> (getlo!> wt a) ww a))
- (setq wt ww)
- (setq ww nil)))
- % Solving for 2*omega_a_b -> W (antisymmetric iff n_a_b=0)
- (fordim!> a do (fordim!> b do
- (cond ((or (lessp a b) wn)
- (setq wc nil)
- (fordim!> c do (progn
- % ( D_a _| D_b _| t_c ) T^c
- (cond (wt
- (setq wc (cons
- (fndfpr!> (vform1!> (getiframe!> a)
- (vform!> (getiframe!> b)
- (getel1!> wt c)))
- (getframe!> c))
- wc))))
- % ( D_b _| n_a_c - D_a _| n_b_c ) T^c
- (cond (wn
- (setq wc (cons
- (fndfpr!> (list 'difference
- (vform1!> (getiframe!> b) (getel2s!> wn a c))
- (vform1!> (getiframe!> a) (getel2s!> wn b c)))
- (getframe!> c))
- wc))))))
- (cond (wt
- % - D_a _| t_b
- (setq wc (cons
- (chsignf!> (vform!> (getiframe!> a) (getel1!> wt b)))
- wc))
- % D_b _| t_a
- (setq wc (cons
- (vform!> (getiframe!> b) (getel1!> wt a))
- wc))))
- (cond (wn
- % n_a_b
- (setq wc (cons (getel2s!> wn a b) wc))))
- (setq wc (evalform!> (dfsum!> wc)))
- (putel!> wc w (list2 a b))))))
- % Now omega^a_b
- (fordim!> a do (fordim!> b do (progn
- (setq wc (evalform!>
- (cond
- ((imotop!>)
- (fndfpr!> (mktimes2!> '(quotient 1 2) (diagmi!> a))
- (cond (wn (getel2!> w (ai!> a) b))
- (t (getasy2!> w (ai!> a) b t)))))
- (t (dfsum!> (foreach!> c in (dimlist!> 0) collect
- (fndfpr!> (mktimes2!> '(quotient 1 2) (getimetr!> a c))
- (cond (wn (getel2!> w c b))
- (t (getasy2!> w c b t))))))))))
- (putel!> wc wr (list2 a b)) ))) ))
- %------ Spinorial Solver 06.96 ------------------------------------------
- % General spinorial solver ...
- % WD = T - dotted, NIL - undotted
- % WR - destination, WZ - Z_AA 3-form
- (de ssolver!> (wr wz wd)
- (prog (wm00 wm10 wm20 wm01 wm11 wm21 w02 w12 w22 w03 w13 w23
- i0 i1 i2 i3 w)
- (set wr (mkbox!> wr))
- (setq wr (eval wr))
- (setq i0 0) (setq i1 1)
- (cond (wd (setq i2 3) (setq i3 2)) % undotted
- (t (setq i2 2) (setq i3 3))) % dotted
- % #( Z_AA/\T^b )
- (setq wm00 (dfp2!> (not wd) (getel1!> wz 0) (getframe!> i0)))
- (setq wm10 (dfp2!> (not wd) (getel1!> wz 1) (getframe!> i0)))
- (setq wm20 (dfp2!> (not wd) (getel1!> wz 2) (getframe!> i0)))
- (setq wm01 (dfp2!> (not wd) (getel1!> wz 0) (getframe!> i1)))
- (setq wm11 (dfp2!> (not wd) (getel1!> wz 1) (getframe!> i1)))
- (setq wm21 (dfp2!> (not wd) (getel1!> wz 2) (getframe!> i1)))
- (setq w02 (dfp2!> wd (getel1!> wz 0) (getframe!> i2)))
- (setq w12 (dfp2!> wd (getel1!> wz 1) (getframe!> i2)))
- (setq w22 (dfp2!> wd (getel1!> wz 2) (getframe!> i2)))
- (setq w03 (dfp2!> wd (getel1!> wz 0) (getframe!> i3)))
- (setq w13 (dfp2!> wd (getel1!> wz 1) (getframe!> i3)))
- (setq w23 (dfp2!> wd (getel1!> wz 2) (getframe!> i3)))
- % omega_0
- (setq w (evalform!> (fndfpr!> 'i (dfsum!> (list
- (fndfpr!> w12 (getframe!> i0))
- (fndfpr!> wm00 (getframe!> i1))
- (fndfpr!> wm10 (getframe!> i2))
- (fndfpr!> w02 (getframe!> i3)))))))
- (putel1!> w wr 0)
- % omega_1
- (setq w (evalform!> (fndfpr!> '(quotient i 2) (dfsum!> (list
- (fndfpr!> (list 'plus w22 wm11) (getframe!> i0))
- (fndfpr!> (list 'plus w03 wm10) (getframe!> i1))
- (fndfpr!> (list 'plus w13 wm20) (getframe!> i2))
- (fndfpr!> (list 'plus w12 wm01) (getframe!> i3)))))))
- (putel1!> w wr 1)
- % omega_2
- (setq w (evalform!> (fndfpr!> 'i (dfsum!> (list
- (fndfpr!> wm21 (getframe!> i0))
- (fndfpr!> w13 (getframe!> i1))
- (fndfpr!> w23 (getframe!> i2))
- (fndfpr!> wm11 (getframe!> i3)))))))
- (putel1!> w wr 2)
- ))
- (de dfp2!> (wd w1 w2)
- (eval!> (duald!>
- (cond
- ((and wd (not(pmmm!>))) (dfprod2!> w1 w2))
- ((and (pmmm!>) (not wd)) (dfprod2!> w1 w2))
- (t (dfprod2!> w2 w1)) ))))
- %-------------------------------------------------------------------------
- % omega from dT with THETA and N ...
- (de connec!> nil % 09.96
- (prog (wt wn)
- % t = dT + TH
- (setq wt (mkt!> 1))
- (fordim!> a do
- (putel1!> (cond (!*torsion (dfsum!> (list
- (dex!>(getframe!> a))
- (getel1!> !#!T!H!E!T!A a))))
- (t (dex!>(getframe!> a))))
- wt a))
- % n = dG + N
- (setq wn (mkt!> 2))
- (fordim!> a do (fordim!> b do
- (cond ((leq a b)
- (putel!> (cond (!*nonmetr (dfsum!> (list
- (dfun!>(getmetr!> a b))
- (getel2!> !#!N a b))))
- (t (dfun!>(getmetr!> a b)) ))
- wn (list2 a b))))))
- % solving ...
- (fsolver!> '!#!o!m!e!g!a wt wn)))
- % Riem connection + wa
- (de connecplus!> (wa) % 09.96
- (prog (wt wn)
- % t = dT
- (setq wt (mkt!> 1))
- (fordim!> a do
- (putel1!> (dex!>(getframe!> a)) wt a))
- % n = dG
- (setq wn (mkt!> 2))
- (fordim!> a do (fordim!> b do
- (cond ((leq a b)
- (putel!> (dfun!>(getmetr!> a b)) wn (list2 a b))))))
- % solving ...
- (cond (wa (fsolver!> '!#!o!m!e!g!a wt wn))
- (t (fsolver!> '!#!r!o!m!e!g!a wt wn)))
- % adding wa ...
- (cond (wa
- (fordim!> a do (fordim!> b do
- (putel!> (evalform!> (dfsum!> (list (getel2!> !#!o!m!e!g!a a b)
- (getel2!> wa a b))))
- !#!o!m!e!g!a (list2 a b)))) ))
- ))
- % K from THETA and N ...
- (de conndef!> nil % 09.96
- (prog (wt wn)
- % t = TH
- (setq wt (mkt!> 1))
- (fordim!> a do
- (putel1!> (getel1!> !#!T!H!E!T!A a) wt a))
- % n = N
- (setq wn (mkt!> 2))
- (fordim!> a do (fordim!> b do
- (cond ((leq a b)
- (putel!> (getel2!> !#!N a b) wn (list2 a b))))))
- % solving ...
- (fsolver!> '!#!K wt wn)))
- % KN from N ...
- (de nondef!> nil % 09.96
- (prog (wt wn)
- (setq wt (mkt!> 1))
- % n = N
- (setq wn (mkt!> 2))
- (fordim!> a do (fordim!> b do
- (cond ((leq a b)
- (putel!> (getel2!> !#!N a b) wn (list2 a b))))))
- % solving ...
- (fsolver!> '!#!K!N wt wn)))
- % KQ from THETA ...
- (de contor!> nil % 09.96
- (prog (wt wn)
- % t = TH
- (setq wt (mkt!> 1))
- (fordim!> a do
- (putel1!> (getel1!> !#!T!H!E!T!A a) wt a))
- (setq wn (mkt!> 2))
- % solving ...
- (fsolver!> '!#!K!Q wt wn)))
- % GAMMA from omega ...
- (de gfromo!> nil
- (prog nil
- (setq !#!G!A!M!M!A (mkt!> 2))
- (fordim!> a do (fordim!> b do
- (putel!> (evalform!> (dfsum!> (list
- (getm!> '!#!o!m!e!g!a nil (list2 a b) '(7 8))
- (addgamma!> a b))))
- !#!G!A!M!M!A (list2 a b)))) ))
- % RGAMMA from romega ...
- (de rgfromro!> nil
- (prog nil
- (setq !#!R!G!A!M!M!A (mkt!> 2))
- (fordim!> a do (fordim!> b do
- (putel!> (evalform!> (dfsum!> (list
- (getm!> '!#!r!o!m!e!g!a nil (list2 a b) '(7 8))
- (addgamma!> a b))))
- !#!R!G!A!M!M!A (list2 a b)))) ))
- (de addgamma!> (wm wn)
- (prog (w)
- (fordim!> ww do
- (setq w (cons (fndfpr!> (hiam!> ww wm) (dfun!>(ham!> ww wn))) w)))
- (return(dfsum!> w))))
- % omega from GAMMA ...
- (de ofromg!> nil
- (prog nil
- (setq !#!o!m!e!g!a (mkt!> 2))
- (fordim!> a do (fordim!> b do
- (putel!> (evalform!> (dfsum!> (list
- (getm!> '!#!G!A!M!M!A nil (list2 a b) '(5 6))
- (addomega!> a b))))
- !#!o!m!e!g!a (list2 a b)))) ))
- (de addomega!> (wa wb)
- (prog (w)
- (fordim!> ww do
- (setq w (cons (fndfpr!> (ham!> wa ww) (dfun!>(hiam!> wb ww))) w)))
- (return(dfsum!> w))))
- % N from K ...
- (de nfromk!> (wk)
- (prog nil
- (setq !#!N (mkt!> 2))
- (fordim!> a do (fordim!> b do (cond ((leq a b)
- (putel!> (evalform!> (dfsum!> (list
- (getm!> wk nil (list2 a b) '(2 nil))
- (getm!> wk nil (list2 b a) '(2 nil))
- )))
- !#!N (list2 a b)))) ))))
- % THETA from K ...
- (de qfromk!> (wk)
- (prog (w)
- (setq !#!T!H!E!T!A (mkt!> 1))
- (setq wk (eval wk))
- (fordim!> a do (progn
- (setq w nil)
- (fordim!> b do
- (setq w (cons (dfprod2!> (getframe!> b) (getel2!> wk a b)) w)))
- (putel1!> (evalform!> (dfsum!> w)) !#!T!H!E!T!A a)))))
- % Torsion trace 1-form 08.01.91
- (de qqq!> nil
- (prog (w)
- (fordim!> a do
- (setq w (cons (vform!> (getiframe!> a)
- (getel1!> !#!T!H!E!T!A a)) w)))
- (setq !#!Q!Q (ncons(evalform!>(chsign!> t (dfsum!> w)))))
- (return t)))
- % Antisymmetric Torsion 3-form 10.96
- (de qqqa!> nil
- (prog (w)
- (fordim!> a do
- (setq w (cons (dfprod2!> (getlo!> !#!T a)
- (getel1!> !#!T!H!E!T!A a)) w)))
- (setq !#!Q!Q!A (ncons (evalform!> (dfsum!> w))))
- (return t)))
- % roumegau ...
- (de ruconnec!> nil
- (ssolver!> '!#!r!o!m!e!g!a!u (mapcar !#!S!U 'dex!>) nil))
- % romegad ...
- (de rdconnec!> nil
- (ssolver!> '!#!r!o!m!e!g!a!d (mapcar !#!S!D 'dex!>) t))
- % oumegau ...
- (de uconnec!> nil
- (prog nil
- (ssolver!> '!#!o!m!e!g!a!u (mapcar !#!S!U 'dex!>) nil)
- (cond (!*torsion
- (for!> x (0 1 2) do
- (putel1!> (evalform!> (dfsum2!> (getel1!> !#!o!m!e!g!a!u x)
- (getel1!> !#!K!U x)))
- !#!o!m!e!g!a!u x))))))
- % omegad ...
- (de dconnec!> nil
- (prog nil
- (ssolver!> '!#!o!m!e!g!a!d (mapcar !#!S!D 'dex!>) t)
- (cond (!*torsion
- (for!> x (0 1 2) do
- (putel1!> (evalform!> (dfsum2!> (getel1!> !#!o!m!e!g!a!d x)
- (getel1!> !#!K!D x)))
- !#!o!m!e!g!a!d x))))))
- % omegau from omega ...
- (de oufromo!> (wu wo)
- (prog nil
- (set wu (mkbox!> wu))
- (setq wu (eval wu))
- (putel1!> (evalform!> (mpf!> (getel2!> wo 2 1))) wu 0)
- (putel1!> (evalform!> (fndfpr!> (pma!> '(quotient 1 2))
- (dfsum2!> (getel2!> wo 1 1) (getel2!> wo 3 3)))) wu 1)
- (putel1!> (evalform!> (pmf!> (getel2!> wo 3 0))) wu 2)
- ))
- % omegad from omega ...
- (de odfromo!> (wu wo)
- (prog nil
- (set wu (mkbox!> wu))
- (setq wu (eval wu))
- (putel1!> (evalform!> (mpf!> (getel2!> wo 3 1))) wu 0)
- (putel1!> (evalform!> (fndfpr!> (pma!> '(quotient 1 2))
- (dfsum2!> (getel2!> wo 1 1) (getel2!> wo 2 2)))) wu 1)
- (putel1!> (evalform!> (pmf!> (getel2!> wo 2 0))) wu 2)
- ))
- % omega from omegau+omegad ...
- (de ofromos!> (wo wu wd)
- (prog (w)
- (set wo (mkbox!> wo))
- (setq wo (eval wo))
- %
- (setq w (dfsum2!> (getel1!> wu 1) (getel1!> wd 1)))
- (putel!> (evalform!>(mpf!> w)) wo (list2 0 0))
- (putel!> (evalform!>(pmf!> w)) wo (list2 1 1))
- %
- (setq w (dfsum2!> (getel1!> wd 1) (chsign!> t (getel1!> wu 1))))
- (putel!> (evalform!>(pmf!> w)) wo (list2 2 2))
- (putel!> (evalform!>(mpf!> w)) wo (list2 3 3))
- %
- (setq w (evalform!>(pmf!>(getel1!> wd 2))))
- (putel!> w wo (list2 2 0))
- (putel!> w wo (list2 1 3))
- %
- (setq w (evalform!>(mpf!>(getel1!> wu 0))))
- (putel!> w wo (list2 2 1))
- (putel!> w wo (list2 0 3))
- %
- (setq w (evalform!>(pmf!>(getel1!> wu 2))))
- (putel!> w wo (list2 3 0))
- (putel!> w wo (list2 1 2))
- %
- (setq w (evalform!>(mpf!>(getel1!> wd 0))))
- (putel!> w wo (list2 3 1))
- (putel!> w wo (list2 0 2))
- ))
- % complex conjugation ...
- (de conj3!> (wr wss)
- (prog nil
- (set wr (mkbox!> wr))
- (setq wr (eval wr))
- (putel1!> (evalform!>(coform!>(getel1!> wss 0))) wr 0)
- (putel1!> (evalform!>(coform!>(getel1!> wss 1))) wr 1)
- (putel1!> (evalform!>(coform!>(getel1!> wss 2))) wr 2)
- ))
- %--------------------------------------------------------------------------
- % Curvature ...
- (de curvature!> nil
- (prog (w)
- (setq !#!O!M!E!G!A (mkt!> 2))
- (fordim!> a do (fordim!> b do (progn
- (setq w (ncons (dex!> (getel2!> !#!o!m!e!g!a a b))))
- (fordim!> x do
- (setq w (cons (dfprod2!> (getel2!> !#!o!m!e!g!a a x)
- (getel2!> !#!o!m!e!g!a x b) ) w)))
- (putel!> (evalform!> (dfsum!> w)) !#!O!M!E!G!A (list2 a b)))))))
- % Spinor Curvature
- (de scurvature!> (wr wo)
- (prog nil
- (set wr (mkbox!> wr))
- (setq wr (eval wr))
- (putel1!> (evalform!>(dfsum2!> (dex!>(getel1!> wo 0))
- (fndfpr!> (pma!> 2) (dfprod2!>
- (getel1!> wo 0)
- (getel1!> wo 1) )))) wr 0)
- (putel1!> (evalform!>(dfsum2!> (dex!>(getel1!> wo 1))
- (fndfpr!> (pma!> 1) (dfprod2!>
- (getel1!> wo 0)
- (getel1!> wo 2) )))) wr 1)
- (putel1!> (evalform!>(dfsum2!> (dex!>(getel1!> wo 2))
- (fndfpr!> (pma!> 2) (dfprod2!>
- (getel1!> wo 1)
- (getel1!> wo 2) )))) wr 2)
- ))
- % Riemann Tensor ...
- (de riemm!> nil
- (prog (w)
- (setq !#!R!I!M (mkt!> 4))
- (fordim!> wa do (fordim!> wb do
- (fordim!> wc do (fordim!> wd do (cond ((lessp wc wd)
- (setq w (vform1!> (getiframe!> wd)
- (vform!> (getiframe!> wc)
- (getel2!> !#!O!M!E!G!A wa wb))))
- (putel!> (evalalg!> w) !#!R!I!M (list wa wb wc wd))))))))))
- % Ricci Tensor ...
- (de ricci!> nil
- (prog (w)
- (setq !#!R!I!C (mkt!> 2))
- (fordim!> wa do (fordim!> wb do
- (cond
- ((and (null !*torsion) (null !*nonmetr) (greaterp wa wb)) nil)
- (t (progn
- (setq w nil)
- (fordim!> wx do
- (setq w (cons (getrim!> wx wa wx wb) w)))
- (putel!> (summa!> w) !#!R!I!C (list2 wa wb)))))))))
- % Scalar Curvature ...
- (de rscalar!> nil
- (prog (w)
- (fordim!> wa do (fordim!> wb do
- (setq w (cons (multa!> (getimetr!> wa wb)
- (cond ((or !*torsion !*nonmetr)
- (getel2!> !#!R!I!C wa wb))
- (t (getel2s!> !#!R!I!C wa wb))) )
- w))))
- (setq w (summa!> w))
- (setq !#!R!R (ncons w)) ))
- % Einstein Tensor ...
- (de gtensor!> nil
- (prog (w)
- (setq !#!G!T (mkt!> 2))
- (fordim!> wa do (fordim!> wb do
- (cond
- ((and (null !*torsion) (null !*nonmetr) (greaterp wa wb)) nil)
- (t (progn
- (setq w (list2 (getel2!> !#!R!I!C wa wb)
- (multa!> '(quotient -1 2)
- (multa!> (getmetr!> wa wb)
- (car !#!R!R)))))
- (putel!> (summa!> w) !#!G!T (list2 wa wb)))))))))
- %------- Curvature spinors -------------------------------------------------
- % local aux functions ...
- (de ousu!> (wa wb)
- (dualdi!> (dfprod2!> (getel1!> !#!O!M!E!G!A!U wa)
- (getel1!> !#!S!U wb))))
- (de ousd!> (wa wb)
- (dualdi!> (dfprod2!> (getel1!> !#!O!M!E!G!A!U wa)
- (getel1!> !#!S!D wb))))
- (de odsu!> (wa wb)
- (dualdi!> (dfprod2!> (getel1!> !#!O!M!E!G!A!D wa)
- (getel1!> !#!S!U wb))))
- (de odsd!> (wa wb)
- (dualdi!> (dfprod2!> (getel1!> !#!O!M!E!G!A!D wa)
- (getel1!> !#!S!D wb))))
- % Scalar curvature ...
- (de rrsp!> nil
- (prog (wr)
- (cond
- (!*torsion
- (setq wr (summa!> (list (ousu!> 2 0) (ousu!> 0 2)
- (multa!> -2 (ousu!> 1 1)))))
- (setq wr (evalalg!>
- (cond (!*torsion (multa!> 2 (list 'plus wr (coalg!> wr))))
- (t (multa!> 4 wr))))) )
- (t
- (setq wr (evalalg!> (multa!> 8 (list 'difference
- (ousu!> 0 2) (ousu!> 1 1))))) ))
- (setq !#!R!R (ncons wr))))
- % Scalar deviation ...
- (de rdsp!> nil
- (prog (wr)
- (setq wr (summa!> (list (ousu!> 2 0) (ousu!> 0 2)
- (multa!> -2 (ousu!> 1 1)))))
- (setq wr (evalalg!>
- (multa!> '(times -2 i) (list 'difference wr (coalg!> wr)))))
- (setq !#!R!D (ncons wr))))
- % Weyl spinor ...
- (de rwsp!> nil
- (progn
- (makebox!> '!#!R!W)
- (cond
- (!*torsion
- (putel1!> (evalalg!> (ousu!> 0 0)) !#!R!W 0)
- (putel1!> (evalalg!> (multa!> '(quotient 1 2)
- (list 'plus (ousu!> 0 1) (ousu!> 1 0)))) !#!R!W 1)
- (putel1!> (evalalg!> (list 'plus
- (multa!> '(quotient 1 6)
- (list 'plus (ousu!> 2 0) (ousu!> 0 2)))
- (multa!> '(quotient 2 3) (ousu!> 1 1)))) !#!R!W 2)
- (putel1!> (evalalg!> (multa!> '(quotient 1 2)
- (list 'plus (ousu!> 1 2) (ousu!> 2 1)))) !#!R!W 3)
- (putel1!> (evalalg!> (ousu!> 2 2)) !#!R!W 4) )
- (t
- (putel1!> (evalalg!> (ousu!> 0 0)) !#!R!W 0)
- (putel1!> (evalalg!> (ousu!> 0 1)) !#!R!W 1)
- (putel1!> (evalalg!> (list 'plus
- (multa!> '(quotient 1 3) (ousu!> 0 2))
- (multa!> '(quotient 2 3) (ousu!> 1 1)))) !#!R!W 2)
- (putel1!> (evalalg!> (ousu!> 1 2)) !#!R!W 3)
- (putel1!> (evalalg!> (ousu!> 2 2)) !#!R!W 4) ) )
- t))
- % Ricanti spinor ...
- (de rasp!> nil
- (progn
- (makebox!> '!#!R!A)
- (putel1!> (evalalg!> (multa!> (cond ((mppp!>) 1) (t -1))
- (list 'difference
- (ousu!> 1 0) (ousu!> 0 1)))) !#!R!A 0)
- (putel1!> (evalalg!> (multa!> (cond ((mppp!>) '(quotient 1 2))
- (t '(quotient -1 2)))
- (list 'difference
- (ousu!> 2 0) (ousu!> 0 2)))) !#!R!A 1)
- (putel1!> (evalalg!> (multa!> (cond ((mppp!>) 1) (t -1))
- (list 'difference
- (ousu!> 2 1) (ousu!> 1 2)))) !#!R!A 2)
- t))
- % Traceless ricci spinor ...
- (de rcsp!> nil
- (progn
- (makebox!> '!#!R!C)
- (for!> x (0 1 2) do (for!> y (0 1 2) do
- (cond ((leq x y)
- (putel!> (cond (!*torsion (evalalg!> (mpa!> (list 'difference
- (ousd!> x y) (odsu!> y x)))))
- (t (evalalg!> (mpa!> (multa!> 2 (ousd!> x y))))))
- !#!R!C (list2 x y))))))
- t))
- % Traceless deviation spinor ...
- (de rbsp!> nil
- (progn
- (makebox!> '!#!R!B)
- (for!> x (0 1 2) do (for!> y (0 1 2) do
- (cond ((leq x y)
- (putel!> (evalalg!> (mpa!> (multa!> 'i (list 'plus
- (ousd!> x y) (odsu!> y x)))))
- !#!R!B (list2 x y))))))
- t))
- %----- NP formalism via macro 10.96 ---------------------------------------
- (de psinp!> (w)
- (getel1!> !#!R!W w))
- (de phinp!> (wa wb)
- (prog (w)
- (setq w (cond ((leq wa wb) (getel2!> !#!R!C wa wb))
- (t (coalg!> (getel2!> !#!R!C wb wa)))))
- (return (cond (w (list 'times (pma!> '(quotient 1 2)) w))
- (t nil)))))
- (de alphanp!> nil (pma!>(spcoef!> 1 2)))
- (de betanp!> nil (pma!>(spcoef!> 1 3)))
- (de gammanp!> nil (pma!>(spcoef!> 1 0)))
- (de epsilonnp!> nil (pma!>(spcoef!> 1 1)))
- (de kappanp!> nil (pma!>(spcoef!> 0 1)))
- (de rhonp!> nil (pma!>(spcoef!> 0 2)))
- (de sigmanp!> nil (pma!>(spcoef!> 0 3)))
- (de taunp!> nil (pma!>(spcoef!> 0 0)))
- (de munp!> nil (pma!>(spcoef!> 2 3)))
- (de nunp!> nil (pma!>(spcoef!> 2 0)))
- (de lambdanp!> nil (pma!>(spcoef!> 2 2)))
- (de pinp!> nil (pma!>(spcoef!> 2 1)))
- (de dtop!> nil (getiframe!> 0))
- (de dddop!> nil (getiframe!> 1))
- (de duop!> nil (getiframe!> 3))
- (de ddop!> nil (getiframe!> 2))
- %----- Geosedics. 10.96 ---------------------------------------------------
- (de geodesics!> nil
- (prog (w)
- (setq !#!G!E!O!q (mkt!> 1))
- (fordim!> x do (progn
- (setq w (ncons (list 'df (getel1!> ![cord!] x) (car ![apar!]) 2)))
- (fordim!> y do (fordim!> z do
- (setq w (cons (list 'times (chr!> x y z)
- (list 'df (getel1!> ![cord!] y) (car ![apar!]))
- (list 'df (getel1!> ![cord!] z) (car ![apar!])))
- w))))
- (putel1!> (equation!> (evalalg!> (cons 'plus w)) nil) !#!G!E!O!q x)))))
- %----- Null Congruence. 10.96 ---------------------------------------------
- (de ncnq!> nil
- (prog (w)
- (setq w (evalalg!> (vprod!> (car !#!K!V) (car !#!K!V))))
- (setq !#!N!C!o (ncons(equation!> w nil)))
- (cond (w (msg!> 6700)))))
- % vec'w
- (de getncv!> (w)
- (vform1!> (car !#!K!V) (getframe!> w)))
- % vec.w
- (de getncvlo!> (w)
- (vform1!> (car !#!K!V) (getlo!> !#!T w)))
- % Riemann omega'a.b
- (de rimomega!> (wa wb)
- (cond ((or !*torsion !*nonmetr) (getel2!> !#!r!o!m!e!g!a wa wb))
- (t (getel2!> !#!o!m!e!g!a wa wb))))
- % Riemann omega'a.b.c
- (de rimomegac!> (wa wb wc)
- (vform1!> (getiframe!> wc) (rimomega!> wa wb)))
- (de ncgq!> nil
- (prog (w wc)
- (setq !#!G!C!o (mkt!> 1))
- (fordim!> x do (progn
- (setq w (ncons (vfun!> (car !#!K!V) (getncv!> x))))
- (fordim!> y do
- (setq w (cons (list 'times
- (vform1!> (car !#!K!V) (rimomega!> x y))
- (getncv!> y)) w)))
- (setq w (evalalg!> (cons 'plus w)))
- (cond (w (setq wc t)))
- (putel1!> (equation!> w nil) !#!G!C!o x)))
- (cond (wc (msg!> 6701)))))
- % D.a ( vec.b ) = D.a | vec.b - omega'm.b.a vec.m
- (de dcnc!> (wa wb)
- (prog (w)
- (setq w (ncons (vfun!> (getiframe!> wa) (getncvlo!> wb))))
- (fordim!> m do
- (setq w (cons (list 'times -1 (rimomegac!> m wb wa)
- (getncvlo!> m)) w)))
- (setq w (evalalg!> (cons 'plus w)))
- (return w)))
- % THETA
- (de nctheta!> nil
- (prog (w)
- (fordim!> x do (fordim!> y do
- (setq w (cons (list 'times '(quotient 1 2)
- (dcnc!> x y)
- (getimetr!> x y)) w))))
- (setq w (evalalg!> (cons 'plus w)))
- (setq !#!t!h!e!t!a!O (ncons w)) ))
- % omega^2
- (de ncomega!> nil
- (prog (w wa wb)
- (fordim!> x do (fordim!> y do
- (fordim!> p do (fordim!> q do (progn
- (setq wa (getimetr!> x p))
- (setq wb (getimetr!> y q))
- (cond ((and wa wb)
- (setq w (cons (list 'times '(quotient 1 4) wa wb (dcnc!> p q)
- (list 'difference (dcnc!> x y) (dcnc!> y x)))
- w)))))))))
- (setq w (evalalg!> (cons 'plus w)))
- (setq !#!o!m!e!g!a!S!Q!O (ncons w)) ))
- % sigma*~sigma
- (de ncsigma!> nil
- (prog (w wa wb)
- (fordim!> x do (fordim!> y do
- (fordim!> p do (fordim!> q do (progn
- (setq wa (getimetr!> x p))
- (setq wb (getimetr!> y q))
- (cond ((and wa wb)
- (setq w (cons (list 'times '(quotient 1 4) wa wb (dcnc!> p q)
- (list 'plus (dcnc!> x y) (dcnc!> y x)))
- w)))))))))
- (setq w (cons 'plus w))
- (setq w (list 'difference w (list 'expt (car !#!t!h!e!t!a!O) 2)))
- (setq w (evalalg!> w))
- (setq !#!s!i!g!m!a!S!Q!O (ncons w)) ))
- %----- Kinematics 10.96 ----------------------------------------------------
- % UV = UUP'a D.a
- (de uvfromuup!> nil
- (prog (w)
- (fordim!> x do
- (setq w (cons (fndfpr!> (getel1!> !#!U!U x) (getiframe!> x)) w)))
- (setq !#!U!V (ncons (evalform!> (dfsum!> w))))))
- % UUp'a = UV _| T'a
- (de uupfromuv!> nil
- (prog nil
- (setq !#!U!U (mkt!> 1))
- (fordim!> x do
- (putel1!> (evalalg!> (vform1!> (car !#!U!V) (getframe!> x)))
- !#!U!U x))
- ))
- (de uudefault!> nil
- (prog nil
- (setq !#!U!U (mkt!> 1))
- (putel1!> 1 !#!U!U 0)
- (msg!> 6805)
- ))
- % USQ = UUP'a UUP.a
- (de usquare!> nil
- (prog (w)
- (fordim!> x do
- (setq w (cons (list 'times (getel1!> !#!U!U x)
- (getloa!> !#!U!U x)) w)))
- (setq w (evalalg!> (cons 'plus w)))
- (cond ((null w) (setq ![er!] 6702) (return !!er!!))
- ((eqn (exprtype!> w) 2) (msg!> 9001)))
- (setq !#!U!S!Q (ncons w))))
- % PRO'a.b
- (de projector!> nil
- (prog (w)
- (setq !#!P!R (mkt!> 2))
- (cond ((null (car !#!U!S!Q)) (setq ![er!] 6702) (return !!er!!)))
- (setq w (list 'quotient 1 (car !#!U!S!Q)))
- (fordim!> a do (fordim!> b do
- (putel!> (evalalg!> (list 'difference (delta!> a b)
- (list 'times w (getel1!> !#!U!U a)
- (getloa!> !#!U!U b))))
- !#!P!R (list2 a b))))))
- (de dcuup!> (wa wb)
- (prog (w)
- (setq w (ncons (vfun!> (getiframe!> wa) (getel1!> !#!U!U wb))))
- (fordim!> wm do
- (setq w (cons (list 'times (getel1!> !#!U!U wm)
- (rimomegac!> wb wm wa)) w)))
- (return (cons 'plus w))))
- (de dcudown!> (wa wb)
- (prog (w)
- (setq w (ncons (vfun!> (getiframe!> wa) (getloa!> !#!U!U wb))))
- (fordim!> wm do
- (setq w (cons (list 'times -1 (getloa!> !#!U!U wm)
- (rimomegac!> wm wb wa)) w)))
- (return (cons 'plus w))))
- (de accelerat!> nil
- (prog (w)
- (setq !#!a!c!c!U (mkt!> 1))
- (fordim!> a do (progn
- (setq w nil)
- (fordim!> m do
- (setq w (cons (list 'times (getel1!> !#!U!U m)
- (dcuup!> m a)) w)))
- (putel1!> (evalalg!> (cons 'plus w)) !#!a!c!c!U a)))))
- (de utheta!> nil
- (prog (w)
- (fordim!> m do (setq w (cons (dcuup!> m m) w)))
- (setq !#!t!h!e!t!a!U (ncons (evalalg!> (cons 'plus w))))))
- (de uomega!> nil
- (prog (w)
- (setq !#!o!m!e!g!a!U (mkt!> 2))
- (fordim!> a do (fordim!> b do (cond ((lessp a b)
- (setq w nil)
- (fordim!> m do (fordim!> n do
- (setq w (cons (list 'times '(quotient 1 2)
- (getel2!> !#!P!R m a) (getel2!> !#!P!R n b)
- (list 'difference (dcudown!> m n)
- (dcudown!> n m))) w))))
- (putel!> (evalalg!> (cons 'plus w)) !#!o!m!e!g!a!U (list2 a b))))))))
- (de usigma!> nil
- (prog (w)
- (setq !#!s!i!g!m!a!U (mkt!> 2))
- (fordim!> a do (fordim!> b do (cond ((leq a b)
- (setq w (ncons (list 'times (list 'quotient -1 ![dim1!])
- (car !#!t!h!e!t!a!U)
- (getm!> '!#!P!R nil (list2 a b) '(2 nil)))))
- (fordim!> m do (fordim!> n do
- (setq w (cons (list 'times '(quotient 1 2)
- (getel2!> !#!P!R m a) (getel2!> !#!P!R n b)
- (list 'plus (dcudown!> m n)
- (dcudown!> n m))) w))))
- (putel!> (evalalg!> (cons 'plus w)) !#!s!i!g!m!a!U (list2 a b))))))))
- %------- Irreducible torsion components. 01.91 ---------------------------
- % Local aux functions ...
- (de qsu!> (wq wss)
- (dualdi!> (dfprod2!> (getel1!> !#!T!H!E!T!A wq) (getel1!> !#!S!U wss))))
- (de qsd!> (wq wss)
- (dualdi!> (dfprod2!> (getel1!> !#!T!H!E!T!A wq) (getel1!> !#!S!D wss))))
- % Tracelass torsion spinor ...
- (de qcfromth!> nil
- (progn
- (makebox!> '!#!Q!C)
- (putel!> (evalalg!> (list 'times 1 (qsu!> 0 0)))
- !#!Q!C (list 0 0))
- (putel!> (evalalg!> (list 'times 1 '(quotient -1 3)
- (list 'plus (qsu!> 3 0) (list 'times -2 (qsu!> 0 1)))))
- !#!Q!C (list 1 0))
- (putel!> (evalalg!> (list 'times 1 (qsu!> 1 2)))
- !#!Q!C (list 3 1))
- (putel!> (evalalg!> (list 'times 1 '(quotient 1 3)
- (list 'plus (qsu!> 0 2) (list 'times -2 (qsu!> 3 1)))))
- !#!Q!C (list 2 0))
- (putel!> (evalalg!> (list 'times -1 (qsu!> 3 2)))
- !#!Q!C (list 3 0))
- (putel!> (evalalg!> (list 'times 1 '(quotient 1 3)
- (list 'plus (qsu!> 1 0) (list 'times -2 (qsu!> 2 1)))))
- !#!Q!C (list 1 1))
- (putel!> (evalalg!> (list 'times -1 (qsu!> 2 0)))
- !#!Q!C (list 0 1))
- (putel!> (evalalg!> (list 'times 1 '(quotient -1 3)
- (list 'plus (qsu!> 2 2) (list 'times -2 (qsu!> 1 1)))))
- !#!Q!C (list 2 1))
- t))
- % Torsion trace vector with spinors ...
- (de qtfromthsp!> nil
- (progn
- (setq !#!Q!T (mkt!> 1))
- (putel1!> (evalalg!> (list 'times (car ![sgn!])
- (list 'plus (qsu!> 1 0) (qsu!> 2 1) (qsd!> 2 1) (qsd!> 0 2))))
- !#!Q!T 2)
- (putel1!> (evalalg!> (list 'times (car ![sgn!]) -1
- (list 'plus (qsu!> 3 1)(qsu!> 0 2)(qsd!> 1 0)(qsd!> 3 1))))
- !#!Q!T 3)
- (putel1!> (evalalg!> (list 'times (car ![sgn!]) -1
- (list 'plus
- (list 'times -1 (list 'plus (qsu!> 3 0) (qsu!> 0 1)))
- (qsd!> 2 0) (qsd!> 0 1))))
- !#!Q!T 0)
- (putel1!> (evalalg!> (list 'times (car ![sgn!]) -1
- (list 'plus
- (qsu!> 1 1) (qsu!> 2 2)
- (list 'times -1 (list 'plus (qsd!> 1 1) (qsd!> 3 2))))))
- !#!Q!T 1)
- t))
- % Torsion pseudotrace vector with spinors ...
- (de qpfromthsp!> nil
- (progn
- (setq !#!Q!P (mkt!> 1))
- (putel1!> (evalalg!> (list 'times (car ![sgn!]) 'i
- (list 'plus (qsu!> 3 0) (qsu!> 0 1) (qsd!> 2 0) (qsd!> 0 1))))
- !#!Q!P 0)
- (putel1!> (evalalg!>(list 'times (car ![sgn!]) '(minus i)
- (list 'plus (qsu!> 1 1) (qsu!> 2 2) (qsd!> 1 1) (qsd!> 3 2))))
- !#!Q!P 1)
- (putel1!> (evalalg!> (list 'times (car ![sgn!]) 'i
- (list 'plus (list 'times -1
- (list 'plus (qsu!> 3 1) (qsu!> 0 2)))
- (qsd!> 1 0) (qsd!> 3 1))))
- !#!Q!P 3)
- (putel1!> (evalalg!>(list 'times (car ![sgn!]) 'i
- (list 'plus (qsu!> 1 0) (qsu!> 2 1)
- (list 'times -1
- (list 'plus (qsd!> 2 1) (qsd!> 0 2))))))
- !#!Q!P 2)
- t))
- %---- Undotted torsion 2-forms. 12.91 ------------------------------------
- % wd - internal variable, fun - get function, wss - s-forms
- (de trfr!> (wd fun wss)
- (prog (w wc)
- (set wd (mkt!> 1))
- (setq wd (eval wd))
- (for!> a (0 1 3) do (progn
- (setq w nil)
- (for!> b (0 1 2) do
- (setq w (cons (fndfpr!> (list 'times (cond ((eqn b 1) -2) (t 1))
- (apply fun (list a b)))
- (getel1!> (eval wss) (si!> b))) w)) )
- (cond (w (putel1!> (evalform!> (dfsum!> w)) wd a)))))
- (return t)))
- % local aux function ...
- (de si!> (w)
- (cond ((eqn w 1) 1)
- ((eqn w 2) 0)
- ((eqn w 0) 2)))
- % Get Traceless Torsion spinor ...
- (de gcf!> (wa wb)
- (cond
- ((and (eqn wa 0) (eqn wb 0)) (getel2!> !#!Q!C 0 0))
- ((and (eqn wa 0) (eqn wb 1)) (getel2!> !#!Q!C 1 0))
- ((and (eqn wa 0) (eqn wb 2)) (getel2!> !#!Q!C 2 0))
- ((and (eqn wa 1) (eqn wb 0)) (getel2!> !#!Q!C 1 1))
- ((and (eqn wa 1) (eqn wb 1)) (getel2!> !#!Q!C 2 1))
- ((and (eqn wa 1) (eqn wb 2)) (getel2!> !#!Q!C 3 1))
- ((and (eqn wa 2) (eqn wb 0)) (list 'times -1 (getel2!> !#!Q!C 0 1)))
- ((and (eqn wa 2) (eqn wb 1)) (list 'times -1 (getel2!> !#!Q!C 1 1)))
- ((and (eqn wa 2) (eqn wb 2)) (list 'times -1 (getel2!> !#!Q!C 2 1)))
- ((and (eqn wa 3) (eqn wb 0)) (list 'times -1 (getel2!> !#!Q!C 1 0)))
- ((and (eqn wa 3) (eqn wb 1)) (list 'times -1 (getel2!> !#!Q!C 2 0)))
- ((and (eqn wa 3) (eqn wb 2)) (list 'times -1 (getel2!> !#!Q!C 3 0))) ))
- % Get Torsion Trace spinor ...
- (de gqf!> (wa wb)
- (gqpf!> wa wb (car ![sgn!]) !#!Q!T))
- % Get Torsion Pseudotrace spinor ...
- (de gpf!> (wa wb)
- (gqpf!> wa wb (cond ((mppp!>) 'i) (t '(minus i))) !#!Q!P))
- (de gqpf!> (wa wb w lst)
- (cond
- ((and (eqn wa 0) (eqn wb 1))
- (list 'times (mkq!> w 6 nil) (getel1!> lst 0)))
- ((and (eqn wa 0) (eqn wb 2))
- (list 'times (mkq!> w 3 t) (getel1!> lst 3)))
- ((and (eqn wa 3) (eqn wb 0))
- (list 'times (mkq!> w 3 nil) (getel1!> lst 0)))
- ((and (eqn wa 3) (eqn wb 1))
- (list 'times (mkq!> w 6 t) (getel1!> lst 3)))
- ((and(eqn wa 2) (eqn wb 1))
- (list 'times (mkq!> w 6 nil) (getel1!> lst 2)))
- ((and (eqn wa 2) (eqn wb 2))
- (list 'times (mkq!> w 3 t) (getel1!> lst 1)))
- ((and (eqn wa 1) (eqn wb 0))
- (list 'times (mkq!> w 3 nil) (getel1!> lst 2)))
- ((and (eqn wa 1) (eqn wb 1))
- (list 'times (mkq!> w 6 t) (getel1!> lst 1))) ))
- (de mkq!> (wd wn wb)
- (list 'quotient (cond (wb (list 'minus wd)) (t wd)) wn))
- (de qtfromqq!> nil
- (prog nil
- (makebox!> '!#!Q!T)
- (fordim!> a do
- (putel1!> (evalalg!> (vform1!> (getup!> !#!D a) (car !#!Q!Q)))
- !#!Q!T a))))
- (de qpfromqqa!> nil
- (prog (w)
- (makebox!> '!#!Q!P)
- (setq w (dual!> (car !#!Q!Q!A)))
- (fordim!> a do
- (putel1!> (evalalg!> (vform1!> (getup!> !#!D a) w))
- !#!Q!P a))))
- %------- Undotted Curvature 2-forms. 01.91 --------------------------------
- % wd - internal variable, fun - get function, wss - s-forms
- (de crfr!> (wd fun wss)
- (prog (w)
- (set wd (mkspace!> '((n . 2))))
- (for!> a (0 1 2) do (progn
- (setq w nil)
- (for!> b (0 1 2) do
- (setq w(cons(fndfpr!>(list 'times
- (cond((eqn b 1) '(minus 2))(t 1))
- (apply fun (list a b)))
- (getel1!> (eval wss) (si!> b)))w)) )
- (cond(w(putel1!>(evalform!>(dfsum!> w)) (eval wd) a)))))
- (return t)))
- % Get Wayl spinor ...
- (de gwf!> (wa wb)
- (getel1!> !#!R!W (plus wa wb)))
- % Get Traceless Ricci spinor ...
- (de gtf!> (wa wb)
- (list 'times (cond ((pmmm!>) '(quotient -1 2))
- (t '(quotient 1 2)))
- (getel2h!> !#!R!C wa wb)))
- % Get Traceless Deviation spinor ...
- (de gbf!> (wa wb)
- (list 'times (cond ((pmmm!>) '(quotient i 2))
- (t '(quotient (minus i) 2)))
- (getel2h!> !#!R!B wa wb)))
- % Get Scalar Curvature spinor ...
- (de gsf!> (wa wb)
- (cond((or(and(eqn wa 0)(eqn wb 2))(and(eqn wa 2)(eqn wb 0)))
- (list 'times '(quotient 1 12) (car !#!R!R)))
- ((and(eqn wa 1)(eqn wb 1))
- (list 'times '(quotient (minus 1) 24)(car !#!R!R)))
- (t nil)))
- % Get Scalar Deviation spinor ...
- (de gdf!> (wa wb)
- (cond((or(and(eqn wa 0)(eqn wb 2))(and(eqn wa 2)(eqn wb 0)))
- (list 'times '(quotient i 12)(car !#!R!D)))
- ((and(eqn wa 1)(eqn wb 1))
- (list 'times '(quotient (minus i) 24)(car !#!R!D)))
- (t nil)))
- % Get Antisymmetric Ricci spinor ...
- (de gaf!> (wa wb)
- (cond((and(eqn wa 0)(eqn wb 1))
- (list 'times (sgnm!>) '(quotient -1 2) (getel1!> !#!R!A 0)))
- ((and(eqn wa 0)(eqn wb 2))
- (list 'times (sgnm!>) -1 (getel1!> !#!R!A 1)))
- ((and(eqn wa 1)(eqn wb 0))
- (list 'times (sgnm!>) '(quotient 1 2) (getel1!> !#!R!A 0)))
- ((and(eqn wa 1)(eqn wb 2))
- (list 'times (sgnm!>) '(quotient -1 2)(getel1!> !#!R!A 2)))
- ((and(eqn wa 2)(eqn wb 0))
- (list 'times (sgnm!>) (getel1!> !#!R!A 1)))
- ((and(eqn wa 2)(eqn wb 1))
- (list 'times (sgnm!>) '(quotient 1 2) (getel1!> !#!R!A 2)))
- (t nil)))
- % Signature ...
- (de sgnm!> nil
- (cond ((pmmm!>) -1) (t 1)))
- %=========== End of GRGgeom.sl ============================================%
|