1 /* file boe.c */
2 #include "def.h"
3 #include "macro.h"
4
5 static INT op_transpo_tab();
6 static INT vander_gen();
7
8 /* AK 180791 berechnung der specht darstellung
9 Wilhelm Specht: Mathematische Zeitschrift 39 (1935) 696-711 */
10
11 #ifdef TABLEAUXTRUE
makevectorofspecht_poly(a,d)12 INT makevectorofspecht_poly(a,d) OP a,d;
13 /* AK 210703 */
14 /* computes the vector of all specht polynomials
15 for a given shape,
16 i.e. basis of ordinary specht modul */
17 {
18 INT erg =OK,i;
19 CTTO(PARTITION,SKEWPARTITION,"makevectorofspecht_poly(1)",a);
20 {
21 OP e = CALLOCOBJECT();
22 erg += makevectorofSYT(a,e);
23 erg += m_il_v(S_V_LI(e),d);
24 for (i=0L;i<S_V_LI(d); i++)
25 erg += specht_poly(S_V_I(e,i),S_V_I(d,i));
26 /* d is vector of specht poly */
27 FREEALL(e);
28 }
29 ENDR("makevectorofspecht_poly");
30 }
31
specht_dg(a,b,c)32 INT specht_dg(a,b,c) OP a,b,c;
33 /* a partition fuer irr. darstellung
34 b permutation
35 c wird die darstellung */
36 /* AK 200891 V1.3 */
37 /* AK 011098 V2.0 */
38 {
39 INT erg = OK;
40 CTTO(PARTITION,SKEWPARTITION,"specht_dg(1)",a);
41 CTO(PERMUTATION,"specht_dg(2)",b);
42 CE3(a,b,c,specht_dg);
43 {
44 OP d,f, e;
45 INT i,j;
46 CALLOCOBJECT3(d,e,f);
47
48 erg += makevectorofspecht_poly(a,d);
49 /* d is vector of specht poly */
50 erg += m_ilih_nm(S_V_LI(d),S_V_LI(d),c);
51
52 for (i=0L;i<S_V_LI(d); i++)
53 {
54 erg += operate_perm_polynom(b,S_V_I(d,i),e);
55 /* e ist das geaenderte specht polynom, welches nun in der
56 basis geschrieben werden muss */
57 aaa:
58 if (not NULLP(e))
59 for (j=0L;j<S_V_LI(d); j++)
60 if (EQ(S_PO_S(e),S_PO_S(S_V_I(d,j))))
61 {
62 CLEVER_COPY(S_PO_K(e),S_M_IJ(c,j,i));
63 FREESELF(f);
64 MULT(S_PO_K(e),S_V_I(d,j),f);
65 erg += sub_apply(f,e); /* e = e -f */
66 goto aaa;
67 }
68 }
69 FREEALL3(d,e,f);
70 }
71 ENDR("specht_dg");
72 }
73 #endif /* TABLEAUXTRUE */
74
75 #ifdef MATRIXTRUE
vander_gen(a,b)76 static INT vander_gen(a,b) OP a,b;
77 /* a ist monom, d.h. vector von integer als self
78 b wird die vandermonde, wie sie bei specht definiert wird */
79 /* AK 200891 V1.3 */
80 /* AK 011098 V2.0 */
81 /* a and b may be equal */
82 /* AK 100902 V2.1 */
83 {
84 INT erg = OK;
85 CTO(MONOM,"local:vander_gen(1)",a);
86 CTO(VECTOR,"local:vander_gen(1.self)",S_MO_S(a));
87 {
88 OP c,d;
89 INT i,j,k;
90
91 c=CALLOCOBJECT();
92 d=CALLOCOBJECT();
93 k=0L;
94 for (i=0L;i<S_MO_SLI(a);i++)
95 if (not NULLP(S_MO_SI(a,i))) k++;
96
97 erg += m_ilih_m(k,k,c);
98 for (i=0L;i<S_M_HI(c);i++)
99 {
100 for (k=0L;k<S_MO_SLI(a);k++)
101 if (not NULLP(S_MO_SI(a,k))) break;
102 for (j=0L;j<S_M_HI(c);j++)
103 {
104 erg += b_skn_po(CALLOCOBJECT(),
105 CALLOCOBJECT(),
106 NULL,
107 S_M_IJ(c,i,j));
108 erg += m_l_nv(S_MO_SL(a),
109 S_PO_S(S_M_IJ(c,i,j)));
110 COPY(S_MO_K(a),S_PO_K(S_M_IJ(c,i,j)));
111 M_I_I(i+S_MO_SII(a,k)-1L,S_PO_SI(S_M_IJ(c,i,j),k));
112 k++;
113 for (;k<S_MO_SLI(a);k++)
114 if (not NULLP(S_MO_SI(a,k))) break;
115 }
116 }
117
118 erg += det_mat_imm(c,b);
119 FREEALL2(c,d);
120 }
121 ENDR("local:vander_gen");
122 }
123 #endif /* MATRIXTRUE */
124
125 #ifdef TABLEAUXTRUE
specht_poly(a,b)126 INT specht_poly(a,b) OP a,b;
127 /* AK 200891 V1.3 */
128 /* AK 011098 V2.0 */
129 /* a and b may be equal */
130 /* a TABLEAUX object
131 b will be POLYNOM object */
132 {
133 INT erg = OK;
134 CTO(TABLEAUX,"specht_poly(1)",a);
135 CE2(a,b,specht_poly);
136 {
137 OP c,d,e,f;
138 INT i,j,diff=0;
139
140
141
142
143 c = CALLOCOBJECT();
144 /* minimal entry must be 1 *//* AK 140703 */
145 min_tableaux(a,c);
146 if (S_O_K(c) != INTEGER)
147 {
148 debugprint(c);
149 error("specht_poly:non integer entries in the tableau");
150 FREEALL(c); goto endr_ende;
151 }
152 if (S_I_I(c) != 1)
153 {
154 diff = S_I_I(c)-1;
155 FREESELF(c);
156 }
157 d = CALLOCOBJECT();
158 e = CALLOCOBJECT();
159 f = CALLOCOBJECT();
160 erg += conjugate(S_T_U(a),c);
161 erg += weight(c,f);
162 erg += b_skn_po(callocobject(),callocobject(),NULL,b);
163 erg += m_l_nv(f,S_PO_S(b));
164 M_I_I(1,S_PO_K(b));
165
166 if (S_O_K(S_T_U(a)) == PARTITION)
167 {
168 for (i=0L; i<S_PA_LI(c); i++)
169 {
170 erg += b_sk_mo(callocobject(),callocobject(),d);
171 erg += m_l_nv(f,S_MO_S(d));
172 M_I_I(1L,S_MO_K(d));
173 for (j=0L;j<S_PA_II(c,i);j++)
174 M_I_I(1L,S_MO_SI(d,
175 S_T_IJI(a,j,S_PA_LI(c)-1L-i)-1L) - diff);
176
177 erg += vander_gen(d,e); /* e ist poly auch falls 1*/
178 MULT_APPLY(e,b);
179 }
180 }
181 else if (S_O_K(S_T_U(a)) == SKEWPARTITION)
182 {
183 for (i=0L; i<S_SPA_GLI(c); i++)
184 {
185 erg += b_sk_mo(callocobject(),callocobject(),d);
186 erg += m_l_nv(f,S_MO_S(d));
187 M_I_I(1L,S_MO_K(d));
188 for (j=spaltenanfang(a,i);j<=spaltenende(a,i);j++)
189 {
190 M_I_I(1+spaltenanfang(a,i),
191 S_MO_SI(d,S_T_IJI(a,j,i)-1L) - diff);
192 }
193
194 erg += vander_gen(d,e); /* e ist poly auch falls 1*/
195 MULT_APPLY(e,b);
196 }
197 }
198 FREEALL4(c,d,e,f);
199 }
200 ENDR("specht_poly");
201 }
202 #endif /* TABLEAUXTRUE */
203
204 /****************************************************************************/
205 /* */
206 /* Name: alt_sdg_trafo() */
207 /* Diese Routine transformiert die seminormale Matrix D der irreduziblen */
208 /* Darstellung [part] der Sn, wenn part selbstassoziiert ist, so dass */
209 /* sie in zwei Bloecke entlang der Hauptdiagonale reduziert wird. Diese */
210 /* Bloecke sind dann die seminormalen Matrizen zu den irreduziblen Dar- */
211 /* stellungen [part]+ und [part]- der An, in die die Darstellung [part] */
212 /* zerfaellt. */
213 /* Rueckgabewert: OK oder error. */
214 /* */
215 /****************************************************************************/
216 /* PF 130892 */
217
218 #ifdef MATRIXTRUE
219
alt_sdg_trafo(part,D)220 INT alt_sdg_trafo(part,D)
221 OP part; /* Partition der Darstellung */
222 OP D; /* Beginn: seminormale Matrix zu [part] */
223 /* Ende: seminormale Matrix zu [part] in Block- */
224 /* gestalt */
225 {
226 OP conpar; /* konjugierte Partition zu part */
227 OP v_sgn; /* Vorzeichenvektor fuer die Tableaux-Permuta- */
228 /* tionen */
229 OP mat1; /* Block oben links der darstellenden Matrix, */
230 /* wenn part = part' */
231 OP mat2; /* Block unten rechts der darstellenden Matrix, */
232 /* wenn part = part' */
233 OP psi, /* Tableaufunktionswerte */
234 psii,psij;
235 OP tab; /* Vektor der Standardtableaux zu part */
236 OP n; /* Gewicht von part */
237 OP zwei; /* INTEGER-Objekt 2L */
238 OP eins; /* INTEGER-Objekt -1L */
239 OP im; /* Imaginaere Einheit i */
240 OP hilf;
241 INT i,j;
242 INT dim; /* Dimension der Matrix ueber der Sn */
243 INT erg = OK; /* Variable zum Ablaufcheck */
244
245 INT make_tab_signs(); /* Routine zur Berechnung der Vorzeichen der */
246 /* Permutationen, die das 1.Standardtableau in */
247 /* die anderen ueberfuehren */
248 INT make_all_st_tabs(); /* Routine zur Berechnung der Standardtableaux */
249 /* in LLS-Ordnung */
250
251 CTO(PARTITION,"alt_sdg_trafo(1)",part);
252 CTO(MATRIX,"alt_sdg_trafo(2)",D);
253
254 /*** Test, ob die Partition part selbstassoziiert ist *******************/
255
256 conpar = callocobject();
257 erg += conjugate(part,conpar);
258 if(part_comp(part,conpar) != 0L)
259 {
260 erg += freeall(conpar);
261 error("alt_sdg_trafo : partition is not selfassociated ");
262 return erg;
263 }
264
265 /*** Falls die Partition part selbstassoziiert ist, wird die darstel- ***/
266 /*** lende Matrix der Sn so transformiert, dass sie in zwei inaequi- ***/
267 /*** valente seminormale Darstellungen zerfaelllt. ***/
268
269 n = callocobject();
270 tab = callocobject();
271 v_sgn = callocobject();
272 mat1 = callocobject();
273 mat2 = callocobject();
274 hilf = callocobject();
275 zwei = callocobject();
276 eins = callocobject();
277 im = callocobject();
278
279 erg += make_all_st_tabs(part,tab);
280 erg += make_tab_signs(part,v_sgn);
281 dim = S_V_LI(v_sgn);
282 erg += weight(part,n);
283 erg += m_ilih_m(dim, dim,mat1);
284 erg += copy(mat1,mat2);
285 M_I_I(2L,zwei);
286 M_I_I(-1L,eins);
287 erg += squareroot(eins,im);
288
289 psi = callocobject();
290 psii = callocobject();
291 psij = callocobject();
292
293 for(i=0L;i<dim;i++)
294 for(j=i+1L;j<dim;j++)
295 if(!(nullp(S_M_IJ(D,i,j))))
296 {
297 erg += tab_funk(n,part,S_V_I(tab,i),psii);
298 erg += tab_funk(n,part,S_V_I(tab,j),psij);
299 erg += div(psii,psij,psi);
300 erg += squareroot(psi,psi);
301 erg += mult_apply(psi,S_M_IJ(D,i,j));
302 erg += invers(psi,psi);
303 erg += mult_apply(psi,S_M_IJ(D,j,i));
304 }
305
306 /*** Berechnung der transformierten Matrix der An ***********************/
307
308 /*** Berechnung der Matrix im reellen Fall ***/
309 if(S_V_II(v_sgn,dim-1) == 1L)
310 for(i=0L;i<dim/2L;i++)
311 for(j=0L;j<dim/2L;j++)
312 {
313 /*** Berechnung des Blockes links oben ***/
314 erg += copy(S_M_IJ(D,dim-i-1,dim-j-1),
315 S_M_IJ(mat1,i,j));
316 erg += mult(S_V_I(v_sgn,i),S_M_IJ(D,i,dim-j-1),hilf);
317 erg += add_apply(hilf,S_M_IJ(mat1,i,j));
318 erg += mult(S_V_I(v_sgn,j),S_M_IJ(D,dim-i-1,j),hilf);
319 erg += add_apply(hilf,S_M_IJ(mat1,i,j));
320 erg += mult(S_V_I(v_sgn,j),S_M_IJ(D,i,j),hilf);
321 erg += mult_apply(S_V_I(v_sgn,i),hilf);
322 erg += add_apply(hilf,S_M_IJ(mat1,i,j));
323 erg += div(S_M_IJ(mat1,i,j),zwei,hilf);
324 erg += copy(hilf,S_M_IJ(mat1,i,j));
325
326 /*** Berechnung des Blockes rechts unten ***/
327 erg += copy(S_M_IJ(D,dim/2-i-1,dim/2-j-1),
328 S_M_IJ(mat2,i,j));
329 erg += mult(S_V_I(v_sgn,dim/2-i-1),
330 S_M_IJ(D,dim/2+i,dim/2-j-1),hilf);
331 erg += mult_apply(eins,hilf);
332 erg += add_apply(hilf,S_M_IJ(mat2,i,j));
333 erg += mult(S_V_I(v_sgn,dim/2-j-1),
334 S_M_IJ(D,dim/2-i-1,dim/2+j),hilf);
335 erg += mult_apply(eins,hilf);
336 erg += add_apply(hilf,S_M_IJ(mat2,i,j));
337 erg += mult(S_V_I(v_sgn,dim/2-j-1),S_M_IJ(D,dim/2+i,
338 dim/2+j),hilf);
339 erg += mult_apply(S_V_I(v_sgn,dim/2-i-1),hilf);
340 erg += add_apply(hilf,S_M_IJ(mat2,i,j));
341 erg += div(S_M_IJ(mat2,i,j),zwei,hilf);
342 erg += copy(hilf,S_M_IJ(mat2,i,j));
343 }
344
345 /*** Berechnung der Matrix im komplexen Fall ***/
346 if(S_V_II(v_sgn,dim-1) == -1L)
347 for(i=0L;i<dim/2L;i++)
348 for(j=0L;j<dim/2L;j++)
349 {
350 /*** Berechnung des Blockes links oben ***/
351 erg += copy(S_M_IJ(D,dim-i-1,dim-j-1),
352 S_M_IJ(mat1,i,j));
353 erg += mult(S_V_I(v_sgn,i),S_M_IJ(D,i,dim-j-1),hilf);
354 erg += mult_apply(eins,hilf);
355 erg += mult_apply(im,hilf);
356 erg += add_apply(hilf,S_M_IJ(mat1,i,j));
357 erg += mult(S_V_I(v_sgn,j),S_M_IJ(D,dim-i-1,j),hilf);
358 erg += mult_apply(im,hilf);
359 erg += add_apply(hilf,S_M_IJ(mat1,i,j));
360 erg += mult(S_V_I(v_sgn,j),S_M_IJ(D,i,j),hilf);
361 erg += mult_apply(S_V_I(v_sgn,i),hilf);
362 erg += add_apply(hilf,S_M_IJ(mat1,i,j));
363 erg += div(S_M_IJ(mat1,i,j),zwei,hilf);
364 erg += copy(hilf,S_M_IJ(mat1,i,j));
365
366 /*** Berechnung des Blockes rechts unten ***/
367 erg += copy(S_M_IJ(D,dim/2-i-1,dim/2-j-1),
368 S_M_IJ(mat2,i,j));
369 erg += mult(S_V_I(v_sgn,dim/2-i-1),
370 S_M_IJ(D,dim/2+i,dim/2-j-1),hilf);
371 erg += mult_apply(eins,hilf);
372 erg += mult_apply(im,hilf);
373 erg += add_apply(hilf,S_M_IJ(mat2,i,j));
374 erg += mult(S_V_I(v_sgn,dim/2-j-1),
375 S_M_IJ(D,dim/2-i-1,dim/2+j),hilf);
376 erg += mult_apply(im,hilf);
377 erg += add_apply(hilf,S_M_IJ(mat2,i,j));
378 erg += mult(S_V_I(v_sgn,dim/2-j-1),S_M_IJ(D,dim/2+i,
379 dim/2+j),hilf);
380 erg += mult_apply(S_V_I(v_sgn,dim/2-i-1),hilf);
381 erg += add_apply(hilf,S_M_IJ(mat2,i,j));
382 erg += div(S_M_IJ(mat2,i,j),zwei,hilf);
383 erg += copy(hilf,S_M_IJ(mat2,i,j));
384 }
385
386 /*** Belegung der transformierten Matrix ********************************/
387
388 erg += freeself(D);
389 erg += m_ilih_nm(dim,dim,D);
390 for(i=0;i<dim/2L;i++)
391 for(j=0;j<dim/2L;j++)
392 {
393 erg += copy(S_M_IJ(mat1,i,j),S_M_IJ(D,i,j));
394 erg += copy(S_M_IJ(mat2,i,j), S_M_IJ(D,dim/2L+i,dim/2L+j));
395 }
396
397 for(i=0L;i<dim;i++)
398 for(j=i+1L;j<dim;j++)
399 if(!(nullp(S_M_IJ(D,i,j))))
400 {
401 erg += tab_funk(n,part,S_V_I(tab,i),psii);
402 erg += tab_funk(n,part,S_V_I(tab,j),psij);
403 erg += div(psij,psii,psi);
404 erg += squareroot(psi,psi);
405 erg += mult_apply(psi,S_M_IJ(D,i,j));
406 erg += invers(psi,psi);
407 erg += mult_apply(psi,S_M_IJ(D,j,i));
408 }
409
410
411 /*** Speicherplatzfreigabe **********************************************/
412
413 erg += freeall(v_sgn); erg += freeall(conpar); erg += freeall(mat1);
414 erg += freeall(mat2); erg += freeall(hilf); erg += freeall(zwei);
415 erg += freeall(eins); erg += freeall(im); erg += freeall(psij);
416 erg += freeall(psii); erg += freeall(psi); erg += freeall(tab);
417 erg += freeall(n);
418
419 /*** Rueckkehr in die aufrufende Routine ********************************/
420
421 ENDR("alt_sdg_trafo");
422 } /* Ende von alt_sdg_trafo */
423 #endif /* MATRIXTRUE */
424 /****************************************************************************/
425 /* */
426 /* Name: alt_odg_trafo() */
427 /* Diese Routine transformiert die orthogonale Matrix D der irreduziblen */
428 /* Darstellung [part] der Sn, wenn part selbstassoziiert ist, so dass */
429 /* sie in zwei Bloecke entlang der Hauptdiagonale reduziert wird. Diese */
430 /* Bloecke sind dann die unitaeren Matrizen zu den irreduziblen Darstel- */
431 /* lungen [part]+ und [part]- der An, in die die Darstellung [part] */
432 /* zerfaellt. */
433 /* Rueckgabewert: OK oder error. */
434 /* */
435 /****************************************************************************/
436 /* PF 130892 */
437
438 #ifdef MATRIXTRUE
alt_odg_trafo(part,D)439 INT alt_odg_trafo(part,D)
440 OP part; /* Partition der Darstellung */
441 OP D; /* Beginn: orthogonale Matrix zu [part] */
442 /* Ende: unitaere Matrix zu [part] in Blockge- */
443 /* stalt */
444 {
445 OP conpar; /* konjugierte Partition zu part */
446 OP v_sgn; /* Vorzeichenvektor fuer die Tableaux-Permuta- */
447 /* tionen */
448 OP mat1; /* Block oben links der darstellenden Matrix, */
449 /* wenn part = part' */
450 OP mat2; /* Block unten rechts der darstellenden Matrix, */
451 /* wenn part = part' */
452 OP zwei; /* INTEGER-Objekt 2L */
453 OP eins; /* INTEGER-Objekt -1L */
454 OP im; /* Imaginaere Einheit i */
455 OP hilf; /* Hilfsvariable */
456 INT i,j;
457 INT dim; /* Dimension von D */
458 INT erg = OK; /* Variable zum Ablaufcheck */
459
460 INT make_tab_signs(); /* Routine zur Berechnung der Vorzeichen der */
461 /* Permutationen, die das 1. Tableau in die */
462 /* anderen ueberfuehren. */
463
464 /*** Test, ob die Partition part selbstassoziiert ist *******************/
465
466 conpar = callocobject();
467 erg += conjugate(part,conpar);
468 if(part_comp(part,conpar) != 0L)
469 {
470 erg += freeall(conpar);
471 error("trafo_check : partition is not selfassociated ");
472 return erg;
473 }
474
475 /*** Falls die Partition part selbstassoziiert ist, wird die darstel- ***/
476 /*** lende Matrix der Sn so transformiert, dass sie in zwei inaequi- ***/
477 /*** valente unitaere Darstellungen zerfaelllt. ***/
478
479
480 v_sgn = callocobject();
481 mat1 = callocobject();
482 mat2 = callocobject();
483 hilf = callocobject();
484 zwei = callocobject();
485 eins = callocobject();
486 im = callocobject();
487
488 erg += make_tab_signs(part,v_sgn);
489 dim = S_V_LI(v_sgn);
490 erg += m_ilih_m(dim, dim,mat1);
491 erg += copy(mat1,mat2);
492 M_I_I(2L,zwei);
493 M_I_I(-1L,eins);
494 erg += squareroot(eins,im);
495
496 /*** Berechnung der transformierten Matrix der An ***********************/
497
498 /*** Berechnung der Matrix im reellen Fall ***/
499 if(S_V_II(v_sgn,dim-1) == 1L)
500 for(i=0L;i<dim/2L;i++)
501 for(j=0L;j<dim/2L;j++)
502 {
503 /*** Berechnung des Blockes links oben ***/
504 erg += copy(S_M_IJ(D,dim-i-1,dim-j-1),
505 S_M_IJ(mat1,i,j));
506 erg += mult(S_V_I(v_sgn,i),S_M_IJ(D,i,dim-j-1),hilf);
507 erg += add_apply(hilf,S_M_IJ(mat1,i,j));
508 erg += mult(S_V_I(v_sgn,j),S_M_IJ(D,dim-i-1,j),hilf);
509 erg += add_apply(hilf,S_M_IJ(mat1,i,j));
510 erg += mult(S_V_I(v_sgn,j),S_M_IJ(D,i,j),hilf);
511 erg += mult_apply(S_V_I(v_sgn,i),hilf);
512 erg += add_apply(hilf,S_M_IJ(mat1,i,j));
513 erg += div(S_M_IJ(mat1,i,j),zwei,hilf);
514 erg += copy(hilf,S_M_IJ(mat1,i,j));
515
516 /*** Berechnung des Blockes rechts unten ***/
517 erg += copy(S_M_IJ(D,dim/2-i-1,dim/2-j-1),
518 S_M_IJ(mat2,i,j));
519 erg += mult(S_V_I(v_sgn,dim/2-i-1),
520 S_M_IJ(D,dim/2+i,dim/2-j-1),hilf);
521 erg += mult_apply(eins,hilf);
522 erg += add_apply(hilf,S_M_IJ(mat2,i,j));
523 erg += mult(S_V_I(v_sgn,dim/2-j-1),
524 S_M_IJ(D,dim/2-i-1,dim/2+j),hilf);
525 erg += mult_apply(eins,hilf);
526 erg += add_apply(hilf,S_M_IJ(mat2,i,j));
527 erg += mult(S_V_I(v_sgn,dim/2-j-1),S_M_IJ(D,dim/2+i,
528 dim/2+j),hilf);
529 erg += mult_apply(S_V_I(v_sgn,dim/2-i-1),hilf);
530 erg += add_apply(hilf,S_M_IJ(mat2,i,j));
531 erg += div(S_M_IJ(mat2,i,j),zwei,hilf);
532 erg += copy(hilf,S_M_IJ(mat2,i,j));
533 }
534
535 /*** Berechnung der Matrix im komplexen Fall ***/
536 if(S_V_II(v_sgn,dim-1) == -1L)
537 for(i=0L;i<dim/2L;i++)
538 for(j=0L;j<dim/2L;j++)
539 {
540 /*** Berechnung des Blockes links oben ***/
541 erg += copy(S_M_IJ(D,dim-i-1,dim-j-1),
542 S_M_IJ(mat1,i,j));
543 erg += mult(S_V_I(v_sgn,i),S_M_IJ(D,i,dim-j-1),hilf);
544 erg += mult_apply(eins,hilf);
545 erg += mult_apply(im,hilf);
546 erg += add_apply(hilf,S_M_IJ(mat1,i,j));
547 erg += mult(S_V_I(v_sgn,j),S_M_IJ(D,dim-i-1,j),hilf);
548 erg += mult_apply(im,hilf);
549 erg += add_apply(hilf,S_M_IJ(mat1,i,j));
550 erg += mult(S_V_I(v_sgn,j),S_M_IJ(D,i,j),hilf);
551 erg += mult_apply(S_V_I(v_sgn,i),hilf);
552 erg += add_apply(hilf,S_M_IJ(mat1,i,j));
553 erg += div(S_M_IJ(mat1,i,j),zwei,hilf);
554 erg += copy(hilf,S_M_IJ(mat1,i,j));
555
556 /*** Berechnung des Blockes rechts unten ***/
557 erg += copy(S_M_IJ(D,dim/2-i-1,dim/2-j-1),
558 S_M_IJ(mat2,i,j));
559 erg += mult(S_V_I(v_sgn,dim/2-i-1),
560 S_M_IJ(D,dim/2+i,dim/2-j-1),hilf);
561 erg += mult_apply(eins,hilf);
562 erg += mult_apply(im,hilf);
563 erg += add_apply(hilf,S_M_IJ(mat2,i,j));
564 erg += mult(S_V_I(v_sgn,dim/2-j-1),
565 S_M_IJ(D,dim/2-i-1,dim/2+j),hilf);
566 erg += mult_apply(im,hilf);
567 erg += add_apply(hilf,S_M_IJ(mat2,i,j));
568 erg += mult(S_V_I(v_sgn,dim/2-j-1),S_M_IJ(D,dim/2+i,
569 dim/2+j),hilf);
570 erg += mult_apply(S_V_I(v_sgn,dim/2-i-1),hilf);
571 erg += add_apply(hilf,S_M_IJ(mat2,i,j));
572 erg += div(S_M_IJ(mat2,i,j),zwei,hilf);
573 erg += copy(hilf,S_M_IJ(mat2,i,j));
574 }
575
576 /*** Belegung der transformierten Matrix ********************************/
577
578 erg += freeself(D);
579 erg += m_ilih_nm(dim,dim,D);
580 for(i=0;i<dim/2L;i++)
581 for(j=0;j<dim/2L;j++)
582 erg += copy(S_M_IJ(mat1,i,j),S_M_IJ(D,i,j));
583 for(i=0;i<dim/2L;i++)
584 for(j=0;j<dim/2L;j++)
585 erg += copy(S_M_IJ(mat2,i,j),
586 S_M_IJ(D,dim/2L+i,dim/2L+j));
587
588
589 /*** Speicherplatzfreigabe **********************************************/
590
591 erg += freeall(v_sgn);
592 erg += freeall(conpar);
593 erg += freeall(mat1);
594 erg += freeall(mat2);
595 erg += freeall(hilf);
596 erg += freeall(zwei);
597 erg += freeall(eins);
598 erg += freeall(im);
599
600 /*** Rueckkehr in die aufrufende Routine ********************************/
601
602 if (erg != OK)
603 {
604 error("alt_odg_trafo : error during computation.");
605 return ERROR;
606 }
607 return OK;
608 } /* Ende von alt_odg_trafo */
609
610
611 #endif /* MTRIXTRUE */
612 /****************************************************************************/
613 /* */
614 /* Name: an_rz_perm() */
615 /* Diese Routine berechnet die Zerlegung einer beliebigen Permutation */
616 /* per der An in erzeugende Elemente des Erzeugendensystems (12)(r-1,r), */
617 /* 2<r<=n. */
618 /* Rueckgabewert: OK oder error. */
619 /* */
620 /****************************************************************************/
621 /* PF 220992 */
622 #ifdef PERMTRUE
an_rz_perm(per,res)623 INT an_rz_perm(per,res)
624 OP per; /* Permutation der An */
625 OP res; /* Vektor von INTEGER-Werten, der angibt, welche */
626 /* erzeugenden Elemente von rechts nach links */
627 /* aneinander multipliziert werden muessen, so dass */
628 /* die Permutation per entsteht. */
629 {
630 OP rz; /* Zerlegungsvektor von per in Elementartransposi- */
631 /* tionen */
632 OP sig; /* Signum von per */
633 INT i,j,k,l;
634 INT erg = OK; /* Variable zum Ablaufcheck */
635
636 if (not EMPTYP(res))
637 erg += freeself(res);
638
639 /*** Test, ob per in der An liegt ***************************************/
640
641 sig = callocobject();
642 erg += signum(per,sig);
643 if(S_I_I(sig) == -1L)
644 {
645 erg += freeall(sig);
646 error("an_rz_perm : permutation not in An");
647 return erg;
648 }
649
650 /*** Berechnung der reduzierten Zerlegung von per in Elementartrans- ***/
651 /*** positionen. ***/
652
653 rz = callocobject();
654 erg += rz_perm(per,rz);
655 l = S_V_LI(rz);
656
657 /*** Berechnung der Anzahl der erzeugenden Elemente ueber der An ********/
658
659 k = l;
660 for(i=0;i<k;i+=2)
661 {
662 if(S_V_II(rz,i) == 1L)
663 l--;
664 if((S_V_II(rz,i) == 2L) && (S_V_II(rz,i+1) > 2L))
665 l++;
666 }
667
668 /*** Berechnung der benoetigten Permutationen (12)(r-1,r) ***************/
669
670 erg += m_il_nv(l,res);
671 j = 0L;
672 for(i=0;i<k;i+=2)
673 {
674 if(S_V_II(rz,i) == 1L)
675 {
676 M_I_I(S_V_II(rz,i+1)-1L,S_V_I(res,j));
677 j++;
678 }
679 if(S_V_II(rz,i) == 2L)
680 {
681 M_I_I(1L,S_V_I(res,j));
682 j++;
683 M_I_I(1L,S_V_I(res,j));
684 j++;
685 if(S_V_II(rz,i+1) > 2L)
686 {
687 M_I_I(S_V_II(rz,i+1)-1L,S_V_I(res,j));
688 j++;
689 }
690 }
691 if(S_V_II(rz,i) > 2L)
692 {
693 M_I_I(S_V_II(rz,i)-1L,S_V_I(res,j));
694 j++;
695 M_I_I(S_V_II(rz,i+1)-1L,S_V_I(res,j));
696 j++;
697 }
698 }
699
700 /*** Speichenplatzfreigabe **********************************************/
701
702 erg += freeall(rz);
703 erg += freeall(sig);
704
705 /*** Rueckkehr in die aufrufende Routine ********************************/
706
707 if (erg != OK)
708 {
709 error("an_rz_perm : error during computation.");
710 return ERROR;
711 }
712 return OK;
713 } /* Ende von an_rz_perm */
714 #endif /* PERMTRUE */
715 /****************************************************************************/
716 /* */
717 /* Name: an_trafo_odg() */
718 /* Diese Routine berechnet die darstellende unitaere Matrix einer */
719 /* Permutation perm in der Darstellung zu einer Partition part, einge- */
720 /* schraenkt auf die An durch Transformation der darstellenden Matrix */
721 /* ueber der Sn. */
722 /* Rueckgabewert: OK oder error. */
723 /* */
724 /****************************************************************************/
725 /* PF 140992 */
726
727 #ifdef MATRIXTRUE
an_trafo_odg(part,perm,D)728 INT an_trafo_odg(part,perm,D)
729 OP part; /* Vektor, der die Darstellung beschreibt: */
730 /* 1. Komponente : Partition */
731 /* 2. Komponente : 0L oder 1L */
732 OP perm; /* Darzustellende Permutation */
733 OP D; /* Ende: unitaere Matrix zu [part](perm) */
734 {
735 OP n; /* Gewicht von part */
736 OP conpar; /* konjugierte Partition zu part */
737 OP dim; /* Dimension der Matrix ueber der Sn */
738 OP sig; /* Signum von perm */
739 INT i;
740 INT erg = OK; /* Variable zum Ablaufcheck */
741
742 INT alt_odg_trafo(); /* Routine zur Transformation einer zerfallen- */
743 /* den Darstellung */
744 INT trafo_check(); /* Routine zum Testen der Anordnung der Bloecke */
745 /* nach der Transformation */
746
747
748 CTO(VECTOR,"an_trafo_odg(1)",part);
749 CTO(PERMUTATION,"an_trafo_odg(2)",perm);
750 CTO(PARTITION,"an_trafo_odg(1.1)",S_V_I(part,0));
751 CTO(INTEGER,"an_trafo_odg(1.2)",S_V_I(part,1));
752
753
754 if (not EMPTYP(D))
755 erg += freeself(D);
756
757 /*** Test, ob perm in der An liegt **************************************/
758
759 sig = callocobject();
760 erg += signum(perm,sig);
761 if(S_I_I(sig) == -1L)
762 {
763 erg += freeall(sig);
764 error("an_trafo_odg : permutation not in An");
765 return erg;
766 }
767
768 /*** Test, ob Laenge von perm mit dem Gewicht von part uebereinstimmt ***/
769
770 n = callocobject();
771 erg += weight(S_V_I(part,0L),n);
772 if(S_I_I(n) != S_P_LI(perm))
773 {
774 erg += freeall(sig);
775 erg += freeall(n);
776 error("an_trafo_odg : permutation and partition don't agree");
777 return erg;
778 }
779
780 /*** Falls n = 1 oder n = 2, wird D = (1) zurueckgegeben. ***************/
781
782 if((S_P_LI(perm) == 1L) || (S_P_LI(perm) == 2L))
783 {
784 erg += m_ilih_m(1L,1L,D);
785 M_I_I(1L,S_M_IJ(D,0L,0L));
786 erg += freeall(sig);
787 erg += freeall(n);
788 return erg;
789 }
790
791 /*** Berechnung der Matrix **********************************************/
792
793 /*** Falls die Partition part nicht selbstassoziiert ist, ist die ***/
794 /*** darstellende Matrix gleich der Matrix fuer die Sn. ***/
795
796 erg += odg(S_V_I(part,0L),perm,D);
797 conpar = callocobject();
798 erg += conjugate(S_V_I(part,0L),conpar);
799 if(part_comp(S_V_I(part,0L),conpar) != 0L)
800 {
801 erg += freeall(sig);
802 erg += freeall(n);
803 erg += freeall(conpar);
804 return erg;
805 }
806
807 /*** Falls die Partition part selbstassoziiert ist, wird die dar- ***/
808 /*** stellende Matrix der Sn so transformiert, dass sie in zwei ***/
809 /*** inaequivalente unitaere Darstellungen zerfaellt. ***/
810
811 erg += alt_odg_trafo(S_V_I(part,0L),D);
812
813 /*** Dann wird mit Hilfe einer Test-Routine nachgeprueft, in ***/
814 /*** welchem der beiden Bloecke die gesuchte Matrixdarstellung ***/
815 /*** steht. Die uebrigen Teile der Matrix werden geloescht. ***/
816
817 dim = callocobject();
818 M_I_I(S_M_LI(D),dim);
819 if(trafo_check(S_V_I(part,0L)) == S_V_II(part,1L))
820 for(i=0L;i<S_I_I(dim)/2L;i++)
821 {
822 erg += delete_row_matrix(D,S_M_LI(D)-1L,D);
823 erg += delete_column_matrix(D,S_M_LI(D)-1L,D);
824 }
825 else
826 for(i=0L;i<S_I_I(dim)/2L;i++)
827 {
828 erg += delete_row_matrix(D,0L,D);
829 erg += delete_column_matrix(D,0L,D);
830 }
831
832 /*** Speicherplatzfreigabe **********************************************/
833
834 erg += freeall(dim);
835 erg += freeall(conpar);
836 erg += freeall(sig);
837 erg += freeall(n);
838
839 /*** Rueckkehr in die aufrufende Routine ********************************/
840
841 ENDR("an_trafo_odg");
842 } /* Ende von an_trafo_odg */
843
844
845 #endif /* MATRIXTRUE */
846 /****************************************************************************/
847 /* */
848 /* Name: an_trafo_sdg() */
849 /* Diese Routine berechnet die darstellende seminormale Matrix einer */
850 /* Permutation perm in der Darstellung zu einer Partition part, einge- */
851 /* schraenkt auf die An durch Transformation der darstellenden Matrix */
852 /* ueber der Sn. */
853 /* Rueckgabewert: OK oder error. */
854 /* */
855 /****************************************************************************/
856 /* PF 140992 */
857
an_trafo_sdg(part,perm,D)858 INT an_trafo_sdg(part,perm,D) OP part,perm,D;
859 /* AK 220704 V3.0 */
860 /* part Vektor, der die Darstellung beschreibt: */
861 /* 1. Komponente : Partition */
862 /* 2. Komponente : 0L oder 1L */
863 /* perm Darzustellende Permutation */
864 /* D Ende: seminormale Matrix zu [part](perm) */
865 {
866 INT erg = OK;
867 CTO(VECTOR,"an_trafo_sdg(1)",part);
868 CTO(PERMUTATION,"an_trafo_sdg(2)",perm);
869 CTO(PARTITION,"an_trafo_sdg(1.1)",S_V_I(part,0));
870 CTO(INTEGER,"an_trafo_sdg(1.2)",S_V_I(part,1));
871 {
872 #ifdef DGTRUE
873 OP n; /* Gewicht von part */
874 OP conpar; /* konjugierte Partition zu part */
875 OP dim; /* Dimension der Matrix ueber der Sn */
876 OP sig; /* Signum von perm */
877 INT i;
878
879 INT alt_sdg_trafo(); /* Routine zur Transformation einer zerfallen- */
880 /* den Darstellung */
881 INT trafo_check(); /* Routine zum Testen der Anordnung der Bloecke */
882 /* nach der Transformation */
883
884
885 FREESELF(D);
886
887 /*** Test, ob perm in der An liegt **************************************/
888
889 sig = callocobject();
890 erg += signum(perm,sig);
891 if(S_I_I(sig) == -1L)
892 {
893 FREEALL(sig);
894 error("an_trafo_sdg : permutation not in An");
895 goto endr_ende;
896 }
897
898 /*** Test, ob Laenge von perm mit dem Gewicht von part uebereinstimmt ***/
899
900 n = callocobject();
901 erg += weight(S_V_I(part,0L),n);
902 if(S_I_I(n) != S_P_LI(perm))
903 {
904 FREEALL2(sig,n);
905 error("an_trafo_sdg : permutation and partition don't agree");
906 goto endr_ende;
907 }
908
909 /*** Falls n = 1 oder n = 2, wird D = (1) zurueckgegeben. ***************/
910
911 if((S_P_LI(perm) == 1L) || (S_P_LI(perm) == 2L))
912 {
913 erg += m_ilih_m(1L,1L,D);
914 M_I_I(1L,S_M_IJ(D,0L,0L));
915 erg += freeall(sig);
916 erg += freeall(n);
917 return erg;
918 }
919
920 /*** Berechnung der Matrix **********************************************/
921
922 /*** Falls die Partition part nicht selbstassoziiert ist, ist die ***/
923 /*** darstellende Matrix gleich der Matrix fuer die Sn. ***/
924
925 erg += sdg(S_V_I(part,0L),perm,D);
926 conpar = callocobject();
927 erg += conjugate(S_V_I(part,0L),conpar);
928 if(part_comp(S_V_I(part,0L),conpar) != 0L)
929 {
930 erg += freeall(conpar);
931 erg += freeall(sig);
932 erg += freeall(n);
933 return erg;
934 }
935
936 /*** Falls die Partition part selbstassoziiert ist, wird die dar- ***/
937 /*** stellende Matrix der Sn so transformiert, dass sie in zwei ***/
938 /*** inaequivalente unitaere Darstellungen zerfaellt. ***/
939
940 erg += alt_sdg_trafo(S_V_I(part,0L),D);
941
942 /*** Dann wird mit Hilfe einer Test-Routine nachgeprueft, in ***/
943 /*** welchem der beiden Bloecke die gesuchte Matrixdarstellung ***/
944 /*** steht. Die uebrigen Teile der Matrix werden geloescht. ***/
945
946 dim = callocobject();
947 M_I_I(S_M_LI(D),dim);
948 if(trafo_check(S_V_I(part,0L)) == S_V_II(part,1L))
949 for(i=0L;i<S_I_I(dim)/2L;i++)
950 {
951 erg += delete_row_matrix(D,S_M_LI(D)-1L,D);
952 erg += delete_column_matrix(D,S_M_LI(D)-1L,D);
953 }
954 else
955 for(i=0L;i<S_I_I(dim)/2L;i++)
956 {
957 erg += delete_row_matrix(D,0L,D);
958 erg += delete_column_matrix(D,0L,D);
959 }
960
961 /*** Speicherplatzfreigabe **********************************************/
962
963 erg += freeall(dim);
964 erg += freeall(conpar);
965 erg += freeall(sig);
966 erg += freeall(n);
967
968 /*** Rueckkehr in die aufrufende Routine ********************************/
969 #endif
970 }
971 ENDR("an_trafo_sdg");
972 } /* Ende von an_trafo_sdg */
973
974
975 /****************************************************************************/
976 /* */
977 /* Name: gen_mat() */
978 /* Diese Routine berechnet die darstellende unitaere Matrix ueber der */
979 /* An des erzeugenden Elements (12)(index+1L,index+2L) zur irreduzib- */
980 /* len Darstellung [part]+ oder [part]-. Dabei bestimmt die Zahl ref, */
981 /* welcher Block der Matrix berechnet wird, die sonst durch Trans- */
982 /* formation der darstellenden Matrix ueber der Sn entstehen wuerde. */
983 /* Rueckgabewert: OK oder error. */
984 /* */
985 /****************************************************************************/
986 /* PF 280992 */
987
988 #ifdef MATRIXTRUE
gen_mat(part,index,ref,res)989 INT gen_mat(part,index,ref,res)
990 OP part; /* selbstassoziierte Partition */
991 INT index; /* Nummer der erzeugenden Permutation, deren */
992 /* darstellende Matrix berechnet werden soll */
993 INT ref; /* INTEGER-Wert: 0L, falls der Block links oben */
994 /* berechnet werden soll, */
995 /* 1L, sonst. */
996 OP res; /* Ende: darstellende Matrix von [part]+ bzw. */
997 /* [part]- der Permutation (12)(index+1,index+2)*/
998 {
999 OP conpar; /* konjugierte Partition zu part */
1000 OP h_part; /* Hakenpartition zu part */
1001 OP tab; /* Vektor der Standardtableaux zu part */
1002 OP sig; /* Vorzeichenvektor der Permutationen zu den */
1003 /* Standardtableaux zu part */
1004 OP vgl_tab; /* Tableau (index+1,index+2)*Standardtableau */
1005 OP dist1; /* Axialdistanz von index+1 und index+2 */
1006 OP dist2; /* Axialdistanz von 1 und 2 */
1007 OP n; /* Grad der An */
1008 OP eins; /* INTEGER 1L */
1009 OP zwei; /* INTEGER 2L */
1010 OP im; /* komlpexe Einheit -i */
1011 OP exp; /* Vorfaktor bei der Belegung */
1012 INT i,j,k,l;
1013 INT fac; /* Faktor bei der Indizierung */
1014 INT erg = OK; /* Variable zum Ablaufcheck */
1015
1016 INT make_all_st_tabs(); /* Routine zur Berechnung der Standardtableaux */
1017 /* zu part */
1018 INT get_index(); /* Routine zur Bestimmung des Index eines Tab- */
1019 /* leaus im Tableauvektor */
1020
1021 CTO(PARTITION,"gen_mat(1)",part);
1022 SYMCHECK((ref != 1) && (ref != 0),"gen_mat:wrong value par2");
1023
1024 if (not EMPTYP(res))
1025 erg += freeself(res);
1026
1027 /*** Test, ob ref = 0L oder 1L ******************************************/
1028
1029 if((ref != 0L) && (ref != 1L))
1030 {
1031 error("gen_mat : wrong reference INTEGER ");
1032 return erg;
1033 }
1034
1035 /*** Test, ob index < n-1 ***********************************************/
1036
1037 n = callocobject();
1038 erg += weight(part,n);
1039 if(S_I_I(n) - 2L < index)
1040 {
1041 erg += freeall(n);
1042 error("gen_mat : index of generating element too big ");
1043 return erg;
1044 }
1045
1046 /*** Test, ob die Partition part selbstassoziiert ist *******************/
1047
1048 conpar = callocobject();
1049 erg += conjugate(part,conpar);
1050 if(part_comp(part,conpar) != 0L)
1051 {
1052 erg += freeall(n);
1053 erg += freeall(conpar);
1054 error("gen_mat : partition is not selfassociated ");
1055 return erg;
1056 }
1057
1058 /*** Falls part = (2,1) oder part = (2,2), sind die Matrizen eindi- ***/
1059 /*** mensional und koennen direkt angegeben werden. ***/
1060
1061 if((S_I_I(n) == 3L) || (S_I_I(n) == 4L))
1062 {
1063 h_part = callocobject();
1064 erg += hook_part(part,h_part);
1065 erg += m_ilih_m(1L,1L,res);
1066 if(index == 1L)
1067 erg += wert(ref,h_part,S_M_IJ(res,0L,0L));
1068 else
1069 M_I_I(1L,S_M_IJ(res,0L,0L));
1070 erg += freeall(conpar);
1071 erg += freeall(h_part);
1072 erg += freeall(n);
1073 return erg;
1074 }
1075
1076 /*** Zunaechst berechnen wir die Standardtableaux zur Partition part ***/
1077 /*** und den Vorzeichenvetor der Permutationen, die das erste ***/
1078 /*** Standardtableau in das i-te ueberfuehren. ***/
1079
1080 tab = callocobject();
1081 sig = callocobject();
1082 erg += make_all_st_tabs(part,tab);
1083 erg += make_tab_signs(part,sig);
1084
1085 /*** Belegung der darstellenden Matrix von (1 2)(index+1,index+2) *******/
1086
1087 vgl_tab = callocobject();
1088 dist1 = callocobject();
1089 dist2 = callocobject();
1090 eins = callocobject();
1091 zwei = callocobject();
1092 im = callocobject();
1093 exp = callocobject();
1094
1095 M_I_I(1L,eins);
1096 M_I_I(2L,zwei);
1097 erg += addinvers(eins,im);
1098 erg += squareroot(im,im);
1099 erg += addinvers_apply(im);
1100 l = S_V_LI(tab)/2L;
1101 fac = ref*l;
1102 erg += m_ilih_nm(l,l,res);
1103 for(i=0L;i<l;i++)
1104 {
1105 /*** Belegung der Hauptdiagonale der Matrix ***/
1106 erg += get_ax_dist(S_V_I(tab,fac+i),index+1,index+2,dist1);
1107 erg += invers(dist1,S_M_IJ(res,i,i));
1108 erg += get_ax_dist(S_V_I(tab,fac+i),1,2,dist2);
1109 erg += mult_apply(dist2,S_M_IJ(res,i,i));
1110
1111 /*** Belegung der Nichtdiagonalelemente innerhalb des Blockes ***/
1112 erg += op_transpo_tab(index+1L,S_V_I(tab,fac+i),vgl_tab);
1113 k = get_index(vgl_tab,tab);
1114 if(k != -1L)
1115 {
1116 if(((fac==0L) && (k<l)) || ((fac==l) && (k>=l)))
1117 j = k-fac;
1118 else
1119 j = S_V_LI(tab)-k-1-fac;
1120 erg += invers(dist1,S_M_IJ(res,i,j));
1121 erg += hoch(S_M_IJ(res,i,j),zwei,S_M_IJ(res,i,j));
1122 erg += addinvers_apply(S_M_IJ(res,i,j));
1123 erg += add_apply(eins,S_M_IJ(res,i,j));
1124 erg += squareroot(S_M_IJ(res,i,j),S_M_IJ(res,i,j));
1125 erg += mult_apply(dist2,S_M_IJ(res,i,j));
1126 if(!(((fac==0L) && (k<l)) || ((fac==l) && (k>=l))))
1127 {
1128 erg += add(eins,S_V_I(sig,S_V_LI(sig)-1L),exp);
1129 erg += hoch(zwei,exp,exp);
1130 erg += hoch(im,exp,exp);
1131 erg += mult_apply(S_V_I(sig,fac+i),exp);
1132 if(ref == 0L)
1133 erg += addinvers_apply(exp);
1134 erg += mult_apply(exp,S_M_IJ(res,i,j));
1135 }
1136 }
1137 }
1138
1139 /*** Speicherplatzfreigabe **********************************************/
1140
1141 erg += freeall(conpar);
1142 erg += freeall(tab);
1143 erg += freeall(n);
1144 erg += freeall(vgl_tab);
1145 erg += freeall(dist1);
1146 erg += freeall(dist2);
1147 erg += freeall(eins);
1148 erg += freeall(zwei);
1149 erg += freeall(im);
1150 erg += freeall(exp);
1151
1152 /*** Rueckkehr in die aufrufende Routine ********************************/
1153
1154 ENDR("gen_mat");
1155 } /* Ende von gen_mat */
1156 #endif /* MATRIXTRUE */
1157
1158 /****************************************************************************/
1159 /* */
1160 /* Name: gen_smat() */
1161 /* Diese Routine berechnet die darstellende seminormale Matrix ueber */
1162 /* der An des erzeugenden Elements (12)(index+1L,index+2L) zur irre- */
1163 /* duziblen Darstellung [part]+ oder [part]-. Dabei bestimmt die Zahl */
1164 /* ref welcher Block der Matrix berechnet wird, die sonst durch Trans- */
1165 /* formation der darstellenden Matrix ueber der Sn entstehen wuerde. */
1166 /* Rueckgabewert: OK oder error. */
1167 /* */
1168 /****************************************************************************/
1169 /* PF 280992 */
1170
gen_smat(part,index,ref,res)1171 INT gen_smat(part,index,ref,res)
1172 OP part; /* selbstassoziierte Partition */
1173 INT index; /* Nummer der erzeugenden Permutation, deren */
1174 /* darstellende Matrix berechnet werden soll */
1175 INT ref; /* INTEGER-Wert: 0L, falls der Block links oben */
1176 /* berechnet werden soll, */
1177 /* 1L, sonst. */
1178 OP res; /* Ende: darstellende Matrix von [part]+ bzw. */
1179 /* [part]- der Permutation (12)(index+1,index+2)*/
1180 {
1181 OP conpar; /* konjugierte Partition zu part */
1182 OP h_part; /* Hakenpartition zu part */
1183 OP tab; /* Vektor der Standardtableaux zu part */
1184 OP sig; /* Vorzeichenvektor der Permutationen zu den */
1185 /* Standardtableaux zu part */
1186 OP vgl_tab; /* Tableau (index+1,index+2)*Standardtableau */
1187 OP dist1; /* Axialdistanz von index+1 und index+2 */
1188 OP dist2; /* Axialdistanz von 1 und 2 */
1189 OP n; /* Grad der An */
1190 OP eins; /* INTEGER 1L */
1191 OP zwei; /* INTEGER 2L */
1192 OP im; /* komlpexe Einheit -i */
1193 OP exp; /* Vorfaktor bei der Belegung */
1194 OP psi, /* Tableaufunktionswerte */
1195 psii,psij;
1196 INT i,j,k,l;
1197 INT fac; /* Faktor bei der Indizierung */
1198 INT erg = OK; /* Variable zum Ablaufcheck */
1199
1200 INT make_all_st_tabs(); /* Routine zur Berechnung der Standardtableaux */
1201 /* zu part */
1202 INT get_index(); /* Routine zur Bestimmung des Index eines Tab- */
1203 /* leaus im Tableauvektor */
1204
1205 if (not EMPTYP(res))
1206 erg += freeself(res);
1207
1208 /*** Test, ob ref = 0L oder 1L ******************************************/
1209
1210 if((ref != 0L) && (ref != 1L))
1211 {
1212 error("gen_smat : wrong reference INTEGER ");
1213 return erg;
1214 }
1215
1216 /*** Test, ob index < n-1 ***********************************************/
1217
1218 n = callocobject();
1219 erg += weight(part,n);
1220 if(S_I_I(n) - 2L < index)
1221 {
1222 erg += freeall(n);
1223 error("gen_smat : index of generating element too big ");
1224 return erg;
1225 }
1226
1227 /*** Test, ob die Partition part selbstassoziiert ist *******************/
1228
1229 conpar = callocobject();
1230 erg += conjugate(part,conpar);
1231 if(part_comp(part,conpar) != 0L)
1232 {
1233 erg += freeall(n);
1234 erg += freeall(conpar);
1235 error("gen_smat : partition is not selfassociated ");
1236 return erg;
1237 }
1238
1239 /*** Falls part = (2,1) oder part = (2,2), sind die Matrizen eindi- ***/
1240 /*** mensional und koennen direkt angegeben werden. ***/
1241
1242 n = callocobject();
1243 erg += weight(part,n);
1244 if((S_I_I(n) == 3L) || (S_I_I(n) == 4L))
1245 {
1246 h_part = callocobject();
1247 erg += hook_part(part,h_part);
1248 erg += m_ilih_m(1L,1L,res);
1249 if(index == 1L)
1250 erg += wert(ref,h_part,S_M_IJ(res,0L,0L));
1251 else
1252 M_I_I(1L,S_M_IJ(res,0L,0L));
1253 erg += freeall(conpar);
1254 erg += freeall(h_part);
1255 erg += freeall(n);
1256 return erg;
1257 }
1258
1259 /*** Zunaechst berechnen wir die Standardtableaux zur Partition part ***/
1260 /*** und den Vorzeichenvetor der Permutationen, die das erste ***/
1261 /*** Standardtableau in das i-te ueberfuehren. ***/
1262
1263 tab = callocobject();
1264 sig = callocobject();
1265 erg += make_all_st_tabs(part,tab);
1266 erg += make_tab_signs(part,sig);
1267
1268 /*** Belegung der darstellenden Matrix von (1 2)(index+1,index+2) *******/
1269
1270 vgl_tab = callocobject();
1271 dist1 = callocobject();
1272 dist2 = callocobject();
1273 eins = callocobject();
1274 zwei = callocobject();
1275 im = callocobject();
1276 exp = callocobject();
1277 psii = callocobject();
1278 psij = callocobject();
1279 psi = callocobject();
1280
1281 M_I_I(1L,eins);
1282 M_I_I(2L,zwei);
1283 erg += addinvers(eins,im);
1284 erg += squareroot(im,im);
1285 erg += addinvers_apply(im);
1286 l = S_V_LI(tab)/2L;
1287 fac = ref*l;
1288 erg += m_ilih_nm(l,l,res);
1289 for(i=0L;i<l;i++)
1290 {
1291 /*** Belegung der Hauptdiagonale der Matrix ***/
1292 erg += get_ax_dist(S_V_I(tab,fac+i),index+1,index+2,dist1);
1293 erg += invers(dist1,S_M_IJ(res,i,i));
1294 erg += get_ax_dist(S_V_I(tab,fac+i),1,2,dist2);
1295 erg += mult_apply(dist2,S_M_IJ(res,i,i));
1296
1297 /*** Belegung der Nichtdiagonalelemente innerhalb des Blockes ***/
1298 erg += op_transpo_tab(index+1L,S_V_I(tab,fac+i),vgl_tab);
1299 k = get_index(vgl_tab,tab);
1300 if(k != -1L)
1301 {
1302 if(((fac==0L) && (k<l)) || ((fac==l) && (k>=l)))
1303 j = k-fac;
1304 else
1305 j = S_V_LI(tab)-k-1-fac;
1306 erg += invers(dist1,S_M_IJ(res,i,j));
1307 erg += hoch(S_M_IJ(res,i,j),zwei,S_M_IJ(res,i,j));
1308 erg += addinvers_apply(S_M_IJ(res,i,j));
1309 erg += add_apply(eins,S_M_IJ(res,i,j));
1310 erg += squareroot(S_M_IJ(res,i,j),S_M_IJ(res,i,j));
1311 erg += mult_apply(dist2,S_M_IJ(res,i,j));
1312 if(!(((fac==0L) && (k<l)) || ((fac==l) && (k>=l))))
1313 {
1314 erg += add(eins,S_V_I(sig,S_V_LI(sig)-1L),exp);
1315 erg += hoch(zwei,exp,exp);
1316 erg += hoch(im,exp,exp);
1317 erg += mult_apply(S_V_I(sig,fac+i),exp);
1318 if(ref ==0L)
1319 erg += addinvers_apply(exp);
1320 erg += mult_apply(exp,S_M_IJ(res,i,j));
1321 }
1322 erg += tab_funk(n,part,S_V_I(tab,fac+i),psii);
1323 erg += tab_funk(n,part,S_V_I(tab,fac+j),psij);
1324 erg += div(psij,psii,psi);
1325 erg += squareroot(psi,psi);
1326 erg += mult_apply(psi,S_M_IJ(res,i,j));
1327 }
1328 }
1329
1330 /*** Speicherplatzfreigabe **********************************************/
1331
1332 erg += freeall(conpar);
1333 erg += freeall(tab);
1334 erg += freeall(n);
1335 erg += freeall(vgl_tab);
1336 erg += freeall(dist1);
1337 erg += freeall(dist2);
1338 erg += freeall(eins);
1339 erg += freeall(zwei);
1340 erg += freeall(im);
1341 erg += freeall(exp);
1342 erg += freeall(psii);
1343 erg += freeall(psij);
1344 erg += freeall(psi);
1345
1346 /*** Rueckkehr in die aufrufende Routine ********************************/
1347
1348 if (erg != OK)
1349 {
1350 error("gen_smat : error during computation.");
1351 return ERROR;
1352 }
1353 return OK;
1354 } /* Ende von gen_smat */
1355
1356
1357 /****************************************************************************/
1358 /* */
1359 /* Name: get_ax_dist() */
1360 /* Diese Routine berechnet die Axialdistanz der Punkte r und s im */
1361 /* Standardtableau tab. */
1362 /* Rueckgabewert: OK oder error. */
1363 /* */
1364 /****************************************************************************/
1365 /* PF 071092 */
1366
get_ax_dist(tab,r,s,res)1367 INT get_ax_dist(tab,r,s,res) OP tab,res; INT r,s;
1368 /* tab Standardtableau */
1369 /* r,s Zahlen zwischen denen die Axialdistanz berechnet werden soll. */
1370 /* res: Axialdistanz von r und s in tab */
1371 {
1372 OP s1; /* Positionsvektor [i,j], falls tab(i,j) = r */
1373 OP s2; /* Positionsvektor [k,l], falls tab(k,l) = s */
1374 INT erg = OK; /* Variable zum Ablaufcheck */
1375
1376
1377 if (not EMPTYP(res))
1378 erg += freeself(res);
1379
1380 /*** Berechnung der Positionen (i,j) und (k,l), an denen r bzw. s in ***/
1381 /*** tab stehen. ***/
1382
1383 s1 = callocobject();
1384 s2 = callocobject();
1385 erg += get_position(tab,r,s1);
1386 erg += get_position(tab,s,s2);
1387
1388 /*** Berechnung der Axialdistanz ****************************************/
1389
1390 M_I_I(S_V_II(s2,0L)-S_V_II(s2,1L)+S_V_II(s1,1L)-S_V_II(s1,0L),res);
1391
1392 /*** Speicherplatzfreigabe **********************************************/
1393
1394 erg += freeall(s1);
1395 erg += freeall(s2);
1396
1397 /*** Rueckkehr in die aufrufende Routine ********************************/
1398
1399 if (erg != OK)
1400 EDC("get_ax_dist");
1401 return erg;
1402 } /* Ende von get_ax_dist */
1403
1404 /****************************************************************************/
1405 /* */
1406 /* Name: get_position() */
1407 /* Diese Routine berechnet die Position des Zahl r in dem Standard- */
1408 /* tableau tab und schreibt sie in den Vektor res = [i,j] der Laenge 2. */
1409 /* Rueckgabewert: 0L, falls r gefunden wurde, */
1410 /* -1L, sonst. */
1411 /* */
1412 /****************************************************************************/
1413 /* PF 071092 */
1414
get_position(tab,r,res)1415 INT get_position(tab,r,res) OP tab, res; INT r;
1416 /* tab Standardtableau */
1417 /* i Zahl die gesucht werden soll */
1418 /* res Positionsvektor [i,j], falls tab(i,j) = r */
1419 {
1420 INT erg = OK; /* Variable zum Ablaufcheck */
1421 INT i,j;
1422
1423 if (not EMPTYP(res))
1424 erg += freeself(res);
1425
1426 /*** Suche der Zahl r im Standardtableau tab ****************************/
1427
1428 erg += m_il_v(2L,res);
1429 for(i=0L;i<S_T_HI(tab);i++) /* HI statt LI AK 090693 */
1430 for(j=0L;j<S_T_LI(tab);j++) /* LI statt HI AK 090693 */
1431 if((!EMPTYP(S_T_IJ(tab,i,j))) && (S_T_IJI(tab,i,j) == r))
1432 {
1433 M_I_I(i,S_V_I(res,0L));
1434 M_I_I(j,S_V_I(res,1L));
1435 if (erg != OK)
1436 EDC("get_position");
1437 return 0L;
1438 }
1439
1440 /*** Falls r nicht im Standardtableau tab steht, wird -1 zurueckgege- ***/
1441 /*** ben. ***/
1442
1443 return -1L;
1444
1445 } /* Ende von get_position */
1446
1447 /****************************************************************************/
1448 /* */
1449 /* Name: op_transpo_tab() */
1450 /* Diese Routine wendet die Permutation (transpo, transpo+1) auf das */
1451 /* Standardtableau tab an und gibt das resultierende Tableau in res */
1452 /* zurueck. */
1453 /* Rueckgabewert: OK oder error */
1454 /* */
1455 /****************************************************************************/
1456 /* PF 071092 */
1457
op_transpo_tab(transpo,tab,res)1458 static INT op_transpo_tab(transpo,tab,res)
1459 INT transpo; /* Zahl, die die Transposition */
1460 /* (transpo,transpo+1) beschreibt. */
1461 OP tab; /* Standardtableau */
1462 OP res; /* Ende: Tableau (transpo,transpo+1)*tab */
1463 {
1464 INT i,j;
1465 INT erg = OK; /* Variable zum Ablaufcheck */
1466
1467 if (not EMPTYP(res))
1468 erg += freeself(res);
1469
1470 /*** Vertauschen der Eintraege transpo und transpo+1 in tab *************/
1471
1472 erg += copy(tab,res);
1473 for(i=0L;i<S_T_LI(res);i++)
1474 for(j=0L;j<S_T_HI(res);j++)
1475 {
1476 if(!EMPTYP(S_T_IJ(res,i,j)))
1477 if((S_T_IJI(res,i,j)==transpo) || (S_T_IJI(res,i,j)==transpo+1))
1478 {
1479 if(S_T_IJI(res,i,j)==transpo)
1480 erg += inc(S_T_IJ(res,i,j));
1481 else
1482 erg += dec(S_T_IJ(res,i,j));
1483 }
1484 }
1485
1486 /*** Rueckkehr in die aufrufende Routine ********************************/
1487
1488 if (erg != OK)
1489 {
1490 error("op_transpo_tab : error during computation.");
1491 return ERROR;
1492 }
1493 return OK;
1494 } /* Ende von op_transpo_tab */
1495
1496
1497 /****************************************************************************/
1498 /* */
1499 /* Name: get_index() */
1500 /* Routine zur Berechnung der Stelle einer Elements tab in einem Vektor */
1501 /* vector. */
1502 /* Rueckgabewert: index, falls tab in vector vorkommt, */
1503 /* -1 sonst */
1504 /* */
1505 /****************************************************************************/
1506 /* PF 200891 V1.3 */
1507
get_index(tab,vector)1508 INT get_index(tab,vector) OP tab,vector;
1509 {
1510 INT i;
1511
1512 for(i=0;i<S_V_LI(vector);i++)
1513 if (comp(tab,S_V_I(vector,i)) == 0)
1514 return i;
1515 return -1;
1516 } /* Ende von get_index */
1517
1518
1519
1520 /****************************************************************************/
1521 /* */
1522 /* Name: make_all_st_tabs() */
1523 /* Diese Routine berechnet alle Standard-Young-Tableaux zu einer Partition */
1524 /* par, geordnet in LLS-ordnung. */
1525 /* Rueckgabewert: 0L oder error. */
1526 /* */
1527 /****************************************************************************/
1528 /* PF 120892 */
1529
make_all_st_tabs(par,res)1530 INT make_all_st_tabs(par,res)
1531 OP par; /* Partition */
1532 OP res; /* Ende: Vektor von Standard-Young-Tableaux geord- */
1533 /* net in LLS-Ordnung */
1534 {
1535 OP n; /* Gewicht von par */
1536 OP new_par; /* neue Partition von n-1 */
1537 OP tab; /* Tableau */
1538 OP hilf; /* Hilfsvektor beim Umspeichern */
1539 OP zw; /* Zwischenergebnis bei der Rekursion */
1540 OP eins; /* INTEGER-Object 1L */
1541 OP mat; /* Matrix als self-part eines Tableau's */
1542 OP ta; /* Tableau als einkomponentiger Vektor */
1543 INT i,j,k;
1544 INT erg = 0L; /* Variable zum Ablaufcheck */
1545 CTO(PARTITION,"make_all_st_tabs(1)",par);
1546
1547
1548 if (not EMPTYP(res))
1549 erg += freeself(res);
1550
1551 eins = callocobject();
1552 tab = callocobject();
1553
1554 M_I_I(1L,eins);
1555
1556 /*** Falls par = (1), existiert nur ein einziges Tableau T = 1 . ********/
1557
1558 if((S_PA_LI(par) == 1) && (S_PA_II(par,0) == 1))
1559 {
1560 mat = callocobject();
1561 erg += m_ilih_m(1,1,mat);
1562 erg += copy(eins,S_M_IJ(mat,0,0));
1563
1564 erg += m_us_t(par,mat,tab);
1565 erg += m_o_v(tab,res);
1566
1567 erg += freeall(mat);
1568 erg += freeall(eins);
1569 erg += freeall(tab);
1570 return OK;
1571 }
1572
1573 /*** Falls par != (1) , werden die Tableaux rekursiv erzeugt ************/
1574
1575 n = callocobject();
1576 zw = callocobject();
1577 new_par = callocobject();
1578 hilf = callocobject();
1579 ta = callocobject();
1580
1581 erg += weight(par,n);
1582 erg += init(VECTOR,res);
1583
1584 /*** Durchlaufe die Zeilen des Young-Diagramms zu par ... ***/
1585 for(i=S_PA_LI(par)-1;i>0;i--)
1586 /*** ... und pruefe, ob die Zahl n in dieser Zeile auftreten kann. ***/
1587 if(S_PA_II(par,i) > S_PA_II(par,i-1))
1588 {
1589 /*** Berechne die Partition, die entsteht, wenn n aus dem ***/
1590 /*** Tableau entfernt wird und erzeuge alle moeglichen ***/
1591 /*** Tableaux zu dieser Partition, fuege die Zahl n an ***/
1592 /*** entsprechender Stelle wieder ein und haenge alle so ***/
1593 /*** gefundenen Tableaux an den Ergebnisvektor an. ***/
1594
1595 erg += copy(par,new_par);
1596 erg += sub(S_PA_I(new_par,i),eins,S_PA_I(new_par,i));
1597 erg += make_all_st_tabs(new_par,zw);
1598 for(j=0;j<S_V_LI(zw);j++)
1599 {
1600 erg += copy(S_V_I(zw,j),tab);
1601 erg += inc(S_T_S(tab));
1602 erg += copy(n,S_M_IJ(S_T_S(tab),S_PA_LI(par)-1L-i,
1603 S_PA_II(new_par,i)));
1604 erg += copy(par,S_T_U(tab));
1605 erg += m_o_v(tab,ta);
1606 erg += append_vector(res,ta,hilf);
1607 erg += copy(hilf,res);
1608 erg += freeself(hilf);
1609 }
1610 }
1611
1612 /*** Erzeuge schliesslich die Tableaux mit der Zahl n in der letzten ***/
1613 /*** Zeile. ***/
1614
1615 k = 0;
1616 erg += copy(par,new_par);
1617 erg += sub(S_PA_I(new_par,0),eins,S_PA_I(new_par,0));
1618
1619 /*** Falls die letzte Zeile nur Laenge 1 hat ***/
1620 if(S_PA_II(new_par,0) == 0L)
1621 {
1622 erg += m_il_v(S_PA_LI(par)-1L,hilf);
1623 for(j=S_PA_LI(par)-1L;j>0;j--)
1624 erg += copy(S_PA_I(par,j),S_V_I(hilf,j-1));
1625 erg += m_v_pa(hilf,new_par);
1626 k++;
1627 }
1628 erg += make_all_st_tabs(new_par,zw);
1629 for(j=0;j<S_V_LI(zw);j++)
1630 {
1631 erg += copy(S_V_I(zw,j),tab);
1632 erg += inc(S_T_S(tab));
1633 if(k==0L)
1634 {
1635 erg += copy(n,S_M_IJ(S_T_S(tab),S_PA_LI(par)-1L,
1636 S_PA_II(new_par,0)));
1637 erg += copy(par,S_T_U(tab));
1638 }
1639 else
1640 {
1641 erg += copy(n,S_M_IJ(S_T_S(tab),S_PA_LI(par)-1L,0));
1642 erg += copy(par,S_T_U(tab));
1643 }
1644 erg += m_o_v(tab,ta);
1645 erg += append_vector(res,ta,hilf);
1646 erg += copy(hilf,res);
1647 }
1648
1649 /*** Speicherfreigabe ***************************************************/
1650
1651 erg += freeall(zw);
1652 erg += freeall(new_par);
1653 erg += freeall(eins);
1654 erg += freeall(tab);
1655 erg += freeall(ta);
1656
1657 /*** Rueckkehr in die aufrufende Routine ********************************/
1658
1659 ENDR("make_all_st_tabs");
1660 } /* Ende von make_all_st_tabs */
1661
1662
1663 /****************************************************************************/
1664 /* */
1665 /* Name: make_tab_signs() */
1666 /* Diese Routine berechnet einen Vorzeichenvektor der Permutationen */
1667 /* pi_1, ... , pi_f, wobei f die Anzahl der Standard-Young-Tableaux */
1668 /* zu einer gegebenen Partition par ist, und pi_i die Permutation, die */
1669 /* das erste Tableau T_1 in das i-te Tableau ueberfuehrt. Die Tableaux */
1670 /* sind dabei in LLS-Ordnung geordnet. */
1671 /* Rueckgabewert: OK oder error. */
1672 /* */
1673 /****************************************************************************/
1674 /* PF 130892 */
1675
make_tab_signs(par,res)1676 INT make_tab_signs(par,res)
1677 OP par; /* Partition des Umrisses der Tableaux */
1678 OP res; /* Am Ende: Vorzeichenvektor */
1679 {
1680 OP pi; /* Permutation */
1681 OP mat; /* Tableau */
1682 OP conpar; /* zu par konjugierte Partition */
1683 OP n; /* Gewicht der Partition par */
1684 INT i,j,k,l;
1685 INT erg = OK; /* Variable zum Ablaufcheck */
1686
1687 INT make_all_st_tabs(); /* Routine zur Berechnung der Standardtableaux */
1688
1689
1690 if (not EMPTYP(res))
1691 erg += freeself(res);
1692
1693 /*** Speicherplatzreservierung ******************************************/
1694
1695 pi = callocobject();
1696 conpar = callocobject();
1697 mat = callocobject();
1698 n = callocobject();
1699
1700 /*** Berechnung der Standard-Young-Tableaux, der konjugierten Parti- ***/
1701 /*** tion und des Gewichts von par, sowie Initialisierung von pi. ***/
1702
1703 erg += make_all_st_tabs(par,res);
1704 erg += conjugate(par,conpar);
1705 erg += weight(par,n);
1706 erg += m_il_p(S_I_I(n),pi);
1707
1708 /*** Berechnung des Vorzeichenvektors ***********************************/
1709
1710 /*** Durchlaufe alle Tableaux zu par ... ***/
1711 for(i=0L;i<S_V_LI(res);i++)
1712 {
1713 /*** ... und belege die Permutation pi, die das erste Tableau ***/
1714 /*** in das i-te ueberfuehrt. ***/
1715 erg += copy(S_T_S(S_V_I(res,i)),mat);
1716 l = 0L;
1717 for(j=0L;j<S_PA_LI(conpar);j++)
1718 for(k=0L;k<S_PA_II(conpar,S_PA_LI(conpar)-j-1L);k++)
1719 {
1720 erg += copy(S_M_IJ(mat,k,j),S_P_I(pi,l));
1721 l++;
1722 }
1723 /*** Berechne schliesslich das Vorzeichen von pi. ***/
1724 erg += signum(pi,S_V_I(res,i));
1725 }
1726
1727 /*** Speicherplatzfreigabe **********************************************/
1728
1729 erg += freeall(pi);
1730 erg += freeall(conpar);
1731 erg += freeall(mat);
1732 erg += freeall(n);
1733
1734 /*** Rueckkehr in die aufrufende Routine ********************************/
1735
1736 if (erg != OK)
1737 {
1738 error("make_tab_signs : error during computation.");
1739 return ERROR;
1740 }
1741 return OK;
1742 } /* Ende von make_tab_signs */
1743
1744 /****************************************************************************/
1745 /* */
1746 /* Name: tab_funk() */
1747 /* Diese Routine berechnet den Wert der Tableaufunktion f"ur ein */
1748 /* Standardtableau tab zu einer Partition part von n und gibt ihn in */
1749 /* res zurueck. Die Tableaufunktion ist dabei definiert wie in "Substi- */
1750 /* tutional Analysis", Kapitel 26, von D.E. Rutherford. */
1751 /* Rueckgabewert: OK oder error */
1752 /* */
1753 /****************************************************************************/
1754 /* PF 091092 */
1755
tab_funk(n,part,tab,res)1756 INT tab_funk(n,part,tab,res)
1757 OP n; /* INTEGER-Object */
1758 OP part; /* Partition von n */
1759 OP tab; /* Standard-Young-Tableau zu part */
1760 OP res; /* Ende: Wert der Tableaufunktion von tab */
1761 {
1762 OP eins; /* INTEGER-Object 1L */
1763 OP wert; /* Axialdistanz in tab */
1764 OP phi; /* Faktor */
1765 OP pos; /* Positionsvektor fuer den Eintrag n in tab */
1766 OP rec_n, /* Hilfsvariablen fuer die Rekursion */
1767 rec_part,
1768 rec_tab;
1769 INT i;
1770 INT erg = OK; /* Variable zum Ablaufcheck */
1771
1772
1773 if (not EMPTYP(res))
1774 erg += freeself(res);
1775
1776 /*** Abbruchbedingung fuer die Rekursion ********************************/
1777
1778 if(S_I_I(n) == 1L)
1779 {
1780 M_I_I(1L,res);
1781 return erg;
1782 }
1783
1784 /*** Falls n>1, wird der Faktor phi berechnet. **************************/
1785
1786 phi = callocobject();
1787 pos = callocobject();
1788 M_I_I(1L,phi);
1789 erg += get_position(tab,S_I_I(n),pos);
1790 if(!(S_V_II(pos,0L) == 0L))
1791 {
1792 eins = callocobject();
1793 wert = callocobject();
1794 M_I_I(1L,eins);
1795 for(i=0L;i<S_V_II(pos,0L);i++)
1796 {
1797 M_I_I(S_V_II(pos,0L)-S_V_II(pos,1L)-i+
1798 S_PA_II(part,S_PA_LI(part)-i-1L)-1L,wert);
1799 erg += invers(wert,wert);
1800 erg += add_apply(eins,wert);
1801 erg += mult_apply(wert,phi);
1802 }
1803 erg += freeall(eins);
1804 erg += freeall(wert);
1805 }
1806
1807 /*** Rekursion **********************************************************/
1808
1809 rec_tab = callocobject();
1810 rec_part = callocobject();
1811 rec_n = callocobject();
1812 erg += copy(tab,rec_tab);
1813 erg += copy(part,rec_part);
1814 erg += copy(n,rec_n);
1815 erg += dec(rec_n);
1816 if(S_PA_II(part,S_PA_LI(part)-S_V_II(pos,0L)-1L) == 1L)
1817 {
1818 for(i=0L;i<S_PA_LI(part)-1L;i++)
1819 erg += copy(S_PA_I(rec_part,i+1L),S_PA_I(rec_part,i));
1820 erg += dec(rec_part);
1821 }
1822 else
1823 erg += dec(S_PA_I(rec_part,S_PA_LI(part)-S_V_II(pos,0L)-1L));
1824 erg += freeself(S_T_IJ(rec_tab,S_V_II(pos,0L),S_V_II(pos,1L)));
1825 erg += tab_funk(rec_n,rec_part,rec_tab,res);
1826 erg += mult_apply(phi,res);
1827
1828 /*** Speicherplatzfreigabe **********************************************/
1829
1830 erg += freeall(phi);
1831 erg += freeall(pos);
1832 erg += freeall(rec_n);
1833 erg += freeall(rec_part);
1834 erg += freeall(rec_tab);
1835
1836 /*** Rueckkehr in die aufrufende Routine ********************************/
1837
1838 if (erg != OK)
1839 {
1840 error("tab_funk : error during computation.");
1841 return ERROR;
1842 }
1843 return OK;
1844 } /* Ende von tab_funk */
1845
1846 /****************************************************************************/
1847 /* */
1848 /* Name: trafo_check() */
1849 /* Diese Routine ueberprueft, wie die Anordnung der irreduziblen */
1850 /* Darstellungen [part]+ und [part]- , als irreduzible Bestandteile */
1851 /* der Darstellung [part] eingeschraenkt auf die An, beschaffen ist, */
1852 /* wenn man die darstellenden orthogonalen Matrizen der Sn mit den von */
1853 /* B.M. Puttaswamaiah (1963) hergeleiteten Transformationsmatrizen */
1854 /* auf Blockgestalt transformiert. */
1855 /* Rueckgabewert: 0L, falls [part]+ der erste Block ist */
1856 /* 1L, sonst. */
1857 /* */
1858 /****************************************************************************/
1859 /* PF 110992 */
1860
trafo_check(part)1861 INT trafo_check(part)
1862 OP part; /* Partition der Darstellung */
1863 {
1864 OP v_sgn; /* Vorzeichenvektor fuer die Tableaux-Permuta- */
1865 /* tionen */
1866 OP conpar; /* konjugierte Partition zu part */
1867 OP dim; /* Dimension der Matrix ueber der Sn */
1868 OP haken; /* Hakenpartition zu part */
1869 OP ch; /* Charakterwert von [part]+ auf (haken)+ */
1870 OP std; /* Standardpermutation zu haken */
1871 OP D; /* Darstellende Matrix von [part](std) */
1872 OP spur; /* Spur des oberen linken Blockes */
1873 OP zwei; /* INTEGER-Objekt 2L */
1874 OP eins; /* INTEGER-Objekt -1L */
1875 OP im; /* Imaginaere Einheit i */
1876 OP hilf; /* Hilfsvariable */
1877 INT i;
1878
1879 INT make_tab_signs(); /* Routine zur Berechnung des Vorzeichenvektors */
1880 /* der Tableaupermutationen */
1881
1882 /*** Test, ob die Partition part selbstassoziiert ist *******************/
1883
1884 conpar = callocobject();
1885 conjugate(part,conpar);
1886 if(part_comp(part,conpar) != 0L)
1887 {
1888 freeall(conpar);
1889 error("trafo_check : partition is not selfassociated ");
1890 return 0L;
1891 }
1892
1893 /*** Berechnung des Charakterwertes der von [part]+ auf der Konju- ***/
1894 /*** giertenklasse der Hakenpartition (h(part))+ ***/
1895
1896 haken = callocobject();
1897 ch = callocobject();
1898 hilf = callocobject();
1899 hook_part(part,haken);
1900 wert(0L,haken,ch);
1901
1902 /*** Berechnung der Spur des linken oberen Blockes, der entstehen ***/
1903 /*** wuerde, wenn man die darstellende Matrix der Standardpermutation ***/
1904 /*** aus (h(part)) durch die Transformationsmatrix auf Blockgestalt ***/
1905 /*** transformieren wuerde. ***/
1906
1907 v_sgn = callocobject();
1908 dim = callocobject();
1909 spur = callocobject();
1910 std = callocobject();
1911 D = callocobject();
1912 zwei = callocobject();
1913 eins = callocobject();
1914 im = callocobject();
1915
1916 make_tab_signs(part,v_sgn);
1917 M_I_I(S_V_LI(v_sgn),dim);
1918 std_perm(haken,std);
1919
1920 odg(part,std,D);
1921
1922 M_I_I(0L,spur);
1923
1924 /*** Berechnung der Spur im reellen Fall ***/
1925 if(S_V_II(v_sgn,S_I_I(dim)-1) == 1L)
1926 for(i=0L;i<(S_I_I(dim))/2L;i++)
1927 {
1928 add_apply(S_M_IJ(D,S_I_I(dim)-i-1,S_I_I(dim)-i-1), spur);
1929 add_apply(S_M_IJ(D,i,i), spur);
1930 mult(S_V_I(v_sgn,i),S_M_IJ(D,i,S_I_I(dim)-i-1),hilf);
1931 add_apply(hilf,spur);
1932 mult(S_V_I(v_sgn,i),S_M_IJ(D,S_I_I(dim)-i-1,i),hilf);
1933 add_apply(hilf,spur);
1934 }
1935
1936 /*** Berechnung der Spur im komplexen Fall ***/
1937 M_I_I(-1L,eins);
1938 squareroot(eins,im);
1939 if(S_V_II(v_sgn,S_I_I(dim)-1) == -1L)
1940 for(i=0L;i<(S_I_I(dim))/2L;i++)
1941 {
1942 add_apply(S_M_IJ(D,S_I_I(dim)-i-1,S_I_I(dim)-i-1), spur);
1943 add_apply(S_M_IJ(D,i,i), spur);
1944 mult(S_V_I(v_sgn,i),S_M_IJ(D,i,S_I_I(dim)-i-1),hilf);
1945 mult_apply(eins,hilf);
1946 mult_apply(im,hilf);
1947 add_apply(hilf,spur);
1948 mult(S_V_I(v_sgn,i),S_M_IJ(D,S_I_I(dim)-i-1,i),hilf);
1949 mult_apply(im,hilf);
1950 add_apply(hilf,spur);
1951 }
1952
1953 M_I_I(2L,zwei);
1954 div(spur,zwei,hilf);
1955 copy(hilf,spur);
1956
1957 /*** Speicherplatzfreigabe **********************************************/
1958
1959 freeall(v_sgn);
1960 freeall(dim);
1961 freeall(hilf);
1962 freeall(zwei);
1963 freeall(eins);
1964 freeall(im);
1965 freeall(haken);
1966 freeall(std);
1967 freeall(D);
1968 freeall(conpar);
1969
1970 /*** Der Vergleich der beiden Werte gibt den gewuenschten Aufschluss ***/
1971 /*** ueber die Blockstruktur der tranformierten Matrizen. ***/
1972
1973 if(comp(S_N_S(spur),S_N_S(ch)) == 0L)
1974 {
1975 freeall(ch);
1976 freeall(spur);
1977 return 0L;
1978 }
1979 else
1980 {
1981 freeall(ch);
1982 freeall(spur);
1983 return 1L;
1984 }
1985
1986 } /* Ende von trafo_check */
1987
1988 /****************************************************************************/
1989 /* */
1990 /* Name: an_odg() */
1991 /* Diese Routine berechnet die darstellende unitaere Matrix einer */
1992 /* Permutation perm in der Darstellung zu einer Partition part, einge- */
1993 /* schraenkt auf die An durch direkte Belegung. */
1994 /* Rueckgabewert: OK oder error. */
1995 /* */
1996 /****************************************************************************/
1997 /* PF 280992 */ /* PF 130593 */
1998
1999
an_odg(part,perm,D)2000 INT an_odg(part,perm,D)
2001 OP part; /* Vektor, der die Darstellung beschreibt: */
2002 /* 1. Komponente : Partition */
2003 /* 2. Komponente : 0L oder 1L */
2004 OP perm; /* Darzustellende Permutation */
2005 OP D; /* Ende: unitaere Matrix zu [part](perm) */
2006 {
2007 OP conpar; /* konjugierte Partition zu part */
2008 OP sig; /* Signum von perm */
2009 OP n; /* Gewicht von part */
2010 OP rz; /* Zerlegungsvektor von perm in erzeugende Elemente */
2011 /* der An */
2012 OP mat; /* Vektor der darstellenden Matrizen der erzeugen- */
2013 /* den Elemente der An */
2014 OP dim; /* Dimension von D */
2015
2016 INT i,l;
2017 INT erg = OK; /* Variable zum Ablaufcheck */
2018
2019 INT an_rz_perm(); /* Routine zur Zerlegung von perm in erzeugende */
2020 /* Elemente (12)(r-1,r) der An */
2021 INT trafo_check(); /* Routine zum Testen der Anordnung der Bloecke */
2022 /* durch die Transformation */
2023 INT gen_mat(); /* Routine zur Berechnung der darstellenden Matri- */
2024 /* zen der erzeugenden Elemente */
2025
2026 if (not EMPTYP(D))
2027 erg += freeself(D);
2028
2029 /*** Test, ob perm in der An liegt **************************************/
2030
2031 sig = callocobject();
2032 erg += signum(perm,sig);
2033 if(S_I_I(sig) == -1L)
2034 {
2035 erg += freeall(sig);
2036 error("an_odg : permutation not in An");
2037 return erg;
2038 }
2039
2040 /*** Test, ob Laenge von perm mit dem Gewicht von part uebereinstimmt ***/
2041
2042 n = callocobject();
2043 erg += weight(S_V_I(part,0L),n);
2044 if(S_I_I(n) != S_P_LI(perm))
2045 {
2046 erg += freeall(sig);
2047 erg += freeall(n);
2048 error("an_odg : permutation and partition don't agree");
2049 return erg;
2050 }
2051
2052 /*** Falls n = 1 oder n = 2, wird D = (1) zurueckgegeben. ***************/
2053
2054 if((S_P_LI(perm) == 1L) || (S_P_LI(perm) == 2L))
2055 {
2056 erg += m_ilih_m(1L,1L,D);
2057 M_I_I(1L,S_M_IJ(D,0L,0L));
2058 erg += freeall(sig);
2059 erg += freeall(n);
2060 return erg;
2061 }
2062
2063 /*** Berechnung der Matrix **********************************************/
2064
2065 /*** Falls es sich um die Identitaet handelt, wird die Einheitsmatrix ***/
2066 /*** ausgegeben. ***/
2067
2068 if(einsp(perm))
2069 {
2070 dim = callocobject();
2071 erg += dimension_partition(S_V_I(part,0L),dim);
2072 erg += m_ilih_nm(S_I_I(dim),S_I_I(dim),D);
2073 for(i=0;i<S_I_I(dim);i++)
2074 erg += C_I_I(S_M_IJ(D,i,i),1L);
2075 return erg;
2076 }
2077
2078 /*** Falls die Partition part nicht selbstassoziiert ist, ist die ***/
2079 /*** darstellende Matrix gleich der Matrix fuer die Sn. ***/
2080
2081 conpar = callocobject();
2082 erg += conjugate(S_V_I(part,0L),conpar);
2083 if(part_comp(S_V_I(part,0L),conpar) != 0L)
2084 {
2085 erg += odg(S_V_I(part,0L),perm,D);
2086 erg += freeall(sig);
2087 erg += freeall(conpar);
2088 erg += freeall(n);
2089 return erg;
2090 }
2091
2092 /*** Falls die Partition part selbstassoziiert ist, werden zu- ***/
2093 /*** naechst die darstellenden Matrizen der erzeugenden Elemente ***/
2094 /*** berechnet. Dabei wird mit Hilfe einer Testroutine nachge- ***/
2095 /*** prueft, welche Standardtableaux zur Belegung herangezogen ***/
2096 /*** werden muessen. ***/
2097
2098 mat = callocobject();
2099 erg += m_il_v(S_P_LI(perm)-2L,mat);
2100 if(trafo_check(S_V_I(part,0L)) == S_V_II(part,1L))
2101 for(i=1L;i<S_P_LI(perm)-1;i++)
2102 erg += gen_mat(S_V_I(part,0L),i,0L,S_V_I(mat,i-1L));
2103 else
2104 for(i=1L;i<S_P_LI(perm)-1;i++)
2105 erg += gen_mat(S_V_I(part,0L),i,1L,S_V_I(mat,i-1L));
2106
2107 /*** Dann wird die Permutation perm in die erzeugenden Elemente ***/
2108 /*** zerlegt, und die entsprechenden Matrizen miteinander multi- ***/
2109 /*** ziert. ***/
2110
2111 rz = callocobject();
2112 erg += an_rz_perm(perm,rz);
2113 l = S_V_LI(rz);
2114 erg += copy(S_V_I(mat,S_V_II(rz,l-1L)-1L),D);
2115 for(i=l-2L;i>=0L;i--)
2116 erg += mult_apply(S_V_I(mat,S_V_II(rz,i)-1L),D);
2117
2118 /*** Speicherplatzfreigabe **********************************************/
2119
2120 erg += freeall(sig);
2121 erg += freeall(conpar);
2122 erg += freeall(rz);
2123 erg += freeall(mat);
2124 erg += freeall(n);
2125
2126 /*** Rueckkehr in die aufrufende Routine ********************************/
2127
2128 if (erg != OK)
2129 EDC("an_odg");
2130 return erg;
2131 } /* Ende von an_odg */
2132
2133 /****************************************************************************/
2134 /****************************************************************************/
2135
2136 /****************************************************************************/
2137 /* */
2138 /* Name: an_sdg() */
2139 /* Diese Routine berechnet die darstellende seminormale Matrix einer */
2140 /* Permutation perm in der Darstellung zu einer Partition part, einge- */
2141 /* schraenkt auf die An durch direkte Belegung. */
2142 /* Rueckgabewert: OK oder error. */
2143 /* */
2144 /****************************************************************************/
2145 /* PF 280992 */ /* PF 130593 */
2146
an_sdg(part,perm,D)2147 INT an_sdg(part,perm,D) OP part,perm,D;
2148 /* PF 1993 */
2149 /* AK 220704 V3.0 */
2150 /* part Vektor, der die Darstellung beschreibt: */
2151 /* 1. Komponente : Partition */
2152 /* 2. Komponente : 0L oder 1L */
2153 /* perm Darzustellende Permutation */
2154 /* D result is seminormale Matrix zu [part](perm) */
2155 {
2156 INT erg = OK;
2157 {
2158 #ifdef DGTRUE
2159 OP conpar; /* konjugierte Partition zu part */
2160 OP sig; /* Signum von perm */
2161 OP n; /* Gewicht von part */
2162 OP rz; /* Zerlegungsvektor von perm in erzeugende Elemente */
2163 /* der An */
2164 OP mat; /* Vektor der darstellenden Matrizen der erzeugen- */
2165 /* den Elemente der An */
2166 OP dim; /* Dimension von D */
2167
2168 INT i,l;
2169
2170 INT an_rz_perm(); /* Routine zur Zerlegung von perm in erzeugende */
2171 /* Elemente (12)(r-1,r) der An */
2172 INT trafo_check(); /* Routine zum Testen der Anordnung der Bloecke */
2173 /* durch die Transformation */
2174 INT gen_smat(); /* Routine zur Berechnung der darstellenden Matri- */
2175 /* zen der erzeugenden Elemente */
2176
2177 FREESELF(D);
2178
2179 /*** Test, ob perm in der An liegt **************************************/
2180
2181 sig = callocobject();
2182 erg += signum(perm,sig);
2183 if(S_I_I(sig) == -1L)
2184 {
2185 FREEALL(sig);
2186 erg += error("an_sdg : permutation not in An");
2187 goto endr_ende;
2188 }
2189
2190 /*** Test, ob Laenge von perm mit dem Gewicht von part uebereinstimmt ***/
2191
2192 n = callocobject();
2193 erg += weight(S_V_I(part,0L),n);
2194 if(S_I_I(n) != S_P_LI(perm))
2195 {
2196 FREEALL2(sig,n);
2197 erg += error("an_sdg : permutation and partition don't agree");
2198 goto endr_ende;
2199 }
2200
2201 /*** Falls n = 1 oder n = 2, wird D = (1) zurueckgegeben. ***************/
2202
2203 if((S_P_LI(perm) == 1L) || (S_P_LI(perm) == 2L))
2204 {
2205 erg += m_ilih_m(1L,1L,D);
2206 M_I_I(1L,S_M_IJ(D,0L,0L));
2207 FREEALL2(sig,n);
2208 goto endr_ende;
2209 }
2210
2211 /*** Berechnung der Matrix **********************************************/
2212
2213 /*** Falls es sich um die Identitaet handelt, wird die Einheitsmatrix ***/
2214 /*** ausgegeben. ***/
2215
2216 if(einsp(perm))
2217 {
2218 dim = callocobject();
2219 erg += dimension_partition(S_V_I(part,0L),dim);
2220 erg += m_lh_nm(dim,dim,D);
2221 for(i=0;i<S_I_I(dim);i++) C_I_I(S_M_IJ(D,i,i),1);
2222 FREEALL3(dim,sig,n);
2223 goto endr_ende;
2224 }
2225
2226 /*** Falls die Partition part nicht selbstassoziiert ist, ist die ***/
2227 /*** darstellende Matrix gleich der Matrix fuer die Sn. ***/
2228
2229 conpar = callocobject();
2230 erg += conjugate(S_V_I(part,0L),conpar);
2231 if(part_comp(S_V_I(part,0L),conpar) != 0L)
2232 {
2233 erg += sdg(S_V_I(part,0L),perm,D);
2234 FREEALL3(sig,n,conpar);
2235 goto endr_ende;
2236 }
2237
2238 /*** Falls die Partition part selbstassoziiert ist, werden zu- ***/
2239 /*** naechst die darstellenden Matrizen der erzeugenden Elemente ***/
2240 /*** berechnet. Dabei wird mit Hilfe einer Testroutine nachge- ***/
2241 /*** prueft, welche Standardtableaux zur Belegung herangezogen ***/
2242 /*** werden muessen. ***/
2243
2244 mat = callocobject();
2245 erg += m_il_v(S_P_LI(perm)-2L,mat);
2246 if(trafo_check(S_V_I(part,0L)) == S_V_II(part,1L))
2247 for(i=1L;i<S_P_LI(perm)-1;i++)
2248 erg += gen_smat(S_V_I(part,0L),i,0L,S_V_I(mat,i-1L));
2249 else
2250 for(i=1L;i<S_P_LI(perm)-1;i++)
2251 erg += gen_smat(S_V_I(part,0L),i,1L,S_V_I(mat,i-1L));
2252
2253 /*** Dann wird die Permutation perm in die erzeugenden Elemente ***/
2254 /*** zerlegt, und die entsprechenden Matrizen miteinander multi- ***/
2255 /*** ziert. ***/
2256
2257 rz = callocobject();
2258 erg += an_rz_perm(perm,rz);
2259 l = S_V_LI(rz);
2260 erg += copy(S_V_I(mat,S_V_II(rz,l-1L)-1L),D);
2261 for(i=l-2L;i>=0L;i--)
2262 erg += mult_apply(S_V_I(mat,S_V_II(rz,i)-1L),D);
2263
2264 FREEALL5(sig,conpar,rz,mat,n);
2265 #endif
2266 }
2267 ENDR("an_sdg");
2268 }
2269
2270
2271