1 /* SYMMETRICA: ga.c */
2 /* group algebra */
3 #include "def.h"
4 #include "macro.h"
5
6 static INT co_posorneg_sum();
7
8 #ifdef PERMTRUE
konj_perm_perm(perm,konj,res)9 INT konj_perm_perm(perm,konj,res) OP perm,konj,res;
10 /* AK 070789 V1.0 */ /* AK 200891 V1.3 */
11 {
12 INT i;
13 INT erg = OK;
14 CE3(perm,konj,res, konj_perm_perm);
15
16 m_il_p(S_P_LI(konj),res);
17 C_O_K(S_P_S(res),INTEGERVECTOR);
18 for (i=0L;i<S_P_LI(perm);i++)
19 M_I_I(S_P_II(konj,S_P_II(perm,i)-1L),S_P_I(res,S_P_II(konj,i)-1L));
20 ENDR("konj_perm_perm");
21 }
22 #endif /* PERMTRUE */
23
24 #ifdef POLYTRUE
mult_gral_gral(eins,zwei,res)25 INT mult_gral_gral(eins,zwei,res) OP eins, zwei, res;
26 /* AK 100789 V1.0 */ /* MB 311290 */ /* AK 200891 V1.3 */
27 {
28
29 OP z, ez, zz;
30 OP bt;
31 INT erg = OK;
32
33 CTO(GRAL,"mult_gral_gral(1)",eins);
34 CTO(GRAL,"mult_gral_gral(2)",zwei);
35 CE3(eins,zwei,res,mult_gral_gral);
36 bt = callocobject();
37 erg += init(BINTREE,bt);
38
39 zz = zwei;
40 while (zz != NULL)
41 {
42 ez = eins;
43 while (ez != NULL)
44 {
45 z = callocobject();
46 erg += b_sk_mo(callocobject(),callocobject(),z);
47 erg += mult( S_PO_S(ez), S_PO_S(zz), S_MO_S(z) );
48 erg += mult( S_PO_K(ez), S_PO_K(zz), S_MO_K(z) );
49 insert(z,bt,add_koeff,comp_monomvector_monomvector);
50 ez = S_PO_N(ez);
51 };
52 zz = S_PO_N(zz);
53 };
54 t_BINTREE_GRAL(bt,res);
55 FREEALL(bt);
56 ENDR("mult_gral_gral");
57 }
58
mult_scalar_gral(von,nach,ergebnis)59 INT mult_scalar_gral(von,nach,ergebnis) OP von, nach, ergebnis;
60 /* AK 230402 */
61 {
62 INT erg = OK;
63 CTO(GRAL,"mult_scalar_gral(2)",nach);
64 CTO(EMPTY,"mult_scalar_gral(3)",ergebnis);
65 MULT_SCALAR_MONOMLIST(von,nach,ergebnis);
66 ENDR("mult_scalar_gral");
67 }
68
69
70
71
horizontal_sum(n,a)72 INT horizontal_sum(n,a) OP n,a;
73 /* MB 311290 */ /* AK 200691 V1.2 */ /* AK 200891 V1.3 */
74 {
75 INT erg = OK; /* AK 310892 */
76 OP p,q;
77 CTO(INTEGER,"horizontal_sum(1)",n);
78 SYMCHECK(S_I_I(n)<1,"horizontal_sum: n<=0");
79
80 p= callocobject();
81 erg += init(GRAL,a);
82 erg += first_permutation(n,p);
83 do {
84 q = callocobject();
85 erg += m_skn_gral(p,cons_eins,NULL,q);
86 erg += insert(q,a,NULL,NULL);
87
88 } while(next_apply(p));
89 FREEALL(p);
90 ENDR("horizontal_sum");
91 }
92
93
94
95
vertikal_sum(n,a)96 INT vertikal_sum(n,a) OP n,a;
97 /* MB 311290 */ /* AK 200691 V1.2 */ /* AK 200891 V1.3 */
98 {
99 OP p,z;
100 INT erg = OK;
101 CTO(INTEGER,"vertikal_sum(1)",n);
102 SYMCHECK(S_I_I(n)<1,"vertikal_sum: n<=0");
103 CE2(n,a,vertikal_sum);
104
105 p= callocobject();
106
107 erg += init(GRAL,a);
108
109 erg += first_permutation(n,p);
110
111 do {
112 z = callocobject();
113 erg += b_skn_gral(callocobject(),callocobject(),NULL,z);
114 erg += copy(p,S_PO_S(z));
115 erg += signum_permutation(p,S_PO_K(z));
116 insert(z,a,NULL,NULL);
117 }
118 while(next(p,p));
119
120 erg += freeall(p);
121 ENDR("vertikal_sum");
122 }
123 #endif /* PERMTRUE */
124
125 #ifdef TABLEAUXTRUE
126 #ifdef POLYTRUE
konjugation(gral,tab,i,d)127 INT konjugation(gral,tab,i,d) OP gral, tab ,d; INT i;
128 /* MB 311290 */ /* AK 200891 V1.3 */
129 {
130
131 OP p, v, w, x, z, zeiger;
132 INT j;
133 INT erg = OK;
134
135 p = callocobject();
136 v = callocobject();
137 w = callocobject();
138 x = callocobject();
139 z = callocobject();
140
141 erg += init(GRAL,d);
142
143 erg += weight(tab,w);
144
145
146 erg += first_permutation(w,v);
147 zeiger = gral;
148 while (zeiger != NULL)
149 {
150 erg += copy(v,p);
151 for(j=0L;j<s_p_li(S_PO_S(zeiger));j++)
152 M_I_I(s_t_iji(tab,i,S_P_II(S_PO_S(zeiger),j)-1L),
153 S_P_I(p,s_t_iji(tab,i,j)-1L));
154 erg += m_skn_gral(p,S_PO_K(zeiger),NULL,z);
155 erg += add_apply(z,d);
156 zeiger = S_PO_N(zeiger);
157 };
158
159
160 erg += freeall(p);
161 erg += freeall(x);
162 erg += freeall(w);
163 erg += freeall(v);
164 erg += freeall(z);
165 ENDR("konjuation");
166 }
167 #endif /* POLYTRUE */
168 #endif /* TABLEAUXTRUE */
169
170
171
172 #ifdef TABLEAUXTRUE
konjugierende(t,i,cp)173 INT konjugierende(t,i,cp) OP t,cp; INT i;
174 /* MB 311290 */ /* AK 200891 V1.3 */
175 {
176
177 OP v,w,x,y,z;
178 INT j;
179 INT erg = OK;
180
181 v = callocobject(); w = callocobject();
182 x = callocobject();
183 z = callocobject();
184 erg += weight(S_T_U(t),w);
185 erg += first_permutation(w,v);
186 erg += copy(v,cp);
187 for(j=0L;j<S_PA_II(S_T_U(t),S_T_HI(t)-1-i);j++)
188 {
189 erg += copy(v,x);
190 c_i_i(S_P_I(x,j),s_t_iji(t,i,j));
191 c_i_i(S_P_I(x,s_t_iji(t,i,j)-1L),j+1L);
192 erg += mult(cp,x,cp);
193 }
194 erg += freeall(z);
195 erg += freeall(w);
196 erg += freeall(v);
197 erg += freeall(x);
198 ENDR("konjugierende");
199 }
200 #endif /* TABLEAUXTRUE */
201
202
203 #ifdef POLYTRUE
konj_gral_perm(gral,perm,res)204 INT konj_gral_perm(gral,perm,res) OP gral, perm, res;
205 /* MB 311290 */ /* AK 200891 V1.3 */
206 /* AK 050898 */
207 {
208 OP x, z, zeiger;
209 INT erg = OK;
210 CE3(gral,perm,res,konj_gral_perm);
211 CTO(GRAL,"konj_gral_perm",gral);
212 CTO(PERMUTATION,"konj_gral_perm",perm);
213
214
215 erg += init(GRAL,res);
216 zeiger = gral;
217 while (zeiger != NULL)
218 {
219 z = callocobject();
220 erg += b_skn_gral(callocobject(),callocobject(),NULL,z);
221 erg += copy(S_PO_K(zeiger),S_PO_K(z));
222 erg += konj_perm_perm( S_PO_S(zeiger), perm, S_PO_S(z) );
223 erg += insert(z,res,NULL,NULL);
224 zeiger = S_PO_N(zeiger);
225 };
226 ENDR("konj_gral_perm");
227 }
228 #endif /* POLYTRUE */
229
230
231 #ifdef TABLEAUXTRUE
hplus(tab,h)232 INT hplus(tab,h) OP tab, h;
233 /* MB 311290 */ /* AK 200691 V1.2 */ /* AK 200891 V1.3 */
234 {
235 OP u,w,x,y,z;
236 INT i;
237 INT erg = OK;
238
239 CTO(TABLEAUX,"hplus",tab);
240 if (S_O_K(S_T_U(tab)) != PARTITION) /* AK 310892 */
241 {
242 return error("hplus:only for TABLEAUX of PARTITION shape");
243 }
244 if (check_equal_2(tab,h,hplus,&erg) == EQUAL)
245 goto he;
246
247
248 u = callocobject();
249 w = callocobject();
250 x = callocobject();
251 y = callocobject();
252 z = callocobject();
253 if (not EMPTYP(h))
254 erg += freeself(h);
255 erg += weight(tab,w);
256 erg += first_permutation(w,u);
257 erg += m_skn_gral(u,cons_eins,NULL,x);
258 for(i=0L;i<S_T_HI(tab);i++)
259 {
260 if(S_PA_II(s_t_u(tab),S_T_HI(tab)-1-i)>1L)
261 {
262 erg += horizontal_sum(s_pa_i(s_t_u(tab),S_T_HI(tab)-1L-i),y);
263 erg += konjugation(y,tab,i,z);
264 erg += mult_gral_gral(x,z,y);
265 erg += copy(y,x);
266 }
267 }
268 erg += copy(x,h);
269 erg += freeall(u);
270 erg += freeall(w);
271 erg += freeall(x);
272 erg += freeall(y);
273 erg += freeall(z);
274 he:
275 ENDR("hplus");
276 }
277
278
279
280
vminus(tab,v)281 INT vminus(tab,v) OP tab,v;
282 /* MB 311290 */ /* AK 200891 V1.3 */
283 {
284 OP u,w,x,y,z,m,tc;
285 INT erg = OK;
286 INT i;
287
288 CTO(TABLEAUX,"vminus",tab);
289 if (S_O_K(S_T_U(tab)) != PARTITION) /* AK 310892 */
290 {
291 return error("vminus:only for TABLEAUX of PARTITION shape");
292 }
293 if (check_equal_2(tab,v,vminus,&erg) == EQUAL)
294 goto ve;
295
296 if (tab == v)
297 FATALERROR("vminus");
298 m = callocobject();
299 tc = callocobject();
300 u = callocobject();
301 w = callocobject();
302 y = callocobject();
303 z = callocobject();
304 if (not EMPTYP(v))
305 erg += freeself(v);
306 erg += transpose(S_T_S(tab),m);
307 erg += m_matrix_tableaux(m,tc);
308 erg += weight(tc,w);
309 erg += first_permutation(w,u);
310 erg += m_skn_gral(u,cons_eins,NULL,v);
311 for(i=0L;i<S_T_HI(tc);i++)
312 {
313 if(S_PA_II(S_T_U(tc),S_T_HI(tc)-1-i)>1L)
314 {
315 erg += vertikal_sum(s_pa_i(S_T_U(tc),S_T_HI(tc)-1-i),y);
316 erg += konjugation(y,tc,i,z);
317 erg += mult(v,z,v);
318 }
319 }
320 erg += freeall(m);
321 erg += freeall(z);
322 erg += freeall(u);
323 erg += freeall(w);
324 erg += freeall(tc);
325 erg += freeall(y);
326 ve:
327 ENDR("vminus");
328 }
329
330
331
idempotent(tab,idp)332 INT idempotent(tab,idp) OP tab,idp;
333 /* MB 311290 */ /* AK 200891 V1.3 */
334 {
335 OP hz,v,h,x;
336 INT erg = OK;
337
338 hz = callocobject();
339 h = callocobject();
340 x = callocobject();
341 v = callocobject();
342 erg += hplus(tab,h);
343 erg += vminus(tab,v);
344 erg += mult(h,v,x);
345 erg += dimension(S_T_U(tab),hz);
346 erg += invers(hz,hz);
347 erg += mult(hz,x,idp);
348 erg += freeall(x);
349 erg += freeall(h);
350 erg += freeall(hz);
351 erg += freeall(v);
352 ENDR("idempotent");
353 }
354 #endif /* TABLEAUXTRUE */
355
356 #ifdef CHARTRUE
zentralprim(part,idp)357 INT zentralprim(part,idp) OP part,idp;
358 /* MB 311290 */ /* AK 200891 V1.3 */
359 {
360 OP hz,p,v,w,x,y,zt,vecsc;
361 INT ind;
362 INT erg = OK;
363
364 hz = CALLOCOBJECT();
365 p = CALLOCOBJECT();
366 v = CALLOCOBJECT();
367 w = CALLOCOBJECT();
368 x = CALLOCOBJECT();
369 y = CALLOCOBJECT();
370 init(GRAL,y);
371 zt = CALLOCOBJECT();
372 vecsc = CALLOCOBJECT();
373 m_part_sc(part,vecsc);
374 weight(part,w);
375 first_permutation(w,p);
376 do {
377 zykeltyp(p,zt);
378 ind = indexofpart(zt);
379 if(S_I_I(S_V_I(s_sc_w(vecsc),ind)))
380 {
381 m_skn_gral(p,S_V_I(s_sc_w(vecsc),ind),
382 NULL, x);
383 erg += add_apply(x,y);
384 }
385 } while(next_apply(p));
386 erg += dimension(part,hz);
387 erg += invers(hz,hz);
388 erg += mult(hz,y,v);
389 erg += copy(v,idp);
390 FREEALL(vecsc);
391 FREEALL(v);
392 FREEALL(hz);
393 FREEALL(y);
394 FREEALL(zt);
395 FREEALL(x);
396 FREEALL(p);
397 FREEALL(w);
398 ENDR("zentralprim");
399 }
400 #endif /* CHARTRUE */
401
402
403 #ifdef POLYTRUE
konjugation2(gral,perm,res)404 INT konjugation2(gral,perm,res) OP gral, perm, res;
405 /* MB 311290 */ /* AK 200891 V1.3 */
406 {
407 OP p, v, x, z, zeiger;
408 INT j;
409
410 p = callocobject();
411 v = callocobject();
412 x = callocobject();
413 z = callocobject();
414
415 first_permutation(s_p_l(perm),v);
416 zeiger = gral;
417 while (zeiger != NULL)
418 {
419 copy(v,p);
420 for(j=0L;j<S_P_LI(S_PO_S(zeiger));j++)
421 M_I_I(S_P_II(perm,S_P_II(S_PO_S(zeiger),j)-1L),
422 S_P_I(p,S_P_II(perm,j)-1L));
423 m_skn_gral(p,S_PO_K(zeiger),NULL,z);
424 add_apply(z,x);
425 zeiger = S_PO_N(zeiger);
426 };
427 copy(x,res);
428 freeall(p);
429 freeall(v);
430 freeall(x);
431 freeall(z);
432 return OK;
433 }
434 #endif /* POLYTRUE */
435
objectread_gral(filename,gral)436 INT objectread_gral(filename,gral) FILE *filename;OP gral;
437 /* MB 311290 */ /* AK 200891 V1.3 */
438 {
439 char antwort[2];
440
441 b_sn_l(callocobject(),NULL,gral);
442
443 objectread_monom(filename,S_L_S(gral));
444 fscanf(filename,"%s",antwort);
445 if (antwort[0] == 'j')
446 {
447 C_L_N(gral,callocobject());
448 objectread_gral(filename,S_L_N(gral));
449 }
450 return(OK);
451 }
452
objectwrite_gral(filename,gral)453 INT objectwrite_gral(filename,gral) FILE *filename;OP gral;
454 /* ausgabe eines list-objects
455 ausgabe bis einschliesslich next == NULL */ /* MB 311290 */
456 /* AK 200891 V1.3 */
457 {
458
459 OP zeiger = gral;
460
461 {
462 fprintf(filename, " %" PRIOBJECTKIND " " ,POLYNOM);
463
464 objectwrite(filename,S_PO_S(zeiger));
465 objectwrite(filename,S_PO_K(zeiger));
466 zeiger=S_PO_N(zeiger);
467 while (zeiger != NULL) /* abbruch bedingung */
468 {
469 fprintf(filename,"j\n");
470 objectwrite(filename,S_PO_S(zeiger));
471 objectwrite(filename,S_PO_K(zeiger));
472 zeiger=S_PO_N(zeiger);/*zeiger auf das naechste element*/
473 }
474 fprintf(filename,"n\n");
475 }
476 return(OK);
477 }
478
479 #ifdef POLYTRUE
scan_gral(a)480 INT scan_gral(a) OP a;
481 /* AK 200891 V1.3 */
482 {
483 char antwort[2];
484 INT erg;
485
486
487 /* ergebnis ist ein leeres object */
488 b_sn_l(callocobject(),NULL,a);
489 C_O_K(a,GRAL);
490 /* self ist nun initialisiert */
491
492 erg=scan(MONOM,S_L_S(a));
493 if (erg == ERROR) {
494 error("scan_gral:error in scanning listelement");
495 return(ERROR);
496 }
497
498 printeingabe("one more monom j/n");
499 scanf("%s",antwort);
500 if (antwort[0] == 'j')
501 {
502 C_L_N(a,callocobject());
503 scan_gral(S_L_N(a));
504 };
505 return OK;
506 }
507 #endif /* POLYTRUE */
508
add_apply_gral_gral(a,b)509 INT add_apply_gral_gral(a,b) OP a,b;
510 /* AK 200891 V1.3 */
511 {
512 OP c = callocobject();
513 copy_list(a,c);
514 return(insert(c,b,NULL,NULL));
515 }
516
517 #ifdef POLYTRUE
add_apply_gral(a,b)518 INT add_apply_gral(a,b) OP a,b;
519 /* AK 200691 V1.2 */ /* AK 200891 V1.3 */
520 {
521 if (EMPTYP(b))
522 return(copy_polynom(a,b));
523 switch(S_O_K(b)) {
524 case GRAL:
525 return add_apply_gral_gral(a,b);
526 default:
527 {
528 /* 210291 */
529 OP c = callocobject();
530 INT erg;
531 *c = *b;
532 C_O_K(b,EMPTY);
533 erg = add(a,c,b);
534 erg += freeall(c);
535 return erg;
536 }
537 }
538 }
539 #endif /* POLYTRUE */
540
541
542 #ifdef GRALTRUE
mult_apply_gral(a,b)543 INT mult_apply_gral(a,b) OP a,b;
544 /* AK 200691 V1.2 */ /* AK 200891 V1.3 */
545 {
546 switch (S_O_K(b))
547 {
548 case GRAL:
549 {
550 OP c;
551 c = callocobject();
552 *c = *b;
553 C_O_K(b,EMPTY);
554 mult_gral_gral(a,c,b);
555 freeall(c);
556 return OK;
557 }
558 default:
559 return error("mult_apply_gral:wrong second type");
560 }
561 }
562
mult_gral(a,b,d)563 INT mult_gral(a,b,d) OP a,b,d;
564 /* AK 030902 */
565 {
566 INT erg = OK;
567 CTO(GRAL,"mult_gral(1)",a);
568 CTO(EMPTY,"mult_gral(3)",d);
569 switch(S_O_K(b))
570 {
571 case GRAL:
572 erg += mult_gral_gral(a,b,d);
573 break;
574 case BRUCH:
575 case LONGINT:
576 case INTEGER:
577 case FF:
578 erg+=mult_scalar_gral(b,a,d);
579 break;
580 default:
581 WTO("mult_gral(2)",b);
582 break;
583 }
584 ENDR("mult_gral");
585 }
586
random_gral(a,b)587 INT random_gral(a,b) OP a,b;
588 /* AK 310892 */
589 {
590 INT i, erg = OK;
591 OP c,d,e;
592 if (S_O_K(a) != INTEGER)
593 return ERROR;
594 erg += init(GRAL,b);
595 d = callocobject();
596 e = callocobject();
597 for (i=0L;i<10L;i++)
598 {
599 c = callocobject();
600 random_permutation(a,d);
601 random_integer(e,NULL,NULL);
602 if (not nullp(e)) {
603 m_skn_gral(d,e,NULL,c);
604 insert(c,b,NULL,NULL);
605 }
606 }
607 freeall(d);
608 freeall(e);
609 return erg;
610 }
611
pos_sum(a,b)612 INT pos_sum(a,b) OP a,b;
613 {
614 return co_posorneg_sum(a,b,1L);
615 }
neg_sum(a,b)616 INT neg_sum(a,b) OP a,b;
617 {
618 return co_posorneg_sum(a,b,0L);
619 }
620
co_posorneg_sum(a,b,what)621 static INT co_posorneg_sum(a,b,what) OP a,b; INT what;
622 /* AK 280193 */
623 {
624 OP c = callocobject();
625 OP d = callocobject();
626 OP e = callocobject();
627 INT erg = OK;
628 INT i,k,j;
629
630 if (what == 1L)
631 erg += horizontal_sum(S_V_L(a),c);
632 else if (what == 0L)
633 erg += vertikal_sum(S_V_L(a),c);
634 erg += copy(a,d);
635 erg += SYM_sort(d);
636 erg += m_il_p(S_V_II(d,S_V_LI(d)-1L),e); /* identitaet */
637 for (i=0L,k=0L,j=S_V_LI(d);i<S_P_LI(e);i++)
638 if (i+1L == S_V_II(d,k) )
639 {
640 erg += m_i_i( S_V_II(d,k) ,S_P_I(e,k));
641 k++;
642 }
643 else
644 {
645 erg += m_i_i( i+1L ,S_P_I(e,j));
646 j++;
647 }
648 /* e ist die permutation zum konjugieren */
649 erg += konj_gral_perm(c,e,b);
650
651 erg += freeall(c);
652 erg += freeall(d);
653 erg += freeall(e);
654 return erg;
655 }
656
657
658
659
vminus_hecke(a,b)660 INT vminus_hecke(a,b) OP a,b;
661 /* AK 070693 */
662 /* das element C^lambda(q) aus wybourne: J math Phys 33 (1992) 4-14 */
663 /* a ist tableaux, b wird group algebra mit koeff polynom in einer variablen */
664 {
665 INT erg = OK;
666 OP z,l,c;
667 vminus(a,b);
668 z = b;
669 l = callocobject();
670 c = callocobject();
671 erg += conjugate(S_T_U(a),c);
672 erg += maxorder_young(c,l);
673 while (z != NULL)
674 {
675 erg += numberof_inversionen(S_PO_S(z),c);
676 erg += m_iindex_iexponent_monom(0L,S_I_I(l)-S_I_I(c),S_PO_K(z));
677 if ((S_I_I(c) % 2L) == 1L)
678 erg += addinvers_apply(S_PO_K(z));
679 z = S_PO_N(z);
680 }
681 erg += freeall(c);
682 erg += freeall(l);
683 ENDR("vminus_hecke");
684 }
685
686
687
garnir(f,g,h,c)688 INT garnir(f,g,h,c) OP f,g,h,c;
689 /* AK 090693 */
690 /* g,h INTVECTOREN , f TABLEAUX , c wird GROUPALGEBRA */
691 {
692 OP a = callocobject();
693 OP b = callocobject();
694 OP d = callocobject();
695 OP h2 = callocobject();
696 OP z;
697 INT i,j,i1;
698 INT erg = OK ;
699
700
701 erg += b_ks_pa(VECTOR,callocobject(),a);
702 erg += m_il_integervector(2L,S_PA_S(a));
703 M_I_I(S_V_LI(g),S_PA_I(a,0L));
704 M_I_I(S_V_LI(h),S_PA_I(a,1L));
705
706 erg += weight(a,c);
707 erg += first_permutation(c,b);
708 erg += m_skn_gral(b,cons_eins,NULL,d);
709 z=d;
710 erg += copy(b,c);
711 while (next_shuffle_part(a,c,b) != FALSE)
712 {
713 C_PO_N(z,callocobject());
714 erg += m_skn_gral(b,cons_eins,NULL,S_PO_N(z));
715 erg += copy(b,c);
716 z = S_PO_N(z);
717 erg += signum(b,S_PO_K(z));
718 }
719
720 erg += weight(f,b); /* grad der permutation, mit der konjugiert wird */
721 erg += first_permutation(b,a);
722
723 j=0L;
724 erg += append(h,g,h2);
725 erg += SYM_sort(h2);
726 for (i=0L;i<S_V_LI(g);i++)
727 {
728 erg += m_i_i(S_V_II(g,i),S_P_I(a,j));
729 j++;
730 }
731 for (i=0L;i<S_V_LI(h);i++)
732 {
733 erg += m_i_i(S_V_II(h,i),S_P_I(a,j));
734 j++;
735 }
736 i1=0L;
737 for (i=1L;i<=S_P_LI(a);i++)
738 {
739 if ((i1 < S_V_LI(h2)) && (S_V_II(h2,i1) == i)) i1++;
740 else {
741 erg += m_i_i(i,S_P_I(a,j));
742 j++;
743 }
744 }
745 erg += konj_gral_perm(d,a,c);
746 FREEALL(a);
747 FREEALL(b);
748 FREEALL(d);
749 FREEALL(h2);
750 ENDR("garnir");
751 }
752 #endif /* GRALTRUE */
753