Overview
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: 96e7dce1263efdde8345bf0da312acf2c636a4aa4658be4cf7c82b65768bc9b2
User & Date: jeff@gridfinity.com on 2021-03-01 03:28:28
Other Links: manifest | tags
Context
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
Changes

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;


GRG for REDUCE
GRG Homepage | GitHub Mirror | SourceHut Mirror | NotABug Mirror | Chisel Mirror | Chisel RSS ]