Comment: | Initial checkin: GRG 3.2 Release 6 (July 16, 2000) |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | descendants | trunk |
Files: | files | file ages | folders |
SHA3-256: |
96e7dce1263efdde8345bf0da312acf2 |
User & Date: | jeff@gridfinity.com on 2021-03-01 03:28:28 |
Other Links: | manifest | tags |
2021-03-01
| ||
03:32:17 | multi: Configure GitHub-specific applications. Leaf check-in: 80978e6653 user: jeff@gridfinity.com tags: 3.2.6, trunk | |
03:28:28 | Initial checkin: GRG 3.2 Release 6 (July 16, 2000) check-in: 96e7dce126 user: jeff@gridfinity.com tags: trunk | |
Added LICENSE version [0b284345bd].
> > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 | The system with source code and documentation is distributed in the hope that it will be useful but without any warranty. You may modify it for personal use, but you are not allowed to remove author's name and/or to distribute modified files. Vadim V. Zhytnikov Physics Department, Faculty of Mathematics, Moscow State Pedagogical University, Davydovskii per. 4, Moscow 107140, Russia Tel(home): (095) 188-16-11 E-mail: vvzhy@mail.ru vvzhy@td.lpi.ac.ru |
Added README.md version [5357b02906].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | # GRG ## Computer Algebra System for Differential Geometry, Gravitation and Field Theory The computer algebra system GRG is designed to make calculation in differential geometry and field theory as simple and natural as possible. GRG is based on the computer algebra system REDUCE but GRG has its own simple input language whose commands resemble short English phrases. GRG understands tensors, spinors, vectors, differential forms and knows all standard operations with these quantities. Input form for mathematical expressions is very close to traditional mathematical notation including Einstein summation rule. GRG knows covariant properties of the objects: one can easily raise and lower indices, compute covariant and Lie derivatives, perform coordinate and frame transformations etc. GRG works in any dimension and allows one to represent tensor quantities with respect to holonomic, orthogonal and even any other arbitrary frame. One of the key features of GRG is that it knows a large number of built-in usual field-theoretical and geometrical quantities and formulas for their computation providing ready solutions to many standard problems. Another unique feature of GRG is that it can export results of calculations into other computer algebra system such as Maple, Mathematica, Macsyma or REDUCE in order to use these systems to proceed with analysis of the data. The LaTeX output format is supported as well. GRG is compatible with the REDUCE graphics shells providing nice book-quality output with Greek letters, integral signs etc. The main built-in GRG capabilities are: - Connection, torsion and nonmetricity. - Curvature. - Spinorial formalism. - Irreducible decomposition of the curvature, torsion, and nonmetricity in any dimension. - Einstein equations. - Scalar field with minimal and non-minimal interaction. - Electromagnetic field. - Yang-Mills field. - Dirac spinor field. - Geodesic equation. - Null congruences and optical scalars. - Kinematics for time-like congruences. - Ideal and spin fluid. - Newman-Penrose formalism. - Gravitational equations for the theory with arbitrary gravitational Lagrangian in Riemann and Riemann-Cartan spaces. The detailed documentation including complete manual and short reference guide is provided. GRG is free of charge. The address for correspondence: ```text Vadim V. Zhytnikov Physics Department, Faculty of Mathematics, Moscow State Pedagogical University, Davydovskii per. 4, Moscow 107140, Russia Telephone (Home): (095) 188-16-11 E-mail: vvzhy@td.lpi.ac.ru E-mail: grg@curie.phy.ncu.edu.tw Subject: for Zhytnikov ``` |
Added bondi.low version [14b08171f1].
> > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | Output "bondi.out"; Zero Time; Comment: Bondi metric; Coordinates u,r,theta,phi; Functions Beta(u,r,theta),V(u,r,theta),U(u,r,theta),Gamma(u,r,theta); Null Metric; Frame T0 = e^Beta*d u, T1 = e^Beta*(d r + (V/r)*d u), T2 = r*(-U*e^Gamma*d u+e^Gamma*d theta +i*sin(theta)*e^(-Gamma)*d phi)/sqrt(2), T3 = r*(-U*e^Gamma*d u+e^Gamma*d theta -i*sin(theta)*e^(-Gamma)*d phi)/sqrt(2); Off WRS; Find and Write Curvature Spinors; Time; Quit; |
Added bondi.up version [c12608a585].
> > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | Output "bondi.out"; Zero Time; Comment: Bondi metric; Coordinates u,r,theta,phi; Functions Beta(u,r,theta),V(u,r,theta),U(u,r,theta),Gamma(u,r,theta); Null Metric; Frame T0 = E^Beta*d u, T1 = E^Beta*(d r + (V/r)*d u), T2 = r*(-U*E^Gamma*d u+E^Gamma*d theta +I*SIN(theta)*E^(-Gamma)*d phi)/SQRT(2), T3 = r*(-U*E^Gamma*d u+E^Gamma*d theta -I*SIN(theta)*E^(-Gamma)*d phi)/SQRT(2); Off WRS; Find and Write Curvature Spinors; Time; Quit; |
Added compare.txt version [62cf5117c5].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | This file is part of GRG 3.2 Copyright (C) 1997 Vadim V. Zhytnikov Disclaimer: The opinion expressed here is the opinion of V.Zhytnikov and nobody else. GRG 3.2 versus EXCALC The GRG 3.2 and EXCALC are two rather similar programs. Both are based on the computer algebra system REDUCE and designed for the problems in differential geometry. They work with the differential forms, vectors, tensors and use convenient notation very similar to the traditional mathematical one. Both programs work with spaces of any dimensionality and can represent tensors with respect to arbitrary frame. On the other hand there are also a number of important differences between EXCALC and GRG 3.2. In particular: 1. EXCALC works with tensors whose components are presented with respect to certain frame. GRG 3.2 understands more complicate quantities having coordinate, frame, spinorial and enumerating indices. GRG 3.2 understands also pseudo-tensors and tensor densities. I'd like to emphasize also GRG's ability to work with spinors. 2. Working with tensors EXCALC actually knows very little about the "covariant" properties of these quantities. On the other hand GRG knows all standard covariant operations and operators. In particular GRG 3.2 performs frame, spinor and coordinate transformations. It automatically computes Lie derivatives, covariant derivatives and differentials of any tensor or spinor quantity. GRG can easily transform the frame indices to coordinate ones and vice versa. 3. GRG 3.2 allows one to save the result of computations in the form which can be later used in other computer algebra programs: Mathematica, Maple and Macsyma. 4. Unlike EXCALC the GRG 3.2 knows almost 150 built-in quantities and numerous built-in formulas for their calculation. So, in GRG you have already solutions for many standard problems. On the contrary to obtain any result with EXCALC it is necessary to write your own program. 5. GRG requires all variables and functions to be declared which makes it more reliable than EXCALC. 6. The input languages of GRG and EXCALC are very different. EXCALC in fact has no any special language and uses the REDUCE programming language with all control instructions: loops, if-then-else, procedures etc. GRG uses the completely different approach. It has its own quite simple language which lacks the aforementioned programming facilities. Commands of GRG input language resemble simple English phrases. This is especially convenient for people who are not interested (or skillful) in programming. 7. The performance of both programs (say the run time for analogous problems) is approximately equal. 8. The advantage of EXCALC is that it can operate with abstract p-forms while in GRG any p-form is always represented as the exterior product of p frame 1-forms (frame may be arbitrary). 9. Another potential advantage of EXCALC is the ability to compute the variational derivatives. Unfortunately in practice this facility is rather limited and buggy. ---------------------------------------------------------------------- |
Added compile.csl version [fe47820608].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 | off echo$ %==========================================================================% % GRG 3.2 Compilation [CSL] (C) 1988-97 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. % %==========================================================================% << prin2 "Compiling GRG 3.2, wait few minutes."; terpri() >>$ out "grgcomp.log"$ in "expand.csl"$ lisp$ off lower$ off raise$ rdf "xdecl.sl"$ load!_package compiler$ faslout "grgdecl" $ rdf "xdecl.sl" $ faslend$ faslout "grggeom" $ rdf "xgeom.sl" $ faslend$ faslout "grggrav" $ rdf "xgrav.sl" $ faslend$ faslout "grginit" $ rdf "xinit.sl" $ faslend$ faslout "grgclass"$ rdf "xclass.sl"$ faslend$ faslout "grgcomm" $ rdf "xcomm.sl" $ faslend$ faslout "grgcoper"$ rdf "xcoper.sl"$ faslend$ faslout "grgmain" $ rdf "xmain.sl" $ faslend$ faslout "grgmater"$ rdf "xmater.sl"$ faslend$ faslout "grgprin" $ rdf "xprin.sl" $ faslend$ faslout "grgproc" $ rdf "xproc.sl" $ faslend$ faslout "grgtrans"$ rdf "xtrans.sl"$ faslend$ faslout "grgcfg" $ rdf "grgcfg.sl"$ faslend$ faslout "grg32" $ rdf "grg32.sl" $ faslend$ faslout "grg" $ rdf "grg.sl" $ faslend$ shut "grgcomp.log"$ << terpri(); prin2 "GRG has been compiled."; terpri(); >>$ bye$ end; %==========================================================================% |
Added compile.grg version [04c9b66563].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 | off echo$ % This file is the part of GRG 3.2 (C) 1997 V.V.Zhytnikov lisp$ begin psl := getd 'dskin; low := getd '!c!a!r; if psl then lis := "PSL" else lis:= "CSL"; if low then cas := "Lower" else cas := "Upper"; prin2 "This REDUCE is based on "; prin2 lis; prin2 " and is "; prin2 cas; prin2 "-Cased."; terpri(); if low then << prin2 "Use lower-case symbols for built-in constants and functions:"; terpri(); prin2 " e i pi sin cos log ..."; >> else << prin2 "Use upper-case symbols for built-in constants and functions:"; terpri(); prin2 " E I PI SIN COS LOG ..."; >>; terpri(); terpri(); compok := errorset('(evload (quote(compiler))),nil,nil); if atom compok then << prin2 "Compiler is absent! Sorry, GRG cannot be installed. "; terpri(); terpri(); bye; >> else << %prin2 "Compiler is present. I'm about to compile GRG ..."; %if psl then << % prin2 "To install GRG use command:"; % terpri(); % prin2 " in ""compile.psl"";"; >> %else << % prin2 "To install GRG use command:"; % terpri(); % prin2 " in ""compile.csl"";"; >>; %terpri(); %pause; >>; end$ if psl then in "compile.psl" else in "compile.csl"$ quit$ end; |
Added compile.psl version [040c154d74].
> > > > | 1 2 3 4 | lisp$ off echo$ dskin "grgcomp.sl"$ end; |
Added dos/addz.exe version [4dc2030764].
cannot compute difference between binary files
Added dos/cutz.exe version [91d2c6e892].
cannot compute difference between binary files
Added dos/dtou.exe version [61cbdbf10b].
cannot compute difference between binary files
Added dos/utod.exe version [d18d54d022].
cannot compute difference between binary files
Added expand.csl version [a50b5e51e2].
> > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | % This file is the part of GRG 3.2 (C) 1997 V.V. Zhytnikov lisp$ off echo$ rdf "grgxmacr.sl"$ %off lower$ expand!-file!>( "grgdecl.sl" , "xdecl.sl" )$ expand!-file!>( "grggeom.sl" , "xgeom.sl" )$ expand!-file!>( "grggrav.sl" , "xgrav.sl" )$ expand!-file!>( "grginit.sl" , "xinit.sl" )$ expand!-file!>( "grgclass.sl" , "xclass.sl" )$ expand!-file!>( "grgcomm.sl" , "xcomm.sl" )$ expand!-file!>( "grgcoper.sl" , "xcoper.sl" )$ expand!-file!>( "grgmain.sl" , "xmain.sl" )$ expand!-file!>( "grgmater.sl" , "xmater.sl" )$ expand!-file!>( "grgprin.sl" , "xprin.sl" )$ expand!-file!>( "grgproc.sl" , "xproc.sl" )$ expand!-file!>( "grgtrans.sl" , "xtrans.sl" )$ on lower$ terpri()$ prin2 "### Expansion done."$ terpri()$ %quit$ end; |
Added expand.psl version [3ecfb80a86].
> > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | % This file is the part of GRG 3.2 (C) 1997 V.V. Zhytnikov lisp$ off echo$ dskin "grgxmacr.sl"$ off lower$ expand!-file!>( "grgdecl.sl" , "xdecl.sl" )$ expand!-file!>( "grggeom.sl" , "xgeom.sl" )$ expand!-file!>( "grggrav.sl" , "xgrav.sl" )$ expand!-file!>( "grginit.sl" , "xinit.sl" )$ expand!-file!>( "grgclass.sl" , "xclass.sl" )$ expand!-file!>( "grgcomm.sl" , "xcomm.sl" )$ expand!-file!>( "grgcoper.sl" , "xcoper.sl" )$ expand!-file!>( "grgmain.sl" , "xmain.sl" )$ expand!-file!>( "grgmater.sl" , "xmater.sl" )$ expand!-file!>( "grgprin.sl" , "xprin.sl" )$ expand!-file!>( "grgproc.sl" , "xproc.sl" )$ expand!-file!>( "grgtrans.sl" , "xtrans.sl" )$ on lower$ prin2 "### All done."$ terpri()$ quit$ end; |
Added grg.cfg version [c0c628437e].
> > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | %==========================================================================% % GRG 3.2 Local Configuration File (C) 1988-96 Vadim V. Zhytnikov % %==========================================================================% % Default Dimensionality and Signature: %(signature!> - + + + ) % Changing the default on/off switch position: %(on!> page) % Pre-loading the packages: %(package!> specfn) % Newer remove the following line! nil %======= End of grg.cfg ===================================================% |
Added grg.sl version [8a101c9894].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | %==========================================================================% % GRG 3.2 Startup File (C) 1988-2000 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. % %==========================================================================% (global '(![version!])) (setq ![version!] "This is GRG 3.2 release 6 (July 16, 2000) ..." ) % Loading modules ... (evload '( grgdecl grggeom grggrav grginit grgclass grgcomm grgcoper grgmain grgmater grgprin grgproc grgtrans grgcfg )) (matrix nil) % Starting GRG ... (cond (![autostart!] (grg)) (t(progn (terpri) (prin2 "Type ``grg;'' to start GRG ...") (terpri)))) %==========================================================================% |
Added grg2tex.red version [7b4bb3114c].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 | % To convert GRG log file "filein" into LaTeX file "fileout.tex" execute: % % grg2tex("filein","fileout.tex"); % % This code is actually logutil.red with infinitesemal changes. % All credits to Herbert Melenk. module grg2tex; % Author: Herbert Melenk <melenk@sc.zib-berlin.de>. % log_latex(<infile>,<outfile>); % % Transform a REDUCE log file <infile> from XR or Windows with % output in type setting style to a LATEX source file <outfile>. fluid '(texstate!* char!-texon!* char!-texoff!* char!-null!* old!-line!* ); char!-texon!* := '!$ $ %===ZW=== char!-texoff!* := '!$ $ %===ZW=== char!-null!* := int2id 0$ symbolic procedure grg2tex(din,dout); %===ZW=== begin scalar fin,fout,oldfin,oldfout,w; fin:=open(din,'input); fout:=open(dout,'output); oldfin:=rds fin; oldfout:=wrs fout; w:=errorset('(log2latex1),t,t) where !*lower=nil,!*raise=nil; wrs oldfout; rds oldfin; close fout; close fin; end; symbolic operator grg2tex; %===ZW=== fluid '(l2xprologue!* l2xepilogue!*); l2xprologue!* :='( "\documentstyle{article}" "\setlength{\parindent}{0cm}" "\sloppy" "\begin{document}" ); l2xepilogue!* :='( "\end{document}" ); symbolic procedure log2latex1(); begin scalar texstate!*,l,w,c; integer n; old!-line!*:=nil; for each l in l2xprologue!* do prin2t l; a: l:=read!-line(); if car l = !$eof!$ then goto done; if car l = 'tex then << l:=transform2tex cdr l; mathon(); c:=nil; n:=0; for each x in l do <<n:=n+1; if n>60 and x='!\ and c neq '!\ then <<terpri(); n:=0>>; prin2 x; c:=x; >>; mathoff(); >> else <<texton(); for each x in cdr l do prin2 x; terpri(); >>; goto a; done: if texstate!*=0 then textoff() else if texstate!*=1 then mathoff(); for each l in l2xepilogue!* do prin2t l; end; symbolic procedure transform2tex ll; begin scalar w,l; % l2xspace!*:=0; l := ll; while l do << if (w:=l2xmatch(l,'(!\ !>))) then l2xsymbtab(l,w) else if (w:=l2xmatch(l,'(!\ !s !y !m !b !{))) then l2xsymb(l,w) else if (w:=l2xmatch(l,'(!\ s y m b !{))) then l2xsymb(l,w); l:=cdr l; >>; return ll; end; symbolic procedure l2xmatch(s,p); if null p then s else if null s then nil else if car s eq car p then l2xmatch(cdr s,cdr p) else nil; symbolic procedure l2xsymbtab(l,w); <<w:=append(explode2 " ",cddr l); %===ZW=== car l:=car w; cdr l:=cdr w; l>>; fluid '(tex!-symbols!*); tex!-symbols!* := '(( 182 . "\partial") ( 198 . "\emptyset") ( 216 . "\neg") ( 163 . "\leq") ( 179 . "\geq") ( 185 . "\not=") ( 199 . "\bigcap") ( 200 . "\bigcup") ( 206 . "\in") ( 217 . "\bigwedge") ( 218 . "\bigvee") ( 239 . "\vert") ( 124 . "\vert") ( 222 . "\Rightarrow") ( 34 . "\forall") ( 71 . "\Gamma") ( 226 . "\dag") % shoud have been (R) ( 227 . "\copyright") ( 32 . "\quad") ); symbolic procedure l2xsymb(l1,l2); % convert \symb{nnn} to tex symbol. begin scalar w;integer n; while digit car l2 do <<n:=n*10 + id2int car l2 - id2int '!0; l2 := cdr l2 >>; w := assoc(n,tex!-symbols!*); if null w then rederr {"symbol not konw:",n}; l2 := append (explode2 cdr w,'! .cdr l2); car l1 := car l2; cdr l1 := cdr l2; end; symbolic procedure read!-line(); begin scalar w,l; l:=read!-line0(); if car l=!$eof!$ then return l; if car l = char!-texon!* then return begin l:=cdr l; a: w:=member(char!-texoff!*,l) or member(!$eof!$,l); if w then <<old!-line!*:=cdr w; car w:= '! ; cdr w:=nil; return 'tex . l>>; l:=append(l,read!-line0()); go to a; end; w:=member(char!-texon!*,l); if w then <<old!-line!* := car w . cdr w; car w:= '! >>; return nil.l; end; symbolic procedure read!-line0(); begin scalar w,c; if old!-line!* then <<w:=old!-line!*; old!-line!*:=nil; return w>>; while not ((c:=readch())=!$eol!$) and not(c=!$eof!$) do if id2int c > 3 then w:=c.w; % for ctrlA, ctrl B if c=!$eof!$ then return {c}; w:=reversip w; return w or read!-line0(); end; symbolic procedure mathon(); << textoff(); prin2 "$"; texstate!* :=1; >>; symbolic procedure mathoff(); << if texstate!*=1 then prin2t "$\\"; texstate!* :=nil>>; symbolic procedure texton(); if not(texstate!*=0) then <<mathoff(); prin2t "\begin{verbatim}"; texstate!* := 0>>; symbolic procedure textoff(); if texstate!*=0 then <<prin2t "\end{verbatim}"; texstate!*:=nil>>; endmodule; end; |
Added grg32.sl version [52133a87cb].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | %==========================================================================% % GRG 3.2 Startup File (C) 1988-2000 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. % %==========================================================================% (global '(![version!])) (setq ![version!] "This is GRG 3.2 release 6 (July 16, 2000) ..." ) % Loading modules ... (evload '( grgdecl grggeom grggrav grginit grgclass grgcomm grgcoper grgmain grgmater grgprin grgproc grgtrans grgcfg )) (matrix nil) (progn (terpri) (prin2 "Type ``grg;'' to start GRG ...") (terpri)) %==========================================================================% |
Added grg32.tex version [b22c15a345].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030 5031 5032 5033 5034 5035 5036 5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 5119 5120 5121 5122 5123 5124 5125 5126 5127 5128 5129 5130 5131 5132 5133 5134 5135 5136 5137 5138 5139 5140 5141 5142 5143 5144 5145 5146 5147 5148 5149 5150 5151 5152 5153 5154 5155 5156 5157 5158 5159 5160 5161 5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 5213 5214 5215 5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 5251 5252 5253 5254 5255 5256 5257 5258 5259 5260 5261 5262 5263 5264 5265 5266 5267 5268 5269 5270 5271 5272 5273 5274 5275 5276 5277 5278 5279 5280 5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 5458 5459 5460 5461 5462 5463 5464 5465 5466 5467 5468 5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 5485 5486 5487 5488 5489 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 5505 5506 5507 5508 5509 5510 5511 5512 5513 5514 5515 5516 5517 5518 5519 5520 5521 5522 5523 5524 5525 5526 5527 5528 5529 5530 5531 5532 5533 5534 5535 5536 5537 5538 5539 5540 5541 5542 5543 5544 5545 5546 5547 5548 5549 5550 5551 5552 5553 5554 5555 5556 5557 5558 5559 5560 5561 5562 5563 5564 5565 5566 5567 5568 5569 5570 5571 5572 5573 5574 5575 5576 5577 5578 5579 5580 5581 5582 5583 5584 5585 5586 5587 5588 5589 5590 5591 5592 5593 5594 5595 5596 5597 5598 5599 5600 5601 5602 5603 5604 5605 5606 5607 5608 5609 5610 5611 5612 5613 5614 5615 5616 5617 5618 5619 5620 5621 5622 5623 5624 5625 5626 5627 5628 5629 5630 5631 5632 5633 5634 5635 5636 5637 5638 5639 5640 5641 5642 5643 5644 5645 5646 5647 5648 5649 5650 5651 5652 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662 5663 5664 5665 5666 5667 5668 5669 5670 5671 5672 5673 5674 5675 5676 5677 5678 5679 5680 5681 5682 5683 5684 5685 5686 5687 5688 5689 5690 5691 5692 5693 5694 5695 5696 5697 5698 5699 5700 5701 5702 5703 5704 5705 5706 5707 5708 5709 5710 5711 5712 5713 5714 5715 5716 5717 5718 5719 5720 5721 5722 5723 5724 5725 5726 5727 5728 5729 5730 5731 5732 5733 5734 5735 5736 5737 5738 5739 5740 5741 5742 5743 5744 5745 5746 5747 5748 5749 5750 5751 5752 5753 5754 5755 5756 5757 5758 5759 5760 5761 5762 5763 5764 5765 5766 5767 5768 5769 5770 5771 5772 5773 5774 5775 5776 5777 5778 5779 5780 5781 5782 5783 5784 5785 5786 5787 5788 5789 5790 5791 5792 5793 5794 5795 5796 5797 5798 5799 5800 5801 5802 5803 5804 5805 5806 5807 5808 5809 5810 5811 5812 5813 5814 5815 5816 5817 5818 5819 5820 5821 5822 5823 5824 5825 5826 5827 5828 5829 5830 5831 5832 5833 5834 5835 5836 5837 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 5863 5864 5865 5866 5867 5868 5869 5870 5871 5872 5873 5874 5875 5876 5877 5878 5879 5880 5881 5882 5883 5884 5885 5886 5887 5888 5889 5890 5891 5892 5893 5894 5895 5896 5897 5898 5899 5900 5901 5902 5903 5904 5905 5906 5907 5908 5909 5910 5911 5912 5913 5914 5915 5916 5917 5918 5919 5920 5921 5922 5923 5924 5925 5926 5927 5928 5929 5930 5931 5932 5933 5934 5935 5936 5937 5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 5950 5951 5952 5953 5954 5955 5956 5957 5958 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 5971 5972 5973 5974 5975 5976 5977 5978 5979 5980 5981 5982 5983 5984 5985 5986 5987 5988 5989 5990 5991 5992 5993 5994 5995 5996 5997 5998 5999 6000 6001 6002 6003 6004 6005 6006 6007 6008 6009 6010 6011 6012 6013 6014 6015 6016 6017 6018 6019 6020 6021 6022 6023 6024 6025 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036 6037 6038 6039 6040 6041 6042 6043 6044 6045 6046 6047 6048 6049 6050 6051 6052 6053 6054 6055 6056 6057 6058 6059 6060 6061 6062 6063 6064 6065 6066 6067 6068 6069 6070 6071 6072 6073 6074 6075 6076 6077 6078 6079 6080 6081 6082 6083 6084 6085 6086 6087 6088 6089 6090 6091 6092 6093 6094 6095 6096 6097 6098 6099 6100 6101 6102 6103 6104 6105 6106 6107 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 6118 6119 6120 6121 6122 6123 6124 6125 6126 6127 6128 6129 6130 6131 6132 6133 6134 6135 6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 6160 6161 6162 6163 6164 6165 6166 6167 6168 6169 6170 6171 6172 6173 6174 6175 6176 6177 6178 6179 6180 6181 6182 6183 6184 6185 6186 6187 6188 6189 6190 6191 6192 6193 6194 6195 6196 6197 6198 6199 6200 6201 6202 6203 6204 6205 6206 6207 6208 6209 6210 6211 6212 6213 6214 6215 6216 6217 6218 6219 6220 6221 6222 6223 6224 6225 6226 6227 6228 6229 6230 6231 6232 6233 6234 6235 6236 6237 6238 6239 6240 6241 6242 6243 6244 6245 6246 6247 6248 6249 6250 6251 6252 6253 6254 6255 6256 6257 6258 6259 6260 6261 6262 6263 6264 6265 6266 6267 6268 6269 6270 6271 6272 6273 6274 6275 6276 6277 6278 6279 6280 6281 6282 6283 6284 6285 6286 6287 6288 6289 6290 6291 6292 6293 6294 6295 6296 6297 6298 6299 6300 6301 6302 6303 6304 6305 6306 6307 6308 6309 6310 6311 6312 6313 6314 6315 6316 6317 6318 6319 6320 6321 6322 6323 6324 6325 6326 6327 6328 6329 6330 6331 6332 6333 6334 6335 6336 6337 6338 6339 6340 6341 6342 6343 6344 6345 6346 6347 6348 6349 6350 6351 6352 6353 6354 6355 6356 6357 6358 6359 6360 6361 6362 6363 6364 6365 6366 6367 6368 6369 6370 6371 6372 6373 6374 6375 6376 6377 6378 6379 6380 6381 6382 6383 6384 6385 6386 6387 6388 6389 6390 6391 6392 6393 6394 6395 6396 6397 6398 6399 6400 6401 6402 6403 6404 6405 6406 6407 6408 6409 6410 6411 6412 6413 6414 6415 6416 6417 6418 6419 6420 6421 6422 6423 6424 6425 6426 6427 6428 6429 6430 6431 6432 6433 6434 6435 6436 6437 6438 6439 6440 6441 6442 6443 6444 6445 6446 6447 6448 6449 6450 6451 6452 6453 6454 6455 6456 6457 6458 6459 6460 6461 6462 6463 6464 6465 6466 6467 6468 6469 6470 6471 6472 6473 6474 6475 6476 6477 6478 6479 6480 6481 6482 6483 6484 6485 6486 6487 6488 6489 6490 6491 6492 6493 6494 6495 6496 6497 6498 6499 6500 6501 6502 6503 6504 6505 6506 6507 6508 6509 6510 6511 6512 6513 6514 6515 6516 6517 6518 6519 6520 6521 6522 6523 6524 6525 6526 6527 6528 6529 6530 6531 6532 6533 6534 6535 6536 6537 6538 6539 6540 6541 6542 6543 6544 6545 6546 6547 6548 6549 6550 6551 6552 6553 6554 6555 6556 6557 6558 6559 6560 6561 6562 6563 6564 6565 6566 6567 6568 6569 6570 6571 6572 6573 6574 6575 6576 6577 6578 6579 6580 6581 6582 6583 6584 6585 6586 6587 6588 6589 6590 6591 6592 6593 6594 6595 6596 6597 6598 6599 6600 6601 6602 6603 6604 6605 6606 6607 6608 6609 6610 6611 6612 6613 6614 6615 6616 6617 6618 6619 6620 6621 6622 6623 6624 6625 6626 6627 6628 6629 6630 6631 6632 6633 6634 6635 6636 6637 6638 6639 6640 6641 6642 6643 6644 6645 6646 6647 6648 6649 6650 6651 6652 6653 6654 6655 6656 6657 6658 6659 6660 6661 6662 6663 6664 6665 6666 6667 6668 6669 6670 6671 6672 6673 6674 6675 6676 6677 6678 6679 6680 6681 6682 6683 6684 6685 6686 6687 6688 6689 6690 6691 6692 6693 6694 6695 6696 6697 6698 6699 6700 6701 6702 6703 6704 6705 6706 6707 6708 6709 6710 6711 6712 6713 6714 6715 6716 6717 6718 6719 6720 6721 6722 6723 6724 6725 6726 6727 6728 6729 6730 6731 6732 6733 6734 6735 6736 6737 6738 6739 6740 6741 6742 6743 6744 6745 6746 6747 6748 6749 6750 6751 6752 6753 6754 6755 6756 6757 6758 6759 6760 6761 6762 6763 6764 6765 6766 6767 6768 6769 6770 6771 6772 6773 6774 6775 6776 6777 6778 6779 6780 6781 6782 6783 6784 6785 6786 6787 6788 6789 6790 6791 6792 6793 6794 6795 6796 6797 6798 6799 6800 6801 6802 6803 6804 6805 6806 6807 6808 6809 6810 6811 6812 6813 6814 6815 6816 6817 6818 6819 6820 6821 6822 6823 6824 6825 6826 6827 6828 6829 6830 6831 6832 6833 6834 6835 6836 6837 6838 6839 6840 6841 6842 6843 6844 6845 6846 6847 6848 6849 6850 6851 6852 6853 6854 6855 6856 6857 6858 6859 6860 6861 6862 6863 6864 6865 6866 6867 6868 6869 6870 6871 6872 6873 6874 6875 6876 6877 6878 6879 6880 6881 6882 6883 6884 6885 6886 6887 6888 6889 6890 6891 6892 6893 6894 6895 6896 6897 6898 6899 6900 6901 6902 6903 6904 6905 6906 6907 6908 6909 6910 6911 6912 6913 6914 6915 6916 6917 6918 6919 6920 6921 6922 6923 6924 6925 6926 6927 6928 6929 6930 6931 6932 6933 6934 6935 6936 6937 6938 6939 6940 6941 6942 6943 6944 6945 6946 6947 6948 6949 6950 6951 6952 6953 6954 6955 6956 6957 6958 6959 6960 6961 6962 6963 6964 6965 6966 6967 6968 6969 6970 6971 6972 6973 6974 6975 6976 6977 6978 6979 6980 6981 6982 6983 6984 6985 6986 6987 6988 6989 6990 6991 6992 6993 6994 6995 6996 6997 6998 6999 7000 7001 7002 7003 7004 7005 7006 7007 7008 7009 7010 7011 7012 7013 7014 7015 | %==========================================================================% % GRG 3.2 Manual (C) 1988-97 Vadim V. Zhytnikov % %==========================================================================% % LaTeX 2e and MakeIndex are required to pront this document: % % % % latex grg32 % % latex grg32 % % latex grg32 % % makeindex grg32 % % latex grg32 % % % % If you do not have MakeIndex just omit two last steps. % % The document is intended for two-side printing. % %==========================================================================% \documentclass[twoside,openright]{report} \oddsidemargin=1.5cm \evensidemargin=1.3cm %%% This is for PS fonts and dvips driver %\usepackage{mathptm} %\usepackage{palatino} %\renewcommand{\bfdefault}{b} %\newcommand{\grgtt}{\bfseries\ttfamily} %\usepackage[dvips]{color} %\definecolor{shade}{gray}{.9} %\newcommand{\shadedbox}[1]{\fcolorbox{black}{shade}{#1}} %%% This is for CM fonts \newcommand{\grgtt}{\ttfamily} \renewcommand{\ttdefault}{cmtt} \newcommand{\shadedbox}[1]{\fbox{#1}} %%% %\usepackage{calrsfs} % rsfs for mathcal %%% \makeatletter \let\@afterindentfalse\@afterindenttrue \@afterindenttrue \makeatother %%% %%% \usepackage{makeidx} \makeindex \newcommand{\cmdind}[1]{\index{Commands!\comm{#1}}\index{#1@\comm{#1} (command)}} \newcommand{\cmdindx}[2]{\index{Commands!\comm{#1}}\index{#1@\comm{#1} (command)!\comm{#2}}} \newcommand{\swind}[1]{\index{Switches!\comm{#1}}% \index{#1@\comm{#1} (switch)}% \label{#1}} \newcommand{\swinda}[1]{\index{Switches!\comm{#1}}% \index{#1@\comm{#1} (switch)}} %%% %%% \newcommand{\rim}[1]{\stackrel{\scriptscriptstyle\{\}}{#1}\!} %%% %%% \newcommand{\object}[2]{% \begin{equation} \mbox{\comm{#1}} =\ #2 \end{equation}} \newcommand{\tsst}{\longleftrightarrow} \newcommand{\vv}{\vphantom{\rule{5mm}{5mm}}} \newcommand{\RR}[1]{\stackrel{\rm #1}{R}\!{}} \newcommand{\OO}[1]{\stackrel{\rm #1}{\Omega}\!{}} %%% %%% \newcommand{\ipr}{\rule{1.8mm}{.1mm}\rule{.1mm}{2.2mm}\,} % _| int. product %%% %%% \newcommand{\spref}[1]{section \ref{#1} on page \pageref{#1}} \newcommand{\pref}[1]{page \pageref{#1}} %%% %%% \newcommand{\seethis}[1]{\marginpar{\footnotesize\it #1}} \newcommand{\rseethis}[1]{ \reversemarginpar \marginpar{\footnotesize\it #1} \normalmarginpar} \newcommand{\important}[1]{\marginpar{\itshape\bfseries\fbox{\ !\ } #1}} %%% %%% Footnotes simbol ... \renewcommand{\thefootnote}{\fnsymbol{footnote}} % + ++ etc for footnotes \makeatletter \def\@fnsymbol#1{\ensuremath{\ifcase#1\or \dagger\or \ddagger\or \mathchar "278\or \mathchar "27B\or \|\or *\or **\or \dagger\dagger \or \ddagger\ddagger \else\@ctrerr\fi}} \makeatother %%% %%% Page layout ... \textheight=180mm \textwidth=120mm %\marginparsep=2mm %\marginparwidth=28mm \marginparsep=5mm \marginparwidth=25mm \parindent=6mm \parskip=1.2mm plus 1mm minus 1mm %%% \newlength{\myparindent} \myparindent=\parindent %%% My own \tt font ... \makeatletter \def\verbatim@font{\grgtt} \makeatother \renewcommand{\tt}{\grgtt} %%% %%% %%% Special symbols ... \def\^{{\tt \char'136}} %%% \^ is ^ \def\_{{\tt \char'137}} %%% \_ is _ \newcommand{\w}{{\tt \char'057 \char'134}} %%% \w is /\ \newcommand{\bs}{{\tt \char'134}} %%% \bs is \ \newcommand{\ul}{{\tt \char'137}} %%% \ul is _ \newcommand{\dd}{{\tt \char'043}} %%% \dd is # \newcommand{\cc}{{\tt \char'176}} %%% \cc is ~ \newcommand{\ip}{{\tt \char'137 \char'174}} %%% \ip is _| \newcommand{\ii}{{\tt \char'174}} %%% \ii is | \newcommand{\udr}{\mbox{$\Updownarrow$}} %%% %%% \grg GRG logo ... \newcommand{\grg}{{\sc GRG}} \newcommand{\reduce}{{\sc Reduce}} \newcommand{\maple}{{\sc Maple}} \newcommand{\macsyma}{{\sc Macsyma}} \newcommand{\mathematica}{{\sc Mathematica}} %%% \marg ... \newcommand{\marg}[1]{\marginpar{\tiny#1}} %%% \command{...} commands in (shaded) box \def\mynewline{\ifvmode \relax \else \unskip\nobreak\hfil\break\fi} \newcommand{\command}[1]{\vspace{1.2mm}\mynewline\hspace*{6mm}% \shadedbox{\begin{tabular}{l}\tt% #1 \end{tabular}}\vspace{1.2mm}\newline} %%% parts of the commands \newcommand{\file}[1]{{\sf#1}} \newcommand{\comm}[1]{{\upshape\tt#1}} % \comm short in-line command \newcommand{\parm}[1]{{\sf\slshape#1\/}} % \parm command parameter \newcommand{\opt}[1]{{\rm[}#1{\rm]}} % \opt optional part of command \newcommand{\user}[1]{{\bfseries\ttfamily#1}} % \user user input \newcommand{\rpt}[1]{#1{\rm[}{\tt,}#1{\rm\dots}{\rm]}} % \rpt repetition \def\closerule{\rule{.1mm}{1mm}\rule{119.8mm}{.1mm}} \def\openrule{\rule{.1mm}{1mm}\rule[1mm]{119.8mm}{.1mm}} %%% \begin{slisting} ... \end{slisting} small font listing with frame %%% \begin{listing} ... \end{listing} normal font listing without frame \newcommand{\etrivlistrule} {\vspace*{-3mm}\endtrivlist{\closerule}\newline} \makeatletter \newdimen\allttindent \allttindent=0mm \def\docspecials{\do\ \do\$\do\&% \do\#\do\^\do\^^K\do\_\do\^^A\do\%\do\~} \def\slisting{\vspace*{-2mm}% \trivlist \item[]\if@minipage\else\relax\fi \leftskip\@totalleftmargin \advance\leftskip\allttindent \rightskip\z@ \parindent\z@\parfillskip\@flushglue\parskip\z@ \@tempswafalse\openrule \def\par{\if@tempswa\hbox{}\fi\@tempswatrue\@@par} \obeylines \small\grgtt% \catcode``=13 \@noligs \let\do\@makeother \docspecials \frenchspacing\@vobeyspaces} \def\listing{\trivlist \item[]\if@minipage\else\relax\fi \leftskip\@totalleftmargin \advance\leftskip\allttindent \rightskip\z@ \parindent\z@\parfillskip\@flushglue\parskip\z@ \@tempswafalse \def\par{\if@tempswa\hbox{}\fi\@tempswatrue\@@par} \obeylines \grgtt% \catcode``=13 \@noligs \let\do\@makeother \docspecials \frenchspacing\@vobeyspaces} \let\endslisting=\etrivlistrule \let\endlisting=\endtrivlist \makeatother %%% %%% Headings style ... %\usepackage{fancyheadings} %%% We just inserat the fancyheadings.sty here literally ... \makeatletter % fancyheadings.sty version 1.7 % Fancy headers and footers. % Piet van Oostrum, Dept of Computer Science, University of Utrecht % Padualaan 14, P.O. Box 80.089, 3508 TB Utrecht, The Netherlands % Telephone: +31-30-531806. piet@cs.ruu.nl (mcvax!sun4nl!ruuinf!piet) % Sep 16, 1994 % version 1.4: Correction for use with \reversemargin % Sep 29, 1994: % version 1.5: Added the \iftopfloat, \ifbotfloat and \iffloatpage commands % Oct 4, 1994: % version 1.6: Reset single spacing in headers/footers for use with % setspace.sty or doublespace.sty % Oct 4, 1994: % version 1.7: changed \let\@mkboth\markboth to % \def\@mkboth{\protect\markboth} to make it more robust \def\lhead{\@ifnextchar[{\@xlhead}{\@ylhead}} \def\@xlhead[#1]#2{\gdef\@elhead{#1}\gdef\@olhead{#2}} \def\@ylhead#1{\gdef\@elhead{#1}\gdef\@olhead{#1}} \def\chead{\@ifnextchar[{\@xchead}{\@ychead}} \def\@xchead[#1]#2{\gdef\@echead{#1}\gdef\@ochead{#2}} \def\@ychead#1{\gdef\@echead{#1}\gdef\@ochead{#1}} \def\rhead{\@ifnextchar[{\@xrhead}{\@yrhead}} \def\@xrhead[#1]#2{\gdef\@erhead{#1}\gdef\@orhead{#2}} \def\@yrhead#1{\gdef\@erhead{#1}\gdef\@orhead{#1}} \def\lfoot{\@ifnextchar[{\@xlfoot}{\@ylfoot}} \def\@xlfoot[#1]#2{\gdef\@elfoot{#1}\gdef\@olfoot{#2}} \def\@ylfoot#1{\gdef\@elfoot{#1}\gdef\@olfoot{#1}} \def\cfoot{\@ifnextchar[{\@xcfoot}{\@ycfoot}} \def\@xcfoot[#1]#2{\gdef\@ecfoot{#1}\gdef\@ocfoot{#2}} \def\@ycfoot#1{\gdef\@ecfoot{#1}\gdef\@ocfoot{#1}} \def\rfoot{\@ifnextchar[{\@xrfoot}{\@yrfoot}} \def\@xrfoot[#1]#2{\gdef\@erfoot{#1}\gdef\@orfoot{#2}} \def\@yrfoot#1{\gdef\@erfoot{#1}\gdef\@orfoot{#1}} \newdimen\headrulewidth \newdimen\footrulewidth \newdimen\plainheadrulewidth \newdimen\plainfootrulewidth \newdimen\headwidth \newif\if@fancyplain \@fancyplainfalse \def\fancyplain#1#2{\if@fancyplain#1\else#2\fi} % Command to reset various things in the headers: % a.o. single spacing (taken from setspace.sty) % and the catcode of ^^M (so that epsf files in the header work if a % verbatim crosses a page boundary) \def\fancy@reset{\restorecr \def\baselinestretch{1}% \ifx\undefined\@newbaseline% NFSS not present; 2.09 or 2e \ifx\@currsize\normalsize\@normalsize\else\@currsize\fi% \else% NFSS (2.09) present \@newbaseline% \fi} % Initialization of the head and foot text. \headrulewidth 0.4pt \footrulewidth\z@ \plainheadrulewidth\z@ \plainfootrulewidth\z@ \lhead[\fancyplain{}{\sl\rightmark}]{\fancyplain{}{\sl\leftmark}} % i.e. empty on ``plain'' pages \rightmark on even, \leftmark on odd pages \chead{} \rhead[\fancyplain{}{\sl\leftmark}]{\fancyplain{}{\sl\rightmark}} % i.e. empty on ``plain'' pages \leftmark on even, \rightmark on odd pages \lfoot{} \cfoot{\rm\thepage} % page number \rfoot{} % Put together a header or footer given the left, center and % right text, fillers at left and right and a rule. % The \lap commands put the text into an hbox of zero size, % so overlapping text does not generate an errormessage. \def\@fancyhead#1#2#3#4#5{#1\hbox to\headwidth{\fancy@reset\vbox{\hbox {\rlap{\parbox[b]{\headwidth}{\raggedright#2\strut}}\hfill \parbox[b]{\headwidth}{\centering#3\strut}\hfill \llap{\parbox[b]{\headwidth}{\raggedleft#4\strut}}}\headrule}}#5} \def\@fancyfoot#1#2#3#4#5{#1\hbox to\headwidth{\fancy@reset\vbox{\footrule \hbox{\rlap{\parbox[t]{\headwidth}{\raggedright#2\strut}}\hfill \parbox[t]{\headwidth}{\centering#3\strut}\hfill \llap{\parbox[t]{\headwidth}{\raggedleft#4\strut}}}}}#5} \def\headrule{{\if@fancyplain\headrulewidth\plainheadrulewidth\fi \hrule\@height\headrulewidth\@width\headwidth \vskip-\headrulewidth}} \def\footrule{{\if@fancyplain\footrulewidth\plainfootrulewidth\fi \vskip-0.3\normalbaselineskip\vskip-\footrulewidth \hrule\@width\headwidth\@height\footrulewidth\vskip0.3\normalbaselineskip}} \def\ps@fancy{ \def\@mkboth{\protect\markboth} \@ifundefined{chapter}{\def\sectionmark##1{\markboth {\uppercase{\ifnum \c@secnumdepth>\z@ \thesection\hskip 1em\relax \fi ##1}}{}} \def\subsectionmark##1{\markright {\ifnum \c@secnumdepth >\@ne \thesubsection\hskip 1em\relax \fi ##1}}} {\def\chaptermark##1{\markboth {\uppercase{\ifnum \c@secnumdepth>\m@ne \@chapapp\ \thechapter. \ \fi ##1}}{}} \def\sectionmark##1{\markright{\uppercase{\ifnum \c@secnumdepth >\z@ \thesection. \ \fi ##1}}}} \ps@@fancy \global\let\ps@fancy\ps@@fancy \headwidth\textwidth} \def\ps@fancyplain{\ps@fancy \let\ps@plain\ps@plain@fancy} \def\ps@plain@fancy{\@fancyplaintrue\ps@@fancy} \def\ps@@fancy{ \def\@oddhead{\@fancyhead\@lodd\@olhead\@ochead\@orhead\@rodd} \def\@oddfoot{\@fancyfoot\@lodd\@olfoot\@ocfoot\@orfoot\@rodd} \def\@evenhead{\@fancyhead\@rodd\@elhead\@echead\@erhead\@lodd} \def\@evenfoot{\@fancyfoot\@rodd\@elfoot\@ecfoot\@erfoot\@lodd} } \def\@lodd{\if@reversemargin\hss\else\relax\fi} \def\@rodd{\if@reversemargin\relax\else\hss\fi} \let\latex@makecol\@makecol \def\@makecol{\let\topfloat\@toplist\let\botfloat\@botlist\latex@makecol} \def\iftopfloat#1#2{\ifx\topfloat\empty #2\else #1\fi} \def\ifbotfloat#1#2{\ifx\botfloat\empty #2\else #1\fi} \def\iffloatpage#1#2{\if@fcolmade #1\else #2\fi} \makeatother %%% \pagestyle{fancy} \addtolength{\headwidth}{\marginparsep} \addtolength{\headwidth}{\marginparwidth} \lhead[\bfseries\thepage]{\bfseries\slshape\rightmark} \chead{} \rhead[\bfseries\slshape\leftmark]{\bfseries\thepage} \lfoot{} \cfoot{} \rfoot{} \renewcommand{\uppercase}[1]{#1} %%% %%% Chapter style ... \makeatletter \def\@makechapterhead#1{% \noindent\grgrule\break% { \hsize=150mm \parindent \z@ \raggedleft \reset@font \ifnum \c@secnumdepth >\m@ne \Large\slshape \@chapapp{} \Huge\bfseries \thechapter \par \vskip 20\p@ \fi \Huge \bfseries\upshape #1\par \nobreak \vskip 40\p@ }} \def\@makeschapterhead#1{% \noindent\grgrule\break% { \hsize=150mm \parindent \z@ \raggedleft \reset@font \Large\slshape #1\par \nobreak \vskip 20\p@ }} \renewcommand\chapter{\if@openright\cleardoublepage\else\clearpage\fi \thispagestyle{empty}% \global\@topnum\z@ %\@afterindentfalse \secdef\@chapter\@schapter} \makeatother \renewcommand{\chaptername}{CHAPTER} \renewcommand{\contentsname}{CONTENTS} \renewcommand{\appendixname}{APPENDIX} \newcommand{\grgrule}{\rule{150mm}{.3mm}\relax} %%% %%% Sections ... %\renewcommand{\thesection}{} %\renewcommand{\thesubsection}{} %\renewcommand{\thesubsubsection}{} \makeatletter %\renewcommand\section{\@startsection {section}{1}{\z@}% % {-3.5ex \@plus -1ex \@minus -.2ex}% % {2.3ex \@plus.2ex}% % {\normalfont\Large\bfseries}} \renewcommand\subsection{\@startsection{subsection}{2}{\z@}% {-3.25ex\@plus -1ex \@minus -.2ex}% {1.5ex \@plus .2ex}% {\normalfont\large\slshape\bfseries}} %\renewcommand\subsubsection{\@startsection{subsubsection}{3}{\z@}% % {-3.25ex\@plus -1ex \@minus -.2ex}% % {1.5ex \@plus .2ex}% % {\normalfont\normalsize\bfseries}} \makeatother %%% \begin{document} \begin{titlepage} \hsize=150mm \hrulefill \vspace*{20mm} \begin{center} \Huge\bf GRG\\[1mm] \normalsize Version 3.2 \end{center} \begin{center} \Large Computer Algebra System for\\ Differential Geometry,\\ Gravitation and \\ Field Theory \vspace*{25mm}\\ {\Large\itshape\bfseries Vadim V. Zhytnikov}\\ \vfill {\normalsize Moscow, 1992--1997 $\bullet$ Chung-Li, 1994} \end{center} \hrulefill \end{titlepage} \setcounter{page}{0}\thispagestyle{empty} \tableofcontents\thispagestyle{empty} \chapter{Introduction} Calculation of various geometrical and physical quantities and equations is the usual technical problem which permanently arises in geometry, field and gravity theory. Numerous indices, contractions and components make these calculations very tedious and error-prone. Since this calculus obeys the well defined rules the idea to automate this kind of problems using computer is quite natural. Now there are several computer algebra systems such as \maple, \reduce, \mathematica\ or \macsyma\ which in principle allow one to do this and it is not so hard to write a program to calculate, for example, the curvature tensor or connection. But suppose that we want to make a non-trivial coordinate transformation or tetrad rotation, calculate covariant or Lie derivative, compute a complicated expression with numerous contraction or raise or lower some indices. All these operations are typical in differential geometry and field theory but their realization with the help of general purpose computer algebra systems requires hard programming since all these systems really know nothing about \emph{covariant properties} of geometrical quantities. The computer algebra system \grg\ is designed in such a way to make calculation in differential geometry and field theory as simple and natural as possible. \grg\ is based on the computer algebra system \reduce\ but \grg\ has its own simple input language whose commands resembles English phrases. Working with \grg\ no any knowledge of programming is required. \grg\ understands tensors, spinors, vectors, differential forms and knows all standard operations with these quantities. Input form for mathematical expressions is very close to traditional mathematical notation including Einstein summation rule. \grg\ knows the covariant properties of these objects, you can easily raise and lower indices, compute covariant and Lie derivatives, perform coordinate and frame transformations. \grg\ works in any dimension and allows one to represent tensor quantities with respect to holonomic, orthogonal and even any other arbitrary frame. One of the useful features of \grg\ is that it has a large number of built-in standard field-theory and geometrical quantities and formulas for their computation. Thus \grg\ provides ready solutions to many standard problems. Another unique feature of \grg\ is that it can export results of calculations into other computer algebra system. You can save your data in to the file in the format of \maple, \mathematica, \macsyma\ or \reduce\ in order to use this system to proceed analysis of the data. The \LaTeX\ output format is supported as well. In addition \grg\ is compatible with \reduce\ graphics shells providing niece book-quality output with Greek letters, integral signs etc. The main built-in \grg\ capabilities are: \begin{list}{$\bullet$}{\labelwidth=8mm\leftmargin=10mm} \item Connection, torsion and nonmetricity. \item Curvature. \item Spinorial formalism. \item Irreducible decomposition of the curvature, torsion, and nonmetricity in any dimension. \item Einstein equations. \item Scalar field with minimal and non-minimal interaction. \item Electromagnetic field. \item Yang-Mills field. \item Dirac spinor field. \item Geodesic equation. \item Null congruences and optical scalars. \item Kinematics for time-like congruences. \item Ideal and spin fluid. \item Newman-Penrose formalism. \item Gravitational equations for the theory with arbitrary gravitational Lagrangian in Riemann and Riemann-Cartan spaces. \end{list} I would like to stress that current \grg\ version is intended for calculations in a concrete coordinate map only. It cannot operate with tensors as with objects having abstract symbolic indices. This book consist of two main parts. First part contains detailed description of \grg\ as a programming system. Second part describes all built-in objects and formulas for their computation. \chapter{Programming in \grg} Throughout the chapter \comm{commands} are printed in typewriter font. The slanted serif-less font is used for command \parm{parameters}. The optional parts of the commands are enclosed in squared brackets \opt{option} and \rpt{\parm{id}} stands for one or several repetitions of \parm{id}: \parm{id} or \comm{\parm{id},\parm{id}} etc. Examples are separated form the text by horizontal lines $\stackrel{\rule{0.1mm}{1mm}\rule[1mm]{3mm}{0.1mm}} {\rule{0.1mm}{1mm}\rule{3mm}{0.1mm}}$ and the user input can be easily distinguished from the \grg\ output by the prompt \comm{<-} which precedes every input line. \section{Session, Tasks and Commands} To start \grg\ it is necessary to start \reduce\ and \seethis{ On some systems you have to use {\tt\upshape load!\_package grg;}\newline since {\tt\upshape load} is not defined.\newline \newline Sometimes it\newline is better to use two commands\newline {\tt\upshape load grg32; grg;}\newline or\newline {\tt\upshape load grg; grg;}\newline (See section \ref{configsect} for details.)} enter the command {\tt load grg;} \begin{slisting} REDUCE 3.5, 15 Oct 93, patched to 15 Jun 95 ... 1: load grg; This is GRG 3.2 release 2 (Feb 9, 1997) ... System directory: c:{\bs}reduce{\bs}grg32{\bs} System variables are upper-cased: E I PI SIN ... Dimension is 4 with Signature (-,+,+,+) <- \end{slisting} Symbol \comm{<-} is the \grg\ prompt which shows that now \grg\ waits for your input. The \grg\ \emph{task} (we prefer this term instead of usual \emph{program}) consist of the sequence of commands terminated by semicolon \comm{;}. Reading the input \grg\ splits it on \emph{atoms}. There are several types of atoms:\index{Atoms} \begin{list}{$\bullet$}{\labelwidth=4mm\leftmargin=\parindent} \item The identifier or symbol is a sequence of letters and digits starting with a letter: \begin{verbatim} i I alpha1 beta ABC123D Find \end{verbatim} The identifiers in \grg\ may have trailing tilde character \cc. Any other character may be incorporated in the identifier if preceded by the exclamation sign:\index{Identifiers} \begin{verbatim} beta~ LIMIT!+ \end{verbatim} The identifiers in \grg\ play the role of the variables and functions in mathematical expressions and words in commands. \item Integer numbers\index{Numbers} \begin{verbatim} 0 123 104341 \end{verbatim} \item String is a sequence of characters enclosed in double quotes\index{Strings} \begin{verbatim} "file.txt" "This is a string" "dir *.doc" \end{verbatim} The strings in \grg\ are used for file names and operating system commands. \item Nine special two-character atoms \begin{verbatim} ** _| /\ |= ~~ .. <= >= -> \end{verbatim} \item Any other characters are considered as single-character atoms. \end{list} The format of \grg\ commands is free. They can span one or several lines and any number of spaces and tabulations can be inserted between two neighbor atoms. \enlargethispage{3mm} The \grg\ session may consist of several independent tasks. The command\index{Tasks}\cmdind{Quit} \command{Quit;} terminates both \grg\ and \reduce\ session and returns the control to the operating system level. The command\cmdind{Stop} \command{Stop;} terminates current \grg\ task and brings the session control menu:\index{Session control menu} \begin{slisting} <- Stop; Quit GRG - 0 Start Task - 1 Exit to REDUCE - 2 Type 0, 1 or 2: \end{slisting} \newpage \noindent The option \comm{0} terminates \reduce\ session similarly to the command \comm{Quit;}. The choice \comm{1} starts new task by bringing \grg\ to its initial state: all variables, declarations, substitutions and results of calculations are cleared and all switches resume their initial positions.\footnote{Usually \grg\ does good job by resuming initial state and new task turns out to be independent of previous ones. But on some rare occasions the initial state cannot be completely recovered and it is better to restart \reduce\ and \grg\ completely.} Finally the option \comm{2} terminates \grg\ task and returns control to the \reduce\ command level. In this case \grg\ can be restarted later by the command \comm{grg;}. The commands in \grg\ are case insensitive, i.e. command \comm{Quit;} is equivalent to \comm{quit;} and \comm{QUIT;} etc. But notice that unlike \reduce\ variables and functions in mathematical expressions in \grg\ \emph{are case sensitive}. \subsection{Switches} \index{Switches} Switches in \grg\ and \reduce\ are used to control various system modes of operation. They are denoted by identifiers and the commands\cmdind{On}\cmdind{Off} \command{On \rpt{\parm{switch}};\\\tt Off \rpt{\parm{switch}};} turns the \parm{switch} on and off respectively. Any switch defined by \reduce\ is available in \grg\ as well. In addition \grg\ defines a couple of its own switches. The full list of \grg\ switches is presented in appendix A. The command\cmdind{Show Switch}\cmdind{Switch} \command{\opt{Show} Switch \parm{switch};} or equivalently \command{Show \parm{switch};\\\tt ?~\parm{switch};} prints current \parm{switch} position \begin{slisting} <- Show Switch TORSION; TORSION is Off. <- On torsion,gcd; <- switch torsion; TORSION is On. <- switch exp; GCD is On \end{slisting} Switches in \grg\ are case insensitive. \subsection{Batch File Execution} Usually \grg\ works in the interactive mode which is not always convenient. The command\cmdind{Input}\index{Batch file execution} \command{\opt{Input} "\parm{file}";} reads the \parm{file} and executes commands stored in it. The file names in \grg\ are always denoted by strings and exact specification of \parm{file} is operating system dependent. The word \comm{Input} is optional, thus in order to run batch file it suffices to enter its name \comm{"\parm{file}";}. The execution of batch file commands can be suspended by the command\cmdind{Pause} \command{Pause;} After this command \grg\ enters the interactive mode. One can enter one or several commands interactively and then resume batch file execution by the command\cmdind{Next} \command{Next;} In general no any special end-of-file symbol or command is required in the \grg\ batch \parm{file} but is necessary the symbol\index{end-of-file symbol \comm{\$}} \comm{\$} is recognized by \grg\ as the end-of-file mark. If during the batch file execution an error occurs \grg\ enter interactive mode and ask user to input the command which is supposed to replace the erroneous one. After the receiving of \emph{one} command \grg\ automatically resumes the batch file execution. The command \comm{Pause;} can be used if it is necessary to execute \emph{several} commands instead of one. The command\cmdind{Output} \command{Output "\parm{outfile}";} redirects all \grg\ output into the \parm{outfile}. The \parm{outfile} can be closed by the equivalent commands \cmdind{EndO}\cmdind{End of Output} \command{EndO;\\\tt End of Output;} It is convenient to run long-time \grg\ tasks in background. The way of doing this depend on the operating system. For example to execute \grg\ task in background in UNIX it is necessary to use the following command \begin{listing} reduce < task.grg > grg.out & \end{listing} Here we assume that the \reduce\ invoking command is \comm{reduce} and the file \comm{task.grg} contains the \grg\ task commands: \begin{listing} load grg; \parm{grg command}; \parm{grg command}; ... \parm{grg command}; quit; \end{listing} The output of the session will be written into the file \file{grg.out}. Since no proper reaction on errors is possible during the background execution it is good idea to turn the switch \comm{BATCH} on.\swind{BATCH} This makes \grg\ to terminate the session immediately in the case of any error. \subsection{Operating System Commands} The command\cmdind{System} \command{System "\parm{command}";} executes the operating system \parm{command}. The same command without parameters \command{System;} temporary suspends \grg\ session and passes the control to the operating system command level. The details may depend on the concrete operating system. In particular in UNIX the command \comm{system;} may fail but UNIX has some general mechanism for suspending running programs: you can press \comm{\^Z} to suspend any program and \comm{\%+} to resume its execution. \subsection{Comments} %\reversemarginpar The comment commands\cmdind{Comment} \command{Comment \parm{any text};\\\tt \% \parm{any text};} are used to supply additional information to \grg\ tasks \seethis{See page \pageref{Unload} about the \comm{Unload} command.} and data saved by the \comm{Unload} command. The comment can be also attached to the end of any \grg\ command \command{\parm{grg command} \% \parm{any text};} %\normalmarginpar \subsection{Timing} The command \cmdind{Time}\cmdind{Show Time} \command{\opt{Show} Time;} prints time elapsed since the beginning of current \grg\ task including the percentage of so called garbage collections. The garbage collection time can be also printed by the command \cmdind{GC Time}\cmdind{Show GC Time} \command{\opt{Show} GC Time;} If percentage of garbage collections grows and exceeds say 30\% then memory of your system is running short and you probably need more RAM. \section{Declarations} Any object, variable or function in \grg\ must be declared. This allows to locate misprints and makes the system more reliable. Since \grg\ always work in some concrete coordinate system (map) the coordinate declaration is the most important one and must be present in every \grg\ task. \subsection{Dimension and Signature} During installation \grg\ always defines default value of the dimension and signature.\index{Dimension!default}\index{Signature!default} \seethis{See \pref{tuning} to find out how to change the default dimension and signature.} The information about this default value is printed\index{Dimension}\index{Signature} upon \grg\ start in the form of the following (or similar) message line: \begin{slisting} Dimension is 4 with Signature (-,+,+,+) \end{slisting} The following command overrides the default dimension and signature\cmdind{Dimension} \command{Dimension \parm{dim} with \opt{Signature} (\rpt{\parm{pm}});} where \parm{dim} is the number \comm{2} or greater and \parm{pm} is \comm{+} or \comm{-}. The \parm{pm} can be preceded or succeeded by a number which denotes several repetitions of this \parm{pm}. For example the declarations \begin{listing} Dimension 5 with Signature (+,+,-,-,-); Dimension 5 with (2+,-3); \end{listing} are equivalent and defines 5-dimensional space with the signature ${\rm diag}{\scriptstyle(+1,+1,-1,}$ ${\scriptstyle-1,-1)}$. The important point is that the dimension declaration must be \emph{very first in the task} and goes before any other command. Current dimension and signature can be printed by the command \cmdind{Status}\cmdind{Show Status} \command{\opt{Show} Status;} \subsection{Coordinates} The coordinate declaration command must be present in every \grg\ task\cmdind{Coordinates} \command{Coordinates \rpt{\parm{id}};} Only few commands such as informational commands, other declarations, switch changing commands may precede the coordinate declaration. The only way to have a tusk without the coordinate declaration is to load the file where coordinates where saved by the \comm{Unload} command.\seethis{See \pref{UnloadLoad} to find out how to save data and declarations into a file.} but no any computation can be done before coordinates are declared. Current coordinate list can be printed by the command\cmdindx{Write}{Coordinates} \command{Write Coordinates;} \begin{table} \begin{center}\index{Constants!predefined} \begin{tabular}{|l|l|} \hline \tt E I PI INFINITY & Mathematical constants $e,i,\pi$,$\infty$ \\ \hline \tt FAILED & \\ \hline \tt ECONST & Charge of the electron \\ \tt DMASS & Dirac field mass \\ \tt SMASS & Scalar field mass \\ \hline \tt GCONST & Gravitational constant \\ \tt CCONST & Cosmological constants \\ \hline \tt LC0 LC1 LC2 LC3 & Parameters of the quadratic \\ \tt LC4 LC5 LC6 & gravitational Lagrangian \\ \tt MC1 MC2 MC3 & \\ \hline \tt AC0 & Nonminimal interaction constant \\ \hline \end{tabular} \caption{Predefined constants}\label{predefconstants} \end{center} \end{table} \subsection{Constants} \index{Constants} Any constant must be declared by the command\cmdind{Constants} \command{Constants \rpt{\parm{id}};} The list of currently declared constants can be printed by the command\cmdindx{Write}{Constants} \command{Write Constants;} There are also a number of built-in constants which are listed in table \ref{predefconstants}. \subsection{Functions} Functions in \grg\ are the analogues of the \reduce\ \emph{operators} but we prefer to use this traditional mathematical term. The function must be declared by the command\cmdind{Functions} \command{Functions \rpt{\parm{f}\opt{(\rpt{\parm{x}})}};} Here \parm{f} is the function identifier. The optional list of parameters \parm{x} defines function with \emph{implicit} dependence. The \parm{x} must be either coordinate or constant. The construction \comm{\parm{f}(*)} is a shortcut which declares the function \parm{f} depending on \emph{all coordinates}. The following example declares three functions \comm{fun1}, \comm{fun2} and \comm{fun3}. The function \comm{fun1}, which was declared without implicit coordinate list, must be always used in mathematical expressions together with the explicit arguments like \comm{fun1(x+y)} etc. The functions \comm{fun2} and \comm{fun3} can appear in expressions in similar fashion but also as a single symbol \comm{fun2} or \comm{fun3} \begin{slisting} <- Coordinates t, x, y, z; <- Constant a; <- Functions fun1, fun2(x,y), fun3(*); <- Write functions; Functions: fun1 fun2(x,y) fun3(t,x,y,z) <- d fun1(x+a); DF(fun1(a + x),x) d x <- d fun2; DF(fun2,x) d x + DF(fun2,y) d y <- d fun3; DF(fun3,t) d t + DF(fun3,x) d x + DF(fun3,y) d y + DF(fun3,z) d z \end{slisting} The functions may have particular properties with respect to their arguments permutation and sign. The corresponding declarations are\cmdind{Symmetric}\cmdind{Antisymmetric}\cmdind{Odd}\cmdind{Even} \command{Symmetric \rpt{\parm{f}};\\\tt Antisymmetric \rpt{\parm{f}};\\\tt Odd \rpt{\parm{f}};\\\tt Even \rpt{\parm{f}};} Notice that these commands are valid only after function \parm{f} was declared by the command \comm{Function}. In addition to user-defined there is also large number of functions predefined in \reduce. All these functions can be used in \grg\ without declaration. The complete list of these functions depends on \reduce\ versions. Any function defined in the \reduce\ package (module) is available too if the package is loaded before \grg\ was started or during \grg\ session.\seethis{See \pref{packages} to find out how to load the \reduce\ packages.} For example the package \file{specfn} contains definitions for various special functions. Finally there is also special declaration \cmdind{Generic Functions} \command{Generic Functions \rpt{\parm{f}(\rpt{\parm{a}})};} This command is valid iff the package \file{dfpart.red} is installed on your \reduce\ system. Here unlike the usual function declaration the list of parameters must be always present and \parm{a} can be any identifier preferably distinct from any other variable. \seethis{See \pref{genfun} to find out about the generic functions.} The role of \parm{a} is also completely different and is explained later. The list of declared functions can be printed by the command \cmdindx{Write}{Functions} \command{Write Functions;} Generic functions in this output are marked by the label \comm{*}. \subsection{Affine Parameter} The variable which plays the role of affine parameter in the geodesic equation must be declared by the command \label{affpar} \command{Affine Parameter \parm{s};} and can be printed by the command\cmdindx{Write}{Affine Parameter} \command{Write Affine Parameter;} \vfill \newpage \subsection{Case Sensitivity} \label{case} Usually \reduce\ is case insensitive which means for example that expression \comm{x-X} will be evaluated by \reduce\ as zero. On the contrary all coordinates, constants and functions in \grg\ are case sensitive, e.g. \comm{alpha}, \comm{Alpha} and \comm{ALPHA} are all different. Notice that commands and switches in \grg\ 3.2 remain case insensitive. \index{Internal \reduce\ case} Therefore all predefined by \grg\ constants and all built-in objects must be used exactly as they presented in this manual \comm{GCONST}, \comm{SMASS} etc. The situation with the constants and functions which predefined by \reduce\ is different. The point is that in spite of its default case insensitivity internally \reduce\ converts everything into some default case which may be upper or lower. Therefore depending on the particular \reduce\ system they must be typed either as \begin{listing} E I PI INFINITY SIN COS ATAN \end{listing} or in lower case \begin{listing} e i pi infinity sin cos atan \end{listing} For the sake of definiteness throughout this book we chose the first upper case convention. When \grg\ starts it informs you about internal case of your particular \reduce\ system by printing the message \begin{slisting} System variables are upper-cased: E I PI SIN ... \end{slisting} or \begin{slisting} System variables are lower-cased: e i pi sin ... \end{slisting} You can find out about the internal case using the command\cmdind{Status}\cmdind{Show Status} \command{\opt{Show} Status;} \vfill \newpage \subsection{Complex Conjugation} By default all variables and functions in \grg\ are considered to be real excluding the imaginary unit constant \comm{I} (or \comm{i} as explained above). But if two identifiers differ only by the trailing character \comm{\cc} they are considered as a pair of complex variables which are conjugated to each other. In the following example coordinates \comm{z} and \comm{z\cc} comprise such a pair: \begin{slisting} <- Coordinates u, v, z, z~; z & z~ - conjugated pair. <- Re(z); z + z~ -------- 2 <- Im(z~); I*(z - z~) ------------ 2 \end{slisting} \section{Objects} Objects play a fundamental role in \grg. They represent mathematical quantities such as metric, connection, curvature and any other spinor or tensor geometrical and physical fields and equations. \grg\ has quite large number of built-in objects and knows many formulas for their calculation. But you are not obliged to use the built-in quantities and can declare your own. The purpose of the declaration is to tell \grg\ basic properties of a new quantity. \subsection{Built-in Objects} \noindent An object is characterized by the following properties and attributes: \index{Built-in objects} \begin{list}{$\bullet$}{\labelwidth=4mm\leftmargin=\parindent\parsep=0mm} \item Name \item Identifier or symbol \item Type of the component \item List of indices \item Symmetries with respect to index permutation \item Density and pseudo-tensor property \item Built-in ways of calculation \item Value \end{list} The object \emph{name} is a sequence of words which are usually the common English name of corresponding quantity. The name is case insensitive and is used to denote a particular object in commands. So called \emph{group names}\index{Group names} refer to a collection of closely related objects. In particular the name {\tt Curvature Spinors} (see page \pageref{curspincoll}) refers to the irreducible components of the curvature tensor in spinorial representation. Actual content of the group may depend on the environment. In particular the group {\tt Curvature Spinors} includes three objects in the Riemann space (Weyl spinor, traceless Ricci spinor and scalar curvature) while in the space with torsion we have six irreducible curvature spinors. The object \emph{identifier} or \emph{symbol} is an identifier which denotes the object in mathematical expressions. Object symbols are case sensitive. The object \emph{type} is the type of its component: objects can be scalar, vector or $p$-form valued. The \emph{density} and \emph{pseudo-tensor} properties of the object characterizes its behaviour under coordinate and frame transformations. Objects can have the following types of indices: \begin{list}{$\bullet$}{\labelwidth=4mm\leftmargin=\parindent} \item Upper and lower holonomic coordinate indices. \item Upper and lower frame indices. \item Upper and lower spinorial indices. \item Upper and lower conjugated spinorial indices. \item Enumerating indices. \end{list} The major part of \grg\ built-in objects has frame indices. \seethis{See page \pageref{metric} about the frame in \grg.} The frame in \grg\ can be arbitrary but you can easily specify the frame to be holonomic or say orthogonal. Then built-in object indices become holonomic or orthogonal respectively. \grg\ deals only with the SL(2,C) spinors which are restricted to the 4-dimensional spaces of Lorentzian signature. \seethis{See \pref{spinors} about the spinorial formalism in \grg.} The corresponding SL(2,C) indices take values 0 and 1. The conjugated indices are transformed with the help of the complex conjugated SL(2,C) matrix. If some spinor is totally symmetric in the group of $n$ spinorial indices (irreducible spinor) then these indices can be replaced by a single so called \emph{summed spinorial index} of rank $n$ which take values from 0 to $n$. The summed spinorial indices provide the most economic way to store the irreducible spinor components. Enumerating indices just label a collection of values and have no any covariant meaning. Accordingly there is no difference between upper and lower enumerating indices. Notice that an index of any type in \grg\ always runs from 0 up to some maximal value which depend on the index type and dimensionality: $d-1$ for frame and coordinate indices,\index{Dimension} and $n$ the spinor indices of the rank $n$. \grg\ understands various types of index symmetries: symmetry, antisymmetry, cyclic symmetry and Hermitian symmetry. These symmetries can apply not only to single indices but to any group of indices as well. \index{Index symmetries}\index{Canonical order of indices} \grg\ uses object symmetries to decrease the amount of memory required to store the object components. It stores only components with the indices in certain \emph{canonical} order and any other component are automatically restored if necessary by appropriate index permutation. The canonical order of indices is defined as follows: for symmetry, antisymmetry or Hermitian symmetry indices are sorted in such a way that index values grows from left to the right. For cyclic symmetry indices are shifted to minimize the numerical value of the whole list of indices. Finally there are two special types of objects: equations and connection 1-forms. \index{Equations} Equations have all the same properties as any other object but in addition they have left and right hand side and are printed in the form of equalities. The connections are used by \grg\ to construct covariant derivatives. \index{Connections}\seethis{See \pref{conn2} about the connections.} There are only four types of connections: holonomic connection 1-form, frame connection 1-form, spinor connection 1-form and conjugated spinor connection 1-form. Almost all built-in objects have associated built-in \emph{ways of calculation} (one or several). \index{Ways of calculation} Each way is nothing but a formula which can be used to obtain the object value. Every object can be in two states. Initially when \grg\ starts all objects are in \emph{indefinite} state, i.e. nothing is known about their value. \index{Object value} Since \grg\ always works in some concrete frame and coordinate system the object value is a table of the components. As soon as the value of certain object is obtained either by direct assignment or using some built-in formula (way of calculation) \grg\ remember this value and store it in some internal table. Later this value can be printed, re-evaluated used in expression etc. The object can be returned to its initial indefinite state using the command \comm{Erase}.\cmdind{Erase} \grg\ uses object symmetries to reduce total number of components to store. The complete list of built-in \grg\ objects is given in appendix C. The chapter 3 also describes built-in objects but in the usual mathematical style. The equivalent commands \cmdind{Show \parm{object}} \command{Show \parm{object};\\\tt% ?~\parm{object};} prints detailed information about the object \parm{object} including object name, identifier, list of indices, type of the component, current state (is the value of an object known or not), symmetries and ways of calculation. Here \parm{object} is either object name or its identifier. The command\cmdind{Show *} \command{Show *;} prints complete list of built-in object names. This list is quite long and the command \command{Show \parm{c}*;} gives list of objects whose names begin with the character \parm{c} (\comm{a}--\comm{z}). Finally the command \cmdind{Show All} \command{Show All;} prints list of objects whose values are currently known. Notice that some built-in objects has limited scope. In particular some objects exists only in certain dimensionality, the quantities which are specific to spaces with torsion are defined iff switch \comm{TORSION} is turned on etc. Let us consider some examples. We begin with the curvature tensor $R^a{}_{bcd}$ \begin{slisting} <- Show Riemann Tensor; Riemann tensor RIM'a.b.c.d is Scalar Value: unknown Symmetries: a(3,4) Ways of calculation: Standard way (D,OMEGA) \end{slisting} This object has name {\tt Riemann Tensor} and identifier {\tt RIM}. The object is {\tt Scalar} (0-form) valued and has four frame indices. Frame indices are denoted by the lower-case characters and their upper or lower position are denoted by \comm{'} or \comm{.} respectively. The Riemann tensor is antisymmetric in two last indices which is denoted by \comm{a(3,4)}. The curvature 2-form $\Omega^a{}_b$ \begin{slisting} <- ? OMEGA; Curvature OMEGA'e.f is 2-form Value: unknown Ways of calculation: Standard way (omega) From spinorial curvature (OMEGAU*,OMEGAD) \end{slisting} has name {\tt Curvature} and the identifier {\tt OMEGA} and is 2-form valued. The traceless Ricci spinor (the quantity which is usually denoted in the Newman-Penrose formalism as $\Phi_{AB\dot{C}\dot{D}}$) \begin{slisting} <- ? Traceless Ricci Spinor; Traceless ricci spinor RC.AB.CD~ is Scalar Value: unknown Symmetries: h(1,2) Ways of calculation: From spinor curvature (OMEGAU,SD,VOL) \end{slisting} Spinorial indices are denoted by upper case characters with the trailing \comm{\cc} for conjugated indices. Usual spinorial indices are denoted by a \emph{single} upper case letter while summed indices are denoted by several characters. Thus, the traceless Ricci spinor has two summed spinorial indices of rank 2 each taking the values from 0 to 2. The spinor is hermitian \comm{h(1,2)}. The Einstein equation is an example of equation \begin{slisting} <- ? Einstein Equation; Einstein equation EEq.g.h is Scalar Equation Value: unknown Symmetries: s(1,2) Ways of calculation: Standard way (G,RIC,RR,TENMOM) \end{slisting} and 1-form $\Gamma^\alpha{}_\beta$ is an example of the connection \enlargethispage{2mm} \begin{slisting} <- Show Holonomic Connection; \reversemarginpar Holonomic connection GAMMA^x_y is 1-form Holonomic Connection Value: unknown Ways of calculation: From frame connection (T,D,omega) \end{slisting} The coordinate indices are denoted by the lower-case letters with labels \comm{\^} and \comm{\_} denoting upper and lower index position respectively. Notice that above the first ``{\tt Holonomic connection}'' is the name of the object while second ``{\tt Holonomic Connection}'' means that \grg\ recognizes it as the connection and will use \comm{GAMMA} to construct covariant derivatives for quantities having the coordinate indices. \seethis{See \pref{cder} about the covariant derivatives.} You can define any number of other holonomic connections and use them in the covariant derivatives on the equal footing with the built-in object \comm{GAMMA}. \normalmarginpar The notation in which command \comm{Show} prints information about a particular object is the same as in the new object declaration and is explained in details below. \subsection{Macro Objects} \index{Macro Objects}\label{macro} There is also another class of built-in objects which are called \emph{macro objects}. The main difference between the usual and macro objects is that macro quantities has no permanent storage to their components instead they are calculated dynamically only when its component is required in some expression. In addition they do not have names and are denoted only by the identifier only. Usually macro objects play auxiliary role. The complete list of macro objects can be found in appendix B. The example of macro objects are the Christoffel symbols of second and first kind $\{{}^\alpha_{\beta\gamma}\}$ and $[{}_{\alpha,\beta\gamma}]$ having identifiers \comm{CHR} and \comm{CHRF} respectively \begin{slisting} <- Show CHR; CHR^x_y_z is Scalar Macro Object Symmetries: s(2,3) <- ? CHRF; CHRF_u_v_w is Scalar Macro Object Symmetries: s(2,3) \end{slisting} \subsection{New Object Declaration} \grg\ has very large number of built-in quantities but you are not obliged to use them in your calculations instead you can define new quantities. The command\cmdind{New Object} \command{New Object \parm{ID}\,\opt{\parm{ilst}}\,\opt{is \parm{ctype}}\,\opt{with \opt{Symmetries}\,\parm{slst}};} declares a new object. The words \comm{New} or \comm{Object} are optional (but not both) so the above command are equivalent to \command{Object \parm{ID}\,\opt{\parm{ilst}}\,\opt{is \parm{ctype}}\,\opt{with \opt{Symmetries}\,\parm{slst}};\\\tt New \parm{ID}\,\opt{\parm{ilst}}\,\opt{is \parm{ctype}}\,\opt{with \opt{Symmetries}\,\parm{slst}}; } Here \parm{ID} is an identifier of a new object. The identifier can contain letters \comm{a}--\comm{z}, \comm{A}--\comm{Z} but neither digits nor any other symbols. The identifier must be unique and cannot coincide with the identifier of any other built-in or user-defined object. The \parm{ilist} is the list of indices having the form \label{indices} \command{\rpt{\parm{ipos}\ \parm{itype}}} where \parm{ipos} defines the index position and \parm{itype} specifies its type. The coordinate holonomic and frame indices are denoted by single lower-case letters with \parm{ipos} \command{{\tt '}\rm\ \ upper frame index \\{\tt .}\rm\ \ lower frame index \\{\tt \^}\rm\ \ upper holonomic index \\{\tt \_}\rm\ \ lower holonomic index} The frame and holonomic indices in \grg\ take values from 0 to $d-1$ where $d$ is the current space dimensionality.\index{Dimension} Spinorial indices are denoted by upper case letters with trailing \comm{\cc} for conjugated spinorial indices: \comm{A}, \comm{B\cc} etc. Summed spinorial index of rank $n$ is denoted by $n$ upper-case letters. For example \comm{ABC} denotes summed spinorial index of the rank 3 (runs from 0 to 3) and \comm{AB\cc} denotes conjugated summed index of the rank 2 (values 0, 1, 2). The upper position for spinorial indices are denoted either by \comm{'} or \comm{\^} and lower one by \comm{.} or \comm{\_}. Finally the enumerating indices are denoted by a single lower-case letter followed either by digits or by \comm{dim}. For example the index declared as \comm{i2} runs from 0 to 2 while specification \comm{a13} denotes index whose values runs from 0 to 13. The specification \comm{idim} denotes enumerating index which takes the values from 0 to $d-1$. Upper of lower position for enumerating indices are identical, thus in this case symbols \comm{' . \^ \_} are equivalent. The \parm{ctype} defines the type of new object component: \command{Scalar \opt{Density \parm{dens}}\\\tt \parm{p}-form \opt{Density \parm{dens}}\\\tt Vector \opt{Density \parm{dens}}} This part of the declaration can be omitted and then the object is assumed to be scalar-valued. The \parm{dens} defines pseudo-scalar and density properties of the object with respect to coordinate and frame transformations: \command{\opt{sgnL}\opt{*sgnD}\opt{*L\^\parm{n}}\opt{*D\^\parm{m}}} where \comm{D} and \comm{L} is the coordinate transformation determinant ${\rm det}(\partial x^{\alpha'}/\partial x^\beta)$ and frame transformation determinant ${\rm det}(L^a{}_b)$ respectively. If \comm{sgnL} or \comm{sgnD} is specified then under appropriate transformation the object must be multiplied on the sign of the corresponding determinant (pseudo tensor). The specification \comm{L\^\parm{n}} or \comm{D\^\parm{m}} means that the quantity must be multiplied on the appropriate degree of the corresponding determinant (tensor density). The parameters \parm{p}, \parm{n} and \parm{m} may be given by expressions (must be enclosed in brackets) but value of these expressions must be always integer and positive in the case of \parm{p}. The symmetry specification \parm{slst} is a list \command{\rpt{\parm{slst1}}} where each element \parm{slst1} describes symmetries for one group of indices and has the form \command{\parm{sym}(\rpt{\parm{slst2}})} The \parm{sym} determines type of the symmetry \command{% \tt s \ \rm symmetry \\ \tt a \ \rm antisymmetry \\ \tt c \ \rm cyclic symmetry \\ \tt h \ \rm Hermitian symmetry} and \parm{slst2} is either index number \parm{i} or list of index numbers \comm{(\rpt{\parm{i}})} or another symmetry specification of the form \parm{slst1}. Notice that $n$th object index can be present only in one of the \parm{slst1}. Let us consider an object having four indices. Then the following symmetry specifications are possible \begin{tabular}{ll} \comm{s(1,2,3,4)} & total symmetry \\[1mm] \comm{a(1,2),s(3,4)} & antisymmetry in first pair of indices and \\ & symmetry in second pair \\[1mm] \comm{s((1,2),(3,4))} & symmetry in pair permutation \\[1mm] \comm{s(a(1,2),a(3,4))} & antisymmetry in first and second pair of indices \\ & and symmetry in pair permutation \end{tabular}\newline The last example is the well known symmetry of Riemann curvature tensor. The specification \comm{a(1,2),s(2,3)} is erroneous since second index present in both parts of the specification which is not allowed. Declaration for new equations is completely similar\cmdind{New Equation} \command{\opt{New} Equation \parm{ID}\,\opt{\parm{ilst}}\,\opt{is \parm{ctype}}\,\opt{with \opt{Symmetries}\,\parm{slst}};} \grg\ knows four types of connections:\cmdind{New Connection} \label{conn2} \begin{list}{$\bullet$}{\labelwidth=4mm\leftmargin=\parindent} \item Frame Connection 1-form $\omega^a{}_b$ having first upper and second lower frame indices \item Holonomic Connection 1-form $\Gamma^\alpha{}_\beta$ having first upper and second lower coordinate indices \item Spinor Connection 1-form $\omega_{AB}$ with lower spinor index of rank 2 \item Conjugated Spinor Connection $\omega_{\dot{A}\dot{B}}$ 1-form with lower conjugated spinor index of rank 2 \end{list} Each of these connections are used to construct covariant derivatives with respect to corresponding indices. In addition they are properly transformed under the coordinate change and frame rotation. There are complete set of built-in connections but you can declare a new one by the command \command{% \opt{New} Connection \parm{ID}'a.b \opt{is 1-form};\\\tt \opt{New} Connection \parm{ID}\^m\_n \opt{is 1-form};\\\tt \opt{New} Connection \parm{ID}.AB\ \opt{is 1-form};\\\tt \opt{New} Connection \parm{ID}.AB\cc\ \opt{is 1-form};} Notice that any new connection must belong to one of the listed above types and have indicated type and position of indices. This representation of connection is chosen in \grg\ for the sake of definiteness. There is one special case when new object can be declared without explicit \comm{New Object} declaration. Let us consider the following example: \begin{slisting} <- Coordinates t, x, y, z; <- www=d x; <- Show www; www is 1-form Value: known \end{slisting} If we assign the value to some identifier \parm{id} (\comm{www} in our example) \seethis{See page \pageref{assig} about assignment command.} and this identifier is not reserved yet by any other object then \grg\ automatically declares a new object without indices labeled by the identifier \parm{id} and having the type of the expression in the right-hand side of the assignment (1-form in our example). Notice that the \parm{id} must not include digits since digits represent indices and any new object with indices must be declared explicitly. The command \command{Forget \parm{ID};} completely removes the user-defined object with the identifier \parm{ID}. Finally let us consider some examples: \begin{slisting} <- Coordinates t, x, y, z; <- New RNEW'a.b_c_d is scalar density sgnD with a(3,4); <- Show RNEW; RNEW'a.b_x_y is Scalar Density sgnD Value: unknown Symmetries: a(3,4) <- Null Metric; <- Connection omnew.AA; <- Show omnew; omnew.AB is 1-form Spinor Connection Value: unknown \end{slisting} Here the first declaration defines a new scalar valued pseudo tensor $\mbox{\comm{RNEW}}^a{}_{b\gamma\delta}$ which is antisymmetric in the last pair of indices. Second declaration introduce new spinor connection \comm{omnew}. Notice that new connection is automatically declared 1-form and the type of connection is derived by the type of new object indices (lower spinorial index of rank 2 in our example). \section{Assignment Command} \index{Assignment (command)}\label{assig} The assignment command sets the value to the particular components of the object. In general it has the form \command{\opt{\parm{Name}} \rpt{\parm{comp} = \parm{expr}};} or for equations \command{\opt{\parm{Name}} \rpt{\parm{comp} = \parm{lhs}=\parm{rhs}};} Here \parm{Name} is the optional object name. If the object has no indices then \parm{comp} is the object identifier. If the object has indices then \parm{comm} consist of identifier with additional digits denoting indices. For example the following command assigns standard spherical flat value to the frame $\theta^a$ \begin{listing} Frame T0 = d t, T1 = d r, T2 = r*d theta, T3 = r*SIN(theta)*d phi; \end{listing} and the command \begin{listing} RIM0123 = 100; \end{listing} assigns the value to the $R^0{}_{123}$ component of the Riemann tensor. Notice that in this notation each digit is considered as one index, thus it does not work if the value of some index is greater than 9 (e.g. if dimensionality is 10 or greater). In this case another notation can be used in which indices are added to the object identifier as a list of digits enclosed in brackets \command{\opt{\parm{Name}} \parm{ID}(\rpt{\parm{n}})~= \parm{expr};} In particular the command \begin{listing} RIM(0,1,2,3) = 100; \end{listing} is equivalent to the example above. The assignment set value only to the certain components of an object leaving other components unchanged. But if before assignment the object was in indefinite state (no value is known) then assignment turns it to the definite state and all other components of the object are assumed to be zero. The digits standing for object indices in the left-hand side of an assignment can be replaced by identifiers \index{Assignment (command)!tensorial} \command{\opt{\parm{Name}} \parm{ID}(\rpt{\parm{id}})~= \parm{expr};} Such assignment is called \emph{tensorial} one. For example the following tensorial assignment set the value to the curvature 2-form $\Omega^a{}_b$ \begin{listing} OMEGA(a,b) = d omega(a,b) + omega(a,m){\w}omega(m,b); \end{listing} This command is equivalent to $d\times d$ of assignments where \comm{a} and \comm{b} take values from 0 to $d-1$ ($d$ is the space dimensionality).\index{Dimension} Notice that identifiers in the left-hand side of tensorial assignment must not coincide with any predefined or declared by the user constant or coordinate. It is possible to mix digits and identifiers: \begin{listing} FT(0,a) = 0; \end{listing} Here \comm{FT} is identifier of the built-in object {\tt EM Tensor} which is the electromagnetic strength tensor $F_{ab}$ and this command sets the electric part of the tensor to zero. The assignment command takes into account symmetries of the objects. For example {\tt EM Tensor} is antisymmetric and in order to assign value say to the components $F_{01}=-F_{10}$ it suffices to do this just for one of them \begin{slisting} <- Coordinates t, x, y, z; <- EM Tensor FT01=111, FT(3,2)=222; <- Write FT; EM tensor: FT = 111 t x FT = -222 y z \end{slisting} We can see that \grg\ automatically transforms indices to the \emph{canonical} order. This rule works in the case or tensorial assignment as well \begin{slisting} <- Coordinates t, x, y, z; <- Function ff; <- EM Tensor FT(a,b)=ff(a,b); <- Write FT; EM tensor: FT = ff(0,1) t x FT = ff(0,2) t y FT = ff(0,3) t z FT = ff(1,2) x y FT = ff(1,3) x z FT = ff(2,3) y z <- FT(2,1); - ff(1,2) \end{slisting} In this case both parameters \comm{a} and \comm{b} runs from 0 to 3 but \grg\ assigns the value only to the components having indices in the canonical order \comm{a}$<$\comm{b}. \grg\ follows this rule also if in the left-hand side of tensorial assignment digits are mixed with parameters which may sometimes produce unexpected result: \begin{slisting} <- Coordinates t, x, y, z; <- Function ee; <- FT(0,a)=ee(a); <- Write FT; EM tensor: FT = ee(1) t x FT = ee(2) t y FT = ee(3) t z <- Erase FT; <- FT(3,a)=ee(a); <- Write FT; EM tensor: 0 \end{slisting} Observe the difference between these two assignments (the command \comm{Erase FT;} destroys the previously assigned value). In fact second assignment assigns no values since \comm{3} and \comm{a} are not in the canonical order \comm{3}$\geq$\comm{a} for \comm{a} running from 0 to 3. Notice the difference from the case when all indices in the left-hand side are given by the explicit numerical values. In this case \grg\ automatically transforms the indices to their canonical order and \comm{FT(3,2)=222;} is equivalent to \comm{FT(2,3)=-222;}. Finally there is one more form of the tensorial assignment which can be applied to the summed spinorial indices. \index{Assignment (command)!summed spinor indices} Let us consider the spinorial analogue of electromagnetic strength tensor $\Phi_{AB}$. This spinor is irreducible (i.e. symmetric in $\scriptstyle AB$). The corresponding \grg\ built-in object {\tt Undotted EM Spinor} (identifier \comm{FIU}) has one summed spinorial index of rank 2. Let us consider two different assignment commands \begin{slisting} <- Coordinates u, v, z, z~; z & z~ - conjugated pair. <- Null Metric; <- Function ee; <- FIU(a)=ee(a); <- Write FIU; Undotted EM spinor: FIU = ee(0) 0 FIU = ee(1) 1 FIU = ee(2) 2 <- Erase FIU; <- FIU(a+b)=ee(a,b); <- Write FIU; Undotted EM spinor: FIU = ee(0,0) 0 FIU = ee(0,1) 1 FIU = ee(1,1) 2 \end{slisting} In the first case \comm{a} is treated as a summed index and runs from 0 to 2 but in the second case \comm{a} and \comm{b} are considered as usual single SL(2,C) spinorial indices each having values 0 and 1. The notation for the object components in the left-hand side of assignment do not distinguishes upper and lower indices. Actually the indices are always assumed to be in the default position. You can always check the default index types and positions using the command \comm{Show \parm{object};}.\cmdind{Show \parm{object}} For example the {\tt Riemann Tensor} has first upper and three lower frame indices and the command \comm{RIM0123=100;} and \comm{RIM(0,1,2,3)=100;} both assign value to the $R^0{}_{123}$ component of the tensor where indices are represented with respect to the current frame. \section{Geometry} The number of built-in objects in \grg\ is rather large. They all described in chapter 3 and appendices B and C. In this section we consider only the most important ones. \subsection{Metric, Frame and Line-Element} \index{Metric}\index{Frame} \label{metric} The line-element in \grg\ is defined by the following equation \begin{equation} ds^2 = g_{ab}\,\theta^a\!\otimes\theta^b \end{equation} where $\theta^a=h^a_\mu dx^\mu$ is the frame 1-form and $g_{ab}$ is the frame metric. The corresponding built-in objects are \comm{Frame} (identifier \comm{T}) and \comm{Metric} (identifier \comm{G}). There are also the ``inverse'' counterparts $\partial_a=h_a^\mu\partial_\mu$ ({\tt Vector Frame}, identifier \comm{D}) and $g^{ab}$ ({\tt Inverse Metric}, identifier \comm{GI}). To determine the metric properties of the space you can assign some values to both the metric and the frame. There are two well known special cases. First is the usual coordinate formalism in which frame is holonomic $\theta^a=dx^\alpha$. In this case there is no difference between frame and coordinate indices. Another representation is known as the tetrad (in dimension 4) formalism. In this case frame metric equals to some constant matrix $g_{ab}=\eta_{ab}$ and significant information about line-element ``is encoded'' in the frame. In general both metric and frame can be nontrivial but not necessarily. If no any value is given by user to the frame when \grg\ automatically assumes that frame is \emph{holonomic} \index{Frame!default value} \begin{equation} \theta^a=dx^\alpha \end{equation} Thus if we assign the value to metric only we automatically get standard coordinate formalism. On the contrary if no value is assigned to the metric then \grg\ automatically assumes\index{Signature} \label{defaultmetric} \index{Metric!default value} \begin{equation} g_{ab} = {\rm diag}(+1,-1,\dots) \end{equation} where $+1$ and $-1$ on the diagonal of the matrix correspond to the current signature specification. Notice that current signature is printed among other information by the command\cmdind{Show Status}\cmdind{Status} \command{\opt{Show} Status;} and current line-element is printed by the command \cmdind{ds2} \command{ds2;} or equivalently\cmdind{Line-Element} \command{Line-Element;} Finally if neither frame nor metric are specified by user then both these quantities acquire default value and we automatically obtain flat space of the default signature: \begin{slisting} <- Dimension 4 with Signature(-,+,+,+); <- Coordinates t, x, y, z; <- ds2; Assuming Default Metric. Metric calculated By default. 0.05 sec Assuming Default Holonomic Frame. Frame calculated By default. 0.05 sec 2 2 2 2 2 ds = - d t + d x + d y + d z \end{slisting} \subsection{Spinors} \label{spinors} Spinorial representations exist in spaces of various dimensions and signatures but in \grg\ spinors are restricted to the 4-dimensional spaces of Lorentzian signature ${\scriptstyle(-,+,+,+)}$ or ${\scriptstyle(+,-,-,-)}$ only. Another restriction is that in the spinorial formalism the metric must be the \index{Metric!Standard Null} \emph{standard null metric}: \index{Standard null metric}\index{Spinors}\index{Spinors!Standard null metric} \begin{equation} g_{ab}=g^{ab}=\pm\left(\begin{array}{rrrr} 0 & -1 & 0 & 0 \\ -1 & 0 & 0 & 0 \\ 0 & 0 & 0 & 1 \\ 0 & 0 & 1 & 0 \end{array}\right) \end{equation} where upper sign correspond to the signature ${\scriptstyle(-,+,+,+)}$ and lower sign to the signature ${\scriptstyle(+,-,-,-)}$. There is special command\cmdind{Null Metric} \command{Null Metric;} which assigns this standard value to the metric. Thus spinorial frame (tetrad) in \grg\ must be null \begin{equation} ds^2 = \pm(-\theta^0\!\otimes\theta^1 -\theta^1\!\otimes\theta^0 +\theta^2\!\otimes\theta^3 +\theta^3\!\otimes\theta^2) \end{equation} and conjugation rules for this tetrad must be \begin{equation} \overline{\theta^0}=\theta^0,\quad \overline{\theta^1}=\theta^1,\quad \overline{\theta^2}=\theta^3,\quad \overline{\theta^3}=\theta^2 \end{equation} For the sake of efficiency the sigma-matrices $\sigma^a\!{}_{A\dot{B}}$ for such a tetrad are chosen in the simplest form. The only nonzero components of the matrices are\index{Sigma matrices} \begin{eqnarray} &&\sigma_0{}^{1\dot{1}}= \sigma_1{}^{0\dot{0}}= \sigma_2{}^{1\dot{0}}= \sigma_3{}^{0\dot{1}}=1 \\[1mm] && \sigma^0{}_{1\dot{1}}= \sigma^1{}_{0\dot{0}}= \sigma^2{}_{1\dot{0}}= \sigma^3{}_{0\dot{1}}=\mp1 \end{eqnarray} \subsection{Connection, Torsion and Nonmetricity} \label{conn} As was explained above \grg\ recognizes four types of connections: holonomic $\Gamma^\alpha{}_\beta$, frame $\omega^a{}_b$, spinorial $\omega_{AB}$ and conjugated spinorial $\omega_{\dot{A}\dot{B}}$. Accordingly there are four built-in objects: {\tt Holonomic Connection} (id. \comm{GAMMA}), {\tt Frame Connection} (id. \comm{omega}), {\tt Undotted Connection} (id. \comm{omegau}), {\tt Dotted Connection} (id. \comm{omegad}). Connections are used in \grg\ in covariant derivatives. In addition they are properly transformed under frame and coordinate transformations. By default the connection in \grg\ are assumed to be Riemannian. In particular in this case holonomic connection is nothing but Christoffel symbols $\Gamma^\alpha{}_\beta= \{{}^\alpha_{\beta\pi}\}dx^\pi$. If it is necessary to work with torsion and/or nonmetricity \swind{TORSION}\swind{NONMETR} then the switches \comm{TORSION} and/or \comm{NONMETR} must be turned on. \seethis{See \pref{conn2} about the built-in connections.} In this case the Riemannian analogues or the aforementioned four connections are available as well. \section{Expressions} Expressions in \grg\ can be algebraic (scalar), vector or p-form valued. \grg\ knows all the usual mathematical operations on algebraic expressions, exterior forms and vectors. \subsection{Operations and Operators} The operations known to \grg\ are presented in the form of the table. Operations are subdivided into six groups separated by horizontal lines. Operations in each group have equal level of precedence and the precedence level decreases from the top to the bottom of the table. As in usual mathematical notation we can use brackets \verb"( )" to change operation precedence. Other constructions which can be used in expression are described below. \begin{table} \begin{center} \begin{tabular}{|c|c|c|} \hline {\bf Operation} & {\bf Description} & {\bf Grouping} \\ \hline {\tt [$v_1$,$v_2$]} & Vector bracket & \\ \hline {\tt @} $x$ & Holonomic vector $\partial_x$ & \\ \cline{1-2} {\tt d} $a$ & Exterior differential & \\ {\tt d} $\omega$ & & {\tt d} \cc$a$ $\Leftrightarrow$ {\tt (d(}\cc$a${\tt))} \\ \cline{1-2} {\tt \dd} $a$ & Dualization & \\ {\tt \dd} $\omega$ & & \\ \cline{1-2} {\tt \cc} $e$ & Complex conjugation & \\ \hline $a_1${\tt **}$a_2$ & Exponention & \\ $a_1${\tt\^} $a_2$ & & \\ \hline $e$\ {\tt /}\ $a$ & Division & $e${\tt /}$a_1${\tt /}$a_2$ $\Leftrightarrow$ {\tt (}$e${\tt /}$a_1${\tt )/}$a_2$ \\ \hline $a$\ {\tt *}\ $e$ & Multiplication & \\ \cline{1-2} $v$\ {\tt |}\ $a$ & Vector acting on scalar & $v$\ii$\omega_1$\w$\omega_2${\tt *}$a$ \\ \cline{1-2} $v$\ \ip\ $\omega$ & Interior product & $\Updownarrow$ \\ \cline{1-2} $v_1$\ {\tt.}\ $v_2$& Scalar product & $v$\ii{\tt (}$\omega_1$\w{\tt(}$\omega_2${\tt *}$a${\tt ))} \\ $v$\ {\tt.}\ $o$ & & \\ $o_1$\ {\tt.}\ $o_2$& & \\ \cline{1-2} $\omega_1$\ \w\ $\omega_2$ & Exterior product & \\ \hline {\tt +}\ $e$ & Prefix plus & \\ \cline{1-2} {\tt -}\ $e$ & Prefix minus & \\ \cline{1-2} $e_1$\ {\tt +}\ $e_2$ & Addition & \\ \cline{1-2} $e_1$\ {\tt -}\ $e_2$ & Subtraction & \\ \hline \end{tabular} \end{center} \label{operators} \caption{Operation and operators. Here: $e$ is any expression, $a$ is any scalar valued (algebraic) expressions, $v$ is any vector valued expression, $x$ is a coordinate, $o$ is any 1-form valued expression, $\omega$ is any form valued expression.} \end{table} \subsection{Variables and Functions} Operator listed in the table 2.2 act on the following types of the operands: \begin{itemize} \item[(i)] integer numbers (e.g. {\tt 0}, {\tt 123}), \item[(ii)] symbols or identifiers (e.g. {\tt I}, {\tt phi}, {\tt RIM0103}), \item[(iii)] functional expressions (e.g. {\tt SIN(x)}, {\tt G(0,1)} etc). \end{itemize} Valid identifier must belong to one of the following types: \begin{itemize} \item Coordinate. \item User-defined or built-in constant. \item Function declared with the implicit dependence list. \item Component of an object. \end{itemize} Any valid functional expression must belong to one of the following types: \itemsep=0.5mm \begin{itemize} \item User-defined function. \item Function defined in \reduce\ (operator). \item Component of built-in or user-defined object in functional notation. \item Some special functional expressions listed below. \end{itemize} \subsection{Derivatives} The derivatives in \grg\ and \reduce\ are written as \command{DF(\parm{a},\rpt{\parm{x}\opt{,\parm{n}}})} where \parm{a} is the differentiated expression, \parm{x} is the differentiation variable and integer number \parm{n} is the repetition of the differentiation. For example \[ \mbox{\tt DF(f(x,y),x,2,y)}=\frac{\partial^3f(x,y)}{\partial^2x\partial y} \] There are also another type of derivatives \command{DFP(\parm{a},\rpt{\parm{x}\opt{,\parm{n}}})} \seethis{See section \ref{genfun} about the generic functions.} They are valid only after {\tt Generic Function} declaration if the package \file{dfpart} is installed on your system. \subsection{Complex Conjugation} Symbol \comm{\cc\cc} in the sum of terms is an abbreviation: \command{% \tt $e$ + \cc\cc\ $=$\ $e$ + \cc$e$ \\ \tt $e$ - \cc\cc\ $=$\ $e$ - \cc$e$ } Functions \comm{Re} and \comm{Im} gives real and imaginary parts of an expression: \command{% \tt Re($e$)\ $=$\ ($e$+\cc$e$)/2 \\ \tt Im($e$)\ $=$\ I*(-$e$+\cc$e$)/2} \subsection{Sums and Products} The following expressions represent sum and product \command{Sum(\rpt{\parm{iter}},\parm{e})\\\tt Prod(\rpt{\parm{iter}},\parm{e})} where \parm{e} is the summed expression and \parm{iter} defines summation variables. The range of summation can be \label{iter} specified by two methods. First ``long'' notation is \command{\parm{id} = \parm{low}..\parm{up}} and the identifier \parm{id} runs from \parm{low} up to \parm{up}. Both \parm{low} and \parm{up} can be given by arbitrary expressions but value of these expressions must be integer. The \parm{low} can be omitted \command{\parm{id} = \parm{up}} and in this case \parm{id} runs from 0 to \parm{up}. The identifier \parm{id} should not coincide with any built-in or user-defined variable. In ``short'' notation \parm{iter} is just identifier \label{siter} \parm{id} and its range is determined using the following rules \begin{list}{$\bullet$}{\labelwidth=4mm\leftmargin=\parindent} \item Mixed letter-digit \parm{id} runs from 0 to $d-1$ where $d$ is the space dimensionality. \begin{verbatim} Aid j2s \end{verbatim} \item The \parm{id} consisting of lower-case letters runs from $0$ to $d-1$ \begin{verbatim} j a abc kkk \end{verbatim} \item The \parm{id} consisting of upper-case letters runs from $0$ to the number of letters in \parm{id}, e.g. the following identifiers run from 0 to 1 and from 0 to 3 respectively \begin{verbatim} B ABC \end{verbatim} \item Letters with one trailing digit run from 0 to the value of this digit. Both \parm{id} below runs from 0 to 3: \begin{verbatim} j3 A3 \end{verbatim} \item Letters with two digits run from the value of the first digit to the value of the second digit. The \parm{id} below run from 2 to 3: \begin{verbatim} j23 A23 \end{verbatim} \item Letters with 3 or more digits are incorrect \begin{verbatim} j123 \end{verbatim} \end{list} Two or more summation parameters are separated either by commas or by one of the relational operators \begin{listing} < > <= => \end{listing} This means that only the terms satisfying these relations will be included in the sum. For example \[ \mbox{\tt Sum(i24<=ABC,k=1..d-1,f(i24,ABC,k))} = \sum_{i=2}^{4} \sum_{\scriptstyle a=0\atop\scriptstyle i\leq a}^{3} \sum^{d-1}_{k=1} f(i,a,k) \] \enlargethispage{5mm} \grg's \comm{Sum} and \comm{Prod} \seethis{Use \comm{SUM}, \comm{PROD} or \comm{sum}, \comm{prod} depending on \reduce\ internal case as explained on page \pageref{case}.} should not be confused with \reduce's \comm{SUM} and \comm{PROD} which are also available in \grg. \grg's \comm{Sum} apply to any scalar, vector or form-valued expressions and always expanded by \grg\ into the appropriate explicit sum of terms. On the contrary \comm{SUM} defined in \reduce\ can be applied to the algebraic expressions only. \grg\ leaves such expression unchanged and passes it to the \reduce\ algebraic evaluator. Unlike \comm{Sum} the summation limits in \comm{SUM} can be given by algebraic expressions. If value of these expressions is integer then result of the \comm{SUM} will be the same as for \comm{Sum} but if summation limits are symbolic sometimes \reduce\ is capable to find a closed expression for such a sum but not always. See the following example \begin{slisting} <- Coordinates t, x, y, z; <- Function f; <- Constants n, m; <- Sum(k=1..3,f(k)); f(3) + f(2) + f(1) <- SUM(f(n),n,1,3); f(3) + f(2) + f(1) <- SUM(n,n,1,m); m*(m + 1) ----------- 2 <- SUM(f(n),n,1,m); SUM(f(n),n,1,m) \end{slisting} \newpage \subsection{Einstein Summation Rule} According to the Einstein summation rule if \grg\ encounters some unknown repeated identifier \parm{id} then summation over this \parm{id} is performed. The range of the summation variable is determined according to the ``short'' notation explained in the previous section. \subsection{Object Components and Index Manipulation} The components of built-in or user-defined object can be denoted in expressions by two methods which are similar to the notation used in the left-hand side of the assignment command. The first method uses the object identifier with additional digits denoting the indices {\tt T0}, {\tt RIM0213}. The second method uses the functional notation {\tt T(0)}, {\tt RIM(0,2,1,3)}, {\tt OMEGA(j,k)}. In functional notation the default index type and position \index{Index manipulations} can be changed using the markers: {\tt '} upper frame, {\tt .} lower frame, {\tt \^} upper holonomic, {\tt \_} lower holonomic. For example expression {\tt RIM(a,b,m,n)} gives components of Riemann tensor with the default indices $R^a{}_{bmn}$ (first upper frame and three lower frame indices) while expression {\tt RIM('a,'b,\_m,\_n)} gives $R^{ab}{}_{\mu\nu}$ with two upper frame and two lower coordinate indices. For enumerating indices position markers are ignored and only {\tt '} and {\tt .} works for spinorial indices. In the spinorial formalism \seethis{See \pref{spinors} about spinorial formalism.} each frame index can be replaced by a pair if spinorial indices according to the formulas: \[ A^a\sigma_a{}^{B\dot{D}}=A^{B\dot{D}},\qquad B_a\sigma^a\!{}_{B\dot{D}}=B_{B\dot{D}} \] Accordingly any frame index can be replaced by a pair of spinorial indices. \label{sumspin} Similarly one summed spinorial index or rank $n$ can be replaced by $n$ single spinor indices. There is only one restriction. If an object has several frame and/or summed spinorial indices then \emph{all} must be represented in such expanded form. In the following example the null frame $\theta^a$ is printed in the usual and spinorial $\theta^{B\dot C}$ representations. The relationship $\theta^a\sigma_a{}^{B\dot C}-\theta^{B\dot C}=0$ is verifies as well \begin{slisting} <- Coordinates u, v, z, z~; z & z~ - conjugated pair. <- Null Metric; <- Frame T(a)=d x(a); <- ds2; \newpage 2 ds = (-2) d u d v + 2 d z d z~ <- T(a); a=0 : d u a=1 : d v a=2 : d z a=3 : d z~ <- T(B,C); B=0 C=0 : d v B=0 C=1 : d z~ B=1 C=0 : d z B=1 C=1 : d u <- T(a)*sigmai(a,B,C)-T(B,C); 0 \end{slisting} \subsection{Parts of Equations and Solutions} \index{Equations!in expressions} The functional expressions \command{LHS(\parm{eqcomp})\\\tt RHS(\parm{eqcomp})} give access to the left-hand and right-hand side of an equation respectively. Here \parm{eqcomp} is the component of the equation as explained in the previous section. The \comm{LHS}, \comm{RHS} also provide access to the \parm{n}'th \seethis{See page \pageref{solutions} about solutions.} solution if \parm{eqcomp} is \comm{Sol(\parm{n})}. \subsection{Lie Derivatives} \index{Lie derivatives} The Lie derivative is given by the expression \command{Lie(\parm{v},\parm{objcomp})} where \parm{objcomp} is the component of an object in functional notation. For example the following expression is the Lie derivative of the metric $\pounds_vg_{ab}$ \begin{listing} Lie(vec,G(a,b)); \end{listing} The index manipulations in the Lie derivatives are permitted. In particular the expression \begin{listing} Lie(vec,G(^m,b)); \end{listing} is the Lie derivative of the frame $\pounds_vg^\mu{}_{b} \equiv \pounds_vh^\mu_a$ and must vanish. \subsection{Covariant Derivatives and Differentials} \index{Covariant derivatives}\index{Covariant differentials} \label{cder} The covariant differential \command{Dc(\parm{objcomp}\opt{{\upshape\tt ,}\rpt{\parm{conn}}})} and covariant derivative \command{Dfc(\parm{v},\parm{objcomp}\opt{{\upshape\tt ,}\rpt{\parm{conn}}})} Here \parm{objcomp} is an object component in functional notation and \parm{v} is a vector-valued expression. The optional parameters \parm{conn} are the identifiers of connections. \seethis{See page \pageref{conn} about the built-in connections.} If \parm{conn} is omitted then \grg\ uses default connection for each type of indices: frame, coordinate, spinor and conjugated spinor. If \parm{conn} is indicated then \grg\ uses this connection instead of default one for appropriate type of indices. For example expression \begin{listing} Dc(OMEGA(a,b)) \end{listing} is the covariant differential of the curvature 2-form $D\Omega^a{}_b$. This expression should vanish in Riemann space and should be proportional to the torsion in Riemann-Cartan space. Here \grg\ will use default object {\tt Frame connection} (id. \comm{omega}). The expression \begin{listing} Dc(OMEGA(a,b),romega) \end{listing} is similar but it uses another built-in connection {\tt Riemann frame connection } (id. \comm{romega}) which are different if torsion or nonmetricity are nonzero. The index manipulations are allowed in the covariant derivatives. For example the expression \begin{listing} Dfc(v,RIC(\^m,\_n)) \end{listing} gives the covariant derivative of the curvature of the Ricci tensor with first coordinate upper and second coordinate lower indices $\nabla_vR^\mu{}_\nu$. \subsection{Symmetrization} The functional expressions works iff the switch \swind{EXPANDSYM} \comm{EXPANDSYM} is on \command{% Asy(\rpt{\parm{i}},\parm{e})\\\tt Sy(\rpt{\parm{i}},\parm{e})\\\tt Cy(\rpt{\parm{i}},\parm{e})} They produce antisymmetrization, symmetrization and cyclic symmetrization of the expression \parm{e} with respect to \parm{i} without corresponding $1/n$ or $1/n!$. \subsection{Substitutions} \index{Substitutions}\label{subs} The expression \command{SUB(\rpt{\parm{sub}},\parm{e})} is similar to the analogous expression in \reduce\ with two generalizations: (i) it applies not only to algebraic but to form and vector valued expression \parm{e} as well, \seethis{See page \pageref{solutions} about solutions.} (ii) as in {\tt Let} command \parm{sub} can be either the relation {\tt \parm{l}\,=\,\parm{r}} or solution {\tt Sub(\parm{n})}. \subsection{Conditional Expressions} \index{Conditional expressions}\index{Boolean expressions} The conditional expression \command{If(\parm{cond},\parm{e1},\parm{e2})} chooses \parm{e1} or \parm{e2} depending on the value of the boolean expression \parm{cond}. Boolean expression appears in (i) the conditional expression \label{bool} {\tt If}, (ii) in {\tt For all Such That} substitutions. Any nonzero expression is considered as {\bf true} and vanishing expression as {\bf false}. Boolean expressions may contain the following usual relations and logical operations: {\tt < > <= >= = |= not and or}. They also may contain the following predicates \vspace*{2mm} \begin{tabular}{|l|l|} \hline \tt OBJECT(\parm{obj}) & Is \parm{obj} an object identifier or not \\ \hline \tt ON(\parm{switch}) & Test position of the \parm{switch} \\ \tt OFF(\parm{switch}) & \\ \hline \tt ZERO(\parm{object}) & Is the value of the \parm{object} zero or not \\ \hline \tt HASVALUE(\parm{object}) & Whether the \parm{object} has any value or not \\ \hline \tt NULLM(\parm{object}) & Is the \parm{object} the standard null metric \\ \hline \end{tabular} \vspace*{2mm} \newline Here \parm{object} is an object identifier. The expression \comm{ERROR("\parm{message}")} causes an error with the \comm{"\parm{message}"}. It can be used to test any required conditions during the batch file execution. \subsection{Functions in Expressions} Any function which appear in expression must be either declared by the \comm{Function} declaration or be defined in \reduce\ (in \reduce\ functions are called operators). In general arguments of functions in \grg\ must be algebraic expression with one exception. If one (and only one) argument of some function $f$ is form-valued $\omega=a d x + b d y$ then \grg\ applies $f$ to the algebraic multipliers of the form $f(\omega) = f(a) d x+ f(b) d y$. The same rule works for vector-valued arguments. Let us consider the example in the \reduce\ operator \comm{LIMIT} is applied to the form-valued expression \begin{slisting} <- Coordinates t, x, y, z; <- www=(x+y)\^2/(x\^2-1)*d x+(x+y)/(x-z)*d y; <- www; 2 2 x + 2*x*y + y x + y (-----------------) d x + (-------) d y 2 x - z x - 1 <- LIMIT(www,x,INFINITY); d x + d y \end{slisting} I would like to remind also that depending on the particular \reduce\ system \reduce\ operators must be used in \grg\ in upper \comm{LIMIT} or lower case \comm{limit}. See page \pageref{case} for more details. Any function or operator defined in the \reduce\ package can be used in \grg\ as well. Some examples are considered in section \ref{packages}. \subsection{Expression Evaluation} \index{Expression evaluation} \grg\ evaluates expressions in several steps: (1) All \grg-specific constructions such as \comm{Sum}, \comm{Prod}, \comm{Re}, \comm{Im} etc are explicitly expanded. (2) If expression contains components of some built-in or user defined object they are replaced by the appropriate value. If the object is in indefinite state \seethis{See page \pageref{find} about the \comm{Find} command.} (no value of the object is known) then \grg\ tries to calculate its value by the method used by the \comm{Find} command. The automatic object calculation can be prevented by \swind{AUTO} turning the switch \comm{AUTO} off. If due to some reason the object cannot be calculated then expression evaluation is terminated with the error message. (3) After all object components are replaced by their values \grg\ performs all ``geometrical'' operations: exterior and interior products, scalar products etc. If expression is form-valued when it is reduced to the form $a\,dx^0\wedge dx^1\dots+b\,d x^1\wedge+\dots$ where $a$ and $b$ are algebraic expressions (similarly for the vector-valued expressions). (4) The \reduce\ algebraic simplification routine is applied to the algebraic expressions $a$, $b$. \seethis{In the anholonomic mode the basis $b^i\wedge b^j\dots$ is used instead. See section \ref{amode}.} Final expression consist of exterior products of basis coordinate differentials $dx^i\wedge dx^j\dots$ (or basis vectors $\partial_{x^i}$) multiplied by the algebraic expressions. The algebraic expressions contain only the coordinates, constants and functions. \subsection{Controlling Expression Evaluation} There are many \reduce\ switches which control algebraic expression evaluation. The number of these switches and details of their work depend on the \reduce\ version. Here we consider some of these switches. All examples below are made with the \reduce\ 3.5. On other \reduce\ versions result may be a bit different. Switches {\tt EXP} and {\tt MCD} control expansion and reduction of rational expressions to a common denominator respectively. \begin{slisting} <- (x+y)\^2; 2 2 x + 2*x*y + y <- Off EXP; <- (x+y)\^2; 2 (x + y) <- On EXP; <- 1/x+1/y; x + y ------- x*y <- Off MCD; <- 1/x+1/y; -1 -1 x + y \end{slisting} These switches are normally on. Switches {\tt PRECISE} and {\tt REDUCED} control evaluation of square roots:\label{PRECISE}\label{REDUCED} \begin{slisting} <- SQRT(-8*x\^2*y); 2*SQRT( - 2*y)*x <- On REDUCED; <- SQRT(-8*x\^2*y); 2*SQRT(y)*SQRT(2)*I*x <- Off REDUCED; <- On PRECISE; <- SQRT(-8*x\^2*y); 2*SQRT(y)*SQRT(2)*I*x <- On REDUCED, PRECISE; <- SQRT(-8*x\^2*y); 2*SQRT(y)*SQRT(2)*ABS(x) \end{slisting} Combining rational expressions the system by default calculates the least common multiple of denominators but turning the switch {\tt LCM} off prevents this calculation. Switch {\tt GCD} (normally off) makes the system search and cancel the greatest common divisor of the numerator and denominator of rational expressions. Turning {\tt GCD} on may significantly slow down the calculations. There is also another switch {\tt EZGCD} which uses other algorithm for g.c.d. calculation. Switches {\tt COMBINELOGS} and {\tt EXPANDLOGS} control the evaluation of logarithms \begin{slisting} <- On EXPANDLOGS; <- LOG(x*y); LOG(x) + LOG(y) <- LOG(x/y); LOG(x) - LOG(y) <- Off EXPANDLOGS; <- On COMBINELOGS; <- LOG(x)+LOG(y); LOG(x*y) \end{slisting} By default all polynomials are considered by \reduce\ as the polynomials with integer coefficients. The switches {\tt RATIONAL} and {\tt COMPLEX} allow rational and complex coefficients in polynomials respectively: \begin{slisting} <- (x\^2+y\^2+x*y/3)/(x-1/2); 2 2 2*(3*x + x*y + 3*y ) ----------------------- 3*(2*x - 1) <- On RATIONAL; <- (x\^2+y\^2+x*y/3)/(x-1/2); 2 1 2 x + ---*x*y + y 3 ------------------- 1 x - --- 2 <- Off RATIONAL; <- 1/I; 1 --- I <- (x\^2+y\^2)/(x+I*y); 2 2 x + y --------- I*y + x <- On COMPLEX; <- 1/I; - I <- (x\^2+y\^2)/(x+I*y); x - I*y \end{slisting} Switch {\tt RATIONALIZE} removes complex numbers from the denominators of the expressions but it works even if {\tt COMPLEX} is off. Turning off switch {\tt EXP} and on {\tt GCD} one can make the system to factor expressions \begin{slisting} <- Off EXP; <- On GCD; <- x\^2+y\^2+2*x*y; 2 (x + y) \end{slisting} Similar effect can be achieved by turning on switch {\tt FACTOR}. Unfortunately this works only when \grg\ prints expressions and internally expressions remain in the expanded form. To make \grg\ to work with factored expressions internally one must turn on {\tt FACTOR} and {\tt AEVAL}. \swind{AEVAL} The \grg\ switch {\tt AEVAL} make \grg\ to use an alternative \reduce\ routine for algebraic expression evaluation and simplification. This routine works well with {\tt FACTOR} on. \seethis{See section \ref{tuning} about configuration files.} Possibly it is good idea to turn switch {\tt AEVAL} on by default. This can be done using \grg\ configuration files. \subsection{Substitutions} \index{Substitutions} The substitution commands in \grg\ are the same as the corresponding \reduce\ instructions \cmdind{Let}\cmdind{Match}\cmdind{For All Let} \command{\opt{For All \rpt{\parm{x}}\,\opt{Such That \parm{cond}}} Let \rpt{\parm{sub}};\\\tt \opt{For All \rpt{\parm{x}}\,\opt{Such That \parm{cond}}} Match \rpt{\parm{sub}};} \seethis{See page \pageref{solutions} about solutions.} where \parm{sub} is either relation {\tt \parm{l}\,=\,\parm{r}} or the solution in the form \comm{Sol(\parm{n})}. After the substitution is activated every appearance of \parm{l} will be replaced by \parm{r}. The {\tt For All} substitutions have additional list of parameters \parm{x} and will work for any value of \parm{x}. The optional condition \parm{cond} imposes restrictions on the value of the parameters \parm{x}. The \parm{cond} is the boolean expression (see page \pageref{bool}). The substitution can be deactivated by the command \cmdind{Clear} \command{\opt{For All \rpt{\parm{x}}\,\opt{Such That \parm{cond}}} Clear \rpt{\parm{sub}};} Notice that the variables \parm{x} must be exactly the same as in the corresponding {\tt For All Let} command. The difference between \comm{Match} and \comm{Let} is that the former matches the degrees of the expressions exactly while \comm{Let} matches all powers which are greater than one indicated in the substitution: \begin{slisting} <- Const a; <- (a+1)\^8; 8 7 6 5 4 3 2 a + 8*a + 28*a + 56*a + 70*a + 56*a + 28*a + 8*a + 1 <- Let a\^3=1; <- (a+1)\^8; 2 85*a + 86*a + 85 <- Clear a\^3; <- Match a\^3=1; <- (a+1)\^8; 8 7 6 5 4 2 a + 8*a + 28*a + 56*a + 70*a + 28*a + 8*a + 57 \end{slisting} Substitutions can be used for various purposes, for example: (i) to define additional mathematical relations such as trigonometric ones; (ii) to ``assign'' value to the user-defined and built-in constants; (iii) to define differentiation rules for functions. After some substitution is activated it applies to every evaluated expression but value of the objects calculated \emph{before} remain unchanged. The command \comm{Evaluate} re-simplifies the value of the object \cmdind{Evaluate} \command{Evaluate \parm{object};} here \parm{object} is the object name, or identifier, or the group object name. Let us consider a simple \grg\ task which calculates the volume 4-form of some metric \begin{slisting} <- Coordinates t, x, y, z; <- Constant a; <- Tetrad T0=d t, T1=d x, T2=SIN(a)*d y+COS(a)*d z, T3=-COS(a)*d y+SIN(a)* d z; <- Find and Write Volume; Volume : 2 2 VOL = (SIN(a) + COS(a) ) d t \w\ d x \w\ d y \w\ d z \end{slisting} We see that \reduce\ do not know the appropriate trigonometric rule. Thus we are going to apply substitution \begin{slisting} <- For all x let SIN(x)\^2 = 1-COS(x)\^2; <- Write Volume; Volume : VOL = d t \w\ d x \w\ d y \w\ d z \end{slisting} The situation has been improved. But actually, the \emph{internal} representation of {\tt VOL} remains unchanged. {\tt Write} by default re-simplifies expressions before printing. \swinda{WRS} By turning switch {\tt WRS} off we can prevent this re-simplification: \begin{slisting} <- Off WRS; <- Write Volume; Volume : 2 2 VOL = (SIN(a) + COS(a) ) d t \w\ d x \w\ d y \w\ d z \end{slisting} Now we can apply \comm{Evaluate}: \begin{slisting} <- Evaluate Volume; <- Write Volume; Volume : VOL = d t \w\ d x \w\ d y \w\ d z \end{slisting} We see that the internal value of {\tt VOL} now has been replaced by re-simplified expression. Notice that the command \command{Evaluate All;} applies \comm{Evaluate} to all objects whose value is currently known. \subsection{Generic Functions} \index{Generic Functions}\label{genfun} Unfortunately \reduce\ lacks the notion of partial derivative of a function. The expression \comm{DF(f(x,y),x)} is treated by \reduce\ as the ``derivative of the expression \comm{f(x,y)} with respect to the variable \comm{x}'' rather than the ``derivative of the function \comm{f} with respect to its first argument''. Due to this \reduce\ cannot handle chain differentiation rule etc. This problem is fixed by the package \file{dfpart} written by H.~Melenk. This package introduces notion of generic function and partial derivative \comm{DFP}. If \file{dfpart} is installed on your \reduce\ system \grg\ provides the interface to these facilities. Let us consider an example. First we declare one usual and two generic functions \begin{slisting} <- Coordinates t, x, y, z; <- Function f; <- Generic Function g(a,b), h(b); <- Write Functions; Functions: g*(a,b) h*(b) f \end{slisting} Generic functions must be always declared with the list of parameters (\comm{a} and \comm{b} in our example). These parameters play the role of labels which denotes arguments of the generic function and the partial derivatives with respect to these arguments are defined. Due to this generic functions allow the chain differentiation rule \begin{slisting} <- DF(f(SIN(x),y),x); DF(f(SIN(x),y),x) <- DF(g(SIN(x),y),x); COS(x)*g (SIN(x),y) a \end{slisting} Here subscript \comm{a} denotes the derivative of the function \comm{g} with respect to the first argument. \enlargethispage{5mm} The operator \comm{DFP} is introduced to denotes such derivatives in expressions: \begin{slisting} <- DF(g(x,y)*h(y),b); 0 <- DFP(g(x,y)*h(y),b); g (x,y)*h(y) + h (y)*g(x,y) b b \end{slisting} \newpage If switch \swind{DFPCOMMUTE} \comm{DFPCOMMUTE} is turned on then \comm{DFP} derivatives commute. \section{Using Built-in Formulas In Calculations} \grg\ has large number of built-in objects and almost each object has built-in formulas or so called \emph{ways of calculation} which can be used to find the value of the object. This section explains how these formulas (ways) can be used. \subsection{\comm{Find} Command} \index{Ways of calculation}\cmdind{Find}\label{find} Almost each \grg\ built-in object has associated \emph{ways of calculation}. Each way is nothing but a formula or equation which allows to compute the value of the object. All these formulas are described in the usual mathematical style in chapter 3. The command\cmdind{Show \parm{object}} \command{Show \parm{object};} or equivalently \command{?~\parm{object};} prints information about object's ways of calculation. The command \comm{Find} applies built-in formulas to calculate the object value \command{Find \parm{object} \opt{\parm{way}};} where \parm{object} is the object name, or identifier, or group object name. The optional specification \parm{way} indicates the particular way if the \parm{object} has several built-in ways of calculation. \enlargethispage{3mm} Consider the curvature 2-form $\Omega^a{}_b$ (object \comm{Curvature}, id. \comm{OMEGA}): \begin{slisting} <- Show Curvature; Curvature OMEGA'a.b is 2-form Value: unknown Ways of calculation: Standard way (omega) From spinorial curvature (OMEGAU*,OMEGAD) \end{slisting} \noindent We can see that this object has two built in ways of calculation. First way named {\tt Standard way} is the usual equation $\Omega^a{}_b=d\omega^a{}_b+\omega^a{}_m\wedge\omega^m{}_b$. Second way under the name {\tt From spinorial curvature} uses spinor $\tsst$ tensor relationship to compute the curvature 2-form using its spinor analogues $\Omega_{AB}$ and $\Omega_{\dot{A}\dot{B}}$ as the source data. The ways of calculation are printed by the command {\tt Show} in the form \command{\parm{wayname} (\rpt{\parm{SI}})} where \parm{wayname} is the way name and \seethis{See Eq. (\ref{omes}) on \pref{omes}.} the \parm{SI} are the identifiers of the \emph{source} objects which are present in the right-hand side of the equation. The value of these objects must be known before the formula can be applied. %\enlargethispage{5mm} The \parm{way} in the \comm{Find} command allows one to choose the particular way which can be done by two methods. In the first form \parm{way} is just the name exactly as it printed by the \comm{Show} command \command{wayname} or {\tt Using standard way} or {\tt By standard way} if the way name is {\tt Standard way}. Another method to specify the way is to indicate the appropriate source object \command{From \parm{object}\\\tt% Using \parm{object}} where \parm{object} is the name or the identifier of the source object. For example second (spinorial) way of calculation for the curvature 2-form can be chosen by the following equivalent commands \vspace{-1mm} \begin{listing} Find curvature from spinorial curvature; Find curvature using OMEGAU; \end{listing} while first way is activated by the commands \vspace*{-1mm} \begin{listing} Find curvature by standard way; Find curvature using omega; \end{listing} Recall that object identifiers are case sensitive and \comm{omega} is the identifier of the frame connection 1-form $\omega^a{}_b$ and should not be confused with \comm{OMEGA}. The \parm{way} specification in the \comm{Find} can be omitted and in this case \grg\ uses the following algorithm to choose a particular way of calculation. Observe that the identifier of the undotted curvature 2-form $\Omega_{AB}$ is marked by the symbol $*$. This label marks so called \emph{main} objects. If no way of calculation is specified when \grg\ tries to choose the way, browsing the way list form top to the bottom, for which the value of the \emph{main} object is already known. If no switch way exists then \grg\ just picks up the first way in the list. Therefore in our example the command \begin{listing} Find curvature; \end{listing} will use the second way if the value of the object $\Omega_{AB}$ (id. \comm{OMEGAU}) is known and second way otherwise. As soon as some way of calculation is chosen \grg\ tries to calculate the values of the source objects which are present in the right-hand side of corresponding equations. \grg\ tries to do this by applying the \comm{Find} command without way specification to these objects. Thus a single \comm{Find} can cause quite long chain of calculations. This recursive work is reflected by the appropriate tracing messages. The tracing can be eliminated by turning off switch \comm{TRACE}.\swind{TRACE} Here we present the sample \grg\ session which computes curvature 2-form for the flat gravitational waves \begin{slisting} <- Cord u, v, z, z~; z & z~ - conjugated pair. <- Null Metric; <- Function H(u,z,z~); <- Frame T0=d u, T1=d v+H*d u, T2=d z, T3=d z~; <- ds2; 2 2 ds = ( - 2*H) d u + (-2) d u d v + 2 d z d z~ <- Find Curvature; Sqrt det of metric calculated. 0.16 sec Volume calculated. 0.16 sec Vector frame calculated From frame. 0.16 sec Inverse metric calculated From metric. 0.16 sec Frame connection calculated. 0.22 sec Curvature calculated. 0.22 sec <- Write Curvature; Curvature: 1 OMEGA = ( - DF(H,z,2)) d u \w d z + ( - DF(H,z,z~)) d u \w d z~ 2 1 OMEGA = ( - DF(H,z,z~)) d u \w d z + ( - DF(H,z~,2)) d u \w d z~ 3 2 OMEGA = ( - DF(H,z,z~)) d u \w d z + ( - DF(H,z~,2)) d u \w d z~ 0 \newpage 3 OMEGA = ( - DF(H,z,2)) d u \w d z + ( - DF(H,z,z~)) d u \w d z~ 0 \end{slisting} Finally we want to emphasize that ways associated with some object may depend on the concrete environment. In particular the {\tt Standard way} for the curvature 2-form is always available but second way which is essentially related to spinors works \seethis{See \pref{spinors} about the spinorial formalism.} only in the 4-dimensional spaces of Lorentzian signature and iff the metric is null. If some way is not valid in the current environment it simply disappears from the way list printed by the \comm{Show}. It should be noted also that the \comm{Find \parm{object};} command works only if the \parm{object} is in the indefinite state and is rejected if the value of the \parm{object} is already known. If you want to re-calculate the object then previous value must be cleared by the \comm{Erase} command. \subsection{\comm{Erase} command} \cmdind{Erase} The command \command{Erase \parm{object};} destroys the \parm{object} value and returns it to initial indefinite state. It can be used also to free the memory. \subsection{\comm{Zero} command} \cmdind{Zero} Command \command{Zero \parm{object};} assigns zero values to all \parm{object} components. \subsection{\comm{Normalize} command} \cmdind{Normalize} Command \command{Normalize \parm{object};} applies to equations. It replaces equalities of the form $l=r$ by the equalities $l-r=0$ and re-simplifies the result. \subsection{\comm{Evaluate} command} \cmdind{Evaluate} The command \command{Evaluate \parm{object};} re-simplifies existing value of the \parm{object}. This command is useful if we want to apply new substitutions \seethis{See page \pageref{subs} about substitutions.} to the object whose value is already known. The command \command{Evaluate All;} re-simplifies all objects whose value is currently known. \section{Printing Result of Calculations} \subsection{\comm{Write} Command} \cmdind{Write} The command \command{Write \parm{object};} prints value of the \parm{object}. Here \parm{object} id the object name or identifier.\index{Group name} Group names denoting a collection of several objects \seethis{See page \pageref{macro} about macro objects.} and macro object identifiers can be used in the \comm{Write} command as well. In addition word \comm{All} can be used to print all currently known objects. The command \comm{Write} can print declarations as well if \parm{object} is {\tt functions}, {\tt constants}, or {\tt affine parameter}. The command \command{Write \rpt{\parm{object}}~to~"\parm{file}";} or equivalently \command{Write \rpt{\parm{object}}~>~"\parm{file}";} writes result into the \comm{"\parm{file}"}. Notice that \comm{Write} always destroys previous contents of the file. Therefore we have another command \command{Write to "\parm{file}";\\\tt% Write > "\parm{file}";} which redirects all output into the file. The standard output can be restored by the commands\cmdind{End of Write}\cmdind{EndW} \command{EndW;\\\tt% End of Write;} \enlargethispage{3mm} By default \comm{Write} re-simplifies the expressions before printing them. \swind{WRS} \seethis{See page \pageref{subs} about substitutions.} This is convenient when substitutions are activated but slows down the printing especially for very large expressions. The re-simplification can be abolished by turning off switch \comm{WRS}. If switch \comm{WMATR} is turned on then \swind{WMATR} \grg\ prints all 2-index scalar-valued objects in the matrix form \begin{slisting} <- Coordinates t, x, y, z; <- On wmatr; <- Find and Write metric; Assuming Default Metric. Metric calculated By default. 0.06 sec Metric: [-1 0 0 0] [ ] [0 1 0 0] [ ] [0 0 1 0] [ ] [0 0 0 1] \end{slisting} \comm{Write} prints frame, spinor and enumerating indices as numerical subscripts while holonomic indices are printed as the coordinate identifiers. If frame is holonomic and there is no difference between frame and coordinate indices then by default all frame indices are also labelled by the appropriate identifiers. But is switch \comm{HOLONOMIC} \swinda{HOLONOMIC} is turned off they are still printed as numbers. \subsection{\comm{Print} Command} \cmdind{Print} The \comm{Write} command described in the previous section prints value of an object. This value must be calculated beforehand by the \comm{Find} command or established by the assignment. The command \comm{Print} evaluates expression and immediately prints its value. It has several forms \command{% \opt{Print} \parm{expr} \opt{For \parm{iter}};\\\tt For \parm{iter} Print \parm{expr};} Here \parm{expr} is expression to be evaluated and \parm{iter} indicates that expression must be evaluated for several value of some variable. The specification \parm{iter} is completely the same as is the \comm{Sum} expression and is described in details in section \ref{iter} on page \pageref{iter}. It consists of the list of parameters separated by commas \comm{,} or relational operators {\tt < > => =<}. For example the command \begin{listing} G(a,b) for a<b; \end{listing} prints off-diagonal components of the metric. Both word \comm{Print} and \comm{For} parts of the command can be omitted and it is possible just to enter an expression \command{\parm{expr};} and it will be evaluated and printed. The expression can contain indefinite identifiers and by default \grg\ treats them similarly to the variables in the \comm{For} part of the \comm{Print} command. The range of such parameters are determined by the short summation variable specification as explained on page \pageref{siter}. For example the following four commands are equivalent. they all print the components of the holonomic metric $g_{\alpha\beta}$ \begin{listing} Print g(a,b) for a,b; For a,b Print g(a,b); g(a,b) for a,b; g(a,b); \end{listing} Here the parameters \comm{a}, \comm{b} run from 0 to $d-1$. Unfortunately such treatment of unknown variables may create some confusion since occasionally misprinted identifier may be recognizes by \grg\ as an iteration variable. If switch\swind{NOFREEVARS} \comm{NOFREEVARS} is turned on then \grg\ becomes more scrupulous and any unknown variable will cause the error. \subsection{Controlling the Output} There are several switches and commands which allow one to change output form of expressions. One needs to stress that all these facilities have no influence on the \emph{internal form} of expressions, they alter the \emph{printout only}. \enlargethispage{2mm} Switches {\tt ALLFAC} and command {\tt Factor} control factoring of subexpressions. In the on default position {\tt ALLFAC} makes the system search for a common factor and print it outside the expression. The command\cmdind{Factor} \command{Factor \rpt{\parm{expr}};} makes the system collect together terms with different powers of subexpressions \parm{expr}. Command\cmdind{RemFac} \command{RemFac \rpt{\parm{expr}};} removes the action of the previous {\tt Factor} command. \begin{slisting} <- Constants a,b,c; <- a*(a+b+1)\^2; \newpage 2 2 a*(a + 2*a*b + 2*a + b + 2*b + 1) <- Off ALLFAC; <- a*(a+b+1)\^2; 3 2 2 2 a + 2*a *b + 2*a + a*b + 2*a*b + a <- Factor b; <- a*(a+b+1)\^2; 2 2 3 2 b *a + b*(2*a + 2*a) + a + 2*a + a <- On ALLFAC; <- a*(a+b+1)\^2; 2 2 b *a + 2*b*a*(a + 1) + a*(a + 2*a + 1) \end{slisting} Normally \reduce\ prints terms in some canonical order. The switch {\tt REVPRI} prints terms in reverse order and command\cmdind{Order} \command{Order \rpt{\parm{expr}};} specifies the required order of subexpressions explicitly. \begin{slisting} <- Constants a,b,c; <- (a+b*c)\^3; 3 2 2 2 3 3 a + 3*a *b*c + 3*a*b *c + b *c <- On REVPRI; <- (a+b*c)\^3; 3 3 2 2 2 3 b *c + 3*a*b *c + 3*a *b*c + a <- Order c,a,b; <- (a+b*c)\^3; 3 2 2 2 3 3 a + 3*c*a *b + 3*c *a*b + c *b <- Off REVPRI; <- (a+b*c)\^3; 3 3 2 2 2 3 c *b + 3*c *a*b + 3*c*a *b + a \end{slisting} By default \reduce\ prints fractions in two-dimensional format but turning off switch {\tt RATPRI} prevents this facility. Switch {\tt DIV} in the on position makes the system divide each term of the numerator by the denominator and to print the denominator in the form of negative powers. Switch {\tt RAT} works in combination with the {\tt Factor} command. In the on position it makes the system divide each term collected by the {\tt Factor} in the numerator by the denominator. \begin{slisting} <- Const a,b,c; <- (a+b+1)\^2/a; 2 2 a + 2*a*b + 2*a + b + 2*b + 1 --------------------------------- a <- Off RATPRI; <- (a+b+1)\^2/a; 2 2 (a + 2*a*b + 2*a + b + 2*b + 1)/a <- On DIV; <- (a+b+1)\^2/a; -1 2 -1 -1 a + a *b + 2*a *b + a + 2*b + 2 <- Factor b; <- (a+b+1)\^2/a; 2 -1 -1 -1 b *a + 2*b*(a + 1) + a + a + 2 <- Off DIV; <- (a+b+1)\^2/a; 2 2 (b + 2*b*(a + 1) + a + 2*a + 1)/a <- On RAT; <- (a+b+1)\^2/a; 2 2 b /a + 2*b*(a + 1)/a + (a + 2*a + 1)/a <- On RATPRI; <- (a+b+1)\^2/a; 2 2 b a + 1 a + 2*a + 1 ---- + 2*b*------- + -------------- a a a \end{slisting} One needs to realize that output form transformations may require a long time and memory expense. There is a special switch {\tt PRI} which allows one to minimize this expense. If {\tt PRI} is turned off then the system will print all expressions exactly in their internal form and output control does not work. This is the fastest way to print result of calculations. The command\cmdind{Line Length} \comm{Line Length \parm{n};} sets the output line length to \parm{n}. \subsection{\LaTeX\ and Graphics Output} \index{LaTeX@\LaTeX\ output mode}\index{Graphics output mode} Some versions of \reduce\ running under Windows, OS/2 or X-windows are equipped with the graphic shells which provide book-style output with Greek characters, integral signs etc. \grg\ is compatible with these systems.\swind{FANCY} This graphic regime is activated by switch \comm{FANCY}. Graphic output mode internally uses some subset of the \LaTeX\ language.\swind{LATEX} Switch \comm{LATEX} makes \grg\ to print the output in the \LaTeX\ format. This output can be written into a file and later directly inserted in a document. Notice that turning off switch \comm{LATEX} returns graphic output mode with switch \comm{FANCY} on while turning off \comm{FANCY} automatically turns off \comm{LATEX} as well and returns usual character output mode. In graphic regime the derivatives are printed in $\partial f/\partial x$ notation. \swind{DFINDEXED} Switch \comm{DFINDEXED} makes the system to print derivatives in the indexed notation $f_x$. The following expressions is the scalar curvature of the Bondi metric obtained by \grg\ and directly inserted in this manual \begin{eqnarray*} R &= & \bigl(4\,e^{2\,\beta\,+\,2\,\gamma}\,\cos(\theta)\,\frac{\partial\,U}{\partial\,r}\,r^2\,-\,8\,e^{4\,\beta}\,\cos(\theta)\,\frac{\partial\,\beta}{\partial\,\theta}\,-\,\\ &&4\,e^{2\,\beta\,+\,2\,\gamma}\,\cos(\theta)\,\frac{\partial\,\gamma}{\partial\,r}\,U\,r^2\,+\,12\,e^{4\,\beta}\,\cos(\theta)\,\frac{\partial\,\gamma}{\partial\,\theta}\,+\,\\ &&12\,e^{2\,\beta\,+\,2\,\gamma}\,\cos(\theta)\,U\,r\,+\,4\,e^{2\,\beta\,+\,2\,\gamma}\,\frac{\partial^2\,U}{\partial\,r\,\partial\,\theta}\,\sin(\theta)\,r^2\,+\,\\ &&e^{4\,\gamma}\,(\frac{\partial\,U}{\partial\,r})^2\,\sin(\theta)\,r^4\,+\,4\,e^{2\,\beta\,+\,2\,\gamma}\,\frac{\partial\,U}{\partial\,r}\,\frac{\partial\,\beta}{\partial\,\theta}\,\sin(\theta)\,r^2\,+\,\\ &&4\,e^{2\,\beta\,+\,2\,\gamma}\,\frac{\partial\,U}{\partial\,\theta}\,\frac{\partial\,\gamma}{\partial\,r}\,\sin(\theta)\,r^2\,+\,12\,e^{2\,\beta\,+\,2\,\gamma}\,\frac{\partial\,U}{\partial\,\theta}\,\sin(\theta)\,r\,-\,\\ &&4\,e^{2\,\beta\,+\,2\,\gamma}\,\frac{\partial^2\,V}{\partial\,r^2}\,\sin(\theta)\,r\,-\,8\,e^{2\,\beta\,+\,2\,\gamma}\,\frac{\partial\,V}{\partial\,r}\,\frac{\partial\,\beta}{\partial\,r}\,\sin(\theta)\,r\,-\,\\ &&8\,e^{2\,\beta\,+\,2\,\gamma}\,\frac{\partial\,V}{\partial\,r}\,\sin(\theta)\,+\,8\,e^{2\,\beta\,+\,2\,\gamma}\,\frac{\partial^2\,\beta}{\partial\,r\,\partial\,\theta}\,\sin(\theta)\,U\,r^2\,-\,\\ &&8\,e^{2\,\beta\,+\,2\,\gamma}\,\frac{\partial^2\,\beta}{\partial\,r^2}\,\sin(\theta)\,V\,r\,+\,8\,e^{2\,\beta\,+\,2\,\gamma}\,\frac{\partial\,\beta}{\partial\,r}\,\sin(\theta)\,V\,-\,\\ &&8\,e^{4\,\beta}\,\frac{\partial^2\,\beta}{\partial\,\theta^2}\,\sin(\theta)\,-\,12\,e^{4\,\beta}\,(\frac{\partial\,\beta}{\partial\,\theta})^2\,\sin(\theta)\,+\,16\,e^{4\,\beta}\,\frac{\partial\,\beta}{\partial\,\theta}\,\frac{\partial\,\gamma}{\partial\,\theta}\,\sin(\theta)\,-\,\\ &&8\,e^{2\,\beta\,+\,2\,\gamma}\,(\frac{\partial\,\gamma}{\partial\,r})^2\,\sin(\theta)\,V\,r\,+\,8\,e^{2\,\beta\,+\,2\,\gamma}\,\frac{\partial\,\gamma}{\partial\,r}\,\frac{\partial\,\gamma}{\partial\,\theta}\,\sin(\theta)\,U\,r^2\,+\,\\ &&4\,e^{4\,\beta}\,\frac{\partial^2\,\gamma}{\partial\,\theta^2}\,\sin(\theta)\,-\,8\,e^{4\,\beta}\,(\frac{\partial\,\gamma}{\partial\,\theta})^2\,\sin(\theta)\,+\,4\,e^{4\,\beta}\,\sin(\theta)\bigr)/\\ &&\bigl(2\,e^{4\,\beta\,+\,2\,\gamma}\,\sin(\theta)\,r^2\bigr) \end{eqnarray*} \subsection{Exporting Data Into Other Systems} \index{Output modes} Capabilities of major modern computer algebra systems are approximately equivalent but not quite. One system is better in doing one things and other is better for other purposes. It may happen that tools which you need are available only in one particular systems. \grg\ provides quite unique facility to export the data into other computer algebra systems. Turning on one of the following switches establishes the \emph{output mode} in which all expressions are printed in the \emph{input} language of other CAS. This output can be saved into a file and later you can use this CAS to proceed you analysis of the data. At present \grg\ supports five output modes which are controlled by the switches \swind{MACSYMA}\swind{MAPLE}\swind{MATH}\swind{REDUCE}\swind{GRG} \begin{tabular}{ll} \comm{MACSYMA} & for \macsyma \\ \comm{MAPLE} & for \maple \\ \comm{MATH} & for \mathematica \\ \comm{REDUCE} & for \reduce \\ \comm{GRG} & for \grg \\ \end{tabular}\newline Notice the last switch allows one to print the data in the form which can be later inserted into \grg\ task. \section{Advanced Facilities} \subsection{Solving Equations} \cmdind{Solve}\label{solutions} \grg\ provides simple interface to the \reduce\ algebraic equation solver. The command \command{Solve \rpt{\parm{l}=\parm{r}}~for~\rpt{\parm{expr}};} resolves equations \comm{\parm{l}=\parm{r}} with respect to expressions \parm{expr}. This command has also other form \command{Solve \parm{equation} for \rpt{\parm{expr}};} where \parm{equation} is the name or identifier of some built-in or user-defined equation. Both form of the \comm{Solve} command works with form and scalar valued equations as well but \parm{expr} must be algebraic. The resulting solutions are stored in the special object \comm{Solutions} (identifier \comm{Sol}). They can be printed by the command\cmdind{Write}\cmdindx{Write}{Solutions} \command{Write Solutions;} Left and right hand sides of \parm{n}'th solution can be used in expression as \comm{LHS(Sol(\parm{n}))} or \comm{RHS(Sol(\parm{n}))}. The expression \comm{Sol(\parm{n})} referring to the \parm{n}'th solution can be used in the \comm{SUB} and \comm{Let} substitutions as well: \begin{slisting} <- Coordinates t, x, y, z; <- Solve x^2-2*x=5, y=9 for x, y; <- Write Solutions; Solutions: Sol(0) : y = 9 Sol(1) : x = - SQRT(6) + 1 Sol(2) : y = 9 Sol(3) : x = SQRT(6) + 1 <- SUB(Sol(1),(x-1)^2); 6 <- Let Sol(3); <- (x-1)^2; 6 \end{slisting} Solutions can be cleared by the command \cmdind{Erase}\cmdindx{Erase}{Solutions} \command{Erase Solutions;} One need to stress that \comm{Solve} is capable to solve algebraic relations only. Solving algebraic relations \reduce\ knows already that the function \comm{ASIN} is inverse to \comm{SIN}. The command\cmdind{Inverse} \command{Inverse \parm{f1},\parm{f2};} tells the system that functions \parm{f1} and \parm{f2} are inverse to each other. \subsection{Saving Data for Later Use} \label{UnloadLoad} It is very convenient to have facilities to save results of calculations in a form fitted for restoring and further manipulation. For this purpose \grg\ has two special commands: {\tt Unload} and {\tt Load}. The command\cmdind{Unload}\label{Unload} \command{Unload \parm{object} > "\parm{file}";\\\tt Unload \parm{object} To "\parm{file}";} writes \parm{object} value into \comm{"\parm{file}"} in some special format. Here \parm{object} is name or identifier of an object. The data can be later restored with help of the command\cmdind{Load} \command{Load "\parm{file}";} The command {\tt Unload} always overwrites previous \comm{"\parm{file}"} contents. To save several objects in one file one must use the following sequence of commands\cmdind{EndU}\cmdind{End of Unload} \begin{listing} Unload > "\parm{file}"; Unload \parm{object}; Unload \parm{object}; ... Unload \parm{object}; End Of Unload; \end{listing} Here command \comm{Unload > "\parm{file}";} opens \comm{"\parm{file}"} and {\tt End Of Unload;} closes it. The last command has the short form \command{EndU;} In fact presented above sequence of commands can be abbreviated as \command{Unload \rpt{\parm{object}}~>~"\parm{file}";} One needs to stress that only the commands {\tt Unload \dots;} can be used between {\tt Unload > \dots} and {\tt End Of Unload;}. If this rule does not hold then {\tt Load} may fail to restore the file. The only additional command which can be used among these {\tt Unload \parm{object};} commands is the comment {\tt \% \parm{text};}. This command insertes the comment \parm{text} into the \comm{"\parm{file}"}. Later when \comm{"\parm{file}"} will be restored by the {\tt Load} the \parm{text} message will be printed. This allows one to attach comments to unreadable files produced by {\tt Unload} command. As in other commands \parm{object} in \comm{Unload} command is either the name or identifier of an object. Names {\tt Coordinates}, {\tt Constants} and {\tt Functions} can also be used to save declarations. And finally, the command \command{Unload All > "\parm{file}";} saves all objects whose value is currently known \seethis{See section \ref{amode} about anholonomic basis.} and all declarations. Moreover, in the anholonomic basis mode this command saves full information about an anholonomic basis. When data or coordinates declarations are restored from a file they replace current values. Function and constant declarations are added to current declarations. One should realize that serious troubles may appear when different coordinates are used in the current session and in the restored file. Even the order of coordinates is extremely important. We strongly recommend saving all declarations (especially coordinates) in addition to other objects. It ensures at least that will \grg\ print a warning message if some contradictions are detected between current declarations and declarations stored into a file. The best way to avoid these troubles is to use the command \command{Unload All > "\parm{file}";} Loading the file saved by this command at the very beginning of a new \grg\ task completely restores the previous \grg\ state with all data and declarations. Sometimes one needs to prevent the {\tt Load}/{\tt Unload} operations with coordinates.\swind{UNLCORD} If switch {\tt UNLCORD} is turned off (normally on) then all {\tt Load} and {\tt Unload} operations with coordinates are blocked. Since {\tt Unload} writes data in human-unreadable form there is the command\cmdind{Show File}\cmdind{File}\cmdind{Show {"\parm{file}"}} \command{Show \opt{File} "\parm{file}";} or equivalently \command{?~\opt{File}~"\parm{file}";\\\tt File "\parm{file}";} which prints short information about objects and declarations contained in the \comm{"\parm{file}"}. It also prints comments contained in the file. \subsection{Coordinate Transformations} \index{Coordinate transformations} Command\cmdind{New Coordinates} \command{New Coordinates \rpt{\parm{new}} with \rpt{\parm{old}=\parm{expr}};} introduces new coordinates \parm{new} and defines how old coordinates \parm{old} are expressed in terms of new ones. If the specified transformation is nonsingular \grg\ converts all existing objects to the new coordinate system. The {\tt New Coordinates} command properly transforms all objects having coordinate indices. The transformation of frame indices depend on the switch \comm{HOLONOMIC}. \swind{HOLONOMIC} In general case when frame is not holonomic then objects having frame indices remain unchanged and only their components are transformed into the new coordinate system. But if frame is holonomic then by default all frame indices are transformed similarly to the coordinate ones. Notice that in such situation the frame after transformation once again will be holonomic in the new coordinate system. But if switch \comm{HOLONOMIC} is turned off the system distinguishes frame and coordinate indices in spite of the current frame type. In such situation the holonomic frame ceases to be holonomic after coordinate transformation. \subsection{Frame Transformations} \index{Frame transformations} Spinorial rotations are performed by the command\cmdind{Make Spinorial Rotation}\cmdind{Spinorial Rotation} \command{\opt{Make} Spinorial Rotation \opt{ ((\parm{expr}${}_{00}$,\parm{expr}${}_{01}$), (\parm{expr}${}_{10}$,\parm{expr}${}_{11}$))};} where expressions $\mbox{\parm{expr}}_{AB}$ comprise the SL(2,C) transformation matrix \[ \phi'_A=L_A{}^B\phi_B,\ \ \mbox{\parm{expr}}_{AB}=L_A{}^B \] If the specified matrix is really a SL(2,C) one then \grg\ performs appropriate transformation on all objects whose value is currently known. Matrix specification in the command can be omitted \command{\opt{Make} Spinorial Rotation;} In this case the SL(2,C) matrix $L_A{}^B$ must be specified as the value of a special object {\tt Spinorial Transformation LS.A'B} (identifier {\tt LS}). Command for frame rotation is analogously\cmdind{Make Rotation}\cmdind{Rotation} \command{\opt{Make} Rotation \opt{ ((\parm{expr}${}_{00}$,\parm{expr}${}_{01}$,...), (\parm{expr}${}_{10}$,\parm{expr}${}_{11}$,...),...)};} with the nonsingular $d\times d$ rotation matrix \[ A'^a=L^a{}_bA^b,\ \ \mbox{\parm{expr}}_{ab}=L^a{}_b \] \grg\ verifies that this matrix is a valid \emph{rotation} by checking that frame metric $g_{ab}$ \emph{remains unchanged} under this transformation \[ g'_{ab} = L^m{}_a L^n{}_b g_{mn} = g_{ab} \] Once again the matrix specification can be omitted and transformation $L^a{}_b$ can be specified as the value of the object {\tt Frame Transformation L'a.b} (identifier {\tt L}) \command{\opt{Make} Rotation;} Frame rotation commands correctly transform frame and spinor connection 1-forms. Finally, there is a special form of the frame transformation command\cmdind{Change Metric} \command{Change Metric \opt{ ((\parm{expr}${}_{00}$,\parm{expr}${}_{01}$,...), (\parm{expr}${}_{10}$,\parm{expr}${}_{11}$,...),...)};} The only difference between this command and {\tt Make Rotation} is that {\tt Change Metric} does not impose any restriction on the transformation matrix and transformed metric does not necessary coincides with the original one. Sometimes it is convenient to keep some object unchanged under the frame transformation. The command\cmdind{Hold} \command{Hold \parm{object};} makes the system to keep the \parm{object} unchanged during frame and spinor transformations. The command\cmdind{Release} \command{Release \parm{object};} discards the action of the \comm{Hold} command. \subsection{Algebraic Classification} \index{Algebraic classification} The command\cmdind{Classify} \command{Classify \parm{object};} performs algebraic classification of the \parm{object} specified by its name or identifier. Currently \grg\ knows algorithms for classifying the following irreducible spinors \begin{tabular}{ll} $X_{ABCD}$ & Weyl spinor type \\ $X_{AB\dot{C}\dot{D}}$ & Traceless Ricci spinor type \\ $X_{AB}$ & Electromagnetic stress spinor type \\ $X_{A\dot{B}}$ & Vector in the spinorial representation \end{tabular} \newline \reversemarginpar The {\tt Classify} command can be applied to any built-in or user-defined object having one of the listed above \seethis{See page \pageref{sumspin} about summed spinor indices.} types of indices. Notice that all spinors must be irreducible (totally symmetric in dotted and undotted indices) and $X_{AB\dot{C}\dot{D}}$, $X_{A\dot{B}}$ must be Hermitian. Groups of the irreducible indices must be represented as a single summed index. \normalmarginpar \grg\ uses the algorithm by F.~W.~Letniowski and R.~G.~McLenaghan [Gen. Rel. Grav. 20 (1988) 463-483] for Petrov-Penrose classification of Weyl spinor $X_{ABCD}$. The obvious simplification of this algorithm is applied to the spinor analog of electromagnetic strength tensor $X_{AB}$. The spinor $X_{AB\dot{C}\dot{D}}$ is classified by the algorithm by G.~C.~Joly, M.~A.~H.~McCallum and W.~Seixas [Class. Quantum Grav. 7 (1990) 541-556, Class. Quantum Grav. 8 (1991) 1577-1585]. The classification process is accompanied by the tracing messages which can be eliminated by turning \swinda{TRACE} off the switch \comm{TRACE}. On the contrary if one turns on \swind{SHOWEXPR} the switch \comm{SHOWEXPR} then \grg\ prints all expressions which appear during the classification to let you check whether the decision about nonvanishing of these expressions is really correct or not. This facility is important also in classifying $X_{AB\dot{C}\dot{D}}$ and $X_{A\dot{B}}$ since algebraic type for this objects may depend on the \emph{sign} of some expressions which cannot be determined by \grg\ correctly. \subsection{\reduce\ Packages and Functions in \grg} \index{Using \reduce\ packages} \label{packages} Any procedure or function defined in \reduce\ package can be used in \grg. The package must be loaded either before \grg\ is started or during \grg\ session by one of the equivalent commands \cmdind{Package}\cmdind{Use Package}\cmdind{Load} \command{\opt{Use} Package \parm{package};\\\tt Load \parm{package};} where \parm{package} is the package name. Notice that an identifier must be used for the package name unlike the \comm{Load "\parm{file}";} command described in \enlargethispage{5mm} section \ref{UnloadLoad}. Let us consider some examples. The \reduce\ package \file{specfn} contains definitions of various special functions and below we demonstrate 11th Legendre polynomial \begin{slisting} <- Coordinates t, x, y, z; <- package specfn; <- LEGENDREP(11,x); 10 8 6 4 2 x*(88179*x - 230945*x + 218790*x - 90090*x + 15015*x - 693) ------------------------------------------------------------------- 256 \end{slisting} \newpage Another example demonstrates the \file{taylor} package \begin{slisting} <- Coordinates t, x, y, z; <- www=d(E^(x+y)*SIN(x)); <- www; x + y x + y (E *(COS(x) + SIN(x))) d x + (E *SIN(x)) d y <- load taylor; <- TAYLOR(www,x,0,5); y y y y y 2 E 4 E 5 6 y y 2 (E + 2*E *x + E *x - ----*x - ----*x + O(x )) d x + (E *x + E *x 6 15 y y E 3 E 5 6 + ----*x - ----*x + O(x )) d y 3 30 \end{slisting} You can also define your own operators and procedures in \reduce\ and later use them in \grg. In the following example file \file{lasym.red} contains a definition of little \reduce\ procedure which computes a leading term of asymptotic expansion of the rational function at large values of some variable. This file is inputted in \reduce\ before \grg\ is started \begin{slisting} 1: in "lasym.red"; procedure leadingterm(w,x); lterm(num(w),x)/lterm(den(w),x); leadingterm end; 2: load grg; This is GRG 3.2 release 2 (Feb 9, 1997) ... System directory: c:{\bs}red35{\bs}grg32{\bs} System variables are upper-cased: E I PI SIN ... Dimension is 4 with Signature (-,+,+,+) <- Coordinates t, r, theta, phi; <- OMEGA01=(123*r^3+2*r+t)/(r+t)^5*d theta{\w}d phi; <- OMEGA01; 3 123*r + 2*r + t (-------------------------------------------------) d theta \w d phi 5 4 3 2 2 3 4 5 r + 5*r *t + 10*r *t + 10*r *t + 5*r*t + t <- LEADINGTERM(OMEGA01,r); 123 (-----) d theta \w d phi 2 r \end{slisting} \subsection{Anholonomic Basis Mode} \index{Anholonomic basis mode}\index{Basis}\label{amode} \grg\ may work in both holonomic and anholonomic basis modes. In the first default case, values of all expressions are represented in a natural holonomic (coordinate) basis: $d x^\mu,~d x^\mu\wedge x^\nu\dots$ for exterior forms and $\partial_\mu=\partial/\partial x^\mu$ for vectors. In the second case an arbitrary basis $b^i=b^i_\mu d x^\mu$ is used for forms and inverse vector basis $e_i=e_i^\mu\partial_\mu$ for vectors ($b^i_\mu e^\mu_j=\delta^i_j$). You can specify this basis assigning a value to built-in object {\tt Basis} (identifier {\tt b}). If {\tt Basis} is not specified by user then \grg\ assumes that it coincides with the frame $b^i=\theta^i$. Frame should not be confused with basis. Frame $\theta^a$ is used only for ``external'' purposes to represent tensor indices while basis $b^i$ and vector basis $e_i$ is used for ``internal'' purposes to represent form and vector valued object components. The command\cmdind{Anholonomic} \command{Anholonomic;} switches the system to the anholonomic basis mode and the command\cmdind{Holonomic} \command{Holonomic;} switches it back to the standard holonomic mode. Working in anholonomic mode \grg\ creates some internal tables for efficient calculation of exterior differentiation and complex conjugation. In anholonomic mode the command \cmdind{Unload} \begin{listing} Unload All > "\parm{file}"; \end{listing} automatically saves these tables into the \comm{"\parm{file}"}. Subsequent\cmdind{Load} \begin{listing} Load "\parm{file}"; \end{listing} restores the tables and automatically switches the current mode to anholonomic one. Note that automatic anholonomic mode saving/restoring works only if {\tt All} is used in {\tt Unload} command. One can find out the current mode with the help of the command \cmdind{Show Status}\cmdind{Status} \command{\opt{Show} Status;} \subsection{Synonymy} \index{Synonymy} Sometimes \grg\ commands may be rather long. For instance, in order to find the curvature 2-form $\Omega_{ab}$ from the spinorial curvature $\Omega_{AB}$ and $\Omega_{\dot{A}\dot{B}}$ the following command should be used \begin{listing} Find Curvature From Spinorial Curvature; \end{listing} Certainly, this command is clear but typing of such long phrases may be very dull. \grg\ has synonymy mechanism which allows one to make input much shorter. The synonymous words in commands and object names are considered to be equivalent. The complete list of predefined \grg\ synonymy is given in appendix D. Here we present just the most important ones \begin{verbatim} Connection Con Constants Const Constant Coordinates Cord Curvature Cur Dotted Do Equation Equations Eq Find F Calculate Calc Functions Fun Function Next N Show ? Spinor Spin Spinorial Sp Switch Sw Symmetries Sym Symmetric Undotted Un Write W \end{verbatim} Words in each line are considered as equivalent in all commands. Thus the above command can be abbreviated as \begin{listing} F cur from sp cur; \end{listing} Section \ref{tuning} explains how to change built-in synonymy and how to define a new one. \subsection{Compound Commands} \index{Compound commands} Sometime one may need to perform several consecutive actions with one object. In this case we can use so called \emph{compound commands} to shorten the input. Internally \grg\ replaces each compound command by several usual ones. For example the compound command \begin{listing} Find and Write Einstein Equation; \end{listing} to a pair of usual ones \begin{listing} Find Einstein Equation; Write Einstein Equation; \end{listing} Actions (commands) can be attached to the end of the compound command as well: \begin{listing} Find, Write Curvature and Erase It; \qquad\qquad \udr Find \& Write \& Erase Curvature; \qquad\qquad \udr Find Curvature; Write Curvature; Erase Curvature; \end{listing} Note that we have used {\tt ,} and {\tt \&} instead of {\tt and} in this example. All these separators are equivalent in compound commands. Now let us consider the case when one needs to perform a single action with several objects. The command \begin{listing} Write Frame, Vector Frame and Metric; \end{listing} is equivalent to \begin{listing} Write Frame; Write Vector Frame; Write Metric; \end{listing} Way specification can be attached to the {\tt Find} command: \begin{listing} Find QT, QP From Torsion using spinors; \qquad\qquad \udr Find QT From Torsion using spinors; Find QP From Torsion using spinors; \end{listing} One can combine several actions and several objects. For example, the command \begin{listing} Find omega, Curvature by Standard Way and Write and Erase Them; \end{listing} is equivalent to the sequence of $(2{\rm\ objects})\times(3{\rm\ commands}) =6$ commands \begin{listing} Find omega by Standard Way; Find Curvature by Standard Way; Write omega; Write Curvature; Erase omega; Erase Curvature; \end{listing} Note that the way specification is attached only to ``left'' commands ({\tt Find} in our case). The compound commands mechanism works only with {\tt Find}, {\tt Erase}, {\tt Write} and {\tt Evaluate} commands. And finally, \grg\ always replaces {\tt Re-\parm{command};} by {\tt Erase and \parm{command};}. For example \begin{listing} Re-Calculate Maxwell Equations; \qquad\qquad \udr Erase and Calculate Maxwell Equations; \end{listing} You can see how \grg\ expand compound commands into the \swind{SHOWCOMMANDS} usual ones by turning switch \comm{SHOWCOMMANDS} on. \section{Tuning \grg} \label{tuning} \grg\ can be tuned according to your needs and preferences. The configuration files allow one to change some default settings and the environment variable \comm{grg} defines the system directory which can be used as the depository for frequently used files. \subsection{Configuration Files} \label{configsect} The configuration files allows one to establish \begin{list}{$\bullet$}{\labelwidth=8mm\leftmargin=10mm} \item Default dimension and signature. \item Initial position of switches. \item \reduce\ packages which must be preloaded. \item Synonymy. \item Default \grg\ start up method. \end{list} There are two configuration files. First \emph{global} configuration file \file{grgcfg.sl} defines the settings \index{Global configuration file} during system installation when \grg\ is compiled. These global settings become permanent and can be changed only if \grg\ is recompiled. The \emph{local} configuration file \file{grg.cfg} allows one to override global settings locally. \index{Local configuration file} When \grg\ starts it search the file \file{grg.cfg} in current directory (folder) and if it is present uses the corresponding settings. Below we are going to explain how to change settings in both global and local configuration files but before doing this we must emphasize that this need some care. First, the configuration files use LISP command format which differs from usual \grg\ commands. Second, is something is wrong with configuration file then no clear diagnostic is provided. Finally, if global configuration is damaged you will not be able to compile \grg. The best strategy is to make a back-up copy of the configuration files before start editing them. Notice that lines preceded by the percent sign \comm{\%} are ignored by the system (comments). Both local \file{grg.cfg} and global \file{grgcfg.sl} configuration files have similar structure and can include the following commands. Command\index{Signature!default}\index{Dimension!default} \begin{listing} (signature!> - + + + +) \end{listing} establishes default dimension 5 with the signature $\scriptstyle(-,+,+,+,+)$. Do not forget \comm{!} and spaces between \comm{+} and \comm{-}. This command \emph{must be present} in the global configuration file \file{grgcfg.sl} otherwise \grg\ cannot be compiled. The commands \begin{listing} (on!> page) (off!> allfac) \end{listing} change default switch position. In this example we turn on the switch \comm{PAGE} (this switch is defined in DOS \reduce\ only and allows one to scroll back and forth through input and output) and turn off switch \comm{ALLFAC}. The command \begin{listing} (package!> taylor) \end{listing} makes the system to load \reduce\ package \file{taylor} during \grg\ start. The command of the form\index{Synonymy} \begin{listing} (synonymous!> ( affine aff ) ( antisymmetric asy ) ( components comp ) ( unload save ) ) \end{listing} defines synonymous words. The words in each line will be equivalent in all \grg\ commands. Finally the command \begin{listing} (setq ![autostart!] nil) \end{listing} alters default \grg\ start up method. It makes sense only in the global configuration file \file{grgcfg.sl}. By default \grg\ is launched by single command \begin{listing} load grg; \end{listing} which firstly load the program into memory and then automatically starts it. Unfortunately on some systems this short method does not work properly: \grg\ shows wrong timing during computations, the \comm{quit;} command returns the control to \reduce\ session instead of terminating the whole program. If the aforementioned option is activated then \grg\ must be launched by two commands \begin{listing} load grg; grg; \end{listing} which fixes the problems. Here first command just loads the program into memory and second one starts it manually. Notice that one can always use commands \begin{listing} load grg32; grg; \end{listing} to start \grg\ manually. Command \comm{load grg32;} always loads \grg\ into memory without starting it independently on the option under consideration. \subsection{System Directory} \index{System directory} The environment variable \comm{grg} or \comm{GRG} defines so called \grg\ system directory (folder). The way of setting this variable is operating system dependent. For example the following commands can be used to set \comm{grg} variable in DOS, UNIX and VAX/VMS respectively: \begin{listing} set grg=d:{\bs}xxx{\bs}yyy{\bs} {\rm DOS} setenv grg /xxx/yyy/ {\rm UNIX} define grg SYS$USER:[xxx.yyy] {\rm VAX/VMS} \end{listing} The value of the variable \comm{grg} must point out to some directory. In DOS and UNIX the directory name must include trailing \comm{\bs} or \comm{/} respectively. The command\cmdind{Show Status}\cmdind{Status} \command{\opt{Show} Status;} prints current system directory. When \grg\ tries to input some batch file containing \grg\ commands it first searches it in the current working directory and if the file is absent then it tries to find it in the system directory. Therefore if you have some frequently used files you can define the system directory and move these files there. In this case it is not necessary to keep them in each working directory. Notice \grg\ uses the same strategy when opening local configuration file \file{grg.cfg}. Thus if system directory is defined and it contains the file \file{grg.cfg} the settings contained in this file effectively overrides global settings without recompiling \grg. \section{Examples} In this section we want to demonstrate how \grg\ can be applied to solve simple but realistic problem. We want to calculate the Ricci tensor for the Robertson-Walker metric by three different methods. First \grg\ task (program) \begin{listing} Coordinates t,r,theta,phi; Function a(t); Frame T0=d t, T1=a*d r, T2=a*r*d theta, T3=a*r*SIN(theta)*d phi; ds2; Find and Write Ricci Tensor; RIC(\_j,\_k); \end{listing} defines the Robertson-Walker metric using the tetrad formalism with the orthonormal Lorentzian tetrad $\theta^a$. Using built-in formulas for the Ricci tensor the only one command is required to accomplish out goal {\tt Find and Write Ricci Tensor;}. The command {\tt ds2;} just shows the metric we are dealing with. Notice that command {\tt Find ...} gives the \emph{tetrad} components of the Ricci tensor $R_{ab}$. Thus, in addition we print coordinate components of the tensor $R_{\mu\nu}$ by the command {\tt RIC(\_j,\_k);}. The hard-copy of the corresponding \grg\ session is presented below \enlargethispage{4mm} \begin{slisting} <- Coordinates t, r, theta, phi; <- Function a(t); <- Frame T0=d t, T1=a*d r, T2=a*r*d theta, T3=a*r*SIN(theta)*d phi; <- ds2; Assuming Default Metric. Metric calculated By default. 0.16 sec 2 2 2 2 2 2 2 2 2 2 2 ds = - d t + (a ) d r + (a *r ) d theta + (SIN(theta) *a *r ) d phi <- Find and Write Ricci Tensor; Sqrt det of metric calculated. 0.21 sec Volume calculated. 0.21 sec Vector frame calculated From frame. 0.21 sec Inverse metric calculated From metric. 0.21 sec Frame connection calculated. 0.38 sec Curvature calculated. 0.49 sec Ricci tensor calculated From curvature. 0.54 sec Ricci tensor: - 3*DF(a,t,2) RIC = ---------------- 00 a \newpage 2 DF(a,t,2)*a + 2*DF(a,t) RIC = -------------------------- 11 2 a 2 DF(a,t,2)*a + 2*DF(a,t) RIC = -------------------------- 22 2 a 2 DF(a,t,2)*a + 2*DF(a,t) RIC = -------------------------- 33 2 a <- RIC(_j,_k); - 3*DF(a,t,2) j=0 k=0 : ---------------- a 2 j=1 k=1 : DF(a,t,2)*a + 2*DF(a,t) 2 2 j=2 k=2 : r *(DF(a,t,2)*a + 2*DF(a,t) ) 2 2 2 j=3 k=3 : SIN(theta) *r *(DF(a,t,2)*a + 2*DF(a,t) ) \end{slisting} Tracing messages demonstrate that \grg\ automatically applied several built-in equations to obtain required value of $R_{ab}$. The metric is automatically assumed to be Lorentzian $g_{ab}={\rm diag}(-1,1,1,1)$. First \grg\ computed the frame connection 1-form $\omega^a{}_b$. Next the curvature 2-form $\Omega^a{}_b$ was computed using standard equation (\ref{omes}) on page \pageref{omes}. Finally the Ricci tensor was obtained using relation (\ref{rics}) on page \pageref{rics}. Second \grg\ task is similar to the first one: \begin{listing} Coordinates t,r,theta,phi; Function a(t); Metric G00=-1, G11=a^2, G22=(a*r)^2, G33=(a*r*SIN(theta))^2; ds2; Find and Write Ricci Tensor; \end{listing} The only difference is that now we work in the coordinate formalism by assigning value to the metric rather than frame. The frame is assumed to be holonomic automatically. \begin{slisting} <- Coordinates t, r, theta, phi; <- Function a(t); <- Metric G00=-1, G11=a^2, G22=(a*r)^2, G33=(a*r*SIN(theta))^2; <- ds2; Assuming Default Holonomic Frame. Frame calculated By default. 0.11 sec 2 2 2 2 2 2 2 2 2 2 2 ds = - d t + (a ) d r + (a *r ) d theta + (SIN(theta) *a *r ) d phi <- Find and Write Ricci Tensor; Sqrt det of metric calculated. 0.22 sec Volume calculated. 0.22 sec Vector frame calculated From frame. 0.22 sec Inverse metric calculated From metric. 0.27 sec Frame connection calculated. 0.33 sec Curvature calculated. 0.60 sec Ricci tensor calculated From curvature. 0.60 sec Ricci tensor: - 3*DF(a,t,2) RIC = ---------------- t t a 2 RIC = DF(a,t,2)*a + 2*DF(a,t) r r 2 2 RIC = r *(DF(a,t,2)*a + 2*DF(a,t) ) theta theta 2 2 2 RIC = SIN(theta) *r *(DF(a,t,2)*a + 2*DF(a,t) ) phi phi \end{slisting} Once again \grg\ uses the same built-in formulas to compute the Ricci tensor but now all quantities have holonomic indices instead of tetrad ones. Finally the third task demonstrate how \grg\ can be used without built-in equations. Once again we use coordinate formalism and declare two new objects the Christoffel symbols \comm{Chr} and Ricci tensor \comm{Ric} (since \grg\ is case sensitive they are different from the built-in objects \comm{CHR} and \comm{RIC}). Next we use well-known equations to compute these quantities \begin{listing} Coordinates t,r,theta,phi; Function a(t); Metric G00=-1, G11=a^2, G22=(a*r)^2, G33=(a*r*SIN(theta))^2; ds2; New Chr^a_b_c with s(2,3); Chr(j,k,l)= 1/2*GI(j,m)*(@x(k)|G(l,m)+@x(l)|G(k,m)-@x(m)|G(k,l)); New Ric_a_b with s(1,2); Ric(j,k) = @x(n)|Chr(n,j,k) - @x(k)|Chr(n,j,n) + Chr(n,m,n)*Chr(m,j,k) - Chr(n,m,k)*Chr(m,n,j); Write Ric; \end{listing} The hard-copy of the corresponding session is \begin{slisting} <- Coordinates t, r, theta, phi; <- Function a(t); <- Metric G00=-1, G11=a^2, G22=(a*r)^2, G33=(a*r*SIN(theta))^2; <- ds2; Assuming Default Holonomic Frame. Frame calculated By default. 0.16 sec 2 2 2 2 2 2 2 2 2 2 2 ds = - d t + (a ) d r + (a *r ) d theta + (SIN(theta) *a *r ) d phi <- New Chr^a_b_c with s(2,3); <- Chr(j,k,l)=1/2*GI(j,m)*(@x(k)|G(l,m)+@x(l)|G(k,m)-@x(m)|G(k,l)); Inverse metric calculated From metric. 0.27 sec <- New Ric_a_b with s(1,2); <- Ric(j,k)=@x(n)|Chr(n,j,k)-@x(k)|Chr(n,j,n)+Chr(n,m,n)*Chr(m,j,k) -Chr(n,m,k)*Chr(m,n,j); <- Write Ric; The Ric: - 3*DF(a,t,2) Ric = ---------------- t t a 2 Ric = DF(a,t,2)*a + 2*DF(a,t) r r \newpage 2 2 Ric = r *(DF(a,t,2)*a + 2*DF(a,t) ) theta theta 2 2 2 Ric = SIN(theta) *r *(DF(a,t,2)*a + 2*DF(a,t) ) phi phi \end{slisting} \chapter{Formulas} \parindent=0pt \arraycolsep=1pt \parskip=1.6mm plus 1mm minus 1mm This chapter describes in usual mathematical manner all \grg\ built-in objects and formulas. The description is extremely short since it is intended for reference only. If not stated explicitly we use lower case greek letters ${\scriptstyle \alpha,\beta,\dots}$ for holonomic (coordinate) indices; ${\scriptstyle a,b,c,d,m,n}$ for anholonomic frame indices and ${\scriptstyle i,j,k,l}$ for enumerating indices. To establish the relationship between \grg\ built-in object6s and mathematical quantities we use the following notation \[ \mbox{\tt Frame Connection omega'a.b} = \omega^a{}_b \] This equality means that there is built-in object named {\tt Frame Connection} having identifier {\tt omega} which represent the frame connection 1-form $\omega^a{}_b$. If the name is omitted then we deal with \emph{macro} object (see page \pageref{macro}). The notation for indices in the left-hand side of such equalities is the same as in the {\tt New object} declaration and is explained on page \pageref{indices}. This chapter contains not only definitions of all built-in objects but all formulas which \grg\ knows and can apply to find their value. If an object has several formulas for its computation when each formula is given together with the corresponding name which is printed in the typewriter font. In the case then an object has only one associated formula the way name is usually omitted. \section{Dimension and Signature} Let us denote the space-time dimensionality by $d$ and $n$'th element of the signature specification ${\rm diag}{\scriptstyle(+1,-1,\dots)}$ by ${\rm diag}_n$ ($n$ runs from 0 to $d-1$). There are several macro objects which gives access to the dimension and signature \object{dim}{d} \object{sdiag.idim}{{\rm diag}_i} \object{sgnt \mbox{=} sign}{s=\prod^{d-1}_{i=0}{\rm diag}_i} \object{mpsgn}{{\rm diag}_0} \object{pmsgn}{-{\rm diag}_0} The macros (two equivalent ones) which give access to coordinates \object{X\^m \mbox{=} x\^m}{x^\mu} \section{Metric, Frame and Basis} Frame $\theta^a$ and metric $g_{ab}$ plays the fundamental role in \grg. Together they determine the space-time line element \begin{equation} ds^2 = g_{ab}\,\theta^a\!\otimes\theta^b = g_{\mu\nu}\,dx^\mu\!\otimes dx^\nu \end{equation} The corresponding objects are \object{Frame T'a}{\theta^a=h^a_\mu dx^\mu} \object{Metric G.a.b}{g_{ab}} and ``inverse'' objects are \object{Vector Frame D.a}{\partial_a=h^\mu_a\partial_\mu} \object{Inverse Metric GI'a'b}{g^{ab}} The frame can be computed by two ways. First, {\tt By default} frame is assumed to be holonomic \begin{equation} \theta^a = dx^\alpha \end{equation} and {\tt From vector frame} \begin{equation} \theta^a= |h_a^\mu|^{-1} d x^\mu \end{equation} The vector frame can be obtained {\tt From frame} \begin{equation} \partial_a= |h^a_\mu|^{-1} \partial_\mu \end{equation} The metric can be computed {\tt By default} \index{Metric!default value} \begin{equation} g_{ab} = {\rm if}\ a=b\ {\rm then}\ {\rm diag}_a\ {\rm else}\ 0 \end{equation} or {\tt From inverse metric} \begin{equation} g_{ab} = |g^{ab}|^{-1} \end{equation} The inverse metric can be computed {\tt From metric} \begin{equation} g^{ab} = |g_{ab}|^{-1} \end{equation} The holonomic metric $g_{\mu\nu}$ and frame $h^a_\mu$ are given by the macro objects: \object{g\_m\_n}{g_{\mu\nu}} \object{gi\^m\^n}{g^{\mu\nu}} \object{h'a\_m}{h^a_\mu} \object{hi.a\^m}{h_a^\mu} The metric determinants and related densities \object{Det of Metric detG}{g={\rm det}|g_{ab}|} \object{Det of Holonomic Metric detg}{{\rm det}|g_{\mu\nu}|} \object{Sqrt Det of Metric sdetG}{\sqrt{sg}} The volume $d$-form \object{Volume VOL}{\upsilon = \sqrt{sg}\,\theta^0\wedge\dots\wedge\,\theta^{d-1} =\frac{1}{d!}{\cal E}_{a_0\dots a_{d-1}}\,\theta^{a_0}\wedge\dots\wedge\,\theta^{a_{d-1}}} The so called s-forms play the role of basis in the space of the 2-forms \object{S-forms S'a'b}{S^{ab}=\theta^a\wedge\theta^b} The basis and corresponding inverse vector basis are used when \grg\ works in the anholonomic mode \seethis{See page \pageref{amode}.} \object{Basis b'idim }{b^i=b^i_\mu dx^\mu} \object{Vector Basis e.idim }{e_i=b_i^\mu\partial_\mu} The basis can be computed {\tt From frame} \begin{equation} b^i=\theta^i \end{equation} or {\tt From vector basis} \begin{equation} b^i = |b_i^\mu|^{-1}dx^\mu \end{equation} The vector basis can be computed {\tt From basis} \begin{equation} e_i = |b^i_\mu|^{-1}\partial_\mu \end{equation} \section{Delta and Epsilon Symbols} Macro objects for Kronecker delta symbols \object{del\^m\_n}{\delta^\mu_\nu} \object{delh'a.b}{\delta^a_b} and totally antisymmetric tensors \object{eps.a.b.c.d}{{\cal E}_{abcd},\quad{\cal E}_{0123}=\sqrt{sg}} \object{epsi'a'b'c'd}{{\cal E}^{abcd},\quad{\cal E}_{0123}=\frac{s}{\sqrt{sg}}} \object{epsh\_m\_n\_k\_l}{{\cal E}_{\mu\nu\kappa\lambda},\quad{\cal E}_{0123}=\sqrt{s\,{\rm det}|g_{\mu\nu}|}} \object{epsih\^m\^n\^k\^l}{{\cal E}^{\mu\nu\kappa\lambda},\quad{\cal E}_{0123}=\frac{s}{\sqrt{s\,{\rm det}|g_{\mu\nu}|}}} The definition for epsilon-tensors is given for dimension 4. The generalization to other dimensions is obvious. \section{Dualization} We use the following definition for the dualization operation. For any $p$-form \begin{equation} \omega_p=\frac{1}{p!}\omega_{\alpha_1\dots\alpha_p}dx^{\alpha_1}\wedge \dots\wedge dx^{\alpha_p} \end{equation} the dual $(d-p)$-form is \begin{equation} *\omega_p=\frac{1}{p!(d-p)!}{\cal E}_{\alpha_1\dots\alpha_{d-p}} {}^{\beta_1\dots\beta_p}\,\omega_{\beta_1\dots\beta_p}\, dx^{\alpha_1}\wedge\dots\wedge dx^{\alpha_{d-p}} \end{equation} The equivalent relation which also uniquely defines the $*$ operation is \begin{equation} *(\theta^{a_1}\wedge\dots\wedge \theta^{a_p}) = (-1)^{p(d-p)} \partial_{a_p}\ipr\dots\partial_{a_1}\ipr\,\upsilon \end{equation} With such convention we have the following identities \begin{eqnarray} **\omega_p &=& s(-1)^{p(d-p)}\,\omega_p \\[0.5mm] *\upsilon &=& s \\[0.5mm] *1 &=& \upsilon \end{eqnarray} \section{Spinors} \label{spinors1} The notion of spinors in \grg\ is restricted to 4-dimensional spaces of Lorentzian signature ${\scriptstyle(-,+,+,+)}$ or ${\scriptstyle(+,-,-,-)}$ only. In this section the upper sign relates to the signature ${\scriptstyle(-,+,+,+)}$ and lower one to ${\scriptstyle(+,-,-,-)}$. In addition to work with spinors the metric must have the following form which we call the \emph{standard null metric} \index{Metric!Standard Null} \index{Standard null metric}\index{Spinors}\index{Spinors!Standard null metric} \begin{equation} g_{ab}=g^{ab}=\pm\left(\begin{array}{rrrr} 0 & -1 & 0 & 0 \\ -1 & 0 & 0 & 0 \\ 0 & 0 & 0 & 1 \\ 0 & 0 & 1 & 0 \end{array}\right) \end{equation} Such value of the metric can be established by the command \cmdind{Null Metric} {\tt Null metric;}. Therefore the line-element for spinorial formalism has the form \begin{equation} ds^2 = \pm(-\theta^0\!\otimes\theta^1 -\theta^1\!\otimes\theta^0 +\theta^2\!\otimes\theta^3 +\theta^3\!\otimes\theta^2) \end{equation} We require also the conjugation rules for this null tetrad (frame) be \begin{equation} \overline{\theta^0}=\theta^0,\quad \overline{\theta^1}=\theta^1,\quad \overline{\theta^2}=\theta^3,\quad \overline{\theta^3}=\theta^2 \end{equation} For such a metric and frame we fix sigma-matrices in the following form \index{Sigma matrices} \begin{eqnarray} \label{sigma} &&\sigma_0{}^{1\dot{1}}= \sigma_1{}^{0\dot{0}}= \sigma_2{}^{1\dot{0}}= \sigma_3{}^{0\dot{1}}=1 \\[1mm] && \sigma^0{}_{1\dot{1}}= \sigma^1{}_{0\dot{0}}= \sigma^2{}_{1\dot{0}}= \sigma^3{}_{0\dot{1}}=\mp1 \end{eqnarray} The sigma-matrices obey the rules \begin{eqnarray} g_{mn}\sigma^m\!{}_{A\dot B}\sigma^n\!{}_{C\dot D} &=& \mp \epsilon_{AC}\epsilon_{\dot B\dot D} \\[1mm] \sigma^{aM\dot N}\sigma^b\!{}_{M\dot N} &=& \mp g^{ab} \end{eqnarray} The antisymmetric SL(2,C) spinor metric \begin{equation} \epsilon_{AB}=\epsilon^{AB} =\epsilon_{\dot A\dot B} =\epsilon^{\dot A\dot B}= \left(\begin{array}{rr} 0 & 1 \\ -1 & 0 \end{array}\right) \end{equation} can be used to raise and lower spinor indices \begin{equation} \varphi^A=\varphi_B\,\epsilon^{BA},\qquad \varphi_A=\epsilon_{AB}\,\varphi^B \end{equation} The following macro objects represent standard spinorial quantities \object{DEL'A.B}{\delta^A_B} \object{EPS.A.B}{\epsilon_{AB}} \object{EPSI'A'B}{\epsilon^{AB}} \object{sigma'a.A.B\cc}{\sigma^a\!{}_{A\dot B}} \object{sigmai.a'A'B\cc}{\sigma_a{}^{A\dot B}} The relationship between tensors and spinors is established by the sigma-matrices \begin{eqnarray} X^a &\tsst& X^{A\dot A}=A^a\sigma_a{}^{A\dot A} \\ X_a &\tsst& X_{A\dot A}=A_a\sigma^a\!{}_{A\dot A} \end{eqnarray} where sigma-matrices are given by Eq. (\ref{sigma}) We shall denote similar equations by the sign $\tsst$ conserving alphabetical relationship between tensor indices in the left-hand side and spinorial one in the right-hand side: $\scriptstyle a\tsst A\dot A$, $\scriptstyle b\tsst B\dot B$. There is one quite important special case. Any real antisymmetric tensor $X_{ab}$ are equivalent to the pair of conjugated irreducible (symmetric) spinors \begin{eqnarray} && X_{ab}=X_{[ab]} \tsst X_{A\dot AB\dot B}= \epsilon_{AB} X_{\dot A\dot B} + \epsilon_{\dot A\dot B}X_{AB} \nonumber\\[1mm] && X_{AB}=\frac{1}{2}X_{A\dot AB\dot B}\epsilon^{\dot A\dot B},\ X_{\dot A\dot B}=\frac{1}{2}X_{A\dot AB\dot B}\epsilon^{AB} \end{eqnarray} The explicit form of these relations for the sigma-matrices (\ref{sigma}) is \begin{equation} \begin{array}{rclrcl} X_0 &=& X_{13} & X_{\dot0} &=& X_{12} \\[1mm] X_1 &=&-\frac{1}{2}(X_{01}-X_{23})\qquad & X_{\dot1} &=& -\frac{1}{2}(X_{01}+X_{23}) \\[1mm] X_2 &=& -X_{02} & X_{\dot2} &=& -X_{03} \end{array}\label{asys} \end{equation} and the ``inverse'' relation \begin{equation} \begin{array}{rclrcl} X_{01} &=& -X_1-X_{\dot1},\qquad & X_{23} &=& X_1-X_{\dot1}, \\[1mm] X_{02} &=& -X_2, & X_{12} &=& X_{\dot0}, \\[1mm] X_{03} &=& -X_{\dot 2}, & X_{13} &=& X_0 \end{array}\label{asyt} \end{equation} We shall apply the relations (\ref{asys}) and (\ref{asyt}) to various antisymmetric quantities. In particular the {\tt Spinorial S-forms} \object{Undotted S-forms SU.AB}{S_{AB}} \object{Dotted S-forms SD.AB\cc}{S_{\dot A\dot B}} The {\tt Standard way} to compute these quantities uses relations (\ref{asys}) \begin{equation} S_{ab}=\theta_a\wedge\theta_b \tsst \epsilon_{AB} S_{\dot A\dot B} + \epsilon_{\dot A\dot B}S_{AB} \end{equation} Spinorial S-forms are self dual \begin{equation} *S_{AB}=iS_{AB},\qquad *S_{\dot A\dot B}=-iS_{\dot A\dot B} \end{equation} and exteriorly orthogonal \begin{equation} S_{AB}\wedge S_{CD}=-\frac{i}2\upsilon(\epsilon_{AC}\epsilon_{BD}+ \epsilon_{AD}\epsilon_{BC}),\quad S_{AB}\wedge S_{\dot C\dot D}=0 \end{equation} There is one subtle pint concerning tensor quantities in the spinorial formalism. Since spinorial null tetrad is complex with the conjugation rule $\overline{\theta^2}=\theta^3$ all tensor quantities represented in this frame also becomes complex with similar conjugation rules for any tensor index. There is special macro object {\tt cci} which performs such ``index conjugation'': {\tt cci{0}=0}, {\tt cci(1)=1}, {\tt cci{2}=3}, {\tt cci(3)=2}. Therefore the correct expression for the $\overline{\theta^a}$ is {\tt \cc T(cci(a))} but not {\tt \cc T(a)}. \section{Connection, Torsion and Nonmetricity} \label{conn1} Covariant derivatives and differentials for quantities having frame and coordinate indices are \begin{eqnarray} DX^a{}_b &=& dX^a{}_b + \omega^a{}_m\wedge X^m{}_b - \omega^m{}_b\wedge X^a{}_m \\[1mm] DX^\mu{}_\nu &=& dX^\mu{}_\nu + \Gamma^\mu{}_\pi\wedge X^\pi{}_\nu - \Gamma^\pi{}_\nu\wedge X^\mu{}_\pi \end{eqnarray} The corresponding built-in connection 1-forms are \object{Frame Connection omega'a.b}{\omega^a{}_b=\omega^a{}_{b\mu}dx^\mu} \object{Holonomic Connection GAMMA\^m\_n} {\Gamma^\mu{}_\nu=\Gamma^\mu{}_{\nu\pi}dx^\pi} Frame connection can be computed {\tt From holonomic connection} \begin{equation} \omega^a{}_b = \Gamma^a{}_b + dh^\mu_b\,h^a_\mu \end{equation} and inversely holonomic connection can be obtained {\tt From frame connection} \begin{equation} \Gamma^\mu{}_\nu=\omega^\mu{}_\nu + dh^b_\nu\,h^\mu_b \end{equation} By default these connections are Riemannian (i.e. symmetric and metric compatible). To work with nonsymmetric connection with torsion the switch \comm{TORSION}\swinda{TORSION} must be turned on. Then the torsion 2-form is \object{Torsion THETA'a}{\Theta^a=\frac12Q^a{}_{pq}S^{pq},\quad Q^a{}_{bc}=\Gamma^a{}_{bc}-\Gamma^a_{cb}} Finally to work with non metric-compatible spaces with nonmetricity the switch \comm{NONMETR}\swinda{NONMETR} must be turned on. The nonmetricity 1-form is \object{Nonmetricity N.a.b}{N_{ab}=N_{ab\mu}dx^\mu, \quad N_{ab\mu}=-\nabla_\mu g_{ab}} In general any torsion or nonmetricity related object is defined iff the corresponding switch is on. If either \comm{TORSION} or \comm{NONMETR} is on then Riemannian versions of the connection 1-forms are available as well \object{Riemann Frame Connection romega'a.b} {\rim{\omega}{}^a{}_b} \object{Riemann Holonomic Connection RGAMMA\^m\_n} {\rim{\Gamma}{}^\mu{}_\nu} The Riemann holonomic connection can be obtained {\tt From Riemann frame connection} \begin{equation} \rim{\Gamma}{}^\mu{}_\nu=\rim{\omega}{}^\mu{}_\nu + dh^b_\nu\,h^\mu_b \end{equation} If torsion is nonzero but nonmetricity vanishes (\comm{TORSION} is on, \comm{NONMETR} is off) then the difference between the connection and Riemann connection is called the contorsion 1-form \object{Contorsion KQ'a.b}{\stackrel{\scriptscriptstyle Q}{K}\!{}^a{}_b= \stackrel{\scriptscriptstyle Q}{K}\!{}^a{}_{b\mu}dx^\mu= \Gamma^a{}_b-\rim{\Gamma}{}^a{}_b} If nonmetricity is nonzero but torsion vanishes (\comm{TORSION} is off, \comm{NONMETR} is on) then the difference between the connection and Riemann connection is called the nonmetricity defect \object{Nonmetricity Defect KN'a.b} {\stackrel{\scriptscriptstyle N}{K}\!{}^a{}_b= \stackrel{\scriptscriptstyle N}{K}\!{}^a{}_{b\mu}dx^\mu= \Gamma^a{}_b-\rim{\Gamma}{}^a{}_b} Finally if both torsion and nonmetricity are nonzero (\comm{TORSION} and \comm{NONMETR} are on) then we \object{Connection Defect K'a.b} {K^a{}_b=K^a{}_{b\mu}dx^\mu= \Gamma^a{}_b-\rim{\Gamma}{}^a{}_b} \begin{equation} K^a{}_b = \stackrel{\scriptscriptstyle Q}{K}\!{}^a{}_b + \stackrel{\scriptscriptstyle N}{K}\!{}^a{}_b \end{equation} For the sake of convenience we introduce also macro objects which compute the usual Christoffel symbols \object{CHR\^m\_n\_p }{ \{{}^\mu_{\nu\pi}\} = \frac{1}{2}g^{\mu\tau}(\partial_\pi g_{\nu\tau} +\partial_\nu g_{\pi\tau} -\partial_\tau g_{\nu\pi})} \object{CHRF\_m\_n\_p }{ [{}_{\mu},_{\nu\pi}] = \frac{1}{2}(\partial_\pi g_{\nu\mu} +\partial_\nu g_{\pi\mu} -\partial_\mu g_{\nu\pi})} \object{CHRT\_m }{ \{{}^\pi_{\pi\mu}\} = \frac{1}{2{\rm det}|g_{\alpha\beta}|}\partial_\mu\left( {\rm det}|g_{\alpha\beta}|\right)} The connection, frame, metric, torsion and nonmetricity are related to each other by the so called structural equations which in the most general case read \begin{eqnarray} && D\theta^a + \Theta^a = 0 \nonumber\\[2mm] && Dg_{ab} + N_{ab} = 0 \label{str0} \end{eqnarray} or in the equivalent ``explicit'' form \begin{equation} \begin{array}{ll} \omega^a{}_b\wedge\theta^b = -t^a,\qquad & t^a=d\theta^a+\Theta^a,\\[2mm] \omega_{ab}+\omega_{ba} = n_{ab},\qquad & n_{ab}=dg_{ab}+N_{ab} \label{str} \end{array} \end{equation} The solution to equations (\ref{str}) are given by the relation \begin{equation} \omega^a{}_b = \frac{1}{2}\left[ -\partial^a\ipr t_b + \partial_b\ipr t^a + n^a{}_b +\big(\partial^a\ipr(\partial_b\ipr t_c-n_{bc}) +\partial_b\ipr n^a{}_c\big)\theta^c\right] \label{solstr} \end{equation} For various specific values of $n_{ab}$ and $t^a$ equations (\ref{str}) and (\ref{solstr}) can be used for different purposes. In the most general case (\ref{solstr}) is the {\tt Standard way} to compute connection 1-form $\omega^a{}_b$. The torsion and nonmetricity are included in these equations depending on the switches \comm{TORSION} and \comm{NONMETR}. The same equation (\ref{solstr}) with $n_{ab}=dg_{ab}$ and $t^a=d\theta^a$ is the {\tt Standard way} to find Riemann frame connection $\rim{\omega}{}^a{}_b$. If torsion is nonzero then $\omega^a{}_b$ can be computed {\tt From contorsion} \begin{equation} \omega^a{}_b = \rim{\omega}{}^a{}_b + \stackrel{\scriptscriptstyle Q}{K}\!{}^a{}_b \label{a1} \end{equation} where $\rim{\omega}{}^a{}_b$ is given by Eq. (\ref{solstr}). Similarly if nonmetricity is nonzero then $\omega^a{}_b$ can be computed {\tt From nonmetricity defect} \begin{equation} \omega^a{}_b = \rim{\omega}{}^a{}_b + \stackrel{\scriptscriptstyle N}{K}\!{}^a{}_b \label{a2} \end{equation} where $\rim{\omega}{}^a{}_b$ is given by Eq. (\ref{solstr}). Finally if both torsion and nonmetricity are nonzero then $\omega^a{}_b$ can be computed {\tt From connection defect} \begin{equation} \omega^a{}_b = \rim{\omega}{}^a{}_b + K^a{}_b \label{a3} \end{equation} where $\rim{\omega}{}^a{}_b$ is given by Eq. (\ref{solstr}). The Riemannian part of connection in Eqs. (\ref{a1}), (\ref{a2}), (\ref{a3}) are directly computed by Eq. (\ref{solstr}) (not via the object \comm{romega}). The contorsion $\stackrel{\scriptscriptstyle Q}{K}\!{}^a{}_b$ is obtained {\tt From torsion} by (\ref{solstr}) with $t^a=\Theta^a$, $n_{ab}=0$. The nonmetricity defect $\stackrel{\scriptscriptstyle N}{K}\!{}^a{}_b$ is obtained {\tt From nonmetricity} by (\ref{solstr}) with $t^a=0$, $n_{ab}=N_{ab}$. Analogously (\ref{solstr}) with $t^a=\Theta^a$, $n_{ab}=N_{ab}$ is the {\tt Standard way} to compute the connection defect $K^a{}_b$. The torsion $\Theta^a$ can be calculated {\tt From contorsion} \begin{equation} \Theta^a = -\stackrel{\scriptscriptstyle Q}{K}\!{}^a{}_b\wedge\theta^b \end{equation} or {\tt From connection defect} \begin{equation} \Theta^a = -K^a{}_b\wedge\theta^b \end{equation} The nonmetricity $N_{ab}$ can be computed {\tt From nonmetricity defect} \begin{equation} N_{ab} = \stackrel{\scriptscriptstyle N}{K}_{ab}+ \stackrel{\scriptscriptstyle N}{K}_{ba} \end{equation} or {\tt From connection defect} \begin{equation} N_{ab} = K_{ab}+K_{ba} \end{equation} \section{Spinorial Connection and Torsion} Spinorial connection is defined in \grg\ iff nonmetricity is zero and switch \comm{NONMETR} is turned off. The upper sign in this section correspond to the signature ${\scriptstyle(-,+,+,+)}$ while lower one to the signature ${\scriptstyle(+,-,-,-)}$. Spinorial connection is defined by the equation \begin{equation} DX^A_{\dot B} = dX^A{}_{\dot B} \mp\omega^A{}_M\,X^M{}_{\dot B} \pm\omega^{\dot M}{}_{\dot B}\,X^A{}_{\dot M} \end{equation} where due to antisymmetry of the frame connection $\omega_{ab}=\omega_{[ab]}$ we have {\tt Spinorial connection} 1-forms \begin{equation} \omega_{ab} \tsst \epsilon_{AB} \omega_{\dot A\dot B} + \epsilon_{\dot A\dot B} \omega_{AB} \end{equation} \object{Undotted Connection omegau.AB}{\omega_{AB}} \object{Dotted Connection omegad.AB\cc}{\omega_{\dot A\dot B}} The spinorial connection 1-forms $\omega_{AB}$ and $\omega_{\dot A\dot B}$ can be calculated {\tt From frame connection} by the standard spinor $\tsst$ tensor relation (\ref{asys}). Inversely the frame connection $\omega_{ab}$ can be found {\tt From spinorial connection} by relation (\ref{asyt}). Since $\omega_{ab}$ is real the spinorial equivalents $\omega_{AB}$ and $\omega_{\dot A\dot B}$ can be computed from each other {\tt By conjugation} \begin{equation} \omega_{\dot A\dot B}=\overline{\omega_{AB}},\qquad \omega_{AB}=\overline{\omega_{\dot A\dot B}} \end{equation} If torsion is nonzero (\comm{TORSION} is on) when we have in addition the {\tt Riemann spinorial connection} \object{Riemann Undotted Connection romegau.AB}{\rim{\omega}_{AB}} \object{Riemann Dotted Connection romegad.AB\cc}{\rim{\omega}_{\dot A\dot B}} The Riemann spinorial connection $\rim{\omega}_{AB}$ can be calculated by {\tt Standard way} \begin{equation} \stackrel{{\scriptscriptstyle\{\}}}{\omega}_{AB}= \label{ssolver} \pm i*[ d S_{AB}\wedge\theta_{C\dot C} -\epsilon_{C(A} d S_{B)M}\wedge \theta^M_{\ \ \dot C}]\theta^{C\dot C} \end{equation} The conjugated relation is used for $\rim{\omega}_{\dot A\dot B}$. The {\tt Spinorial contorsion} 1-forms \object{Undotted Contorsion KU.AB}{\stackrel{\scriptscriptstyle Q}{K}\!{}_{AB}} \object{Dotted Contorsion KD.AB\cc}{\stackrel{\scriptscriptstyle Q}{K}\!{}_{\dot A\dot B}} are the spinorial analogues of the contorsion 1-form \begin{equation} \stackrel{\scriptscriptstyle Q}{K}_{ab} \tsst \epsilon_{AB} \stackrel{\scriptscriptstyle Q}{K}_{\dot A\dot B} + \epsilon_{\dot A\dot B} \stackrel{\scriptscriptstyle Q}{K}_{AB} \end{equation} The spinorial contorsion 1-forms $\stackrel{\scriptscriptstyle Q}{K}_{AB}$ and $\stackrel{\scriptscriptstyle Q}{K}_{\dot A\dot B}$ can be calculated {\tt From contorsion} by the standard spinor $\tsst$ tensor relation (\ref{asys}). Inversely the contorsion $\stackrel{\scriptscriptstyle Q}{K}_{ab}$ can be found {\tt From spinorial contorsion} by relation (\ref{asyt}). The spinorial equivalents $\stackrel{\scriptscriptstyle Q}{K}_{AB}$ and $\stackrel{\scriptscriptstyle Q}{K}_{\dot A\dot B}$ can be computed from each other {\tt By conjugation} \begin{equation} \stackrel{\scriptscriptstyle Q}{K}_{\dot A\dot B}=\overline{\stackrel{\scriptscriptstyle Q}{K}_{AB}},\qquad \stackrel{\scriptscriptstyle Q}{K}_{AB}=\overline{\stackrel{\scriptscriptstyle Q}{K}_{\dot A\dot B}} \end{equation} The {\tt Standard way} to find $\omega_{AB}$ is \begin{equation} \omega_{AB} = \rim{\omega}_{AB}+\stackrel{\scriptscriptstyle Q}{K}_{AB} \end{equation} where $\rim{\omega}_{AB}$ is given directly by Eq. (\ref{ssolver}). The conjugated Eq. is used for $\omega_{\dot A\dot B}$. \section{Curvature} The curvature 2-form \object{Curvature OMEGA'a.b}{\Omega^a{}_b= \frac{1}{2}R^a_{bcd}\,S^{cd}} can be computed {\tt By standard way} \begin{equation} \Omega^a{}_b = d\omega^a{}_b + \omega^a{}_n \wedge \omega^n{}_b \label{omes} \end{equation} The Riemann curvature tensor is given by the relation \object{Riemann Tensor RIM'a.b.c.d}{R^a{}_{bcd}= \partial_d\ipr\partial_c\ipr\Omega^a{}_b} The Ricci tensor \object{Ricci Tensor RIC.a.b}{R_{ab}} can be computed {\tt From Curvature} \begin{equation} R_{ab} = \partial_b\ipr\partial_m\ipr\Omega^m{}_a \label{rics} \end{equation} or {\tt From Riemann tensor} \begin{equation} R_{ab} = R^m{}_{amb} \end{equation} The \object{Scalar Curvature RR}{R} can be computed {\tt From Ricci Tensor} \begin{equation} R = R_{mn}\,g^{mn} \end{equation} The Einstein tensor is given by the relation \object{Einstein Tensor GT.a.b}{G_{ab}=R_{ab}-\frac{1}{2}g_{ab}R} If nonmetricity is nonzero (\comm{NONMETR} is on) then we have \object{Homothetic Curvature OMEGAH}{\OO{h}} \object{A-Ricci Tensor RICA.a.b}{\RR{A}_{ab}} \object{S-Ricci Tensor RICS.a.b}{\RR{S}_{ab}} They can be calculated {\tt From curvature} by the relations \begin{equation} \OO{h}=\Omega^n{}_n \end{equation} \begin{equation} \RR{A}_{ab}= \partial_b\ipr\partial^m\ipr\Omega_{[ma]} \end{equation} \begin{equation} \RR{S}_{ab}= \partial_b\ipr\partial^m\ipr\Omega_{(ma)} \end{equation} and the scalar curvature can be computed {\tt From A-Ricci tensor} \begin{equation} R = \RR{A}_{mn}g^{mn} \end{equation} \section{Spinorial Curvature} Spinorial curvature is defined in \grg\ iff nonmetricity is zero and switch \comm{NONMETR} is turned off. The upper sign in this section correspond to the signature ${\scriptstyle(-,+,+,+)}$ while lower one to the signature ${\scriptstyle(+,-,-,-)}$. The {\tt Spinorial curvature} 2-forms \object{Undotted Curvature OMEGAU.AB}{\Omega_{AB}} \object{Dotted Curvature OMEGAD.AB\cc}{\Omega_{\dot A\dot B}} is related to the curvature 2-form $\Omega_{ab}$ by the standard relation \begin{equation} \Omega_{ab} \tsst \epsilon_{AB} \Omega_{\dot A\dot B} + \epsilon_{\dot A\dot B} \Omega_{AB} \end{equation} The spinorial curvature 1-forms $\Omega_{AB}$ and $\Omega_{\dot A\dot B}$ can be calculated {\tt From curvature} by the relation (\ref{asys}). The frame curvature $\Omega_{ab}$ can be found {\tt From spinorial curvature} by relation (\ref{asyt}). The $\Omega_{AB}$ and $\Omega_{\dot A\dot B}$ can be computed from each other {\tt By conjugation} \begin{equation} \Omega_{\dot A\dot B}=\overline{\Omega_{AB}},\qquad \Omega_{AB}=\overline{\Omega_{\dot A\dot B}} \end{equation} The {\tt Standard way} to calculate $\Omega_{AB}$ is \begin{equation} \Omega_{AB} = d\omega_{AB} \pm \omega_A{}^M\wedge\omega_{MB} \end{equation} The conjugated relation is used for $\Omega_{\dot A\dot B}$. \section{Curvature Decomposition} In general curvature consists of 11 irreducible pieces. If nonmetricity is nonzero then one can perform decomposition \begin{equation} R_{abcd}=\RR{A}_{abcd}+\RR{S}_{abcd},\qquad \RR{A}_{abcd}=R_{[ab]cd},\qquad \RR{S}_{abcd}=R_{(ab)cd} \end{equation} Here the S-part of the curvature vanishes identically if nonmetricity is zero and we consider further decomposition of A and S parts independently. First we consider the A-part of the curvature. It can be decomposed into 6 pieces \begin{equation} \RR{A}_{abcd} = \RR{w}_{abcd}+ \RR{c}_{abcd}+ \RR{r}_{abcd}+ \RR{a}_{abcd}+ \RR{b}_{abcd}+ \RR{d}_{abcd} \end{equation} Here first three terms are the well-known irreducible pieces of the Riemannian curvature while last three terms vanish if torsion is zero. The corresponding 2-forms are \object{Weyl 2-form OMW.a.b } {\OO{w}_{ab} = \frac12 \RR{w}_{abcd}\,S^{cd}} \object{Traceless Ricci 2-form OMC.a.b } {\OO{c}_{ab} = \frac12 \RR{c}_{abcd}\,S^{cd}} \object{Scalar Curvature 2-form OMR.a.b } {\OO{r}_{ab} = \frac12 \RR{r}_{abcd}\,S^{cd}} \object{Ricanti 2-form OMA.a.b } {\OO{a}_{ab} = \frac12 \RR{a}_{abcd}\,S^{cd}} \object{Traceless Deviation 2-form OMB.a.b } {\OO{b}_{ab} = \frac12 \RR{b}_{abcd}\,S^{cd}} \object{Antisymmetric Curvature 2-form OMD.a.b } {\OO{d}_{ab} = \frac12 \RR{d}_{abcd}\,S^{cd}} The {\tt Standard way} to find these quantities is given by the following formulas. \begin{equation} \OO{r}_{ab} = \frac{1}{d(d-1)}R\,S_{ab} \end{equation} \begin{equation} \OO{c}_{ab} = \frac{1}{(d-2)}\left[ C_{am}\,\theta^m\!\wedge\theta_b -C_{bm}\,\theta^m\!\wedge\theta_a\right],\quad C_{ab}=\RR{A}_{(ab)}-\frac{1}{d}g_{ab}R \end{equation} \begin{equation} \OO{a}_{ab} = \frac{1}{(d-2)}\left[ A_{am}\,\theta^m\!\wedge\theta_b -A_{bm}\,\theta^m\!\wedge\theta_a\right],\quad A_{ab}=\RR{A}_{[ab]} \end{equation} \begin{equation} \OO{d}_{ab} = \frac{1}{12}\partial_b\ipr\partial_a\ipr (\OO{A}_{mn}\wedge\theta^m\!\wedge\theta^n) \end{equation} \begin{equation} \OO{b}_{ab} =\frac{1}{2}\left[ \partial_b\ipr(\theta^m\!\wedge\OO{A0}_{am}) -\partial_a\ipr(\theta^m\!\wedge\OO{A0}_{bm}) \right] \end{equation} where \[ \OO{A0}_{ab} = \OO{A}_{ab} -\OO{c}_{ab} -\OO{r}_{ab} -\OO{a}_{ab} -\OO{d}_{ab} \] And finally \begin{equation} \OO{w}_{ab} = \OO{A}_{ab} -\OO{c}_{ab} -\OO{r}_{ab} -\OO{a}_{ab} -\OO{b}_{ab} -\OO{d}_{ab} \end{equation} If $d=2$ then $\OO{A}_{ab}$ turns out to be irreducible and coincides with the scalar curvature irreducible piece \begin{equation} \OO{A}_{ab} = \OO{r}_{ab} \end{equation} Now we consider the decomposition of the S curvature part which is nonzero iff nonmetricity is nonzero. First we consider the case $d\geq3$. In this case we have 5 irreducible components \begin{equation} \RR{S}_{abcd} = \RR{h}_{abcd}+ \RR{sc}_{abcd}+ \RR{sa}_{abcd}+ \RR{v}_{abcd}+ \RR{u}_{abcd} \end{equation} The corresponding 2-forms are \object{Homothetic Curvature 2-form OSH.a.b } {\OO{h}_{ab} = \frac12 \RR{h}_{abcd}\,S^{cd}} \object{Antisymmetric S-Ricci 2-form OSA.a.b } {\OO{sa}_{ab} = \frac12 \RR{sa}_{abcd}\,S^{cd}} \object{Traceless S-Ricci 2-form OSC.a.b } {\OO{sc}_{ab} = \frac12 \RR{sc}_{abcd}\,S^{cd}} \object{Antisymmetric S-Curvature 2-form OSV.a.b } {\OO{v}_{ab} = \frac12 \RR{v}_{abcd}\,S^{cd}} \object{Symmetric S-Curvature 2-form OSU.a.b } {\OO{u}_{ab} = \frac12 \RR{u}_{abcd}\,S^{cd}} The {\tt Standard way} to compute the decomposition is \begin{equation} \OO{h}_{ab}=-\frac{1}{(d^2-4)}\left[ \theta_a\wedge\partial_b\ipr\OO{h}{} +\theta_b\wedge\partial_a\ipr\OO{h}{} -g_{ab}\OO{h}{}d\right] \end{equation} \begin{equation} \OO{sa}_{ab} =\frac{d}{(d^2-4)}\left[ \theta_a\wedge(\RR{S}_{[bm]}\wedge\theta^m) +\theta_b\wedge(\RR{S}_{[am]}\wedge\theta^m) -\frac{2}{d}g_{ab}\,\RR{S}_{cd}S^{cd}\right] \end{equation} \begin{equation} \OO{sc}_{ab} =\frac{1}{d}\left[ \theta_a\wedge(\RR{S}_{(bm)}\wedge\theta^m) +\theta_b\wedge(\RR{S}_{(am)}\wedge\theta^m)\right] \label{ccc} \end{equation} \begin{equation} \OO{v}_{ab} = \frac{1}{4}\left[ \partial_a\ipr(\OO{S0}_{bm}\wedge\theta^m) +\partial_b\ipr(\OO{S0}_{am}\wedge\theta^m)\right] \end{equation} where \[ \OO{S0}_{ab} = \OO{S}_{ab} -\OO{h}_{ab} -\OO{sa}_{ab} -\OO{sc}_{ab} \] And finally \begin{equation} \OO{u}_{ab} = \OO{S}_{ab} -\OO{h}_{ab} -\OO{sa}_{ab} -\OO{sc}_{ab} -\OO{v}_{ab} \end{equation} If $d=2$ then only the h- and sc-components are nonzero. The $\OO{sc}_{ab}$ are given by (\ref{ccc}) and \begin{equation} \OO{h}_{ab} = \OO{S}_{ab}-\OO{sc}_{ab} \end{equation} \begin{center} \begin{tabular}{|c|c|c|} \hline object & exists if & and has $n$ components \\ \hline \vv$R_{abcd}$ & & $\frac{d^3(d-1)}{2}$ \\[1mm] \hline\vv$\rim{R}{}_{abcd}$ & & $\frac{d^2(d^2-1)}{12}$ \\[1mm] \hline\vv$\RR{A}_{abcd}$ & & $\frac{d^2(d-1)^2}{4}$ \\[1mm] \hline\vv$\RR{S}_{abcd}$ & & $\frac{d^2(d^2-1)}{4}$ \\[1mm] \hline\vv$\RR{w}_{abcd}$ & $d\geq4$ & $\frac{d(d+1)(d+2)(d-3)}{12}$ \\ \vv$\RR{c}_{abcd}$ & $d\geq3$ & $\frac{(d+2)(d-1)}{2}$ \\ \vv$\RR{r}_{abcd}$ & & $1$ \\[1mm] \hline\vv$\RR{a}_{abcd}$ & $d\geq3$ & $\frac{d(d-1)}{2}$ \\ \vv$\RR{b}_{abcd}$ & $d\geq4$ & $\frac{d(d-1)(d+2)(d-3)}{8}$ \\ \vv$\RR{d}_{abcd}$ & $d\geq4$ & $\frac{d(d-1)(d-2)(d-3)}{24}$ \\[1mm] \hline\vv$\RR{h}_{abcd}$ & & $\frac{d(d-1)}{2}$ \\ \vv$\RR{sa}_{abcd}$ & $d\geq3$ & $\frac{d(d-1)}{2}$ \\ \vv$\RR{sc}_{abcd}$ & & $\frac{(d+2)(d-1)}{2}$ \\ \vv$\RR{v}_{abcd}$ & $d\geq4$ & $\frac{d(d+2)(d-1)(d-3)}{8}$ \\ \vv$\RR{u}_{abcd}$ & $d\geq3$ & $\frac{(d-2)(d+4)(d^2-1)}{8}$ \\[1mm] \hline \end{tabular} \end{center} \section{Spinorial Curvature Decomposition} Spinorial curvature is defined in \grg\ iff nonmetricity is zero and switch \comm{NONMETR} is turned off. The upper sign in this section correspond to the signature ${\scriptstyle(-,+,+,+)}$ while lower one to the signature ${\scriptstyle(+,-,-,-)}$. Let us introduce the spinorial analog of the curvature tensor \begin{eqnarray} R_{abcd}&\tsst& \ \ R_{ABCD}\epsilon_{\dot{A}\dot{B}}\epsilon_{\dot{C}\dot{D}} +R_{\dot{A}\dot{B}\dot{C}\dot{D}}\epsilon_{AB}\epsilon_{CD} \nonumber\\[1mm] &&+R_{AB\dot{C}\dot{D}}\epsilon_{\dot{A}\dot{B}}\epsilon_{CD} +R_{\dot{A}\dot{B} CD}\epsilon_{AB}\epsilon_{\dot{C}\dot{D}}, \\[1.5mm] R_{ABCD}&=&-i*(\Omega_{AB}\wedge S_{CD}),\ \ R_{AB\dot{C}\dot{D}}\ =\ i*(\Omega_{AB}\wedge S_{\dot{C}\dot{D}})\\[1.5mm] R_{\dot{A}\dot{B}\dot{C}\dot{D}}&=&\overline{R_{ABCD}},\ \ R_{\dot{A}\dot{B} CD}\ =\ \overline{R_{AB\dot{C}\dot{D}}} \end{eqnarray} The quantities $R_{ABCD}$ and $R_{AB\dot C\dot D}$ can be used to compute the {\tt Curvature spinors} ($\equiv$ {\tt Curvature components}) \object{Weyl Spinor RW.ABCD}{C_{ABCD}} \object{Traceless Ricci Spinor RC.AB.CD\cc}{C_{AB\dot C\dot D}} \object{Scalar Curvature RR}{R} \object{Ricanti Spinor RA.AB}{A_{AB}} \object{Traceless Deviation Spinor RB.AB.CD\cc}{B_{AB\dot C\dot D}} \object{Scalar Deviation RD}{D} All these spinors are irreducible (totally symmetric). Weyl spinor $C_{ABCD}$ {\tt From spinor curvature} is \begin{eqnarray} C_{abcd}&\tsst& C_{ABCD}\epsilon_{\dot{A}\dot{B}}\epsilon_{\dot{C}\dot{D}} +C_{\dot{A}\dot{B}\dot{C}\dot{D}}\epsilon_{AB}\epsilon_{CD} \\[1mm] C_{ABCD}&=&R_{(ABCD)} \label{RW} \end{eqnarray} Traceless Ricci spinor $C_{AB\dot{A}\dot{B}}$ {\tt From spinor curvature} is \begin{eqnarray} C_{ab}&\tsst&C_{AB\dot{A}\dot{B}}\\[2mm] C_{AB\dot{C}\dot{D}}&=&\pm(R_{AB\dot{C}\dot{D}}+R_{\dot{C}\dot{D} AB}) \end{eqnarray} Scalar curvature {\tt From spinor curvature} is \begin{equation} R=2(R^{MN}_{\ \ \ \ MN}+R^{\dot{M}\dot{N}}_{\ \ \ \ \dot{M}\dot{N}}) \end{equation} Antisymmetric Ricci spinor $A_{AB}$ {\tt From spinor curvature} is \begin{eqnarray} A_{ab}&\tsst& A_{AB}\epsilon_{\dot{A}\dot{B}}+A_{\dot{A}\dot{B}}\epsilon_{AB}\\[1mm] A_{AB}&=&\mp R^{\ \ \ \,M}_{(A|\ \ M|B)} \end{eqnarray} Traceless deviation spinor $B_{AB\dot{A}\dot{B}}$ {\tt From spinor curvature} is \begin{eqnarray} B_{ab}&\tsst&B_{AB\dot{A}\dot{B}}\\[1mm] B_{AB\dot{C}\dot{D}}&=&\pm i(R_{AB\dot{C}\dot{D}}-R_{\dot{C}\dot{D} AB}) \end{eqnarray} Deviation trace {\tt From spinor curvature} is \begin{equation} D=-2i(R^{MN}_{\ \ \ \ MN}-R^{\dot{M}\dot{N}}_{\ \ \ \ \dot{M}\dot{N}}) \end{equation} Note that spinors $C_{AB\dot{A}\dot{B}},B_{AB\dot{A}\dot{B}}$ are Hermitian \begin{equation} C_{AB\dot{C}\dot{D}}=\overline{C_{CD\dot{A}\dot{B}}},\ \ B_{AB\dot{C}\dot{D}}=\overline{B_{CD\dot{A}\dot{B}}} \end{equation} Finally we introduce the decomposition for the spinorial curvature 2-form \begin{equation} \Omega_{AB}= \OO{w}_{AB}+\OO{c}_{AB}+\OO{r}_{AB} +\OO{a}_{AB}+\OO{b}_{AB}+\OO{c}_{AB} \end{equation} where the {\tt Undotted curvature 2-forms} \object{Undotted Weyl 2-form OMWU.AB }{\OO{w}_{AB}} \object{Undotted Traceless Ricci 2-form OMCU.AB }{\OO{c}_{AB}} \object{Undotted Scalar Curvature 2-form OMRU.AB }{\OO{r}_{AB}} \object{Undotted Ricanti 2-form OMAU.AB }{\OO{a}_{AB}} \object{Undotted Traceless Deviation 2-form OMBU.AB }{\OO{b}_{AB}} \object{Undotted Scalar Deviation 2-form OMDU.AB }{\OO{d}_{AB}} are given by \begin{eqnarray} \OO{w}_{AB}&=&C_{ABCD}S^{CD} \\[1mm] \OO{c}_{AB}&=&\pm\frac12 C_{AB\dot{C}\dot{D}}S^{\dot{C}\dot{D}} \\[1mm] \OO{r}_{AB}&=&\frac1{12}S_{AB}R \\[1mm] \OO{a}_{AB}&=&\pm A_{(A}^{\ \ \ M}S_{M|B)} \\[1mm] \OO{b}_{AB}&=&\mp\frac{i}2 B_{AB\dot{C}\dot{D}}S^{\dot{C}\dot{D}} \\[1mm] \OO{d}_{AB}&=&\frac{i}{12}S_{AB}D \end{eqnarray} \section{Torsion Decomposition} The torsion tensor \begin{equation} Q_{abc}=Q_{a[bc]},\qquad \Theta^a=\frac{1}{2}Q^a{}_{bc}\,S^{bc} \end{equation} consists of three irreducible pieces \begin{equation} Q_{abc} = \stackrel{\rm c}{Q}_{abc} +\stackrel{\rm t}{Q}_{abc} +\stackrel{\rm a}{Q}_{abc} \end{equation} \begin{center} \begin{tabular}{|c|c|c|} \hline object & exists if & and has $n$ components \\ \hline \vv$Q_{abc}$ & & $\frac{d^2(d-1)}{2}$ \\[1mm] \hline\vv$\stackrel{\rm c}{Q}_{abc}$ & $d\geq3$ & $\frac{d(d^2-4)}{3}$ \\ \vv$\stackrel{\rm t}{Q}_{abc}$ & & $d$ \\ \vv$\stackrel{\rm a}{Q}_{abc}$ & $d\geq3$ & $\frac{d(d-1)(d-2)}{6}$ \\[1mm] \hline \end{tabular} \end{center} The corresponding union of three objects {\tt Torsion 2-forms} is \object{Traceless Torsion 2-form THQC'a} {\stackrel{\rm c}{\Theta}\!{}^a=\frac{1}{2} \stackrel{\rm c}{Q}\!{}^a{}_{bc}\,S^{bc}} \object{Torsion Trace 2-form THQT'a} {\stackrel{\rm t}{\Theta}\!{}^a=\frac{1}{2} \stackrel{\rm t}{Q}\!{}^a{}_{bc}\,S^{bc}} \object{Antisymmetric Torsion 2-form THQA'a} {\stackrel{\rm a}{\Theta}\!{}^a=\frac{1}{2} \stackrel{\rm a}{Q}\!{}^a{}_{bc}\,S^{bc}} And the auxiliary quantities \object{Torsion Trace QT'a}{Q^a} \object{Torsion Trace 1-form QQ}{Q=-\partial_a\ipr\Theta^a} \object{Antisymmetric Torsion 3-form QQA}{\stackrel{\rm a}{Q}=\theta_a\wedge\Theta^a} The torsion trace $Q^a=Q^m{}_{am}$ can be obtained {\tt From torsion trace 1-form} \begin{equation} Q^a = \partial^a\ipr Q \end{equation} The {\tt Standard way} for the irreducible torsion 2-forms is \begin{equation} \stackrel{\rm t}{\Theta}\!{}^a = -\frac{1}{(d-1)}\theta^a\wedge Q \end{equation} \begin{equation} \stackrel{\rm t}{\Theta}\!{}^a = \frac{1}{3}\partial^a\ipr\stackrel{\rm a}{Q} \end{equation} \begin{equation} \stackrel{\rm c}{\Theta}\!{}^a = \Theta^a -\stackrel{\rm t}{\Theta}\!{}^a -\stackrel{\rm a}{\Theta}\!{}^a \end{equation} The rest of this section is valid in dimension 4 only. In this case one can introduce the torsion pseudo trace \object{Torsion Pseudo Trace QP'a}{ P^a = \stackrel{*}{Q}\!{}^{ma}{}_{m}, \ \stackrel{*}{Q}\!{}^a{}_{bc} = \frac{1}{2}{\cal E}_{bc}{}^{pq} Q^a{}_{pq}} which can be computed {\tt From antisymmetric torsion 3-form} \begin{equation} P^a = \partial^a\ipr\,*\!\stackrel{\rm a}{Q} \end{equation} Finally let us consider the spinorial representation of the torsion. Below the upper sign corresponds to the \seethis{See \pref{spinors}\ or \ref{spinors1}.} signature ${\scriptstyle(-,+,+,+)}$ and lower one to the signature ${\scriptstyle(+,-,-,-)}$. First we introduce the spinorial analog of the torsion tensor \begin{equation} Q_{abc}\tsst Q_{A\dot{A} BC}\epsilon_{\dot{B}\dot{C}} +Q_{A\dot{A}\dot{B}\dot{C}}\epsilon_{BC} \end{equation} where \begin{equation} Q_{A\dot{A} BC}=-i*(\Theta_{A\dot{A}}\wedge S_{BC}),\qquad Q_{A\dot{A}\dot{B}\dot{C}}=i*(\Theta_{A\dot{A}}\wedge S_{\dot{B}\dot{C}}) \end{equation} These spinors are reducible but the \object{Traceless Torsion Spinor QC.ABC.D\cc}{C_{ABC\dot D}} \[ \stackrel{\rm c}{Q}_{abc}\tsst C_{ABC\dot A}\epsilon_{\dot{B}\dot{C}} +Q_{\dot{A}\dot{B}\dot{C}A}\epsilon_{BC},\quad C_{\dot{A}\dot{B}\dot{C} A}=\overline{C_{ABC\dot{A}}} \] is irreducible (symmetric in $\scriptstyle ABC$). And it can be computed {\tt From torsion} by the relation \begin{equation} C_{ABC\dot A} = Q_{(A|\dot{A}|BC)} \end{equation} The torsion trace can be calculated {\tt From torsion using spinors} \begin{equation} Q^a\tsst Q^{A\dot{A}},\quad Q_{A\dot{B}}=\mp(Q^M{}_{\dot{B}MA}+Q_A{}^{\dot M}{}_{\dot M\dot{B}}) \end{equation} And similarly the torsion pseudo-trace can be found {\tt From torsion using spinors} \begin{equation} P^a\tsst P^{A\dot{A}},\quad P_{A\dot{B}}=\mp i(Q^M{}_{\dot{B}MA}-Q_A{}^{\dot M}{}_{\dot M\dot{B}}) \end{equation} Finally we introduce the {\tt Undotted trace 2-forms} which are selfdual parts of the irreducible torsion 2-forms \object{Undotted Traceless Torsion 2-form THQCU'a} {\stackrel{\rm c}{\vartheta}\!{}^a} \object{Undotted Torsion Trace 2-form THQTU'a} {\stackrel{\rm t}{\vartheta}\!{}^a} \object{Undotted Antisymmetric Torsion 2-form THQAU'a} {\stackrel{\rm a}{\vartheta}\!{}^a} \seethis{See \pref{thetau}.} These quantities will be used in the gravitational equations. This complex 2-forms can be obtained by the equations ({\tt Standard way}): \begin{eqnarray} \stackrel{\rm c}{\vartheta}\!{}^a &\tsst& \stackrel{\rm c}{\vartheta}\!{}^{A\dot A} =C^A_{\ \ BC}{}^{\dot{A}}S^{BC}\\[1mm] \stackrel{\rm t}{\vartheta}\!{}^a &\tsst& \stackrel{\rm t}{\vartheta}\!{}^{A\dot A} =\mp\frac13 Q_{M}^{\ \ \ \dot{A}}S^{AM}\\[1mm] \stackrel{\rm a}{\vartheta}\!{}^a &\tsst& \stackrel{\rm a}{\vartheta}\!{}^{A\dot A} =\pm\frac{i}3 P_{M}^{\ \ \ \dot{A}}S^{AM} \end{eqnarray} \section{Nonmetricity Decomposition} In general the nonmetricity tensor \begin{equation} N_{abc}=N_{(ab)c},\qquad N_{ab}=N_{abc}\theta^c \end{equation} consist of 4 irreducible pieces \begin{equation} N_{abcd} = \stackrel{\rm c}{N}_{abc} +\stackrel{\rm a}{N}_{abc} +\stackrel{\rm t}{N}_{abc} +\stackrel{\rm w}{N}_{abc} \end{equation} \begin{center} \begin{tabular}{|c|c|c|} \hline object & exists if & and has $n$ components \\ \hline \vv$N_{abc}$ & & $\frac{d^2(d+1)}{2}$ \\[1mm] \hline\vv$\stackrel{\rm c}{N}_{abc}$ & & $\frac{d(d-1)(d+4)}{6}$ \\ \vv$\stackrel{\rm a}{N}_{abc}$ & $d\geq3$ & $\frac{d(d^2-4)}{3}$ \\ \vv$\stackrel{\rm t}{N}_{abc}$ & & $d$ \\ \vv$\stackrel{\rm w}{N}_{abc}$ & & $d$ \\[1mm] \hline \end{tabular} \end{center} The corresponding union of objects {\tt Nonmetricity 1-forms} consist of \object{Symmetric Nonmetricity 1-form NC.a.b} {\stackrel{\rm c}{N}_{ab}=\stackrel{\rm c}{N}_{abc}\theta^c} \object{Antisymmetric Nonmetricity 1-form NA.a.b} {\stackrel{\rm a}{N}_{ab}=\stackrel{\rm a}{N}_{abc}\theta^c} \object{Nonmetricity Trace 1-form NT.a.b} {\stackrel{\rm t}{N}_{ab}=\stackrel{\rm t}{N}_{abc}\theta^c} \object{Weyl Nonmetricity 1-form NW.a.b} {\stackrel{\rm w}{N}_{ab}=\stackrel{\rm w}{N}_{abc}\theta^c} We have also two auxiliary 1-forms \object{Weyl Vector NNW}{\stackrel{\rm w}{N}} \object{Nonmetricity Trace NNT}{\stackrel{\rm t}{N}} They are computed according to the following formulas \begin{equation} \stackrel{\rm w}{N} = N^a{}_a \end{equation} \begin{equation} \stackrel{\rm t}{N} = \theta^a\,\partial^b\ipr N_{ab} - \frac{1}{d} \stackrel{\rm w}{N} \end{equation} \begin{equation} \stackrel{\rm w}{N}_{ab} = \frac{1}{d}g_{ab}\stackrel{\rm w}{N} \end{equation} \begin{equation} \stackrel{\rm t}{N}_{ab}=\frac{d}{(d-1)(d+2)}\left[ \theta_b\partial_a\ipr\stackrel{\rm t}{N} +\theta_a\partial_b\ipr\stackrel{\rm t}{N} -\frac{2}{d} g_{ab} \stackrel{\rm t}{N}\right] \end{equation} \begin{equation} \stackrel{\rm a}{N}_{ab}=\frac{1}{3}\left[ \partial_a\ipr(\theta^m\wedge\stackrel{0}{N}_{bm}) +\partial_b\ipr(\theta^m\wedge\stackrel{0}{N}_{am})\right] \end{equation} where \[ \stackrel{\rm 0}{N}_{ab}= N_{abc} -\stackrel{\rm t}{N}_{abc} -\stackrel{\rm w}{N}_{abc} \] And finally \begin{equation} \stackrel{\rm c}{N}_{ab}= N_{abc} -\stackrel{\rm a}{N}_{abc} -\stackrel{\rm t}{N}_{abc} -\stackrel{\rm w}{N}_{abc} \end{equation} \section{Newman-Penrose Formalism} The method of spinorial differential forms described in the previous sections are essentially equivalent to the well known Newman-Penrose formalism but for the sake of convenience \grg\ has complete set of macro objects which allows to write the Newman-Penrose equations in traditional notation. All these objects refer (up to some sign and 1/2 factors) to other \grg\ built-in objects. In this section upper sign corresponds to the signature ${\scriptstyle(-,+,+,+)}$ and lower one to the signature ${\scriptstyle(+,-,-,-)}$. \seethis{See \pref{spinors}.} The frame must be null as explained in section \ref{spinors}. For the Newman-Penrose formalism we use notation and conventions of the book \emph{Exact Solutions of the Einstein Field Equations} by D. Kramer, H. Stephani, M. MacCallum and E. Herlt, ed. E. Schmutzer (Berlin, 1980). We denote this book as ESEFE. We chose the relationships between NP null tetrad and \grg\ null frame as follows \begin{equation} l^\mu=h^\mu_0,\quad k^\mu=h^\mu_1,\quad \overline{m}\!{}^\mu=h^\mu_2,\quad m^\mu=h^\mu_3 \end{equation} The NP vector operators are just the components of the vector frame $\partial_a$ \begin{eqnarray} \mbox{\tt DD}&=& D =\partial_1 \\ \mbox{\tt DT}&=& \Delta=\partial_0 \\ \mbox{\tt du}&=& \delta=\partial_3 \\ \mbox{\tt dd}&=& \overline\delta=\partial_2 \end{eqnarray} The spin coefficient are the components of the connection 1-form \object{SPCOEF.AB.c}{ \omega_{AB\,c}=\partial_c\ipr\omega_{AB}} or in the NP notation \begin{eqnarray} \mbox{\tt alphanp }&=& \alpha =\pm\omega_{(1)2} \\ \mbox{\tt betanp }&=& \beta =\pm\omega_{(1)3} \\ \mbox{\tt gammanp }&=& \gamma =\pm\omega_{(1)0} \\ \mbox{\tt epsilonnp }&=& \epsilon =\pm\omega_{(1)1} \\ \mbox{\tt kappanp }&=& \kappa =\pm\omega_{(0)1} \\ \mbox{\tt rhonp }&=& \rho =\pm\omega_{(0)2} \\ \mbox{\tt sigmanp }&=& \sigma =\pm\omega_{(0)3} \\ \mbox{\tt taunp }&=& \tau =\pm\omega_{(0)0} \\ \mbox{\tt munp }&=& \mu =\pm\omega_{(2)3} \\ \mbox{\tt nunp }&=& \nu =\pm\omega_{(2)0} \\ \mbox{\tt lambdanp }&=& \lambda =\pm\omega_{(2)2} \\ \mbox{\tt pinp }&=& \pi =\pm\omega_{(2)1} \\ \end{eqnarray} where the first index of the quantity $\omega_{(AB)c}$ is included inn parentheses to remind that it is summed spinorial index. Finally for the curvature we have \object{PHINP.AB.CD\cc }{ \Phi_{AB\dot{C}\dot{D}} = \pm\frac{1}{2}C_{AB\dot C\dot D} } \object{PSINP.ABCD }{\Psi_{ABCD}=C_{ABCD}} the conventions for the scalar curvature $R$ in ESEFE and in \grg\ are the same. For the signature ${\scriptstyle(-,+,+,+)}$ the Newman-Penrose equations for the quantities introduced above can be found in section 7.1 of ESEFE. For other signature ${\scriptstyle(+,-,-,-)}$ one must alter the sign of $\Psi_{ABCD}$, $\Phi_{AB\dot{C}\dot{D}}$ and $R$ in Eqs. (7.28)--(7.45). \section{Electromagnetic Field} Formulas in this section are valid only in spaces with the signature ${\scriptstyle(-,+,\dots,+)}$ and ${\scriptstyle(+,-,\dots,-)}$. The sign factor $\sigma$ in the expressions below is $\sigma=-{\rm diag}_0$ ($+1$ for the first signature and $-1$ for the second). Let us introduce the \object{EM Potential A}{A=A_\mu dx^\mu} and the \object{Current 1-form J}{J=j_\mu dx^\mu} The EM strength tensor $F_{\alpha\beta}=\partial_\alpha A_\beta-\partial_\beta A_\alpha$ \object{EM Tensor FT.a.b}{F_{ab}= \partial_b\ipr\partial_a\ipr F} where $F$ is the \object{EM 2-form FF}{F} which can be found {\tt From EM potential} \begin{equation} F=dA \end{equation} or {\tt From EM tensor} \begin{equation} F = \frac{1}{2}F_{ab}\,S^{ab} \end{equation} The EM action $d$-form \object{EM Action EMACT}{L_{\rm EM}= -\frac{1}{8\pi}\,F\wedge *F} The {\tt Maxwell Equations} \object{First Maxwell Equation MWFq}{d*F=-4\pi\sigma\,(-1)^{d}\,*J} \object{Second Maxwell Equation MWSq}{dF=0} The current must satisfy the \object{Continuity Equation COq}{d*J=0} The \object{EM Energy-Momentum Tensor TEM.a.b}{T_{ab}^{\rm EM}} is given by the equation \begin{equation} T^{\rm EM}_{ab} = \frac{\sigma}{4\pi} F_{am}F_b{}^m +s\sigma\,g_{ab}\,*L_{\rm EM} \end{equation} The rest of the section is valid in the dimension 4 only. In 4 dimensions the tensor $F_{ab}$ and its dual $\stackrel{*}{F}_{ab}=\frac{1}{2}{\cal E}_{ab}{}^{mn}F_{mn}$ are expressed via usual 3-dimensional vectors $\vec E$ and $\vec H$ \begin{eqnarray} F_{ab}&=&-\sigma\left(\begin{array}{rrr} E_1&E_2&E_3\\ &-H_3&H_2\\ &&-H_1\end{array}\right)\\[1.5mm] \stackrel{*}{F}_{ab}&=&\sigma\left(\begin{array}{rrr} H_1&H_2&H_3\\ &E_3&-E_2\\ &&E_1\end{array}\right) \end{eqnarray} Similarly for the current we have \begin{equation} J=\sigma(-\rho dt + \vec j\,d\vec x) \end{equation} The {\tt EM scalars} \object{First EM Scalar SCF}{I_1=\frac12F_{ab}F^{ab} ={\vec H}^2-{\vec E}^2} \object{Second EM Scalar SCS}{I_2=\frac12\stackrel{*}{F}_{ab}F^{ab} =2\vec E\cdot\vec H} can be obtained as follows by {\tt Standard way} \begin{equation} I_1 = -*(F\wedge*F) \end{equation} \begin{equation} I_2 = *(F\wedge F) \end{equation} The \object{Complex EM 2-form FFU}{\Phi} can be found {\tt From EM 2-form} \begin{equation} \Phi=F-i*F \end{equation} or {\tt From EM Spinor} \begin{equation} \Phi = 2\Phi_{AB}\,S^{AB} \end{equation} The 2-form $\Phi$ must obey the \object{Selfduality Equation SDq.AB\cc}{\Phi\wedge S_{\dot A\dot B}} and gives rise to the \object{Complex Maxwell Equation MWUq}{d\Phi=-4i\sigma\pi\,*J} The EM 2-form $F$ can be restored {\tt From Complex EM 2-form} \begin{equation} F=\frac{1}{2}(\Phi+\overline\Phi) \end{equation} The symmetric \object{Undotted EM Spinor FIU.AB}{\Phi_{AB}} is the spinorial analog of the tensor $F_{ab}$ \begin{equation} F_{ab} \tsst \epsilon_{AB} \Phi_{\dot A\dot B} + \epsilon_{\dot A\dot B} \Phi_{AB} \end{equation} It can be obtained either {\tt From complex EM 2-form} \begin{equation} \Phi_{AB} = -\frac{i}{2}*(\Phi\wedge S_{AB}) \end{equation} of {\tt From EM 2-form} \begin{equation} \Phi_{AB} = -i*(F\wedge S_{AB}) \end{equation} The \object{Complex EM Scalar SCU}{\iota=I_1-iI_2} can be found {\tt From EM Spinor} \begin{equation} \iota = 2\Phi_{AB}\Phi^{AB} \end{equation} or {\tt From Complex EM 2-form} \begin{equation} \iota = -\frac{i}{2} *(\Phi\wedge\Phi) \end{equation} Finally we have the \object{EM Energy-Momentum Spinor TEMS.AB.CD\cc} {T^{\rm EM}_{AB\dot A\dot B}=\frac{1}{2\pi}\Phi_{AB}\Phi_{\dot A\dot B}} \section{Dirac Field} In this section upper sign corresponds to the signature ${\scriptstyle(-,+,+,+)}$ and lower one to the signature ${\scriptstyle(+,-,-,-)}$. The four component Dirac spinor consists of two 1-index spinors \begin{equation} \psi=\left(\begin{array}{c}\phi^A\\ \chi_{\dot A}\end{array}\right),\ \ \overline\psi=\left(\chi_A\ \ \phi^{\dot A}\right) \end{equation} Thus we have the {\tt Dirac spinor} as the union of two objects \object{Phi Spinor PHI.A}{\phi_A} \object{Chi Spinor CHI.B}{\chi_B} The gamma-matrices are expressed via sigma-matrices as follows \begin{equation} \gamma^m=\sqrt2\left(\begin{array}{cc} 0&\sigma^{mA\dot B}\\ \sigma^m\!{}_{B\dot A}&0\end{array}\right) \end{equation} Dirac field action 4-form \begin{eqnarray} &&\mbox{\tt Dirac Action 4-form DACT}=L_{\rm D}=\nonumber\\[1mm] &&\quad=\left[\frac{i}2(\overline\psi\gamma^a (\nabla_a+ieA_a)\psi-(\nabla_a-ieA_a)\overline\psi\gamma^a\psi) -m_{\rm D}\overline\psi\psi\right]\upsilon \end{eqnarray} The {\tt Standard way} to compute this quantity is \begin{eqnarray} L_{\rm D} &=& -\frac{i}{\sqrt2}\left[ \phi_{\dot A}\theta^{A\dot A}\!\wedge*(D+ieA)\phi_A-{\rm c.c.} -\chi_{\dot A} \theta^{A\dot A}\!\wedge*(D-ieA)\chi_A -{\rm c.c.}\right]- \nonumber\\[1mm]&&\qquad\qquad\quad -m_{\rm D}\left(\phi^A\chi_A+{\rm c.c.}\right)\upsilon \end{eqnarray} The {\tt Dirac equation} is \object{Phi Dirac Equation DPq.A\cc}{ i\sqrt2\partial_{B\dot A}\ipr(D+ieA-\frac12Q)\phi^B-m_{\rm D}\chi_{\dot A}=0} \object{Chi Dirac Equation DCq.A\cc}{ i\sqrt2\partial_{B\dot A}\ipr(D-ieA-\frac12Q)\chi^B-m_{\rm D}\phi_{\dot A}=0} where $Q$ is the torsion trace 1-form. Notice that terms with the electromagnetic field $eA$ are included in equations iff the value of $A$ is defined. The unit charge $e$ is given by the constant \comm{ECONST}. The current 1-form can be computed {\tt From Dirac Spinor} \begin{equation} J=\mp\sqrt2e(\phi_A\phi_{\dot A}+\chi_A\chi_{\dot A})\theta^{A\dot A} \end{equation} The symmetrized \object{Dirac Energy-Momentum Tensor TDI.a.b}{T^{\rm D}_{ab}} can be obtained as follows \begin{eqnarray} T^{\rm D}_{ab}&=& *(\theta_{(a}\wedge T^{\rm D}_{b)})\nonumber\\[1mm] T^{\rm D}_a&=&\mp\frac{i}{\sqrt2}\Big[ *\theta^{A\dot A}\partial_a\ipr(D+ieA)\phi_A\phi_{\dot A} -{\rm c.c.}\nonumber\\ &&\qquad-*\theta^{A\dot A}\partial_a\ipr(D-ieA)\chi_A\chi_{\dot A} -{\rm c.c.}\Big] \pm\partial_a\ipr L_{\rm D} \end{eqnarray} The \object{Undotted Dirac Spin 3-Form SPDIU.AB}{s^{\rm D}_{AB}} \begin{equation} s^{\rm D}_{AB}=\frac{i}{2\sqrt2} \left(*\theta_{(A|\dot A}\phi_{B)}\phi^{\dot A} -*\theta_{(A|\dot A}\chi_{B)}\chi^{\dot A}\right) \end{equation} The Dirac field mass $m_{\rm D}$ is given by the constant \comm{DMASS}. \section{Scalar Field} Formulas in this section are valid in any dimension with the signature ${\scriptstyle(-,+,\dots,+)}$ and ${\scriptstyle(+,-,\dots,-)}$. The sign factor $\sigma$ is $\sigma=-{\rm diag}_0$ ($+1$ for the first signature and $-1$ for the second). The scalar field \object{Scalar Field FI}{\phi} The minimal scalar field action $d$-form \object{Minimal Scalar Action SACTMIN}{ L_{\rm Smin}= -\frac{1}{2}\left[\sigma(\partial_\alpha\phi)^2+ m_{\rm s}^2 \phi^2\right]\upsilon} The nonminimal scalar field action \object{Scalar Action SACT}{ L_{\rm S}= -\frac{1}{2}\left[\sigma(\partial_\alpha\phi)^2+ (m_{\rm s}^2+a_0R) \phi^2\right]\upsilon} The scalar field equation \object{Scalar Equation SCq} {s\sigma(-1)^d*d*d\phi-(m_{\rm s}^2+a_0R)\phi=0} which gives \[ -\sigma\rim{\nabla}{}^\pi\rim{\nabla}_\pi\phi-(m_{\rm s}^2+a_0R)\phi=0 \] The minimal energy-momentum tensor is \begin{eqnarray} &&\mbox{\tt Minimal Scalar Energy-Momentum Tensor TSCLMIN.a.b} =T^{\rm Smin}_{ab}= \nonumber\\ &&\qquad\qquad=\partial_a\phi\partial_b\phi+s\sigma\,g_{ab} *L_{\rm Smin} \end{eqnarray} The nonminimal part of the scalar field energy-momentum \seethis{See pages \pageref{graveq}\ and \pageref{metreq}.} tensor can be taken into account in the left-hand side of gravitational equations. The scalar field mass $m_{\rm s}$ are given by the constant {\tt SMASS}. The nonminimal interaction terms are included iff the switch \comm{NONMIN} \swind{NONMIN} is turned on and the value of nonminimal interaction constant $a_0$ is determined by the object \object{A-Constants ACONST.i2}{a_i} The default value of $a_0$ is the constant \comm{AC0}. \section{Yang-Mills Field} Formulas in this section are valid in any dimension with the signature ${\scriptstyle(-,+,\dots,+)}$ and ${\scriptstyle(+,-,\dots,-)}$. The sign factor $\sigma$ in the expressions below is $\sigma=-{\rm diag}_0$ ($+1$ for the first signature and $-1$ for the second). The indices $\scriptstyle i,j,k,l,m,n$ are the internal space Yang-Mills indices and we a assume that the internal Yang-Mills metric is $\delta_{ij}$. The Yang-Mills potential 1-form \object{YM Potential AYM.i9}{A^i=A^i_\mu dx^\mu} The structural constants \object{Structural Constants SCONST.i9.j9.k9}{c^i{}_{jk}=c^i{}_{[jk]}} The Yang-Mills strength 2-form \object{YM 2-form FFYM.i9}{F^i} and strength tensor \object{YM Tensor FTYM.i9.a.b}{F^i{}_{ab}} The $F^i$ can be computed {\tt From YM potential} \begin{equation} F^i = dA^i + \frac12 c^i{}_{jk} \, A^j\wedge A^k \end{equation} or {\tt From YM tensor} \begin{equation} F^i = \frac12 F^i{}_{ab}\, S^{ab} \end{equation} The {\tt Standard way} to find Yang-Mills strength tensor is \begin{equation} F^i{}_{ab}=\partial_b\ipr\partial_a\ipr F^i \end{equation} The Yang-Mills action $d$-form \object{YM Action YMACT}{L_{\rm YM}= -\frac{1}{8\pi}F^i\wedge*F_i} The {\tt YM Equations} \object{First YM Equation YMFq.i9}{d*F^i + c^i{}_{jk} \, A^j\wedge *F^k=0} \object{Second YM Equation YMSq.i9}{dF^i + c^i{}_{jk} \, A^j\wedge F^k=0} The energy-momentum tensor \object{YM Energy-Momentum Tensor TYM.a.b} {\frac{\sigma}{4\pi}F^i{}_{am}F^i{}_b{}^m + s\sigma\,g_{ab}\, *L_{\rm YM}} \section{Geodesics} The geodesic equation \object{Geodesic Equation GEOq\^m}{ \frac{d^2x^\mu}{dt^2}+\{^\mu_{\pi\tau}\} \frac{dx^\pi}{dt}\frac{dx^\tau}{dt}=0} Here the parameter $t$ must be declared by the \seethis{See page \pageref{affpar}.} \cmdind{Affine Parameter} {\tt Affine parameter} declaration. \section{Null Congruence and Optical Scalars} Let us consider the congruence defined by the vector field $k^\alpha$ \object{Congruence KV}{k=k^\mu\partial_\mu} This congruence is null iff \object{Null Congruence Condition NCo}{k\cdot k=0} holds. The congruence is geodesic iff the condition \object{Geodesics Congruence Condition GCo'a}{k^\mu\rim{\nabla}_\mu k^a=0} is fulfilled. For the null geodesic congruence one can calculate the {\tt Optical scalars} \object{Congruence Expansion thetaO}{\theta= \frac{1}{2}\rim{\nabla}{}^\pi k_\pi} \object{Congruence Squared Rotation omegaSQO}{\omega^2= \frac{1}{2}(\rim{\nabla}_{[\alpha}k_{\beta]})^2} \object{Congruence Squared Shear sigmaSQO}{\sigma\overline\sigma= \frac{1}{2}\left[ (\rim{\nabla}_{(\alpha}k_{\beta)})^2 -2\theta^2\right]} \section{Timelike Congruences and Kinematics} Let us consider the congruence determined by the velocity vector $u^\alpha$ \object{Velocity UU'a}{u^a} \object{Velocity Vector UV}{u=u^a\partial_a} The velocity vector must be normalized and the quantity \object{Velocity Square USQ}{u^2=u\cdot u} must be constant but nonzero. If the frame metric coincides with its default diagonal value \seethis{See \pref{defaultmetric}.} $g_{ab}={\rm diag}(-1,\dots)$ then {\tt By default} we have for the velocity \begin{equation} u^a=(1,0,\dots,0) \end{equation} which means that the congruence is comoving in the given frame. In general case the velocity can be obtained {\tt From velocity vector} \begin{equation} u^a=u\ipr \theta^a \end{equation} We introduce the auxiliary object \object{Projector PR'a.b}{P^a{}_b= \delta^a_b-\frac{1}{u^2}u^an_b} The following four quantities called {\tt Kinematics} comprise the complete set of the congruence characteristics \object{Acceleration accU'a}{A^a=\rim{\nabla}_uu^a} \object{Vorticity omegaU.a.b}{\omega_{ab}= P^m{}_aP^n{}_b \rim{\nabla}_{[m}u_{n]}} \object{Volume Expansion thetaU}{\Theta=\rim{\nabla}_au^a} \object{Shear sigmaU.a.b}{ P^m{}_aP^n{}_b \rim{\nabla}_{(m}u_{n)}- \frac{1}{(d-1)}P_{ab}\Theta} \section{Ideal And Spin Fluid} The ideal fluid is characterized by the \object{Pressure PRES}{p} and \object{Energy Density ENER}{\varepsilon} The ideal fluid energy-momentum tensor is \begin{eqnarray} &&\mbox{\tt Ideal Fluid Energy-Momentum Tensor TIFL.a.b}= T^{\rm IF}_{ab} = \nonumber\\ &&\qquad\qquad=(\varepsilon+p)u_a u_b - u^2p g_{ab} \end{eqnarray} The rest of the section requires the nonmetricity be zero (\comm{NONMETR} is off). In addition spin-fluid is characterized by \object{Spin Density SPFLT.a.b }{S^{\rm SF}_{ab}=S^{\rm SF}_{[ab]}} or equivalently by \object{Spin Density 2-form SPFL }{S^{\rm SF}} The spin 2-form can be obtained {\tt From spin density} \begin{equation} S^{\rm SF}=\frac{1}{2}S^{\rm SF}_{ab} \theta^a\wedge\theta^a \end{equation} and $s_{ab}$ is determined {\tt From spin density 2-form} \begin{equation} S^{\rm SF}_{ab}= \partial_b\ipr\partial_a\ipr S^{\rm SF} \end{equation} The spin density must satisfy the Frenkel condition \object{Frenkel Condition FCo}{u\ipr S^{\rm SF}=0} The spin fluid energy-momentum tensor is \begin{eqnarray} &&\mbox{\tt Spin Fluid Energy-Momentum Tensor TSFL.a.b}=T^{\rm SF}_{ab}= \nonumber\\ &&\qquad\qquad=(\varepsilon+p)u_a u_b - u^2p g_{ab}+\Delta_{(ab)} \end{eqnarray} where \begin{equation} \Delta_{ab}=-2(g^{cd}+u^{-2}\,u^cu^d) \nabla_c S^{\rm SF}_{(ab)d} \end{equation} \begin{equation} s^{\rm SF}_{abc}=u_a\,S^{\rm SF}_{bc} \end{equation} if torsion is zero (\comm{TORSION} off) and \begin{equation} \Delta_{ab}=2u^{-2}\,u_au^d\,\nabla_u S^{\rm SF}_{bd} \end{equation} if torsion is nonzero (\comm{TORSION} on). Notice that the energy-momentum \seethis{See \pref{tsym}.} tensor $T^{\rm SF}_{ab}$ is symmetrized. Finally yet another representation for the spin is the undotted spin 3-form \object{Undotted Fluid Spin 3-form SPFLU.AB }{s^{\rm SF}_{AB}} which is given by the standard spinor $\tsst$ tensor correspondence rules \begin{equation} s^{\rm SF}_{mab}\,*\theta^m \tsst \epsilon_{AB} s^{\rm SF}_{\dot A\dot B} + \epsilon_{\dot A\dot B}s^{\rm SF}_{AB} \end{equation} according to Eq. (\ref{asys}). \seethis{See \pref{asys}.} This quantity is used in the right-hand side of gravitational equations. \section{Total Energy-Momentum And Spin} \label{totalc} \enlargethispage{4mm} The total energy-momentum tensor \object{Total Energy-Momentum Tensor TENMOM.a.b}{T_{ab}} and the total undotted spin 3-form \seethis{See pages \pageref{graveq}\ and \pageref{metreq}.} \object{Total Undotted Spin 3-form SPINU.AB}{s_{AB}} play the role of sources in the right-hand side of the gravitational equations. The expression for these quantities read \begin{equation} T_{ab} = T^{\rm D}_{ab}+ T^{\rm EM}_{ab}+ T^{\rm YM}_{ab}+ T^{\rm Smin}_{ab}+ T^{\rm IF}_{ab}+ T^{\rm SF}_{ab} \label{b1} \end{equation} \begin{equation} s_{AB} = s_{AB}^{\rm D} + s_{AB}^{\rm SF} \label{b2} \end{equation} When $T_{ab}$ and $s_{AB}$ are calculated \grg\ does not tries to find value of all objects in the right-hand side of Eqs. (\ref{b1}), (\ref{b2}) instead it adds only the quantities whose value are currently defined. In particular if none of above tensors and spinors are defined then $T_{ab}=s_{AB}=0$. Notice that $T_{ab}$ and all tensors in the right-hand side of Eq. (\ref{b1}) are symmetric. \seethis{See \pref{tsym}.} They are the symmetric parts of the canonical energy-momentum tensors. In addition we introduce the \object{Total Energy-Momentum Trace TENMOMT}{T=T^a{}_a} and the spinor \object{Total Energy-Momentum Spinor TENMOMS.AB.CD\cc}{T_{AB\dot C\dot D}} is a spinorial equivalent of the traceless part of $T_{ab}$ \begin{equation} T_{ab}-\frac{1}{4}g_{ab}T \tsst T_{AB\dot A\dot B} \end{equation} \section{Einstein Equations} The Einstein equation \object{Einstein Equation EEq.a.b} {R_{ab}-\frac{1}{2}g_{ab}R +\Lambda R =8\pi G\, T_{ab}} And the {\tt Spinor Einstein equations} \object{Traceless Einstein Equation CEEq.AB.CD\cc}{ C_{AB\dot C\dot D} = 8\pi G\, T_{AB\dot C\dot D}} \object{Trace of Einstein Equation TEEq} {R-4\Lambda = -8\pi G\, T} The cosmological constant is included in these equations iff the switch \comm{CCONST} is turned on \swind{CCONST} and its value is given by the constant \comm{CCONST}. The gravitational constant $G$ is given by the constant \comm{GCONST}. \section{Gravitational Equations in Space With Torsion} Equations in this section are valid in dimension $d=4$ with the signature ${\scriptstyle(-,+,+,+)}$ and ${\scriptstyle(+,-,-,-)}$ only. The $\sigma=1$ for the first signature and $\sigma=-1$ for the second. The nonmetricity must be zero and the switch \comm{NONMETR} turned off. Let us consider the action \begin{equation} S=\int\left[\frac{\sigma}{16\pi G}L_{\rm g} +L_{\rm m}\right] \end{equation} where \object{Action LACT}{L_{\rm g}=\upsilon\,{\cal L}_{\rm g}} is the gravitational action 4-form and \begin{equation} L_{\rm m} = \upsilon\,{\cal L}_{\rm m} \end{equation} is the matter action 4-form. Let us define the following variational derivatives \begin{equation} Z^\mu{}_{a} = \frac{1}{\sqrt{-g}} \frac{\delta\sqrt{-g}{\cal L}_{\rm g}}{\delta h^a_\mu} ,\qquad t^\mu{}_{a} = \frac{\sigma}{\sqrt{-g}} \frac{\delta\sqrt{-g}{\cal L}_{\rm m}}{\delta h^a_\mu} \end{equation} \begin{equation} V^\mu{}_{ab} = \frac{1}{\sqrt{-g}} \frac{\delta\sqrt{-g}{\cal L}_{\rm g}}{\delta \omega^{ab}{}_\mu} ,\qquad s^\mu{}_{ab} = \frac{\sigma}{\sqrt{-g}} \frac{\delta\sqrt{-g}{\cal L}_{\rm m}}{\delta \omega^{ab}{}_\mu} \end{equation} Then the gravitational equations reads \begin{eqnarray} Z^\mu{}_a &=& -16\pi G\,t^\mu{}_a \label{zma} \\[2mm] V^\mu{}_{ab} &=& -16\pi G\,s^\mu{}_{ab} \label{vab} \end{eqnarray} Here the first equation is an analog of Einstein equation and has the canonical nonsymmetric energy-momentum tensor $t^\mu{}_a$ as a source. The source in the second equation is the spin tensor $s^\mu{}_{ab}$. Now we rewrite these equation in other equivalent form. First let us define the following 3-forms \begin{equation} Z_a = Z^m{}_a\,*\theta_m,\qquad t_a = t^m{}_a\,*\theta_m \end{equation} \begin{equation} V_{ab} = V^m{}_{ab}\,*\theta_m,\qquad s_{ab} = s^m{}_{ab}\,*\theta_m \end{equation} Notice that Eq. (\ref{zma}) is not symmetric but \label{tsym} the antisymmetric part of this equation is expressed via second Eq. (\ref{vab}) due to Bianchi identity. Therefore only the symmetric part of Eq. (\ref{zma}) is essential. Eq. (\ref{vab}) is antisymmetric and we can consider its spinorial analog using the standard relations \begin{eqnarray} V_{ab} &\tsst& V_{A\dot AB\dot B}= \epsilon_{AB} V_{\dot A\dot B} + \epsilon_{\dot A\dot B}V_{AB} \\ s_{ab} &\tsst& s_{A\dot AB\dot B}= \epsilon_{AB} s_{\dot A\dot B} + \epsilon_{\dot A\dot B}s_{AB} \end{eqnarray} \seethis{See \pref{asys}.} Finally we define the {\tt Gravitational equations} in the form \label{graveq} \object{Metric Equation METRq.a.b}{-\frac12Z_{(ab)}=8\pi G\,T_{ab}} \object{Torsion Equation TORSq.AB}{V_{AB}=-16\pi G\,s_{AB}} where the currents in the right-hand side of equations are \seethis{See \pref{totalc}.} \object{Total Energy-Momentum Tensor TENMOM.a.b}{T_{ab}=t_{(ab)}} \object{Total Undotted Spin 3-form SPINU.AB}{s_{AB}} Now let us consider the equations which are used in \grg\ to compute the left-hand side of the gravitational equations $Z_{(ab)}$ and $V_{AB}$. We have to emphasize that we use \seethis{See \pref{spinors}.} spinors and all restrictions imposed by the spinorial formalism must be fulfilled. We consider the Lagrangian which is an arbitrary algebraic function of the curvature and torsion tensors \begin{equation} {\cal L}_{\rm g} = {\cal L}_{\rm g}(R_{abcd},Q_{abc}) \end{equation} No derivatives of the torsion or curvature are permitted. For such a Lagrangian we define so called curvature and torsion momentums \begin{equation} \widetilde{R}{}^{abcd} = 2\frac{\partial{\cal L}_{\rm g}(R,Q)}{\partial R_{abcd}},\qquad \widetilde{Q}{}^{abc} = 2\frac{\partial{\cal L}_{\rm g}(R,Q)}{\partial Q_{abc}},\qquad \end{equation} The corresponding objects are \object{Undotted Curvature Momentum POMEGAU.AB}{\widetilde{\Omega}_{AB}} \object{Torsion Momentum PTHETA'a}{\widetilde{\Theta}{}^a} where \begin{eqnarray} \widetilde{\Omega}_{ab} &=& \frac12 \widetilde{R}_{abcd}\,S^{cd} \\[1mm] \widetilde{\Theta}{}^a &=& \frac12 \widetilde{Q}{}^a{}_{cd}\,S^{cd} \end{eqnarray} and \begin{equation} \widetilde{\Omega}_{ab} \tsst \widetilde{\Omega}_{A\dot AB\dot B}= \epsilon_{AB} \widetilde{\Omega}_{\dot A\dot B} + \epsilon_{\dot A\dot B}\widetilde{\Omega}_{AB} \end{equation} If value of three objects $L_{\rm g}$ ({\tt Action}), $\widetilde{\Omega}_{AB}$ ({\tt Undotted curvature momentum}) and $\widetilde{\Theta}{}^a$ are specified then the {\tt Gravitational equations} can be calculated using equations ({\tt Standard way}) \begin{eqnarray} Z_{(ab)} &=& *(\theta_{(a}\wedge Z_{b)}),\nonumber\\[1mm] Z_a &=& D\widetilde{\Theta}_a + (\partial_a\ipr\Theta^b)\wedge\widetilde{\Theta}_b +2(\partial_a\ipr\Omega^{MN})\wedge\widetilde{\Omega}_{MN} \nonumber\\ && + {\rm c.c.}-\partial_a L_{\rm g} \end{eqnarray} \begin{eqnarray} &&V_{AB} = -D\widetilde{\Omega}_{AB} - \widetilde{\Theta}_{AB},\nonumber\\[1mm] && \theta_{[a}\wedge\widetilde{\Theta}_{b]} \tsst \epsilon_{AB} \widetilde{\Theta}_{\dot A\dot B} + \epsilon_{\dot A\dot B}\widetilde{\Theta}_{AB} \end{eqnarray} Since gravitational equations are computed in the spinorial formalism with the standard null frame \seethis{See pages \pageref{spinors}\ and \pageref{spinors1}.} the metric equation is complex and components $\scriptstyle02$, $\scriptstyle12$, $\scriptstyle22$ are conjugated to $\scriptstyle03$. $\scriptstyle13$, $\scriptstyle33$. Since these components are not independent For the sake of efficiency by default \grg\ computes only the $\scriptstyle00$, $\scriptstyle01$, $\scriptstyle02$, $\scriptstyle11$, $\scriptstyle12$, $\scriptstyle22$ and $\scriptstyle23$ components of $Z_{(ab)}$ only. If you want to have all components the switch \comm{FULL} must be turned on. \swind{FULL} These equations allows one to compute field equations for gravity theory with an arbitrary Lagrangian. But the value of three quantities $L_{\rm g}$, $\widetilde{\Omega}_{AB}$ and $\widetilde{\Theta}{}^a$ must be specified by the user. In addition \grg\ has built-in formulas for the most general quadratic in torsion and curvature Lagrangian. The {\tt Standard way} for $L_{\rm g}$, $\widetilde{\Omega}_{AB}$ and $\widetilde{\Theta}{}^a$ is \label{thetau} \begin{eqnarray} \widetilde{\Theta}{}^a &=& i\mu_1 (\stackrel{\scriptscriptstyle\rm c}{\vartheta}{}^a -{\rm c.c.}) +i\mu_2 (\stackrel{\scriptscriptstyle\rm t}{\vartheta}{}^a -{\rm c.c.}) +i\mu_3 (\stackrel{\scriptscriptstyle\rm a}{\vartheta}\!{}^a -{\rm c.c.}), \\[2mm] \widetilde{\Omega}_{AB} &=& i(\lambda_0-\sigma\,8\pi G\, a_0\phi^2)\, S_{AB} \nonumber\\&& +i\lambda_1 \OO{w}_{AB} -i\lambda_2 \OO{c}_{AB} +i\lambda_3 \OO{r}_{AB} \nonumber\\&& +i\lambda_4 \OO{a}_{AB} -i\lambda_5 \OO{b}_{AB} +i\lambda_6 \OO{d}_{AB} , \\[2mm] L_{\rm g} &=& (-2\Lambda +\frac{1}{2}\lambda_0R -\sigma\,4\pi G a_0 \phi^2 R) \upsilon + \Omega^{AB}\wedge\widetilde{\Omega}_{AB} + {\rm c.c.} \nonumber\\&& + \frac{1}{2} \Theta^a\wedge\widetilde{\Theta}_a \end{eqnarray} The cosmological term $\Lambda$ is included into equations iff the switch \comm{CCONST} is turned on \swinda{CCONST} and the value of $\Lambda$ is given by the constant \comm{CCONST}. The term with the scalar field $\phi$ is included into equations iff the switch \comm{NONMIN} is on. \swinda{NONMIN} The gravitational constant $G$ is given by the constant \comm{GCONST}. The parameters of the quadratic Lagrangian are given by the objects \object{L-Constants LCONST.i6}{\lambda_i} \object{M-Constants MCONST.i3}{\mu_i} \object{A-Constants ACONST.i2}{a_i} The default value of these objects ({\tt Standard way}) is \begin{eqnarray} \lambda_i &=& (\mbox{\tt LC0},\mbox{\tt LC1},\mbox{\tt LC2},\mbox{\tt LC3},\mbox{\tt LC4},\mbox{\tt LC5},\mbox{\tt LC6}), \\ \mu_i &=& (0,\mbox{\tt MC1},\mbox{\tt MC2},\mbox{\tt MC32}), \\ a_i &=& (\mbox{\tt AC0},0,0) \end{eqnarray} \section{Gravitational Equations in Riemann Space} Equations in this section are valid in dimension $d=4$ with the signature ${\scriptstyle(-,+,+,+)}$ and ${\scriptstyle(+,-,-,-)}$ only. The $\sigma=1$ for the first signature and $\sigma=-1$ for the second. The nonmetricity and torsion must be zero and the switches \comm{NONMETR} and \comm{TORSION} must be turned off. Let us consider the action \begin{equation} S=\int\left[\frac{\sigma}{16\pi G}L_{\rm g} +L_{\rm m}\right] \end{equation} where \object{Action LACT}{L_{\rm g}=\upsilon\,{\cal L}_{\rm g}} is the gravitational action 4-form and \begin{equation} L_{\rm m} = \upsilon\,{\cal L}_{\rm m} \end{equation} is the matter action 4-form. Let us define the following variational derivatives \begin{equation} Z^\mu{}_{a} = \frac{1}{\sqrt{-g}} \frac{\delta\sqrt{-g}{\cal L}_{\rm g}}{\delta h^a_\mu} ,\qquad T^\mu{}_{a} = \frac{\sigma}{\sqrt{-g}} \frac{\delta\sqrt{-g}{\cal L}_{\rm m}}{\delta h^a_\mu} \end{equation} Then the {\tt Metric equation} is \label{metreq} \object{Metric Equation METRq.a.b}{-\frac12Z_{ab}=8\pi G\,T_{ab}} Notice that $Z_{ab}$ and $T_{ab}$ are automatically symmetric. Let us define 3-form \begin{equation} Z_a = Z^m{}_a\,*\theta_m,\qquad t_a = t^m{}_a\,*\theta_m \end{equation} Now we consider the equations which are used in \grg\ to compute the left-hand side of the metric equation $Z_{ab}$. We have to emphasize that we use spinors and all restrictions imposed by the spinorial formalism \seethis{See pages \pageref{spinors}\ or \pageref{spinors1}.} must be fulfilled. We consider the Lagrangian which is an arbitrary algebraic function of the curvature tensor \begin{equation} {\cal L}_{\rm g} = {\cal L}_{\rm g}(R_{abcd}) \end{equation} No derivatives of the curvature are permitted. For such a Lagrangian we define so called curvature momentum \begin{equation} \widetilde{R}{}^{abcd} = 2\frac{\partial{\cal L}_{\rm g}(R)}{\partial R_{abcd}} \end{equation} The corresponding \grg\ built-in object is \object{Undotted Curvature Momentum POMEGAU.AB}{\widetilde{\Omega}_{AB}} where \begin{eqnarray} \widetilde{\Omega}_{ab} &=& \frac12 \widetilde{R}_{abcd}\,S^{cd} \\[1mm] \end{eqnarray} and \begin{equation} \widetilde{\Omega}_{ab} \tsst \widetilde{\Omega}_{A\dot AB\dot B}= \epsilon_{AB} \widetilde{\Omega}_{\dot A\dot B} + \epsilon_{\dot A\dot B}\widetilde{\Omega}_{AB} \end{equation} If value of the objects $L_{\rm g}$ ({\tt Action}) and $\widetilde{\Omega}_{AB}$ ({\tt Undotted curvature momentum}) is specified then the {\tt Metric equation} can be calculated using equations ({\tt Standard way}) \begin{eqnarray} Z_{ab} &=& *(\theta_{(a}\wedge Z_{b)}),\nonumber\\[1mm] Z_a &=& D [ 2\partial_m\ipr D\widetilde{\Omega}_a{}^{m} -{\frac{1}{2}}\theta_a\!\wedge (\partial_m\ipr\partial_n\ipr D\widetilde{\Omega}{}^{mn})] \nonumber\\&& +2(\partial_a\ipr\Omega^{MN})\wedge\widetilde{\Omega}_{MN} + {\rm c.c.}-\partial_a L_{\rm g} \end{eqnarray} Since gravitational equations are computed in the spinorial formalism with the standard null frame \seethis{See \pref{spinors}\ or \pref{spinors1}.} the metric equation is complex and components $\scriptstyle02$, $\scriptstyle12$, $\scriptstyle22$ are conjugated to $\scriptstyle03$, $\scriptstyle13$, $\scriptstyle33$. For the sake of efficiency by default \grg\ computes only the components $\scriptstyle00$, $\scriptstyle01$, $\scriptstyle02$, $\scriptstyle11$, $\scriptstyle12$, $\scriptstyle22$ and $\scriptstyle23$ only. If you want to have all components the switch \comm{FULL} must be turned on. \swinda{FULL} These equations allows one to compute field equations for gravity theory with an arbitrary Lagrangian. But the value of three quantities $L_{\rm g}$ and $\widetilde{\Omega}_{AB}$ must be specified by user. In addition \grg\ has built-in formulas for the most general quadratic in the curvature Lagrangian. The {\tt Standard way} for $L_{\rm g}$ and $\widetilde{\Omega}_{AB}$ is \begin{eqnarray} \widetilde{\Omega}_{AB} &=& i(\lambda_0-\sigma8\pi G\, a_0\phi^2)\, S_{AB} \nonumber\\&& +i\lambda_1 \OO{w}_{AB} -i\lambda_2 \OO{c}_{AB} +i\lambda_3 \OO{r}_{AB}, \\[2mm] L_{\rm g} &=& (-2\Lambda +{\frac{1}{2}}\lambda_0R -\sigma4\pi G a_0 \phi^2 R) \upsilon + \Omega^{AB}\wedge\widetilde{\Omega}_{AB} + {\rm c.c.} \end{eqnarray} The cosmological term is included into equations iff the switch \comm{CCONST} is on \swinda{CCONST} and the value of $\Lambda$ is given by the constant \comm{CCONST}. The term with the scalar field $\phi$ is included into equations iff the switch \comm{NONMIN} is on. \swinda{NONMIN} The gravitational constant $G$ is given by the constant \comm{GCONST}. The parameters of the quadratic lagrangian are given by the object \object{L-Constants LCONST.i6}{\lambda_i} \object{A-Constants ACONST.i2}{a_i} The default value of these objects ({\tt Standard way}) is \begin{eqnarray} \lambda_i &=& (\mbox{\tt LC0},\mbox{\tt LC1},\mbox{\tt LC2},\mbox{\tt LC3},\mbox{\tt LC4},\mbox{\tt LC5},\mbox{\tt LC6}), \\ a_i &=& (\mbox{\tt AC0},0,0) \end{eqnarray} \appendix \chapter{\grg\ Switches}\vspace*{-6mm} \index{Switches} \tabcolsep=1.5mm \begin{tabular}{|c|c|l|c|} \hline Switch & Default &\qquad Description & See \\ & State & & page\\ \hline \tt AEVAL & Off & Use {\tt AEVAL} instead of {\tt REVAL}. &\pageref{AEVAL}\\ \tt WRS & On & Re-simplify object before printing. &\pageref{WRS}\\ \tt WMATR & Off & Write 2-index objects in matrix form. &\pageref{WMATR}\\ \tt TORSION & Off & Torsion. &\pageref{TORSION}\\ \tt NONMETR & Off & Nonmetricity. &\pageref{NONMETR}\\ \tt UNLCORD & On & Save coordinates in {\tt Unload}. &\pageref{UNLCORD}\\ \tt AUTO & On & Automatic object calculation in expressions. &\pageref{AUTO}\\ \tt TRACE & On & Trace the calculation process. &\pageref{TRACE}\\ \tt SHOWCOMMANDS & Off & Show compound command expansion. &\pageref{SHOWCOMMANDS}\\ \tt EXPANDSYM & Off & Enable {\tt Sy Asy Cy} in expressions &\pageref{EXPANDSYM}\\ \tt DFPCOMMUTE & On & Commutativity of {\tt DFP} derivatives. &\pageref{DFPCOMMUTE}\\ \tt NONMIN & Off & Nonminimal interaction for scalar field. &\pageref{NONMIN}\\ \tt NOFREEVARS & Off & Prohibit free variables in {\tt Print}. &\pageref{NOFREEVARS}\\ \tt CCONST & Off & Include cosmological constant in equations. &\pageref{CCONST}\\ \tt FULL & Off & Number of components in {\tt Metric Equation}. &\pageref{FULL}\\ \tt LATEX & Off & \LaTeX\ output mode. &\pageref{LATEX}\\ \tt GRG & Off & \grg\ output mode. &\pageref{GRG}\\ \tt REDUCE & Off & \reduce\ output mode. &\pageref{REDUCE}\\ \tt MAPLE & Off & {\sc Maple} output mode. &\pageref{MAPLE}\\ \tt MATH & Off & {\sc Mathematica} output mode. &\pageref{MATH}\\ \tt MACSYMA & Off & {\sc Macsyma} output mode. &\pageref{MACSYMA}\\ \tt DFINDEXED & Off & Print {\tt DF} in index notation. &\pageref{DFINDEXED}\\ \tt BATCH & Off & Batch mode. &\pageref{BATCH}\\ \tt HOLONOMIC & On & Keep frame holonomic. &\pageref{HOLONOMIC}\\ \tt SHOWEXPR & Off & Print expressions during algebraic &\pageref{SHOWEXPR}\\ \tt & & classification. &\\ \hline \end{tabular} \chapter{Macro Objects} \index{Macro Objects} Macro objects can be used in expression, in {\tt Write} and {\tt Show} commands but not in the {\tt Find} command. The notation for indices is the same as in the {\tt New Object} declaration (see page \pageref{indices}). \begin{center} \section{Dimension and Signature} \begin{tabular}{|l|l|} \hline \tt dim & Dimension $d$ \\ \hline \tt sdiag.idim & {\tt sdiag(\parm{n})} is the $n$'th element of the \\ & signature diag($-1,+1$\dots) \\ \hline \tt sign & Product of the signature specification \\ \tt sgnt & elements $\prod_{n=0}^{d-1}\mbox{\tt sdiag(}n\mbox{\tt)}$ \\[1mm] \hline \tt mpsgn & {\tt sdiag(0)} \\ \tt pmsgn & {\tt -sdiag(0)} \\ \hline \end{tabular} \section{Metric and Frame} \begin{tabular}{|l|l|} \hline \tt x\^m & $m$'th coordinate \\ \tt X\^m & \\ \hline \tt h'a\_m & Frame coefficients \\ \tt hi.a\^m & \\ \hline \tt g\_m\_n & Holonomic metric \\ \tt gi\^m\^n & \\ \hline \end{tabular} \section{Delta and Epsilon Symbols} \begin{tabular}{|l|l|} \hline \tt del'a.b & Delta symbols \\ \tt delh\^m\_n & \\ \hline \tt eps.a.b.c.d & Totally antisymmetric symbols \\ \tt epsi'a'b'c'd & (number of indices depend on $d$) \\ \tt epsh\_m\_n\_p\_q & \\ \tt epsih\^m\^n\^p\^q & \\ \hline \end{tabular} \section{Spinors} \begin{tabular}{|l|l|} \hline \tt DEL'A.B & Delta symbol \\ \hline \tt EPS.A.B & Spinorial metric \\ \tt EPSI'A'B & \\ \hline \tt sigma'a.A.B\cc & Sigma matrices \\ \tt sigmai.a'A'B\cc & \\ \hline \tt cci.i3 & Frame index conjugation in standard null frame \\ & {\tt cci(0)=0}\ {\tt cci(1)=1}\ {\tt cci(2)=3}\ {\tt cci(3)=2} \\ \hline \end{tabular} \section{Connection Coefficients} \begin{tabular}{|l|l|} \hline \tt CHR\^m\_n\_p & Christoffel symbols $\{{}^\mu_{\nu\pi}\}$ \\ \tt CHRF\_m\_n\_p & and $[{}_{\mu},_{\nu\pi}]$ \\ \tt CHRT\_m & Christoffel symbol trace $\{{}^\pi_{\pi\mu}\}$ \\ \hline \tt SPCOEF.AB.c & Spin coefficients $\omega_{AB\,c}$ \\ \hline \end{tabular} \section{NP Formalism} \begin{tabular}{|l|c|} \hline \tt PHINP.AB.CD~ & $\Phi_{AB\dot{c}\dot{D}}$ \\ \tt PSINP.ABCD & $\Psi_{ABCD}$ \\ \hline \tt alphanp & $\alpha$ \\ \tt betanp & $\beta$ \\ \tt gammanp & $\gamma$ \\ \tt epsilonnp & $\epsilon$ \\ \tt kappanp & $\kappa$ \\ \tt rhonp & $\rho$ \\ \tt sigmanp & $\sigma$ \\ \tt taunp & $\tau$ \\ \tt munp & $\mu$ \\ \tt nunp & $\nu$ \\ \tt lambdanp & $\lambda$ \\ \tt pinp & $\pi$ \\ \hline \tt DD & $D$ \\ \tt DT & $\Delta$ \\ \tt du & $\delta$ \\ \tt dd & $\overline\delta$ \\ \hline \end{tabular} \end{center} \chapter{Objects} Here we present the complete list of built-in objects with names and identifiers. The notation for indices is the same as in the {\tt New Object} declaration (see page \pageref{indices}). Some names (group names) refer to a set of objects. For example the group name {\tt Spinorial S - forms} below denotes {\tt SU.AB} and {\tt SD.AB\cc} \begin{center} \section{Metric, Frame, Basis, Volume \dots} \begin{tabular}{|l|l|}\hline \tt Frame &\tt T'a\\ \tt Vector Frame &\tt D.a\\ \hline \tt Metric &\tt G.a.b\\ \tt Inverse Metric &\tt GI'a'b\\ \tt Det of Metric &\tt detG\\ \tt Det of Holonomic Metric &\tt detg\\ \tt Sqrt Det of Metric &\tt sdetG\\ \hline \tt Volume &\tt VOL\\ \hline \tt Basis &\tt b'idim \\ \tt Vector Basis &\tt e.idim \\ \hline \tt S-forms &\tt S'a'b\\ \hline \multicolumn{2}{|c|}{\tt Spinorial S-forms} \\ \tt Undotted S-forms &\tt SU.AB\\ \tt Dotted S-forms &\tt SD.AB\cc\\ \hline\end{tabular} \section{Rotation Matrices} \begin{tabular}{|l|l|}\hline \tt Frame Transformation &\tt L'a.b \\ \tt Spinorial Transformation &\tt LS.A'B \\ \hline\end{tabular} \section{Connection and related objects} \begin{tabular}{|l|l|}\hline \tt Frame Connection &\tt omega'a.b\\ \tt Holonomic Connection &\tt GAMMA\^m\_n\\ \hline \multicolumn{2}{|c|}{\tt Spinorial Connection}\\ \tt Undotted Connection &\tt omegau.AB\\ \tt Dotted Connection &\tt omegad.AB\cc\\ \hline \tt Riemann Frame Connection &\tt romega'a.b\\ \tt Riemann Holonomic Connection &\tt RGAMMA\^m\_n\\ \hline \multicolumn{2}{|c|}{\tt Riemann Spinorial Connection}\\ \tt Riemann Undotted Connection &\tt romegau.AB\\ \tt Riemann Dotted Connection &\tt romegad.AB\cc\\ \hline \tt Connection Defect &\tt K'a.b\\ \hline\end{tabular} \section{Torsion} \begin{tabular}{|l|l|}\hline \tt Torsion &\tt THETA'a\\ \tt Contorsion &\tt KQ'a.b\\ \tt Torsion Trace 1-form &\tt QQ\\ \tt Antisymmetric Torsion 3-form &\tt QQA\\ \hline \multicolumn{2}{|c|}{\tt Spinorial Contorsion}\\ \tt Undotted Contorsion &\tt KU.AB\\ \tt Dotted Contorsion &\tt KD.AB\cc\\ \hline \multicolumn{2}{|c|}{\tt Torsion Spinors }\\ \multicolumn{2}{|c|}{\tt Torsion Components }\\ \tt Torsion Trace &\tt QT'a\\ \tt Torsion Pseudo Trace &\tt QP'a\\ \tt Traceless Torsion Spinor &\tt QC.ABC.D\cc\\ \hline \multicolumn{2}{|c|}{\tt Torsion 2-forms}\\ \tt Traceless Torsion 2-form &\tt THQC'a\\ \tt Torsion Trace 2-form &\tt THQT'a\\ \tt Antisymmetric Torsion 2-form &\tt THQA'a\\ \hline \multicolumn{2}{|c|}{\tt Undotted Torsion 2-forms}\\ \tt Undotted Torsion Trace 2-form &\tt THQTU'a\\ \tt Undotted Antisymmetric Torsion 2-form &\tt THQAU'a\\ \tt Undotted Traceless Torsion 2-form &\tt THQCU'a\\ \hline\end{tabular} \section{Curvature} \label{curspincoll} \begin{tabular}{|l|l|}\hline \tt Curvature &\tt OMEGA'a.b\\ \hline \multicolumn{2}{|c|}{\tt Spinorial Curvature}\\ \tt Undotted Curvature &\tt OMEGAU.AB\\ \tt Dotted Curvature &\tt OMEGAD.AB\cc\\ \hline \tt Riemann Tensor &\tt RIM'a.b.c.d\\ \tt Ricci Tensor &\tt RIC.a.b\\ \tt A-Ricci Tensor &\tt RICA.a.b\\ \tt S-Ricci Tensor &\tt RICS.a.b\\ \tt Homothetic Curvature &\tt OMEGAH\\ \tt Einstein Tensor &\tt GT.a.b\\ \hline \multicolumn{2}{|c|}{\tt Curvature Spinors}\\ \multicolumn{2}{|c|}{\tt Curvature Components}\\ \tt Weyl Spinor &\tt RW.ABCD\\ \tt Traceless Ricci Spinor &\tt RC.AB.CD\cc\\ \tt Scalar Curvature &\tt RR\\ \tt Ricanti Spinor &\tt RA.AB\\ \tt Traceless Deviation Spinor &\tt RB.AB.CD\cc\\ \tt Scalar Deviation &\tt RD\\ \hline \multicolumn{2}{|c|}{\tt Undotted Curvature 2-forms}\\ \tt Undotted Weyl 2-form &\tt OMWU.AB \\ \tt Undotted Traceless Ricci 2-form &\tt OMCU.AB \\ \tt Undotted Scalar Curvature 2-form &\tt OMRU.AB \\ \tt Undotted Ricanti 2-form &\tt OMAU.AB \\ \tt Undotted Traceless Deviation 2-form &\tt OMBU.AB \\ \tt Undotted Scalar Deviation 2-form &\tt OMDU.AB \\ \hline \multicolumn{2}{|c|}{\tt Curvature 2-forms}\\ \tt Weyl 2-form &\tt OMW.a.b \\ \tt Traceless Ricci 2-form &\tt OMC.a.b \\ \tt Scalar Curvature 2-form &\tt OMR.a.b \\ \tt Ricanti 2-form &\tt OMA.a.b \\ \tt Traceless Deviation 2-form &\tt OMB.a.b \\ \tt Antisymmetric Curvature 2-form &\tt OMD.a.b \\ \tt Homothetic Curvature 2-form &\tt OSH.a.b \\ \tt Antisymmetric S-Ricci 2-form &\tt OSA.a.b \\ \tt Traceless S-Ricci 2-form &\tt OSC.a.b \\ \tt Antisymmetric S-Curvature 2-form &\tt OSV.a.b \\ \tt Symmetric S-Curvature 2-form &\tt OSU.a.b \\ \hline \end{tabular} \section{Nonmetricity} \begin{tabular}{|l|l|}\hline \tt Nonmetricity &\tt N.a.b\\ \tt Nonmetricity Defect &\tt KN'a.b\\ \tt Weyl Vector &\tt NNW\\ \tt Nonmetricity Trace &\tt NNT\\ \hline \multicolumn{2}{|c|}{\tt Nonmetricity 1-forms}\\ \tt Symmetric Nonmetricity 1-form &\tt NC.a.b\\ \tt Antisymmetric Nonmetricity 1-form &\tt NA.a.b\\ \tt Nonmetricity Trace 1-form &\tt NT.a.b\\ \tt Weyl Nonmetricity 1-form &\tt NW.a.b\\ \hline\end{tabular} \section{EM field} \begin{tabular}{|l|l|}\hline \tt EM Potential &\tt A\\ \tt Current 1-form &\tt J\\ \tt EM Action &\tt EMACT\\ \tt EM 2-form &\tt FF\\ \tt EM Tensor &\tt FT.a.b\\ \hline \multicolumn{2}{|c|}{\tt Maxwell Equations}\\ \tt First Maxwell Equation &\tt MWFq\\ \tt Second Maxwell Equation &\tt MWSq\\ \hline \tt Continuity Equation &\tt COq\\ \tt EM Energy-Momentum Tensor &\tt TEM.a.b\\ \hline \multicolumn{2}{|c|}{\tt EM Scalars}\\ \tt First EM Scalar &\tt SCF\\ \tt Second EM Scalar &\tt SCS\\ \hline \tt Selfduality Equation &\tt SDq.AB\cc\\ \tt Complex EM 2-form &\tt FFU\\ \tt Complex Maxwell Equation &\tt MWUq\\ \tt Undotted EM Spinor &\tt FIU.AB\\ \tt Complex EM Scalar &\tt SCU\\ \tt EM Energy-Momentum Spinor &\tt TEMS.AB.CD\cc\\ \hline\end{tabular} \section{Scalar field} \begin{tabular}{|l|l|}\hline \tt Scalar Equation &\tt SCq\\ \tt Scalar Field &\tt FI\\ \tt Scalar Action &\tt SACT\\ \tt Minimal Scalar Action &\tt SACTMIN\\ \tt Minimal Scalar Energy-Momentum Tensor &\tt TSCLMIN.a.b\\ \hline\end{tabular} \section{YM field} \begin{tabular}{|l|l|}\hline \tt YM Potential &\tt AYM.i9\\ \tt Structural Constants &\tt SCONST.i9.j9.k9\\ \tt YM Action &\tt YMACT\\ \tt YM 2-form &\tt FFYM.i9\\ \tt YM Tensor &\tt FTYM.i9.a.b\\ \hline \multicolumn{2}{|c|}{\tt YM Equations}\\ \tt First YM Equation &\tt YMFq.i9\\ \tt Second YM Equation &\tt YMSq.i9\\ \hline \tt YM Energy-Momentum Tensor &\tt TYM.a.b\\ \hline\end{tabular} \section{Dirac field} \begin{tabular}{|l|l|}\hline \multicolumn{2}{|c|}{\tt Dirac Spinor}\\ \tt Phi Spinor &\tt PHI.A\\ \tt Chi Spinor &\tt CHI.B\\ \hline \tt Dirac Action 4-form &\tt DACT\\ \tt Undotted Dirac Spin 3-Form &\tt SPDIU.AB\\ \tt Dirac Energy-Momentum Tensor &\tt TDI.a.b\\ \hline \multicolumn{2}{|c|}{\tt Dirac Equation}\\ \tt Phi Dirac Equation &\tt DPq.A\cc\\ \tt Chi Dirac Equation &\tt DCq.A\cc\\ \hline\end{tabular} \section{Geodesics} \begin{tabular}{|l|l|}\hline \tt Geodesic Equation &\tt GEOq\^m\\ \hline\end{tabular} \section{Null Congruence} \begin{tabular}{|l|l|}\hline \tt Congruence &\tt KV\\ \tt Null Congruence Condition &\tt NCo\\ \tt Geodesics Congruence Condition&\tt GCo'a\\ \hline \multicolumn{2}{|c|}{\tt Optical Scalars}\\ \tt Congruence Expansion &\tt thetaO\\ \tt Congruence Squared Rotation &\tt omegaSQO\\ \tt Congruence Squared Shear &\tt sigmaSQO\\ \hline\end{tabular} \section{Kinematics} \begin{tabular}{|l|l|}\hline \tt Velocity Vector &\tt UV\\ \tt Velocity &\tt UU'a\\ \tt Velocity Square &\tt USQ\\ \tt Projector &\tt PR'a.b\\ \hline \multicolumn{2}{|c|}{\tt Kinematics}\\ \tt Acceleration &\tt accU'a\\ \tt Vorticity &\tt omegaU.a.b\\ \tt Volume Expansion &\tt thetaU\\ \tt Shear &\tt sigmaU.a.b\\ \hline\end{tabular} \section{Ideal and Spin Fluid} \begin{tabular}{|l|l|}\hline \tt Pressure &\tt PRES\\ \tt Energy Density &\tt ENER\\ \tt Ideal Fluid Energy-Momentum Tensor &\tt TIFL.a.b\\ \hline \tt Spin Fluid Energy-Momentum Tensor &\tt TSFL.a.b \\ \tt Spin Density &\tt SPFLT.a.b \\ \tt Spin Density 2-form &\tt SPFL \\ \tt Undotted Fluid Spin 3-form &\tt SPFLU.AB \\ \tt Frenkel Condition &\tt FCo \\ \hline\end{tabular} \section{Total Energy-Momentum and Spin} \begin{tabular}{|l|l|}\hline \tt Total Energy-Momentum Tensor &\tt TENMOM.a.b\\ \tt Total Energy-Momentum Spinor &\tt TENMOMS.AB.CD\cc\\ \tt Total Energy-Momentum Trace &\tt TENMOMT\\ \tt Total Undotted Spin 3-form &\tt SPINU.AB\\ \hline\end{tabular} \section{Einstein Equations} \begin{tabular}{|l|l|}\hline \tt Einstein Equation &\tt EEq.a.b\\ \hline \multicolumn{2}{|c|}{\tt Spinor Einstein Equations}\\ \tt Traceless Einstein Equation &\tt CEEq.AB.CD\cc\\ \tt Trace of Einstein Equation &\tt TEEq\\ \hline\end{tabular} \section{Constants} \begin{tabular}{|l|l|}\hline \tt A-Constants &\tt ACONST.i2\\ \tt L-Constants &\tt LCONST.i6\\ \tt M-Constants &\tt MCONST.i3\\ \hline\end{tabular} \section{Gravitational Equations} \begin{tabular}{|l|l|}\hline \tt Action &\tt LACT\\ \tt Undotted Curvature Momentum &\tt POMEGAU.AB\\ \tt Torsion Momentum &\tt PTHETA'a\\ \hline \multicolumn{2}{|c|}{\tt Gravitational Equations}\\ \tt Metric Equation &\tt METRq.a.b\\ \tt Torsion Equation &\tt TORSq.AB\\ \hline\end{tabular} \end{center} \chapter{Standard Synonymy} \index{Synonymy} Below we present the default synonymy as it is defined in the global configuration file. See section \ref{tuning} to find out how to change the default synonymy or define a new one. \begin{verbatim} Affine Aff Anholonomic Nonholonomic AMode ABasis Antisymmetric Asy Change Transform Classify Class Components Comp Connection Con Constants Const Constant Coordinates Cord Curvature Cur Dimension Dim Dotted Do Equation Equations Eq Erase Delete Del Evaluate Eval Simplify Find F Calculate Calc Form Forms Functions Fun Function Generic Gen Gravitational Gravity Gravitation Grav Holonomic HMode HBasis Inverse Inv Load Restore Next N Normalize Normal Object Obj Output Out Parameter Par Rotation Rot Scalar Scal Show ? Signature Sig Solutions Solution Sol Spinor Spin Spinorial Sp standardlisp lisp Switch Sw Symmetries Sym Symmetric Tensor Tensors Tens Torsion Tors Transformation Trans Undotted Un Unload Save Vector Vec Write W Zero Nullify \end{verbatim} \makeatletter \if@openright\cleardoublepage\else\clearpage\fi \makeatother \thispagestyle{empty} \def\indexname{INDEX} \printindex \end{document} %======== End of grg32.tex ==============================================% |
Added grg32r6.txt version [96ebf0d1e5].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 | This is GRG 3.2 Copyright (C) 1997-2000 Vadim V. Zhytnikov The system with source code and documentation is distributed in the hope that it will be useful but without any warranty. You may modify it for personal use, but you are not allowed to remove author's name and/or to distribute modified files. GRG 3.2 is available by anonymous ftp download at ftp://ftp.maths.qmw.ac.uk in the directory /pub/grg3.2 GRG 3.2 is free of charge but any contribution is highly appreciated. I work on GRG in my spare time and if you like the program you can help the development and support of new versions. Please, acknowledge use of GRG in publications. The address for correspondence: Vadim V. Zhytnikov Physics Department, Faculty of Mathematics, Moscow State Pedagogical University, Davydovskii per. 4, Moscow 107140, Russia Tel(home): (095) 188-16-11 E-mail: vvzhy@mail.ru vvzhy@td.lpi.ac.ru 1. INTRODUCTION --------------- GRG 3.2 is the computer algebra program designed for the problems in the differential geometry, gravitation and field theory. GRG 3.2 is based on the computer algebra system REDUCE and works with REDUCE versions 3.3, 3.4, 3.4.1, 3.5, 3.6 and 3.7. 2. SYSTEM REQUIREMENTS ---------------------- Both GRG and REDUCE are written in LISP. There are several versions of REDUCE which use different LISP dialects. At present GRG works with REDUCE based on PSL (Portable Standard Lisp distributed by Konrad-Zuse-Zentrum (ZIB) <http://www.zib.de/Symbolik/reduce/>) and CSL (Codemist Standard Lisp distributed by Codemist Ltd. <http://www.codemist.tc>). In practice you should not worry about these details since GRG compilation script automatically determines current LISP dialect. Some little details depending on the particular REDUCE version which will be explained below. GRG is distributed as the source code and in order to install it one must compile the program. Usually REDUCE is equipped with the compiler except so called "personal" REDUCE. To install GRG on the system which has no compiler it is necessary to find the full REDUCE installed on similar platform, compile GRG on this machine and then copy the resulting fasl files (grg*.b or grg*.fsl, see below) on your computer. GRG compilation script automatically determines presence whether the compiler is installed on your system or not. 3. THE DISTRIBUTIVE FILE CONTENTS --------------------------------- GRG 3.2 distributive includes the following files: readme.txt - this file new-in32.txt - the note describing new features of GRG 3.2 compared to GRG 3.1. Can be useful for user who is familiar with GRG 3.1 compare.txt - please read this file if you wonder Why should I use GRG if I have excalc? timing.txt - statistics on the performance of REDUCE and GRG on various platforms guide32.tex - documentation grg32.tex compile.grg - GRG compilation script and relevant files compile.csl expand.csl expand.psl compile.psl xcompile.psl grg.sl - GRG source code grg32.sl grgcfg.sl grgclass.sl grgcomm.sl grgcomp.sl grgcoper.sl grgdecl.sl grggeom.sl grggrav.sl grginit.sl grgmacro.sl grgmain.sl grgmater.sl grgprin.sl grgproc.sl grgtrans.sl grgxcomp.sl grgxmacr.sl grg.cfg - GRG local configuration file bondi.low - GRG tests bondi.up pgt.low pgt.up test.red - Script which determines the background LISP version grg2tex.red - REDUCE program which converts GRG output into LaTeX Notice that the GRG distributive is completely the same for all operational systems: various UNIX dialects, VAX/VMS, DOS, MS Windows etc. One should take into account only that different operational system have different text file formats. Thus the DOS distributive may include the programs: dtou.exe utod.exe addz.exe cutz.exe The utod.exe converts UNIX text file into DOS text file format and dtou.exe makes inverse transformation. The programs addz.exe and cutz.exe add and cut ^Z at the very end of the text file (see below). 4. IMPORTANT NOTE FOR IBM-PC REDUCE 3.3 and maybe 3.4 ! ------------------------------------------------------- The PSL-based REDUCE 3.3 (possibly 3.4 too) for DOS has rather nasty bug. If such REDUCE 3.3 reads the text file which has no trailing ^Z (hexadecimal code 1A which is optionally used as the end-of-file marker for DOS text files) and reaches the end of the file then DOS hangs and it is necessary to reboot the computer. This is not so important to REDUCE itself since REDUCE input files are usually terminated by the `soft' end-of-file command `end;' (if both end; and ^Z are missing the REDUCE hangs too). The same relates to the GRG input files: they must be ended either by the GRG `soft' end-of-file $ or by ^Z. If GRG is compiled under the DOS REDUCE 3.3 all GRG source files grg*.sl (see above) must have trailing ^Z. The ^Z code can be added with the help of the addz.exe program: addz *.sl The program cutz.exe removes the trailing ^Z. The ^Z problem is fixed in REDUCE 3.5 and (I hope) in later PSL versions. 5. GRG COMPILATION ------------------ Step 1: Create a new directory and copy the files: grg*.sl (19 files) compile.grg compile.psl compile.csl expand.csl into this directory. Usually GRG is distributed in packed form, so it suffices to unpack the distributive in this directory. Step 2: This step is required only for PSL REDUCE 3.3 (and 3.4 ?) under DOS, MS Windows and possibly OS/2. Copy addz.exe program into the directory and type the command (see above for explanations): addz *.sl Step 3: To compile GRG start REDUCE and type the command: in "compile.grg"; Compilation usually takes several minutes. Please watch error messages. The compilation will create 15 files grg*.b (PSL) or grg*.fsl (CSL). Usually *.fsl files are automatically stored into appropriate system directory (recent CSL versions do not create *.fsl files but automatically store them into single REDUCE image file). PSL based REDUCE creates grg*.b files in current directory. You can move them into your working directory or into REDUCE fasl directory. The second option is preferable since in this case GRG can be started from any place and will be accessible for any user. Notice that under UNIX the REDUCE fasl directory is usually write protected for ordinary users and this step may require the interference of system administrator. The REDUCE fasl directory is located at $reduce/fasl (UNIX) or $reduce\fasl (DOS) where $reduce stands for the REDUCE root directory. Step 4: You can remove the unnecessary source files: grg*.sl *.csl *.psl compile.grg 6. RUNNING GRG -------------- Now to run GRG it is necessary to start REDUCE and type the command (depending on the REDUCE version): load grg; or load_package grg; or load!_package grg; GRG will respond with something like this ----------------------------------------------------------------- This is GRG 3.2 release 2 (Feb 9, 1997) ... System variables are upper-cased: E I PI SIN ... Dimension is 4 with Signature (-,+,+,+) <- ----------------------------------------------------------------- The symbol <- is the prompt which means that GRG waits for your commands. Pay attention to the message System variables are upper-cased: E I PI SIN ... The point is that REDUCE is case insensitive which means that x-X is evaluated as zero while in GRG x and X are different. So any variable or function declared in GRG (Unlike REDUCE all variables and functions in GRG must be declared) must be later used exactly as they indicated in declaration. But mathematical constants and functions which are defined by REDUCE must be used in Upper or Lower case depending on the current REDUCE version. So in the example above they must be typed in upper-case: E, I, PI etc. But if the message reads System variables are lower-cased: e i pi sin ... then use e, i, pi etc instead. The GRG session is terminated by the command quit; Usually command load grg; loads GRG program into memory and automatically starts it. On some systems (recent CSL versions) it makes some troubles which are manifested by the following symptoms: (1) wrong timing during computations, (2) command quit; terminates GRG session instead of terminating whole REDUCE program. In such situation one must start GRG manually using two commands instead of one load grg32; grg; Here the first command loads GRG into memory and second one starts it. One can also recompile GRG to make `load grg;' behave as `load grg32;' (see Section 8 below). After this you can start GRG by the commands load grg; grg; 7. TESTING GRG -------------- After installation it is good idea to run a test. The GRG distributive include the test which calculates the irreducible curvature spinors for the Bondi metric. To run this test start GRG and type the command "bondi.up"; or "bondi.low"; depending on the upper or lower case of the built-in constants as explained above. The output of this test is automatically stored into the file bondi.out. There is also another test pgt.up/pgt.low which is far more complicated. See the file timing.txt to compare performance of your system with other platforms. 8. CONFIGURING GRG ------------------ The beginners may skip this section. GRG has two configuration files grgcfg.sl and grg.cgf which allow one to change some initial settings. The first configuration file grgcfg.sl is used during the GRG compilation. You may to edit this file before compiling GRG and in this case the corresponding settings will be activated whenever GRG is started (global settings). Other configuration file grg.cfg is optional. If necessary you can place it into working directory to override the global settings locally. The structure of both configuration files is the same. They can include the following commands: (1) The default signature is established by the command (signature!> - + + +) which also determines the default dimensionality. Do not forget the spaces between + and - ! And newer remove this command from the global configuration file grgcfg.sl. (2) The commands on!> and off!> determines the initial position of switches. For example the commands (on!> torsion) (off!> allfac) turn the switch TORSION on and the switch ALLFAC off. (3) The command package!> loads any REDUCE package. For example (package!> specfn) loads the special functions package specfn. (4) The command (synonymous!> (coordinates cord) (constants constant const) ... ) defines the words will be considered as synonyms in the GRG commands and object names (the synonymy is intended for making the input shorter). (5) The only option which is valid only in the global configuration file grgcfg.sl is (setq ![autostart!] nil) By default GRG is started by the single REDUCE command `load grg;'. This option alters default behaviour and one must start GRG using two commands `load grg; grg;'. This is preferable way on some systems (recent CSL versions, see Section 6 above). Finally you can change the default output line-length which can be useful in the variable-size windows environments like X-Windows. For example, to set the output line-length to 100 include the line (linelength 100) to your configuration file. Be careful with editing the configuration file. If you make some mistake in them GRG probably will not start at all. The good idea is to save original configuration files to be able to restore initial state. Notice also that lines in grg.cfg and grggfg.sl beginning with % are the comments and are ignored by the system. 9. GRG ENVIRONMENT VARIABLE -------------------------- The environment variable grg defines the GRG System Directory. To set it use the command set grg=c:\xxx\yyy in DOS setenv grg /xxx/yyy in UNIX with csh grg=/xxx/yyy in UNIX with sh define grg sys$user:[xxx.yyy] in VAX/VMS When asked to input some file GRG looks for it in the current directory and if the file is absent GRG tries to input it from the system directory. Thus this directory can be used as the storage for oftenly used files. 10. DOCUMENTATION ----------------- The documentation is typeset in LaTeX 2e. The file guide32.tex is short reference guide while grg32.tex is the detailed manual. To print the manual use the following procedure latex grg32 latex grg32 latex grg32 makeindex grg32 latex grg32 11. ACKNOWLEDGMENTS ------------------- I would like to express my sincere gratitude to S.I.Tertychniy who initiated the GRG project. I also want to thank I.G.Obukhova, Yu.N.Obukhov, V.P.Gerdt, and A.Raportirenko. I am grateful to R.L.Agacy, M.A.H.MacCallum< J.M.Nester, and De-Ching Chern for support. ---------------------------------------------------------------- |
Added grgcfg.sl version [088d39a19e].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | %==========================================================================% % GRG 3.2 Global Configuration File (C) 1988-96 Vadim V. Zhytnikov % %==========================================================================% % Default Dimensionality and Signature. % You can modify this line but newer remove it! (signature!> - + + + ) % Uncomment the line below if one need to start GRG % manually using two commands % load grg; % grg; % instead of default (causes trouble on some systems) % load grg; %(setq ![autostart!] nil) % Changing the default on/off switch position: %(on!> page) % Pre-loading the packages: %(package!> specfn) % Command synonymy: (synonymous!> ( Affine Aff ) ( Anholonomic Nonholonomic AMode ABasis ) ( Antisymmetric Asy ) ( Change Transform ) ( Classify Class ) ( Components Comp ) ( Connection Con ) ( Constants Const Constant ) ( Coordinates Cord ) ( Curvature Cur ) ( Dimension Dim ) ( Dotted Do ) ( Equation Equations Eq ) ( Erase Delete Del ) ( Evaluate Eval Simplify ) ( Find F Calculate Calc ) ( Form Forms ) ( Functions Fun Function ) ( Generic Gen ) ( Gravitational Gravity Gravitation Grav ) ( Holonomic HMode HBasis ) ( Inverse Inv ) ( Load Restore ) ( Next N ) ( Normalize Normal ) ( Object Obj ) ( Output Out ) ( Parameter Par ) ( Rotation Rot ) ( Scalar Scal ) ( Show ? ) ( Signature Sig ) ( Solutions Solution Sol ) ( Spinor Spin Spinorial Sp ) ( standardlisp lisp ) ( Switch Sw ) ( Symmetries Sym Symmetric ) ( Tensor Tensors Tens ) ( Torsion Tors ) ( Transformation Trans ) ( Undotted Un ) ( Unload Save ) ( Vector Vec ) ( Write W ) ( Zero Nullify ) ) %======= End of GRGcfg.sl =================================================% |
Added grgclass.sl version [b52cac10e2].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 | %==========================================================================% % GRGclass.sl Assignment, Macro Functions, Classification % %==========================================================================% % 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. % %==========================================================================% %------- Assignment Command 09.91,03.94 ------------------------------- % % Assignment Command in forms % Tetrad T0=..., ...; % Tetrad T(j)=..., ...; % T(j)=..., ...; % T0=..., ...; % (de seti!> (lst) (prog (w wl wa wr was) (setq ![newabbr!] nil) (setq w (seek!> lst '(!=))) (cond ((or (null w) (null(car w)) (null(cdr w))) (prog2 (setq ![er!] 2204) (return !!er!!)))) (setq wa (car w)) (setq wl (length wa)) (cond ((or (eqn wl 1) % t0 = ... (and(eqn wl 2)(pairp(car wa)))) % t(j) = ... (progn (setq wa(cond((eqn wl 1) (car wa)) (t (cadr wa)))) (cond((not(idp wa)) (prog2(setq ![er!] 2204)(return !!er!!)))) (setq was wa) (setq wa (explode2 wa)) (cond((eqn wl 1)(setq wr(selid!> wa nil)))) (setq wa(incomiv!> wa)) (cond((not(flagp wa '!+ivar)) (cond (wr(progn(doub!> was)(setq ![er!] 8604)(return !!er!!))) ((or(flagp wa '!+grgmac)(gettype!> wa)) (progn(doub!> was)(setq ![er!] 3000)(return !!er!!))) (t(progn (cond((flagp was '!+grg)(prog2(doub!> was)(msg!> 8603)))) (setq ![abbr!] (cons wa ![abbr!])) (setq ![newabbr!] wa) (global (ncons wa)) (flag (ncons wa) '!+ivar) (flag (ncons wa) '!+abbr)))))) (return(datr!> lst wa)))) % ---> datr> ... ((atom(car wa))(prog2 (setq w(cons(car wa)(cdr w))) (setq wa(cdr wa)))) (t (prog2 (setq w(cons(cadr wa)(cons(car wa)(cdr w)))) (setq wa(cddr wa))))) (setq wa(reverse wa)) (setq was wa) (setq wa (assocf!> wa ![datl!])) (cond((or(null wa)(pairp(car wa))) (progn(setq ![er!] 6030)(doubl!> was)(return !!er!!)))) (setq wa(car wa)) (return(datr!> w wa)))) % ---> datr> ... % 03.94, 05.96 ... WN - Internal Variable, LST - Text (de datr!> (lst wn) (proc (w wl wr ww) (cond ((null lst) (return nil)) ((setq w (constrp!> wn)) % constrained! (progn (doubo!> wn) (setq ![er!] w) (return !!er!!)))) (setq lst (memlistbr!> '!, lst)) (cond ((eq lst !!er!!) (prog2 (setq ![er!] 2202) (return !!er!!)))) (while!> lst (setq w (seek1!> (car lst) '!=)) (cond((or (null w) (null(car w)) (null(cdr w))) (prog2 (setq ![er!] 2204) (return !!er!!)))) (setq wl (reverse (car w))) (setq wr (cdr w)) (cond((or (not(idp(car wl))) (and (cdr wl) (not(pairp(cadr wl)))) (greaterp (length wl) 2)) (prog2 (setq ![er!] 2204) (return !!er!!)))) (setq ww (cond ((cdr wl) (transi!> wn wl wr)) (t (trans!> wn (car wl) wr)))) (cond ((eq ww !!er!!) (cond (![newabbr!] (forget1!> ![newabbr!]))) (return !!er!!))) (cond ((eq wn '!#!G) (mtype!>)) ((eq wn '!#!G!I) (mitype!>)) ((eq wn '!#!T) (ftype!>)) ((eq wn '!#!D) (fitype!>))) (setq lst (cdr lst)) ))) % Normal Form ... % 11.94 ... WN Internal var, WL Left, WR Right (de trans!> (wn wl wr) (prog (wi wc) (cond((and (flagp wn '!+equ) (not(memq '!= wr))) (prog2 (setq ![er!] 2208) (return !!er!!)))) (setq wi (get wn '!=idxl)) % index types list (setq wc (transn!> wl wn wi)) % id = ... translation (cond ((eq wc !!er!!) (return !!er!!))) (return (trans0!> wn wc wr)) )) % 11.94 ... WN Internal var, WL indices, WR Right (de trans0!> (wn wc wr) (prog (wss wi wt we wnn) (setq wss (get wn '!=sidxl)) % symmetry list (setq wi (get wn '!=idxl)) % index types list (setq wt (gettype!> wn)) % expression type (cond((null(eval wn)) % prepare space for storing if not exists (prog2(setq wnn t)(set wn (mkbox!> wn))))) (cond (wc (setq wc (syaidx!> wc wss)))) (cond((and wi (null wc)) (return nil))) (setq wr (cschtr!> wr (flagp wn '!+equ))) (setq ![extvar!] nil) (cond((flagp wn '!+equ) (setq we (translateeq!> wr))) % expr translation (t (setq we (translate!> wr)))) (cond ((equal we !!er!!) (cond (wnn (set wn nil))) (return !!er!!)) ((null we) (cond ((null wt) (put wn '!=type 0)))) ((null wt) (setq wt (car we)) (put wn '!=type wt)) ((not(eqn wt (car we))) % incorrect expression type (cond(wnn(set wn nil))) (expects!> wt) (setq ![er!] 2100) (return !!er!!))) % storing of the data component (putel!> (cond(we(cdr we))(t nil)) (eval wn) (cond(wc wc)(t '(0)))) (return t))) % Perform Sign Changing [CS] and Complex Conjugations [CH] ... (de cschtr!> (wr we) (cond((and ![ch!] ![cs!]) (cond (we (progn (setq wr (seek1!> wr '!=)) (list (csch0!>(reverse(car wr))) (csch0!>(cdr wr))))) (t (csch0!> wr)))) (![cs!] (cond (we (progn (setq wr (seek1!> wr '!=)) (list (cs0!>(reverse(car wr))) (cs0!>(cdr wr))))) (t (cs0!> wr)))) (![ch!] (cond (we (progn (setq wr (seek1!> wr '!=)) (list (ch0!>(reverse(car wr))) (ch0!>(cdr wr))))) (t (ch0!> wr)))) (t wr))) % aux functions ... (de cs0!> (w) (list2 '!- (ncons w))) (de ch0!> (w) (list2 '!~ (ncons w))) (de csch0!> (w) (list '!- '!~ (ncons w))) % Message about wrong type of the expression ... (de expects!> (wt) (progn (cond((eqn wt 0) (prin2 "Algebraic expression")) ((eqn wt -1) (prin2 "Vector")) (t (prin2 wt) (prin2 "-form"))) (prin2 " is expected.") (terpri))) % w - id = ... wn - internal variable wi - index types list (de transn!> (w wn wi) (prog(wa wb wc wd wl wf) (setq wb(explode2 w)) (setq wa(cdr(explode2 wn))) (setq wf(selid!> wb nil)) % wb - id wf - indices (cond((not(equal wb wa)) (progn(expid!> wa)(setq ![er!] 2101)(return !!er!!)))) (cond((null wf)(cond((null wi)(return nil)) % scalar data ... (t(prog2(setq ![er!] 2102)(return !!er!!)))))) (setq wf (mapcar wf 'digorerr!>)) (cond((memq !!er!! wf) (prog2(setq ![er!] 2102)(return !!er!!)))) (cond ((eq (goodidxl!> wf wi) !!er!!) (return !!er!!))) (return wf))) % aux fun ... (de digorerr!> (w) (cond((digit w)(compress (ncons w))) (t !!er!!))) % w is expected ... (de expid!> (w) (progn (mapc w 'prin2) (prin2 " is expected.") (terpri))) % Verifies correct range of indices ... (de goodidxl!> (wb wi) (cond ((and (null wb) (null wi)) t) ((null wb) (setq ![er!] 21023) !!er!!) ((null wi) (setq ![er!] 21024) !!er!!) ((lessp (dimid!>(car wi) )(car wb)) (setq ![er!] 21022) !!er!!) (t (goodidxl!> (cdr wb) (cdr wi))))) % Verifies correct range the index ... (de goodid1!> (w wt) (cond((lessp(dimid!> wt)w) nil) (t t))) % Tensorial Form ... % WN - Internal Variable WL - Left WR - Right (de transi!> (wn wl wr) (proc (wt wi w wll wa wii) (setq wll(cons nil(get wn '!=idxl))) (setq wt (car wl)) (setq wi (cadr wl)) (setq wt (explode2 wt)) (cond((not(equal wt(cdr(explode2 wn)))) (progn(expid!>(cdr(explode2 wn))) (setq ![er!] 2101)(return !!er!!)))) (setq wi(memlist!> '!, wi)) (cond((eq wi !!er!!) (prog2(setq ![er!] 2202)(return !!er!!)))) (cond((not(eqn(length wi)(length(get wn '!=idxl)))) (prog2 (cond (![newabbr!] (doubo!> ![newabbr!]) (setq ![er!] 22071)) (t (setq ![er!] 2207))) (return !!er!!)))) (setq wii nil) (while!> wi (setq wii (cons (prog2 (setq wll(cdr wll)) (sumintr!> (car wi) (car wll))) wii)) (setq wi (cdr wi))) (setq wi (reverse wii)) % here now the list of indices in lhs (cond((memq !!er!! wi)(return !!er!!))) (setq ![extvar!] (mkextvars!> wi)) % prepare list of ext. vars. (cond((memq !!er!! ![extvar!]) (return !!er!!)) ((null ![extvar!]) % only numerical indices ... (return (trans0!> wn (mklitind!> wi) wr)))) (cond((flagp wn '!+equ)(setq wr (pretranseq!> wr))) % pre translation (t (setq wr (pretrans!> wr)))) (cond((eq wr !!er!!)(return !!er!!))) (setq ![idl!] wi) (setq ![texpr!] wr) (setq w(cond((null(eval wn))(mkbox!> wn)) (t(eval wn)))) (setq w (errorset!> (list 'allcoll!> (list 'quote w) (list 'quote wn) nil (list 'quote (get wn '!=idxl)) (list 'function 'transel!>) ) ![erst1!] ![erst2!] )) (remsubindex!> ![idl!])(setq ![texpr!] nil) (cond((atom w)(prog2(setq ![er!] w)(return !!er!!))) (t(set wn(car w)))) (return t))) % Prepare List of Ext. vars ... (de mkextvars!> (lst) (cond((null lst) nil) ((atom(car lst))(consmemer!>(car lst)(mkextvars!>(cdr lst)))) (t(appmemer!>(car lst)(mkextvars!>(cdr lst)))))) (de appmemer!> (wa wb) (prog2 (while!> wa (setq wb (consmemer!> (car wa)wb)) (setq wa (cdr wa))) wb)) (de consmemer!> (w lst) (cond((and(idp w)(memq w lst)) (prog2(setq ![er!] 2205)(cons !!er!! lst))) ((idp w) (cons w lst)) (t lst))) (de mklitind!> (lst) (mapcar lst 'mklitind1!>)) (de mklitind1!> (w) (cond ((numberp w) w) (t (eval(cons 'plus w))))) % Translate the element ... (de transel!> (lst wi wn) (cond((and (syaidxp!> wi (get wn '!=sidxl)) (coidxp!> wi ![idl!]) ) (progn (putindex!> wi) (cond((flagp wn '!+equ)(setq lst(unievaluateeq!> ![texpr!]))) (t (setq lst(unievaluate!> ![texpr!])))) (remsubindex!> ![idl!]) (cond((null(gettype!> wn))(put wn '!=type (car lst)))) (cond((and lst(not(eqn(car lst)(gettype!> wn)))) (prog2 (expects!>(gettype!> wn)) (err!> 2100)))) (cond(lst(cdr lst)) (t nil)))) (t lst))) % Summed index treatment if exists ... (de sumintr!> (w wl) (cond((atom wl) % tetrad or holonomic index (cond((or(cdr w)(not(or(idp(car w))(numberp(car w))))) (prog2(setq ![er!] 2206) !!er!!)) ((and(numberp(car w))(not(goodid1!>(car w)wl))) (prog2(setq ![er!] 21022) !!er!!)) (t(car w)))) ((null(cdr w)) % spinor or enumerating index (cond((not(or(idp(car w))(numberp(car w)))) (prog2(setq ![er!] 2206) !!er!!)) ((and(numberp(car w))(not(goodid1!>(car w)wl))) (prog2(setq ![er!] 21022) !!er!!)) (t(car w)))) (t(prog nil % summed spinor index (setq w(memlist!> '!+ w)) (cond((or(eq w !!er!!)(not(eqn(length w)(dimid!> wl)))) (prog2(setq ![er!] 2206) (return !!er!!)))) (setq w (mapcar w 'auxfun1!>)) (cond((memq !!er!! w) (prog2(setq ![er!] 2206)(return !!er!!))) (t(return w))))))) (de auxfun1!> (w) (cond((or (cdr w) (and (not(idp(car w))) (not(numberp(car w))))) !!er!!) ((and (numberp(car w)) (greaterp(car w)1)) !!er!!) (t(car w)))) % Compares current list of indices WI with concrete values in WL ... (de coidxp!> (wi wl) (cond((and(null wi)(null wl)) t) (t(and (coidxp1!> (car wi)(car wl)) (coidxp!> (cdr wi)(cdr wl)))))) (de coidxp1!> (wi wl) (cond((numberp wl) (cond((eqn wi wl)t) (t nil))) ((pairp wl) (prog2 (setq wl (putindex2!> wl)) (cond((or (lessp wi (car wl)) (lessp(length(cdr wl))(difference wi (car wl)))) nil) (t t)))) (t t))) % Preparing Ext. vars for translator ... (de putindex!> (wi) (proc(w) (setq w ![idl!]) (while!> wi (cond((numberp(car w)) nil) ((atom(car w))(put (car w) '!=subind (car wi))) (t(putindex1!> (car w) (car wi)))) (setq w(cdr w)) (setq wi(cdr wi))))) (de putindex1!> (wa wb) (proc nil (setq wa (putindex2!> wa)) (setq wb (difference wb (car wa))) (setq wa (cdr wa)) (setq wb (add1 wb)) (while!> wa (put (car wa) '!=subind (cond((lessp(length wa)wb) 1) (t 0))) (setq wa(cdr wa))))) (de putindex2!> (w) (proc (wn wr) (setq wn 0) (while!> w (cond ((numberp(car w)) (setq wn (plus wn (car w)))) (t(setq wr (cons(car w)wr)))) (setq w (cdr w))) (return(cons wn (reversip wr))))) % Removing Ext. vars. after translation ... (de remsubindex!> (w) (cond((null w) nil) ((pairp(car w)) (prog2 (remsubindex!>(car w)) (remsubindex!>(cdr w)))) ((idp(car w))(prog2 (remprop (car w) '!=subind) (remsubindex!>(cdr w)))) (t(remsubindex!>(cdr w))))) %----- Macro Functions. 08.01.91, 05.96 ------------------------------- % Solution ... (de getsoln!> (lst) (cond((cdr lst) (prog2(doub!> '!S!o!l)(err!> 2105))) ((null(car lst)) (getsoln1!> 0)) ((not(zerop(caar lst))) (prog2(doub!> '!S!o!l)(err!> 2023))) ((not(numberp(cdar lst))) (prog2(doub!> '!S!o!l)(err!> 2106))) (t(getsoln1!> (cdar lst))))) (de getsoln1!> (wn) (cond((null ![sol!]) (err!> 2113)) (t(proc (w wnn) (setq wnn wn) (setq w ![sol!]) (while!> (and w (not(zerop wn))) (setq w (cdr w)) (setq wn (sub1 wn))) (cond((or(null w)(not(zerop wn))) (prog2 (doub!> wnn) (err!> 2114)))) (return(cona1!> 0 (get1equ!>(car w)))))))) %----- Classify command 06.96 ------------------------------------------ (de classify!> (lst) (proc (w wc wi) (cond ((null lst) (return nil))) (cond ((eq (setq w (dgood!> lst)) !!er!!) (return !!er!!))) (setq w (altdata!> w)) (while!> w (setq wc (car w)) (cond ((not(zerop(get wc '!=type))) (setq ![er!] 9100) (doubo!> wc) (return !!er!!)) ((null(eval wc)) (abse!> wc) (go lab))) (setq wi (get wc '!=idxl)) (cond ((null wi) (cmsg!> wc) (scaltype!> (eval wc))) ((eqn (length wi) 1) (cond ((eqn (dimid!> (car wi)) 2) (cmsg!> wc) (emtype!> (eval wc))) ((eqn (dimid!> (car wi)) 4) (cmsg!> wc) (petrov!> (eval wc))) (t (setq ![er!] 9101) (doubo!> wc) (return !!er!!)))) ((eqn (length wi) 2) (cond ((and (eqn (dimid!> (car wi)) 2) (eqn (dimid!> (cadr wi)) 2)) (cmsg!> wc) (riccisclass!> (eval wc))) ((and (eqn (dimid!> (car wi)) 1) (eqn (dimid!> (cadr wi)) 1)) (cmsg!> wc) (vectype!> (eval wc))) (t (setq ![er!] 9101) (doubo!> wc) (return !!er!!)))) (t (setq ![er!] 9101) (doubo!> wc) (return !!er!!))) lab (setq w (cdr w))))) (de cmsg!> (w) (progn (gprinreset!>) (gprils!> '("Classifying")) (pn0!> w) (gprils0!> '(":")) (gterpri!>))) %----- Petrov classification. 08.01.91, 06.96 -------------------------- (de petrov!> (lst) (prog (w0 w1 w2 w3 w4 wc wr) (cond (!*trace (prin2 "Petrov classification ...") (terpri) (prin2 " Using algorithm by F.W.Letniowski & R.G.McLenaghan") (terpri) (prin2 " Gen. Rel. Grav. 20 (1988) 463-483") (terpri))) (setq w0 (aeval (nz!> (getel1!> lst 0 )))) (setq w1 (aeval (nz!> (getel1!> lst 1 )))) (setq w2 (aeval (nz!> (getel1!> lst 2 )))) (setq w3 (aeval (nz!> (getel1!> lst 3 )))) (setq w4 (aeval (nz!> (getel1!> lst 4 )))) (setq wc (plus (times 16 (to1!> w0)) (times 8 (to1!> w1)) (times 4 (to1!> w2)) (times 2 (to1!> w3)) (times 1 (to1!> w4)) )) (cond (!*trace (prin2 "Case ") (prin2 wc) (prin2 ": ") (foreach!> x in (list w0 w1 w2 w3 w4) do (progn (prin2 " ") (cond ((zerop x) (prin2 0)) (t (prin2 "N"))))) (prin2 " =>") (terpri) )) (setq wr (cond ((eqn wc 0) (finis!> "0" )) ((eqn wc 1) (finis!> "N" )) ((eqn wc 2) (finis!> "III" )) ((eqn wc 3) (finis!> "III" )) ((eqn wc 4) (finis!> "D" )) ((eqn wc 5) (finis!> "II" )) ((eqn wc 6) (finis!> "II" )) ((eqn wc 7) (alter!> (list 'plus (list 'times 2 w3 w3) (list 'times -3 w2 w4)) "2*W3^2-3*W2*W4" "D" "II")) ((eqn wc 8) (finis!> "III" )) ((eqn wc 9) (finis!> "I" )) ((eqn wc 10) (finis!> "I" )) ((eqn wc 11) (alter!> (list 'plus (list 'times 27 w4 w4 w1) (list 'times 64 w3 w3 w3)) "27*W4^2*W1+64*W3^3" "II" "I")) ((eqn wc 12) (finis!> "II" )) ((eqn wc 13) (alter!> (list 'plus (list 'times w1 w1 w4) (list 'times 2 w2 w2 w2)) "W1^2*W4+2*W2^3" "II" "I")) ((eqn wc 14) (alter!> (list 'plus (list 'times 9 w2 w2) (list 'times -16 w1 w3)) "9*W2^2-16*W1*W3" "II" "I")) ((eqn wc 15) (scase15!> w0 w1 w2 w3 w4)) ((eqn wc 16) (finis!> "N" )) ((eqn wc 17) (finis!> "I" )) ((eqn wc 18) (finis!> "I" )) ((eqn wc 19) (alter!> (list 'plus (list 'times w0 w4 w4 w4) (list 'times -27 w3 w3 w3 w3)) "W0*W4^3-27*W3^4" "II" "I")) ((eqn wc 20) (finis!> "II" )) ((eqn wc 21) (alter!> (list 'plus (list 'times 9 w2 w2) (list 'times -1 w0 w4)) "9*W2^2-W0*W4" "D" "I")) ((eqn wc 22) (alter!> (list 'plus (list 'times w3 w3 w0) (list 'times 2 w2 w2 w2)) "W3^2*W0+2*W2^3" "II" "I")) ((eqn wc 23) (scase23!> w0 w1 w2 w3 w4)) ((eqn wc 24) (finis!> "III" )) ((eqn wc 25) (alter!> (list 'plus (list 'times w4 w0 w0 w0) (list 'times -27 w1 w1 w1 w1)) "W4*W0^3-27*W1^4" "II" "I")) ((eqn wc 26) (alter!> (list 'plus (list 'times 27 w0 w0 w3) (list 'times 64 w1 w1 w1)) "27*W0^2*W3+64*W1^3" "II" "I")) ((eqn wc 27) (scase27!> w0 w1 w2 w3 w4)) ((eqn wc 28) (alter!> (list 'plus (list 'times 2 w1 w1) (list 'times -3 w2 w0)) "2*W1^2-3*W2*W0" "D" "II")) ((eqn wc 29) (scase29!> w0 w1 w2 w3 w4)) ((eqn wc 30) (scase30!> w0 w1 w2 w3 w4)) ((eqn wc 31) (scase31!> w0 w1 w2 w3 w4)) )) (return wr))) (de to1!> (w) (cond ((zerop w) 0) (t 1))) (de finis!> (w) (progn (prin2 "Petrov type is ") (prin2 w) (prin2 ".") (terpri) w)) (de alter!> (w wp w0 w1) (prog2 (setq w (aeval w)) (cond ((zerop w) (iszero!> wp 2) (finis!> w0)) (t (isnonzero!> wp 2 w) (finis!> w1))))) (de iszero!> (wp wl) (cond (!*trace (spaces wl) (prin2 wp) (prin2 " = 0 =>") (terpri)))) (de isnonzero!> (wp wl w) (cond (!*trace (spaces wl) (prin2 wp) (cond (!*showexpr (prin2 " = ") (terpri) (algpri!> " ") (algpri!> w) (algterpri!>) (spaces (sub1 wl)))) (prin2 " is nonzero =>") (terpri)))) (de zt!> (we wp wl) (cond ((zerop we) (prog2 (iszero!> wp wl) t)) (t (prog2 (isnonzero!> wp wl we) nil)))) (de scase15!> (w0 w1 w2 w3 w4) (prog (wi wf1 wf2 wdh) (setq wi (aeval (list 'plus (list 'times 3 w2 w2) (list 'times -4 w1 w3)))) (setq wf1 (aeval (list 'plus (list 'times 2 w2 w3) (list 'times -3 w1 w4)))) (cond ((zt!> wi "I=3*W2^2-4*W1*W3" 2) (cond ((zt!> wf1 "F1=2*W2*W3-3*W1*W4" 4) (return(finis!> "III"))) (t (return(finis!> "I"))))) (t (cond ((zt!> wf1 "F1=2*W2*W3-3*W1*W4" 4) (return(finis!> "I"))) (t (setq wf2 (aeval (list 'plus (list 'times 9 w2 w4) (list 'times -8 w3 w3)))) (cond ((zt!> wf2 "F2=9*W2*W4-8*W3^2" 6) (return(finis!> "I"))) (t (setq wdh (aeval (list 'plus (list 'times 3 wf1 wf1) (list 'times 2 wi wf2)))) (cond ((zt!> wdh "D^=3*F1^2+2*I*F2" 8) (return(finis!> "II"))) (t (return(finis!> "I")))))))))))) (de scase30!> (w0 w1 w2 w3 w4) (prog (wi wf1 wf2 wdh) (setq wi (aeval (list 'plus (list 'times 3 w2 w2) (list 'times -4 w1 w3)))) (setq wf1 (aeval (list 'plus (list 'times 2 w2 w1) (list 'times -3 w3 w0)))) (cond ((zt!> wi "I=3*W2^2-4*W1*W3" 2) (cond ((zt!> wf1 "F1=2*W2*W1-3*W3*W0" 4) (return(finis!> "III"))) (t (return(finis!> "I"))))) (t (cond ((zt!> wf1 "F1=2*W2*W1-3*W3*W0" 4) (return(finis!> "I"))) (t (setq wf2 (aeval (list 'plus (list 'times 9 w2 w0) (list 'times -8 w1 w1)))) (cond ((zt!> wf2 "F2=9*W2*W0-8*W1^2" 6) (return(finis!> "I"))) (t (setq wdh (aeval (list 'plus (list 'times 3 wf1 wf1) (list 'times 2 wi wf2)))) (cond ((zt!> wdh "D^=3*F1^2+2*I*F2" 8) (return(finis!> "II"))) (t (return(finis!> "I")))))))))))) (de scase23!> (w0 w1 w2 w3 w4) (prog (wi wjh wf3 wdt) (setq wi (aeval (list 'plus (list 'times w0 w4) (list 'times 3 w2 w2)))) (setq wjh (aeval (list 'plus (list 'times 4 w2 w4) (list 'times -3 w3 w3)))) (cond ((zt!> wi "I=W0*W4+3*W2^2" 2) (cond ((zt!> wjh "J^=4*W2*W4-3*W3^2" 4) (return(finis!> "III"))) (t (return(finis!> "I"))))) (t (cond ((zt!> wjh "J^=4*W2*W4-3*W3^2" 4) (return(finis!> "I"))) (t (setq wf3 (aeval (list 'plus (list 'times w0 wjh) (list 'times -2 w2 wi )))) (cond ((zt!> wf3 "F3=W0*J^-2*W2*I" 6) (return(finis!> "I"))) (t (setq wdt (aeval (list 'plus (list 'times w4 wi wi) (list 'times -3 wjh wf3)))) (cond ((zt!> wdt "D~=W4*I^2-3*J^*F3" 8) (return(finis!> "II"))) (t (return(finis!> "I")))))))))))) (de scase29!> (w0 w1 w2 w3 w4) (prog (wi wjh wf3 wdt) (setq wi (aeval (list 'plus (list 'times w0 w4) (list 'times 3 w2 w2)))) (setq wjh (aeval (list 'plus (list 'times 4 w2 w0) (list 'times -3 w1 w1)))) (cond ((zt!> wi "I=W0*W4+3*W2^2" 2) (cond ((zt!> wjh "J^=4*W2*W0-3*W1^2" 4) (return(finis!> "III"))) (t (return(finis!> "I"))))) (t (cond ((zt!> wjh "J^=4*W2*W0-3*W1^2" 4) (return(finis!> "I"))) (t (setq wf3 (aeval (list 'plus (list 'times w4 wjh) (list 'times -2 w2 wi )))) (cond ((zt!> wf3 "F3=W4*J^-2*W2*I" 6) (return(finis!> "I"))) (t (setq wdt (aeval (list 'plus (list 'times w0 wi wi) (list 'times -3 wjh wf3)))) (cond ((zt!> wdt "D~=W0*I^2-3*J^*F3" 8) (return(finis!> "II"))) (t (return(finis!> "I")))))))))))) (de scase27!> (w0 w1 w2 w3 w4) (prog (wv wu ww wi wj wd) (setq wv (aeval (list 'plus (list 'times w0 w3 w3) (list 'times -1 w1 w1 w4)))) (cond ((zt!> wv "V=W0*W3^3-W1^2*W4" 2) (setq wu (aeval (list 'plus (list 'times w0 w4) (list 'times 2 w1 w3)))) (cond ((zt!> wu "U=W0*W4+2*W1*W3" 4) (return(finis!> "D"))) (t (setq ww (aeval (list 'plus (list 'times w0 w4) (list 'times -16 w1 w3)))) (cond ((zt!> ww "W=W0*W4-16*W1*W3" 6) (return(finis!> "II"))) (t (return(finis!> "I"))))))) (t (setq wi (aeval (list 'plus (list 'times w0 w4) (list 'times -4 w1 w3)))) (setq wj (aeval (list 'plus (list 'times -1 w0 w3 w3) (list 'times -1 w1 w1 w4)))) (cond ((ZT!> WI "I=W0*W4-4*W1*W3" 4) (cond ((zt!> wj "J=-W0*W3^2-W1^2*W4" 6) (return(finis!> "III"))) (t (return(finis!> "I"))))) ((zt!> wj "J=-W0*W3^2-W1^2*W4" 6) (return(finis!> "I"))) (t (setq wd (aeval (list 'plus (list 'times wi wi wi) (list 'times -27 wj wj )))) (cond ((zt!> wd "D=I^3-27*J^2" 8) (return(finis!> "II"))) (t (return(finis!> "I")))))))))) (de scase31!> (w0 w1 w2 w3 w4) (prog (wh wf we wa wi wq wj wg wz wss wd) (setq wh (aeval (list 'plus (list 'times w0 w2 ) (list 'times -1 w1 w1 )))) (cond ((zt!> wh "H=W0*W2-W1^2" 2) (setq wf (aeval (list 'plus (list 'times w0 w3 ) (list 'times -1 w1 w2 )))) (setq we (aeval (list 'plus (list 'times w0 w4 ) (list 'times -1 w2 w2 )))) (cond ((zt!> wf "F=W0*W3-W1*W2" 4) (cond ((zt!> we "E=W0*W4-W2^2" 6) (return(finis!> "N"))) (t (return(finis!> "I"))))) ((zt!> we "E=W0*W4-W2^2" 6) (setq wq (aeval (list 'plus (list 'times 37 w2 w2 ) (list 'times 27 w1 w3 )))) (cond ((zt!> wq "Q=37*W2^2+27*W1*W3" 8) (return(finis!> "II"))) (t (return(finis!> "I"))))) (t (setq wa (aeval (list 'plus (list 'times w1 w3 ) (list 'times -1 w2 w2 )))) (setq wi (aeval (list 'plus we (list 'times -4 wa )))) (cond ((zt!> wi "A=W1*W3-W2^2; I=E-4*A" 8) (return(finis!> "I"))) (t (setq wj (aeval (list 'plus (list 'times w4 wh ) (list 'times -1 w3 wf ) (list 'times w2 wa )))) (setq wd (aeval (list 'plus (list 'times wi wi wi ) (list 'times -27 wj wj )))) (cond ((zt!> wd "J=W4*H-W3*F+W2*A; D=I^3-27*J^2" 10) (return(finis!> "II"))) (t (return(finis!> "I"))))))))) (t (setq wf (aeval (list 'plus (list 'times w0 w3 ) (list 'times -1 w1 w2 )))) (setq we (aeval (list 'plus (list 'times w0 w4 ) (list 'times -1 w2 w2 )))) (setq wa (aeval (list 'plus (list 'times w1 w3 ) (list 'times -1 w2 w2 )))) (setq wi (aeval (list 'plus we (list 'times -4 wa )))) (cond ((zt!> wi "E=W0*W4-W2^2; A=W1*W3-W2^2; I=E-4*A" 4) (setq wf (aeval (list 'plus (list 'times w0 w3 ) (list 'times -1 w1 w2 )))) (setq wj (aeval (list 'plus (list 'times w4 wh ) (list 'times -1 w3 wf ) (list 'times w2 wa )))) (cond ((zt!> wj "F=W0*W3-W1*W2; J=W4*H-W3*F+W2*A" 6) (return(finis!> "III"))) (t (return(finis!> "I"))))) (t (setq wf (aeval (list 'plus (list 'times w0 w3 ) (list 'times -1 w1 w2 )))) (setq wg (aeval (list 'plus (list 'times w0 wf ) (list 'times -2 w1 wh )))) (cond ((zt!> wg "G=W0*F-2*W1*H" 6) (setq wz (aeval (list 'plus (list 'times w0 w0 wi ) (list 'times -12 wh wh )))) (cond ((zt!> WZ "Z=W0^2*I-12*H^2" 8) (return(finis!> "D"))) (t (setq wss (aeval (list 'plus (list 'times w0 w0 wi ) (list 'times -3 wh wh )))) (cond ((zt!> wss "S=W0^2*I-3*H^2" 10) (return(finis!> "II"))) (t (return(finis!> "I"))))))) (t (setq wj (aeval (list 'plus (list 'times w4 wh ) (list 'times -1 w3 wf ) (list 'times w2 wa )))) (cond ((zt!> wj "J=W4*H-W3*F+W2*A" 8) (return(finis!> "I"))) (t (setq wd (aeval (list 'plus (list 'times wi wi wi ) (list 'times -27 wj wj )))) (cond ((zt!> wd "D=I^3-27*J^3" 10) (return(finis!> "II"))) (t (return(finis!> "I")))))))))))))) %------- EM Type 06.96 ---------------------------------------------------- (de emtype!> (lst) (prog (w0 w1 w2 wc wr wd) (cond (!*trace (prin2 "EM strength classification ...") (terpri))) (setq w0 (aeval (nz!> (getel1!> lst 0 )))) (setq w1 (aeval (nz!> (getel1!> lst 1 )))) (setq w2 (aeval (nz!> (getel1!> lst 2 )))) (setq wc (plus (times 4 (to1!> w0)) (times 2 (to1!> w1)) (times 1 (to1!> w2)) )) (cond (!*trace (prin2 "Case ") (prin2 wc) (prin2 ": ") (foreach!> x in (list w0 w1 w2) do (progn (prin2 " ") (cond ((zerop x) (prin2 0)) (t (prin2 "N"))))) (prin2 " =>") (terpri) )) (setq wr (cond ((eqn wc 0) (emfinis!> "0")) ((eqn wc 1) (emfinis!> "N")) ((eqn wc 2) (emfinis!> "I")) ((eqn wc 3) (emfinis!> "I")) ((eqn wc 4) (emfinis!> "N")) ((eqn wc 5) (emfinis!> "I")) ((eqn wc 6) (emfinis!> "I")) ((eqn wc 7) (setq wd (aeval (list 'plus (list 'times w0 w2) (list 'times -1 w1 w1)))) (cond ((zt!> wd "D=F0*F2-F1^2" 2) (emfinis!> "N")) (t (emfinis!> "I")))))) (return wr))) (de emfinis!> (w) (progn (prin2 "EM type is ") (prin2 w) (prin2 ".") (terpri) w)) %------- Ricci spinor classification 06.96 -------------------------------- (de riccisclass!> (lst) (prog (f00 f01 f02 f11 f12 f22 w0 w1 w2 w3 w4 wc wr wpp wi6 ww wq ws1 ws2 ws3 ws4 ws5 ws6 ws7 wip wi7) (cond (!*trace (prin2 "Ricci Spinor classification ...") (terpri) (prin2 " Using algorithm by G.C.Joly, M.A.H.McCallum & W.Seixas") (terpri) (prin2 " Class. Quantum Grav. 7 (1990) 541-556") (terpri) (prin2 " Class. Quantum Grav. 8 (1991) 1577-1585") (terpri))) (setq f00 (aeval (nz!> (getel2!> lst 0 0)))) (setq f01 (aeval (nz!> (getel2!> lst 0 1)))) (setq f02 (aeval (nz!> (getel2!> lst 0 2)))) (setq f11 (aeval (nz!> (getel2!> lst 1 1)))) (setq f12 (aeval (nz!> (getel2!> lst 1 2)))) (setq f22 (aeval (nz!> (getel2!> lst 2 2)))) (setq wc (mapcar (list f00 f01 f02 f11 f12 f22) 'to1!>)) (cond (!*trace (prin2 "Case ") (foreach!> x in wc do (prin2 x)) (prin2 " =>") (terpri) )) % Special cases ... (setq wr (cond ((equal wc '(0 0 0 0 0 0)) (rfin!> "0" "[(1111)]")) ((equal wc '(0 0 0 1 0 0)) (rfin!> "D" "[(11)(1,1)]")) ((equal wc '(0 0 1 0 0 0)) (rfin!> "D" "[11(1,1)]")) ((equal wc '(0 0 0 0 0 1)) (rfin!> "0" "[(112)]")) ((equal wc '(1 0 0 0 0 0)) (rfin!> "0" "[(112)]")) ((equal wc '(0 0 0 1 0 1)) (rfin!> "D" "[(11)2]")) ((equal wc '(1 0 0 1 0 0)) (rfin!> "D" "[(11)2]")) ((equal wc '(0 0 1 0 0 1)) (rfin!> "II" "[112]")) ((equal wc '(1 0 1 0 0 0)) (rfin!> "II" "[112]")) ((equal wc '(0 0 0 0 1 0)) (rfin!> "N" "[(13)]")) ((equal wc '(0 1 0 0 0 0)) (rfin!> "N" "[(13)]")) ((equal wc '(0 0 0 1 1 0)) (rfin!> "D" "[(11)2]")) ((equal wc '(0 1 0 1 0 0)) (rfin!> "D" "[(11)2]")) ((equal wc '(0 0 0 0 1 1)) (rfin!> "N" "[(13)]")) ((equal wc '(1 1 0 0 0 0)) (rfin!> "N" "[(13)]")) ((equal wc '(0 1 0 0 0 1)) (rfin!> "I" "[11ZZ~]")) ((equal wc '(1 0 0 0 1 0)) (rfin!> "I" "[11ZZ~]")) )) (cond (wr (return wr))) % General case ... % PP type first ... (setq w0 (aeval(wff!> 0 lst))) (setq w1 (aeval(wff!> 1 lst))) (setq w2 (aeval(wff!> 2 lst))) (setq w3 (aeval(wff!> 3 lst))) (setq w4 (aeval(wff!> 4 lst))) (cond (!*trace (prin2 "Making Petrov-Plebanski (PP) classification ...") (terpri))) (setq wpp (petrov!> (list w0 w1 w2 w3 w4))) % Segre type ... (setq wr (cond ((equal wpp "0" ) (setq ww (aeval (list 'plus (list 'times f11 f11) (list 'times -1 f12 (gfab!> 1 0 lst))))) (cond ((zt!> ww "W=F11'^2-F10'*F12'" 2) (rfin!> wpp "[(112)]")) ((zt!> f00 "F00" 4) (rfin!> wpp "[1(11,1)]")) ((zt!> f22 "F22" 4) (rfin!> wpp "[1(11,1)]")) (t (rfincond!> wpp "[(111),1]" " if W>0 and " "[1(11,1)]" " if W<0")))) ((equal wpp "I" ) (rfincond!> wpp "[111,1]" " if D>0 and " "[11ZZ~]" " if D<0")) ((equal wpp "II" ) (rfin!> wpp "[112]")) ((equal wpp "III") (rfin!> wpp "[13]")) ((equal wpp "N" ) (setq wi6 (aeval (list 'plus (list 'times (gfab!> 0 0 lst) (gfab!> 2 2 lst)) (list 'times 2 (gfab!> 1 1 lst) (gfab!> 1 1 lst)) (list 'times -2 (gfab!> 0 1 lst) (gfab!> 2 1 lst)) (list 'times -2 (gfab!> 1 0 lst) (gfab!> 1 2 lst)) (list 'times (gfab!> 0 2 lst) (gfab!> 2 0 lst))))) (cond ((zt!> wi6 "I6" 2) (rfin!> wpp "[(13)]")) (t (rfin!> wpp "[1(12)]")))) ((equal wpp "D" ) (setq wi6 (aeval (list 'plus (list 'times (gfab!> 0 0 lst) (gfab!> 2 2 lst)) (list 'times 2 (gfab!> 1 1 lst) (gfab!> 1 1 lst)) (list 'times -2 (gfab!> 0 1 lst) (gfab!> 2 1 lst)) (list 'times -2 (gfab!> 1 0 lst) (gfab!> 1 2 lst)) (list 'times (gfab!> 0 2 lst) (gfab!> 2 0 lst))))) (cond ((zt!> wi6 "I6" 2) (rfin!> wpp "[(11)ZZ~]")) (t (setq wip (aeval (list 'plus (list 'times w0 w4) (list 'times -4 w1 w3) (list 'times 3 w2 w2)))) (setq ww (aeval (list 'plus (list 'times f11 f11) (list 'times -1 f12 (gfab!> 1 0 lst))))) (setq wq (aeval (list 'plus wip (list 'times -3 (list 'expt (list 'plus w2 ww) 2))))) (cond ((zt!> wq "Q" 4) (setq ws1 (aeval (list 'plus (list 'times (gfab!> 2 0 lst) (gfab!> 1 2 lst)) (list 'times -1 (gfab!> 1 0 lst) (gfab!> 2 2 lst))))) (setq ws2 (aeval (list 'plus (list 'times (gfab!> 0 0 lst) (gfab!> 2 2 lst)) (list 'times -1 (gfab!> 2 0 lst) (gfab!> 0 2 lst))))) (setq ws3 (aeval (list 'plus (list 'times (gfab!> 1 0 lst) (gfab!> 0 2 lst)) (list 'times -1 (gfab!> 0 0 lst) (gfab!> 1 2 lst))))) (setq ws4 (aeval (list 'plus (list 'times (gfab!> 0 0 lst) (gfab!> 1 1 lst)) (list 'times -1 (gfab!> 1 0 lst) (gfab!> 0 1 lst))))) (setq ws5 (aeval (list 'plus (list 'times (gfab!> 0 1 lst) (gfab!> 1 2 lst)) (list 'times -1 (gfab!> 0 2 lst) (gfab!> 1 1 lst))))) (setq ws6 (aeval (list 'plus (list 'times (gfab!> 1 1 lst) (gfab!> 2 2 lst)) (list 'times -1 (gfab!> 1 2 lst) (gfab!> 2 1 lst))))) (setq wi7 (aeval (list 'plus (list 'times f01 ws1) (list 'times f11 ws2) (list 'times (gfab!> 2 1 lst) ws3)))) (cond ((and (zt!> ws1 "S1" 6) (zt!> ws2 "S2" 6) (zt!> ws3 "S3" 6)) (cond ((and (zt!> ws4 "S4" 6) (zt!> ws5 "S5" 6) (zt!> ws6 "S6" 6)) (rfin!> wpp "[(11)(1,1)]")) (t (rfin!> wpp "[(11)2]")))) ((zt!> wi7 "I7" 6) (rfin!> wpp "[(11)2]")) (t (rfin!> wpp "[11ZZ~]")))) (t (rfincond!> wpp "[(11)ZZ~]" " if S7<0 and " "[(11)1,1] or [11(1,1)]" " if S7>0")))) )))) (return wr))) (de rfin!> (wpp wss) (progn (prin2 "Petrov-Plebanski type is ") (prin2 wpp) (prin2 ".") (terpri) (prin2 "Segre type is ") (prin2 wss) (prin2 ".") (terpri) (cons wpp wss))) (de rfincond!> (wpp wss1 wcc1 wss2 wcc2) (progn (prin2 "PP type is ") (prin2 wpp) (prin2 ".") (terpri) (prin2 "Segre type is ") (prin2 wss1) (prin2 wcc1) (prin2 wss2) (prin2 wcc2) (prin2 ".") (terpri) (cons wpp (cons wss1 wss2)))) (de gfab!> (wa wb lst) (cond ((lessp wb wa) (nz!>(coalg!>(getel2!> lst wb wa)))) (t (nz!> (getel2!> lst wa wb))))) (de ffabsum!> (wa wb lst) (list 'quotient (list 'plus (list 'times (gfab!> wa 0 lst) (gfab!> wb 2 lst)) (list 'times (gfab!> wa 2 lst) (gfab!> wb 0 lst)) (list 'times -2 (gfab!> wa 1 lst) (gfab!> wb 1 lst)) ) 4)) (de wff!> (wa lst) (cond ((eqn wa 0) (ffabsum!> 0 0 lst)) ((eqn wa 1) (list 'quotient (list 'plus (ffabsum!> 0 1 lst) (ffabsum!> 1 0 lst)) 2)) ((eqn wa 2) (list 'quotient (list 'plus (ffabsum!> 0 2 lst) (ffabsum!> 2 0 lst) (list 'times 4 (ffabsum!> 1 1 lst))) 6)) ((eqn wa 3) (list 'quotient (list 'plus (ffabsum!> 1 2 lst) (ffabsum!> 2 1 lst)) 2)) ((eqn wa 4) (ffabsum!> 2 2 lst)) )) %--------- Vector and Scalar classification 06.96 ------------------------- (de scaltype!> (lst) (prog (w) (setq w (aeval(nz!>(car lst)))) (cond ((zerop w) (prin2 "Scalar is 0.") (terpri)) (t (prin2 "Scalar is nonzero.") (terpri))) (return (to1!> w)))) (de vectype!> (lst) (prog (v01 v10 v00 v11 w) (setq v00 (aeval (gfab!> 0 0 lst))) (setq v01 (aeval (gfab!> 0 1 lst))) (setq v10 (aeval (gfab!> 1 0 lst))) (setq v11 (aeval (gfab!> 1 1 lst))) (setq w (aeval (list 'plus (list 'times 2 v01 v10) (list 'times -2 v00 v11)))) (cond ((zt!> w "2*V01'*V10'-2*V00'*V11'" 2) (prin2 "Vector is Null.") (terpri)) (t (prin2 "Vector is Time or Space-like.") (terpri))) (return (to1!> w)))) %=========== End of GRGclass.sl =========================================% |
Added grgcomm.sl version [ed0bfbc361].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 | %==========================================================================% % GRGcomm.sl Main Commands % %==========================================================================% % GRG 3.2 Standard Lisp Source Code (C) 1988-97 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. % %==========================================================================% %---------- Some General Aux Functions ----------------------------------- % Data name -> Internal variables list ... (de dgood!> (lst) (prog (w wa wss) (setq w lst) (cond ((eqs!> lst '(all)) (return(alldata!>)))) % word!!! (setq wss lst) (setq lst (assocf!> lst ![datl!])) (cond ((and (null lst) w (null(cdr w)) (idp(car w))) (progn (setq wa (incomiv!>(explode(car w)))) (cond ((flagp wa '!+ivar) (setq lst (ncons wa))))))) (cond ((null lst) (progn (setq ![er!] 6030) (doubl!> wss) (return !!er!!)))) (setq lst (car lst)) (cond ((atom lst) (setq lst (ncons lst)))) (setq w (constrpl!> lst)) (cond ((eq w !!er!!) (return !!er!!))) (return lst))) % Same but for Write Macro Tensors are alowed ... (de dgoodw!> (lst) (prog (w wa wss) (setq w lst) (cond ((eqs!> lst '(all)) (return(alldata!>)))) % word!!! (setq wss lst) (setq lst (assocf!> lst ![datl!])) (cond ((and (null lst) w (null(cdr w)) (idp(car w))) (progn (setq wa (incomiv!>(explode(car w)))) (cond ((or (flagp wa '!+ivar) (flagp wa '!+macros2)) (setq lst (ncons wa))))))) (cond ((null lst) (progn (setq ![er!] 6030) (doubl!> wss) (return !!er!!)))) (setq lst (car lst)) (cond ((atom lst) (setq lst (ncons lst)))) (setq w (constrpl!> lst)) (cond ((eq w !!er!!) (return !!er!!))) (return lst))) % All existing data variables ... (de alldata!> nil (proc (w lst) (setq lst ![datl!]) (while!> lst (cond ((and (atom(cadar lst)) (eval(cadar lst))) (setq w (cons (cadar lst) w)))) (setq lst (cdr lst))) (setq lst ![abbr!]) (while!> lst (cond ((eval(car lst)) (setq w (cons (car lst) w)))) (setq lst (cdr lst))) (return(reversip w)))) % Data variables list modification in correspondence with flags .. (de altdata!> (w) (cond ((null w) nil) ((atom (car w)) (consmem!> (car w) (altdata!>(cdr w)))) ((eval(caar w)) (appmem!> (cdar w) (altdata!>(cdr w)))) (t (altdata!>(cdr w))))) %----- Commands in `grg.cfg' file --------------------------------------- % Package ... (dm package!> (w) (list 'package0!> (list 'quote (cdr w)))) (de package0!> (w) (prog (ww) (setq ![lower!] (islowercase!>)) lab (cond ((null w) (return nil))) (setq ww (loadpack!> (ncons(car w)) nil)) (cond ((eq ww !!er!!) (prog2 (erm!> ![er!]) (return !!er!!)))) (setq w (cdr w)) (go lab) )) % On ... (dm on!> (w) (list 'on0!> (list 'quote (cdr w)))) (de on0!> (w) (prog (ww) (setq ![lower!] (islowercase!>)) lab (cond((null w)(return nil))) (setq ww (onoff!> (ncons(car w)) t)) (cond((eq ww !!er!!) (prog2 (erm!> ![er!])(return !!er!!)))) (setq w (cdr w)) (go lab) )) % Off ... (dm off!> (w) (list 'off0!> (list 'quote (cdr w)))) (de off0!> (w) (prog (ww) (setq ![lower!] (islowercase!>)) lab (cond((null w)(return nil))) (setq ww (onoff!> (ncons(car w)) nil)) (cond((eq ww !!er!!) (prog2 (erm!> ![er!])(return !!er!!)))) (setq w (cdr w)) (go lab) )) % Signature ... (dm signature!> (w) (list 'signature0!> (list 'quote (cdr w)))) (de signature0!> (w) (proc (wr ww) (setq ww w) (while!> ww (cond ((equal (car ww) '!+) (setq wr (cons 1 wr))) ((equal (car ww) '!-) (setq wr (cons -1 wr))) (t (erm!> 9002) (bye))) (setq ww (cdr ww))) (setq ![sgn!] (reverse wr)) (setq ![dim!] (length ![sgn!])) (cond ((lessp ![dim!] 2) (erm!> 9002) (bye))) (tunedim!>) )) %----- On ...; and Off ...; commands 20.02.94 ----------------------- (de onoff!> (lst bool) (proc (w wc wo ww) (cond ((null lst) (return nil))) (setq w (memlist!> '!, lst)) (cond ((eq w !!er!!) (prog2 (setq ![er!] 1100) (return !!er!!)))) (while!> w (setq wc (car w)) (cond ((or (cdr wc) (not(idp(car wc)))) % bad parameter ... (prog2 (setq ![er!] 1100) (return !!er!!))) ) (setq wc (idtostcase!> (car wc))) (cond ((flagp wc 'switch) % reduce switch ... (progn (setq ww (makeswvar!> wc)) (setq wo (eval ww)) (cond((not(equal wo bool))(prog2 (cond ((iscsl!>) (cond (bool (eval(list 'on (list 'quote (ncons wc))))) (t (eval(list 'off (list 'quote (ncons wc))))))) (t (cond (bool (eval(list '!~on (list 'quote (ncons wc))))) (t (eval(list '!~off (list 'quote (ncons wc)))))))) (onoff1!> wc bool) ))))) % maybe extra grg tuning ... ((flagp wc '!+switch) % grg switch ... (progn (setq ww (makeswvar!> wc)) (setq wo (eval ww)) (cond((not(equal wo bool)) (onoff1!> wc bool) )) )) (t(progn % none of above ... (doub!> wc)(setq ![er!] 6402)(return !!er!!)))) (cond((not(equal wo bool)) (setq ![flaghis!] (cons (cons wc wo) ![flaghis!])))) (setq w (cdr w))))) % On/Off GRG switch with tuning ... (de onoff1!> (w bool) (progn (set (makeswvar!> w) bool) (setq w (get w '!=tuning)) % tuning required ... (cond(w (apply w (list bool)))))) % On/Off GRG switch without tuning ... (de onoff2!> (w bool) (set (makeswvar!> w) bool)) % On/Off GRG switch without tuning but with history ... (de onoff3!> (w bool) (prog (ww wo) (setq ww (makeswvar!> w)) (setq wo (eval ww)) (set ww bool) (setq ![flaghis!] (cons (cons w wo) ![flaghis!])))) % Makes *SWITCH from SWITCH ... (de makeswvar!> (w) (incom!>(cons '!* (explode2 w)))) % Tuning for TORSION ... (de tunetorsion!> (bool) (cond ((and bool (null !*nonmetr)) % Result is Q but N=0 (put '!#!R!I!C '!=sidxl nil) (put '!#!G!T '!=sidxl nil) (put '!#!T!D!I '!=sidxl nil) (put '!#!T!S!F!L '!=sidxl nil) ) ((and bool !*nonmetr) % Result is Q and N (put '!#!R!I!C '!=sidxl nil) (put '!#!G!T '!=sidxl nil) (put '!#!T!D!I '!=sidxl nil) (put '!#!T!S!F!L '!=sidxl nil) ) ((null !*nonmetr) % Result is Q=0 and N=0 (put '!#!R!I!C '!=sidxl '((s 1 2))) (put '!#!G!T '!=sidxl '((s 1 2))) (put '!#!T!D!I '!=sidxl '((s 1 2))) (put '!#!T!S!F!L '!=sidxl '((s 1 2))) ) ((null !*nonmetr) % Result is Q=0 but N (put '!#!R!I!C '!=sidxl nil) (put '!#!G!T '!=sidxl nil) (put '!#!T!D!I '!=sidxl '((s 1 2))) (put '!#!T!S!F!L '!=sidxl '((s 1 2))) ) )) % Tuning for NONMETR ... (de tunenonmetr!> (bool) (cond (bool % Result is N with arbitrary Q (put '!#!R!I!C '!=sidxl nil) (put '!#!G!T '!=sidxl nil) ) (!*torsion % Result is N=0 but Q (put '!#!R!I!C '!=sidxl nil) (put '!#!G!T '!=sidxl nil) ) ((null !*torsion) % Result N=0 and Q=0 (put '!#!R!I!C '!=sidxl '((s 1 2))) (put '!#!G!T '!=sidxl '((s 1 2))) ) )) %----- Stop; command ---------------------------------------------------- (de stop!> nil !!stop!! ) %----- Next; command ---------------------------------------------------- (de next!> nil !!next!! ) %----- Pause; command --------------------------------------------------- (de pause!> nil (proc(w) (cond (![pause!] (return t)) (t (prin2 "Pausing ...") (terpri) (setq ![pause!] t))) (loop!> (setq w (runcom!> nil)) (exitif (or (eq w !!stop!!) (eq w !!next!!)))) (setq ![pause!] nil) (return w))) %----- Inverse ; command ------------------------------------------------ (de invi!> (lst) (prog (wa wb) (cond((null lst)(return nil))) (setq lst (memlist!> '!, lst)) (cond((or (eq lst !!er!!) (not(eqn(length lst)2)) ) (prog2(setq ![er!] 1100)(return !!er!!)))) (setq wa (car lst)) (setq wb (cadr lst)) (cond((or (cdr wa) (cdr wb) (not(idp(car wa))) (not(idp(car wb))) ) (prog2(setq ![er!] 1100)(return !!er!!)))) (setq wa (car wa)) (setq wb (car wb)) (cond((or (and (not(flagp wa '!+fun)) (not(redgood!> wa)) ) (and (not(flagp wb '!+fun)) (not(redgood!> wb)) ) ) (prog2(setq ![er!] 1100)(return !!er!!)))) (put wa 'inverse wb) (put wb 'inverse wa) (return t))) %----- Order, Factor, RemFac commands ----------------------------------- (de orfare!> (lst wt) (proc nil (cond((null lst)(return nil))) (setq lst(memlist!> '!, lst)) (cond((eq lst !!er!!) (prog2 (setq ![er!] 2202) (return !!er!!)))) (setq lst (mapcar lst 'translata!>)) (cond((memq !!er!! lst) (return !!er!!))) (apply wt (list lst)))) %----- Substitutions calls ----------------------------------------------- (de smatch!> nil 'match) (de famatch!> nil (cond ((getd 'match00) 'match00) (t 'match ) )) (de slet!> nil (cond ((and (getd '!~let) (not(iscsl!>))) '!~let) (t 'let ) )) (de falet!> nil (cond ((getd 'let00) 'let00) ((and (getd '!~let) (not(iscsl!>))) '!~let) (t 'let ) )) (de sclear!> nil (cond ((and (getd '!~clear) (not(iscsl!>))) '!~clear) (t 'clear ) )) (de faclear!> nil (cond ((and (getd '!~clear) (not(iscsl!>))) '!~clear) (t 'clear ) )) %----- Clear ; command -------------------------------------------------- (de cleri!> (lst wt) % wt=t clear wt=nil for all clear (proc (w wa wss) (cond ((null lst) (return nil))) (setq lst (memlist!> '!, lst)) (cond ((eq lst !!er!!) (prog2 (setq ![er!] 2202) (return !!er!!)))) (while!> lst (setq wa (translata!>(car lst))) (cond((eq wa !!er!!) (return !!er!!)) ((null wa)(prog2(setq ![er!] 8710)(return !!er!!))) ) (setq w (cons wa w)) (setq lst (cdr lst))) (setq w (reverse w)) (cond ((null wt) % this is for all case returning (clear w) (return (list (faclear!>) (list 'quote w))))) (eval (list (sclear!>) (list 'quote w))) % making (clear w) (while!> w % remembering (setq wss (list (sclear!>) (ncons(car w)))) (setq ![sublist!] (delete wss ![sublist!])) (setq w (cdr w))) (return t))) %----- Let ; and Match ; commands --------------------------------------- (de leti!> (lst wt) (letmatchi!> lst wt t)) (de matchi!> (lst wt) (letmatchi!> lst wt nil)) % WW=T - Let, WW=NIL - Match % WT=T - Execute (Let/Match command), WT=NIL - Form (For All command) (de letmatchi!> (lst wt ww) (proc (w wa wl wr wss) (cond ((null lst) (return nil))) (setq lst (memlist!> '!, lst)) (cond((eq lst !!er!!) (prog2 (setq ![er!] 2202) (return !!er!!)))) (while!> lst (setq wa (seek1!> (car lst) '!=)) (cond ((null wa)(progn (cond((not(eq (caar lst) '!S!o!l)) (prog2(setq ![er!] 8709)(return !!er!!)))) (setq wa (soltra!>(car lst))) (cond((eq wa !!er!!)(return !!er!!))) (setq w (cons wa w)))) ((or(null(car wa))(null(cdr wa))) (prog2(setq ![er!] 8709)(return !!er!!))) (t(progn (setq wl (translata!>(reverse(car wa)))) (setq wr (translate!>(cdr wa))) (cond((or(eq wl !!er!!)(eq wr !!er!!)) (return !!er!!)) ((null wl) (prog2(setq ![er!] 8710)(return !!er!!))) ((and wr(not(zerop(car wr)))) (prog2(setq ![er!] 8711)(return !!er!!)))) (setq w (cons (list 'equal wl (cond(wr(cdr wr))(t 0))) w))))) (setq lst (cdr lst))) (setq w (reverse w)) (cond((null wt) % for all case - returning (return (list (cond (ww (falet!>)) (t (famatch!>))) (list 'quote w))))) % let/match case - executing (cond (ww (eval (list (slet!>) (list 'quote w)))) (t (eval (list (smatch!>) (list 'quote w))))) (while!> w % remembering (setq wss (list (sclear!>) (ncons(cadar w)))) (setq ![sublist!] (cons wss (delete wss ![sublist!]))) (setq w (cdr w))) (return t))) % Solution Translation ... (de soltra!> (w) (cond((or (null(setq w (cdr w))) (cdr w) (atom(setq w (car w))) (not(numberp(setq w (car w)))) ) (progn (doub!> '!S!o!l) (setq ![er!] 2020) !!er!!)) (t(soltra1!> w)))) (de soltra1!> (wn) (cond((null ![sol!]) (prog2 (setq ![er!] 2113) !!er!!)) (t(proc (w wnn) (setq wnn wn) (setq w ![sol!]) (while!> (and w (not(zerop wn))) (setq w (cdr w)) (setq wn (sub1 wn))) (cond ((or(null w)(not(zerop wn))) (progn(doub!> wnn)(setq ![er!] 2114)(return !!er!!))) ((null(car w)) (progn(setq ![er!] 2115)(return !!er!!)))) (return(mapcar (car w) 'nz!>)))))) %----- For ...; commands ------------------------------------------------ (de forinstrs!> (lst) (cond ((null lst) nil) ((eqs!> (car lst) 'all) (foralli!> (cdr lst))) % word!!! for all ... ((memqs!> 'print lst) (proc (w) % word!!! for...print... (while!> (not(eqs!> (car lst) 'print)) % word!!! (setq w (cons(car lst)w))(setq lst(cdr lst))) (cond((null(cdr lst)) (prog2(setq ![er!] 6042)(return !!er!!)))) (return(printi!>(append (cdr lst) (cons 'for % word!!! (reverse w))))))) (t(prog2(setq ![er!] 6042) !!er!!)))) %----- For All...; command ---------------------------------------------- (de foralli!> (lst) (proc (w wt wa wss w1 w2 w3) (cond((null lst)(return nil)) ((memqs!> 'let lst)(setq wt 'let)) % word!!! ((memqs!> 'match lst)(setq wt 'match)) % word!!! ((memqs!> 'clear lst)(setq wt 'clear)) % word!!! (t(prog2(setq ![er!] 8712)(return !!er!!)))) (while!> lst (exitif (eqs!> wt (car lst))) (setq wa(cons(car lst)wa)) (setq lst(cdr lst))) (cond((or(null lst)(null(cdr lst))(null wa)) (prog2(setq ![er!] 8713)(return !!er!!)))) (setq lst (cdr lst)) (cond((memqs!> 'such wa)(progn % word!!! (setq wa (reverse wa)) (setq w3 (seek1q!> wa 'such)) % word!!! (cond((or (null(car w3)) (null(cdr w3)) (null(cddr w3)) (not(eqs!> (cadr w3) 'that))) % word!!! (prog2(setq ![er!] 8712)(return !!er!!)))) (setq wa (car w3)) (setq w3 (cddr w3)) ))) (setq wa(memlist!> '!, wa)) (cond((eq wa !!er!!) (prog2 (setq ![er!] 2202) (return !!er!!)))) (while!> wa (cond((or(cdar wa)(not(idp(caar wa)))) (prog2 (setq ![er!] 8714) (return !!er!!)))) (setq w (cons(caar wa)w)) (setq wa (cdr wa))) (setq w1 w) (while!> w1 (cond((not(flagp (car w1) '!+grgvar)) (setq w2 (cons(car w1)w2)))) (setq w1 (cdr w1))) (flag w '!+grgvar) (cond((null w3)(setq w3 t)) (t(progn (setq w3 (booltra!> w3)) (cond((eq w3 !!er!!)(return !!er!!)))))) (setq wa (cond((eq wt 'let) (leti!> lst nil)) % not words ((eq wt 'match) (matchi!> lst nil)) % not words (t (cleri!> lst nil)))) (cond((eq wa !!er!!) (prog2(remflag w2 '!+grgvar)(return !!er!!)))) (errorset (list 'forall (list 'quote (list w w3 wa))) ![erst1!] ![erst2!] ) (remflag w2 '!+grgvar) (setq wa (cadadr wa)) (cond((not(eqs!> wt 'clear)) (setq wa (mapcar wa 'cadr)))) % not word (while!> wa (setq wss (list 'forall (list w w3 (list (faclear!>) (list 'quote (ncons(car wa))))))) (setq ![sublist!] (delete wss ![sublist!])) (cond((not(eq wt 'clear)) % not word (setq ![sublist!] (cons wss ![sublist!])))) (setq wa (cdr wa))) (return t))) %----- Print...; command ------------------------------------------------ (de printi!> (lst) (prog (wi) (cond ((null lst) (return nil))) (setq ![modp!] ![umod!]) (cond ((not(and (fancyon!>) (not !*latex))) (terpri))) (cond ((memqs!> 'for lst) (progn % word!!! (setq lst (seek1q!> lst 'for)) % word!!! (setq wi (cdr lst)) (setq lst (reverse(car lst)))))) (cond ((null lst) (return nil))) (cond(wi(setq wi (memlist!> '!, wi)))) (cond((eq wi !!er!!)(prog2(setq ![er!] 2202)(return wi)))) (cond(wi(setq wi (itercon!> wi)))) (cond((eq wi !!er!!)(prog2(setq ![er!] 21031)(return wi)))) (setq ![allzero!] t) (setq ![extvar!] (mapcar wi 'caar)) % This with prohibited unknown vars -> for % (setq lst (pretrans!> lst)) % Pre Translation ... % This with allowed unknown vars -> for (setq lst (pretransext!> lst)) % pre translation ... (cond ((and ![extvara!] !*nofreevars) (mapcar ![extvara!] 'doub!>) (setq ![er!] 2018) (setq ![extvara!] nil) (return !!er!!)) ((and ![extvara!] (not(and (eqn (length ![extvara!]) 1) (equal (list 'dummyvar!> (car ![extvara!])) lst)))) (setq wi (mapcar ![extvara!] 'ncons)) (setq wi (mapcar wi 'ncons)) (setq ![extvar!] ![extvara!]) (setq ![extvara!] nil) )) (cond ((eq lst !!er!!) (return !!er!!))) (setq lst (printico!> wi nil lst nil)) (cond((eq lst !!er!!)(return !!er!!))) (cond (![allzero!] (progn (alpri!> nil) (grgend!>) (grgterpri!>) (terpri))) ((and (not !*latex) (fancyon!>)) (terpri))) (return t))) (de appendn!> (wa wd) (cond((null wa) wd) (t(cons(ncons(car wa))(appendn!>(cdr wa)wd))))) (de printico!> (wi wt lst wp) (cond ((null wi) (progn (setq lst (fintrans!> lst)) % final translation (cond((eq lst !!er!!) !!er!!) ((null lst) nil) (t(progn (setq ![allzero!] nil) (cond(wt(prinvarl!>(reverse wt)))) (cond(!*math(gprin!> "("))) (cond ((zerop(car lst)) (alpri!> (cdr lst))) % algexpr (t (dfpri!> (cdr lst) (car lst)))) % form (cond(!*math(gprin!> ")"))) (cond((ifmodo!>)(ooend!>))) (grgterpri!>) (cond((not(and (fancyon!>) (not !*latex))) (terpri))) ))))) (t(proc (wa we) (setq wa (errorset!> (list3 'itertr!> (list2 'quote (car wi)) (list2 'quote wp) ) ![erst1!] ![erst2!])) (cond((atom wa)(prog2(setq ![er!] wa)(return !!er!!))) (t(setq wa(reverse(car wa))))) (while!> wa (put (caar wa) '!=subind (cdar wa)) (setq we (printico!> (cdr wi) (cons(cdar wa)wt) lst (cdar wa))) (remprop (caar wa) '!=subind) (cond((eq we !!er!!)(return we))) (setq wa (cdr wa))))))) (de prinvarl!> (w) (proc (wr we) (cond (!*math (setq wr '( !(!* ))) (!*macsyma (setq wr '( !/!* ))) (!*maple (setq wr '( !#! ))) ((or !*grg !*reduce) (setq wr '( !% )))) (setq we ![extvar!]) (while!> w (setq wr (cons(car w)(cons '!= (cons(car we)wr)))) (setq w (cdr w)) (cond((and w (fancyon!>)) (setq wr (cons '!, wr)))) (setq we (cdr we))) (setq wr (cons (cond (!*math '!*!) ) (!*macsyma '!*!/ ) (!*grg '!;! ) ((fancyon!>) '!: ) % ((fancyon!>) '!:!\! ) (t '!:! )) wr)) (setq wr (reverse wr)) (cond((ifmodo!>) (prog2(gprinwb!> wr)(gterpri!>))) (t (algprinwb!> wr))) (cond ((fancyon!>) (algpri!> " "))) )) (de itercon!> (lst) (proc (w wc) (while!> lst (setq wc (car lst)) (setq lst (cdr lst)) (cond((or(memq '!< wc)(memq '!> wc)(memq '!<!= wc)(memq '!>!= wc)) (progn (setq wc (itercon1!> wc)) (cond((eq wc !!er!!)(return !!er!!))) (setq w (append wc w)) )) (t(setq w (cons(ncons wc)w))))) (return(reversip w)))) (de itercon1!> (lst) (proc (w wc wa) (while!> lst (cond ((memq (car lst) '(!< !> !<!= !>!=)) (cond((or(null(cdr lst))(null wa))(return !!er!!)) (t(progn (setq w (cons (cons(reverse wa)wc) w)) (setq wa nil) (setq wc (itcty!>(car lst))) (setq lst (cdr lst)) )))) (t(prog2(setq wa (cons(car lst)wa)) (setq lst (cdr lst)))))) (setq w (cons (cons(reverse wa)wc) w)) (return w))) (de itcty!> (w) (cond ((eq w '!<) 1) ((eq w '!>) 2) ((eq w '!<!=) 3) ((eq w '!>!=) 4))) %----- Comment ... command ----------------------------------------------- (de comment!> (lst) (cond (![unl!] (progn (wrs ![unl!]) (print '(cout!>)) (terpri) (print (list 'comin!> (list 'quote lst))) (terpri) (wrs ![wri!]) )) (t nil))) %----- Zero/Nullify command ---------------------------------------------- (de zero!> (lst) % 05.96 (proc (w wc) (cond ((null lst) (return nil)) ((eqs!> lst '(time)) (progn % word!!! (setq ![time!] (time)) (setq ![gctime!] (gctime)) (return nil)))) (cond ((eq (setq w (dgood!> lst)) !!er!!) (return !!er!!))) (setq w (altdata!> w)) (while!> w (setq wc (car w)) (cond ((not (memq wc '(![cord!] ![const!] ![fun!] ![sol!] ![apar!] ))) (cond ((eq wc '!#!G) (setq ![mtype!] 3) (setq ![dtype!] 1) ) ((eq wc '!#!G!I) (setq ![mitype!] 3) (setq ![ditype!] 1) ) ((eq wc '!#!T) (setq ![ftype!] 3) ) ((eq wc '!#!D) (setq ![fitype!] 3) ) ) (set wc (mkbox!> wc)))) (setq w (cdr w))))) %----- Forget ; command -------------------------------------------------- (de forget!> (lst) (proc (w) (cond ((null lst) (return nil)) ((eq (setq w (dgood!> lst)) !!er!!) (return !!er!!))) (setq w (altdata!> w)) (while!> w (cond ((flagp (car w) '!+abbr) (forget1!>(car w))) (t (msg!> 8701))) (setq w (cdr w))))) (de forget1!> (w) (prog (wa wb wl) (cond ((flagp w '!+abbr) (prog2 (setq wb ![abbr!]) (setq ![abbr!] (loop!> (cond ((eq w (car wb)) (return (app!> wa (cdr wb)))) (t(prog2 (setq wa (cons (car wb) wa)) (setq wb (cdr wb)))))))))) % (setplist w nil) % AMI: removes ALL properties and flags (remprop w 'vartype) % PSL: removes GLOBAL/FLUID (setq wl (ncons w)) (set w nil) (foreach!> x in ![allflags!] do (remflag wl x)) (foreach!> x in ![allprops!] do (remprop w x)) )) %-------- Hold/Relese; --------------------------------------------------- (de hold!> (lst wt) (prog (w) (cond ((null lst) (return nil)) ((eq (setq w (dgood!> lst)) !!er!!) (return !!er!!))) (setq w (altdata!> w)) (cond (wt (flag w '!+hold)) (t (remflag w '!+hold))) (return t))) %---------- Erase/Delete; ----------------------------------------------- (de erase!> (lst) % 5.96 (proc (w wc) (cond ((null lst) (return nil)) ((eq (setq w (dgood!> lst)) !!er!!) (return !!er!!))) (setq w (altdata!> w)) (while!> w (setq wc (car w)) (cond ((and ![umod!] (memq wc '(!#!b !#!e))) (msg!> 7012)) ((eq wc '![cord!]) (rempf!> ![rpflcr!] nil) (setq ![cord!] nil)) ((eq wc '![const!]) (rempf!> ![rpflcn!] nil) (setq ![const!] nil)) ((eq wc '![apar!]) (rempf!> ![rpflap!] '(2)) (setq ![apar!] nil)) ((eq wc '![fun!]) (rempf!> ![rpflfu!] '(1)) (setq ![fun!] nil) (setq ![gfun!] nil) ) (t (set wc nil))) (cond ((eq wc '!#!G) (setq ![mtype!] nil) (setq ![dtype!] nil) ) ((eq wc '!#!G!I) (setq ![mitype!] nil) (setq ![ditype!] nil) ) ((eq wc '!#!T) (setq ![ftype!] nil) ) ((eq wc '!#!D) (setq ![fitype!] nil) ) ) (setq w (cdr w)) ) (return t))) %----- New Commands Driver ----------------------------------------------- (de newcommands!> (w) (cond ((null w) nil) ((eqs!> (car w) 'coordinates) (chcoord!> (cdr w))) % word!!! ((eqs!> (car w) 'object) (obdec!> (cdr w) 0)) % word!!! ((eqs!> (car w) 'equation) (obdec!> (cdr w) 1)) % word!!! ((eqs!> (car w) 'connection) (obdec!> (cdr w) 2)) % word!!! (t (obdec!> w 0)))) %----- Show Commands Driver ---------------------------------------------- (de shcommands!> (w) (cond ((null w) nil) ((eqs!> w '(time)) (timei!>)) % word!!! ((eqs!> w '(status)) (shstatus!>)) % word!!! ((eqs!> w '(all)) (shall!>)) % word!!! ((eqs!> w '(gc time)) (gctime!>)) % word!!! ((eqs!> (car w) 'switch) (sflag!> (cdr w))) % word!!! ((eqs!> (car w) 'file) (showfil!> (cdr w))) % word!!! ((memq '!* w) (shallbuilt!> w)) ((stringp (car w)) (showfil!> w)) ((and (null(cdr w)) (idp(car w)) (or (flagp (idtostcase!> (car w)) 'switch) (flagp (idtostcase!> (car w)) '!+switch))) (sflag!> w)) (t (showobj!> w)))) %----- Show Object ------------------------------------------------------- (de showobj!> (lst) (proc (w) (cond ((null lst) (return nil)) ((eq (setq w (dgoodw!> lst)) !!er!!) (return !!er!!))) (setq w (altdata!> w)) (cond ((null w) (return nil))) (while!> w (cond ((memq (car w) '(![cord!] ![const!] ![fun!] ![sol!] ![apar!])) nil ) (t (shobj1!> (car w)))) (setq w (cdr w)) ) (terpri) (return t))) (de shobj1!> (w) (prog (wi wt wy ww wc wd wx) (terpri) (setq wi (get w '!=idxl)) (setq wt (gettype!> w)) (setq wy (get w '!=sidxl)) (setq ww (get w '!=way)) (setq wd (get w '!=dens)) (gprinreset!>) (setq ![gptab!] 2) % Name ... (cond ((not(or (flagp w '!+abbr) (flagp w '!+macros2))) (thepn!> w))) % ID ... (gprin!> (incom!>(cdr(explode2 w)))) % Indices ... (while!> wi (setq wc (car wi)) % Position ... (cond ((and (upperp!> wc) (holp!> wc)) (gprin!> "^")) ((upperp!> wc) (gprin!> "'")) ((holp!> wc) (gprin!> "_")) (t (gprin!> "."))) % Type ... (cond ((holp!> wc) (gprin!>(car ![wh!])) (setq ![wh!] (cdr ![wh!]))) ((tetrp!> wc) (gprin!>(car ![wf!])) (setq ![wf!] (cdr ![wf!]))) ((enump!> wc) (gprin!>(car ![wi!])) (setq ![wi!] (cdr ![wi!])) (cond ((cdr wc) (gprin!> (cdr wc))) (t (gprin!> "dim")))) ((spinp!> wc) (for!> x (1 1 (cdr wc)) do (progn (gprin!>(car ![ws!])) (setq ![ws!] (cdr ![ws!])))))) (cond ((dotp!> wc) (gprin!> "~"))) (setq wi (cdr wi))) (gpris!>) % Type ... (gprin!> (cond((flagp w '!+pl) "are")(t "is"))) (gpris!>) (cond ((eqn wt -1) (gprin!> "Vector")) ((eqn wt 0) (gprin!> "Scalar")) (t (gprin!> wt) (gprin!> "-form"))) (cond ((flagp w '!+equ) (gpris!>) (gprin!> "Equation")) ((flagp w '!+fconn) (gpris!>) (gprils0!> '("Frame" "Connection"))) ((flagp w '!+hconn) (gpris!>) (gprils0!> '("Holonomic" "Connection"))) ((flagp w '!+uconn) (gpris!>) (gprils0!> '("Spinor" "Connection"))) ((flagp w '!+dconn) (gpris!>) (gprils0!> '("Conjugate" "Spinor" "Connection"))) ((flagp w '!+macros2) (gpris!>) (gprils0!> '("Macro" "Object"))) (wd (gpris!>) (gprin!> "Density") (gpris!>) (cond ((car wd) (gprin!> "sgnD") (setq wx t))) (cond ((cadr wd) (cond (wx (gprin!> "*"))) (setq wx t) (gprin!> "D") (cond ((not(eqn (cadr wd) 1)) (gprin!> "^") (cond ((lessp (cadr wd) 0) (gprin!> "("))) (gprin!> (cadr wd)) (cond ((lessp (cadr wd) 0) (gprin!> ")"))) )))) (cond ((caddr wd) (cond (wx (gprin!> "*"))) (setq wx t) (gprin!> "sgnL"))) (cond ((cadddr wd) (cond (wx (gprin!> "*"))) (gprin!> "L") (cond ((not(eqn (cadddr wd) 1)) (gprin!> "^") (cond ((lessp (cadddr wd) 0) (gprin!> "("))) (gprin!> (cadddr wd)) (cond ((lessp (cadddr wd) 0) (gprin!> ")"))) )))) )) (gterpri!>) % Value ... (cond ((flagp w '!+macros2) nil) ((eval w) (gprin!> "Value: known") (gterpri!>)) (t (gprin!> "Value: unknown") (gterpri!>))) % Symmetries ... (cond((null wy) (go lab1))) (gprinreset!>) (gprin!> " ") (setq ![gptab!] 4) (gprin!> "Symmetries:") (gpris!>) (while!> wy (shsy!>(car wy)) (cond((cdr wy) (prog2 (gprin!> ",") (gpris!>)))) (setq wy (cdr wy))) (gterpri!>) lab1 % Ways of calculation ... (setq ww (allways!> ww)) (cond ((null ww) (go lab2))) (gprinreset!>) (gprin!> " ") (setq ![gptab!] 4) (gprin!> "Ways of calculation:") (gterpri!>) (while!> ww (gprinreset!>) (setq ![gptab!] 6) (gprin!> " ") (setq wc (car ww)) (gprils!> (lowertxt!>(car wc))) (setq wc (cdr wc)) (gprin!> "(") (while!> wc (gprin!> (incom!> (cdr (explode2 (cond ((pairp(car wc)) (cadar wc)) (t (car wc))) )))) (cond((pairp(car wc)) (gprin!> "*"))) (cond ((cdr wc) (gprin!> ","))) (setq wc (cdr wc))) (gprin!> ")") (gterpri!>) (setq ww (cdr ww))) lab2 (gprinreset!>))) (de shsy!> (w) (cond ((numberp w) (gprin!> w)) ((idp w) (gprin!> (tolc!> w))) ((idp(car w)) (prog2 (shsy!>(car w)) (shsy!>(cdr w)))) (t(proc nil (gprin!> "(") (while!> w (shsy!> (car w)) (cond((cdr w) (gprin!> ","))) (setq w (cdr w))) (gprin!> ")") )))) (de allways!> (ww) (proc (wr w) (while!> ww (cond((not(eval(cadar ww))) (setq wr (cons (car ww) wr)))) (setq ww (cdr ww))) (setq ww nil) (while!> wr (setq w (needdata!>(cdddar wr))) (setq w (cons (cond((null(caar wr)) '( "Standard way" )) (t(caar wr))) w)) (setq ww (cons w ww)) (setq wr (cdr wr))) (return ww))) (de needdata!> (w) (cond ((null w) nil) ((atom (car w)) (cons (car w) (needdata!> (cdr w)))) ((eq (caar w) t) (cons (car w) (needdata!> (cdr w)))) ((eval (caar w)) (append (cdar w) (needdata!> (cdr w)))) (t (needdata!> (cdr w))))) %----- Time; and GC Time; commands --------------------------------------- (de timei!> nil (prog (wt wgt) (setq wt (difference (time) ![time!])) (setq wgt (difference (gctime) ![gctime!])) (cond ((iscsl!>) (setq wt (plus wt wgt)))) (cond ((not(eqn wt 0)) (setq wgt (quotient (times 100 wgt) wt))) (t (setq wgt 0))) (prin2 "Time: ") (prtime!> wt) (cond ((zerop wt) (prog2 (terpri) (return nil)))) (prin2 " (") (prin2 wgt) (prin2 "%GC)") (terpri))) (de gptime!> nil (prog (wt wgt) (setq wt (difference (time) ![time!])) (cond ((iscsl!>) (setq wgt (difference (gctime) ![gctime!])) (setq wt (plus wt wgt)))) (gprtime!> wt) (gterpri!>))) (de gctime!> nil (progn (prin2 "Garbage collections time: ") (prtime!> (difference (gctime) ![gctime!])) (terpri))) (de prtime!> (w) (prog (wa wb) (setq wb (quotient (remainder w 1000) 10)) (setq wa (quotient w 1000)) (prin2 wa)(prin2 ".") (cond((lessp wb 10)(prin2 "0"))) (prin2 wb) (prin2 " sec"))) (de gprtime!> (w) (prog (wa wb wt) (setq wb (quotient (remainder w 1000) 10)) (setq wa (quotient w 1000)) % (gprin!> wa)(gprin!> ".") % (cond((lessp wb 10)(gprin!> "0"))) % (gprin!> wb) % (gprin!> " sec") (setq wt '(! !s !e !c !")) (setq wt (append (explode2 wb) wt)) (cond((lessp wb 10) (setq wt (cons '!0 wt)))) (setq wt (cons '!. wt)) (setq wt (append (explode2 wa) wt)) (setq wt (cons '!" wt)) (gprin!>(compress wt)) )) %----- Find/Calculate ; command ------------------------------------------ (de find!> (lst) (proc (w wa wss) (cond ((null lst) (return nil))) (setq w (byfrom!> lst)) (cond ((eq w !!er!!) (return !!er!!))) (setq wss w) (cond ((eq(setq w (dgoodw!> w)) !!er!!) (return !!er!!))) (setq w (altdata!> w)) (while!> w (cond ((flagp (car w) '!+macros2) (doubo!>(car w)) (msg!> 100) (setq w (cdr w))) ((null(eval(car w))) (progn (setq ![chain!] nil) (setq wa (request!>(car w))) (cond((eq wa !!er!!) (prog2(trsf!>(car w))(return !!er!!))) ((null wa) (progn(setq ![er!] 6046)(trsf!>(car w))(return !!er!!)))) (setq w (cdr w)))) (t (aexp!>(car w)) (setq w (cdr w))))) (return t))) % Way extraction ... (de byfrom!>(w) (proc(wa) (setq ![way!] nil) (while!>(and w (not(bftp!>(car w)))) (prog2(setq wa(cons(car w)wa))(setq w(cdr w)))) (cond((or(null wa)(and w(null(cdr w)))) (progn(setq ![er!] 6042)(return !!er!!))) (w(prog2(setq ![way!] w)(return(reverse wa)))) (t(prog2(setq ![way!] nil)(return(reverse wa))))))) %---------- Write ...; command ------------------------------------------- (de write!> (lst) (proc (w wa wc) (cond ((null lst) (return nil))) (setq w (tofile!> lst 'write)) (cond((eq w !!er!!) (return !!er!!)) ((null w) % here ends global write to...; command (progn (closewrite!>) % close old global file .. (setq ![wri!] ![lwri!]) (setq ![lwri!] nil) (wrs ![wri!]) (return t))) (t(progn (setq wc (cdr w)) (setq w (car w))))) % wc=t write...to...; (cond((eq (setq w (dgoodw!> w)) !!er!!) (progn (cond(wc(closelw!>))) (return !!er!!)))) (cond (wc(wrs ![lwri!]))) (setq w (altdata!> w)) (while!> w (cond((memq (car w) '(!#!b !#!e)) (setq ![modp!] nil)) (t (setq ![modp!] ![umod!]))) (setq wa (dtl!> (car w))) (cond((eq wa !!er!!) (progn (cond(wc(closelw!>))) (return !!er!!)))) (setq w(cdr w))) (cond (wc(closelw!>))) % closing if it is write..to...; command (return t))) (de closelw!> nil (progn (close ![lwri!]) (setq ![lwri!] nil) (wrs ![wri!]) )) % Write ; commands for different data types 27.12.90 % General write: if =DATL call special function otherwise Standard ... (de dtl!> (w) (cond ((get w '!=datl) (apply 'eval (get w '!=datl))) (t (datlt!> w)))) % The Standard form of Write command ... (de datlt!> (wn) (proc (lst w) (cond ((flagp wn '!+macros2) (setq lst (prepmac!> wn))) (t (setq lst (eval wn)))) (cond ((null lst) (prog2 (abse!> wn) (return nil)))) (gprinreset!>) (thepn0!> wn) (gprin!> ":") (gterpri!>) (cond % write as a matrix ... ((and !*wmatr (not(ifmodo!>)) (zerop(gettype!> wn)) (eqn (length(get wn '!=idxl)) 2)) (setq ![allzero!] nil) (alpri!>(cons 'mat lst)) (algterpri!>) (go lab))) (cond ((not(and (fancyon!>) (not !*latex))) (terpri))) (setq ![idwri!] (incom!>(cdr(explode2 wn)))) (setq ![allzero!] t) (allcom!> lst wn nil (cond ((setq w (get wn '!=idxl)) w) (t '(0))) (function printco!>)) lab (cond (![allzero!] (progn (cond ((flagp wn '!+equ) (eqpri!> nil nil 0)) (t (alpri!> nil))) (grgend!>) (grgterpri!>) (terpri))) ((and (not !*latex) (fancyon!>)) (terpri))) )) % Prepare values for Macro tensor ... (de prepmac!> (wn) (prog (wr) (setq wr (errorset (list 'require!> (list 'quote (get wn '!=ndl)) nil nil))) (cond ((atom wr) (return nil))) (setq wr (mkbox!> wn)) (setq wr (allcoll!> wr wn nil (cond((get wn '!=idxl) (get wn '!=idxl)) (t '(0))) (function prepmac0!>))) (return wr))) (de prepmac0!> (w wi wn) (cond ((syaidxp!> wi (get wn '!=sidxl)) (setq w (eval (cons (get wn '!=evf) wi))) (cond ((eqn (gettype!> wn) 0) (evalalg!> w)) (t (evalform!> w)))) (t nil))) % One component printing ... (de printco!> (we wi wn) (prog (wq) (cond((null we)(return nil))) (setq ![allzero!] nil) (setq wq (flagp wn '!+equ)) % equation (idwri!> wn wi) % write identifier (wriassign!> wq) % write = (prel!> we (gettype!> wn) wq) % write value (grgends!>) (grgterpri!>) (cond((not(and (fancyon!>) (not !*latex))) (terpri))) )) (de idwri!> (wn wi) (cond ((fancyon!>) (prog (wa w ww wc wss) (setq wc 0) (cond ((setq wa (get wn '!=idxl)) (setq wss (needspace!> wa)) % we need extra space between indices? (foreach!> x in wi do (progn (setq wc (add1 wc)) % index ... (cond ((holonomq1!>(car wa)) (setq w (getel1!> ![cord!] x))) (t (setq w '( !" )) (cond ((dotp!>(car wa)) (setq w (cons (cond (!*latex '!}) (t '!')) w)))) (setq w (append (explode2 x) w)) (cond ((and (dotp!>(car wa)) !*latex) (setq w (append '(!\ !d !o !t !{) w)))) (setq w (cons '!" w)) (setq w (compress w)))) % place to put index ... (cond((eqn wc 1) (setq ww (fancyidwri!> wn))) (t (setq ww '!#!#lr))) (cond ((and wss (not(eqn wc 1))) (algpri!> "\,"))) (cond ((or (upperp!>(car wa)) (eq wn '!#b)) (algpri!> (list 'expt ww w) )) (t(progn (flag (ncons ww) 'print!-indexed) (algpri!> (list ww w) ) (remflag (ncons ww) 'print!-indexed)))) (setq wa (cdr wa))))) (t (algpri!> (fancyidwri!> wn) )) ))) ((ifmodo!>) (ooelem!> ![idwri!] wi)) (t(prog (wa wp wss wl wx) (algpri!> ![idwri!] ) (cond((setq wa (get wn '!=idxl)) (setq wss (needspace!> wa)) % we need extra space between indices? (foreach!> x in wi do (progn (setq wx (cond ((holonomq1!>(car wa)) (getel1!> ![cord!] x)) (t x))) (cond (wss (algpri!> " "))) % extra space (cond (wss (setq wl (length(explode2 wx)))) (t (setq wl 1))) % vertical position ... (setq wp (cond ((enump!>(car wa)) 0) % enum ((and (upperp!>(car wa)) (dotp!>(car wa))) % upper dot (setq ymax!* 2) 1) ((upperp!>(car wa)) % upper (setq ymax!* 1) 1) (t (setq ymin!* -1) -1))) % lower % drawing index itself ... (setq pline!* (cons (cons (cons (cons posn!* (plus wl posn!*)) wp) wx) pline!*)) % dot for dotted index ... (cond ((dotp!>(car wa)) (setq pline!* (cons (cons (cons (cons posn!* (add1 posn!*)) (add1 wp)) ".") pline!*)))) (setq posn!* (plus wl posn!*)) (setq wa (cdr wa)) )))) )))) (de needspace!> (wi) (cond ((null wi) nil) ((holonomq1!>(car wi)) t) ((greaterp (dimid!>(car wi)) 9) t) (t (needspace!> (cdr wi))))) (de fancyidwri!> (wn) (prog (w) (setq w (get wn '!=tex)) (cond (w(prog2 (put wn 'fancy!-special!-symbol (cond ((and (pairp w) !*latex) (car w)) ((pairp w) (cdr w)) (t w))) (return wn))) (t(return ![idwri!]))))) % Expression or Equality printing ... (de prel!> (we wt wq) (prog (wl wr) (cond(!*math(gprin!> "("))) (cond (wq (prog2 (cond(we(prog2 (setq wl (cadr we)) (setq wr (caddr we))))) (eqpri!> wl wr wt))) ((zerop wt) (alpri!> we)) (t (dfpri!> we wt))) (cond(!*math(gprin!> ")"))) )) % Special write for Constant and Coordinates ... (de datlc!> (wa txt pl) (proc nil (cond((null wa)(progn(terpri) (prin2 txt) (cond (pl (prin2 " are absent.")) (t (prin2 " is absent."))) (terpri) (return nil)))) (prin2 txt) (prin2 ":")(terpri)(terpri) (gprinreset!>) (gprils0!> wa) (gterpri!>)(terpri))) % Special write for Functions ... (de funl!> nil (prog (w) (cond((null ![fun!])(progn (prin2 "Functions are absent.")(terpri) (return t)))) (prin2 "Functions:")(terpri)(terpri) (gprinreset!>) (foreach!> x in ![fun!] do (progn (cond((setq w(get x '!=depend)) (gfnpri!> w)) (t (gprin!> x))) (gprin!> '! ))) (gterpri!>)(terpri))) % Special write for Solutions ... (de solwri!> nil (proc (w wn) (cond((null ![sol!])(progn (prin2 "Solutions are absent.")(terpri) (return t)))) (prin2 "Solutions:")(terpri) (cond((not(and (fancyon!>) (not !*latex))) (terpri))) (setq w ![sol!]) (setq wn 0) (while!> w (cond ((ifmodo!>) (ooelem!> '!S!o!l (ncons wn))) (t(progn (algpri!> "Sol(" ) (algpri!> wn ) (algpri!> ")" ) ))) (wriassign!> t) (prel!> (car w) 0 t) (grgends!>) (grgterpri!>) (cond((not(and (fancyon!>) (not !*latex))) (terpri))) (setq wn (add1 wn)) (setq w (cdr w))) (cond((and (fancyon!>) (not !*latex)) (terpri))) )) %---------- Output ...; command ------------------------------------------ (de grgout!> (w) (write!> (cons '!> w))) %---------- In "..."; command ------------------------------------------ (de from!> (lst) (proc (w wp) (cond ((null lst) (return nil)) ((or(not(stringp(car lst))) (cdr lst)) (prog2 (setq ![er!] 6301) (return !!er!!)))) (setq w (grgopeninput!> (car lst))) (cond ((atom w) (prog2 (setq ![er!] 6321) (return !!er!!)))) (setq w (car w)) (rds w) (setq ![echo!] t) % (terpri) (setq wp (listok!> '( !$ ))) (setq ![echo!] nil) % (terpri) (rds nil) (close w) (cond ((eq wp !!er!!) (return !!er!!))) (setq wp (collect!> wp)) (cond ((eq wp !!er!!) (return !!er!!))) (setq wp (mapcar wp 'mklevel!>)) (setq wp (mapcar wp 'car)) % execute the commands ... (while!> wp (cond ((and (car wp) (eq (runcom!>(car wp)) !!stop!!)) (return !!stop!!))) (setq wp (cdr wp))) (return t))) % Open file ... % WD - filename, WI - INPUT/OUTPUT, WB - UNLOAD/WRITE (de rdsio!> (wd wi wb) (prog (w wf) (cond((not(stringp wd))(prog2(setq ![er!] 6301)(return !!er!!)))) (setq w (errorset (list 'open wd(list 'quote wi)) nil nil)) (cond((atom w)(prog2(setq ![er!] 6321)(return !!er!!)))) (cond % input file for load ... ((eq wi 'input) (prog2 (setq ![loa!] (car w)) (rds ![loa!]))) % output file for write ... ((eq wb 'write) (setq ![lwri!] (car w))) % output file for unload ... ((eq wb 'unload) (setq ![lunl!] (car w))) ))) %---------- Unload ...; command ------------------------------------------ (de unl!> (lst) (proc (w wc wa) (cond ((null lst) (return nil))) (setq w (tofile!> lst 'unload)) (cond((eq w !!er!!) (return !!er!!)) ((null w) (progn % global unload file resetting and quit (closeunload!>) (setq ![unl!] ![lunl!]) (setq ![lunl!] nil) (return t))) % here ends unload to...; command (t(progn (setq wc (cdr w)) (setq w (car w))))) (setq wa w) (cond((eq (setq w (dgood!> w)) !!er!!) (prog2 (cond(wc(closelu!>))) (return !!er!!)))) (cond (wc (wrs ![lunl!])) (t(wrs ![unl!]))) % directing output ... (print '(cout!>)) (terpri) (print (list 'sgn!> (list 'quote ![sgn!]))) (terpri) (setq w (altdata!> w)) (cond ((and ![umod!] (eqs!> wa '(all))) (progn % word!!! (print '(smt!>)) (terpri) (setq w (append '(![dbas!] ![xb!] ![xv!] ![xf!] ![ccb!] ![ccbi!]) w))))) (while!> w (cond ((and (eq (car w) '![cord!]) (null !*unlcord)) nil) ((get (car w) '!=unl) (apply 'eval (get (car w) '!=unl)) (cond ((and (eq (car w) '![fun!]) ![gfun!]) (print (list 'putgfun!> (list 'quote ![gfun!]))) (terpri)))) (t(progn (cond ((flagp (car w) '!+abbr) (unlnvar!>(car w)))) (print (list 'setq (car w) (list 'quote (eval(car w))))) (terpri) ))) (setq w (cdr w))) (print '(rout!>)) (terpri) (cond (wc (closelu!>)) (t (wrs ![wri!]))) % restoring output ... (return t))) (de closelu!> nil (progn (print t) (close ![lunl!]) (setq ![lunl!] nil) (wrs ![wri!]) )) % Unload new-built data ... (de unlnvar!> (w) (proc (lst) (cond ((flagp w '!+abbr) (print (list 'pushabbr!> (list 'quote w))) (terpri) )) (setq lst ![allflags!]) (while!> lst (unlflag!> w (car lst)) (setq lst(cdr lst))) (setq lst ![allprops!]) (while!> lst (unlprop!> w (car lst)) (setq lst(cdr lst))) )) % Unloads flag ... (de unlflag!> (w wf) (cond ((flagp w wf) (print (list 'flag (list 'quote (list w)) (list 'quote wf))) (terpri) ))) % Unloads prop ... (de unlprop!> (w wf) (prog (wa) (cond ((setq wa (get w wf)) (print (list 'put (list 'quote w) (list 'quote wf) (list 'quote wa))) (terpri) )))) %---------- Load ...; command -------------------------------------------- (de loa!> (lst) (proc (w wf we) (cond ((null lst) (return nil)) ((eqs!> (car lst) 'package) % word!!! (return (loadpack!> (cdr lst) t))) ((not(stringp(car lst))) (return (loadpack!> lst t)))) (setq wf t) (cond ((cdr lst) (prog2(setq ![er!] 6301)(return !!er!!)))) (setq lst (rdsio!> (car lst) 'input nil)) (cond ((eq lst !!er!!) (return !!er!!))) (loop!> (setq w (errorset '(read) nil nil)) (cond ((atom w) % unexpected data (progn (cload!>) (setq ![er!] 7720) (return !!er!!))) ((or (equal w '(t)) (equal w (ncons !$eof!$)) (atom w)) % eof encountered (progn (cload!>) (copar!>) (return t))) ((and wf (not (equal w '((cout!>))))) % not .loa file format (progn (cload!>) (setq ![er!] 7200) (return !!er!!)))) (setq we (errorset (car w) nil nil)) (cond ((atom we) % unexpected data (progn (cload!>) (setq ![er!] 7720) (return !!er!!)))) (setq wf nil)) )) (de cload!> nil (progn (close ![loa!]) (rds nil) (mtype!>) (mitype!>) (ftype!>) (fitype!>) )) % Basis changing with Load ... (de smt!> nil (prog2 (setq ![umod!] t) (prin2 "Basis is anholonomic now.") (terpri))) % Dimension/Signature control with Load ... (de sgn!> (w) (cond ((not(equal w ![sgn!])) % signature diffres (cond (![firsti!] (setq ![sgn!] w) (setq ![dim!] (length w)) (tunedim!>) (sdimsgn!>) ) (t (erm!> 7900) (err!> 7900)))))) % Load Comment ... (de comin!> (lst) (progn (gprinreset!>) (gprils0!> (cons "%" lst)) (gprin!> ";") (gterpri!>) )) %----- Special Load/Unload for Fun, Cord and Const ----------------------- (dm putpnu!> (u) (list 'putpnu0!> (list 'quote (cdr u)))) (de putpnu0!> (u) (prog (w wc) (setq w '(putpn!>)) (for!> x (0 1 1) do (progn (setq wc (eval(car u))) (setq u (cdr u)) (setq w (cons (list 'quote wc) w)))) (foreach!> x in u do (setq w (cons (list 'quote x) w))) (print(reverse w)) (terpri) )) (de putgfun!> (w) (progn (loadpack!> '(dfpart) nil) (generic!_function w) (cond (!*dfpcommute (dfp!_commute w))))) (de putpn!> (wd w wf wp wss) (proc (wn wa) (cond((null w)(return nil))) (cond((and (eqn wss 1) !*unlcord) (progn (warcor!> w) (rempf!> ![rpflcr!] nil) (setq ![cord!] w))) ((eqn wss 1)(return nil)) ((eqn wss 2) (prog2 (warcon!> w) (setq w(setq ![const!](appmem!> w ![const!]))))) ((eqn wss 3)(progn (warfun!> w) (setq wa(newid!> w ![fun!])) (setq w(setq ![fun!](appmem!> w ![fun!]))) (operator wa))) ((eqn wss 4) (setq ![apar!] w) (foreach!> x in ![cord!] do (depend (cons x w)))) ) (while!> wf (flag w (car wf)) (setq wf(cdr wf))) (setq wn 0) (while!> w (cond(wp(put (car w) wp wn))) (setq wn(add1 wn)) (setq w(cdr w))) (cond(wd(foreach!> x in wd do (progn (depend x) (flag (ncons(car x)) '!+grgvar) (put (car x) '!=depend x) )))) )) (de putfndp!> nil (prog (w wa) (foreach!> x in ![fun!] do (cond((setq wa(get x '!=depend))(setq w(cons wa w))))) (return w))) (de warcor!> (w) (progn (cond((and ![cord!](not(equal w ![cord!]))) (msg!> 7630))) (cond((intersec!> w ![const!]) (msg!> 7635))) (cond((intersec!> w ![fun!]) (msg!> 7637))) )) (de warcon!> (w) (progn (cond((intersec!> w ![cord!]) (msg!> 7631))) (cond((intersec!> w ![fun!]) (msg!> 7632))) )) (de warfun!> (w) (progn (cond((intersec!> w ![cord!]) (msg!> 7633))) (cond((intersec!> w ![const!]) (msg!> 7634))) )) (de intersec!> (wa wb) (cond((or(null wa)(null wb)) nil) ((memq(car wa)wb) t) ((memq(car wb)wa) t) (t(intersec!>(cdr wa)(cdr wb))))) (de newid!> (w lst) (cond((null w) nil) ((not(memq(car w)lst))(cons(car w)(newid!>(cdr w)lst))) (t(newid!>(cdr w)lst)))) (de pushabbr!> (w) (prog2 (cond((flagp w '!+abbr) (forget1!> w))) (setq ![abbr!] (consmem!> w ![abbr!])))) %----- Unload/Write ... To/In file --------------------------------------- (de tofile!> (lst wb) % wb=write/unload (proc(w) (while!>(and lst(not(memqs!> (car lst) '( !> to )))) % word!!! (setq w(cons(car lst)w))(setq lst(cdr lst))) (cond ((and lst(eqn(length lst)2)) (progn (setq lst(rdsio!> (cadr lst) 'output wb)) (cond((eq lst !!er!!)(return !!er!!))) (cond((null w)(return nil)) % just file... (t(return(cons(reverse w) t)))))) % file and data... (lst(prog2(setq ![er!] 6301)(return !!er!!))) (t(return(cons(reverse w) nil)))))) % just data... %------ Show File "..."; command ----------------------------------------- (de showfil!> (lst) (proc (w wf wt wss wi wd wx) (cond((null lst)(return nil))) (setq wf t) (cond((cdr lst)(prog2(setq ![er!] 6301)(return !!er!!)))) (setq lst(rdsio!>(car lst) 'input nil)) (cond((eq lst !!er!!)(return !!er!!))) (loop!> (setq w(errorset '(read) nil nil)) (cond((atom w) % unexpected data (progn(cload!>)(setq ![er!] 7720)(return !!er!!))) ((or(equal w (ncons !$eof!$)) (equal w '(t)) (atom w)) % eof encountered (progn(cload!>)(copar!>)(return t))) ((and wf(not(equal w '((cout!>))))) % not .loa file format (progn(cload!>)(setq ![er!] 7200)(return !!er!!)))) (setq w (car w)) (cond((or (null w) (atom w)) nil) ((and (pairp w) (null wx) (eq (car w) 'sgn!>)) (setq wx t) (shsgndim!> (cadadr w))) ((eq(car w) 'setq) (progn (setq w(cadr w)) (cond((flagp w '!+ivar) (prog2(pn!> w)(gterpri!>)))) )) ((eq(car w) 'pushabbr!>) (setq w (cadadr w)) (cond ((not (flagp w '!+abbr)) (setq w (cdr (explode2 w))) (mapc w 'prin2) (terpri)))) ((eq (car w) 'comin!>) (comin!> (cadadr w))) ((eq (car w) 'putpn!>) (progn (setq wt (cadadr(cddddr w))) (setq w (cadr(caddr w))) (algpri!> (cond((eqn wt 1) "Coordinates: ") ((eqn wt 2) "Constants: ") ((eqn wt 3) "Functions: ")) ) (algprinwb!> w) (algterpri!>)))) (setq wf nil)) )) (de shsgndim!> (w) (proc nil (prin2 "Dimension is ") (prin2 (length w)) (prin2 " with Signature (") (while!> w (cond ((eqn (car w) 1) (prin2 "+")) (t (prin2 "-"))) (cond ((cdr w) (prin2 ","))) (setq w (cdr w))) (prin2 ")") (terpri))) %----- Line Length ; command --------------------------------------------- (de setlinel!> (lst) (cond((null lst) (progn (prin2 "Line Length is ") (prin2 (linelength nil)) (prin2 ".")(terpri) )) ((or(cdr lst)(not(numberp(car lst)))(lessp(car lst)0)) (prog2 (setq ![er!] 1100) !!er!!)) (t(linelength (car lst))))) %-------- Show Switch ...; command 20.02.94 ------------------------------ (de sflag!> (w) (prog (wa) (cond ((null w) (return nil)) ((or (cdr w) (not(idp(car w)))) (prog2 (setq ![er!] 1100) (return !!er!!))) ) (setq w (idtostcase!> (car w))) (cond ((and (not (flagp w 'switch)) (not (flagp w '!+switch))) (progn (setq ![er!] 6402) (doub!> w) (return !!er!!)))) (setq wa (incom!> (cons '!* (explode2 w)))) (prin2 w) (prin2 " is ") (prin2 (cond ((eval wa) "On.")(t "Off."))) (terpri) (return t))) %------- Show Status; command 06.94 -------------------------------------- (de shstatus!> nil % 05.96 (progn % REDUCE version ... (prin2 "Running with ") (cond ((boundp!> 'version!*) (prin2 (eval 'version!*))) (t (prin2 "REDUCE 3.3"))) (cond ((iscsl!>) (prin2 " [CSL")) (t (prin2 " [PSL"))) (cond ((islowercase!>) (prin2 " Lower-Case]")) (t (prin2 " Upper-Case]"))) (cond ((os!>) (prin2 " under ") (prin2 (os!>)))) (terpri) % System Directory ... (cond (![grgdir1!] (progn (prin2 "System directory: ") (prin2 ![grgdir1!]) (terpri)))) % System case ... (showcase!>) % Dimension and Signature ... (sdimsgn!>) % Metric ... (cond (!#!G (progn (prin2 " Metric: ") (prin2 (cond ((eqn ![mtype!] 1) "null") ((eqn ![mtype!] 2) "diagonal") ((eqn ![mtype!] 3) "general") (t "unknown type"))) (prin2 (cond ((and (eqn ![dtype!] 1) (not(eqn ![mtype!] 1))) " and constant") (t " "))) (terpri)))) % Frame ... (cond (!#!T (progn (prin2 " Frame: ") (prin2 (cond ((eqn ![ftype!] 1) "holonomic") ((eqn ![ftype!] 2) "diagonal") ((eqn ![ftype!] 3) "general") (t "unknown type"))) (terpri)))) % Basis ... (cond (![umod!] (progn (prin2 " Basis: anholonomic") (terpri)))) t)) (de sdimsgn!> nil % 05.96 (proc (w) (prin2 "Dimension is ") (prin2 ![dim!]) (prin2 " with Signature (") (setq w ![sgn!]) (while!> w (cond ((eqn (car w) 1) (prin2 "+")) (t (prin2 "-"))) (cond ((cdr w) (prin2 ","))) (setq w (cdr w))) (prin2 ")") (terpri))) %------- Show All; command ----------------------------------------------- (de shall!> nil (proc (w) (setq w (alldata!>)) (cond ((null w) (progn (prin2 "Nothing is known.") (terpri) (return nil)))) (prin2 "Value of the following objects is known:") (terpri) (gprinreset!>) (while!> w (gprin!> " ") (pn0!>(car w)) (gterpri!>) (setq w (cdr w))) )) (de shallbuilt!> (ww) (proc (w wc wn wx) (cond ((eq (car ww) '!*) (setq wc nil)) ((liter (car ww)) (setq wc (tostcase!> (car ww)))) (t (return nil))) (setq w ![datl!]) (gprinreset!>) (while!> w (setq wn (car (explode (caaar w)))) (cond ((or (null wc) (eq wc wn)) (cond ((null wx) (setq wx t) (prin2 "Built-in objects:") (terpri))) (gprin!> " ") (gprils0!> (lowertxt!> (caar w))) (gterpri!>) )) (setq w (cdr w))) (cond ((null wx) (prin2 "No such built-in objects.") (terpri))))) %------- Evaluate ...; command ------------------------------------------- (de evalcomm!> (w fun) % o5.96 (proc (we wb wc) (cond ((null w) (return nil))) (cond ((eq (setq w (dgood!> w)) !!er!!) (return !!er!!))) (setq w (altdata!> w)) (while!> w (setq wc (car w)) (cond((memq wc '(![cord!] ![const!] ![fun!] ![apar!])) nil) ((null (setq wb (eval wc))) (abse!> wc)) (t(set wc (allcoll!> wb wc nil (cond((get wc '!=idxl)(get wc '!=idxl)) (t '(0))) fun)) )) (cond ((eq wc '!#!G ) (mtype!>)) ((eq wc '!#!G!I ) (mitype!>)) ((eq wc '!#!T ) (ftype!>)) ((eq wc '!#!D ) (fitype!>)) ) (setq w (cdr w))) (return t))) % Evaluation of expression of equality ... (de evel!> (lst wi wn) (cond((null lst) nil) ((and (zerop(gettype!> wn))(not (flagp wn '!+equ))) (evalalg!> lst)) ((and (not(zerop(gettype!> wn)))(not (flagp wn '!+equ))) (evalform!> lst)) ((and (not(zerop(gettype!> wn))) (flagp wn '!+equ)) (equationf!> (cadr lst) (caddr lst))) ((and (zerop(gettype!> wn))(flagp wn '!+equ)) (equationa!> (cadr lst) (caddr lst))))) (de normel!> (lst wi wn) (cond((null lst) nil) ((and (zerop(gettype!> wn))(not (flagp wn '!+equ))) (evalalg!> lst)) ((and (not(zerop(gettype!> wn)))(not (flagp wn '!+equ))) (evalform!> lst)) ((and (not(zerop(gettype!> wn))) (flagp wn '!+equ)) (equationf1!> (cadr lst) (caddr lst))) ((and (zerop(gettype!> wn))(flagp wn '!+equ)) (equationa1!> (cadr lst) (caddr lst))))) %---------- Package ...; command 25.02.94 -------------------------------- (de loadpack!> (lst bool) % bool=t - message, bool=nil - silence (proc (w ww wu wl) (cond ((null lst) (return nil)) ((or (cdr lst) (not(idp(car lst)))) (setq ![er!] 8100) (return !!er!!))) (setq ww (car lst)) (setq w (explode2 ww)) (setq wu (incom!> (mapcar w 'touc!>))) (setq wl (incom!> (mapcar w 'tolc!>))) % already loaded ... (cond((or (memq ww (eval 'loaded!-packages!*)) (memq wu (eval 'loaded!-packages!*)) (memq wl (eval 'loaded!-packages!*))) (cond (bool (msg!> 8101) (return t)) (t (return t))))) % trying name as it is ... (setq w (errorset (list 'evload (list 'quote (ncons ww))) ![erst1!] ![erst2!])) (cond ((not(atom w)) (progn (set 'loaded!-packages!* (cons ww (eval 'loaded!-packages!*))) (set 'loaded!-packages!* (cons wu (eval 'loaded!-packages!*))) (set 'loaded!-packages!* (cons wl (eval 'loaded!-packages!*))) (return t)))) % trying uppercase name ... (setq w (errorset (list 'evload (list 'quote (ncons wu))) ![erst1!] ![erst2!])) (cond ((not(atom w)) (progn (set 'loaded!-packages!* (cons ww (eval 'loaded!-packages!*))) (set 'loaded!-packages!* (cons wu (eval 'loaded!-packages!*))) (set 'loaded!-packages!* (cons wl (eval 'loaded!-packages!*))) (return t)))) % trying lowercase name ... (setq w (errorset (list 'evload (list 'quote (ncons wl))) ![erst1!] ![erst2!])) (cond ((not(atom w)) (progn (set 'loaded!-packages!* (cons ww (eval 'loaded!-packages!*))) (set 'loaded!-packages!* (cons wu (eval 'loaded!-packages!*))) (set 'loaded!-packages!* (cons wl (eval 'loaded!-packages!*))) (return t)))) (setq ![er!] 8102) (return !!er!!))) %---------- Solve ...; command 16.03.94 ---------------------------------- (de solvei!> (lst) (prog (we wv w wr) (setq lst (seek1q!> lst 'for)) % word!!! (cond((or(null lst)(null(car lst))(null(cdr lst))) (prog2(setq ![er!] 2300)(return !!er!!)))) (setq wv (memlist!> '!, (cdr lst))) (setq we (memlist!> '!, (reverse(car lst)))) (setq wv (mapcar wv 'solvev!>)) (cond((memq !!er!! wv)(return !!er!!))) (setq we (mapcar we 'solvee!>)) (cond((memq !!er!! we)(return !!er!!))) (setq ![solveq!] nil) (solveprep!> we) (setq we ![solveq!]) (setq ![solveq!] nil) (cond((null we)(prog2(setq ![er!] 2304)(return !!er!!)))) (setq w (list 'eval!> (list 'quote (list 'solve (cons 'list we) (cons 'list wv))))) (setq w (errorset w ![erst1!] ![erst2!])) (cond((atom w)(prog2(setq ![er!] 2301)(return !!er!!)))) (solveres!> (car w)) (setq wr ![solveq!]) (setq ![solveq!] nil) (cond(wr (setq ![sol!] (append wr ![sol!]))) (t (msg!> 2302))) (return t))) (de solvev!> (w) (nz!>(translata!> w))) (de solveprep!> (w) (cond((atom w) nil) ((eq (car w) 'equal) (setq ![solveq!] (cons (solveprep1!> w) ![solveq!]))) (t(mapc w 'solveprep!>)))) (de solveprep1!> (w) (mapcar w 'nz!>)) (de solveres!> (w) (cond((atom w) nil) ((eq (car w) 'equal) (setq ![solveq!] (cons (solveres1!> w) ![solveq!]))) (t(mapc w 'solveres!>)))) (de solveres1!> (w) (mapcar w 'evalalg!>)) (de solvee!> (w) (cond((memq '!= w)(solveeq!> w)) (t(prog (ww wi) (setq ww (dgood!> w)) (cond((not(eq ww !!er!!))(return(solveeo!>(altdata!> ww))))) (cond ((idp(car w))(progn (setq wi (explode2(car w))) (selid!> wi nil) (setq wi (incomiv!> wi)) (cond((not(flagp wi '!+equ)) (prog2(setq ![er!] 2300)(return !!er!!)))) (return(solveeq!>(list '!L!H!S w '!= '!R!H!S w))))) (t(prog2(setq ![er!] 2300)(return !!er!!)))))))) (de solveeq!> (w) (proc (wa wr) (setq wa (seek1!> w '!=)) (cond((or(null(car wa))(null(cdr wa))) (prog2(setq ![er!] 2300)(return !!er!!)))) (setq w (list (reverse(car wa)) '!- (cdr wa))) (setq ![extvar!] nil) (setq w (translate!> w)) (cond((or(null w)(eq w !!er!!)) (return w))) (cond((zerop(car w)) (return(ncons(list 'equal (cdr w) nil))))) (setq w (cdr w)) (while!> w (setq wr (cons (list 'equal (caar w) nil) wr)) (setq w (cdr w))) (return wr))) (de solveeo!> (w) (cond((null w) (prog2 (setq ![er!] 2304) !!er!!)) (t(proc (wr) (while!> w (cond((not(flagp (car w) '!+equ)) (prog2(setq ![er!] 2303)(return !!er!!)))) (setq ![solveq!] nil) (put '![solveq!] '!=typ (gettype!> (car w))) (soexp!> (eval(car w))) (setq wr (append ![solveq!] wr)) (setq ![solveq!] nil) (setq w (cdr w))) (return wr))))) (de soexp!> (w) (cond((atom w) nil) ((eq (car w) 'equal) (soexp1!> w)) (t (mapc w 'soexp!>)))) (de soexp1!> (w) (cond((zerop(get '![solveq!] '!=typ)) (setq ![solveq!] (cons w ![solveq!]))) (t(proc nil (setq w (dfsum!> (list (cadr w) (chsign!> t (caddr w))))) (while!> w (setq ![solveq!] (cons (list 'equal (caar w) nil) ![solveq!])) (setq w (cdr w))))))) %----- Object Declaration Command 11.94, 05.96 -------------------------- (de obdec!> (lst type) % type=0 object, 1 equation, 2 connection ... (cond((null lst) nil) (t (proc (wn wt wi wy wd wa wb wc) % wn - internal id % wt - =type % wi - =idxl % wy - =sidxl % wd - =dens (setq wt 0) % default type is scalar ... (setq wn (idtra!> (car lst))) % identifier ... (cond ((eq wn !!er!!) (return !!er!!)) ((null(setq lst (cdr lst))) (return (formnew!> wn (cond ((eqn type 2) 1) (t wt)) wi wy wd type)))) % splitting lst into parts ... (setq lst (splitparts!> lst)) (setq wa (car lst)) % indices (setq wb (cadr lst)) % type (setq wc (caddr lst)) % symmetries % indices ... (cond ((null wa) (go lab1))) (setq wi (indtrac!> wa)) (cond ((eq wi !!er!!) (setq ![er!] 8602) (return !!er!!))) lab1 % type ... (cond ((and (eqn type 2) (null wb)) (setq wt 1))) (cond ((null wb) (go lab2))) (setq wt (typetrac!> wb)) (cond ((eq wt !!er!!) (setq ![er!] 8601) (return !!er!!))) (setq wd (cdr wt)) (setq wt (car wt)) lab2 % symmetries ... (cond ((null wc) (go lab3))) (setq wy (symtrac!> wc wi)) (cond ((eq wy !!er!!) (setq ![er!] 8606) (return !!er!!))) lab3 (return (formnew!> wn wt wi wy wd type)) )))) % Forms new object by assigning appropriate flags and props ... (de formnew!> (wn wt wi wy wd type) % 05.96 (proc nil (cond ((eqn type 2) % connection (cond ((not(eqn wt 1)) (setq ![er!] 3002) (return !!er!!))) (cond ((equal wi '(t nil)) (flag (ncons wn) '!+fconn) (flag (ncons wn) '!+noncov)) ((equal wi '(1 0)) (flag (ncons wn) '!+hconn) (flag (ncons wn) '!+noncov)) ((equal wi '((u . 2))) (flag (ncons wn) '!+uconn) (flag (ncons wn) '!+noncov)) ((equal wi '((d . 2))) (flag (ncons wn) '!+dconn) (flag (ncons wn) '!+noncov)) ((null wi) (setq wi '(t nil)) (flag (ncons wn) '!+fconn) (flag (ncons wn) '!+noncov)) (t (setq ![er!] 3001) (return !!er!!))))) (global (ncons wn)) (flag (ncons wn) '!+ivar) (flag (ncons wn) '!+abbr) (setq ![abbr!] (cons wn ![abbr!])) (put wn '!=type wt) (cond (wi (put wn '!=idxl wi))) (cond (wy (put wn '!=sidxl wy))) (cond (wd (put wn '!=dens wd))) (cond ((eqn type 1) (flag (ncons wn) '!+equ))) % equation (while!> wi (cond ((spinp!>(car wi)) (put wn '!=constr '((sp!>))))) (setq wi (cdr wi))) (return t))) % ID translation ... (de idtra!> (w) % 05.96 (prog (we wv) (cond ((not(idp w)) (prog2 (setq ![er!] 8600) (return !!er!!))) ((flagp w '!+grg) (prog2 (doub!> w) (msg!> 8603)))) (setq we (explode2 w)) (cond((badchar!> we) (progn (doub!> w) (setq ![er!] 8604) (return !!er!!)))) (setq wv (incomiv!> we)) (cond ((or (flagp wv '!+ivar) (flagp w '!+grgmac) (gettype!> wv)) (progn (doub!> w) (setq ![er!] 3000) (return !!er!!)))) (return wv))) (de badchar!> (lst) % 05.96 (cond ((null lst) nil) ((or (digit(car lst)) (eq (car lst) '!~)) t) (t (badchar!>(cdr lst))))) % Split command in parts .... (de splitparts!> (lst) % 05.96 (proc (w wr) (while!> (and lst (not (memqs!> (car lst) '(is with)))) % word!!! (setq w (cons (car lst) w)) (setq lst (cdr lst))) (setq w (reverse w)) (cond ((null lst) (return (list w nil nil))) ((memqs!> (car lst) '(with)) % word!!! (return (list w nil (cdr lst))))) (setq lst (cdr lst)) (setq wr w) (setq w nil) (while!> (and lst (not (memqs!> (car lst) '(with)))) % word!!! (setq w (cons (car lst) w)) (setq lst (cdr lst))) (cond ((null lst) (return (list wr (reverse w) nil))) (t (return (list wr (reverse w) (cdr lst))))) )) % Indices translation ... (de indtrac!> (w) % 05.96 (proc (wr wp wt) (cond ((not(zerop(remainder (length w) 2))) (return !!er!!))) (while!> w (setq wp (car w)) (cond ((not(memq wp '( !_ !. !' !^ ))) (return !!er!!))) (setq wt (cadr w)) (setq wt (indtra1!> wt wp)) (cond ((eq wt !!er!!) (return !!er!!))) (setq wr (cons wt wr)) (setq w (cddr w))) (return(reversip wr)) )) % One index translation ... (de indtra1!> (w wp) % 05.96 (cond ((not(idp w)) !!er!!) ((get w '!=uc) % single lc letter => holonomic or frame (cond ((eq wp '!') t ) ((eq wp '!.) nil ) ((eq wp '!^) 1 ) ((eq wp '!_) 0 ))) (t(prog (ww wd wl www) (setq ww (explode2 w)) (cond ((get (car ww) '!=lc) % spinorial (cond ((eq (car(reverse ww)) '!~) (setq wd t))) (return (cons (cond ((memq wp '(!' !^)) (cond (wd 'ud) (t 'uu))) (t (cond (wd 'd) (t 'u)))) (cond (wd (sub1(length ww))) (t (length ww)))))) ((get (car ww) '!=uc) % enumerating (setq www (compress (cdr ww))) (cond ((idp www) (cond ((equal (cdr ww) '(!d !i !m)) (return '(n))) (t (return !!er!!)))) ((zerop www) (return !!er!!)) (t (return (cons 'n www))))) (t (return !!er!!))))))) % Type and Density translation ... (de typetrac!> (wb) % 05.96 (prog (wt wd) (setq wb (splitpartsd!> wb)) (setq wt (typetra1!> (car wb))) (setq wd (denstra1!> (cdr wb))) (cond ((or (eq wt !!er!!) (eq wd !!er!!)) (return !!er!!)) (t (return (cons wt wd)))))) (de splitpartsd!> (lst) % 05.96 (proc (w) (while!> (and lst (not (memqs!> (car lst) '(density)))) % word!!! (setq w (cons (car lst) w)) (setq lst (cdr lst))) (setq w (reverse w)) (cond ((null lst) (return (cons w nil))) (t (return (cons w (cdr lst))))))) % Type translation ... (de typetra1!> (w) % 05.96 (cond ((null w) 0) ((eqs!> w '(vector)) -1) % word!!! ((eqs!> w '(scalar)) 0) % word!!! ((eqs!> (cdr w) '(!- form)) (pformtra1!>(car w))) % word!!! (t !!er!!))) (de pformtra1!> (w) % 05.96 (prog2 (setq w (ntranslata!> w)) (cond ((eq w !!er!!) !!er!!) ((lessp w 0) !!er!!) (t w)))) % Density translation ... (de denstra1!> (w) % 05.96 (proc (w1 w2 w3 w4 wc) (cond ((null w) (return nil))) (setq w (memlist!> '!* w)) (cond ((eq w !!er!!) (return !!er!!))) (while!> w (setq wc (car w)) (cond ((equal wc '(!s!g!n!D)) (setq w1 t)) ((equal wc '(!s!g!n!L)) (setq w3 t)) ((equal wc '(!D)) (setq w2 1)) ((equal wc '(!L)) (setq w4 1)) ((and (eq (car wc) '!D) (cdr wc) (eq (cadr wc) '!^) (cddr wc)) (setq wc (ntranslata!>(cddr wc))) (cond ((eq wc !!er!!) (return !!er!!))) (setq w2 wc)) ((and (eq (car wc) '!L) (cdr wc) (eq (cadr wc) '!^) (cddr wc)) (setq wc (ntranslata!>(cddr wc))) (cond ((eq wc !!er!!) (return !!er!!))) (setq w4 wc)) (t (return !!er!!))) (setq w (cdr w))) (cond ((or w1 w2 w3 w4) (return (list w1 w2 w3 w4))) (t (return nil))))) % Symmetries translation ... (de symtrac!> (wy wi) % 05.96 (cond (t(proc (wr w) (cond ((eqs!> (car wy) 'symmetries) % word!!! (setq wy (cdr wy)))) (cond ((null wy) (return nil))) (setq wy (memlist!> '!, wy)) (cond ((eq wy !!er!!) (return !!er!!))) (while!> wy (setq w (symspec1!> (car wy) wi)) (cond ((eq w !!er!!) (return !!er!!))) (setq wr (cons w wr)) (setq wy (cdr wy))) (cond((overlapp!> wr) (prog2 (msg!> 8607) (return !!er!!)))) (return(reversip wr)))))) % One symmetry item: W = (s ( , , )) (de symspec1!> (w wi) % 05.96 (cond ((or (null(cdr w)) (not(memq (car w) '(!a !s !c !h !A !S !C !H)))) !!er!!) (t(prog (wt wr) (setq wt (tostcase!> (car w))) (setq w (symspecl!> (cadr w) wi)) (cond ((eq w !!er!!) (return !!er!!)) ((null(cdr w)) (return !!er!!))) % length must be 2 or greater (cond ((memq wt '(!h !H)) (cond ((or (not (eqn (length w) 2)) (not (hequal!> w wi))) (return !!er!!)) (t (return (cons wt w))))) ((not(allequal!> w wi)) (return !!er!!)) (t (return (cons wt w)))))))) % List of symmetries or indices: W = ( , , ) (de symspecl!> (w wi) % 05.96 (proc (wr wa) (setq w (memlist!> '!, w)) (cond ((eq w !!er!!) (return !!er!!))) (while!> w (setq wa (symspec2!> (car w) wi)) (cond ((eq wa !!er!!) (return !!er!!))) (setq wr (cons wa wr)) (setq w (cdr w))) (return(reversip wr)))) % General translation ... (de symspec2!> (w wi) (cond ((cdr w) (symspec1!> w wi)) % something general: s( , ) ((atom(car w)) (symspec0!> (car w) wi)) % one index: 1 (t (symspecl!> (car w) wi)))) % list: ( , , ) % Just one index number ... (de symspec0!> (w wi) (cond ((and (numberp w) (leq w (length wi))) w) (t !!er!!))) % out of range (de overlapp!> (wr) (proc (w wa) (while!> wr (setq wa (iron1!>(car wr))) (cond ((intersecl!> wa w) (return !!er!!))) (setq w (append wa w)) (setq wr (cdr wr))) (return nil))) % Forms list of all numbers ... (de iron1!> (wr) (cond ((null wr) nil) ((idp(car wr)) (iron1!>(cdr wr))) ((atom(car wr)) (cons (car wr) (iron1!>(cdr wr)))) (t (append (iron1!>(car wr)) (iron1!>(cdr wr)))))) % Replaces ind numbers by their types ... (de itypes!> (w wi) (cond ((null w) nil) ((idp w) w) ((numberp w) (getn!> wi w)) (t (cons (itypes!> (car w) wi) (itypes!> (cdr w) wi))))) % All symmetries in the list are identical ... (de allequal!> (w wi) (cond ((null(cdr w)) t) ((equal (itypes!> (car w) wi) (itypes!> (cadr w) wi)) (allequal!> (cdr w) wi)) (t nil))) (de hequal!> (w wi) (prog (w1 w2) (setq w1 (itypes!> (car w) wi)) (setq w2 (cotype!>(itypes!> (cadr w) wi))) (return(equal w1 w2)))) (de cotype!> (w) (cond ((pairp w) (cond ((eq (car w) 'u) (cons 'd (cdr w))) ((eq (car w) 'd) (cons 'u (cdr w))) ((eq (car w) 'uu) (cons 'ud (cdr w))) ((eq (car w) 'ud) (cons 'uu (cdr w))) (t (mapcar w 'cotype!>)))) (t w))) %========== End of GRGcomm.sl =============================================% |
Added grgcomp.sl version [ebfdd7d028].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 | %==========================================================================% % GRG 3.2 Compilation [PSL] (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. % %==========================================================================% % Set here amount of required free BPS or nil ... (setq free!-bps!-size 45000) (progn (terpri) (prin2 "Compiling GRG 3.2, wait few minutes.") (terpri) (prin2 "After several `*** Init code length is #'") (terpri) (prin2 "messages the compilation should be completed.") (terpri) (prin2 "Watch possible error messages preceded by `*****' ...") (terpri) (terpri) (wrs (open "grgcomp.log" 'output)) ) (de compile!-file!> (bin src) (prog (wcc) (setq wcc (wrs nil)) (prin2 "Compiling `") (prin2 bin) (prin2 "' ...") (terpri) (wrs wcc) (terpri) (prin2 "### Compiling `") (prin2 bin) (prin2 "' ...") (terpri) (setq !*comp t) (faslout bin) (dskin src) (faslend) (setq !*comp nil) )) % Loading compiler ... (load compiler) % Do we need symget.dat ? % (cond % ((and (getd 'filep) (filep "$reduce/util/symget.dat")) % (dskin "$reduce/util/symget.dat") )) % Enlarging BPS if necessary ... (cond ((and free!-bps!-size (getd 'set!-bps!-size) (getd 'free!-bps) (lessp (free!-bps) free!-bps!-size)) (set!-bps!-size free!-bps!-size))) (dskin "grgmacro.sl" ) (dskin "grgdecl.sl" ) (compile!-file!> "grg" "grg.sl" ) (compile!-file!> "grg32" "grg32.sl" ) (compile!-file!> "grgdecl" "grgdecl.sl" ) (compile!-file!> "grggeom" "grggeom.sl" ) (compile!-file!> "grggrav" "grggrav.sl" ) (compile!-file!> "grginit" "grginit.sl" ) (compile!-file!> "grgclass" "grgclass.sl" ) (compile!-file!> "grgcomm" "grgcomm.sl" ) (compile!-file!> "grgcoper" "grgcoper.sl" ) (compile!-file!> "grgmain" "grgmain.sl" ) (compile!-file!> "grgmater" "grgmater.sl" ) (compile!-file!> "grgprin" "grgprin.sl" ) (compile!-file!> "grgproc" "grgproc.sl" ) (compile!-file!> "grgtrans" "grgtrans.sl" ) (compile!-file!> "grgcfg" "grgcfg.sl" ) (progn (terpri) (prin2 "### All done.") (terpri) (wrs nil) (terpri) (prin2 "GRG has been compiled.") (terpri) (prin2 "Move all created grg*.b files in the $reduce/fasl") (terpri) (prin2 "directory or keep them in your working directory.") (terpri) ) (bye) %==========================================================================% |
Added grgcoper.sl version [735cb9bb13].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 | %==========================================================================% % GRGcoper.sl Operators and Transformations % %==========================================================================% % 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. % %==========================================================================% %--- Spinorial rotation 13.03.91, 05.96 --------------------------------- % Main function ... (de rotas!> (lst) % 05.96 (prog2 (setq lst (errorset!> (list 'rotas0!> (list 'quote lst)) ![erst1!] ![erst2!])) (cond ((atom lst) (erm!> lst) (erm!> 8803) (msg!> 88033) !!er!!) (t (car lst))) )) (de rotas0!> (lst) % 05.96 (proc (w wa wm wr wc) (cond ((sp!>) (setq ![er!] 78041) (return !!er!!))) % null metric! (setq wm '(mat (0 1) (-1 0))) (cond ((null lst) (prog2 (setq wr t) (go lab)))) % matrix from ls % translating the rotation matrix ... (cond ((or (atom lst) (cdr lst) (atom(car lst))) (setq ![er!] 8500) (return !!er!!))) (setq lst (memlist!> '!, (car lst))) (cond ((or (eq lst !!er!!) (not(eqn (length lst) 2))) (setq ![er!] 8500) (return !!er!!))) (while!> lst (setq wa (car lst)) (setq lst (cdr lst)) (cond ((or (cdr wa) (atom(car wa))) (setq ![er!] 8500) (return !!er!!))) (setq wa (memlist!> '!, (car wa))) (cond ((or (eq wa !!er!!) (not(eqn (length wa) 2))) (setq ![er!] 8500) (return !!er!!))) (setq wa (mapcar wa (function translate!>))) (cond ((memq !!er!! wa) (return !!er!!))) (setq wa (mapcar wa 'nullzero!>)) (cond ((memq !!er!! wa) (setq ![er!] 8500) (return !!er!!))) (setq w (cons wa w))) lab % here we should have the matrix ... (cond (wr (cond (!#!L!S (setq w !#!L!S)) (t (setq ![er!] 4001) (return !!er!!)))) (t (setq w (reverse w)))) (setq wa (aeval (list 'times (cons 'mat w) wm (list2 'tp (cons 'mat w)) ))) (cond ((not(equal wa wm)) % chek for sl(2,c) (setq ![er!] 8501) (return !!er!!))) (setq ![ls!] w) (ls!-li!>) % ls -> li (li!-l!>) % li -> l (setq w (altdata!>(alldata!>))) (setq ![dens!] nil) % no density for spinorial rotations (while!> w % rotate all known objects ... (setq wc (car w)) (cond ((or (memq wc % skipping silently ... '( ![cord!] ![const!] ![fun!] ![sol!] ![apar!] !#!L !#!L!S !#!b !#!e )) (null(get wc '!=idxl))) nil) ((flagp wc '!+hold) (nonrot!> wc)) % skipping noisily... (t % rotating particular object ... (set wc (allcoll!> (eval wc) wc nil (cond ((get wc '!=idxl) (get wc '!=idxl)) (t '(0))) (function rotatel!>))) (cond ((flagp wc '!+uconn) (gammascorrect!> (eval wc) nil)) ((flagp wc '!+dconn) (gammascorrect!> (eval wc) t)) ((flagp wc '!+fconn) (gammacorrect!> (eval wc) ))) )) (setq w (cdr w))) (clearandfinish!>))) (de clearandfinish!> nil % 05.96 (progn % clearing all matrices ... (setq ![l!] nil) (setq ![li!] nil) (setq ![dl!] nil) (setq ![sdl!] nil) (setq ![ls!] nil) (setq ![dens!] nil) (setq ![dex!] nil) (setq ![dfx!] nil) (setq ![x!] nil) % new types of frame and metric ... (ftype!>) (mtype!>) (fitype!>) (mitype!>) % done message ... (done!>) )) % Build tensorial rotation from spinorial ... (de ls!-li!> nil % 05.96 (prog (wa wb) (setq ![li!] (mkt!> 2)) (fordim!> a do (fordim!> b do (progn (setq wa (tenspini!> a)) (setq wb (tenspini!> b)) (putel!> (evalalg!>(list 'times (getel2!> ![ls!] (car wb) (car wa)) (coalg!>(getel2!> ![ls!] (cdr wb) (cdr wa))))) ![li!] (list2 b a))))))) (de tenspini!> (w) % 05.96 (cond ((eqn w 0) '(1 . 1)) ((eqn w 1) '(0 . 0)) ((eqn w 2) '(1 . 0)) ((eqn w 3) '(0 . 1)))) % Build inverse transposed matrix ... (de li!-l!> nil % 05.96 (progn (setq ![l!] (mkt!> 2)) (rmat!> ![l!] (aeval(list 'quotient 1 (list 'tp (mat!> ![li!]))))))) (de l!-li!> nil (progn (setq ![li!] (mkt!> 2)) (rmat!> ![li!] (aeval(list 'quotient 1 (list 'tp (mat!> ![l!]))))))) % Correction for spinorial connection ... % WB=NIL - Undotted, WB=T - Dotted (de gammascorrect!> (w wb) % 05.96 (progn (putel1!> (evalform!> (dfsum!> (list (getel1!> w 0) (fndfpr!> (ls!> 0 1 wb) (dfunsgn!>(ls!> 0 0 wb))) (chsign!> t (fndfpr!> (ls!> 0 0 wb) (dfunsgn!>(ls!> 0 1 wb))))))) w 0) (putel1!> (evalform!> (dfsum!> (list (getel1!> w 1) (fndfpr!> (ls!> 1 1 wb) (dfunsgn!>(ls!> 0 0 wb))) (chsign!> t (fndfpr!> (ls!> 1 0 wb) (dfunsgn!>(ls!> 0 1 wb))))))) w 1) (putel1!> (evalform!> (dfsum!> (list (getel1!> w 2) (fndfpr!> (ls!> 1 1 wb) (dfunsgn!>(ls!> 1 0 wb))) (chsign!> t (fndfpr!> (ls!> 1 0 wb) (dfunsgn!>(ls!> 1 1 wb))))))) w 2))) (de dfunsgn!> (lst) % 05.96 (cond ((pmmm!>) (chsign!> t (dfun!> lst))) (t (dfun!> lst)))) % aux function ... (de nullzero!> (w) % 05.96 (cond ((null w) nil) ((zerop(car w)) (cdr w)) (t !!er!!))) %--- Rotation of single element 03.91, 05.96 --------------------------- % WI - Current Indices, WN - Internal Variable (de rotatel!> (lst wi wn) (cond ((syaidxp!> wi (get wn '!=sidxl)) % if wi is in canonic order ... (cond (![dens!] (dcorr!> wn (rotatel1!> wi nil (get wn '!=idxl) wn t nil))) (t (rotatel1!> wi nil (get wn '!=idxl) wn t nil)))) (t nil))) % WA,WI - Current Indices, WD - IDXL, WN - Int. Variable (de rotatel1!> (wi wa wd wn wf wc) % 05.96 (cond % Last element (IDXL is empty), so getting the value of the element ((null wd) (getsa0!> wn (reverse wa))) % Enumerating or Holonomic index, skipping ... ((or (enump!> (car wd)) (holp!> (car wd))) (rotatel1!> (cdr wi) (cons (car wi) wa) (cdr wd) wn t nil)) % Spinorial index ... ((spinp!>(car wd)) (prog (w wl we wx) (cond (wf (setq wa (cons 0 wa)) (setq wc (dotp!>(car wd))) (setq wf nil))) (foreach!> x in '(0 1) do (progn (setq wx (cond ((lessp (car wi) (cdar wd)) 0) (t 1))) (cond ((upperp!>(car wd)) (setq wl (lsi!> wx x wc))) (t (setq wl (ls!> wx x wc)))) (cond (wl (progn (setq we (rotatel1!> (cond ((eqn (cdar wd) 1) (cdr wi)) (t wi)) (cons (plus (car wa) x) (cdr wa)) (cond ((eqn (cdar wd) 1) (cdr wd)) (t (cons (cons (caar wd) (sub1(cdar wd))) (cdr wd)))) wn (cond ((eqn (cdar wd) 1) t) (t nil)) wc )) (cond (we (setq w (cons (cond ((algp!> wn) (multax!> wl we)) (t (multfx!> wl we))) w))))))))) (return (cond ((null w) nil) ((algp!> wn) (summax!> w)) (t (summfx!> w)))))) % Frame index ... (t(prog (w wl we) (fordim!> x do (progn (setq wl (lli!> (car wi) x (car wd))) (cond (wl (progn (setq we (rotatel1!> (cdr wi) (cons x wa) (cdr wd) wn t nil)) (cond (we (setq w (cons (cond ((algp!> wn) (multax!> wl we)) (t (multfx!> wl we))) w))))))))) (return (cond ((null w) nil) ((algp!> wn) (summax!> w)) (t (summfx!> w)))))))) % Element of LS matrix or ~LS matrix ... (de ls!> (wa wb wc) % 05.96 (cond (wc (coalg!> (getel2!> ![ls!] wa wb))) (t (getel2!> ![ls!] wa wb)))) % Element of inverse transposed spinorial matrix ... (de lsi!> (wa wb wc) % 05.96 (cond ((and (eqn wa 0) (eqn wb 0)) (ls!> 1 1 wc)) ((and (eqn wa 0) (eqn wb 1)) (chsigna!> (ls!> 1 0 wc))) ((and (eqn wa 1) (eqn wb 0)) (chsigna!> (ls!> 0 1 wc))) ((and (eqn wa 1) (eqn wb 1)) (ls!> 0 0 wc)))) % Element of L or LI matrix ... (de lli!> (wa wb wc) % 05.96 (cond (wc (getel2!> ![l!] wa wb)) (t (getel2!> ![li!] wa wb)))) %---------- Tensorial rotation 15.03.91, 05.96 --------------------------- % Main function ... (de rotat!> (lst bool) % 05.96 (prog2 (setq lst (errorset!> (list 'rotat0!> (list 'quote lst) bool) ![erst1!] ![erst2!])) (cond ((atom lst) (erm!> lst) (erm!> 8803) (msg!> 88033) !!er!!) (t (car lst))) )) % BOOL=T - Transformation, BOOL=NIL - Rotation (de rotat0!> (lst bool) (proc (w wa wm we wb wr wd wc) (cond ((null bool) % for rotation we need metric ... (setq ![chain!] nil) (setq we (request!> '!#!G)) (cond ((eq we !!er!!) (return we)) ((null we) (trsf!> '!#!G) (prin2 "Cannot perform rotation without Metric.") (terpri) (setq ![er!] 6046) (return !!er!!))) )) (cond ((null lst) (prog2 (setq wr t) (go lab))))% matrix from L (cond ((or (atom lst) (cdr lst) (atom(car lst)))% matrix in the command (prog2 (setq ![er!] 8500) (return !!er!!)))) (setq lst (memlist!> '!, (car lst))) (cond((or (eq lst !!er!!) (not(eqn (length lst) ![dim!]))) (prog2 (setq ![er!] 8500) (return !!er!!)))) (while!> lst (setq wa (car lst)) (setq lst(cdr lst)) (cond((or(cdr wa)(atom(car wa))) (prog2 (setq ![er!] 8500) (return !!er!!)))) (setq wa (memlist!> '!, (car wa))) (cond ((or (eq wa !!er!!) (not(eqn (length wa) ![dim!]))) (prog2 (setq ![er!] 8500) (return !!er!!)))) (setq wa (mapcar wa (function translate!>))) (cond ((memq !!er!! wa) (return !!er!!))) (setq wa (mapcar wa 'nullzero!>)) (cond ((memq !!er!! wa) (prog2 (setq ![er!] 8500) (return !!er!!)))) (setq w (cons wa w)) ) lab % here in w we should have the matrix already ... (cond (wr (cond (!#!L (setq w !#!L)) (t (prog2 (setq ![er!] 4001) (return !!er!!))))) (t (setq w (reverse w)))) (cond (bool(go lab1))) % transformation -> skipping correct rotation % checking for correct rotation ... (setq wm !#!G) (setq wm (cons 'mat (mapcar wm 'aeval2!>))) (setq wa (aeval (list 'times (cons 'mat w) wm (list2 'tp (cons 'mat w)) ))) (cond ((not (equal wa wm)) % check for correct rotation (prog2 (setq ![er!] 8502) (return !!er!!)))) lab1 % Here W is the matrix ... (setq wd (raeval!>(list 'det (cons 'mat w)))) % wd=detl (cond ((or (null wd) (zerop wd)) (prog2 (setq ![er!] 8504) (return !!er!!)))) (setq ![l!] w) (setq ![dl!] wd) % The most sabtle point in all machinery with densityes % and pseudotensors. We choose sign factor as % sdl = detL * sqrt(1/(detL)^2) <- we use this! % this gives transformation for pseudo tensors consistent % with their calculation after transformation. The sabtle % point is for imagenary detL this definition of sdl is % quite strange and is different from another % sdl1 = detL/sqrt((detL)^2) % in fact for positive real "a" we have: % detL: sdl: sdl1: % a 1 1 % -a -1 -1 % i*a -1 1 % -i*a 1 -1 % Actually the whole problem is in the way how to choose % the branch of sqrt. (setq ![sdl!] (raeval!> (list 'times ![dl!] (list 'sqrt (list 'quotient 1 (list 'expt ![dl!] 2)))))) (l!-li!>) (setq w (altdata!>(alldata!>))) (while!> w (setq wc (car w)) (cond ((memq wc '(![cord!] ![const!] ![fun!] ![sol!] ![apar!] !#!b !#!e )) nil) ((flagp wc '!+hold) (nonrot!> wc)) ((isspinor!> wc) (nonrot!> wc)) (t (prepldens!> wc) (set wc (allcoll!> (eval wc ) wc nil (cond ((get wc '!=idxl) (get wc '!=idxl)) (t '(0))) (function rotatel!>))) (cond ((flagp wc '!+fconn) (gammacorrect!> (eval wc) ))) )) (setq w (cdr w))) (clearandfinish!>))) (de aeval2!> (w) (mapcar w 'aeval1!>)) (de aeval1!> (w) (aeval(nz!> w))) % Correction for connection ... (de gammacorrect!> (w) % 05.96 (fordim!> a do (fordim!> b do (putel!> (evalform!> (dfsum!> (cons (getel2!> w a b) (mkldli!> a b)))) w (list2 a b))))) (de mkldli!> (wa wb) % 05.96 (foreach!> wx in (dimlist!> 0) collect (fndfpr!> (getel2!> ![l!] wa wx) (dfun!> (getel2!> ![li!] wb wx))))) (de nonrot!> (wd) % 05.96 (progn (gprinreset!>) (gprin!> "WARNING: ") (pn!> wd) (gprils0!> (cond ((flagp wd '!+pl) '("remain" "unchanged.")) (t '("remains" "unchanged.")))) (gterpri!>))) (de dcorr!> (wn w) (cond ((algp!> wn) (multax!> ![dens!] w)) (t (multfx!> ![dens!] w)))) (de prepldens!> (wn) (prog (w) (setq w (get wn '!=dens)) (cond ((null w) (setq ![dens!] nil)) ((and (null(caddr w)) (null(cadddr w))) (setq ![dens!] nil)) ((null(cadddr w)) (setq ![dens!] ![sdl!])) ((null(caddr w)) (setq ![dens!] (list 'expt ![dl!] (cadddr w)))) (t (setq ![dens!] (list 'times ![sdl!] (list 'expt ![dl!] (cadddr w)))))) (return ![dens!]))) %--- Coordinates Transformations 25.02.91, 05.96 ------------------------- % Main Function ... (de chcoord!> (lst) (prog2 (setq lst (errorset!> (list 'chcoord0!> (list 'quote lst)) ![erst1!] ![erst2!])) (cond ((atom lst) (erm!> lst) (erm!> 8803) (msg!> 88033) !!er!!) (t (car lst))) )) (de chcoord0!> (lst) % 05.96 ... (proc (w wn wa wb wd) (cond ((null lst) (return nil))) (setq wn 0) (setq ![xb!] nil) (while!> (and lst (not(eqs!> (car lst) 'with))) % word!!! (setq w (cons (car lst) w)) (setq lst (cdr lst))) (cond ((or (null w) (null lst) (null(cdr lst))) (setq ![er!] 8375) (return !!er!!))) (setq w (memlist!> '!, (reverse w))) (setq lst (memlist!> '!, (cdr lst))) (cond ((or (eq w !!er!!) (eq lst !!er!!) (not(eqn (length lst) ![dim!])) (not(eqn (length w) ![dim!]))) (setq ![er!] 8375) (return !!er!!))) (setq ![ocord!] ![cord!]) (setq ![cord!] nil) (while!> w % new coordinates list ... (cond ((or (cdar w) (not(idp(caar w)))) (setq ![er!] 8375) (remnew!>) (return !!er!!))) (cond ((flagp(caar w) '!+grg) (setq ![er!] 5013) (doub!>(caar w)) (remnew!>) (return !!er!!))) (flag (car w) 'used!*) (flag (car w) '!+grgvar) (flag (car w) '!+grg) (put (caar w) '!=cord wn) (cond (![apar!] (depend (cons (caar w) ![apar!])))) (setq ![cord!] (cons (caar w) ![cord!])) (setq wn (add1 wn)) (setq w (cdr w))) (setq ![cord!] (reverse ![cord!])) (setq ![dfx!] (mkt!> 1)) (setq ![x!] (mkt!> 1)) (while!> lst % x = f(x') ... (setq wa (car lst)) (setq lst (cdr lst)) (cond ((or (null(cdr wa)) (null(cddr wa)) (not(eq (cadr wa) '=)) (not(idp(car wa))) (not (memq (car wa) ![ocord!])) ) (setq ![er!] 8375) (remnew!>) (return !!er!!)) ((memold!> (cddr wa)) (setq ![er!] 8388) (remnew!>) (return !!er!!))) (setq wb (translate!>(cddr wa))) (cond ((eq wb !!er!!) (remnew!>) (return !!er!!)) ((not(zerop(car wb))) (setq ![er!] 8389) (remnew!>) (return !!er!!))) (setq wd (evalform!> (dfun1!> (cdr wb) nil))) (putel1!> (cdr wb) ![x!] (get (car wa) '!=cord)) (putel1!> wd ![dfx!] (get (car wa) '!=cord)) ) (setq w (evalform!>(dfprod!> ![dfx!]))) (cond ((null w) (setq ![er!] 8377)(remnew!>)(return !!er!!))) (setq ![dbas!] nil) (idfx!>) % d x -> /d x (ncfdep!>) % rebuilding implicit dependence (evalcomm!> '(all) (function ncel!>)) % transform all objects ... (remold!>) % remove old coordinates (copar1!> (ncons ![cord!])) % conjugated pairs (cond (![umod!] (mktables!>))) % refreshing tables in amode % now transforming holonomic indices ... (crotat0!>) % finish ... (clearandfinish!>))) (de ncel!> (lst wi wn) (cond ((null lst) nil) % in holonomic regime frame/inv frame stay holonomic ((and (eq wn '!#!T) (holonomicp!>)) lst) ((and (eq wn '!#!D) (holonomicp!>)) lst) ((eq wn '!#!b) (ncform0!> lst)) % b ((eq wn '!#!e) (ncvec0!> lst)) % e ((and (zerop(gettype!> wn)) (not (flagp wn '!+equ))) % alg (ncalg!> lst)) ((and (eqn(gettype!> wn)-1)(not (flagp wn '!+equ))) % vec (ncvec!> lst)) ((not (flagp wn '!+equ)) % form (ncform!> lst)) ((zerop(gettype!> wn)) % eq alg (equation!> (ncalg!>(cadr lst)) (ncalg!>(caddr lst)))) ((eqn(gettype!> wn)-1) % eq vec (equation!> (ncvec!>(cadr lst)) (ncvec!>(caddr lst)))) (t % eq alg (equation!> (ncform!>(cadr lst)) (ncform!>(caddr lst)))) )) % New coord for algebraic expression ... (de ncalg!> (w) (cond ((null w) w) (t (evalalg!> (ncalg0!> w))))) (de ncalg0!> (w) (cond ((and (idp w) (get w '!=cord)) (getel1!> ![x!] (get w '!=cord))) ((atom w) w) ((eq (car w) 'dfp) (list 'dfp (ncalg!>(cadr w)) (caddr w))) ((eq (car w) 'df) (ncdf!> (ncalg!>(cadr w)) (cddr w))) ((or (eq (car w) '!*sq) (eq (car w) 'taylor!*)) (err!> 9999)) (t (mapcar w (function ncalg0!>))))) % New coord for DF(...) ... (de ncdf!> (w wl) % w - expr, wl - diff list (cond ((null wl) w) (t(prog (wb wn wd) % wd - diff or number of coordinate (cond ((and (atom(car wl)) (memq (car wl) ![ocord!])) (setq wd (get (car wl) '!=cord))) (t (prog2 (setq wb t) (setq wd (car wl))))) % wn - how many times (cond ((and (cdr wl) (numberp(cadr wl))) (prog2 (setq wn (cadr wl)) (setq wl (cddr wl)))) (t (prog2 (setq wn 1) (setq wl (cdr wl))))) % not coordinate, so exiting (cond (wb (return (ncdf!> (list 'df w (ncalg!> wd) wn) wl)))) (setq wd (getel1!> ![dex!] wd)) % we diffentiate wn times (for!> x (1 1 wn) do (setq w (vfun!> wd w))) (return (ncdf!> w wl)))))) % New coord for form ... (de ncform!> (w) (cond ((null w) w) (t (evalform!> (dfsum!> (mapcar w (function ncform1!>))))))) (de ncform1!> (w) (fndfpr!> (ncalg!> (car w)) (ncxb!> (cdr w) ![umod!]))) % New coord for d X/\d Y/\... (de ncxb!> (w wm) (cond (wm (ncons (cons 1 w))) ((assoc (car w) ![xb!]) (cadr(assoc (car w) ![xb!]))) (t(progn (setq ![xb!] (cons (list2 (car w) (evalform!> (mkxb!>(cdr w)))) ![xb!])) (cadar ![xb!]))))) (de mkxb!> (w) (proc (wa wn) (setq wn 0) (while!> w (cond ((caar w) (setq wa (cons (getel1!> ![dfx!] wn) wa)))) (setq wn (add1 wn)) (setq w (cdr w))) (return (evalform!> (dfprod!> (reverse wa)))))) (de ncform0!> (w) (cond ((null w) w) (t (evalform!> (dfsum!> (mapcar w (function ncform00!>))))))) (de ncform00!> (w) (fndfpr!> (ncalg!> (car w)) (ncxb!> (cdr w) nil))) % New coord for vector ... (de ncvec!> (w) (cond ((null w) w) (t (evalform!> (dfsum!> (mapcar w (function ncvec1!>))))))) (de ncvec1!> (w) (fndfpr!> (ncalg!> (car w)) (ncxv!> (cdr w) ![umod!]))) (de ncxv!> (w wm) (proc (wc) (cond (wm (return (ncons (cons 1 w))))) (setq wc -1) (setq w (car w)) (while!> (not(eqn w 1)) (setq w (quotient w 2)) (setq wc (add1 wc)) ) (return (getel1!> ![dex!] wc)) )) (de ncvec0!> (w) (cond ((null w) w) (t (evalform!> (dfsum!> (mapcar w (function ncvec00!>))))))) (de ncvec00!> (w) (fndfpr!> (ncalg!> (car w)) (ncxv!> (cdr w) nil))) % d x -> /d x (de idfx!> nil (prog (w) (setq ![dex!] (mkt!> 1)) (setq w (aeval (list 'tp (list 'quotient 1 (mkmtetr!> ![dfx!]))))) (mktetrm!> (cdr w) ![dex!]) (return t))) % New coord for implicit function dependence ... (de ncfdep!> nil (prog (wd wn) (foreach!> x in ![fun!] do (prog2 (setq wd (get x '!=depend)) (cond (wd (progn (setq wn (vard!> (ncalg0!> wd))) (nodepend wd) (depend wn) (put x '!=depend wn)))))))) (de vard!> (lst) (cond ((and (atom lst) (flagp lst '!+grgvar)) (ncons lst)) ((atom lst) nil) (t (appmem!> (vard!>(car lst)) (vard!>(cdr lst)))))) (de memold!> (w) (cond ((and (atom w) (memq w ![ocord!])) t) ((atom w) nil) (t (or (memold!>(car w)) (memold!>(cdr w)))))) (de remold!> nil (progn (remflag ![ocord!] '!+grg) (remflag ![ocord!] '!+grgvar) (remflag ![ocord!] 'used!*) (foreach!> x in ![ocord!] do (progn (cond (![apar!] (nodepend (cons x ![apar!])))) (remprop x '!=cord) (remprop x '!=conj))) (setq ![xb!] nil) (setq ![ocord!] nil) )) (de remnew!> nil (progn (remflag ![cord!] '!+grg) (remflag ![cord!] '!+grgvar) (remflag ![cord!] 'used!*) (foreach!> x in ![cord!] do (progn (cond (![apar!] (nodepend (cons x ![apar!])))) (remprop x '!=cord))) (setq ![cord!] ![ocord!]) (setq ![dex!] nil) (setq ![dfx!] nil) (setq ![x!] nil) (setq ![xb!] nil) (setq ![ocord!] nil) )) (de crotat0!> nil (proc (w wa wm we wb wr wd wc) % here w is the matrix ... (setq w (foreach!> a in (dimlist!> 0) collect (foreach!> b in (dimlist!> 0) collect (getfdx!> (getel1!> ![dex!] b) a)))) (setq wd (raeval!> (list 'det (cons 'mat w)))) (cond ((or (null wd) (zerop wd)) (prog2 (setq ![er!] 8377) (return !!er!!)))) (setq ![l!] w) % d = d xnew/d xold (setq ![dl!] wd) % detd (setq ![sdl!] (raeval!> % sign(detd) (list 'times ![dl!] (list 'sqrt (list 'quotient 1 (list 'expt ![dl!] 2)))))) (l!-li!>) % d^(-1) (setq w (altdata!>(alldata!>))) % transforming all ... (while!> w (setq wc (car w)) (cond ((memq wc '(![cord!] ![const!] ![fun!] ![sol!] ![apar!] % skipping !#!b !#!e )) nil) ((and (holonomicp!>) (eq wc '!#!T)) (msg!> 8391)) % keep T ((and (holonomicp!>) (eq wc '!#!D)) (msg!> 8392)) % keep D ((not(mustbecrotated!> wc)) nil) % skipping ((flagp wc '!+hold) (nonrot!> wc)) % skipping noisily (t (cprepdens!> wc) % prepare density (set wc (allcoll!> (eval wc ) wc nil (cond ((get wc '!=idxl) (get wc '!=idxl)) (t '(0))) (function crotatel!>))) % correct connection (cond % holonomic ... ((flagp wc '!+hconn) (gammacorrect!> (eval wc))) % in holonomic regime holonomir = frame ... ((and (flagp wc '!+fconn) (holonomicp!>)) (gammacorrect!> (eval wc)))) )) (setq w (cdr w))) )) % Defines whether this object requires any cord rotation or not ... (de mustbecrotated!> (w) (or (hashol!> w) % it has hol. index (and (holonomicp!>) (hasfram!> w)) % in hol. regime hol.=frame (get w '!=dens))) % density correction % Rotate an element ... (de crotatel!> (lst wi wn) (cond ((syaidxp!> wi (get wn '!=sidxl)) % if wi is in canonic order ... (cond (![dens!] (dcorr!> wn (crotatel1!> wi nil (get wn '!=idxl) wn t nil))) (t (crotatel1!> wi nil (get wn '!=idxl) wn t nil)))) (t nil))) % Prepares density correction ... (de cprepdens!> (wn) (prog (w) (setq w (get wn '!=dens)) % In hol. regime if exists DENS for frame roration % then we use it ... (cond ((and w (holonomicp!>) (or (caddr w) (cadddr w))) (return (prepldens!> wn)))) (cond ((null w) (setq ![dens!] nil)) ((and (null(car w)) (null(cadr w))) (setq ![dens!] nil)) ((null(cadr w)) (setq ![dens!] ![sdl!])) ((null(car w)) (setq ![dens!] (list 'expt ![dl!] (cadr w)))) (t (setq ![dens!] (list 'times ![sdl!] (list 'expt ![dl!] (cadr w)))))) (return ![dens!]))) % WA,WI - Current Indices, WD - IDXL, WN - Int. Variable (de crotatel1!> (wi wa wd wn wf wc) % 05.96 (cond % Last element (IDXL is empty), so getting the value of the element ((null wd) (getsa0!> wn (reverse wa))) % Enumerating or Spinor index, or Frame in Nonholonomic skipping ... ((or (enump!> (car wd)) (spinp!> (car wd)) (and (tetrp!> wd) (not(holonomicp!>)))) (crotatel1!> (cdr wi) (cons (car wi) wa) (cdr wd) wn t nil)) % Holonomic of Frame in holonomic mode index ... (t(prog (w wl we) (fordim!> x do (progn (setq wl (lli!> (car wi) x (upperp!>(car wd)))) (cond (wl (progn (setq we (crotatel1!> (cdr wi) (cons x wa) (cdr wd) wn t nil)) (cond (we (setq w (cons (cond ((algp!> wn) (multax!> wl we)) (t (multfx!> wl we))) w))))))))) (return (cond ((null w) nil) ((algp!> wn) (summax!> w)) (t (summfx!> w)))))))) %----- Lie Derivatives --------------------------------------------------- (de lietr!> (lst) (prog (wv wn wi wi1 wl wm wsi wr) % wv - vector, wn - int.var. of differentiated object % wi - idxl of wn, wl - indices, wm - manipulations % wi1 - new idxl after manipulation (setq lst (memlist!> '!, lst)) (cond ((eq lst !!er!!) (err!> 2020)) ((not(eqn (length lst) 2)) (err!> 2500))) (setq wv (unitra0!> (car lst))) % vector (setq lst (cadr lst)) % lst = (id (...)) % Internal variable ... (cond ((not(idp(car lst))) (err!> 2500)) (t (setq wn (incomiv!>(explode(car lst)))))) (cond ((not (or (flagp wn '!+ivar) (flagp wn '!+macros2))) (err!> 2500)) ((flagp wn '!+noncov) (err!> 2502))) % Indices ... (setq wi (get wn '!=idxl)) (cond ((null wi) (cond ((not(eqn (length lst) 1)) (err!> 2207))) (setq wi nil) (go lab)) ((null(cdr lst)) (err!> 2207)) ((not(pairp(cadr lst))) (err!> 2102))) (setq lst (memlist!> '!, (cadr lst))) (cond ((eq lst !!er!!) (err!> 2020)) ((not(eqn (length lst) (length wi))) (err!> 2207))) (setq wm (mapcar lst 'selmani!>)) % manipulations (setq lst (mapcar lst 'delmani!>)) (setq wl (mapcar lst (function unitra0!>))) (setq wi1 (chidxl!> wi wm)) % Maybe we need T and D ... (cond ((frameorspin!> wi1) (require!> '( !#!T !#!D )))) lab (cond ((get wn '!=dens) (require!> '( !#!T !#!D )))) % Einstein summation ... (setq wsi (intersecl!> (freevar!> wv ![extvar!]) (freevar!> wl ![extvar!]))) % result ... (setq wr (list 'lieexec!> wn wi1 wl wm wv)) (cond (wsi (setq wr (mkeinsum0!> wsi wr)))) (return wr) )) (de frameorspin!> (wi) (cond ((null wi) nil) ((or (spinp!>(car wi)) (tetrp!>(car wi))) t) (t (frameorspin!>(cdr wi))))) (de chidxl!> (wi wm) (cond ((null wi) nil) (t (cons (chidxl1!> (car wi) (car wm)) (chidxl!> (cdr wi) (cdr wm)))))) (de chidxl1!> (wi wm) (cond ((null wm) wi) ((enump!> wi) wi) ((eqn wm 1) % ' cvalificator - up (cond ((and (spinp!> wi) (not(upperp!> wi))) (spinup!> wi)) % .s -> 's ((holpd!> wi) t) % .g -> 't ((tetrpd!> wi) t) % .t -> 't ((holpu!> wi) t) % 'g -> 't (t wi))) ((eqn wm 2) % . cvalificator - down (cond ((and (spinp!> wi) (upperp!> wi)) (spindown!> wi)) % 's -> .s ((holpu!> wi) nil) % 'g -> .t ((tetrpu!> wi) nil) % 't -> .t ((holpd!> wi) nil) % .g -> .t (t wi))) ((eqn wm 3) % ^ cvalificator - g up (cond ((spinp!> wi) (err!> 9913)) ((holpd!> wi) 1) % .g -> 'g ((tetrpd!> wi) 1) % .t -> 'g ((tetrpu!> wi) 1) % 't -> 'g (t wi))) ((eqn wm 4) % _ cvalificator - g down (cond ((spinp!> wi) (err!> 9913)) ((holpu!> wi) 0) % 'g -> .g ((tetrpu!> wi) 0) % 't -> .g ((tetrpd!> wi) 0) % .t -> .g (t wi))) )) (de spinup!> (wi) (cond ((eq (car wi) 'u) (cons 'uu (cdr wi))) ((eq (car wi) 'd) (cons 'ud (cdr wi))) (t wi))) (de spindown!> (wi) (cond ((eq (car wi) 'uu) (cons 'u (cdr wi))) ((eq (car wi) 'ud) (cons 'd (cdr wi))) (t wi))) (de cdrnil!> (w) (cond ((null w) nil) (t (cdr w)))) % wv - vector, wn - int. variable, wi - modified idxl % wl - index list, wm - ind. manipulations (de lieexec!> (wn wi wl wm wv) (prog (wt wr w0 ww wi1 wl0 wl1 wc wd) % evaluating vector ... (setq wv (unieval!> wv)) (cond ((null wv) (return nil)) ((not(eqn (car wv) -1)) (err!> 2501))) (setq wv (cdr wv)) % evaluating indices ... (setq wl (mapcar wl 'unieval!>)) % type of expression ... (setq wt (get wn '!=type)) % main element of lie derivative (setq ww (cdrnil!>(funapply!> wn wl wm))) (setq w0 ww) (cond ((eqn wt 0) (setq wr (ncons(vfun!> wv ww)))) % ksi | w ((eqn wt -1) (setq wr (ncons(vbrack!> wv ww)))) % [ksi,w] ((eqn wt 1) (setq wr (list2 (vform!> wv (dex!> ww)) % ksi _| d w (dfun!> (vform1!> wv ww))))) % + d ksi _| w (t (setq wr (list2 (vform!> wv (dex!> ww)) % ksi _| d w (dex!> (vform!> wv ww)))))) % + d ksi _| w (setq wl1 wl) (setq wi1 wi) % for all indices ... (while!> wl1 (cond % frame or holonomic ... ((or (tetrp!>(car wi1)) (holp!>(car wi1))) (fordim!> x do (progn (setq wc (liecoef!> (tonumb!>(car wl1)) x wv (car wi1))) (cond (wc (setq ww (cdrnil!>(funapply!> wn (app!> wl0 (cons (tocalg!> x) (cdr wl1))) wm))))) (cond (wc (setq wr (cons (cond ((zerop wt) (mktimes2!> wc ww)) (t (fndfpr!> wc ww))) wr))))))) % spinorial index ... ((spinp!>(car wi1)) (for!> x (0 1 2) do (progn (setq wc (liespin!> (tonumb!>(car wl1)) x wv (car wi1))) (cond (wc (setq ww (cdrnil!>(funapply!> wn (app!> wl0 (cons (tocalg!> (sind!> (tonumb!>(car wl1)) x (car wi1))) (cdr wl1))) wm))))) (cond (wc (setq wr (cons (cond ((zerop wt) (mktimes2!> wc ww)) (t (fndfpr!> wc ww))) wr))))))) (t nil)) (setq wl0 (cons (car wl1) wl0)) (setq wl1 (cdr wl1)) (setq wi1 (cdr wi1))) % density ... (setq wd (get wn '!=dens)) (cond (wd (setq wd (mkplus2!> (mktimes2!> (cadr wd) (ksisum!> wv)) (mktimes2!> (cadddr wd) (zetasum!> wv)))))) (cond (wd (setq wd (chsign!> nil wd)) (setq wr (cons (cond ((zerop wt) (mktimes2!> wd w0)) (t (fndfpr!> wd w0))) wr)))) % result ... (cond ((zerop wt) (setq wr (evalalg!>(algsum!> wr)))) (t (setq wr (evalform!>(dfsum!> wr))))) (cond ((null wr) (return nil))) (return (cons wt wr))) ) (de mkplus2!> (wa wb) (cond ((and (null wa) (null wb)) nil) ((null wa) wb) ((null wb) wa) (t (list 'plus wa wb)))) % Frame and Holonomic indices ... (de liecoef!> (wa wb wv wi) (cond ((holpu!> wi) (evalalg!> (chsign!> nil (ksicoef!> wa wb wv)))) ((holpd!> wi) (evalalg!> (ksicoef!> wb wa wv))) ((tetrpu!> wi) (evalalg!> (chsign!> nil (zetacoef!> wa wb wv)))) ((tetrpd!> wi) (evalalg!> (zetacoef!> wb wa wv))) )) % KSI^a_b (de ksicoef!> (wa wb wv) (prog2 (setq wv (cond (![umod!] (vform1!> wv (getel1!> ![xf!] wa))) (t (getfdx!> wv wa)))) (cond ((null wv) wv) (t (list 'df wv (getel1!> ![cord!] wb)))))) % ZETA'a.b (de zetacoef!> (wa wb wv) (prog2 (setq wv (dfsum!> (list (dfun!> (vform1!> wv (getframe!> wa))) (vform!> wv (dex!> (getframe!> wa)))))) (vform1!> (getiframe!> wb) wv))) % KSI^x_x (de ksisum!> (wv) (prog (w) (fordim!> x do (setq w (cons (ksicoef!> x x wv) w))) (return (evalalg!> (algsum!> w))))) % ZETA'm.m (de zetasum!> (wv) (prog (w) (fordim!> x do (setq w (cons (zetacoef!> x x wv) w))) (return (evalalg!> (algsum!> w))))) % Spinorial indices ... (de liespin!> (wk wx wv wi) (prog (w) (setq w (spinumb!> wk wx wi)) (cond ((zerop w) (return nil))) (return (mktimes2!> w (cond ((dotp!> wi) (zetaspinc!> wx wv)) (t (zetaspin!> wx wv))))))) (de spinumb!> (wk wx wi) (cond % upper spinorial ... ((upperp!> wi) (cond ((eqn wx 0) (cond ((greaterp wk 0) (pm!> wk)) (t 0 ))) ((eqn wx 1) (pm!>(difference (times 2 wk) (cdr wi)))) ((eqn wx 2) (cond ((lessp wk (cdr wi)) (pm!>(difference wk (cdr wi)))) (t 0 ))))) % lower spinorial ... (t (cond ((eqn wx 0) (cond ((lessp wk (cdr wi)) (pm!>(difference wk (cdr wi)))) (t 0 ))) ((eqn wx 1) (mp!>(difference (times 2 wk) (cdr wi)))) ((eqn wx 2) (cond ((greaterp wk 0) (pm!> wk)) (t 0 ))))))) (de sind!> (wk wx wi) (cond ((upperp!> wi) (plus wk (sub1 wx))) (t (plus wk (minus(sub1 wx)))))) % ZETA_AA (de zetaspin!> (wa wv) (cond ((eqn wa 0) (mpa!>(zetacoef!> 2 1 wv))) ((eqn wa 1) (pma!>(evalalg!> (list 'quotient (list 'plus (zetacoef!> 3 3 wv) (zetacoef!> 1 1 wv)) 2)))) ((eqn wa 2) (pma!>(zetacoef!> 3 0 wv))))) % ZETA~_AA (de zetaspinc!> (wa wv) (cond ((eqn wa 0) (mpa!>(zetacoef!> 3 1 wv))) ((eqn wa 1) (pma!>(evalalg!> (list 'quotient (list 'plus (zetacoef!> 2 2 wv) (zetacoef!> 1 1 wv)) 2)))) ((eqn wa 2) (pma!>(zetacoef!> 2 0 wv))))) (de tocalg!> (w) (cond ((null w) '(0 . 0)) (t (cons 0 w)))) (de tonumb!> (w) (cond ((null w) 0) (t (cdr w)))) (de pm!> (w) (cond ((not(pmmm!>)) w) (t (minus w )))) (de mp!> (w) (cond ((pmmm!>) w) (t (minus w )))) (de pma!> (w) (cond ((not(pmmm!>)) w) (t (chsign!> nil w )))) (de mpa!> (w) (cond ((pmmm!>) w) (t (chsign!> nil w )))) (de pmf!> (w) (cond ((not(pmmm!>)) w) (t (chsign!> t w )))) (de mpf!> (w) (cond ((pmmm!>) w) (t (chsign!> t w )))) %------- Covariant Differential ------------------------------------------- (de dctran!> (lst) (prog (wn wi wi1 wl wm wc w wf wh wu wd) % wn - int.var. of differentiated object % wi - idxl of wn, wl - indices, wm - manipulations % wi1 - new idxl after manipulation % wc - possible list of alternative connections (setq lst (memlist!> '!, lst)) (cond ((eq lst !!er!!) (err!> 2020))) (setq wc (cdr lst)) (setq lst (car lst)) % lst = (id (...)) % Internal variable ... (cond ((not(idp(car lst))) (err!> 2600)) (t (setq wn (incomiv!>(explode(car lst)))))) (cond ((not (or (flagp wn '!+ivar) (flagp wn '!+macros2))) (err!> 2600)) ((flagp wn '!+noncov) (err!> 2602)) ((eqn (get wn '!=type) -1) (err!> 2004))) % Indices ... (setq wi (get wn '!=idxl)) % We need connections ... (setq wf '!#!o!m!e!g!a) (setq wh '!#!G!A!M!M!A) (setq wu '!#!o!m!e!g!a!u) (setq wd '!#!o!m!e!g!a!d) (cond ((holonomicp!>) (setq wh '!#!o!m!e!g!a))) % possible alternative connections ... (cond (wc (setq wc (mapcar wc 'car)) (foreach!> wx in wc do (progn (cond ((not(idp wx)) (err!> 2603))) (setq w (incomiv!>(explode wx))) (cond ((flagp w '!+fconn) (setq wf w) (cond ((holonomicp!>) (setq wh w)))) ((flagp w '!+hconn) (setq wh w) (cond ((holonomicp!>) (setq wf w)))) ((flagp w '!+uconn) (setq wu w)) ((flagp w '!+dconn) (setq wd w)) (t (err!> 2603))))))) (setq wc (list wf wh wu wd)) % indices ... (cond ((null wi) (cond ((not(eqn (length lst) 1)) (err!> 2207))) (setq wi nil) (go lab)) ((null(cdr lst)) (err!> 2207)) ((not(pairp(cadr lst))) (err!> 2102))) (setq lst (memlist!> '!, (cadr lst))) (cond ((eq lst !!er!!) (err!> 2020)) ((not(eqn (length lst) (length wi))) (err!> 2207))) (setq wm (mapcar lst 'selmani!>)) % manipulations (setq lst (mapcar lst 'delmani!>)) (setq wl (mapcar lst (function unitra0!>))) (setq wi1 (chidxl!> wi wm)) % which of connections we really need ... (foreach!> wx in wi1 do (cond ((tetrp!> wx) (require!> (list wf))) ((holp!> wx) (require!> (list wh))) ((undotp!> wx) (require!> (list wu))) ((dotp!> wx) (require!> (list wd))) )) lab (cond ((get wn '!=dens) (cond ((cadr(get wn '!=dens)) (require!> (list wh)))) (cond ((cadddr(get wn '!=dens)) (require!> (list wf)))) )) % result ... (return (list 'dcexec!> wn wi1 wl wm wc)) )) % wn - int. variable, wi - modified idxl % wl - index list, wm - ind. manipulations % wo - connections (de dcexec!> (wn wi wl wm wo) (prog (wt wr w0 ww wi1 wl0 wl1 wc wd) % evaluating connections ... (setq wo (mapcar wo 'eval)) % evaluating indices ... (setq wl (mapcar wl 'unieval!>)) % type of expression ... (setq wt (get wn '!=type)) % main differential (setq ww (cdrnil!>(funapply!> wn wl wm))) (setq w0 ww) (cond ((eqn wt 0) (setq wr (ncons(dfun!> ww)))) % d alg (t (setq wr (ncons(dex!> ww))))) % d form (setq wl1 wl) (setq wi1 wi) % for all indices ... (while!> wl1 (cond % frame or holonomic ... ((or (tetrp!>(car wi1)) (holp!>(car wi1))) (fordim!> x do (progn (setq wc (concoef!> (tonumb!>(car wl1)) x (car wi1) wo)) (cond (wc (setq ww (cdrnil!>(funapply!> wn (app!> wl0 (cons (tocalg!> x) (cdr wl1))) wm))))) (cond (wc (setq wr (cons (cond ((zerop wt) (fndfpr!> ww wc)) (t (dfprod2!> wc ww))) wr))))))) % spinorial index ... ((spinp!>(car wi1)) (for!> x (0 1 2) do (progn (setq wc (conspin!> (tonumb!>(car wl1)) x (car wi1) wo)) (cond (wc (setq ww (cdrnil!>(funapply!> wn (app!> wl0 (cons (tocalg!> (sind!> (tonumb!>(car wl1)) x (car wi1))) (cdr wl1))) wm))))) (cond (wc (setq wr (cons (cond ((zerop wt) (fndfpr!> ww wc)) (t (dfprod2!> wc ww))) wr))))))) (t nil)) (setq wl0 (cons (car wl1) wl0)) (setq wl1 (cdr wl1)) (setq wi1 (cdr wi1))) % density ... (setq wd (get wn '!=dens)) (cond (wd (setq wd (evalform!> (dfsum2!> (cond ((cadr wd) (fndfpr!>(cadr wd)(hosum!> wo)))(t nil)) (cond ((cadddr wd) (fndfpr!>(cadddr wd)(fosum!> wo)))(t nil)) ))))) (cond (wd (setq wr (cons (cond ((zerop wt) (fndfpr!> w0 wd)) (t (fndfpr!> wd w0))) wr)))) % result ... (setq wr (evalform!>(dfsum!> wr))) (cond ((null wr) (return nil))) (return (cons (add1 wt) wr))) ) % Frame of Holonomic ... (de concoef!> (wa wb wi wo) (cond ((tetrpu!> wi) (getel2!> (car wo) wa wb)) ((tetrpd!> wi) (chsignf!>(getel2!>(car wo) wb wa))) ((holpu!> wi) (getel2!> (cadr wo) wa wb)) ((holpd!> wi) (chsignf!>(getel2!>(cadr wo) wb wa))))) % Spinorial ... (de conspin!> (wk wx wi wo) (prog (w) (setq w (spinumb!> wk wx wi)) (cond ((zerop w) (return nil))) (return (fndfpr!> (chsigna!> w) (cond ((dotp!> wi) (getel1!> (cadddr wo) wx)) (t (getel1!> (caddr wo) wx))))))) % Summed connection ... (de fosum!> (wo) (prog (w) (setq wo (car wo)) (fordim!> wx do (setq w (cons (getel2!> wo wx wx) w))) (return(dfsum!> w)))) (de hosum!> (wo) (prog (w) (setq wo (cadr wo)) (fordim!> wx do (setq w (cons (getel2!> wo wx wx) w))) (return(dfsum!> w)))) %------- Covariant Derivative --------------------------------------------- (de dfctran!> (lst) (prog (wv wn wi wi1 wl wm wc w wf wh wu wd wsi wr) % wv - vector % wn - int.var. of differentiated object % wi - idxl of wn, wl - indices, wm - manipulations % wi1 - new idxl after manipulation % wc - possible list of alternative connections (setq lst (memlist!> '!, lst)) (cond ((eq lst !!er!!) (err!> 2020)) ((lessp (length lst) 2) (err!> 2700))) (setq wv (unitra0!> (car lst))) % vector (setq lst (cdr lst)) (setq wc (cdr lst)) % alternative connections (setq lst (car lst)) % lst = (id (...)) % Internal variable ... (cond ((not(idp(car lst))) (err!> 2700)) (t (setq wn (incomiv!>(explode(car lst)))))) (cond ((not (or (flagp wn '!+ivar) (flagp wn '!+macros2))) (err!> 2700)) ((flagp wn '!+noncov) (err!> 2702)) ((not(eqn (get wn '!=type) 0)_) (err!> 2704))) % Indices ... (setq wi (get wn '!=idxl)) % We need connections ... (setq wf '!#!o!m!e!g!a) (setq wh '!#!G!A!M!M!A) (setq wu '!#!o!m!e!g!a!u) (setq wd '!#!o!m!e!g!a!d) (cond ((holonomicp!>) (setq wh '!#!o!m!e!g!a))) % possible alternative connections ... (cond (wc (setq wc (mapcar wc 'car)) (foreach!> wx in wc do (progn (cond ((not(idp wx)) (err!> 2703))) (setq w (incomiv!>(explode wx))) (cond ((flagp w '!+fconn) (setq wf w) (cond ((holonomicp!>) (setq wh w)))) ((flagp w '!+hconn) (setq wh w) (cond ((holonomicp!>) (setq wf w)))) ((flagp w '!+uconn) (setq wu w)) ((flagp w '!+dconn) (setq wd w)) (t (err!> 2703))))))) (setq wc (list wf wh wu wd)) % indices ... (cond ((null wi) (cond ((not(eqn (length lst) 1)) (err!> 2207))) (setq wi nil) (go lab)) ((null(cdr lst)) (err!> 2207)) ((not(pairp(cadr lst))) (err!> 2102))) (setq lst (memlist!> '!, (cadr lst))) (cond ((eq lst !!er!!) (err!> 2020)) ((not(eqn (length lst) (length wi))) (err!> 2207))) (setq wm (mapcar lst 'selmani!>)) % manipulations (setq lst (mapcar lst 'delmani!>)) (setq wl (mapcar lst (function unitra0!>))) (setq wi1 (chidxl!> wi wm)) % which of connections we really need ... (foreach!> wx in wi1 do (cond ((tetrp!> wx) (require!> (list wf))) ((holp!> wx) (require!> (list wh))) ((undotp!> wx) (require!> (list wu))) ((dotp!> wx) (require!> (list wd))) )) lab (cond ((get wn '!=dens) (cond ((cadr(get wn '!=dens)) (require!> (list wh)))) (cond ((cadddr(get wn '!=dens)) (require!> (list wf)))) )) % einstein summation ... (setq wsi (intersecl!> (freevar!> wv ![extvar!]) (freevar!> wl ![extvar!]))) % result ... (setq wr (list 'dfcexec!> wn wi1 wl wm wc wv)) (cond (wsi (setq wr (mkeinsum0!> wsi wr)))) (return wr) )) % wn - int. variable, wi - modified idxl % wl - index list, wm - ind. manipulations % wo - connections, wv - vector (de dfcexec!> (wn wi wl wm wo wv) (prog (wr w0 ww wi1 wl0 wl1 wc wd) % evaluating vector ... (setq wv (unieval!> wv)) (cond ((null wv) (return nil)) ((not(eqn (car wv) -1)) (err!> 2701))) (setq wv (cdr wv)) % evaluating connections ... (setq wo (mapcar wo 'eval)) % evaluating indices ... (setq wl (mapcar wl 'unieval!>)) % main differential (setq ww (cdrnil!>(funapply!> wn wl wm))) (setq w0 ww) (setq wr (ncons(dfun!> ww))) % d alg (setq wl1 wl) (setq wi1 wi) % for all indices ... (while!> wl1 (cond % frame or holonomic ... ((or (tetrp!>(car wi1)) (holp!>(car wi1))) (fordim!> x do (progn (setq wc (concoef!> (tonumb!>(car wl1)) x (car wi1) wo)) (cond (wc (setq ww (cdrnil!>(funapply!> wn (app!> wl0 (cons (tocalg!> x) (cdr wl1))) wm))))) (cond (wc (setq wr (cons (fndfpr!> ww wc) wr))))))) % spinorial index ... ((spinp!>(car wi1)) (for!> x (0 1 2) do (progn (setq wc (conspin!> (tonumb!>(car wl1)) x (car wi1) wo)) (cond (wc (setq ww (cdrnil!>(funapply!> wn (app!> wl0 (cons (tocalg!> (sind!> (tonumb!>(car wl1)) x (car wi1))) (cdr wl1))) wm))))) (cond (wc (setq wr (cons (fndfpr!> ww wc) wr))))))) (t nil)) (setq wl0 (cons (car wl1) wl0)) (setq wl1 (cdr wl1)) (setq wi1 (cdr wi1))) % density ... (setq wd (get wn '!=dens)) (cond (wd (setq wd (evalform!> (dfsum2!> (cond ((cadr wd) (fndfpr!>(cadr wd)(hosum!> wo)))(t nil)) (cond ((cadddr wd) (fndfpr!>(cadddr wd)(fosum!> wo)))(t nil)) ))))) (cond (wd (setq wr (cons (fndfpr!> w0 wd) wr)))) % result ... (setq wr (evalalg!>(vform1!> wv (dfsum!> wr)))) (cond ((null wr) (return nil))) (return (cons 0 wr))) ) %======= End of GRGcoper.sl ===============================================% |
Added grgdecl.sl version [fca031d98c].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 | %==========================================================================% % GRGdecl.sl Internal Variables, Flags, Properties % %==========================================================================% % GRG 3.2 Standard Lisp Source Code (C) 1988-2000 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. % %==========================================================================% % % Notation for GRG symbols : % % !!sym!! - Self-Quoted Symbols % ![sys!] - Internal GRG Control or Working System Variables % !#id - Internal Variables of Built-in Objects % !+flag - GRG Specific Flags % !=prop - GRG Specific Properties % !*switch - GRG and REDUCE Switches % funtion!> - GRG functions % %========== (1) Internal GRG Control Variables ========================== (put 'grg 'stat 'endstat) % Making grg; REDUCE command ... %---------- GRG System Variables -------------------------------------- (global '( ![version!] % Version number % Start mode : ![autostart!] % Run (grg) atomatically during load grg; or not % General Status : ![dim!] % Current Dimension 4 ![dim1!] % dim-1 ![sgn!] % Current Signature (-1 1 1 1) ![sigprod!] % prod(-1 1 1 1) ![dim0!] % Initial Dimension and ![sgn0!] % Signature in the session ![umod!] % Current basis mode % Metric and Frame Type : ![mtype!] % Metric type: nil - unknown ![mitype!] % 1 - null 2 - diagonal 3 - general ![dtype!] % Metric differentiability: nil - unknown ![ditype!] % 1 - constant 2 - general ![ftype!] % Frame type: nil - unknown ![fitype!] % 1 - holonomic 2 - diagonal 3 - general ![nullm!] % Standard Null Metric for -,+,+,+ ![nullm1!] % Standard Null Metric for +,-,-,- % Others working variables : ![w!] % General purpose ![instr!] % All Commands list ![datl!] % All Objects ![abbr!] % All User-Defined Objects (Abbreviations) ![rconstl!] % List of reserved constants ![sublist!] % Substitutions List ![rpfl!] % Flags and properties which must be cleared ![rpflcr!] % for Coordinates ![rpflcn!] % for Constants ![rpflap!] % for Affine Parameter ![rpflfu!] % for Functions ![tlst!] % List of Energy-Momentum tensors ![slst!] % List of spin forms ![solveq!] % Equations for solve ![allprops!] % All Flags and Props ![allflags!] % important for Load/Unload ![icompos!] % List of Commands allowed in composites ![newabbr!] % New object in assignment ![wi!] ![wh!] ![wf!] ![ws!] ![gfun!] % Generic functions list % Session Control : ![er!] % Error type ![firsti!] % First instruction indicator for Dimension ![time!] % Timer ![gctime!] % GC Timer ![ttime!] % Total Session Time ![tgctime!] % Total GC Time ![pause!] % Pause regim indicator ![origlower!] % Switches control : ![flaghis!] % Flags On/Off history list ![flagl!] % GRG Flags list ![flaglo!] % GRG Output-Flags list ![iflago!] % Initial mode of output ![echo!] % Echo in LISTOK> ![flagnil!] % Swithes initailly to nil ![flagt!] % Swithes initially t ![fldtuned!] % nil tuning of FANCY-LOWER-DIGITS is needded % OS scpecific : ![dirsep!] % The directories separator. This symbol is % added to the end of GRG environ. var. when % trying to open files. % \ for DOS, / for UNIX, : for VMS (?) % if nil then nothing added. ![syscall!] % Temporary exit to OS and OS commands % 1 - via SYSTEM (UNIX,DOS) % 2 - via QUIT (VAX/VMS) % nil - forbidden ![grgdir!] % Standard Input Didrectory Expanded ![grgdir1!] % Standard Input Didrectory % Version specific: ![lower!] % If t then background lisp internally is in lower case % Debugging : ![erst1!] % First ERRORSET debuggin parameter ![erst2!] % Second ERRORSET debuggin parameter % GRG printing: ![line!] % Current Line for GPRIN ![lline!] % Current Line Length ![gptab!] % Tabulation for GPRIN ![gpfirst!] % First Line marker for GPRIN ![modp!] % Basis mode for write ![allzero!] % Zero-Nonzero components indicator for write ![idwri!] % Writed Data Identifier % Files manipulation : ![fromf!] % In file ![loa!] % Load file ![unl!] % Global Unload file ![lunl!] % Local Unload file ![wri!] % Global Write file ![lwri!] % Local Write file % Data evaluation control : ![chain!] % Chain of required data in REQUEST ![way!] % Way for Find/Calculate % Translation control: ![cs!] % Chanhe Sign ![ch!] % Change Conjugation ![lsrs!] % Left or Right side in equation ![extvar!] % External variables list ![extvara!] % Additional external variables list ![idl!] % For T(J) = expr(J) ![texpr!] % translation ![ivs!] % Iteration vars stack % Coordinates transformation: ![ocord!] % Old coordinates list ![x!] % X ![dfx!] % d X ![dex!] % @ X % Basis mode: ![xb!] % d X/\d Y/\... ![xf!] % d X = b ![xv!] % @ X = e ![ccb!] % ~ b ![ccbi!] % ~ e ![dbas!] % d(b/\...) accumulation % Rotations: ![l!] % L - frame rotaion matrix ![dl!] % det(L) - its det ![sdl!] % sgn(det(L)) - the sign of its det ![li!] % L^(-1) - its inverse ![ls!] % LS - spinor rotation matrix ![dens!] % density factor for an object % Processor internals: ![tlow!] % T_a (lower index a) for Duialisation )) (setq ![autostart!] t) % By default we start (grg) during load grg; %------- Self Quoted Atoms ------------------------------------------- (global '( !!stop!! !!next!! !!er!! )) (setq !!stop!! '!!stop!!) % This is STOP (setq !!er!! '!!er!!) % This is ERROR (setq !!next!! '!!next!!) % This is NEXT %----------------------------------------------------------------------- %========== (2) Built-In Objects ======================================= %---- Flags and Properties for Internal Data variables #ID ------------- % % Prop =type - Type of Component: % -1 - vector; 0 - algebraic expression, n - n-form. % % Prop =idxl - List of Indices. Absent for Scalars. In The List: % nil - lower frame, t - upper frame, % 0 - lower holonomic, 1 - upper holonomic, % (u . n) - un. spinor, (d . n) - do. spinor, % (uu . n) - up un. spinor, (ud . n) - up do. spinor, % (n . n) - enimerating, (n) - enum. d-dimensional. % % Prop =sidxl - Symmetries List is (sy1 sy2 ...) % sy = (type el1 el2 ...) % with type = a | s | h | c which stands for % Antisymmetric, Symmetric, Hermitian, Cyclic % el = n | (n1 n2 ...) | sy % where n is the index number and sy as above. % % Prop =way - Ways of Calculation is (el1 el2 ...) % el = ( (name) (cond) (evfun) data ... ) % data = id | (cond id1 id2 ...) | (t id) % the second form is included iff cond=true % the third form defines Main data. % % Prop =constr - Restriction when data can be used is % (fn1 fn2 ...) % where fn is function call. % % Prop =dens - Pseudo-tensor and Density properties % List of four elements (a b c d) % a=t/nil - Pseudo for coodrinate transform sgnD % b=n - Density for coordinate transform D^n % c=t/nil - Pseudo for rotations sgnL % d=n - Density for rotations L^n % % Flag +noncov - Marks Noncovariant data types for % preventing Dc and Lie calculation. % But don't prevent rotations. % % Flags +fconn +hconn +uconn +dconn % types of connection are % Frame, Holonomic, Spinorial, Conjugate Spinorial % % Flag +hold - Prevents rotation or coordinate % transformation of the object. % % Flag +pl - Marks oblects with plural name. % % Flag +equ - Marks equations. % % Flag +ivar - Marks all internal variables. % % Flag +abbr - Marks new user created objects (abbreviations). % % Prop =unl - Special function call for Unload. % % Prop =datl - Special function call for Write. % % Prop =tex - Writre in FANCY/TEX output mode. % If ID than ID both in TEX and FANCY mode % If (IT . IF) IT for TEX IF for FANCY %----- Flags and Prop. for Funs and Vars (Cord, Const, Fun) -------- % % Flag +grg - Already used by GRG (Can't be declared once again). % % Prop =depend - Dependence List for Functions. % % Flag +grgvar - Marks Variables: Cord, Const, Implicit Fun. % So, can be used as var in any expression. % % Flag +fun - Marks Functions. % % Prop =cord - Coordinate number N (0 1 ... dim-1). % % Prop =conj - Complex Conjugated Object. % % Prop =subind - Value of Iteration Variable. % % Flag +redbad - Specially blocks some atoms. % % Reduce Flags: used!* constant % % Reduce Flags: subfn symmetric antisymmetric odd even % % Reduce Props: simpfn kvalue klist narg % %----------------------------------------------------------------------- %------- Data List ------------------------------------------------- (setq ![datl!] '( % Coordinates, Constants, Functions, Solutions ... ((Coordinates) ![cord!] ) ((Functions) ![fun!] ) ((Constants) ![const!] ) ((Affine Parameter) ![apar!] ) ((Solutions) ![sol!] ) % Metric, Frame, Basis, Volume ... ((Frame) !#!T ) ((Vector Frame) !#!D ) ((Metric) !#!G ) ((Inverse Metric) !#!G!I ) ((Det of Metric) !#!d!e!t!G ) ((Det of Holonomic Metric) !#!d!e!t!g ) ((Sqrt Det of Metric) !#!s!d!e!t!G ) ((Volume) !#!V!O!L ) ((Basis) !#!b ) ((Vector Basis) !#!e ) ((S - forms) !#!S ) % Rotation Matrices ... ((Frame Transformation) !#!L ) ((Spinorial Transformation) !#!L!S ) % Connection and related objects ... ((Frame Connection) !#!o!m!e!g!a ) ((Holonomic Connection) !#!G!A!M!M!A ) ((Undotted Connection) !#!o!m!e!g!a!u ) ((Dotted Connection) !#!o!m!e!g!a!d ) ((Spinorial Connection) ( !#!o!m!e!g!a!u !#!o!m!e!g!a!d )) ((Riemann Frame Connection) !#!r!o!m!e!g!a ) ((Riemann Holonomic Connection) !#!R!G!A!M!M!A ) ((Riemann Undotted Connection) !#!r!o!m!e!g!a!u ) ((Riemann Dotted Connection) !#!r!o!m!e!g!a!d ) ((Riemann Spinorial Connection) ( !#!r!o!m!e!g!a!u !#!r!o!m!e!g!a!d )) ((Connection Defect) !#!K ) ((Undotted S - forms) !#!S!U ) ((Dotted S - forms) !#!S!D ) ((Spinorial S - forms) ( !#!S!U !#!S!D )) % Torsion ... ((Torsion) !#!T!H!E!T!A ) ((Contorsion) !#!K!Q ) ((Torsion Trace 1 - form) !#!Q!Q ) ((Antisymmetric Torsion 3 - form) !#!Q!Q!A ) ((Undotted Contorsion) !#!K!U ) ((Dotted Contorsion) !#!K!D ) ((Spinorial Contorsion) ( !#!K!U !#!K!D )) ((Torsion Trace) !#!Q!T ) ((Torsion Pseudo Trace) !#!Q!P ) ((Traceless Torsion Spinor) !#!Q!C ) ((Torsion Spinors) ( !#!Q!C !#!Q!T !#!Q!P )) ((Torsion Components) ( !#!Q!C !#!Q!T !#!Q!P )) ((Traceless Torsion 2 - form) !#!T!H!Q!C ) ((Torsion Trace 2 - form) !#!T!H!Q!T ) ((Antisymmetric Torsion 2 - form) !#!T!H!Q!A ) ((Torsion 2 - forms) ( ((geq ![dim!] 3) !#!T!H!Q!C) !#!T!H!Q!T ((geq ![dim!] 3) !#!T!H!Q!A) )) ((Undotted Torsion Trace 2 - form) !#!T!H!Q!T!U ) ((Undotted Antisymmetric Torsion 2 - form) !#!T!H!Q!A!U ) ((Undotted Traceless Torsion 2 - form) !#!T!H!Q!C!U ) ((Undotted Torsion 2 - forms) ( !#!T!H!Q!C!U !#!T!H!Q!T!U !#!T!H!Q!A!U )) % Nonmetricity ... ((Nonmetricity) !#!N ) ((Nonmetricity Defect ) !#!K!N ) ((Weyl Vector) !#!N!N!W ) ((Nonmetricity Trace) !#!N!N!T ) ((Symmetric Nonmetricity 1 - form) !#!N!C ) ((Antisymmetric Nonmetricity 1 - form) !#!N!A ) ((Nonmetricity Trace 1 - form) !#!N!T ) ((Weyl Nonmetricity 1 - form) !#!N!W ) ((Nonmetricity 1 - forms) ( !#!N!C ((geq ![dim!] 3) !#!N!A) !#!N!T !#!N!W )) % Curvature ... ((Curvature) !#!O!M!E!G!A ) ((Undotted Curvature) !#!O!M!E!G!A!U ) ((Dotted Curvature) !#!O!M!E!G!A!D ) ((Spinorial Curvature) ( !#!O!M!E!G!A!U !#!O!M!E!G!A!D )) ((Riemann Tensor) !#!R!I!M ) ((Ricci Tensor) !#!R!I!C ) ((A - Ricci Tensor) !#!R!I!C!A ) ((S - Ricci Tensor) !#!R!I!C!S ) ((Homothetic Curvature) !#!O!M!E!G!A!H ) ((Scalar Curvature) !#!R!R ) ((Einstein Tensor) !#!G!T ) ((Weyl Spinor) !#!R!W) ((Traceless Ricci Spinor) !#!R!C) ((Ricanti Spinor) !#!R!A) ((Traceless Deviation Spinor) !#!R!B) ((Scalar Deviation) !#!R!D) ((Curvature Spinors) ( !#!R!W !#!R!C !#!R!R (!*torsion !#!R!B !#!R!A !#!R!D ) )) ((Curvature Components) ( !#!R!W !#!R!C !#!R!R (!*torsion !#!R!B !#!R!A !#!R!D ) )) ((Undotted Weyl 2 - form) !#!O!M!W!U ) ((Undotted Traceless Ricci 2 - form) !#!O!M!C!U ) ((Undotted Scalar Curvature 2 - form) !#!O!M!R!U ) ((Undotted Ricanti 2 - form) !#!O!M!A!U ) ((Undotted Traceless Deviation 2 - form) !#!O!M!B!U ) ((Undotted Scalar Deviation 2 - form) !#!O!M!D!U ) ((Undotted Curvature 2 - forms) ( !#!O!M!W!U !#!O!M!C!U !#!O!M!R!U (!*torsion !#!O!M!A!U !#!O!M!B!U !#!O!M!D!U ))) ((Weyl 2 - form) !#!O!M!W ) ((Traceless Ricci 2 - form) !#!O!M!C ) ((Scalar Curvature 2 - form) !#!O!M!R ) ((Ricanti 2 - form) !#!O!M!A ) ((Traceless Deviation 2 - form) !#!O!M!B ) ((Antisymmetric Curvature 2 - form) !#!O!M!D ) ((Homothetic Curvature 2 - form) !#!O!S!H ) ((Antisymmetric S - Ricci 2 - form) !#!O!S!A ) ((Traceless S - Ricci 2 - form) !#!O!S!C ) ((Antisymmetric S - Curvature 2 - form) !#!O!S!V ) ((Symmetric S - Curvature 2 - form) !#!O!S!U ) ((Curvature 2 - forms) ( ((geq ![dim!] 4) !#!O!M!W ) ((geq ![dim!] 3) !#!O!M!C ) !#!O!M!R ((and (or !*torsion !*nonmetr) (geq ![dim!] 3)) !#!O!M!A ) ((and (or !*torsion !*nonmetr) (geq ![dim!] 4)) !#!O!M!B ) ((and (or !*torsion !*nonmetr) (geq ![dim!] 4)) !#!O!M!D ) (!*nonmetr !#!O!S!H ) ((and !*nonmetr (geq ![dim!] 3)) !#!O!S!A ) (!*nonmetr !#!O!S!C ) ((and !*nonmetr (geq ![dim!] 4)) !#!O!S!V ) ((and !*nonmetr (geq ![dim!] 3)) !#!O!S!U ) )) % Various constants ... ((A - Constants) !#!A!C!O!N!S!T ) ((L - Constants) !#!L!C!O!N!S!T ) ((M - Constants) !#!M!C!O!N!S!T ) % Scalar field ... ((Scalar Equation) !#!S!C!q ) ((Scalar Field) !#!F!I ) ((Scalar Action) !#!S!A!C!T ) ((Minimal Scalar Action) !#!S!A!C!T!M!I!N ) ((Minimal Scalar Energy - Momentum Tensor) !#!T!S!C!L!M!I!N ) % EM field ... % for all dim ... ((EM Potential) !#!A ) ((Current 1 - form) !#!J ) ((EM Action) !#!E!M!A!C!T ) ((EM 2 - form) !#!F!F ) ((EM Tensor) !#!F!T ) ((First Maxwell Equation) !#!M!W!F!q ) ((Second Maxwell Equation) !#!M!W!S!q ) ((Maxwell Equations) ( !#!M!W!F!q !#!M!W!S!q )) ((Continuity Equation) !#!C!O!q ) ((EM Energy - Momentum Tensor) !#!T!E!M ) % dim=4 only ... ((First EM Scalar) !#!S!C!F ) ((Second EM Scalar) !#!S!C!S ) ((EM Scalars) ( !#!S!C!F !#!S!C!S )) ((Selfduality Equation) !#!S!D!q ) ((Complex EM 2 - form) !#!F!F!U ) ((Complex Maxwell Equation) !#!M!W!U!q ) ((Undotted EM Spinor) !#!F!I!U ) ((Complex EM Scalar) !#!S!C!U ) ((EM Energy - Momentum Spinor) !#!T!E!M!S ) % YM field ... ((YM Potential) !#!A!Y!M ) ((Structural Constants) !#!S!C!O!N!S!T ) ((YM Action) !#!Y!M!A!C!T ) ((YM 2 - form) !#!F!F!Y!M ) ((YM Tensor) !#!F!T!Y!M ) ((First YM Equation) !#!Y!M!F!q ) ((Second YM Equation) !#!Y!M!S!q ) ((YM Equations) ( !#!Y!M!F!q !#!Y!M!S!q )) ((YM Energy - Momentum Tensor) !#!T!Y!M ) % Dirac field ... ((Phi Spinor) !#!P!H!I ) ((Chi Spinor) !#!C!H!I ) ((Dirac Spinor) ( !#!P!H!I !#!C!H!I )) ((Dirac Action 4 - form) !#!D!A!C!T ) ((Undotted Dirac Spin 3 - Form) !#!S!P!D!I!U ) ((Dirac Energy - Momentum Tensor) !#!T!D!I ) ((Phi Dirac Equation) !#!D!P!q ) ((Chi Dirac Equation) !#!D!C!q ) ((Dirac Equation) ( !#!D!P!q !#!D!C!q )) % Geodesics and congruences ... ((Geodesic Equation) !#!G!E!O!q ) % Null congruence ... ((Congruence) !#!K!V ) ((Null Congruence Condition) !#!N!C!o ) ((Geodesics Congruence Condition) !#!G!C!o ) ((Congruence Expansion) !#!t!h!e!t!a!O ) ((Congruence Squared Rotation) !#!o!m!e!g!a!S!Q!O ) ((Congruence Squared Shear) !#!s!i!g!m!a!S!Q!O ) ((Optical Scalars) (!#!t!h!e!t!a!O !#!o!m!e!g!a!S!Q!O !#!s!i!g!m!a!S!Q!O )) % Kinematics ... ((Velocity Vector) !#!U!V ) ((Velocity) !#!U!U ) ((Velocity Square) !#!U!S!Q ) ((Projector) !#!P!R ) ((Acceleration) !#!a!c!c!U ) ((Vorticity) !#!o!m!e!g!a!U ) ((Volume Expansion) !#!t!h!e!t!a!U ) ((Shear) !#!s!i!g!m!a!U ) ((Kinematics) ( !#!a!c!c!U !#!o!m!e!g!a!U !#!t!h!e!t!a!U !#!s!i!g!m!a!U )) % Ideal Fluid ... ((Pressure) !#!P!R!E!S ) ((Energy Density) !#!E!N!E!R ) ((Ideal Fluid Energy - Momentum Tensor) !#!T!I!F!L ) % Spin Fluid ... ((Spin Fluid Energy - Momentum Tensor) !#!T!S!F!L ) ((Spin Density) !#!S!P!F!L!T ) ((Spin Density 2 - form) !#!S!P!F!L ) ((Undotted Fluid Spin 3 - form) !#!S!P!F!L!U ) ((Frenkel Condition) !#!F!C!o ) % Total Energy-Momentum and Spin ... ((Total Energy - Momentum Tensor) !#!T!E!N!M!O!M ) ((Total Energy - Momentum Spinor) !#!T!E!N!M!O!M!S ) ((Total Energy - Momentum Trace) !#!T!E!N!M!O!M!T ) ((Total Undotted Spin 3 - form) !#!S!P!I!N!U ) % Einstein Equations ... ((Einstein Equation) !#!E!E!q ) ((Traceless Einstein Equation) !#!C!E!E!q ) ((Trace of Einstein Equation) !#!T!E!E!q ) ((Spinor Einstein Equations) ( !#!C!E!E!q !#!T!E!E!q )) % Gravitational Equations ... ((Action) !#!L!A!C!T ) ((Undotted Curvature Momentum) !#!P!O!M!E!G!A!U ) ((Torsion Momentum) !#!P!T!H!E!T!A ) ((Metric Equation) !#!M!E!T!R!q ) ((Torsion Equation) !#!T!O!R!S!q ) ((Gravitational Equations) ( !#!M!E!T!R!q (!*torsion !#!T!O!R!S!q ))) )) (prog ( ![idatl!] ) (foreach!> ![www!] in ![datl!] do (cond ((atom (cadr ![www!])) (setq ![idatl!] (cons (cadr ![www!]) ![idatl!] ))))) (global ![idatl!]) (flag ![idatl!] '!+ivar)) %------- Plural ---------------------------------------------------- (flag '( ![cord!] ![const!] ![fun!] !#!T !#!b !#!S !#!S!U !#!S!D !#!A!C!O!N!S!T !#!M!C!O!N!S!T !#!L!C!O!N!S!T ) '!+pl) %-------- Equations ---------------------------------------------------- (flag '( ![sol!] !#!S!C!q !#!D!P!q !#!D!C!q !#!Y!M!F!q !#!Y!M!S!q !#!M!W!F!q !#!M!W!S!q !#!C!O!q !#!S!D!q !#!M!W!U!q !#!G!E!O!q !#!N!C!o !#!G!C!o !#!F!C!o !#!E!E!q !#!T!E!E!q !#!C!E!E!q !#!M!E!T!R!q !#!T!O!R!S!q ) '!+equ) %-------- Total Enargy-Momentum and Spin ------------------------------- (setq ![tlst!] '( !#!T!D!I !#!T!E!M !#!T!Y!M !#!T!S!C!L!M!I!N !#!T!I!F!L !#!T!S!F!L )) (setq ![slst!] '( !#!S!P!D!I!U !#!S!P!F!L!U )) %-------- Properties of the Built-In Objects --------------------------- (put '![sol!] '!=type 0) % word!!! in =way % Metric, Farame, Volume ... (put '!#!T '!=type 1) (put '!#!T '!=idxl '(t)) (put '!#!T '!=way '( ((By Default) nil (frame0!>) ) ((From Vector Frame) nil (frame1!>) (t !#!D) ) )) (put '!#!T '!=tex "\theta") (put '!#!D '!=type -1) (put '!#!D '!=idxl '(nil)) (put '!#!D '!=way '( ((From Frame) nil (iframe1!>) !#!V!O!L !#!T ) )) (put '!#!D '!=tex '("\partial" . 182)) (put '!#!G '!=type 0) (put '!#!G '!=idxl '(nil nil)) (put '!#!G '!=sidxl '((s 1 2))) (put '!#!G '!=way '( ((By Default) nil (metr0!>) ) ((From Inverse Metric) nil (metr1!>) (t !#!G!I) ) )) (put '!#!G '!=tex '!g) (put '!#!G!I '!=type 0) (put '!#!G!I '!=idxl '(t t)) (put '!#!G!I '!=sidxl '((s 1 2))) (put '!#!G!I '!=way '( ((From Metric) nil (imetr1!>) !#!G ) )) (put '!#!G!I '!=tex '!g) (put '!#!d!e!t!G '!=type 0) (put '!#!d!e!t!G '!=way '( (nil nil (detg1!>) !#!G ) )) (put '!#!d!e!t!G '!=dens '(nil nil nil -2)) (put '!#!d!e!t!G '!=tex '!g) (put '!#!d!e!t!g '!=type 0) (put '!#!d!e!t!g '!=way '( (nil nil (dethg1!>) !#!G !#!T ) )) (put '!#!d!e!t!g '!=dens '(nil -2 nil nil)) (put '!#!d!e!t!g '!=tex '!g) (put '!#!s!d!e!t!G '!=type 0) (put '!#!s!d!e!t!G '!=way '((nil nil (sdetg1!>) !#!G ) )) (put '!#!s!d!e!t!G '!=dens '(nil nil t -1)) (put '!#!s!d!e!t!G '!=tex "\sqrt{-g}") (put '!#!V!O!L '!=type '![dim!]) % Variable Type !!! (put '!#!V!O!L '!=way '((nil nil (vol0!>) !#!s!d!e!t!G !#!T ) )) (put '!#!V!O!L '!=dens '(t nil t nil)) (put '!#!V!O!L '!=tex "\upsilon") (put '!#!b '!=type 1) (put '!#!b '!=idxl '((n))) (put '!#!b '!=way '(((From Frame) nil (base!>) !#!V!O!L !#!T ) ((From Vector Basis) nil (base1!>) (t !#!e) ) )) (put '!#!e '!=type -1) (put '!#!e '!=idxl '((n))) (put '!#!e '!=way '(((From Basis) nil (ibase!>) !#!b ) )) (put '!#!S '!=type 2) (put '!#!S '!=idxl '(t t)) (put '!#!S '!=sidxl '((a 1 2))) (put '!#!S '!=way '((nil nil (makesforms!>) !#!T))) % Rotation matrices ... (put '!#!L '!=type 0) (put '!#!L '!=idxl '(t nil)) (put '!#!L '!=tex '!L) (put '!#!L!S '!=type 0) (put '!#!L!S '!=idxl '((u . 1) (uu . 1))) (put '!#!L!S '!=tex '("\Lambda" . 76)) % Spinorial S-forms ... (put '!#!S!U '!=type 2) (put '!#!S!U '!=idxl '((u . 2))) (put '!#!S!U '!=way '( (nil nil (ssform!> '!#!S!U 2 3) !#!T ) )) (put '!#!S!U '!=constr '((sp!>))) (put '!#!S!D '!=type 2) (put '!#!S!D '!=idxl '((d . 2))) (put '!#!S!D '!=way '( (nil nil (ssform!> '!#!S!D 3 2) !#!T ) )) (put '!#!S!D '!=constr '((sp!>))) % Connection and related objects ... (flag '( !#!G!A!M!M!A !#!o!m!e!g!a !#!o!m!e!g!a!u !#!o!m!e!g!a!d ) '!+noncov) (flag '( !#!R!G!A!M!M!A !#!r!o!m!e!g!a !#!r!o!m!e!g!a!u !#!r!o!m!e!g!a!d ) '!+noncov) (put '!#!G!A!M!M!A '!=type 1) (put '!#!G!A!M!M!A '!=idxl '(1 0)) (put '!#!G!A!M!M!A '!=way '( ((From Frame Connection) nil (gfromo!>) !#!T !#!D !#!o!m!e!g!a ) )) (flag '(!#!G!A!M!M!A) '!+hconn) (put '!#!G!A!M!M!A '!=tex '("\Gamma" . 71)) (put '!#!R!G!A!M!M!A '!=type 1) (put '!#!R!G!A!M!M!A '!=idxl '(1 0)) (put '!#!R!G!A!M!M!A '!=way '( ((From Riemann Frame Connection) nil (rgfromro!>) !#!T !#!D !#!r!o!m!e!g!a ) )) (flag '(!#!R!G!A!M!M!A) '!+hconn) (put '!#!o!m!e!g!a '!=type 1) (put '!#!o!m!e!g!a '!=idxl '(t nil)) (put '!#!o!m!e!g!a '!=way '( (nil nil (connec!>) !#!T !#!D !#!G !#!G!I (!*torsion !#!T!H!E!T!A) (!*nonmetr !#!N)) ((From Spinorial Connection) (sp!-n!>) (ofromos!> '!#!o!m!e!g!a !#!o!m!e!g!a!u !#!o!m!e!g!a!d) (t !#!o!m!e!g!a!u) !#!o!m!e!g!a!d ) ((From Connection Defect) (tttqandn!>) (connecplus!> !#!K) !#!T !#!D !#!G !#!G!I (t !#!K)) ((From Contorsion) (tttq!>) (connecplus!> !#!K!Q) !#!T !#!D !#!G !#!G!I (t !#!K!Q)) ((From Nonmetricity Defect) (tttn!>) (connecplus!> !#!K!N) !#!T !#!D !#!G !#!G!I (t !#!K!N)) ((From Holonomic Connection) nil (ofromg!>) !#!T !#!D !#!G!A!M!M!A ) )) (flag '(!#!o!m!e!g!a) '!+fconn) (put '!#!r!o!m!e!g!a '!=type 1) (put '!#!r!o!m!e!g!a '!=idxl '(t nil)) (put '!#!r!o!m!e!g!a '!=way '( (nil nil (connecplus!> nil) !#!T !#!D !#!G !#!G!I) )) (put '!#!r!o!m!e!g!a '!=constr '((tttqorn!>))) (flag '(!#!r!o!m!e!g!a) '!+fconn) (put '!#!o!m!e!g!a!u '!=type 1) (put '!#!o!m!e!g!a!u '!=idxl '((u . 2))) (put '!#!o!m!e!g!a!u '!=way '( (nil nil (uconnec!>) !#!T !#!S!U !#!V!O!L (!*torsion !#!K!U)) ((By Conjugation) nil (conj3!> '!#!o!m!e!g!a!u !#!o!m!e!g!a!d) !#!o!m!e!g!a!d) ((From Frame Connection) nil (oufromo!> '!#!o!m!e!g!a!u !#!o!m!e!g!a) !#!o!m!e!g!a ) )) (put '!#!o!m!e!g!a!u '!=tex "\omega") (put '!#!o!m!e!g!a!u '!=constr '((sp!-n!>))) (flag '(!#!o!m!e!g!a!u) '!+uconn) (put '!#!o!m!e!g!a!d '!=type 1) (put '!#!o!m!e!g!a!d '!=idxl '((d . 2))) (put '!#!o!m!e!g!a!d '!=way '( (nil nil (dconnec!>) !#!T !#!S!D !#!V!O!L (!*torsion !#!K!D)) ((By Conjugation) nil (conj3!> '!#!o!m!e!g!a!d !#!o!m!e!g!a!u) !#!o!m!e!g!a!u) ((From Frame Connection) nil (odfromo!> '!#!o!m!e!g!a!d !#!o!m!e!g!a) !#!o!m!e!g!a ) )) (put '!#!o!m!e!g!a!d '!=tex "\omega") (put '!#!o!m!e!g!a!d '!=constr '((sp!-n!>))) (flag '(!#!o!m!e!g!a!d) '!+dconn) (put '!#!r!o!m!e!g!a!u '!=type 1) (put '!#!r!o!m!e!g!a!u '!=idxl '((u . 2))) (put '!#!r!o!m!e!g!a!u '!=way '( (nil nil (ruconnec!>) !#!T !#!S!U !#!V!O!L) )) (put '!#!r!o!m!e!g!a!u '!=constr '((tttqorn!>) (sp!>))) (flag '(!#!r!o!m!e!g!a!u) '!+uconn) (put '!#!r!o!m!e!g!a!d '!=type 1) (put '!#!r!o!m!e!g!a!d '!=idxl '((d . 2))) (put '!#!r!o!m!e!g!a!d '!=way '( (nil nil (rdconnec!>) !#!T !#!S!D !#!V!O!L) )) (put '!#!r!o!m!e!g!a!d '!=constr '((tttqorn!>) (sp!>))) (flag '(!#!r!o!m!e!g!a!d) '!+dconn) % Torsion ... (put '!#!T!H!E!T!A '!=type 2) (put '!#!T!H!E!T!A '!=idxl '(t)) (put '!#!T!H!E!T!A '!=constr '((tttq!>))) (put '!#!T!H!E!T!A '!=way '( ((From Connection Defect) (tttqandn!>) (qfromk!> '!#!K) !#!T !#!K ) ((From Contorsion) (tttq!>) (qfromk!> '!#!K!Q) !#!T !#!K!Q ) )) (put '!#!T!H!E!T!A '!=tex '("\Theta" . 81)) (put '!#!Q!Q '!=type 1) (put '!#!Q!Q '!=way '((nil nil (qqq!>) !#!T!H!E!T!A !#!D ))) (put '!#!Q!Q '!=constr '((tttq!>))) (put '!#!Q!Q!A '!=type 1) (put '!#!Q!Q!A '!=way '((nil nil (qqqa!>) !#!T!H!E!T!A !#!T ))) (put '!#!Q!Q!A '!=constr '((dg2!>)(tttq!>))) (put '!#!K!Q '!=type 1) (put '!#!K!Q '!=idxl '(t nil)) (put '!#!K!Q '!=way '( ((From Torsion) nil (contor!>) !#!T !#!D !#!G !#!G!I !#!T!H!E!T!A ) ((From Spinorial Contorsion) (sp!>) (ofromos!> '!#!K!Q !#!K!U !#!K!D) (t !#!K!U) (t !#!K!D) ) )) (put '!#!K!Q '!=constr '((tttq!>))) (put '!#!K!U '!=type 1) (put '!#!K!U '!=idxl '((u . 2))) (put '!#!K!U '!=way '( ((From Contorsion) (sp!>) (oufromo!> '!#!K!U !#!K!Q) !#!K!Q) ((By Conjugation) nil (conj3!> '!#!K!U !#!K!D) (t !#!K!D)) )) (put '!#!K!U '!=constr '((tttq!>)(sp!>))) (put '!#!K!D '!=type 1) (put '!#!K!D '!=idxl '((d . 2))) (put '!#!K!D '!=way '( ((From Contorsion) (sp!>) (odfromo!> '!#!K!D !#!K!Q) !#!K!Q) ((By Conjugation) nil (conj3!> '!#!K!D !#!K!U) (t !#!K!U)) )) (put '!#!K!D '!=constr '((tttq!>)(sp!>))) (put '!#!Q!T '!=type 0) (put '!#!Q!T '!=idxl '(t)) (put '!#!Q!T '!=way '( ((From Torsion using Spinors) (sp!>) (qtfromthsp!>) !#!T!H!E!T!A !#!S!U !#!S!D !#!V!O!L ) ((From Torsion Trace 1 - form) nil (qtfromqq!>) !#!Q!Q !#!D !#!G!I ) )) (put '!#!Q!T '!=constr '((tttq!>))) (put '!#!Q!P '!=type 0) (put '!#!Q!P '!=idxl '(t)) (put '!#!Q!P '!=way '( ((From Torsion using Spinors) (sp!>) (qpfromthsp!>) !#!T!H!E!T!A !#!S!U !#!S!D !#!V!O!L ) ((From Antisymmetric Torsion 3 - form) (ttt4!>) (qpfromqqa!>) !#!Q!Q!A !#!D !#!G!I !#!T !#!G ) )) (put '!#!Q!P '!=constr '((tttq!>)(ttt4!>))) (put '!#!Q!C '!=type 0) (put '!#!Q!C '!=idxl '((u . 3)(d . 1))) (put '!#!Q!C '!=way '( ((From Torsion) (sp!>) (qcfromth!>) !#!T!H!E!T!A !#!S!U !#!V!O!L) )) (put '!#!Q!C '!=constr '((tttq!>)(sp!>))) (put '!#!T!H!Q!C '!=type 2) (put '!#!T!H!Q!C '!=idxl '(t)) (put '!#!T!H!Q!C '!=way '( (nil nil (qcfcomp!>) !#!T!H!E!T!A !#!T!H!Q!T !#!T!H!Q!A ))) (put '!#!T!H!Q!C '!=constr '((tttq!>)(dg2!>))) (put '!#!T!H!Q!T '!=type 2) (put '!#!T!H!Q!T '!=idxl '(t)) (put '!#!T!H!Q!T '!=way '( (nil nil (qtfcomp!>) !#!Q!Q !#!T ))) (put '!#!T!H!Q!T '!=constr '((tttq!>))) (put '!#!T!H!Q!A '!=type 2) (put '!#!T!H!Q!A '!=idxl '(t)) (put '!#!T!H!Q!A '!=way '( (nil nil (qafcomp!>) !#!Q!Q!A !#!D !#!G!I ))) (put '!#!T!H!Q!A '!=constr '((tttq!>)(dg2!>))) (put '!#!T!H!Q!C!U '!=type 2) (put '!#!T!H!Q!C!U '!=idxl '(t)) (put '!#!T!H!Q!C!U '!=way '( (nil (sp!>) (trfr!> '!#!T!H!Q!C!U 'gcf!> '!#!S!U) !#!S!U !#!Q!C ) )) (put '!#!T!H!Q!C!U '!=constr '((sp!>)(tttq!>))) (put '!#!T!H!Q!T!U '!=type 2) (put '!#!T!H!Q!T!U '!=idxl '(t)) (put '!#!T!H!Q!T!U '!=way '( (nil (sp!>) (trfr!> '!#!T!H!Q!T!U 'gqf!> '!#!S!U) !#!S!U !#!Q!T ) )) (put '!#!T!H!Q!T!U '!=constr '((sp!>)(tttq!>))) (put '!#!T!H!Q!A!U '!=type 2) (put '!#!T!H!Q!A!U '!=idxl '(t)) (put '!#!T!H!Q!A!U '!=way '( (nil (sp!>) (trfr!> '!#!T!H!Q!A!U 'gpf!> '!#!S!U) !#!S!U !#!Q!P ) )) (put '!#!T!H!Q!A!U '!=constr '((sp!>)(tttq!>))) % Nonmetricity ... (put '!#!N '!=type 1) (put '!#!N '!=idxl '(nil nil)) (put '!#!N '!=sidxl '((s 1 2))) (put '!#!N '!=way '( ((From Connection Defect) (tttqandn!>) (nfromk!> '!#!K) !#!G !#!K ) ((From Nonmetricity Defect) (tttn!>) (nfromk!> '!#!K!N) !#!G !#!K!N ) )) (put '!#!N '!=constr '((tttn!>))) (put '!#!K!N '!=type 1) (put '!#!K!N '!=idxl '(t nil)) (put '!#!K!N '!=way '( ((From Nonmetricity) nil (nondef!>) !#!T !#!D !#!G !#!G!I !#!N ) )) (put '!#!K!N '!=constr '((tttn!>))) (put '!#!K '!=type 1) (put '!#!K '!=idxl '(t nil)) (put '!#!K '!=way '( (nil nil (conndef!>) !#!T !#!D !#!G !#!G!I !#!T!H!E!T!A !#!N ) )) (put '!#!K '!=constr '((tttqandn!>))) (put '!#!N!N!W '!=type 1) (put '!#!N!N!W '!=way '( (nil nil (compnnw!>) !#!N !#!G!I )) ) (put '!#!N!N!W '!=constr '((tttn!>))) (put '!#!N!N!T '!=type 1) (put '!#!N!N!T '!=way '( (nil nil (compnnt!>) !#!N !#!G!I !#!D !#!T !#!N!N!W )) ) (put '!#!N!N!T '!=constr '((tttn!>))) (put '!#!N!W '!=type 1) (put '!#!N!W '!=idxl '(nil nil)) (put '!#!N!W '!=sidxl '((s 1 2))) (put '!#!N!W '!=way '( (nil nil (compnw!>) !#!G !#!N!N!W )) ) (put '!#!N!W '!=constr '((tttn!>))) (put '!#!N!T '!=type 1) (put '!#!N!T '!=idxl '(nil nil)) (put '!#!N!T '!=sidxl '((s 1 2))) (put '!#!N!T '!=way '( (nil nil (compnt!>) !#!G !#!T !#!N!N!T )) ) (put '!#!N!T '!=constr '((tttn!>))) (put '!#!N!A '!=type 1) (put '!#!N!A '!=idxl '(nil nil)) (put '!#!N!A '!=sidxl '((s 1 2))) (put '!#!N!A '!=way '( (nil nil (compna!>) !#!D !#!T !#!N !#!N!W !#!N!T ))) (put '!#!N!A '!=constr '((tttn!>)(dg2!>))) (put '!#!N!C '!=type 1) (put '!#!N!C '!=idxl '(nil nil)) (put '!#!N!C '!=sidxl '((s 1 2))) (put '!#!N!C '!=way '( (nil nil (compnc!>) !#!N ((geq ![dim!] 3) !#!N!A) !#!N!T !#!N!W ))) (put '!#!N!C '!=constr '((tttn!>))) % Curvature ... (put '!#!O!M!E!G!A '!=type 2) (put '!#!O!M!E!G!A '!=idxl '(t nil)) (put '!#!O!M!E!G!A '!=way '( (nil nil (curvature!>) !#!o!m!e!g!a ) ((From Spinorial Curvature) (sp!-n!>) (ofromos!> '!#!O!M!E!G!A !#!O!M!E!G!A!U !#!O!M!E!G!A!D) (t !#!O!M!E!G!A!U) !#!O!M!E!G!A!D ) )) (put '!#!O!M!E!G!A '!=tex '("\Omega" . 87)) (put '!#!O!M!E!G!A!U '!=type 2) (put '!#!O!M!E!G!A!U '!=idxl '((u . 2))) (put '!#!O!M!E!G!A!U '!=way '( (nil nil (scurvature!> '!#!O!M!E!G!A!U !#!o!m!e!g!a!u) !#!o!m!e!g!a!u ) ((By Conjugation) nil (conj3!> '!#!O!M!E!G!A!U !#!O!M!E!G!A!D) !#!O!M!E!G!A!D) ((From Curvature) nil (oufromo!> '!#!O!M!E!G!A!U !#!O!M!E!G!A) !#!O!M!E!G!A ) )) (put '!#!O!M!E!G!A!U '!=constr '((sp!-n!>))) (put '!#!O!M!E!G!A!U '!=tex '("\Omega" . 87)) (put '!#!O!M!E!G!A!D '!=type 2) (put '!#!O!M!E!G!A!D '!=idxl '((d . 2))) (put '!#!O!M!E!G!A!D '!=way '( (nil nil (scurvature!> '!#!O!M!E!G!A!D !#!o!m!e!g!a!d) !#!o!m!e!g!a!d ) ((By Conjugation) nil (conj3!> '!#!O!M!E!G!A!D !#!O!M!E!G!A!U) !#!O!M!E!G!A!U) ((From Curvature) nil (odfromo!> '!#!O!M!E!G!A!D !#!O!M!E!G!A) !#!O!M!E!G!A ) )) (put '!#!O!M!E!G!A!D '!=constr '((sp!-n!>))) (put '!#!O!M!E!G!A!D '!=tex '("\Omega" . 87)) (put '!#!R!I!M '!=type 0) (put '!#!R!I!M '!=idxl '(t nil nil nil)) (put '!#!R!I!M '!=sidxl '((a 3 4))) (put '!#!R!I!M '!=way '( (nil nil (riemm!>) !#!D !#!O!M!E!G!A ) )) (put '!#!R!I!M '!=tex '!R) (put '!#!R!I!C '!=type 0) (put '!#!R!I!C '!=idxl '( nil nil)) (put '!#!R!I!C '!=sidxl '((s 1 2))) (put '!#!R!I!C '!=way '( ((From Curvature) nil (riccio!>) !#!D !#!G !#!G!I !#!O!M!E!G!A ) ((From Riemann Tensor) nil (ricci!>) !#!R!I!M ) )) (put '!#!R!I!C '!=tex '!R) (put '!#!R!I!C!A '!=type 0) (put '!#!R!I!C!A '!=idxl '( nil nil)) (put '!#!R!I!C!A '!=way '( ((From Curvature) nil (riccioa!>) !#!D !#!G !#!G!I !#!O!M!E!G!A ))) (put '!#!R!I!C!A '!=constr '((tttn!>))) (put '!#!R!R '!=type 0) (put '!#!R!R '!=way '( ((From A - Ricci Tensor) (tttn!>) (rscalara!>) !#!G!I (t !#!R!I!C!A) ) ((From Ricci Tensor) nil (rscalar!>) !#!G!I !#!R!I!C ) ((From Spinor Curvature) (sp!-n!>) (rrsp!>) (t !#!O!M!E!G!A!U) !#!S!U !#!V!O!L ) )) (put '!#!R!R '!=tex '!R) (put '!#!G!T '!=type 0) (put '!#!G!T '!=idxl '( nil nil)) (put '!#!G!T '!=sidxl '((s 1 2))) (put '!#!G!T '!=way '( (nil nil (gtensor!>) !#!G !#!R!R !#!R!I!C ) )) (put '!#!R!W '!=type 0) (put '!#!R!W '!=idxl '((u . 4))) (put '!#!R!W '!=way '( ((From Spinor Curvature) nil (rwsp!>) !#!O!M!E!G!A!U !#!S!U !#!V!O!L))) (put '!#!R!W '!=tex '!C) (put '!#!R!W '!=constr '((sp!-n!>))) (put '!#!R!C '!=type 0) (put '!#!R!C '!=idxl '((u . 2)(d . 2))) (put '!#!R!C '!=sidxl '((h 1 2))) (put '!#!R!C '!=way '( ((From Spinor Curvature) nil (rcsp!>) !#!O!M!E!G!A!U !#!S!D !#!V!O!L (!*torsion !#!O!M!E!G!A!D !#!S!U)))) (put '!#!R!C '!=tex '!C) (put '!#!R!C '!=constr '((sp!-n!>))) (put '!#!R!A '!=type 0) (put '!#!R!A '!=idxl '((u . 2))) (put '!#!R!A '!=way '( ((From Spinor Curvature) nil (rasp!>) !#!O!M!E!G!A!U !#!S!U !#!V!O!L))) (put '!#!R!A '!=tex '!A) (put '!#!R!A '!=constr '((tttq!>)(sp!-n!>))) (put '!#!R!B '!=type 0) (put '!#!R!B '!=idxl '((u . 2)(d . 2))) (put '!#!R!B '!=sidxl '((h 1 2))) (put '!#!R!B '!=way '( ((From Spinor Curvature) nil (rbsp!>) !#!O!M!E!G!A!U !#!O!M!E!G!A!D !#!S!U !#!S!D !#!V!O!L))) (put '!#!R!B '!=tex '!B) (put '!#!R!B '!=constr '((tttq!>)(sp!-n!>))) (put '!#!R!D '!=type 0) (put '!#!R!D '!=way '( ((From Spinor Curvature) (sp!-n!>) (rdsp!>) !#!O!M!E!G!A!U !#!S!U !#!V!O!L))) (put '!#!R!D '!=tex '!D) (put '!#!R!D '!=constr '((tttq!>)(ttt4!>))) (put '!#!O!M!W!U '!=type 2) (put '!#!O!M!W!U '!=idxl '((u . 2))) (put '!#!O!M!W!U '!=way '( (nil nil (crfr!> '!#!O!M!W!U 'gwf!> '!#!S!U) !#!S!U !#!R!W ) )) (put '!#!O!M!W!U '!=constr '((sp!-n!>))) (put '!#!O!M!C!U '!=type 2) (put '!#!O!M!C!U '!=idxl '((u . 2))) (put '!#!O!M!C!U '!=way '( (nil nil (crfr!> '!#!O!M!C!U 'gtf!> '!#!S!D) !#!S!D !#!R!C ) )) (put '!#!O!M!C!U '!=constr '((sp!-n!>))) (put '!#!O!M!R!U '!=type 2) (put '!#!O!M!R!U '!=idxl '((u . 2))) (put '!#!O!M!R!U '!=way '( (nil nil (crfr!> '!#!O!M!R!U 'gsf!> '!#!S!U) !#!S!U !#!R!R ) )) (put '!#!O!M!R!U '!=constr '((sp!-n!>))) (put '!#!O!M!A!U '!=type 2) (put '!#!O!M!A!U '!=idxl '((u . 2))) (put '!#!O!M!A!U '!=way '( (nil nil (crfr!> '!#!O!M!A!U 'gaf!> '!#!S!U) !#!S!U !#!R!A ) )) (put '!#!O!M!A!U '!=constr '((sp!-n!>)(tttqnotn!>))) (put '!#!O!M!B!U '!=type 2) (put '!#!O!M!B!U '!=idxl '((u . 2))) (put '!#!O!M!B!U '!=way '( (nil nil (crfr!> '!#!O!M!B!U 'gbf!> '!#!S!D) !#!S!D !#!R!B ) )) (put '!#!O!M!B!U '!=constr '((sp!-n!>)(tttqnotn!>))) (put '!#!O!M!D!U '!=type 2) (put '!#!O!M!D!U '!=idxl '((u . 2))) (put '!#!O!M!D!U '!=way '( (nil nil (crfr!> '!#!O!M!D!U 'gdf!> '!#!S!U) !#!S!U !#!R!D ) )) (put '!#!O!M!D!U '!=constr '((sp!-n!>)(tttqnotn!>))) (put '!#!O!M!W '!=type 2) (put '!#!O!M!W '!=idxl '(nil nil)) (put '!#!O!M!W '!=sidxl '((a 1 2))) (put '!#!O!M!W '!=way '( (nil nil (mkrwf!>) !#!G !#!O!M!E!G!A !#!O!M!C !#!O!M!R ((or !*torsion !*nonmetr) !#!O!M!A !#!O!M!B !#!O!M!D ) ))) (put '!#!O!M!W '!=constr '((dg3!>))) (put '!#!O!M!C '!=type 2) (put '!#!O!M!C '!=idxl '(nil nil)) (put '!#!O!M!C '!=sidxl '((a 1 2))) (put '!#!O!M!C '!=way '( (nil nil (mkrcf!>) !#!G !#!T (!*nonmetr !#!R!I!C!A) ((not !*nonmetr) !#!R!I!C) !#!R!R ))) (put '!#!O!M!C '!=constr '((dg2!>))) (put '!#!O!M!R '!=type 2) (put '!#!O!M!R '!=idxl '(nil nil)) (put '!#!O!M!R '!=sidxl '((a 1 2))) (put '!#!O!M!R '!=way '( (nil nil (mkrrf!>) !#!G !#!S !#!R!R ))) (put '!#!O!M!R '!=sidxl '((a 1 2))) (put '!#!O!M!A '!=type 2) (put '!#!O!M!A '!=idxl '(nil nil)) (put '!#!O!M!A '!=sidxl '((a 1 2))) (put '!#!O!M!A '!=way '( (nil nil (mkraf!>) !#!G !#!T (!*nonmetr !#!R!I!C!A) ((not !*nonmetr) !#!R!I!C) ))) (put '!#!O!M!A '!=constr '((tttqorn!>)(dg2!>))) (put '!#!O!M!B '!=type 2) (put '!#!O!M!B '!=idxl '(nil nil)) (put '!#!O!M!B '!=sidxl '((a 1 2))) (put '!#!O!M!B '!=way '( (nil nil (mkrbf!>) !#!G !#!T !#!D !#!O!M!E!G!A !#!O!M!R !#!O!M!C !#!O!M!A !#!O!M!D ))) (put '!#!O!M!B '!=constr '((tttqorn!>)(dg3!>))) (put '!#!O!M!D '!=type 2) (put '!#!O!M!D '!=idxl '(nil nil)) (put '!#!O!M!D '!=sidxl '((a 1 2))) (put '!#!O!M!D '!=way '( (nil nil (mkrdf!>) !#!G !#!D !#!S !#!T !#!O!M!E!G!A ))) (put '!#!O!M!D '!=constr '((tttqorn!>)(dg3!>))) (put '!#!R!I!C!S '!=type 0) (put '!#!R!I!C!S '!=idxl '(nil nil)) (put '!#!R!I!C!S '!=way '( ((From Curvature) nil (riccios!>) !#!D !#!G !#!G!I !#!O!M!E!G!A ))) (put '!#!R!I!C!S '!=constr '((tttn!>))) (put '!#!O!M!E!G!A!H '!=type 2) (put '!#!O!M!E!G!A!H '!=way '( (nil nil (mkomegah!>) !#!O!M!E!G!A ))) (put '!#!O!M!E!G!A!H '!=constr '((tttn!>))) (put '!#!O!S!H '!=type 2) (put '!#!O!S!H '!=idxl '(nil nil)) (put '!#!O!S!H '!=sidxl '((s 1 2))) (put '!#!O!S!H '!=way '( (nil (deq2!>) (mkrshf2!>) !#!G !#!T !#!O!M!E!G!A #!O!S!C ) (nil (dg2!>) (mkrshf!>) !#!G !#!O!M!E!G!A!H ) % (nil (dg2!>) (mkrshf!>) !#!G !#!T !#!O!M!E!G!A!H ) )) (put '!#!O!S!H '!=constr '((tttn!>))) (put '!#!O!S!A '!=type 2) (put '!#!O!S!A '!=idxl '(nil nil)) (put '!#!O!S!A '!=sidxl '((s 1 2))) (put '!#!O!S!A '!=way '( (nil nil (mkrsaf!>) !#!G !#!T !#!S !#!D !#!R!I!C!S !#!O!M!E!G!A!H ) % (nil nil (mkrsaf!>) !#!G !#!T !#!S !#!R!I!C!S ) )) (put '!#!O!S!A '!=constr '((tttn!>)(dg2!>))) (put '!#!O!S!C '!=type 2) (put '!#!O!S!C '!=idxl '(nil nil)) (put '!#!O!S!C '!=sidxl '((s 1 2))) (put '!#!O!S!C '!=way '( (nil nil (mkrscf!>) !#!G !#!T !#!S !#!R!I!C!S ))) (put '!#!O!S!C '!=constr '((tttn!>))) (put '!#!O!S!V '!=type 2) (put '!#!O!S!V '!=idxl '(nil nil)) (put '!#!O!S!V '!=sidxl '((s 1 2))) (put '!#!O!S!V '!=way '( (nil nil (mkrsvf!>) !#!T !#!D !#!G !#!O!S!H !#!O!S!A !#!O!S!C ))) (put '!#!O!S!V '!=constr '((tttn!>)(dg3!>))) (put '!#!O!S!U '!=type 2) (put '!#!O!S!U '!=idxl '(nil nil)) (put '!#!O!S!U '!=sidxl '((s 1 2))) (put '!#!O!S!U '!=way '( (nil nil (mkrsuf!>) !#!G !#!O!M!E!G!A ((geq ![dim!] 4) !#!O!S!V ) !#!O!S!H !#!O!S!A !#!O!S!C ))) (put '!#!O!S!U '!=constr '((tttn!>)(dg2!>))) % Dirac field ... (put '!#!P!H!I '!=type 0) (put '!#!P!H!I '!=idxl '((u . 1))) (put '!#!C!H!I '!=type 0) (put '!#!C!H!I '!=idxl '((u . 1))) (put '!#!P!H!I '!=tex "\phi") (put '!#!C!H!I '!=tex "\chi") (put '!#!P!H!I '!=constr '((sp!-n!>))) (put '!#!C!H!I '!=constr '((sp!-n!>))) (put '!#!D!A!C!T '!=type 4) (put '!#!D!A!C!T '!=way '( (nil (sp!-n!>) (dact!>) !#!P!H!I !#!C!H!I !#!D !#!T !#!o!m!e!g!a!u !#!G !#!V!O!L !#!s!d!e!t!G !#!G!I (!*torsion !#!Q!Q)) )) (put '!#!D!A!C!T '!=dens '(t nil t nil)) (put '!#!T!D!I '!=type 0) (put '!#!T!D!I '!=idxl '(nil nil)) (put '!#!T!D!I '!=sidxl '((s 1 2))) (put '!#!T!D!I '!=way '( (nil (sp!-n!>) (tdi!>) !#!T !#!D !#!G !#!G!I !#!s!d!e!t!G !#!V!O!L !#!D!A!C!T !#!P!H!I !#!C!H!I !#!o!m!e!g!a!u ) )) (put '!#!T!D!I '!=constr '((tttnotn!>))) (put '!#!S!P!D!I!U '!=type 3) (put '!#!S!P!D!I!U '!=idxl '((u . 2))) (put '!#!S!P!D!I!U '!=way '( (nil nil (spinsd!>) !#!C!H!I !#!P!H!I !#!T !#!s!d!e!t!G !#!G !#!V!O!L ) )) (put '!#!S!P!D!I!U '!=constr '((sp!-n!>))) (put '!#!D!P!q '!=type 0) (put '!#!D!P!q '!=idxl '((d . 1))) (put '!#!D!P!q '!=way '( (nil nil (dequ!> !#!P!H!I !#!C!H!I '!#!D!P!q t) !#!P!H!I !#!C!H!I !#!D !#!o!m!e!g!a!u (!*torsion !#!Q!Q)) )) (put '!#!D!P!q '!=constr '((sp!-n!>))) (put '!#!D!C!q '!=type 0) (put '!#!D!C!q '!=idxl '((d . 1))) (put '!#!D!C!q '!=way '( (nil nil (dequ!> !#!C!H!I !#!P!H!I '!#!D!C!q nil) !#!P!H!I !#!C!H!I !#!D !#!o!m!e!g!a!u (!*torsion !#!Q!Q)) )) (put '!#!D!C!q '!=constr '((sp!-n!>))) % EM field ... (put '!#!A '!=type 1) (put '!#!A '!=constr '((dg2!>))) (put '!#!F!F '!=type 2) (put '!#!F!F '!=way '( ((From EM Potential) nil (fffroma!>) !#!A) ((From EM Tensor) nil (fffromft!>) !#!S (t !#!F!T)) ((From Complex EM 2 - form) (sp!>) (fffromffu!>) (t !#!F!F!U)) )) (put '!#!F!F '!=constr '((dg2!>))) (put '!#!J '!=type 1) (put '!#!J '!=way '( ((From Dirac Spinor) (sp!>) (dcurr!>) !#!P!H!I !#!C!H!I !#!T ) )) (put '!#!J '!=constr '((dg2!>))) (put '!#!F!T '!=type 0) (put '!#!F!T '!=idxl '(nil nil)) (put '!#!F!T '!=sidxl '((a 1 2))) (put '!#!F!T '!=way '( (nil nil (ftfromff!>) !#!D !#!F!F) )) (put '!#!F!T '!=constr '((dg2!>))) (put '!#!E!M!A!C!T '!=type '![dim!]) (put '!#!E!M!A!C!T '!=way '( (nil nil (emact!>) !#!F!F !#!V!O!L !#!s!d!e!t!G !#!T !#!G ) )) (put '!#!E!M!A!C!T '!=constr '((dg2!>))) (put '!#!E!M!A!C!T '!=dens '(t nil t nil)) (put '!#!T!E!M '!=type 0) (put '!#!T!E!M '!=idxl '(nil nil)) (put '!#!T!E!M '!=sidxl '((s 1 2))) (put '!#!T!E!M '!=way '( (nil nil (tembydef!>) !#!G!I !#!G !#!V!O!L !#!F!T !#!E!M!A!C!T ) )) (put '!#!T!E!M '!=constr '((dg2!>))) (put '!#!M!W!F!q '!=type '![dim1!]) (put '!#!M!W!F!q '!=way '( (nil nil (firstmw!>) !#!T !#!G !#!s!d!e!t!G !#!V!O!L !#!F!F ) )) (put '!#!M!W!F!q '!=constr '((dg2!>))) (put '!#!M!W!S!q '!=type 3) (put '!#!M!W!S!q '!=way '( (nil nil (secondmw!>) !#!F!F ))) (put '!#!M!W!S!q '!=constr '((dg2!>))) (put '!#!C!O!q '!=type '![dim!]) (put '!#!C!O!q '!=way '( (nil nil (contineq!>) !#!T !#!G !#!s!d!e!t!G !#!V!O!L !#!J ) )) (put '!#!C!O!q '!=constr '((dg2!>))) (put '!#!S!C!F '!=type 0) (put '!#!S!C!F '!=way '( (nil (ttt4!>) (firstscal!>) !#!T !#!G !#!s!d!e!t!G !#!V!O!L !#!F!F ) )) (put '!#!S!C!F '!=constr '((ttt4!>))) (put '!#!S!C!S '!=type 0) (put '!#!S!C!S '!=way '( (nil (ttt4!>) (secondscal!>) !#!T !#!G !#!s!d!e!t!G !#!V!O!L !#!F!F ) )) (put '!#!S!C!F '!=constr '((ttt4!>))) (put '!#!F!I!U '!=type 0) (put '!#!F!I!U '!=idxl '((u . 2))) (put '!#!F!I!U '!=way '( ((From Complex EM 2 - form) nil (fiufromffu!>) !#!S!U !#!V!O!L !#!F!F!U ) ((From EM 2 - form) nil (fiufromff!>) !#!S!U !#!V!O!L !#!F!F ) )) (put '!#!F!I!U '!=constr '((sp!>))) (put '!#!F!I!U '!=tex '("\Phi" . 70)) (put '!#!S!D!q '!=type 4) (put '!#!S!D!q '!=idxl '((d . 2))) (put '!#!S!D!q '!=way '( (nil nil (sduality!>) !#!S!D !#!F!F!U ) )) (put '!#!S!D!q '!=constr '((sp!>))) (put '!#!F!F!U '!=type 2) (put '!#!F!F!U '!=way '( ((From EM 2 - form) nil (ffufromff!>) !#!V!O!L !#!T !#!G !#!s!d!e!t!G !#!F!F ) ((From EM Spinor) (sp!>) (ffufromfiu!>) !#!S!U !#!F!I!U ) )) (put '!#!F!F!U '!=constr '((sp!>))) (put '!#!F!F!U '!=tex '("\Phi" . 70)) (put '!#!S!C!U '!=type 0) (put '!#!S!C!U '!=way '( ((From EM Spinor) nil (scufromfiu!>) !#!F!I!U ) ((From Complex EM 2 - form) nil (scufromffu!>) !#!V!O!L !#!F!F!U ) )) (put '!#!S!C!U '!=constr '((sp!>))) (put '!#!M!W!U!q '!=type 3) (put '!#!M!W!U!q '!=way '( (nil nil (complexmw!>) !#!T !#!G !#!s!d!e!t!G !#!V!O!L !#!F!F!U ) )) (put '!#!M!W!U!q '!=constr '((sp!>))) (put '!#!T!E!M!S '!=type 0) (put '!#!T!E!M!S '!=idxl '((u . 2)(d . 2))) (put '!#!T!E!M!S '!=sidxl '((h 1 2))) (put '!#!T!E!M!S '!=way '( (nil nil (tems!>) !#!F!I!U ))) (put '!#!T!E!M!S '!=constr '((sp!>))) % YM field ... (put '!#!A!Y!M '!=type 1) (put '!#!A!Y!M '!=idxl '((n . 9))) (put '!#!A!Y!M '!=constr '((dg2!>))) (put '!#!S!C!O!N!S!T '!=type 0) (put '!#!S!C!O!N!S!T '!=idxl '((n . 9)(n . 9)(n . 9))) (put '!#!S!C!O!N!S!T '!=sidxl '((a 1 2 3))) (put '!#!S!C!O!N!S!T '!=constr '((dg2!>))) (put '!#!F!F!Y!M '!=type 2) (put '!#!F!F!Y!M '!=idxl '((n . 9))) (put '!#!F!F!Y!M '!=way '( ((From YM Potential) nil (ffymfromaym!>) !#!A!Y!M !#!S!C!O!N!S!T ) ((From YM Tensor) nil (ffymfromftym!>) !#!S (t !#!F!T!Y!M)) )) (put '!#!F!F!Y!M '!=constr '((dg2!>))) (put '!#!F!T!Y!M '!=type 0) (put '!#!F!T!Y!M '!=idxl '((n . 9) nil nil)) (put '!#!F!T!Y!M '!=sidxl '((a 2 3))) (put '!#!F!T!Y!M '!=way '( (nil nil (ftymfromffym!>) !#!D !#!F!F!Y!M) )) (put '!#!F!T!Y!M '!=constr '((dg2!>))) (put '!#!Y!M!A!C!T '!=type '![dim!]) (put '!#!Y!M!A!C!T '!=way '( (nil nil (ymact!>) !#!F!F!Y!M !#!V!O!L !#!s!d!e!t!G !#!T !#!G ) )) (put '!#!Y!M!A!C!T '!=constr '((dg2!>))) (put '!#!Y!M!A!C!T '!=dens '(t nil t nil)) (put '!#!T!Y!M '!=type 0) (put '!#!T!Y!M '!=idxl '(nil nil)) (put '!#!T!Y!M '!=sidxl '((s 1 2))) (put '!#!T!Y!M '!=way '( (nil nil (tymbydef!>) !#!G!I !#!G !#!V!O!L !#!F!T!Y!M !#!Y!M!A!C!T ) )) (put '!#!T!Y!M '!=constr '((dg2!>))) (put '!#!Y!M!F!q '!=type '![dim1!]) (put '!#!Y!M!F!q '!=idxl '((n . 9))) (put '!#!Y!M!F!q '!=way '( (nil nil (firstym!>) !#!T !#!G !#!s!d!e!t!G !#!V!O!L !#!F!F!Y!M !#!S!C!O!N!S!T ) )) (put '!#!Y!M!F!q '!=constr '((dg2!>))) (put '!#!Y!M!S!q '!=type 3) (put '!#!Y!M!S!q '!=idxl '((n . 9))) (put '!#!Y!M!S!q '!=way '( (nil nil (secondym!>) !#!F!F!Y!M !#!S!C!O!N!S!T ) )) (put '!#!Y!M!S!q '!=constr '((dg2!>))) % Scalar field ... (put '!#!F!I '!=type 0) (put '!#!S!A!C!T!M!I!N '!=type '![dim!]) (put '!#!S!A!C!T!M!I!N '!=way '( (nil nil (sactmin!>) !#!F!I !#!V!O!L !#!G!I !#!D ))) (put '!#!S!A!C!T!M!I!N '!=dens '(t nil t nil)) (put '!#!S!A!C!T '!=type '![dim!]) (put '!#!S!A!C!T '!=way '( (nil nil (sact!>) !#!F!I !#!V!O!L !#!G!I !#!D (!*nonmin !#!R!R !#!A!C!O!N!S!T ) ))) (put '!#!S!A!C!T '!=dens '(t nil t nil)) (put '!#!S!C!q '!=type 0) (put '!#!S!C!q '!=way '( (nil nil (kgeq!>) !#!V!O!L !#!s!d!e!t!G !#!D !#!T !#!F!I (!*nonmin !#!A!C!O!N!S!T !#!R!R )))) (put '!#!T!S!C!L!M!I!N '!=type 0) (put '!#!T!S!C!L!M!I!N '!=idxl '(nil nil)) (put '!#!T!S!C!L!M!I!N '!=sidxl '((s 1 2))) (put '!#!T!S!C!L!M!I!N '!=way '( (nil nil (tsclmin!>) !#!F!I !#!V!O!L !#!G !#!D !#!S!A!C!T!M!I!N ))) % Constants ... (put '!#!A!C!O!N!S!T '!=type 0) (put '!#!A!C!O!N!S!T '!=idxl '((n . 2))) (put '!#!A!C!O!N!S!T '!=way '((nil nil (aconst!>)))) (put '!#!M!C!O!N!S!T '!=type 0) (put '!#!M!C!O!N!S!T '!=idxl '((n . 3))) (put '!#!M!C!O!N!S!T '!=way '((nil nil (mconst!>)))) (put '!#!L!C!O!N!S!T '!=type 0) (put '!#!L!C!O!N!S!T '!=idxl '((n . 6))) (put '!#!L!C!O!N!S!T '!=way '((nil nil (lconst!>)))) % Einstein Equations ... (put '!#!E!E!q '!=type 0) (put '!#!E!E!q '!=idxl '(nil nil)) (put '!#!E!E!q '!=sidxl '((s 1 2))) (put '!#!E!E!q '!=way '( (nil nil (einstein!>) !#!G !#!R!I!C !#!R!R !#!T!E!N!M!O!M ))) (put '!#!E!E!q '!=constr '((tttnotqn!>))) (put '!#!T!E!E!q '!=type 0) (put '!#!T!E!E!q '!=way '( (nil nil (einsteint!>) !#!R!R !#!T!E!N!M!O!M!T ))) (put '!#!T!E!E!q '!=constr '((sp!>)(tttnotqn!>))) (put '!#!C!E!E!q '!=type 0) (put '!#!C!E!E!q '!=idxl '((u . 2)(d . 2))) (put '!#!C!E!E!q '!=sidxl '((h 1 2))) (put '!#!C!E!E!q '!=way '( (nil nil (einsteinc!>) !#!R!C !#!T!E!N!M!O!M!S ))) (put '!#!C!E!E!q '!=constr '((sp!>)(tttnotqn!>))) % Gravitational Equations ... (put '!#!P!O!M!E!G!A!U '!=type 2) (put '!#!P!O!M!E!G!A!U '!=idxl '((u . 2))) (put '!#!P!O!M!E!G!A!U '!=way '( (nil nil (pomegau!>) !#!L!C!O!N!S!T !#!S!U (!*nonmin !#!A!C!O!N!S!T !#!F!I) ))) (put '!#!P!O!M!E!G!A!U '!=constr '((sp!-n!>))) (put '!#!P!T!H!E!T!A '!=type 2) (put '!#!P!T!H!E!T!A '!=idxl '(t)) (put '!#!P!T!H!E!T!A '!=way '( (nil nil (ptheta!>) !#!M!C!O!N!S!T ))) (put '!#!P!T!H!E!T!A '!=constr '((sp!-n!>)(tttq!>))) (put '!#!L!A!C!T '!=type 4) (put '!#!L!A!C!T '!=way '( (nil (sp!-n!>) (lact!>) !#!V!O!L !#!R!R !#!L!C!O!N!S!T !#!P!O!M!E!G!A!U !#!O!M!E!G!A!U (!*torsion !#!P!T!H!E!T!A !#!T!H!E!T!A) (!*nonmin !#!A!C!O!N!S!T !#!F!I) ) )) (put '!#!L!A!C!T '!=constr '((ttt4!>))) (put '!#!L!A!C!T '!=dens '(t nil t nil)) (put '!#!M!E!T!R!q '!=type 0) (put '!#!M!E!T!R!q '!=idxl '(nil nil)) (put '!#!M!E!T!R!q '!=sidxl '((s 1 2))) (put '!#!M!E!T!R!q '!=way '( (nil nil (metrequation!>) !#!D !#!T !#!S!U !#!V!O!L !#!L!A!C!T !#!T!E!N!M!O!M !#!o!m!e!g!a!u !#!o!m!e!g!a!d !#!O!M!E!G!A!U !#!P!O!M!E!G!A!U (!*torsion !#!T!H!E!T!A !#!P!T!H!E!T!A ) ) )) (put '!#!M!E!T!R!q '!=constr '((sp!-n!>))) (put '!#!T!O!R!S!q '!=type 3) (put '!#!T!O!R!S!q '!=idxl '((u . 2))) (put '!#!T!O!R!S!q '!=way '( (nil nil (torsequation!>) !#!T !#!S!U !#!o!m!e!g!a!u !#!P!O!M!E!G!A!U !#!P!T!H!E!T!A !#!S!P!I!N!U ) )) (put '!#!T!O!R!S!q '!=constr '((sp!-n!>)(tttq!>))) % Geodesics and congruences ... (put '!#!G!E!O!q '!=type 0) (put '!#!G!E!O!q '!=idxl '(1)) (put '!#!G!E!O!q '!=way '( (nil (tttapar!>) (geodesics!>) !#!G !#!G!I !#!T !#!D ))) (put '!#!G!E!O!q '!=constr '((tttapar!>))) % Null congruence ... (put '!#!K!V '!=type -1) (put '!#!N!C!o '!=type 0) (put '!#!N!C!o '!=way '( (nil nil (ncnq!>) !#!T !#!D !#!G !#!G!I !#!K!V ))) (put '!#!G!C!o '!=type 0) (put '!#!G!C!o '!=idxl '(t)) (put '!#!G!C!o '!=way '( (nil nil (ncgq!>) !#!T !#!D !#!G !#!G!I !#!K!V ((or !*torsion !*nonmetr) !#!r!o!m!e!g!a) ((and (null !*torsion) (null !*nonmetr)) !#!o!m!e!g!a) ) )) (put '!#!t!h!e!t!a!O '!=type 0) (put '!#!t!h!e!t!a!O '!=way '( (nil nil (nctheta!>) !#!T !#!D !#!G !#!G!I !#!K!V !#!N!C!o !#!G!C!o ((or !*torsion !*nonmetr) !#!r!o!m!e!g!a) ((and (null !*torsion) (null !*nonmetr)) !#!o!m!e!g!a) ) )) (put '!#!t!h!e!t!a!O '!=constr '((ttt4!>))) (put '!#!o!m!e!g!a!S!Q!O '!=type 0) (put '!#!o!m!e!g!a!S!Q!O '!=way '( (nil nil (ncomega!>) !#!T !#!D !#!G !#!G!I !#!K!V !#!N!C!o !#!G!C!o ((or !*torsion !*nonmetr) !#!r!o!m!e!g!a) ((and (null !*torsion) (null !*nonmetr)) !#!o!m!e!g!a) ) )) (put '!#!o!m!e!g!a!S!Q!O '!=constr '((ttt4!>))) (put '!#!s!i!g!m!a!S!Q!O '!=type 0) (put '!#!s!i!g!m!a!S!Q!O '!=way '( (nil nil (ncsigma!>) !#!T !#!D !#!G !#!G!I !#!K!V !#!t!h!e!t!a!O !#!N!C!o !#!G!C!o ((or !*torsion !*nonmetr) !#!r!o!m!e!g!a) ((and (null !*torsion) (null !*nonmetr)) !#!o!m!e!g!a) ) )) (put '!#!s!i!g!m!a!S!Q!O '!=constr '((ttt4!>))) % Kinematics ... (put '!#!U!V '!=type -1) (put '!#!U!V '!=way '((nil nil (uvfromuup!>) !#!D !#!U!U ))) (put '!#!U!U '!=type 0) (put '!#!U!U '!=idxl '(t)) (put '!#!U!U '!=way '( ((By Default) (tttdiag!>) (uudefault!>) ) ((From Velocity Vector) nil (uupfromuv!>) !#!T (t !#!U!V) ) )) (put '!#!U!S!Q '!=type 0) (put '!#!U!S!Q '!=way '((nil nil (usquare!>) !#!U!U !#!G ))) (put '!#!P!R '!=type 0) (put '!#!P!R '!=idxl '(t nil)) (put '!#!P!R '!=way '((nil nil (projector!>) !#!U!U !#!U!S!Q ))) (put '!#!a!c!c!U '!=type 0) (put '!#!a!c!c!U '!=idxl '(t)) (put '!#!a!c!c!U '!=way '( (nil nil (accelerat!>) !#!T !#!D !#!G !#!G!I !#!U!U ((or !*torsion !*nonmetr) !#!r!o!m!e!g!a) ((and (null !*torsion) (null !*nonmetr)) !#!o!m!e!g!a) ) )) (put '!#!o!m!e!g!a!U '!=type 0) (put '!#!o!m!e!g!a!U '!=idxl '(nil nil)) (put '!#!o!m!e!g!a!U '!=sidxl '((a 1 2))) (put '!#!o!m!e!g!a!U '!=way '( (nil nil (uomega!>) !#!T !#!D !#!G !#!G!I !#!U!U !#!P!R ((or !*torsion !*nonmetr) !#!r!o!m!e!g!a) ((and (null !*torsion) (null !*nonmetr)) !#!o!m!e!g!a) ) )) (put '!#!s!i!g!m!a!U '!=type 0) (put '!#!s!i!g!m!a!U '!=idxl '(nil nil)) (put '!#!s!i!g!m!a!U '!=sidxl '((s 1 2))) (put '!#!s!i!g!m!a!U '!=way '( (nil nil (usigma!>) !#!T !#!D !#!G !#!G!I !#!U!U !#!P!R !#!t!h!e!t!a!U ((or !*torsion !*nonmetr) !#!r!o!m!e!g!a) ((and (null !*torsion) (null !*nonmetr)) !#!o!m!e!g!a) ) )) (put '!#!t!h!e!t!a!U '!=type 0) (put '!#!t!h!e!t!a!U '!=way '( (nil nil (utheta!>) !#!T !#!D !#!G !#!G!I !#!U!U ((or !*torsion !*nonmetr) !#!r!o!m!e!g!a) ((and (null !*torsion) (null !*nonmetr)) !#!o!m!e!g!a) ) )) % Ideal Fluid ... (put '!#!P!R!E!S '!=type 0) (put '!#!E!N!E!R '!=type 0) (put '!#!T!I!F!L '!=type 0) (put '!#!T!I!F!L '!=idxl '(nil nil)) (put '!#!T!I!F!L '!=sidxl '((s 1 2))) (put '!#!T!I!F!L '!=way '( (nil nil (tfli!>) !#!G !#!U!S!Q !#!U!U !#!E!N!E!R !#!P!R!E!S ))) % Spin Fluid ... (put '!#!T!S!F!L '!=type 0) (put '!#!T!S!F!L '!=idxl '(nil nil)) (put '!#!T!S!F!L '!=sidxl '((s 1 2))) (put '!#!T!S!F!L '!=way '( (nil nil (tsfluid!>) !#!T !#!D !#!G !#!G!I !#!U!S!Q !#!U!U !#!U!V !#!E!N!E!R !#!P!R!E!S !#!S!P!F!L!T !#!F!C!o !#!o!m!e!g!a ))) (put '!#!T!S!F!L '!=constr '((tttnotn!>))) (put '!#!S!P!F!L '!=type 2) (put '!#!S!P!F!L '!=way '( ((From Spin Density) nil (spfl!>) !#!S !#!S!P!F!L!T ))) (put '!#!S!P!F!L!T '!=type 0) (put '!#!S!P!F!L!T '!=idxl '(nil nil)) (put '!#!S!P!F!L!T '!=sidxl '((a 1 2))) (put '!#!S!P!F!L!T '!=way '( ((From Spin Density 2 - form) nil (spflt!>) !#!D !#!S!P!F!L ))) (put '!#!S!P!F!L!U '!=type 3) (put '!#!S!P!F!L!U '!=idxl '((u . 2))) (put '!#!S!P!F!L!U '!=way '( (nil nil (spflu!>) !#!D !#!T !#!G !#!G!I !#!S!P!F!L!T !#!U!U !#!F!C!o ))) (put '!#!S!P!F!L!U '!=constr '((sp!>))) (put '!#!F!C!o '!=type 1) (put '!#!F!C!o '!=way '( (nil nil (frenkel!>) !#!U!V !#!S!P!F!L ))) % Total Energy-Momentum and Spin ... (put '!#!T!E!N!M!O!M '!=type 0) (put '!#!T!E!N!M!O!M '!=idxl '(nil nil)) (put '!#!T!E!N!M!O!M '!=sidxl '((s 1 2))) (put '!#!T!E!N!M!O!M '!=way '((nil nil (tenmom!>) ))) (put '!#!T!E!N!M!O!M!T '!=type 0) (put '!#!T!E!N!M!O!M!T '!=way '( (nil nil (tenmomt!>) !#!G!I !#!T!E!N!M!O!M ))) (put '!#!T!E!N!M!O!M!S '!=type 0) (put '!#!T!E!N!M!O!M!S '!=idxl '((u . 2)(d . 2))) (put '!#!T!E!N!M!O!M!S '!=sidxl '((h 1 2))) (put '!#!T!E!N!M!O!M!S '!=way '( (nil nil (tenmoms!>) !#!G !#!T!E!N!M!O!M !#!T!E!N!M!O!M!T ))) (put '!#!T!E!N!M!O!M!S '!=constr '((sp!>))) (put '!#!S!P!I!N!U '!=type 3) (put '!#!S!P!I!N!U '!=idxl '((u . 2))) (put '!#!S!P!I!N!U '!=way '((nil nil (spinu!>) ))) (put '!#!S!P!I!N!U '!=constr '((sp!>))) %------ Macros --------------------------------------------------------- % Macro Functions. Work like functions. Recognized by property =MACROS % its value is the evaluator function. Additional flags: % +MACROS - marks corresponding evaluating functions % +grgmac - protect external names from additional usage (flag '( ima!> re!> getsoln!> ) '!+macros) (flag '( !I!m !R!e !S!o!l !E!R!R!O!R ) '!+grgmac) (put '!I!m '!=macros 'ima!>) (put '!R!e '!=macros 're!>) (put '!S!o!l '!=macros 'getsoln!>) %--- Macros 2 and 3 ---------------------------------------------------- % Macro Tensor. Work in expressions like tensors. % They are flagged by +MACROS2 falg. They have their properties: % =type =idxl - as usual, and in addition properties: % =evf - function evaluator for the component % =ndl - list of required data (flag '( !#!x !#!X !#!d!i!m !#!s!i!g!n !#!s!g!n!t !#!s!d!i!a!g !#!p!m!s!g!n !#!m!p!s!g!n !#!h !#!h!i !#!g !#!g!i !#!d!e!l !#!d!e!l!h !#!e!p!s !#!e!p!s!i !#!e!p!s!h !#!e!p!s!i!h !#!E!P!S !#!E!P!S!I !#!D!E!L !#!s!i!g!m!a !#!s!i!g!m!a!i !#!C!H!R !#!C!H!R!F !#!C!H!R!T !#!S!P!C!O!E!F !#!c!c!i !#!P!H!I!N!P !#!P!S!I!N!P !#!a!l!p!h!a!n!p !#!b!e!t!a!n!p !#!g!a!m!m!a!n!p !#!e!p!s!i!l!o!n!n!p !#!k!a!p!p!a!n!p !#!r!h!o!n!p !#!s!i!g!m!a!n!p !#!t!a!u!n!p !#!m!u!n!p !#!n!u!n!p !#!l!a!m!b!d!a!n!p !#!p!i!n!p !#!D!D !#!D!T !#!d!d !#!d!u ) '!+macros2) % Coordinates (put '!#!x '!=type 0) (put '!#!x '!=idxl '(1)) (put '!#!x '!=evf 'x!>) (put '!#!X '!=type 0) (put '!#!X '!=idxl '(1)) (put '!#!X '!=evf 'x!>) % Conjugate spinorial index (put '!#!c!c!i '!=type 0) (put '!#!c!c!i '!=idxl '((n . 3))) (put '!#!c!c!i '!=evf 'ccin!>) % Signature (put '!#!s!d!i!a!g '!=type 0) (put '!#!s!d!i!a!g '!=idxl '((n))) (put '!#!s!d!i!a!g '!=evf 'diagonal!>) % Frame components (put '!#!h '!=type 0) (put '!#!h '!=idxl '(t 0)) (put '!#!h '!=ndl '(!#!T)) (put '!#!h '!=evf 'ham!>) (put '!#!h!i '!=type 0) (put '!#!h!i '!=idxl '(nil 1)) (put '!#!h!i '!=ndl '(!#!D)) (put '!#!h!i '!=evf 'hiam!>) % Holonomic metric (put '!#!g '!=type 0) (put '!#!g '!=idxl '(0 0)) (put '!#!g '!=sidxl '((s 1 2))) (put '!#!g '!=ndl '(!#!G !#!T)) (put '!#!g '!=evf 'gmetr!>) (put '!#!g '!=tex '!g) (put '!#!g!i '!=type 0) (put '!#!g!i '!=idxl '(1 1)) (put '!#!g!i '!=sidxl '((s 1 2))) (put '!#!g!i '!=ndl '(!#!G!I !#!D)) (put '!#!g!i '!=evf 'gimetr!>) (put '!#!g!i '!=tex '!g) % Delta symbols (put '!#!d!e!l '!=type 0) (put '!#!d!e!l '!=idxl '(t nil)) (put '!#!d!e!l '!=evf 'delta!>) (put '!#!d!e!l '!=tex "\delta") (put '!#!d!e!l!h '!=type 0) (put '!#!d!e!l!h '!=idxl '(1 0)) (put '!#!d!e!l!h '!=evf 'delta!>) (put '!#!d!e!l!h '!=tex "\delta") (put '!#!D!E!L '!=type 0) (put '!#!D!E!L '!=idxl '((uu . 1) (u . 1))) (put '!#!D!E!L '!=evf 'delta!>) (put '!#!D!E!L '!=tex "\delta") % Antysymmetric tensors (put '!#!e!p!s '!=type 0) (put '!#!e!p!s '!=idxl '(nil nil nil nil)) (put '!#!e!p!s '!=sidxl '((a 1 2 3 4))) (put '!#!e!p!s '!=ndl '(!#!s!d!e!t!G)) (put '!#!e!p!s '!=evf 'epsilf!>) (put '!#!e!p!s '!=tex '!E) (put '!#!e!p!s!i '!=type 0) (put '!#!e!p!s!i '!=idxl '(t t t t)) (put '!#!e!p!s!i '!=sidxl '((a 1 2 3 4))) (put '!#!e!p!s!i '!=ndl '(!#!s!d!e!t!G)) (put '!#!e!p!s!i '!=evf 'epsiuf!>) (put '!#!e!p!s!i '!=tex '!E) (put '!#!e!p!s!h '!=type 0) (put '!#!e!p!s!h '!=idxl '(0 0 0 0)) (put '!#!e!p!s!h '!=sidxl '((a 1 2 3 4))) (put '!#!e!p!s!h '!=ndl '(!#!d!e!t!g)) (put '!#!e!p!s!h '!=evf 'epsilh!>) (put '!#!e!p!s!h '!=tex '!E) (put '!#!e!p!s!i!h '!=type 0) (put '!#!e!p!s!i!h '!=idxl '(1 1 1 1)) (put '!#!e!p!s!i!h '!=sidxl '((a 1 2 3 4))) (put '!#!e!p!s!i!h '!=ndl '(!#!d!e!t!g)) (put '!#!e!p!s!i!h '!=evf 'epsiuh!>) (put '!#!e!p!s!i!h '!=tex '!E) (put '!#!E!P!S '!=type 0) (put '!#!E!P!S '!=idxl '((u . 1) (u . 1))) (put '!#!E!P!S '!=sidxl '((a 1 2))) (put '!#!E!P!S '!=evf 'epss!>) (put '!#!E!P!S '!=constr '((sp!>))) (put '!#!E!P!S '!=tex "\epsilon") (put '!#!E!P!S!I '!=type 0) (put '!#!E!P!S!I '!=idxl '((uu . 1) (uu . 1))) (put '!#!E!P!S!I '!=sidxl '((a 1 2))) (put '!#!E!P!S!I '!=evf 'epss!>) (put '!#!E!P!S!I '!=constr '((sp!>))) (put '!#!E!P!S!I '!=tex "\epsilon") % Sigma matrices (put '!#!s!i!g!m!a '!=type 0) (put '!#!s!i!g!m!a '!=idxl '(t (u . 1) (d . 1))) (put '!#!s!i!g!m!a '!=evf 'sigma!>) (put '!#!s!i!g!m!a '!=constr '((sp!>))) (put '!#!s!i!g!m!a '!=tex '"\sigma") (put '!#!s!i!g!m!a!i '!=type 0) (put '!#!s!i!g!m!a!i '!=idxl '(nil (uu . 1) (ud . 1))) (put '!#!s!i!g!m!a!i '!=evf 'sigmai!>) (put '!#!s!i!g!m!a!i '!=constr '((sp!>))) (put '!#!s!i!g!m!a!i '!=tex '"\sigma") % Christoffel symbols % of first kind (put '!#!C!H!R!F '!=type 0) (put '!#!C!H!R!F '!=idxl '(0 0 0)) (put '!#!C!H!R!F '!=sidxl '((s 2 3))) (put '!#!C!H!R!F '!=evf 'chrf!>) (put '!#!C!H!R!F '!=ndl '( !#!G !#!D )) % of second kind (put '!#!C!H!R '!=type 0) (put '!#!C!H!R '!=idxl '(1 0 0)) (put '!#!C!H!R '!=sidxl '((s 2 3))) (put '!#!C!H!R '!=evf 'chr!>) (put '!#!C!H!R '!=ndl '( !#!G !#!D !#!G!I !#!T )) % trace (put '!#!C!H!R!T '!=type 0) (put '!#!C!H!R!T '!=idxl '(0)) (put '!#!C!H!R!T '!=evf 'chrt!>) (put '!#!C!H!R!T '!=ndl '( !#!d!e!t!g )) (put '!#!S!P!C!O!E!F '!=type 0) (put '!#!S!P!C!O!E!F '!=idxl '((u . 2) nil)) (put '!#!S!P!C!O!E!F '!=constr '((sp!-n!>))) (put '!#!S!P!C!O!E!F '!=evf 'spcoef!>) (put '!#!S!P!C!O!E!F '!=ndl '( !#!D !#!o!m!e!g!a!u )) (put '!#!P!H!I!N!P '!=type 0) (put '!#!P!H!I!N!P '!=idxl '((u . 2)(d . 2))) (put '!#!P!H!I!N!P '!=evf 'phinp!>) (put '!#!P!H!I!N!P '!=ndl '( !#!R!C )) (put '!#!P!S!I!N!P '!=type 0) (put '!#!P!S!I!N!P '!=idxl '((u . 4))) (put '!#!P!S!I!N!P '!=evf 'psinp!>) (put '!#!P!S!I!N!P '!=ndl '( !#!R!W )) % Macros 3 extension of Macros 2. For quantities without indices. (flag '( !#!d!i!m !#!s!i!g!n !#!s!g!n!t !#!p!m!s!g!n !#!m!p!s!g!n !#!a!l!p!h!a!n!p !#!b!e!t!a!n!p !#!g!a!m!m!a!n!p !#!e!p!s!i!l!o!n!n!p !#!k!a!p!p!a!n!p !#!r!h!o!n!p !#!s!i!g!m!a!n!p !#!t!a!u!n!p !#!m!u!n!p !#!n!u!n!p !#!l!a!m!b!d!a!n!p !#!p!i!n!p !#!D!D !#!D!T !#!d!d !#!d!u ) '!+macros3) (flag '( !d!i!m !s!i!g!n !s!g!n!t ) '!+grgmac) % Dimension (put '!#!d!i!m '!=type 0) (put '!#!d!i!m '!=evf 'dim!>) % Signature (put '!#!s!i!g!n '!=type 0) (put '!#!s!i!g!n '!=evf 'sigprod!>) (put '!#!s!g!n!t '!=type 0) (put '!#!s!g!n!t '!=evf 'sigprod!>) (put '!#!p!m!s!g!n '!=type 0) (put '!#!p!m!s!g!n '!=evf 'pmsgn!>) (put '!#!m!p!s!g!n '!=type 0) (put '!#!m!p!s!g!n '!=evf 'mpsgn!>) % NP spin coefficients (put '!#!a!l!p!h!a!n!p '!=type 0) (put '!#!b!e!t!a!n!p '!=type 0) (put '!#!g!a!m!m!a!n!p '!=type 0) (put '!#!e!p!s!i!l!o!n!n!p '!=type 0) (put '!#!k!a!p!p!a!n!p '!=type 0) (put '!#!r!h!o!n!p '!=type 0) (put '!#!s!i!g!m!a!n!p '!=type 0) (put '!#!t!a!u!n!p '!=type 0) (put '!#!m!u!n!p '!=type 0) (put '!#!n!u!n!p '!=type 0) (put '!#!l!a!m!b!d!a!n!p '!=type 0) (put '!#!p!i!n!p '!=type 0) (put '!#!a!l!p!h!a!n!p '!=evf 'alphanp!>) (put '!#!b!e!t!a!n!p '!=evf 'betanp!>) (put '!#!g!a!m!m!a!n!p '!=evf 'gammanp!>) (put '!#!e!p!s!i!l!o!n!n!p '!=evf 'epsilonnp!>) (put '!#!k!a!p!p!a!n!p '!=evf 'kappanp!>) (put '!#!r!h!o!n!p '!=evf 'rhonp!>) (put '!#!s!i!g!m!a!n!p '!=evf 'sigmanp!>) (put '!#!t!a!u!n!p '!=evf 'taunp!>) (put '!#!m!u!n!p '!=evf 'munp!>) (put '!#!n!u!n!p '!=evf 'nunp!>) (put '!#!l!a!m!b!d!a!n!p '!=evf 'lambdanp!>) (put '!#!p!i!n!p '!=evf 'pinp!>) (put '!#!a!l!p!h!a!n!p '!=ndl '( !#!D !#!o!m!e!g!a!u )) (put '!#!b!e!t!a!n!p '!=ndl '( !#!D !#!o!m!e!g!a!u )) (put '!#!g!a!m!m!a!n!p '!=ndl '( !#!D !#!o!m!e!g!a!u )) (put '!#!e!p!s!i!l!o!n!n!p '!=ndl '( !#!D !#!o!m!e!g!a!u )) (put '!#!k!a!p!p!a!n!p '!=ndl '( !#!D !#!o!m!e!g!a!u )) (put '!#!r!h!o!n!p '!=ndl '( !#!D !#!o!m!e!g!a!u )) (put '!#!s!i!g!m!a!n!p '!=ndl '( !#!D !#!o!m!e!g!a!u )) (put '!#!t!a!u!n!p '!=ndl '( !#!D !#!o!m!e!g!a!u )) (put '!#!m!u!n!p '!=ndl '( !#!D !#!o!m!e!g!a!u )) (put '!#!n!u!n!p '!=ndl '( !#!D !#!o!m!e!g!a!u )) (put '!#!l!a!m!b!d!a!n!p '!=ndl '( !#!D !#!o!m!e!g!a!u )) (put '!#!p!i!n!p '!=ndl '( !#!D !#!o!m!e!g!a!u )) (put '!#!D!D '!=type -1) (put '!#!D!T '!=type -1) (put '!#!d!d '!=type -1) (put '!#!d!u '!=type -1) (put '!#!D!D '!=ndl '( !#!D )) (put '!#!D!T '!=ndl '( !#!D )) (put '!#!d!d '!=ndl '( !#!D )) (put '!#!d!u '!=ndl '( !#!D )) (put '!#!D!D '!=evf 'dddop!>) (put '!#!D!T '!=evf 'dtop!>) (put '!#!d!d '!=evf 'ddop!>) (put '!#!d!u '!=evf 'duop!>) %----------------------------------------------------------------------- %====== (3) Other Internals ============================================= %--------- Properties for Scaner ----------------------------------- (flag '( !/ !* !_ !~ !< !> !- !| !. ) '!=fc) %%-------- Properties for Translator ------------------------------- (put '!* '!=op2 'times2!>) (put '!/ '!=op2 'quoti!>) (put '!/!\ '!=op2 'dfpr2!>) (put '!_!| '!=op2 'inpr!>) (put '!| '!=op2 'vef!>) (put '!. '!=op2 'vpr!>) (flag '(times2!> quoti!> dfpr2!> inpr!> vef!> vpr!>) '!+multop2) (put '!@ '!=sysfun 'bvec!>) (put '!# '!=sysfun 'dualis!>) (put '!d '!=sysfun 'dx!>) (put '!~ '!=sysfun 'co!>) (put '!S!u!m '!=spectr 'sumtr!>) (put '!P!r!o!d '!=spectr 'prodtr!>) (put '!L!i!e '!=spectr 'lietr!>) (put '!D!c '!=spectr 'dctran!>) (put '!D!f!c '!=spectr 'dfctran!>) %(put '!L!i!m '!=spectr 'limtr!>) %(put '!L!i!m!M '!=spectr 'limtrm!>) %(put '!L!i!m!P '!=spectr 'limtrp!>) (put '!L!H!S '!=spectr 'lhs0!>) (put '!R!H!S '!=spectr 'rhs0!>) (put 'sub '!=spectr 'subtr!>) (put '!I!f '!=spectr 'iftran!>) %(put '!D!f '!=spectr 'pdftra!>) %(put '!D!f!p '!=spectr 'dfptra!>) (put '!E!R!R!O!R '!=spectr 'errortr!>) (flag '( funapply!> sumexec!> prodexec!> lhs!> rhs!> dummyvar!> subexec!> ifexec!> lieexec!> dcexec!> dfcexec!> error!> % limexec!> ) '!+specexec) %------- Boollean Expressions -------------------------------------- (put '!O!B!J!E!C!T '!=boolmac 'objexe!>) (put '!O!N '!=boolmac 'onexe!>) (put '!O!F!F '!=boolmac 'offexe!>) (put '!Z!E!R!O '!=boolmac 'zeroexe!>) (put '!H!A!S!V!A!L!U!E '!=boolmac 'valexe!>) (put '!N!U!L!L!M '!=boolmac 'nullexe!>) (flag '(objexe!> onexe!> offexe!> zeroexe!> valexe!> nullexe!>) '!+specbexe) %------- Flags and properties which must be cleared ---------------- (setq ![rpfl!] '( ((![const!]) (!+grg !+grgvar used!* constant) !=conj ) ((![fun!]) ( !+grg subfn !+grgvar !+fun used!* symmetric antisymmetric odd even) simpfn kvalue klist narg !=conj !=depend) ((![cord!]) (!+grg !+grgvar used!*) !=cord !=conj) ((![ocord!]) (!+grg !+grgvar used!*) !=cord !=conj) ((![apar!]) (!+grg !+grgvar used!*) ) )) (setq ![rpflcr!] '( ((![cord!]) (!+grg !+grgvar used!*) !=cord !=conj) )) (setq ![rpflcn!] '( ((![const!]) (!+grg !+grgvar used!* constant) !=conj) )) (setq ![rpflap!] '( ((![apar!]) (!+grg !+grgvar used!* constant) ) )) (setq ![rpflfu!] '( ((![fun!]) ( !+grg subfn !+grgvar !+fun used!* symmetric antisymmetric odd even dfp!_commute ) subfunc generic!_function simpfn kvalue klist narg !=conj !=depend) )) %------- List of Flags and Props important for Load/Unload ------ (setq ![allflags!] '( !+equ !+pl !+ivar !+abbr !+noncov !+hconn !+fconn !+uconn !+dconn )) (setq ![allprops!] '( !=type !=idxl !=sidxl !=constr !=tex !=dens )) %------- Commands ---------------------------------------------- % word!!! (setq ![instr!] '( (On !!!! onoff!> t) (Off !!!! onoff!> nil) (Quit !! grgquit!>) (System !!!! grgsystem!>) (Stop !! stop!>) (Find !!!! find!>) % (Calculate !!!! find!>) (Write !!!! write!>) (Zero !!!! zero!>) % (Nullify !!!! zero!>) (Print !!!! printi!>) (Evaluate !!!! evalcomm!> (function evel!>)) % (Simplify !!!! evalcomm!> (function evel!>)) (Erase !!!! erase!>) % (Delete !!!! erase!>) (Let !!!! leti!> t) (Match !!!! matchi!> t) (Clear !!!! cleri!> t) (For !!!! forinstrs!>) (Input !!!! from!>) (Dimension !!!! dimension!>) (!% !!!! comment!>) (Comment !!!! comment!>) (File !!!! showfil!>) (Factor !!!! orfare!> 'factor) (RemFac !!!! orfare!> 'remfac) (Order !!!! orfare!> 'order) (Holonomic !! turnbg!> nil) (Anholonomic !! turnbg!> t) (Show !!!! shcommands!>) (ds2 !! showlinel!>) (Time !! timei!>) (GC (Time !! gctime!>)) (Switch !!!! sflag!>) (Status !! shstatus!>) (Load !!!! loa!>) % (Restore !!!! loa!>) (Unload !!!! unl!>) % (Save !!!! unl!>) (Next !! next!>) (Pause !! pause!>) (Normalize !!!! evalcomm!> (function normel!>)) (Classify !!!! classify!>) (Output !!!! grgout!>) (Symmetric !!!! funsym!> 0) (Antisymmetric !!!! funsym!> 1) (Odd !!!! funsym!> 2) (Even !!!! funsym!> 3) (Coordinates !!!! datrc!> '![cord!] ![dim!]) (Constants !!!! datrc!> '![const!] nil) (Functions !!!! fun!>) (Generic (Functions !!!! genfun!>)) (New !!!! newcommands!>) (Object !!!! obdec!> 0) (Equation !!!! obdec!> 1) (Connection !!!! obdec!> 2) (Line (!- (Element !! showlinel!>)) (Length !!!! setlinel!>) ) (Make (Spinorial (Rotation !!!! rotas!>)) (Rotation !!!! rotat!> nil)) (Spinorial (Rotation !!!! rotas!>)) (Rotation !!!! rotat!> nil) (Change (Metric !!!! rotat!> t)) (Forget !!!! forget!>) (Solve !!!! solvei!>) (EndO !! closewrite!>) (EndW !! closewrite!>) (EndU !! closeunload!>) (End (of (Output !! closewrite!>) (Write !! closewrite!>) (Unload !! closeunload!>) )) (Inverse !!!! invi!>) (Null (Metric !! nullmetric!>)) (Package !!!! loadpack!> t) (Hold !!!! hold!> t) (Release !!!! hold!> nil) (Affine (Parameter !!!! affpar!>)) (copyright !! copyrzw!>) (lisp !! lisp!>) (debug !! otladka!>) )) %------- Commands allowed as composites ------------------------------ % word!!! (setq ![icompos!] '( Find Write Calculate Nullify Zero Save Unload Forget Erase Delete Simplify Evaluate Normalize Hold Release )) %------- Unlocked Commands when coordinates are undefined ------------ (flag '( onoff!> grgquit!> stop!> pause!> next!> from!> showfil!> erase!> zero!> comment!> timei!> datrc!> fun!> copyrzw!> loa!> sflag!> shobj!> obdec!> gctime!> shstatus!> shall!> forget!> grgsystem!> grgout!> setlinel!> hold!> lisp!> loadpack!> closewrite!> closeunload!> shcommands!> dimension!> otladka!> ) '!+unloc) %------- Reserved Variables ------------------------------------------ (setq ![rconstl!] '( e i pi infinity failed !E!C!O!N!S!T !D!M!A!S!S !S!M!A!S!S !G!C!O!N!S!T !C!C!O!N!S!T !L!C0 !L!C1 !L!C2 !L!C3 !L!C4 !L!C5 !L!C6 !A!C0 !M!C1 !M!C2 !M!C3 )) (operator '(arbcomplex!~)) (put 'arbcomplex '!=conj 'arbcomplex!~) (put 'arbcomplex!~ '!=conj 'arbcomplex) % These can not be used in new declarations ... (flag '( df nil sub !d !L!H!S !R!H!S !S!u!m !P!r!o!d !L!i!e !D!c !I!f !D!f !D!f!p !E!R!R!O!R % !L!i!m !L!i!m!M !L!i!m!P ) '!+grg) (flag ![rconstl!] '!+grg) (flag ![rconstl!] 'used!*) (flag ![rconstl!] '!+grgvar) (flag ![rconstl!] 'constant) %---- Specially Prohibiting the usage of some symbols in GRG --------- (flag '( conj repart impart fix floor round interpol ceiling set ws evenp list factorize ) '!+redbad ) %------- GRG Switches ---------------------------------------------- % GRG switches : (global '( !*aeval % If On REVAL(AEVAL()) else REVAL() (Off) !*wrs % Evaluate expression before Write if On (On) !*wmatr % Print 2-index scalars as matrices (Off) !*torsion % Torsion (Off) !*nonmetr % Nonmetricity (Off) !*unlcord % Saves coordinates in Save/Unload (On) !*auto % Automatical data calculation in expr (On) !*trace % Tracing evaluation process (On) !*showcommands % Show composite commands expansion (Off) !*expandsym % Sym Asym and othre in expr (Off) !*dfpcommute % Commutativity ofr DFP (On) !*nonmin % Nonminimal Interaction (Off) !*nofreevars % Prohibites free vars. in Print command (Off) !*cconst % Include cosm.-const. in equation or not (Off) !*full % Control number of components in Metr.Eq.(Off) !*latex % O !*grg % u !*reduce % t !*maple % p !*math % u !*macsyma % t !*dfindexed % DF in indexed form (Off) !*batch % Batch mode (Off) !*holonomic % Keeps farme holonomic during cord. (On) % and frame transformations !*showexpr % If On then values of nonzero expr is (Off) % shown in the process of classification )) % oftenly this is already fluid (cond ((not (or (fluidp '!*debug) (globalp '!*debug))) (global '( !*debug % Otladka )))) (setq ![flagl!] '( aeval % If On REVAL(AEVAL()) else REVAL() (Off) wrs % Evaluate expression before Write if On (On) wmatr % Print 2-index scalars as matrices (Off) torsion % Torsion (Off) nonmetr % Nonmetricity (Off) unlcord % Saves coordinates in Save/Unload (On) auto % Automatical data calculation in expr (On) trace % Tracing evaluation process (On) showcommands % Show composite commands expansion (Off) expandsym % Sym Asym and othre in expr (Off) dfpcommute % Commutativity ofr DFP (On) nonmin % Nonminimal Interaction (Off) nofreevars % Prohibites free vars. in Print command (Off) cconst % Include cosm.-const. in equation or not (Off) full % Control number of components in Metr.Eq.(Off) latex % O grg % u reduce % t maple % p math % u macsyma % t dfindexed % DF in indexed form (Off) batch % Batch mode (Off) holonomic % Keeps farme holonomic during cord. (On) % and frame transformations showexpr % If On then values of nonzero expr is (Off) % shown in the process of classification debug % Otladka (Off) )) (flag ![flagl!] '!+switch) % Set these initially to Off position ... (setq ![flagnil!] '( !*torsion !*nonmetr !*gc !*echo !*batch !*showcommands !*expandsym !*dfindexed !*aeval !*wmatr !*showexpr !*nonmin !*nofreevars !*cconst !*full !*debug )) % Set these initially to On position ... (setq ![flagt!] '( !*unlcord !*wrs !*trace !*auto !*holonomic !*dfpcommute )) % Output switches ... (setq ![flaglo!] '( grg reduce maple math macsyma )) % Switches tuning ... (put 'torsion '!=tuning 'tunetorsion!>) (put 'nonmetr '!=tuning 'tunenonmetr!>) (put 'fancy '!=tuning 'tunefancy!>) (put 'latex '!=tuning 'tunetex!>) (put 'grg '!=tuning 'tunegrg!>) (put 'reduce '!=tuning 'tunereduce!>) (put 'maple '!=tuning 'tunemaple!>) (put 'math '!=tuning 'tunemath!>) (put 'macsyma '!=tuning 'tunemacsyma!>) (put 'dfindexed '!=tuning 'tunedfindexed!>) (put 'debug '!=tuning 'swotladka!>) %---------- Special Treatment for Write ---------------------------- (put '![cord!] '!=datl '((datlc!> ![cord!] "Coordinates" t))) (put '![const!] '!=datl '((datlc!> ![const!] "Constants" t))) (put '![apar!] '!=datl '((datlc!> ![apar!] "Affine Parameter" nil))) (put '![fun!] '!=datl '((funl!>))) (put '![sol!] '!=datl '((solwri!>))) %---------- Special Actions For Load/Unload ------------------------ (put '![cord!] '!=unl '((putpnu!> nil ![cord!] (used!* !+grgvar !+grg) !=cord 1))) (put '![const!] '!=unl '((putpnu!> nil ![const!] (used!* !+grgvar !+grg) nil 2))) (put '![apar!] '!=unl '((putpnu!> nil ![apar!] (used!* !+grgvar !+grg) nil 4))) (put '![fun!] '!=unl '((putpnu!> (putfndp!>) ![fun!] (used!* !+fun !+grg) nil 3))) %---------- Standard Null Metric ----------------------------------- % Signature (-,+,+,+) (setq ![nullm!] '( ( nil -1 nil nil ) ( nil nil nil nil ) ( nil nil nil 1 ) ( nil nil nil nil ) )) % Signature (+,-,-,-) (setq ![nullm1!] '( ( nil 1 nil nil ) ( nil nil nil nil ) ( nil nil nil -1 ) ( nil nil nil nil ) )) %---------- For Nice Printing -------------------------------------- (flag '( !. !, !; !_ !/!\ !* !** !+ !- !_!| ![ !:!\! != !#! !] !^ !/ !' !.!. !'!' !# !| !@ !> !< !~ !>!= !<!= !: ) '!+nonsp) (put 'em '!=printas '!E!M) (put 'ym '!=printas '!Y!M) %---------- Indices Manipulations ---------------------------------- (flag '( !' !^ !. !_ ) '!+indexman) %----------------------------------------------------------------------- (put '!a '!=uc '!A) (put '!A '!=lc '!a) (put '!b '!=uc '!B) (put '!B '!=lc '!b) (put '!c '!=uc '!C) (put '!C '!=lc '!c) (put '!d '!=uc '!D) (put '!D '!=lc '!d) (put '!e '!=uc '!E) (put '!E '!=lc '!e) (put '!f '!=uc '!F) (put '!F '!=lc '!f) (put '!g '!=uc '!G) (put '!G '!=lc '!g) (put '!h '!=uc '!H) (put '!H '!=lc '!h) (put '!i '!=uc '!I) (put '!I '!=lc '!i) (put '!j '!=uc '!J) (put '!J '!=lc '!j) (put '!k '!=uc '!K) (put '!K '!=lc '!k) (put '!l '!=uc '!L) (put '!L '!=lc '!l) (put '!m '!=uc '!M) (put '!M '!=lc '!m) (put '!n '!=uc '!N) (put '!N '!=lc '!n) (put '!o '!=uc '!O) (put '!O '!=lc '!o) (put '!p '!=uc '!P) (put '!P '!=lc '!p) (put '!q '!=uc '!Q) (put '!Q '!=lc '!q) (put '!r '!=uc '!R) (put '!R '!=lc '!r) (put '!s '!=uc '!S) (put '!S '!=lc '!s) (put '!t '!=uc '!T) (put '!T '!=lc '!t) (put '!u '!=uc '!U) (put '!U '!=lc '!u) (put '!v '!=uc '!V) (put '!V '!=lc '!v) (put '!w '!=uc '!W) (put '!W '!=lc '!w) (put '!x '!=uc '!X) (put '!X '!=lc '!x) (put '!y '!=uc '!Y) (put '!Y '!=lc '!y) (put '!z '!=uc '!Z) (put '!Z '!=lc '!z) %------- Trigonometric Functions --------------------------------------- (flag '( sin cos tan cot sec csc sinh cosh tanh coth sech csch asin acos atan acot asec acsc asinh acosh atanh acoth asech acsch ) '!+trig) %============ End of GRGdecl.sl =========================================% |
Added grggeom.sl version [39ceddc9bb].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 | %==========================================================================% % 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 ============================================% |
Added grggrav.sl version [687b70f37d].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 | %==========================================================================% % 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 ==============================================% |
Added grginit.sl version [e20034adc6].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 | %==========================================================================% % GRGinit.sl Useful Functions, Cord Const Fun Declarations, Scanner % %==========================================================================% % GRG 3.2 Standard Lisp Source Code (C) 1988-2000 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. % %==========================================================================% %--------- Debuggin 05.96 -------------------------------------------------- % Switch otaldka (de swotladka!> (bool) (progn (cond ((not(iscsl!>)) (eval '(load debug)))) (setq ![erst1!] t) (setq ![erst1!] t) )) % Command otladka (de otladka!> nil (progn (swotladka!> t) (lisp!>) )) % lisp interpreter (de lisp!> nil (prog (w) (setq promptstring!* "<= ") (prin2 "Entering LISP ...")(terpri) loop (cond ((iscsl!>) (prog2 (printprompt promptstring!*) (setpchar promptstring!*)))) (setq w (read)) (cond ((or (eq w '!e!x!i!t) (eq w '!E!X!I!T)) (prin2 "Exiting LISP ...")(terpri) (setq promptstring!* "<- ") (cond ((iscsl!>) (setpchar promptstring!*))) (return nil))) (setq w (errorset w t nil)) (cond ((atom w) (print 'error)) (t (print (car w)))) (go loop))) %-------- Reduce version and OS auto detection --------------------------- % We use this since in some old versions of PSL BOUND is absent (de boundp!> (w) (cond ((getd 'boundp) (boundp w)) (t (setq w (errorset w nil nil)) (cond ((atom w) nil) (t t))))) % Check w into LISPSYSTEM* or not (de yes!> (w) (memq w (eval 'lispsystem!*))) % Is background PSL internally lowercase or not (de islowercase!> nil (cond ((getd '!c!a!r) t) (t nil))) (de showcase!> nil (cond ((islowercase!>) (prin2 "System variables are lower-cased: e i pi sin ...") (terpri)) (t (prin2 "System variables are upper-cased: E I PI SIN ...") (terpri)))) % This function is called at the very start of GRG and tryes % to set appropriate values for [dirsep] and [syscall]. % If something wrong this values can be overriden in grg.cfg (de tuneos!> nil (cond % We can tune. Works for R 3.5 and later ... ((boundp!> 'lispsystem!*) % [dirsep] (setq ![dirsep!] nil) % We prefer to have GRG with trailing / % for the sake of definiteness %(cond ((yes!> 'vms) (setq ![dirsep!] '!:)) % VMS (?) % ((yes!> 'unix) (setq ![dirsep!] '!/)) % UNIX % (t (setq ![dirsep!] '!\))) % Others % loaddirectories* under UNIX ... (cond ((and (yes!> 'unix) (boundp!> 'loaddirectories!*)) (set 'loaddirectories!* (cons "$reduce/xr/bin/" (eval 'loaddirectories!*))))) % [syscall] (cond ((yes!> 'vms) (setq ![syscall!] 2)) % VMS via quit (?) (t (setq ![syscall!] 1)))) % Other via system % No information for tuning is available. R 3.3 and 3.4 ... (t (setq ![dirsep!] nil) % In this case GRG env.var. must include % trailing \ or / or ... (setq ![syscall!] 1) % We allways trying system ))) % Is this CSL or PSL ? (de iscsl!> nil (cond ((and (boundp!> 'lispsystem!*) (yes!> 'csl)) t ) ((and (boundp!> 'lispsystem!*) (yes!> 'psl)) nil ) ((getd 'dskin) nil ) (t t ))) % OS (de os!> nil (cond ((boundp!> 'lispsystem!*) (cond ((yes!> 'dos) "DOS" ) ((yes!> 'unix) "UNIX" ) ((yes!> 'winnt) "Windows NT" ) ((yes!> 'os2) "OS/2" ) ((yes!> 'vms) "VMS" ) (t nil))) (t nil) )) %-------- General Useful Functions ---------------------------------------- %(de copy (lst) % (cond ((atom lst) lst) % ((null(cdr lst)) (cons (copy(car lst)) nil)) % ((null(car lst)) (cons nil (copy(cdr lst)))) % (t (cons (copy(car lst)) (copy(cdr lst)))))) % De in CSL explode2 is buggy so we provide replacement ... (de explode2!> (lst) (proc (wr wc) (setq lst (explode lst)) (while!> lst (setq wc (car lst)) (setq lst (cdr lst)) (cond ((eq wc '!!) (cond ((and lst (eq (car lst) '!!)) (setq wr (cons wc wr)) (setq lst (cdr lst))))) (t (setq wr (cons wc wr)))) ) (return (reversip wr)))) % Makes loop list from a list ... (de makeloop!> (lst) (proc (w) (setq w lst) (while!> (cdr w) (setq w (cdr w))) (rplacd w lst))) (de cout!> nil nil) (de rout!> nil nil) (de factorial!> (w) (cond ((zerop w) 1) (t (times w (factorial!> (sub1 w)))))) (de binom!> (wk wn) (quotient (factorial!> wn) (times (factorial!> wk) (factorial!> (difference wn wk))))) % Upper<->Lower Case conversion for letters ... (de tolc!> (w) (cond ((get w '!=lc) (get w '!=lc)) (t w))) (de touc!> (w) (cond ((get w '!=uc) (get w '!=uc)) (t w))) % To default case ... (de tostcase!> (w) (cond ((not(liter w)) w) (![lower!] (tolc!> w)) (t (touc!> w)))) % Error Interrupt ... (de err!> (we) (progn (setq ![er!] we) (error we nil))) %(de err!> (we) (throw '!$error!$ we)) (de errorset!> (we wa wb) (prog (wr) (setq wr (errorset we wa wb)) (cond ((null wr) (return ![er!])) (t (return wr))))) % Menu function ... % WQ - questions, WA - answers (de asker!> (wq wa) (proc (w) (while!> wq (prin2 (car wq)) (terpri) (setq wq (cdr wq))) (terpri) (cond ((or (getd 'x!-pr!!) (getenv "redfront")) (prog2 (prin2 " Type 0, 1 or 2") (setq promptstring!* (compress (list '!" (int2id 1) '! '!: (int2id 2) '!" ))))) (t (setq promptstring!* " Type 0, 1 or 2: "))) (cond ((iscsl!>) (prog2 (printprompt promptstring!*) (setpchar promptstring!*)))) (loop!> (exitif (memq (setq w (intern(readch))) wa))) (return w))) % Is there any number in the lst ? ... (de memnum!> (lst) (cond ((null lst) nil) ((numberp (car lst)) t) (t (memnum!> (cdr lst))))) % Cut the tail of lst. Side Effect! ... (de wipl12!> (lst) (prog2 (wipl12r!> lst) lst)) (de wipl12r!> (lst) (cond((null(cddr lst)) (rplacd lst nil)) ((eq (cadr lst) '!!) (rplacd lst nil)) (t(wipl12r!> (cdr lst))))) % Produces d x^wn 1-form wn=0,1,2,3,4... (de mkdx!> (wn) (proc (w wc) (setq wn (add1 wn)) (setq wc wn) (while!> (lessp 1 wc) (setq wc (sub1 wc)) (setq w (cons '(nil . t) w)) ) (return (ncons (cons 1 (cons (expt 2 wn) (reversip (cons '(t . t) w)))))))) % LESSP for lists ... (de lessl!> (w1 w2) (cond ((null w1) nil) ((atom w1) (lessp w1 w2)) ((equal (car w1) (car w2)) (lessl!> (cdr w1) (cdr w2))) (t (lessl!> (car w1) (car w2))))) % LEQ for lists ... (de leql!> (w1 w2) (cond ((null w1) t) ((atom w1) (leq w1 w2)) ((equal (car w1) (car w2)) (leql!> (cdr w1) (cdr w2))) (t (lessl!> (car w1) (car w2))))) % WN=2^N -> N (de log2!> (wn) (cond ((eqn wn 2) 1) (t (add1(log2!>(quotient wn 2)))))) % Absolute value ... (de abs!> (w) (cond ((lessp w 0) (minus w)) (t w))) % Like OR but with one argument ... (de orl!> (lst) (cond ((null lst) nil) ((car lst) t) (t (orl!>(cdr lst))))) %----- List Splitting and Analysis functions ------------------------------ % All ID=, in % (a b , c , k ...) -> ( (a b) (c) (k ...) ) (de memlist!> (id lst) (proc (wa wb) (setq lst (cons id lst)) (while!> lst (setq lst (cdr lst)) (while!> (and lst (not(eq (car lst) id))) (setq wa (cons (car lst) wa)) (setq lst (cdr lst))) (cond ((null wa) (prog2 (setq ![er!] 913) (return !!er!!))) (t(prog2 (setq wb (cons (reversip wa) wb)) (setq wa nil))))) (return(reversip wb)))) (de memlistbr!> (id lst) (proc (wa wb wl) (setq wl 0) (setq lst (cons id lst)) (while!> lst (setq lst (cdr lst)) (while!> lst (exitif (and (eq (car lst) id) (leq wl 0))) (cond ((eq (car lst) '![) (setq wl (add1 wl))) ((eq (car lst) '!]) (setq wl (sub1 wl))) ) (setq wa (cons (car lst) wa)) (setq lst (cdr lst))) (cond ((null wa) (prog2 (setq ![er!] 913) (return !!er!!))) (t(prog2 (setq wb (cons (reversip wa) wb)) (setq wa nil))))) (return(reversip wb)))) % All IDL=(+ - ) in % (a b - c + k ... ) -> ( ((a b).-) ((c).+) ...) (de mems!> (idl lst bool) (proc(w wa wss) (cond((null lst)(return nil))) (while!> lst (cond((setq wss(memq(car lst)idl)) (cond(wa (prog2 (setq w(cons(cons(cond(bool(reversip wa)) (t wa)) (car wss))w)) (setq wa nil))) (t(return !!er!!)))) ((memq(car lst)idl)(return !!er!!)) (t(setq wa(cons(car lst)wa)))) (setq lst(cdr lst)) (cond((and(null lst)wa)(return !!er!!))) ) (return(reversip w)))) % MEMBER with Synonymy ... (de memqs!> (wi lst) (cond((null lst) nil) ((eqs!> wi (car lst)) t) (t (memqs!> wi (cdr lst))))) % WA=(A B C 0 1) -> WA=(A B C) WD=(0 1) Side Effect for WA! (de selid!> (wa wd) % -> wd (cond((null(cdr wa)) nil) ((liter(cadr wa)) (selid!> (cdr wa) wd)) (t(progn (setq wd (cdr wa)) (rplacd wa nil) wd)))) % First WI=xxx with Synonymy in % (a b xxx m n ...) -> ( (b a) m n ...) (de seek1q!> (lst wi) (proc (wa) (while!> lst (cond ((eqs!> (car lst) wi) (return(cons wa (cdr lst))))) (setq wa(cons(car lst)wa)) (setq lst(cdr lst))))) % First W=(xxx yyy) in % (a b xxx m n ...) -> ( (b a) xxx m n ...) (de seek!> (lst w) (proc (wa) (while!> lst (cond ((memq (car lst) w) (return(cons wa lst)))) (setq wa(cons(car lst)wa)) (setq lst(cdr lst))))) % First WI=xxx in % (a b xxx m n ...) -> ( (b a) m n ...) (de seek1!> (lst wi) (proc (wa) (while!> lst (cond ((eq (car lst) wi) (return(cons wa (cdr lst))))) (setq wa(cons(car lst)wa)) (setq lst(cdr lst))))) % Special ASSOC with Synonymy ... (de assocf!> (nm lst) (proc (w) (while!> lst (cond ((eqs!> (caar lst) nm) (return(cdar lst))) ((and (idp(caar lst)) (pairp nm) (setq w(layf!> nm(car lst)))) (return w)) (t(setq lst(cdr lst))))))) % With Synonymy If WN=(a b) and LST=(a b c ...) -> (c ...) % otherwise NIL ... (de layf!> (wn lst) (proc nil (while!>(and wn lst) (cond ((eqs!> (car wn) (car lst)) (prog2 (setq lst (cdr lst)) (setq wn (cdr wn)))) (t (return nil)))) (cond ((null wn) (return lst))))) % Multy level ASSOCF> ... (de assf!> (nms lst) (cond ((null(cdr nms))(assocf!>(car nms)lst)) ((setq lst(assocf!>(car nms)lst))(assf!>(cdr nms)lst)) (t nil))) %----- Type of the Object may depend on the context ---------------------- (de gettype!> (u) % 05.96 (prog (w) (setq w (get u '!=type)) (return (cond ((null w) nil) ((numberp w) w) (t (eval w)))))) (de algp!> (u) (zerop(gettype!> u))) %----- Constructing Functions -------------------------------------------- % APPEND with LST1 reversed ... (de app!> (lst1 lst2) (proc nil (while!> lst1 (setq lst2(cons(car lst1)lst2)) (setq lst1(cdr lst1))) (return lst2))) % APPEND without repeated elements ... (de appmem!> (wa wb) (prog2(while!> wa (cond((not(memq(car wa) wb))(setq wb(cons(car wa)wb)))) (setq wa(cdr wa))) wb)) % CONS without repeated elements ... (de consmem!> (w lst) (cond((memq w lst) lst) (t(cons w lst)))) % CONS if WA non NIL otherwise WD ... (de consn!> (wa wd) (cond(wa (cons wa wd)) (t wd))) % CONS if WB non NIL otherwise NIL ... (de consni!> (wa wb) (cond(wb (cons wa wb))(t nil))) % Make List from linear list with !( !) ... (de mklevel!> (any) (cond((atom any)(ncons any)) (t(proc(wa wb wc) (loop!> (while!>(not(or(null any) (eq(car any)(quote !) )) (eq(car any)(quote !( )) )) (setq wa(cons(car any)wa)) (setq any(cdr any)) ) (exitif (or(null any)(eq(car any)(quote !) )))) (setq wb(mklevel!>(cdr any))) (setq wa(cons(car wb)wa)) (setq wc(nconc wa wc)) (setq wa nil) (setq any(cddr wb)) ) (return(cons(reversip(nconc wa wc)) any)))))) % Makes (TIMES a b c ...) if a,b,c... not NIL ... (de mktimes!> (lst) (cond ((memq nil lst) nil) (t (cons 'times lst)))) % Makes (TIMES a b) if ab not NIL ... (de mktimes2!> (wa wb) (cond ((and wa wb) (list 'times wa wb)) (t nil))) %----- Open With System Directory ---------------------------------------- (de grgopeninput!> (w) (prog (wc ww) (setq wc (errorset (list 'open w (list 'quote 'input)) nil nil)) (cond ((and (atom wc) ![grgdir!]) % Trying from system directory ... (progn (setq ww (compress (app!> ![grgdir!] (cdr(explode w))))) (setq wc (errorset (list 'open ww (list 'quote 'input)) nil nil)) (cond((not(atom wc)) (cond((equal w "grg.cfg") (msg!> 8902)) (t (msg!> 8901))))) (return wc))) (t(return wc))))) %-------- Types of Indices ----------------------------------------------- % Index Type Predicates ... (de holp!> (w) (numberp w)) % Holonomic (de holpu!> (w) (eqn w 1)) % Holonomic Up (de holpd!> (w) (eqn w 0)) % Holonomic Down (de tetrp!> (w) (or(eq w t)(null w))) % Tetrad (de tetrpu!> (w) (eq w t)) % Tetrad Up (de tetrpd!> (w) (null w)) % Tetrad Down (de spinp!> (w) (and (pairp w) (not(eq (car w) 'n)))) % Spinorial (de enump!> (w) (and (pairp w) (eq (car w) 'n))) % Enumarating (de dotp!> (w) (and (pairp w) % Dotted (memq (car w) '(d ud)))) (de undotp!> (w) (and (pairp w) % Undotted (memq (car w) '(u uu)))) (de upperp!> (w) (or (eq w 't) (eqn w 1) % Upper (and (pairp w) (memq (car w) '(uu ud))))) % The object W has a spinorial index ... (de isspinor!> (w) (isspinor1!> (get w '!=idxl))) (de isspinor1!> (wi) (cond ((null wi) nil) ((spinp!>(car wi)) t) (t (isspinor1!>(cdr wi))))) % The object has a holonomic index ... (de hashol!> (w) (hashol1!> (get w '!=idxl))) (de hashol1!> (wi) (cond ((null wi) nil) ((holp!>(car wi)) t) (t (hashol1!>(cdr wi))))) % The object has a frame index ... (de hasfram!> (w) (hasfram1!> (get w '!=idxl))) (de hasfram1!> (wi) (cond ((null wi) nil) ((tetrp!>(car wi)) t) (t (hasfram1!>(cdr wi))))) % Object has hol indices or frame which equals holonomic % in holonomic regime ... (de holonomq!> (wi) (or (hashol1!> wi) (and (holonomicp!>) (hasfram1!> wi)))) % For one index ... (de holonomq1!> (w) (or (holp!> w) (and (holonomicp!>) (tetrp!> w)))) % Gives Dimension of this index ... (de dimid!> (w) (cond ((or (atom w) (null(cdr w))) ![dim1!]) (t (cdr w)))) %----- intern-compress --------------------------------------------------- (de incom!> (w) (intern(compress w))) (de incomiv!> (w) (intern(compress (cons '!# w)))) (de idtostcase!> (w) (cond ((idp w) (intern (compress (mapcar (explode w) 'tostcase!>)))) (t w))) %----- Make Boxes for Data Storing --------------------------------------- % Sets empty Box for int.var. W ... (de makebox!> (w) (set w (mkbox!> w))) % Returns empty Box appropriate for int.var. W's storing ... (de mkbox!> (w) (mkspace!> (cond ((get w '!=idxl) (get w '!=idxl)) (t '((n . 0))) ))) % Box for general case ... (de mkspace!> (wi) % wi - idxl list (cond((null wi) nil) (t(mks1!> (dimid!>(car wi)) (mkspace!>(cdr wi)))))) % Makes list of WN+1 copyes of LST ... (de mks1!> (wn lst) (prog (w) (for!> i (0 1 wn) do (setq w (cons (copy lst) w))) (return w))) % Makes list of WN copyes of LST ... (de mknlist!> (wn lst) (prog (w) (for!> i (1 1 wn) do (setq w (cons (copy lst) w))) (return w))) % Box for scalar ... (de mkskl!> nil (copy '(nil))) % Box for 1-index tensor ... (de mkt1!> nil (mks1!> ![dim1!] nil)) % Box for wn-index tensor ... (de mkt!> (wn) (prog (w) (cond((eqn wn 1)(return(mkt1!>)))) (setq w (mkt!>(sub1 wn))) (return (mks1!> ![dim1!] w)))) % Forms list (0 1 2 ... (SUB1 [!DIM!])) (de dimlist!> (u) (cond ((eqn u ![dim!]) nil) (t (cons u (dimlist!> (add1 u)))))) % Forms list (1 2 ... [!DIM!]) (de dimlist1!> (u) (cond ((eqn u ![dim!]) (ncons ![dim!])) (t (cons u (dimlist1!> (add1 u)))))) %----- GET funstions for data components. 14.01.91 ----------------------- % Get with symmetry. % LST - box, W - numbers list, WSS - symmetries list, % WT - type 0, -1 or n , WE - equation (de gets!> (lst w wss wt we) (cond(wss(cond((setq w (syaidx!> w wss))(progn (setq w (cond(we(getelq!> lst w))(t(getel!> lst w)))) (cond(![cs!] (setq w (chsign!> (not(zerop wt)) w)))) (cond(![ch!] (setq w (coexpr!> wt w)))) w)) (t nil))) (t(prog2 (cond((null w)(setq w '(0)))) (cond(we(getelq!> lst w))(t(getel!> lst w))))))) (de gets0!> (lst w wss wt) (cond(wss(cond((setq w (syaidx!> w wss))(progn (setq w (getel!> lst w)) (cond(![cs!] (setq w (chsignx!> (not(zerop wt)) w)))) (cond(![ch!] (setq w (coexprx!> wt w)))) w)) (t nil))) (t(prog2 (cond((null w)(setq w '(0)))) (getel!> lst w))))) % Automatic Get with Symmetry. -> expr % WI - Internal Variable, W - Index List, (de getsa!> (wi w) (cond((flagp wi '!+macros2) (eval (cons (get wi '!=evf) w))) (t(gets!> (eval wi) w (get wi '!=sidxl) (gettype!> wi) (flagp wi '!+equ) )))) (de getsa0!> (wi w) (cond((flagp wi '!+macros2) (eval (cons (get wi '!=evf) w))) (t(gets0!> (eval wi) w (get wi '!=sidxl) (gettype!> wi) )))) % Cvalified Version of GETSA!> -> (type . expr) (de getsac!> (wi w) (consni!> (gettype!> wi) (cond((flagp wi '!+macros2) (eval (cons (get wi '!=evf) w))) (t(gets!> (eval wi) w (get wi '!=sidxl) (gettype!> wi) (flagp wi '!+equ) ))))) % Get 1-index. LST - box, WN - number ... (de getel1!> (lst wn) (cond ((eqn wn 0) (car lst)) ((eqn wn 1) (cadr lst)) ((eqn wn 2) (caddr lst)) ((eqn wn 3) (cadddr lst)) (t (getel1!> (cddddr lst) (difference wn 4))))) % Get 2-index. LST - box, WA,WB - numbers ... (de getel2!> (lst wa wb) (getel1!>(getel1!> lst wa)wb)) % Symmetric 2-index GETEL ... (de getel2s!> (lst wa wb) (cond((lessp wa wb) (getel2!> lst wa wb)) (t (getel2!> lst wb wa)))) % Hermitian sclar valued object ... (de getel2h!> (lst wa wb) (cond((leq wa wb) (getel2!> lst wa wb)) (t (coalg!> (getel2!> lst wb wa))))) % Antisymmetric 2-index GETEL ... (de getasy2!> (lst wa wb bool) (cond((eqn wa wb) nil) ((lessp wa wb) (getel2!> lst wa wb)) (t(chsign!> bool (getel2!> lst wb wa))))) % General Get. LST - box, W - numbers list ... (de getel!> (lst w) (cond((null(cdr w))(getel1!> lst(car w))) (t(getel!>(getel1!> lst(car w))(cdr w))))) % General Get for equations ... (de getelq!> (lst w) (get1equ!>(getel!> lst w))) % Get LHS or RHS of the equation ... (de get1equ!> (w) (cond ((null w) nil) (![lsrs!] (caddr w)) (t (cadr w)))) % Get F in F*d x^WN element of 1-form, WN=0,1, ... 05.96 (de getfdx!> (w wn) (prog2 (setq wn (expt 2 (add1 wn))) (while!> w (cond ((eqn wn (cadar w)) (return(caar w))) (t (setq w (cdr w))))))) % Same but for d x/\d x ... (de getfdxdx!> (w wl) (progn (setq wl (mapcar wl 'add1)) (setq wl (mapcar wl 'expt2!>)) (setq wl (eval (cons 'plus wl))) (while!> w (cond ((eqn wl (cadar w)) (return(caar w))) (t (setq w (cdr w))))))) (de expt2!> (w) (expt 2 w)) % Get 1-lower-index form with raised index ... (de getup!> (w wa) (cond ((imotop!>) (fndfpr!> (diagmi!> wa) (getel1!> w (ai!> wa)))) (t (dfsum!> (foreach!> m in (dimlist!> 0) collect (fndfpr!> (getimetr!> wa m) (getel1!> w m))))))) % Get 1-upper-index form with index lowered ... (de getlo!> (w wa) (cond((motop!>) (fndfpr!> (diagm!> wa) (getel1!> w (ai!> wa)))) (t(dfsum!> (foreach!> m in (dimlist!> 0) collect (fndfpr!> (getmetr!> wa m) (getel1!> w m))))))) % Get 1-upper-index alg with index lowered ... (de getloa!> (w wa) (cond((motop!>) (mktimes2!> (diagm!> wa) (getel1!> w (ai!> wa)))) (t(cons 'plus (foreach!> m in (dimlist!> 0) collect (mktimes2!> (getmetr!> wa m) (getel1!> w m))))))) % Get WN'th element in the LST ... (de getn!> (lst wn) (cond ((eqn wn 1) (car lst)) ((eqn wn 2) (cadr lst)) ((eqn wn 3) (caddr lst)) ((eqn wn 4) (cadddr lst)) (t (getn!> (cddddr lst) (difference wn 4) )))) %--------- Specialized Gets ---------------------------------------------- % Frame ... 05.96 (de getframe!> (w) (getel1!> !#!T w)) (de getiframe!> (w) (getel1!> !#!D w)) % Components of Frame/Inverse Frame ... 05.96 % In basis mode gives h^a_i with i-basis index (de ham0!> (wa wm) (getfdx!> (getel1!> !#!T wa) wm)) % h^a_m (de hiam0!> (wa wm) (getfdx!> (getel1!> !#!D wa) wm)) % h_a^m % Metric ... 05.96 (de getmetr!> (wa wb) (cond ((lessp wa wb) (getel2!> !#!G wa wb)) (t (getel2!> !#!G wb wa)))) % Inv Metric ... 05.96 (de getimetr!> (wa wb) (cond ((lessp wa wb) (getel2!> !#!G!I wa wb)) (t (getel2!> !#!G!I wb wa)))) % Riemann Tensor ... (de getrim!> (wa wb wc wd) (cond ((eqn wc wd) nil) ((lessp wc wd) (getel!> !#!R!I!M (list wa wb wc wd))) (t (chsigna!> (getel!> !#!R!I!M (list wa wb wd wc)))))) %----- PUT funstions for data components. 14.01.91 ----------------------- % Put general. WE - data component, LST - box, W - numbers list ... (de putel!> (we lst w) (prog2 (setq w (pgetel!> lst w)) (rplaca w we))) % Put 1-index. WE - data component, LST - box, WN - number ... (de putel1!> (we lst wn) (prog2 (setq wn (pgetel1!> lst wn)) (rplaca wn we))) (de pgetel!> (lst w) (cond((null(cdr w))(pgetel1!> lst(car w))) (t(pgetel!>(car(pgetel1!> lst(car w)))(cdr w))))) (de pgetel1!> (lst wn) (cond ((eqn wn 0) lst) (t(getel0!>(cdr lst)(sub1 wn))))) (de getel0!> (lst wn) (cond ((eqn wn 0) lst) (t(getel0!>(cdr lst)(sub1 wn))))) %--------- Symmetry ------------------------------------------------------ % Index list -> Index list in standard order, % sign changing in [CS] and comlex conjugation in [CH] % W - index list, WSS - symmetry list ... (de syaidx!> (w wss) (progn (setq ![cs!] nil) (setq ![ch!] nil) (cond((null wss) w) (t(prog (wr wa wb wc) (setq wb wss) lab (setq wa (syaidx1!> w (car wss))) (cond ((null wa) (return nil))) (setq wr (cons wa wr)) (setq wss (cdr wss)) (cond (wss (go lab))) (setq wr (reverse wr)) (setq wc (copy w)) (newidx!> wc wr wb) (return wc) ))))) % For one groop of symmetries ... (de syaidx1!> (w wss) (cond((numberp wss) (getn!> w wss)) ((numberp(car wss)) (syaidxl!> w wss)) ((eq (car wss) 'h) (prog (w1 w2) % Hermitian ... (setq w1 (syaidx1!> w (cadr wss))) (setq w2 (syaidx1!> w (caddr wss))) (cond((or(null w1)(null w2)) (return nil))) (cond((lessl!> w2 w1) (prog2 (setq ![ch!] (not ![ch!])) (return(list w2 w1))))) (return(list w1 w2)))) ((eq (car wss) 's) (prog (w1 wr wb wa wx) % Symmmetric ... (setq wss (cdr wss)) lab1 (setq w1 (syaidx1!> w (car wss))) (cond((null w1) (return nil))) (setq wr (cons w1 wr)) (setq wss (cdr wss)) (cond(wss(go lab1))) lab3 (setq wa nil) (setq wr (reverse wr)) (setq wb nil) lab2 (cond ((and wa (lessl!> (car wr) (car wa))) (progn (setq wb t) (setq wx (car wa)) (setq wa (cons wx (cons (car wr) (cdr wa)))) (setq wr (cdr wr)) )) (t(progn (setq wa (cons (car wr) wa)) (setq wr (cdr wr))))) (cond(wr(go lab2))) (cond(wb (prog2 (setq wr wa) (go lab3)))) (return(reverse wa)))) ((eq (car wss) 'a) (prog (w1 wr wb wa wx) % Antisymmmetric ... (setq wss (cdr wss)) lab1 (setq w1 (syaidx1!> w (car wss))) (cond((or (null w1) (member w1 wr)) (return nil))) (setq wr (cons w1 wr)) (setq wss (cdr wss)) (cond(wss(go lab1))) lab3 (setq wa nil) (setq wr (reverse wr)) (setq wb nil) lab2 (cond ((and wa (lessl!> (car wr) (car wa))) (progn (setq wb t) (setq ![cs!] (not ![cs!])) (setq wx (car wa)) (setq wa (cons wx (cons (car wr) (cdr wa)))) (setq wr (cdr wr)) )) (t(progn (setq wa (cons (car wr) wa)) (setq wr (cdr wr))))) (cond(wr(go lab2))) (cond(wb (prog2 (setq wr wa) (go lab3)))) (return(reverse wa)))) ((eq (car wss) 'c) (prog (w1 wr wb wa wx) % Cyclic ... (setq wss (cdr wss)) lab1 (setq w1 (syaidx1!> w (car wss))) (cond((null w1) (return nil))) (setq wr (cons w1 wr)) (setq wss (cdr wss)) (cond(wss(go lab1))) (setq wr (reverse wr)) (setq wb (cdr wr)) (setq wa (ncons(car wr))) lab2 (setq wx (append wb (reverse wa))) (cond((lessl!> wx wr)(setq wr wx))) (setq wa (cons (car wb) wa)) (setq wb (cdr wb)) (cond(wb(go lab2))) (return wr))) )) % List of indices ... (de syaidxl!> (w wss) (cond ((null wss) nil) (t (prog (wa wd) (setq wa (syaidx1!> w (car wss))) (cond((null wa)(return nil))) (setq wd (syaidxl!> w (cdr wss))) (cond((and (null wd) (cdr wss)) (return nil))) (return(cons wa wd)))))) % Forms final list of indices in standard order ... (de newidx!> (w wr wss) (cond((null wss) nil) ((idp(car wss)) (newidx!> w wr (cdr wss))) ((numberp(car wss)) (prog2 (putel1!> (car wr) w (sub1(car wss))) (newidx!> w (cdr wr) (cdr wss)))) (t(prog2 (newidx!> w (car wr) (car wss)) (newidx!> w (cdr wr) (cdr wss)) )))) % Predicate of standard oredering for Index list. % W - index list, WSS - Symmetry list ... (de syaidxp!> (w wss) (cond(wss(prog nil lab (cond((null(syaidxp1!> w (car wss))) (return nil))) (setq wss (cdr wss)) (cond(wss(go lab))) (return t))) (t t))) % For one symmetry groop ... (de syaidxp1!> (w wss) (cond((numberp wss) (getn!> w wss)) ((numberp(car wss)) (syaidxlp!> w wss)) ((or (eq (car wss) 's) (eq (car wss) 'h)) (prog (w1 w2 wr) lab (setq wss (cdr wss)) (setq w2 (syaidxp1!> w (car wss))) (cond((null w2)(return nil))) (setq wr (cons w2 wr)) (cond((and w1 (not(leql!> w1 w2))) (return nil)) ((null(cdr wss)) (return(reversip wr)))) (setq w1 w2) (go lab))) ((eq (car wss) 'a) (prog (w1 w2 wr) lab (setq wss (cdr wss)) (setq w2 (syaidxp1!> w (car wss))) (cond((null w2)(return nil))) (setq wr (cons w2 wr)) (cond((and w1 (not(lessl!> w1 w2))) (return nil)) ((null(cdr wss)) (return(reversip wr)))) (setq w1 w2) (go lab))) ((eq (car wss) 'c) (prog (wr w1 w2) lab (setq wss (cdr wss)) (setq w2 (syaidxp1!> w (car wss))) (cond((null w2)(return nil))) (setq wr (cons w2 wr)) (cond((cdr wss) (go lab))) (setq wr (reverse wr)) (setq w2 wr) lab1 (setq w1 (cons (car w2) w1)) (setq w2 (cdr w2)) (cond((lessl!> (append w2 (reverse w1)) wr) (return nil)) ((cdr w2)(go lab1))) (return wr))))) (de syaidxlp!> (w wss) (cond(wss(prog (wr ww) lab (cond((null(setq ww (syaidxp1!> w (car wss)))) (return nil))) (setq wr (cons ww wr)) (setq wss (cdr wss)) (cond(wss(go lab))) (return(reversip wr)))) (t t))) %------ Synonymy --------------------------------------------------------- % Defines New Synonymy ... (dm synonymous!> (u) (list 'synonymous0!> (list 'quote (cdr u)))) (de synonymous0!> (u) (proc nil (setq ![lower!] (islowercase!>)) (while!> u (synonymous1!> (car u)) (setq u(cdr u))))) (de synonymous1!> (u) (proc (w) (setq w (gensym)) (cond ((iscsl!>) (setq u (mapcar u 'idtostcase!>)))) (while!> u (put (car u) 'grgsyn w) (setq u (cdr u))))) % Equal with synonymy ... (de eqs!> (id1 id2) (cond ((and (idp id1) (idp id2)) (setq id1 (idtostcase!> id1)) (setq id2 (idtostcase!> id2)) (eqs0!> id1 id2)) (t (eqs0!> id1 id2)))) (de eqs0!> (id1 id2) (or (eq id1 id2) (eqn id1 id2) (and (idp id1) (idp id2) (get id1 'grgsyn) (eq (get id1 'grgsyn) (get id2 'grgsyn))) (and (pairp id1) (pairp id2) (eqs!> (car id1) (car id2)) (eqs!> (cdr id1) (cdr id2))))) %----- Dimension ; declaration 05.05.96 ---------------------------------- (de dimension!> (w) (proc (wd wss) (cond ((not ![firsti!]) (setq ![er!] 88012) (return !!er!!)) ((null w) (setq ![er!] 88011) (return !!er!!))) (setq wd (car w)) (setq w (cdr w)) (cond ((or (not(numberp wd)) (lessp wd 2)) (setq ![er!] 8800) (return !!er!!))) (cond ((or (null w) (not(eqs!> (car w) 'with)) % word!!! (null (cdr w))) (setq ![er!] 88011) (return !!er!!))) (setq w (cdr w)) (cond ((eqs!> (car w) 'signature) (setq w (cdr w)))) % word!!! (cond ((or (null w) (cdr w)) (setq ![er!] 88011) (return !!er!!)) (t (setq w (car w)))) (setq w (memlist!> '!, w)) (cond ((eq w !!er!!) (setq ![er!] 88011) (return !!er!!))) (setq w (expandnum!> w)) (while!> w (cond ((equal (car w) '( !+ )) (setq wss (cons 1 wss))) ((equal (car w) '( !- )) (setq wss (cons -1 wss))) (t (setq ![er!] 88011) (return !!er!!))) (setq w (cdr w))) (cond ((not(equal wd (length wss))) (setq ![er!] 8801) (return !!er!!))) (setq ![dim!] wd) (setq ![sgn!] (reverse wss)) (tunedim!>) (return t))) (de expandnum!> (w) (cond ((null w) nil) ((cdar w) (append (expandnum1!> (car w)) (expandnum!> (cdr w)))) (t (cons (car w) (expandnum!> (cdr w)))))) (de expandnum1!> (w) (cond ((numberp(car w)) (mknlist!> (car w) (ncons(cadr w)))) ((numberp(cadr w)) (mknlist!> (cadr w) (ncons(car w)))) (t (ncons w)))) %----- Coordinates ; and Constants ; declaration 20.02.94 ---------------- % LST - Text, WN - Internal variable, WD - Dimension ... (de datrc!> (lst wn wd) (proc (w wc) (cond((null lst)(return nil)) ((and wd ![cord!])(prog2(setq ![er!] 1101)(return !!er!!)))) (setq lst(memlist!> '!, lst)) (cond((eq lst !!er!!)(prog2(setq ![er!] 2202)(return lst)))) (while!> lst (cond((or(cdar lst)(not(idp(caar lst)))) (prog2(setq ![er!] 2201)(return !!er!!))) ((flagp (caar lst) '!+grg) (progn(setq ![er!] 5013)(doub!>(caar lst))(return !!er!!))) ((redused!>(caar lst)) (progn(setq ![er!] 50130)(doub!>(caar lst))(return !!er!!))) ) (setq w(cons(caar lst) w)) (setq lst(cdr lst))) (cond((and wd(not(eqn(length w) wd))) (prog2 (setq ![er!] 2203)(return !!er!!)))) (setq wc 0) (setq w(reversip w)) (set wn (append w (eval wn))) (flag w 'used!*) (flag w '!+grgvar) (flag w '!+grg) (cond ((null wd) (flag w 'constant))) (cond (wd (foreach!> x in w do (prog2 (put x '!=cord wc) (setq wc (add1 wc)) )))) (copar1!> (ncons(eval wn))) (return t) )) %----- Affine Parameter Declaration 10.96 -------------------------------- (de affpar!> (lst) (cond ((null lst) nil) (t (prog (w) (cond ((or (cdr lst) (not(idp(car lst)))) (setq ![er!] 1100) (return !!er!!))) (setq lst (car lst)) (cond ((flagp lst '!+grg) (progn (setq ![er!] 5013) (doub!> lst) (return !!er!!))) ((redused!> lst) (progn (setq ![er!] 50130) (doub!> lst) (return !!er!!))))) (setq lst (ncons lst)) (flag lst '!+grg) (flag lst '!+grgvar) (flag lst 'used!*) (flag lst 'constant) (setq ![apar!] lst) (foreach!> x in ![cord!] do (depend (cons x lst)))))) %----- Asy, Sy, Odd, Even declarations 20.02.94 ------------------------- (de funsym!> (lst wn) (proc (w) (cond((null lst)(return nil))) (setq lst(memlist!> '!, lst)) (cond((eq lst !!er!!)(prog2(setq ![er!] 2202)(return lst)))) (while!> lst (cond((or(cdar lst)(not(idp(caar lst)))) (prog2(setq ![er!] 1100)(return !!er!!))) ((not(or(flagp (caar lst) '!+fun)(redgood!>(caar lst)))) (progn(setq ![er!] 2022)(doub!>(caar lst))(return !!er!!)))) (setq w(cons(caar lst) w)) (setq lst(cdr lst))) (cond ((eqn wn 0) (flag w 'symmetric)) ((eqn wn 1) (flag w 'antisymmetric)) ((eqn wn 2) (flag w 'odd)) ((eqn wn 3) (flag w 'even)) ) (return t) )) %--------- Functions ; declaration --------------------------------------- (de fun!> (w) (proc (wi wa wb wss) (cond ((null w) (return nil))) (setq w (memlist!> '!, w)) (cond ((eq w !!er!!) (prog2(setq ![er!] 5012)(return w)))) (setq wi (mapcar w 'car)) (setq wa (mapcar wi 'idp)) (cond ((memq nil wa) (prog2 (setq ![er!] 5012) (return !!er!!)))) (setq wi (mapcar wi 'fun1!>)) % ids list ... (cond ((memq !!er!! wi) (return !!er!!))) (setq wss (remnil!> wi)) (setq w (mapcar w 'cdr)) (setq w (mapcar w 'fundep!>)) % dep list ... (cond ((memq !!er!! w) (return !!er!!))) (while!> w (flag (ncons (car wi)) '!+grgvar) (flag (ncons (car wi)) 'used!*) (setq wb (car w)) % dep list (cond (wb (setq wb (cons (car wi) wb)) (depend wb) (put (car wi) '!=depend wb) )) (setq w (cdr w)) (setq wi (cdr wi))) (flag wss '!+fun) (flag wss '!+grg) (operator wss) (setq ![fun!] (append wss ![fun!])) (copar1!> (ncons ![fun!])) (return t))) % Removes all NIL from the list W ... (de remnil!> (w) (cond ((eq w nil) nil) ((car w) (cons(car w)(remnil!>(cdr w)))) (t (remnil!>(cdr w))))) % Check that W can be declared as new function ... (de fun1!> (w) (cond ((flagp w '!+grg) % Already used in GRG (progn (doub!> w) (setq ![er!] 5013) !!er!!)) ((redbad!> w) % Known to reduce and cannot be used in GRG (progn (doub!> w) (setq ![er!] 50130) !!er!!)) ((redgood!> w) % Known to reduce and transparent for GRG (progn (doub!> w) (msg!> 50131) nil)) (t w))) % Functions Dependence List ... (de fundep!> (lst) (cond((null lst) nil) ((equal lst '( ( !* ) )) (copy ![cord!])) ((or (cdr lst) (atom(car lst)))(prog2 (setq ![er!] 5016) !!er!!)) (t(prog nil (setq lst(car lst)) (setq lst (memlist!> '!, lst)) (cond((eq lst !!er!!)(prog2(setq ![er!] 5016)(return lst)))) (setq lst (mapcar lst 'fundep1!>)) (cond((memq !!er!! lst)(prog2(setq ![er!] 5016)(return !!er!!)))) (return lst))))) (de fundep1!> (w) (cond ((or (cdr w) (not(idp(car w))) (not(flagp (car w) '!+grgvar))) !!er!!) (t(car w)))) %--------- Generic Functions ; declaration ------------------------------- (de genfun!> (w) (proc (wi wa wss wsss wx) (cond ((null w) (return nil)) ((eq (loadpack!> '(dfpart) nil) !!er!!) (setq ![er!] 5100) (return !!er!!))) (setq w (memlist!> '!, w)) (cond ((eq w !!er!!) (prog2(setq ![er!] 5012)(return w)))) (setq wi (mapcar w 'car)) (setq wa (mapcar wi 'idp)) (cond ((memq nil wa) (prog2 (setq ![er!] 5012) (return !!er!!)))) (setq wi (mapcar wi 'fun1!>)) % Ids list ... (cond ((memq !!er!! wi) (return !!er!!))) (setq wss (remnil!> wi)) (setq w (mapcar w 'cdr)) (setq w (mapcar w 'genfundep!>)) % Dep list ... (cond ((memq !!er!! w) (return !!er!!))) (while!> w (setq wsss (cons (cons (car wi) (car w)) wsss)) (setq w (cdr w)) (setq wi (cdr wi))) (setq wsss (reverse wsss)) (flag wss 'used!*) (setq wx (errorset (list 'generic!_function (list 'quote wsss)) ![erst1!] ![erst2!])) (cond ((atom wx) (return !!er!!))) (cond (!*dfpcommute (dfp!_commute wsss))) (flag wss '!+grgvar) (flag wss '!+fun) (flag wss '!+grg) (setq wx wsss) (while!> wsss (put (caar wsss) '!=depend (car wsss)) (setq wsss (cdr wsss))) (setq ![fun!] (append wss ![fun!])) (setq ![gfun!] (append wx ![gfun!])) (copar1!> (ncons ![fun!])) (copar1!> (ncons ![const!])) (return t))) % Generic Functions Dependence List ... (de genfundep!> (lst) (cond((null lst) !!er!!) ((or (cdr lst)(atom(car lst)))(prog2 (setq ![er!] 5016) !!er!!)) (t(prog nil (setq lst (car lst)) (setq lst (memlist!> '!, lst)) (cond((eq lst !!er!!)(prog2(setq ![er!] 5016)(return lst)))) (setq lst (mapcar lst 'genfundep1!>)) (cond((memq !!er!! lst)(prog2(setq ![er!] 5016)(return !!er!!)))) (return lst))))) (de genfundep1!> (w) (cond ((or (cdr w) (not(idp(car w)))) !!er!!) ((not (flagp (car w) '!+grgvar)) (flag w 'constant) (flag w '!+grg) (flag w '!+grgvar) (flag w 'used!*) (setq ![const!] (cons (car w) ![const!])) (car w)) (t (car w)))) %------- Reduce - GRG filter 16.02.96 ------------------------------------ % W already known to Reduce as some sort of operator ... (de redused!> (w) (or (get w 'simpfn) (get w 'infix) (get w 'formfn) (get w 'boolfn) (get w 'psopfn) (get w 'polyfn) (flagp w 'opfn) (flagp w 'boolean) )) % Known to Reduce but use in GRG prohibited ... (de redbad!> (w) (or (flagp w '!+redbad) (get w 'infix) (get w 'formfn) (get w 'boolfn) (get w 'psopfn) % (get w 'polyfn) % (flagp w 'opfn) (flagp w 'boolean) )) % Known to Reduce and transparent to GRG ... (de redgood!> (w) (and (or (get w 'simpfn) (get w 'polyfn) (flagp w 'opfn)) (not (redbad!> w)) )) %---- Conjugated pairs. 27.12.90 ----------------------------------------- % Conj. Par. For Cord, Const and Fun ... (de copar!> nil (copar1!> (list ![cord!] ![const!] ![fun!]))) % Conj. Par. For WE only ... (de copar1!> (we) (proc (w wc wa wb wd wt) (while!> we (setq wd(setq w(car we))) (while!> w (setq wc(explode2(car w))) (cond((and(eqlast!~!> wc) (memq(setq wa(incom!>(wipl12!> wc))) wd) (or(null(get wa '!=conj))(null(get (car w) '!=conj))) ) (progn (cond((null wt)(terpri))) (setq wt t) (setq wb(car w)) (put wa '!=conj wb) (put wb '!=conj wa) (prin2 wa)(prin2 " & ")(prin2 wb) (prin2 " - conjugated pair.") (terpri)))) (setq w(cdr w))) (setq we(cdr we))) (cond(wt(terpri))) )) % Predicate Last Element in LST is ~ ... (de eqlast!~!> (lst) (cond ((cdr lst) (eqlast!~!> (cdr lst))) ((eq (car lst) '!~) t) (t nil))) %---------- GRG Scaner. 17.09.91 ---------------------------------------- (de listok!> (wf) (prog (w wa wb wa1 wa2 wc) (setq wa(readch!>)) lab (cond ((eq wa '! ) (prog2 (setq wa (readch!>)) (go lab)))) (cond ((or (memq wa wf) (eq wa !$eof!$)) % End or EOF (cond(wc (progn (rds nil) % in file (close wc) (setq wc nil) (setq wa(readch!>)))) (t(return(reversip w))))) % Normal end ((liter wa)(prog (wf) % Identifyer (setq wb nil) lab1 (cond (wf (setq wf nil) (setq wb (cons wa wb)) (setq wa (readch!>)) (go lab1)) ((or (liter wa) (digit wa)) (setq wb (cons wa wb)) (setq wa (readch!>)) (go lab1)) ((eq wa '!!) (setq wb (cons wa wb)) (setq wf t) (setq wa (readch!>)) (go lab1))) (cond((eq wa '!~)(prog2 (setq wb (cons '!~ (cons '!! wb))) (setq wa (readch!>))))) (setq w(cons(intern(compress(reversip wb))) w)) (setq wb nil) )) ((digit wa)(prog nil % Number lab2 (cond((digit wa)(progn (setq wb(cons wa wb)) (setq wa(readch!>)) (go lab2)))) (setq w(cons(compress(reversip wb)) w)) (setq wb nil))) ((eq wa '!")(cond((eq !!er!! (prog nil % String (setq wb (copy '(!"))) (setq wa(readch!>)) lab3 (cond((not(eq wa '!"))(progn (setq wb(cons wa wb)) (setq wa(readch!>)) (cond((eq wa !$eof!$)(progn (setq ![er!] 9901) (rds nil) (cond(wc(close wc))) (setq wc nil) (return !!er!!)))) (go lab3)))) (setq w(cons(compress(reversip(cons '!" wb))) w)) (setq wa(readch!>)) (setq wb nil))) (return !!er!!)))) ((flagp wa '!=fc)(progn % Possible double symbol (setq wa1 wa) (setq wa(readch!>)) (cond((and(eq wa1 '!*)(eq wa '!*)) (prog2(setq w(cons '!*!* w))(setq wa(readch!>)))) % ** ((and(eq wa1 '!_)(eq wa '!|)) (prog2(setq w(cons '!_!| w))(setq wa(readch!>)))) % _| ((and(eq wa1 '!/)(eq wa '!\)) (prog2(setq w(cons '!/!\ w))(setq wa(readch!>)))) % /\ ((and(eq wa1 '!|)(eq wa '!=)) (prog2(setq w(cons '!|!= w))(setq wa(readch!>)))) % |= ((and(eq wa1 '!~)(eq wa '!~)) (prog2(setq w(cons '!~!~ w))(setq wa(readch!>)))) % ~~ ((and(eq wa1 '!.)(eq wa '!.)) (prog2(setq w(cons '!.!. w))(setq wa(readch!>)))) % .. ((and(eq wa1 '!<)(eq wa '!=)) (prog2(setq w(cons '!<!= w))(setq wa(readch!>)))) % <= ((and(eq wa1 '!>)(eq wa '!=)) (prog2(setq w(cons '!>!= w))(setq wa(readch!>)))) % >= ((and(eq wa1 '!-)(eq wa '!>)) (prog2(setq w(cons '!-!> w))(setq wa(readch!>)))) % -> (t(setq w % Single symbol (cons(intern wa1)w) ))))) (t(prog2 % Single symbol (setq w (cons (intern wa) w)) (setq wa (readch!>))))) % Symbol (go lab))) (de readch!> nil (carfile!> (errorset '(readch) nil nil))) % Via SEPRP ... (de carfile!> (w) (cond ((atom w) !$eof!$) ((seprp(car w)) '! ) (t (car w)))) % With ECHO .... %(de carfile!> (w) % (prog2 % (cond ((and ![echo!] (not(or (atom w) (eq (car w) !$eof!$)))) % (prin2(car w)))) % (cond ((atom w) !$eof!$) % ((seprp(car w)) '! ) % (t (car w))))) % With direct TAB, CR and so on ... %(de carfile!> (w) % (cond((atom w)!$eof!$) % ((eq(car w) !$eol!$) '! ) % ((eq(car w) '! ) '! ) % tab here and cr below ! % ((eq(car w) '! %) '! ) % (t(car w)))) %---- Sequence of Commands -> Internal Representation. 20.09.91 ---------- (de collect!> (lst) (proc (ww wa wb) (setq wb 0) (loop!> (cond ((null lst) % End of list (cond((not(eqn wb 0)) % Bad brackets. (prog2(setq ![er!] 6100)(return !!er!!))) (wa (return(reversip (cons(reversip wa)ww)))) (t (return(reversip ww))) )) ((memq (car lst) '(!;)) % End of command (cond((null wa) % ;; encountered. (prog2(setq ![er!] 9602)(return !!er!!))) ((not(eqn wb 0)) % Bad brackets. (prog2(setq ![er!] 6100)(return !!er!!))) (t(progn (setq ww (cons (reversip wa) ww)) (cond(lst(setq lst(cdr lst)))) (setq wa nil)))))) (tohead(null lst)) (cond((eq(car lst) '!( ) (setq wb(add1 wb))) ((eq(car lst) '!) ) (setq wb(sub1 wb)))) (cond((lessp wb 0)(prog2(setq ![er!] 6100)(return !!er!!)))) (cond((and(null wa)(memq(car lst) '(!;))) (prog2(setq ![er!] 9602)(return !!er!!)))) (setq wa (cons (car lst) wa)) (setq lst (cdr lst))))) %========= End of GRGinit.sl ==============================================% |
Added grgmacro.sl version [337ed81e62].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 | %==========================================================================% % GRGmacro.sl Lisp Macro Functions % %==========================================================================% % 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 macro for loops ... % makes (cond ((not bool) (go lab))) (de mkcng!> (bool lab) (list2 (quote cond) (list2 (list2 (quote not) bool) (list2 (quote go) lab)))) % makes (cond (bool (go lab))) (de mkcg!> (bool lab) (list2 (quote cond) (list2 bool (list2 (quote go) lab)))) % proc - prog with while, repeat, loop, tohead and exitif (dm proc (u) (prog (body w wa wb wc) (setq body (list2 (cadr u) (quote prog))) (setq u (cddr u)) label1 (cond ((and (null u) (null wa)) (go label2))) (cond ((null u) (go label3))) (cond ((atom(car u)) (prog2 (setq body (cons (car u) body)) (setq u (cdr u)))) ((or (setq wb (eq (caar u) (quote while!>))) (eq (caar u) (quote loop!>)) (eq (caar u) (quote repeat!>))) (progn (setq wa (cons (cdr u) wa)) (setq u (cdar u)) (setq w (cons (gensym) w)) (setq w (cons (gensym) w)) (cond (wb (setq body (cons (mkcng!> (car u) (car w)) (cons (cadr w) body)))) (t (setq body (cons (cadr w) body)))) (cond (wb (setq u (cdr u)))) (setq wc (cons nil wc)))) ((eq (caar u) (quote exitif)) (prog2 (setq body (cons (mkcg!> (cadar u)(car w)) body)) (setq u (cdr u)) )) ((eq (caar u) (quote tohead)) (prog2 (setq body (cons (mkcg!> (cadar u)(cadr w)) body)) (setq u (cdr u)) )) ((eq (caar u) (quote until)) (progn (setq body (cons (car w) (cons (mkcng!> (cadar u)(cadr w)) body))) (setq u (cdr u)) (setq wc (cons t wc)))) (t (prog2 (setq body (cons (car u) body)) (setq u (cdr u)) ))) label3 (cond((and wa (null u)) (progn (cond ((null (car wc)) (setq body (cons (car w) (cons (list2 (quote go) (cadr w)) body))))) (setq w (cddr w)) (setq u (car wa)) (setq wa (cdr wa)) (setq wc (cdr wc))))) (go label1) label2 (return (reversip body)))) (dm loop!> (u) (list (quote proc) nil (cons (quote loop!>) (cdr u)))) (dm while!> (u) (list (quote proc) nil (cons (quote while!>) (cdr u)))) (dm repeat!> (u) (list (quote proc) nil (cons (quote repeat!>) (cdr u)))) (dm for!> (u) (prog (action body exp incr lab1 lab2 result tail var x) (setq var (cadr u)) (setq incr (caddr u)) (setq action (cadddr u)) (setq body (car (cddddr u))) (setq result (list (list 'setq var (car incr)))) (setq incr (cdr incr)) (setq x (list 'difference (cadr incr) var)) (cond ((not (equal (car incr) 1)) (setq x (list 'times (car incr) x)))) (setq lab1 (gensym)) (setq lab2 (gensym)) (setq x (list 'minusp x)) (setq result (nconc result (cons lab1 (cons (list 'cond (list x (list 'go lab2))) (cons body (cons (list 'setq var (list 'plus2 var (car incr)) ) (cons (list 'go lab1) (cons lab2 tail)))) ))) ) (return (mkprog (cons var exp) result)))) (dm fordim!> (u) (prog (action body exp incr lab1 lab2 result tail var x) (setq var (cadr u)) (setq incr (list 0 1 '![dim1!])) (setq action (caddr u)) (setq body (car (cdddr u))) (setq result (list (list 'setq var (car incr)))) (setq incr (cdr incr)) (setq x (list 'difference (cadr incr) var)) (cond ((not (equal (car incr) 1)) (setq x (list 'times (car incr) x)))) (setq lab1 (gensym)) (setq lab2 (gensym)) (setq x (list 'minusp x)) (setq result (nconc result (cons lab1 (cons (list 'cond (list x (list 'go lab2))) (cons body (cons (list 'setq var (list 'plus2 var (car incr)) ) (cons (list 'go lab1) (cons lab2 tail)))) ))) ) (return (mkprog (cons var exp) result)))) (dm foreach!> (u) (prog (action body fn lst mod var) (setq var (cadr u)) (setq u (cddr u)) (setq mod (car u)) (setq u (cdr u)) (setq lst (car u)) (setq u (cdr u)) (setq action (car u)) (setq u (cdr u)) (setq body (car u)) (setq fn (cond ((eq action 'do) (cond ((eq mod 'in) 'mapc) (t 'map))) ((eq action 'conc) (cond ((eq mod 'in) 'mapcan) (t 'mapcon))) ((eq action 'collect) (cond ((eq mod 'in) 'mapcar) (t 'maplist))) (t (rederr (list action "invalid in foreach statement")))) ) (return (list fn lst (list 'function (list 'lambda (list var) body)))) )) %(dm signature!> (w) (list 'signature0!> (list 'quote (cdr w)))) %(dm off!> (w) (list 'off0!> (list 'quote (cdr w)))) %(dm on!> (w) (list 'on0!> (list 'quote (cdr w)))) %(dm package!> (w) (list 'package0!> (list 'quote (cdr w)))) %(dm synonymous!> (u) (list 'synonymous0!> (list 'quote (cdr u)))) %========== End of GRGmacro.sl ============================================% |
Added grgmain.sl version [90def78c02].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 | %==========================================================================% % GRGmain.sl Main GRG Functions % %==========================================================================% % GRG 3.2 Standard Lisp Source Code (C) 1988-2000 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. % %==========================================================================% %------- Reduce Entry Points used in GRG -------------------------------- % % reval aeval % % writepri : varpri - Reduce 3.3, 3.4, 3.4.1, 3.5 % assgnpri - Reduce 3.6, 3.7 % % on off !~on !~off % % operator remopr depend nodepend % % order factor remfac % % forall !~let let match !~clear clear let00 match00 % % seprp printprompt % %------------------------------------------------------------------------- %----- Main Function and Sturtup Procedures ------------------------------ % Really Main function. Just puts GRG> into ERRORSET ... (de grg nil (errorset '(grg!>) nil nil)) %(de grg nil (grg!>)) % May be helpful for debuggin ... (de grg!> nil (proc (w wtasknum) (setq wtasknum 0) % Banner ... (terpri) (prin2 ![version!]) (terpri)(terpri) % Initial settings which can be overridden later in `grg.cfg' ... (setq !*gc nil) (setq !*raise nil) (setq ![origlower!] !*lower) (setq !*lower nil) (setq ![lower!] (islowercase!>)) (setq ![fldtuned!] nil) (setq ![erst1!] nil) (setq ![erst2!] nil) (cond ((null ![wf!]) (setq ![wf!] '(!a !b !c !d !e !f !g !h)) (setq ![wi!] '(!i !j !k !l !m !n !o !p !q)) (setq ![wh!] '(!x !y !z !u !v !w !r !s !t)) (setq ![ws!] '(!A !B !C !D !E !F !G !H !M !N !P !Q)) (makeloop!> ![wf!]) (makeloop!> ![wh!]) (makeloop!> ![wi!]) (makeloop!> ![ws!]) )) (tuneos!>) % trying set [dirsep] and [syscall] % First Init of GRG switches ... (initflags!>) % Trying to get standard input directory from environment ... (cond ((getd 'getenv) (progn (setq w (errorset '(getenv "grg") nil nil)) (cond ((equal w '(nil)) (setq w (errorset '(getenv "GRG") nil nil)))) (cond ((atom w) (setq w nil)) (t (setq ![grgdir!] (cdr (reverse (explode (setq ![grgdir1!] (car w))))))))))) (cond ((and ![dirsep!] ![grgdir!]) (setq ![grgdir!] (cons ![dirsep!] ![grgdir!])))) (cond (![grgdir1!] (progn (prin2 "System directory: ") (prin2 ![grgdir1!]) (terpri)))) % Input `grg.cfg' file ... (ingrgsys!>) (setq ![flaghis!] nil) (saveflago!>) % Initial Settings Printing ... (showcase!>) (sdimsgn!>) % Absolute initial settings after `grg.cfg' ... (setq ![ttime!] (time)) % Overall time (setq ![tgctime!] (gctime)) % GC time (setq ![dim0!] ![dim!]) (setq ![sgn0!] ![sgn!]) (initial0!>) % Main Loop ... (loop!> (terpri) (cond ((eqn wtasknum 0) (setq w '!1)) (t (setq w (asker!> '( " Quit GRG - 0" " Start Task - 1" " Exit to REDUCE - 2" ) '( !0 !1 !2 ) )) (terpri) )) (setq promptstring!* "<- ") (cond ((iscsl!>) (setpchar promptstring!*))) (xrprompt!>) (setq wtasknum (add1 wtasknum)) (setq w (cond ((eq w '!0) '(grgquit!>)) ((eq w '!1) '(proceed!>)) ((eq w '!2) '(grgexit!>)) (t nil))) (cond (w (progn (setq w (errorset!> w ![erst1!] ![erst2!])) (cond ((atom w) (progn (terpri) (erm!> w) (terpri))) ((equal w '(!!exit!!)) (return nil)) ))))))) (de xrprompt!> nil (cond ((or (getd 'x!-pr!!) (getenv "redfront")) (setq promptstring!* (compress (append (list2 '!" (int2id 1)) (append (reverse (cdr (reverse (cdr (explode promptstring!*))))) (list2 (int2id 2) '!")))))))) % In `grg.cfg' file ... (de ingrgsys!> nil (prog (w cn) (setq !*lower t) (setq !*raise t) (setq cn (grgopeninput!> "grg.cfg")) (cond ((atom cn) (setq !*lower nil) (setq !*raise nil) (return nil))) (rds (car cn)) lab1 (setq w (errorset '(read) nil nil)) (cond ((atom w) (progn (erm!> 8802) (go lab2)))) (cond ((equal w '(nil)) (go lab2))) (setq w (errorset (car w) nil nil)) (cond ((atom w) (progn (erm!> 8802) (go lab2)))) (go lab1) lab2 (rds nil) (close (car cn)) (setq !*lower nil) (setq !*raise nil) )) % First init of switches in the session ... (de initflags!> nil (progn (gprinreset!>) (cond ((and (fancyexist!>) (fancyloaded!>) (fancyon!>)) (tunefancy!> t))) (cond ((and (getd 'x!-pr!!) (fancyexist!>)) (on0!> '(fancy)))) (setq ![flaghis!] nil) (foreach!> x in ![flagnil!] do (set x nil)) (foreach!> x in ![flagt!] do (set x t)) )) % Saves the initial setting of output mode switch ... (de saveflago!> nil (prog (w) (setq w (cond (!*latex 'latex ) ((fancyon!>) 'fancy ) (!*grg 'grg ) (!*reduce 'reduce ) (!*maple 'maple ) (!*math 'math ) (!*macsyma 'macsyma ) )) (setq ![iflago!] w))) %----- Main Loop --------------------------------------------------------- % Start new Task ... (de proceed!> nil (progn (initial0!>) (rund!>) )) % Continue old Task ... (de continue!> nil (prog2 (setq ![er!] nil) (rund!>))) %----- Some General Commands --------------------------------------------- (de copyrzw!> nil (progn (terpri) (prin2 ![version!]) (terpri) (prin2 "(C) 1988-96 Vadim V. Zhytnikov ") (terpri) (terpri))) % The System ; command. % Temporary exit to OS ... (de grgsystem!> (lst) (cond ((null lst) % System; (cond ((eqn ![syscall!] 1) % Via system ... (progn (setq lst (errorset '(system) nil nil)) (cond ((atom lst) (prog2 (setq ![er!] 1104) !!er!!))))) ((eqn ![syscall!] 2) % via quit ... (quit)) (t (msg!> 1102)))) % Not supported ((and (stringp(car lst)) (null(cdr lst))) % System "..."; (cond ((or (eqn ![syscall!] 1) (eqn ![syscall!] 2)) % Trying system ... (progn (setq lst (errorset (list 'system (car lst)) nil nil)) (cond ((atom lst) (prog2 (setq ![er!] 1104) !!er!!))))) (t (msg!> 1102)))) % Not supported (t (prog2 (setq ![er!] 1103) !!er!!)))) % The Quit; Command and related operations ... (de grgquit!> nil (progn (closeunload!>) (grgstat!>) (closewrite!>) (bye) )) (de grgexit!> nil (prog nil (closeunload!>) (grgstat!>) (closewrite!>) (setq !*raise t) (setq !*lower ![origlower!]) (prin2 "Exiting. Type ``grg;'' to restart GRG ...")(terpri) (return '!!exit!!) )) % Statistics printing ... (de grgstat!> nil (prog (wt wgt) (setq wt (difference (time) ![ttime!])) (setq wgt (difference (gctime) ![tgctime!])) (cond ((iscsl!>) (setq wt (plus wt wgt)))) (cond ((not(eqn wt 0)) (setq wgt (quotient (times 100 wgt) wt))) (t (setq wgt 0))) (terpri) (prin2 "Overall Session time: ") (prtime!> wt) (cond ((zerop wt) (prog2 (terpri) (return nil)))) (prin2 " (") (prin2 wgt) (prin2 "%GC)") (terpri))) %------ Messages ------------------------------------------------------- % Error messages ... (de erm!> (w) (proc (lst wm) (cond ((null w) (return nil))) (closewrite!>) (setq lst '( (1000 . "ERROR: User interrupt.") (1100 . "ERROR: Incorrect parameter of the command.") (1101 . "ERROR: Coordinates already exist.") (1103 . "ERROR: String is expected as a parameter.") (1104 . "ERROR: Command failed.") (2001 . "ERROR: Missing parameter or closing bracket in [,].") (2002 . "ERROR: First parameter of _| must be a vector.") (2003 . "ERROR: Second parameter of _| must be a form.") (20021 . "ERROR: First parameter of | must be a vector.") (20031 . "ERROR: Second parameter of | must be a scalar.") (2004 . "ERROR: Exterior differential of a vector is impossible.") (2005 . "ERROR: Parameters of /\ must be exterior forms.") (2006 . "ERROR: Parameters of [,] must be vectors.") (2007 . "ERROR: Dualization of a vector is impossible.") (2008 . "ERROR: Form or vector is invalid in ^.") (2009 . "ERROR: Zero denominator.") (2010 . "ERROR: At lest one parameter of * must be a scalar.") (2011 . "ERROR: Division on form or vector is impossible.") (2012 . "ERROR: Terms of different type in A+B or A-B.") (2013 . "ERROR: X must be a coordinate in @ X.") (2014 . "ERROR: Missing operation.") (2015 . "ERROR: Missing parameter of unary operation.") (2016 . "ERROR: Missing parameter of operation.") (2017 . "ERROR: Missing summand.") (2018 . "ERROR: Unrecognized identifier.") (20181 . "ERROR: Unrecognized variable.") (2019 . "ERROR: String in expression.") (2020 . "ERROR: Incorrect parameters list.") (2021 . "ERROR: Incorrect function or missing operation.") (2022 . "ERROR: Unrecognized function.") (2023 . "ERROR: Form or vector as an argument of function is invalid.") (20231 . "ERROR: Form or vector valued index is invalid.") (2030 . "ERROR: Vector or 1-form are expected in scalar product.") (2100 . "ERROR: Wrong type of expression.") (2101 . "ERROR: Wrong identifier of object.") (2102 . "ERROR: Incorrect indices.") (21022 . "ERROR: Index out of range.") (21023 . "ERROR: Number of indices is less than expected.") (21024 . "ERROR: Number of indices is more than expected.") (2103 . "ERROR: Incorrect Sum() or Prod() expression.") (21031 . "ERROR: Wrong iteration variable specification.") (2104 . "ERROR: Strange variable.") (2105 . "ERROR: Wrong number of parameters.") (2106 . "ERROR: Wrong parameter's value.") (2108 . "ERROR: Incorrect min or max in iteration specification.") (2110 . "ERROR: ~~ can be used as expr+~~ or expr-~~ only.") (2113 . "ERROR: No Solutions are defined.") (2114 . "ERROR: There is no Solution with this number.") (2115 . "ERROR: 0 = 0 relation is invalid here.") (2200 . "ERROR: Incorrect tensorial assignment.") (2201 . "ERROR: Incorrect Coordinates or Constants declaration.") (2202 . "ERROR: Wrong commas.") (2203 . "ERROR: Coordinates does not match Dimension.") (2204 . "ERROR: Incorrect assignment.") (2205 . "ERROR: Repeated index in LHS.") (2206 . "ERROR: Incorrect indices in tensorial assignment.") (2207 . "ERROR: Wrong number of indices.") (22071 . "ERROR: Unrecognized object.") (2208 . "ERROR: Equation is expected at RHS.") (2209 . "ERROR: Types of RHS and LHS differ.") (2300 . "ERROR: Incorrect Solve command.") (2301 . "ERROR: Solve failed.") (2303 . "ERROR: Non equation in Solve.") (2304 . "ERROR: Empty or trivial equations in Solve.") (2400 . "ERROR: Incorrect boolean expression.") (2410 . "ERROR: Unknown object name.") (2420 . "ERROR: Unknown switch.") (2500 . "ERROR: Incorrect Lie derivative.") (2501 . "ERROR: Vector is expected in Lie derivative.") (2502 . "ERROR: Cannot calculate Lie derivative of noncovariant object.") (2600 . "ERROR: Incorrect covariant differential Dc.") (2602 . "ERROR: Cannot calculate Dc of noncovariant object.") (2603 . "ERROR: Wrong specification of alternative connection in Dc.") (2700 . "ERROR: Incorrect covariant derivative Dfc.") (2701 . "ERROR: Vector is expected in covariant derivative.") (2702 . "ERROR: Cannot calculate Dfc of noncovariant object.") (2703 . "ERROR: Wrong specification of alternative connection in Dfc.") (2704 . "ERROR: Dfc of form or vector is impossible.") (3000 . "ERROR: Object already exists.") (3001 . "ERROR: Wrong type of indices for connection 1-form.") (3002 . "ERROR: Connection must be 1-form valued.") (4000 . "ERROR: Zero volume element.") (4001 . "ERROR: Rotation Matrix isn't specified.") (5012 . "ERROR: Incorrect Functions declaration.") (5013 . "ERROR: Identifier already used.") (50130 . "ERROR: This Identifier can't be used in GRG.") (5016 . "ERROR: Incorrect function dependence list.") (5100 . "ERROR: Generic Functions are not supported.") (5101 . "ERROR: Incorrect Generic Function declaration.") (6030 . "ERROR: Unrecognized object.") (6042 . "ERROR: Incorrect command.") (6043 . "ERROR: Unrecognized way of calculation.") (6044 . "ERROR: Incorrect compound command structure.") (6046 . "ERROR: Too few data.") (6100 . "ERROR: Bad bracket count.") (6200 . "ERROR: Incorrect Asy/Sy/Cy expression.") %(6201 . "ERROR: Limits does not supported.") %(6202 . "ERROR: Incorrect Limit expression.") %(6203 . "ERROR: Form or Vector as a limiting point in Lim.") (6204 . "ERROR: Incorrect SUB() expression.") (6205 . "ERROR: Form or Vector in SUB().") (6301 . "ERROR: Incorrect file name.") (6321 . "ERROR: Can't open the file.") (6402 . "ERROR: Unrecognized switch.") (6500 . "ERROR: On TORSION is required.") (6501 . "ERROR: On NONMETR is required.") (6502 . "ERROR: On TORSION and On NONMETR is required.") (6503 . "ERROR: On TORSION or On NONMETR is required.") (6504 . "ERROR: Off NONMETR is required.") (6505 . "ERROR: Off TORSION is required.") (6506 . "ERROR: Off TORSION and Off NONMETR is required.") (65002 . "ERROR: dim>2 is required.") (650022 . "ERROR: dim=2 is required.") (65003 . "ERROR: dim>3 is required.") (65004 . "ERROR: dim>4 is required.") (65005 . "ERROR: dim>5 is required.") (6702 . "ERROR: Velocity is null.") (6800 . "ERROR: Singular Metric or Inverse Metric.") (6802 . "ERROR: Singular Frame or Vector Frame.") (7200 . "ERROR: The file has format unknown for Load/Show.") (7301 . "ERROR: Please specify Coordinates first.") (7302 . "ERROR: Please specify Affine Parameter first.") (7720 . "ERROR: File contains erroneous data.") (7804 . "ERROR: Standard null metric is required for spinors.") (78040 . "ERROR: dim=4 is required for spinors.") (78041 . "ERROR: Standard null metric is required for spinorial rotation.") (7805 . "ERROR: dim=4 is required.") (7806 . "ERROR: Default diagonal metric is required.") (7900 . "ERROR: The file contains other Dimension and/or Signature.") (7910 . "ERROR: Signature -,+,+,+ or +,-,-,- is required for Null Metric.") (8100 . "ERROR: Bad package name.") (8102 . "ERROR: Cannot load the package.") (8200 . "ERROR: Incorrect If( ) expression.") (8201 . "ERROR: Non numeric argument in a relation.") (8375 . "ERROR: Incorrect New Coordinates declaration.") (8377 . "ERROR: Singular coordinates transformation.") (8389 . "ERROR: Form or vector in old coordinates dependence list.") (8388 . "ERROR: Recursive old coordinates dependence.") (8400 . "ERROR: Singular Basis.") (8401 . "ERROR: Singular Vector Basis.") (8500 . "ERROR: Incorrect matrix.") (8501 . "ERROR: The matrix isn't spinorial rotation.") (8502 . "ERROR: The matrix isn't frame rotation.") (8504 . "ERROR: Singular Matrix.") (8600 . "ERROR: Incorrect New Object declaration.") (8601 . "ERROR: Wrong type specification in the declaration.") (8602 . "ERROR: Wrong indices specification in the declaration.") (8604 . "ERROR: Identifier of new object contains digits or ~.") (8606 . "ERROR: Wrong symmetry specification.") (8709 . "ERROR: Incorrect Let command.") (8710 . "ERROR: Zero is invalid in Let or Clear.") (8711 . "ERROR: Form or vector in Let or Clear.") (8712 . "ERROR: Incorrect For All command.") (8713 . "ERROR: Incorrect For All command.") (8714 . "ERROR: Incorrect parameters list in For All.") (8800 . "ERROR: Dimension must be 2 or greater.") (8801 . "ERROR: Dimension does not match Signature.") (88011 . "ERROR: Incorrect Dimension declaration.") (88012 . "ERROR: Dimension declaration must be first in session.") (8802 . "ERROR: Incorrect data in the `grg.cfg' file.") (8803 . "ERROR: Transformation was not properly completed.") (9002 . "ERROR: Incorrect Signature in `grg.cfg' file.") (9100 . "ERROR: Cannot classify form of vector.") (9101 . "ERROR: Do not know how to classify this object.") (9602 . "ERROR: Double ; delimiter.") (9901 . "ERROR: Unexpected end of file.") (9913 . "ERROR: Can't transform spinorial index to holonomic.") (9999 . "ERROR: Cannot handle *SQ form in the expression.") )) (while!> lst (cond ((eqn w (caar lst)) (setq wm (cdar lst)))) (setq lst (cdr lst))) (cond (wm (prin2 wm) (terpri)) (t (prin2 "ERROR: ") (prin2 w) (terpri) (lowmemwarn!>) )) % If Batch mode then quitting ... (cond (!*batch (prinN2 "GRG is in Batch mode. Quitting ...") (terpri) (grgquit!>))) )) % Messages ... (de msg!> (w) (proc (lst wm) (cond ((null w) (return nil))) (setq lst '( (100 . "WARNING: Macro tensor is not allowed in Find command.") (1102 . "Command System; is not supported.") (2104 . "WARNING: min > max in iteration.") (2109 . "WARNING: Summation or iteration variable is already in use.") (2112 . "WARNING: Manipulation with enumerating index is ignored.") (2302 . "WARNING: No solutions found.") (50131 . "WARNING: This Function can be used without declaration.") (6700 . "WARNING: Null congruence is not actually null.") (6701 . "WARNING: Null congruence is not geodesic.") (6702 . "WARNING: Frenkel condition is not satisfied.") (6801 . "Assuming Default Metric.") (6803 . "Assuming Default Holonomic Frame.") (6805 . "Assuming Default comoving Velocity.") (6820 . "WARNING: Metric already exists.") (7012 . "Basis can not be erased in anholonomic mode.") (7630 . "WARNING: Coordinates have been redefined.") (7631 . "WARNING: Loaded constants conflict with coordinates.") (7632 . "WARNING: Loaded constants conflict with functions.") (7633 . "WARNING: Loaded functions conflict with coordinates.") (7634 . "WARNING: Loaded functions conflict with constants.") (7635 . "WARNING: Loaded coordinates conflict with constants.") (7637 . "WARNING: Loaded coordinates conflict with functions.") (8101 . "WARNING: Package already loaded.") (8391 . "Keeping Frame holonomic.") (8392 . "Keeping Vector Frame holonomic.") (8603 . "WARNING: Identifier already used.") (8607 . "Same indices in different symmetry groups.") (8701 . "WARNING: Unable to Forget built-in object.") (88033 . "No guaranty for correct operation of the system. Better quit now!") (8901 . "Fetching the file from System directory.") (8902 . "Fetching `grg.cfg' file from System directory.") (9001 . "WARNING: Velocity is not normalized.") (9100 . "WARNING: Quite old REDUCE. All letters will be in lower case.") (9101 . "WARNING: LaTeX output mode is not supported since GRG unable") (91011 . "WARNING: to load `fmprint' package. Check that you have `fmprint.b'") (91012 . "WARNING: file and copy it into your current directory or into the") (91013 . "WARNING: directory where REDUCE usually looks for binary packages") (91014 . "WARNING: (e.g. `$reduce/fasl/').") )) (while!> lst (cond ((eqn w (caar lst)) (setq wm (cdar lst)))) (setq lst (cdr lst))) (cond (wm (prin2 wm) (terpri)) (t (prin2 "WARNING: ") (prin2 w) (terpri))) )) (de doub!> (w) (progn (closewrite!>) (prin2 w) (prin2 " - ? ") (terpri))) (de doubs!> (w) (progn (closewrite!>) (prin1 w) (prin2 " - ? ") (terpri))) (de doubl!> (lst) (progn (closewrite!>) (gprinreset!>) (gprin!> "`") (gprinwb!> lst) (gprin!> "'")(gprin!> " - ?") (gterpri!>))) (de doubo!> (wi) (progn (closewrite!>) (gprinreset!>) (gprinwb!> (txt!> wi)) (gprin!> " - ?") (gterpri!>))) % Warning about low memory ... (de lowmemwarn!> nil (prog (wt wgt) (setq wt (difference (time) ![time!])) (setq wgt (difference (gctime) ![gctime!])) (cond ((iscsl!>) (setq wt (plus wt wgt)))) (cond ((not(eqn wt 0)) (setq wgt (quotient (times 100 wgt) wt))) (t (setq wgt 0))) (cond ((and (lessp wgt 100) (greaterp wgt 39)) (progn (prin2 "Garbage Collections constitute ") (prin2 wgt) (prin2 "% of the total CPU time.") (terpri) (cond ((greaterp wgt 59) (prin2 "ATTENTION: Memory is exhausted!")) (t (prin2 "WARNING: Free memory is low!"))) (terpri) ))) )) %------- Names of Built-In Objects -------------------------------------- % This gives the list - Name of an Object ... (de txt!> (wi) % wi - internal variable (proc (w) (cond ((or (flagp wi '!+abbr) (flagp wi '!+macros2)) (return (idtxt!> wi)))) (setq w ![datl!]) (while!> w (cond ((eq wi (cadar w)) (return (lowertxt!> (caar w)))) (t (setq w (cdr w))))))) (de thetxt!> (wi) % wi - internal variable (proc(w) (cond ((or (flagp wi '!+abbr) (flagp wi '!+macros2)) (return (cons '!T!h!e (idtxt!> wi))))) % word!!! (setq w ![datl!]) (while!> w (cond ((eq wi (cadar w)) (return (lowertxt!> (caar w)))) (t (setq w (cdr w))))))) (de lowertxt!> (w) (proc (wr wn) (while!> w (cond (wn (setq wr (cons (lowertxt0!> (car w) t) wr))) (t (setq wr (cons (lowertxt0!> (car w) nil) wr)) (setq wn t))) (setq w (cdr w))) (return(reversip wr)))) (de lowertxt0!> (w wc) (cond ((not(idp w)) w) ((get w '!=printas) (get w '!=printas)) (t (proc (we wr) (setq we (explode w)) (while!> we (cond ((liter (car we)) (cond (wc (setq wr (cons (tolc!>(car we)) wr))) (t (setq wr (cons (touc!>(car we)) wr)) (setq wc t)))) (t (setq wr (cons (car we) wr)))) (setq we (cdr we))) (return(incom!>(reversip wr))))))) % The name for a new Object created by user ... (de idtxt!> (wi) (prog (w) (setq w (cdr (explode2 wi))) (return (ncons (incom!> w))))) % Prints Object's name via GPRIN> ... (de pn!> (wi) (gprils!> (txt!> wi))) (de pn0!> (wi) (gprils0!> (txt!> wi))) (de pn0dot!> (wi) (gprils0dot!> (txt!> wi))) (de thepn!> (wi) (gprils!> (thetxt!> wi))) (de thepn0!> (wi) (gprils0!> (thetxt!> wi))) %------- Functions for manipulation with whole data boxes ----------- % Here: LST - the Box list; WN - internal variable; % WI - NIL at the beginning, the index list is collected here; % IDXL - IDXL list at the beginning; % FUN - function (FUN W WI WN) here % W - element, WI - its indices, WN - intern. variable % Apply FUN to each element in the LST ... (de allcom!> (lst wn wi idxl fun) (cond((null idxl) (apply fun (list lst (reverse wi) wn))) (t(proc (wc) (setq wc -1) (while!> lst (setq wc (add1 wc)) (allcom!> (car lst) wn (cons wc wi) (cdr idxl) fun) (setq lst(cdr lst))))))) % Apply FUN to each element in LST and collect result ... (de allcoll!> (lst wn wi idxl fun) (cond((null idxl) (apply fun (list lst (reverse wi) wn))) (t(proc (wc w) (setq wc -1) (while!> lst (setq wc (add1 wc)) (setq w (cons (allcoll!> (car lst) wn (cons wc wi) (cdr idxl) fun) w)) (setq lst(cdr lst))) (return (reverse w)) )))) %--------- Tracing messages ---------------------------------------------- % Sometning has/have been calculated ... (de trsc!> (w wy) (cond(!*trace (prog (wm) (gprinreset!>) (setq ![gptab!] 2) (pn!> w) (cond ((null wy) (gprils0!> (cond ((flagp w '!+pl) '("calculated.")) (t '("calculated.")) ))) %((flagp w '!+pl) '("have" "been" "calculated.")) %(t '("has" "been" "calculated.")) ))) (t (gprils0!> (cond ((flagp w '!+pl) '("calculated")) (t '("calculated")) )) %((flagp w '!+pl) '("have" "been" "calculated")) %(t '("has" "been" "calculated")) )) (cond (wy (gprin!> '! ) (gprils0dot!> (lowertxt!> wy)))))) (gprin!> '! ) (gptime!>))))) %(de trsc!> (w wy) % (cond(!*trace % (progn (gprinreset!>) % (setq ![gptab!] 2) % (pn!> w) % (gprils0!> (cond % ((flagp w '!+pl) '("have" "been" "calculated")) % (t '("has" "been" "calculated")) )) % (cond(wy(prog2 (gprin!> '! ) (gprils0!> (lowertxt!> wy))))) % (gprin!> ". ") % (gptime!>))))) % Done ... (de done!> nil (cond(!*trace (progn (gprinreset!>) (gprils0!> '("Done: ")) (gptime!>))))) % Too few data ... (de tfd!> (w) (progn (gprinreset!>) (setq ![gptab!] 2) (gprils!> '("Too" "few" "data" "for" "calculation" "of")) %(pn0!> w)(gprin!> ".")(gterpri!>))) (pn0dot!> w)(gterpri!>))) % Failed to calculate ... (de trsf!> (w) (progn (gprinreset!>) (setq ![gptab!] 2) (gprils!> '("Cannot" "calculate")) %(pn0!> w)(gprin!> ".")(gterpri!>))) (pn0dot!> w)(gterpri!>))) % Already exists ... (de aexp!> (w) (progn (gprinreset!>) (setq ![gptab!] 2) (gprils!> '("Value" "of")) (pn!> w) (gprils0!> '("is" "known" "already.")) (gterpri!>))) % The value indefinite ... (de abse!> (w) (progn (gprinreset!>) (setq ![gptab!] 2) (gprils!> '("Value" "of")) (pn!> w) (gprils0!> '("is" "indefinite.")) (gterpri!>))) % Something can't be calculated ... (de cantcalc!> (w) (progn (gprinreset!>) (setq ![gptab!] 2) (thepn!> w) (gprin!> '("can't" "be" "calculated.")) (gterpri!>))) % Something can't be calculated by way WY ... (de cantway!> (w wy) (progn (gprinreset!>) (setq ![gptab!] 2) (thepn!> w) (gprin!> '("can't" "be" "calculated")) %(gprils0!> (lowertxt!> wy))(gprin!> ".")(gterpri!>) )) (gprils0dot!> (lowertxt!> wy))(gterpri!>) )) %------ Initial Settings for a New Task ---------------------------------- % All system parameters resetting ... (de initial0!> nil (progn (setq ![mtype!] nil) (setq ![mitype!] nil) (setq ![dtype!] nil) (setq ![ditype!] nil) (setq ![ftype!] nil) (setq ![fitype!] nil) (setq ![dim!] ![dim0!]) (setq ![sgn!] ![sgn0!]) (tunedim!>) (setq ![echo!] nil) (resetsubs!>) % Reset substitutions (before declarations!) ... (rempf!> ![rpfl!] '(1 2)) % Clear all declarations ... (setq ![gfun!] nil) % Clear all data values ... (foreach!> x in ![datl!] do (cond((atom(cadr x)) (prog2 (set (cadr x) nil) (cond ((flagp (cadr x) '!+abbr) (forget1!>(cadr x)))))))) (foreach!> x in ![abbr!] do (prog2 (set x nil) (forget1!> x))) (resetflags!>) % Resetting switches ... (closeallo!>) % Cloasing all files ... % Restoring default values of system variables ... (foreach!> x in '( ![solveq!] ![er!] ![wri!] ![chain!] ![unl!] ![pause!] ![fromf!] ![loa!] ![umod!] ![way!] ![x!] ![ocord!] ![xb!] ![dfx!] ![dex!] ![lsrs!] ![xv!] ![ccb!] ![xf!] ![ccbi!] ![lwri!] ![lunl!] ![l!] ![la!] ![li!] ![dbas!] ) do (set x nil)) (setq ![lline!] 0) (gprinreset!>) (setq ![time!] (time)) (setq ![gctime!] (gctime)) )) % This closes really all output files ... (de closeallo!> nil (prog2 (closeunload!>) (closewrite!>) )) % This closes global Write output ... (de closewrite!> nil (progn (cond(![wri!] (close ![wri!]))) (setq ![wri!] nil) (wrs nil))) % This close global Unload ... (de closeunload!> nil (progn (cond(![unl!](progn (wrs ![unl!]) (print t) (wrs ![wri!]) (close ![unl!])))) (setq ![unl!] nil) )) % Resets all switches to initial values ... (de resetflags!> nil (proc (w ww) (cond(![iflago!] (setq ![flaghis!] (append ![flaghis!] (ncons(cons ![iflago!] t)))))) (while!> ![flaghis!] (setq w (car ![flaghis!])) (setq ww (makeswvar!> (car w))) (cond((not(equal (eval ww) (cdr w))) (cond ((flagp (car w) 'switch) % Reduce ... (cond ((cdr w) (eval (list 'on (car w)))) (t (eval (list 'off (car w))))) (onoff1!> (car w) (cdr w))) (t(onoff1!> (car w) (cdr w)))))) % GRG ... (setq ![flaghis!] (cdr ![flaghis!])) (cond((null ![iflago!]) (offallo!>))) ))) % Resets all substitutions ... (de resetsubs!> nil (proc (w) (while!> ![sublist!] (setq w (car ![sublist!])) (errorset (list (car w) (list 'quote (cadr w))) ![erst1!] ![erst2!]) (setq ![sublist!] (cdr ![sublist!]))))) % Removes all Cord, Const and Fun declarations ... (de rempf!> (lst wt) (proc (w x) (cond ((member 2 wt) (foreach!> xx in ![cord!] do (nodepend (cons xx ![apar!]))))) (cond((member 1 wt) (foreach!> xx in ![fun!] do (prog2 (cond((setq w(get xx '!=depend))(nodepend w))) (remopr xx) )) )) (while!> lst (setq x (car lst)) (cond((setq w(eval(caar x))) (progn (cond((cadr x) (foreach!> y in (cadr x) do (remflag w y)))) (cond((cddr x) (foreach!> y in (cddr x) do (foreach!> z in w do (remprop z y)))))))) (setq lst(cdr lst))) )) %------ Tuning for dimension -------------------------------------------- (de tunedim!> nil (prog (w wa) (setq ![dim1!] (sub1 ![dim!])) (setq ![sigprod!] (sigprod!>)) (put '!d!i!m '!=sysconst ![dim!]) (put '!s!i!g!n '!=sysconst ![sigprod!]) (put '!s!g!n!t '!=sysconst ![sigprod!]) (setq wa (ncons(cons 'a (dimlist1!> 1)))) (put '!#!e!p!s '!=sidxl wa) (put '!#!e!p!s!i '!=sidxl wa) (put '!#!e!p!s!h '!=sidxl wa) (put '!#!e!p!s!i!h '!=sidxl wa) (put '!#!e!p!s '!=idxl (mks1!> ![dim1!] nil)) (put '!#!e!p!s!i '!=idxl (mks1!> ![dim1!] t)) (put '!#!e!p!s!h '!=idxl (mks1!> ![dim1!] 0)) (put '!#!e!p!s!i!h '!=idxl (mks1!> ![dim1!] 1)) (cond ((eqn ![sigprod!] -1) (put '!#!s!d!e!t!G '!=tex "\sqrt{-g}") ) (t (put '!#!s!d!e!t!G '!=tex "\sqrt{g}") )) )) %------ Metric and Frame Type ------------------------------------------- % Determines Frame Type ... % [FTYPE] NIL - unknown, 1 - holonomic, 2 - diag, 3 - general (de ftype!> nil (ftype0!> !#!T '![ftype!])) (de fitype!> nil (ftype0!> !#!D '![fitype!])) (de ftype0!> (w wt) (cond (w (prog (wc wcc wod wnu) % wod - off diag, wnu - non unit (cond (![umod!] (set wt 3) (return nil))) (fordim!> i do (fordim!> j do (progn (setq wc (exprtype!> (setq wcc (getfdx!> (getel1!> w i) j)))) (cond ((and (not(eqn i j)) wc) % off diag (setq wod t))) (cond ((and (eqn i j) (not(equal wcc 1))) % not unit (setq wnu t)) )))) (cond ((and (null wod) (null wnu)) (set wt 1)) ((null wod) (set wt 2)) ( t (set wt 3))))) (t (set wt nil)))) % Determines Metric Type ... % [MTYPE] NIL - unknown, 1 - null, 2 - diag, 3 - general % [DTYPE] NIL - unknown, 1 - constant, 2 - general (de mtype!> nil (mtype0!> !#!G '![mtype!] '![dtype!])) (de mitype!> nil (mtype0!> !#!G!I '![mitype!] '![ditype!])) (de mtype0!> (w wt wd) (cond (w (prog (wc wod wnc) % wod - off diag, wnc - non const (cond ((and (equal ![sgn!] '(-1 1 1 1)) (equal w ![nullm!])) (set wt 1) (set wd 1) (return t)) ((and (equal ![sgn!] '(1 -1 -1 -1)) (equal w ![nullm1!])) (set wt 1) (set wd 1) (return t))) (fordim!> i do (fordim!> j do (cond ((geq j i) (progn (setq wc (exprtype!> (getel2!> w i j))) (cond ((and (not(eqn i j)) wc) % off diag (setq wod t))) (cond ((eqn wc 2) % non const (setq wnc t))) ))))) (cond ((not wnc) (set wd 1)) (t (set wd 2))) (cond ((not wod) (set wt 2)) (t (set wt 3))) (return t))) (t (set wt nil)))) % Determines expression type: % NIL - zero, 1 - constant, 2 - general (de exprtype!> (w) (cond ((null w) nil) (t (exprtype1!> w)))) (de exprtype1!> (w) (cond ((atom w) (cond ((numberp w) 1) ((get w '!=cord) 2) ((get w '!=depend) (exprtype1!> (cons nil (cdr(get w '!=depend))))) (t 1))) (t(proc nil (setq w (cdr w)) (while!> w (cond ((eqn 2 (exprtype1!> (car w))) (return 2))) (setq w (cdr w))) (return 1))))) % [FTYPE] NIL - unknown, 1 - holonomic, 2 - diag, 3 - general % Frame holomonic ? (de fholop!> nil (cond ((and ![ftype!] (eqn ![ftype!] 1)) t) (t nil))) % Inverse Frame holomonic ? (de ifholop!> nil (cond ((and ![fitype!] (eqn ![fitype!] 1)) t) (t nil))) % This crucial predicate defines Holonomic Regime. % In this case frame indixes are not differnt from % holonomic ones. This is important in coordinates % transformations and in the Dc/Lie covar. operations. (de holonomicp!> nil (and !*holonomic % holonomic is on (not ![umod!]) % not if basis mode (or (null !#!T) (fholop!>)) % t is holonomic or absent (or (null !#!D) (ifholop!>)))) % d is holonomic or absent % Frame diagonal ? (de fdiagp!> nil (cond ((and ![ftype!] (eqn ![ftype!] 2)) t) (t nil))) % Inverse Frame diagonal ? (de ifdiagp!> nil (cond ((and ![fitype!] (eqn ![fitype!] 2)) t) (t nil))) % [MTYPE] NIL - unknown, 1 - null, 2 - diag, 3 - general % [DTYPE] NIL - unknown, 1 - constant, 2 - general % Metric diagonal or null? (de motop!> nil (cond ((and ![mtype!] (leq ![mtype!] 2)) t) (t nil))) % Inverse Metric diagonal or null? (de imotop!> nil (cond ((and ![mitype!] (leq ![mitype!] 2)) t) (t nil))) % Null Metric ? (de mnullp!> nil (cond ((and ![mtype!] (eqn ![mtype!] 1)) t) (t nil))) (de imnullp!> nil (cond ((and ![mitype!] (eqn ![mtype!] 1)) t) (t nil))) % Maps `diagonal' index to its adjacent ... (de ai!> (wa) (cond ((eqn ![mtype!] 1) (cond ((eqn wa 1) 0) ((eqn wa 0) 1) ((eqn wa 2) 3) ((eqn wa 3) 2))) (t wa))) % `Diagonal' element of Metric/Inverse Metric ... (de diagm!> (w) (getmetr!> w (ai!> w))) (de diagmi!> (w) (getimetr!> w (ai!> w))) % Predicat of +--- version in the spinorial regime ... (de pmmm!> nil (eqn (car ![sgn!]) 1)) (de mppp!> nil (eqn (car ![sgn!]) -1)) %------ Restrictors for Constrained Data Types and Ways ------------------ % Only dim=4 ... (de ttt4!> nil (cond ((not(eqn ![dim!] 4)) 7805) (t nil))) % We need affine parameter ... (de tttapar!> nil (cond ((null ![apar!]) 7302) (t nil))) % Need Torsion ... (de tttq!> nil (cond ((null !*torsion) 6500) (t nil))) % Need Nonmetricity ... (de tttn!> nil (cond ((null !*nonmetr) 6501) (t nil))) % Need Torsion or Nonmetricity ... (de tttqorn!> nil (cond ((not(or !*torsion !*nonmetr)) 6503) (t nil))) % Need Torsion and Nonmetricity ... (de tttqandn!> nil (cond ((not(and !*torsion !*nonmetr)) 6502) (t nil))) % Need Torsion but not Nonmetr ... (de tttqnotn!> nil (cond ((not !*torsion) 6500) (!*nonmetr 6504) (t nil))) % Need Off Nonmetr ... (de tttnotn!> nil (cond (!*nonmetr 6504) (t nil))) % Need Nonmetr but not Torsion ... (de tttnnotq!> nil (cond ((not !*nonmetr) 6501) (!*torsion 6505) (t nil))) % No Torsion and No Nonmetricity ... (de tttnotqn!> nil (cond ((or !*nonmetr !*torsion) 6506) (t nil))) % We need default diagonal metric ... (de tttdiag!> nil (cond ((or (null !#!G) (null ![mtype!]) (null ![dtype!])) 7806) ((not(eqn ![mtype!] 2)) 7806) ((not(eqn ![dtype!] 1)) 7806) (t nil))) % Spinorial restrictor ... (de sp!> nil (cond ((not(eqn ![dim!] 4)) 78040) ((null !#!G) 7804) ((null ![mtype!]) 7804) ((not(eqn ![mtype!] 1)) 7804) ((and !#!G!I (not(eqn ![mitype!] 1))) 7804) (t nil))) % Spinorial but NONMETR must be Off ... (de sp!-n!> nil (cond (!*nonmetr 6504) ((not(eqn ![dim!] 4)) 78040) ((null !#!G) 7804) ((null ![mtype!]) 7804) ((not(eqn ![mtype!] 1)) 7804) ((and !#!G!I (not(eqn ![mitype!] 1))) 7804) (t nil))) % dim>n restrictors ... (de deq2!> nil (cond ((not(eqn ![dim!] 2)) 650022) (t nil))) (de dg2!> nil (cond ((not(greaterp ![dim!] 2)) 65002) (t nil))) (de dg3!> nil (cond ((not(greaterp ![dim!] 3)) 65003) (t nil))) (de dg4!> nil (cond ((not(greaterp ![dim!] 4)) 65004) (t nil))) (de dg5!> nil (cond ((not(greaterp ![dim!] 5)) 65005) (t nil))) % Check consrtains for one object WI ... (de constrp!> (wi) (cond ((null (setq wi (get wi '!=constr))) nil) (t (constrp1!> wi)))) (de constrp1!> (w) % w - list of constraints ... (cond ((null w) nil) ((eval(car w)) (eval(car w))) (t (constrp1!>(cdr w))))) % Check constrains for list of objects ... (de constrpl!> (lst) (cond ((null lst) nil) (t(prog (w) (setq w (constrp!>(car lst))) (cond (w (progn (setq ![er!] w) (doubo!>(car lst)) (return !!er!!))) (t (return (constrpl!> (cdr lst))))))))) %------ Main Data Calculation Algorithm ---------------------------------- % Main Data Calculation Recursive Algorithm. Returns: % !!ER!! - Some error in the process of calculation. % NIL - Cannot calculate. Too few data or no any ways. % T - Done. (de request!> (nam) (cond ((eval nam) t) % already exists ... ((memq nam ![chain!]) nil) % already in the chain ... ((constrp!> nam) % constrained object ... (progn (doubo!> nam) (erm!>(constrp!> nam)) nil)) (t(proc (w wa wy w1w) % trying to find method for calculation ... (cond((not ![way!]) (progn % choosing way ... (setq w (get nam '!=way)) (cond ((null w) (return nil))) % no any way ... (setq wa (mainway!> w)) (cond ((null wa) (setq wa (firstgoodway!> w)))) (cond ((null wa) (return nil))) % no any appropriate way ... (setq w1w (car wa)) (setq wy (caddr wa)) (setq w (cdddr wa)) )) (t(progn % alternative way ... (setq w (get nam '!=way)) (cond((null w) % no any ways for this object ... (progn (setq ![er!] 6043) (doubl!> ![way!]) (setq ![way!] nil) (return !!er!!)))) (setq w (getthisway!> ![way!] w)) (cond ((eq w !!er!!) (return !!er!!)) ((null w) % unknown way ... (progn (setq ![er!] 6043) (doubl!> ![way!]) (setq ![way!] nil) (return !!er!!)))) (cond((setq wa (constrp1!>(ncons(cadr w)))) % constr.way ... (progn (cantway!> nam ![way!]) (setq ![way!] nil) (setq ![er!] wa) (return !!er!!)))) (setq ![way!] nil) (setq w1w (car w)) (setq wy (caddr w)) (setq w (cdddr w))))) % now: w - reqired data list, w1w - way name, % wy - calculating call for ways (setq ![chain!] (cons nam ![chain!])) (while!> w % request for data required for calculation ... (cond((and (pairp(car w)) (eval(caar w))) (setq w (appmem!>(cdar w)(cdr w))) ) % new group ... ((and (pairp(car w)) (null(eval(caar w)))) (setq w (cdr w)) )) % skip group ... (tohead (or(null w)(pairp(car w)))) (setq wa (request!>(car w))) (cond ((eq wa !!er!!) (return !!er!!)) ((not wa) (progn (trsf!>(car w)) (return nil)))) (setq w (cdr w))) (setq w (eval wy)) % calculation ... (cond((eq w !!er!!)(return !!er!!))) (trsc!> nam w1w) % successful calculation ... (return t))))) % Seek main way if awailable ... (de mainway!> (wl) (cond ((null wl) nil) ((and (not(eval(cadar wl))) (mainwayp!>(cdddar wl))) (car wl)) (t (mainway!> (cdr wl))))) (de mainwayp!> (w) (proc (wt wc) (while!> w (setq wc (car w)) (cond ((and (pairp wc) (eq (car wc) t)) (cond ((eval(cadr wc)) (setq wt t)) (t (return nil))))) (setq w (cdr w))) (return wt))) % Seek first appropriate way ... (de firstgoodway!> (wl) (cond ((null wl) nil) ((not(eval(cadar wl))) (car wl)) (t (firstgoodway!> (cdr wl))))) % Get This Way from List ... (de getthisway!> (wy wl) (prog (w) (cond ((or (eqs!> wy '(by standard way)) % word!!! (eqs!> wy '(using standard way))) % word!!! (setq wy nil))) (setq w (getthisway1!> wy wl)) % searching by name of the way ... (cond (w (return w)) ((memqs!> (car wy) '(from using)) (setq wy (cdr wy))) % word!!! (t (return nil))) (cond ((null wy) (return nil))) (setq wy (dgood!> wy)) (cond ((null wy) (return nil)) ((and (eq wy !!er!!) (eqn ![er!] 6030)) (prog2 (setq ![er!] nil) (return nil))) ((eq wy !!er!!) (return !!er!!)) ((cdr wy) (return nil))) (return (getthisway2!> (car wy) wl)) % searching by data name ... )) (de getthisway1!> (wy wl) (cond ((null wl) wl) ((eqs!> wy (caar wl)) (car wl)) (t (getthisway1!> wy (cdr wl))))) (de getthisway2!> (wy wl) (cond ((null wl) wl) ((memq!> wy (cdddar wl)) (car wl)) (t (getthisway2!> wy (cdr wl))))) (de memq!> (w lst) (cond ((null lst) nil) ((or (eq w (car lst)) (and (pairp(car lst)) (memq w (car lst)))) t) (t (memq!> w (cdr lst))))) % Tries to calculate all data in the list LST if AUTO is On. % ERR interrupt is can not do it. (de require!> (lst) (cond((null lst) nil) (t (prog (wa) (cond(!*auto (foreach!> x in lst do (progn (setq ![chain!] nil) (setq wa (request!> x)) (cond((eq wa !!er!!) (prog2 (trsf!> x) (err!> ![er!]))) ((null wa) (cantfd!> x))))))) (foreach!> x in lst do (cond((null(eval x)) (cantfd!> x)))))) )) % Tries to calculate X if AUTO is On. % ERR interrupt is can not do it. (de require1!> (x) (prog (wa) (cond(!*auto (progn (setq ![chain!] nil) (setq wa (request!> x)) (cond((eq wa !!er!!) (prog2 (trsf!> x) (err!> ![er!]))) ((or(null wa)(null(eval x))) (cantfd!> x)) )))))) (de cantfd!> (w) (prog2 (trsf!> w) (err!> 6046))) %------- Commands translation ------------------------------------- % General Command translation with Compound Mechanism ... % Command -> List Of Commands -> List of Evaluations (de instrs!> (lst) (prog nil (setq lst (composin!> lst)) % compound command maybe ... (cond (!*showcommands (showcommands!> lst))) % print the result (cond ((eq lst !!er!!) (prog2 (erm!> 6044) (return lst)))) (setq lst (mapcar lst (function instr!>))) (cond ((memq !!er!! lst) (return !!er!!))) (return lst))) % One Command translation ... % Command text -> Evaluation (de instr!> (lst) (proc (w wa) (cond ((null lst) (return '(nil next!>)))) (setq wa lst) (setq w ![instr!]) (while!> lst (setq w (assocf!> (car lst) w)) (cond ((null w) (setq lst nil)) ((eq(car w)(quote !!)) (cond((cdr lst)(setq lst nil)) (t(return(cons t(cdr w)))))) ((eq(car w)(quote !!!!)) (return(cons nil(cons(cadr w)(cons(cdr lst)(cddr w)))))) (t(setq lst(cdr lst)))) (exitif(null lst))) (cond((and(null(cdr wa))(stringp(car wa))) % in ... (return(list nil 'from!> wa))) ((memqs!> 'for wa) % word!!! % print ... (return(list nil 'printi!> wa))) ((memq '!= wa) % assign ... (return(list nil 'seti!> wa))) (t(return(list nil 'printi!> wa))) % print ... ? ) (closewrite!>) (gprinreset!>) (gprin!> "Unknown command - '") (gprinwb!> wa)(gprin!> "'.")(gterpri!>) (return !!er!! ))) % Print list of commands ... (de showcommands!> (lst) (cond ((null lst) (gprinreset!>)) ((eq lst !!er!!) !!er!!) (t(progn (gprinreset!>)(setq ![gptab!] 4) (gprin!> " ") (gprinwb!> (car lst)) (gprin!> ";") (gterpri!>) (showcommands!> (cdr lst)))))) % Conpound command -> commands list ... (de composin!> (lst) (cond % Comments in command ... ((and (not(eq (car lst) '!%)) (memq '!% lst)) (proc (w) (while!> (not (eq (car lst) '!%)) (setq w (cons (car lst) w)) (setq lst (cdr lst))) (return (cons lst (composin!> (reverse w)))))) % Re prefix ... ((or (eq (car lst) '!R!E) (eq (car lst) '!R!e) (eq (car lst) '!r!e)) (cond ((and (cdr lst) (eq (cadr lst) '!-)) (composin!> (append '(erase and) (cddr lst)))) (t (ncons lst)))) % Not Composite Command ... ((or (not (memqs!> (car lst) ![icompos!])) % compound version forbidden (not (or (memq '!& lst)(memq '!, lst)(memqs!> 'and lst)))) % word!!! (ncons lst)) % Composite Command Itself ... (t(proc (w wa wb wc wd) (setq lst (memll!> lst '(!& !, and))) % word!!! (cond ((eq lst !!er!!) (prog2(setq ![er!] 6044)(return !!er!!)))) % Select Left Commands ... (while!> lst (setq w (inspar!> (car lst))) (cond ((eq w !!er!!) (return !!er!!))) (setq wa (cons (car w) wa)) (setq lst (cdr lst)) (exitif (cdr w))) (cond ((cdr w) (setq lst (cons (cdr w) lst)))) % Select Paremeters ... (while!> (and lst (not(insp!>(car lst)))) (setq w (parway!> (car lst))) (cond ((null(car w)) (return !!er!!))) (setq wb (cons (car w) wb)) (setq lst (cdr lst)) (exitif (cdr w))) (setq wc (cdr w)) % Right Commands ... (while!> lst (cond ((not(insp!>(car lst))) (return !!er!!))) (setq wd (cons (car lst) wd)) (setq lst (cdr lst))) (cond (wd % it after right comm (setq wd (cons (wiplit!>(car wd)) (cdr wd))))) (setq wa (reverse wa)) (setq wb (reverse wb)) (setq wd (reverse wd)) % WA - Left Commands % WB - Parameters % WC - Way % WD - Right commands (setq w nil) (cond ((null wb) (return wa))) (while!> wa (cond ((and (wucp!>(car wa)) wc) (setq w (cons (append (car wa) wc) w)))) (setq w (append w (foreach!> x in wb collect (append (car wa) (append x (cond ((wucp!>(car wa)) nil) (t wc))))))) (cond ((and (ucp!>(car wa)) wc) (setq w (append w '((ends))))) % word!!! ((and (wcp!>(car wa)) wc) (setq w (append w '((endw)))))) % word!!! (setq wa (cdr wa))) (while!> wd (setq w (append w (foreach!> x in wb collect (append (car wd) x)))) (setq wd (cdr wd))) (return w) )))) % Command predicate ... (de insp!> (lst) (memqs!> (car lst) ![icompos!])) % Write, Unload commands predicate ... (de wucp!> (w) (memqs!> (car w) '(write save unload))) % word!!! (de wcp!> (w) (memqs!> (car w) '(write))) % word!!! (de ucp!> (w) (memqs!> (car w) '(save unload))) % word!!! % Way predicate ... (de bftp!> (w) (memqs!> w '( by from using to with in !> ))) % word!!! % LST -> ( Command . Parameters ) ... (de inspar!> (lst) (proc (w wa) (cond ((not(memqs!> (car lst) ![icompos!])) (return !!er!!))) (setq w ![instr!]) (while!> lst (setq w (assocf!> (car lst) w)) (cond ((null w) (return !!er!!))) (exitif (or (eq (car w) '!!) (eq (car w) '!!!!))) (setq wa (cons (car lst) wa)) (setq lst (cdr lst))) (cond ((null lst) (return !!er!!))) (return(cons(reverse(cons(car lst) wa))(cdr lst))))) % LST -> ( Parameters . Way ) ... (de parway!> (lst) (proc (wa) (while!> (and lst (not(bftp!>(car lst)))) % by from ... (setq wa(cons(car lst) wa)) (setq lst(cdr lst))) (return(cons(reverse wa)lst)))) % Split LST by WI=( and , & ) delimiters ... (de memll!> (lst wi) (proc(wa wb) (setq lst(cons(car wi) lst)) (while!> lst (setq lst(cdr lst)) (while!>(and lst(not(memqs!>(car lst)wi))) (setq wa(cons(car lst)wa)) (setq lst(cdr lst))) (cond ((null wa)(return !!er!!)) (t(prog2 (setq wb(cons(reversip wa)wb)) (setq wa nil))))) (return(reversip wb)))) % Cut It etc in the end of LST ... (de wiplit!> (lst) (cond ((null(cdr lst)) (cond ((memqs!> (car lst) '(it them)) nil) % word!!! (t lst))) (t (cons (car lst) (wiplit!> (cdr lst)))))) %-------- Commands execution -------------------------------------------- % Execute command from the terminal ... (de rund!> nil (proc nil (setq ![firsti!] t) (loop!> (cond ((eq (runcom!> nil) !!stop!!) (return !!stop!!))) (setq ![firsti!] nil)) )) % This is main command executer. Work with the ERRORSET % and catches possible internal REDUCE errors. The RUNCOM> % is called only in tree places: % (1) in main function RUND> as the basic commands' loop (RUNCOM> NIL) % (2) in the In command for each command COM from file (RUNCOM> COM) % (3) in the Pause commad as another command loop (RUNCOM> NIL) % If WA=NIL then the command is requested from the terminal % otherwise the WA is executed. (de runcom!> (wa) (proc (wp wq wr w wc wx) (cond (wa % command from file must be printed (progn (setq wx t) (setq w wa) % print commands (gprinreset!>) (setq ![gptab!] 3) (gprin!> '!<!-! ) (gprinwb!> w) (gprin!> ";") (gterpri!>) (gprinreset!>) ))) (loop!> (cond (wa (setq wa (instrs!> wa)))) % command translation labela (cond ((or (null wa) (eq wa !!er!!)) % take command from terminal if (progn (cond ((eq wa !!er!!) (closewrite!>))) (setq wp t) (setq wq t) (cond (wx (prin2 "Please enter correct command:") (terpri))) (cond ( (eq (loop!> % getting a correct command (cond ((iscsl!>) (printprompt promptstring!*))) (setq wa (listok!> '( !; ))) (cond ((and (not (eq wa !!er!!)) (not (eq (bc!> wa) !!er!!))) (progn (setq wp nil) % success (setq wa (car(mklevel!> wa))))) (t (progn (erm!> ![er!]) (setq ![er!] nil)))) (tohead wp) % failure => loop again (return nil) ) !!er!!) (return !!er!!))))) (t (setq wq nil))) (tohead wq) % we have not a command so loop again % here we have translated list of commands and we % are going to execute them (while!> wa % commands list evaluation (execution) (setq ![lsrs!] nil) % these are the values that not bad to (setq ![ivs!] nil) % clear before each commands execution (cond % coordinates must be specified! ((and (null ![cord!]) (not (flagp (cadar wa) '!+unloc))) (erm!> 7301) (setq wa !!er!!) (go labela))) % (tohead % coordinates must be specified! % (and (null ![cord!]) % (not (flagp (cadar wa) '!+unloc)) % (progn (erm!> 7301) (setq wa (cdr wa)) t) )) % execution ... (setq wc (cadar wa)) (setq wr (list 'apply (list2 'function (cadar wa)) (list2 'quote (cond ((caar wa) (mapcar (cddar wa) 'eval)) (t (cons (caddar wa) (mapcar (cdddar wa) 'eval))))))) (setq wr (errorset!> wr ![erst1!] ![erst2!])) (cond ((atom wr) (algterpri!>) (setq ![er!] wr) (setq wr !!er!!)) (t (setq wr (car wr)))) (cond ((eq wr !!stop!!) (return !!stop!!)) ((eq wr !!er!!) (progn (erm!> ![er!]) (setq wa nil) (setq ![er!] nil)))) (exitif (null wa)) % error, so exit it (setq wa (cdr wa))) (tohead (eq wr !!er!!)) % making the cycle in the case of the error. %(cond ((not(eq wc 'comment!>)) (setq ![firsti!] nil))) (cond ((and (not(eq wc 'comment!>)) (not(eq wc 'grgout!>))) (setq ![firsti!] nil))) (return wr)))) % Brackets count ... (de bc!> (lst) (proc (wc) (setq wc 0) (while!> lst (cond((eq(car lst) '!()(setq wc(add1 wc))) ((eq(car lst) '!))(setq wc(sub1 wc)))) (cond((lessp wc 0)(prog2(setq ![er!] 6100)(return !!er!!)))) (setq lst(cdr lst))) (cond((not(eqn wc 0)) (prog2(setq ![er!] 6100)(return !!er!!)))) )) %========== End of GRGmain.sl ==========================================% |
Added grgmater.sl version [b56bb0eba7].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 | %==========================================================================% % GRGmater.sl Matter fields: EM, YM, Scalar, Dirac, Fluid % %==========================================================================% % 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. % %==========================================================================% %---------- YM field. 09.96 ----------------------------------------------- (de sconst!> (wa wb wc) (gets0!> !#!S!C!O!N!S!T (list3 wa wb wc) '((a 1 2 3)) 0)) % FFYM = d AYM + AYM/\AYM (de ffymfromaym!> nil (prog (w wc) (makebox!> '!#!F!F!Y!M) (for!> x (0 1 9) do (progn (setq w (ncons (dex!> (getel1!> !#!A!Y!M x)))) (for!> y (0 1 9) do (for!> z (0 1 9) do (progn (setq wc (sconst!> x y z)) (cond (wc (setq w (cons (fndfpr!> (list 'quotient wc 2) (dfprod2!> (getel1!> !#!A!Y!M y) (getel1!> !#!A!Y!M z))) w))))))) (putel1!> (evalform!> (dfsum!> w)) !#!F!F!Y!M x))) (return t))) % First YM equation ... (de firstym!> nil (prog (w wc) (makebox!> '!#!Y!M!F!q) (for!> x (0 1 9) do (progn (setq w (ncons (dex!> (dual!> (getel1!> !#!F!F!Y!M x))))) (for!> y (0 1 9) do (for!> z (0 1 9) do (progn (setq wc (sconst!> x y z)) (cond (wc (setq w (cons (fndfpr!> wc (dfprod2!> (getel1!> !#!A!Y!M y) (dual!>(getel1!> !#!F!F!Y!M z)))) w))))))) (putel1!> (equation!> (evalform!> (dfsum!> w)) nil) !#!Y!M!F!q x))) (return t))) % Second YM equation ... (de secondym!> nil (prog (w wc) (makebox!> '!#!Y!M!S!q) (for!> x (0 1 9) do (progn (setq w (ncons (dex!> (getel1!> !#!F!F!Y!M x)))) (for!> y (0 1 9) do (for!> z (0 1 9) do (progn (setq wc (sconst!> x y z)) (cond (wc (setq w (cons (fndfpr!> wc (dfprod2!> (getel1!> !#!A!Y!M y) (getel1!> !#!F!F!Y!M z))) w))))))) (putel1!> (equation!> (evalform!> (dfsum!> w)) nil) !#!Y!M!S!q x))) (return t))) % YMACT = -1/8/pi FFYM/\*FFYM (de ymact!> nil (prog (w) (for!> x (0 1 9) do (progn (setq w (cons (dfprod2!> (getel1!> !#!F!F!Y!M x) (dual!> (getel1!> !#!F!F!Y!M x))) w)))) (setq w (evalform!> (fndfpr!> '(quotient (minus 1) (times 8 pi)) (dfsum!> w)))) (setq !#!Y!M!A!C!T (ncons w)))) % FFYM = 1/2 FTYM.a.b S'a'b (de ffymfromftym!> nil (prog (w) (makebox!> '!#!F!F!Y!M) (for!> x (0 1 9) do (progn (setq w nil) (fordim!> a do (fordim!> b do (cond ((lessp a b) (setq w (cons (fndfpr!> (getel!> !#!F!T!Y!M (list x a b)) (getel2!> !#!S a b)) w)))))) (putel1!> (evalform!> (dfsum!> w)) !#!F!F!Y!M x))))) % FTYM.a.b = D.b _| D.a _| FFYM (de ftymfromffym!> nil (prog nil (makebox!> '!#!F!T!Y!M) (for!> x (0 1 9) do (fordim!> a do (fordim!> b do (cond ((lessp a b) (putel!> (evalalg!> (vform1!> (getiframe!> b) (vform!> (getiframe!> a) (getel1!> !#!F!F!Y!M x)))) !#!F!T!Y!M (list3 x a b))))))) (return t))) % TYM (de tymbydef!> nil (prog (w wr) (setq !#!T!Y!M (mkt!> 2)) (setq w (list 'times -1 ![sigprod!] (car ![sgn!]) (duald!> (car !#!Y!M!A!C!T)))) (fordim!> a do (fordim!> b do (cond ((leq a b) (setq wr (ncons (list 'times (getmetr!> a b) w))) (fordim!> m do (for!> x (0 1 9) do (setq wr (cons (list 'times -1 (list 'quotient (car ![sgn!]) '(times 4 pi)) (getm!> '!#!F!T!Y!M nil (list3 x a m) '(nil nil nil)) (getm!> '!#!F!T!Y!M nil (list3 x b m) '(nil nil 1))) wr)))) (putel!> (evalalg!> (cons 'plus wr)) !#!T!Y!M (list2 a b)))))))) %---------- EM field. 09.96 ----------------------------------------------- % FF = d A (de fffroma!> nil (setq !#!F!F (ncons (evalform!> (dex!> (car !#!A)))))) % FF = 1/2 FT.a.b S'a'b (de fffromft!> nil (prog (w) (fordim!> a do (fordim!> b do (cond ((lessp a b) (setq w (cons (fndfpr!> (getel2!> !#!F!T a b) (getel2!> !#!S a b)) w)))))) (setq !#!F!F (ncons (evalform!> (dfsum!> w)))))) % FT.a.b = D.b _| D.a _| FF (de ftfromff!> nil (prog nil (setq !#!F!T (mkt!> 2)) (fordim!> a do (fordim!> b do (cond ((lessp a b) (putel!> (evalalg!> (vform1!> (getiframe!> b) (vform!> (getiframe!> a) (car !#!F!F)))) !#!F!T (list2 a b)))))) (return t))) % EMACT = -1/8/pi FF/\*FF (de emact!> nil (setq !#!E!M!A!C!T (ncons (evalform!> (fndfpr!> '(quotient (minus 1) (times 8 pi)) (dfprod2!> (car !#!F!F) (dual!> (car !#!F!F)))))))) % TEM (de tembydef!> nil (prog (w wr) (setq !#!T!E!M (mkt!> 2)) (setq w (list 'times -1 ![sigprod!] (car ![sgn!]) (duald!> (car !#!E!M!A!C!T)))) (fordim!> a do (fordim!> b do (cond ((leq a b) (setq wr (ncons (list 'times (getmetr!> a b) w))) (fordim!> m do (setq wr (cons (list 'times -1 (list 'quotient (car ![sgn!]) '(times 4 pi)) (getasy2!> !#!F!T a m nil) (getm!> '!#!F!T nil (list2 b m) '(nil 1))) wr))) (putel!> (evalalg!> (cons 'plus wr)) !#!T!E!M (list2 a b)))))))) % d # FF = # J (de firstmw!> nil (setq !#!M!W!F!q (ncons (equation!> (evalform!> (dex!> (dual!> (car !#!F!F)))) (cond ((not !#!J) nil) (t (evalform!> (fndfpr!> (list 'times 4 'pi (car ![sgn!]) (list 'expt -1 (difference ![dim!] 2))) (dual!> (car !#!J)))))) )))) % d FF = 0 (de secondmw!> nil (setq !#!M!W!S!q (ncons (equation!> (evalform!> (dex!> (car !#!F!F))) nil)))) % d # J =0 (de contineq!> nil (setq !#!C!O!q (ncons (equation!> (evalform!> (dex!> (dual!> (car !#!J)))) nil)))) % First scalar ... (de firstscal!> nil (setq !#!S!C!F (ncons (evalalg!> (chsigna!> (duald!> (dfprod2!> (car !#!F!F) (dual!> (car !#!F!F))))))))) % Second scalar ... (de secondscal!> nil (setq !#!S!C!S (ncons (evalalg!> (duald!> (dfprod2!> (car !#!F!F) (car !#!F!F))))))) % FFU = FF - i #FF (de ffufromff!> nil (setq !#!F!F!U (ncons (evalform!> (dfsum2!> (car !#!F!F) (fndfpr!> '(minus i) (dual!> (car !#!F!F)))))))) % FFU = 2 FIU_AB SU^AB (de ffufromfiu!> nil (setq !#!F!F!U (ncons (evalform!> (fndfpr!> 2 (dfsum!> (list (fndfpr!> (getel1!> !#!F!I!U 0) (getel1!> !#!S!U 2)) (fndfpr!> (getel1!> !#!F!I!U 2) (getel1!> !#!S!U 0)) (fndfpr!> -2 (fndfpr!> (getel1!> !#!F!I!U 1) (getel1!> !#!S!U 1)))))))))) % FF= 1/2 (FFU + ~FFU) (de fffromffu!> nil (setq !#!F!F (ncons (evalform!> (fndfpr!> '(quotient 1 2) (dfsum2!> (car !#!F!F!U) (coform!> (car !#!F!F!U)))))))) % FIU_AB = -i/2 # ( FFU/\SU_AB ) (de fiufromffu!> nil (prog nil (makebox!> '!#!F!I!U) (for!> a (0 1 2) do (putel1!> (evalalg!> (list 'times '(quotient (minus i) 2) (duald!> (dfprod2!> (car !#!F!F!U) (getel1!> !#!S!U a))))) !#!F!I!U a )))) % FIU_AB = -i # ( FF/\SU_AB ) (de fiufromff!> nil (prog nil (makebox!> '!#!F!I!U) (for!> a (0 1 2) do (putel1!> (evalalg!> (list 'times '(minus i) (duald!> (dfprod2!> (car !#!F!F) (getel1!> !#!S!U a))))) !#!F!I!U a )))) % SCU = 2 FIU_AB FIU^AB (de scufromfiu!> nil (setq !#!S!C!U (ncons (evalalg!> (list 'times 4 (list 'plus (list 'times (getel1!> !#!F!I!U 2) (getel1!> !#!F!I!U 0)) (list 'times -1 (getel1!> !#!F!I!U 1) (getel1!> !#!F!I!U 1)) )))))) % SCU = -i/2 #( FFU/\FFU ) (de scufromffu!> nil (setq !#!S!C!U (ncons (evalalg!> (list 'times '(quotient (minus i) 2) (duald!> (dfprod2!> (car !#!F!F!U) (car !#!F!F!U)))))))) % TEMS.AA.BB (de tems!> nil (prog nil (makebox!> '!#!T!E!M!S) (for!> a (0 1 2) do (for!> b (0 1 2) do (cond ((leq a b) (putel!> (evalalg!> (list 'times '(quotient 1 (times 2 pi)) (getel1!> !#!F!I!U a) (coalg!> (getel1!> !#!F!I!U b)))) !#!T!E!M!S (list2 a b)))))))) % d FFU = i #J (de complexmw!> nil (setq !#!M!W!U!q (ncons (equation!> (evalform!> (dex!> (car !#!F!F!U))) (cond ((not !#!J) nil) (t (evalform!> (fndfpr!> (list 'times -4 'i 'pi (car ![sgn!])) (dual!> (car !#!J)))))) )))) % FIU/\SD_AA = 0 (de sduality!> nil (prog nil (makebox!> '!#!S!D!q) (for!> a (0 1 2) do (putel1!> (equation!> (evalform!> (dfprod2!> (car !#!F!F!U) (getel1!> !#!S!D a))) nil) !#!S!D!q a)))) %---------- Scalar field. 01.91, 09.96 ------------------------------------ % Scalar field action (minimal interaction) ... (de sactmin!> nil (prog (w wr wss) (setq w (car !#!F!I)) (fordim!> a do (fordim!> b do (setq wr (cons (list 'times (dfisign!>) (list 'df w (x!> a)) (list 'df w (x!> b)) (gimetr!> a b)) wr)))) (setq wr (cons (list 'times '(expt !S!M!A!S!S 2) w w) wr)) (setq wr (cons 'plus wr)) (setq !#!S!A!C!T!M!I!N (ncons (evalform!> (fndfpr!> '(quotient -1 2) (fndfpr!> wr (car !#!V!O!L)))))) (return t))) (de dfisign!> nil (cond ((lessp (car ![sgn!]) 0) 1 ) (t -1 ))) % Scalar field action ... (de sact!> nil (prog (w wr wss) (setq w (car !#!F!I)) (fordim!> a do (fordim!> b do (setq wr (cons (list 'times (dfisign!>) (list 'df w (x!> a)) (list 'df w (x!> a)) (gimetr!> a b)) wr)))) (setq wr (cons (list 'times '(expt !S!M!A!S!S 2) w w) wr)) (cond (!*nonmin (setq wr (cons (list 'times (car !#!A!C!O!N!S!T) (car !#!R!R) w w ) wr)))) (setq wr (cons 'plus wr)) (setq !#!S!A!C!T (ncons (evalform!> (fndfpr!> '(quotient -1 2) (fndfpr!> wr (car !#!V!O!L)))))) (return t))) % Scalar field equation ... (de kgeq!> nil (prog (w wf) (setq wf (car !#!F!I)) (setq w (list 'plus (list 'times (dfisign!>) ![sigprod!] (list 'expt -1 ![dim1!]) (duald!> (dex!> (dual!> (dfun!> wf)))) ) (list 'times -1 wf (list 'plus '(expt !S!M!A!S!S 2) (cond (!*nonmin (list 'times (car !#!A!C!O!N!S!T) (car !#!R!R))) (t 0)))) )) (setq !#!S!C!q (ncons (equation!> (evalalg!> w) nil))) (return t))) % Scalar energy-momentum tensor (minimal interaction) ... (de tsclmin!> nil (prog (w) (setq !#!T!S!C!L!M!I!N (mkt!> 2)) (setq w (duald!> (car !#!S!A!C!T!M!I!N))) (setq w (evalalg!> (list 'times -1 ![sigprod!] (car ![sgn!]) w))) (fordim!> wa do (fordim!> wb do (cond ((leq wa wb) (putel!> (evalalg!> (list 'plus (list 'times (vfun!> (getiframe!> wa) (car !#!F!I)) (vfun!> (getiframe!> wb) (car !#!F!I))) (list 'times (getmetr!> wa wb) w))) !#!T!S!C!L!M!I!N (list2 wa wb)))))) (return t))) %---------- Dirac field. 12.90, 9.96 ------------------------------------ % Current 1-form from Dirac spinor ... (de dcurr!> nil (progn (setq !#!J (ncons (evalform!> (fndfpr!> (list 'times (mp!> 1) '(sqrt 2) '!E!C!O!N!S!T) (dfsum!> (list2 (spintetr!> !#!C!H!I) (spintetr!> !#!P!H!I) )))))) t)) (de spintetr!> (wss) (dfsum!> (list (fndfpr!> (getel1!> wss 0) (fndfpr!> (coalg!>(getel1!> wss 0)) (getframe!> 1))) (fndfpr!> (getel1!> wss 1) (fndfpr!> (coalg!>(getel1!> wss 1)) (getframe!> 0))) (fndfpr!> (getel1!> wss 0) (fndfpr!> (coalg!>(getel1!> wss 1)) (getframe!> 3))) (fndfpr!> (getel1!> wss 1) (fndfpr!> (coalg!>(getel1!> wss 0)) (getframe!> 2))) ))) % Covariant derivative with ieA and 1/2 Q terms ... % wi - index, wss - spinor, bool=t - 1/2 Q term must be included % wc=t +i for phi and wc=nil -i for chi (de dexcs!> (wi wss bool wc) (prog (w) (setq w (list (dfun!>(getel1!> wss wi)) (chsign!> t (fndfpr!> (getel1!> wss 0) (pmf!>(getel1!> !#!o!m!e!g!a!u (add1 wi))))) (fndfpr!> (getel1!> wss 1) (pmf!>(getel1!> !#!o!m!e!g!a!u wi))))) (cond (!#!A (setq w (cons (fndfpr!> (list 'times '!E!C!O!N!S!T (cond (wc 'i) (t '(minus i)))) (fndfpr!> (getel1!> wss wi) (car !#!A))) w)))) (cond ((and bool !*torsion) (setq w (cons (fndfpr!> '(quotient -1 2) (fndfpr!> (getel1!> wss wi) (car !#!Q!Q))) w)))) (return(dfsum!> w)))) % Dirac equation ... (de dequ!> (wa wb we wc) (prog nil (set we (mkbox!> we)) (for!> a (0 1 1) do (putel1!> (equation!> (evalalg!> (list 'plus (list 'times '(sqrt 2) (mpa!> 'i) (dfcs!> a wa wc)) (list 'times '(minus !D!M!A!S!S) (coalg!>(getel1!> wb a))))) nil) (eval we) a)) (return t))) (de dfcs!> (wi wss wc) (list 'plus (vform1!> (getiframe!> (cond ((eqn wi 0) 2) (t 0))) (dexcs!> 0 wss t wc)) (vform1!> (getiframe!> (cond ((eqn wi 0) 1) (t 3))) (chsign!> t (dexcs!> 1 wss t wc))))) % Dirac action 4-form ... (de dact!> nil (prog (www) (setq www (list (fndfpr!> '(quotient i (sqrt 2)) (sdstetr!> !#!P!H!I t)) (fndfpr!> '(quotient (minus i) (sqrt 2)) (sdstetr!> !#!C!H!I nil)) (fndfpr!> '(minus !D!M!A!S!S) (fndfpr!> (scaldir!>) (car !#!V!O!L))) )) (setq www (append www (mapcar www (function coform!>)))) (setq !#!D!A!C!T (ncons(evalform!>(dfsum!> www)))) (return t))) (de sdstetr!> (wss wc) (dfsum!> (list (dfprod2!> (dual!>(dexcs!> 0 wss nil wc)) (fndfpr!> (coalg!>(getel1!> wss 0)) (getframe!> 1))) (dfprod2!> (dual!>(dexcs!> 1 wss nil wc)) (fndfpr!>(coalg!>(getel1!> wss 1)) (getframe!> 0))) (dfprod2!> (dual!>(dexcs!> 0 wss nil wc)) (fndfpr!>(coalg!>(getel1!> wss 1)) (getframe!> 3))) (dfprod2!> (dual!>(dexcs!> 1 wss nil wc)) (fndfpr!>(coalg!>(getel1!> wss 0)) (getframe!> 2))) ))) (de scaldir!> nil (list 'plus (list 'times (getel1!> !#!P!H!I 0) (getel1!> !#!C!H!I 1)) (list 'times -1 (getel1!> !#!P!H!I 1) (getel1!> !#!C!H!I 0)))) % Dirac spin 3-form ... (de spinsd!> nil (prog (w) (setq !#!S!P!D!I!U (mkbox!> '!#!S!P!D!I!U)) (setq w '(quotient i (sqrt 8))) (putel1!> (evalform!> (fndfpr!> w (dual!> (dfsum!> (list (sst!> !#!P!H!I 0 1 0 nil) (sst!> !#!P!H!I 0 0 2 nil) (sst!> !#!C!H!I 0 1 0 t) (sst!> !#!C!H!I 0 0 2 t)))))) !#!S!P!D!I!U 0) (putel1!> (evalform!> (fndfpr!> w (dual!> (fndfpr!> '(quotient 1 2) (dfsum!> (list (sst!> !#!P!H!I 1 1 0 nil) (sst!> !#!P!H!I 1 0 2 nil) (sst!> !#!C!H!I 1 1 0 t) (sst!> !#!C!H!I 1 0 2 t) (sst!> !#!P!H!I 0 1 3 t) (sst!> !#!P!H!I 0 0 1 t) (sst!> !#!C!H!I 0 1 3 nil) (sst!> !#!C!H!I 0 0 1 nil))))))) !#!S!P!D!I!U 1) (putel1!> (evalform!> (fndfpr!> w (dual!> (dfsum!> (list (sst!> !#!P!H!I 1 1 3 t) (sst!> !#!P!H!I 1 0 1 t) (sst!> !#!C!H!I 1 1 3 nil) (sst!> !#!C!H!I 1 0 1 nil)))))) !#!S!P!D!I!U 2))) (de sst!> (wss wa wb wt bool) (prog (w) (setq w (fndfpr!> (getel1!> wss wa) (fndfpr!> (coalg!>(getel1!> wss wb)) (getframe!> wt)))) (return (cond (bool w) (t (chsign!> t w)))))) % Dirac energy-momentum tensor ... (de tdi!> nil (prog (w wa) (setq !#!T!D!I (mkt!> 2)) (setq w (mkt!> 1)) (for!> a (0 1 3) do (putel1!> (dfsum!> (list (chsign!> t (vform!> (getiframe!> a) (car !#!D!A!C!T))) (pmf!>(ddss!> !#!P!H!I a t t)) (pmf!>(coform!> (ddss!> !#!P!H!I (ccin!> a) t t))) (pmf!>(ddss!> !#!C!H!I a nil nil)) (pmf!>(coform!> (ddss!> !#!C!H!I (ccin!> a) nil nil))))) w a)) (cond (!*torsion (for!> a (0 1 3) do (for!> b (0 1 3) do (progn (setq wa (dfprod2!> (getlo!> !#!T b) (getel1!> w a))) (putel!> (evalalg!> (duald!> (pmf!> wa))) !#!T!D!I (list2 a b))))) ) (t(for!> a (0 1 3) do (for!> b (0 1 3) do (cond ((leq a b) (progn (setq wa nil) (setq wa (cons (dfprod2!> (getlo!> !#!T b) (getel1!> w a)) wa)) (setq wa (cons (dfprod2!> (getlo!> !#!T a) (getel1!> w b)) wa)) (putel!> (evalalg!> (duald!> (fndfpr!> '(quotient -1 2) (mpf!> (dfsum!> wa))))) !#!T!D!I (list2 a b))))))) )) (return t))) (de ddss!> (wss wa bool wc) (prog (w) (setq w (cond ((eqn wa 0) (fndfpr!> (coalg!>(getel1!> wss 1)) (dexcs!> 1 wss nil wc))) ((eqn wa 1) (fndfpr!> (coalg!>(getel1!> wss 0)) (dexcs!> 0 wss nil wc))) ((eqn wa 2) (fndfpr!> (coalg!>(getel1!> wss 0)) (dexcs!> 1 wss nil wc))) ((eqn wa 3) (fndfpr!> (coalg!>(getel1!> wss 1)) (dexcs!> 0 wss nil wc))))) (setq w (fndfpr!> (mpa!> '(quotient i (sqrt 2))) (dual!> w))) (return (cond (bool w) (t (chsign!> t w)))))) (de ccin!> (w) (cond ((eqn w 2) 3) ((eqn w 3) 2) (t w))) %---- Total Energy-Momentun and Spin. 10.96 ------------------------------- (de tenmom!> nil (prog (w wc wr wss) (makebox!> '!#!T!E!N!M!O!M) (fordim!> a do (fordim!> b do (cond ((leq a b) (setq w ![tlst!]) (setq wr nil) (while!> w (setq wc (eval(car w))) (setq wss (get (car w) '!=sidxl)) (cond (wc (setq wr (cons (getelsyc!> wc wss a b) wr)))) (setq w (cdr w))) (cond (wr (putel!> (evalalg!> (cons 'plus wr)) !#!T!E!N!M!O!M (list2 a b)))) )))))) (de getelsyc!> (w wss wa wb) (cond (wss (getel2!> w wa wb)) (t (list 'times '(quotient 1 2) (list 'plus (getel2!> w wa wb) (getel2!> w wb wa)))))) (de spinu!> nil (prog (w wc wr) (makebox!> '!#!S!P!I!N!U) (for!> a (0 1 2) do (progn (setq w ![slst!]) (setq wr nil) (while!> w (setq wc (eval(car w))) (cond (wc (setq wr (cons (getel1!> wc a) wr)))) (setq w (cdr w))) (cond (wr (putel1!> (evalform!> (dfsum!> wr)) !#!S!P!I!N!U a))) )))) (de tenmomt!> nil (prog (w) (fordim!> m do (setq w (cons (getm!> '!#!T!E!N!M!O!M nil (list2 m m) '(1 nil)) w))) (setq !#!T!E!N!M!O!M!T (ncons (evalalg!> (cond (w (cons 'plus w)) (t nil))))))) (de tenmoms!> nil (prog nil (makebox!> '!#!T!E!N!M!O!M!S) (putel!> (tenmomc!> 1 1) !#!T!E!N!M!O!M!S (list2 0 0)) (putel!> (tenmomc!> 1 3) !#!T!E!N!M!O!M!S (list2 0 1)) (putel!> (tenmomc!> 3 3) !#!T!E!N!M!O!M!S (list2 0 2)) (putel!> (tenmomc!> 0 1) !#!T!E!N!M!O!M!S (list2 1 1)) (putel!> (tenmomc!> 0 3) !#!T!E!N!M!O!M!S (list2 1 2)) (putel!> (tenmomc!> 0 0) !#!T!E!N!M!O!M!S (list2 2 2)) )) (de tenmomc!> (wa wb) (evalalg!> (list 'plus (getel2s!> !#!T!E!N!M!O!M wa wb) (list 'times '(quotient -1 4) (getmetr!> wa wb) (car !#!T!E!N!M!O!M!T))))) %----- Ideal Fluid. 10.96 ------------------------------------------------- (de tfli!> nil (prog (w) (setq !#!T!I!F!L (mkt!> 2)) (fordim!> a do (fordim!> b do (cond ((leq a b) (setq w (tfli0!> a b)) (putel!> (evalalg!> w) !#!T!I!F!L (list2 a b)))))))) (de tfli0!> (a b) (list 'plus (list 'times -1 (car !#!P!R!E!S) (car !#!U!S!Q) (getmetr!> a b)) (list 'times (list 'plus (car !#!E!N!E!R) (car !#!P!R!E!S)) (getloa!> !#!U!U a) (getloa!> !#!U!U b)))) %----- Spin Fluid. 11.96 -------------------------------------------------- (de spfl!> nil (prog (w) (fordim!> a do (fordim!> b do (cond ((lessp a b) (setq w (cons (fndfpr!> (getel2!> !#!S!P!F!L!T a b) (getel2!> !#!S a b)) w)))))) (setq !#!S!P!F!L (ncons (evalform!> (dfsum!> w)))))) (de spflt!> nil (prog nil (setq !#!S!P!F!L!T (mkt!> 2)) (fordim!> a do (fordim!> b do (cond ((leq a b) (putel!> (evalalg!> (vform1!> (getiframe!> b) (vform!> (getiframe!> a) (car !#!S!P!F!L)))) !#!S!P!F!L!T (list2 a b)))))))) (de frenkel!> nil (prog (w) (setq w (evalform!> (vform!> (car !#!U!V) (car !#!S!P!F!L)))) (cond (w (msg!> 6702))) (setq !#!F!C!o (ncons (equation!> w nil))))) (de spflu!> nil (prog (w) (fordim!> a do (setq w (cons (fndfpr!> (getloa!> !#!U!U a) (getframe!> a)) w))) (setq w (evalform!> (dual!> (dfsum!> w)))) (makebox!> '!#!S!P!F!L!U) (putel1!> (evalform!> (fndfpr!> (getel2!> !#!S!P!F!L!T 1 3) w)) !#!S!P!F!L!U 0) (putel1!> (evalform!> (fndfpr!> '(quotient 1 2) (fndfpr!> (list 'difference (getel2!> !#!S!P!F!L!T 2 3) (getel2!> !#!S!P!F!L!T 0 1)) w))) !#!S!P!F!L!U 1) (putel1!> (evalform!> (chsign!> t (fndfpr!> (getel2!> !#!S!P!F!L!T 0 2) w))) !#!S!P!F!L!U 2) )) (de tsfluid!> nil (progn (setq !#!T!S!F!L (mkt!> 2)) (cond (!*torsion (tsfluidq!>)) (t (tsfluidq0!>))))) (de tsfluidq0!> nil (prog (w) (fordim!> a do (fordim!> b do (cond ((leq a b) (setq w (list 'plus (tfli0!> a b) (sdeltq0!> a b))) (putel!> (evalalg!> w) !#!T!S!F!L (list2 a b)))))))) (de spin3!> (a b c) (multa!> (getloa!> !#!U!U a) (getasy2!> !#!S!P!F!L!T b c nil))) (de spin2!> (b c) (getasy2!> !#!S!P!F!L!T b c nil)) (de dspin3!> (a b c d) (prog (w) (setq w (ncons (chsign!> t (dfun!> (spin3!> b c d))))) (fordim!> m do (setq w (append w (list (fndfpr!> (spin3!> m c d) (getel2!> !#!o!m!e!g!a m b)) (fndfpr!> (spin3!> b m d) (getel2!> !#!o!m!e!g!a m c)) (fndfpr!> (spin3!> b c m) (getel2!> !#!o!m!e!g!a m d)) )))) (setq w (dfsum!> w)) (return (evalalg!> (vform1!> (getiframe!> a) w))))) (de projq0!> (a b) (list 'plus (getimetr!> a b) (list 'quotient (multa!> (getel1!> !#!U!U a) (getel1!> !#!U!U b)) (car !#!U!S!Q)))) (de sdeltq0!> (a b) (prog (w) (fordim!> c do (fordim!> d do (setq w (cons (list 'times (projq0!> c d) (list 'plus (dspin3!> c a b d) (dspin3!> c b a d))) w)))) (return (cons 'plus w)))) (de tsfluidq!> nil (prog (w) (fordim!> a do (fordim!> b do (progn (setq w (list 'plus (tfli0!> a b) (sdeltq!> a b))) (putel!> (evalalg!> w) !#!T!S!F!L (list2 a b))))))) (de sdeltq!> (a b) (prog (w) (fordim!> d do (setq w (cons (list 'times (list 'quotient -2 (car !#!U!S!Q)) (getloa!> !#!U!U a) (getel1!> !#!U!U d) (dspin2!> b d)) w))) (return (cons 'plus w)))) (de dspin2!> (a b) (prog (w) (setq w (ncons (chsign!> t (dfun!> (spin2!> a b))))) (fordim!> m do (setq w (append w (list (fndfpr!> (spin2!> m b) (getel2!> !#!o!m!e!g!a m a)) (fndfpr!> (spin2!> a m) (getel2!> !#!o!m!e!g!a m b)) )))) (setq w (dfsum!> w)) (return (evalalg!> (vform1!> (car !#!U!V) w))))) %========= End of GRGmater.sl =============================================% |
Added grgprin.sl version [084958f5da].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 | %==========================================================================% % GRGprin.sl Output Routines % %==========================================================================% % 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. % %==========================================================================% %----- REDUCE algebraic expression printing ----------------------------- % Algebraic Expressions Printing ... (de algpri!> (w) (cond ((getd 'assgnpri) (assgnpri w nil nil)) (t (varpri w nil nil)))) % TERPRI for algebraic expressions ... (de algterpri!> nil (cond ((getd 'assgnpri) (assgnpri "" nil t)) (t (varpri "" nil t)))) % Plain print list without spaces and () ... (de algrpril!> (lst) (mapc lst 'algrpri!>)) % Print list without () with Special treatment % of strings and spaces ... (de algprinwb!> (lst) (foreach!> x on lst do (prog2 (cond ((stringp(car x)) (progn (algpri!> '!" ) (algpri!> (car x) ) (algpri!> '!" ))) ((atom(car x)) (algpri!> (car x) )) (t(progn (algpri!> '!( ) (algprinwb!>(car x)) (algpri!> '!) ) ))) (cond((and x (cdr x) (atom(cadr x)) (not(or (flagp (cadr x) '!+nonsp) (flagp (car x) '!+nonsp)))) (algpri!> " " )))))) %----- Print Functions with Linelength check --------------------------- (de gterpri!> nil (progn (cond(![line!] (gterpri0!> ![line!]))) (terpri) (setq ![gpfirst!] nil) (setq ![line!] nil) (setq ![lline!] 0) )) (de gterpri0!> (lst) (cond ((null(cdr lst)) (prin2(car lst))) (t (prog2 (gterpri0!>(cdr lst)) (prin2(car lst)))))) (de gprinreset!> nil (progn (setq ![lline!] 0) (setq ![line!] nil) (setq ![gpfirst!] t) (setq ![gptab!] 0) )) (de gprin!> (w) (cond ((pairp w) (progn (gprin!> "(") (mapcar w 'gprin!>) (gprin!> ")"))) (t(prog (wc wl) (setq wl (difference (linelength nil) spare!*)) (setq wc (length(explode2 w))) (cond ((lessp (plus2 ![lline!] wc) wl) (progn (cond ((and(null ![line!])(not ![gpfirst!])) (progn (spaces ![gptab!]) (setq ![lline!] ![gptab!])))) (cond % We skip '! in the beginning of line (but not " ") ... ((not(and (null ![line!]) (seprp w))) (prog2 (setq ![line!] (cons w ![line!])) (setq ![lline!] (plus2 ![lline!] wc)) ))))) (t(progn (gterpri!>) (cond((not(seprp w))(progn (spaces ![gptab!]) (setq ![lline!] (plus2 ![gptab!] wc)) (setq ![line!] (ncons w)))))))))))) % Print list without () by GPRIN> with Special treatment % of strings and spaces ... (de gprinwb!> (lst) (gprinwb0!> lst 0)) (de gprinwb0!> (lst wl) (foreach!> x on lst do (prog2 (cond ((stringp(car x)) (progn (gprin!> '!") (gprin!>(car x)) (gprin!> '!") )) ((atom(car x)) (gprin!>(car x))) (t(progn (gprin!> '!( ) (gprinwb0!> (car x) (add1 wl)) (gprin!> '!) ) ))) (cond ((and x (cdr x) (atom(cadr x)) (not(or (flagp (cadr x) '!+nonsp) (flagp (car x) '!+nonsp)))) (gprin!> '! ))) (cond ((and (eq (car x) '!,) (zerop wl)) (gprin!> '! ))) ))) % Prints simply spaced list of atoms without () (de gprils!> (lst) (while!> lst (gprin!>(car lst)) (gprin!> '! ) (setq lst (cdr lst)))) % Prints simply spaced list of atoms without () % and without last trailing space (de gprils0!> (lst) (while!> lst (gprin!> (car lst)) (cond ((cdr lst) (gprin!> '! ))) (setq lst (cdr lst)))) (de gprils0dot!> (lst) (while!> lst (gprin!> (cond ((cdr lst) (car lst)) (t (incom!> (append (explode2(car lst)) '(!! !.)))))) (cond ((cdr lst) (gprin!> '! ))) (setq lst (cdr lst)))) (de gpris!> nil (gprin!> '! )) % Prints concatenated list of atoms (de gpril!> (lst) (while!> lst (gprin!>(car lst)) (setq lst (cdr lst)))) % Function Print (de gfnpri!> (lst) (progn (gprin!> (car lst)) (cond ((get (car lst) 'generic!_function) (gprin!> "*"))) (gprin!> "(") (gfnpri0!> (cdr lst)) (gprin!> ")") )) (de gfnpri0!> (lst) (cond((null(cdr lst)) (gprin!>(car lst))) (t(progn (gprin!>(car lst))(gprin!> ",")(gfnpri0!>(cdr lst)))))) %---------- Output Switches Management --------------------------------- % Fancy/LaTeX (FT) switcses: FANCY LATEX % Output (O) switches: GRG REDUCE MAPLE MATH MACSYMA % FT mode is defined by *FANCY=T (FANCYON>) % latex mode is defined by *latex=T % This detects O output mode ... (de ifmodo!> nil (or !*grg !*reduce !*maple !*math !*macsyma)) % This detects existence of fancy mode in REDUCE (de fancyexist!> nil (flagp 'fancy 'switch)) (de fancyloaded!> nil (getd 'fmp!-switch)) (de fancyon!> nil (and (or(fluidp '!*fancy)(globalp '!*fancy)) (eval '!*fancy))) (de tunefancy!> (bool) (cond(bool(progn (cond((or (fluidp '!*fancy!-lower) (globalp '!*fancy!-lower)) (set '!*fancy!-lower nil)) (t(msg!> 9100))) (cond ((not ![fldtuned!]) (fldtune!>))) (onoff2!> 'latex nil) (set 'fancy!-switch!-on!* (int2id 16)) (set 'fancy!-switch!-off!* (int2id 17)) (onfancydefs!>) (offothero!> nil))) (t(offallo!>)))) (de tunetex!> (bool) (prog nil (cond ((not(fancyexist!>)) (loadpack!> '(fmprint) nil))) (cond ((not(fancyexist!>)) (progn (msg!> 9101) (msg!> 91011) (msg!> 91012) (msg!> 91013) (msg!> 91014) (setq !*latex nil) (return nil)))) (cond(bool(progn (on fancy) (cond((or (fluidp '!*fancy!-lower) (globalp '!*fancy!-lower)) (set '!*fancy!-lower nil)) (t (progn (msg!> 9100) (msg!> 91011) (msg!> 91012) (msg!> 91013) (msg!> 91014) ))) (cond ((not ![fldtuned!]) (fldtune!>))) (set 'fancy!-switch!-on!* '!$) (set 'fancy!-switch!-off!* '!$) (ontexdefs!>) (offothero!> nil))) (t(progn (offothero!> nil) (set 'fancy!-switch!-on!* (int2id 16)) (set 'fancy!-switch!-off!* (int2id 17)) (onfancydefs!>) ))))) (de fldtune!> nil (progn (setq ![fldtuned!] t) (copyd 'oldfld!> 'fancy!-lower!-digits) (remd 'fancy!-lower!-digits) (copyd 'fancy!-lower!-digits 'fancylowerdigits!>) )) (de fancylowerdigits!> (u) (prog (w wa wn wz wr) (setq w (reverse u)) % Last symbol is ~ ? (cond ((eq (car w) '!~) (setq wz t) (setq w (cdr w)))) % Selecting digits ... lab1 (cond ((or (null w) (not(digit(car w)))) (go lab2))) (setq wn (cons (car w) wn)) (setq w (cdr w)) (go lab1) lab2 % Atom itself (setq w (reverse w)) (setq wa (intern(compress w))) % Symbol is special (cond ((setq wa (get wa 'fancy!-special!-symbol)) (cond ((stringp wa) (setq w (explode2 wa))) (t (setq w (append '(!\ !s !y !m !b !{) (append (explode2 wa) '(!})))))))) (cond (!*latex % latex mode: usinge \dot{} (cond (wz (setq w (append '( !\ !d !o !t !{ ) (append w '( !} )))))) (cond (wn (setq wr (append w (append '( !_ !{ ) (append wn '( !} )))))) (t (setq wr w)))) (t(cond % FANCY mode: using ' for conjugation ((and wz wn) (setq wr (append w (append '( !' !_ !{ ) (append wn '( !} )))))) (wz (setq wr (append w '( !' )))) (wn (setq wr (append w (append '( !_ !{ ) (append wn '( !} )))))) (t (setq wr w))))) (return wr))) (de tunedfindexed!> (bool) (cond ((or (globalp 'fancy!_print!_df) (fluidp 'fancy!_print!_df)) (cond (bool (set 'fancy!_print!_df 'indexed)) (t (set 'fancy!_print!_df 'partial)))))) (de tunegrg!> (bool) (cond(bool(progn (offft!>) (offothero!> 'grg))) (t(offallo!>)))) (de tunereduce!> (bool) (cond(bool(progn (offft!>) (offothero!> 'reduce))) (t(offallo!>)))) (de tunemaple!> (bool) (cond(bool(progn (offft!>) (offothero!> 'maple))) (t(offallo!>)))) (de tunemath!> (bool) (cond(bool(progn (offft!>) (offothero!> 'math))) (t(offallo!>)))) (de tunemacsyma!> (bool) (cond(bool(progn (offft!>) (offothero!> 'macsyma))) (t(offallo!>)))) % Offs All O-switches exept WSS ... (de offothero!> (wss) (proc (w) (setq w ![flaglo!]) (while!> w (cond((not(eq (car w) wss)) (onoff2!> (car w) nil))) (setq w (cdr w))))) % Offs FT-switces ... (de offft!> nil (progn (cond(!*latex (onoff2!> 'latex nil))) (cond((fancyon!>)(off fancy))))) % Offs all FT and O-switches ... (de offallo!> nil (prog2 (offft!>) (offothero!> nil))) (de ontexdefs!> nil (progn (put '!#!#lr 'fancy!-special!-symbol "{}") (put '!#!#e 'fancy!-special!-symbol "e") (put '!#!#b 'fancy!-special!-symbol "b") (put '!#!#p 'fancy!-special!-symbol "\partial") (flag '(!#!#e !#!#p) 'print!-indexed) (put 'e 'fancy!-special!-symbol "e") (put 'i 'fancy!-special!-symbol "i") (put '!a!l!p!h!a 'fancy!-special!-symbol "\alpha") (remprop '!A!L!P!H!A 'fancy!-special!-symbol) (put '!b!e!t!a 'fancy!-special!-symbol "\beta") (remprop '!B!E!T!A 'fancy!-special!-symbol) (put '!g!a!m!m!a 'fancy!-special!-symbol "\gamma") (put '!G!A!M!M!A 'fancy!-special!-symbol "\Gamma") (put '!G!a!m!m!a 'fancy!-special!-symbol "\Gamma") (put '!d!e!l!t!a 'fancy!-special!-symbol "\delta") (put '!D!E!L!T!A 'fancy!-special!-symbol "\Delta") (put '!D!e!l!t!a 'fancy!-special!-symbol "\Delta") (put '!e!p!s!i!l!o!n 'fancy!-special!-symbol "\epsilon") (remprop '!E!P!S!I!L!O!N 'fancy!-special!-symbol) (put '!z!e!t!a 'fancy!-special!-symbol "\zeta") (remprop '!Z!E!T!A 'fancy!-special!-symbol) (put '!e!t!a 'fancy!-special!-symbol "\eta") (remprop '!E!T!A 'fancy!-special!-symbol) (put '!t!h!e!t!a 'fancy!-special!-symbol "\theta") (put '!T!H!E!T!A 'fancy!-special!-symbol "\Theta") (put '!T!h!e!t!a 'fancy!-special!-symbol "\Theta") (put '!i!o!t!a 'fancy!-special!-symbol "\iota") (remprop '!I!O!T!A 'fancy!-special!-symbol) (put '!k!a!p!p!a 'fancy!-special!-symbol "\kappa") (remprop '!K!A!P!P!A 'fancy!-special!-symbol) (put '!l!a!m!b!d!a 'fancy!-special!-symbol "\lambda") (put '!L!A!M!B!D!A 'fancy!-special!-symbol "\Lambda") (put '!L!a!m!b!d!a 'fancy!-special!-symbol "\Lambda") (put '!m!u 'fancy!-special!-symbol "\mu") (remprop '!M!U 'fancy!-special!-symbol) (put '!n!u 'fancy!-special!-symbol "\nu") (remprop '!N!U 'fancy!-special!-symbol) (put '!x!i 'fancy!-special!-symbol "\xi") (put '!X!I 'fancy!-special!-symbol "\Xi") (put '!X!i 'fancy!-special!-symbol "\Xi") (put '!p!i 'fancy!-special!-symbol "\pi") (put '!P!I 'fancy!-special!-symbol "\pi") (put '!P!i 'fancy!-special!-symbol "\Pi") (put '!r!h!o 'fancy!-special!-symbol "\rho") (remprop '!R!H!O 'fancy!-special!-symbol) (put '!s!i!g!m!a 'fancy!-special!-symbol "\sigma") (put '!S!I!G!M!A 'fancy!-special!-symbol "\Sigma") (put '!S!i!g!m!a 'fancy!-special!-symbol "\Sigma") (put '!t!a!u 'fancy!-special!-symbol "\tau") (remprop '!T!A!U 'fancy!-special!-symbol) (put '!u!p!s!i!l!o!n 'fancy!-special!-symbol "\upsilon") (put '!U!P!S!I!L!O!N 'fancy!-special!-symbol "\Upsilon") (put '!U!p!s!i!l!o!n 'fancy!-special!-symbol "\Upsilon") (put '!p!h!i 'fancy!-special!-symbol "\phi") (put '!P!H!I 'fancy!-special!-symbol "\Phi") (put '!P!h!i 'fancy!-special!-symbol "\Phi") (put '!c!h!i 'fancy!-special!-symbol "\chi") (remprop '!C!H!I 'fancy!-special!-symbol) (put '!p!s!i 'fancy!-special!-symbol "\psi") (put '!P!S!I 'fancy!-special!-symbol "\Psi") (put '!P!s!i 'fancy!-special!-symbol "\Psi") (put '!o!m!e!g!a 'fancy!-special!-symbol "\omega") (put '!O!M!E!G!A 'fancy!-special!-symbol "\Omega") (put '!O!m!e!g!a 'fancy!-special!-symbol "\Omega") (put 'infinity 'fancy!-special!-symbol "\infty") (put 'partial!-df 'fancy!-special!-symbol "\partial") (remflag '(!D!E!L!T!A !d!e!l!t!a) 'PRINT!-INDEXED) (put 'sin 'fancy!-functionsymbol "\sin") (put 'sinh 'fancy!-functionsymbol "\sinh") (put 'asin 'fancy!-functionsymbol "\arcsin") (put 'asinh 'fancy!-functionsymbol "arcsinh") (put 'cos 'fancy!-functionsymbol "\cos") (put 'cosh 'fancy!-functionsymbol "\cosh") (put 'acos 'fancy!-functionsymbol "\arccos") (put 'acosh 'fancy!-functionsymbol "arccosh") (put 'tan 'fancy!-functionsymbol "\tan") (put 'tanh 'fancy!-functionsymbol "\tanh") (put 'atan 'fancy!-functionsymbol "\arctan") (put 'atanh 'fancy!-functionsymbol "arctanh") (put 'cot 'fancy!-functionsymbol "\cot") (put 'coth 'fancy!-functionsymbol "\coth") (put 'acot 'fancy!-functionsymbol "arccot") (put 'acoth 'fancy!-functionsymbol "arccoth") (put 'sec 'fancy!-functionsymbol "\sec") (put 'sech 'fancy!-functionsymbol "sech") (put 'asec 'fancy!-functionsymbol "arcsec") (put 'asech 'fancy!-functionsymbol "arcsech") (put 'csc 'fancy!-functionsymbol "\csc") (put 'csch 'fancy!-functionsymbol "csch") (put 'acsc 'fancy!-functionsymbol "arccsc") (put 'acsch 'fancy!-functionsymbol "arccsch") (put 'ln 'fancy!-functionsymbol "\ln") (put 'log 'fancy!-functionsymbol "\log") )) (DE ONFANCYDEFS!> NIL (PROGN (put '!#!#lr 'fancy!-special!-symbol "{}") (put '!#!#e 'fancy!-special!-symbol "e") (put '!#!#b 'fancy!-special!-symbol "b") (put '!#!#p 'fancy!-special!-symbol 182) (flag '(!#!#e !#!#p) 'print!-indexed) (put 'e 'fancy!-special!-symbol "e") (put 'i 'fancy!-special!-symbol "i") (put '!a!l!p!h!a 'fancy!-special!-symbol "\alpha") (remprop '!A!L!P!H!A 'fancy!-special!-symbol) (put '!b!e!t!a 'fancy!-special!-symbol "\beta") (remprop '!B!E!T!A 'fancy!-special!-symbol) (put '!g!a!m!m!a 'fancy!-special!-symbol "\gamma") (put '!G!A!M!M!A 'fancy!-special!-symbol 71) (put '!G!a!m!m!a 'fancy!-special!-symbol 71) (put '!d!e!l!t!a 'fancy!-special!-symbol "\delta") (put '!D!E!L!T!A 'fancy!-special!-symbol 68) (put '!D!e!l!t!a 'fancy!-special!-symbol 68) (put '!e!p!s!i!l!o!n 'fancy!-special!-symbol "\epsilon") (remprop '!E!P!S!I!L!O!N 'fancy!-special!-symbol) (put '!z!e!t!a 'fancy!-special!-symbol "\zeta") (remprop '!Z!E!T!A 'fancy!-special!-symbol) (put '!e!t!a 'fancy!-special!-symbol "\eta") (remprop '!E!T!A 'fancy!-special!-symbol) (put '!t!h!e!t!a 'fancy!-special!-symbol "\theta") (put '!T!H!E!T!A 'fancy!-special!-symbol 81) (put '!T!h!e!t!a 'fancy!-special!-symbol 81) (put '!i!o!t!a 'fancy!-special!-symbol "\iota") (remprop '!I!O!T!A 'fancy!-special!-symbol) (put '!k!a!p!p!a 'fancy!-special!-symbol "\kappa") (remprop '!K!A!P!P!A 'fancy!-special!-symbol) (put '!l!a!m!b!d!a 'fancy!-special!-symbol "\lambda") (put '!L!A!M!B!D!A 'fancy!-special!-symbol 76) (put '!L!a!m!b!d!a 'fancy!-special!-symbol 76) (put '!m!u 'fancy!-special!-symbol "\mu") (remprop '!M!U 'fancy!-special!-symbol) (put '!n!u 'fancy!-special!-symbol "\nu") (remprop '!N!U 'fancy!-special!-symbol) (put '!x!i 'fancy!-special!-symbol "\xi") (put '!X!I 'fancy!-special!-symbol 88) (put '!X!i 'fancy!-special!-symbol 88) (put '!p!i 'fancy!-special!-symbol "\pi") (put '!P!I 'fancy!-special!-symbol "\pi") (put '!P!i 'fancy!-special!-symbol 80) (put '!r!h!o 'fancy!-special!-symbol "\rho") (remprop '!R!H!O 'fancy!-special!-symbol) (put '!s!i!g!m!a 'fancy!-special!-symbol "\sigma") (put '!S!I!G!M!A 'fancy!-special!-symbol 83) (put '!S!i!g!m!a 'fancy!-special!-symbol 83) (put '!t!a!u 'fancy!-special!-symbol "\tau") (remprop '!T!A!U 'fancy!-special!-symbol) (put '!u!p!s!i!l!o!n 'fancy!-special!-symbol "\upsilon") (put '!U!P!S!I!L!O!N 'fancy!-special!-symbol 161) (put '!U!p!s!i!l!o!n 'fancy!-special!-symbol 161) (put '!p!h!i 'fancy!-special!-symbol "\phi") (put '!P!H!I 'fancy!-special!-symbol 70) (put '!P!h!i 'fancy!-special!-symbol 70) (put '!c!h!i 'fancy!-special!-symbol "\chi") (remprop '!C!H!I 'fancy!-special!-symbol) (put '!p!s!i 'fancy!-special!-symbol "\psi") (put '!P!S!I 'fancy!-special!-symbol 89) (put '!P!s!i 'fancy!-special!-symbol 89) (put '!o!m!e!g!a 'fancy!-special!-symbol "\omega") (put '!O!M!E!G!A 'fancy!-special!-symbol 87) (put '!O!m!e!g!a 'fancy!-special!-symbol 87) (put 'infinity 'fancy!-special!-symbol "\infty") (put 'partial!-df 'fancy!-special!-symbol 182) (remflag '(!D!E!L!T!A !d!e!l!t!a) 'PRINT!-INDEXED) (put 'sin 'fancy!-functionsymbol "sin") (put 'sinh 'fancy!-functionsymbol "sinh") (put 'asin 'fancy!-functionsymbol "asin") (put 'asinh 'fancy!-functionsymbol "asinh") (put 'cos 'fancy!-functionsymbol "cos") (put 'cosh 'fancy!-functionsymbol "cosh") (put 'acos 'fancy!-functionsymbol "acos") (put 'acosh 'fancy!-functionsymbol "acosh") (put 'tan 'fancy!-functionsymbol "tan") (put 'tanh 'fancy!-functionsymbol "tanh") (put 'atan 'fancy!-functionsymbol "atan") (put 'atanh 'fancy!-functionsymbol "atanh") (put 'cot 'fancy!-functionsymbol "cot") (put 'coth 'fancy!-functionsymbol "coth") (put 'acot 'fancy!-functionsymbol "acot") (put 'acoth 'fancy!-functionsymbol "acoth") (put 'sec 'fancy!-functionsymbol "sec") (put 'sech 'fancy!-functionsymbol "sech") (put 'asec 'fancy!-functionsymbol "asec") (put 'asech 'fancy!-functionsymbol "asech") (put 'csc 'fancy!-functionsymbol "csc") (put 'csch 'fancy!-functionsymbol "csch") (put 'acsc 'fancy!-functionsymbol "acsc") (put 'acsch 'fancy!-functionsymbol "acsch") (put 'ln 'fancy!-functionsymbol "ln") (put 'log 'fancy!-functionsymbol "log") )) %------- Print functions for GRG REDUCE MAPLE ... ------------------------ (de ooprin!> (lst) (cond ((atom lst) (ooatom!> lst)) ((eq (car lst) 'plus) (oonop!> lst "+")) ((eq (car lst) 'minus) (oominus!> lst)) ((eq (car lst) 'difference) (oo2op!> lst "-")) ((eq (car lst) 'times) (oonop!> lst "*")) ((eq (car lst) 'quotient) (oo2op!> lst "/")) ((eq (car lst) 'expt) (oo2op!> lst '!^ )) (t (oofun!> lst)) )) (de oominus!> (lst) (progn (gprin!> "(") (gprin!> "-") (ooprin!> (cadr lst)) (gprin!> ")") )) (de oo2op!> (lst w) (progn (gprin!> "(") (ooprin!> (cadr lst)) (gprin!> w) (ooprin!> (caddr lst)) (gprin!> ")") )) (de oonop!> (lst w) (proc nil (gprin!> "(") (setq lst (cdr lst)) (ooprin!> (car lst)) (setq lst (cdr lst)) (while!> lst (gprin!> w) (ooprin!> (car lst)) (setq lst (cdr lst))) (gprin!> ")"))) (de ooatom!> (w) (cond ((null w) (gprin!> 0)) ((eq w 'e) (ooae!>)) ((eq w 'i) (ooai!>)) ((eq w 'pi) (ooapi!>)) ((eq w 'infinity) (ooainf!>)) ((and (not !*grg) (get w '!=depend)) (oofun0!>(get w '!=depend))) (t (gprin!> w)))) (de ooae!> nil (gprin!> (cond (!*macsyma '!%!e ) ((or !*math !*maple) '!E ) (t 'e )))) (de ooai!> nil (gprin!> (cond (!*macsyma '!%!i ) ((or !*math !*maple) '!I ) (t 'i )))) (de ooapi!> nil (gprin!> (cond (!*macsyma '!%!p!i ) ((or !*maple !*math) '!P!i ) (t 'pi )))) (de ooainf!> nil (gprin!> (cond (!*maple '!i!n!f!i!n!i!t!y ) (!*math '!I!n!f!i!n!i!t!y ) (t 'infinity )))) (de oolb!> nil (gprin!> (cond (!*math "[") (t "(")))) (de oorb!> nil (gprin!> (cond (!*math "]") (t ")")))) (de oofun!> (w) (cond ((or !*grg !*reduce) (oofun0!> w)) ((eq (car w) 'df) (oodf!> w)) ((eq (car w) 'int) (ooint!> w)) ((eq (car w) 'prod) (oops!> w t)) ((eq (car w) 'sum) (oops!> w nil)) ((eq (car w) 'ln) (ooln!> w)) ((eq (car w) 'log) (oolog!> w)) ((eq (car w) 'sqrt) (oosqrt!> w)) ((flagp (car w) '!+trig) (ootrig!> w)) (t (oofun0!> w)))) (de oofun0!> (lst) (prog2 (gprin!> (car lst)) (ooargs!> (cdr lst)))) (de ooargs!> (lst) (proc nil (oolb!>) (ooprin!> (car lst)) (setq lst (cdr lst)) (while!> lst (gprin!> ",") (ooprin!> (car lst)) (setq lst (cdr lst))) (oorb!>))) (de oodf!> (lst) (cond((or !*reduce !*grg) (oofun0!> lst)) (t(prog2 (gprin!> (cond ((or !*maple !*macsyma) '!d!i!f!f ) (!*math '!D ) (t 'df ))) (ooargsdf!>(cdr lst)))))) (de ooargsdf!> (lst) (proc (w wc) (oolb!>) (ooprin!> (car lst)) (setq lst (cdr lst)) (while!> lst (gprin!> ",") (setq wc (car lst)) (cond ((numberp wc) (for!> ww (2 1 wc) do (prog2 (ooprin!> w) (cond((not(eqn ww wc))(gprin!> ",")))))) (t(ooprin!> wc))) (setq w wc) (setq lst (cdr lst))) (oorb!>))) (de ooint!> (lst) (prog2 (gprin!> (cond ((or !*maple !*macsyma) '!i!n!t!e!g!r!a!t!e ) (!*math '!I!n!t!e!g!r!a!t!e ) (t 'int ))) (ooargs!>(cdr lst)))) (de oosqrt!> (lst) (prog2 (gprin!> (cond ((or !*maple !*macsyma) '!s!q!r!t ) (!*math '!S!q!r!t ) (T 'sqrt ))) (ooargs!>(cdr lst)))) (de ooln!> (lst) (prog2 (gprin!> (cond (!*maple '!l!n ) (!*macsyma '!l!o!g ) (!*math '!L!o!g ) (t 'ln ))) (ooargs!>(cdr lst)))) (de oolog!> (lst) (prog2 (gprin!> (cond (!*maple '!l!o!g ) (!*macsyma '!l!o!g ) (!*math '!L!o!g ) (t 'log ))) (ooargs!>(cdr lst)))) (de oops!> (lst bool) (prog nil (gprin!> (cond (bool (cond ((or !*maple !*macsyma) '!p!r!o!d ) (!*math '!P!r!o!d ) (t 'prod ))) (t (cond ((or !*maple !*macsyma) '!s!u!m ) (!*math '!S!u!m ) (t 'sum ))) )) (cond((not(or !*math !*maple)) (prog2 (ooargs!>(cdr lst)) (return nil)))) (oolb!>) (ooprin!> (cadr lst)) (setq lst (cddr lst)) (gprin!> ",") (cond(!*math (gprin!> "{"))) (ooprin!> (car lst)) (gprin!> (cond (!*math ",") (!*maple "="))) (ooprin!> (cadr lst)) (gprin!> (cond (!*math ",") (!*maple ".."))) (ooprin!> (caddr lst)) (cond(!*math (gprin!> "}"))) (oorb!>))) (de ootrig!> (lst) (prog (w wa) (setq w (explode2(car lst))) (cond((eq (car w) 'a) (prog2 (setq wa t) (setq w (cdr w))))) (cond(wa (setq wa (cond (!*maple '( !a !r !c )) (!*math '( !A !r !c )) (t '( A )))))) (cond (!*maple (setq w (mapcar w 'tolc!>))) (!*math (setq w (cons (touc!> (car w)) (mapcar (cdr w) 'tolc!>))))) (setq w (compress(append wa w))) (oofun0!>(cons w (cdr lst))))) (de ooend!> nil (cond ((not !*math) (gprin!> ";")))) (de ooends!> nil (cond((not !*math) (gprin!> (cond ((or !*reduce !*macsyma) "$") (!*maple ":") (t ";")))))) (de ooelem!> (wi wl) (proc nil (gprin!> wi) (cond((null wl) (return nil))) (gprin!> (cond((or !*math !*macsyma) "[")(t "("))) (while!> wl (gprin!> (car wl)) (cond((cdr wl)(gprin!> ","))) (setq wl (cdr wl))) (gprin!> (cond((or !*math !*macsyma) "]")(t ")"))) )) %---------- For Write ---------------------------------------------------- (de wriassign!> (we) (cond ((fancyon!>) (algpri!> (cond (we ":\,") (t "\,=\,")) )) ((ifmodo!>) (gprin!> (cond (!*macsyma " : " ) ((or !*maple !*reduce) " := ") (t " = " )))) (t (algpri!> (cond (we " : ") (t " = ")) )))) (de wriequal!> nil (cond ((fancyon!>) (algpri!> "\,=\," )) ((ifmodo!>) (gprin!> (cond (!*math " == ") (t " = " )))) (t (algpri!> " = " )))) %---------- Equations Printing ------------------------------------------ (de eqpri!> (wl wr wt) (progn (cond ((zerop wt) (alpri!> wl)) (t (dfpri!> wl wt))) (wriequal!>) (cond ((zerop wt) (alpri!> wr)) (t (dfpri!> wr wt))) )) %---------- Algebraic Expressions Printing ----------------------------- (de alpri!> (lst) (cond ((ifmodo!>) (ooprin!> lst)) (t (algpri!> (cond (!*wrs (aeval lst)) (t lst)) )))) %---------- Form Printing ---------------------------------------------- (de dfpri!> (lst type) (cond ((ifmodo!>) (dfpri1!> lst type)) (t (dfpri0!> lst type)))) (de dfpri0!> (lst type) (cond((null lst) (algpri!> 0 )) % 0 (t(prog (wx) (setq type (lessp type 0)) (cond(!*wrs(setq lst(aevalform!> lst)))) (cond((null lst)(algpri!> 0 ))(t (foreach!> x in lst do % for all terms ... (progn (cond((eqn(car x)-1) (primi!>)) % - d x ((not(eq x(car lst))) (pripl!>))) % ... + ... (cond((not(or(eqn(car x)-1)(eqn(car x)1))) % d x (cond((or(idp(car x)) (and(numberp(car x))(not(lessp(car x)0))) (and !*wrs !*exp (not(getd 'taysimpexpt)) (not(numberp(car x))) % not -n (eqn(cdr(cadar x)) 1) % den = 1 (null(cdar(cadar x)) ) % not a + b (eqn(cdaar(cadar x)) 1) % not n * a (eqn(cdaaar(cadar x)) 1) % not a ** b )) % a d x (algpri!> (car x) )) (t % (algpri!> (list2 '! (car x)) ) (progn (algpri!> "(" ) (algpri!> (car x) ) (algpri!> ")" ) ) )) )) % (...) d x (setq wx (cddr x)) % wx - d x list (prixvost!> wx type) )))))))) (de primi!> nil (algpri!> (cond (!*latex "-") (t " -")) )) (de pripl!> nil (algpri!> (cond (!*latex "+") (t " + ")) )) (de prixvost!> (wx type) (proc (w wc) (setq wc 0) (while!> wx (cond((caar wx) (prog2 (printdx0!> wc type) (cond((cdr wx) (priex!>))) ))) (setq wc (add1 wc)) (setq wx (cdr wx))))) (de priex!> nil (algpri!> (cond (!*latex "\,\wedge") ((fancyon!>) "\,\symb{217}") (t " /\")) )) (de printdx0!> (wc type) (cond (![modp!] %%% Anholonomic mode: b or e (cond ((fancyon!>) (prog2 % latex or fancy ... (algpri!> "\," ) (cond (type (algpri!> (list '!#!#e wc) )) % e_i (t (algpri!> (list 'expt '!#!#b wc) ))))) % b^i (t (prog2 % plain grg ... (algpri!> " " ) (algpri!> (compress (cons (bore!> type) (explode2 wc))) % bi or ei ))))) (t(cond %%% Holonomic mode: @ x or d x ... ((fancyon!>) % latex or fancy ... (cond (type % \partial_x (algpri!> (list '!#!#p (getel1!> ![cord!] wc)) )) (t (prog2 % d x (algpri!> "\,d\," ) (algpri!> (getel1!> ![cord!] wc) ))))) (t (prog2 % plain grg ... (algpri!> (cond(type " @ ")(t " d ")) ) (algpri!> (getel1!> ![cord!] wc) ))))))) (de bore!> (type) (cond (type '!e) (t '!b))) (de dfpri1!> (lst type) (cond((null lst) (gprin!> 0)) % 0 (t(proc (w wf wx wc) (setq type (lessp type 0)) (while!> lst (setq w (car lst)) (cond (wf (gprin!> "+")) (t (setq wf t))) (cond((not(equal (car w) 1)) (prog2 (cond ((and (numberp(car w)) (lessp (car w) 0)) (ooprin!> (list2 'minus (minus(car w))))) (t (ooprin!> (car w)))) (gprin!> "*")))) (setq w (cddr w)) % d x list (setq wc 0) (setq wx nil) (while!> w (cond((caar w) (setq wx (cons (prepdx1!> wc type) wx)))) (setq wc (add1 wc)) (setq w (cdr w))) (cond(!*grg (oogrgdx!> (reverse wx) type)) (t (oofun0!> (cons (cond (type '!pd) (t '!dx)) (reverse wx))))) (setq lst (cdr lst))))))) (de oogrgdx!> (wx type) (loop!> (cond((not ![modp!])(prog2 (cond (type (gprin!> '!@)) (t (gprin!> '!d))) (gprin!> '! )))) (gprin!> (car wx)) (setq wx (cdr wx)) (exitif (null wx)) (gprin!> '!/!\))) (de prepdx1!> (wc type) (cond (![modp!] (compress (cons (bore!> type) (explode2 wc)))) (t (getel1!> ![cord!] wc)))) %-------- Some General Print Functions ----------------------------------- (de grgterpri!> nil (cond((ifmodo!>) (gterpri!>)) (t (algterpri!>)))) (de grgend!> nil (cond((ifmodo!>) (ooend!>)))) (de grgends!> nil (cond((ifmodo!>) (ooends!>)))) %============ End of GRGprin.sl ===========================================% |
Added grgproc.sl version [880ea473ea].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 | %==========================================================================% % GRGproc.sl Forms and Vectors Processor % %==========================================================================% % 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. % %==========================================================================% %---- Main algebraic simplification functionS ----------------------------- (de eval!> (w) (cond (!*aeval (reval (aeval w)) ) (t (reval w) ) )) (de raeval!> (w) (reval (aeval w))) %---------- Algebraic Simplification -------------------------------------- % Algebraic simplification with NIL return ... (de evalalg!> (w) (cond ((or (null w) (eqn w 0)) nil) (t (zn!>(eval!> w))))) % Alg or Alg Equation simplification ... (de evalalgx!> (w) (cond ((and (pairp w) (eq (car w) 'equal)) (equationa!> (cadr w) (caddr w))) (t (evalalg!> w)))) %---------- Form Simplification ------------------------------------------- % Form simplification ... (de evalform!> (lst) (cond ((null lst) nil) (t (proc (wa wb wc) (while!> lst (setq wa (eval!> (caar lst))) (cond ((not(or (eqn wa 0) (null wa))) (setq wc (cons (cons wa (cdar lst)) wc)) )) (setq lst (cdr lst))) (return (reversip wc)))))) % Alg or Alg Equation simplification ... (de evalformx!> (w) (cond ((and (pairp w) (eq (car w) 'equal)) (equationf!> (cadr w) (caddr w))) (t (evalform!> w)))) % Form simplification with AEVAL ... (de aevalform!> (lst) (cond((null lst)nil) (t(proc(wa wb wc) (while!> lst (setq wa(aeval(caar lst))) (cond((not(or(eqn wa 0)(null wa))) (setq wc(cons(cons wa(cdar lst))wc)) )) (setq lst(cdr lst))) (return(reversip wc)))))) %---------- 0 <-> nil ----------------------------------------------------- (de nz!> (w) (cond (w w) (t 0))) % alg -> alg0 (de zn!> (w) (cond ((eqn w 0) nil)(t w))) % alg0 -> alg %-------- Multiplication ------------------------------------------------ % Times W * Alg ... (de multa!> (w wa) (cond ((or (null w) (null wa)) nil) ((eqn w 1) wa ) (t (list 'times w wa)))) % Times W * Alg or Alg Equation ... (de multax!> (w wa) (cond ((and (pairp wa) (eq (car wa) 'equal)) (equation!> (multa!> w (cadr wa)) (multa!> w (caddr wa)))) (t (multa!> w wa)))) % Times W * Form ... (de multf!> (w wa) (cond ((or (null w) (null wa)) nil) ((eqn w 1) wa ) (t (fndfpr!> w wa)))) % Times W * Form or Form Equation ... (de multfx!> (w wa) (cond ((and (pairp wa) (eq (car wa) 'equal)) (equation!> (multf!> w (cadr wa)) (multf!> w (caddr wa)))) (t (multf!> w wa)))) %-------- Summatuon -------------------------------------------------------- % Sum list of Alg ... (de summa!> (w) (cond ((null w) nil) (t (evalalg!> (cons 'plus w))))) % Sum list of Alg or Alg Equations ... (de summax!> (w) (cond ((not(equationp!> w)) (summa!> w)) (t (equation!> (summa!> (mapcar w 'eqleft!>)) (summa!> (mapcar w 'eqright!>)))))) % Sum list of Forms ... (de summf!> (w) (cond ((null w) nil) (t (evalform!> (dfsum!> w))))) % Sum list of Forms or Forms Equations ... (de summfx!> (w) (cond ((not(equationp!> w)) (summf!> w)) (t (equation!> (summf!> (mapcar w 'eqleft!>)) (summf!> (mapcar w 'eqright!>)))))) (de eqleft!> (w) (cond ((pairp w) (cadr w)) (t nil))) (de eqright!> (w) (cond ((pairp w) (caddr w)) (t nil))) (de equationp!> (w) (cond ((null w) nil) ((null(car w)) (equationp!>(cdr w))) ((pairp(car w)) (eq (caar w) 'equal)) (t nil))) % Summation ... (de algsum!> (w) (progn (setq w (algsum1!> w)) (cond ((null w) w) ((null(cdr w)) (car w)) (t (cons 'plus w))))) (de algsum1!> (w) (cond ((null w) nil) ((null(car w)) (algsum1!>(cdr w))) (t (cons (car w) (algsum1!>(cdr w)))))) %-------- Equations building functions ------------------------------------- (de equation!> (wl wr) % makes (equal wl wr) or nil if both null ... (cond ((and (null wl) (null wr)) nil) (t (list 'equal wl wr)))) (de equationf!> (w1 w2) % form=form with eval ... (cond((and(null(setq w1(evalform!> w1))) (null(setq w2(evalform!> w2)))) nil) (t(list3 'equal w1 w2)))) (de equationf1!> (w1 w2) % form=form -> form-form=0 with eval ... (cond((null(setq w1 (evalform!>(dfsum!>(list w1 (chsign!> t w2)))))) nil) (t(list3 'equal w1 nil)))) (de equationa!> (w1 w2) % alg=alg with eval ... (cond((and(or(null(setq w1(eval!> w1)))(eqn w1 0)) (or(null(setq w2(eval!> w2)))(eqn w2 0)) ) nil) (t(list3 'equal (zn!> w1) (zn!> w2))))) (de equationa1!> (w1 w2) % alg=alg -> alg-alg=0 with eval ... (cond((or(null(setq w1(eval!>(list3 'difference w1 w2))))(eqn w1 0)) nil) (t(list3 'equal (zn!> w1) nil)))) %------ Forms <-> Reduce matrix conversion support ------------------------- % (LIST of 1-forms) -> Reduce matrix ... 05.96 (de mkmtetr!> (lst) (cons 'mat (foreach!> a in (dimlist!> 0) collect (foreach!> b in (dimlist!> 0) collect (getfdx!> (getel1!> lst a) b))))) % Reduce matrix -> tetrad (LIST of 1-forms) ... 05.96 (de mktetrm!> (w ww) (prog(wa wb wc) (setq wa 0) (foreach!> x in w do (progn (setq wa(add1 wa)) (setq wc nil) (setq wb -1) (foreach!> y in x do (progn (setq wb(add1 wb)) (setq wc(dfsum!>(list2 wc(fndfpr!>(zn!>(eval!> y))(mkdx!> wb))))))) (putel1!> (evalform!> wc) ww (sub1 wa)))) (return t))) %----- Matrix Reduce <-> GRG conversion support ---------------------------- (de mat!> (lst) % 05.96 GRG -> Reduce (cons 'mat (foreach!> i in (dimlist!> 0) collect (foreach!> j in (dimlist!> 0) collect (getel!> lst (list2 i j)))))) (de mats!> (lst) % 05.96 GRG -> Reduce (cons 'mat (foreach!> i in (dimlist!> 0) collect (foreach!> j in (dimlist!> 0) collect (getel2s!> lst i j))))) (de matsf!> (fun) % 05.96 GRG -> Reduce (cons 'mat (foreach!> i in (dimlist!> 0) collect (foreach!> j in (dimlist!> 0) collect (eval (list fun i j)))))) (de rmat!> (lst wm) % 05.96 Reduce -> GRG (prog (w) (fordim!> i do (progn (setq wm (cdr wm)) (setq w (car wm)) (fordim!> j do (progn (putel!> (zn!>(eval!>(car w))) lst (list2 i j)) (setq w (cdr w)))))))) (de rmats!> (lst wm) % 05.96 Reduce -> GRG (prog (w) (fordim!> i do (progn (setq wm (cdr wm)) (setq w (car wm)) (fordim!> j do (progn (cond((leq i j) (putel!> (zn!>(eval!>(car w))) lst (list2 i j)))) (setq w (cdr w)))))))) %---------- Sign Changing -------------------------------------------------- (de chsignf!> (w) (chsign!> t w)) % form (de chsigna!> (w) (chsign!> nil w)) % alg expression % Sign changing ... BOOL=T - Form, BOOL=NIL - Alg (de chsign!> (bool lst) (cond((null lst) nil) (bool(mapcar lst 'chsign1!>)) (t(chsign2!> lst)))) (de chsignx!> (wt w) (cond ((and (pairp w) (eq (car w) 'equal)) (equation!> (chsign!> wt (cadr w)) (chsign!> wt (caddr w)))) (t (chsign!> wt w)))) (de chsign1!> (w) (cond((and(pairp(car w))(eq(caar w) 'minus)) (cons (cadar w) (cdr w))) ((numberp(car w)) (cons (minus(car w)) (cdr w))) (t(cons (list2 'minus(car w)) (cdr w))))) (de chsign2!> (w) (cond((and(pairp w)(eq(car w) 'minus)) (cadr w)) ((numberp w) (minus w)) (t (list2 'minus w)))) %---------- Exterior Forms Processor. 10.01.91 --------------------------- % Exterior forms summation ... (de dfsum!> (lst) (cond ((null lst)nil) ((null(cdr lst))(car lst)) (t(proc (w ww wt wn wr wx) (setq w (flcopy!> lst)) (setq ww w) (loop!> (setq wn nil) (setq w ww) (while!> w (cond((car w) (cond((null wn) (setq wn (cadaar w))) ((lessp(cadaar w)wn) (setq wn (cadaar w)))))) (setq w (cdr w))) (exitif(null wn)) (setq w ww) (setq wt nil) (while!> w (cond((car w) (cond((eqn wn (cadaar w)) (progn (setq wx (cdaar w)) (setq wt (cons (caaar w) wt)) (rplaca w (cdar w)) ))))) (setq w (cdr w))) (cond((cdr wt)(setq wt (cons (cons 'plus wt) wx))) (t (setq wt (cons (car wt) wx)))) (setq wr (cons wt wr)) ) (return(reversip wr)) )))) (de flcopy!> (w) (cond((null w) nil) (t(cons (car w) (flcopy!> (cdr w)))))) % alg * form or vector multiplication ... (de fndfpr!> (alg form) (cond((or(null form)(zerop alg)(null alg))nil) ((eqn alg 1) form) ((eqn alg -1) (chsign!> t form)) (t(proc(wa) (while!> form (setq wa (cons (cons (list 'times alg (caar form)) (cdar form)) wa)) (setq form(cdr form))) (return(reversip wa)))))) % Exterior product ... (de dfprod!> (lst) (cond ((memq nil lst) nil) ((null(cdr lst)) (car lst)) (t (dfprod2!> (car lst) (dfprod!>(cdr lst)))))) % Exterior product form1/\form2 ... (de dfprod2!> (frm1 frm2) (cond((null(and frm1 frm2))nil) (t(proc (x y wa wb wc w res sgn) (setq w t) (while!> frm1 (setq wa frm2) (while!> frm2 (setq sgn t) (setq x(cddar frm1)) (setq y(cddar frm2)) (while!> (and x y (null(and(caar x)(caar y))) (prog2 (and (null(cdr y)) (setq w(not(cdar y)))) t)) (setq wb(cons(cons(or(caar x)(caar y)) (eq(cdar x)(cdar y))) wb)) (cond((and(caar x)(not(cdar y))) (setq sgn(not sgn)) )) (setq x(cdr x)) (setq y(cdr y)) ) (tohead (and x y (caar x) (caar y) (progn (setq wb nil) (setq frm2(cdr frm2)) t))) (while!> x (setq wb(cons(cons(caar x) (cond((caar wb)(not(cdar wb))) (t(cdar wb)))) wb)) (cond((and(caar wb)(null w)) (setq sgn(not sgn)))) (setq x(cdr x))) (while!> y (setq wb(cons(cons(caar y) (cond((caar wb)(not(cdar wb))) (t(cdar wb)))) wb)) (setq y(cdr y))) (setq x(list3(quote times)(caar frm1)(caar frm2))) (cond((null sgn)(setq x(list2(quote minus)x)))) (setq y(cons x(cons (plus(cadar frm1)(cadar frm2)) (reversip wb)))) (setq wc(cons y wc)) (setq wb nil) (setq frm2(cdr frm2))) (setq frm1(cdr frm1)) (setq frm2 wa) (cond(wc(prog2(setq res(cons(reversip wc)res)) (setq wc nil)))) ) (return(dfsum!> res)) )) )) (de dfsum2!> (wa wb) (dfsum!> (list2 wa wb))) % Exterior differential d form ... (de dex!> (frm) (dex1!> frm ![umod!])) (de dex1!> (frm wm) (cond ((null frm) nil) (t (prog(w) (foreach!> x in frm do (prog2 (setq w (cons (dfprod2!> (dfun1!> (car x) wm) (ncons (cons 1 (cdr x))) ) w)) (cond (wm (setq w (cons (fndfpr!> (car x) (dexxb!>(cdr x))) w)))) )) (return (dfsum!> w)))))) (de dexxb!> (w) % with d(b/\...) accumulation (proc (wc wr ww) (setq ww (car w)) (cond ((setq wc (assoc (car w) ![dbas!])) (return(cdr wc))) (t (setq w (cdr w)))) (setq wc -1) (while!> w (setq wc (add1 wc)) (cond ((caar w) (setq wr (cons (getel1!> !#!b wc) wr)))) (setq w (cdr w))) (setq wr (evalform!>(nbform!>(dex1!>(dfprod!>(reversip wr))nil)))) (setq ![dbas!] (cons (cons ww wr) ![dbas!])) (return wr))) %(de dexxb!> (w) % without d(b/\...) accumulation % (proc (wc wr) % (setq w (cdr w)) % (setq wc -1) % (while!> w % (setq wc (add1 wc)) % (cond((caar w)(setq wr(cons(getel1!> !#!b wc)wr)))) % (setq w (cdr w))) % (return(nbform!>(dex1!>(dfprod!>(reversip wr))nil))))) % Exterior differential d Alg ... (de dfun!> (lst) (dfun1!> lst ![umod!])) (de dfun1!> (lst wm) (cond((null lst) nil) (t (proc (wb wc wd) (foreach!> x in ![cord!] do (prog2 (setq wd (mkdf!> lst x wm)) (cond (wd (setq wb (cons (cons wd (cdar (mkdx!> (get x '!=cord)))) wb)))))) (return(reversip wb)))) )) (de mkdf!> (lst id wm) (evalalg!> (cond (wm (bfun!> (getel1!> !#!e (get id '!=cord)) lst)) (t (list3 'df lst id))))) (de bfun!> (wb lst) (cond((null lst) nil) (t(proc (w wn wc) (while!> wb (setq wn (cadar wb)) (setq wc -1) (while!> (not(eqn wn 1)) (setq wn (quotient wn 2)) (setq wc (add1 wc)) ) (setq w(cons(list 'times (caar wb) (list 'df lst (getel1!> ![cord!] wc))) w)) (setq wb(cdr wb))) (return(cond((null w) nil) ((null(cdr w)) (car w)) (t(cons 'plus w)))))))) %---------- Vectors processor. 08.01.91 --------------------------------- % Vec _| 1-form ... (de vform1!> (wv wf) (cond((or (null wv)(null wf)) nil) (t(proc (w wa) (setq wa wf) (while!> wv (setq wf wa)(setq wa nil) (while!> wf (cond((eqn(cadar wf)(cadar wv)) (setq w(cons(list 'times(caar wf)(caar wv))w))) (t(setq wa(cons(car wf)wa)))) (setq wf(cdr wf))) (setq wv(cdr wv))) (return(cond((null w) nil) ((null(cdr w)) (car w)) (t(cons 'plus w)))))))) % Vec | Alg ... (de vfun!> (wv wf) (cond ((or (null wv) (null wf)) nil) (t (vfun1!> wv wf ![umod!])))) %(de vfun0!> (wv wf) % (cond((or(null wv)(null wf)) nil) % (t(vfun1!> wv wf nil)))) (de vfun1!> (wv wf wm) (proc (wb wa x cord) (setq cord ![cord!]) (while!> (and cord wv) (setq x (car cord)) (setq cord (cdr cord)) (cond ((eqn (expt 2 (add1(get x '!=cord))) (cadar wv)) (progn (setq wa (mkdf!> wf x wm)) (cond(wa (setq wb (cons (list 'times (caar wv) wa) wb)))) (setq wv (cdr wv)) )))) (return (cond ((null wb) nil) ((null (cdr wb)) (car wb)) (t (cons 'plus wb))) ))) % Vecr _| n-form for n>1 ... (de vform!> (wv wf) (cond((or(null wv)(null wf)) nil) (t(proc(w wl wa wb wc wss) (while!> wv (setq wl wf) (while!> wl (setq wa(cddar wv)) (setq wb(cddar wl)) (setq wc nil) (while!> (and wa wb) (exitif (and(caar wa)(caar wb))) (setq wc(cons(car wb)wc)) (setq wa(cdr wa)) (setq wb(cdr wb))) (cond((and wa wb) (progn (setq wss(cdar wb)) (setq wc(cons(cons nil(cdar wb))wc)) (setq wb(cdr wb)) (while!> wb (setq wc(cons(cons(caar wb)(not(cdar wb)))wc)) (setq wb(cdr wb))) (setq w (cons(ncons(append(list (list 'times(caar wv) (cond(wss(caar wl)) (t(list 'minus(caar wl))))) (difference(cadar wl)(cadar wv)) ) (rever!> wc))) w)) ))) (setq wl(cdr wl))) (setq wv(cdr wv))) (return(cond(w(dfsum!> w)) (t nil))))))) (de rever!>(wc) (proc(w wss) (while!> wc (cond((and(null wss)(null(caar wc))) nil) (t(prog2(setq wss t)(setq w(cons(car wc)w))))) (setq wc(cdr wc))) (return w))) % [ vec1 , vec2 ] ... (de vbrack!> (w1 w2) (cond((and w1 w2) (dfsum!> (list2 (vcvc!> w1 w2 ![umod!]) (chsign!> t (vcvc!> w2 w1 ![umod!]))))) (t nil))) (de vcvc!> (w1 w2 wm) (proc (w wc ww wa) (while!> w2 (setq wc (vfun1!> w1 (caar w2) wm)) (cond (wc (setq w (cons (cons wc (cdar w2)) w)))) (cond (wm (cond ((setq wa (vcb!> w1 (sub1(log2!>(cadar w2))))) (setq ww (cons (fndfpr!> (caar w2) wa) ww)))))) (setq w2 (cdr w2))) (return (cond ((and wm ww) (dfsum!> (cons (reversip w) ww))) (t (reversip w)))))) (de vcb!> (w1 we) (cond ((null w1) nil) (t(proc (wa w) (setq we (getel1!> !#!e we)) (while!> w1 (setq wa (vcvc!> (getel1!> !#!e (sub1(log2!>(cadar w1)))) we nil)) (cond (wa (setq w (cons (fndfpr!> (caar w1) (nbvec!> wa)) w)))) (setq w1 (cdr w1))) (return (cond (w (dfsum!> w)) (t nil))))))) %---------- Complex conjugation. 25.12.90 -------------------------------- (de coexpr!> (wt w) % wt - type, 0 alg, n form, -1 vector (cond ((eqn wt 0) (coalg!> w)) ((eqn wt -1) (covec!> w)) (t (coform!> w)))) (de coexprx!> (wt w) (cond ((and (pairp w) (eq (car w) 'equal)) (equation!> (coexpr!> wt (cadr w)) (coexpr!> wt (caddr w)))) (t (coexpr!> wt w)))) % Conjugation of Alg ... (de coalg!> (w) (cond ((atom w) (cond ((or (eq w '!*sq) (eq w 'taylor!*)) (err!> 9999)) % *sq form !!! ((eq w 'i) '(minus i)) % i -> -i ((get w '!=conj) (get w '!=conj)) % x~ -> x, x -> x~ (t w))) % y -> y (t (mapcar w 'coalg!>)))) % Conjugation of Form ... (de coform!> (wf) (cofv!> wf ![ccb!])) % Conjugation of Vector ... (de covec!> (wf) (cofv!> wf ![ccbi!])) (de cofv!> (wf wb) (cond ((null wf) nil) (t(proc (w wa wp wx wn) (while!> wf (setq wa (coalg!>(caar wf))) (setq wx (cddar wf)) % wx = d x/\d y ... (setq wp nil) (setq wn -1) (while!> wx (setq wn (add1 wn)) (cond((caar wx) (setq wp (cons (cond (![umod!] (getel1!> wb wn)) (t (mkdx!> (get (coalg!>(getel1!> ![cord!] wn)) '!=cord)))) wp)))) (setq wx (cdr wx))) (setq wp (dfprod!>(reversip wp))) % wp = (d x/\d y ...)~ (setq w (cons (fndfpr!> wa wp) w)) (setq wf (cdr wf))) (return(evalform!>(dfsum!> w))))))) %---------- Vector Product 09.96 ------------------------------------------- % vec.vec Need !#G !#T (de vprod!> (wa wb) (prog (w wx wy) (fordim!> m do (progn (setq wx (vform1!> wa (getframe!> m))) (setq wy (vform1!> wb (getlo!> !#!T m))) (cond ((and wx wy) (setq w (cons (list 'times wx wy) w)))))) (return (cond (w (cons 'plus w)) (t nil))))) % frm1.frm1 Need !#D !#GI (de fprod!> (wa wb) (prog (w wx wy) (fordim!> m do (progn (setq wx (vform1!> (getiframe!> m) wa)) (setq wy (vform1!> (getup!> !#!D m) wb)) (cond ((and wx wy) (setq w (cons (list 'times wx wy) w)))))) (return (cond (w (cons 'plus w)) (t nil))))) %---------- Dualisation 05.96 ---------------------------------------------- % Dualisation #(alg) -> dim-form ... % Use: !#VOL (de dual0!> (w) (cond ((null w) nil) (t (fndfpr!> w (car !#!V!O!L))))) % Dualisation #(dim-form) -> alg ... % Use: !#VOL (de duald!> (w) (cond ((null w) nil) (t (list 'times (invsvol!>) (caar w))))) % version for spinorial regime only = - i # (de dualdi!> (w) (cond ((null w) nil) (t (list 'times (invsvoli!>) (caar w))))) (de invsvol!> nil (cond ((null(car !#!V!O!L)) 0) (t (list 'quotient ![sigprod!] (caaar !#!V!O!L))))) (de invsvoli!> nil (cond ((null(car !#!V!O!L)) 0) (t (list 'quotient 'i (caaar !#!V!O!L))))) % Defines P of the P-form ... (de pformq!> (w) (proc (wp) (cond ((null w) (return 0))) (setq wp 0) (setq w (cddar w)) (while!> w (cond ((caar w) (setq wp (add1 wp)))) (setq w (cdr w))) (return wp))) % Dualisation #(p-form) -> (dim-p)-form ... % Use: !#sdetG !#G !#T !#VOL (de dual!> (w) (cond ((null w) nil) (t(proc (wp wdp wr wl wf wc) (setq wp (pformq!> w)) % We are dualizing p-form=wp (cond ((eqn wp ![dim!]) (return (duald!> w)))) (setq wdp (difference ![dim!] wp)) % to (dim-p)-form (setq ![tlow!] % List of T_a (lower index a) (foreach!> x in (dimlist!> 0) collect (getlo!> !#!T x))) (setq wl (mklambda!> wdp ![dim!])) % All T_a/\... (dim-p)-forms (setq wf (invsvol!>)) % The coefficient (while!> wl (setq wc (dfprod2!> (cdar wl) w)) (cond (wc (setq wr (cons (fndfpr!> (list 'times wf (caar wc)) (tprod!> (caar wl))) wr)))) (setq wl (cdr wl))) (return (dfsum!> wr)) )))) (de mklambda!> (wp wd) (proc (wr ww wc wn wi wa) (setq wr (mklist!> (sub1 wp) (sub1 wd))) (setq wr (mapcar wr 'lform1!>)) (setq wi (sub1 wp)) (while!> (greaterp wi 0) (setq ww nil) (while!> wr (setq wc (car wr)) (setq wn (mklist!> (sub1 wi) (sub1(caar wc)))) (while!> wn (setq wa (car wn)) (setq ww (cons (cons (cons wa (car wc)) (dfprod2!> (getel1!> ![tlow!] wa) (cdr wc))) ww)) (setq wn (cdr wn))) (setq wr (cdr wr))) (setq wr (reversip ww)) (setq wi (sub1 wi))) (return wr))) (de lform1!> (w) (cons (ncons w) (getel1!> ![tlow!] w))) (de tprod!> (w) (cond ((null(cdr w)) (getframe!> (car w))) (t (dfprod2!> (getframe!> (car w)) (tprod!> (cdr w)))))) (de mklist!> (wa wb) (cond ((greaterp wa wb) nil) (t (cons wa (mklist!> (add1 wa) wb))))) %---------- Limits --------------------------------------------------------- % Limits 6.03.94 ... %(de lima!> (wx wl wt lst) % (cond((null lst) nil) % ((eq wt 'p) (list 'limit!+ lst wx wl)) % ((eq wt 'm) (list 'limit!- lst wx wl)) % (t (list 'limit lst wx wl)))) % %(de limf!> (wx wl wt lst) % (cond((null lst) nil) % (t(proc (wr) % (while!> lst % (setq wr (cons (cons (lima!> wx wl wt (caar lst)) % (cdar lst)) wr)) % (setq lst (cdr lst))) % (return(reversip wr)))))) %---------- SUBstitutions 7.03.94 ----------------------------------------- (de subalg!> (wl lst) (cond((null lst) nil) (t(cons 'sub (append wl (ncons lst)))))) (de subdf!> (wl lst) (cond((null lst) nil) (t(proc (wr) (while!> lst (setq wr (cons (cons (subalg!> wl(caar lst)) (cdar lst)) wr)) (setq lst (cdr lst))) (return(reversip wr)))))) %-------- Anholonomic Mode 04.03.91, 05.96 -------------------------------- % Anholonomic/Holonomic command ... (de turnbg!> (wm) (prog2 (setq wm (errorset!> (list 'turnbg0!> wm) ![erst1!] ![erst2!])) (cond ((atom wm) (erm!> wm) (erm!> 8803) (msg!> 88033) !!er!!) (t (car wm))) )) (de turnbg0!> (wm) (proc (w) (cond((eq wm ![umod!]) (progn % current mode ? (prin2 "Current Basis is ") (cond(![umod!](prin2 "an"))) (prin2 "holonomic already.")(terpri) (return t)))) (setq ![chain!] nil) (setq w (request!> '!#!b)) % basis ? (cond((eq w !!er!!) (return w)) ((null w) (trsf!> '!#!b)(setq ![er!] 6046)(return !!er!!))) (setq ![chain!] nil) (setq w (request!> '!#!e)) % inverse basis ? (cond((eq w !!er!!) (return w)) ((null w) (trsf!> '!#!b)(setq ![er!] 6046)(return !!er!!))) (setq w (evalform!>(dfprod!> !#!b))) % singular basis ? (cond ((null w) (prog2 (setq ![er!] 8400) (return !!er!!)))) (setq w (evalform!>(dfprod!> !#!e))) % singilar inverse basis ? (cond ((null w) (prog2 (setq ![er!] 8401) (return !!er!!)))) (cond (wm (mktables!>)) (t (prog2 (setq ![xf!] !#!b) % b = d x (setq ![xv!] !#!e)))) % e = @ x (setq ![xb!] nil) (setq w (altdata!>(alldata!>))) (while!> w % converting all data to new basis ... (cond ((or (memq (car w) '( ![cord!] ![const!] ![fun!] ![apar!] !#!b !#!e)) (zerop (gettype!> (car w)))) nil) (t (set (car w) (allcoll!> (eval(car w)) (car w) nil (cond((get (car w) '!=idxl)(get (car w) '!=idxl)) (t '(0))) (function nbel!>))) )) (setq w (cdr w))) (setq ![umod!] wm) (cond ((null wm) (progn (setq ![ccb!] nil) (setq ![ccbi!] nil) (setq ![xv!] nil) (setq ![xf!] nil)))) (ftype!>) (fitype!>) (done!>) (return t))) % New basis for element ... (de nbel!> (lst wi wn) (cond ((null lst) nil) ((and (eqn (gettype!> wn) -1) (not (flagp wn '!+equ))) % vec (nbvec!> lst)) ((not (flagp wn '!+equ)) % form (nbform!> lst)) ((eqn (gettype!> wn) -1) % eq vec (equation!> (nbvec!>(cadr lst)) (nbvec!>(caddr lst)))) (t % eq form (equation!> (nbform!>(cadr lst)) (nbform!>(caddr lst)))) )) % New basis for form ... (de nbform!> (w) (cond ((null w) w) (t (evalform!> (dfsum!> (mapcar w (function nbform1!>))))))) (de nbform1!> (w) (fndfpr!> (car w) (nbxb!> (cdr w)))) % New basis for d X/\d Y/\... (de nbxb!> (w) (cond ((assoc (car w) ![xb!]) (cadr (assoc (car w) ![xb!]))) (t (progn (setq ![xb!] (cons (list2 (car w) (evalform!> (mkbxb!>(cdr w) ))) ![xb!])) (cadar ![xb!]))))) (de mkbxb!> (w) (proc (wa wn) (setq wn 0) (while!> w (cond ((caar w) (setq wa (cons (getel1!> ![xf!] wn) wa)))) (setq wn (add1 wn)) (setq w (cdr w))) (return (evalform!> (dfprod!>(reverse wa)))))) (de mktables!> nil (prog (w) (setq ![xf!] (mkt!> 1)) (setq w (aeval (list 'quotient 1 (mkmtetr!> !#!b)))) (mktetrm!> (cdr w) ![xf!]) % d x = b (setq ![xv!] (mkt!> 1)) (setq w (aeval (list 'tp (mkmtetr!> !#!b)))) (mktetrm!> (cdr w) ![xv!]) % @ x = e (setq ![ccb!] % ~ b (mapcar (mapcar !#!b 'coform!>) (function nbform!>))) (setq ![ccbi!] % ~ e (mapcar (mapcar !#!e 'coform!>) (function nbvec!>))) )) % New basis for vector ... (de nbvec!> (w) (cond ((null w) w) (t (evalform!> (dfsum!> (mapcar w (function nbvec1!>))))))) (de nbvec1!> (w) (fndfpr!> (car w) (nbxv!> (cadr w)))) (de nbxv!> (w) (proc (wc) (setq wc -1) (while!> (not (eqn w 1)) (setq w (quotient w 2)) (setq wc (add1 wc)) ) (return (getel1!> ![xv!] wc)) )) %========= End of GRGproc.sl ==============================================% |
Added grgtrans.sl version [2a2cc1f553].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 | %==========================================================================% % GRGtrans.sl Formula Translator % %==========================================================================% % 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. % %==========================================================================% %---------- General GRG Translator --------------------------------------- % Translation with (ERROR ...) interruption ... (de translate1!> (lst) (cond (lst (unievaluate!> (unitra!> lst))) (t nil))) % Translation with !!ER!! return ... (de translate!> (lst) (prog nil (cond((null lst)(return nil))) (setq ![lsrs!] nil) (setq lst (errorset!> (list2 'unitra!> (list2 'quote lst)) ![erst1!] ![erst2!])) (cond((atom lst)(prog2(setq ![er!] lst)(return !!er!!)))) (setq lst (errorset!> (list2 'unievaluate!> (list 'quote(car lst))) ![erst1!] ![erst2!])) (cond((atom lst)(prog2(setq ![er!] lst)(return !!er!!)))) (return(car lst)) )) % Translate for equations with !!ER!! return ... (de translateeq!> (lst) (prog nil (cond((null lst)(return nil))) (setq ![lsrs!] nil) (setq lst (errorset!> (list2 'unitraeq!> (list2 'quote lst)) ![erst1!] ![erst2!])) (cond((atom lst)(prog2(setq ![er!] lst)(return !!er!!)))) (setq lst (errorset!> (list2 'unievaluateeq!> (list 'quote(car lst))) ![erst1!] ![erst2!])) (cond((atom lst)(prog2(setq ![er!] lst)(return !!er!!)))) (return(car lst)) )) % Pre-Translation with !!ER!! return ... (de pretrans!> (lst) (prog nil (cond ((null lst) (return nil))) (setq ![lsrs!] nil) (setq lst (errorset!> (list2 'unitra!> (list2 'quote lst)) ![erst1!] ![erst2!])) (cond((atom lst)(prog2(setq ![er!] lst)(return !!er!!)))) (return(car lst)) )) % Pre-Translation for equations with !!ER!! return ... (de pretranseq!> (lst) (prog nil (cond((null lst)(return nil))) (setq ![lsrs!] nil) (setq lst (errorset!> (list2 'unitraeq!> (list2 'quote lst)) ![erst1!] ![erst2!])) (cond((atom lst)(prog2(setq ![er!] lst)(return !!er!!)))) (return(car lst)) )) % Pre-Translation with !!ER!! return with external vars ... (de pretransext!> (lst) (prog nil (cond ((null lst) (return nil))) (setq ![lsrs!] nil) (setq lst (errorset!> (list2 'unitraext!> (list2 'quote lst)) ![erst1!] ![erst2!])) (cond((atom lst)(prog2(setq ![er!] lst)(return !!er!!)))) (return(car lst)) )) % Final translation with !!ER!! return ... (de fintrans!> (lst) (prog nil (setq lst (errorset!> (list2 'unievaluate!> (list 'quote lst)) ![erst1!] ![erst2!])) (cond((atom lst)(prog2(setq ![er!] lst)(return !!er!!)))) (return(car lst)) )) % Evaluation with simplification ... (de unievaluate!> (lst) (prog2 (setq lst(unieval!> lst)) (cond((null lst) lst) ((zerop(car lst))(cona!> 0 (cdr lst))) (t(conf!>(car lst)(cdr lst)))))) % Evaluation with simplification for equations ... (de unievaluateeq!> (lst) (prog (wl wr) (setq wl (unievaluate!>(car lst))) (setq wr (unievaluate!>(cdr lst))) (cond((and(null wl)(null wr)) (return nil)) ((and wl wr (not(eqn(car wl)(car wr))))(err!> 2209))) (return (cond((and wl wr)(cons(car wl)(list 'equal (cdr wl) (cdr wr)))) (wl (cons(car wl)(list 'equal (cdr wl) nil))) (wr (cons(car wr)(list 'equal nil (cdr wr)))) )))) % Evaluation ... (de unieval!> (lst) (cond((atom lst) lst) ((or(numberp(car lst))(pairp(car lst))(null(car lst))) lst) ((flagp (car lst) '!+specexec) (apply (car lst) (cdr lst))) (t(apply (car lst) (mapcar (cdr lst) (function unieval!>)))))) % Final value predicate ... (de concrp!> (w) (cond((or(null w)(numberp(car w))) t) (t nil))) % Final valies list predicate ... (de concrpl!> (lst) (cond((null lst) t) ((or(null(car lst))(numberp(caar lst))) (concrpl!>(cdr lst))) (t nil))) % Pre-Translation with ERR interrupt ... (de unitra!> (lst) (einstsum!> (unitra0!>(expandsym!> lst)) ![extvar!])) % Pre-Translation with ERR and external variables ... (de unitraext!> (lst) (cond (![extvar!] (unitra!> lst)) (t (prog (w we) (setq w (einstsum!> (unitra0!>(expandsym!> lst)) nil)) (setq we (freevar!> w nil)) (setq ![extvara!] (reverse we)) (return w))))) % Pre-Translation with ERR interrupt for equations ... (de unitraeq!> (lst) (cond((or (null(setq lst (seek1!> lst '!=))) (null(cdr lst)) (null(car lst)) ) (err!> 2208)) (t(cons(unitra!>(reverse(car lst)))(unitra!>(cdr lst)))))) %---------- Einstein Summation ------------------------------------------- % This is main function ... (de einstsum!> (lst we) (cond((atom lst) lst) ((numberp(car lst)) lst) ((null(freevar!> lst we)) lst) % no any free variables % Spacial treatment for Sum and Prod since summation % variables should not be treated as free variables ... ((memq (car lst) '(sumexec!> prodexec!>)) (list3(car lst)(cadr lst)(einstsum!>(caddr lst) (consmem!>(caaadr lst)we)))) % Product of two expressions A*B. We make summation if % there is the same free variables in both A and B ... ((flagp(car lst) '!+multop2)(prog (w1 w2 w) (setq w1 (freevar!> (cadr lst) we)) (setq w2 (freevar!> (caddr lst) we)) (setq w (intersecl!> w1 w2)) (cond((and(null w1)(null w2))(return lst)) % no any free vars ((null w)(return(list3 % empty intersection => no summation (car lst) (einstsum!>(cadr lst)we) (einstsum!>(caddr lst)we)))) (t(return(mkeinsum!> w lst we)))))) % make new sum % This is function f(A). We make summation if only % some free variable appear in A at least twice ... ((eq(car lst) 'funapply!>)(prog (w) (setq w (freevar1!> (caddr lst) we)) (setq w (errsingl!> w nil)) (cond ((null w) (return lst)) (t (return(mkeinsum0!> w lst)))))) % This is sum of terms. Just apply EINSTSUM> to each % term independently ... ((eq(car lst) 'plus!>) (list2 (car lst) (einstsum1!> (cadr lst) we))) % Others ... (t(cons (car lst) (einstsum1!> (cdr lst) we))))) % Just apply EINSTSUM> to the each element of list ... (de einstsum1!> (lst we) (cond((null lst) nil) (t(cons (einstsum!> (car lst) we) (einstsum1!> (cdr lst) we))))) % Make Summation for Function ... (de mkeinsum0!> (w lst) (cond((null(cdr w)) (list3 'sumexec!> (ncons w) lst)) (t(list3 'sumexec!> (ncons(ncons(car w))) (mkeinsum0!> (cdr w) lst))))) % Make Summation for product ... (de mkeinsum!> (w lst we) (cond((null(cdr w)) (list3 'sumexec!> (ncons w) (list3 (car lst) (einstsum!>(cadr lst)(consmem!>(car w)we)) (einstsum!>(caddr lst)(consmem!>(car w)we))))) (t(list3 'sumexec!> (ncons(ncons(car w))) (mkeinsum!> (cdr w) lst (consmem!> (car w) we)))))) % Collects all DUMMYVAR!> variables in expr LST ... % WE - list of vars already excluded from consideration % Takes into account special forms like Sum, Prod ... (de freevar!> (lst we) (cond((atom lst) nil) ((numberp(car lst)) nil) ((eq(car lst) 'dummyvar!>) (cond((not(memq(cadr lst)we))(cdr lst)))) ((memq (car lst) '(sumexec!> prodexec!>)) (freevar!> (caddr lst) (consmem!>(caaadr lst)we))) (t(appmem!>(freevar!> (car lst) we) (freevar!> (cdr lst) we))))) % Like FREEVAR> but repeated vars can be collected twice ... (de freevar1!> (lst we) (cond((atom lst) nil) ((numberp(car lst)) nil) ((eq(car lst) 'dummyvar!>) (cond((not(memq(cadr lst)we))(cdr lst)))) ((memq (car lst) '(sumexec!> prodexec!>)) (freevar1!> (caddr lst) (consmem!>(caaadr lst)we))) (t(append(freevar1!> (car lst) we) (freevar1!> (cdr lst) we))))) % Produces Error if some var in the list present only once ... %(de errsingl!> (w wr) % (cond ((null w) wr) % ((memq (car w) wr) (errsingl!> (cdr w) wr)) % ((memq (car w) (cdr w)) (errsingl!> (cdr w) (cons (car w) wr))) % (t (prog2 (doub!>(car w)) (err!> 2018))))) % This version just removes single var from the list ... (de errsingl!> (w wr) (cond ((null w) wr) ((memq (car w) wr) (errsingl!> (cdr w) wr)) ((memq (car w) (cdr w)) (errsingl!> (cdr w) (cons (car w) wr))) (t (errsingl!> (cdr w) wr)))) % Intersections of two lists ... (de intersecl!> (w1 w2) (cond((or(null w1)(null w2)) nil) (t(proc (w) (while!> w1 (cond((memq (car w1) w2)(setq w(cons(car w1)w)))) (setq w1(cdr w1))) (return w))))) %------- Main Operations Translation ------------------------------------- % Main sum/difference translation with [,] ... (de unitra0!> (lst) (cond ((atom lst) (atomtr!> lst)) % atom ((and(pairp lst)(null(cdr lst)))(unitra0!>(car lst))) % next level (t(proc (w) (cond((memq '![ lst)(setq lst(vbrctr!> lst)))) % [ , ] ? (cond((not(memq(car lst) '(!+ !-))) % + - translation (setq lst(cons '!+ lst)))) (setq w(mems!> '(!+ !-) (reverse lst) nil)) (cond((eq w !!er!!) (err!> 2017))) (setq w(listra!>(reversip w))) (return(cond((null(cdr w))(car w)) ((concrpl!> w) (plus!> w)) (t(list2 'plus!> w)))))))) % List of Expressions translation with ~~ treatment ... (de listra!> (lst) (proc (w) (while!> lst (cond ((eq(caaar lst) '!~!~) (cond((null w) (err!> 2110)) ((eq(cdar lst) '!+) (setq w(cons(list2 're2!>(car w))(cdr w)))) (t(setq w(cons(list2 'im2i!>(car w))(cdr w)))))) ((eq(cdar lst) '!+)(setq w(cons(termtr!>(caar lst))w))) (t(setq w(cons(list2 'minus!> (termtr!>(caar lst)))w)))) (setq lst(cdr lst))) (return w))) % Atom translation ... (de atomtr!> (w) (cond ((zerop w) nil) % zero ((stringp w)(prog2(doubs!> w) (err!> 2019))) ((or(numberp w)(flagp w '!+grgvar))(cons 0 w))% number or variable ((get w '!=subind) (prog2 % tensorial index (setq w (get w '!=subind)) (cond((zerop w) nil) (t(cons 0 w))))) (t(prog (wn wi wd wss wb) % data component (setq wss w) (setq w (explode2 w)) (setq wb (selid!> w nil)) % w - id wb - indices (setq wn (incomiv!> w)) (cond ((flagp wn '!+macros3) % it is macro 3 scalar (cond (wb (doub!> wss) (err!> 2018)) (t (require!> (get wn '!=ndl)) (return (getsac!> wn nil))))) ((flagp wn '!+macros2) % it is macro 2 component (cond ((null wb) (doub!> wss) (err!> 2018)) (t (return (funtr!> (list (incom!> w) (addcomm!> wb wss)) nil))))) ((not(flagp wn '!+ivar)) % it is not an object (cond ((eq wss '!~!~) (err!> 2110)) (t (return(list2 'dummyvar!> wss)))))) (cond((and(null wb)(get wn '!=idxl)) (return(list2 'dummyvar!> wss)))) (setq wi(mapcar wb 'digorerr!>)) % indixes list (cond((memq !!er!! wi) (return(list2 'dummyvar!> wss)))) (cond((eq(goodidxl!> wi (get wn '!=idxl)) !!er!!) (return(list2 'dummyvar!> wss)))) (require1!> wn) (cond((and ![umod!] (memq wn '(!#!b !#!e))) (return(cons (cond((eq wn '!#!b) 1)(t -1)) (mkdx!> (car wi)))))) (return(getsac!> wn wi)) % extracting value )))) (de addcomm!> (w wss) (cond ((null (cdr w)) (ncons(addcomm1!> (car w) wss))) (t (cons (addcomm1!> (car w) wss) (cons '!, (addcomm!> (cdr w) wss)))))) (de addcomm1!> (w wss) (cond ((digit w) (compress(ncons w))) (t (doub!> wss) (err!> 2018)))) % * | /\ _| translation ... (de termtr!> (lst) (prog (w wss wo) (cond((null lst) (err!> 2016))) (setq w(seek!> lst '( !* !/!\ !_!| !| !. ))) (cond((null w) (return(quotr!> lst)))) (setq wo (get (cadr w) '!=op2)) (setq wss (termtr1!> (cddr w))) (setq w (quotr!>(reverse (car w)))) (return (cond((and(concrp!> w)(concrp!> wss)) (apply wo (list2 w wss))) (t (list wo w wss)))))) (de termtr1!> (lst) (prog (wa wb wo) (cond((null lst) (err!> 2016))) (setq wa(seek!> lst '( !* !/!\ !_!| !| !. ))) (cond((null wa) (return(quotr!> lst)))) (setq wo (get (cadr wa) '!=op2)) (setq wb (termtr1!> (cddr wa))) (setq wa (quotr!>(reverse(car wa)))) (return (cond((and(concrp!> wa)(concrp!> wb)) (apply wo (list2 wa wb))) (t (list wo wa wb)))))) % / translation ... (de quotr!> (lst) (cond((null lst) (err!> 2016)) ((not(memq '!/ lst))(exptr!> lst)) (t(prog (w) (setq w(memlist!> '!/ lst)) (cond((eq w !!er!!) (err!> 2016))) (setq w (mapcar w 'exptr!>)) (return(quotmk!>(car w)(cdr w))))))) (de quotmk!> (lst1 lst2) (cond((null lst2) lst1) ((and(concrp!> lst1)(concrp!>(car lst2))) (quotmk!> (quoti!> lst1 (car lst2)) (cdr lst2))) (t(quotmk!> (list 'quoti!> lst1 (car lst2)) (cdr lst2))))) % ** or ^ translation ... (de exptr!> (lst) (prog (w wb) (cond((null lst) (err!> 2016))) (setq w(seek!> lst '(!*!* !^) )) (cond((null w)(return(kertr!> lst)))) (setq wb (exptr!> (cddr w))) (setq w (kertr!>(reverse(car w)))) (return (cond((and(concrp!> w)(concrp!> wb)) (exp!> w wb)) (t(list 'exp!> w wb)))))) % d # ~ translation ... (de kertr!> (lst) (cond((null lst) (err!> 2015)) ((pairp(car lst))(cond((cdr lst) (err!> 2014)) (t(unitra0!>(car lst))))) ((not(cdr lst)) (atomtr!>(car lst))) ((get(car lst) '!=sysfun) (prog (w) (setq w (get (car lst) '!=sysfun)) (setq lst (kertr!> (cdr lst))) (return (cond((concrp!> lst) (apply w (ncons lst))) (t (list2 w lst)))))) (t(funtr!> lst t)))) % [ , ] translation (de vbrctr!> (lst) (prog (wa wd w) (setq lst(seek1!> lst '![ )) (cond((null(cdr lst)) (err!> 2001))) (setq wa(car lst)) (setq lst(cdr lst)) (setq lst(seek1!> lst '!] )) (cond((or(null lst)(null(car lst))) (err!> 2001))) (setq wd(cdr lst)) (setq lst(car lst)) (setq w(seek1!> lst '!, )) (cond((or(null w)(null(car w))(null(cdr w))(memq '!, (cdr w))) (err!> 2001))) (return(app!> wa (cons 'vbrc!> (cons(reverse lst) wd)))))) % Function translation ... (de funtr!> (lst bool) % bool=t - einstein summation rule is allowed (cond((or(null lst)(atom lst)(not(eqn(length lst)2)) (not(idp(car lst)))) (err!> 2021)) ((atom(cadr lst))(err!> 2021)) ((get (car lst) '!=spectr) % Sum Prod LHS RHS SUB Lim ... (apply (get (car lst) '!=spectr) (cdr lst))) (t(prog (w wt wm wx) (cond((not(or (eq(car lst) 'vbrc!>) (flagp (car lst) '!+fun) (redgood!> (car lst)) (setq wt(get(car lst) '!=macros)) (gettype!> (setq wt (incomiv!>(explode(car lst)))) ))) (prog2(doub!>(car lst)) (err!> 2022)))) (setq w(cond(wt wt)(t (car lst)))) % wt=t - internal variable (setq lst(cadr lst)) % parameters list (setq lst(memlist!> '!, lst)) (cond((eq lst !!er!!) (err!> 2020))) (cond((and wt (get wt '!=idxl))(prog2 % if internal var => (setq wm (mapcar lst 'selmani!>)) % indices manipul. (cond((setq wx(orl!> wm)) (setq lst (mapcar lst 'delmani!>))))))) (setq lst (mapcar lst (function unitra0!>))) (return(cond((concrpl!> lst) (funapply!> w lst wm)) (t(list 'funapply!> w lst wm)))))))) %---------- Indices Manipulations ---------------------------------------- % Selects indices manipulation prefixes ... (de selmani!> (w) (cond ((eq (setq w (car w)) '!') 1) ((eq w '!.) 2) ((eq w '!^) 3) ((eq w '!_) 4) (t nil))) % Delets iddices manipulation prefixes from expression ... (de delmani!> (w) (cond ((flagp (car w) '!+indexman) (cond ((null(cdr w)) (err!> 2020)) (t (cdr w)))) (t w))) % Indices manipulations translation ... (de manitr!> (wf wm) % wf - int.var., wm - manip. types list (cond ((null(orl!> wm)) nil) ((null(orl!>(setq wm (manitr1!> wm (get wf '!=idxl))))) nil) (t wm))) % Manipulation for one index. Prepares action ... (de manitr1!> (wm wi) % wm - manip.types list, wi - idxl (cond ((null wm) nil) (t (cons (manitr2!> (car wm) (car wi)) (manitr1!> (cdr wm) (cdr wi)) )))) (de manitr2!> (wm wi) (cond ((null wm) nil) ((enump!> wi) nil) ((eqn wm 1) % ' cvalificator - up (cond ((and (spinp!> wi) (not(upperp!> wi))) (require!> '(!#!G)) (ncons(cdr wi))) % .s -> 's ((holpd!> wi) % .g -> 't (require!> '(!#!G!I !#!D)) 9) ((tetrpd!> wi) % .t -> 't (require!> '(!#!G!I)) 1) ((holpu!> wi) % 'g -> 't (require!> '(!#!T)) 5) (t nil))) ((eqn wm 2) % . cvalificator - down (cond ((and (spinp!> wi) (upperp!> wi)) (require!> '(!#!G)) (ncons(minus(cdr wi)))) % 's -> .s ((holpu!> wi) % 'g -> .t (require!> '(!#!G !#!T)) 10) ((tetrpu!> wi) % 't -> .t (require!> '(!#!G)) 2) ((holpd!> wi) % .g -> .t (require!> '(!#!D)) 6) (t nil))) ((eqn wm 3) % ^ cvalificator - g up (cond ((spinp!> wi) (err!> 9913)) ((holpd!> wi) % .g -> 'g (require!> '(!#!G!I !#!D)) 3) ((tetrpd!> wi) % .t -> 'g (require!> '(!#!G!I !#!D)) 11) ((tetrpu!> wi) % 't -> 'g (require!> '(!#!D)) 7) (t nil))) ((eqn wm 4) % _ cvalificator - g down (cond ((spinp!> wi) (err!> 9913)) ((holpu!> wi) % 'g -> .g (require!> '(!#!G !#!T)) 4) ((tetrpu!> wi) % 't -> .g (require!> '(!#!G !#!T)) 12) ((tetrpd!> wi) % .t -> .g (require!> '(!#!T)) 8) (t nil))) )) % Qualified GET data component with ind. manipulations ... (de getmc!> (w wi wa wm) (cond ((zerop(gettype!> w)) (cona1!> 0 (getm!> w wi wa wm))) (t (conf1!> (gettype!> w) (getm!> w wi wa wm))))) % GET dat component with ind. manipulation ... (de getm!> (w wi wa wm) % w - int.var. wa - ind.list wm - manipul. (cond ((null wa) (getsa!> w (reverse wi))) (t (proc (wc wg wl we wr wo wx) (setq wl wa) (setq wo wi) (while!> wm (cond((null(car wm)) (setq wi(cons(car wl)wi))) ((singlmanp!>(car wm)) (prog2 % the `diagonal' manipulation (setq wi (cons (rasin!> (car wl) (car wm)) wi)) (setq wc (cons (rasco!> (car wl) (car wm)) wc)) )) (t(progn (setq we t) (setq wx t) (setq wr (getm1!> w wi wl wm)) ))) (exitif wx) (setq wl (cdr wl)) (setq wm (cdr wm)) ) (cond((null wc)(return(cond(we wr) (t(getsa!> w(cond (wo(append(reverse wo)wa)) (t wa))))))) ((null(setq wc(mktimes!> wc))) (return nil)) ((zerop(gettype!> w)) (return (mktimes!>(list wc (cond(we wr) (t(getsa!> w(reverse wi)))))))) (t(return (fndfpr!> wc (cond(we wr) (t(getsa!> w(reverse wi)))))))) )))) (de getm1!> (w wi wa wm) (proc (wc wr wt) (fordim!> m do (prog2 (setq wc (rasco2!> (car wa) m (car wm))) (cond(wc(prog2 (setq wt(getm!> w (cons m wi) (cdr wa) (cdr wm))) (cond(wt (setq wr (cons (cond((zerop(gettype!> w)) (mktimes!>(list2 wc wt))) (t(fndfpr!> wc wt))) wr))))))))) (cond(wr (cond((zerop(gettype!> w))(return(cons 'plus wr))) (t(return(dfsum!> wr)))))))) % `Diagonal' manipulation predicate. So in this case we % do not need make a sum for rasing or lowering of the index ... (de singlmanp!> (wt) % wt - manipulation type (cond ((pairp wt) t) % spinorial ((eqn wt 1) (imotop!>)) % m^ab .t -> 't GI ((eqn wt 2) (motop!>)) % m_ab 't -> .t G ((eqn wt 3) (and (imotop!>) (ifdiagp!>))) % g^ab .g -> 'g GI D ((eqn wt 4) (and (motop!>) (fdiagp!>))) % g_ab 'g -> .g G T ((eqn wt 5) (fdiagp!>)) % h^a_m 'g -> 't T ((eqn wt 6) (ifdiagp!>)) % h_a^m .g -> .t D ((eqn wt 7) (ifdiagp!>)) % h^m_a 't -> 'g D ((eqn wt 8) (fdiagp!>)) % h_m^a .t -> .g T ((eqn wt 9) (and (imotop!>) (ifdiagp!>))) % h^am .g -> 't GI D ((eqn wt 10) (and (motop!>) (fdiagp!>))) % h_am 'g -> .t G T ((eqn wt 11) (and (imotop!>) (ifdiagp!>))) % h^ma .t -> 'g GI D ((eqn wt 12) (and (motop!>) (fdiagp!>))) % h_ma 't -> .g G T (t nil))) % Index one-to-one map for `diagonl' manipulation ... (de rasin!> (w wt) % w - index, wt - manipulation type (cond ((pairp wt) (difference (abs!>(car wt)) w)) % spinorial ((and (imnullp!>) (member wt '(1 3 9 11))) % null inv metric (rasinst!> w)) ((and (mnullp!>) (member wt '(2 4 10 12))) % null metric (rasinst!> w)) (t w))) % any other % null indices ... (de rasinst!> (w) (cond ((eqn w 0) 1) ((eqn w 1) 0) ((eqn w 2) 3) ((eqn w 3) 2))) % Multiplier for `diagonal' manipulation ... (de rasco!> (w wt) % w - index, wt - manipulation type (cond ((pairp wt) % Spinorial (cond ((lessp (car wt) 0) (expt -1 w)) % 's -> .s (t (expt -1 (difference (car wt) w))))) % .s -> 's ((and (mnullp!>) (member wt '(2 4 10 12))) % Null Metric (cond ((eqn wt 2) (rascost!> w)) % m_ab 't -> .t ((eqn wt 4) (gmetr!> w (rasinst!> w))) % g_mn 'g -> .g ((eqn wt 10) (hlam!> w (rasinst!> w))) % h_am 'g -> .t ((eqn wt 12) (hlam!> (rasinst!> w) w)))) % h_ma 't -> .g ((and (imnullp!>) (member wt '(1 3 9 11))) % Null Inv Metric (cond ((eqn wt 1) (rascost!> w)) % m^ab .t -> 't ((eqn wt 3) (gimetr!> w (rasinst!> w))) % g^mn .g -> 'g ((eqn wt 9) (huam!> w (rasinst!> w))) % h^am .g -> 't ((eqn wt 11) (huam!> (rasinst!> w) w)))) % h^ma .t -> 'g (t (rasco2!> w w wt)))) % Any Other % Null metric ... (de rascost!> (w) (cond ((pmmm!>) (cond ((lessp w 2) 1) (t -1)) ) % +--- (t (cond ((lessp w 2) -1) (t 1)) ))) % -+++ % Gives the coefficient for non-daigonal index manipulation ... (de rasco2!> (wa wm wt) % wm - summation index (cond ((eqn wt 1) (getimetr!> wa wm)) % m^ab .t -> 't GI ((eqn wt 2) (getmetr!> wa wm)) % m_ab 't -> .t G ((eqn wt 3) (gimetr!> wa wm)) % g^ab .g -> 'g GI D ((eqn wt 4) (gmetr!> wa wm)) % g_ab 'g -> .g G T ((eqn wt 5) (ham!> wa wm)) % h^a_m 'g -> 't T ((eqn wt 6) (hiam!> wa wm)) % h_a^m .g -> .t D ((eqn wt 7) (hiam!> wm wa)) % h^m_a 't -> 'g D ((eqn wt 8) (ham!> wm wa)) % h_m^a .t -> .g T ((eqn wt 9) (huam!> wa wm)) % h^am .g -> 't GI D ((eqn wt 10) (hlam!> wa wm)) % h_am 'g -> .t G T ((eqn wt 11) (huam!> wm wa)) % h^ma .t -> 'g GI D ((eqn wt 12) (hlam!> wm wa)) % h_ma 't -> .g G T )) %---------- Cvalified simplification ------------------------------------- (de cona!> (w lst) (cond ((or(null lst)(null(setq lst(zn!>(eval!> lst)))))nil) (t(cons 0 lst)))) (de conf!> (w lst) (cond ((or(null lst)(null(setq lst(evalform!> lst))))nil) (t(cons w lst)))) (de cona1!> (w lst) (cond ((null lst) nil) (t (cons 0 lst)))) (de conf1!> (w lst) (cond ((null lst) nil) (t (cons w lst)))) %------- Evaluation Functions -------------------------------------------- % Function evaluator ... (de funapply!> (wf lst wm) % wf - function id or internal data var (prog (w wi wt) % lst - paramaters, wm - index manipulation (setq lst (mapcar lst (function unieval!>))) (cond((eq wf 'vbrc!>) (return(apply 'vbrc!> lst))) % [ , ] ((flagp wf '!+macros)(return(apply wf (ncons lst)))) % macro tensor ((setq wt (gettype!> wf)) (progn % data component % we need this data ... (cond ((flagp wf '!+macros2) (require!> (get wf '!=ndl))) (t (require1!> wf))) (setq wi (get wf '!=idxl)) % translating indices ... (setq lst (mapcar lst (function indextr!>))) (cond ((eq (goodidxl!> lst wi) !!er!!) (cond % index out of range ... ((eqn ![er!] 21022) (err!> ![er!])) ((eqn ![er!] 21023) (err!> ![er!])) % wrong number of indices ... (t (return(tryexp!> wf lst wm)))))) % special case: b e in basis mode ... (cond ((and ![umod!] (memq wf '(!#!b !#!e))) (return (cons (cond ((eq wf '!#!b) 1) (t -1)) (mkdx!> (car lst)))))) (cond ((setq wm (manitr!> wf wm)) % ind. manipul. (return (getmc!> wf nil lst wm))) (t (return (getsac!> wf lst)))) ))) % and this is really function ... (setq wt (mapcar lst 'auxfun2!>)) (cond ((memq !!er!! wt) (return(trydistr!> wf lst)))) (return (cons 0 (cons wf wt))))) (de auxfun2!> (w) (cond ((null w) 0) ((not(zerop(car w))) !!er!!) (t (cdr w)))) % Function can be applied distributively to form % or vector on one and only one argument ... (de trydistr!> (wf lst) (proc (wa wb w we wt wr) (while!> lst (setq w (car lst)) (cond ((null w) (setq w 0)) ((not(zerop(car w))) (go lab)) (t (setq w (cdr w)))) (setq wa (cons w wa)) (setq lst (cdr lst))) lab (setq wt (caar lst)) % type (setq we (cdar lst)) % form or vector expression (setq lst (cdr lst)) (setq wb (mapcar lst 'auxfun2!>)) (cond ((memq !!er!! wb) (err!> 2023))) (while!> we (setq wr (cons (cons (cons wf (app!> wa (cons (caar we) wb))) (cdar we)) wr)) (setq we (cdr we))) (return(cons wt (reversip wr))))) % Trying expand summed indices ... % wf - int.var., wl - list of indices, wm - list of manipulations (de tryexp!> (wf wl wm) (cond ((sp!>) (err!> ![er!])) (t (proc (wi wll wmm wm1 wl1 wd wss) (setq wi (get wf '!=idxl)) % idxl (cond ((null wm) (setq wm (mknlist!> nil (length wi))))) (while!> wi (cond ((null wl) (err!> ![er!])) % wrong number of indices % Summed spinor index ... ((and (spinp!>(car wi)) (greaterp (dimid!>(car wi)) 1)) (setq wd (dimid!>(car wi))) (while!> (geq wd 1) (cond ((null wl) (err!> ![er!])) (t (setq wl1 (cons (car wl) wl1)) (setq wm1 (cons (car wm) wm1)) (setq wl (cdr wl)) (setq wm (cdr wm)))) (setq wd (sub1 wd))) (setq wll (cons (reverse wl1) wll)) (setq wmm (cons (reverse wm1) wmm)) (setq wl1 nil) (setq wm1 nil)) % Tetrad index ... ((tetrp!>(car wi)) (setq wd 2) (while!> (geq wd 1) (cond ((null wl) (err!> ![er!])) (t (setq wl1 (cons (car wl) wl1)) (setq wm1 (cons (car wm) wm1)) (setq wl (cdr wl)) (setq wm (cdr wm)))) (setq wd (sub1 wd))) (setq wll (cons (reverse wl1) wll)) (setq wmm (cons (reverse wm1) wmm)) (setq wl1 nil) (setq wm1 nil)) (t (setq wll (cons (car wl) wll)) (setq wmm (cons (manitr2!> (car wm) (car wi)) wmm)) (setq wl (cdr wl)) (setq wm (cdr wm)))) (setq wi (cdr wi))) (cond ((or wm wl) (err!> ![er!]))) % wrong number of indices (setq wi (reverse(get wf '!=idxl))) (setq wss (signchange!> wll wmm wi)) (setq wm (indexchange!> wll wmm wi)) (setq wl (car wm)) (setq wm (cdr wm)) (return (cond (wss (minus!>(getmc!> wf nil wl wm))) (t (getmc!> wf nil wl wm)))) )))) (de signchange!> (wll wmm wi) (proc (wss) (while!> wll (cond ((and (pairp (car wll)) (signchange1!> (car wll) (car wmm) (car wi))) (setq wss (not wss)) )) (setq wll (cdr wll)) (setq wmm (cdr wmm)) (setq wi (cdr wi))) (return wss))) (de signchange1!> (wl wm wi) (proc (wss wl1 wm1) (while!> wl (setq wm1 (car wm)) (setq wl1 (car wl)) (cond ((or (lessp wl1 0) (greaterp wl1 1)) (err!> 21022)) ((or (eqn wm1 3) (eqn wm1 4)) (err!> 9913))) (cond ((and (eqn wm1 1) (not(upperp!> wi)) (eqn wl1 0)) % index up (setq wss (not wss))) ((and (eqn wm1 2) (upperp!> wi) (eqn wl1 1)) % index down (setq wss (not wss)))) (setq wl (cdr wl)) (setq wm (cdr wm))) (cond ((and (tetrpd!> wi) (not(pmmm!>))) (setq wss (not wss)))) (return wss))) (de indexchange!> (wl wm wi) (proc (wll wmm) (while!> wl (cond ((pairp(car wl)) (setq wmm (cons nil wmm)) (setq wll (cons (idxchg1!> (car wl) (car wm) (car wi)) wll))) (t (setq wll (cons (car wl) wll)) (setq wmm (cons (car wm) wmm)))) (setq wl (cdr wl)) (setq wm (cdr wm)) (setq wi (cdr wi))) (return (cons wll wmm)))) (de idxchg1!> (wl wm wi) (cond ((spinp!> wi) (idxchg2!> wl wm)) ((not(member wl '((0 0)(0 1)(1 0)(1 1)))) !!er!!) (t (setq wl (list2 (idch1!> (car wl) (car wm)) (idch1!> (cadr wl) (cadr wm)))) (cond ((equal wl '(0 0)) 1) ((equal wl '(1 1)) 0) ((equal wl '(0 1)) 3) ((equal wl '(1 0)) 2) )))) (de idch1!> (wl wm) (cond ((and wm (eqn wl 0)) 1) ((and wm (eqn wl 1)) 0) (t wl))) (de idxchg2!> (wl wm) (cond ((null wl) 0) ((car wm) (plus2 (cond ((zerop(car wl)) 1) (t 0)) (idxchg2!> (cdr wl) (cdr wm)))) (t (plus2 (car wl) (idxchg2!> (cdr wl) (cdr wm)))) )) % Index for data component translation ... (de indextr!> (w) (cond((null w) 0) ((not(zerop(car w))) (err!> 20231)) ((or(not(numberp(setq w(nz!>(eval!>(cdr w)))))) (lessp w 0)) (err!> 2102)) (t w))) % Dummy variable evaluation ... (de dummyvar!> (w) (cond ((get w '!=subind) (prog2 (setq w (get w '!=subind)) (cond((zerop w) nil) (t(cons 0 w))))) (t(prog2(doub!> w) (err!> 2018))))) % _| execution (de inpr!> (lst1 lst2) (cond ((or(null lst1)(null lst2)) nil) ((not(eqn(car lst1) -1)) (err!> 2002)) ((eqn(car lst2) -1) (err!> 2003)) ((eqn(car lst2) 0) (err!> 2003)) ((eqn(car lst2) 1) (cona1!> 0 (vform1!>(cdr lst1)(cdr lst2)))) (t(conf1!> (sub1(car lst2)) (vform!>(cdr lst1)(cdr lst2)))))) % | execution (de vef!> (lst1 lst2) (cond ((or(null lst1)(null lst2)) nil) ((not(eqn(car lst1) -1)) (err!> 20021)) ((not(zerop(car lst2))) (err!> 20031)) (t (cona1!> 0 (vfun!>(cdr lst1)(cdr lst2)))))) % . execution (de vpr!> (lst1 lst2) (cond ((or (null lst1) (null lst2)) nil) ((and (eqn (car lst1) -1) (eqn (car lst2) -1)) (require!> '( !#!T !#!G )) (cona1!> 0 (vprod!> (cdr lst1) (cdr lst2))) ) ((and (eqn (car lst1) 1) (eqn (car lst2) 1)) (require!> '( !#!D !#!G!I )) (cona1!> 0 (fprod!> (cdr lst1) (cdr lst2))) ) ((and (eqn (car lst1) -1) (eqn (car lst2) 1)) (cona1!> 0 (vform1!> (cdr lst1) (cdr lst2))) ) ((and (eqn (car lst1) 1) (eqn (car lst2) -1)) (cona1!> 0 (vform1!> (cdr lst2) (cdr lst1))) ) (t (err!> 2030)))) % d execution (de dx!> (lst) (cond ((null lst) nil) ((minusp(car lst)) (err!> 2004)) ((and(eqn(car lst)0)(idp(cdr lst))(get(cdr lst) '!=cord)) (cons 1 (cond(![umod!](getel1!> ![xf!] (get (cdr lst) '!=cord))) (t (mkdx!>(get (cdr lst) '!=cord)))))) ((eqn(car lst) 0) (conf1!> 1(dfun!>(cdr lst)))) (t(conf1!> (add1(car lst)) (dex!>(cdr lst)))))) % @ X execution (de bvec!> (lst) (cond ((null lst) nil) ((not(zerop(car lst))) (err!> 2013)) ((and(idp(cdr lst))(get (cdr lst) '!=cord)) (cons -1 (cond (![umod!] (getel1!> ![xv!] (get(cdr lst) '!=cord))) (t (mkdx!>(get (cdr lst) '!=cord)))))) (t(err!> 2013)))) % # execution (de dualis!> (lst) (cond ((null lst) nil) ((eqn (car lst) -1) (err!> 2007)) ((eqn (car lst) 0) (prog2 (require!> '(!#!V!O!L)) (conf1!> ![dim!] (dual0!>(cdr lst))))) ((eqn (car lst) ![dim!]) (prog2 (require!> '(!#!V!O!L)) (cona1!> 0 (duald!>(cdr lst))))) (t (prog2 (require!> '(!#!T !#!G !#!V!O!L)) (conf1!> (difference ![dim!] (car lst)) (dual!>(cdr lst))))))) % / execution (de quoti!> (lst1 lst2) (cond ((null lst2) (err!> 2009)) ((null lst1) nil) ((not(zerop(car lst2))) (err!> 2011)) ((zerop(car lst1)) (cona1!> 0 (list 'quotient (cdr lst1) (cdr lst2)))) (t(conf1!> (car lst1) (fndfpr!> (list 'quotient 1 (cdr lst2)) (cdr lst1)))))) % + execution (de plus2!> (lst1 lst2) (cond((null(setq lst1(unieval!> lst1))) (unieval!> lst2)) ((null(setq lst2(unieval!> lst2))) lst1) ((not(eqn(car lst1)(car lst2))) (err!> 2012)) ((zerop(car lst1)) (cona1!> 0 (list 'plus(cdr lst1)(cdr lst2)))) (t(conf1!>(car lst1)(dfsum!>(list2(cdr lst1)(cdr lst2))))))) % + execution (de plus!> (lst) (prog (w wt wa) (foreach!> x in lst do (cond((setq wa(unieval!> x))(progn (cond((null wt)(setq wt(car wa)))) (cond((not(eqn wt(car wa))) (err!> 2012))) (setq w(cons(cdr wa)w)))))) (return(cond((null w) nil) ((zerop wt)(cona1!> 0 (cons 'plus w))) (t(conf1!> wt (dfsum!> w))))))) % * execution (de times2!> (lst1 lst2) (cond ((or(null lst1)(null lst2)) nil) ((and(zerop(car lst1))(zerop(car lst2))) (cona1!> 0 (list 'times (cdr lst1)(cdr lst2)))) ((and(zerop(car lst1))(not(zerop(car lst2)))) (conf1!> (car lst2)(fndfpr!> (cdr lst1)(cdr lst2)))) ((and(zerop(car lst2))(not(zerop(car lst1)))) (conf1!> (car lst1)(fndfpr!> (cdr lst2)(cdr lst1)))) (t (err!> 2010)))) (de times22!> (lst1 lst2) (cond ((or(null lst1)(null lst2)) nil) ((or(null(setq lst1 (unieval!> lst1))) (null(setq lst2 (unieval!> lst2)))) nil) ((and(zerop(car lst1))(zerop(car lst2))) (cona1!> 0 (list 'times (cdr lst1)(cdr lst2)))) ((and(zerop(car lst1))(not(zerop(car lst2)))) (conf1!> (car lst2)(fndfpr!> (cdr lst1)(cdr lst2)))) ((and(zerop(car lst2))(not(zerop(car lst1)))) (conf1!> (car lst1)(fndfpr!> (cdr lst2)(cdr lst1)))) (t (err!> 2010)))) % - execution (de minus!> (lst) (cond ((null lst) nil) ((zerop(car lst)) (cons 0 (chsign!> nil (cdr lst)))) (t(cons (car lst)(chsign!> t (cdr lst)))))) % ~ execution (de co!> (lst) (cond ((null lst) nil) ((zerop(car lst)) (cons 0 (coalg!> (cdr lst)))) ((eqn(car lst) -1) (cons -1 (covec!> (cdr lst)))) (t(cons (car lst)(coform!> (cdr lst)))))) % re=(expr+~expr)/2 execution (de re!> (lst) (cond((cdr lst) (err!> 2105))(t (times2!> '(0 quotient 1 2) (plus2!>(car lst)(co!>(car lst))))))) % expr+~~=expr+~expr execution (de re2!> (lst) (plus2!> lst (co!> lst))) % im=-i * (expr-~expr)/2 execution (de ima!> (lst) (cond((cdr lst) (err!> 2105))(t (times2!> '(0 quotient(minus i)2) (plus2!>(car lst)(minus!> (co!>(car lst)))))))) % expr-~~ = expr-~expr execution (de im2i!> (lst) (plus2!> lst(minus!> (co!> lst)))) % /\ execution (de dfpr2!> (lst1 lst2) (cond ((or(null lst1)(null lst2)) nil) ((or(lessp(car lst1)1)(lessp(car lst2)1)) (err!> 2005)) (t(conf1!> (plus(car lst1)(car lst2)) (dfprod2!> (cdr lst1)(cdr lst2)))))) % [ , ] execution (de vbrc!> (lst1 lst2) (cond ((or(null lst1)(null lst2)) nil) ((or(not(minusp(car lst1)))(not(minusp(car lst2)))) (err!> 2006)) (t(conf1!> -1 (vbrack!> (cdr lst1)(cdr lst2)))))) % ** execution (de exp!> (lst1 lst2) (cond((null lst1) nil) ((not(zerop(car lst1))) (err!> 2008)) ((null lst2) '(0 . 1)) ((not(zerop(car lst2))) (err!> 2008)) (t(cona1!> 0 (list 'expt (cdr lst1)(cdr lst2)))))) %---------- SUM translator. 08.01.91 ------------------------------------- % SUM translation ... (de sumtr!> (lst) (prog (w) (setq lst(memlist!> '!, lst)) (cond((eq lst !!er!!) (err!> 2020)) ((null(cdr lst)) (err!> 2103))) (setq lst (reverse lst)) (setq w (car lst)) (setq lst (itercon!>(reverse(cdr lst)))) (cond((eq lst !!er!!) (err!> 2103))) (setq lst (append lst (ncons w))) (return(sumtr1!> lst nil)))) (de sumtr1!> (lst bool) (cond((null(cdr lst))(cond((eq bool 'func)(funtr!>(car lst)nil)) ((eq bool 'term)(termtr1!>(car lst))) (t(unitra0!> lst)))) (t(list 'sumexec!> (car lst) (sumtr1!> (cdr lst) bool))))) % SUM Execution ... (de sumexec!> (wi we) (proc (w wr) (setq wi(itertr!> wi (cond(![ivs!] (car ![ivs!]))(t t)))) (while!> wi (put (caar wi) '!=subind (cdar wi)) (setq ![ivs!] (cons (cdar wi) ![ivs!])) (setq wr (errorset!> (list 'plus2!> (list 'quote we)(list 'quote w)) ![erst1!] ![erst2!])) (remprop (caar wi) '!=subind) (cond(![ivs!] (setq ![ivs!] (cdr ![ivs!])))) (cond((atom wr) (err!> wr))) (setq w (car wr)) (setq wi(cdr wi))) (return w))) %---------- PROD translator 02.03.94 ------------------------------------- % Prod Translation ... (de prodtr!> (lst) (prog (w) (setq lst(memlist!> '!, lst)) (cond((eq lst !!er!!) (err!> 2020)) ((null(cdr lst)) (err!> 2103))) (setq lst (reverse lst)) (setq w (car lst)) (setq lst (itercon!>(reverse(cdr lst)))) (cond((eq lst !!er!!) (err!> 2103))) (setq lst (append lst (ncons w))) (return(prodtr1!> lst nil)))) (de prodtr1!> (lst bool) (cond((null(cdr lst))(cond((eq bool 'func)(funtr!>(car lst)nil)) ((eq bool 'term)(termtr1!>(car lst))) (t(unitra0!> lst)))) (t(list 'prodexec!> (car lst) (prodtr1!> (cdr lst) bool))))) % PROD Execution ... (de prodexec!> (wi we) (proc (w wr) (setq wi(itertr!> wi (cond(![ivs!] (car ![ivs!]))(t t)))) (setq w '(0 . 1)) (while!> wi (put (caar wi) '!=subind (cdar wi)) (setq ![ivs!] (cons (cdar wi) ![ivs!])) (setq wr (errorset!> (list 'times22!> (list 'quote we)(list 'quote w)) ![erst1!] ![erst2!])) (remprop (caar wi) '!=subind) (cond(![ivs!] (setq ![ivs!] (cdr ![ivs!])))) (cond((atom wr) (err!> wr))) (setq w (car wr)) (setq wi(cdr wi))) (return w))) %----- Iterator translation for SUM/PROD and Print ----------------------- % Main Iterator translation ... (de itertr!> (lst wp) (prog (wa wc w) (setq wa (car lst)) (setq wc (cdr lst)) (cond((not(idp(car wa))) (err!> 21031)) ((flagp (car wa) '!+grgvar)(msg!> 2109))) (cond ((null(cdr wa))(return(iditertr!> (car wa) wc wp))) % j or j1 or j02 ((not(eq(cadr wa) '!=)) (err!> 21031)) ((not(memq '!.!. (cddr wa))) % j = a (return(mkiter!> (car wa) 0 (boundtr!>(cddr wa)) wc wp))) (t(progn % j = a _ b (setq w (car wa)) (setq wa (seek1!> (cddr wa) '!.!. )) (cond((or(null(car wa))(null(cdr wa))) (err!> 21031))) (return (mkiter!> w (boundtr!>(reverse(car wa))) (boundtr!>(cdr wa)) wc wp))))))) % Iterator in the form of single identifier j or j1 or j02 ... (de iditertr!> (wi wc wp) (prog (wa wd) (setq wa (explode2 wi)) (cond ((not (liter (car wa))) (doub!> wi) (err!> 2104))) (setq wd (selid!> wa nil)) % wd - numbers wa - atom % we cut trailing ~ , we do not care about it ... (setq wd (wipe!~!> wd)) (cond % j12d = 0 .. (dim-1) ((notalldig!> wd) (return (mkiter!> wi 0 ![dim1!] wc wp))) % j = 0 .. (dim-1) ((and (null wd) (get (car wa) '!=uc)) (return (mkiter!> wi 0 ![dim1!] wc wp))) % abc = 0 .. length(abc) ((and (null wd) (get (car wa) '!=lc)) (return (mkiter!> wi 0 (length wa) wc wp))) % j3 = 0 .. 3 ((null (cdr wd)) (return (mkiter!> wi 0 (compress wd) wc wp))) % j13 = 1 .. 3 ((null(cddr wd)) (progn (setq wa (compress (ncons (car wd)))) (setq wd (compress (cdr wd))) (return (mkiter!> wi wa wd wc wp)))) (t(err!> 2108))))) (de wipe!~!> (w) (cond ((null w) nil) ((eq (car w) '!~) nil) (t (cons (car w) (wipe!~!> (cdr w)))))) (de notalldig!> (w) (cond ((null w) nil) ((not (digit (car w))) t) (t (notalldig!>(cdr w))))) % Bound translation ... (de boundtr!> (lst) (progn (cond((null lst) (err!> 21031))) (setq lst(translate!>(ncons lst))) (cond((eq lst !!er!!) (err!> ![er!])) ((null lst) 0) ((or(not(zerop(car lst))) (not(numberp(cdr lst)))) (err!> 2108)) (t(cdr lst))))) % Prepares Iterator ... (de mkiter!> (id wi wf wc wp) % wc-comparison with wp ... (proc (w) % wi wf - up/lo bounds ... (cond((lessp wf wi)(prog2(msg!> 2104)(return nil)))) (loop!> (cond((or(null wc)(validit!> wi wc wp)) (setq w(cons(cons id wi) w)))) (exitif (eqn wi wf)) (setq wi(add1 wi))) (return w))) % Compare by < > <= >= ... (de validit!> (wi wc wp) (cond ((eqn wc 1)(lessp wp wi)) ((eqn wc 2)(greaterp wp wi)) ((eqn wc 3)(leq wp wi)) ((eqn wc 4)(geq wp wi)) (t t))) %-------- LHS and RHS ---------------------------------------------------- (de lhs0!> (lst) (prog2(setq ![lsrs!] nil)(list2 'lhs!> (unitra0!> lst)))) (de rhs0!> (lst) (prog2(setq ![lsrs!] t)(list2 'rhs!> (unitra0!> lst)))) (de lhs!> (w) (prog2 (setq ![lsrs!] nil) (unieval!> w))) (de rhs!> (w) (prog2 (setq ![lsrs!] t) (unieval!> w))) %--------- Asy Sy Cy expansion 6.03.94 ----------------------------------- (de allcy!> (lst) (proc (wi w) (while!> lst (setq w (cons (ncons(append lst (reverse wi))) w)) (setq wi (cons (car lst) wi)) (setq lst (cdr lst))) (return w))) (de allasy!> (lst) (cond ((or(null lst)(null(cdr lst))) nil) ((null(cddr lst)) (all2y!> lst t)) (t(add1y!> t (car lst) (allasy!>(cdr lst)))))) (de allsy!> (lst) (cond ((or(null lst)(null(cdr lst))) nil) ((null(cddr lst)) (all2y!> lst nil)) (t(add1y!> nil (car lst) (allsy!>(cdr lst)))))) (de all2y!> (lst wt) (list2 (cons(list2(cadr lst)(car lst))wt) (ncons(list2(car lst)(cadr lst))))) (de add1y!> (wt w lst) (proc (wr) (while!> lst (setq wr (add11y!> wt w (car lst) wr)) (setq lst (cdr lst))) (return wr))) (de add11y!> (wtt w wl wr) (proc (wt wi) (setq wt (cdr wl)) (setq wl (car wl)) (while!> wl (setq wr (cons (cons(app!> wi (cons w wl))wt) wr)) (setq wt (cond(wtt(not wt))(t nil))) (setq wi (cons (car wl) wi)) (setq wl (cdr wl))) (setq wr (cons (cons(app!> wi (cons w wl))wt) wr)) (return wr))) (de expandsym!> (lst) (cond(!*expandsym (expandsym0!> lst))(t lst))) (de expandsym0!> (lst) (cond ((atom lst) lst) (t(prog (w) (while!> lst (cond ((memq (car lst) '(!A!s!y !S!y !C!y))(progn (cond((or(null(cdr lst))(atom(cadr lst)))(err!> 6200))) (setq w (cons (expandsym1!>(car lst)(cadr lst)) w)) (setq lst (cdr lst)))) (t(setq w (cons (expandsym0!>(car lst)) w)))) (setq lst (cdr lst))) (return(reversip w)))))) (de expandsym1!> (w lst) (proc (we we wi wr) (setq lst (memlist!> '!, lst)) (cond((or(eq lst !!er!!)(null(cdr lst)))(err!> 6200))) (setq lst (reverse lst)) (setq we (expandsym0!>(car lst))) (setq lst (mapcar (cdr lst) 'idorerr!>)) (setq wi lst) (setq lst (cond((eq w '!A!s!y )(allasy!> wi)) ((eq w '!S!y )(allsy!> wi)) ((eq w '!C!y )(allcy!> wi)))) (while!> lst (setq wr (cons (cond((cdar lst) '!-)(t '!+)) wr)) (setq wr (cons (mkreplace!> (pair wi (caar lst)) we) wr)) (setq lst (cdr lst))) (return(reversip wr)))) (de idorerr!> (w) (cond((or(cdr w)(not(idp(car w))))(err!> 6200)) (t(car w)))) (de mkreplace!> (w lst) (cond((atom lst) (cond((setq w (assoc lst w))(cdr w)) (t lst))) (t(proc (wr) (while!> lst (setq wr (cons (mkreplace!> w (car lst)) wr)) (setq lst (cdr lst))) (return(reversip wr)))))) %----------- DF in prefix form 05.96 ------------------------------------ %(de pdftra!> (w) (invord!> w 'df)) %(de dfptra!> (w) (invord!> w 'dfp)) %(de invord!> (w wf) % (proc (wa wr) % (while!> w % (cond % ((eq (car w) '!,) % (setq wr (append (cons '!, (reverse wa)) wr)) % (setq wa nil) % (setq w (cdr w))) % (t (setq wa (cons (car w) wa)) % (setq w (cdr w))))) % (setq wr (append (reverse wa) wr)) % (return (funtr!> (list2 wf wr) t)))) %----------- Limits 6.03.94 -------------------------------------------- %(de limtr!> (lst) (limtra!> nil lst)) %(de limtrm!> (lst) (limtra!> 'm lst)) %(de limtrp!> (lst) (limtra!> 'p lst)) %(de limtra!> (wt lst) % (prog (wx wl) % (cond((not(or(flagp 'limit 'opfn)(get 'limit 'simpfn))) % (err!> 6201))) % (setq lst (memlist!> '!, lst)) % (cond((or (eq lst !!er!!) (null(cdr lst)) (cddr lst) % (not(idp(caar lst))) (not(eq(cadar lst) '!-!>)) % (null(caddar lst))) % (err!> 6202))) % (setq wx (caar lst)) % (cond((not(flagp wx '!+grgvar)) % (prog2(doub!> wx) (err!> 2018)))) % (setq wl (unitra0!>(cddar lst))) % (setq lst (unitra0!>(cdr lst))) % (return(list 'limexec!> (list wx wl wt) lst)))) % % wx - limiting var wl - limiting point wt - limit's type %(de limexec!> (ww lst) % (prog (wx wl wt) % (setq wx (car ww)) % (setq wl (cadr ww)) % (setq wt (caddr ww)) % (setq wl (unieval!> wl)) % (cond((or(null wl)(zerop wl))(setq wl 0)) % ((not(zerop(car wl))) (err!> 6203)) % (t(setq wl (cdr wl)))) % (setq lst (unieval!> lst)) % (return % (cond((null lst) nil) % ((zerop(car lst))(cona1!> 0 (lima!> wx wl wt (cdr lst)))) % (t(conf1!>(car lst)(limf!> wx wl wt (cdr lst)))))))) %------- SUBstitutions 7.03.94 ------------------------------------------- (de subtr!> (lst) (prog (wl) (setq lst (memlist!> '!, lst)) (cond((eq lst !!er!!) (err!> 6204))) (setq lst (reverse lst)) (setq wl (cdr lst)) (setq lst (unitra0!>(car lst))) (setq wl (mapcar wl 'subtr1!>)) (setq wl (reversip wl)) (return(list 'subexec!> wl lst)))) (de subtr1!> (w) (prog (ww) (setq ww w) (setq w (seek1!> w '!=)) (cond ((null w) (cond((or(atom ww)(not(eq (car ww) '!S!o!l))) (err!> 6204)) (t(progn (setq w (soltra!> ww)) (cond((eq w !!er!!)(err!> ![er!]))) (return w))))) ((or (null(car w)) (null(cdr w))) (err!> 6204)) (t(return(cons (unitraa!>(reverse(car w))) (unitra!>(cdr w)))))))) (de subexec!> (wl lst) (cond((null(setq lst (unieval!> lst))) nil) ((zerop(car lst)) (cona1!> 0 (subalg!>(mapcar wl 'subexec1!>)(cdr lst)))) (t(conf1!>(car lst)(subdf!>(mapcar wl 'subexec1!>)(cdr lst)))))) (de subexec1!> (w) (prog (ww) (cond((eq (car w) 'equal)(return w))) (setq ww (unieval!>(cdr w))) (cond((null ww)(setq ww nil)) ((not(zerop(car ww))) (err!> 6205)) (t(setq ww (cdr ww)))) (return (list 'equal (nz!>(car w)) (nz!> ww))))) %------- If and boolean expressions. 19.03.94 ---------------------------- (de iftran!> (lst) (cond ((eq (setq lst (memlist!> '!, lst)) !!er!!) (err!> 8200)) ((eqn (length lst) 2) % if ... then ... (list 'ifexec!> (booltrai!>(car lst)) (unitra0!>(cadr lst)) nil)) ((eqn (length lst) 3) % if ... then ... else ... (list 'ifexec!> (booltrai!>(car lst)) (unitra0!>(cadr lst)) (unitra0!>(caddr lst)) )) (t(err!> 8200)))) (de booltrai!> (lst) (cond ((atom lst) (atomtrabi!> lst)) % atom ((and(pairp lst)(null(cdr lst))) % next level (booltrai!>(car lst))) (t(prog (w) % or - translation ... (setq w (memlist!> '!o!r lst)) (cond((eq w !!er!!) (err!> 2400)) ((null(cdr w))(return(andtrai!> lst)))) (return(list2 'orex!> (mapcar w 'andtrai!>))))))) (de andtrai!> (lst) (cond ((null lst) (err!> 2400)) ((null(cdr lst)) (booltrai!>(car lst))) % next level (t(prog (w) % and - translation ... (setq w (memlist!> '!a!n!d lst)) (cond((eq w !!er!!) (err!> 2400)) ((null(cdr w))(return(nottrai!> lst)))) % bool function (return(list2 'andex!> (mapcar w 'nottrai!>))))))) (de nottrai!> (lst) (cond ((null lst) (err!> 2400)) ((null(cdr lst)) (booltrai!>(car lst))) % next level ((and (idp(car lst)) (get (car lst) '!=boolmac)) (list2 (get (car lst) '!=boolmac) (list2 'quote (cadr lst)))) ((eq (car lst) '!n!o!t) (list2 'notex!> (reltrai!>(cdr lst)))) (t(reltrai!> lst)))) (de reltrai!> (lst) (cond ((null lst) (err!> 2400)) ((null(cdr lst)) (booltrai!>(car lst))) % next level (t(prog (w wa wb) (setq w (seek!> lst '( != !< !> !<!= !>!= !|!= ))) (cond((null w) (return(algtra1i!> lst))) ((or (null(car w)) (null(cddr w))) (err!> 2400))) (setq wa (unitra0!>(reverse(car w)))) (setq wb (unitra0!>(cddr w))) (setq w (cadr w)) (cond ((eq w '!=) (setq w 'equal)) ((eq w '!<) (setq w 'lessp)) ((eq w '!>) (setq w 'greaterp)) ((eq w '!|!=) (setq w 'neq)) ((eq w '!<!=) (setq w 'leq)) ((eq w '!>!=) (setq w 'geq))) (return(list 'relex!> w wa wb)))))) (de algtra1i!> (lst) (list 'balgex!> (unitra0!> lst))) (de atomtrabi!> (lst) (list 'balgex!> (atomtr!> lst))) (de ifexec!> (wc wa wb) (cond((booleval!> wc) (unieval!> wa)) (t (unieval!> wb)) )) (de booleval!> (lst) (cond((or (atom lst) (numberp(car lst)) (pairp(car lst))) lst) ((and (idp(car lst)) (flagp (car lst) '!+specbexe)) (eval lst)) (t (apply (car lst) (mapcar (cdr lst) (function booleval!>)))))) (de balgex!> (w) (cond((unievaluate!> w) t) (t nil))) (de orex!> (w) (proc nil (while!> w (cond((booleval!>(car w)) (return t))) (setq w (cdr w))) (return nil))) (de andex!> (w) (proc nil (while!> w (cond((null(booleval!>(car w))) (return nil))) (setq w (cdr w))) (return t))) (de notex!> (w) (not(booleval!> w))) (de n00!> (w) (cond(w w)(t '(0 . 0)))) (de relex!> (w wa wb) (progn (setq wa (n00!>(unievaluate!> wa))) (setq wb (n00!>(unievaluate!> wb))) (cond((or (not(zerop(car wa))) (not(zerop(car wb))) (not(numberp(cdr wa))) (not(numberp(cdr wb))) ) (err!> 8201))) (setq wa (cdr wa)) (setq wb (cdr wb)) (cond ((eq w 'equal) (eqn wa wb)) ((eq w 'lessp) (lessp wa wb)) ((eq w 'greaterp) (greaterp wa wb)) ((eq w 'neq) (not(eqn wa wb))) ((eq w 'leq) (leq wa wb)) ((eq w 'geq) (geq wa wb)) ))) (de prepiv!> (w) (cond ((or (not(pairp w)) (not(idp(car w)))) (err!> 2400)) (t (incomiv!> (explode2(car w)))))) (de prepsw!> (w) (cond ((or (not(pairp w)) (not(idp(car w)))) (err!> 2400)) (t (makeswvar!>(car w))))) (de objexe!> (w) (prog2 (setq w (prepiv!> w)) (cond ((flagp w '!+ivar) t) (t nil)))) (de onexe!> (w) (prog nil (setq w (prepsw!> w)) (cond ((not(or (globalp w) (fluidp w))) (err!> 2420))) (return(eval w)))) (de offexe!> (w) (prog nil (setq w (prepsw!> w)) (cond ((not(or (globalp w) (fluidp w))) (err!> 2420))) (return(not(eval w))))) (de valexe!> (w) (prog nil (setq w (prepiv!> w)) (cond ((not(flagp w '!+ivar)) (err!> 2410))) (return(eval w)))) (de zeroexe!> (w) (prog nil (setq w (prepiv!> w)) (cond ((not(flagp w '!+ivar)) (err!> 2410))) (return(equal (eval w) (mkbox!> w))))) (de nullexe!> (w) (prog nil (setq w (prepiv!> w)) (cond ((not(flagp w '!+ivar)) (err!> 2410))) (return(equal (eval w) (cond ((pmmm!>) ![nullm1!]) (t ![nullm!])))))) %----- User interrupt ---------------------------------------------------- (de errortr!> (w) (list 'error!> w)) (de error!> (w) (progn (cond ((pairp w) (setq w (car w)))) (prin2 w)(terpri) (err!> 1000))) %----- Translation for Algebraic Expressions Only ------------------------ % Without Evaluation for Let, Clear, Factor, RamFac, Ordaer ... % Translation with !!ER!! return for Algebraic Expressions only ... % dim sgnt sign - are replaced by exact numbers (de translata!> (lst) (prog nil (cond((null lst)(return nil))) (setq lst (errorset!> (list2 'unitraa!> (list2 'quote lst)) ![erst1!] ![erst2!])) (cond((atom lst)(prog2(setq ![er!] lst)(return !!er!!)))) (return(car lst)) )) % The same but result must ne a pure number after EVAL!> ... (de ntranslata!> (lst) (prog nil (cond ((null lst) (return 0))) (setq lst (errorset!> (list2 'unitraa!> (list2 'quote lst)) ![erst1!] ![erst2!])) (cond ((atom lst) (setq ![er!] lst) (return !!er!!))) (setq lst (errorset!> (list2 'eval!> (list2 'quote (car lst))) ![erst1!] ![erst2!])) (cond ((atom lst) (setq ![er!] lst) (return !!er!!))) (setq lst (car lst)) (cond ((null lst) (return 0)) ((numberp lst) (return lst)) (t (setq ![er!] 99) (return !!er!!))) )) % Alg translation ... (de unitraa!> (lst) (cond ((atom lst) (atomtra!> lst)) % atom ((and(pairp lst)(null(cdr lst)))(unitraa!>(car lst))) % next level (t(proc (w) (cond((not(memq(car lst) '(!+ !-))) % + - translation (setq lst(cons '!+ lst)))) (setq w(mems!> '(!+ !-) (reverse lst) nil)) (cond((eq w !!er!!) (err!> 2017))) (setq w(mapcar w 'auxfun3!>)) (return(cond((null(cdr w))(car w)) (t(cons 'plus w)))))))) (de auxfun3!> (w) (cond((eq(cdr w) '!+)(termtra!>(car w))) (t(list2 'minus (termtra!>(car w)))))) % Atom translation ... (de atomtra!> (w) (cond ((zerop w) nil) % zero ((stringp w)(prog2(doubs!> w) (err!> 2019))) ((eq w '!d!i!m) ![dim!]) % dimension ((or (eq w '!s!g!n!t) (eq w '!s!i!g!n)) ![sigprod!]) % signature ((or(numberp w)(flagp w '!+grgvar)) w) % number or variable (t(prog2(doub!> w) (err!> 2018))))) % * translation (de termtra!> (lst) (prog (w) (cond((null lst) (err!> 2016))) (setq w(seek1!> lst '!* )) (cond((null w) (return(quotra!> lst)))) (return (list 'times (quotra!>(reverse(car w))) (termtra!>(cdr w)))))) % / translation (de quotra!> (lst) (cond((null lst) (err!> 2016)) ((not(memq '!/ lst))(exptra!> lst)) (t(prog (w) (setq w(memlist!> '!/ lst)) (cond((eq w !!er!!) (err!> 2016))) (return(quotmka!> nil w)))))) (de quotmka!> (lst1 lst2) (cond((null lst2) lst1) (t(quotmka!> (list 'quotient (cond(lst1 lst1)(t(exptra!>(car lst2)))) (exptra!>(cond(lst1(car lst2))(t(cadr lst2))))) (cond(lst1(cdr lst2))(t (cddr lst2))))))) % ** or ^ translation (de exptra!> (lst) (prog (w) (cond((null lst) (err!> 2016))) (setq w(seek!> lst '(!*!* !^) )) (cond((null w)(return(kertra!> lst)))) (return (list 'expt (kertra!>(reverse(car w))) (exptra!>(cddr w)))))) % Kernel translation (de kertra!> (lst) (cond((null lst) (err!> 2015)) ((pairp(car lst))(cond((cdr lst) (err!> 2014)) (t(unitraa!>(car lst))))) ((not(cdr lst)) (atomtra!>(car lst))) (t(funtra!> lst)))) % Function translation (de funtra!> (lst) (cond((or(null lst)(atom lst)(not(eqn(length lst)2)) (not(idp(car lst)))(atom(cadr lst))) (err!> 2021)) ((and(not(flagp(car lst) '!+fun)) (not(redgood!>(car lst)))) (prog2(doub!>(car lst)) (err!> 2022))) (t(prog (w) (setq w (car lst)) (setq lst(cadr lst)) (setq lst(memlist!> '!, lst)) (cond((eq lst !!er!!) (err!> 2020))) (setq lst (mapcar lst (function unitraa1!>))) (return(cons w lst)))))) (de unitraa1!> (lst) (cond((setq lst (unitraa!> lst)) lst) (t 0))) %--------- Boolean Expressions Translation ------------------------------- % For For All Such That ; command ... % Translation with !!ER!! return for Bollean Expressions ... (de booltra!> (lst) (prog nil (cond((null lst)(return nil))) (setq lst (errorset!> (list2 'booltra0!> (list2 'quote lst)) ![erst1!] ![erst2!])) (cond((atom lst)(prog2(setq ![er!] lst)(return !!er!!)))) (return(car lst)) )) (de booltra0!> (lst) (cond ((atom lst) (atomtrab!> lst)) % atom ((and(pairp lst)(null(cdr lst))) % next level (booltra0!>(car lst))) (t(prog (w) % or - translation ... (setq w (memlist!> '!o!r lst)) (cond((eq w !!er!!) (err!> 2400)) ((null(cdr w))(return(andtra!> lst)))) (return(cons 'or (mapcar w 'andtra!>))))))) (de andtra!> (lst) (cond ((null lst) (err!> 2400)) ((null(cdr lst)) (booltra0!>(car lst))) % next level (t(prog (w) % and - translation ... (setq w (memlist!> '!a!n!d lst)) (cond((eq w !!er!!) (err!> 2400)) ((null(cdr w))(return(nottra!> lst)))) (return(cons 'and (mapcar w 'nottra!>))))))) (de nottra!> (lst) (cond ((null lst) (err!> 2400)) ((null(cdr lst)) (booltra0!>(car lst))) % next level ((eq (car lst) '!n!o!t) (list2 'not (reltra!>(cdr lst)))) (t(reltra!> lst)))) (de reltra!> (lst) (cond ((null lst) (err!> 2400)) ((null(cdr lst)) (booltra0!>(car lst))) % next level (t(prog (w wa wb) (setq w (seek!> lst '( != !< !> !<!= !>!= !|!= ))) (cond((null w) (return(algtra1!> lst))) ((or (null(car w)) (null(cddr w))) (err!> 2400))) (setq wa (algtra!>(reverse(car w)))) (setq wb (algtra!>(cddr w))) (setq w (cadr w)) (cond ((eq w '!=) (setq w 'evalequal)) ((eq w '!<) (setq w 'evallessp)) ((eq w '!>) (setq w 'evalgreaterp)) ((eq w '!|!=) (setq w 'evalneq)) ((eq w '!<!=) (setq w 'evalleq)) ((eq w '!>!=) (setq w 'evalgeq))) (return(list w wa wb)))))) (de algtra!> (lst) (list 'aeval (list 'quote (unitraa!> lst)))) (de algtra1!> (lst) (list 'boolvalue!* (list 'eval!> (list 'quote (unitraa!> lst))))) (de atomtrab!> (lst) (list 'boolvalue!* (list 'eval!> (list 'quote (atomtra!> lst))))) %========= End of GRGtrans.sl ===========================================% |
Added grgxcomp.sl version [ef5f4f1078].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 | %==========================================================================% % GRG 3.2 Compilation [PSL] (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. % %==========================================================================% % Set here amount of required free BPS or nil ... (setq free!-bps!-size 45000) (progn (terpri) (prin2 "Compiling GRG 3.2[x], wait few minutes.") (terpri) (prin2 "After several `*** Init code length is #'") (terpri) (prin2 "messages the compilation should be completed.") (terpri) (prin2 "Watch possible error messages preceded by `*****' ...") (terpri) (terpri) (wrs (open "grgxcomp.log" 'output)) ) (de compile!-file!> (bin src) (prog (wcc) (setq wcc (wrs nil)) (prin2 "Compiling `") (prin2 bin) (prin2 "' ...") (terpri) (wrs wcc) (terpri) (prin2 "### Compiling `") (prin2 bin) (prin2 "' ...") (terpri) (setq !*comp t) (faslout bin) (dskin src) (faslend) (setq !*comp nil) )) % Loading compiler ... (load compiler) % Do we need symget.dat ? % (cond % ((and (getd 'filep) (filep "$reduce/util/symget.dat")) % (dskin "$reduce/util/symget.dat") )) % Enlarging BPS if necessary ... (cond ((and free!-bps!-size (getd 'set!-bps!-size) (getd 'free!-bps) (lessp (free!-bps) free!-bps!-size)) (set!-bps!-size free!-bps!-size))) (dskin "xdecl.sl" ) (compile!-file!> "grg" "grg.sl" ) (compile!-file!> "grgdecl" "xdecl.sl" ) (compile!-file!> "grggeom" "xgeom.sl" ) (compile!-file!> "grggrav" "xgrav.sl" ) (compile!-file!> "grginit" "xinit.sl" ) (compile!-file!> "grgclass" "xclass.sl" ) (compile!-file!> "grgcomm" "xcomm.sl" ) (compile!-file!> "grgcoper" "xcoper.sl" ) (compile!-file!> "grgmain" "xmain.sl" ) (compile!-file!> "grgmater" "xmater.sl" ) (compile!-file!> "grgprin" "xprin.sl" ) (compile!-file!> "grgproc" "xproc.sl" ) (compile!-file!> "grgtrans" "xtrans.sl" ) (compile!-file!> "grgcfg" "grgcfg.sl" ) (progn (terpri) (prin2 "### All done.") (terpri) (wrs nil) (terpri) (prin2 "GRG has been compiled.") (terpri) (prin2 "Move all created grg*.b files in the $reduce/fasl") (terpri) (prin2 "directory or keep them in your working directory.") (terpri) ) (bye) %==========================================================================% |
Added grgxmacr.sl version [7d0e4b9b6a].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 | %==========================================================================% % GRXmacro.sl Macro Expansion % %==========================================================================% % GRG 3.2 Standard Lisp Source Code (C) 1988-97 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. % %==========================================================================% (de expand!-file!> (ifile ofile) (prog (ic oc w is os) (setq ic (open ifile 'input)) (setq oc (open ofile 'output)) (terpri) (prin2 "### Expanding `")(prin2 ifile)(prin2 "' to `")(prin2 ofile)(prin2 "' ...")(terpri) (setq is (rds ic)) (setq os (wrs oc)) (prin2 "%==========================================================================%")(terpri) (prin2 "% GRG 3.2 Standard Lisp Source Code (C) 1988-97 Vadim V. Zhytnikov %")(terpri) (prin2 "%==========================================================================%")(terpri) (prin2 "% This file is distributed without any warranty. You may modify it but you %")(terpri) (prin2 "% are not allowed to remove author's name and/or distribute modified file. %")(terpri) (prin2 "%==========================================================================%")(terpri) (prin2 "% The file `")(prin2 ofile)(prin2 "' was generated from `")(prin2 ifile)(prin2 "' at ") (terpri) (prin2 "% ")(prin2 (date)) (terpri) (prin2 "% Must be used on a ") (cond ((getd 'rdf) (prin2 "CSL-based")) (t (prin2 "PSL-based"))) (terpri) (cond ((getd '!c!a!r) (prin2 "% Lower-Case system only!")) (t (prin2 "% Upper-Case system only!"))) (terpri) (terpri) (terpri) loop (setq w (errorset '(read) nil nil)) (cond ((or (atom w) (eq (car w) !$eof!$)) (go end))) (print (xpand!> (car w))) (terpri) (go loop) end (prin2 "%======== End of `")(prin2 ofile)(prin2 "' =============================================%") (terpri) (wrs os) (rds is) (close ic) (close oc) )) (de xpand!> (w) (cond ((atom w) w) ((and (eq (car w) 'explode2) % CSL explode2 is buggy! (getd 'rdf)) (list 'explode2!> (xpand!> (cadr w)))) ((eq (car w) 'proc) (xproc w)) ((eq (car w) 'loop!>) (xloop!> w)) ((eq (car w) 'while!>) (xwhile!> w)) ((eq (car w) 'repeat!>) (xrepeat!> w)) ((eq (car w) 'for!>) (xfor!> w)) ((eq (car w) 'fordim!>) (xfordim!> w)) ((eq (car w) 'foreach!>) (xforeach!> w)) (t (cons (xpand!>(car w)) (xpand!>(cdr w)))))) (de mkcng!> (bool lab) (list2 (quote cond) (list2 (list2 (quote not) bool) (list2 (quote go) lab)))) (de mkcg!> (bool lab) (list2 (quote cond) (list2 bool (list2 (quote go) lab)))) (de xproc (u) (prog (body w wa wb wc) (setq body (list2 (cadr u) (quote prog))) (setq u (cddr u)) label1 (cond ((and (null u) (null wa)) (go label2))) (cond ((null u) (go label3))) (cond ((atom(car u)) (prog2 (setq body (cons (car u) body)) (setq u (cdr u)))) ((or (setq wb (eq (caar u) (quote while!>))) (eq (caar u) (quote loop!>)) (eq (caar u) (quote repeat!>))) (progn (setq wa (cons (cdr u) wa)) (setq u (cdar u)) (setq w (cons (gensym) w)) (setq w (cons (gensym) w)) (cond (wb (setq body (cons (mkcng!> (car u) (car w)) (cons (cadr w) body)))) (t (setq body (cons (cadr w) body)))) (cond (wb (setq u (cdr u)))) (setq wc (cons nil wc)))) ((eq (caar u) (quote exitif)) (prog2 (setq body (cons (mkcg!> (cadar u)(car w)) body)) (setq u (cdr u)) )) ((eq (caar u) (quote tohead)) (prog2 (setq body (cons (mkcg!> (cadar u)(cadr w)) body)) (setq u (cdr u)) )) ((eq (caar u) (quote until)) (progn (setq body (cons (car w) (cons (mkcng!> (cadar u)(cadr w)) body))) (setq u (cdr u)) (setq wc (cons t wc)))) (t (prog2 (setq body (cons (car u) body)) (setq u (cdr u)) ))) label3 (cond((and wa (null u)) (progn (cond ((null (car wc)) (setq body (cons (car w) (cons (list2 (quote go) (cadr w)) body))))) (setq w (cddr w)) (setq u (car wa)) (setq wa (cdr wa)) (setq wc (cdr wc))))) (go label1) label2 (return (xpand!>(reverse body))))) (de xloop!> (u) (xproc (list (quote proc) nil (cons (quote loop!>) (cdr u))))) (de xwhile!> (u) (xproc (list (quote proc) nil (cons (quote while!>) (cdr u))))) (de xrepeat!> (u) (xproc (list (quote proc) nil (cons (quote repeat!>) (cdr u))))) (de xfor!> (u) (prog (action body exp incr lab1 lab2 result tail var x) (setq var (cadr u)) (setq incr (caddr u)) (setq action (cadddr u)) (setq body (xpand!>(car (cddddr u)))) (setq result (list (list 'setq var (car incr)))) (setq incr (cdr incr)) (setq x (list 'difference (cadr incr) var)) (cond ((not (equal (car incr) 1)) (setq x (list 'times (car incr) x)))) (setq lab1 (gensym)) (setq lab2 (gensym)) (setq x (list 'minusp x)) (setq result (nconc result (cons lab1 (cons (list 'cond (list x (list 'go lab2))) (cons body (cons (list 'setq var (list 'plus2 var (car incr)) ) (cons (list 'go lab1) (cons lab2 tail)))) ))) ) (return (mkprog (cons var exp) result)))) (de xfordim!> (u) (prog (action body exp incr lab1 lab2 result tail var x) (setq var (cadr u)) (setq incr (list 0 1 '![dim1!])) (setq action (caddr u)) (setq body (xpand!>(car (cdddr u)))) (setq result (list (list 'setq var (car incr)))) (setq incr (cdr incr)) (setq x (list 'difference (cadr incr) var)) (cond ((not (equal (car incr) 1)) (setq x (list 'times (car incr) x)))) (setq lab1 (gensym)) (setq lab2 (gensym)) (setq x (list 'minusp x)) (setq result (nconc result (cons lab1 (cons (list 'cond (list x (list 'go lab2))) (cons body (cons (list 'setq var (list 'plus2 var (car incr)) ) (cons (list 'go lab1) (cons lab2 tail)))) ))) ) (return (mkprog (cons var exp) result)))) (de xforeach!> (u) (prog (action body fn lst mod var) (setq var (cadr u)) (setq u (cddr u)) (setq mod (car u)) (setq u (cdr u)) (setq lst (car u)) (setq u (cdr u)) (setq action (car u)) (setq u (cdr u)) (setq body (xpand!>(car u))) (setq fn (cond ((eq action 'do) (cond ((eq mod 'in) 'mapc) (t 'map))) ((eq action 'conc) (cond ((eq mod 'in) 'mapcan) (t 'mapcon))) ((eq action 'collect) (cond ((eq mod 'in) 'mapcar) (t 'maplist))) (t (rederr (list action "invalid in foreach statement")))) ) (return (list fn lst (list 'function (list 'lambda (list var) body)))) )) %========== End of GRXmacro.sl ============================================% |
Added guide32.tex version [c9c7c3b2cc].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 | %==========================================================================% % GRG 3.2 Reference Guide (C) 1988-97 Vadim V. Zhytnikov % %==========================================================================% % This document requires LaTeX 2e. Run LaTeX once: % % % % latex guide32 % % % %==========================================================================% \documentclass[twocolumn]{article} \addtolength{\voffset}{-10mm} \addtolength{\textheight}{28mm} \addtolength{\hoffset}{-8mm} \addtolength{\textwidth}{10mm} \usepackage{indentfirst} %%% This is for CM fonts \newcommand{\grgtt}{\ttfamily} \renewcommand{\ttdefault}{cmtt} \newcommand{\shadedbox}[1]{\fbox{#1}} \fboxsep=1pt %%% %%% Page layout ... \parindent=0mm \parskip=2mm \vfuzz=3pt %%% %%% My own \tt font ... \makeatletter \def\verbatim@font{\grgtt} \makeatother \renewcommand{\tt}{\grgtt} %%% %%% Special symbols ... \def\^{{\tt \char'136}} %%% \^ is ^ \def\_{{\tt \char'137}} %%% \_ is _ \newcommand{\w}{{\tt \char'057 \char'134}} %%% \w is /\ \newcommand{\bs}{{\tt \char'134}} %%% \bs is \ \newcommand{\ul}{{\tt \char'137}} %%% \ul is _ \newcommand{\dd}{{\tt \char'043}} %%% \dd is # \newcommand{\cc}{{\tt \char'176}} %%% \cc is ~ \newcommand{\ip}{{\tt \char'137 \char'174}} %%% \ip is _| \newcommand{\ii}{{\tt \char'174}} %%% \ii is | %%% %%% \grg GRG logo ... %\newcommand{\grglogofont}{\bfseries} %\newcommand{\grg}{{\grglogofont GRG}} \newcommand{\grg}{GRG} %%% \comm{...} in-line command in the box \newcommand{\comm}[1]{\shadedbox{\tt#1}} %%% \command{...} commands in (shaded) box \newcommand{\command}[1]{\vspace*{1mm}\hfil\break\hspace*{5mm} \shadedbox{\begin{tabular}{l} \tt#1 \end{tabular}}\vspace*{0.7mm}\newline} \newcommand{\longcommand}[1]{\vspace*{1mm}\hfil\break \shadedbox{\begin{tabular}{l} \tt#1 \end{tabular}}\vspace*{0.7mm}\newline} %%% \parm{...} is \itshape for parameters \newcommand{\parm}[1]{{\slshape\sffamily#1}} %%% \opt{...} optional \newcommand{\opt}[1]{{\rm [}#1{\rm ]}} %%% \rpt{...} repeat \newcommand{\rpt}[1]{{#1}\,\,{\rm [}{\tt,}{#1}{\tiny\dots}{\rm ]}} %%% Headings style ... %\usepackage{fancyheadings} %%% We just inserat the fancyheadings.sty here literally ... \makeatletter % fancyheadings.sty version 1.7 % Fancy headers and footers. % Piet van Oostrum, Dept of Computer Science, University of Utrecht % Padualaan 14, P.O. Box 80.089, 3508 TB Utrecht, The Netherlands % Telephone: +31-30-531806. piet@cs.ruu.nl (mcvax!sun4nl!ruuinf!piet) % Sep 16, 1994 % version 1.4: Correction for use with \reversemargin % Sep 29, 1994: % version 1.5: Added the \iftopfloat, \ifbotfloat and \iffloatpage commands % Oct 4, 1994: % version 1.6: Reset single spacing in headers/footers for use with % setspace.sty or doublespace.sty % Oct 4, 1994: % version 1.7: changed \let\@mkboth\markboth to % \def\@mkboth{\protect\markboth} to make it more robust \def\lhead{\@ifnextchar[{\@xlhead}{\@ylhead}} \def\@xlhead[#1]#2{\gdef\@elhead{#1}\gdef\@olhead{#2}} \def\@ylhead#1{\gdef\@elhead{#1}\gdef\@olhead{#1}} \def\chead{\@ifnextchar[{\@xchead}{\@ychead}} \def\@xchead[#1]#2{\gdef\@echead{#1}\gdef\@ochead{#2}} \def\@ychead#1{\gdef\@echead{#1}\gdef\@ochead{#1}} \def\rhead{\@ifnextchar[{\@xrhead}{\@yrhead}} \def\@xrhead[#1]#2{\gdef\@erhead{#1}\gdef\@orhead{#2}} \def\@yrhead#1{\gdef\@erhead{#1}\gdef\@orhead{#1}} \def\lfoot{\@ifnextchar[{\@xlfoot}{\@ylfoot}} \def\@xlfoot[#1]#2{\gdef\@elfoot{#1}\gdef\@olfoot{#2}} \def\@ylfoot#1{\gdef\@elfoot{#1}\gdef\@olfoot{#1}} \def\cfoot{\@ifnextchar[{\@xcfoot}{\@ycfoot}} \def\@xcfoot[#1]#2{\gdef\@ecfoot{#1}\gdef\@ocfoot{#2}} \def\@ycfoot#1{\gdef\@ecfoot{#1}\gdef\@ocfoot{#1}} \def\rfoot{\@ifnextchar[{\@xrfoot}{\@yrfoot}} \def\@xrfoot[#1]#2{\gdef\@erfoot{#1}\gdef\@orfoot{#2}} \def\@yrfoot#1{\gdef\@erfoot{#1}\gdef\@orfoot{#1}} \newdimen\headrulewidth \newdimen\footrulewidth \newdimen\plainheadrulewidth \newdimen\plainfootrulewidth \newdimen\headwidth \newif\if@fancyplain \@fancyplainfalse \def\fancyplain#1#2{\if@fancyplain#1\else#2\fi} % Command to reset various things in the headers: % a.o. single spacing (taken from setspace.sty) % and the catcode of ^^M (so that epsf files in the header work if a % verbatim crosses a page boundary) \def\fancy@reset{\restorecr \def\baselinestretch{1}% \ifx\undefined\@newbaseline% NFSS not present; 2.09 or 2e \ifx\@currsize\normalsize\@normalsize\else\@currsize\fi% \else% NFSS (2.09) present \@newbaseline% \fi} % Initialization of the head and foot text. \headrulewidth 0.4pt \footrulewidth\z@ \plainheadrulewidth\z@ \plainfootrulewidth\z@ \lhead[\fancyplain{}{\sl\rightmark}]{\fancyplain{}{\sl\leftmark}} % i.e. empty on ``plain'' pages \rightmark on even, \leftmark on odd pages \chead{} \rhead[\fancyplain{}{\sl\leftmark}]{\fancyplain{}{\sl\rightmark}} % i.e. empty on ``plain'' pages \leftmark on even, \rightmark on odd pages \lfoot{} \cfoot{\rm\thepage} % page number \rfoot{} % Put together a header or footer given the left, center and % right text, fillers at left and right and a rule. % The \lap commands put the text into an hbox of zero size, % so overlapping text does not generate an errormessage. \def\@fancyhead#1#2#3#4#5{#1\hbox to\headwidth{\fancy@reset\vbox{\hbox {\rlap{\parbox[b]{\headwidth}{\raggedright#2\strut}}\hfill \parbox[b]{\headwidth}{\centering#3\strut}\hfill \llap{\parbox[b]{\headwidth}{\raggedleft#4\strut}}}\headrule}}#5} \def\@fancyfoot#1#2#3#4#5{#1\hbox to\headwidth{\fancy@reset\vbox{\footrule \hbox{\rlap{\parbox[t]{\headwidth}{\raggedright#2\strut}}\hfill \parbox[t]{\headwidth}{\centering#3\strut}\hfill \llap{\parbox[t]{\headwidth}{\raggedleft#4\strut}}}}}#5} \def\headrule{{\if@fancyplain\headrulewidth\plainheadrulewidth\fi \hrule\@height\headrulewidth\@width\headwidth \vskip-\headrulewidth}} \def\footrule{{\if@fancyplain\footrulewidth\plainfootrulewidth\fi \vskip-0.3\normalbaselineskip\vskip-\footrulewidth \hrule\@width\headwidth\@height\footrulewidth\vskip0.3\normalbaselineskip}} \def\ps@fancy{ \def\@mkboth{\protect\markboth} \@ifundefined{chapter}{\def\sectionmark##1{\markboth {\uppercase{\ifnum \c@secnumdepth>\z@ \thesection\hskip 1em\relax \fi ##1}}{}} \def\subsectionmark##1{\markright {\ifnum \c@secnumdepth >\@ne \thesubsection\hskip 1em\relax \fi ##1}}} {\def\chaptermark##1{\markboth {\uppercase{\ifnum \c@secnumdepth>\m@ne \@chapapp\ \thechapter. \ \fi ##1}}{}} \def\sectionmark##1{\markright{\uppercase{\ifnum \c@secnumdepth >\z@ \thesection. \ \fi ##1}}}} \ps@@fancy \global\let\ps@fancy\ps@@fancy \headwidth\textwidth} \def\ps@fancyplain{\ps@fancy \let\ps@plain\ps@plain@fancy} \def\ps@plain@fancy{\@fancyplaintrue\ps@@fancy} \def\ps@@fancy{ \def\@oddhead{\@fancyhead\@lodd\@olhead\@ochead\@orhead\@rodd} \def\@oddfoot{\@fancyfoot\@lodd\@olfoot\@ocfoot\@orfoot\@rodd} \def\@evenhead{\@fancyhead\@rodd\@elhead\@echead\@erhead\@lodd} \def\@evenfoot{\@fancyfoot\@rodd\@elfoot\@ecfoot\@erfoot\@lodd} } \def\@lodd{\if@reversemargin\hss\else\relax\fi} \def\@rodd{\if@reversemargin\relax\else\hss\fi} \let\latex@makecol\@makecol \def\@makecol{\let\topfloat\@toplist\let\botfloat\@botlist\latex@makecol} \def\iftopfloat#1#2{\ifx\topfloat\empty #2\else #1\fi} \def\ifbotfloat#1#2{\ifx\botfloat\empty #2\else #1\fi} \def\iffloatpage#1#2{\if@fcolmade #1\else #2\fi} \makeatother %%% \pagestyle{fancy} \headrulewidth=0.1mm \footrulewidth=0.1mm \lhead{\bf\slshape GRG 3.2 Reference Guide} \chead{} \rhead{\bf\thepage} \lfoot{} \cfoot{} \rfoot{} %%% %%% Sections ... \renewcommand{\thesection}{\hspace*{-5mm}} \renewcommand{\thesubsection} {{\sf\slshape\arabic{subsection}.}\hspace*{-3mm}} \begin{document} %\title{\LARGE\bf \grg\ 3.2 Reference Guide\vspace*{-8mm}} %\date{} %\maketitle %\raggedright \footnotesize \section{\LARGE\sf\slshape Commands} \chead{\slshape Commands} \tabcolsep=0.5mm \grg\ commands are not case sensitive, i.e. they can be typed in lower, upper or mixed case. Optional parts of the commands are enclosed in square brackets \opt{\parm{x}} and construction \rpt{\parm{x}} stands for {\tt \parm{x}} or {\tt \parm{x},\,\parm{x}} or {\tt \parm{x},\,\parm{x},\,\parm{x}} etc. \subsection{\sf\slshape Session Control Commands} The command \comm{Quit;} terminates both \grg\ and {\sc Reduce} sessions. The command \comm{Stop;} terminates \grg\ task and brings the session control menu. Batch file execution: \command{\opt{Input} "\parm{file}";} The batch file execution can be suspended by the command \comm{Pause;} and resumed by the command \comm{Next;}. The command \comm{Output "\parm{file}";}\vspace*{0.4mm} redirects all \grg\ output into the \parm{file}. The command \comm{EndO;} or \comm{End of Output;} closes the \parm{file} and restores standard output. \subsection{\sf\slshape Operating System Commands} The command \comm{System;} suspend \grg\ session and passes control to the operating system command level. The command \comm{System "\parm{command}";} executes single operating system \parm{command}. \subsection{\sf\slshape Comments}\vspace{-5mm} \command{Comment \parm{any text};\\\tt \parm{any command} \% \parm{any text};\\\tt \% \parm{any text};} \subsection{\sf\slshape Switches Control Commands} The commands \command{On \rpt{\parm{switch}}; \\\tt Off \rpt{\parm{switch}};} change the \parm{switch} position and the command \command{\opt{Show} Switch \parm{switch};\\\tt Show \parm{switch};} prints current \parm{switch} status. \subsection{\sf\slshape Info Commands} Time and garbage collection time commands: \command{\opt{Show} Time;\\\tt \opt{Show} GC Time;} The timer can be set to zero by the command \comm{Zero Time;}. The command \command{\opt{Show} Status;} print information about the current system directory, type of the metric, frame and basis. The command \comm{Show *;} prints the list of all built-in objects. The command \comm{Show a*;} prints the list of the built-in objects whose names begins with the character {\tt a}. Finally the command \command{Show \parm{object};} prints detailed information about the \parm{object} including its name, symbol, indices, symmetries, type of the component, current state and ways of calculation. The command \comm{Show All;} prints a list of objects whose values are currently known. \subsection{\sf\slshape Declarations} The dimension and signature declaration \command{Dimension \parm{dim} with \opt{Signature} (\rpt{\parm{pm}});} where \parm{pm} is {\tt +} or {\tt -}. The coordinates and constants declarations \command{Coordinates \rpt{\parm{x}};\\\tt Constants \rpt{\parm{c}};} The functions and generic function declarations \command{Functions \rpt{\parm{f}\,\,\opt{{\upshape (}\rpt{\parm{x}}{\upshape )}}};\\\tt Generic Functions \rpt{\parm{f}\,\,{\upshape (}\rpt{\parm{x}}{\upshape )}};} Function properties declaration \command{Symmetric \rpt{\parm{f}};\\\tt Antisymmetric \rpt{\parm{f}};\\\tt Odd \rpt{\parm{f}};\\\tt Even \rpt{\parm{f}}; } The command \comm{Affine Parameter \parm{s};} declares the affine parameter. \subsection{\sf\slshape New Object Declaration} The following equivalent declarations \command{New Object \parm{ID}\,\opt{\parm{ilst}}\,\opt{is \parm{ctype}}\,\opt{with \opt{Symmetries}\,\parm{slst}};\\\tt Object \parm{ID}\,\opt{\parm{ilst}}\,\opt{is \parm{ctype}}\,\opt{with \opt{Symmetries}\,\parm{slst}};\\\tt New \parm{ID}\,\opt{\parm{ilst}}\,\opt{is \parm{ctype}}\,\opt{with \opt{Symmetries}\,\parm{slst}}; } introduce new user-defined object, equation \command{New Equation \parm{ID}\,\opt{\parm{ilst}}\,\opt{is \parm{ctype}}\,\opt{with \opt{Symmetries}\,\parm{slst}};\\\tt Equation \parm{ID}\,\opt{\parm{ilst}}\,\opt{is \parm{ctype}}\,\opt{with \opt{Symmetries}\,\parm{slst}}; } or connection 1-form \command{New Connection \parm{ID}\,\opt{\parm{ilst}}\,\opt{is 1-form};\\\tt Connection \parm{ID}\,\opt{\parm{ilst}}\,\opt{is 1-form}; } Here \parm{ilst} is the index type list \comm{\rpt{\parm{ipos}\ \parm{itype}}} where \parm{ipos} is one of the markers denoting the index position \command{{\tt '}\rm\ \ upper frame \\{\tt .}\rm\ \ lower frame \\{\tt \^}\rm\ \ upper holonomic \\{\tt \ul}\rm\ \ lower holonomic } and \parm{itype} determines index type. For example: holonomic or frame indices {\tt a b c}, enumerating indices {\tt i3 i15 idim}, spinor {\tt A PQ MNL} and conjugated spinor indices {\tt A\cc\ PQ\cc\ MNL\cc}. The \parm{ctype} defines the type of the component: \command{Scalar \opt{Density \parm{dens}}\\\tt \parm{n}-form \opt{Density \parm{dens}}\\\tt Vector \opt{Density \parm{dens}}} The \parm{dens} defines pseudo-scalar and density properties of the object with respect to coordinate and frame transformations: \command{\opt{sgnL}\opt{*sgnD}\opt{*L\^\parm{n}}\opt{*D\^\parm{m}}} where \comm{D} and \comm{L} is the coordinate and frame transformation determinants respectively. The symmetry specification \parm{slst} is a list \rpt{\parm{slst1}}. Each \parm{slst1} is {\tt \parm{sym}(\rpt{\parm{slst2}})} where \parm{sym} is: \comm{a} for antisymmetry, \comm{t} for symmetry, \comm{c} for cyclic symmetry and \comm{h} for Hermitian symmetry. The \parm{slst2} is either index number, or list of index numbers or once again another symmetry specification \parm{slst1}. The command \comm{Forget \parm{object};} removes the user-defined \parm{object}. \subsection{\sf\slshape Assignment} The command \command{\opt{\parm{Name}}\,\rpt{\parm{ID}\,\opt{{\upshape(}\rpt{\parm{i}}{\upshape)}}=\parm{expr}};} assigns the value to the component(s) of the object \parm{Name} having the symbol \parm{ID}. \subsection{\sf\slshape Object Calculation} The command for calculating the value of an \parm{object} using built-in \parm{way} (formula): \command{Find \rpt{\parm{object}}\,\opt{\parm{way}};} Here \parm{object} is either the name or the symbol of the built-in object. The \parm{way} is either the name of the way or any object which is present at the right-hand side of the formula. The command \command{Null Metric;} makes the metric to be the \emph{standard null metric}. The command re-simplifies the \parm{object}. The command \command{Erase \parm{object};} removes the value of the \parm{object} and makes it indefinite once again. The command \command{Zero \parm{object};} assigns zero value to the \parm{object}. The command \command{Normalize \parm{equation};} replaces equation $l=r$ by $l-r=0$. \subsection{\sf\slshape Object Printing} The command \command{Write \rpt{\parm{object}}\,\,\opt{to "\parm{file}"};} prints the value of the \parm{object} (to the \parm{file} if present). The command \command{Write \opt{to "\parm{file}"};} redirects all output into the \parm{file}. The command \comm{EndW;} or \comm{End of Write;} closes the \parm{file} and restores standard output. The symbol {\tt >} can be used instead of {\tt to} in these commands. %\newpage The following commands print the line-element: \command{ds2;\\\tt Line-Element;} \subsection{\sf\slshape Expression Printing} The following commands evaluate expression \parm{expr} and print its value: \command{\opt{Print} \parm{expr} \opt{For \parm{iter}};\\\tt For \parm{iter} Print \parm{expr};} The parameter \parm{iter} determines that the \parm{expr} must be evaluated for several values of some variable. The \parm{iter} has the form: \command{\rpt{\parm{it}\,\opt{=\opt{\parm{lo}{\upshape..}}\parm{up}}}} The separator {\tt ,} can be replaced by one of the relational operators {\tt <\ \ >\ \ <=\ \ >=}. In general \parm{it} runs from \parm{lo} (or from 0 if \parm{lo} is omitted) to \parm{up}. If both \parm{lo} and \parm{up} are omitted then range of the symbol \parm{it} is determined by its form. For example: {\tt a p ijk} run from 0 to $d-1$ ($d$ is the dimension), {\tt a5 ij5} run from 0 to 5, {\tt a13 ij13} run from 1 to 3, {\tt A} runs from 0 to 1, {\tt AB} runs from 0 to 2, {\tt ABC} runs from 0 to 3 etc. \subsection{\sf\slshape Output Control} The following commands are identical to \command{Factor \rpt{\parm{expr}};\\\tt RemFac \rpt{\parm{expr}};\\\tt Order \rpt{\parm{expr}};} similar {\sc Reduce} commands. The command \comm{Line-Length \parm{n};} sets new output line width. \subsection{\sf\slshape Substitutions} The substitution commands are similar to corresponding {\sc Reduce} instructions \command{\opt{For All \rpt{\parm{x}}\,\opt{Such That \parm{cond}}} Let \rpt{\parm{sub}};\\\tt \opt{For All \rpt{\parm{x}}\,\opt{Such That \parm{cond}}} Match \rpt{\parm{sub}};\\\tt \opt{For All \rpt{\parm{x}}\,\opt{Such That \parm{cond}}} Clear \rpt{\parm{sub}}; } where \parm{sub} is either relation {\tt \parm{l}\,=\,\parm{r}} as in {\sc Reduce} or component of the solution {\tt Sol(\parm{n})}. \subsection{\sf\slshape Basis Mode Switching Commands} The command \command{Anholonomic;} switch \grg\ to the anholonomic basis mode and the command \command{Holonomic;} switches back to the default holonomic mode. \subsection{\sf\slshape Saving and Restoring the Data} The command \command{Unload \rpt{\parm{object}} to "\parm{file}";} saves the value of the \parm{object} into the \parm{file}. The command \command{Unload to "\parm{file}";} must be followed by the sequence of the commands \command{Unload \parm{object};} or comments. The sequence must be terminated by the command \comm{EndU;} or \comm{End of Unload;}. The symbol {\tt >} can be used instead of {\tt to}. The data saved by {\tt Unload} can be restored by the command \command{Load "\parm{file}";} The command \command{\opt{Show} File "\parm{file}";\\\tt Show "\parm{file}";} lists the objects saved into the \parm{file}. \subsection{\sf\slshape Algebraic Classification} The command \command{Classify \parm{object};} performs algebraic classification of the \parm{object}. \grg\ has built-in algorithms for the algebraic classification of the following irreducible spinors: $X_{A\dot{B}}$, $X_{AB}$, $X_{AB\dot{C}\dot{D}}$, $X_{ABCD}$. \subsection{\sf\slshape Coordinate Transformations} The coordinate transformation command: \longcommand{New Coordinates \rpt{\parm{new}} with \rpt{\parm{old}=\parm{expr}};} \subsection{\sf\slshape Frame Transformations} Frame rotation command \command{\opt{Make} Rotation \opt{\parm{matrix}};} The \parm{matrix} must be frame rotation, i.e. the metric must remain unchanged under the transformation. The \parm{matrix} has the following form \command{{\upshape (}\rpt{{\upshape (}\rpt{\parm{expr}}{\upshape )}}{\upshape )}} If \parm{matrix} is omitted then the rotation is taken from the object {\tt Frame Transformation}. The command \command{Change Metric \opt{\parm{matrix}};} is similar to the previous one but the \parm{matrix} is not necessary the rotation but any nonsingular matrix. The spinorial transformation command: \command{\opt{Make} Spinorial Rotation \opt{\parm{matrix}};} The \parm{matrix} must be SL(2,C) matrix. If the parameter \parm{matrix} is omitted then the matrix must be defined by the value of the object {\tt Spinorial Transformation}. The command \command{Hold \parm{object};} makes \grg\ to keep the \parm{object} unchanged under the frame transformation. The command \command{Release \parm{object};} removes the action of the {\tt Hold} command. \subsection{\sf\slshape Solving Equations} The algebraic equation solving command has two forms \command{Solve \parm{equation} for \rpt{\parm{x}};\\\tt Solve \rpt{\parm{l}=\parm{r}}\,\,for \rpt{\parm{x}};} where \parm{equation} is any built-in or user-defined equation. The solutions are stored into the special built-in object {\tt Solutions}. The command \command{\tt Inverse \parm{f},\,\parm{h};} declares the functions \parm{f} and \parm{h} to be inverse to each other. \subsection{\sf\slshape Loading Package} \command{\opt{Load} Package \parm{package};\\\tt Load \parm{package};} \section{\LARGE\sf\slshape Switches}\vspace*{-2mm} \chead{\slshape Commands and Switches} Switches in \grg\ are case insensitive. \tabcolsep=1.5mm \begin{tabular}{|c|c|l|} \hline \tt AEVAL & Off & Use aeval() instead of reval(). \\ \tt WRS & On & Re-simplify expr. before printing. \\ \tt WMATR & Off & Write 2-index objects in matrix form. \\ \tt TORSION & Off & Torsion. \\ \tt NONMETR & Off & Nonmetricity. \\ \tt UNLCORD & On & Save coordinates in {\tt Unload}. \\ \tt AUTO & On & Automatic data calculation in expr. \\ \tt TRACE & On & Trace the calculation process. \\ \tt SHOWCOMMANDS & Off & Show compound command expansion. \\ \tt EXPANDSYM & Off & Allow {\tt Sy Asy Cy}in expr. \\ \tt DFPCOMMUTE & On & Commutativity of {\tt DFP}. \\ \tt NONMIN & Off & Nonmin. interaction for scalar field. \\ \tt NOFREEVARS & Off & Prohibit free variables in {\tt Print}. \\ \tt CCONST & Off & Include cosm. constant in equations. \\ \tt FULL & Off & Number of components in {\tt Metric Eq}. \\ \tt LATEX & Off & \LaTeX\ output mode. \\ \tt GRG & Off & \grg\ output mode. \\ \tt REDUCE & Off & {\sc Reduce} output mode. \\ \tt MAPLE & Off & {\sc Maple} output mode. \\ \tt MATH & Off & {\sc Mathematica} output mode. \\ \tt MACSYMA & Off & {\sc Macsyma} output mode. \\ \tt DFINDEXED & Off & Print {\tt DF} in index notation. \\ \tt BATCH & Off & Batch mode. \\ \tt HOLONOMIC & On & Keep frame holonomic. \\ \tt SHOWEXPR & Off & Print expressions during algebraic \\ \tt & & classification. \\ \hline \end{tabular} \newpage \section{\LARGE\sf\slshape Synonymy} \chead{\slshape Synonymy} This is default \grg\ synonymy list. The symbols in each line are equivalent in all \grg\ commands and in the built-in object names. The case does not matter. So {\tt Affine} is equivalent to {\tt affine}, {\tt Aff}, {\tt aff} and so on. \begin{verbatim} Affine Aff Anholonomic Nonholonomic AMode ABasis Antisymmetric Asy Change Transform Classify Class Components Comp Connection Con Constants Const Constant Coordinates Cord Curvature Cur Dimension Dim Dotted Do Equation Equations Eq Erase Delete Del Evaluate Eval Simplify Find F Calculate Calc Form Forms Functions Fun Function Generic Gen Gravitational Gravity Gravitation Grav Holonomic HMode HBasis Inverse Inv Load Restore Next N Normalize Normal Object Obj Output Out Parameter Par Rotation Rot Scalar Scal Show ? Signature Sig Solutions Solution Sol Spinor Spin Spinorial Sp standardlisp lisp Switch Sw Symmetries Sym Symmetric Tensor Tensors Tens Torsion Tors Transformation Trans Undotted Un Unload Save Vector Vec Write W Zero Nullify \end{verbatim} \newpage \section{\LARGE\sf\slshape Expressions} \chead{\slshape Expressions} \subsection{\sf\slshape Operations and Operators} Notation: $e$ is any expression, $a$ is any scalar valued (algebraic) expressions, $v$ is any vector valued expression, $x$ is a coordinate, $o$ is any 1-form valued expression, $\omega$ is any form valued expression. \begin{tabular}{|c|c|c|} \hline {\tt [$v_1$,$v_2$]} & Vector bracket & \\ \hline {\tt @} $x$ & Holonomic vector $\partial_x$ & \\ \cline{1-2} {\tt d} $a$ & Exterior differential & \\ {\tt d} $\omega$ & & {\tt d} \cc$a$ $\Leftrightarrow$ {\tt (d(}\cc$a${\tt))} \\ \cline{1-2} {\tt \dd} $a$ & Dualization & \\ {\tt \dd} $\omega$ & & \\ \cline{1-2} {\tt \cc} $e$ & Complex conjugation & \\ \hline $a_1${\tt **}$a_2$ & Exponention & \\ $a_1${\tt\^} $a_2$ & & \\ \hline $e$\ {\tt /}\ $a$ & Division & $e${\tt /}$a_1${\tt /}$a_2$ $\Leftrightarrow$ {\tt (}$e${\tt /}$a_1${\tt )/}$a_2$ \\ \hline $a$\ {\tt *}\ $e$ & Multiplication & \\ \cline{1-2} $v$\ {\tt |}\ $a$ & Vector acting on scalar & $v$\ii$\omega_1$\w$\omega_2${\tt *}$a$ \\ \cline{1-2} $v$\ \ip\ $\omega$ & Interior product & $\Updownarrow$ \\ \cline{1-2} $v_1$\ {\tt.}\ $v_2$& Scalar product & $v$\ii{\tt (}$\omega_1$\w{\tt(}$\omega_2${\tt *}$a${\tt ))} \\ $v$\ {\tt.}\ $o$ & & \\ $o_1$\ {\tt.}\ $o_2$& & \\ \cline{1-2} $\omega_1$\ \w\ $\omega_2$ & Exterior product & \\ \hline {\tt +}\ $e$ & Prefix plus & \\ \cline{1-2} {\tt -}\ $e$ & Prefix minus & \\ \cline{1-2} $e_1$\ {\tt +}\ $e_2$ & Addition & \\ \cline{1-2} $e_1$\ {\tt -}\ $e_2$ & Subtraction & \\ \hline \end{tabular} \subsection{\sf\slshape Variables and Functions} Operator listed in the previous section can act on: (i) integer numbers (e.g. {\tt 0}, {\tt 123}), (ii) symbols or identifiers (e.g. {\tt I}, {\tt phi}, {\tt RIM0103}), (iii) functional expressions (e.g. {\tt SIN(x)}, {\tt G(0,1)} etc). Valid symbol must belong to one of the following types: \begin{itemize} \item Coordinate. \item Declared by user or built-in constant. \item Function declared with implicit dependence list. \item Component of an object. \end{itemize} Any valid functional expression must belong to one of the following types: \itemsep=0.5mm \begin{itemize} \item User-defined function. \item Function defined in {\sc Reduce} or in any loaded package. \item Component of an object in functional notation. \item Some special \grg\ functional expressions listed below. \end{itemize} \subsection{\sf\slshape Object Components} The components of built-in or user-defined object can be referred by two methods: using symbols {\tt dim}, {\tt VOL}, {\tt T0}, {\tt RIM0213} etc, or using functional notation {\tt T(0)}, {\tt RIM(0,2,1,3)}, {\tt OMEGA(i,j)}. In functional notation the default index type and position can be changed using the markers: {\tt '} upper frame, {\tt .} lower frame, {\tt \^} upper holonomic, {\tt \_} lower holonomic. For example: {\tt RIM('0,.1,\_2,\_3)}. \subsection{\sf\slshape Built-in Constants} \begin{tabular}{|l|l|} \hline \tt E I PI INFINITY & Mathematical constants $e,i,\pi$,$\infty$ \\ \hline \tt FAILED & \\ \hline \tt ECONST & Charge of the electron \\ \tt DMASS & Dirac field mass \\ \tt SMASS & Scalar field mass \\ \hline \tt GCONST & Gravitational constant \\ \tt CCONST & Cosmological constants \\ \hline \tt LC0 LC1 LC2 LC3 & Parameters of the quadratic \\ \tt LC4 LC5 LC6 & gravitational Lagrangian \\ \tt MC1 MC2 MC3 & \\ \hline \tt AC0 & Nonminimal interaction constant \\ \hline \end{tabular} \subsection{\sf\slshape Derivatives}\vspace*{-5mm} \command{DF(\parm{a},\rpt{\parm{x}\opt{{\upshape ,}\parm{n}}})\\\tt DFP(\parm{a},\rpt{\parm{x}\opt{{\upshape ,}\parm{n}}})}\vspace*{-1mm} {\tt DFP} derivatives are valid only after {\tt Generic Function} declaration. \subsection{\sf\slshape Complex Conjugation} These constructions are shortcuts for standard complex conjugation operations: \command{% \tt $e$ + \cc\cc\ $=$\ $e$ + \cc$e$ \\ \tt $e$ - \cc\cc\ $=$\ $e$ - \cc$e$ \\ \tt Re($e$)\ $=$\ ($e$ + \cc$e$)/2 \\ \tt Im($e$)\ $=$\ I*(-$e$ + \cc$e$)/2} \subsection{\sf\slshape Parts of Equations and Solutions} The functional expressions \command{LHS(\parm{eqcomp})\\\tt RHS(\parm{eqcomp})} give access to the left-hand and right-hand side of an equation respectively. They also provide access to the \parm{n}'th solution if \parm{eqcomp} is \comm{Sol(\parm{n})}. \subsection{\sf\slshape Sums and Products}\vspace*{-5mm} \command{Sum(\parm{iter},\parm{e})\\\tt Prod(\parm{iter},\parm{e})} The \parm{iter} specification is completely the same as in the {\tt Print For} command. \subsection{\sf\slshape Lie Derivatives} The Lie derivative \command{Lie(\parm{v},\parm{objcomp})} where \parm{objcomp} is the component of an object in functional notation. \subsection{\sf\slshape Covariant Derivatives and Differentials} The covariant differential \command{Dc(\parm{objcomp}\opt{{\upshape\tt ,}\rpt{\parm{conn}}})} and covariant derivative \command{Dfc(\parm{v},\parm{objcomp}\opt{{\upshape\tt ,}\rpt{\parm{conn}}})} Here \parm{objcomp} is an object component in functional notation and \parm{conn} is the symbol(s) of alternative connection 1-form(s). \subsection{\sf\slshape Symmetrization} The functional expressions \command{% Asy(\rpt{\parm{i}},\parm{e})\\\tt Sy(\rpt{\parm{i}},\parm{e})\\\tt Cy(\rpt{\parm{i}},\parm{e})} produces antisymmetrization, symmetrization and cyclic symmetrization of the expression \parm{e} with respect to \parm{i} (without corresponding $1/n$ or $1/n!$ etc). The switch {\tt EXPANDSYM} must be on. \subsection{\sf\slshape Substitutions} The expression \command{SUB(\rpt{\parm{sub}},\parm{e})} is similar to the analogous {\sc Reduce} one with two generalizations: (i) it applies not only to algebraic but to form and vector valued expression \parm{e} as well, (ii) as in {\tt Let} command \parm{sub} can be either the relation {\tt \parm{l}\,=\,\parm{r}} or solution {\tt Sub(\parm{n})}. \subsection{\sf\slshape Conditional Expressions} The conditional expression \command{If(\parm{cond},\parm{$e_1$},\parm{$e_2$})} chooses $e_1$ or $e_2$ depending on the value of the boolean expression \parm{cond}. Boolean expression appears in (i) the conditional expression {\tt If}, (ii) in {\tt For all Such That} substitutions. Any nonzero expression is considered as {\bf true} and vanishing expression as {\bf false}. Boolean expressions may contain the following usual relations and logical operations: {\tt < > <= >= = |= not and or}. They also may contain the predicates \begin{tabular}{|l|l|} \hline \tt OBJECT(\parm{obj}) & Is \parm{obj} an object or not \\ \hline \tt ON(\parm{switch}) & Test position of the \parm{switch} \\ \tt OFF(\parm{switch}) & \\ \hline \tt ZERO(\parm{object}) & Is the value of the \parm{object} zero or not \\ \hline \tt HASVALUE(\parm{object}) & Whether the \parm{object} has any value or not \\ \hline \tt NULLM(\parm{object}) & Is the \parm{object} the standard null metric \\ \hline \end{tabular} The expression \comm{ERROR("\parm{message}")} causes an error with the \comm{"\parm{message}"}. It can be used together with conditional expressions to test any required conditions during the batch file execution. \newpage \section{\LARGE\sf\slshape Macro Objects} \chead{\slshape Objects} Macro objects can be used in expression, in {\tt Write} and {\tt Show} commands but not in {\tt Find}. The indices are specified as in the {\tt New Object} declaration. \subsection{\sf\slshape Dimension and Signature} \begin{tabular}{|l|l|} \hline \tt dim & Dimension $d$ \\ \hline \tt sdiag.idim & {\tt sdiag(\parm{n})} is the $n$'th element of the \\ & signature diag($-1,+1$\dots) \\ \hline \tt sign & Product of the signature specification \\ \tt sgnt & elements $\prod_{n=0}^{d-1}\mbox{\tt sdiag(}n\mbox{\tt)}$ \\[1mm] \hline \tt mpsgn & {\tt sdiag(0)} \\ \tt pmsgn & {\tt -sdiag(0)} \\ \hline \end{tabular} \subsection{\sf\slshape Metric and Frame} \begin{tabular}{|l|l|} \hline \tt x\^m & $m$'th coordinate \\ \tt X\^m & \\ \hline \tt h'a\_m & Frame coefficients \\ \tt hi.a\^m & \\ \hline \tt g\_m\_n & Holonomic metric \\ \tt gi\^m\^n & \\ \hline \end{tabular} \subsection{\sf\slshape Delta and Epsilon Symbols} \begin{tabular}{|l|l|} \hline \tt del'a.b & Delta symbols \\ \tt delh\^m\_n & \\ \hline \tt eps.a.b.c.d & Totally antisymmetric symbols \\ \tt epsi'a'b'c'd & (number of indices depend on $d$) \\ \tt epsh\_m\_n\_p\_q & \\ \tt epsih\^m\^n\^p\^q & \\ \hline \end{tabular} \subsection{\sf\slshape Spinors} \begin{tabular}{|l|l|} \hline \tt DEL'A.B & Delta symbol \\ \hline \tt EPS.A.B & Spinorial metric \\ \tt EPSI'A'B & \\ \hline \tt sigma'a.A.B\cc & Sigma matrices \\ \tt sigmai.a'A'B\cc & \\ \hline \tt cci.i3 & Frame index conjugation in st. null frame \\ & {\tt cci(0)=0}\ {\tt cci(1)=1}\ {\tt cci(2)=3}\ {\tt cci(3)=2} \\ \hline \end{tabular} \subsection{\sf\slshape Connection Coefficients} \begin{tabular}{|l|l|} \hline \tt CHR\^m\_n\_p & Christoffel symbols $\{{}^\mu_{\nu\pi}\}$ \\ \tt CHRF\_m\_n\_p & and $[{}_{\mu},_{\nu\pi}]$ \\ \tt CHRT\_m & Christoffel symbol trace $\{{}^\pi_{\pi\mu}\}$ \\ \hline \tt SPCOEF.AB.c & Spin coefficients $\omega_{AB\,c}$ \\ \hline \end{tabular} \subsection{\sf\slshape NP Formalism} \begin{tabular}{|l|c|} \hline \tt PHINP.AB.CD~ & $\Phi_{AB\dot{C}\dot{D}}$ \\ \tt PSINP.ABCD & $\Psi_{ABCD}$ \\ \hline \tt alphanp & $\alpha$ \\ \tt betanp & $\beta$ \\ \tt gammanp & $\gamma$ \\ \tt epsilonnp & $\epsilon$ \\ \tt kappanp & $\kappa$ \\ \tt rhonp & $\rho$ \\ \tt sigmanp & $\sigma$ \\ \tt taunp & $\tau$ \\ \tt munp & $\mu$ \\ \tt nunp & $\nu$ \\ \tt lambdanp & $\lambda$ \\ \tt pinp & $\pi$ \\ \hline \tt DD & $D$ \\ \tt DT & $\Delta$ \\ \tt du & $\delta$ \\ \tt dd & $\overline\delta$ \\ \hline \end{tabular} \section{\LARGE\sf\slshape Built-in Objects} \tabcolsep=1mm The complete list of built-in objects with names and symbols. The case of the object names is not important but symbols are case sensitive. The indices are specified as in the {\tt New Object} declaration. Some names refer to a set of objects. For example the name {\tt Spinorial S - forms} denotes {\tt SU.AB} and {\tt SD.AB~}. \subsection{\sf\slshape Metric, Frame, Basis, Volume \dots} \begin{tabular}{|l|l|}\hline \tt Frame &\tt T'a\\ \tt Vector Frame &\tt D.a\\ \hline \tt Metric &\tt G.a.b\\ \tt Inverse Metric &\tt GI'a'b\\ \tt Det of Metric &\tt detG\\ \tt Det of Holonomic Metric &\tt detg\\ \tt Sqrt Det of Metric &\tt sdetG\\ \hline \tt Volume &\tt VOL\\ \hline \tt Basis &\tt b'idim \\ \tt Vector Basis &\tt e.idim \\ \hline \tt S-forms &\tt S'a'b\\ \hline \multicolumn{2}{|c|}{\tt Spinorial S-forms} \\ \tt Undotted S-forms &\tt SU.AB\\ \tt Dotted S-forms &\tt SD.AB\cc\\ \hline\end{tabular} \subsection{\sf\slshape Rotation Matrices} \begin{tabular}{|l|l|}\hline \tt Frame Transformation &\tt L'a.b \\ \tt Spinorial Transformation &\tt LS.A'B \\ \hline\end{tabular} \subsection{\sf\slshape Connection and related objects} \begin{tabular}{|l|l|}\hline \tt Frame Connection &\tt omega'a.b\\ \tt Holonomic Connection &\tt GAMMA\^m\_n\\ \hline \multicolumn{2}{|c|}{\tt Spinorial Connection}\\ \tt Undotted Connection &\tt omegau.AB\\ \tt Dotted Connection &\tt omegad.AB\cc\\ \hline \tt Riemann Frame Connection &\tt romega'a.b\\ \tt Riemann Holonomic Connection &\tt RGAMMA\^m\_n\\ \hline \multicolumn{2}{|c|}{\tt Riemann Spinorial Connection}\\ \tt Riemann Undotted Connection &\tt romegau.AB\\ \tt Riemann Dotted Connection &\tt romegad.AB\cc\\ \hline \tt Connection Defect &\tt K'a.b\\ \hline\end{tabular} \subsection{\sf\slshape Torsion} \begin{tabular}{|l|l|}\hline \tt Torsion &\tt THETA'a\\ \tt Contorsion &\tt KQ'a.b\\ \tt Torsion Trace 1-form &\tt QQ\\ \tt Antisymmetric Torsion 3-form &\tt QQA\\ \hline \multicolumn{2}{|c|}{\tt Spinorial Contorsion}\\ \tt Undotted Contorsion &\tt KU.AB\\ \tt Dotted Contorsion &\tt KD.AB\cc\\ \hline \multicolumn{2}{|c|}{\tt Torsion Spinors }\\ \multicolumn{2}{|c|}{\tt Torsion Components }\\ \tt Torsion Trace &\tt QT'a\\ \tt Torsion Pseudo Trace &\tt QP'a\\ \tt Traceless Torsion Spinor &\tt QC.ABC.D\cc\\ \hline \multicolumn{2}{|c|}{\tt Torsion 2-forms}\\ \tt Traceless Torsion 2-form &\tt THQC'a\\ \tt Torsion Trace 2-form &\tt THQT'a\\ \tt Antisymmetric Torsion 2-form &\tt THQA'a\\ \hline \multicolumn{2}{|c|}{\tt Undotted Torsion 2-forms}\\ \tt Undotted Torsion Trace 2-form &\tt THQTU'a\\ \tt Undotted Antisymmetric Torsion 2-form &\tt THQAU'a\\ \tt Undotted Traceless Torsion 2-form &\tt THQCU'a\\ \hline\end{tabular} \subsection{\sf\slshape Nonmetricity} \begin{tabular}{|l|l|}\hline \tt Nonmetricity &\tt N.a.b\\ \tt Nonmetricity Defect &\tt KN'a.b\\ \tt Weyl Vector &\tt NNW\\ \tt Nonmetricity Trace &\tt NNT\\ \hline \multicolumn{2}{|c|}{\tt Nonmetricity 1-forms}\\ \tt Symmetric Nonmetricity 1-form &\tt NC.a.b\\ \tt Antisymmetric Nonmetricity 1-form &\tt NA.a.b\\ \tt Nonmetricity Trace 1-form &\tt NT.a.b\\ \tt Weyl Nonmetricity 1-form &\tt NW.a.b\\ \hline\end{tabular} \subsection{\sf\slshape Curvature} \begin{tabular}{|l|l|}\hline \tt Curvature &\tt OMEGA'a.b\\ \hline \multicolumn{2}{|c|}{\tt Spinorial Curvature}\\ \tt Undotted Curvature &\tt OMEGAU.AB\\ \tt Dotted Curvature &\tt OMEGAD.AB\cc\\ \hline \tt Riemann Tensor &\tt RIM'a.b.c.d\\ \tt Ricci Tensor &\tt RIC.a.b\\ \tt A-Ricci Tensor &\tt RICA.a.b\\ \tt S-Ricci Tensor &\tt RICS.a.b\\ \tt Homothetic Curvature &\tt OMEGAH\\ \tt Einstein Tensor &\tt GT.a.b\\ \hline \multicolumn{2}{|c|}{\tt Curvature Spinors}\\ \multicolumn{2}{|c|}{\tt Curvature Components}\\ \tt Weyl Spinor &\tt RW.ABCD\\ \tt Traceless Ricci Spinor &\tt RC.AB.CD\cc\\ \tt Scalar Curvature &\tt RR\\ \tt Ricanti Spinor &\tt RA.AB\\ \tt Traceless Deviation Spinor &\tt RB.AB.CD\cc\\ \tt Scalar Deviation &\tt RD\\ \hline \multicolumn{2}{|c|}{\tt Undotted Curvature 2-forms}\\ \tt Undotted Weyl 2-form &\tt OMWU.AB \\ \tt Undotted Traceless Ricci 2-form &\tt OMCU.AB \\ \tt Undotted Scalar Curvature 2-form &\tt OMRU.AB \\ \tt Undotted Ricanti 2-form &\tt OMAU.AB \\ \tt Undotted Traceless Deviation 2-form &\tt OMBU.AB \\ \tt Undotted Scalar Deviation 2-form &\tt OMDU.AB \\ \hline \multicolumn{2}{|c|}{\tt Curvature 2-forms}\\ \tt Weyl 2-form &\tt OMW.a.b \\ \tt Traceless Ricci 2-form &\tt OMC.a.b \\ \tt Scalar Curvature 2-form &\tt OMR.a.b \\ \tt Ricanti 2-form &\tt OMA.a.b \\ \tt Traceless Deviation 2-form &\tt OMB.a.b \\ \tt Antisymmetric Curvature 2-form &\tt OMD.a.b \\ \tt Homothetic Curvature 2-form &\tt OSH.a.b \\ \tt Antisymmetric S-Ricci 2-form &\tt OSA.a.b \\ \tt Traceless S-Ricci 2-form &\tt OSC.a.b \\ \tt Antisymmetric S-Curvature 2-form &\tt OSV.a.b \\ \tt Symmetric S-Curvature 2-form &\tt OSU.a.b \\ \hline \end{tabular} \subsection{\sf\slshape EM field} \begin{tabular}{|l|l|}\hline \tt EM Potential &\tt A\\ \tt Current 1-form &\tt J\\ \tt EM Action &\tt EMACT\\ \tt EM 2-form &\tt FF\\ \tt EM Tensor &\tt FT.a.b\\ \hline \multicolumn{2}{|c|}{\tt Maxwell Equations}\\ \tt First Maxwell Equation &\tt MWFq\\ \tt Second Maxwell Equation &\tt MWSq\\ \hline \tt Continuity Equation &\tt COq\\ \tt EM Energy-Momentum Tensor &\tt TEM.a.b\\ \hline \multicolumn{2}{|c|}{\tt EM Scalars}\\ \tt First EM Scalar &\tt SCF\\ \tt Second EM Scalar &\tt SCS\\ \hline \tt Selfduality Equation &\tt SDq.AB\cc\\ \tt Complex EM 2-form &\tt FFU\\ \tt Complex Maxwell Equation &\tt MWUq\\ \tt Undotted EM Spinor &\tt FIU.AB\\ \tt Complex EM Scalar &\tt SCU\\ \tt EM Energy-Momentum Spinor &\tt TEMS.AB.CD\cc\\ \hline\end{tabular} \subsection{\sf\slshape Scalar field} \begin{tabular}{|l|l|}\hline \tt Scalar Equation &\tt SCq\\ \tt Scalar Field &\tt FI\\ \tt Scalar Action &\tt SACT\\ \tt Minimal Scalar Action &\tt SACTMIN\\ \tt Minimal Scalar Energy-Momentum Tensor &\tt TSCLMIN.a.b\\ \hline\end{tabular} \subsection{\sf\slshape YM field} \begin{tabular}{|l|l|}\hline \tt YM Potential &\tt AYM.i9\\ \tt Structural Constants &\tt SCONST.i9.j9.k9\\ \tt YM Action &\tt YMACT\\ \tt YM 2-form &\tt FFYM.i9\\ \tt YM Tensor &\tt FTYM.i9.a.b\\ \hline \multicolumn{2}{|c|}{\tt YM Equations}\\ \tt First YM Equation &\tt YMFq.i9\\ \tt Second YM Equation &\tt YMSq.i9\\ \hline \tt YM Energy-Momentum Tensor &\tt TYM.a.b\\ \hline\end{tabular} \subsection{\sf\slshape Dirac field} \begin{tabular}{|l|l|}\hline \multicolumn{2}{|c|}{\tt Dirac Spinor}\\ \tt Phi Spinor &\tt PHI.A\\ \tt Chi Spinor &\tt CHI.B\\ \hline \tt Dirac Action 4-form &\tt DACT\\ \tt Undotted Dirac Spin 3-Form &\tt SPDIU.AB\\ \tt Dirac Energy-Momentum Tensor &\tt TDI.a.b\\ \hline \multicolumn{2}{|c|}{\tt Dirac Equation}\\ \tt Phi Dirac Equation &\tt DPq.A\cc\\ \tt Chi Dirac Equation &\tt DCq.A\cc\\ \hline\end{tabular} \subsection{\sf\slshape Geodesics} \begin{tabular}{|l|l|}\hline \tt Geodesic Equation &\tt GEOq\^m\\ \hline\end{tabular} \subsection{\sf\slshape Null Congruence} \begin{tabular}{|l|l|}\hline \tt Congruence &\tt KV\\ \tt Null Congruence Condition &\tt NCo\\ \tt Geodesics Congruence Condition&\tt GCo'a\\ \hline \multicolumn{2}{|c|}{\tt Optical Scalars}\\ \tt Congruence Expansion &\tt thetaO\\ \tt Congruence Squared Rotation &\tt omegaSQO\\ \tt Congruence Squared Shear &\tt sigmaSQO\\ \hline\end{tabular} \subsection{\sf\slshape Kinematics} \begin{tabular}{|l|l|}\hline \tt Velocity Vector &\tt UV\\ \tt Velocity &\tt UU'a\\ \tt Velocity Square &\tt USQ\\ \tt Projector &\tt PR'a.b\\ \hline \multicolumn{2}{|c|}{\tt Kinematics}\\ \tt Acceleration &\tt accU'a\\ \tt Vorticity &\tt omegaU.a.b\\ \tt Volume Expansion &\tt thetaU\\ \tt Shear &\tt sigmaU.a.b\\ \hline\end{tabular} \subsection{\sf\slshape Ideal and Spin Fluid} \begin{tabular}{|l|l|}\hline \tt Pressure &\tt PRES\\ \tt Energy Density &\tt ENER\\ \tt Ideal Fluid Energy-Momentum Tensor &\tt TIFL.a.b\\ \hline \tt Spin Fluid Energy-Momentum Tensor &\tt TSFL.a.b \\ \tt Spin Density &\tt SPFLT.a.b \\ \tt Spin Density 2-form &\tt SPFL \\ \tt Undotted Fluid Spin 3-form &\tt SPFLU.AB \\ \tt Frenkel Condition &\tt FCo \\ \hline\end{tabular} \subsection{\sf\slshape Total Energy-Momentum and Spin} \begin{tabular}{|l|l|}\hline \tt Total Energy-Momentum Tensor &\tt TENMOM.a.b\\ \tt Total Energy-Momentum Spinor &\tt TENMOMS.AB.CD\cc\\ \tt Total Energy-Momentum Trace &\tt TENMOMT\\ \tt Total Undotted Spin 3-form &\tt SPINU.AB\\ \hline\end{tabular} \subsection{\sf\slshape Einstein Equations} \begin{tabular}{|l|l|}\hline \tt Einstein Equation &\tt EEq.a.b\\ \hline \multicolumn{2}{|c|}{\tt Spinor Einstein Equations}\\ \tt Traceless Einstein Equation &\tt CEEq.AB.CD\cc\\ \tt Trace of Einstein Equation &\tt TEEq\\ \hline\end{tabular} \subsection{\sf\slshape Constants} \begin{tabular}{|l|l|}\hline \tt A-Constants &\tt ACONST.i2\\ \tt L-Constants &\tt LCONST.i6\\ \tt M-Constants &\tt MCONST.i3\\ \hline\end{tabular} \subsection{\sf\slshape Gravitational Equations} \begin{tabular}{|l|l|}\hline \tt Action &\tt LACT\\ \tt Undotted Curvature Momentum &\tt POMEGAU.AB\\ \tt Torsion Momentum &\tt PTHETA'a\\ \hline \multicolumn{2}{|c|}{\tt Gravitational Equations}\\ \tt Metric Equation &\tt METRq.a.b\\ \tt Torsion Equation &\tt TORSq.AB\\ \hline\end{tabular} \end{document} %======== End of guide32.tex ============================================% |
Added new-in32.txt version [d65e9a79c3].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 | This file is part of GRG 3.2 Copyright (C) 1997 Vadim V. Zhytnikov This note outlines the main new features of GRG 3.2 compared to the previous version GRG 3.1. Detailed description of GRG 3.2 can be found in the manual. 1. Dimensionality and Signature GRG 3.2 removes the most important restriction of GRG 3.1 - now GRG 3.2 works in any dimension greater or equal 2. The only signatures GRG 3.1 works with are (-1,1,1,1) or (1,-1,-1,-1). In GRG 3.2 you can specify any signature of the form diag(+1,-1,...). 2. Metric and Frame In GRG 3.1 the space-time metric can be specified only in the form of the tetrad and the tetrad metric must be quasi-orthogonal (here "quasi" means any metric having constant coefficients: null, semi-null, diagonal Lorentzian etc). In GRG 3.2 you can use arbitrary metric and frame (in GRG 3.2 we use the name "frame" instead of "tetrad" since the latter is essentially 4-dimensional). In general the space-time line-element in GRG 3.1 and 3.2 is 2 i j d s = G T T ij Here G.i.j (M in GRG 3.1) is the Metric and T'i is frame (former Tetrad). In GRG 3.1 the G (M) has predefined value equals to Null Metric and can be changed only by assigning a new value to M or loading the file "lorentz.loa" or similar. Even more, the coefficients of M in GRG 3.1 must be constant ("tetrad" formalism). In GRG 3.2 both G.i.j and T'i are initially indefinite. You can assign any value to these quantities and G is no not necessary constant now. But if no value is given to G or T then GRG 3.2 automatically assumes the default values to these quantities i i T = d x G = diag(i,j) ij where diag(i,j) is the matrix having only diagonal nonzero elements +1 or -1 according to current signature. For example, if dimensionality 3 with the signature diag(+1,-1,+1) and no value is specified to T and G than GRG 3.2 automatically assumes 0 1 2 G = diag(+1,-1,+1), T = d x0, T = d x1, T = d x2, ij which gives finally 2 2 2 2 d s = d x0 - d x1 + d x2 where x0, x1, x2 are the coordinates. Thus, if you want to work in "tetrad" formalism - give the value to T and leave G to be default constant diagonal metric. Otherwise, if you want to use usual coordinate formalism - assign the value to G only and the default holonomic value will be automatically assigned to frame T. 3. Nonmetricity GRG 3.2 works with arbitrary affine connection having both the torsion and nonmetricity. The corresponding switches TORSION and NONMETR determine the connection type. 4. Better Representation of Built-in and User-Defined objects GRG 3.2 knows various symmetries with respect to index permutation: symmetry, antisymmetry, cyclic symmetry and Hermitian symmetry. All these symmetries can be applied to both single indices and the groups of indices. The groups of symmetric indices can be nested (like the symmetries of the Riemann curvature tensor). In GRG 3.2 the built-in and user-defined objects can have indices of the following types: holonomic (coordinate) indices (new), frame indices, undotted and dotted spinorial indices, and enumerating indices. All indices can be upper and lower (upper spinorial indices are new). GRG 3.2 understands tensor densities and pseudo-tensors. The "New Object" declaration is redesigned to account for the aforementioned changes. 5. Output Modes The new and quite unique feature of GRG 32 is that it can export the results of computations into other programs. Now GRG 3.2 supports output modes for all major computer algebra systems Maple, Mathematica, Macsyma, REDUCE and the document preparation system LaTeX. Thus, for example, you can write result of computation into a file in the Maple input format and later use Maple to work with the data. LaTeX output mode allows one to insert the results of computation into a document. 6. GRG 3.2 is compatible with the REDUCE graphic-shells such as XR (under UNIX) or PSLLW (under MS Windows). In graphic mode GRG 3.2 provides niece output with greek characters, integral signs etc. 7. The quite restrictive feature of GRG 3.1 is that it permits to use only some fixed set of the REDUCE built-in functions (such as SIN, COS, LOG etc) and switches. GRG 3.2 is not so restrictive. You can use any REDUCE switch, function (operator in the REDUCE terminology) or user-defined procedure. For example: (a) You can load the package specfn and use in GRG all special function defined in this package. (b) You can write your own procedure in the REDUCE language and apply it in GRG. (c) You can use built-in REDUCE operators such as INT, LIMIT, SUM, PROD, DEN, NUM and any other. Notice also GRG 3.2 allows one to apply REDUCE procedures and functions not only to algebraic expressions but to vectors and exterior forms in accordance to the distributive law. 8. Many GRG built-in objects and formulas (ways of calculation) have limited scope. Some are valid in a particular dimension only, some, like spinors, require standard null frame etc. GRG 3.2 always checks the applicability conditions for any built-in object and formula. 9. The mechanism for computing covariant differentials and Lie derivatives in GRG 3.1 is rather clumsy. In GRG 3.2 it is completely replaced by another simpler and more natural method: one can use covariant exterior differentials, covariant derivatives and Lie derivatives directly in expressions. 10. In GRG 3.2 one can access the left- and right-hand side of equations using LHS(...) and RHS(...). The equations are properly transformed under the frame (tetrad) rotation and the coordinate transformations. 11. In GRG 3.2 expressions are case sensitive but commands and names of objects are not. Thus, the variable alpha is different from ALPHA but command Find is the same as find, FIND etc. 12. Usually irreducible spinors are labelled in GRG by so called summed spinorial index. This method provides the most efficient way to store irreducible spinor components but it is inconvenient when the spinor is used in expressions. Now any irreducible spinor can be labeled by both single summed index of rank N or by a group of N single spinorial indices. Analogously the frame index (for null frame) can be also represented as a pair of single spinorial indices. 13. GRG 3.2 provides simple interface to the REDUCE algebraic equation solver. The solutions can be used in the "Let" and "SUB" substitutions. 14. GRG 3.2 includes algebraic classification schemes for the following spinors: Weyl spinor W_ABCD, Traceless Ricci spinor C_AB_CD~, Electromagnetic stress spinor F_AB, Vector V_A_B~ (in spinorial representation). The work of all classification algorithms is traced. The command Petrov Type; is replaced by the command Classify <object>;. 15. If some built-in object has several ways of calculation GRG 3.2 provides better method for choosing the particular way. One can indicate the way both by its name and by specifying any object which is present in the right-hand side of the corresponding formula. 16. GRG 3.2 provide interface to the REDUCE package dfpart.red written by H. Melenk. This very useful package introduces the notion of the partial derivative of a function with respect to its n-th argument and performs the chain differentiation. 17. Configuring GRG GRG 3.2 has some configuration facilities. The configuration file allows one to define: (a) the default dimensionality and signature, (b) the default position of switches, (c) the packages which must be preloaded, (d) the synonymy for the commands. Actually there are two configuration files. The first grgcfg.sl defines the "global" GRG configuration at the moment of the compilation. You can edit this file before compiling GRG and the corresponding settings will be active whenever GRG is started. The second configuration file grg.cfg is optional. You can keep it in your working directory to override the "global" settings. Another configuration tool is the environment variable "grg". This environment variable should contain the name of some directory (so called GRG System Directory). This directory can serve as the depository for the files which are oftenly used. So it is not necessary to have their copy in every working directory. 18. The GRG commands are terminated now only by the symbol ; (not by ; and ?). The end-of-file symbol for GRG batch files has changed from ! to $. 19. The GRG 3.1 command Help <object>; is replaced by the command Show <object>;. The commands Mode; and Signature; are replaced by the command Status;. 20. Built in Objects and Ways of calculation The list of built-in objects and formulas is significantly changed. Some objects and ways of calculation are renamed, some abolished but many other are added. Now GRG 3.2 has built-in object and formulas for: - Connection, torsion, nonmetricity (new). - Curvature. - Irreducible decomposition of the curvature, torsion, and nonmetricity in any dimension (new). - Einstein equations. - Scalar field with minimal and non-minimal interaction. - Electromagnetic field. - Yang-Mills field. - Dirac spinor field. - Geodesic equation (new). - Optical scalars (new). - Kinematics for time-like congruences (new). - Ideal fluid and spin fluid (new). - Newman-Penrose formalism (new). - Gravitational equations for the theory with arbitrary gravitational Lagrangian in Riemann and Riemann-Cartan spaces. ---------------------------------------------------------------------- |
Added pgt.low version [eadb6ff427].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | % Exact soluition of the Poincare Gauge Theory with the Kerr-Newman in De Sitter metric; Zero Time; Coordinates t,r,th,ph; Constants m,j,q,L; Find Metric; Functions f(th),Si(r,th),De(r),J(th),Q(r); Frame T0 = sqrt(De)/sqrt(Si)*(d t + j*sin(th)^2*d ph), T1 = sqrt(Si)/sqrt(De)*d r, T2 = sqrt(Si)/sqrt(f)*d th, T3 = sqrt(f)/sqrt(Si)*sin(th)*(j*d t + (r^2+j^2)*d ph); Constants L0,L1,L2,L3,L4,L5,L6; L-Constants LCONST1 = L0, LCONST2 = -L0+2*L1, LCONST3 = L0+2*L3-2*L1, LCONST4 = L0+2*L5-2*L2, LCONST5 = -L0+2*L2, LCONST6 = L0+2*L4-2*L2, LCONST0 = 1; FF = sqrt(1+2/3*L*L3)/sqrt(GCONST)*q/Si^2*( (r^2-J^2)*S01 +2*r*J*S23); On TORSION,CCONST; New V.n5; V1=1/Si^2*((Q-q^2/2)*r-m*J^2); V2=-sqrt(f)/sqrt(Si)/Si^2*Q*j*sin(th)*J; V3=sqrt(f)/sqrt(Si)/Si^2*Q*j*sin(th)*r; V4=1/Si^2*Q*J; V5=1/Si^2*Q*r; Torsion THETA0 = sqrt(Si)/sqrt(De)*(V1*S01+2*V4*S23) + Si/De*(-V2*(S02-S12)-V3*(S03-S13)), THETA2 = sqrt(Si)/sqrt(De)*(-V5*(S02-S12)-V4*(S03-S13)), THETA3 = sqrt(Si)/sqrt(De)*( V4*(S02-S12)-V5*(S03-S13)); THETA1 = THETA0; Transform Metric ( (1/sqrt(2),-1/sqrt(2),0,0), (1/sqrt(2), 1/sqrt(2),0,0), (0,0,1/sqrt(2), i/sqrt(2)), (0,0,1/sqrt(2),-i/sqrt(2)) ); Find Maxwell Eq, TEM; Find Curvature Components; Show Time; Let sin(th)^2=1-cos(th)^2; Let f = 1 + L/3*j^2*cos(th)^2; Let Si = r^2 + j^2*cos(th)^2; Let De = r^2 + j^2 + q^2 - 2*m*r - L/3*r^2*(r^2+j^2); Let Q = m*r-q^2/2; Let J = j*cos(th); Evaluate All; Show Time; Write Maxwell Eq; Write Curvature Components; Let CCONST=L; Let MC1=-2-4/3*L*L3, MC2=4+8/3*L*L3; Find and Write Gravitational Equations; Show Time; |
Added pgt.up version [d2f384d413].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | % Exact soluition of the Poincare Gauge Theory with the Kerr-Newman in De Sitter metric; Zero Time; Coordinates t,r,th,ph; Constants m,j,q,L; Find Metric; Functions f(th),Si(r,th),De(r),J(th),Q(r); Frame T0 = SQRT(De)/SQRT(Si)*(d t + j*SIN(th)^2*d ph), T1 = SQRT(Si)/SQRT(De)*d r, T2 = SQRT(Si)/SQRT(f)*d th, T3 = SQRT(f)/SQRT(Si)*SIN(th)*(j*d t + (r^2+j^2)*d ph); Constants L0,L1,L2,L3,L4,L5,L6; L-Constants LCONST1 = L0, LCONST2 = -L0+2*L1, LCONST3 = L0+2*L3-2*L1, LCONST4 = L0+2*L5-2*L2, LCONST5 = -L0+2*L2, LCONST6 = L0+2*L4-2*L2, LCONST0 = 1; FF = SQRT(1+2/3*L*L3)/SQRT(GCONST)*q/Si^2*( (r^2-J^2)*S01 +2*r*J*S23); On TORSION,CCONST; New V.n5; V1=1/Si^2*((Q-q^2/2)*r-m*J^2); V2=-SQRT(f)/SQRT(Si)/Si^2*Q*j*SIN(th)*J; V3=SQRT(f)/SQRT(Si)/Si^2*Q*j*SIN(th)*r; V4=1/Si^2*Q*J; V5=1/Si^2*Q*r; Torsion THETA0 = SQRT(Si)/SQRT(De)*(V1*S01+2*V4*S23) + Si/De*(-V2*(S02-S12)-V3*(S03-S13)), THETA2 = SQRT(Si)/SQRT(De)*(-V5*(S02-S12)-V4*(S03-S13)), THETA3 = SQRT(Si)/SQRT(De)*( V4*(S02-S12)-V5*(S03-S13)); THETA1 = THETA0; Transform Metric ( (1/SQRT(2),-1/SQRT(2),0,0), (1/SQRT(2), 1/SQRT(2),0,0), (0,0,1/SQRT(2), I/SQRT(2)), (0,0,1/SQRT(2),-I/SQRT(2)) ); Find Maxwell Eq, TEM; Find Curvature Components; Show Time; Let SIN(th)^2=1-COS(th)^2; Let f = 1 + L/3*j^2*COS(th)^2; Let Si = r^2 + j^2*COS(th)^2; Let De = r^2 + j^2 + q^2 - 2*m*r - L/3*r^2*(r^2+j^2); Let Q = m*r-q^2/2; Let J = j*COS(th); Evaluate All; Show Time; Write Maxwell Eq; Write Curvature Components; Let CCONST=L; Let MC1=-2-4/3*L*L3, MC2=4+8/3*L*L3; Find and Write Gravitational Equations; Show Time; |
Added test.red version [c78301acc3].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | off echo$ % This file is the part of GRG 3.2 (C) 1997 V.V.Zhytnikov lisp$ begin scalar psl,low,lis,cas,ok; psl := getd 'dskin; low := getd '!c!a!r; if psl then lis := "PSL" else lis:= "CSL"; if low then cas := "Lower" else cas := "Upper"; prin2 "This REDUCE is based on "; prin2 lis; prin2 " and is "; prin2 cas; prin2 "-Cased."; terpri(); if low then << prin2 "Use lower-case symbols for built-in constans and functions:"; terpri(); prin2 " e i pi sin cos log ..."; >> else << prin2 "Use upper-case symbols for built-in constans and functions:"; terpri(); prin2 " E I PI SIN COS LOG ..."; >>; terpri(); terpri(); end$ algebraic$ end; |
Added timing.txt version [4d5b1bcab4].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 | This file is part of GRG 3.2 Copyright (C) 1997-2000 Vadim V. Zhytnikov GRG 3.2 and REDUCE Timing Here I collected some statistics on the performance of REDUCE and GRG 3.2 on various platforms. This information can be useful if you want to estimate which type of machine you need for your problems. The statistics includes timing for three different tests: 1. First time T1 is the run-time of the standard REDUCE test reduce.tst. To run this test you have to start REDUCE and type the command in "$reduce/xmpl/reduce.tst"; 2. Second test T2 is the computation of the irreducible curvature spinors for the Bondi metric. This metric is widely used for comparing performance of computer algebra systems in general relativity. To run this test you have to start REDUCE and GRG and enter the command "bondi.up"; or "bondi.low"; You must use "bondi.up"; if after start GRG prints System variables are upper-cased: E I PI SIN ... and "bondi.low"; if the message reads System variables are lower-cased: e i pi sin ... The output of this test is stored automatically into the file bondi.out and the timing can be found at the end of this file: Time: XX.XX sec (Y%GC) 3. Two previous tests run quite fast on modern computers and their typical run-time is just several seconds. Thus they do not reflect properly the performance for really hard computations. The third test is a more complicated task which usually runs many minutes and requires 8Mb of RAM or more. This test computes field equations for some exact solution of the Poincare Gauge Theory of Gravitation with dynamical torsion. To run this test you have to start GRG and type "pgt.up"; or "pgt.low"; as explained above. Type quit; to terminate GRG session. All timings below are given in seconds. The GRG timings T2 and T3 are given including the garbage collection time and the garbage collection percentage is shown in parentheses. ------------------------------------------------------------------------------ Machine and OS: REDUCE: T1: T2: T3: ------------------------------------------------------------------------------ Notebooks i86: Cx486DX 33MHz (DOS) 3.4 PSL 7Mb 5.2 15.0 (3%) 2911.5 (19%) Cx486DX 33MHz (DOS) 3.5 PSL 7Mb 5.7 27.4 (2%) 5216.1 (14%) Cx486DX 33MHz (DOS) 3.6 PSL 7Mb 6.0 26.0 (2%) 3933.3 (11%) PC i86: 386DX 40MHz (DOS) 3.4 PSL 3Mb 9.0 27.6 (1%) 486DX2 66MHz (DOS) 3.4 CSL 10Mb 5.8 27.8 (0%) 5174.9 (8%) 486DX2 66MHz (DOS) 3.5 PSL 8Mb 2.9 13.2 (3%) 2605.0 (12%) 486DX2 66MHz (Win3.1) 3.5 PSL 15Mb 3.5 13.0 (0%) 2389.7 (5%) 486DX2 66MHz (DOS) 3.4 PSL 18Mb 3.2 7.3 (0%) 1215.5 (7%) 486DX2 66MHz (DOS) 3.6 PSL 18Mb 3.5 12.2 (0%) 1851.6 (3%) Pentium 100MHz (DOS) 3.4 PSL 10Mb 1.3 3.5 (0%) 610.0 (10%) Pentium 100MHz (DOS) 3.4 PSL 10Mb 0.77 2.1 (0%) 401.6 (13%) Pentium 166MHz (DOS) 3.4 PSL 7Mb 0.66 1.6 (3%) 314.2 (21%) Pentium MMX 166MHz (DOS) 3.4 PSL 8Mb 0.33 1.2 (4%) 226.3 (20%) Pentium MMX 166MHz (DOS) 3.4 PSL 24Mb 0.33 1.1 (0%) 191.9 (6%) Pentium MMX 233MHz (DOS) 3.4 PSL 48Mb 0.38 0.9 (0%) 145.3 (3%) Pentium MMX 233MHz (DOS) 3.5 PSL 48Mb 0.28 1.6 (0%) 317.4 (1%) Pentium MMX 233MHz (DOS) 3.6 PSL 48Mb 0.38 1.7 (0%) 251.7 (1%) Pentium MMX 233MHz (Linux) 3.6 PSL 36Mb 0.39 1.6 (0%) 226.3 (1%) Pentium Pro 200MHz 256Kb (DOS) 3.4 PSL 24Mb 0.31 0.8 (0%) 127.9 (5%) Pentium Pro 200MHz 256Kb (DOS) 3.6 PSL 24Mb 0.49 1.3 (0%) 192.2 (2%) Pentium II 233MHz (DOS) 3.4 PSL 48Mb 0.27 0.6 (0%) 109.1 (3%) Pentium II 233MHz (DOS) 3.6 PSL 48Mb 0.44 1.3 (0%) 181.9 (1%) Pentium II 233MHz (Linux) 3.6 PSL 36Mb 0.30 1.1 (0%) 136.4 (2%) Pentium II 233MHz (Linux) 3.7 PSL 48Mb 1.3 (0%) 143.5 (1%) Pentium II 266MHz (DOS) 3.4 PSL 48Mb 0.26 0.6 (0%) 96.2 (3%) Pentium II 266MHz (DOS) 3.6 PSL 48Mb 0.34 1.1 (0%) 154.2 (1%) K6-2 350MHz (DOS) 3.4 PSL 32Mb 0.5 0.8 (0%) 114.5 (4%) K6-2 400MHz (DOS) 3.4 PSL 48Mb 0.6 (0%) 101.3 (3%) K6-2 400MHz (DOS) 3.6 PSL 48Mb 0.9 (0%) 166.7 (1%) Celeron A 366MHz (DOS) 3.4 PSL 48Mb 0.1 0.4 (0%) 70.2 (4%) Celeron A 366MHz (DOS) 3.6 PSL 48Mb 0.2 0.8 (0%) 146.0 (1%) Celeron A 366MHz (Linux) 3.6 PSL 48Mb 0.2 0.7 (0%) 110.3 (2%) Celeron A 366MHz (Linux) 3.7 PSL 48Mb 0.9 (0%) 116.6 (1%) Pentium II 450MHz (DOS) 3.4 PSL 36Mb 0.2 0.3 (0%) 62.1 (4%) Pentium III 450MHz (DOS) 3.4 PSL 48Mb 0.6 (0%) 60.4 (4%) Pentium III 450MHz (DOS) 3.6 PSL 48Mb 0.3 (0%) 101.5 (1%) Celeron A 500MHz (DOS) 3.4 PSL 48Mb 0.4 (0%) 53.7 (4%) Celeron A 500MHz (DOS) 3.6 PSL 48Mb 0.6 (0%) 118.9 (1%) Celeron A 500MHz (Linux) 3.7 PSL 48Mb 0.6 (0%) 97.1 (1%) Pentium III E 500MHz (DOS) 3.4 PSL 48Mb 50.6 (5%) Pentium III E 500MHz (DOS) 3.6 PSL 48Mb 75.6 (2%) Pentium III E 667MHz (DOS) 3.4 PSL 48Mb 39.3 (6%) Pentium III E 667MHz (DOS) 3.6 PSL 48Mb 58.1 (2%) Pentium III E 733MHz (DOS) 3.4 PSL 48Mb 33.6 (4%) Pentium III E 733MHz (Win98) 3.6 CSL/WC 48Mb 156.0 (1%) Pentium III E 733MHz (Win98) 3.6 CSL/VC 48Mb 67.0 (2%) Pentium III E 733MHz (DOS) 3.6 PSL 48Mb 50.8 (1%) Pentium III E 733MHz (Linux) 3.7 PSL 48Mb 38.9 (2%) IBM RS/6000: RS/6000 3BT (AIX) 3.5 PSL 8Mb 1.1 6.0 (5%) 1267.1 (15%) RS/6000 590 (AIX) 3.5 PSL 8Mb 1.1 5.9 (5%) 1226.8 (15%) SPARC: SPARC 1+ 65MHz 3.6 PSL 20Mb 3.2 12.5 (0%) 1716.1 (5%) SPARC 2 75MHz 3.6 PSL 20Mb 2.1 7.8 (0%) 1132.2 (4%) SPARC 10/20 SuperSPARC 33MHz 3.6 PSL 20Mb 1.4 5.9 (0%) 832.0 (3%) SPARC 4 microSPARC 110MHz 3.6 PSL 20Mb 0.98 3.5 (0%) 442.0 (3%) SPARC 20-612 2xSuperSPARC 60MHz 3.6 PSL 20Mb 0.76 3.2 (0%) 431.1 (4%) HyperSPARC 22 2xHyperSPARC 125MHz 3.6 PSL 20Mb 0.58 2.3 (0%) 308.4 (4%) Ultra 1 UltraSPARC 167MHz 3.6 PSL 20Mb 0.30 1.2 (0%) 187.9 (4%) Ultra 2 2xUltraSPARC 167MHz 3.6 PSL 20Mb 0.31 1.2 (0%) 190.5 (4%) Ultra 2 2xUltraSPARC 167MHz 3.7 PSL 120Mb 299.0 (0%) Ultra 4 4xUltraSPARC-II 400MHz 3.7 PSL 120Mb 113.1 (0%) Ultra 5/10 UltraSPARC-IIi 440MHz 3.7 PSL 120Mb 114.6 (0%) ------------------------------------------------------------------------------ |
Added xcompile.psl version [2e341a1b08].
> > > > | 1 2 3 4 | lisp$ off echo$ dskin "grgxcomp.sl"$ end; |