#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  hybridinfo hybridnum hybridsym generror
# Wrapped by karin@borodin on Wed Jul 24 21:50:48 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'hybridinfo' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'hybridinfo'\"
else
echo shar: Extracting \"'hybridinfo'\" \(28647 characters\)
sed "s/^X//" >'hybridinfo' <<'END_OF_FILE'
X% SYMCON  hybridinfo 
Xoff echo$
X
X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
X%%%
X%%% facts about representrations and subgroups for hybridconjug 
X%%%
X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
X
X
Xsymbolic procedure dimsofrep(group);
X% number of representations, dimension 
Xbegin
X  scalar res;
X  if reval(group) = 'D4 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1),list(3,1 ./ 1),list(4,1 ./ 1),
X               list(5,2 ./ 1));
X  if reval(group) = 'D5 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1),list(3,2 ./ 1),list(4,2 ./ 1));
X  if reval(group) = 'D6 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1),list(3,1 ./ 1),list(4,1 ./ 1),
X               list(5,2 ./ 1),list(6,2 ./ 1));
X  if reval(group) = 'D3 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1),
X                                     list(3,2 ./ 1));
X  if reval(group) = 'D32 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1),
X                                     list(3,2 ./ 1));
X  if reval(group) = 'Z2 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1));
X  if reval(group) = 'Id then
X      res:=list(list(1,1 ./ 1));
X  if reval(group) = 'C4 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1),list(3,2 ./ 1,'C));
X  if reval(group) = 'C6 then  %subgroup of D6
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1),
X                   list(3,2 ./ 1,'C),list(4,2 ./ 1,'C));
X  if reval(group) = 'C3 then  %subgroup of D6 and D3
X      res:=list(list(1,1 ./ 1),
X                   list(2,2 ./ 1,'C));
X  if reval(group) = 'K41 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1),list(3,1 ./ 1),list(4,1 ./ 1));
X  if reval(group) = 'K42 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1),list(3,1 ./ 1),list(4,1 ./ 1));
X  if reval(group) = 'K61 then  %subgroup of D6
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1),list(3,1 ./ 1),list(4,1 ./ 1));
X  if reval(group) = 'K62 then  %subgroup of D6
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1),list(3,1 ./ 1),list(4,1 ./ 1));
X  if reval(group) = 'K63 then  %subgroup of D6
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1),list(3,1 ./ 1),list(4,1 ./ 1));
X  if reval(group) = 'Z2 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1));
X  if reval(group) = 'Z20 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1));
X  if reval(group) = 'Z21 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1));
X  if reval(group) = 'Z22 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1));
X  if reval(group) = 'Z23 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1));
X  if reval(group) = 'Z24 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1));
X  if reval(group) = 'Z25 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1));
X  if reval(group) = 'C2 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1));
X  if reval(group) = 'Z2 then
X      res:=list(list(1,1 ./ 1),list(2,1 ./ 1));
X  if reval(group) = 'Id then
X      res:=list(list(1,1 ./ 1));
X  if not(res) 
X        then print list("group ",reval(group),"not known in dimsofrep");
X  return res;
Xend;
X
Xsymbolic procedure onedimchar(group);
X% number of representations, dimension and characters and 
X% representation matrices as output
X% here only onedimensional representations -> Characters
Xbegin
X  scalar phi1,phi2,phi3,phi4,i,p2,p3,p4,p5,res;
X  if reval(group) = 'D4 then
X% order: 1,r,r^2,r^3,s,sr,sr^2,sr^3
X   << phi1:=for i:=1:8 collect (1 ./ 1);
X      p2:=for i:=1:4 collect (1 ./ 1);
X      p3:=for i:=1:4 collect negsq(1 ./ 1);
X      phi2:=append(p2,p3);
X     % print list("phi2",phi2);
X      p4:=for i:=1:2 join list(nth(p2,i),nth(p3,i));
X      p5:=for i:=1:2 join list(nth(p3,i),nth(p2,i));
X      phi3:=append(p4,p4);
X      phi4:=append(p4,p5);
X     % print list("phi3",phi3);
X     % print list("phi4",phi4);
X      res:=list(phi1,phi2,phi3,phi4);
X   >>;
X  if reval(group) = 'D5 then
X% order: 1,r,r^2,r^3,r^4,s,sr,sr^2,sr^3,sr^4
X   << phi1:=for i:=1:10 collect (1 ./ 1);
X      p2:=for i:=1:5 collect (1 ./ 1);
X      p3:=for i:=1:5 collect negsq(1 ./ 1);
X      phi2:=append(p2,p3);
X      res:=list(phi1,phi2);
X   >>;
X  if reval(group) = 'D6 then
X% order: 1,r,r^2,r^3,r^4,r^5,s,sr,sr^2,sr^3,sr^4,sr^5
X   << phi1:=for i:=1:12 collect (1 ./ 1);
X      p2:=for i:=1:6 collect (1 ./ 1);
X      p3:=for i:=1:6 collect negsq(1 ./ 1);
X      phi2:=append(p2,p3);
X     % print list("phi2",phi2);
X      p4:=for i:=1:3 join list(nth(p2,i),nth(p3,i));
X      p5:=for i:=1:3 join list(nth(p3,i),nth(p2,i));
X      phi3:=append(p4,p4);
X      phi4:=append(p4,p5);
X    %  print list("phi3",phi3);
X     % print list("phi4",phi4);
X      res:=list(phi1,phi2,phi3,phi4);
X   >>;
X  if reval(group) = 'D3 then
X% order: 1,r,r^2,s,sr,sr^2
X   << phi1:=for i:=1:6 collect (1 ./ 1);
X      p2:=for i:=1:3 collect (1 ./ 1);
X      p3:=for i:=1:3 collect negsq(1 ./ 1);
X      phi2:=append(p2,p3);
X      res:=list(phi1,phi2);
X   >>;
X  if reval(group) = 'Z2 then
X% order: 1,s
X     <<
X        phi1:=for i:=1:2 collect (1 ./ 1);
X        phi2:=list((1 ./ 1),negsq(1 ./ 1));
X        res:=list(phi1,phi2);
X     >>;
X  if reval(group) = 'Id then
X     <<
X        phi1:=for i:=1:1 collect (1 ./ 1);
X        res:=list(phi1);
X     >>;
X  %print list("onedimchar fertig");
X  if not(res)  then
X       print list("group ",reval(group),"not known in onedimchar");
X  return res;
Xend;
X
Xsymbolic procedure moredimchar(group);
X% number of representations, dimension and characters and 
X% representation matrices as output
X% here only moredimensional representations -> character
Xbegin
X  scalar res,s,r,i,phi1,phi2,cos2,cos4,cos6,cos8;
X  if reval(group) = 'D4 then
X% order: 1,r,r^2,r^3,s,sr,sr^2,sr^3
X   <<
X      s:=for i:=1:5 collect (nil ./ 1);
X      r:=list((2 ./ 1),(nil ./ 1),(-2 ./ 1));
X      res:=append(r,s);
X      res:=list(res);% only one rep. with dim. 2
X   >>;
X  if reval(group) = 'D5 then
X% order: 1,r,r^2,r^3,r^4,s,sr,sr^2,sr^3,sr^4
X   <<
X      s:=for i:=1:5 collect (nil ./ 1);
X      cos2:=simp list('COS ,list('QUOTIENT ,list('TIMES, 2, 'PI) ,5));
X      cos4:=simp list('COS ,list('QUOTIENT ,list('TIMES, 4, 'PI) ,5));
X      cos6:=cos4;
X      cos8:=cos2;
X      r:=list((1 ./ 1),cos2,cos4,cos6,cos8);
X      r:=for each i in r collect multsq( 2 ./ 1 ,i);
X      phi1:=append(r,s);
X      r:=list((1 ./ 1),cos4,cos8,cos2,cos6);
X      r:=for each i in r collect multsq( 2 ./ 1 ,i);
X      phi2:=append(r,s);
X      res:=list(phi1,phi2);% only two rep. with dim. 2
X   >>;
X  if reval(group) = 'D6 then
X% order: 1,r,r^2,r^3,r^4,r^5,s,sr,sr^2,sr^3,sr^4,sr^5
X   << % 2* cos (2*pi*k*j/6) und 6 nullen
X      phi1:=list( (2 ./ 1),(1 ./ 1),(-1 ./ 1),(-2 ./ 1), (-1 ./ 1),(1 ./ 1));
X       s:=for i:=1:6 collect (nil ./ 1);
X      phi1:=append(phi1,s);
X      phi2:=list((2 ./ 1),(-1 ./ 1),(-1 ./ 1));
X      phi2:=append(phi2,phi2);
X      phi2:=append(phi2,s);
X      res:=list(phi1,phi2);
X   >>;
X  if reval(group) = 'D3 then
X% order: 1,r,r^2,s,sr,sr^2
X   << % 2* cos (2*pi*k*j/3) und  nullen
X      phi1:=list( (2 ./ 1),(-1 ./ 4),(-1 ./ 4));
X       s:=for i:=1:3 collect (nil ./ 1);
X      phi1:=append(phi1,s);
X      res:=list(phi1);
X   >>;
X  if reval(group) = 'Z2 then res:=nil;
X  if reval(group) = 'Id then res:=nil;
X  if not(res) and not(reval(group)= 'Z2) and not(reval(group)= 'Id) then 
X         print list("group ",reval(group),"not known in moredimchar");
X  return res;
Xend;
X
Xsymbolic procedure moredimrep(group);
X% number of representations, dimension and characters and 
X% representation matrices as output
X% here only moredimensional representations -> first row of special repmatrices
Xbegin
X  scalar res,s,r,r2,r3,r4,r5,wurz3,w3,res1,res2,cos2,cos4,cos6,cos8;
X  scalar sin2,sin4,sin6,sin8;
X  if reval(group) = 'D4 then
X% order: 1,r^3,r^2,r,s,sr,sr^2,sr^3
X   << s:=list(list((1 ./ 1),(nil ./ 1)),list((nil ./ 1),(-1 ./ 1)));
X      r:=list(list((nil ./ 1),(1 ./ 1)),list((-1 ./ 1),(nil ./ 1)));
X      r2:=matmult(r,r);
X      r3:=matmult(r,r2);
X      res:=list(matmult(r2,r2),r3,r2,r,
X                s,matmult(s,r),matmult(s,r2),matmult(s,r3));
X      res:=for each s in res collect car s; % collect first rows
X      res:=list(res); % only one moredim. repesentation 
X   >>;
X  if reval(group) = 'D5 then
X% order: 1,r^4,r^3,r^2,r,s,sr,sr^2,sr^3,sr^4
X   << 
X      cos2:=simp list('COS ,list('QUOTIENT ,list('TIMES, 2, 'PI) ,5));
X      cos4:=simp list('COS ,list('QUOTIENT ,list('TIMES, 4, 'PI) ,5));
X      cos6:=cos4;
X      cos8:=cos2;
X      sin2:=simp list('sin ,list('QUOTIENT ,list('TIMES, 2, 'PI) ,5));
X      sin4:=simp list('sin ,list('QUOTIENT ,list('TIMES, 4, 'PI) ,5));
X      sin6:=negsq(sin4);
X      sin8:=negsq(sin2);
X      r:=list(list(1 ./ 1, nil ./ 1),list(cos8,sin8),list(cos6,sin6),
X              list(cos4,sin4),list(cos2,sin2));
X      s:=list(list(1 ./ 1, nil ./ 1),list(cos2,sin2),list(cos4,sin4),
X              list(cos6,sin6),list(cos8,sin8));
X      res1:=append(r,s);
X      r:=list(list(1 ./ 1, nil ./ 1),list(cos4,sin4),list(cos8,sin8),
X              list(cos2,sin2),list(cos6,sin6));
X      s:=list(list(1 ./ 1, nil ./ 1),list(cos4,sin4),
X              list(cos8,sin8),list(cos2,sin2),list(cos6,sin6));
X      res:=list(res1,append(r,s));
X   >>;
X  if reval(group) = 'D6 then
X% order: 1,r^5,r^4,r^3,r^2,r,s,sr,sr^2,sr^3,sr^4,sr^5
X     <<%wurz3:=simp 'sqrt3;
X         wurz3:=simp eval list('mysqrt,mkquote  prepf 3); %sq zu sqrt(3)
X       w3:=multsq(wurz3,(1 ./ 2));
X       s:=list(list((1 ./ 1),(nil ./ 1)),list((nil ./ 1),(-1 ./ 1)));
X       r:=list(list((1 ./ 2),w3),list(negsq(w3),(1 ./ 2)));
X       r2:=matmult(r,r);
X       r3:=matmult(r,r2);
X       r4:=matmult(r2,r2);
X       r5:=matmult(r3,r2);
X       res1:=list(matmult(r3,r3),r5,r4,r3,r2,r,
X                s,matmult(s,r),matmult(s,r2),matmult(s,r3),
X                matmult(s,r4),matmult(s,r5));
X      res1:=for each s in res1 collect car s; % collect first rows
X % zweite representation
X       r:=list(list((-1 ./ 2),w3),list(negsq(w3),(-1 ./ 2)));
X       r2:=matmult(r,r);
X       r3:=matmult(r,r2);
X       r4:=matmult(r2,r2);
X       r5:=matmult(r3,r2);
X       res2:=list(matmult(r3,r3),r5,r4,r3,r2,r,
X                s,matmult(s,r),matmult(s,r2),matmult(s,r3),
X                matmult(s,r4),matmult(s,r5));
X       res2:=for each s in res2 collect car s; % collect first rows
X       res:=list(res1,res2);
X     >>;
X  if reval(group) = 'D3 then
X% order: 1,r^2,r,s,sr,sr^2
X     <<%wurz3:=simp 'sqrt3;
X         wurz3:=simp eval list('mysqrt,mkquote  prepf 3); %sq zu sqrt(3)
X       w3:=multsq(wurz3,(1 ./ 2));
X       s:=list(list((1 ./ 1),(nil ./ 1)),list((nil ./ 1),(-1 ./ 1)));
X       r:=list(list((-1 ./ 2),w3),list(negsq(w3),(-1 ./ 2)));
X       r2:=matmult(r,r);
X       res1:=list(matmult(r,r2),r2,r,
X                s,matmult(s,r),matmult(s,r2));
X      res1:=for each s in res1 collect car s; % collect first rows
X      res:=list(res1);
X     >>;
X  if reval(group) = 'Z2 then res:=nil;
X  if reval(group) = 'Id then res:=nil;
X % print list("in moredimrep",res);
X  if not(res) and not(reval(group)='Z2) and not(reval(group)='Id) then 
X        print list("group ",reval(group),"not known in moredimrep");
X
X  return res;
Xend;
X
Xsymbolic procedure isogrouptree(group);
X%  for each isotypical component possible bifurcation group
Xbegin
X  scalar res,bifurg;
X  if reval(group) = 'Z2 then res:=list(list(2,'Id));
X  if reval(group) = 'D4 then
X    <<
X      bifurg:=list(2,'C4);
X      res:=list(bifurg);
X      bifurg:=list(3,'K41);
X      res:=append(res,list(bifurg));
X      bifurg:=list(4,'K42);
X      res:=append(res,list(bifurg));
X      bifurg:=list(5,'Z20,'Z21,'Z22,'Z23);     
X      res:=append(res,list(bifurg));
X    >>;
X  if reval(group) = 'D5 then
X    <<
X      bifurg:=list(2,'C5);
X      res:=list(bifurg);
X      bifurg:=list(3,'Z20,'Z21,'Z22,'Z23,'Z24);
X      res:=append(res,list(bifurg));
X      bifurg:=list(4,'Z20,'Z21,'Z22,'Z23,'Z24);
X      res:=append(res,list(bifurg));
X    >>;
X  if reval(group) = 'D3 then
X    <<
X      bifurg:=list(2,'C3);
X      res:=list(bifurg);
X      bifurg:=list(3,'Z20,'Z22,'Z24);     
X      res:=append(res,list(bifurg));
X    >>;
X  if reval(group) = 'D32 then
X    <<
X      bifurg:=list(2,'C3);
X      res:=list(bifurg);
X      bifurg:=list(3,'Z21,'Z23,'Z25);     
X      res:=append(res,list(bifurg));
X    >>;
X  if reval(group) = 'D6 then
X    <<
X      bifurg:=list(2,'C6);
X      res:=list(bifurg);
X      bifurg:=list(3,'D3);
X      res:=append(res,list(bifurg));
X      bifurg:=list(4,'D32);
X      res:=append(res,list(bifurg));
X      bifurg:=list(5,'Z20,'Z21,'Z22,'Z23,'Z24,'Z25);     
X      res:=append(res,list(bifurg));
X      bifurg:=list(6,'K61,'K62,'K63);     
X      res:=append(res,list(bifurg));
X    >>;
X  if reval(group) = 'C4 then
X    <<
X      bifurg:=list(2,'C2);
X      res:=list(bifurg);
X    >>;
X  if reval(group) = 'C2 then
X    <<
X      bifurg:=list(2,'Id);
X      res:=list(bifurg);
X    >>;
X  if reval(group) = 'C6 then
X    <<
X      bifurg:=list(2,'C3);
X      res:=list(bifurg);
X    >>;
X  if reval(group) = 'C5 then
X    <<
X      res:=nil;
X    >>;
X  if reval(group) = 'C3 then
X    <<
X      res:=nil;
X    >>;
X  if reval(group) = 'K41 then
X    <<
X      bifurg:=list(2,'C2);
X      res:=list(bifurg);
X      bifurg:=list(3,'Z22);
X      res:=append(res,list(bifurg));
X      bifurg:=list(4,'Z20);
X      res:=append(res,list(bifurg));
X    >>;
X if reval(group) = 'K42 then
X    <<
X      bifurg:=list(2,'C2);
X      res:=list(bifurg);
X      bifurg:=list(3,'Z23);
X      res:=append(res,list(bifurg));
X      bifurg:=list(4,'Z21);
X      res:=append(res,list(bifurg));
X    >>;
X if reval(group) = 'K61 then
X    <<
X      bifurg:=list(2,'C2);
X      res:=list(bifurg);
X      bifurg:=list(3,'Z23);
X      res:=append(res,list(bifurg));
X      bifurg:=list(4,'Z20);
X      res:=append(res,list(bifurg));
X    >>;
X if reval(group) = 'K62 then
X    <<
X      bifurg:=list(2,'C2);
X      res:=list(bifurg);
X      bifurg:=list(3,'Z24);
X      res:=append(res,list(bifurg));
X      bifurg:=list(4,'Z21);
X      res:=append(res,list(bifurg));
X    >>;
X if reval(group) = 'K63 then
X    <<
X      bifurg:=list(2,'C2);
X      res:=list(bifurg);
X      bifurg:=list(3,'Z25);
X      res:=append(res,list(bifurg));
X      bifurg:=list(4,'Z22);
X      res:=append(res,list(bifurg));
X    >>;
X if reval(group) = 'Z20 then
X    <<
X      bifurg:=list(2,'Id);
X      res:=list(bifurg);
X    >>;
X if reval(group) = 'Z21 then
X    <<
X      bifurg:=list(2,'Id);
X      res:=list(bifurg);
X    >>;
X if reval(group) = 'Z22 then
X    <<
X      bifurg:=list(2,'Id);
X      res:=list(bifurg);
X    >>;
X if reval(group) = 'Z23 then
X    <<
X      bifurg:=list(2,'Id);
X      res:=list(bifurg);
X    >>;
X if reval(group) = 'Z24 then
X    <<
X      bifurg:=list(2,'Id);
X      res:=list(bifurg);
X    >>;
X if reval(group) = 'Z25 then
X    <<
X      bifurg:=list(2,'Id);
X      res:=list(bifurg);
X    >>;
X if reval(group) = 'Id then
X    <<
X      res:=nil;
X    >>;
X  if not(res) and not(reval(group)='Id) and not(reval(group)='C3) then 
X        print list("group ",reval(group),"not known isogrouptree");
X  return res;
Xend;
X
Xsymbolic procedure connectiso(group,subgroup);
X%  connections between isotypical components
Xbegin
X  scalar res,sublist,subl,sublist1,sublist2,wu2;
X  %print list("in connectiso",group,subgroup);
X % wu2:=simp 'sqrt2;
X   wu2:=simp list('sqrt,2);
X  if reval(group) = 'Z2 then 
X   <<
X     if reval (subgroup) = 'Id then res:=list(list(1,list(1,2)));
X   >>;
X  if reval(group) = 'D4 then
X    <<
X      if reval(subgroup) = 'C4 then
X        <<
X          res:=list(list(1,list(1,2)),list(2,list(3,4)),
X            list(3,list(5,'split,list( 1 ./ 1, nil ./ 1,nil ./ 1, 1 ./ 1) )));
X        >>; 
X      if reval(subgroup) = 'K41 then
X       <<
X         res:=list(list(1,list(1,3)),list(2,list(2,4)));
X            sublist:=list(3,list(5,'split, list(nil ./ 1, 1 ./ 1)));
X         res:=append(res,list(sublist));
X            sublist:=list(4,list(5,'split, list( 1 ./ 1, nil ./ 1)));
X         res:=append(res,list(sublist));
X       >>;
X
X      if reval(subgroup) = 'K42 then
X       <<
X         res:=list(list(1,list(1,4)),list(2,list(2,3)));
X            sublist:=list(3,list(5,'split, 
X                      list( quotsq(wu2,2 ./ 1), quotsq(negsq(wu2),2 ./ 1))));
X         res:=append(res,list(sublist));
X            sublist:=list(4,list(5, 'split, 
X                      list( quotsq(wu2,2 ./ 1), quotsq(wu2,2 ./ 1))));
X         res:=append(res,list(sublist));
X       >>;
X
X      if reval(subgroup) = 'Z20 then
X       <<
X         subl:=list( 1 ./ 1, nil ./ 1);
X         sublist1:=list(1,list(1,3,5,'split,subl));
X         subl:=list( nil ./ 1, 1 ./ 1);
X         sublist2:=list(2,list(2,4,5,'split,subl));
X         res:=list(sublist1,sublist2);
X       >>;
X
X      if reval(subgroup) = 'Z21 then
X       <<
X         subl:=list( quotsq(wu2,2 ./ 1), quotsq(wu2,2 ./ 1));
X         sublist1:=list(1,list(1,4,5,'split,subl));
X         subl:=list( quotsq(wu2,2 ./ 1), quotsq(negsq(wu2),2 ./ 1));
X         sublist2:=list(2,list(2,3,5,'split,subl));
X         res:=list(sublist1,sublist2);
X       >>;
X      if reval(subgroup) = 'Z22 then
X       <<
X         subl:=list( nil ./ 1, 1 ./ 1);
X         sublist1:=list(1,list(1,3,5,'split,subl));
X         subl:=list( 1 ./ 1, nil ./ 1);
X         sublist2:=list(2,list(2,4,5,'split,subl));
X         res:=list(sublist1,sublist2);
X       >>;
X
X      if reval(subgroup) = 'Z23 then
X       <<
X         subl:=list( quotsq(wu2,2 ./ 1), quotsq(negsq(wu2),2 ./ 1));
X         sublist1:=list(1,list(1,4,5,'split,subl));
X         subl:=list( quotsq(wu2,2 ./ 1), quotsq(wu2,2 ./ 1));
X         sublist2:=list(2,list(2,3,5,'split,subl));
X         res:=list(sublist1,sublist2);
X       >>;
X
X      if reval(subgroup) = 'C2 then
X       <<
X         sublist1:=list(1,list(1,2,3,4));
X         sublist2:=list(2,list(5));
X         res:=list(sublist1,sublist2);
X       >>;
X
X      if reval(subgroup) = 'Id then
X       <<
X         sublist1:=list(1,list(1,2,3,4,5));
X         res:=list(sublist1);
X       >>;
X    >>;
X  if reval(group) = 'D6 then res:=D6connect(subgroup);
X  if reval(group) = 'D3 then res:=D3connect(subgroup);
X  if reval(group) = 'D5 then res:=D5connect(subgroup);
X  if not(res) and not(reval(group)='Id) then 
X       print list("group ",reval(group),"not known connectiso");
X % print list ("connectiso gives",res);
X  return res;
Xend;
X
Xsymbolic procedure D3connect(subgroup);
X% connections between isotyp. comp. of D3 and its subgroups
Xbegin
X  scalar res,subl1,subl2,sublist1,sublist2,sublist3,sublist4,w3;
X  w3:=quotsq(simp list('sqrt,3),2 ./ 1);
X % w3:=quotsq(simp 'sqrt3,2 ./ 1);
X  if reval(subgroup) = 'C3 then
X       <<
X         sublist1:=list(1,list(1,2));
X        % subl:=list( nil ./ 1, 1 ./ 1);
X         sublist2:=list(2,list(3));
X         res:=list(sublist1,sublist2);
X       >>;
X  if reval(subgroup) = 'Z20 then
X       <<
X         subl1:=list( 1 ./ 1, nil ./ 1);
X         sublist1:=list(1,list(1,3,'split,subl1));
X         subl2:=list( nil ./ 1,1 ./ 1);
X         sublist2:=list(2,list(2,3,'split,subl2));
X         res:=list(sublist1,sublist2);
X       >>;
X  if reval(subgroup) = 'Z22 then
X       <<
X         subl1:=list( 1 ./ 2, w3);
X         sublist1:=list(1,list(1,3,'split,subl1));
X         subl2:=list( negsq(w3),1 ./ 2);
X         sublist2:=list(2,list(2,3,'split,subl2));
X         res:=list(sublist1,sublist2);
X       >>;
X  if reval(subgroup) = 'Z24 then
X       <<
X         subl1:=list( -1 ./ 2, w3);
X         sublist1:=list(1,list(1,3,'split,subl1));
X         subl2:=list( w3,1 ./ 2);
X         sublist2:=list(2,list(2,3,'split,subl2));
X         res:=list(sublist1,sublist2);
X       >>;
X  if reval(subgroup) = 'ID then
X       <<
X         sublist1:=list(1,list(1,2,3));
X         res:=list(sublist1);
X       >>;
X  return res;
Xend;
X
Xsymbolic procedure D5connect(subgroup);
X% connections between isotyp. comp. of D5 and its subgroups
Xbegin
X  scalar res,subl1,subl2,sublist1,sublist2,sublist3,sublist4;
X  if reval(subgroup) = 'C5 then
X       <<
X         sublist1:=list(1,list(1,2));
X        % subl:=list( nil ./ 1, 1 ./ 1);
X         sublist2:=list(2,list(3));
X         sublist3:=list(2,list(4));
X         res:=list(sublist1,sublist2,sublist3);
X       >>;
X  if reval(subgroup) = 'Z20 then
X       <<
X         subl1:=list( 1 ./ 1, nil ./ 1);
X         sublist1:=list(1,list(1,3,'split,subl1,4,'split,subl1));
X         subl2:=list( nil ./ 1,1 ./ 1);
X         sublist2:=list(2,list(2,3,'split,subl2,4,'split,subl2));
X         res:=list(sublist1,sublist2);
X       >>;
X   if reval(subgroup) = 'ID then
X       <<
X         sublist1:=list(1,list(1,2,3,4));
X         res:=list(sublist1);
X       >>;
X  return res;
Xend;
X
Xsymbolic procedure D6connect(subgroup);
X% connections between isotyp. comp. of D6 and its subgroups
Xbegin
X  scalar res,subl1,subl2,sublist1,sublist2,sublist3,sublist4,w3;
X % w3:=quotsq(simp 'sqrt3,2 ./ 1);
X  w3:=quotsq(simp list('sqrt,3),2 ./ 1);
X  if reval(subgroup) = 'C6 then
X       <<
X         sublist1:=list(1,list(1,2));
X        % subl:=list( nil ./ 1, 1 ./ 1);
X         subl1:=list( 1 ./ 1, nil ./ 1,nil ./ 1,1 ./ 1);
X         sublist2:=list(2,list(3,4));
X         sublist3:=list(3,list(5,'split,subl1));
X         sublist4:=list(4,list(6,'split,subl1));
X         res:=list(sublist1,sublist2,sublist3,sublist4);
X       >>;
X  if reval(subgroup) = 'C3 then
X       <<
X         sublist1:=list(1,list(1,2,3,4));
X         subl1:=list( 1 ./ 1, nil ./ 1,nil ./ 1,1 ./ 1);
X         subl2:=list( 1 ./ 1, nil ./ 1,nil ./ 1,-1 ./ 1);
X         sublist2:=list(2,list(5,'split,subl1,6,'split,subl2));
X         res:=list(sublist1,sublist2);
X       >>;
X  if reval(subgroup) = 'D3 then
X       <<
X         sublist1:=list(1,list(1,3));
X         sublist2:=list(2,list(2,4));
X         subl1:=list( 1 ./ 1, nil ./ 1,nil ./ 1,1 ./ 1);
X         subl2:=list( 1 ./ 1, nil ./ 1,nil ./ 1,-1 ./ 1);
X         sublist3:=list(3,list(5,'split,subl1,6,'split,subl2));
X         res:=list(sublist1,sublist2,sublist3);
X       >>;
X  if reval(subgroup) = 'D32 then
X       <<
X         sublist1:=list(1,list(1,4));
X         sublist2:=list(2,list(2,3));
X         subl1:=list( 1 ./ 1, nil ./ 1,nil ./ 1,1 ./ 1);
X         subl2:=list( nil ./ 1, 1 ./ 1, 1 ./ 1, nil ./ 1);
X         sublist3:=list(3,list(5,'split,subl1,6,'split,subl2));
X         res:=list(sublist1,sublist2,sublist3);
X       >>;
X  if reval(subgroup) = 'K61 then
X       <<
X         subl1:=list( 1 ./ 1, nil ./ 1);
X         sublist1:=list(1,list(1,6,'split,subl1));
X         subl1:=list( nil ./ 1,1 ./ 1);
X         sublist2:=list(2,list(2,6,'split,subl1));
X         subl1:=list( nil ./ 1,1 ./ 1);
X         sublist3:=list(3,list(4,5,'split,subl1));
X         subl1:=list(1 ./ 1,nil ./ 1);
X         sublist4:=list(4,list(3,5,'split,subl1));
X         res:=list(sublist1,sublist2,sublist3,sublist4);
X       >>;
X  if reval(subgroup) = 'K62 then
X       <<
X         subl1:=list( 1 ./ 2, w3);
X         sublist1:=list(1,list(1,6,'split,subl1));
X         subl1:=list( negsq(w3),1 ./ 2);
X         sublist2:=list(2,list(2,6,'split,subl1));
X         subl1:=list( 1 ./ 2,negsq( w3));
X         sublist3:=list(3,list(3,5,'split,subl1));
X         subl1:=list( w3,1 ./ 2);
X         sublist4:=list(4,list(4,5,'split,subl1));
X         res:=list(sublist1,sublist2,sublist3,sublist4);
X       >>;
X  if reval(subgroup) = 'K63 then
X       <<
X         subl1:=list( 1 ./ 2, negsq(w3));
X         sublist1:=list(1,list(1,6,'split,subl1));
X         subl1:=list( w3,1 ./ 2);
X         sublist2:=list(2,list(2,6,'split,subl1));
X         subl1:=list( w3,-1 ./ 2);
X         sublist3:=list(3,list(4,5,'split,subl1));
X         subl1:=list(1 ./ 2,w3);
X         sublist4:=list(4,list(3,5,'split,subl1));
X         res:=list(sublist1,sublist2,sublist3,sublist4);
X       >>;
X  if reval(subgroup) = 'Z20 then
X       <<
X         subl1:=list( 1 ./ 1, nil ./ 1);
X         sublist1:=list(1,list(1,3,5,'split,subl1,6,'split,subl1));
X         subl1:=list( nil ./ 1,1 ./ 1);
X         sublist2:=list(2,list(2,4,5,'split,subl1,6,'split,subl1));
X         res:=list(sublist1,sublist2);
X       >>;
X  if reval(subgroup) = 'Z21 then
X       <<
X         subl1:=list( w3, 1 ./ 2);
X         subl2:=list( 1 ./ 2,w3);
X         sublist1:=list(1,list(1,4,5,'split,subl1,6,'split,subl2));
X         subl1:=list( -1 ./ 2,w3);
X         subl2:=list( negsq(w3),1 ./ 2);
X         sublist2:=list(2,list(2,3,5,'split,subl1,6,'split,subl2));
X         res:=list(sublist1,sublist2);
X       >>;
X  if reval(subgroup) = 'Z22 then
X       <<
X         subl1:=list( 1 ./ 2,w3);
X         subl2:=list( 1 ./ 2,negsq(w3));
X         sublist1:=list(1,list(1,3,5,'split,subl1,6,'split,subl2));
X         subl1:=list( negsq(w3),1 ./ 2);
X         subl2:=list( w3,1 ./ 2);
X         sublist2:=list(2,list(2,4,5,'split,subl1,6,'split,subl2));
X         res:=list(sublist1,sublist2);
X       >>;
X  if reval(subgroup) = 'Z23 then
X       <<
X         subl1:=list( nil ./ 1, 1 ./ 1);
X         subl2:=list( 1 ./ 1,nil ./ 1);
X         sublist1:=list(1,list(1,4,5,'split,subl1,6,'split,subl2));
X         sublist2:=list(2,list(2,3,5,'split,subl2,6,'split,subl1));
X         res:=list(sublist1,sublist2);
X       >>;
X  if reval(subgroup) = 'Z24 then
X       <<
X         subl1:=list( -1 ./ 2,w3);
X         subl2:=list( 1 ./ 2,w3);
X         sublist1:=list(1,list(1,3,5,'split,subl1,6,'split,subl2));
X         subl1:=list( negsq(w3),1 ./ 2);
X         subl2:=list( w3,1 ./ 2);
X         sublist2:=list(2,list(2,4,5,'split,subl2,6,'split,subl1));
X         res:=list(sublist1,sublist2);
X       >>;
X  if reval(subgroup) = 'Z25 then
X       <<
X         subl1:=list( negsq(w3), 1 ./ 2);
X         subl2:=list( 1 ./ 2,negsq(w3));
X         sublist1:=list(1,list(1,4,5,'split,subl1,6,'split,subl2));
X         subl1:=list( 1 ./ 2,w3);
X         subl2:=list( w3,1 ./ 2);
X         sublist2:=list(2,list(2,3,5,'split,subl1,6,'split,subl2));
X         res:=list(sublist1,sublist2);
X       >>;
X  if reval(subgroup) = 'C2 then
X       <<
X         sublist1:=list(1,list(1,2,6));
X         sublist2:=list(2,list(3,4,5));
X         res:=list(sublist1,sublist2);
X       >>;
X  if reval(subgroup) = 'Id then
X       <<
X         sublist1:=list(1,list(1,2,3,4,5,6));
X         res:=list(sublist1);
X       >>;
X
X  return res;
Xend;
X
Xsymbolic procedure subgrouptree(group) ;
X% gives the numbers of elements in group, which are in subgroup
Xbegin
X  if reval(group) = 'ID then 
X   <<
X     put(mkid(mkid('!*,group),mkid('ID,'!*)),'elems,list(1));
X   >>;
X  if reval(group) = 'Z2 then 
X   <<
X     put(mkid(mkid('!*,group),mkid('Z2,'!*)),'elems,
X           list(1,2));
X     put(mkid(mkid('!*,group),mkid('ID,'!*)),'elems,list(1));
X   >>;
X  if reval(group) = 'D3 then 
X   <<
X     put(mkid(mkid('!*,group),mkid('D3,'!*)),'elems,
X          list(1,2,3,4,5,6));
X     put(mkid(mkid('!*,group),mkid('Z20,'!*)),'elems,
X          list(1,4));
X     put(mkid(mkid('!*,group),mkid('Z22,'!*)),'elems,
X          list(1,5));
X     put(mkid(mkid('!*,group),mkid('Z24,'!*)),'elems,
X          list(1,6));
X     put(mkid(mkid('!*,group),mkid('ID,'!*)),'elems,list(1));
X   >>;
X  if reval(group) = 'D6 then 
X   <<put(mkid(mkid('!*,group),mkid('D6,'!*)),'elems,
X         list(1,2,3,4,5,6,7,8,9,10,11,12));
X     put(mkid(mkid('!*,group),mkid('C6,'!*)),'elems,
X         list(1,2,3,4,5,6));
X     put(mkid(mkid('!*,group),mkid('D3,'!*)),'elems,
X         list(1,3,5,7,9,11)) ;
X     put(mkid(mkid('!*,group),mkid('D32,'!*)),'elems,
X         list(1,3,5,8,10,12));
X     put(mkid(mkid('!*,group),mkid('K61,'!*)),'elems,
X         list(1,4,7,10));
X     put(mkid(mkid('!*,group),mkid('K62,'!*)),'elems,
X         list(1,4,8,11));
X     put(mkid(mkid('!*,group),mkid('K63,'!*)),'elems,
X         list(1,4,9,12));
X     put(mkid(mkid('!*,group),mkid('C3,'!*)),'elems,
X         list(1,3,5));
X     put(mkid(mkid('!*,group),mkid('Z20,'!*)),'elems,
X         list(1,7));
X     put(mkid(mkid('!*,group),mkid('Z21,'!*)),'elems,
X         list(1,8));
X     put(mkid(mkid('!*,group),mkid('Z22,'!*)),'elems,
X         list(1,9));
X     put(mkid(mkid('!*,group),mkid('Z23,'!*)),'elems,
X         list(1,10));
X     put(mkid(mkid('!*,group),mkid('Z24,'!*)),'elems,
X         list(1,11));
X     put(mkid(mkid('!*,group),mkid('Z25,'!*)),'elems,
X         list(1,12));
X     put(mkid(mkid('!*,group),mkid('C2,'!*)),'elems,
X         list(1,4));
X     put(mkid(mkid('!*,group),mkid('ID,'!*)),'elems,list(1));
X   >>;
X  if reval(group) = 'D4 then 
X   <<
X    put(mkid(mkid('!*,group),mkid('D4,'!*)),'elems, list(1,2,3,4,5,6,7,8));
X     put(mkid(mkid('!*,group),mkid('C4,'!*)),'elems, list(1,2,3,4));
X     put(mkid(mkid('!*,group),mkid('K41,'!*)),'elems,  list(1,3,5,7));
X      put(mkid(mkid('!*,group),mkid('K42,'!*)),'elems, list(1,3,6,8));
X      put(mkid(mkid('!*,group),mkid('Z20,'!*)),'elems,  list(1,5));
X      put(mkid(mkid('!*,group),mkid('Z21,'!*)),'elems,  list(1,6));
X      put(mkid(mkid('!*,group),mkid('Z22,'!*)),'elems, list(1,7));
X      put(mkid(mkid('!*,group),mkid('Z23,'!*)),'elems,  list(1,8));
X      put(mkid(mkid('!*,group),mkid('C2,'!*)),'elems,  list(1,3));
X      put(mkid(mkid('!*,group),mkid('ID,'!*)),'elems,  list(1));
X   >>;
Xend;
X
X
Xend;
X
END_OF_FILE
if test 28647 -ne `wc -c <'hybridinfo'`; then
    echo shar: \"'hybridinfo'\" unpacked with wrong size!
fi
# end of 'hybridinfo'
fi
if test -f 'hybridnum' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'hybridnum'\"
else
echo shar: Extracting \"'hybridnum'\" \(9641 characters\)
sed "s/^X//" >'hybridnum' <<'END_OF_FILE'
X% functions for numeric mode of symcon
X% g,dg,ddg are evaluated pointwise
X% parts of the transformation matrices are generated
X% hybridnum
X
Xoff echo;
X
X
Xsymbolic procedure genorgf(f,vars,group,n);
X% generate f,df,ddf  
Xbegin
Xscalar newvars,s,avt,tf,i,fjac;
X  newvars:=for i:=1:(n+1) collect list('Y!v!a!r,i);
X  avt:=for i:=1:(n+1) collect 
X      LIST('SETQ,nth(vars,i),prepsq simp!* nth(newvars,i));
X  % mkraus(tf);
X  fjac:=mkjac(f,vars);
X  % print list("fjac",fjac);
X  genfnum(f,'Y!v!a!r,group,n,avt,vars);
X  gendf(fjac,'Y!v!a!r,group,n,avt,vars)
Xend;
X
Xsymbolic procedure decorgf();
Xbegin
X  SCALAR gentlist;
X  gentlist:=list('literal,"void f()",'cr!*,"{",'cr!*,"}",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=list('literal,"void df()",'cr!*,"{",'cr!*,"}",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
Xend;
X
Xsymbolic procedure genfnum(f,var,group,n,avt,vars);
X% vars are the variables given by the user
Xbegin
X  SCALAR gentlist,eqs,decls,args,fktname,comp,i,hugo;
X  fktname:='!f;
X  hugo:=LIST('DOUBLE, LIST(var,'TIMES),
X               LIST('!f!o,'TIMES));
X  hugo:=append(hugo,vars);
X  decls:= LIST('DECLARE, LIST('!v!o!i!d,fktname),
X                       hugo);
X  args:= LIST(var,'!f!o);
X  i:=0;
X  eqs:=FOR EACH comp IN f COLLECT
X    <<i:=i+1;
X      LIST('SETQ, LIST('!f!o,i),replacesqrt (CAR comp))
X    >>;
X  eqs:=append(avt,eqs);
X  gentlist:= LIST('PROCEDURE,fktname,'NIL,'EXPRN,args,
X                 APPEND( LIST('BLOCK,'NIL,decls),eqs));
X  EVAL LIST('GENTRAN,mkquote gentlist,'NIL);
Xend;
X
Xsymbolic procedure gendf(fjac,var,group,n,avt,vars);
Xbegin
X  SCALAR gentlist,eqs,decls,args,fktname,comp,i,j,s,hugo;
X  fktname:='!d!f;
X  hugo:=LIST('DOUBLE, LIST(var,'TIMES),
X               LIST('!d!f!o,'TIMES,'TIMES));
X  hugo:=append(hugo,vars);
X  decls:= LIST('DECLARE, LIST('!v!o!i!d,fktname),
X                       hugo);
X  args:= LIST(var,'!d!f!o);
X  i:=0;
X  eqs:=FOR EACH comp IN fjac join
X    <<i:=i+1;
X      j:=0;
X   for each s in comp collect
X       <<
X          j:=j+1;
X          LIST('SETQ, LIST('!d!f!o,i,j),replacesqrt s)
X       >>
X    >>;
X  eqs:=append(avt,eqs);
X  gentlist:= LIST('PROCEDURE,fktname,'NIL,'EXPRN,args,
X                 APPEND( LIST('BLOCK,'NIL,decls),eqs));
X  EVAL LIST('GENTRAN,mkquote gentlist,'NIL);
Xend;
X
X
Xsymbolic procedure genmatrices(group,subg,m,nicis,noncgs);
X% generate the submatrices of the transformation matrices
X% for the nonconjugate groups
Xbegin
X  scalar subg,storename,subnicis,subcmat,subm;
X % print list("in genmatrices");
X      storename:=mkid(mkid('!*,group),mkid(subg,'!*));
X      subnicis:=get(storename,'nici);
X      subcmat:=get(storename,'cmat);
X      subm:= matmult(m,subcmat);
X      genmats(subg,subm,subnicis,noncgs);
Xend;
X
Xsymbolic procedure genmats(subg,subm,subnicis,noncgs);
X% generate the submatrices of the transformation matrices
Xbegin
X  scalar i,j,pr,ioffset,di;
X % print list("in genmats",subg);
X  i:=0;
X  ioffset:=0;
X  if not(member(subg,noncgs)) then subnicis:=list car subnicis;
X % for conjugate groups only first part of transformation matrix needed
X   for each pr in subnicis do
X    <<
X       i:=i+1;
X       if numr(cadr pr) then
X         <<
X            if length(pr)=2 then %irr. of real type
X               <<
X                  gen1matrice(subm,ioffset,numr(cadr pr),i,subg);
X                  gen2matrice(subm,ioffset,numr(cadr pr),i,subg);
X                  ioffset:=ioffset+numr(cadr pr)*numr(car pr);
X               >> else           % irr. of complex type
X               <<
X                  di:=numr multsq(cadr pr,car pr);
X                  gen1matrice(subm,ioffset,di,i,subg);
X                  gen2matrice(subm,ioffset,di,i,subg);
X                  ioffset:=ioffset+di;
X               >>;
X         >>;
X    >>;
Xend;
X
Xsymbolic procedure gen1matrice(m,ioffset,ilen,i,subg);
Xbegin
X  scalar n,gentlist,eqs,decls,args,fktname,comp,i1,ii,j,hugo,sam;
X  n:=length(m);
X  fktname:=mkid(mkid('!i!n!v!t!r!a!n!s,i),subg);
X  hugo:=LIST('DOUBLE, 
X               LIST('!Y,'TIMES),LIST('!u,'TIMES));
X  decls:= LIST('DECLARE, LIST('!s!t!a!t!i!c! !v!o!i!d,fktname),
X                       hugo);
X  args:= LIST('!Y,'!u);
X  ii:=0;
X  eqs:=FOR i1:=(ioffset+1):(ioffset+ilen) collect
X    <<sam:=nil ./ 1;
X      ii:=ii+1;
X      FOR j:=1:n do
X        sam:=addsq(sam,multsq(nth(nth(m,j),i1),simp!*(list('Y,j))));
X      LIST('SETQ, LIST('!u,ii),replacesqrt sam)
X    >>;
X  gentlist:= LIST('PROCEDURE,fktname,'NIL,'EXPRN,args,
X                 APPEND( LIST('BLOCK,'NIL,decls),eqs));
X  EVAL LIST('GENTRAN,mkquote gentlist,'NIL);
X  eval list('gentran,mkquote list('literal,'cr!*),'nil);
Xend;
X
Xsymbolic procedure gen2matrice(m,ioffset,ilen,i,subg);
Xbegin
X  scalar gentlist,eqs,decls,args,fktname,comp,i1,ii,j,hugo,sam;
X  n:=length(m);
X  fktname:=mkid(mkid('!t!r!a!n!s,i),subg);
X  hugo:=LIST('DOUBLE, 
X               LIST('!U,'TIMES),LIST('!y,'TIMES));
X  decls:= LIST('DECLARE, LIST('!s!t!a!t!i!c! !v!o!i!d,fktname),
X                       hugo);
X  args:= LIST('!U,'!y);
X  eqs:=FOR j:=1:n collect
X    <<sam:=nil ./ 1;
X      ii:=0;
X      FOR i1:=(ioffset+1):(ioffset+ilen) do
X        <<ii:=ii+1;
X           sam:=addsq(sam,multsq(nth(nth(m,j),i1),simp!* (list('U,ii))));
X        >>;
X      LIST('SETQ, LIST('!y,j),replacesqrt sam)
X    >>;
X  gentlist:= LIST('PROCEDURE,fktname,'NIL,'EXPRN,args,
X                 APPEND( LIST('BLOCK,'NIL,decls),eqs));
X  EVAL LIST('GENTRAN,mkquote gentlist,'NIL);
X  eval list('gentran,mkquote list('literal,'cr!*),'nil);
Xend;
X
Xsymbolic procedure gentrans(subg,nsym,n);
Xbegin
X  gen1trans(subg,nsym,n);
X  gen2trans(subg,nsym,n);
Xend;
X
Xsymbolic procedure gen1trans(subg,nsym,n);
Xbegin
X  SCALAR gentlist;
X  gentlist:=list('literal,"static void transform",subg,"(U,y)",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=list('literal,"double *U,*y;",'cr!*,"{",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=list('literal,"trans1",subg,"(U,y);",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=list('literal,"y[",n+1,"]=U[",nsym+1,"];",'cr!*,"}",'cr!*,'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
Xend;
X
Xsymbolic procedure gen2trans(subg,nsym,n);
Xbegin
X  SCALAR gentlist;
X  gentlist:=list('literal,"static void invtransform",subg,"(Y,u)",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=list('literal,"double *Y,*u;",'cr!*,"{",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=list('literal,"invtrans1",subg,"(Y,u);",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=list('literal,"u[",nsym+1,"]=Y[",n+1,"];",'cr!*,"}",'cr!*," ",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
Xend;
X
Xsymbolic procedure gengnum(subg);
X% generates the reduced equations g
Xbegin
X  SCALAR gentlist;
X  gentlist:=list('literal,"static void g",subg,"(U,g)",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=list('literal,"double *U,*g;",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=list('literal,"{",'cr!*,"g_num(",subg,",U,g);",'cr!*,"}",'cr!*," ",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
Xend;
X
Xsymbolic procedure gengjacnum(subg,subnicis);
X% make Jacobian blocks in numerical case
Xbegin
X  scalar pr,i,j;
X  genjac1num(subg);
X  i:=1;
X  j:=1;
X  for each pr in cdr subnicis do
X   <<i:=i+1;
X     if numr cadr pr then
X      <<j:=j+1;
X        genjac2num(subg,i,j);
X      >>;
X   >>;
Xend;
X
Xsymbolic procedure genjac1num(subg);
Xbegin
X  scalar gentlist,c1;
X  gentlist:=list('literal,"static void dg",subg,"1(U,dgu)",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=
X   list('literal,"double *U,**dgu;",'cr!*,"{",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=list('literal,"dg_num(",subg,",U,dgu); ",'cr!*,"}",'cr!*," ",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
Xend;
X
Xsymbolic procedure genjac2num(subg,i,j);
Xbegin
X  scalar gentlist;
X  gentlist:=list('literal,"static void dg",subg,i,"(U,dgu)",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=
X   list('literal,"double *U,**dgu;",'cr!*,"{",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=list('literal,"dgi_num(",subg,",",j,",U,dgu);",'cr!*,"}",'cr!*," ",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
Xend;
X
Xsymbolic procedure gensecjacnum(subg,subnicis);
X% make second derivatives in numerical case
Xbegin
X  scalar pr,i,j;
X  gensec1num(subg);
X  i:=1;
X  j:=1;
X  for each pr in cdr subnicis do
X    <<i:=i+1;
X      if numr cadr pr then
X        <<j:=j+1;
X          gensec2num(subg,i,j);
X        >>
X    >>;
Xend;
X
Xsymbolic procedure gensec1num(subg);
Xbegin
X  scalar gentlist;
X  gentlist:=list('literal,"static void cg",subg,"1(U,Z,c)",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=
X   list('literal,"double *U,*Z,**c;",'cr!*,"{",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=list('literal,"cg_num(",subg,",U,Z,c);",'cr!*,"}",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
Xend;
X
Xsymbolic procedure gensec2num(subg,i,j);
Xbegin
X  scalar gentlist;
X  gentlist:=list('literal,"static void cg",subg,i,"(U,Z,c)",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=
X   list('literal,"double *U,*Z,**c;",'cr!*,"{",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
X  gentlist:=list('literal,"cgi_num(",subg,",",j,",U,Z,c);",'cr!*,"}",'cr!*);
X  eval list('gentran,mkquote gentlist,'nil);
Xend;
X
X
Xsymbolic procedure numinits();
Xbegin
X  scalar eqs,eqhelp,nicis,i,j;
X  eqs:=nil; 
X  if !*numericmode then
X        eqhelp:=list('setq,'!n!u!m!e!r!i!c!_!m!o!d!e, 'TRUE)
X  else
X        eqhelp:=list('setq,'!n!u!m!e!r!i!c!_!m!o!d!e, 'FALSE);
X  eqs:=cons(eqhelp,eqs);
X  eqhelp:=list('!i!n!i!t!_!d!a!t!a);
X  eqs:=append(eqs,list(eqhelp));
X  return eqs;
Xend;
X
Xend;
END_OF_FILE
if test 9641 -ne `wc -c <'hybridnum'`; then
    echo shar: \"'hybridnum'\" unpacked with wrong size!
fi
# end of 'hybridnum'
fi
if test -f 'hybridsym' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'hybridsym'\"
else
echo shar: Extracting \"'hybridsym'\" \(23881 characters\)
sed "s/^X//" >'hybridsym' <<'END_OF_FILE'
X% SYMCON hybridsym
Xoff echo$
X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
X%%
X%% find conjugate and symmetric groups for hybridconjug hybridsym
X%%
X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
X
Xsymbolic procedure printmat(ma);
Xbegin
X  scalar maalg;
X  maalg:=for each z in ma collect
X            for each s in z collect
X              prepsq s;
X  maalg:=cons('mat,maalg);
X%  print list("maalg=",maalg);
X  eval list('mywrite,mkquote maalg);
Xend;
Xprocedure mywrite(arg);
Xwrite arg;
X
Xsymbolic procedure inverse(group,nrelem);
X  get(mkid('!*tab,group),mkid('inverse,nrelem));
X
Xsymbolic procedure mkinversetable(grouplist,group);
Xbegin
X  scalar ma,nrelem,i,glen,j;
X  glen:=length(grouplist);
X % tble:=nil;
X  for nrelem:=1:glen do
X    <<
X      ma:=nth(grouplist,nrelem);
X      ma:=mkmattrans(ma);
X      i:=0;j:=1;
X      while i=0 and not(j>glen) do
X          if nth(grouplist,j)=ma then i:=1 else j:=j+1;
X      if j>glen then rederror"matrices are not orthogonal";
X      put(mkid('!*tab,group),mkid('inverse,nrelem),j);
X     % tble:=cons(list(nrelem,j),tble);
X    >>;
X%  put(mkid('!*tab,group),'inverse,tble);
Xend;
X
Xsymbolic procedure mkgrouptable(grouplist,group);
X% 
Xbegin
X  scalar nr1,nr2,nr3,ma,glen,j,i;
X  glen:=length(grouplist);
X  for nr1:=1:glen do
X     for nr2:=1:glen do
X       <<
X          ma:=matmult(nth(grouplist,nr1),nth(grouplist,nr2)); 
X         i:=0;j:=1;
X         while i=0 and not(j>glen) do
X           if nth(grouplist,j)=ma then i:=1 else j:=j+1;
X         if j>glen then generror"matrices don't represent a group";
X         put(mkid('!*tab,group),mkid(mkid('op,nr1),nr2),j);
X       >>;
Xend;
X
Xsymbolic procedure findcgs(group,n,subgroups);
X% 
Xbegin
X  scalar grouplist,subg,invnr,g,g1,nam,subels,nrelem;
X  scalar cg,wo,noncgs,nolsator,subgroups1,tsubg; %,newg,newsubels;
X%print list("in findcgs",group,n,subgroups);
Xnoncgs:=subgroups;
X%print list("subgroups",subgroups);
Xsubgroups1:=mysubsetminus(subgroups,list(group));
Xwhile length(subgroups1)>0 do
X<< subg:= car subgroups1;
X   subgroups1:=cdr subgroups1;
X  subels:=get(mkid(mkid('!*,group),mkid(subg,'!*)),'elems);
X%  print list("elems",subg,subels);
X%  glen:=length(subels);
X  nolsator:=subels;
X  wo:=mkid('!*tab,group);
X  grouplist:= get(mkid(mkid('!*,group),mkid(group,'!*)),'elems);
X% try to make conjugate group tsubg
X  grouplist:=mysubsetminus(grouplist,subels);
X % print list("grouplist",grouplist);
X  while length(grouplist)>0 do
X    <<
X      nrelem:=car grouplist;
X      invnr:=get(wo,mkid('inverse,nrelem));
X   %    print list("inverse of ",nrelem," is ",invnr);
X      grouplist:=cdr grouplist;
X      tsubg:=for each g in subels collect
X         <<
X            g1:=get(wo,mkid(mkid('op,nrelem),g));
X            nam:=mkid(mkid('op,g1),invnr);
X %           print list("g1,nam",g1,nam);
X  %          print list("elem",get(wo,nam));
X            get(wo,nam)
X         >>;
X  %    print list("subg",subg,subels,tsubg);
X      if eqgroup(subels,tsubg) then  % conjugate group
X        <<
X          nolsator:=cons(nrelem,nolsator);
X        %  print list("normalisator",nolsator);
X        >> else
X        <<
X          cg:=searchg(group,delete(subg,subgroups),tsubg);
X              notetable(group,list(subg,cg),nrelem);
X    %      print list("2 groups",subg,cg);
X    %      if member(cg,noncgs) and  member(subg,noncgs) then 
X    %        <<
X    %          noncgs:=delete(cg,noncgs);
X           %   for each newg in subgroups do
X           %     <<
X           %       newsubels:=get(mkid(mkid('!*,group),mkid(subg,'!*)),'elems);
X           %       if member(nrelem,newsubels) and 
X           %         intersection(newsubels,subels)=subels and 
X           %         intersection(newsubels,tsubg)=tsubg then
X           %         flag1(mkid(mkid(cg,'in),newg),'conjugate);
X           %     >>;
X     %       >>;
X        >>;
X    >>;
X  notesymmetric(group,subg,subgroups,subels,nolsator); 
X>>;
Xreturn findcgs1(subgroups,group);
Xend;
X
Xsymbolic procedure findcgs1(subgroups,group);
X% eliminate the conjugate groups
Xbegin
X  scalar noncgs,nrelem,grouplist,cgs,storename,pr,pr1,i;
X  noncgs:=subgroups;
X  storename:=mkid('!*tab,group);
X  grouplist:= get(mkid(mkid('!*,group),mkid(group,'!*)),'elems);
X % search important group element which causes most conjugate groups
X  i:=0;
X  while length(grouplist)>0 do
X  <<  i:=i+1;
X    % print list("i",i,grouplist);
X     pr:=findnrmax(grouplist,storename);
X     nrelem:=car pr;
X     cgs:=cadr pr;
X     for each pr1 in cgs do 
X       if member(car pr1,noncgs) and member(cadr pr1,noncgs) then
X         << % which of the conjugate groups should be eliminated?
X            % try weighting with respect to subgroups
X            if subgweight(car pr1,noncgs) > subgweight(cadr pr1,noncgs) then
X            noncgs:=delete(cadr pr1,noncgs) else
X            noncgs:=delete(car pr1,noncgs);
X         >>;
X    grouplist:=delete(nrelem,grouplist);
X  >>;
X  return noncgs;
Xend;
X
Xsymbolic procedure findcgs1(subgroups,group);
X% second version 
X% eliminate the conjugate groups
Xbegin
X  scalar noncgs,nrelem,grouplist,cgs,storename,pr,pr1,i,subg;
X  storename:=mkid('!*tab,group);
X  grouplist:= get(mkid(mkid('!*,group),mkid(group,'!*)),'elems);
X % search important group element which causes most conjugate groups
X  i:=0;
X  cgs:=nil;
X  while length(grouplist)>0 do
X  <<  i:=i+1;
X    % print list("i",i,grouplist);
X     pr:=findnrmax(grouplist,storename);
X     nrelem:=car pr;
X     cgs:=append(cgs,cadr pr);
X     grouplist:=delete(nrelem,grouplist);
X  >>;
X  cgs:=condense(cgs);
X%  print list("call sortcgs",timc());
X  cgs:=sortcgs(cgs,group);
X%  print list("sortcgs ready",timc());
X  noncgs:=elimcgs(cgs,subgroups,group);
X  return noncgs;
Xend;
X
Xsymbolic procedure elimcgs(cgs,subgroups,group);
Xbegin
X  scalar noncgs,pr,elimg,hgs,ll,hg,prcg;
X  noncgs:=subgroups;
X  while length(cgs)>0 do
X   << pr:=car cgs;
X      cgs:=cdr cgs;
X      elimg:=elim1cgs(pr,noncgs);
X      if elimg then 
X        <<
X           noncgs:=delete(elimg,noncgs);
X           hgs:=isogrouptree(elimg);
X           hgs:=for each ll in hgs join cdr ll;
X           for each hg in hgs do
X            <<
X               prcg:=getcgpr(cgs,hg);
X               if prcg then 
X                 << 
X                    cgs:=delete(prcg,cgs);
X                    if elim1cgs(prcg,noncgs) then noncgs:=delete(hg,noncgs);
X                 >>;
X            >>;
X        >>;
X   >>;
X  return noncgs;
Xend;
X
X
Xsymbolic procedure elim1cgs(pr,noncgs);
Xbegin
X  scalar resval;
X  if length(pr)=2 then
X    <<
X       if member(car pr,noncgs) and member(cadr pr,noncgs) then
X          resval:=car pr;
X    >> else print list("error in elim1cgs");
X  return resval;
Xend;  
X
Xsymbolic procedure getcgpr(cgs,subg);
X if length(cgs)>0 then
X    if (caar cgs = subg) or (cadr car cgs =subg) then car cgs else
X       getcgpr(cdr cgs,subg);
X
Xsymbolic procedure sortcgs(cgs,group);
Xbegin
X  scalar i,subgmax,max,subg2,subgmaxelems,subg2elems,gs;
X  gs:=nil;
X  while length(cgs)>0 do
X   <<
X     subgmax:=car cgs;
X     subgmaxelems:=get(mkid(mkid('!*,group),mkid(car subgmax,'!*)),'elems);
X     max:=length(subgmaxelems);
X     for i:=2:length(cgs) do
X       <<
X          subg2:=nth(cgs,i);
X          subg2elems:=get(mkid(mkid('!*,group), mkid(car subg2,'!*)),'elems);
X          if length(subg2elems) > max then
X            <<
X               subgmax:=subg2;
X               max:=length(subg2elems);
X            >>;
X       >>;
X     gs:=append(gs,list(subgmax));
X     cgs:=delete(subgmax,cgs);
X   >>;
X  return gs;
Xend;
X
X%symbolic procedure subgweight(subg,gs);
X% number of subgroups of subg in gs
X%begin
X%  scalar bifgs,pr,group,count;
X%  bifgs:=isogrouptree(subg);
X%  bifgs:=for each pr in bifgs join cdr pr;
X%  bifgs:=condense(bifgs);
X%  count:=0;
X%  for each group in bifgs do
X%     if member(group,gs) then count:=count+1;
X%  return count;
X%end;
X
Xsymbolic procedure findnrmax(grouplist,storename);
X% 
Xbegin
X  scalar nrelem,nrmax,cgs,cgsmax;
X % search important group element which causes most conjugate groups
X  nrmax:=car grouplist;
X  cgsmax:=get(storename,mkid('cgof,nrelem));
X  for each nrelem in cdr grouplist do
X    <<
X      cgs:=get(storename,mkid('cgof,nrelem));
X      if length(cgs) > length(cgsmax) then
X        <<
X           cgsmax:=cgs;
X           nrmax:=nrelem;
X        >>;
X    >>;
X  return list(nrmax,cgsmax);
Xend;
X
Xsymbolic procedure noteconjugates(group,subgroups,noncgs);
Xbegin
X  scalar subg,comp,g,nrelem,cgs,pr,subels;
X % nrs:=get(mkid(mkid('!*,group),mkid(group,'!*)),'elems);
X  for each subg in subgroups do
X   <<
X     subels:=get(mkid(mkid('!*,group),mkid(subg,'!*)),'elems);
X     for each comp in isogrouptree(subg) do
X       <<
X         for each nrelem in subels do
X           <<
X             cgs:=get(mkid('!*tab,group),mkid('cgof,nrelem));
X             for each pr in cgs do
X             if intersection(pr,comp)=pr and 
X                 member(car pr,noncgs) and not(member(cadr pr,noncgs)) then
X                 <<
X                 flag1(mkid(mkid(cadr pr,'in),subg),'conjugate);
X             %     print list(cadr pr,"in",subg,"conjugate");
X                 >>;
X           >>;
X      >>;
X   >>;
Xend;
X
Xsymbolic procedure mysubsetminus(lbig,lsmall);
X% eliminate elements of lsmall in lbig
X if length(lsmall)>0 then mysubsetminus(delete(car lsmall,lbig),cdr lsmall) else
X            lbig;
X
Xsymbolic procedure searchg(group,subgroups,tsubg);
X% search for conjugate group of mamats in subgroups
Xbegin
X  scalar gl,subg,res;
X % print list("in searchg");
X  while not(res) and subgroups do
X   << subg:=car subgroups;
X      subgroups:=cdr subgroups;
X      gl:=get(mkid(mkid('!*,group),mkid(subg,'!*)),'elems);
X    %  print list("groups",subg,gl,tsubg);
X      if eqgroup(gl,tsubg) then res:= subg;
X   >>;
X  if not(res) then rederr"group not found";
X  return res;
Xend;
X
Xsymbolic procedure eqgroup(l1,l2);
X   if length(l1)=length(l2) and groupmem(l1,l2) then t ;
X
Xsymbolic procedure groupmem(l1,l2) ;
X  if length(l1)>0 then
X     (member(car l1,l2) and groupmem(cdr l1,l2)) else t;
X
Xsymbolic procedure notetable(group,pr,nrelem);
Xbegin
X  scalar propl,storename;
X  storename:=mkid('!*tab,group);
X  propl:=get(storename,mkid('cgof,nrelem));
X  if not(member(pr,propl)) then
X         put(storename,mkid('cgof,nrelem),cons(pr,propl));
Xend;
X
Xsymbolic procedure notesymmetric(group,subg,subgroups,subels,normalisator);
Xbegin
X  scalar g,gl,intglnorm;
X % print list("normalisator",subg,subels,normalisator);
X  for each g in subgroups do
X    <<
X       gl:= get(mkid(mkid('!*,group),mkid(g,'!*)),'elems);
X     %  print list("gl",gl);
X       if eqgroup(intersection(subels,gl),subels)  then  %supergroup found
X        <<
X           intglnorm:=intersection(gl,normalisator);
X        if not(eqgroup(intglnorm,subels)) 
X          and (length(intglnorm)=2*length(subels)) 
X         then 
X                                   % nor. in supergr.
X          <<
X             flag1(mkid(mkid(subg,'in),g),'symmetric);
X            % print list(subg," in ",g," symmetric");
X            writepri(list('aeval,mkquote subg),'first);
X            writepri(" is a symmetrical subgroup of ",'nil);
X            writepri(list('aeval,mkquote g),'last);
X          >>;
X       >>;
X    >>;
Xend;
X
X
Xsymbolic procedure mkops(group,subgroups,grouplist,n);
Xbegin
X  scalar ops,subg;
X  ops:=nil;
X  for each subg in subgroups do
X    ops:=union(ops,mkops1(group,subg,grouplist,n));
X% complete the inverse elements
X  return ops;
Xend;
X
Xsymbolic procedure mkops1(group,subg,grouplist,n);
Xbegin
X  scalar tup,invtup,ll,ops,charirr,ll,elems,j,jlast,ma;
X  scalar flagge1,flagge2,glen;
X  tup:=for i:=1:n collect list(simp list('Y,i));
X  elems:=get(mkid(mkid('!*,group),mkid(subg,'!*)),'elems);
X  ll:=for each j in elems collect nth(grouplist,j);
X  charirr:=for j:=1:length(elems) collect (1 ./ 1);
X  ma:=projection(1 ./ 1,charirr,ll);
X  invtup:=mkmatvek(ma,tup);  % invtup is inv. wrt subg
X  ll:=list(invtup);
X  glen:=length(grouplist);
X  ops:=nil;
X  flagge1:=nil;
X  while not flagge1 do   % search group elements which 
X                         % generate the orbit in a cycle 
X   <<
X      flagge2:=nil;
X      j:=1; jlast:=1;
X      while not flagge2 and j<glen do
X       <<
X         j:=j+1;
X         tup:=mkmatvek(nth(grouplist,j),first(ll));
X         if not(member(tup,ll)) then   %great, found new tup in orbit
X           <<
X              ll:=cons(tup,ll);
X              ops:=cons(j,ops);
X              flagge2:=t;
X           >>;
X         if jlast=1 and tup=invtup then jlast:=j;
X       >>;
X      if not(flagge2) then 
X         <<
X            ops:=cons(jlast,ops);
X            flagge1:=t;
X         >>;
X   >>;
X  ops:=reverse ops;
X  put(mkid(mkid('!*,group),mkid(subg,'!*)),'ops,ops);
X  return ops;
Xend;
X
Xsymbolic procedure genoperations(indixes,grouplist,group,n);
X% makes a C-procedures with output of a group transformation
X% using gentran
XBEGIN
X  SCALAR gentlist,eqs,decls,args,fktname,comp,i,gnr,tup,ma;
X  indixes:=union(indixes,
X     for each i in indixes collect 
X         inverse(group,i));
X  tup:=for i:=1:n collect list(simp list('Y,i));
X  for each gnr in indixes do
X    <<
X       ma:=nth(grouplist,gnr);
X      fktname:=MKID(group,MKID('!_!p!r!o!c!_,gnr));
X      decls:= LIST('DECLARE, LIST('!s!t!a!t!i!c! !v!o!i!d,fktname),
X                       LIST('DOUBLE, LIST('Y,'TIMES), LIST('!y!t,'TIMES)));
X      args:= LIST('Y,'!y!t);
X      i:=0;
X      eqs:=FOR EACH comp IN mkmatvek(ma,tup) COLLECT
X        <<i:=i+1;
X      LIST('SETQ, LIST('!y!t,i),replacesqrt(CAR comp))
X        >>;
X      eqs:=append(eqs,list(
X       list('SETQ, LIST('!y!t,n+1),list('Y,n+1))
X                           ));
X      gentlist:= LIST('PROCEDURE,fktname,'NIL,'EXPRN,args,
X                 APPEND( LIST('BLOCK,'NIL,decls),eqs));
X      EVAL LIST('GENTRAN,mkquote gentlist,'NIL);
X   >>;
XEND;
X
X%symbolic procedure mystoremats(group,subg,grouplist,storename);
X%% store the matrices corresponding to subgroup
X% for each g in subgrouptree(group,subg) collect
X%      nth(grouplist,g);
X
Xsymbolic procedure fdbreaks(nrelem,group,subg,subgroups,m,ma1);
Xbegin
X  scalar stornam,pr,g,flagge,ll,h,raus1;
X  flagge:=0;
X % print list("in fdbreaks ",subg);
X  stornam:=mkid(mkid('!*,group),mkid(subg,'!*));
X  raus1:=0;
X  h:=get(stornam,mkid('cgof,nrelem));
X  while length(h)>0 and raus1=0 do
X   <<
X      pr:=car h;
X      h:=cdr h;
X      if car pr = subg then  raus1:=1;
X   >>;
X  if raus1=1 then goto raus;
X % for each pr in get(stornam,mkid('cgof,nrelem)) do
X  %  if car pr = subg then goto raus;
X % print list("in fdbreaks nach 1. Schleife");
X  for each g in subgroups do 
X   if flagp(mkid(mkid(subg,'in),g),'symmetric) then
X       flagge:=1;
X % print list("in fdbreaks nach 2. Schleife");
X  if flagge=0 then goto raus;   % symmetric groups only
X % print list("in fdbreaks flagge",flagge);
X  if length(get(stornam,'nici))<3 then goto raus; 
X      % only several components are interesting
X % print list("in fdbreaks nach 3. Abfrage");
X  ll:=fdbreaks1(nrelem,group,subg,m,ma1);
X  if not(ll) then flagge:=0 else
X    <<
X      put(stornam,mkid('isol,nrelem),ll);
X      genbreak(mkid(mkid(subg,'!_),nrelem),ll);
X    >>;
X  raus: return;
Xend;
X
Xsymbolic procedure fdbreaks1(nrelem,group,subg,m,ma1);
Xbegin
X  scalar stornam,nici,cmat,ma,ll,i,j,itrans;
X  stornam:=mkid(mkid('!*,group),mkid(subg,'!*));
X  nici:=get(stornam,'nici);
X  %print list("stornam, nici",stornam,nici);
X  cmat:=get(stornam,'cmat);
X  ma:=matmult(mkmattrans(m),ma1);
X  ma:=matmult(ma,m);
X  ma:=matmult(ma,cmat);
X  ma:=matmult(mkmattrans(cmat),ma);
X%  print list("in fdbreaks1 group",subg);
X% run through the isotypic components
X  itrans:=2;
X  for i:=2:length(nici) do
X    << %print list("in fdbreaks1 i=",i,"multi",numr cadr nth(nici,i));
X      if numr cadr nth(nici,i) then
X       << %print list("length vector",length(mktup(nici,length(m),i)));
X          j:=memcomp(mkmatvek(ma,mktup(nici,length(m),i)),
X               nici) ;
X        %  print list("i,itrans,j",itrans,i,j);
X          if numberp j and not(itrans=j)  then ll:=cons(list(itrans,j),ll);
X          itrans:=itrans+1;
X       >>;
X    >>; 
X  return ll;
Xend;
X
Xsymbolic procedure memcomp(tup,nici);
Xbegin
X  scalar k,j,nk,ck,ll,flagge,n,ktrans,len;
X  n:=0; 
X  ll:=nil;
X % print list("in memcomp",tup);
X  ktrans:=1;
X  for k:=1:length(nici) do
X     <<
X       ck:=numr cadr nth(nici,k);
X       nk:=numr car nth(nici,k);
X       if not ck then 
X         <<
X           ck:=0;
X           ktrans:=ktrans;
X         >> else
X         <<
X          % if length(nth(nici,k))=2 then 
X           len:=nk*ck; % else len:=ck;  % complex case wrong
X           flagge:=nil;
X           for j:=1:len do
X              if not(numr car nth(tup,n+j)) then flagge:=0 else flagge:=1;
X           if flagge=1 then ll:=cons(ktrans,ll);
X       %    print list("k= ",ktrans,"flagge= ",flagge);
X           n:=n+ len;
X           ktrans:=ktrans+1;
X         >>;
X     >>;
X  ll:=condense(ll);
X  if not(length(ll)=1) then 
X     <<
X       print list("error in memcomp");
X       print list(ll,tup,nici);
X     >>;
X % print list("list in memcomp",ll);
X  return car ll;
Xend;
X
Xsymbolic procedure condense(ll);
Xbegin
X  scalar l1,elem;
X  l1:=nil;
X  while length(ll)>0 do
X    <<
X      elem:=car ll;
X      ll:=cdr ll;
X      if not(member(elem,l1)) then l1:=cons(elem,l1);
X    >>;
X  return l1;
Xend;
X
Xsymbolic procedure mktup(nici,n,i);
Xbegin
X  scalar k,j,nk,ck,res,hlp;
X % print list("in mktup",nici,n,i);
X  res:=for k:=1:length(nici) join
X     <<
X       ck:=numr cadr nth(nici,k);
X       nk:=numr car nth(nici,k);
X      % print list("nk,ck",nk,ck);
X       if not ck then ck:=0;
X       if k=i then 
X        <<
X          % if length(nth(nici,k))=2 then
X             hlp:=for j:=1:(ck*nk) collect list(simp list('Y,i));
X           %  else  % wrong % complex case
X            % hlp:=for j:=1:(ck) collect list(simp list('Y,i)) ; 
X        >> else
X        <<
X          % if length(nth(nici,k))=2 then
X             hlp:=for j:=1:(ck*nk) collect list( nil ./ 1) ;
X          % else % wrong % complex case
X           %  hlp:=for j:=1:(ck) collect list( nil ./ 1);
X        >>;
X        hlp
X     >>;
X % print list("tup",res);
X  if not(length(res) = n) then rederr"wrong length of tupel";
X  return res;
Xend;
X
Xsymbolic procedure findsupgsbreakis(subgroups,group,subg);
Xbegin
X  scalar gr,comp,res;
X % scalar gr,comp,res,storename;
X  res:=for each gr in subgroups join
X      <<
X         for each comp in isogrouptree(gr) join
X            if member(subg,cdr comp) then list list(gr,car comp) 
X      >>;
X%  print list("supergroups,isotyp.comp. in findsupgsbreakis",res);
X % storename:=mkid(mkid('!*,group),mkid(subg,'!*));
X % put(storename,'supergroups,res);
X  return res;
Xend;
X
Xsymbolic procedure fillsupgsbreakis(isogroups,group,subg);
Xbegin
X  scalar gr,comp,res,storename,oldsupis,storeid,gbreaki,supergs,newcomp;
X  storename:=mkid(mkid('!*,group),mkid(subg,'!*));
X  oldsupis:=get(storename,'supergroups);
X % print list("oldsupis",oldsupis);
X  res:=for each oldcomp in  oldsupis collect
X    <<
X      gr:=car oldcomp;
X     % print list("gr",gr);
X      supergs:=delete(oldcomp,oldsupis);
X     % print list("delete richtig",supergs);
X      newcomp:=oldcomp;
X     % print list("newcomp",newcomp);
X      for each gbreaki in supergs do
X        <<% print list("gbreaki",gbreaki);
X           storeid:=mkid(mkid('!*,group),mkid(car gbreaki,'!*));
X           for each  listgi in get(storeid,'supergroups) do
X            <<%print list("listgi",listgi);
X             if car listgi = gr then newcomp:=append(newcomp,cdr listgi);
X         %    print list("newcomp",newcomp);
X            >>;
X        >>;
X       newcomp
X    >>;
X % print list("fillsupgsbreakis gives",res);
X  return res;
Xend;
X
Xsymbolic procedure findsubgs(group,nicis);
X%determine Isotropie subgroups 
Xbegin
X  scalar treelist,isotropiegs,plist,subgroup,iso2;
X%  print list("in findsubgs");
X  isotropiegs:=for each plist in isogrouptree(group) join
X        detg(nicis,plist);
X   isotropiegs:=killequals(isotropiegs);
X % print list("isotropiegs",isotropiegs);
X  iso2:=for each subgroup in isotropiegs join
X          for each plist in isogrouptree(subgroup) join
X              detg(detnicis(subgroup,group,nicis),plist);
X  iso2:=killequals(iso2);   
X  isotropiegs:=append(iso2,isotropiegs);
X  isotropiegs:=killequals(isotropiegs);
X  iso2:=for each subgroup in isotropiegs join
X          for each plist in isogrouptree(subgroup) join
X              detg(detnicis(subgroup,group,nicis),plist);
X  iso2:=killequals(iso2);   
X %only two iterations -- possibly modification necessary
X  isotropiegs:=append(iso2,isotropiegs);
X  isotropiegs:=killequals(isotropiegs);
X  return isotropiegs;
Xend;
X
Xsymbolic procedure detg(nicis,plist);
X% nicis -- list of pairs (dimension,multiplicity ci,possibly 'C)
X% plist -- list of isotyp.nr., group1,group2,..
Xbegin
X   scalar nr,ci;
X  % print list("in detg");
X   nr:=car plist;
X   ci:=numr(cadr(nth(nicis,nr)) );
X  % print list("ci",ci);
X   if numberp(ci) then return cdr plist else return nil ; 
X   % if ci>0 then groups are possible bifurcation groups
Xend;
X
Xsymbolic procedure detnicis(subgroup,group,oldnicis);
X% oldnicis -- list of pairs (dimension,multiplicity) for group
X% subgroup is a proper subgroup of group
X% determine list nicis for subgroup
Xbegin
X  scalar connectlist,res;
X % print list("in detnicis oldnicis",oldnicis);
X  res:=for each connectlist in connectiso(group,subgroup) collect
X            newnicis(subgroup,connectlist,oldnicis);
X % print list("detnicis gives ",res,"for",group,subgroup);
X  return res;
Xend;
X
Xsymbolic procedure dimnicis(group,isotypnrs);
X% isotypnrs -- list with nr of isotypical comp. and - or split
X% nicis -- list of pairs (dim., multiplicity)
X% determines the dimension of this isotyp. of subgroup with help of nicis
Xbegin
X  scalar dimisotyp,dimlist,pairiso;
X  dimlist:=dimsofrep(group);
X  for each pairiso in dimlist do
X     if car pairiso =  isotypnrs then dimisotyp:=cdr pairiso;
X  return dimisotyp;
Xend;
X
Xsymbolic procedure newnicis(subgroup,connectlist,nicis);
X% isotypnrs -- list with nr of isotypical comp. and - or split
X% nicis -- list of pairs (dim., multiplicity)
X% determines the multiplicity of this isotyp. of subgroup 
X% with help of nicis and dimnicis
Xbegin
X  scalar nr,sumci,dimni,dimniold,isotypnrs,splitlist,splmult,res;
X % print list("in multnicis",connectlist);
X  dimni:=dimnicis(subgroup,car connectlist);
X  isotypnrs:=cadr connectlist;  % only list of isotyonr. of supergroup
X  sumci:=nil ./ 1;
X  while length(isotypnrs)>0 do
X   <<
X      nr:=car isotypnrs;
X      isotypnrs:=cdr isotypnrs;
X      if length(isotypnrs)>0 and car isotypnrs = 'split then
X          <<
X             isotypnrs:=cdr isotypnrs;
X             splitlist:=car isotypnrs;
X             isotypnrs:=cdr isotypnrs;
X             dimniold:=car nth(nicis,nr);
X  % the subgroup isotypical comp. of nr. car connectlist
X  % has dimension car dimni and has a part of the isotyp. comp. of the
X  % supergroup of nr. nr
X  % where splmult is the multiplicity of appearence
X             splmult:=quotsq(quotsq(length(splitlist) ./ 1,dimniold),car dimni);
X             sumci:=addsq(sumci, multsq(splmult,cadr(nth(nicis,nr))));
X% multiplicity of real irreducible representation
X          >> else
X          <<
X              sumci:=addsq(sumci, 
X                          multsq(cadr(nth(nicis,nr)),car(nth(nicis,nr)))
X                          );
X       %      print list("else case",subgroup,isotypnrs,nr);
X          >>;
X   >>;
X % print list("multnicicis gives",sumci);
X  res:=list(sumci);
X  res:=append(res,cdr dimni);
X  res:=append(list(car dimni),res);
X % print list(" subgroup , res",subgroup,res);
X  return res;
Xend;
X
Xsymbolic procedure killequals(objectlist);
X% make from a list a list with unequal objects
Xbegin
X  scalar reslist,ll,l1;
X%  print list("in killequals");
X  ll:=reverse objectlist;
X % print list("liste vorher",ll);
X  reslist:=nil;
X  while length(ll)>0 do
X    <<
X      l1:=car ll;
X      ll:=cdr ll;
X      if not(member(l1,ll)) then reslist:=append(reslist,list(l1));
X    >>;
X % print list("liste hinterher",reslist);
X  return reverse reslist;
Xend;
X
X
Xend;
X
END_OF_FILE
if test 23881 -ne `wc -c <'hybridsym'`; then
    echo shar: \"'hybridsym'\" unpacked with wrong size!
fi
# end of 'hybridsym'
fi
if test -f 'generror' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'generror'\"
else
echo shar: Extracting \"'generror'\" \(7790 characters\)
sed "s/^X//" >'generror' <<'END_OF_FILE'
Xoff echo$
Xsymbolic;
X 
Xsymbolic procedure mkfcdec(type, varlist); %Amended mcd 13/11/87,3/3/88
Xif type equal '!s!t!i!l!l!&!l!e!i!s!eINTEGER then
X   t else
X<<
X    if type equal 'scalar then
X        type := deftype!*;
X 
X    % Convert Reduce types to C types.
X    if type equal 'real then
X        type := 'float
X    else if type equal 'integer then
X        type := '!i!n!t
X    else if type equal 'double then 
X        type:='!d!o!u!b!l!e;
X 
X    % Deal with precision.
X    if !*double then  
X        if type equal 'float then
X                type := '!d!o!u!b!l!e
X        else if type equal '!i!n!t then
X                type := '!l!o!n!g;
X 
X    varlist := for each v in varlist collect
X           if atom v then
X               v 
X           else 
X               car v . for each dim in cdr v collect
X                       if numberp dim then add1 dim
X                        ELSE IF DIM='TIMES then '!* 
X                         else gentranerr('e,dim,"Not C dimension",nil);
X    append(mkctab() . type . '!  . for each v in insertcommas varlist
X                                       conc dimcexp v,
X           list('!;, mkcterpri()))
X>>$
X
Xsymbolic procedure lispcodeassign form;
X% Modified mcd 27/11/87 to prevent coercing things already declared as
X% integers to reals when the PERIOD flag is on.
X%
X% (SETQ var (MAT lst lst')) --> (PROGN (SETQ (var 1 1) exp11)          %
X%                                      (SETQ (var 1 2) exp12)          %
X%                                       .                              %
X%                                       .                              %
X%                                      (SETQ (var m n) expmn))         %
Xif eqcar( caddr form, 'mat) then
X    begin
X    scalar name, r, c, relts, result,ftype;
X    name := cadr form;
X    form := caddr form;
X    r := c := 1;
X    ftype := symtabget(nil,name);
X    if null ftype then ftype := !*period else
X    << ftype := cadr ftype;
X       ftype := if ftype equal 'integer or 
X        ftype equal '!s!t!i!l!l!&!l!e!i!s!eINTEGER  or
X            (ftype equal 'scalar and deftype!* equal 'integer) then nil
X                                                         else !*period;
X    >>;
X    while form := cdr form do
X    <<
X        relts := car form;
X        repeat
X        <<
X            result := mkassign(list(name, r, c),
X                               lispcodeexp(car relts, ftype))
X                                  . result;
X            c := add1 c
X        >>
X        until null(relts := cdr relts);
X        r := add1 r;
X        c := 1
X    >>;
X    return mkstmtgp(nil, reverse result)
X    end
Xelse begin
X	scalar ftype,name;
X	name := cadr form;
X	if pairp name then name := car name;
X	ftype := symtabget(nil,name);
X        if null ftype then ftype := !*period else
X        << ftype := cadr ftype;
X           ftype := if ftype equal 'integer or
X        ftype equal '!s!t!i!l!l!&!l!e!i!s!eINTEGER  or
X             (ftype equal 'scalar and deftype!* equal 'integer) then nil
X                                                          else !*period;
X        >>;
X        if cadr form eq 'e then % To prevent an 'e on the lhs
X                                % being changed to exp(1) by lispcodeexp
X                                % mcd 29/4/88
X                return mkassign('e,lispcodeexp(caddr form, ftype))
X        else
X             return mkassign(lispcodeexp(cadr form, ftype),
X               		     lispcodeexp(caddr form, ftype))
Xend$
X 
Xsymbolic procedure dimcexp v;
X     if atom v then list v else 
X     begin scalar name,dims; integer count; 
X       name := car v; dims := cdr v; 
X       while dims and car dims = '!* do 
X        <<count := count+1; dims:= cdr dims>>;
X       for each d in dims do if not fixp d then
X           gentranerr('e,d,"after number in array declaration",nil); 
X       v := if dims then cexp(name . dims) else list name;
X       for i:=1:count do v := '!* . v; 
X       return v; 
X     end; 
X 
Xalgebraic;
X
X
X
Xsymbolic procedure cexp1(exp, wtin);
Xif atom exp then
X    list cname exp
Xelse
X    if onep length exp then
X        append(cname exp, insertparens(()))
Xelse if car exp eq 'expt then
X        if cadr exp eq 'e
X          then !e!x!p . insertparens ('!(!d!o!u!b!l!e!) . insertparens cexp1(caddr exp,0))
X         else if caddr exp = 2
X          then cexp1 (list('times, cadr exp, cadr exp), wtin)
X         else if caddr exp = 3
X          then cexp1 (list('times, cadr exp, cadr exp, cadr exp), wtin)
X         else if caddr exp = 4
X          then cexp1 (list('times, cadr exp, cadr exp, cadr exp, cadr exp), wtin)
X         else
X        '!p!o!w . insertparens append('!(!d!o!u!b!l!e!) . insertparens cexp1(cadr exp, 0),
X                                     '!, . '!(!d!o!u!b!l!e!) . insertparens cexp1(caddr exp, 0))
X   else if optype car exp then
X        begin
X        scalar wt, op, res;
X        wt := cprecedence car exp;
X        op := cop car exp;
X        exp := cdr exp;
X        if onep length exp then
X            res := op . cexp1(car exp, wt)
X        else
X        <<
X            res := cexp1(car exp, wt);
X            if op eq '!+ then
X                while exp := cdr exp do
X                <<
X                    if atom car exp or caar exp neq 'minus then
X                        res := append(res, list op);
X                    res := append(res, cexp1(car exp, wt))
X                >>
X            else
X                while exp := cdr exp do
X                    res := append(append(res, list op),
X                                  cexp1(car exp, wt))
X        >>;
X        if wtin >= wt then res := insertparens res;
X        return res
X        end
X    else if car exp eq 'literal then
X        cliteral exp
X    else if car exp eq 'range then
X        if cadr exp = 0 then cexp caddr exp
X           else gentranerr('e,exp,
X                   "C does not support non-zero lower bounds",nil)
X    else if car exp eq '!:rd!: then
X        fortliteral list('literal,
X                         cadr exp,
X                         '!.e,
X                         cddr exp)
X    else if car exp memq '(!:cr!: !:crn!: !:gi!:) then
X        gentranerr('e,exp,"C doesn't support complex data type",nil)
X    else if arrayeltp exp then
X        cname car exp . foreach s in cdr exp conc
X                                insertbrackets cexp1(s, 0)
X   else if fktp car exp then         %5.June.90 K.G. & W.N.
X        cname car exp . insertparens 
X          cdr foreach s in cdr exp conc
X                                cons('!, , cexp1(s, 0))
X    else
X        begin
X        scalar op, res;
X        op := cname car exp;
X        exp := cdr exp;
X        res := append( '![ . cexp1(car exp, 0),'( !]) );
X	% Changed to generate proper C arrays - mcd 25/9/89
X        while exp := cdr exp do
X            res := append(res, append('![ . cexp1(car exp, 0)
X                                      ,'( !]) ) );
X        return op . res
X        end$
X
X
Xsymbolic procedure fktp (arg);  %5.June.90 K.G. & W.N.
X  memq( arg, !*symboltable!*);
X
X%symbolic symtabput('!r!e!t!u!r!n,nil,nil);
Xsymbolic symtabput('!a!p!p!e!n!d!_!o!p,nil,nil);
Xsymbolic symtabput('F!_!o!r!g,nil,nil);
Xsymbolic symtabput('!m!a!t!t!r!v!e!c!m!u!l!t,nil,nil);
Xsymbolic symtabput('SQRT,nil,nil);
Xsymbolic symtabput('!s!q!r!t,nil,nil);
Xsymbolic symtabput('!s!i!n,nil,nil);
Xsymbolic symtabput('!c!o!s,nil,nil);
Xsymbolic symtabput('SIN,nil,nil);
Xsymbolic symtabput('COS,nil,nil);
X%symbolic symtabput('!e!x!p,nil,nil);
Xsymbolic symtabput('EXP,nil,nil);
Xsymbolic symtabput('ABS,nil,nil);
X
Xend;
X
Xsymbolic symtabput('f,nil,nil);
X
Xoff raise;
XGENTRAN (PROCEDURE Z2();
XBEGIN
X  DECLARE <<
X             Z2 : void;
X             nsub(*) : INTEGER;
X             Z2!-!>dg : still!&leiseINTEGER;
X             s : INTEGER;
X            >>;
Xs:=2;
XZ2!-!>dg(8):=9;
Xnsub(2):=4;
Xreturn (Z2);
XEND ); 
XON RAISE;
Xsymbolic symtabput('Z2,'!n!s!u!b,list('INTEGER));
END_OF_FILE
if test 7790 -ne `wc -c <'generror'`; then
    echo shar: \"'generror'\" unpacked with wrong size!
fi
# end of 'generror'
fi
echo shar: End of shell archive.
exit 0

