1 /* SYMMETRICA source code file: mo.c */
2 #include "def.h"
3 #include "macro.h"
4 #ifdef DGTRUE
5 /* Darstellungen werden benoetigt */
6
7 #define ALLOCOFFSET 0
8 #define TL_calloc(a,b) SYM_calloc(a+ALLOCOFFSET,b)
9 #define TL_malloc(a) SYM_malloc(a+ALLOCOFFSET)
10 #define TL_free(a) SYM_free(a)
11
12 typedef signed char TL_BYTE;
13 typedef signed short TL_2BYTE;
14
15 #define SYM_memcmp memcmp
16
17 static void init_mat();
18 static void close_mat();
19 static INT _ber_inx_dec();
20 static INT modmat();
21 static INT moddreimat();
22 static INT r_modgauss();
23 static INT _modgauss();
24 static INT p_rel();
25 static INT p_writemat();
26 static INT zykel();
27 static INT modgauss();
28 static INT ganzgaussmod();
29 static INT homp();
30 static INT TL_darmod();
31 static INT d_mat();
32 static INT k_dimmod();
33 static INT _k_moddreimat();
34 static INT _assoziiere();
35 static INT alkonmat();
36 static INT zweikonmat();
37 static INT mat_comp();
38 static INT alcoeff();
39 static INT symdet ();
40 static INT sigper();
41 static INT alzyk();
42 static INT k_alzyk();
43 static INT j_zyk();
44 static INT inzeil();
45 static INT zykschnitt ();
46 static INT leer();
47 static INT a_teilmenge_b();
48 static INT setmin();
49 static INT _teste_r_mat_dim();
50 static INT _red_r_mat();
51 static INT _diff();
52 static INT _kleiner();
53 static INT _ggT();
54 static INT _v_eintrag();
55 static INT _ber_dim();
56 static INT _dimension();
57 static INT _fakul();
58 static INT _ber_lambdas();
59 static INT _r_induk();
60 static INT _num_part();
61 static INT _part_reg();
62 static INT _nexpart();
63 static INT _k_modgauss();
64 static INT COEFF();
65 static INT _search_dec();
66 static INT _k_zweikonmat();
67 static INT invp();
68 static INT fak();
69 static INT nexgitt();
70 static INT _ber_idx_pelem();
71 static INT darmod();
72 static INT lmatmulp();
73 static INT rmatmulp();
74 static INT homtestp();
75 static INT a_ohne_b_gl_c();
76 static INT matcopy();
77 static INT konjugiere();
78 static INT schnitt();
79 static INT _ggT_v();
80
81
82 static TL_BYTE AK_buf;
83 #define TL_MOD(a,b) \
84 ((AK_buf = (((INT)a)%(b)))<0?AK_buf+b:AK_buf)
85
86 /* mod(a,b)=a mod b >= 0 */
87 #define TL_ADP(x,y,p) TL_MOD((x)+(y),(INT)p)
88 #define TL_MULP(x,y,p) TL_MOD(((INT)x)*((INT)y),(INT)p)
89 #define TL_DIVP(x,y,p) TL_MULP((x),invp((INT)y,(INT)p),(INT)p)
90
91 /*
92 Global variables of MODULDAR
93 */
94 /*******************************************************************************
95 *
96 * Datei MODDGGLB.C
97 *
98 * Globale Variablen, die eventuell geaendert werden muessen.
99 *
100 *******************************************************************************/
101 /*
102 Ueblicher Headerfile...
103 */
104
105 static INT idmat();
106 /*
107 Globale Variablen des Programmpakets MODULDAR
108 */
109
110 /*
111 static INT MAXN = (INT)20;
112 static INT MAXZEILENZ = (INT)20;
113 static INT MAXSPALTENZ = (INT)20;
114 */
115 static INT MAXDM = (INT)5000;
116 static INT ZYK = (INT)50;
117
118 static INT PZ[] = {
119 (INT)2,(INT)3,(INT)5,(INT)7,(INT)11,(INT)13,(INT)17,(INT)19,(INT)23,(INT)29,(INT)31};
120
121
122 /*
123 Defines of possible errors
124 */
125 #define LmbNul (INT)-10
126 #define LmbEmp (INT)-11
127 #define LmbLt_null (INT)-12
128 #define LmbNRg (INT)-13
129 #define NLe_null (INT)-14
130 #define NGtMax (INT)-15
131 #define ZzGtMx (INT)-16
132 #define SzGtMx (INT)-17
133 #define DmGtMx ((INT)-18)
134 #define BzNul (INT)-19
135 #define CntOFl (INT)-20
136 #define DimLe_null (INT)-21
137 #define DrtNul (INT)-22
138 #define GzlNul (INT)-23
139 #define NoPrm (INT)-24
140 #define PrmLe_null (INT)-25
141 #define PrmGtN (INT)-26
142 #define NoSolu (INT)-27
143 #define DDmLt_null (INT)-28
144 #define DDmGMx (INT)-29
145 #define PerNul (INT)-30
146 #define PerLe_null (INT)-31
147 #define PerGtN (INT)-32
148 #define PeLgGN (INT)-33
149 #define RTabFt (INT)-99
150 #define NtEMem (INT)-109
151
152
153 /*
154 Macros for modulararithmetic
155
156
157 Die Modulararithmetik berechnet Summen (adp), Produkte (mulp),
158 Inverse (invp) und Quotienten (divp) modulo p. Bei Verwendung der
159 entsprechenden Funktionen muss p als Parameter uebergeben werden.
160 */
161
162 /*
163 und schliesslich globale Variablen.
164 */
165 static INT _zeilenz;
166 static INT q_zeilenz;
167 static INT _spaltenz;
168 static INT _n;
169 static INT _zyk;
170 #ifdef UNDEF
171 #define COEFF(x,y,z) ((z-y)%2L)?(((INT)-1)*fak(x+y-2L*z)*fak(z-y)*fak(z)) \
172 : (fak(x+y-2L*z)*fak(z-y)*fak(z))
173 #endif
COEFF(x,y,z)174 static INT COEFF(x,y,z) INT x,y,z;
175 {
176 return ((z-y)%(INT)2)?(((INT)-1)*fak(x+y-(INT)2*z)*fak(z-y)*fak(z))
177 : (fak(x+y-(INT)2*z)*fak(z-y)*fak(z)) ;
178 }
179
180 /*----------------------------------------------------------------------------*/
_k_zweikonmat(lambda,bz,pz)181 static INT _k_zweikonmat(lambda,bz,pz) TL_BYTE *lambda, *bz;
182 INT pz;
183 /*-----------------------------------------------------------------------------
184 berechnet die Koeffizientenmatrix B zu einer Partition lambda, deren
185 Laenge gleich zwei ist. Dabei werden die Elemente der Matrix modulo pz
186 abgelegt. (Vgl. MODULKFF.C Funktion zweikonmat().)
187 Variablen: lambda, Partition;
188 pz, Primzahl.
189 Reuckgabe Koeffizientenmatrix bz.
190 Rueckgabewerte: >(INT)0, Dimension der gewoehnlichen irred. Darstellung;
191 (INT)-109, falls nicht genuegend Speicher zur Verfuegung stand.
192 ------------------------------------------------------------------------------*/
193 /* TL 0790 */ /* AK 210891 V1.3 */
194 {
195 INT i,j,l,z,zaehl,mdim,dim;
196 TL_BYTE *g_i,*g_j;
197 TL_BYTE *start;
198 TL_BYTE *_bz;
199 INT g_im,g_jm;
200
201 start=(TL_BYTE *)TL_calloc((int)_n*3,sizeof(TL_BYTE));
202 if (!start) return no_memory();
203 g_i=start+(INT)_n;
204 g_j=g_i+(INT)_n;
205 mdim=MAXDM;
206 g_im=FALSE;
207 if (nexgitt(start,lambda,&g_im))
208 {
209 SYM_free(start);
210 return no_memory();
211 }
212 for (z=0;z<_n;g_i[z]=start[z],z++);
213 _bz=bz;
214 for (i=0,g_im=TRUE;g_im;i++)
215 {
216 for (z=0;z<_n;g_j[z]=start[z],z++);
217
218 for (j=0,g_jm=TRUE;g_jm;j++)
219 {
220 for (l=0,zaehl=(INT)0;l<_n;l++)
221 if (g_i[l]==(TL_BYTE)1 && g_j[l]==(TL_BYTE)1) zaehl++;
222 *_bz++ = (TL_BYTE) TL_MOD( COEFF(_n,zaehl,(INT)lambda[1]) ,pz);
223 if (nexgitt(g_j,lambda,&g_jm))
224 {
225 SYM_free(start);
226 return no_memory();
227 }
228 }
229 if (!i)
230 {
231 dim=j;
232 if (dim>MAXDM)
233 {
234 dim *= ((INT)-1);
235 break;
236 }
237 }
238 if (dim<mdim)
239 mdim=dim;
240 if (nexgitt(g_i,lambda,&g_im))
241 {
242 SYM_free(start);
243 return no_memory();
244 }
245 }
246 SYM_free(start);
247 return(dim);
248 } /* k_zweikonmat */
249
250
251
252
253 /*
254 Externe Funktion der Modulararithmetik aus MODULARI.C
255 */
256 /*******************************************************************************
257 *
258 * Datei MODULARI.C
259 * Version vom 29.09.1989
260 *
261 *
262 * Zeile Funktion
263 *
264 * Funktion zur Berechnung des modular Inversen
265 * --------------------------------------------
266 * 30 INT invp(INT z,INT p)
267 *
268 *******************************************************************************/
269 /*
270 Uebliche...
271 */
272
273
274
275 /*----------------------------------------------------------------------------*/
invp(z,p)276 static INT invp(z,p) INT z;
277 INT p;
278 /*------------------------------------------------------------------------------
279 berechnet das Inverse von z in GF(p) mit Hilfe Euklids.
280 Variablen: z, ganze Zahl;
281 p, Primzahl.
282 Rueckgabewert: Inverses von z in GF(p).
283 ------------------------------------------------------------------------------*/
284 /* TL 0790 */ /* AK 210891 V1.3 */
285 {
286 INT x[2],y[2],yh,i,q,r;
287
288 x[0]=(INT)1;
289 x[1]=(INT)abs(z);
290 y[0]=(INT)0;
291 y[1]=(INT)abs(p);
292 if (x[1]<y[1])
293 for (i=(INT)0;i<2L;++i)
294 {
295 yh=y[i];
296 y[i]=x[i];
297 x[i]=yh;
298 }
299 while (y[1]>(INT)0)
300 {
301 while ((INT)2*y[1]>x[1])
302 for (i=(INT)0;i<2L;++i)
303 {
304 yh=y[i];
305 y[i]=x[i]-y[i];
306 x[i]=yh;
307 }
308 q=x[1]/y[1];
309 r=x[1]%y[1];
310 yh=y[0];
311 y[0]=x[0]-q*y[0];
312 x[0]=yh;
313 x[1]=y[1];
314 y[1]=r;
315 }
316 x[0]= z<(INT)0 ? -x[0] : x[0];
317 /* return(((x[0]%p)<(INT)0) ? x[0]%p+p : x[0]%p); */
318 return(((z=(x[0]%p))<(INT)0) ? z+p : z);
319 } /* invp */
320
321
322 /*
323 Makros zur Modulararithmetik
324 */
325
326 /*******************************************************************************
327 *
328 * Datei MODULKFF.C
329 * Version vom 29.09.89
330 *
331 *
332 * Zeile Funktion
333 *
334 *
335 * Funktionen fuer Mengenoperationen
336 * ---------------------------------
337 * 88 INT setmin(TL_BYTE *a)
338 * 107 INT a_teilmenge_b(TL_BYTE *a,TL_BYTE *b)
339 * 129 INT leer(TL_BYTE *a)
340 * 148 a_ohne_b_gl_c(TL_BYTE *a,TL_BYTE *b,TL_BYTE *c)
341 *
342 * Funktionen zur Berechnung der Koeffizientenmatrix (B,C_eins,C_zwei)
343 * -----------------------------------------------------------
344 * 175 INT zykschnitt(INT *t_eins,INT *t_zwei,INT *perm,INT *zykmt)
345 * 216 INT inzeil(INT la,TL_BYTE *zmat,TL_BYTE *fln)
346 * 355 INT j_zyk(INT la,INT j_zwei,TL_BYTE **xm,TL_BYTE *zh)
347 * 454 INT k_alzyk(INT la,INT *zmat,INT *fln,INT *cy)
348 * 523 INT alzyk(INT la,INT *zmat,INT *fln,INT *cy)
349 * 547 INT sigper(INT *fln,INT la)
350 * 586 INT symdet(TL_BYTE *mat,TL_BYTE *slambda,INT li,INT *tsc)
351 * 804 INT fak(INT i)
352 * 820 INT alcoeff(INT *mat,INT *slambda)
353 * 849 INT nexgitt(TL_BYTE *y,TL_BYTE *lambda,INT *mtc)
354 * 918 INT zweikonmat(INT *lambda,INT *perm,INT *bz)
355 * 1003 konjugiere(INT *lambda,INT *lambdastrich)
356 * 1025 schnitt(INT *t_eins,INT *t_zwei,INT *mat)
357 * 1043 INT mat_comp(TL_BYTE *co,TL_BYTE *mat,INT *slamda)
358 *
359 * Hauptfunktion
360 * -------------
361 * 1099 INT alkonmat(INT *lambda,INT *perm,INT *bz)
362 *
363 *******************************************************************************/
364 /*
365 Headerfiles wie in jedem C-Programm,...
366 */
367
368
369
370
371 /*
372 interne Makros ...
373 */
374 /* #define IND(a,b,c) (INT)((INT)(a)*(INT)(c)+(INT)(b)) */
375 #define IND(a,b,c) ((INT)(a)*(INT)(c)+(b))
376 /*
377 #define COEFF(x,y,z) ((z-y)%2L)?((-1L)*fak(x+y-2L*z)*fak(z-y)*fak(z)) \
378 : (fak(x+y-2L*z)*fak(z-y)*fak(z))
379 */
380 #define INDEX(x) ZYK/2+x
381
382
383
384 /*******************************************************************************
385 *
386 * Funktionen fuer Mengenoperationen ...
387 *
388 * Mengen sind Felder a mit Eintraegen a[i]:
389 * Element i nicht enthalten => a[i]=0
390 * Element i enthalten => a[i]=1
391 *
392 *******************************************************************************/
393
394
395 /*----------------------------------------------------------------------------*/
setmin(a)396 static INT setmin(a) TL_BYTE *a;
397 /*------------------------------------------------------------------------------
398 errechnet das Minimum der Menge a.
399 Rueckgabewerte: Elementnummer m, falls m Minimum ist;
400 -1L, falls kein Minimum existiert.
401 ------------------------------------------------------------------------------*/
402 /* TL 0790 */ /* AK 210891 V1.3 */
403 {
404 TL_BYTE *_a;
405 INT m;
406
407 for (m=(INT)0,_a=a;m<_n;m++,_a++)
408 if (*_a)
409 return(m);
410 return(-1L);
411 }
412
413
414 /*----------------------------------------------------------------------------*/
a_teilmenge_b(a,b)415 static INT a_teilmenge_b(a,b) TL_BYTE *a, *b;
416 /*------------------------------------------------------------------------------
417 ueberprueft, ob Menge a Teilmenge von Menge b ist.
418 Rueckgabewerte: TRUE, falls a Teilmenge von b ist;
419 FALSE, falls a nicht Teilmenge von b ist.
420 ------------------------------------------------------------------------------*/
421 /* TL 0790 */ /* AK 210891 V1.3 */
422 {
423 TL_BYTE *_a,*_b;
424 INT m;
425
426 for (m=(INT)0,_a=a,_b=b;m<_n;m++,_a++,_b++)
427 if (*_a)
428 {
429 if (! *_b)
430 return(FALSE);
431 }
432 return(TRUE);
433 }
434
435
436 /*----------------------------------------------------------------------------*/
leer(a)437 static INT leer(a) TL_BYTE *a;
438 /*------------------------------------------------------------------------------
439 ueberprueft, ob die Menge a leer ist.
440 Rueckgabewerte: TRUE, falls a leer ist;
441 FALSE, falls a nicht leer ist.
442 ------------------------------------------------------------------------------*/
443 /* TL 0790 */ /* AK 210891 V1.3 */
444 {
445 INT m;
446
447 for (m=(INT)0;m<_n;m++,a++)
448 if (*a)
449 return (FALSE);
450 return (TRUE);
451 }
452
453
454 /*----------------------------------------------------------------------------*/
a_ohne_b_gl_c(a,b,c)455 static INT a_ohne_b_gl_c(a,b,c) TL_BYTE *a,*b,*c;
456 /*------------------------------------------------------------------------------
457 berechnet die Menge a\b.
458 Rueckgabe Menge c = a\b.
459 ------------------------------------------------------------------------------*/
460 /* TL 0790 */ /* AK 210891 V1.3 */
461 {
462 INT m;
463
464 for (m=(INT)0;m<_n;m++,a++,b++,c++)
465 {
466 if (*b)
467 *c = (TL_BYTE)0;
468 else
469 *c = *a;
470 }
471 return OK;
472 }
473
474
475 /*******************************************************************************
476 *
477 * Funktionen fuer die Bestimmung der Koeffizientenmatrix (B,C_eins,C_zwei)...
478 *
479 *******************************************************************************/
480
481
482 /*----------------------------------------------------------------------------*/
zykschnitt(t_eins,t_zwei,perm,zykmt)483 static INT zykschnitt (t_eins,t_zwei,perm,zykmt) TL_BYTE *t_eins, *t_zwei, *perm, *zykmt;
484 /*------------------------------------------------------------------------------
485 berechnet Schnittmatrix zykmt in Abhaengigkeit von der Permutation perm.
486 Rueckgabewerte: (INT)0, falls alles ohne Fehler durchgefuehrt werden konnte;
487 (INT)-109, falls nicht genuegend Speicher zu Verfuegung steht.
488 Rueckgabe Schnittmatrix zykmt.
489 ------------------------------------------------------------------------------*/
490 /* TL 0790 */ /* AK 210891 V1.3 */
491 {
492 INT i,j;
493 TL_BYTE *zeile,*z;
494 INT enthalten;
495
496 zeile=(TL_BYTE *)TL_calloc((int)_n*(int)_n,sizeof(TL_BYTE));
497 if (!zeile) return no_memory();
498 for (i=q_zeilenz,z=zykmt;i>(INT)0;i--,*z++ = (INT)0);
499 /*
500 Berechnung der Zeilenziffernmengen von (perm)T2:
501 */
502 for (i=_n-1L;i>=(INT)0;--i)
503 zeile[IND(t_zwei[i],perm[i]-1L,_n)]=1L;
504 for (j=(INT)0;j<_n;++j)
505 {
506 enthalten=FALSE;
507 i=(INT)0;
508 do
509 {
510 if (zeile[IND(i,j,_n)])
511 {
512 ++zykmt[IND(t_eins[j],i,_zeilenz)];
513 enthalten=TRUE;
514 }
515 else
516 ++i;
517 } while (!enthalten);
518 }
519 SYM_free(zeile);
520 return (INT)0;
521 } /* zykschnitt */
522
523
524 /*----------------------------------------------------------------------------*/
inzeil(la,zmat,fln)525 static INT inzeil(la,zmat,fln) INT la;
526 TL_BYTE *zmat, *fln;
527 /*------------------------------------------------------------------------------
528 bestimmt, falls moeglich, paarweise verschiedene Ziffern i_eins,i2L,...,ilambda1L,
529 welche die injektive erste Zeile eines Elementes von [Ts]c darstellen.
530 (Weitere Erlaeuterung in:
531 Golembiowski, Andreas
532 Zur Berechnung modular irreduzibler Matrixdarstellungen symmetrischer
533 Gruppen mit Hilfe eines Verfahrens von M.Clausen
534 Bayreuther Mathematische Schriften Heft 25L, Bayreuth 1987
535 SS. 162ff)
536 Variablen: la, Teil der konjugierten Partition;
537 zmat, Schnittmatrix.
538 Rueckgabewerte: (INT)-109, falls kein Speicher zur Verfuegung stand;
539 (INT)0, sonst.
540 Rueckgabe Matrix fln.
541 ------------------------------------------------------------------------------*/
542 /* TL 0790 */ /* AK 210891 V1.3 */
543 {
544 INT i,i_eins,j,j_eins,r,k,m,oz;
545 TL_BYTE **xm,**qu,*ze[2],*un,*hilf;
546
547 xm=(TL_BYTE **)TL_calloc((int)(_zeilenz+_zeilenz+2L),sizeof(TL_BYTE *));
548 if (!xm)
549 return no_memory();
550 qu=xm+(INT)_zeilenz+1L;
551 hilf=(TL_BYTE *)TL_calloc((int)(_zeilenz+_zeilenz+6L)*(INT)_n,sizeof(TL_BYTE));
552 if (!hilf)
553 {
554 SYM_free(xm);
555 return no_memory();
556 }
557 un=hilf+(INT)_n;
558 ze[0]=un+(INT)_n;
559 ze[1]=ze[0]+(INT)_n;
560 xm[0]=ze[1]+(INT)_n;
561 for (i=1L;i<=_zeilenz;xm[i]=xm[i-1]+(INT)_n,i++);
562 qu[0]=xm[_zeilenz]+(INT)_n;
563 for (i=1L;i<=_zeilenz;qu[i]=qu[i-1]+(INT)_n,i++);
564 for (j=(INT)0;j<la;fln[j++]= (TL_BYTE) -1);
565 i=(INT)0;
566 while (fln[0]<(INT)0)
567 if (zmat[IND(i,(INT)0,_zeilenz)])
568 fln[0]=i;
569 else
570 ++i;
571 ze[0][fln[0]]=(TL_BYTE)1;
572 ze[1][0]=(TL_BYTE)1;
573 r=1L;
574 while (r<la)
575 {
576 for (m=(INT)0;m<la;xm[0][m]=(ze[0][m]?(TL_BYTE)0:(TL_BYTE)1), m++);
577 for (m=(INT)0;m<_n;qu[0][m]=(TL_BYTE)0,m++);
578 for (j=(INT)0;j<la;++j)
579 {
580 i=(INT)0;
581 oz=(INT)0;
582 while (!oz && i<la)
583 if (xm[0][i] && zmat[IND(i,j,_zeilenz)])
584 {
585 qu[0][j]=(TL_BYTE)1;
586 oz=1L;
587 }
588 else
589 ++i;
590 }
591 for (m=(INT)0;m<_n;un[m]=qu[0][m],m++);
592 k=(INT)0;
593 while (a_teilmenge_b(qu[k],ze[1]) && (oz!=2L))
594 {
595 ++k;
596 for (m=(INT)0;m<_n;xm[k][m]=(TL_BYTE)0,m++);
597 for (j=(INT)0;j<la;++j)
598 if (qu[k-1][j])
599 xm[k][fln[j]]=1L;
600 for (m=(INT)0;m<_n;qu[k][m]=(INT)0,m++);
601 for (j=(INT)0;j<la;++j)
602 {
603 for (m=0;m<la;m++)
604 if (un[m] == 0)
605 hilf[m]=1;
606 else
607 hilf[m]=0;
608 if (hilf[j])
609 {
610 i=(INT)0;
611 oz=(INT)0;
612 while (!oz && i<la)
613 if ((xm[k][i]) && (zmat[IND(i,j,_zeilenz)]))
614 {
615 qu[k][j]=(TL_BYTE)1;
616 oz=1L;
617 }
618 else
619 ++i;
620 }
621 }
622 if (leer(qu[k]))
623 {
624 oz=2L;
625 fln[0]= -1L;
626 }
627 else
628 for (m=(INT)0;m<_n;++m)
629 if (qu[k][m])
630 un[m]=1L;
631 }
632 if (oz!=2L)
633 {
634 a_ohne_b_gl_c(qu[k],ze[1],hilf);
635 j_eins=setmin(hilf);
636 ze[1][j_eins]=(TL_BYTE)1;
637 ++r;
638 i_eins=(INT)0;
639 while (fln[j_eins]<(INT)0)
640 if (xm[k][i_eins] && zmat[IND(i_eins,j_eins,_zeilenz)])
641 fln[j_eins]=i_eins;
642 else
643 ++i_eins;
644 while (k>=1L)
645 {
646 for (j=(INT)0;fln[j]!=i_eins || j==j_eins;j++);
647 j_eins=j;
648 i=(INT)0;
649 while (fln[j_eins]==i_eins)
650 if (xm[k-1][i] && zmat[IND(i,j_eins,_zeilenz)])
651 fln[j_eins]=i;
652 else
653 ++i;
654 i_eins=i;
655 --k;
656 }
657 ze[0][i_eins]=(TL_BYTE)1;
658 }
659 else
660 r=la;
661 }
662 SYM_free(hilf);
663 SYM_free(xm);
664 return((INT)0);
665 } /* inzeil */
666
667
668 /*----------------------------------------------------------------------------*/
j_zyk(la,j_zwei,xm,zh)669 static INT j_zyk(la,j_zwei,xm,zh) INT la,j_zwei;
670 TL_BYTE **xm, *zh;
671 /*------------------------------------------------------------------------------
672 berechnet Menge der Zyklen (j_null j_eins ... jk).
673 (Weitere Erlaeuterung in:
674 Golembiowski, Andreas
675 Zur Berechnung modular irreduzibler Matrixdarstellungen symmetrischer
676 Gruppen mit Hilfe eines Verfahrens von M.Clausen
677 Bayreuther Mathematische Schriften Heft 25L, Bayreuth 1987
678 SS. 166ff)
679 Variablen: la, Element der konjugierten Partition;
680 j_zwei, erstes Element des Zykels;
681 xm, Mengen.
682 Rueckgabewerte: (INT)-109, nicht genug Speicher;
683 (INT)0, sonst.
684 Rueckgabe Vektor zh.
685 ------------------------------------------------------------------------------*/
686 /* TL 0790 */ /* AK 210891 V1.3 */
687 {
688 INT i,k,l,nr,m;
689 static TL_BYTE *j=NULL;
690 static TL_BYTE *ym=NULL,*hilf=NULL,**xm_eins=NULL;
691 static INT old_z = (INT)-1;
692
693 if (la == (INT)-15) {
694 if (j != NULL) {
695 SYM_free(j);
696 j = NULL;
697 }
698 if (xm_eins != NULL) {
699 SYM_free(xm_eins);
700 xm_eins = NULL;
701 }
702 old_z = (INT)-1;
703 return (INT)0;
704 }
705
706 if (old_z < _zeilenz) {
707 if (j != NULL) SYM_free(j);
708 if (xm_eins != NULL) SYM_free(xm_eins);
709 j=(TL_BYTE *)TL_calloc((int)_zeilenz+1
710 + (int)(_zeilenz+2L)*(int)_n ,sizeof(TL_BYTE));
711 xm_eins=(TL_BYTE **)
712 TL_calloc((int)_zeilenz,sizeof(TL_BYTE *));
713
714 if (!j)
715 return no_memory();
716 if (!xm_eins)
717 {
718 SYM_free(j);
719 return no_memory();
720 }
721
722 hilf = j + (int)_zeilenz+1;
723 ym=hilf+_n;
724 xm_eins[0]=ym+_n;
725 for (i=1L;i<_zeilenz;xm_eins[i]=xm_eins[i-1]+_n,i++);
726 old_z = _zeilenz;
727
728 }
729 j[0]=j_zwei;
730
731
732 memset(&zh[INDEX(-la)],0,(ZYK+la+1) * sizeof(TL_BYTE) );
733
734 if (la >= ZYK) error("internal error MO-5");
735 for (i= 0;i<la;++i)
736 memcpy(xm_eins[i],xm[i],_n * sizeof(TL_BYTE));
737
738 l=(INT)0;
739 nr=1L;
740 while (!leer(xm_eins[j_zwei]))
741 {
742 for (m=(INT)0;m<_n;ym[m++]=(INT)0);
743 k=1L;
744 do
745 {
746 a_ohne_b_gl_c(xm_eins[j[k-1]],ym,hilf);
747 j[k]=setmin(hilf);
748 if (xm_eins[j[k]][j[0]])
749 {
750 ++nr;
751 zh[INDEX(-nr)]=l+1L;
752 ++zh[INDEX(-1L)];
753 if (l==(INT)0)
754 zh[INDEX(0)]=k+1L;
755 else if ((k+1L)<(zh[INDEX(0)]))
756 zh[INDEX(0)]=k+1L;
757 zh[INDEX(l+1L)]=k+1L;
758 zh[INDEX(l+2L)]=j[0]+1L;
759 for (i=k+1L;i>=2L;--i)
760 zh[INDEX(l+k+4-i)]=j[i-1]+1L;
761 l=l+k+3L;
762 }
763 ym[j[k-1]]=1L;
764 a_ohne_b_gl_c(xm_eins[j[k]],ym,hilf);
765 if (!leer(hilf))
766 ++k;
767 else
768 {
769 while (leer(hilf) && (k>=1L))
770 {
771 xm_eins[j[k-1]][j[k]]=(INT)0;
772 ym[j[k]]=(INT)0;
773 for (m=(INT)0;m<_n;xm_eins[j[k]][m]=xm[j[k]][m],m++);
774 --k;
775 a_ohne_b_gl_c(xm_eins[j[k]],ym,hilf);
776 }
777 if (k>=1L)
778 ++k;
779 }
780 } while (k);
781 }
782 return((INT)0);
783 } /* j_zyk */
784
785
786 /*----------------------------------------------------------------------------*/
k_alzyk(la,zmat,fln,cy)787 static INT k_alzyk(la,zmat,fln,cy) INT la;
788 TL_BYTE *cy;
789 TL_BYTE *zmat, *fln;
790 /*------------------------------------------------------------------------------
791 initialisiert Felder, die im Unterprogramm j_zyk benoetigt werden, und ruft
792 j_zyk auf.
793 (Weitere Erlaeuterung in:
794 Golembiowski, Andreas
795 Zur Berechnung modular irreduzibler Matrixdarstellungen symmetrischer
796 Gruppen mit Hilfe eines Verfahrens von M.Clausen
797 Bayreuther Mathematische Schriften Heft 25L, Bayreuth 1987
798 SS. 168ff)
799 Variablen: la, Element der konjugierten Partition;
800 zmat, Schnittmatrix;
801 fln, Matrix aus inzeil.
802 Rueckgabewerte: (INT)-109, nicht genug Speicher;
803 (INT)0, sonst.
804 Rueckgabe Matrix aller Zyklen.
805 ------------------------------------------------------------------------------*/
806 /* TL 0790 */ /* AK 210891 V1.3 */
807 {
808 INT i,j_eins,j_zwei,m;
809 TL_BYTE *zh;
810 TL_BYTE *z_eins,*z_zwei;
811 TL_BYTE **xm;
812
813 xm=(TL_BYTE **)TL_calloc((int)_zeilenz,sizeof(TL_BYTE *));
814 if (!xm)
815 return no_memory();
816 xm[0]=(TL_BYTE *)TL_calloc((int)_zeilenz*(int)_n,sizeof(TL_BYTE));
817 if (!xm[0])
818 {
819 SYM_free(xm);
820 return no_memory();
821 }
822 zh=(TL_BYTE *)TL_calloc((int)_zyk,sizeof(TL_BYTE));
823 if (!zh)
824 {
825 SYM_free(xm[0]);
826 SYM_free(xm);
827 return no_memory();
828 }
829 for (i=1L;i<_zeilenz;xm[i]=xm[i-1]+_n,i++);
830 for (j_eins=(INT)0,z_eins=zmat;j_eins<la;j_eins++,z_eins++)
831 {
832 j_zwei=fln[j_eins];
833 for (m=(INT)0;m<_n;(xm[j_zwei])[m++]=(TL_BYTE)0);
834 for (i=(INT)0,z_zwei=z_eins;i<la;i++,z_zwei += _zeilenz)
835 if (*z_zwei && (i!=j_zwei))
836 xm[j_zwei][i]=1L;
837 }
838 for (j_eins=(INT)0;j_eins<la;++j_eins)
839 {
840 j_zwei=fln[j_eins];
841 if (j_zyk(la,j_zwei,xm,zh))
842 {
843 SYM_free(xm[0]);
844 SYM_free(xm);
845 SYM_free(zh);
846 return no_memory();
847 }
848
849 memcpy(&cy[IND(j_zwei,(INT)0,_zyk)],
850 &zh[INDEX(-(ZYK/2L))],
851 sizeof(TL_BYTE)*(ZYK+ZYK/2 + 1));
852 for (m=(INT)0;m<_n;xm[j_zwei][m++]=(INT)0);
853 }
854 SYM_free(xm[0]);
855 SYM_free(xm);
856 SYM_free(zh);
857 j_zyk((INT) -15,0,NULL,NULL); /* AK 050794 */
858 return((INT)0);
859 } /* k_alzyk */
860
861
862 /*----------------------------------------------------------------------------*/
alzyk(la,zmat,fln,cy)863 static INT alzyk(la,zmat,fln,cy) INT la; TL_BYTE *cy; TL_BYTE *zmat, *fln;
864 /*------------------------------------------------------------------------------
865 ruft inzeil und k_alzyk koordiniert auf.
866 Variablen: la, Element der konjugierten Partition;
867 zmat, Schnittmatrix.
868 Rueckgabewerte: (INT)-109, nicht genug Speicher;
869 (INT)0, sonst.
870 Rueckgabe Matrix cy aller Zyklen und Matrix fln paarweise verschiedene
871 Ziffern i_eins,...,ilambda1.
872 ------------------------------------------------------------------------------*/
873 /* TL 0790 */ /* AK 210891 V1.3 */
874 {
875 if (inzeil(la,zmat,fln))
876 return no_memory();
877 if (fln[0]>=(INT)0)
878 {
879 if (k_alzyk(la,zmat,fln,cy))
880 return no_memory();
881 }
882 return((INT)0);
883 } /* alzyk */
884
885
886 /*----------------------------------------------------------------------------*/
sigper(fln,la)887 static INT sigper(fln,la) TL_BYTE *fln, la;
888 /*------------------------------------------------------------------------------
889 berechnet sgn(fln).
890 Variablen: fln, gewisses pi* aus inzeil;
891 la, Element aus konjugierter Partition.
892 Rueckgabewert: (INT)-109, falls nicht genuegend Speicher;
893 signum, sonst.
894 ------------------------------------------------------------------------------*/
895 /* TL 0790 */ /* AK 210891 V1.3 */
896 {
897 TL_BYTE *hilf;
898 INT i,j,k,l,v;
899
900 hilf=(TL_BYTE *)TL_calloc((int)_zeilenz,sizeof(TL_BYTE));
901 if (!hilf)
902 return no_memory();
903 for (i=(INT)0;i<_zeilenz;hilf[i]=fln[i],i++);
904 v=1L;
905 for (i=(INT)0;i<la;++i)
906 if ((hilf[i]>=(INT)0) && (hilf[i]!=i))
907 {
908 l=1L;
909 j=hilf[i];
910 while (j>=(INT)0 && hilf[j]!=i)
911 {
912 ++l;
913 k=hilf[j];
914 hilf[j]= -1L;
915 j=k;
916 }
917 if (j>=(INT)0) /* AK 030194 */
918 hilf[j]= -1L;
919 if (l%2L)
920 v *= (-1L);
921 }
922 SYM_free(hilf);
923 return(v);
924 } /* sigper */
925
926
927 /*----------------------------------------------------------------------------*/
symdet(mat,slambda,li,tsc)928 static INT symdet (mat,slambda,li,tsc) TL_BYTE *mat, *slambda; INT li, *tsc;
929 /*------------------------------------------------------------------------------
930 berechnet einen Faktor des Koeffizienten zur Schnittmatrix mat.
931 (Weitere Erlaeuterung in:
932 Golembiowski, Andreas
933 Zur Berechnung modular irreduzibler Matrixdarstellungen symmetrischer
934 Gruppen mit Hilfe eines Verfahrens von M.Clausen
935 Bayreuther Mathematische Schriften Heft 25L, Bayreuth 1987
936 SS. 170ff)
937 Variablen: mat, Schnittmatrix;
938 slambda, konjugierte Partition;
939 li, Element aus slambda.
940 Rueckgabewerte: (INT)-108, falls Resttableau falsch;
941 (INT)-109, falls nicht genug Speicher;
942 (INT)0, sonst.
943 Rueckgabe Koeffizientenfaktor tsc.
944 ------------------------------------------------------------------------------*/
945 /* TL 0790 */ /* AK 210891 V1.3 */
946 {
947 TL_BYTE *cy,*pi,*zmat,*fln,*hfl,*afl,*ii,*z;
948 INT lpi,i,j,k,l,d,la,_li,signum,bv,ik,r,err;
949 TL_BYTE *piset,*mpi,*zm;
950
951 _li=li;
952 la=slambda[_li];
953 ++_li;
954 if (la==1L)
955 {
956 if (mat[0]==(_spaltenz-_li+1L))
957 {
958 *tsc=1L;
959 return((INT)0);
960 }
961 else
962 {
963 *tsc=(INT)0;
964 return((INT)0);/*return(RTabFt);*/
965 }
966 }
967 cy=(TL_BYTE *)TL_calloc((int)_zeilenz*((int)_zyk+2*(int)_zeilenz+5),
968 sizeof(TL_BYTE));
969 if (!cy) return no_memory();
970 mpi=(TL_BYTE *)TL_calloc((int)q_zeilenz+(int)_zeilenz,sizeof(TL_BYTE));
971 if (!mpi)
972 {
973 SYM_free(cy);
974 return no_memory();
975 }
976 pi=cy+_zeilenz*_zyk;
977 zmat=pi+_zeilenz*(_zeilenz+1L);
978 fln=zmat+q_zeilenz;
979 hfl=fln+_zeilenz;
980 afl=hfl+_zeilenz;
981 ii=afl+_zeilenz;
982 piset=mpi+_zeilenz;
983 *tsc=(INT)0;
984 matcopy(zmat,mat,_zeilenz);
985 if (alzyk(la,zmat,fln,cy))
986 {
987 SYM_free(cy);
988 SYM_free(mpi);
989 return no_memory();
990 }
991 if (fln[0]>=(INT)0)
992 {
993 for (r=(INT)0;r<_zeilenz;afl[r]=fln[r],r++);
994 signum=sigper(fln,la);
995 /* kann nich sein AK 090792
996 if (signum==NtEMem)
997 {
998 SYM_free(cy);
999 SYM_free(mpi);
1000 return(NtEMem);
1001 }
1002 */
1003 bv= *tsc;
1004 if (_li == _spaltenz)
1005 *tsc=signum;
1006 else
1007 {
1008 for (j=(INT)0;j<la;++j)
1009 --zmat[IND(fln[j],j,_zeilenz)];
1010 if ((err=symdet(zmat,slambda,_li,tsc))!=(INT)0)
1011 {
1012 SYM_free(cy);
1013 SYM_free(mpi);
1014 return(err);
1015 }
1016 *tsc *= signum;
1017 }
1018 *tsc += bv;
1019 matcopy(zmat,mat,_zeilenz);
1020 if (_li == _spaltenz)
1021 {
1022 SYM_free(cy);
1023 SYM_free(mpi);
1024 return((INT)0);
1025 }
1026 for (k=(INT)0,z=pi+1L;k<la;k++,z += (_zeilenz+1L))
1027 *z=(INT)0;
1028 for (r=(INT)0;r<_zeilenz;mpi[r++]=(INT)0);
1029 lpi=(INT)0;
1030 k=(INT)0;
1031 fl111:
1032 if ((lpi+cy[IND(k,INDEX((INT)0),_zyk)])<=la)
1033 {
1034 ii[k]=1L;
1035 fl100:
1036 if (ii[k]<=cy[IND(k,INDEX(-1L),_zyk)])
1037 {
1038 ik=ii[k];
1039 i=cy[IND(k,INDEX(-ik-1L),_zyk)];
1040 d=(INT)0;
1041 l=1L;
1042 while ((d!=1L) && (l<=cy[IND(k,INDEX(i),_zyk)]))
1043 {
1044 if (mpi[cy[IND(k,INDEX(i+1L),_zyk)]-1])
1045 d=1L;
1046 ++l;
1047 }
1048 if (d==(INT)0)
1049 {
1050 for (r=(INT)0,zm= &piset[IND(k,(INT)0,_zeilenz)];r<_zeilenz;r++,zm++)
1051 *zm=(INT)0;
1052 for (j=i+1L;j<=(i+cy[IND(k,INDEX(i),_zyk)]);++j)
1053 {
1054 pi[IND(k,(INT)0,_zeilenz+1L)]=cy[IND(k,INDEX(i),_zyk)];
1055 pi[IND(k,j-i,_zeilenz+1L)]=cy[IND(k,INDEX(j),_zyk)];
1056 piset[IND(k,cy[IND(k,INDEX(j),_zyk)]-1L,_zeilenz)]=1L;
1057 }
1058 for (r=(INT)0,zm= &piset[IND(k,(INT)0,_zeilenz)];r<_zeilenz;r++,zm++)
1059 if (*zm)
1060 mpi[r]=1L;
1061 lpi += pi[IND(k,(INT)0,_zeilenz+1L)];
1062 for (r=(INT)0;r<_zeilenz;hfl[r]=fln[r],r++);
1063 l=pi[IND(k,(INT)0,_zeilenz+1L)];
1064 for (j=1L,z= &pi[IND(k,1L,_zeilenz+1L)];j<=l;j++,z++)
1065 for (i=(INT)0;i<la;++i)
1066 if (*z==fln[i]+1L)
1067 hfl[i]= (j==1L)?pi[IND(k,l,_zeilenz+1L)]-1
1068 :pi[IND(k,j-1L,_zeilenz+1L)]-1L;
1069 for (r=(INT)0;r<_zeilenz;fln[r]=hfl[r],r++);
1070 for (j=(INT)0;j<la;++j)
1071 --zmat[IND(fln[j],j,_zeilenz)];
1072 bv= *tsc;
1073 if ((err=symdet(zmat,slambda,_li,tsc))!=(INT)0)
1074 {
1075 SYM_free(cy);
1076 SYM_free(mpi);
1077 return(err);
1078 }
1079 if ((l+1L)%(INT)2)
1080 signum *= (INT)(-1);
1081 *tsc = bv + signum * (*tsc);
1082 matcopy(zmat,mat,_zeilenz);
1083 if ((lpi<=(la-(INT)2)) && (k<la-1L))
1084 {
1085 ++k;
1086 goto fl111;
1087 }
1088 else
1089 {
1090 for(r=(INT)0;r<_zeilenz;fln[r]=afl[r],r++);
1091 pi[IND(k,1L,_zeilenz+1L)]=(INT)0;
1092 for (r=(INT)0,zm= &piset[IND(k,(INT)0,_zeilenz)];r<_zeilenz;r++,zm++)
1093 if (*zm)
1094 mpi[r]=(INT)0;
1095 --lpi;
1096 if ((l+1L)%2L)
1097 signum *= (-1L);
1098 ++ii[k];
1099 goto fl100;
1100 }
1101 }
1102 else
1103 {
1104 ++ii[k];
1105 goto fl100;
1106 }
1107 }
1108 else
1109 {
1110 if (k<la-1L)
1111 {
1112 pi[IND(k,1L,_zeilenz+1L)]=(INT)0;
1113 ++k;
1114 goto fl111;
1115 }
1116 else
1117 goto fl222;
1118 }
1119 }
1120 else
1121 fl222:
1122 {
1123 while ((pi[IND(k-1L,1L,_zeilenz+1L)]==(INT)0) && k>1L)
1124 --k;
1125 if (pi[IND(k-1L,1L,_zeilenz+1L)])
1126 {
1127 --k;
1128 for (r=(INT)0;r<_zeilenz;fln[r]=afl[r],r++);
1129 pi[IND(k,1L,_zeilenz+1L)]=(INT)0;
1130 for (r=(INT)0,zm= &piset[IND(k,(INT)0,_zeilenz)];r<_zeilenz;r++,zm++)
1131 if (*zm)
1132 mpi[r]=(INT)0;
1133 lpi -= pi[IND(k,(INT)0,_zeilenz+1L)];
1134 if ((pi[IND(k,(INT)0,_zeilenz+1L)]+1L)%2L)
1135 signum *= (-1L);
1136 ++ii[k];
1137 goto fl100;
1138 }
1139 }
1140 }
1141 SYM_free(cy);
1142 SYM_free(mpi);
1143 return((INT)0);
1144 } /* symdet */
1145
1146
1147
1148 /*----------------------------------------------------------------------------*/
alcoeff(mat,slambda)1149 static INT alcoeff(mat,slambda) TL_BYTE *mat, *slambda;
1150 /*------------------------------------------------------------------------------
1151 berechnet aus der Schnittmatrix mat und Partition slambda den Koeffizienten.
1152 Variablen: mat, Schnittmatrix;
1153 slambda, konjugierte Partition zu lambda;
1154 Rueckgabewerte: koeff, Koeffizient zu mat und slambda;
1155 (INT)-108, falls ein Resttableau falsch war;
1156 (INT)-109, falls kein Speicherplatz vorhanden war.
1157 ------------------------------------------------------------------------------*/
1158 /* TL 0790 */ /* AK 210891 V1.3 */
1159 {
1160 TL_BYTE *z;
1161 INT i,tsc,faktor;
1162
1163 faktor=symdet(mat,slambda,(INT)0,&tsc);
1164 if (faktor)
1165 return(faktor);
1166 if (tsc)
1167 {
1168 for (i=q_zeilenz,z=mat,faktor=1L;i>(INT)0;i--,z++)
1169 if (*z)
1170 faktor *= fak((INT) *z);
1171 return(faktor*tsc);
1172 }
1173 else
1174 return (INT)0;
1175 } /* alcoeff */
1176
1177
1178 /*----------------------------------------------------------------------------*/
zweikonmat(lambda,perm,bz)1179 static INT zweikonmat(lambda,perm,bz) TL_BYTE *lambda,*perm,*bz;
1180 /*------------------------------------------------------------------------------
1181 berechnet die Koeffizientenmatrix bz fuer Partitionen lambda der
1182 Laenge 2.
1183 Variablen: lambda, eigentliche Partition;
1184 perm, Permutation.
1185 Rueckgabe Koeffizientenmatrix bz.
1186 Rueckgabewerte: dim, Dimension der gewoehnlichen Darstellungen, dim ist
1187 negativ, falls dim groesser MAXDM;
1188 (INT)-109, falls kein Speicherplatz vorhanden war.
1189 ------------------------------------------------------------------------------*/
1190 /* TL 0790 */ /* AK 210891 V1.3 */
1191 {
1192 INT i,j,k,l,z,zaehl[3],mdim,dim;
1193 TL_BYTE *hz,*g_i,*g_j,*start,*hilf_zwei,*hilf_drei,*_hz,*_bz,*z_eins;
1194 INT g_im,g_jm;
1195
1196 start=(TL_BYTE *)TL_calloc((int)_n*5+(int)MAXDM*3,sizeof(TL_BYTE));
1197 if (!start)
1198 return no_memory();
1199 g_i=start+_n;
1200 g_j=g_i+_n;
1201 hilf_zwei=g_j+_n;
1202 hilf_drei=hilf_zwei+_n;
1203 hz=hilf_drei+_n;
1204 mdim=MAXDM;
1205 g_im=FALSE;
1206 if (nexgitt(start,lambda,&g_im))
1207 {
1208 SYM_free(start);
1209 return no_memory();
1210 }
1211 for (z=(INT)0;z<_n;g_i[z]=start[z],z++);
1212 for (i=(INT)0,g_im=TRUE;g_im;++i)
1213 {
1214 for (z=(INT)0;z<_n;g_j[z]=start[z],z++);
1215 for (z=3L*mdim,_hz=hz;z>(INT)0;z--,*_hz++ = (INT)0);
1216 for (j=(INT)0,g_jm=TRUE,_hz=hz;g_jm;j++,_hz++)
1217 {
1218 for (z=(INT)0;z<3L;zaehl[z++]=(INT)0);
1219 for (z=(INT)0;z<_n;hilf_zwei[z]=hilf_drei[perm[z]-1]=g_j[z],z++);
1220 hilf_zwei[1]=(INT)0;
1221 for (l=(INT)0;l<_n;++l)
1222 if (g_i[l]==1L)
1223 {
1224 if (g_j[l]==1L) ++zaehl[0];
1225 if (hilf_zwei[l]==1L) ++zaehl[1];
1226 if (hilf_drei[l]==1L) ++zaehl[2];
1227 }
1228 for (z=(INT)0,z_eins=_hz;z<3L;z++,z_eins += mdim)
1229 *z_eins=COEFF(_n,(INT)zaehl[z],(INT)lambda[1]);
1230 if (nexgitt(g_j,lambda,&g_jm))
1231 {
1232 SYM_free(start);
1233 return no_memory();
1234 }
1235 }
1236 if (!i)
1237 {
1238 dim=j;
1239 if (dim>MAXDM)
1240 {
1241 dim *= (-1L);
1242 break;
1243 }
1244 else
1245 _bz=bz;
1246 }
1247 for (z=(INT)0,_hz=hz;z<3L;z++,_hz += mdim)
1248 for (k=(INT)0,z_eins=_hz;k< dim;k++)
1249 *_bz++ = *z_eins++;
1250 if (dim<mdim)
1251 mdim=dim;
1252 if(nexgitt(g_i,lambda,&g_im))
1253 {
1254 SYM_free(start);
1255 return no_memory();
1256 }
1257 }
1258 SYM_free(start);
1259 g_im = 280194L;
1260 nexgitt(NULL,NULL,&g_im); /* AK 280194 */
1261 return(dim);
1262 } /* zweikonmat */
1263
1264
1265 /*----------------------------------------------------------------------------*/
konjugiere(lambda,lambdastrich)1266 static INT konjugiere(lambda,lambdastrich) TL_BYTE *lambda, *lambdastrich;
1267 /*------------------------------------------------------------------------------
1268 konjugiert die eigentliche Partition lambda mit Ergebnis lambdastrich.
1269 Variablen: lambda, eigentliche Partition.
1270 Rueckgabe lambdastrich.
1271 ------------------------------------------------------------------------------*/
1272 /* TL 0790 */ /* AK 210891 V1.3 */
1273 {
1274 INT i,j;
1275
1276 for (i=(INT)0;i<lambda[0];++i)
1277 {
1278 for (j=(INT)0;j<_zeilenz && lambda[j]>=i+1L;++j);
1279 if ((j<_n) && (lambda[j] < i+1L))
1280 lambdastrich[i]=j;
1281 else
1282 lambdastrich[i]=_zeilenz;
1283 }
1284 return OK;
1285 } /* konjugiere */
1286
1287
1288 /*----------------------------------------------------------------------------*/
schnitt(t_eins,t_zwei,mat)1289 static INT schnitt(t_eins,t_zwei,mat) TL_BYTE *t_eins, *t_zwei, *mat;
1290 /*------------------------------------------------------------------------------
1291 berechnet Schnittmatrix zu den Tableaux t_eins und t_zwei.
1292 Variablen: t_eins, Tableau;
1293 t_zwei, Tableau.
1294 Rueckgabe Schnittmatrix mat.
1295 ------------------------------------------------------------------------------*/
1296 /* TL 0790 */ /* AK 210891 V1.3 */
1297 {
1298 TL_BYTE *z;
1299 INT i;
1300
1301
1302 memset(mat,0,q_zeilenz * sizeof(TL_BYTE));
1303
1304 for (i=(INT)0;i<_n;++i)
1305 ++mat[IND(t_eins[i],t_zwei[i],_zeilenz)];
1306 return OK;
1307 } /*schnitt*/
1308
1309 struct ak {
1310 INT c;
1311 INT p;
1312 char *ptr;
1313 };
1314
ak_tmpfile()1315 static struct ak * ak_tmpfile()
1316 {
1317 #ifdef UNDEF
1318 struct ak *a;
1319 a = (struct ak *) TL_calloc((int)1,sizeof(struct ak));
1320 if (a==NULL) return (struct ak *) no_memory();
1321 a->c = (INT)0; /* erste unzulaessige stelle */
1322 a->p = (INT)0;
1323 a->ptr = NULL;
1324 #endif
1325 init_mat();
1326 }
1327
ak_rewind(a)1328 static INT ak_rewind(a) struct ak *a;
1329 {
1330 a->p = (INT)0;
1331 return OK;
1332 }
1333
ak_fread(buf,size,numb,a)1334 static INT ak_fread(buf,size,numb,a) char **buf;
1335 INT size;
1336 INT numb;
1337 struct ak *a;
1338 {
1339 size = size * numb;
1340
1341 if (a->p + size > a->c)
1342 size = a->c - a->p;
1343
1344 *buf = a->ptr + a->p;
1345 a->p = a->p + size;
1346 return a->p;
1347 }
1348
1349 #define AXSIZE 10000
1350
ak_fwrite(buf,size,numb,a)1351 static INT ak_fwrite(buf,size,numb,a) char *buf;
1352 INT size;
1353 INT numb;
1354 struct ak *a;
1355 {
1356 size = size *numb;
1357
1358 if (a->ptr == NULL) {
1359 a->ptr = (char *)TL_calloc(AXSIZE,1);
1360 a->c = AXSIZE;
1361 }
1362 again:
1363 if (a->ptr == NULL)
1364 return no_memory();
1365 if (a->p + size > a->c) {
1366 a->ptr = (char *) SYM_realloc(a->ptr,a->c + AXSIZE);
1367 if (a->ptr == NULL)
1368 return no_memory();
1369 a->c = a->c + AXSIZE;
1370 goto again;
1371 }
1372 memcpy(a->ptr + a->p, buf,(int) size);
1373 a->p = a->p + size;
1374 return a->p;
1375 }
1376
ak_fclose(a)1377 static void ak_fclose(a) struct ak *a;
1378 {
1379 close_mat();
1380 }
1381 /*
1382 #define ak_fclose(a) fclose(a)
1383 #define ak_tmpfile() tmpfile()
1384 #define ak_rewind(a) rewind(a)
1385 #define ak_fwrite(buf,size,numb,a) fwrite(buf,size,numb,a)
1386 #define ak_fread(buf,size,numb,a) fread(buf,size,numb,a)
1387 */
1388
1389 static INT tl_prime = (INT) 9973;
1390 static INT tl_max_numb = (INT) 8;
1391 static INT tl_index_inc = (INT) 1;
1392 static TL_BYTE **mat_table;
1393 static TL_2BYTE **koeff_table;
1394 static INT *mat_length;
1395 static INT mat_size;
tl_set_prime(p)1396 INT tl_set_prime(p) INT p;
1397 {
1398 tl_prime = p;
1399 }
tl_set_max_numb(p)1400 INT tl_set_max_numb(p) INT p;
1401 {
1402 tl_max_numb = p;
1403 }
tl_set_index_inc(p)1404 INT tl_set_index_inc(p) INT p;
1405 {
1406 tl_index_inc = p;
1407 }
1408 #ifdef UNDEF
1409 #define PRIME 9973 /* 40993 */
1410 #define INDEX_INC 1
1411 #define MAX_NUMB 8
1412 TL_BYTE *mat_table[PRIME];
1413 TL_2BYTE *koeff_table[PRIME];
1414 INT mat_length[PRIME];
1415 #endif
1416
init_mat()1417 static void init_mat()
1418 {
1419 INT i,size;
1420 TL_BYTE *a,*b;
1421 mat_table = (TL_BYTE **) TL_calloc(tl_prime,sizeof(TL_BYTE *));
1422 mat_length = (INT *) TL_calloc(tl_prime,sizeof(INT));
1423 koeff_table = (TL_2BYTE **) TL_calloc(tl_prime,sizeof(TL_2BYTE *));
1424 mat_size = q_zeilenz;
1425
1426 size = tl_prime * tl_max_numb * (q_zeilenz + sizeof(TL_2BYTE));
1427 a = (TL_BYTE *) TL_malloc(size * sizeof(TL_BYTE));
1428 b = a;
1429
1430 for (i=(INT)0;i<tl_prime;i++)
1431 {
1432 mat_length[i] = (INT)0;
1433 /*koeff_table[i] = mat_table[i]=NULL; */
1434
1435 mat_table[i] = a;
1436 a += (tl_max_numb * q_zeilenz );
1437 koeff_table[i] = (TL_2BYTE *) a;
1438 a += tl_max_numb * sizeof(TL_2BYTE) ;
1439 }
1440
1441
1442 }
1443
close_mat()1444 static void close_mat()
1445 {
1446 INT i;
1447 if (mat_size != q_zeilenz) error("MO-35");
1448 TL_free(mat_table[0]);
1449 TL_free(mat_table);
1450 TL_free(koeff_table);
1451 for (i=(INT)0;i<tl_prime;i++)
1452 {
1453 mat_length[i] = (INT)0;
1454 }
1455 TL_free(mat_length);
1456 }
1457
1458 static UINT offset[32] = {
1459 1,1<<1,1<<2,1<<3,1<<4,1<<5,1<<6,1<<7,
1460 1<<8,1<<9,1<<10,1<<11,1<<12,1<<13,1<<14,1<<15,
1461 1<<16,1<<17,1<<18,1<<19,1<<20,1<<21,1<<22,1<<23,
1462 1<<24,1<<25,1<<26,1<<27,1<<28,1<<29,1<<30,((UINT)1)<<31 };
1463
write_mat(mat,koeff)1464 static INT write_mat(mat,koeff) TL_BYTE *mat;
1465 TL_2BYTE koeff;
1466 {
1467 INT i,j,k;
1468 UINT index=(INT)0;
1469 /* compute adress */
1470
1471 i=(INT)0;
1472 if (q_zeilenz > 31)
1473 {
1474 k = q_zeilenz / 32;
1475 for (;k>0;k--)
1476 for (j=(INT)0; j<32;i+=tl_index_inc,j+=tl_index_inc)
1477 if (mat[i]) index += offset[j];
1478 }
1479
1480 for (j=(INT)0; i<q_zeilenz;i+=tl_index_inc,j+=tl_index_inc)
1481 if (mat[i]) index += offset[j];
1482
1483 index = index % tl_prime;
1484
1485 if (mat_length[index] >= tl_max_numb)
1486 {
1487 mat_length[index]++;
1488 * (koeff_table[index]+
1489 (mat_length[index] % tl_max_numb)
1490 ) = koeff;
1491 memcpy(mat_table[index]+
1492 (q_zeilenz*
1493 (mat_length[index]%tl_max_numb)
1494 ),
1495 mat, q_zeilenz * sizeof(TL_BYTE));
1496 }
1497 else {
1498 mat_length[index]++;
1499 * (koeff_table[index]+mat_length[index]-1) = koeff;
1500 memcpy(mat_table[index]+
1501 (q_zeilenz*(mat_length[index]-1)),
1502 mat, q_zeilenz * sizeof(TL_BYTE));
1503 }
1504
1505
1506 }
1507
1508
search_mat(co,mat,koeff)1509 static INT search_mat(co,mat, koeff) TL_BYTE *mat;
1510 TL_2BYTE *koeff;
1511 INT *co;
1512 {
1513 INT i=(INT)0,k,j;
1514 UINT index=(INT)0;
1515 /* compute adress */
1516
1517 if (q_zeilenz > 31)
1518 {
1519 k = q_zeilenz / 32;
1520 for (;k>0;k--)
1521 for (j=(INT)0; j<32;i+=tl_index_inc,j+=tl_index_inc)
1522 if (mat[i]) index += offset[j];
1523 }
1524
1525 for (j=0; i<q_zeilenz;i+=tl_index_inc,j+=tl_index_inc)
1526 if (mat[i]) index += offset[j];
1527
1528 index = index % tl_prime;
1529 for (i=mat_length[index]%tl_max_numb -1 ; i>=0 ; i--)
1530 if (SYM_memcmp(mat,(mat_table[index])+(q_zeilenz * i),
1531 sizeof(TL_BYTE) * q_zeilenz) == 0)
1532 {
1533 *koeff = * (koeff_table[index] + i);
1534 return OK;
1535 }
1536
1537
1538 return -12L;
1539 }
1540
1541 /*----------------------------------------------------------------------------*/
mat_comp(co,mat,slambda)1542 static INT mat_comp(co,mat,slambda) INT *co;
1543 TL_BYTE *mat,*slambda;
1544 /*------------------------------------------------------------------------------
1545 ueberprueft die Schnittmatrix mat, ob mit dieser schon gerechnet wurde. Ist
1546 dies der Fall, so ist der Koeffizient gleich. Ansonsten wird fuer mat der
1547 neue Koeffizient berechnet.
1548 Variablen: co, Zaehler der verschiedenen Schnittmatrizen;
1549 mat, Schnittmatrix;
1550 slambda, konjugierte Partition zu lambda;
1551 Rueckgabe co mit alter bzw. neuer Anzahl der verschiedenen Schnittmatrizen.
1552 Rueckgabewerte: koeff, Koeffizient zu mat und slambda;
1553 (INT)-109, falls nicht genuegend Speicher vorhanden ist.
1554 ------------------------------------------------------------------------------*/
1555 /* TL 0790 */ /* AK 210891 V1.3 */
1556 {
1557 INT gefunden, i,erg;
1558 TL_BYTE *schnittmat ,*z_eins,*z_zwei ,rr ;
1559 TL_2BYTE koeff;
1560 TL_BYTE *ak_buffer; /* AK 060392 */
1561 i=1L;
1562 if ((*co)>(INT)0)
1563 {
1564 erg = search_mat(co,mat,&koeff);
1565 if (erg == OK) return koeff;
1566 }
1567 ++(*co);
1568 koeff = alcoeff(mat,slambda);
1569 if (koeff==RTabFt || koeff==NtEMem)
1570 return(koeff);
1571 write_mat(mat,koeff);
1572 return koeff;
1573 } /* mat_comp */
1574
1575
1576 /*----------------------------------------------------------------------------*/
alkonmat(lambda,perm,bz)1577 static INT alkonmat(lambda,perm,bz) TL_BYTE *lambda, *perm, *bz;
1578 /*------------------------------------------------------------------------------
1579 berechnet zu einer Partition lambda und einer Permutation perm die Koeffi-
1580 zientenmatrix (B|C(12)|C(perm)).
1581 Variablen: lambda, eigentliche Partition;
1582 perm, Permutation.
1583 Rueckgabewerte: >(INT)0, kein Fehler aufgetreten;
1584 (INT)-10, falls Pointer auf lambda NULL ist;
1585 (INT)-11, falls lambda leer ist;
1586 (INT)-12, falls ein Element von lambda kleiner 0 ist;
1587 (INT)-13, falls lambda keine eigentliche Partition ist;
1588 // -15L, falls n > MAXN;
1589 // -16L, falls Laenge von lambda groesser MAXZEILENZ ist;
1590 // -17L, falls erstes Element von lambda groesser MAXSPALTENZ ist;
1591 (INT)-18, falls Dimension der gew. irred. Dg. >MAXDIM;
1592 (INT)-19, falls Pointer auf bz NULL ist;
1593 (INT)-20, falls sich der temporaere File nicht oeffnen laesst;
1594 (INT)-30, falls Pointer auf perm NULL ist;
1595 (INT)-31, falls Teil von perm <= 0 ist;
1596 (INT)-32, falls Teil von perm > n ist;
1597 (INT)-33, falls perm zu viele Elemente hat;
1598 (INT)-108, falls Resttableau in SYMDET falsch ist;
1599 (INT)-109, falls nicht genuegend Speicher vorhanden ist.
1600 Rueckgabe Koeffizientenmatrix bz.
1601 ------------------------------------------------------------------------------*/
1602 /* TL 0790 */ /* AK 210891 V1.3 */
1603 {
1604 TL_BYTE *mat,*transmt,*zykmt,*hz,*t_eins,*t_zwei;
1605 TL_BYTE *ht,*asslambda,*_hz,*_bz,*z_eins;
1606 INT ii,jj,kk,i,k,z,co = (INT)0,co_eins,co_zwei,dim,diag,mdim,dim_,koeff;
1607 INT mehr_eins,mehr_zwei;
1608
1609 /* Moegliche Eingabefehler... */
1610 if (!lambda)
1611 return(LmbNul);
1612 else if (!lambda[0])
1613 return(LmbEmp);
1614 else if (!bz)
1615 return(BzNul);
1616 for (i=(INT)0,_n=(INT)0;lambda[i];++i)
1617 if (lambda[i]<(TL_BYTE)0)
1618 return(LmbLt_null);
1619 else
1620 _n += lambda[i];
1621 /*
1622 if (_n>MAXN)
1623 return(NGtMax);
1624
1625 else */ if (perm==NULL)
1626 return(PerNul);
1627 /*
1628 for (i=(INT)0;i<MAXN && perm[i];i++);
1629 if (i>_n)
1630 return(PeLgGN);
1631 */
1632 for (i=(INT)0;i<_n;i++)
1633 if (perm[i]<=(INT)0)
1634 return(PerLe_null);
1635 else if (perm[i]>_n)
1636 return(PerGtN);
1637 for (i=1L;lambda[i];++i)
1638 if (lambda[i]>lambda[i-1])
1639 return(LmbNRg);
1640
1641
1642 /*
1643 Na denn ma' los...
1644 */
1645 _zyk=ZYK/2+ZYK+1L;
1646 _spaltenz=lambda[0]; /*AK 240194 */
1647 _zeilenz = i ; /* AK 240194 */
1648 /*
1649 if ((_spaltenz=lambda[0])>MAXSPALTENZ)
1650 return(SzGtMx);
1651 if ((_zeilenz=i)>MAXZEILENZ)
1652 return(ZzGtMx);
1653 */
1654 q_zeilenz=_zeilenz*_zeilenz;
1655 if (_zeilenz==2L)
1656 {
1657 dim_=zweikonmat(lambda,perm,bz);
1658 if (dim_<(INT)0)
1659 dim=DmGtMx;
1660 else
1661 dim=dim_;
1662 }
1663 else
1664 { /* allgemeine Partition/Anfang */
1665 init_mat();
1666 mat=(TL_BYTE *)TL_calloc((int)(q_zeilenz+MAXDM)*3+(int)(4*_n),sizeof(TL_BYTE));
1667 if (mat == NULL)
1668 {
1669 close_mat();
1670 return no_memory();
1671 }
1672 transmt=mat+q_zeilenz;
1673 zykmt=transmt+q_zeilenz;
1674 t_eins=zykmt+q_zeilenz;
1675 t_zwei=t_eins+_n;
1676 ht=t_zwei+_n;
1677 asslambda=ht+_n;
1678 hz=asslambda+_n;
1679 mdim=MAXDM;
1680 konjugiere(lambda,asslambda);
1681 for (ii=(INT)0,diag=1L;ii<_zeilenz;++ii)
1682 diag *= fak(lambda[ii]);
1683 for (ii=(INT)0,kk=(INT)0;ii<_n && lambda[ii];++ii)
1684 {
1685 for (jj=kk;jj < (kk+lambda[ii]);ht[jj++]= ii);
1686 kk += lambda[ii];
1687 }
1688 for (z=(INT)0;z<_n;t_zwei[z]=ht[z],z++);
1689 co_eins=co_zwei=(INT)0;
1690 for (i=(INT)0,mehr_zwei=TRUE;mehr_zwei;++i)
1691 {
1692 for (z=(INT)0;z<_n;t_eins[z]=ht[z],z++);
1693 for (z=3L*mdim,_hz=hz;z>(INT)0;z--,*_hz++ =(INT)0);
1694 for (k=(INT)0,mehr_eins=TRUE;mehr_eins;++k)
1695 {
1696 if (i==k)
1697 /*Hauptdiag. von B(lambda) und C(lambda/(12))*/
1698 {
1699 hz[i]=diag;
1700 if (t_zwei[1]== 1)
1701 hz[i+mdim]=((TL_BYTE) -1)*(hz[i]/lambda[0]);
1702 else
1703 hz[i+mdim]=hz[i];
1704 }
1705 else if (i<k)
1706 {
1707 schnitt(t_eins,t_zwei,mat);
1708 /*Rest von B(lambda)*/
1709 koeff=mat_comp(&co,mat,asslambda);
1710 if (koeff!=NtEMem && koeff!=RTabFt)
1711 hz[k]=koeff;
1712 else
1713 {
1714 close_mat();
1715 SYM_free(mat);
1716 return(koeff);
1717 }
1718 if ((t_zwei[1]==1L) && (t_eins[1]==1L))
1719 /*Rest von C(lambda/(12))*/
1720 {
1721 matcopy(transmt,mat,_zeilenz);
1722 --transmt[0];
1723 --transmt[_zeilenz+1];
1724 ++transmt[1];
1725 ++transmt[_zeilenz];
1726 ii=co;
1727 koeff=mat_comp(&co,transmt,asslambda);
1728 if (koeff!=NtEMem && koeff!=RTabFt)
1729 hz[k+mdim]=koeff;
1730 else
1731 {
1732 close_mat();
1733 SYM_free(mat);
1734 return(koeff);
1735 }
1736 if (co>ii) co_eins++;
1737 }
1738 else
1739 hz[k+mdim]= hz[k];
1740 }
1741 if (zykschnitt(t_zwei,t_eins,perm,zykmt))
1742 {
1743 close_mat();
1744 SYM_free(mat);
1745 return no_memory();
1746 }
1747 /*Berechnung von C(lambda/(1..n)).*/
1748 if (!i && !k)
1749 {
1750 co=(INT)0;
1751 koeff=mat_comp(&co,zykmt,asslambda);
1752 if (koeff!=NtEMem && koeff!=RTabFt)
1753 hz[2L*mdim]=koeff;
1754 else
1755 {
1756 close_mat();
1757 SYM_free(mat);
1758 mehr_zwei = 280194L;
1759 nexgitt(NULL,NULL,&mehr_zwei); /* AK 280194 */
1760 return(koeff);
1761 }
1762 }
1763 ii=co;
1764 koeff=mat_comp(&co,zykmt,asslambda);
1765 if (koeff!=NtEMem && koeff!=RTabFt)
1766 hz[k+2L*mdim]=koeff;
1767 else
1768 {
1769 close_mat();
1770 SYM_free(mat);
1771 mehr_zwei = 280194L;
1772 nexgitt(NULL,NULL,&mehr_zwei); /* AK 280194 */
1773 return(koeff);
1774 }
1775 if (co>ii) ++co_zwei;
1776 if (nexgitt(t_eins,lambda,&mehr_eins))
1777 {
1778 close_mat();
1779 SYM_free(mat);
1780 return no_memory();
1781 }
1782 }
1783 if ((_zeilenz==1L) || (_spaltenz==1L))
1784 co=1L;
1785 if (!i)
1786 {
1787 dim=dim_=k;
1788 if (dim>MAXDM)
1789 {
1790 dim_ *= (-1L);
1791 dim=DmGtMx;
1792 break;
1793 }
1794 else
1795 _bz=bz;
1796 }
1797 for (z=(INT)0,_hz=hz;z<3L;z++,_hz += mdim)
1798 for (k=(INT)0,z_eins=_hz;k<dim;k++)
1799 *_bz++ = *z_eins++;
1800 if (dim<mdim)
1801 mdim=dim;
1802 if (nexgitt(t_zwei,lambda,&mehr_zwei))
1803 {
1804 close_mat();
1805 SYM_free(mat);
1806 return no_memory();
1807 }
1808 }
1809 close_mat();
1810 SYM_free(mat);
1811
1812
1813 } /*allgemeine Partition/Ende*/
1814
1815
1816 mehr_zwei = 280194L;
1817 nexgitt(NULL,NULL,&mehr_zwei); /* AK 280194 */
1818 return(dim);
1819 } /*alkonmat*/
1820 /*******************************************************************************
1821 *
1822 * Datei MODULDIM.C
1823 * Version vom 17.11.89
1824 *
1825 *
1826 * Zeile Funktion
1827 *
1828 * Funktionen zur Berechnung der Dimensionen mod. irred. Darstellungen
1829 * -------------------------------------------------------------------
1830 * 77 INT _k_zweikonmat(INT *lambda,TL_BYTE *bz,INT pz)
1831 * 139 INT k_alkonmat(TL_BYTE *lambda,TL_BYTE *bz,INT pz)
1832 * 269 INT _k_moddreimat(TL_BYTE *bz,INT pz)
1833 * 311 INT _k_modgauss(TL_BYTE *bz,INT pz)
1834 * 359 INT k_dimmod(TL_BYTE *bz,INT dim,INT pz)
1835 *
1836 *******************************************************************************/
1837
1838 static INT dm;
1839 static INT dm_zwei;
1840 static INT qdm;
1841
1842
1843 /*
1844 Defines...
1845 */
1846 /*----------------------------------------------------------------------------*/
k_alkonmat(lambda,bz,pz)1847 static INT k_alkonmat(lambda,bz,pz) TL_BYTE * lambda;
1848 TL_BYTE *bz;
1849 INT pz;
1850 /*------------------------------------------------------------------------------
1851 berechnet die Koeffizientenmatrix B fuer alle Partitionen lambda. Dabei
1852 werden die Eintraege der Matrix modulo pz abgelegt.
1853 (Vgl. in MODULKFF.C Funktion alkonmat().)
1854 Variablen: lambda, Partition;
1855 pz, Primzahl.
1856 Rueckgabe Koeffizientenmatrix bz.
1857 Rueckgabewerte: >(INT)0, Dimension der gew. irred. Darstellung;
1858 sonst, s. MODULKFF.C Funktion alkonmat().
1859 ------------------------------------------------------------------------------*/
1860 /* TL 0790 */ /* AK 210891 V1.3 */
1861 {
1862 TL_BYTE *mat,*t_eins,*t_zwei,*ht,*slambda,*hz;
1863 INT ii,jj,kk,i,k,z,co = (INT)0,dim,diag,mdim,dim_,koeff;
1864 INT mehr_eins,mehr_zwei;
1865 TL_BYTE *_bz;
1866
1867 /*
1868 Moegliche Eingabefehler...
1869 */
1870 if (!lambda) return(LmbNul);
1871 else if (!lambda[0]) return(LmbEmp);
1872 else if (!bz) return(BzNul);
1873 for (i=(INT)0,_n=(INT)0;lambda[i];++i)
1874 if (lambda[i]<0) return(LmbLt_null);
1875 else _n += (INT)lambda[i];
1876 /*
1877 if (_n>MAXN) return(NGtMax);
1878
1879 else */
1880 if (pz<=(INT)0) return(PrmLe_null);
1881 else if (pz)
1882 {
1883 for (i=(INT)0;PZ[i]<=pz;i++);
1884 if (pz!=PZ[i-1]) return(NoPrm);
1885 }
1886 for (i=1L;lambda[i];++i)
1887 if (lambda[i]>lambda[i-1]) return(LmbNRg);
1888
1889
1890 /*
1891 Na denn ma' los...
1892 */
1893 /* printeingabe("C1");*/
1894 _zyk=ZYK/2L+ZYK+1L;
1895 _zeilenz = i; /* AK 240194 */
1896 _spaltenz = lambda[0]; /* AK 240194 */
1897 /*
1898 if ((_spaltenz=lambda[0])>MAXSPALTENZ) return(SzGtMx);
1899 if ((_zeilenz=i)>MAXZEILENZ) return(ZzGtMx);
1900 */
1901 q_zeilenz=_zeilenz*_zeilenz;
1902 if (_zeilenz==2L)
1903 {
1904 dim_=_k_zweikonmat(lambda,bz,pz);
1905 /* kann nich sein AK 090792
1906 if (dim_==NtEMem)
1907 return(NtEMem);
1908 */
1909 if (dim_<(INT)0)
1910 dim=DmGtMx;
1911 else
1912 dim=dim_;
1913 }
1914 else
1915 { /* allgemeine Partition/Anfang */
1916 /* printeingabe("C2");*/
1917 init_mat();
1918 mat=(TL_BYTE *)TL_calloc((int)(q_zeilenz)+(int)(4*_n)+1,sizeof(TL_BYTE));
1919 if (mat == NULL)
1920 {
1921 close_mat();
1922 return no_memory();
1923 }
1924 t_eins=mat+(INT)q_zeilenz;
1925 t_zwei=t_eins+(INT)_n;
1926 ht=t_zwei+(INT)_n;
1927 /* printeingabe("C3");*/
1928 slambda=ht+_n;
1929 mdim=MAXDM;
1930 _assoziiere(lambda,slambda,_n);
1931 for (ii=(INT)0,diag=1L;ii<_zeilenz;++ii)
1932 diag *= fak((INT)lambda[ii]);
1933 for (ii=(INT)0,kk=(INT)0;ii<_n && lambda[ii];++ii)
1934 {
1935 for (jj=kk;jj < (kk+lambda[ii]);jj++)
1936 ht[jj]=(TL_BYTE)ii;
1937 kk += lambda[ii];
1938 }
1939 for (z=(INT)0;z<_n;t_zwei[z]=ht[z],z++);
1940 _bz=bz;
1941 for (i=(INT)0,mehr_zwei=TRUE;mehr_zwei;++i)
1942 {
1943 for (z=(INT)0;z<_n;t_eins[z]=ht[z],z++);
1944 for (k=0,hz=bz+i,mehr_eins=TRUE;mehr_eins;++k)
1945 {
1946 /* printeingabe("C4");*/
1947 if (i==k)
1948 *_bz++ = (TL_BYTE) TL_MOD(diag,pz);
1949 else if (k<i)
1950 /* *_bz++ = bz[k*MAXDM+i]; */
1951 _bz++;
1952 else if (i<k)
1953 {
1954 schnitt(t_eins,t_zwei,mat);
1955 /* printeingabe("C5");*/
1956 koeff=mat_comp(&co,mat,slambda);
1957 if (koeff!=NtEMem && koeff!=RTabFt)
1958 {
1959 *_bz++ = TL_MOD(koeff,pz);
1960 }
1961 else
1962 {
1963 close_mat();
1964 SYM_free(mat);
1965 mehr_zwei = 280194L;
1966 nexgitt(NULL,NULL,&mehr_zwei); /* AK 280194 */
1967 return(koeff);
1968 }
1969 }
1970 /* printeingabe("C6");*/
1971 if (nexgitt(t_eins,lambda,&mehr_eins))
1972 {
1973 close_mat();
1974 SYM_free(mat);
1975 return no_memory();
1976 }
1977 }
1978 if ((_zeilenz==1L) || (_spaltenz==1L))
1979 co=1L;
1980 if (!i)
1981 {
1982 /* printeingabe("C7");*/
1983 dim=dim_=k;
1984 if (dim>MAXDM)
1985 {
1986 dim_ *= (-1L);
1987 dim=DmGtMx;
1988 error("mo.c:internal error 400");
1989 break;
1990 }
1991 }
1992 if (dim<mdim)
1993 mdim=dim;
1994 /* printeingabe("C7");*/
1995 if (nexgitt(t_zwei,lambda,&mehr_zwei))
1996 {
1997 close_mat();
1998 SYM_free(mat);
1999 return no_memory();
2000 }
2001 }
2002
2003 close_mat();
2004 SYM_free(mat);
2005
2006
2007 #define AKSIZE 100
2008 hz = (TL_BYTE *) TL_malloc(sizeof(TL_BYTE) * MAXDM * AKSIZE);
2009 for (kk=MAXDM -1; kk>0; kk-= AKSIZE)
2010 {
2011 for (jj=0;jj<kk;jj++)
2012 for (ii=0;(ii<AKSIZE) && (kk-ii > 0) ;ii++)
2013 {
2014 hz[MAXDM*ii+jj] = bz[jj*MAXDM+(kk-ii)];
2015 }
2016 for (ii=0;(ii<AKSIZE) && (kk-ii > 0) ;ii++)
2017 memcpy(&bz[(kk-ii)*MAXDM], &hz[ii * MAXDM], kk-ii);
2018 }
2019
2020
2021 /*
2022 for (i=0;i<MAXDM;i++)
2023 {
2024 for (k=0;k<i;k++)
2025 if(bz[i*MAXDM+k] != bz[k*MAXDM+i])
2026 printf("%d %d\n",i,k);
2027 }
2028
2029 */
2030 SYM_free(hz);
2031
2032 } /*allgemeine Partition/Ende*/
2033 /* printeingabe("C8");*/
2034 mehr_zwei = 280194L;
2035 nexgitt(NULL,NULL,&mehr_zwei); /* AK 280194 */
2036 return(dim);
2037 } /*alkonmat*/
2038
2039
2040 /*----------------------------------------------------------------------------*/
_k_moddreimat(_bz,pz)2041 static INT _k_moddreimat(_bz,pz) TL_BYTE *_bz;
2042 INT pz;
2043 /*------------------------------------------------------------------------------
2044 bringt die Matrix bz mit Hilfe des Gaussalgorithmus ueber GF(pz) auf obere
2045 Dreiecksform mit 1 oder 0 auf der Hauptdiagonalen.
2046 (Vgl. in MODULDG.C Funktion moddreimat().)
2047 Variablen: bz, Koeffizientenmatrix aus k_alkonmat();
2048 pz, Primzahl;
2049 Rueckgabe bz.
2050 ------------------------------------------------------------------------------*/
2051 /* TL 0790 */ /* AK 210891 V1.3 */
2052 {
2053 TL_BYTE *jz, *z_eins,*z_zwei;
2054 TL_BYTE qu,mu;
2055 INT i,j,k;
2056
2057 for (i=0;i<dm;i++,_bz += (dm+1))
2058 {
2059 for (k=i+1,jz=_bz+dm;!*_bz && k<dm;k++,jz += dm)
2060 if (*jz)
2061 for (j=dm,z_eins=jz,z_zwei=_bz;j>i;j--)
2062 {
2063 mu= *z_zwei;
2064 *z_zwei++ = *z_eins;
2065 *z_eins++ = mu;
2066 }
2067 if (*_bz)
2068 {
2069 if ((qu= *_bz)!=(TL_BYTE)1)
2070 for (j=dm,z_eins=_bz;j>i;j--,z_eins++)
2071 {
2072 if (*z_eins) /* AK 010394 */
2073 *z_eins=(TL_BYTE)TL_DIVP(*z_eins,qu,pz);
2074 }
2075 if (i<dm-(INT)1)
2076 for (k=i+1L,jz=_bz+dm;k<dm;k++,jz += dm)
2077 if ((qu= *jz)!=(TL_BYTE)0)
2078 for (j=dm,z_eins=jz,z_zwei=_bz;j>i;j--,z_eins++,z_zwei++)
2079 if (*z_zwei)
2080 {
2081 *z_eins = TL_MOD( *z_eins - qu * *z_zwei, pz);
2082 }
2083 }
2084 }
2085 return OK;
2086 } /* _k_moddreimat */
2087
2088
2089 /*----------------------------------------------------------------------------*/
_k_modgauss(bz,pz)2090 static INT _k_modgauss(bz,pz) TL_BYTE *bz;
2091 INT pz;
2092 /*------------------------------------------------------------------------------
2093 berechnet mit Hilfe des Gaussalgorithmus ueber GF(pz) die Dimension der
2094 modular irreduziblen Darstellung.
2095 (Vgl. in MODULDG.C Funktion modgauss().)
2096 Variablen: bz, Matrix mit Basis;
2097 pz, Primzahl.
2098 Rueckgabe bz.
2099 Rueckgabewert: Dimension der mod. irred. Darstellung.
2100 ------------------------------------------------------------------------------*/
2101 /* TL 0790 */ /* AK 210891 V1.3 */
2102 {
2103 TL_BYTE *_bz,*z_eins,*z_zwei,*z_drei,*z_vier,qu;
2104 INT i,j,k,prang;
2105
2106 TL_BYTE mu;
2107
2108 prang=(INT)0;
2109 for (i=dm-1,_bz= &bz[qdm-1];i>0;i--,_bz -= (dm+1L))
2110 if (*_bz)
2111 {
2112 if ((qu= *_bz)!=(TL_BYTE)1)
2113 for (k=i,z_eins=_bz;k<dm;k++,z_eins++)
2114 if (*z_eins)
2115 *z_eins=(TL_BYTE)TL_DIVP(*z_eins,qu,pz);
2116
2117 for (j=i-1L,z_eins= &bz[i*dm+i],z_zwei=z_eins-dm;j>=0;j--,z_zwei -= dm)
2118 if ((qu= *z_zwei)!=(TL_BYTE)0)
2119 for (k=dm,z_drei=z_eins,z_vier=z_zwei;k>i;k--,z_drei++,z_vier++)
2120 if (*z_drei)
2121 {
2122 *z_vier = TL_MOD(*z_vier - qu * *z_drei, pz);
2123 }
2124 }
2125 else
2126 prang++;
2127
2128 if (bz[0]!=(TL_BYTE)1)
2129 {
2130 if ((qu=bz[0])==(TL_BYTE)0)
2131 prang++;
2132 else
2133 for (j=0,_bz=bz;j<dm;j++,_bz++)
2134 if (*_bz)
2135 *_bz= (TL_BYTE)TL_DIVP(*_bz,qu,pz);
2136 }
2137 return(dm-prang);
2138 } /* _k_modgauss */
2139
co_070295(m,p)2140 INT co_070295(m,p) OP m,p;
2141 /* AK eingabe primzahl p und schnittmatrix m */
2142 {
2143 TL_BYTE *bz,*z;
2144 INT i,j;
2145 bz = (TL_BYTE *) TL_calloc(S_M_HI(m) * S_M_LI(m), sizeof(TL_BYTE));
2146
2147 for (i=0,z=bz;i<S_M_HI(m);i++)
2148 for(j=0;j<S_M_LI(m);j++,z++)
2149 *z = TL_MOD((TL_BYTE)S_M_IJI(m,i,j), S_I_I(p));
2150 i= k_dimmod(bz,S_M_HI(m),S_I_I(p));
2151 TL_free(bz);
2152 return i;
2153 }
2154
co_k_dimmod(bz,dim,pz)2155 INT co_k_dimmod(bz,dim,pz) signed char *bz; INT dim,pz;
2156 {
2157 return k_dimmod(bz,dim,pz);
2158 }
2159
2160 /*----------------------------------------------------------------------------*/
k_dimmod(bz,dim,pz)2161 static INT k_dimmod(bz,dim,pz) TL_BYTE *bz; INT dim,pz;
2162 /*------------------------------------------------------------------------------
2163 berechnet aus bz, der Koeffizientenmatrix aus k_alkonmat(), die Dimension
2164 der modular irreduziblen Darstellung fuer ein pz.
2165 Variablen: bz, Koeffizientenmatrix aus k_alkonmat();
2166 dim, Dimension der Matrix;
2167 pz, Primzahl.
2168 Rueckgabewert: Dimension der mod. irred. Darstellung.
2169 ------------------------------------------------------------------------------*/
2170 /* TL 0790 */ /* AK 210891 V1.3 */
2171 {
2172 dm=dim;
2173 dm_zwei=(INT)2*dm;
2174 qdm=(INT)dm*(INT)dm;
2175 _k_moddreimat(bz,pz);
2176 return(_k_modgauss(bz,pz));
2177 } /* k_dimmod */
2178 /*******************************************************************************
2179 *
2180 * Datei MODULDCM.C
2181 * Version vom 22.11.89
2182 *
2183 *
2184 * Zeile Funktionen
2185 *
2186 * Funktionen zur Berechnung der Zerlegungszahlen
2187 * ----------------------------------------------
2188 * 61 INT _nexpart(INT n,INT mode,TL_BYTE *r,TL_BYTE *m)
2189 * 103 INT _part_reg(INT p,INT *r,INT *m)
2190 * 124 INT _num_part(INT n,INT pz)
2191 * 159 INT _r_induk(INT *lambda,INT n,INT pz,INT i,INT r)
2192 * 188 INT _ber_lambdas(INT **lambda,INT n,INT p)
2193 * 238 INT _fakul(INT n)
2194 * 250 INT _assoziiere(TL_BYTE *lambda,TL_BYTE *slambda,INT n)
2195 * 274 INT _dimension(INT *lambda,INT n)
2196 * 302 INT _ber_dim(INT *dim,TL_BYTE **lambda,INT lda,INT n,INT p)
2197 * 366 INT _v_eintrag(TL_BYTE **lambda,INT lanz,TL_BYTE *part,TL_BYTE *v,INT vv,INT n)
2198 * 405 INT _ggT(INT a,INT b)
2199 * 431 INT _ggT_v(TL_BYTE *v,INT vl)
2200 * 455 INT _kleiner(TL_BYTE *col_eins,TL_BYTE *col_zwei,INT len)
2201 * 483 INT _diff(TL_BYTE *col_eins,TL_BYTE *col_zwei,TL_BYTE *erg,INT len)
2202 * 507 INT _red_r_mat(TL_BYTE **r_mat,INT col,INT row)
2203 * 608 INT _teste_r_mat_dim(TL_BYTE **r_mat,INT col,INT row,INT p,INT *dim,
2204 * INT *rg_dim,INT ab)
2205 * 709 INT _search_dec(INT *decomp,INT n, INT pz)
2206 * 753 _append_dec(INT *decomp,INT row,INT col,INT n,INT pz)
2207 * 778 INT d_mat(TL_BYTE *decomp,INT col,INT row,INT n,INT pz)
2208 *
2209 *******************************************************************************/
2210 /*
2211 Uebliche Headerfiles
2212 */
2213
2214
2215
2216
2217 /*
2218 Defines...
2219 */
2220 #define _H_IJ(l,i,sl,j) (l[i]-i+sl[j]-j-1L) /* Macro Hook_length */
2221
2222
2223 /*----------------------------------------------------------------------------*/
_nexpart(n,mode,r,m)2224 static INT _nexpart(n,mode,r,m) TL_BYTE *r,*m; INT n, mode;
2225 /*------------------------------------------------------------------------------
2226 berechnet die naechste Partition von n. Dabei enthaelt r die r[0] Teile der
2227 Partition und m die Vielfachheiten.
2228 Variablen: n, die zu partitionierende Zahl;
2229 mode, =0 erste Partitionierung,
2230 !=0 weitere Partitionierungen.
2231 Rueckgabe r und m.
2232 Rueckgabewerte: (INT)0, falls keine weitere Partitionierung moeglich;
2233 1L, falls weitere Partitionen von n existieren.
2234 ------------------------------------------------------------------------------*/
2235 /* TL 0790 */ /* AK 210891 V1.3 */
2236 {
2237 INT d,s,sum,f;
2238
2239 if (sym_timelimit > 0L) /* AK 230996 */
2240 check_time();
2241
2242 d=r[0];
2243 if (mode)
2244 {
2245 sum=(r[d]==1L)? m[d--]+1L : 1L;
2246 f=r[d]-1L;
2247 if (m[d]!=1L) m[d++]--;
2248 r[d]=f;
2249 m[d]=(sum/f)+1L;
2250 s=sum % f;
2251 if (s>(INT)0)
2252 {
2253 r[++d]=s;
2254 m[d]=1L;
2255 }
2256 r[0]=d;
2257 return(m[d]!=n);
2258 }
2259 else
2260 {
2261 r[0]=m[1]=1L;
2262 r[1]=n;
2263 return(n!=1L);
2264 }
2265 } /* _nexpart */
2266
2267
2268 /*----------------------------------------------------------------------------*/
_part_reg(p,r,m)2269 static INT _part_reg(p,r,m) INT p;
2270 TL_BYTE *r, *m;
2271 /*------------------------------------------------------------------------------
2272 ueberprueft die Partition gegeben durch r und m, ob sie p-regulaer ist.
2273 Variablen: p, Primzahl;
2274 r, Partition mit r[0]=Laenge von r und m,
2275 r[1]...r[r[0]] Elemente der Partition;
2276 m, Vielfachheiten von r[1]...r[r[0]].
2277 Rueckgabewerte: (INT)0, falls Partition nicht p-regulaer;
2278 1L, falls Partition p-regulaer ist.
2279 ------------------------------------------------------------------------------*/
2280 /* TL 0790 */ /* AK 210891 V1.3 */
2281 {
2282 INT i;
2283 for (i=1L;i<=r[0];i++)
2284 if (m[i]>=p)
2285 return((INT)0);
2286 return(1L);
2287 } /* _part_reg */
2288
2289
2290 /*----------------------------------------------------------------------------*/
_num_part(n,pz)2291 static INT _num_part(n,pz) INT n,pz;
2292 /*------------------------------------------------------------------------------
2293 berechnet fuer pz=0 die Anzahl der Partitionen zu n und fuer pz!=0 die
2294 Anzahl der regulaeren Partitionen.
2295 Variablen: n, die zu partitionierende Zahl;
2296 pz, Primzahl oder 0.
2297 Rueckgabewerte: >(INT)0, die Anzahl der (p-regulaeren) Partitionen von n;
2298 (INT)-109, falls nicht genuegend Speicher vorhanden war.
2299 ------------------------------------------------------------------------------*/
2300 /* TL 0790 */ /* AK 210891 V1.3 */
2301 {
2302 INT num,d,e;
2303 TL_BYTE *r,*m;
2304
2305 r=(TL_BYTE *)SYM_calloc(2*(int)(n+1),sizeof(TL_BYTE));
2306 m=r+(INT)n+1L;
2307 num=(INT)0;
2308 e=1L;
2309 d=(INT)0;
2310 while (e)
2311 {
2312 e=d=_nexpart(n,d,r,m);
2313 if (pz)
2314 {
2315 if (_part_reg(pz,r,m)) num++;
2316 }
2317 else num++;
2318 }
2319 SYM_free(r);
2320 return(num);
2321 } /* _num_part */
2322
2323
2324 /*----------------------------------------------------------------------------*/
_r_induk(lambda,n,pz,i,r)2325 static INT _r_induk(lambda,n,pz,i,r) TL_BYTE *lambda;
2326 INT n,pz,i,r;
2327 /*------------------------------------------------------------------------------
2328 ueberprueft die Moeglichkeit einer r-Induktion des zur Partition lambda
2329 gehoerenden Tableaux in der Zeile i.
2330 Variablen: lambda, Partition zu n;
2331 n;
2332 pz, Primzahl;
2333 i, Zeile des Tableaux;
2334 r, die "Ordnung" des anzuhaengenden Knotens.
2335 Rueckgabewerte: (INT)0, falls r-Induktion nicht moeglich;
2336 1L, falls r-Induktion moeglich ist.
2337 ------------------------------------------------------------------------------*/
2338 /* TL 0790 */ /* AK 210891 V1.3 */
2339 {
2340 INT len;
2341
2342 for (len=(INT)0;len<n && lambda[len];len++);
2343 if (!i) return(TL_MOD(lambda[0],pz)==r);
2344 else if (i<len)
2345 {
2346 if (lambda[i-1]>lambda[i]) return(TL_MOD(lambda[i]-i,pz)==r);
2347 else return((INT)0);
2348 }
2349 else if (i==len) return(TL_MOD(-i,pz)==r);
2350 else return((INT)0);
2351 } /* _r_induk */
2352
2353
2354 /*----------------------------------------------------------------------------*/
_ber_lambdas(lambda,n,p)2355 static INT _ber_lambdas(lambda,n,p) INT n,p;
2356 TL_BYTE **lambda;
2357 /*------------------------------------------------------------------------------
2358 berechnet fuer p=0 alle eigentlichen Partitionen von n und fuer p!=(INT)0, p
2359 Primzahl, alle p-regulaeren Partitionen von n.
2360 Variablen: n, die zu partitionierende Zahl;
2361 p, Primzahl oder (INT)0;
2362 Rueckgabe lambda, Vektor von Partitionen.
2363 Rueckgabewerte: (INT)0, falls alle Partitionen ohne Fehler berechnet wurden;
2364 (INT)-109, falls kein Speicher zur Verfuegung stand.
2365 ------------------------------------------------------------------------------*/
2366 /* TL 0790 */ /* AK 210891 V1.3 */
2367 {
2368 TL_BYTE *r,*m;
2369 INT d,e,i,j,k,l;
2370
2371 r=(TL_BYTE *)TL_calloc((int)(n+1)*2,sizeof(TL_BYTE));
2372 if (r == NULL) return no_memory();
2373 m=r+(INT)(n+1L);
2374 e=1L;
2375 k=d=(INT)0;
2376 while(e)
2377 {
2378 d=e=_nexpart(n,d,r,m);
2379 if (!p)
2380 {
2381 for (i=(INT)0;i<n;lambda[k][i++]=(TL_BYTE)0);
2382 for (i=1L,l=(INT)0;i<=r[0];i++)
2383 for (j=(INT)0;j<m[i];j++)
2384 lambda[k][l++]=r[i];
2385 k++;
2386 }
2387 else
2388 {
2389 if (_part_reg(p,r,m))
2390 {
2391 for (i=(INT)0;i<n;lambda[k][i++]=(TL_BYTE)0);
2392 for (i=1L,l=(INT)0;i<=r[0];i++)
2393 for (j=(INT)0;j<m[i];j++)
2394 lambda[k][l++]=r[i];
2395 k++;
2396 }
2397 }
2398 }
2399 #ifndef __TURBOC__ /* leider gibt Turbo C hier nicht sauber frei?? */
2400 SYM_free(r);
2401 #endif
2402 return((INT)0);
2403 } /* _ber_lambdas */
2404
2405
2406 /*----------------------------------------------------------------------------*/
_fakul(n)2407 static INT _fakul(n) INT n;
2408 /*------------------------------------------------------------------------------
2409 berechnet n! und gibt das Ergebnis als Langzahl zurueck.
2410 ------------------------------------------------------------------------------*/
2411 /* TL 0790 */ /* AK 210891 V1.3 */
2412 {
2413 if (n > 12) error("mo:internal error: 500");
2414 if (n<=1L) return(1L);
2415 else return ((INT)n*_fakul(n-1L));
2416 } /* _fakul */
2417
2418
2419
2420 /*----------------------------------------------------------------------------*/
_dimension(lambda,n)2421 static INT _dimension(lambda,n) TL_BYTE *lambda;
2422 INT n;
2423 /*------------------------------------------------------------------------------
2424 berechnet die Dimension der Darstellung zu einer eigentlichen Partition
2425 mit Hilfe der Hakenformel.
2426 Variablen: lambda, Partition;
2427 n, die partitionierte Zahl.
2428 Rueckgabewert: Dimension.
2429 ------------------------------------------------------------------------------*/
2430 /* TL 0790 */ /* AK 210891 V1.3 */
2431 {
2432 INT i,j,l;
2433 INT zz,zn;
2434 TL_BYTE *slambda;
2435 if (n > (INT)12) /* AK 260195 */
2436 {
2437 OP p,a;
2438 a = callocobject();
2439 p = callocobject();
2440 for (l=(INT)0;lambda[l]>0;l++);
2441 b_ks_pa(VECTOR,callocobject(),p);
2442 m_il_v(l,S_PA_S(p));
2443 l--;
2444 for (i=0;l>=0;i++,l--)
2445 m_i_i((INT)(lambda[l]),S_PA_I(p,i));
2446
2447 dimension_partition(p,a);
2448 l=s_i_i(a);
2449 freeall(a);
2450 freeall(p);
2451 return l;
2452 }
2453
2454 slambda=(TL_BYTE *)TL_calloc((int)(n+1),sizeof(TL_BYTE));
2455 if (slambda == NULL) return no_memory();
2456 _assoziiere(lambda,slambda,n);
2457 zz=_fakul(n);
2458 for (l=(INT)0;l<n && lambda[l];l++);
2459 for (i=(INT)0,zn=1L;i<l;i++)
2460 for (j=(INT)0;j<lambda[i];j++)
2461 zn *= (INT)_H_IJ(lambda,i,slambda,j);
2462 SYM_free(slambda);
2463 return((INT)(zz/zn));
2464 } /* _dimension */
2465
2466
2467 /*----------------------------------------------------------------------------*/
_ber_dim(dim,lambda,lda,n,p)2468 static INT _ber_dim(dim,lambda,lda,n,p) INT *dim;
2469 TL_BYTE **lambda;
2470 INT lda, n,p;
2471 /*------------------------------------------------------------------------------
2472 berechnet fuer p=0 die Dimensionen zu allen eigentlichen Partitionen lambda
2473 und fuer p!=(INT)0, p Primzahl, die p-Dimensionen zu allen p-regulaeren Parti-
2474 tionen lambda.
2475 Variablen: lambda, Vektor von Partitionen;
2476 lda, Laenge des Vektors lambda;
2477 n, die partitionierte Zahl;
2478 p, Primzahl oder 0.
2479 Rueckgabe dim, Vektor der Dimensionen.
2480 Rueckgabewerte: (INT)0, falls alles ohne Fehler berechnet wurde;
2481 <(INT)0, s. Datei MODULKFF.C Funktion alkonmat().
2482 ------------------------------------------------------------------------------*/
2483 /* TL 0790 */ /* AK 210891 V1.3 */
2484 {
2485 TL_BYTE *slambda;
2486 INT i,dm,omaxdim,k;
2487 TL_BYTE *bz;
2488
2489 omaxdim=MAXDM;
2490 for (i=(INT)0;i<lda;dim[i++]=(INT)0);
2491 for (i=(INT)0;i<lda;i++)
2492 {
2493 if (p) /* D.h. keine gewoehnliche darstellung */
2494 {
2495
2496 MAXDM=_dimension(lambda[i],n);
2497 if (MAXDM<(INT)0)
2498 {
2499 MAXDM=omaxdim;
2500 return(MAXDM);
2501 }
2502 slambda=(TL_BYTE *)TL_calloc((int)(n+1),sizeof(TL_BYTE));
2503 if (slambda == NULL)
2504 {
2505 MAXDM=omaxdim;
2506 return no_memory();
2507 }
2508 bz=(TL_BYTE *)TL_calloc((int)MAXDM*(int)MAXDM,sizeof(TL_BYTE));
2509 if (bz == NULL)
2510 {
2511 MAXDM=omaxdim;
2512 SYM_free(slambda);
2513 return no_memory();
2514 }
2515 if (lambda[i][0]==5 && lambda[i][1]==4 && lambda[i][2]==2 && n==11L && p==2L)
2516 dim[i]=416L;
2517 else
2518 {
2519 _assoziiere(lambda[i],slambda,n);
2520 if ((dm=k_alkonmat(slambda,bz,p))<(INT)0)
2521 {
2522 MAXDM=omaxdim;
2523 SYM_free(slambda);
2524 SYM_free(bz);
2525 error("mo:internal error : 345");
2526 return(dm);
2527 }
2528 if ((dim[i]=k_dimmod(bz,MAXDM,p))<(INT)0)
2529 {
2530 MAXDM=omaxdim;
2531 SYM_free(slambda);
2532 SYM_free(bz);
2533 error("mo:internal error : 346");
2534 return(dim[i]);
2535 }
2536 }
2537 SYM_free(bz);
2538 SYM_free(slambda);
2539
2540 }
2541 else
2542 if ((dim[i]=_dimension(lambda[i],n))<(INT)0)
2543 {
2544 MAXDM=omaxdim;
2545 error("mo:internal error : 347");
2546 return(dim[i]);
2547 }
2548 }
2549 MAXDM=omaxdim;
2550 j_zyk((INT) -15,0,NULL,NULL); /* AK 020294 */
2551 return((INT)0);
2552 } /* _ber_dim */
2553
2554
2555 /*----------------------------------------------------------------------------*/
_v_eintrag(lambda,lanz,part,v,vv,n)2556 static INT _v_eintrag(lambda,lanz,part,v,vv,n)
2557 TL_BYTE **lambda, *part, *v;
2558 INT lanz,vv,n;
2559 /*------------------------------------------------------------------------------
2560 zaehlt das Vorkommen der durch r-Induktion erhaltenen Partition part von
2561 n in lambda. Dabei wird der Eintrag der Zerlegungsmatrix fuer n-1 berueck-
2562 sichtigt.
2563 Variablen: lambda, Vektor der Partitionen von n;
2564 lanz, Laenge des Vektors lambda;
2565 part, Partition, errechnet durch r-Induktion von n-1 nach n;
2566 v, Spalte der Zerlegungsmatrix;
2567 vv, Eintrag der Partition part vor der r-Induktion in der Zer-
2568 legungsmatrix fuer n-1L;
2569 n, partitionierte Zahl.
2570 Rueckgabewerte: (INT)0, alles in Ordnung;
2571 -1L, warum existiert kein solches lambda?????
2572 ------------------------------------------------------------------------------*/
2573 /* TL 0790 */ /* AK 210891 V1.3 */
2574 {
2575 INT i,j;
2576 INT gefunden;
2577
2578 for (i=0,gefunden=0;i<lanz && !gefunden;i++)
2579 {
2580 for (j=0;j<n;j++)
2581 if (lambda[i][j]!=part[j])
2582 break;
2583 gefunden= (j==n);
2584 }
2585 if (gefunden)
2586 {
2587 v[i-1] += (TL_BYTE)vv;
2588 return (INT)0;
2589 }
2590 else
2591 return (INT)-1L;
2592 } /* _v_eintrag */
2593
2594
2595 /*----------------------------------------------------------------------------*/
_ggT(a,b)2596 static INT _ggT(a,b) INT a,b;
2597 /*------------------------------------------------------------------------------
2598 berechnet mit Hilfe Euklids den ggT zweier Zahlen a und b.
2599 ------------------------------------------------------------------------------*/
2600 /* TL 0790 */ /* AK 210891 V1.3 */
2601 {
2602 INT x,y,r;
2603
2604 if (a==b) return(a);
2605 else if (!a) return(b);
2606 else if (!b) return(a);
2607 x=a;
2608 y=b;
2609 if (x<y)
2610 {
2611 r=x;
2612 x=y;
2613 y=r;
2614 }
2615 x=a;
2616 y=b;
2617 while(y)
2618 {
2619 r=x%y;
2620 x=y;
2621 y=r;
2622 }
2623 return(x);
2624 } /* _ggT */
2625
2626
2627 /*----------------------------------------------------------------------------*/
_ggT_v(v,vl)2628 static INT _ggT_v(v,vl) TL_BYTE *v;
2629 INT vl;
2630 /*------------------------------------------------------------------------------
2631 berechnet den ggT der Eintraege eines Vektors v der Laenge vl und
2632 multipliziert den Vektor mit 1/ggT.
2633 ------------------------------------------------------------------------------*/
2634 /* TL 0790 */ /* AK 210891 V1.3 */
2635 {
2636 INT i,ggT;
2637
2638 for (i=0;i<vl;i++)
2639 if (v[i]==(TL_BYTE)1)
2640 return OK;
2641 ggT=_ggT((INT)v[0],(INT)v[1]);
2642 for (i=2;i<vl;i++)
2643 ggT=_ggT(ggT,(INT)v[i]);
2644 if (ggT>1)
2645 {
2646 for (i=0;i<vl;i++)
2647 v[i] = (TL_BYTE)(v[i]/ggT);
2648 }
2649 return OK;
2650 } /* _ggT_v */
2651
2652
2653 /*----------------------------------------------------------------------------*/
_kleiner(col_eins,col_zwei,len)2654 static INT _kleiner(col_eins,col_zwei,len)
2655 TL_BYTE *col_eins, *col_zwei;
2656 INT len;
2657 /*------------------------------------------------------------------------------
2658 vergleicht zwei Spalten col_eins und col_zwei. Ist col_eins (lexikographisch)
2659 kleiner als col_zwei, so gibt _kleiner eine 1 zurueck, sonst 0.
2660 Variablen: col_eins, erste Spalte;
2661 col_zwei, zweite Spalte;
2662 len, Laenge der Spalten.
2663 Rueckgabewerte: 1L, falls col_eins kleiner col_zwei;
2664 (INT)0, sonst.
2665 ------------------------------------------------------------------------------*/
2666 /* TL 0790 */ /* AK 210891 V1.3 */
2667 {
2668 INT i;
2669
2670 if (!col_zwei) return((INT)0);
2671 if (!col_eins) return(1L);
2672 for (i=(INT)0;i<len;i++)
2673 if (col_eins[i] || col_zwei[i])
2674 {
2675 if (col_eins[i]<col_zwei[i]) return(1L);
2676 else if (col_eins[i]==col_zwei[i]) continue;
2677 else break;
2678 }
2679 return((INT)0);
2680 } /* _kleiner */
2681
2682
2683 /*----------------------------------------------------------------------------*/
_diff(col_eins,col_zwei,erg,len)2684 static INT _diff(col_eins,col_zwei,erg,len)
2685 TL_BYTE *col_eins, *col_zwei, *erg;
2686 INT len;
2687 /*------------------------------------------------------------------------------
2688 berechnet die Differenz erg=col_eins-col_zwei. Existiert in erg ein Eintrag
2689 kleiner als (INT)0, so gibt _diff 0 zurueck, sonst 1.
2690 Variablen: col_eins, erste Spalte;
2691 col_zwei, zweite Spalte;
2692 len, Laenge der Spalten.
2693 Rueckgabe Ergebnis erg.
2694 Rueckgabewerte: (INT)0, falls Eintrag von erg <(INT)0;
2695 1L, sonst.
2696 ------------------------------------------------------------------------------*/
2697 /* TL 0790 */ /* AK 210891 V1.3 */
2698 {
2699 INT i;
2700
2701 for (i=0;i<len;erg[i++]=(TL_BYTE)0);
2702 for (i=0;i<len;i++)
2703 if ((erg[i]=col_eins[i]-col_zwei[i])<(TL_BYTE)0)
2704 return (INT)0;
2705 return (INT)1;
2706 } /* _diff */
2707
2708
2709 /*----------------------------------------------------------------------------*/
_red_r_mat(r_mat,col,row)2710 static INT _red_r_mat(r_mat,col,row) TL_BYTE **r_mat;
2711 INT col,row;
2712 /*------------------------------------------------------------------------------
2713 untersucht die Matrix r_mat auf Spalten, die (INT)0, gleich oder von
2714 anderen abgezogen werden koennen.
2715 Variablen: r_mat, Matrix aller durch r-Induktion entstandenen
2716 Spalten;
2717 col, Anzahl der Spalten von r_mat;
2718 row, Anzahl der Zeilen von r_mat;
2719 Rueckgabe ausreduzierte Matrix r_mat.
2720 Rueckgabewerte: (INT)0, alles ohne Fehler gelaufen;
2721 (INT)-109, falls nicht genuegend Speicher verfuegbar war.
2722 ------------------------------------------------------------------------------*/
2723 /* TL 0790 */ /* AK 210891 V1.3 */
2724 {
2725 INT i,j,k,l,max;
2726 TL_BYTE *r;
2727 TL_BYTE *hp,*c;
2728 INT gleiche;
2729
2730 c=(TL_BYTE *)TL_calloc((int)(col+row),sizeof(TL_BYTE));
2731 if (c == NULL)
2732 return no_memory();
2733 r=c+(int)row;
2734 for (i=0;i<col;i++) /* pruefe, ob in r_mat Spalte=0 existiert */
2735 {
2736 if (r_mat[i] == NULL)
2737 continue;
2738 for (j=0;j<row;j++)
2739 if (r_mat[i][j] != (TL_BYTE)0)
2740 break;
2741 if (j==row) /* wenn ja, vergesse Spalte */
2742 r_mat[i]=(TL_BYTE *)NULL;
2743 }
2744 for (i=0;i<col-1;i++)
2745 /* pruefe, ob in r_mat zwei Spalten gleich sind */
2746 {
2747 if (r_mat[i] == NULL) continue;
2748 for (j=i+1L;j<col;j++)
2749 {
2750 if (!r_mat[j])
2751 continue;
2752 for (k=0;k<row;k++)
2753 if (r_mat[i][k]!=r_mat[j][k])
2754 break;
2755 if (k==row) /* wenn ja, vergesse eine davon */
2756 r_mat[j]=NULL;
2757 }
2758 }
2759 for (i=0;i<col-1;i++) /* sortiere Spalten in r_mat lexikographisch */
2760 { /* absteigend */
2761 max=i;
2762 for (j=i+1L;j<col;j++)
2763 if (_kleiner(r_mat[max],r_mat[j],row))
2764 max=j;
2765 if (max!=i)
2766 {
2767 hp=r_mat[i];
2768 r_mat[i]=r_mat[max];
2769 r_mat[max]=hp;
2770 }
2771 }
2772 for (i=0;i<col;i++) /* belege r[i] mit der Zeilennummer des ersten */
2773 if (!r_mat[i]) r[i]=(TL_BYTE)0; /* Eintrags in der Spalte r_mat[i] */
2774 else
2775 for (j=0;j<row;j++)
2776 if (r_mat[i][j])
2777 {
2778 r[i]=(TL_BYTE)j+1;
2779 break;
2780 }
2781 for (i=0,gleiche=0;i<col-1 && !gleiche;i++)
2782 { /* ueberpruefe r auf gleiche Eintraege */
2783 if (!r[i]) continue;
2784 for (j=i+1L;j<col;j++)
2785 {
2786 if (!r[j]) continue;
2787 if (r[i]==r[j]) /* existieren zwei gleiche Eintraege: */
2788 {
2789 if (_diff(r_mat[i],r_mat[j],c,row)) /* probiere, die zwei Spalten */
2790 for (k=0;k<row;k++) /* voneinander abzuziehen */
2791 r_mat[i][k]=c[k];
2792 else /* lassen sie sich nicht abziehen, probiere, hintere Spalten */
2793 /* von der lex. kleineren der beiden Spalten abzuziehen */
2794 for (k=col-(INT)1;k>j;k--)
2795 {
2796 if (!r_mat[k]) continue;
2797 if (_diff(r_mat[j],r_mat[k],c,row))
2798 {
2799 for (l=0;l<row;l++)
2800 r_mat[j][l]=c[l];
2801 break;
2802 }
2803 }
2804 gleiche=1;
2805 break;
2806 }
2807 }
2808 }
2809 if (gleiche) /* gab es gleiche Spalten, so */
2810 if (_red_r_mat(r_mat,col,row)) /* untersuche r_mat nochmals */
2811 {
2812 SYM_free(c);
2813 return no_memory();
2814 }
2815 SYM_free(c);
2816 return (INT)0;
2817 } /* _red_r_mat */
2818
2819
2820 /*----------------------------------------------------------------------------*/
_teste_r_mat_dim(r_mat,col,row,p,dim,rg_dim,ab)2821 static INT _teste_r_mat_dim(r_mat,col,row,p,dim,rg_dim,ab)
2822 INT *dim, *rg_dim;
2823 TL_BYTE **r_mat;
2824 INT col,row,p,ab;
2825 /*------------------------------------------------------------------------------
2826 untersucht die Zeilen von r_mat auf Richtigkeit. Dabei werden die p-Dimen-
2827 sionen der p-regulaeren Partitionen multipliziert mit den korrespon-
2828 dierenden Eintraegen in den Zeilen von r_mat aufsummiert und schliesslich
2829 mit den jeweiligen gewoehnlichen Dimensionen zu den Partitionen verglichen.
2830 Variablen: r_mat, vorher mit _red_r_mat() ueberpruefte Matrix der mit
2831 r-Induktion erhaltenen Spalten;
2832 col, Anzahl der p-regulaeren Partitionen;
2833 row, Anzahl der eigentlichen Partitionen;
2834 dim, Dimensionen der gew. irred. Dg.en zu den eigentlichen
2835 Partitionen;
2836 rg_dim, p-Dimensionen der mod. irred. Dg.en zu den p-regulaeren
2837 Partitionen.
2838 Rueckgabe Matrix r_mat, ueberprueft und eventl. mit neuen Spalten, die
2839 durch Abziehen lexikographisch kleinerer Spalten von der alten entstanden
2840 ist.
2841 Rueckgabewerte: (INT)0, alles ohne Fehler abgelaufen;
2842 (INT)-109, falls nicht genuegend Speicher vorhanden war.
2843 ------------------------------------------------------------------------------*/
2844 /* TL 0790 */ /* AK 210891 V1.3 */
2845 {
2846 INT i,j,k,clmn,dm;
2847 TL_BYTE *c,*r, *hp;
2848 INT err,l;
2849
2850 clmn=col*p;
2851 c=(TL_BYTE *)TL_calloc((int)row*2+(int)clmn,sizeof(TL_BYTE));
2852 if (c == NULL) return no_memory();
2853 hp=c+(int)row;
2854 r=hp+(int)row;
2855
2856 for (i=ab;i<row;i++)
2857 {
2858 for (j=0,k=0,dm=0;j<clmn;j++)
2859 /* summiere in den Zeilen die Produkte */
2860 { /* aus Eintraegen von r_mat und Dimen- */
2861 if (r_mat[j] == NULL) continue; /* sionen der p-regulaeren Partitionen */
2862 dm += (rg_dim[k++]*(INT)r_mat[j][i]);
2863 }
2864 if (dm>dim[i]) break;
2865 else if (dm<dim[i])
2866 {
2867 fprintf(stderr,"\n dm = %d : %d \n",dm,dim[i]);
2868 SYM_free(c);
2869 error("MO-1:internal error");
2870 return (INT)-1;
2871 }
2872 }
2873 if (i==row)
2874 {
2875 SYM_free(c);
2876 return((INT)0);
2877 }
2878 for (j=(INT)0;j<clmn;j++) /* belege r[i] mit der Zeilennummer des ersten */
2879 if (r_mat[j]) /* Eintrags in der Spalte r_mat[i] */
2880 for (k=(INT)0;k<row;k++)
2881 {
2882 if (r_mat[j][k])
2883 {
2884 r[j]=(TL_BYTE)k+1;
2885 break;
2886 }
2887 }
2888 else r[j]=(INT)0;
2889 for (j=(INT)0;j<clmn-(INT)1;j++)
2890 {
2891 if (!r_mat[j]) continue;
2892 if (r_mat[j][i])
2893 {
2894 for (k=j+1L;k<clmn;k++)
2895 {
2896 if (!r[k]) continue;
2897 if (i+1!=r[k]) continue;
2898 if (r_mat[k][i])
2899 {
2900 if (_diff(r_mat[j],r_mat[k],c,row))
2901 {
2902 for (l=(INT)0;l<row;l++)
2903 {
2904 hp[l]=r_mat[j][l];
2905 r_mat[j][l]=c[l];
2906 }
2907 if ((err=_teste_r_mat_dim(r_mat,col,row,p,dim,rg_dim,i))<(INT)0 )
2908 {
2909 for (l=(INT)0;l<row;l++)
2910 r_mat[j][l]=hp[l];
2911 if (err == (INT)-109)
2912 {
2913 SYM_free(c);
2914 return(err);
2915 }
2916 break;
2917 }
2918 SYM_free(c);
2919 return((INT)0);
2920 }
2921 }
2922 }
2923 }
2924 }
2925 SYM_free(c);
2926 return (INT)0;
2927 } /* _teste_r_mat_dim */
2928
2929
2930 /*----------------------------------------------------------------------------*/
_search_dec(decomp,n,pz)2931 static INT _search_dec(decomp,n,pz) INT pz,n;
2932 TL_BYTE *decomp;
2933 /*------------------------------------------------------------------------------
2934 sucht im File 'decommix.dat' nach, ob die Zerlegungsmatrix fuer n und pz
2935 schon einmal berechnet wurde.
2936 Variablen: decomp, Zerlegungsmatrix;
2937 n, Sn;
2938 pz, Primzahl.
2939 Rueckgabe der Zerlegungsmatrix fuer n und pz, falls gefunden.
2940 Rueckgabewerte: (INT)0, falls keine Zerlegungsmatrix fuer n und pz gefunden werden
2941 konnte;
2942 1L, falls Zerlegungsmatrix fuer n und pz existiert.
2943 ------------------------------------------------------------------------------*/
2944 /* TL 0790 */ /* AK 210891 V1.3 */
2945 {
2946 FILE *dfp;
2947 INT info[4],i,j,k;
2948 TL_BYTE *d;
2949 INT end;
2950
2951 dfp=fopen("decommix.dat","r");
2952 if (!dfp) return (INT) 0;
2953 rewind(dfp);
2954 do
2955 {
2956 /* fread(info,sizeof(INT),4,dfp); */
2957 fscanf(dfp,"%d",&info[0]);
2958 fscanf(dfp,"%d",&info[1]);
2959 fscanf(dfp,"%d",&info[2]);
2960 fscanf(dfp,"%d",&info[3]);
2961 if (info[0]==n && info[1]==pz)
2962 {
2963 /*
2964 fread(decomp,sizeof(TL_BYTE),(int)info[2]*(int)info[3],dfp);
2965 */
2966 j = info[2] * info[3];
2967 for (i=(INT)0; i<j;i++)
2968 {
2969 fscanf(dfp,"%d",&end);
2970 decomp[i] = (TL_BYTE) end;
2971 }
2972 fclose(dfp);
2973 return (INT) 1;
2974 }
2975 else
2976 {
2977 if ( (int)info[2]*(int)info[3] == 0) /* AK 311293 */
2978 return (INT)0;
2979 /*
2980 d=(TL_BYTE *)TL_calloc((int)info[2]*(int)info[3],sizeof(TL_BYTE));
2981 if (d==NULL) return((INT)0);
2982 end=fread(d,sizeof(TL_BYTE),(int)info[2]*(int)info[3],dfp);
2983 SYM_free(d);
2984 */
2985 j = info[2] * info[3];
2986 for (i=(INT)0; i<j;i++)
2987 {
2988 end = (fscanf(dfp,"%d",&k) > 0) ;
2989 }
2990 }
2991 } while(end);
2992 fclose(dfp);
2993 return((INT)0);
2994 } /* _search_dec */
2995
2996
2997 /*----------------------------------------------------------------------------*/
_append_dec(decomp,row,col,n,pz)2998 static INT _append_dec(decomp,row,col,n,pz) TL_BYTE *decomp;
2999 INT row,col,n,pz;
3000 /*------------------------------------------------------------------------------
3001 haengt an das Ende des Files 'decommix.dat' eine fuer n und pz noch nicht
3002 berechnete Zerlegungsmatrix.
3003 Variablen: decomp, Zerlegungsmatrix;
3004 row, Zeilenzahl der Zerlegungsmatrix;
3005 col, Spaltenzahl der Zerlegungsmatrix;
3006 n, Sn;
3007 pz, Primzahl.
3008 ------------------------------------------------------------------------------*/
3009 /* TL 0790 */ /* AK 210891 V1.3 */
3010 {
3011 FILE *dfp;
3012 INT info[4],i,j;
3013
3014 dfp=fopen("decommix.dat","a+");
3015 if (!dfp) return ERROR;
3016 info[0]=n;
3017 info[1]=pz;
3018 info[2]=row;
3019 info[3]=col;
3020 fprintf(dfp, "%" PRIINT " %" PRIINT " %" PRIINT " %" PRIINT " \n " ,info[0],info[1],info[2],info[3]);
3021 j = info[2] * info[3];
3022 for (i=(INT)0; i<j;i++)
3023 fprintf(dfp,"%d ",(int)decomp[i]);
3024 fprintf(dfp,"\n");
3025 fclose(dfp);
3026 return OK;
3027 } /*_append_dec */
3028
3029
3030 /*----------------------------------------------------------------------------*/
d_mat(decomp,col,row,n,pz)3031 static INT d_mat(decomp,col,row,n,pz) TL_BYTE *decomp;
3032 INT col,row,n,pz;
3033 /*------------------------------------------------------------------------------
3034 berechnet die (row x col)-Zerlegungsmatrix decomp zu n und der Primzahl pz.
3035 Variablen: col, Spaltenzahl der Zerlegungsmatrix;
3036 row, Zeilenzahl der Zerlegungsmatrix;
3037 n;
3038 pz, Primzahl.
3039 Rueckgabe Zerlegungsmatrix decomp.
3040 Rueckgabewerte: (INT)0, alles ohne Fehler;
3041 sonst, s. Datei MODULKFF.C Funktion alkonmat().
3042 ------------------------------------------------------------------------------*/
3043 /* TL 0790 */ /* AK 210891 V1.3 */
3044 {
3045 TL_BYTE **lambda,**rg_lambda,*part,*pr,*mr,*v;
3046 INT *dim,*rg_dim;
3047 INT num,i,j,k,l,r,e,d,o,p,m,err,vv;
3048 TL_BYTE *odec;
3049 INT orow,ocol;
3050 TL_BYTE **r_mat,*z;
3051 TL_BYTE **hr,*hrc;
3052 INT erg = OK;
3053
3054 if (n<=1L)
3055 {
3056 decomp[0]=(TL_BYTE)1;
3057 return((INT)0);
3058 }
3059 else
3060 {
3061 if (_search_dec(decomp,n,pz))
3062 return((INT)0);
3063 if ((orow=_num_part(n-1L,(INT)0))<(INT)0) return(orow);
3064 ocol=_num_part(n-1L,pz);
3065 odec=(TL_BYTE *)TL_calloc((int)ocol*(int)orow,sizeof(TL_BYTE));
3066 if (!odec) return no_memory();
3067 if ((err=d_mat(odec,ocol,orow,n-1L,pz))<(INT)0)
3068 {
3069 SYM_free(odec);
3070 return error("d_mat:error in n-1");
3071 }
3072 lambda=(TL_BYTE **)TL_calloc((int)row+(int)col,sizeof(TL_BYTE *));
3073 if (lambda == NULL)
3074 {
3075 SYM_free(odec);
3076 return no_memory();
3077 }
3078 /* printeingabe("1");*/
3079 rg_lambda=lambda+(INT)row;
3080 lambda[0]=(TL_BYTE *)TL_calloc((int)(row+col)*(int)(n+1),sizeof(TL_BYTE));
3081 if (lambda[0] == NULL)
3082 {
3083 SYM_free(odec);
3084 SYM_free(lambda);
3085 return no_memory();
3086 }
3087 for (i=1L;i<row;i++)
3088 lambda[i]=lambda[i-1]+n;
3089 /* printeingabe("2");*/
3090 if ((err=_ber_lambdas(lambda,n,(INT)0))<(INT)0)
3091 {
3092 SYM_free(odec);
3093 SYM_free(lambda[0]);
3094 SYM_free(lambda);
3095 return error("d_mat:error in ber_lambdas");
3096 }
3097 rg_lambda[0]=lambda[row-1]+(TL_BYTE)n;
3098 for (i=1L;i<col;i++)
3099 rg_lambda[i]=rg_lambda[i-1]+(INT)n;
3100 /* printeingabe("3");*/
3101 if ((err=_ber_lambdas(rg_lambda,n,pz))<(INT)0)
3102 {
3103 SYM_free(odec);
3104 SYM_free(lambda[0]);
3105 SYM_free(lambda);
3106 return error("d_mat:error in ber_rlambdas");
3107 }
3108 /* dim=rg_lambda[col-1]+(INT)n; */
3109 dim = (INT *) TL_calloc(row+col,sizeof(INT));
3110 rg_dim=dim+(INT)row;
3111 /* printeingabe("4");*/
3112 if ((err=_ber_dim(dim,lambda,row,n,(INT)0))<(INT)0)
3113 {
3114 SYM_free(odec);
3115 SYM_free(lambda[0]);
3116 SYM_free(lambda);
3117 SYM_free(dim);
3118 return error("d_mat: error in ber_dim");
3119 }
3120 /* printeingabe("5");*/
3121 if ((err=_ber_dim(rg_dim,rg_lambda,col,n,pz))<(INT)0)
3122 {
3123 SYM_free(odec);
3124 SYM_free(lambda[0]);
3125 SYM_free(lambda);
3126 SYM_free(dim);
3127 return error("d_mat: error in ber_dim rlambdas");
3128 }
3129 hr=r_mat=(TL_BYTE **)TL_calloc((int)(col*pz),sizeof(TL_BYTE *));
3130 /* printeingabe("6");*/
3131 if (!r_mat)
3132 {
3133 SYM_free(odec);
3134 SYM_free(lambda[0]);
3135 SYM_free(lambda);
3136 SYM_free(dim);
3137 return no_memory();
3138 }
3139 hrc=r_mat[0]=(TL_BYTE *)TL_calloc((int)(col*pz)*(int)row,sizeof(TL_BYTE));
3140 if (!r_mat[0])
3141 {
3142 SYM_free(odec);
3143 SYM_free(lambda[0]);
3144 SYM_free(lambda);
3145 SYM_free(r_mat);
3146 SYM_free(dim);
3147 return no_memory();
3148 }
3149 /* printeingabe("7");*/
3150 for (i=1L;i<col*pz;i++)
3151 r_mat[i]=r_mat[i-1]+row;
3152 part=(TL_BYTE *)TL_calloc(3*(int)n+2+(int)row,sizeof(TL_BYTE));
3153 if (!part)
3154 {
3155 SYM_free(odec);
3156 SYM_free(lambda[0]);
3157 SYM_free(lambda);
3158 SYM_free(r_mat[0]);
3159 SYM_free(r_mat);
3160 SYM_free(dim);
3161 return no_memory();
3162 }
3163 pr=part+(INT)n;
3164 mr=pr+(INT)n+1L;
3165 v=mr+(INT)n+1L;
3166 k=(INT)0;
3167 /*
3168 Berechne alle r-Induktionen und lege die Ergebnisse in der Matrix r_mat
3169 spaltenweise ab.
3170 */
3171 /* printeingabe("8");*/
3172 for (l=(INT)0;l<ocol && k<(col*pz);l++)
3173 {
3174 for (i=(INT)0,num=(INT)0;i<orow;i++)
3175 if (odec[i*ocol+l])
3176 num ++;
3177 for (r=(INT)0;r<pz && k<(col*pz);r++)
3178 {
3179 e=1L;
3180 d=(INT)0;
3181 j=(INT)0;
3182 for (i=(INT)0;i<row;v[i++]=(TL_BYTE)0);
3183 for (i=(INT)0;i<num;i++)
3184 {
3185 do
3186 {
3187 e=d=_nexpart(n-1L,d,pr,mr);
3188 vv=odec[j*ocol+l];
3189 j++;
3190 } while(!vv && e);
3191 for (o=(INT)0;o<n;part[o++]=(TL_BYTE)0);
3192 for (p=1L,m=(INT)0;p<=pr[0];p++)
3193 {
3194 for (o=(INT)0;o<mr[p];o++)
3195 part[m++]=pr[p];
3196 }
3197 for (p=(INT)0;p<n;p++)
3198 if (_r_induk(part,(INT)n-1,pz,p,r))
3199 {
3200 part[p]++;
3201 _v_eintrag(lambda,row,part,v,vv,n);
3202 part[p]--;
3203 }
3204 }
3205 for (i=0;i<row;i++)
3206 if(v[i])
3207 {
3208 _ggT_v(v,row);
3209 break;
3210 }
3211 for (i=0;i<row;i++)
3212 r_mat[k][i]=v[i];
3213 k++;
3214 }
3215 }
3216 /* printeingabe("9");*/
3217 /*
3218 Durchsuche nun r_mat nach ueberfluessigen Spalten und
3219 errechne schliesslich die entgueltige Zerlegungsmatrix fuer n und pz.
3220 */
3221 if ((err=_red_r_mat(r_mat,col*pz,row))<(INT)0)
3222 {
3223 SYM_free(odec);
3224 SYM_free(lambda[0]);
3225 SYM_free(lambda);
3226 SYM_free(hrc);
3227 SYM_free(hr);
3228 SYM_free(part);
3229 SYM_free(dim);
3230 erg += error("d_mat:red_r_mat");
3231 goto dm1;
3232 }
3233 /* printeingabe("10");*/
3234 if ((err=_teste_r_mat_dim(r_mat,col,row,pz,dim,rg_dim,(INT)0))<(INT)0)
3235
3236 {
3237 erg += SYM_free(odec);
3238 erg += SYM_free(lambda[0]);
3239 erg += SYM_free(lambda);
3240 erg += SYM_free(hrc);
3241 erg += SYM_free(hr);
3242 erg += SYM_free(part);
3243 erg += SYM_free(dim);
3244 erg += error("d_mat:teste_r_mat_dim");
3245 goto dm1;
3246
3247 }
3248 for (i=(INT)0,k=(INT)0;i<col*pz;i++)
3249 if (r_mat[i])
3250 {
3251 for (j=(INT)0,z=decomp+k;j<row;j++,z +=col)
3252 *z = r_mat[i][j];
3253 k++;
3254 }
3255 /* printeingabe("11");*/
3256 _append_dec(decomp,row,col,n,pz);
3257 SYM_free(lambda[0]);
3258 SYM_free(lambda);
3259 SYM_free(hrc);
3260 SYM_free(hr);
3261 SYM_free(odec);
3262 SYM_free(part);
3263 SYM_free(dim);
3264 dm1:
3265 if (erg != OK)
3266 EDC("mo.c:d_mat");
3267 return (INT)0;
3268 }
3269 } /* d_mat */
3270
3271 /*----------------------------------------------------------------------------*/
moddg(prime,llambda,pi,dmat)3272 INT moddg(prime,llambda,pi,dmat) OP prime;
3273 OP llambda;
3274 OP pi;
3275 OP dmat;
3276 /*------------------------------------------------------------------------------
3277 berechnet zu einer Primzahl prime, einer Partition llambda und einer
3278 Permutation pi die modulare Matrixdarstellung dmat.
3279 Variablen: prime, Primzahl (objectkind: INTEGER);
3280 lambda, Partition (objectkind: PARTITION);
3281 pi, Permutation (objectkind: PERMUTATION).
3282 Rueckgabewerte: >=(INT)0, Dimension der Darstellung;
3283 -1L, falls Fehler Aufgetreten ist.
3284 Rueckgabe darstellende Matrix dmat, die erst hier dimensioniert wird,
3285 falls die Dimension groesser 0 ist.
3286 ------------------------------------------------------------------------------*/
3287 {
3288 TL_BYTE *part,*bz,*perm;
3289 TL_BYTE *darmat[2],*dar;
3290 INT pz,dim;
3291 INT spe,i,j,l_pa,l_p,gzl;
3292 OP dimen;
3293 OP lambda;
3294
3295 if (equal_parts(llambda,prime))
3296 {
3297 fprint(stderr,llambda);
3298 fprintln(stderr,prime);
3299 return error("moddg: wrong partition, wrong prime");
3300 }
3301
3302
3303 if (S_PA_LI(llambda) == 1L) /* AK 020692 */
3304 if (S_PA_II(llambda,(INT)0) == 1L) /* AK 020692 */
3305 { /* AK 020692 */
3306 m_ilih_m(1L,1L,dmat); /* AK 020692 */
3307 m_i_i(1L,S_M_IJ(dmat,(INT)0,(INT)0)); /* AK 020692 */
3308 return OK; /* AK 020692 */
3309 } /* AK 020692 */
3310
3311 dimen=callocobject();
3312 weight(llambda,dimen);
3313 if (neq(dimen,S_P_L(pi))) { /* AK 310702 */
3314 fprint(stderr,llambda);
3315 fprintln(stderr,pi);
3316 error("moddg: wrong permutation, wrong degree");
3317 freeall(dimen);
3318 return ERROR;
3319 }
3320 lambda=callocobject();
3321
3322 conjugate(llambda,lambda);
3323
3324 l_pa=S_PA_LI(lambda);
3325 l_p=S_P_LI(pi);
3326 spe=l_pa+l_p+2L;
3327 dimension(lambda,dimen);
3328 MAXDM=(INT)S_I_I(dimen);
3329 spe += ((INT)MAXDM*(INT)MAXDM*5L);
3330 part=(TL_BYTE *)TL_calloc(spe,sizeof(TL_BYTE));
3331 if (!part)
3332 {
3333 freeall(dimen);
3334 freeall(lambda);
3335 return(-1L);
3336 }
3337 perm=part+l_pa+1;
3338 bz=perm+l_p+1;
3339 for (i=0;i<l_pa;i++)
3340 part[i]=(TL_BYTE)S_PA_II(lambda,(l_pa-1L-i));
3341 for (i=0;i<l_p;i++)
3342 perm[i]=(TL_BYTE)S_P_II(pi,i);
3343 if ((dim=alkonmat(part,perm,bz))<(INT)0)
3344 {
3345 freeall(dimen);
3346 freeall(lambda);
3347 SYM_free(part);
3348 return error("mo.c: internal MO-12");
3349 }
3350 darmat[0]=(TL_BYTE *)TL_calloc((int)dim*(int)dim,sizeof(TL_BYTE));
3351 darmat[1]=(TL_BYTE *)TL_calloc((int)dim*(int)dim,sizeof(TL_BYTE));
3352 if (!darmat[0])
3353 {
3354 freeall(dimen);
3355 freeall(lambda);
3356 SYM_free(part);
3357 return error("mo.c: internal MO-13");
3358 }
3359 if (!darmat[1])
3360 {
3361 freeall(dimen);
3362 freeall(lambda);
3363 SYM_free(part);
3364 return error("mo.c: internal MO-14");
3365 }
3366 pz=(INT)S_I_I(prime);
3367 gzl=1L;
3368 if ((dim=darmod(part,dim,bz,pz,&gzl,perm,darmat))
3369 <=(INT)0) /* AK 020692 <= statt < */
3370 {
3371 freeall(dimen);
3372 freeall(lambda);
3373 SYM_free(part);
3374 SYM_free(darmat[0]); /* AK 020692 statt free(darmat) */
3375 SYM_free(darmat[1]); /* AK 020692 statt free(darmat) */
3376 fprintf(stderr, "error-no = %" PRIINT "\n" ,dim);
3377 return error("mo.c: internal MO-15");
3378 }
3379 m_ilih_m(dim,dim,dmat);
3380 for (i=(INT)0,dar=darmat[1];i<dim;i++)
3381 /* darmat[1] statt darmat[0] *//* AK 301091 */
3382 for (j=(INT)0;j<(INT)dim;j++)
3383 m_i_i((INT)(*dar++),s_m_ij(dmat,i,j));
3384 freeall(dimen);
3385 freeall(lambda);
3386 SYM_free(part);
3387 SYM_free(darmat[0]);
3388 SYM_free(darmat[1]);
3389 return((INT)dim);
3390 } /* moddg */
3391
3392
3393 /*----------------------------------------------------------------------------*/
decp_mat(sn,prime,dmat)3394 INT decp_mat(sn,prime,dmat) OP sn; OP prime; OP dmat;
3395 /*-----------------------------------------------------------------------------
3396 berechnet zu Sn und einer Primzahl prime die Zerlegungsmatrix dmat.
3397 Variablen: sn, Sn;
3398 prime, Primzahl.
3399 Rueckgabewerte: (INT)0, falls kein Fehler aufgetreten ist;
3400 -1L, falls Fehler aufgetreten ist.
3401 Rueckgabe Zerlegungsmatrix dmat.
3402 -----------------------------------------------------------------------------*/
3403 /* AK 300398 V2.0 */
3404 {
3405 INT TL_n,p,row,col;
3406 TL_BYTE *dec,*d;
3407 INT i,j,erg=OK;
3408
3409 TL_n=(INT)S_I_I(sn);
3410 p=(INT)S_I_I(prime);
3411 if ((col=_num_part(TL_n,p))<(INT)0) return(ERROR);
3412 row=_num_part(TL_n,(INT)0);
3413 dec=(TL_BYTE *)TL_calloc((int)col*(int)row,sizeof(TL_BYTE));
3414 if (!dec) return(ERROR);
3415 if (d_mat(dec,col,row,TL_n,p))
3416 {
3417 SYM_free(dec);
3418 return EDC("decp_mat");
3419 }
3420 m_ilih_m((INT)col,(INT)row,dmat);
3421 for (i=(INT)0,d=dec;i<(INT)row;i++)
3422 for (j=(INT)0;j<(INT)col;j++)
3423 m_i_i((INT)(*d++),S_M_IJ(dmat,i,j));
3424 SYM_free(dec);
3425 return((INT)0);
3426 } /* decp_mat */
3427
3428
3429 /*----------------------------------------------------------------------------*/
homp(transmat,nzykmat,sn,prime,relation)3430 static INT homp(transmat,nzykmat,sn,prime,relation)
3431 OP transmat;
3432 OP nzykmat;
3433 OP sn;
3434 OP prime;
3435 OP relation;
3436 /*------------------------------------------------------------------------------
3437 testet die Darstellung ueber die darstellenden Matrizen einer
3438 Transposition und eines n-Zykels.
3439 Variablen: transmat, darstellende Matrix einer Transposition
3440 (objectkind: MATRIX);
3441 nzykmat, darstellende Matrix eines n-Zykels
3442 (objectkind: MATRIX);
3443 sn, Sn (objectkind: INTEGER);
3444 prime, Primzahl,fuer welche die darstellenden Matrizen
3445 berechnet wurden (objectkind: INTEGER).
3446 Rueckgabewerte: (INT)0, alle Relationen sind erfuellt;
3447 >(INT)0, Relation ... ist nicht erfuellt;
3448 -1L, Fehler aufgetreten.
3449 Rueckgabe relation erhaelt die Nummer der nicht erfuellten Relation
3450 oder 0.
3451 ------------------------------------------------------------------------------*/
3452 {
3453 TL_BYTE *darmat[2],*d[2];
3454 INT dm,i_n,rl,pz;
3455 INT i,j;
3456
3457 if (!S_M_LI(transmat))
3458 {
3459 m_i_i((INT)0,relation);
3460 return((INT)0);
3461 }
3462 dm=(INT)S_M_LI(transmat);
3463 i_n=(INT)S_I_I(sn);
3464 pz=(INT)S_I_I(prime);
3465 darmat[0]=(TL_BYTE *)TL_calloc((int)dm*(int)dm*2,sizeof(TL_BYTE));
3466 if (!darmat[0])
3467 return(-1L);
3468 darmat[1]=darmat[0]+(INT)dm*(INT)dm;
3469 for (i=(INT)0,d[0]=darmat[0],d[1]=darmat[1];i<(INT)dm;i++)
3470 for (j=(INT)0;j<(INT)dm;j++)
3471 {
3472 *d[0]++ =(INT)S_M_IJI(transmat,i,j);
3473 *d[1]++ =(INT)S_M_IJI(nzykmat,i,j);
3474 }
3475 if ((rl=homtestp(darmat,i_n,dm,pz))<(INT)0)
3476 {
3477 SYM_free(darmat[0]);
3478 return(-1L);
3479 }
3480 m_i_i((INT)rl,relation);
3481 SYM_free(darmat[0]);
3482 return((INT)rl);
3483 } /* homp */
3484
3485
3486 /*----------------------------------------------------------------------------*/
brauer_char(sn,prime,bc)3487 INT brauer_char(sn,prime,bc) OP sn,prime,bc;
3488 /*------------------------------------------------------------------------------
3489 berechnet die Charaktertafel der Brauercharaktere der Sn zur Primzahl prime.
3490 Variablen: sn, Sn (objectkind:INTEGER);
3491 prime,Primzahl (objectkind:INTEGER).
3492 Rueckgabewerte: (INT)0, falls fehlerfrei;
3493 -1L, falls Fehler aufgetreten ist.
3494 Rueckgabe der Charaktertafel bc.
3495 ------------------------------------------------------------------------------*/
3496 {
3497 INT _n,p,col,*idx,*idm;
3498 INT i,j,k,erg = OK;
3499 OP tafel,decomp, su, mu, _su;
3500
3501 if (not primep(prime))
3502 return error("brauer_char:second parameter no prime");
3503
3504
3505 _n=(INT)S_I_I(sn);
3506 p=(INT)S_I_I(prime);
3507 if ((col=_num_part(_n,p))<(INT)0)
3508 return(-1L);
3509 idx=(INT *)TL_calloc((int)col*2,sizeof(INT));
3510 if (!idx)
3511 {
3512 return ERROR;
3513 }
3514 idm=idx+(INT)col;
3515 if (_ber_idx_pelem(_n,p,col,idx))
3516 {
3517 SYM_free(idx);
3518 return(-1L);
3519 }
3520
3521 tafel=callocobject();
3522 decomp=callocobject();
3523 su=callocobject();
3524 mu=callocobject();
3525 _su=callocobject();
3526
3527 if (decp_mat(sn,prime,decomp))
3528 {
3529 SYM_free(idx);
3530 freeall(tafel);
3531 freeall(decomp);
3532 freeall(su);
3533 freeall(mu);
3534 freeall(_su);
3535 return(-1L);
3536 }
3537 _ber_inx_dec(decomp,idm);
3538 chartafel(sn,tafel);
3539 m_ilih_m((INT)col,(INT)col,bc);
3540 for (i=(INT)0;i<(INT)col;i++)
3541 for (j=(INT)0;j<(INT)col;j++)
3542 {
3543 copy(S_M_IJ(tafel,(INT)idm[i],(INT)idx[j]),su);
3544 for (k=(INT)0;k<i;k++)
3545 {
3546 erg += mult(S_M_IJ(decomp,(INT)idm[i],k),S_M_IJ(bc,k,j),mu);
3547 erg += addinvers(mu,_su);
3548 erg += add_apply(_su,su);
3549 }
3550 erg += copy(su,S_M_IJ(bc,i,j));
3551 }
3552 SYM_free(idx);
3553 erg += freeall(tafel);
3554 erg += freeall(decomp);
3555 erg += freeall(su);
3556 erg += freeall(_su);
3557 erg += freeall(mu);
3558 ENDR("brauer_char");
3559 } /* brauer_char */
3560 /*
3561 test the functions moddg(...), homp(...), decp_mat(...) and
3562 brauer_char(...).
3563 */
3564
3565
test_mdg()3566 INT test_mdg()
3567 {
3568 OP lambda=callocobject();
3569 OP trans=callocobject();
3570 OP transmat=callocobject();
3571 OP nzyk=callocobject();
3572 OP nzykmat=callocobject();
3573 OP prime=callocobject();
3574 OP sn=callocobject();
3575 OP relation=callocobject();
3576 INT i_n,i,dim;
3577
3578 scan(PARTITION,lambda);
3579 scan(INTEGER,prime);
3580 weight(lambda,sn);
3581 i_n=S_I_I(sn);
3582 init(PERMUTATION,trans);
3583 m_il_v(i_n,S_P_S(trans));
3584 m_i_i(2L,S_P_I(trans,(INT)0));
3585 m_i_i(1L,S_P_I(trans,1L));
3586 for (i=2L;i<i_n;i++) m_i_i(i+1L,S_P_I(trans,i));
3587 println(trans);
3588 if ((dim=moddg(prime,lambda,trans,transmat))<(INT)0)
3589 {
3590 freeall(lambda);
3591 freeall(prime);
3592 freeall(trans);
3593 freeall(transmat);
3594 freeall(nzyk);
3595 freeall(nzykmat);
3596 freeall(sn);
3597 freeall(relation);
3598 return(-1L);
3599 }
3600 println(transmat);
3601 init(PERMUTATION,nzyk);
3602 m_il_v(i_n,S_P_S(nzyk));
3603 for(i=(INT)0;i<i_n-1L;i++) m_i_i(i+2L,S_P_I(nzyk,i));
3604 m_i_i(1L,S_P_I(nzyk,i_n-1L));
3605 println(nzyk);
3606 if ((dim=moddg(prime,lambda,nzyk,nzykmat))<(INT)0)
3607 {
3608 freeall(lambda);
3609 freeall(prime);
3610 freeall(trans);
3611 freeall(transmat);
3612 freeall(nzyk);
3613 freeall(nzykmat);
3614 freeall(sn);
3615 freeall(relation);
3616 return(-1L);
3617 }
3618 println(nzykmat);
3619 if (homp(transmat,nzykmat,sn,prime,relation)<(INT)0)
3620 {
3621 freeall(lambda);
3622 freeall(prime);
3623 freeall(trans);
3624 freeall(transmat);
3625 freeall(nzyk);
3626 freeall(nzykmat);
3627 freeall(sn);
3628 freeall(relation);
3629 return(-1L);
3630 }
3631 println(relation);
3632 freeall(lambda);
3633 freeall(relation);
3634 freeall(trans);
3635 freeall(transmat);
3636 freeall(nzyk);
3637 freeall(nzykmat);
3638 freeall(sn);
3639 freeall(prime);
3640 return OK;
3641 } /* test_mdg */
3642
3643
test_dcp()3644 INT test_dcp()
3645 {
3646 OP prime=callocobject();
3647 OP sn=callocobject();
3648 OP decmat=callocobject();
3649
3650 scan(INTEGER,sn);
3651 scan(INTEGER,prime);
3652 if (decp_mat(sn,prime,decmat))
3653 {
3654 freeall(prime);
3655 freeall(sn);
3656 freeall(decmat);
3657 return(-1L);
3658 }
3659 println(decmat);
3660 freeall(prime);
3661 freeall(sn);
3662 freeall(decmat);
3663 return((INT)0);
3664 } /* test_dcp */
3665
3666
test_brc()3667 INT test_brc()
3668 {
3669 OP prime=callocobject();
3670 OP sn=callocobject();
3671 OP tafel=callocobject();
3672
3673 scan(INTEGER,sn);
3674 scan(INTEGER,prime);
3675 if (brauer_char(sn,prime,tafel))
3676 {
3677 freeall(prime);
3678 freeall(sn);
3679 freeall(tafel);
3680 return(-1L);
3681 }
3682 println(tafel);
3683 freeall(prime);
3684 freeall(sn);
3685 freeall(tafel);
3686 return((INT)0);
3687 } /* test_brc */
3688
3689 /*----------------------------------------------------------------------------*/
_ber_idx_pelem(sn,p,c,idx)3690 static INT _ber_idx_pelem(sn,p,c,idx) INT sn,p,c,*idx;
3691 /*------------------------------------------------------------------------------
3692 berechnet Index eines p-Elements in der Liste der Partitionen der Sn.
3693 Variablen: sn, Sn;
3694 p, Primzahl;
3695 c, Anzahl der p-Elemente.
3696 Rueckgabewerte: (INT)0, kein Fehler aufgetreten;
3697 (INT)-109, nicht genuegend Speicher.
3698 Rueckgabe Indexvektor idx.
3699 ------------------------------------------------------------------------------*/
3700 {
3701 INT i,j,e,d;
3702 TL_BYTE *r,*m;
3703 INT *id;
3704
3705 for (i=(INT)0;i<c;idx[i++]=(INT)0);
3706 r=(TL_BYTE *)TL_calloc((int)(sn+1)*2,sizeof(TL_BYTE));
3707 if (r == NULL) return no_memory();
3708 m=r+sn+1L;
3709 e=1L;
3710 d=(INT)0;
3711 i=(INT)0;
3712 id=idx;
3713 while (e)
3714 {
3715 e=d=_nexpart(sn,d,r,m);
3716 for (j=1L;j<=r[0];j++)
3717 if (!(r[j]%p))
3718 break;
3719 if (j>r[0]) *id++ =i;
3720 i++;
3721 }
3722 SYM_free(r);
3723 return((INT)0);
3724 } /* _ber_idx_pelem */
3725
3726
3727 /*----------------------------------------------------------------------------*/
_ber_inx_dec(dcm,idx)3728 static INT _ber_inx_dec(dcm,idx) OP dcm;
3729 INT *idx;
3730 /*------------------------------------------------------------------------------
3731 berechnet in den Spalten der Zerlegungsmatrix dcm den Zeilenindex des ersten
3732 Elements !=0.
3733 Variablen: dcm, Zerlegungsmatrix;
3734 col, Spaltenanzahl der Zerlegungsmatrix;
3735 row, Zeilenanzahl der Zerlegungsmatrix.
3736 Rueckgabe Indexvektor idx.
3737 ------------------------------------------------------------------------------*/
3738 {
3739 INT i,j,col,row;
3740 INT *id;
3741
3742 col=S_M_LI(dcm);
3743 row=S_M_HI(dcm);
3744 for (i=(INT)0;i<col;idx[i++]=(INT)0);
3745 for (j=(INT)0,id=idx;j<col;j++)
3746 for (i=(INT)0;i<row;i++)
3747 if (!nullp(S_M_IJ(dcm,i,j)))
3748 {
3749
3750 *id++ = (INT)i;
3751 break;
3752 }
3753 return OK;
3754 } /* _ber_idx_dec */
3755
3756 /*******************************************************************************
3757 *
3758 * Datei HOMP.C
3759 * Version vom 29.09.1989
3760 *
3761 *
3762 * Zeile Funktion
3763 *
3764 * Funktion zur Ueberpruefung der Darstellungen
3765 * --------------------------------------------
3766 * 30 INT homtestp(INT **darmat,INT n,INT ddim,INT pz)
3767 *
3768 *******************************************************************************/
3769
3770 /*----------------------------------------------------------------------------*/
homtestp(darmat,n,ddim,pz)3771 static INT homtestp(darmat,n,ddim,pz) TL_BYTE **darmat;
3772 INT n,ddim,pz;
3773 /*------------------------------------------------------------------------------
3774 ueberprueft, ob die im Buch von Carmichael auf Seite 175 (Aufgabe 2)
3775 angegebenen Relationen erfuellt sind, d.h. eine treue Darstellung von Sn
3776 erzeugt wird. Dabei wird ueber GF(pz) gerechnet. Es handelt sich insgesamt
3777 um 4+[n/2] Relationen.
3778 Indexnummern: 1. t^2 = I,
3779 2. s^n = I,
3780 3. (st)^(n-1L) = I,
3781 4. (ts^(-1L)ts)^3 = I,
3782 3+j. (ts^(-j)ts^j)^2 = I fuer j=2L,...,[n/2].
3783 Variablen: darmat, darstellende Matrizen einer Transposition
3784 und eines n-Zykels;
3785 n, Sn;
3786 ddim, Dimension der darstellenden Matrizen;
3787 pz, Primzahl.
3788 Rueckgabewerte: (INT)0, falls alle Relationen erfuellt sind;
3789 index, falls Relation mit Indexnummer index nicht
3790 erfuellt ist;
3791 -14L, falls n kleiner 1 ist;
3792 // -15L, falls n groesser MAXN ist;
3793 -22L, falls Pointer auf darmat NULL ist;
3794 -24L, falls pz keine Primzahl ist;
3795 -25L, falls pz kleiner 1 ist;
3796 -26L, falls pz groesser n ist;
3797 -28L, falls ddim kleiner 0 ist;
3798 -29L, falls ddim groesser MAXDM ist;
3799 (INT)-109, falls nicht genuegend Speicher zu Verfuegung war.
3800 ------------------------------------------------------------------------------*/
3801 /* TL 0790 */ /* AK 210891 V1.3 */
3802 {
3803 TL_BYTE *invzyk,*mat,*mat_eins;
3804 INT k,i,j,az;
3805
3806 if (ddim<(INT)0) return(DDmLt_null);
3807 else if (ddim==(INT)0) return((INT)0);
3808 else if (ddim>MAXDM) return(DDmGMx);
3809 else if (darmat==NULL) return (DrtNul);
3810 else if (n<=(INT)0) return(NLe_null);
3811 /* else if (n>MAXN) return(NGtMax); */
3812 else if (pz<=(INT)0) return(PrmLe_null);
3813 else if (pz>n) return(PrmGtN);
3814 for (i=(INT)0;PZ[i]<=n && PZ[i]<=pz;i++);
3815 if (pz!=PZ[i-1]) return(NoPrm);
3816 /*
3817 Kein Eingabefehler, also koennen wir loslegen:
3818 */
3819 mat=(TL_BYTE *)TL_calloc((int)ddim*(int)ddim*3,sizeof(TL_BYTE));
3820 if (!mat)
3821 return no_memory();
3822 mat_eins= &mat[(INT)ddim*(INT)ddim];
3823 invzyk= &mat_eins[(INT)ddim*(INT)ddim];
3824 matcopy(mat,darmat[0],ddim);
3825 if (rmatmulp(mat,darmat[0],ddim,pz)<(INT)0)
3826 {
3827 SYM_free(mat);
3828 return no_memory();
3829 }
3830 if (!idmat(mat,ddim)) /* t^2 = 1 ? */
3831 {
3832 SYM_free(mat);
3833 return(1L);
3834 }
3835 matcopy(mat,darmat[1],ddim);
3836 rmatmulp(mat,darmat[0],ddim,pz);
3837 matcopy(mat_eins,mat,ddim);
3838 az=1L;
3839 while (2L*az <= (n-1L))
3840 {
3841 matcopy(invzyk,mat_eins,ddim);
3842 rmatmulp(mat_eins,invzyk,ddim,pz);
3843 az *= 2L;
3844 }
3845 for (i=az+2L; i<= n; i++)
3846 rmatmulp(mat_eins,mat,ddim,pz);
3847 if (!idmat(mat_eins,ddim)) /* (s * t) ^ (n-1L) =1 ? */
3848 {
3849 SYM_free(mat);
3850 return(3L);
3851 }
3852 matcopy(mat,darmat[1],ddim);
3853 az=1L;
3854 while (2L*az <= n-1L)
3855 {
3856 matcopy(mat_eins,mat,ddim);
3857 rmatmulp(mat,mat_eins,ddim,pz);
3858 az*=2L;
3859 }
3860 for (i=az+2L;i<=n;++i)
3861 rmatmulp(mat,darmat[1],ddim,pz);
3862 matcopy(invzyk,mat,ddim); /* s^(-1L) = s^(n-1L) */
3863 rmatmulp(mat,darmat[1],ddim,pz);
3864 if (!idmat(mat,ddim)) /* s^n = 1 ? */
3865 {
3866 SYM_free(mat);
3867 return(2L);
3868 }
3869 matcopy(mat,darmat[0],ddim);
3870 rmatmulp(mat,invzyk,ddim,pz);
3871 rmatmulp(mat,darmat[0],ddim,pz);
3872 rmatmulp(mat,darmat[1],ddim,pz);
3873 matcopy(mat_eins,mat,ddim);
3874 rmatmulp(mat_eins,mat,ddim,pz);
3875 rmatmulp(mat_eins,mat,ddim,pz);
3876 if (!idmat(mat_eins,ddim)) /* (t * s^(-1L) * t * s) ^ 3 = 1 ? */
3877 {
3878 SYM_free(mat);
3879 return(4L);
3880 }
3881 k=n/2L;
3882 for (j=2L; j<=k; j++)
3883 {
3884 rmatmulp(mat,darmat[1],ddim,pz); /* in mat ist noch t*s^1*t*s */
3885 lmatmulp(darmat[0],mat,ddim,pz);
3886 lmatmulp(invzyk,mat,ddim,pz);
3887 lmatmulp(darmat[0],mat,ddim,pz);
3888 matcopy(mat_eins,mat,ddim);
3889 rmatmulp(mat_eins,mat,ddim,pz);
3890 if (!idmat(mat_eins,ddim)) /* (t*s^(-j)*t*s^j)^2 = 1 fuer j=2L,...k ? */
3891 {
3892 SYM_free(mat);
3893 return(j+3L);
3894 }
3895 }
3896 SYM_free(mat);
3897 return((INT)0);
3898 } /*homtestp */
3899 /*******************************************************************************
3900 *
3901 * Datei MODMAT.C
3902 * Version vom 11.10.1989
3903 *
3904 *
3905 * Zeile Funktion
3906 *
3907 * Funktionen fuer Matrixoperationen
3908 * ---------------------------------
3909 * 39 INT matcopy(TL_BYTE *ziel,TL_BYTE *quelle,INT dim)
3910 * 59 INT rmatmulp(TL_BYTE *lmat,TL_BYTE *rmat,INT pdim,INT pz)
3911 * 102 INT lmatmulp(TL_BYTE *lmat,TL_BYTE *rmat,INT pdim,INT pz)
3912 * 152 INT idmat(TL_BYTE *z,INT dm)
3913 *
3914 *******************************************************************************/
3915 /*
3916 Uebliche Headerfiles...
3917 */
3918
3919
3920
3921 /*----------------------------------------------------------------------------*/
rmatmulp(lmat,rmat,pdim,pz)3922 static INT rmatmulp(lmat,rmat,pdim,pz) INT pz, pdim;
3923 TL_BYTE *lmat, *rmat;
3924 /*-----------------------------------------------------------------------------
3925 multipliziert die (pdim x pdim)-Matrix lmat von rechts mit der
3926 (pdim x pdim)-Matrix rmat. Dabei werden Multiplikationen und Additionen
3927 modulo pz ausgefuehrt.
3928 Variablen: lmat, Matrix;
3929 rmat, Matrix;
3930 pdim, Dimension der Matrizen;
3931 pz, Primzahl.
3932 Rueckgabe Ergebnismatrix lmat.
3933 Ruechgabewerte: (INT)0, falls alles geklappt hat;
3934 (INT)-109, falls der noetige Speicher nicht vorhanden war.
3935 ------------------------------------------------------------------------------*/
3936 /* TL 0790 */ /* AK 210891 V1.3 */
3937 {
3938 INT h,i,j,k,o_eins,o_zwei;
3939 TL_BYTE *aa,*bb,*hilf,*aa_eins;
3940
3941 hilf=(TL_BYTE *)TL_calloc((int)pdim,sizeof(TL_BYTE));
3942 if (hilf == NULL) return no_memory();
3943 aa_eins=lmat;
3944 for (i=(INT)0 ; i < pdim; ++i)
3945 {
3946 for (j=(INT)0 ; j < pdim; ++j)
3947 {
3948 h=(INT)0;
3949 bb= &rmat[(INT)j];
3950 aa=aa_eins;
3951 for (k=(INT)0; k<pdim; k++,bb+=(INT)pdim)
3952 {
3953 if ((o_eins= *aa++)==(INT)0) continue;
3954 if ((o_zwei= *bb)==(INT)0) continue;
3955 h=TL_ADP(h,TL_MULP(o_eins,o_zwei,pz),pz);
3956 }
3957 hilf[j]=h;
3958 }
3959 for (j=(INT)0; j < pdim; ++j) *aa_eins++=hilf[j];
3960 }
3961 SYM_free(hilf);
3962 return((INT)0);
3963 } /* rmatmulp */
3964
3965
3966 /*----------------------------------------------------------------------------*/
lmatmulp(lmat,rmat,pdim,pz)3967 static INT lmatmulp(lmat,rmat,pdim,pz) TL_BYTE *lmat, *rmat;
3968 INT pz, pdim;
3969 /*------------------------------------------------------------------------------
3970 multipliziert die (pdim x pdim)-Matrix rmat von links mit der
3971 (pdim x pdim)-Matrix lmat. Dabei werden Multiplikationen und Additionen
3972 modulo pz ausgefuehrt.
3973 Variablen: lmat, Matrix;
3974 rmat, Matrix;
3975 pdim, Dimension der Matrizen;
3976 pz, Primzahl.
3977 Rueckgabe Ergebnismatrix rmat.
3978 Rueckgabewerte: (INT)0, falls kein Fehler aufgetreten ist;
3979 (INT)-109, falls kein Speicher zu Verfuegung stand.
3980 ------------------------------------------------------------------------------*/
3981 /* TL 0790 */ /* AK 210891 V1.3 */
3982 {
3983 INT h,i,j,k;
3984 TL_BYTE *hilf,*_a,*_b;
3985 INT o_eins,o_zwei;
3986
3987 hilf=(TL_BYTE *)TL_calloc((int)pdim,sizeof(TL_BYTE));
3988 if (hilf==NULL) no_memory();
3989
3990 for (j=(INT)0 ;j < pdim; ++j)
3991 {
3992 _a=lmat;
3993 for (i=(INT)0 ; i < pdim; ++i)
3994 {
3995 _b=rmat+j;
3996 h=(INT)0;
3997 for (k=(INT)0 ; k < pdim; k++,_b+=pdim)
3998 {
3999 if ((o_eins= *_a++)==(INT)0) continue;
4000 if ((o_zwei= *_b)==(INT)0) continue;
4001 h=TL_ADP(h,TL_MULP(o_eins,o_zwei,pz),pz);
4002 }
4003 hilf[i]=h;
4004 }
4005 _b=rmat+j;
4006 for (i=(INT)0; i < pdim; ++i)
4007 {
4008 *_b=hilf[(INT)i];
4009 _b+=pdim;
4010 }
4011 }
4012 SYM_free(hilf);
4013 return((INT)0);
4014 } /* lmatmulp */
4015
4016
4017 /*----------------------------------------------------------------------------*/
idmat(z,dm)4018 static INT idmat(z,dm) TL_BYTE *z;
4019 INT dm;
4020 /*------------------------------------------------------------------------------
4021 testet die (dm x dm)-Matrix z, ob sie die Einheitsmatrix ist.
4022 Variablen: z, Matrix;
4023 dm, Dimension der Matrix.
4024 Rueckgabewerte: TRUE, falls z Einheitsmatrix ist;
4025 FALSE, falls z keine Einheitsmatrix ist.
4026 ------------------------------------------------------------------------------*/
4027 /* TL 0790 */ /* AK 210891 V1.3 */
4028 {
4029 INT i,j,o_eins;
4030 TL_BYTE *zz;
4031
4032 zz=z;
4033 for (i=(INT)0; i<dm; ++i)
4034 for (j=(INT)0; j<dm; ++j)
4035 {
4036 o_eins= *zz++;
4037 if (i==j)
4038 {
4039 if (o_eins!=1L) return(FALSE);
4040 }
4041 else
4042 {
4043 if (o_eins) return(FALSE);
4044 }
4045 }
4046 return(TRUE);
4047 } /* idmat */
4048 /*******************************************************************************
4049 *
4050 * Datei MODULDG.C
4051 * Version vom 29.09.1989
4052 *
4053 *
4054 * Zeile Funktion
4055 *
4056 * Funktionen zur Berechnung der gew./p-mod. irred. Darst.
4057 * -------------------------------------------------------
4058 * 75 INT moddreimat(TL_BYTE *hz,INT pz,INT mode)
4059 * 126 INT _modgauss(TL_BYTE *hz,INT pz,INT i,INT mode)
4060 *
4061 * Funktionen zur Berechnung der gew. irred. Darstellungen
4062 * -------------------------------------------------------
4063 * 160 INT r_modgauss(TL_BYTE *hz,INT pz)
4064 * 181 INT ganzgaussmod(TL_BYTE *bz,TL_BYTE *hz)
4065 *
4066 * Funktionen zur Berechnung der p-mod. irred. Darstellungen
4067 * ---------------------------------------------------------
4068 * 269 INT modmat(TL_BYTE *hz,INT pr)
4069 * 290 INT modgauss(TL_BYTE *hz,TL_BYTE *v,INT pr)
4070 * 363 p_rel(TL_BYTE *hz,TL_BYTE *v,INT pr)
4071 * 392 zykel(INT *liste,INT *zyk)
4072 * 439 INT p_writemat(INT *hz,INT *v,INT *lambda,INT pr,INT *perm,INT **darmat,
4073 * INT prang)
4074 * 521 INT TL_darmod(TL_BYTE *hz,TL_BYTE *lambda,INT pr,TL_BYTE *perm,TL_BYTE **darmat)
4075 *
4076 * Hauptfunktion
4077 * -------------
4078 * 563 INT darmod(TL_BYTE *lambda,INT dim,TL_BYTE *bz,INT pz,INT *gzl,TL_BYTE *perm,
4079 * TL_BYTE **darmat)
4080 *
4081 *******************************************************************************/
4082 /*
4083 Uebliche Headerfiles,...
4084 */
4085
4086 /* #define IND(a,b,c) (INT)((INT)(a)*(INT)(c)+(INT)(b)) */
4087
4088
4089 /*
4090 und globale Variablen.
4091 */
4092 static INT _dm;
4093 static INT _dm_zwei;
4094 static INT _dm_drei;
4095
4096
4097 /*******************************************************************************
4098 *
4099 * Funktionen fuer die Bestimmung gew./p-mod. irred. Darstellungen...
4100 *
4101 *******************************************************************************/
4102
4103
4104 /*----------------------------------------------------------------------------*/
moddreimat(hz,pz,mode)4105 static INT moddreimat(hz,pz,mode) INT mode,pz;
4106 TL_BYTE *hz;
4107 /*------------------------------------------------------------------------------
4108 mode=1:
4109 bringt die erste (_dm x _dm)-Teilmatrix von hz mit Hilfe des Gaussalgorith-
4110 mus ueber GF(pz) auf obere Dreiecksform mit 1 oder 0 auf der Hauptdiago-
4111 nalen,
4112 mode=3:
4113 wendet auf das (_dm x 3_dm)-Gleichungsschema hz den Gaussalgorithmus ueber
4114 GF(pz) an, bis die erste der drei (_dm x _dm)-Teilmatrizen eine obere Drei-
4115 ecksmatrix mit 1 oder 0 auf der Hauptdiagonalen ist.
4116 (Simultanes Loesen von 2_dm linearen Gleichungssystemen.)
4117 Variablen: hz, Matrix mit Basis und Darstellungen;
4118 pz, Primzahl;
4119 mode, s.o.
4120 Rueckgabe Matrix hz.
4121 ------------------------------------------------------------------------------*/
4122 /* TL 0790 */ /* AK 210891 V1.3 */
4123 {
4124 TL_BYTE *_hz,*jz,*z_eins,*z_zwei,qu,mu;
4125 INT i,j,k,mdm;
4126
4127 mdm=mode*_dm;
4128 for (i=(INT)0,_hz=hz;i<_dm;i++,_hz += (_dm_drei+1L))
4129 {
4130 for (k=i+1L,jz=_hz+_dm_drei;!*_hz && k<_dm;k++,jz += _dm_drei)
4131 if (*jz)
4132 for (j=mdm,z_eins=jz,z_zwei=_hz;j>i;j--)
4133 {
4134 mu= *z_zwei;
4135 *z_zwei++ = *z_eins;
4136 *z_eins++ = mu;
4137 }
4138 if (*_hz)
4139 {
4140 if ((qu= *_hz)!=1L)
4141 for (j=mdm,z_eins=_hz;j>i;j--,z_eins++)
4142 {
4143 if (*z_eins)
4144 *z_eins=TL_DIVP(*z_eins,qu,pz);
4145 }
4146 if (i<_dm-1L)
4147 for (k=i+1L,jz=_hz+_dm_drei;k<_dm;k++,jz += _dm_drei)
4148 if ((qu= *jz)!=(INT)0)
4149 for (j=mdm,z_eins=jz,z_zwei=_hz;j>i;j--,z_eins++,z_zwei++)
4150 if (*z_zwei)
4151 {
4152 /*
4153 mu=(-1L)*(TL_MULP(qu,*z_zwei,pz));
4154 *z_eins=TL_ADP(*z_eins,mu,pz);
4155 */
4156
4157 *z_eins = TL_MOD((-1 * qu * *z_zwei) + *z_eins, pz);
4158
4159 }
4160 }
4161 }
4162 return OK;
4163 } /* moddreimat */
4164
4165
4166 /*----------------------------------------------------------------------------*/
_modgauss(hz,pz,i,mode)4167 static INT _modgauss(hz,pz,i,mode) INT pz,i,mode;
4168 TL_BYTE *hz;
4169 /*------------------------------------------------------------------------------
4170 wird benoetigt fuer die Funktionen modgauss und r_modgauss.
4171 Variablen: hz, Matrix mit Basis und Darstellungen;
4172 pz, Primzahl;
4173 i, Anfangswert der Schleife;
4174 mode, =1L, fuer modgauss,
4175 =3L, fuer r_modgauss;
4176 Rueckgabe Matrix hz.
4177 ------------------------------------------------------------------------------*/
4178 /* TL 0790 */ /* AK 210891 V1.3 */
4179 {
4180 TL_BYTE mu,qu,*_hz,*jz,*z_eins,*z_zwei;
4181 INT j,k,mdm;
4182
4183 mdm=mode*_dm;
4184 for (j=i-1L,_hz= &hz[IND(i,i,_dm_drei)],jz=_hz-_dm_drei;j>=(INT)0;j--,jz -= _dm_drei)
4185 if ((qu= *jz)!=(TL_BYTE)0)
4186 for (k=mdm,z_eins=_hz,z_zwei=jz;k>i;k--,z_zwei++,z_eins++)
4187 if (*z_eins)
4188 {
4189 mu=(TL_BYTE) (-1L)*(TL_MULP(qu,*z_eins,pz));
4190 *z_zwei= TL_ADP(*z_zwei,mu,pz);
4191 }
4192 return OK;
4193 } /* _modgauss */
4194
4195
4196 /*******************************************************************************
4197 *
4198 * Funktionen zur Bestimmung der gew. irred. Darstellungen...
4199 *
4200 *******************************************************************************/
4201
4202
4203 /*----------------------------------------------------------------------------*/
r_modgauss(hz,pz)4204 static INT r_modgauss(hz,pz) TL_BYTE *hz;
4205 INT pz;
4206 /*------------------------------------------------------------------------------
4207 wendet den Gaussalgorithmus ueber GF(pz) auf das (_dm x 3_dm)-Koeffizienten-
4208 schema an, wobei die erste (_dm x _dm)-Teilmatrix eine obere Dreiecksmatrix
4209 mit 0 oder 1 auf der Hauptdiagonalen sein muss.
4210 (Simultanes Loesen von 2_dm linearen Gleichungssystemen.)
4211 Variablen: hz, Matrix mit Basis und Darstellungen;
4212 pz, Primzahl.
4213 Rueckgabe Matrix hz.
4214 ------------------------------------------------------------------------------*/
4215 /* TL 0790 */ /* AK 210891 V1.3 */
4216 {
4217 TL_BYTE *_hz;
4218 INT i;
4219
4220 for (i=_dm-1L,_hz= &hz[IND(_dm-1L,_dm-1L,_dm_drei)];i>(INT)0;i--,_hz -= (_dm_drei+1L))
4221 if (*_hz)
4222 _modgauss(hz,pz,i,3L);
4223 return OK;
4224 } /* r_modgauss */
4225
4226
4227 /*----------------------------------------------------------------------------*/
ganzgaussmod(bz,hz)4228 static INT ganzgaussmod(bz,hz) TL_BYTE *hz, *bz;
4229 /*------------------------------------------------------------------------------
4230 loest simultan die in dem (_dm x 3_dm)-Koeffizientenschema bz kodierten 2_dm
4231 linearen Gleichungssysteme. Am Ende stehen die Loesungen fuer die gew.
4232 irred. Darstellungen in den letzten 2_dm Spalten von bz.
4233 Koennen keine ganzz. Loesungen errechnet werden, wird die Berechnung abge-
4234 brochen.
4235 Variablen: bz, Matrix aus alkonmat;
4236 hz, Matrix wie bz.
4237 Rueckgabe Matrix hz mit Basis und Matrizen der gewoehnlichen Darstellungen.
4238 Rueckgabewerte: (INT)0, falls alles geglueckt ist;
4239 -27L, falls keine ganzzahlige Loesung existiert.
4240 ------------------------------------------------------------------------------*/
4241 /* TL 0790 */ /* AK 210891 V1.3 */
4242 {
4243 TL_BYTE *_hz,*_bz,*z_eins,*z_zwei,*z_drei;
4244 INT i,j,k,pz,su;
4245 INT il,cl;
4246 INT chance;
4247
4248 pz=(INT)29;
4249 chance=TRUE;
4250 while (chance)
4251 {
4252 /*
4253 Interpretation von bz ueber GF(pz) und Uebergabe an hz
4254 */
4255 for (il=(INT)_dm*(INT)_dm_drei,_hz=hz,_bz=bz;il>(INT)0;il--,_hz++,_bz++)
4256 if (*_bz)
4257 *_hz = (TL_BYTE) TL_MOD(*_bz,pz);
4258 else
4259 *_hz = (TL_BYTE) 0;
4260 /*
4261 Anwendung des Gaussalgorithmus ueber GF(pz)
4262 */
4263 moddreimat(hz,pz,3L);
4264 r_modgauss(hz,pz);
4265 /*
4266 Rekonstruktion der ganzzahligen Loesungen
4267 */
4268 for (i=(INT)0,_hz=hz+_dm;i<_dm;i++,_hz += _dm_drei)
4269 for (j=_dm,z_eins=_hz;j<_dm_drei;j++,z_eins++)
4270 if (*z_eins)
4271 {
4272 if ((*z_eins + *z_eins) > pz)
4273 *z_eins -= pz;
4274 }
4275 /*
4276 Verifikation der Loesungen: Die Koeffizientenmatrix der Gleichungssysteme
4277 (die ersten _dm Spalten von bz) wird mit der Loesungsmatrix (die letzten
4278 2_dm Spalten von hz) multipliziert. Jeder Eintrag der Produktmatrix wird
4279 unmittelbar nach seiner Berechnung mit dem entsprechenden Eintrag in den
4280 letzten 2_dm Spalten von bz verglichen.
4281 cl gibt die Anzahl der Uebereinstimmungen an.
4282 */
4283 for(i=(INT)0,cl=(INT)0,_bz=bz;i<_dm;i++,_bz += _dm_drei)
4284 for (j=_dm,z_eins=_bz+_dm,_hz=hz+_dm;j<_dm_drei;j++,z_eins++,_hz++)
4285 {
4286 for (k=(INT)0,su=(INT)0,z_zwei=_hz,z_drei=_bz;k<_dm;k++,z_drei++,z_zwei +=_dm_drei)
4287 {
4288 if (! *z_zwei) continue;
4289 if (! *z_drei) continue;
4290 su += (*z_zwei * *z_drei);
4291 }
4292 if (su == *z_eins)
4293 ++cl;
4294 }
4295 if (cl==((INT)_dm_zwei*(INT)_dm))
4296 chance=FALSE;
4297 else
4298 {
4299 if (pz==(INT)211)
4300 {
4301 error("internal error: MO_50");
4302 return(NoSolu);
4303 }
4304 pz=(INT)211;
4305 chance=TRUE;
4306 }
4307 }
4308 return((INT)0);
4309 } /* ganzgaussmod */
4310
4311
4312 /*******************************************************************************
4313 *
4314 * Funktionen zur Bestimmung der p-mod. irred. Darstellungen...
4315 *
4316 *******************************************************************************/
4317
4318
4319 /*----------------------------------------------------------------------------*/
modmat(hz,pr)4320 static INT modmat(hz,pr) TL_BYTE *hz;
4321 INT pr;
4322 /*------------------------------------------------------------------------------
4323 transformiert die (_dm x 3_dm)-Matrix hz nach (hz mod pr).
4324 Variablen: hz, Matrix mit Basis und Darstellungen;
4325 pr, Primzahl.
4326 Rueckgabe Matrix hz gerechnet modulo pr.
4327 ------------------------------------------------------------------------------*/
4328 /* TL 0790 */ /* AK 210891 V1.3 */
4329 {
4330 TL_BYTE *_hz;
4331 INT il;
4332
4333 for (il=(INT)_dm*(INT)_dm_drei,_hz=hz;il>(INT)0;il--,_hz++)
4334 if (*_hz)
4335 *_hz=(TL_BYTE)TL_MOD(*_hz,pr);
4336 else
4337 *_hz=(TL_BYTE)0;
4338 return OK;
4339 } /* modmat */
4340
4341
4342 /*----------------------------------------------------------------------------*/
modgauss(hz,v,pr)4343 static INT modgauss(hz,v,pr) TL_BYTE *hz, *v;
4344 INT pr;
4345 /*------------------------------------------------------------------------------
4346 berechnet mit Hilfe des Gaussalgorithmus ueber GF(pr) die Dimension der
4347 p-mod. irred. Darstellung. Der Gaussalgorithmus wird dabei auf die erste
4348 (_dm x _dm)-Teilmatrix von hz angewendet, wobei diese eine obere Dreiecks-
4349 matrix mit 0 oder 1 auf der Hauptdiagonalen sein muss.
4350 Variablen: hz, Matrix mit Basis und Darstellungen;
4351 pr, Primzahl.
4352 Rueckgabe Nummernvektor v der abhaengigen Spalten in hz.
4353 Rueckgabewerte: prang, Dimension der p-modular irreduziblen Darstellung.
4354 ------------------------------------------------------------------------------*/
4355 /* TL 0790 */ /* AK 210891 V1.3 */
4356 {
4357 TL_BYTE *_hz,*z_eins,*z_zwei,*_v,qu,su;
4358 INT z,i,j,k,prang;
4359
4360 prang=(INT)0;
4361 for (i=(INT)0;i<_dm;v[i++]=(TL_BYTE)0);
4362
4363 for (i=_dm-1L,_hz= &hz[IND(_dm-1L,_dm-1L,_dm_drei)],_v= &v[_dm-1];i>(INT)0;
4364 i--,_hz -= (_dm_drei+1L),_v--)
4365 if (*_hz)
4366 {
4367 if ((qu = *_hz)!=(TL_BYTE)1)
4368 for (k=i,z_eins=_hz;k<_dm;k++,z_eins++)
4369 if (*z_eins)
4370 *z_eins= TL_DIVP(*z_eins,qu,pr);
4371 _modgauss(hz,pr,i,1L);
4372 }
4373 else
4374 {
4375 *_v = (TL_BYTE)i+1;
4376 ++prang;
4377 }
4378 if (hz[0]!=(TL_BYTE)1)
4379 {
4380 if ((qu=hz[0])==(TL_BYTE)0)
4381 {
4382 v[0]=(TL_BYTE)1;
4383 ++prang;
4384 }
4385 else
4386 for (j=(INT)0,_hz=hz;j<_dm;j++,_hz++)
4387 if (*_hz)
4388 *_hz = TL_DIVP(*_hz,qu,pr);
4389 }
4390 prang=_dm-prang;
4391
4392
4393 for (i=_dm-2L,_v= &v[_dm-2],_hz= &hz[IND(_dm-2L,_dm-1L,_dm_drei)];i>=(INT)0;
4394 i--,_v--,_hz -= (_dm_drei+1L))
4395 if (*_v == (TL_BYTE) i+1)
4396 {
4397 for (j=i+1L,su=(TL_BYTE)0,z_eins=_hz;!su && j<_dm;j++,z_eins++)
4398 if (*z_eins)
4399 su=(TL_BYTE)j;
4400 if (su)
4401 {
4402 v[su]=(TL_BYTE)0;
4403 z_eins= &hz[IND(i,su,_dm_drei)];
4404 z_zwei= &hz[IND(su,su,_dm_drei)];
4405 for (j=su;j<_dm;++j)
4406 {
4407 z= *z_eins;
4408 *z_eins++ = *z_zwei;
4409 *z_zwei++ = z;
4410 }
4411 }
4412 _modgauss(hz,pr,su,1L);
4413 }
4414 return(prang);
4415 } /* modgauss */
4416
4417
4418 /*----------------------------------------------------------------------------*/
p_rel(hz,v,pr)4419 static INT p_rel(hz,v,pr) TL_BYTE *hz, *v;
4420 INT pr;
4421 /*------------------------------------------------------------------------------
4422 Simultane Ermittlung und Anwendung der p-Relationen.
4423 (Lineare Algebra!)
4424 Variablen: v, Nummern der abhaengigen Spalten in hz;
4425 pr, Primzahl;
4426 hz, Matrix mit Basis und Darstellungen.
4427 Rueckgabe Matrix hz.
4428 ------------------------------------------------------------------------------*/
4429 /* TL 0790 */ /* AK 210891 V1.3 */
4430 {
4431 TL_BYTE *_v,*_hz,*z_eins,*z_zwei,*z_drei,*z_vier,mu,su;
4432 INT i,j,k;
4433
4434 for (i=(INT)0,_v=v,_hz=hz;i<_dm;i++,_v++,_hz += _dm_drei)
4435 if (*_v == i+1L)
4436 for (j=(INT)0,z_eins=_hz+_dm,z_zwei=hz+_dm;j<_dm_zwei;j++,z_eins++,z_zwei++)
4437 if ((mu= *z_eins)!=(TL_BYTE)0)
4438 for (k=(INT)0,z_drei=hz+i,z_vier=z_zwei;k<=i-1L;k++,z_drei += _dm_drei,z_vier +=
4439 _dm_drei)
4440 if (*z_drei != (TL_BYTE)0)
4441 {
4442 su= TL_MULP(mu,*z_drei,pr);
4443 *z_vier=TL_ADP(su,*z_vier,pr);
4444 }
4445 return OK;
4446 } /* p_rel */
4447
4448
4449 /*----------------------------------------------------------------------------*/
zykel(liste,zyk)4450 static INT zykel(liste,zyk) TL_BYTE *liste, *zyk;
4451 /*------------------------------------------------------------------------------
4452 berechnet die Zykelschreibweise einer Permutation liste aus ihrer Listen-
4453 schreibweise. Dabei steht eine negative Zahl immer als Ende des Zykels.
4454 Variablen: liste, Pointer auf die Permutation in Listenschreibweise.
4455 Rueckgabe Permutation zyk in Zykelschreibweise.
4456 Rueckgabewerte: (INT)0, falls kein Fehler aufgetreten ist;
4457 (INT)-109, falls nicht genuegend Speicher vorhanden war.
4458 ------------------------------------------------------------------------------*/
4459 /* TL 0790 */ /* AK 210891 V1.3 */
4460 {
4461 TL_BYTE *z;
4462 INT merk,merk_eins,i,j,n;
4463 INT fertig;
4464 TL_BYTE *besucht;
4465
4466 for (n=(INT)0;liste[n];n++);
4467 if ((besucht=(TL_BYTE *)TL_calloc((int)n,sizeof(TL_BYTE)))==NULL)
4468 return no_memory();
4469 z=zyk;
4470 i=(INT)0;
4471 *z++ =(TL_BYTE)(merk=merk_eins=1L);
4472 fertig=FALSE;
4473 do
4474 {
4475 besucht[i]=(TL_BYTE)1;
4476 if (liste[i]==merk_eins)
4477 {
4478 z--;
4479 *z++ = -merk;
4480 for (j=(INT)0;j<n && besucht[j] && liste[j];j++);
4481 i=j;
4482 if (i>=n || !liste[i])
4483 fertig=TRUE;
4484 else
4485 *z++ =(TL_BYTE)(merk=merk_eins=i+1L);
4486 }
4487 else
4488 {
4489 merk= *z++ =(TL_BYTE)liste[i];
4490 i=liste[i]-1L;
4491 }
4492 } while (!fertig && i<n && liste[i]);
4493 return((INT)0);
4494 } /* zykel */
4495
4496
4497 /*----------------------------------------------------------------------------*/
p_writemat(hz,v,lambda,pr,perm,darmat,prang)4498 static INT p_writemat(hz,v,lambda,pr,perm,darmat,prang)
4499 INT prang,pr;
4500 TL_BYTE *hz,*v,*lambda, *perm, **darmat;
4501 /*------------------------------------------------------------------------------
4502 schreibt die in darmod berechneten Matrizen unter Beruecksichtigung der
4503 pr-Relationen auf stream. In darmat stehen die Darstellungsmatrizen, falls
4504 sie mindestens eine Spalte und eine Zeile enthalten.
4505 Rueckgabe Darstellungsmatrizen darmat.
4506 Rueckgabewerte: (INT)0, falls alles ohne Fehler durchgefuehrt wurde;
4507 (INT)-109, falls nicht genuegend Speicherplatz vorhanden ist.
4508 ------------------------------------------------------------------------------*/
4509 /* TL 0790 */ /* AK 210891 V1.3 */
4510 {
4511 TL_BYTE *dar,*_hz,*vi,*vj,*z_eins,*z_zwei,*z;
4512 INT i,j,n;
4513 INT q,klam;
4514
4515 if (prang)
4516 {
4517 for (n=(INT)0;perm[n];n++);
4518 n++;
4519 #ifdef UNDEF
4520 if (stream && prang<85L)
4521 {
4522 if ((z=(TL_BYTE *)TL_calloc((int)n,sizeof(TL_BYTE)))==NULL)
4523 return no_memory();
4524 if (zykel(perm,z))
4525 return no_memory();
4526 }
4527 #endif
4528 for (q=(INT)0,_hz=hz+_dm;q<2L;q++,_hz += _dm)
4529 {
4530 for (i=(INT)0,vi=v,z_eins=_hz,dar=darmat[q];i<_dm;i++,vi++,z_eins += _dm_drei)
4531 if (! *vi)
4532 for (j=(INT)0,vj=v,z_zwei=z_eins;j<_dm;j++,vj++,z_zwei++)
4533 if (! *vj)
4534 *dar++ = *z_zwei;
4535 #ifdef UNDEF
4536 if (stream && prang<85L)
4537 {
4538
4539 fprintf(stream,"D(%d/(%d",pr,lambda[0]);
4540 for (i=1L;i<n && lambda[i];++i)
4541 fprintf(stream,",%d",lambda[i]);
4542 switch ((int)q)
4543 {
4544 case (INT)0:
4545 fprintf(stream,")/(1 2L))");
4546 break;
4547 case 1L:
4548 fprintf(stream,")/(");
4549 klam=1L;
4550 for (i=(INT)0;i<n && z[i];i++)
4551 {
4552 if (!klam)
4553 {
4554 fprintf(stream,"(");
4555 klam = 1-klam;
4556 }
4557 if (z[i]>(TL_BYTE)0)
4558 fprintf(stream,"%d ",z[i]);
4559 else
4560 {
4561 fprintf(stream,"%d)",-z[i]);
4562 klam=1-klam;
4563 }
4564 }
4565 fprintf(stream,")");
4566 break;
4567 }
4568 fprintf(stream,"\n");
4569 for (i=prang*prang,dar=darmat[q];i>(INT)0;i--,dar++)
4570 {
4571 if (!(i%prang)) fprintf(stream,"\n");
4572 fprintf(stream,"%3d",*dar);
4573 }
4574 fprintf(stream,"\n\n\n");
4575 SYM_free(z);
4576 }
4577 #endif
4578 }
4579 }
4580 return((INT)0);
4581 } /* p_writemat */
4582
4583 /*----------------------------------------------------------------------------*/
TL_darmod(hz,lambda,pr,perm,darmat)4584 static INT TL_darmod(hz,lambda,pr,perm,darmat)
4585 TL_BYTE *perm,*hz, *lambda, **darmat;
4586 INT pr;
4587 /*------------------------------------------------------------------------------
4588 berechnet die pr-modular irreduziblen Darstellungsmatrizen fuer zwei Permu-
4589 tationen. Dazu muessen die Spalten der ersten (_dm x _dm)-Teilmatrix von hz
4590 die zugrunde gelegte Basis kodieren sowie die naechsten beiden (_dm x _dm)-
4591 Teilmatrizen von hz die zugehoerigen gewoehnlichen darstellenden Matrizen
4592 sein. (_dm ist die gewoehnliche Dimension der Darstellung.)
4593 Variablen: hz, Matrix mit der zugrunde gelegten Basis und die zugehoerigen
4594 gewoehnlichen Darstellungsmatrizen;
4595 lambda, Partition;
4596 pr, Primzahl;
4597 perm, Permutation.
4598 Rueckgabe Matrizen darmat der p-modular irreduziblen Darstellungen.
4599 Rueckgabewerte: prang, Dimension der p-modular irreduziblen Darstellungen;
4600 (INT)-109, falls nicht genuegend Speicher vorhanden war.
4601 ------------------------------------------------------------------------------*/
4602 /* TL 0790 */ /* AK 210891 V1.3 */
4603 {
4604 TL_BYTE *v;
4605 INT prang;
4606
4607 if ((v=(TL_BYTE *)TL_calloc((int)_dm,sizeof(TL_BYTE)))==NULL)
4608 return no_memory();
4609 modmat(hz,pr);
4610 moddreimat(hz,pr,1L);
4611 prang=modgauss(hz,v,pr);
4612 p_rel(hz,v,pr);
4613 if (p_writemat(hz,v,lambda,pr,perm,darmat,prang))
4614 return no_memory();
4615 SYM_free(v);
4616 return(prang);
4617 } /* TL_darmod */
4618
4619
4620 /*******************************************************************************
4621 *
4622 * Hauptfunktion zur Berechnung der p-mod. irred. Darstellungen...
4623 *
4624 *******************************************************************************/
4625
4626
4627 /*----------------------------------------------------------------------------*/
darmod(lambda,dim,bz,pz,gzl,perm,darmat)4628 static INT darmod(lambda,dim,bz,pz,gzl,perm,darmat)
4629 TL_BYTE *lambda, *bz, *perm, **darmat;
4630 INT dim,pz,*gzl;
4631 /*------------------------------------------------------------------------------
4632 koordiniert die Berechnung der gew. irred. Darstellungen mit der Berechnung
4633 der p-mod. irred.
4634 Variablen: lambda, Partition;
4635 dim, Dimension der gewoehnlichen Darstellungen;
4636 bz, Koeffizientenschema aus alkonmat;
4637 pz, Primzahl,fuer welche die p-mod. Darstellungsmatrizen be-
4638 rechnet werden;
4639 gzl, #(INT)0, d.h. berechne zuerst die gew. irred. Darstellungen,
4640 =(INT)0, d.h. gew. irred. Darstellungen existieren schon;
4641 perm, Permutation, fuer die die Darstellungen berechnet werden.
4642 Rueckgabe Matrizen darmat der p-modular irreduziblen Darstellungen.
4643 Rueckgabewerte: prang, Dimension der Darstellung;
4644 (INT)-10, falls Pointer auf lambda NULL ist;
4645 -11L, falls lambda keinen Eintrag hat;
4646 -12L, falls lambda einen Eintrag kleiner 0 hat;
4647 -13L, falls lambda keine eigentliche Partition ist;
4648 // -15L, falls n MAXN uebersteigt;
4649 -18L, falls dim groesser MAXDM ist;
4650 -19L, falls Pointer auf bz NULL ist;
4651 -21L, falls dim kleiner 1 ist;
4652 -22L, falls Pointer auf darmat NULL ist;
4653 -23L, falls Pointer auf gzl NULL ist;
4654 -24L, falls pz keine Primzahl ist;
4655 -25L, falls pz kleiner 1 ist;
4656 -26L, falls pz groesser n ist;
4657 -27L, falls keine ganzzahlige Loesung bei der Berechnung
4658 der gewoehnlichen Darstellungen existiert;
4659 (INT)-30, falls Pointer auf perm NULL ist;
4660 -31L, falls ein Element von perm kleiner 1 ist;
4661 -32L, falls ein Element von perm groesser n ist;
4662 -33L, falls Laenge von perm groesser n ist;
4663 (INT)-109, falls nicht genuegend Speicher zu Verfuegung steht.
4664 Bemerkungen:
4665 gzl veraendert sich selbststaendig. Wird darmod mit einem von alkonmat
4666 neuberechneten bz aufgerufen, muss gzl einen von 0 verschiedenen Wert
4667 haben. Sind die ganzzahligen Loesungen der gewoenlichen Darstellungen
4668 berechnet, so ist gzl=(INT)0, und man kann durch nochmaliges Aufrufen von
4669 darmod mit diesem die Berechnungen der gew. Darstellungen ueberspringen.
4670 ------------------------------------------------------------------------------*/
4671 /* TL 0790 */ /* AK 210891 V1.3 */
4672 {
4673 TL_BYTE *_hz,*z_eins,*z_zwei,*z_drei;
4674 INT prang,n,j,i;
4675 TL_BYTE *hz; /* dim x 3dim */
4676 INT il;
4677
4678
4679 /*
4680 Abfangen moeglicher Uebergabefehler...
4681 */
4682 if (lambda==NULL)
4683 return(LmbNul);
4684 else if (!lambda[0])
4685 return(LmbEmp);
4686 for (j=(INT)0,n=(INT)0;lambda[j];j++)
4687 if (lambda[j]<(TL_BYTE)0)
4688 return(LmbLt_null);
4689 else
4690 n+=lambda[j];
4691 for (j=1L;lambda[j];j++)
4692 if (lambda[j]>lambda[j-1])
4693 return(LmbNRg);
4694
4695 if (darmat==NULL)
4696 return(DrtNul);
4697 else if (gzl==NULL)
4698 return(GzlNul);
4699 else if (bz==NULL)
4700 return(BzNul);
4701 else if (dim<=(INT)0)
4702 return(DimLe_null);
4703 else if (dim>MAXDM)
4704 return(DmGtMx);
4705 else if (pz<=(INT)0)
4706 return(PrmLe_null);
4707 else if (pz>n)
4708 return(PrmGtN);
4709 else if (pz)
4710 {
4711 for (j=(INT)0;PZ[j]<=n && PZ[j]<=pz;j++);
4712 if (pz!=PZ[j-1])
4713 return(NoPrm);
4714 }
4715 else if (perm==NULL)
4716 return(PerNul);
4717
4718
4719
4720 for (j=(INT)0;j<n;j++)
4721 if (perm[j]<=(INT)0)
4722 return(PerLe_null);
4723 else if (perm[j]>n)
4724 return(PerGtN);
4725
4726 /*
4727 Auf geht's...
4728 */
4729 _dm=dim;
4730 _dm_zwei=2L*_dm;
4731 _dm_drei=3L*_dm;
4732 if ((hz=(TL_BYTE *)TL_calloc((int)_dm_drei*(int)_dm,sizeof(TL_BYTE)))==NULL)
4733 return no_memory();
4734 for (il=(INT)_dm*(INT)_dm_drei,z_eins=hz,z_zwei=bz;il>(INT)0;il--)
4735 *z_eins++ = *z_zwei++;
4736 if (*gzl)
4737 {
4738 if (lambda[2])
4739 for (i=(INT)0,_hz=hz+1,z_zwei=hz+_dm_drei;i<_dm-1L;i++,_hz += (_dm_drei+1L),z_zwei += (_dm_drei+1L))
4740 {
4741 for (j=i+1L,z_eins=_hz,z_drei=z_zwei;j<_dm;j++,z_eins++,z_drei += _dm_drei)
4742 *z_drei = *z_eins;
4743 for (j=i+1L,z_eins=_hz+_dm,z_drei=z_zwei+_dm;j<_dm;j++,z_eins++,z_drei += _dm_drei)
4744 *z_drei = *z_eins;
4745 }
4746 for (il=(INT)_dm*(INT)_dm_drei,z_eins=bz,z_zwei=hz;il>(INT)0;il--)
4747 *z_eins++ = *z_zwei++;
4748 /*
4749 Berechnung der gewoehnlichen irreduziblen Darstellung mit Hilfe
4750 einer modularen Arithmetik.
4751 */
4752 *gzl=ganzgaussmod(bz,hz);
4753 for (i=(INT)0,z_eins=hz,z_zwei=bz;i<_dm;++i)
4754 {
4755 for (j=(INT)0;j<_dm;++j)
4756 *z_eins++ = *z_zwei++;
4757 for (j=_dm;j<_dm_drei;++j)
4758 *z_zwei++ = *z_eins++;
4759 }
4760 }
4761 if (!(*gzl))
4762 /*
4763 Berechnung der modular irred. Darstellg.
4764 */
4765 prang=TL_darmod(hz,lambda,pz,perm,darmat);
4766 else
4767 prang= *gzl;
4768 SYM_free(hz);
4769 return(prang);
4770 } /* darmod */
4771
4772
dimension_mod(part,prim,res)4773 INT dimension_mod(part,prim,res) OP part,prim; OP res;
4774 /* AK 200294 */
4775 {
4776 /* AK 240194 for a single dimension */
4777 TL_BYTE *lambda;
4778 TL_BYTE *slambda;
4779 INT erg = OK;
4780 INT i,dm,omaxdim;
4781 INT ak_j;
4782 TL_BYTE *bz;
4783 INT res_dim;
4784 INT n,p;
4785 OP w;
4786 CTO(INTEGER,"dimension_mod",prim);
4787 CTO(PARTITION,"dimension_mod",part);
4788 C2R(part,prim,"dimension_mod",res);
4789
4790 if (S_I_I(prim) < (INT)0)
4791 {
4792 fprintf(stderr,"number = %ld\n",S_I_I(prim));
4793 error("dimension_mod: prime number (2. parameter) is negativ");
4794 goto endr_ende;
4795 }
4796 if (S_I_I(prim) == (INT)0) /* ordinary dimension */
4797 {
4798 erg += dimension(part,res);
4799 goto s2r;
4800 }
4801 if (not primep(prim))
4802 {
4803 fprintf(stderr,"number = %ld\n",S_I_I(prim));
4804 error("dimension_mod: prime number (2. parameter) is not prime");
4805 goto endr_ende;
4806 }
4807
4808 if (equal_parts(part,prim))
4809 {
4810 erg += m_i_i((INT)0,res);
4811 goto s2r;
4812 }
4813
4814 omaxdim=MAXDM;
4815 w = callocobject();
4816 weight(part,w);
4817 n = S_I_I(w);
4818 p = S_I_I(prim);
4819 lambda = (TL_BYTE *)TL_calloc((int)n, sizeof(TL_BYTE));
4820 if (lambda == NULL)
4821 {
4822 MAXDM=omaxdim;
4823 erg += ERROR;
4824 goto endr_ende;
4825 }
4826
4827 for (i=(INT)0;i<n;i++) lambda[i]=(INT)0;
4828
4829 for (i=S_PA_LI(part)-(INT)1,ak_j=(INT)0; i>=(INT)0;i--,ak_j++)
4830 lambda[ak_j]=S_PA_II(part,i);
4831
4832 dimension(part,w);
4833 MAXDM= S_I_I(w);
4834 freeall(w);
4835 if (MAXDM<(INT)0)
4836 {
4837 MAXDM=omaxdim;
4838 SYM_free(lambda);
4839 error("dimension_mod:internal error");
4840
4841 erg =MAXDM;
4842 goto endr_ende;
4843 }
4844
4845 slambda=(TL_BYTE *)TL_calloc((int)(n+1),sizeof(TL_BYTE));
4846 if (slambda == NULL)
4847 {
4848 MAXDM=omaxdim;
4849 SYM_free(lambda);
4850 erg += ERROR;
4851 goto endr_ende;
4852 }
4853 bz=(TL_BYTE *)TL_calloc((int)MAXDM*(int)MAXDM,sizeof(TL_BYTE));
4854 if (bz == NULL)
4855 {
4856 MAXDM=omaxdim;
4857 SYM_free(slambda);
4858 SYM_free(lambda);
4859 erg += ERROR;
4860 goto endr_ende;
4861 }
4862 _assoziiere(lambda,slambda,n);
4863 if ((dm=k_alkonmat(slambda,bz,p))<(INT)0)
4864 {
4865 res_dim=dm;
4866 MAXDM=omaxdim;
4867 goto dme;
4868 }
4869 if ((res_dim=k_dimmod(bz,MAXDM,p))<(INT)0)
4870 {
4871 MAXDM=omaxdim;
4872 SYM_free(bz);
4873 SYM_free(slambda);
4874 SYM_free(lambda);
4875 goto endr_ende;
4876
4877 }
4878 dme:
4879 SYM_free(bz);
4880 SYM_free(slambda);
4881 SYM_free(lambda);
4882 m_i_i(res_dim,res);
4883 j_zyk((INT)-15,(INT)0,NULL,NULL); /* AK 020294 */
4884
4885 s2r:
4886 S2R(part,prim,"dimension_mod",res);
4887 ENDR("dimension_mod");
4888 }
4889
4890
schnitt_mat(part,prim,res)4891 INT schnitt_mat(part,prim,res) OP part,prim; OP res;
4892 /* input: partition part
4893 prime number: p
4894 output integer matrix modulo p, whose rang = degree of mod irrep */
4895 /* AK 200294 */ /* AK 070498 V2.0 */
4896 {
4897 TL_BYTE *lambda;
4898 TL_BYTE *slambda;
4899 INT i,j,dm,omaxdim;
4900 INT ak_j;
4901 TL_BYTE *bz;
4902 INT res_dim;
4903 INT n,p;
4904 OP w;
4905 INT erg = OK;
4906
4907 CE3(part,prim,res,schnitt_mat);
4908
4909 if (equal_parts(part,prim))
4910 return m_i_i((INT)0,res);
4911
4912 C2R(part,prim,"schnitt_mat",res);
4913 omaxdim=MAXDM;
4914 w = callocobject();
4915 weight(part,w);
4916 n = S_I_I(w);
4917 p = S_I_I(prim);
4918 lambda = (TL_BYTE *)TL_calloc((int)n, sizeof(TL_BYTE));
4919 if (lambda == NULL)
4920 {
4921 MAXDM=omaxdim;
4922 return no_memory();
4923 }
4924
4925 for (i=(INT)0;i<n;i++) lambda[i]=(INT)0;
4926
4927 for (i=S_PA_LI(part)-(INT)1,ak_j=(INT)0; i>=(INT)0;i--,ak_j++)
4928 lambda[ak_j]=S_PA_II(part,i);
4929
4930 dimension(part,w);
4931 MAXDM= S_I_I(w);
4932 freeall(w);
4933 /* _dimension(lambda,n); */
4934 if (MAXDM<(INT)0)
4935 {
4936 MAXDM=omaxdim;
4937 SYM_free(lambda);
4938 error("dimension_mod:internal error");
4939 return(MAXDM);
4940 }
4941
4942 slambda=(TL_BYTE *)TL_calloc((int)(n+1),sizeof(TL_BYTE));
4943 if (slambda == NULL)
4944 {
4945 MAXDM=omaxdim;
4946 SYM_free(lambda);
4947 return no_memory();
4948 }
4949 bz=(TL_BYTE *)TL_calloc((int)MAXDM*(int)MAXDM,sizeof(TL_BYTE));
4950 if (bz == NULL)
4951 {
4952 MAXDM=omaxdim;
4953 SYM_free(slambda);
4954 SYM_free(lambda);
4955 return no_memory();
4956 }
4957 _assoziiere(lambda,slambda,n);
4958 if ((dm=k_alkonmat(slambda,bz,p))<(INT)0)
4959 {
4960 res_dim=dm;
4961 MAXDM=omaxdim;
4962 goto dme;
4963 }
4964
4965 erg += m_ilih_m(MAXDM,MAXDM,res);
4966 for (i=0;i<MAXDM;i++)
4967 for (j=0;j<MAXDM;j++)
4968 M_I_I((INT)(bz[i*MAXDM+j]),S_M_IJ(res,i,j));
4969 dme:
4970 SYM_free(bz);
4971 SYM_free(slambda);
4972 SYM_free(lambda);
4973 S2R(part,prim,"schnitt_mat",res);
4974
4975 j_zyk((INT)-15,(INT)0,NULL,NULL); /* AK 020294 */
4976 ENDR("schnitt_mat");
4977 }
4978
4979 /*----------------------------------------------------------------------------*/
_assoziiere(lambda,slambda,n)4980 static INT _assoziiere(lambda,slambda,n) TL_BYTE *lambda, *slambda;
4981 INT n;
4982 /*------------------------------------------------------------------------------
4983 konjugiert die eigentliche Partition lambda mit Ergebnis slambda.
4984 Variablen: lambda, eigentliche Partition.
4985 Rueckgabe slambda.
4986 ------------------------------------------------------------------------------*/
4987 /* TL 0790 */ /* AK 210891 V1.3 */
4988 {
4989 INT i,j,llen;
4990
4991 for (i=(INT)0;i<=n;slambda[i++]=(TL_BYTE)0);
4992 for (llen=(INT)0;llen<n && lambda[llen];llen++);
4993 for (i=(INT)0;i<lambda[0];++i)
4994 {
4995 for (j=(INT)0;j<llen && lambda[j]>=i+1;++j);
4996 if ((j<n) && (lambda[j] < i+1))
4997 slambda[i]=(TL_BYTE)j;
4998 else
4999 slambda[i]=(TL_BYTE)llen;
5000 }
5001 return OK;
5002 } /* _assoziiere */
5003
5004 /*----------------------------------------------------------------------------*/
matcopy(ziel,quelle,dim)5005 static INT matcopy(ziel,quelle,dim) TL_BYTE *ziel,*quelle,dim;
5006 /*------------------------------------------------------------------------------
5007 kopiert die (dim x dim)-Matrix quelle auf die (dim x dim)-Matrix ziel.
5008 Variablen: quelle, Matrix;
5009 dim, Dimension beider Matrizen.
5010 Rueckgabe Matrix ziel, Kopie von Matrix quelle.
5011 ------------------------------------------------------------------------------*/
5012 /* TL 0790 */ /* AK 210891 V1.3 */
5013 {
5014 INT i;
5015 TL_BYTE *bb,*aa;
5016
5017 bb=ziel;
5018 aa=quelle;
5019 for (i=(INT)dim*(INT)dim; i>(INT)0 ; i--)
5020 *bb++= *aa++;
5021 return OK;
5022 } /* matcopy */
5023
5024
5025 /*----------------------------------------------------------------------------*/
fak(x)5026 static INT fak(x) INT x;
5027 /*------------------------------------------------------------------------------
5028 berechnet x!.
5029 Variable: x, natuerliche Zahl.
5030 Rueckgabewert: x!.
5031 ------------------------------------------------------------------------------*/
5032 /* TL 0790 */ /* AK 210891 V1.3 */
5033 {
5034 if (x<=1L)
5035 return(1L);
5036 else
5037 return (x*fak(x-1L));
5038 } /*fak*/
5039
5040 /*----------------------------------------------------------------------------*/
nexgitt(y,lambda,mtc)5041 static INT nexgitt(y,lambda,mtc) TL_BYTE *lambda, *y;
5042 INT *mtc;
5043 /*------------------------------------------------------------------------------
5044 berechnet aus Tableau y und Partition lambda das naechste Tableau y.
5045 Variablen: y, Tableau;
5046 lambda, Partition.
5047 Rueckgabe neues Tableau y, falls ein neues existiert (mtc = TRUE).
5048 Rueckgabewerte: (INT)0, falls kein Fehler aufgetreten ist;
5049 (INT)-109, falls kein Speicherplatz vorhanden war.
5050 ------------------------------------------------------------------------------*/
5051 /* TL 0790 */ /* AK 210891 V1.3 */
5052 {
5053 TL_BYTE *hilf;
5054 static TL_BYTE *h=NULL;
5055 static int _nn = 0;
5056 INT m,i,j,l,merke;
5057 INT durch;
5058
5059 if (*mtc == 280194L) {
5060 if (h != NULL) SYM_free(h);
5061 h = NULL;
5062 return OK;
5063 }
5064 if (_nn != _n)
5065 {
5066 if (h != NULL) SYM_free(h);
5067 h = NULL;
5068 }
5069
5070 if (h == NULL)
5071 {
5072 h=(TL_BYTE *)TL_calloc(_n+_n,sizeof(TL_BYTE));
5073 _nn = _n;
5074 }
5075
5076 if (!h)
5077 return no_memory();
5078
5079 hilf=h+_n;
5080 memcpy(h,y,_n * sizeof(TL_BYTE));
5081
5082 if (!(*mtc))
5083 for (i=(INT)0,j=(INT)0;lambda[i];++i)
5084 {
5085 for (l=j;l<j+lambda[i];h[l++]=(TL_BYTE)i);
5086 j += lambda[i];
5087 }
5088 else
5089 {
5090 memset(hilf,0,_n * sizeof(TL_BYTE));
5091 i=_n-(INT)1;
5092 durch=FALSE;
5093 do
5094 {
5095 ++ hilf[m=h[i]];
5096 if (m>(l=h[i-1]))
5097 {
5098 if ((lambda[l]-lambda[m])>
5099 (hilf[l]-hilf[m]+(TL_BYTE)1))
5100 {
5101 durch=TRUE;
5102 merke=l;
5103 j=merke+(TL_BYTE)1;
5104 while ((hilf[j]==(TL_BYTE)0) ||
5105 ((lambda[l]-lambda[j])<
5106 (hilf[l]-hilf[j]+(TL_BYTE)2)))
5107 ++j;
5108 h[i-1]=j;
5109 --hilf[j];
5110 ++hilf[merke];
5111 for (l=i;l<_n;++l)
5112 if (j<_n)
5113 {
5114 for (j=(TL_BYTE)0;!hilf[j];++j);
5115 h[l]=j;
5116 --hilf[j];
5117 }
5118 }
5119 }
5120 --i;
5121 if (i == (INT)0)
5122 *mtc=FALSE;
5123 } while (!durch && *mtc);
5124 }
5125 memcpy(y,h,_n * sizeof(TL_BYTE) );
5126 return (INT)0;
5127 } /*nexgitt*/
5128
5129
5130 #endif /* DGTRUE */
5131