/* SYMMETRICA source code file: mo.c */ #include "def.h" #include "macro.h" #ifdef DGTRUE /* Darstellungen werden benoetigt */ #define ALLOCOFFSET 0 #define TL_calloc(a,b) SYM_calloc(a+ALLOCOFFSET,b) #define TL_malloc(a) SYM_malloc(a+ALLOCOFFSET) #define TL_free(a) SYM_free(a) typedef signed char TL_BYTE; typedef signed short TL_2BYTE; #define SYM_memcmp memcmp static close_mat(); static init_mat(); static INT _ber_inx_dec(); static INT modmat(); static INT moddreimat(); static INT r_modgauss(); static INT _modgauss(); static INT p_rel(); static INT p_writemat(); static INT zykel(); static INT modgauss(); static INT ganzgaussmod(); static INT homp(); static INT TL_darmod(); static INT d_mat(); static INT k_dimmod(); static INT _k_moddreimat(); static INT _assoziiere(); static INT alkonmat(); static INT zweikonmat(); static INT mat_comp(); static INT alcoeff(); static INT symdet (); static INT sigper(); static INT alzyk(); static INT k_alzyk(); static INT j_zyk(); static INT inzeil(); static INT zykschnitt (); static INT leer(); static INT a_teilmenge_b(); static INT setmin(); static INT _teste_r_mat_dim(); static INT _red_r_mat(); static INT _diff(); static INT _kleiner(); static INT _ggT(); static INT _v_eintrag(); static INT _ber_dim(); static INT _dimension(); static INT _fakul(); static INT _ber_lambdas(); static INT _r_induk(); static INT _num_part(); static INT _part_reg(); static INT _nexpart(); static INT _k_modgauss(); static INT COEFF(); static INT _search_dec(); static INT _k_zweikonmat(); static INT invp(); static INT fak(); static INT nexgitt(); static INT _ber_idx_pelem(); static INT darmod(); static INT lmatmulp(); static INT rmatmulp(); static INT homtestp(); static INT a_ohne_b_gl_c(); static INT matcopy(); static INT konjugiere(); static INT schnitt(); static INT _ggT_v(); static TL_BYTE AK_buf; #define TL_MOD(a,b) \ ((AK_buf = (((INT)a)%(b)))<0?AK_buf+b:AK_buf) /* mod(a,b)=a mod b >= 0 */ #define TL_ADP(x,y,p) TL_MOD((x)+(y),(INT)p) #define TL_MULP(x,y,p) TL_MOD(((INT)x)*((INT)y),(INT)p) #define TL_DIVP(x,y,p) TL_MULP((x),invp((INT)y,(INT)p),(INT)p) /* Global variables of MODULDAR */ /******************************************************************************* * * Datei MODDGGLB.C * * Globale Variablen, die eventuell geaendert werden muessen. * *******************************************************************************/ /* Ueblicher Headerfile... */ static INT idmat(); /* Globale Variablen des Programmpakets MODULDAR */ /* static INT MAXN = (INT)20; static INT MAXZEILENZ = (INT)20; static INT MAXSPALTENZ = (INT)20; */ static INT MAXDM = (INT)5000; static INT ZYK = (INT)50; static INT PZ[] = { (INT)2,(INT)3,(INT)5,(INT)7,(INT)11,(INT)13,(INT)17,(INT)19,(INT)23,(INT)29,(INT)31}; /* Defines of possible errors */ #define LmbNul (INT)-10 #define LmbEmp (INT)-11 #define LmbLt_null (INT)-12 #define LmbNRg (INT)-13 #define NLe_null (INT)-14 #define NGtMax (INT)-15 #define ZzGtMx (INT)-16 #define SzGtMx (INT)-17 #define DmGtMx ((INT)-18) #define BzNul (INT)-19 #define CntOFl (INT)-20 #define DimLe_null (INT)-21 #define DrtNul (INT)-22 #define GzlNul (INT)-23 #define NoPrm (INT)-24 #define PrmLe_null (INT)-25 #define PrmGtN (INT)-26 #define NoSolu (INT)-27 #define DDmLt_null (INT)-28 #define DDmGMx (INT)-29 #define PerNul (INT)-30 #define PerLe_null (INT)-31 #define PerGtN (INT)-32 #define PeLgGN (INT)-33 #define RTabFt (INT)-99 #define NtEMem (INT)-109 /* Macros for modulararithmetic Die Modulararithmetik berechnet Summen (adp), Produkte (mulp), Inverse (invp) und Quotienten (divp) modulo p. Bei Verwendung der entsprechenden Funktionen muss p als Parameter uebergeben werden. */ /* und schliesslich globale Variablen. */ static INT _zeilenz; static INT q_zeilenz; static INT _spaltenz; static INT _n; static INT _zyk; #ifdef UNDEF #define COEFF(x,y,z) ((z-y)%2L)?(((INT)-1)*fak(x+y-2L*z)*fak(z-y)*fak(z)) \ : (fak(x+y-2L*z)*fak(z-y)*fak(z)) #endif static INT COEFF(x,y,z) INT x,y,z; { return ((z-y)%(INT)2)?(((INT)-1)*fak(x+y-(INT)2*z)*fak(z-y)*fak(z)) : (fak(x+y-(INT)2*z)*fak(z-y)*fak(z)) ; } /*----------------------------------------------------------------------------*/ static INT _k_zweikonmat(lambda,bz,pz) TL_BYTE *lambda, *bz; INT pz; /*----------------------------------------------------------------------------- berechnet die Koeffizientenmatrix B zu einer Partition lambda, deren Laenge gleich zwei ist. Dabei werden die Elemente der Matrix modulo pz abgelegt. (Vgl. MODULKFF.C Funktion zweikonmat().) Variablen: lambda, Partition; pz, Primzahl. Reuckgabe Koeffizientenmatrix bz. Rueckgabewerte: >(INT)0, Dimension der gewoehnlichen irred. Darstellung; (INT)-109, falls nicht genuegend Speicher zur Verfuegung stand. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { INT i,j,l,z,zaehl,mdim,dim; TL_BYTE *g_i,*g_j; TL_BYTE *start; TL_BYTE *_bz; INT g_im,g_jm; start=(TL_BYTE *)TL_calloc((int)_n*3,sizeof(TL_BYTE)); if (!start) return no_memory(); g_i=start+(INT)_n; g_j=g_i+(INT)_n; mdim=MAXDM; g_im=FALSE; if (nexgitt(start,lambda,&g_im)) { SYM_free(start); return no_memory(); } for (z=0;z<_n;g_i[z]=start[z],z++); _bz=bz; for (i=0,g_im=TRUE;g_im;i++) { for (z=0;z<_n;g_j[z]=start[z],z++); for (j=0,g_jm=TRUE;g_jm;j++) { for (l=0,zaehl=(INT)0;l<_n;l++) if (g_i[l]==(TL_BYTE)1 && g_j[l]==(TL_BYTE)1) zaehl++; *_bz++ = (TL_BYTE) TL_MOD( COEFF(_n,zaehl,(INT)lambda[1]) ,pz); if (nexgitt(g_j,lambda,&g_jm)) { SYM_free(start); return no_memory(); } } if (!i) { dim=j; if (dim>MAXDM) { dim *= ((INT)-1); break; } } if (dim(INT)0) { while ((INT)2*y[1]>x[1]) for (i=(INT)0;i<2L;++i) { yh=y[i]; y[i]=x[i]-y[i]; x[i]=yh; } q=x[1]/y[1]; r=x[1]%y[1]; yh=y[0]; y[0]=x[0]-q*y[0]; x[0]=yh; x[1]=y[1]; y[1]=r; } x[0]= z<(INT)0 ? -x[0] : x[0]; /* return(((x[0]%p)<(INT)0) ? x[0]%p+p : x[0]%p); */ return(((z=(x[0]%p))<(INT)0) ? z+p : z); } /* invp */ /* Makros zur Modulararithmetik */ /******************************************************************************* * * Datei MODULKFF.C * Version vom 29.09.89 * * * Zeile Funktion * * * Funktionen fuer Mengenoperationen * --------------------------------- * 88 INT setmin(TL_BYTE *a) * 107 INT a_teilmenge_b(TL_BYTE *a,TL_BYTE *b) * 129 INT leer(TL_BYTE *a) * 148 a_ohne_b_gl_c(TL_BYTE *a,TL_BYTE *b,TL_BYTE *c) * * Funktionen zur Berechnung der Koeffizientenmatrix (B,C_eins,C_zwei) * ----------------------------------------------------------- * 175 INT zykschnitt(INT *t_eins,INT *t_zwei,INT *perm,INT *zykmt) * 216 INT inzeil(INT la,TL_BYTE *zmat,TL_BYTE *fln) * 355 INT j_zyk(INT la,INT j_zwei,TL_BYTE **xm,TL_BYTE *zh) * 454 INT k_alzyk(INT la,INT *zmat,INT *fln,INT *cy) * 523 INT alzyk(INT la,INT *zmat,INT *fln,INT *cy) * 547 INT sigper(INT *fln,INT la) * 586 INT symdet(TL_BYTE *mat,TL_BYTE *slambda,INT li,INT *tsc) * 804 INT fak(INT i) * 820 INT alcoeff(INT *mat,INT *slambda) * 849 INT nexgitt(TL_BYTE *y,TL_BYTE *lambda,INT *mtc) * 918 INT zweikonmat(INT *lambda,INT *perm,INT *bz) * 1003 konjugiere(INT *lambda,INT *lambdastrich) * 1025 schnitt(INT *t_eins,INT *t_zwei,INT *mat) * 1043 INT mat_comp(TL_BYTE *co,TL_BYTE *mat,INT *slamda) * * Hauptfunktion * ------------- * 1099 INT alkonmat(INT *lambda,INT *perm,INT *bz) * *******************************************************************************/ /* Headerfiles wie in jedem C-Programm,... */ /* interne Makros ... */ /* #define IND(a,b,c) (INT)((INT)(a)*(INT)(c)+(INT)(b)) */ #define IND(a,b,c) ((INT)(a)*(INT)(c)+(b)) /* #define COEFF(x,y,z) ((z-y)%2L)?((-1L)*fak(x+y-2L*z)*fak(z-y)*fak(z)) \ : (fak(x+y-2L*z)*fak(z-y)*fak(z)) */ #define INDEX(x) ZYK/2+x /******************************************************************************* * * Funktionen fuer Mengenoperationen ... * * Mengen sind Felder a mit Eintraegen a[i]: * Element i nicht enthalten => a[i]=0 * Element i enthalten => a[i]=1 * *******************************************************************************/ /*----------------------------------------------------------------------------*/ static INT setmin(a) TL_BYTE *a; /*------------------------------------------------------------------------------ errechnet das Minimum der Menge a. Rueckgabewerte: Elementnummer m, falls m Minimum ist; -1L, falls kein Minimum existiert. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *_a; INT m; for (m=(INT)0,_a=a;m<_n;m++,_a++) if (*_a) return(m); return(-1L); } /*----------------------------------------------------------------------------*/ static INT a_teilmenge_b(a,b) TL_BYTE *a, *b; /*------------------------------------------------------------------------------ ueberprueft, ob Menge a Teilmenge von Menge b ist. Rueckgabewerte: TRUE, falls a Teilmenge von b ist; FALSE, falls a nicht Teilmenge von b ist. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *_a,*_b; INT m; for (m=(INT)0,_a=a,_b=b;m<_n;m++,_a++,_b++) if (*_a) { if (! *_b) return(FALSE); } return(TRUE); } /*----------------------------------------------------------------------------*/ static INT leer(a) TL_BYTE *a; /*------------------------------------------------------------------------------ ueberprueft, ob die Menge a leer ist. Rueckgabewerte: TRUE, falls a leer ist; FALSE, falls a nicht leer ist. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { INT m; for (m=(INT)0;m<_n;m++,a++) if (*a) return (FALSE); return (TRUE); } /*----------------------------------------------------------------------------*/ static INT a_ohne_b_gl_c(a,b,c) TL_BYTE *a,*b,*c; /*------------------------------------------------------------------------------ berechnet die Menge a\b. Rueckgabe Menge c = a\b. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { INT m; for (m=(INT)0;m<_n;m++,a++,b++,c++) { if (*b) *c = (TL_BYTE)0; else *c = *a; } return OK; } /******************************************************************************* * * Funktionen fuer die Bestimmung der Koeffizientenmatrix (B,C_eins,C_zwei)... * *******************************************************************************/ /*----------------------------------------------------------------------------*/ static INT zykschnitt (t_eins,t_zwei,perm,zykmt) TL_BYTE *t_eins, *t_zwei, *perm, *zykmt; /*------------------------------------------------------------------------------ berechnet Schnittmatrix zykmt in Abhaengigkeit von der Permutation perm. Rueckgabewerte: (INT)0, falls alles ohne Fehler durchgefuehrt werden konnte; (INT)-109, falls nicht genuegend Speicher zu Verfuegung steht. Rueckgabe Schnittmatrix zykmt. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { INT i,j; TL_BYTE *zeile,*z; INT enthalten; zeile=(TL_BYTE *)TL_calloc((int)_n*(int)_n,sizeof(TL_BYTE)); if (!zeile) return no_memory(); for (i=q_zeilenz,z=zykmt;i>(INT)0;i--,*z++ = (INT)0); /* Berechnung der Zeilenziffernmengen von (perm)T2: */ for (i=_n-1L;i>=(INT)0;--i) zeile[IND(t_zwei[i],perm[i]-1L,_n)]=1L; for (j=(INT)0;j<_n;++j) { enthalten=FALSE; i=(INT)0; do { if (zeile[IND(i,j,_n)]) { ++zykmt[IND(t_eins[j],i,_zeilenz)]; enthalten=TRUE; } else ++i; } while (!enthalten); } SYM_free(zeile); return (INT)0; } /* zykschnitt */ /*----------------------------------------------------------------------------*/ static INT inzeil(la,zmat,fln) INT la; TL_BYTE *zmat, *fln; /*------------------------------------------------------------------------------ bestimmt, falls moeglich, paarweise verschiedene Ziffern i_eins,i2L,...,ilambda1L, welche die injektive erste Zeile eines Elementes von [Ts]c darstellen. (Weitere Erlaeuterung in: Golembiowski, Andreas Zur Berechnung modular irreduzibler Matrixdarstellungen symmetrischer Gruppen mit Hilfe eines Verfahrens von M.Clausen Bayreuther Mathematische Schriften Heft 25L, Bayreuth 1987 SS. 162ff) Variablen: la, Teil der konjugierten Partition; zmat, Schnittmatrix. Rueckgabewerte: (INT)-109, falls kein Speicher zur Verfuegung stand; (INT)0, sonst. Rueckgabe Matrix fln. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { INT i,i_eins,j,j_eins,r,k,m,oz; TL_BYTE **xm,**qu,*ze[2],*un,*hilf; xm=(TL_BYTE **)TL_calloc((int)(_zeilenz+_zeilenz+2L),sizeof(TL_BYTE *)); if (!xm) return no_memory(); qu=xm+(INT)_zeilenz+1L; hilf=(TL_BYTE *)TL_calloc((int)(_zeilenz+_zeilenz+6L)*(INT)_n,sizeof(TL_BYTE)); if (!hilf) { SYM_free(xm); return no_memory(); } un=hilf+(INT)_n; ze[0]=un+(INT)_n; ze[1]=ze[0]+(INT)_n; xm[0]=ze[1]+(INT)_n; for (i=1L;i<=_zeilenz;xm[i]=xm[i-1]+(INT)_n,i++); qu[0]=xm[_zeilenz]+(INT)_n; for (i=1L;i<=_zeilenz;qu[i]=qu[i-1]+(INT)_n,i++); for (j=(INT)0;j=1L) { for (j=(INT)0;fln[j]!=i_eins || j==j_eins;j++); j_eins=j; i=(INT)0; while (fln[j_eins]==i_eins) if (xm[k-1][i] && zmat[IND(i,j_eins,_zeilenz)]) fln[j_eins]=i; else ++i; i_eins=i; --k; } ze[0][i_eins]=(TL_BYTE)1; } else r=la; } SYM_free(hilf); SYM_free(xm); return((INT)0); } /* inzeil */ /*----------------------------------------------------------------------------*/ static INT j_zyk(la,j_zwei,xm,zh) INT la,j_zwei; TL_BYTE **xm, *zh; /*------------------------------------------------------------------------------ berechnet Menge der Zyklen (j_null j_eins ... jk). (Weitere Erlaeuterung in: Golembiowski, Andreas Zur Berechnung modular irreduzibler Matrixdarstellungen symmetrischer Gruppen mit Hilfe eines Verfahrens von M.Clausen Bayreuther Mathematische Schriften Heft 25L, Bayreuth 1987 SS. 166ff) Variablen: la, Element der konjugierten Partition; j_zwei, erstes Element des Zykels; xm, Mengen. Rueckgabewerte: (INT)-109, nicht genug Speicher; (INT)0, sonst. Rueckgabe Vektor zh. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { INT i,k,l,nr,m; static TL_BYTE *j=NULL; static TL_BYTE *ym=NULL,*hilf=NULL,**xm_eins=NULL; static INT old_z = (INT)-1; if (la == (INT)-15) { if (j != NULL) { SYM_free(j); j = NULL; } if (xm_eins != NULL) { SYM_free(xm_eins); xm_eins = NULL; } old_z = (INT)-1; return (INT)0; } if (old_z < _zeilenz) { if (j != NULL) SYM_free(j); if (xm_eins != NULL) SYM_free(xm_eins); j=(TL_BYTE *)TL_calloc((int)_zeilenz+1 + (int)(_zeilenz+2L)*(int)_n ,sizeof(TL_BYTE)); xm_eins=(TL_BYTE **) TL_calloc((int)_zeilenz,sizeof(TL_BYTE *)); if (!j) return no_memory(); if (!xm_eins) { SYM_free(j); return no_memory(); } hilf = j + (int)_zeilenz+1; ym=hilf+_n; xm_eins[0]=ym+_n; for (i=1L;i<_zeilenz;xm_eins[i]=xm_eins[i-1]+_n,i++); old_z = _zeilenz; } j[0]=j_zwei; memset(&zh[INDEX(-la)],0,(ZYK+la+1) * sizeof(TL_BYTE) ); if (la >= ZYK) error("internal error MO-5"); for (i= 0;i=2L;--i) zh[INDEX(l+k+4-i)]=j[i-1]+1L; l=l+k+3L; } ym[j[k-1]]=1L; a_ohne_b_gl_c(xm_eins[j[k]],ym,hilf); if (!leer(hilf)) ++k; else { while (leer(hilf) && (k>=1L)) { xm_eins[j[k-1]][j[k]]=(INT)0; ym[j[k]]=(INT)0; for (m=(INT)0;m<_n;xm_eins[j[k]][m]=xm[j[k]][m],m++); --k; a_ohne_b_gl_c(xm_eins[j[k]],ym,hilf); } if (k>=1L) ++k; } } while (k); } return((INT)0); } /* j_zyk */ /*----------------------------------------------------------------------------*/ static INT k_alzyk(la,zmat,fln,cy) INT la; TL_BYTE *cy; TL_BYTE *zmat, *fln; /*------------------------------------------------------------------------------ initialisiert Felder, die im Unterprogramm j_zyk benoetigt werden, und ruft j_zyk auf. (Weitere Erlaeuterung in: Golembiowski, Andreas Zur Berechnung modular irreduzibler Matrixdarstellungen symmetrischer Gruppen mit Hilfe eines Verfahrens von M.Clausen Bayreuther Mathematische Schriften Heft 25L, Bayreuth 1987 SS. 168ff) Variablen: la, Element der konjugierten Partition; zmat, Schnittmatrix; fln, Matrix aus inzeil. Rueckgabewerte: (INT)-109, nicht genug Speicher; (INT)0, sonst. Rueckgabe Matrix aller Zyklen. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { INT i,j_eins,j_zwei,m; TL_BYTE *zh; TL_BYTE *z_eins,*z_zwei; TL_BYTE **xm; xm=(TL_BYTE **)TL_calloc((int)_zeilenz,sizeof(TL_BYTE *)); if (!xm) return no_memory(); xm[0]=(TL_BYTE *)TL_calloc((int)_zeilenz*(int)_n,sizeof(TL_BYTE)); if (!xm[0]) { SYM_free(xm); return no_memory(); } zh=(TL_BYTE *)TL_calloc((int)_zyk,sizeof(TL_BYTE)); if (!zh) { SYM_free(xm[0]); SYM_free(xm); return no_memory(); } for (i=1L;i<_zeilenz;xm[i]=xm[i-1]+_n,i++); for (j_eins=(INT)0,z_eins=zmat;j_eins=(INT)0) { if (k_alzyk(la,zmat,fln,cy)) return no_memory(); } return((INT)0); } /* alzyk */ /*----------------------------------------------------------------------------*/ static INT sigper(fln,la) TL_BYTE *fln, la; /*------------------------------------------------------------------------------ berechnet sgn(fln). Variablen: fln, gewisses pi* aus inzeil; la, Element aus konjugierter Partition. Rueckgabewert: (INT)-109, falls nicht genuegend Speicher; signum, sonst. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *hilf; INT i,j,k,l,v; hilf=(TL_BYTE *)TL_calloc((int)_zeilenz,sizeof(TL_BYTE)); if (!hilf) return no_memory(); for (i=(INT)0;i<_zeilenz;hilf[i]=fln[i],i++); v=1L; for (i=(INT)0;i=(INT)0) && (hilf[i]!=i)) { l=1L; j=hilf[i]; while (j>=(INT)0 && hilf[j]!=i) { ++l; k=hilf[j]; hilf[j]= -1L; j=k; } if (j>=(INT)0) /* AK 030194 */ hilf[j]= -1L; if (l%2L) v *= (-1L); } SYM_free(hilf); return(v); } /* sigper */ /*----------------------------------------------------------------------------*/ static INT symdet (mat,slambda,li,tsc) TL_BYTE *mat, *slambda; INT li, *tsc; /*------------------------------------------------------------------------------ berechnet einen Faktor des Koeffizienten zur Schnittmatrix mat. (Weitere Erlaeuterung in: Golembiowski, Andreas Zur Berechnung modular irreduzibler Matrixdarstellungen symmetrischer Gruppen mit Hilfe eines Verfahrens von M.Clausen Bayreuther Mathematische Schriften Heft 25L, Bayreuth 1987 SS. 170ff) Variablen: mat, Schnittmatrix; slambda, konjugierte Partition; li, Element aus slambda. Rueckgabewerte: (INT)-108, falls Resttableau falsch; (INT)-109, falls nicht genug Speicher; (INT)0, sonst. Rueckgabe Koeffizientenfaktor tsc. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *cy,*pi,*zmat,*fln,*hfl,*afl,*ii,*z; INT lpi,i,j,k,l,d,la,_li,signum,bv,ik,r,err; TL_BYTE *piset,*mpi,*zm; _li=li; la=slambda[_li]; ++_li; if (la==1L) { if (mat[0]==(_spaltenz-_li+1L)) { *tsc=1L; return((INT)0); } else { *tsc=(INT)0; return((INT)0);/*return(RTabFt);*/ } } cy=(TL_BYTE *)TL_calloc((int)_zeilenz*((int)_zyk+2*(int)_zeilenz+5), sizeof(TL_BYTE)); if (!cy) return no_memory(); mpi=(TL_BYTE *)TL_calloc((int)q_zeilenz+(int)_zeilenz,sizeof(TL_BYTE)); if (!mpi) { SYM_free(cy); return no_memory(); } pi=cy+_zeilenz*_zyk; zmat=pi+_zeilenz*(_zeilenz+1L); fln=zmat+q_zeilenz; hfl=fln+_zeilenz; afl=hfl+_zeilenz; ii=afl+_zeilenz; piset=mpi+_zeilenz; *tsc=(INT)0; matcopy(zmat,mat,_zeilenz); if (alzyk(la,zmat,fln,cy)) { SYM_free(cy); SYM_free(mpi); return no_memory(); } if (fln[0]>=(INT)0) { for (r=(INT)0;r<_zeilenz;afl[r]=fln[r],r++); signum=sigper(fln,la); /* kann nich sein AK 090792 if (signum==NtEMem) { SYM_free(cy); SYM_free(mpi); return(NtEMem); } */ bv= *tsc; if (_li == _spaltenz) *tsc=signum; else { for (j=(INT)0;j1L) --k; if (pi[IND(k-1L,1L,_zeilenz+1L)]) { --k; for (r=(INT)0;r<_zeilenz;fln[r]=afl[r],r++); pi[IND(k,1L,_zeilenz+1L)]=(INT)0; for (r=(INT)0,zm= &piset[IND(k,(INT)0,_zeilenz)];r<_zeilenz;r++,zm++) if (*zm) mpi[r]=(INT)0; lpi -= pi[IND(k,(INT)0,_zeilenz+1L)]; if ((pi[IND(k,(INT)0,_zeilenz+1L)]+1L)%2L) signum *= (-1L); ++ii[k]; goto fl100; } } } SYM_free(cy); SYM_free(mpi); return((INT)0); } /* symdet */ /*----------------------------------------------------------------------------*/ static INT alcoeff(mat,slambda) TL_BYTE *mat, *slambda; /*------------------------------------------------------------------------------ berechnet aus der Schnittmatrix mat und Partition slambda den Koeffizienten. Variablen: mat, Schnittmatrix; slambda, konjugierte Partition zu lambda; Rueckgabewerte: koeff, Koeffizient zu mat und slambda; (INT)-108, falls ein Resttableau falsch war; (INT)-109, falls kein Speicherplatz vorhanden war. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *z; INT i,tsc,faktor; faktor=symdet(mat,slambda,(INT)0,&tsc); if (faktor) return(faktor); if (tsc) { for (i=q_zeilenz,z=mat,faktor=1L;i>(INT)0;i--,z++) if (*z) faktor *= fak((INT) *z); return(faktor*tsc); } else return (INT)0; } /* alcoeff */ /*----------------------------------------------------------------------------*/ static INT zweikonmat(lambda,perm,bz) TL_BYTE *lambda,*perm,*bz; /*------------------------------------------------------------------------------ berechnet die Koeffizientenmatrix bz fuer Partitionen lambda der Laenge 2. Variablen: lambda, eigentliche Partition; perm, Permutation. Rueckgabe Koeffizientenmatrix bz. Rueckgabewerte: dim, Dimension der gewoehnlichen Darstellungen, dim ist negativ, falls dim groesser MAXDM; (INT)-109, falls kein Speicherplatz vorhanden war. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { INT i,j,k,l,z,zaehl[3],mdim,dim; TL_BYTE *hz,*g_i,*g_j,*start,*hilf_zwei,*hilf_drei,*_hz,*_bz,*z_eins; INT g_im,g_jm; start=(TL_BYTE *)TL_calloc((int)_n*5+(int)MAXDM*3,sizeof(TL_BYTE)); if (!start) return no_memory(); g_i=start+_n; g_j=g_i+_n; hilf_zwei=g_j+_n; hilf_drei=hilf_zwei+_n; hz=hilf_drei+_n; mdim=MAXDM; g_im=FALSE; if (nexgitt(start,lambda,&g_im)) { SYM_free(start); return no_memory(); } for (z=(INT)0;z<_n;g_i[z]=start[z],z++); for (i=(INT)0,g_im=TRUE;g_im;++i) { for (z=(INT)0;z<_n;g_j[z]=start[z],z++); for (z=3L*mdim,_hz=hz;z>(INT)0;z--,*_hz++ = (INT)0); for (j=(INT)0,g_jm=TRUE,_hz=hz;g_jm;j++,_hz++) { for (z=(INT)0;z<3L;zaehl[z++]=(INT)0); for (z=(INT)0;z<_n;hilf_zwei[z]=hilf_drei[perm[z]-1]=g_j[z],z++); hilf_zwei[1]=(INT)0; for (l=(INT)0;l<_n;++l) if (g_i[l]==1L) { if (g_j[l]==1L) ++zaehl[0]; if (hilf_zwei[l]==1L) ++zaehl[1]; if (hilf_drei[l]==1L) ++zaehl[2]; } for (z=(INT)0,z_eins=_hz;z<3L;z++,z_eins += mdim) *z_eins=COEFF(_n,(INT)zaehl[z],(INT)lambda[1]); if (nexgitt(g_j,lambda,&g_jm)) { SYM_free(start); return no_memory(); } } if (!i) { dim=j; if (dim>MAXDM) { dim *= (-1L); break; } else _bz=bz; } for (z=(INT)0,_hz=hz;z<3L;z++,_hz += mdim) for (k=(INT)0,z_eins=_hz;k< dim;k++) *_bz++ = *z_eins++; if (dim=i+1L;++j); if ((j<_n) && (lambda[j] < i+1L)) lambdastrich[i]=j; else lambdastrich[i]=_zeilenz; } return OK; } /* konjugiere */ /*----------------------------------------------------------------------------*/ static INT schnitt(t_eins,t_zwei,mat) TL_BYTE *t_eins, *t_zwei, *mat; /*------------------------------------------------------------------------------ berechnet Schnittmatrix zu den Tableaux t_eins und t_zwei. Variablen: t_eins, Tableau; t_zwei, Tableau. Rueckgabe Schnittmatrix mat. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *z; INT i; memset(mat,0,q_zeilenz * sizeof(TL_BYTE)); for (i=(INT)0;i<_n;++i) ++mat[IND(t_eins[i],t_zwei[i],_zeilenz)]; return OK; } /*schnitt*/ struct ak { INT c; INT p; char *ptr; }; static struct ak * ak_tmpfile() { #ifdef UNDEF struct ak *a; a = (struct ak *) TL_calloc((int)1,sizeof(struct ak)); if (a==NULL) return (struct ak *) no_memory(); a->c = (INT)0; /* erste unzulaessige stelle */ a->p = (INT)0; a->ptr = NULL; #endif init_mat(); } static ak_rewind(a) struct ak *a; { a->p = (INT)0; return OK; } static ak_fread(buf,size,numb,a) char **buf; INT size; INT numb; struct ak *a; { size = size * numb; if (a->p + size > a->c) size = a->c - a->p; *buf = a->ptr + a->p; a->p = a->p + size; return a->p; } #define AXSIZE 10000 static ak_fwrite(buf,size,numb,a) char *buf; INT size; INT numb; struct ak *a; { size = size *numb; if (a->ptr == NULL) { a->ptr = (char *)TL_calloc(AXSIZE,1); a->c = AXSIZE; } again: if (a->ptr == NULL) return no_memory(); if (a->p + size > a->c) { a->ptr = (char *) SYM_realloc(a->ptr,a->c + AXSIZE); if (a->ptr == NULL) return no_memory(); a->c = a->c + AXSIZE; goto again; } memcpy(a->ptr + a->p, buf,(int) size); a->p = a->p + size; return a->p; } static ak_fclose(a) struct ak *a; { close_mat(); } /* #define ak_fclose(a) fclose(a) #define ak_tmpfile() tmpfile() #define ak_rewind(a) rewind(a) #define ak_fwrite(buf,size,numb,a) fwrite(buf,size,numb,a) #define ak_fread(buf,size,numb,a) fread(buf,size,numb,a) */ static INT tl_prime = (INT) 9973; static INT tl_max_numb = (INT) 8; static INT tl_index_inc = (INT) 1; static TL_BYTE **mat_table; static TL_2BYTE **koeff_table; static INT *mat_length; static INT mat_size; INT tl_set_prime(p) INT p; { tl_prime = p; } INT tl_set_max_numb(p) INT p; { tl_max_numb = p; } INT tl_set_index_inc(p) INT p; { tl_index_inc = p; } #ifdef UNDEF #define PRIME 9973 /* 40993 */ #define INDEX_INC 1 #define MAX_NUMB 8 TL_BYTE *mat_table[PRIME]; TL_2BYTE *koeff_table[PRIME]; INT mat_length[PRIME]; #endif static init_mat() { INT i,size; TL_BYTE *a,*b; mat_table = (TL_BYTE **) TL_calloc(tl_prime,sizeof(TL_BYTE *)); mat_length = (INT *) TL_calloc(tl_prime,sizeof(INT)); koeff_table = (TL_2BYTE **) TL_calloc(tl_prime,sizeof(TL_2BYTE *)); mat_size = q_zeilenz; size = tl_prime * tl_max_numb * (q_zeilenz + sizeof(TL_2BYTE)); a = (TL_BYTE *) TL_malloc(size * sizeof(TL_BYTE)); b = a; for (i=(INT)0;i 31) { k = q_zeilenz / 32; for (;k>0;k--) for (j=(INT)0; j<32;i+=tl_index_inc,j+=tl_index_inc) if (mat[i]) index += offset[j]; } for (j=(INT)0; i= tl_max_numb) { mat_length[index]++; * (koeff_table[index]+ (mat_length[index] % tl_max_numb) ) = koeff; memcpy(mat_table[index]+ (q_zeilenz* (mat_length[index]%tl_max_numb) ), mat, q_zeilenz * sizeof(TL_BYTE)); } else { mat_length[index]++; * (koeff_table[index]+mat_length[index]-1) = koeff; memcpy(mat_table[index]+ (q_zeilenz*(mat_length[index]-1)), mat, q_zeilenz * sizeof(TL_BYTE)); } } static INT search_mat(co,mat, koeff) TL_BYTE *mat; TL_2BYTE *koeff; INT *co; { INT i=(INT)0,k,j; UINT index=(INT)0; /* compute adress */ if (q_zeilenz > 31) { k = q_zeilenz / 32; for (;k>0;k--) for (j=(INT)0; j<32;i+=tl_index_inc,j+=tl_index_inc) if (mat[i]) index += offset[j]; } for (j=0; i=0 ; i--) if (SYM_memcmp(mat,(mat_table[index])+(q_zeilenz * i), sizeof(TL_BYTE) * q_zeilenz) == 0) { *koeff = * (koeff_table[index] + i); return OK; } return -12L; } /*----------------------------------------------------------------------------*/ static INT mat_comp(co,mat,slambda) INT *co; TL_BYTE *mat,*slambda; /*------------------------------------------------------------------------------ ueberprueft die Schnittmatrix mat, ob mit dieser schon gerechnet wurde. Ist dies der Fall, so ist der Koeffizient gleich. Ansonsten wird fuer mat der neue Koeffizient berechnet. Variablen: co, Zaehler der verschiedenen Schnittmatrizen; mat, Schnittmatrix; slambda, konjugierte Partition zu lambda; Rueckgabe co mit alter bzw. neuer Anzahl der verschiedenen Schnittmatrizen. Rueckgabewerte: koeff, Koeffizient zu mat und slambda; (INT)-109, falls nicht genuegend Speicher vorhanden ist. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { INT gefunden, i,erg; TL_BYTE *schnittmat ,*z_eins,*z_zwei ,rr ; TL_2BYTE koeff; TL_BYTE *ak_buffer; /* AK 060392 */ i=1L; if ((*co)>(INT)0) { erg = search_mat(co,mat,&koeff); if (erg == OK) return koeff; } ++(*co); koeff = alcoeff(mat,slambda); if (koeff==RTabFt || koeff==NtEMem) return(koeff); write_mat(mat,koeff); return koeff; } /* mat_comp */ /*----------------------------------------------------------------------------*/ static INT alkonmat(lambda,perm,bz) TL_BYTE *lambda, *perm, *bz; /*------------------------------------------------------------------------------ berechnet zu einer Partition lambda und einer Permutation perm die Koeffi- zientenmatrix (B|C(12)|C(perm)). Variablen: lambda, eigentliche Partition; perm, Permutation. Rueckgabewerte: >(INT)0, kein Fehler aufgetreten; (INT)-10, falls Pointer auf lambda NULL ist; (INT)-11, falls lambda leer ist; (INT)-12, falls ein Element von lambda kleiner 0 ist; (INT)-13, falls lambda keine eigentliche Partition ist; // -15L, falls n > MAXN; // -16L, falls Laenge von lambda groesser MAXZEILENZ ist; // -17L, falls erstes Element von lambda groesser MAXSPALTENZ ist; (INT)-18, falls Dimension der gew. irred. Dg. >MAXDIM; (INT)-19, falls Pointer auf bz NULL ist; (INT)-20, falls sich der temporaere File nicht oeffnen laesst; (INT)-30, falls Pointer auf perm NULL ist; (INT)-31, falls Teil von perm <= 0 ist; (INT)-32, falls Teil von perm > n ist; (INT)-33, falls perm zu viele Elemente hat; (INT)-108, falls Resttableau in SYMDET falsch ist; (INT)-109, falls nicht genuegend Speicher vorhanden ist. Rueckgabe Koeffizientenmatrix bz. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *mat,*transmt,*zykmt,*hz,*t_eins,*t_zwei; TL_BYTE *ht,*asslambda,*_hz,*_bz,*z_eins; INT ii,jj,kk,i,k,z,co = (INT)0,co_eins,co_zwei,dim,diag,mdim,dim_,koeff; INT mehr_eins,mehr_zwei; /* Moegliche Eingabefehler... */ if (!lambda) return(LmbNul); else if (!lambda[0]) return(LmbEmp); else if (!bz) return(BzNul); for (i=(INT)0,_n=(INT)0;lambda[i];++i) if (lambda[i]<(TL_BYTE)0) return(LmbLt_null); else _n += lambda[i]; /* if (_n>MAXN) return(NGtMax); else */ if (perm==NULL) return(PerNul); /* for (i=(INT)0;i_n) return(PeLgGN); */ for (i=(INT)0;i<_n;i++) if (perm[i]<=(INT)0) return(PerLe_null); else if (perm[i]>_n) return(PerGtN); for (i=1L;lambda[i];++i) if (lambda[i]>lambda[i-1]) return(LmbNRg); /* Na denn ma' los... */ _zyk=ZYK/2+ZYK+1L; _spaltenz=lambda[0]; /*AK 240194 */ _zeilenz = i ; /* AK 240194 */ /* if ((_spaltenz=lambda[0])>MAXSPALTENZ) return(SzGtMx); if ((_zeilenz=i)>MAXZEILENZ) return(ZzGtMx); */ q_zeilenz=_zeilenz*_zeilenz; if (_zeilenz==2L) { dim_=zweikonmat(lambda,perm,bz); if (dim_<(INT)0) dim=DmGtMx; else dim=dim_; } else { /* allgemeine Partition/Anfang */ init_mat(); mat=(TL_BYTE *)TL_calloc((int)(q_zeilenz+MAXDM)*3+(int)(4*_n),sizeof(TL_BYTE)); if (mat == NULL) { close_mat(); return no_memory(); } transmt=mat+q_zeilenz; zykmt=transmt+q_zeilenz; t_eins=zykmt+q_zeilenz; t_zwei=t_eins+_n; ht=t_zwei+_n; asslambda=ht+_n; hz=asslambda+_n; mdim=MAXDM; konjugiere(lambda,asslambda); for (ii=(INT)0,diag=1L;ii<_zeilenz;++ii) diag *= fak(lambda[ii]); for (ii=(INT)0,kk=(INT)0;ii<_n && lambda[ii];++ii) { for (jj=kk;jj < (kk+lambda[ii]);ht[jj++]= ii); kk += lambda[ii]; } for (z=(INT)0;z<_n;t_zwei[z]=ht[z],z++); co_eins=co_zwei=(INT)0; for (i=(INT)0,mehr_zwei=TRUE;mehr_zwei;++i) { for (z=(INT)0;z<_n;t_eins[z]=ht[z],z++); for (z=3L*mdim,_hz=hz;z>(INT)0;z--,*_hz++ =(INT)0); for (k=(INT)0,mehr_eins=TRUE;mehr_eins;++k) { if (i==k) /*Hauptdiag. von B(lambda) und C(lambda/(12))*/ { hz[i]=diag; if (t_zwei[1]== 1) hz[i+mdim]=((TL_BYTE) -1)*(hz[i]/lambda[0]); else hz[i+mdim]=hz[i]; } else if (iii) co_eins++; } else hz[k+mdim]= hz[k]; } if (zykschnitt(t_zwei,t_eins,perm,zykmt)) { close_mat(); SYM_free(mat); return no_memory(); } /*Berechnung von C(lambda/(1..n)).*/ if (!i && !k) { co=(INT)0; koeff=mat_comp(&co,zykmt,asslambda); if (koeff!=NtEMem && koeff!=RTabFt) hz[2L*mdim]=koeff; else { close_mat(); SYM_free(mat); mehr_zwei = 280194L; nexgitt(NULL,NULL,&mehr_zwei); /* AK 280194 */ return(koeff); } } ii=co; koeff=mat_comp(&co,zykmt,asslambda); if (koeff!=NtEMem && koeff!=RTabFt) hz[k+2L*mdim]=koeff; else { close_mat(); SYM_free(mat); mehr_zwei = 280194L; nexgitt(NULL,NULL,&mehr_zwei); /* AK 280194 */ return(koeff); } if (co>ii) ++co_zwei; if (nexgitt(t_eins,lambda,&mehr_eins)) { close_mat(); SYM_free(mat); return no_memory(); } } if ((_zeilenz==1L) || (_spaltenz==1L)) co=1L; if (!i) { dim=dim_=k; if (dim>MAXDM) { dim_ *= (-1L); dim=DmGtMx; break; } else _bz=bz; } for (z=(INT)0,_hz=hz;z<3L;z++,_hz += mdim) for (k=(INT)0,z_eins=_hz;k(INT)0, Dimension der gew. irred. Darstellung; sonst, s. MODULKFF.C Funktion alkonmat(). ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *mat,*t_eins,*t_zwei,*ht,*slambda,*hz; INT ii,jj,kk,i,k,z,co = (INT)0,dim,diag,mdim,dim_,koeff; INT mehr_eins,mehr_zwei; TL_BYTE *_bz; /* Moegliche Eingabefehler... */ if (!lambda) return(LmbNul); else if (!lambda[0]) return(LmbEmp); else if (!bz) return(BzNul); for (i=(INT)0,_n=(INT)0;lambda[i];++i) if (lambda[i]<0) return(LmbLt_null); else _n += (INT)lambda[i]; /* if (_n>MAXN) return(NGtMax); else */ if (pz<=(INT)0) return(PrmLe_null); else if (pz) { for (i=(INT)0;PZ[i]<=pz;i++); if (pz!=PZ[i-1]) return(NoPrm); } for (i=1L;lambda[i];++i) if (lambda[i]>lambda[i-1]) return(LmbNRg); /* Na denn ma' los... */ /* printeingabe("C1");*/ _zyk=ZYK/2L+ZYK+1L; _zeilenz = i; /* AK 240194 */ _spaltenz = lambda[0]; /* AK 240194 */ /* if ((_spaltenz=lambda[0])>MAXSPALTENZ) return(SzGtMx); if ((_zeilenz=i)>MAXZEILENZ) return(ZzGtMx); */ q_zeilenz=_zeilenz*_zeilenz; if (_zeilenz==2L) { dim_=_k_zweikonmat(lambda,bz,pz); /* kann nich sein AK 090792 if (dim_==NtEMem) return(NtEMem); */ if (dim_<(INT)0) dim=DmGtMx; else dim=dim_; } else { /* allgemeine Partition/Anfang */ /* printeingabe("C2");*/ init_mat(); mat=(TL_BYTE *)TL_calloc((int)(q_zeilenz)+(int)(4*_n)+1,sizeof(TL_BYTE)); if (mat == NULL) { close_mat(); return no_memory(); } t_eins=mat+(INT)q_zeilenz; t_zwei=t_eins+(INT)_n; ht=t_zwei+(INT)_n; /* printeingabe("C3");*/ slambda=ht+_n; mdim=MAXDM; _assoziiere(lambda,slambda,_n); for (ii=(INT)0,diag=1L;ii<_zeilenz;++ii) diag *= fak((INT)lambda[ii]); for (ii=(INT)0,kk=(INT)0;ii<_n && lambda[ii];++ii) { for (jj=kk;jj < (kk+lambda[ii]);jj++) ht[jj]=(TL_BYTE)ii; kk += lambda[ii]; } for (z=(INT)0;z<_n;t_zwei[z]=ht[z],z++); _bz=bz; for (i=(INT)0,mehr_zwei=TRUE;mehr_zwei;++i) { for (z=(INT)0;z<_n;t_eins[z]=ht[z],z++); for (k=0,hz=bz+i,mehr_eins=TRUE;mehr_eins;++k) { /* printeingabe("C4");*/ if (i==k) *_bz++ = (TL_BYTE) TL_MOD(diag,pz); else if (kMAXDM) { dim_ *= (-1L); dim=DmGtMx; error("mo.c:internal error 400"); break; } } if (dim0; kk-= AKSIZE) { for (jj=0;jj 0) ;ii++) { hz[MAXDM*ii+jj] = bz[jj*MAXDM+(kk-ii)]; } for (ii=0;(ii 0) ;ii++) memcpy(&bz[(kk-ii)*MAXDM], &hz[ii * MAXDM], kk-ii); } /* for (i=0;ii;j--) { mu= *z_zwei; *z_zwei++ = *z_eins; *z_eins++ = mu; } if (*_bz) { if ((qu= *_bz)!=(TL_BYTE)1) for (j=dm,z_eins=_bz;j>i;j--,z_eins++) { if (*z_eins) /* AK 010394 */ *z_eins=(TL_BYTE)TL_DIVP(*z_eins,qu,pz); } if (ii;j--,z_eins++,z_zwei++) if (*z_zwei) { *z_eins = TL_MOD( *z_eins - qu * *z_zwei, pz); } } } return OK; } /* _k_moddreimat */ /*----------------------------------------------------------------------------*/ static INT _k_modgauss(bz,pz) TL_BYTE *bz; INT pz; /*------------------------------------------------------------------------------ berechnet mit Hilfe des Gaussalgorithmus ueber GF(pz) die Dimension der modular irreduziblen Darstellung. (Vgl. in MODULDG.C Funktion modgauss().) Variablen: bz, Matrix mit Basis; pz, Primzahl. Rueckgabe bz. Rueckgabewert: Dimension der mod. irred. Darstellung. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *_bz,*z_eins,*z_zwei,*z_drei,*z_vier,qu; INT i,j,k,prang; TL_BYTE mu; prang=(INT)0; for (i=dm-1,_bz= &bz[qdm-1];i>0;i--,_bz -= (dm+1L)) if (*_bz) { if ((qu= *_bz)!=(TL_BYTE)1) for (k=i,z_eins=_bz;k=0;j--,z_zwei -= dm) if ((qu= *z_zwei)!=(TL_BYTE)0) for (k=dm,z_drei=z_eins,z_vier=z_zwei;k>i;k--,z_drei++,z_vier++) if (*z_drei) { *z_vier = TL_MOD(*z_vier - qu * *z_drei, pz); } } else prang++; if (bz[0]!=(TL_BYTE)1) { if ((qu=bz[0])==(TL_BYTE)0) prang++; else for (j=0,_bz=bz;j 0L) /* AK 230996 */ check_time(); d=r[0]; if (mode) { sum=(r[d]==1L)? m[d--]+1L : 1L; f=r[d]-1L; if (m[d]!=1L) m[d++]--; r[d]=f; m[d]=(sum/f)+1L; s=sum % f; if (s>(INT)0) { r[++d]=s; m[d]=1L; } r[0]=d; return(m[d]!=n); } else { r[0]=m[1]=1L; r[1]=n; return(n!=1L); } } /* _nexpart */ /*----------------------------------------------------------------------------*/ static INT _part_reg(p,r,m) INT p; TL_BYTE *r, *m; /*------------------------------------------------------------------------------ ueberprueft die Partition gegeben durch r und m, ob sie p-regulaer ist. Variablen: p, Primzahl; r, Partition mit r[0]=Laenge von r und m, r[1]...r[r[0]] Elemente der Partition; m, Vielfachheiten von r[1]...r[r[0]]. Rueckgabewerte: (INT)0, falls Partition nicht p-regulaer; 1L, falls Partition p-regulaer ist. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { INT i; for (i=1L;i<=r[0];i++) if (m[i]>=p) return((INT)0); return(1L); } /* _part_reg */ /*----------------------------------------------------------------------------*/ static INT _num_part(n,pz) INT n,pz; /*------------------------------------------------------------------------------ berechnet fuer pz=0 die Anzahl der Partitionen zu n und fuer pz!=0 die Anzahl der regulaeren Partitionen. Variablen: n, die zu partitionierende Zahl; pz, Primzahl oder 0. Rueckgabewerte: >(INT)0, die Anzahl der (p-regulaeren) Partitionen von n; (INT)-109, falls nicht genuegend Speicher vorhanden war. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { INT num,d,e; TL_BYTE *r,*m; r=(TL_BYTE *)SYM_calloc(2*(int)(n+1),sizeof(TL_BYTE)); m=r+(INT)n+1L; num=(INT)0; e=1L; d=(INT)0; while (e) { e=d=_nexpart(n,d,r,m); if (pz) { if (_part_reg(pz,r,m)) num++; } else num++; } SYM_free(r); return(num); } /* _num_part */ /*----------------------------------------------------------------------------*/ static INT _r_induk(lambda,n,pz,i,r) TL_BYTE *lambda; INT n,pz,i,r; /*------------------------------------------------------------------------------ ueberprueft die Moeglichkeit einer r-Induktion des zur Partition lambda gehoerenden Tableaux in der Zeile i. Variablen: lambda, Partition zu n; n; pz, Primzahl; i, Zeile des Tableaux; r, die "Ordnung" des anzuhaengenden Knotens. Rueckgabewerte: (INT)0, falls r-Induktion nicht moeglich; 1L, falls r-Induktion moeglich ist. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { INT len; for (len=(INT)0;lenlambda[i]) return(TL_MOD(lambda[i]-i,pz)==r); else return((INT)0); } else if (i==len) return(TL_MOD(-i,pz)==r); else return((INT)0); } /* _r_induk */ /*----------------------------------------------------------------------------*/ static INT _ber_lambdas(lambda,n,p) INT n,p; TL_BYTE **lambda; /*------------------------------------------------------------------------------ berechnet fuer p=0 alle eigentlichen Partitionen von n und fuer p!=(INT)0, p Primzahl, alle p-regulaeren Partitionen von n. Variablen: n, die zu partitionierende Zahl; p, Primzahl oder (INT)0; Rueckgabe lambda, Vektor von Partitionen. Rueckgabewerte: (INT)0, falls alle Partitionen ohne Fehler berechnet wurden; (INT)-109, falls kein Speicher zur Verfuegung stand. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *r,*m; INT d,e,i,j,k,l; r=(TL_BYTE *)TL_calloc((int)(n+1)*2,sizeof(TL_BYTE)); if (r == NULL) return no_memory(); m=r+(INT)(n+1L); e=1L; k=d=(INT)0; while(e) { d=e=_nexpart(n,d,r,m); if (!p) { for (i=(INT)0;i 12) error("mo:internal error: 500"); if (n<=1L) return(1L); else return ((INT)n*_fakul(n-1L)); } /* _fakul */ /*----------------------------------------------------------------------------*/ static INT _dimension(lambda,n) TL_BYTE *lambda; INT n; /*------------------------------------------------------------------------------ berechnet die Dimension der Darstellung zu einer eigentlichen Partition mit Hilfe der Hakenformel. Variablen: lambda, Partition; n, die partitionierte Zahl. Rueckgabewert: Dimension. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { INT i,j,l; INT zz,zn; TL_BYTE *slambda; if (n > (INT)12) /* AK 260195 */ { OP p,a; a = callocobject(); p = callocobject(); for (l=(INT)0;lambda[l]>0;l++); b_ks_pa(VECTOR,callocobject(),p); m_il_v(l,S_PA_S(p)); l--; for (i=0;l>=0;i++,l--) m_i_i((INT)(lambda[l]),S_PA_I(p,i)); dimension_partition(p,a); l=s_i_i(a); freeall(a); freeall(p); return l; } slambda=(TL_BYTE *)TL_calloc((int)(n+1),sizeof(TL_BYTE)); if (slambda == NULL) return no_memory(); _assoziiere(lambda,slambda,n); zz=_fakul(n); for (l=(INT)0;l1) { for (i=0;ij;k--) { if (!r_mat[k]) continue; if (_diff(r_mat[j],r_mat[k],c,row)) { for (l=0;ldim[i]) break; else if (dm 0) ; } } } while(end); fclose(dfp); return((INT)0); } /* _search_dec */ /*----------------------------------------------------------------------------*/ static INT _append_dec(decomp,row,col,n,pz) TL_BYTE *decomp; INT row,col,n,pz; /*------------------------------------------------------------------------------ haengt an das Ende des Files 'decommix.dat' eine fuer n und pz noch nicht berechnete Zerlegungsmatrix. Variablen: decomp, Zerlegungsmatrix; row, Zeilenzahl der Zerlegungsmatrix; col, Spaltenzahl der Zerlegungsmatrix; n, Sn; pz, Primzahl. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { FILE *dfp; INT info[4],i,j; dfp=fopen("decommix.dat","a+"); if (!dfp) return ERROR; info[0]=n; info[1]=pz; info[2]=row; info[3]=col; fprintf(dfp,"%ld %ld %ld %ld \n ",info[0],info[1],info[2],info[3]); j = info[2] * info[3]; for (i=(INT)0; i=(INT)0, Dimension der Darstellung; -1L, falls Fehler Aufgetreten ist. Rueckgabe darstellende Matrix dmat, die erst hier dimensioniert wird, falls die Dimension groesser 0 ist. ------------------------------------------------------------------------------*/ { TL_BYTE *part,*bz,*perm; TL_BYTE *darmat[2],*dar; INT pz,dim; INT spe,i,j,l_pa,l_p,gzl; OP dimen; OP lambda; if (equal_parts(llambda,prime)) { fprint(stderr,llambda); fprintln(stderr,prime); return error("moddg: wrong partition, wrong prime"); } if (S_PA_LI(llambda) == 1L) /* AK 020692 */ if (S_PA_II(llambda,(INT)0) == 1L) /* AK 020692 */ { /* AK 020692 */ m_ilih_m(1L,1L,dmat); /* AK 020692 */ m_i_i(1L,S_M_IJ(dmat,(INT)0,(INT)0)); /* AK 020692 */ return OK; /* AK 020692 */ } /* AK 020692 */ dimen=callocobject(); weight(llambda,dimen); if (neq(dimen,S_P_L(pi))) { /* AK 310702 */ fprint(stderr,llambda); fprintln(stderr,pi); error("moddg: wrong permutation, wrong degree"); freeall(dimen); return ERROR; } lambda=callocobject(); conjugate(llambda,lambda); l_pa=S_PA_LI(lambda); l_p=S_P_LI(pi); spe=l_pa+l_p+2L; dimension(lambda,dimen); MAXDM=(INT)S_I_I(dimen); spe += ((INT)MAXDM*(INT)MAXDM*5L); part=(TL_BYTE *)TL_calloc(spe,sizeof(TL_BYTE)); if (!part) { freeall(dimen); freeall(lambda); return(-1L); } perm=part+l_pa+1; bz=perm+l_p+1; for (i=0;i(INT)0, Relation ... ist nicht erfuellt; -1L, Fehler aufgetreten. Rueckgabe relation erhaelt die Nummer der nicht erfuellten Relation oder 0. ------------------------------------------------------------------------------*/ { TL_BYTE *darmat[2],*d[2]; INT dm,i_n,rl,pz; INT i,j; if (!S_M_LI(transmat)) { m_i_i((INT)0,relation); return((INT)0); } dm=(INT)S_M_LI(transmat); i_n=(INT)S_I_I(sn); pz=(INT)S_I_I(prime); darmat[0]=(TL_BYTE *)TL_calloc((int)dm*(int)dm*2,sizeof(TL_BYTE)); if (!darmat[0]) return(-1L); darmat[1]=darmat[0]+(INT)dm*(INT)dm; for (i=(INT)0,d[0]=darmat[0],d[1]=darmat[1];i<(INT)dm;i++) for (j=(INT)0;j<(INT)dm;j++) { *d[0]++ =(INT)S_M_IJI(transmat,i,j); *d[1]++ =(INT)S_M_IJI(nzykmat,i,j); } if ((rl=homtestp(darmat,i_n,dm,pz))<(INT)0) { SYM_free(darmat[0]); return(-1L); } m_i_i((INT)rl,relation); SYM_free(darmat[0]); return((INT)rl); } /* homp */ /*----------------------------------------------------------------------------*/ INT brauer_char(sn,prime,bc) OP sn,prime,bc; /*------------------------------------------------------------------------------ berechnet die Charaktertafel der Brauercharaktere der Sn zur Primzahl prime. Variablen: sn, Sn (objectkind:INTEGER); prime,Primzahl (objectkind:INTEGER). Rueckgabewerte: (INT)0, falls fehlerfrei; -1L, falls Fehler aufgetreten ist. Rueckgabe der Charaktertafel bc. ------------------------------------------------------------------------------*/ { INT _n,p,col,*idx,*idm; INT i,j,k,erg = OK; OP tafel,decomp, su, mu, _su; if (not primep(prime)) return error("brauer_char:second parameter no prime"); _n=(INT)S_I_I(sn); p=(INT)S_I_I(prime); if ((col=_num_part(_n,p))<(INT)0) return(-1L); idx=(INT *)TL_calloc((int)col*2,sizeof(INT)); if (!idx) { return ERROR; } idm=idx+(INT)col; if (_ber_idx_pelem(_n,p,col,idx)) { SYM_free(idx); return(-1L); } tafel=callocobject(); decomp=callocobject(); su=callocobject(); mu=callocobject(); _su=callocobject(); if (decp_mat(sn,prime,decomp)) { SYM_free(idx); freeall(tafel); freeall(decomp); freeall(su); freeall(mu); freeall(_su); return(-1L); } _ber_inx_dec(decomp,idm); chartafel(sn,tafel); m_ilih_m((INT)col,(INT)col,bc); for (i=(INT)0;i<(INT)col;i++) for (j=(INT)0;j<(INT)col;j++) { copy(S_M_IJ(tafel,(INT)idm[i],(INT)idx[j]),su); for (k=(INT)0;kr[0]) *id++ =i; i++; } SYM_free(r); return((INT)0); } /* _ber_idx_pelem */ /*----------------------------------------------------------------------------*/ static INT _ber_inx_dec(dcm,idx) OP dcm; INT *idx; /*------------------------------------------------------------------------------ berechnet in den Spalten der Zerlegungsmatrix dcm den Zeilenindex des ersten Elements !=0. Variablen: dcm, Zerlegungsmatrix; col, Spaltenanzahl der Zerlegungsmatrix; row, Zeilenanzahl der Zerlegungsmatrix. Rueckgabe Indexvektor idx. ------------------------------------------------------------------------------*/ { INT i,j,col,row; INT *id; col=S_M_LI(dcm); row=S_M_HI(dcm); for (i=(INT)0;iMAXDM) return(DDmGMx); else if (darmat==NULL) return (DrtNul); else if (n<=(INT)0) return(NLe_null); /* else if (n>MAXN) return(NGtMax); */ else if (pz<=(INT)0) return(PrmLe_null); else if (pz>n) return(PrmGtN); for (i=(INT)0;PZ[i]<=n && PZ[i]<=pz;i++); if (pz!=PZ[i-1]) return(NoPrm); /* Kein Eingabefehler, also koennen wir loslegen: */ mat=(TL_BYTE *)TL_calloc((int)ddim*(int)ddim*3,sizeof(TL_BYTE)); if (!mat) return no_memory(); mat_eins= &mat[(INT)ddim*(INT)ddim]; invzyk= &mat_eins[(INT)ddim*(INT)ddim]; matcopy(mat,darmat[0],ddim); if (rmatmulp(mat,darmat[0],ddim,pz)<(INT)0) { SYM_free(mat); return no_memory(); } if (!idmat(mat,ddim)) /* t^2 = 1 ? */ { SYM_free(mat); return(1L); } matcopy(mat,darmat[1],ddim); rmatmulp(mat,darmat[0],ddim,pz); matcopy(mat_eins,mat,ddim); az=1L; while (2L*az <= (n-1L)) { matcopy(invzyk,mat_eins,ddim); rmatmulp(mat_eins,invzyk,ddim,pz); az *= 2L; } for (i=az+2L; i<= n; i++) rmatmulp(mat_eins,mat,ddim,pz); if (!idmat(mat_eins,ddim)) /* (s * t) ^ (n-1L) =1 ? */ { SYM_free(mat); return(3L); } matcopy(mat,darmat[1],ddim); az=1L; while (2L*az <= n-1L) { matcopy(mat_eins,mat,ddim); rmatmulp(mat,mat_eins,ddim,pz); az*=2L; } for (i=az+2L;i<=n;++i) rmatmulp(mat,darmat[1],ddim,pz); matcopy(invzyk,mat,ddim); /* s^(-1L) = s^(n-1L) */ rmatmulp(mat,darmat[1],ddim,pz); if (!idmat(mat,ddim)) /* s^n = 1 ? */ { SYM_free(mat); return(2L); } matcopy(mat,darmat[0],ddim); rmatmulp(mat,invzyk,ddim,pz); rmatmulp(mat,darmat[0],ddim,pz); rmatmulp(mat,darmat[1],ddim,pz); matcopy(mat_eins,mat,ddim); rmatmulp(mat_eins,mat,ddim,pz); rmatmulp(mat_eins,mat,ddim,pz); if (!idmat(mat_eins,ddim)) /* (t * s^(-1L) * t * s) ^ 3 = 1 ? */ { SYM_free(mat); return(4L); } k=n/2L; for (j=2L; j<=k; j++) { rmatmulp(mat,darmat[1],ddim,pz); /* in mat ist noch t*s^1*t*s */ lmatmulp(darmat[0],mat,ddim,pz); lmatmulp(invzyk,mat,ddim,pz); lmatmulp(darmat[0],mat,ddim,pz); matcopy(mat_eins,mat,ddim); rmatmulp(mat_eins,mat,ddim,pz); if (!idmat(mat_eins,ddim)) /* (t*s^(-j)*t*s^j)^2 = 1 fuer j=2L,...k ? */ { SYM_free(mat); return(j+3L); } } SYM_free(mat); return((INT)0); } /*homtestp */ /******************************************************************************* * * Datei MODMAT.C * Version vom 11.10.1989 * * * Zeile Funktion * * Funktionen fuer Matrixoperationen * --------------------------------- * 39 INT matcopy(TL_BYTE *ziel,TL_BYTE *quelle,INT dim) * 59 INT rmatmulp(TL_BYTE *lmat,TL_BYTE *rmat,INT pdim,INT pz) * 102 INT lmatmulp(TL_BYTE *lmat,TL_BYTE *rmat,INT pdim,INT pz) * 152 INT idmat(TL_BYTE *z,INT dm) * *******************************************************************************/ /* Uebliche Headerfiles... */ /*----------------------------------------------------------------------------*/ static INT rmatmulp(lmat,rmat,pdim,pz) INT pz, pdim; TL_BYTE *lmat, *rmat; /*----------------------------------------------------------------------------- multipliziert die (pdim x pdim)-Matrix lmat von rechts mit der (pdim x pdim)-Matrix rmat. Dabei werden Multiplikationen und Additionen modulo pz ausgefuehrt. Variablen: lmat, Matrix; rmat, Matrix; pdim, Dimension der Matrizen; pz, Primzahl. Rueckgabe Ergebnismatrix lmat. Ruechgabewerte: (INT)0, falls alles geklappt hat; (INT)-109, falls der noetige Speicher nicht vorhanden war. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { INT h,i,j,k,o_eins,o_zwei; TL_BYTE *aa,*bb,*hilf,*aa_eins; hilf=(TL_BYTE *)TL_calloc((int)pdim,sizeof(TL_BYTE)); if (hilf == NULL) return no_memory(); aa_eins=lmat; for (i=(INT)0 ; i < pdim; ++i) { for (j=(INT)0 ; j < pdim; ++j) { h=(INT)0; bb= &rmat[(INT)j]; aa=aa_eins; for (k=(INT)0; ki;j--) { mu= *z_zwei; *z_zwei++ = *z_eins; *z_eins++ = mu; } if (*_hz) { if ((qu= *_hz)!=1L) for (j=mdm,z_eins=_hz;j>i;j--,z_eins++) { if (*z_eins) *z_eins=TL_DIVP(*z_eins,qu,pz); } if (i<_dm-1L) for (k=i+1L,jz=_hz+_dm_drei;k<_dm;k++,jz += _dm_drei) if ((qu= *jz)!=(INT)0) for (j=mdm,z_eins=jz,z_zwei=_hz;j>i;j--,z_eins++,z_zwei++) if (*z_zwei) { /* mu=(-1L)*(TL_MULP(qu,*z_zwei,pz)); *z_eins=TL_ADP(*z_eins,mu,pz); */ *z_eins = TL_MOD((-1 * qu * *z_zwei) + *z_eins, pz); } } } return OK; } /* moddreimat */ /*----------------------------------------------------------------------------*/ static INT _modgauss(hz,pz,i,mode) INT pz,i,mode; TL_BYTE *hz; /*------------------------------------------------------------------------------ wird benoetigt fuer die Funktionen modgauss und r_modgauss. Variablen: hz, Matrix mit Basis und Darstellungen; pz, Primzahl; i, Anfangswert der Schleife; mode, =1L, fuer modgauss, =3L, fuer r_modgauss; Rueckgabe Matrix hz. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE mu,qu,*_hz,*jz,*z_eins,*z_zwei; INT j,k,mdm; mdm=mode*_dm; for (j=i-1L,_hz= &hz[IND(i,i,_dm_drei)],jz=_hz-_dm_drei;j>=(INT)0;j--,jz -= _dm_drei) if ((qu= *jz)!=(TL_BYTE)0) for (k=mdm,z_eins=_hz,z_zwei=jz;k>i;k--,z_zwei++,z_eins++) if (*z_eins) { mu=(TL_BYTE) (-1L)*(TL_MULP(qu,*z_eins,pz)); *z_zwei= TL_ADP(*z_zwei,mu,pz); } return OK; } /* _modgauss */ /******************************************************************************* * * Funktionen zur Bestimmung der gew. irred. Darstellungen... * *******************************************************************************/ /*----------------------------------------------------------------------------*/ static INT r_modgauss(hz,pz) TL_BYTE *hz; INT pz; /*------------------------------------------------------------------------------ wendet den Gaussalgorithmus ueber GF(pz) auf das (_dm x 3_dm)-Koeffizienten- schema an, wobei die erste (_dm x _dm)-Teilmatrix eine obere Dreiecksmatrix mit 0 oder 1 auf der Hauptdiagonalen sein muss. (Simultanes Loesen von 2_dm linearen Gleichungssystemen.) Variablen: hz, Matrix mit Basis und Darstellungen; pz, Primzahl. Rueckgabe Matrix hz. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *_hz; INT i; for (i=_dm-1L,_hz= &hz[IND(_dm-1L,_dm-1L,_dm_drei)];i>(INT)0;i--,_hz -= (_dm_drei+1L)) if (*_hz) _modgauss(hz,pz,i,3L); return OK; } /* r_modgauss */ /*----------------------------------------------------------------------------*/ static INT ganzgaussmod(bz,hz) TL_BYTE *hz, *bz; /*------------------------------------------------------------------------------ loest simultan die in dem (_dm x 3_dm)-Koeffizientenschema bz kodierten 2_dm linearen Gleichungssysteme. Am Ende stehen die Loesungen fuer die gew. irred. Darstellungen in den letzten 2_dm Spalten von bz. Koennen keine ganzz. Loesungen errechnet werden, wird die Berechnung abge- brochen. Variablen: bz, Matrix aus alkonmat; hz, Matrix wie bz. Rueckgabe Matrix hz mit Basis und Matrizen der gewoehnlichen Darstellungen. Rueckgabewerte: (INT)0, falls alles geglueckt ist; -27L, falls keine ganzzahlige Loesung existiert. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *_hz,*_bz,*z_eins,*z_zwei,*z_drei; INT i,j,k,pz,su; INT il,cl; INT chance; pz=(INT)29; chance=TRUE; while (chance) { /* Interpretation von bz ueber GF(pz) und Uebergabe an hz */ for (il=(INT)_dm*(INT)_dm_drei,_hz=hz,_bz=bz;il>(INT)0;il--,_hz++,_bz++) if (*_bz) *_hz = (TL_BYTE) TL_MOD(*_bz,pz); else *_hz = (TL_BYTE) 0; /* Anwendung des Gaussalgorithmus ueber GF(pz) */ moddreimat(hz,pz,3L); r_modgauss(hz,pz); /* Rekonstruktion der ganzzahligen Loesungen */ for (i=(INT)0,_hz=hz+_dm;i<_dm;i++,_hz += _dm_drei) for (j=_dm,z_eins=_hz;j<_dm_drei;j++,z_eins++) if (*z_eins) { if ((*z_eins + *z_eins) > pz) *z_eins -= pz; } /* Verifikation der Loesungen: Die Koeffizientenmatrix der Gleichungssysteme (die ersten _dm Spalten von bz) wird mit der Loesungsmatrix (die letzten 2_dm Spalten von hz) multipliziert. Jeder Eintrag der Produktmatrix wird unmittelbar nach seiner Berechnung mit dem entsprechenden Eintrag in den letzten 2_dm Spalten von bz verglichen. cl gibt die Anzahl der Uebereinstimmungen an. */ for(i=(INT)0,cl=(INT)0,_bz=bz;i<_dm;i++,_bz += _dm_drei) for (j=_dm,z_eins=_bz+_dm,_hz=hz+_dm;j<_dm_drei;j++,z_eins++,_hz++) { for (k=(INT)0,su=(INT)0,z_zwei=_hz,z_drei=_bz;k<_dm;k++,z_drei++,z_zwei +=_dm_drei) { if (! *z_zwei) continue; if (! *z_drei) continue; su += (*z_zwei * *z_drei); } if (su == *z_eins) ++cl; } if (cl==((INT)_dm_zwei*(INT)_dm)) chance=FALSE; else { if (pz==(INT)211) { error("internal error: MO_50"); return(NoSolu); } pz=(INT)211; chance=TRUE; } } return((INT)0); } /* ganzgaussmod */ /******************************************************************************* * * Funktionen zur Bestimmung der p-mod. irred. Darstellungen... * *******************************************************************************/ /*----------------------------------------------------------------------------*/ static INT modmat(hz,pr) TL_BYTE *hz; INT pr; /*------------------------------------------------------------------------------ transformiert die (_dm x 3_dm)-Matrix hz nach (hz mod pr). Variablen: hz, Matrix mit Basis und Darstellungen; pr, Primzahl. Rueckgabe Matrix hz gerechnet modulo pr. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *_hz; INT il; for (il=(INT)_dm*(INT)_dm_drei,_hz=hz;il>(INT)0;il--,_hz++) if (*_hz) *_hz=(TL_BYTE)TL_MOD(*_hz,pr); else *_hz=(TL_BYTE)0; return OK; } /* modmat */ /*----------------------------------------------------------------------------*/ static INT modgauss(hz,v,pr) TL_BYTE *hz, *v; INT pr; /*------------------------------------------------------------------------------ berechnet mit Hilfe des Gaussalgorithmus ueber GF(pr) die Dimension der p-mod. irred. Darstellung. Der Gaussalgorithmus wird dabei auf die erste (_dm x _dm)-Teilmatrix von hz angewendet, wobei diese eine obere Dreiecks- matrix mit 0 oder 1 auf der Hauptdiagonalen sein muss. Variablen: hz, Matrix mit Basis und Darstellungen; pr, Primzahl. Rueckgabe Nummernvektor v der abhaengigen Spalten in hz. Rueckgabewerte: prang, Dimension der p-modular irreduziblen Darstellung. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *_hz,*z_eins,*z_zwei,*_v,qu,su; INT z,i,j,k,prang; prang=(INT)0; for (i=(INT)0;i<_dm;v[i++]=(TL_BYTE)0); for (i=_dm-1L,_hz= &hz[IND(_dm-1L,_dm-1L,_dm_drei)],_v= &v[_dm-1];i>(INT)0; i--,_hz -= (_dm_drei+1L),_v--) if (*_hz) { if ((qu = *_hz)!=(TL_BYTE)1) for (k=i,z_eins=_hz;k<_dm;k++,z_eins++) if (*z_eins) *z_eins= TL_DIVP(*z_eins,qu,pr); _modgauss(hz,pr,i,1L); } else { *_v = (TL_BYTE)i+1; ++prang; } if (hz[0]!=(TL_BYTE)1) { if ((qu=hz[0])==(TL_BYTE)0) { v[0]=(TL_BYTE)1; ++prang; } else for (j=(INT)0,_hz=hz;j<_dm;j++,_hz++) if (*_hz) *_hz = TL_DIVP(*_hz,qu,pr); } prang=_dm-prang; for (i=_dm-2L,_v= &v[_dm-2],_hz= &hz[IND(_dm-2L,_dm-1L,_dm_drei)];i>=(INT)0; i--,_v--,_hz -= (_dm_drei+1L)) if (*_v == (TL_BYTE) i+1) { for (j=i+1L,su=(TL_BYTE)0,z_eins=_hz;!su && j<_dm;j++,z_eins++) if (*z_eins) su=(TL_BYTE)j; if (su) { v[su]=(TL_BYTE)0; z_eins= &hz[IND(i,su,_dm_drei)]; z_zwei= &hz[IND(su,su,_dm_drei)]; for (j=su;j<_dm;++j) { z= *z_eins; *z_eins++ = *z_zwei; *z_zwei++ = z; } } _modgauss(hz,pr,su,1L); } return(prang); } /* modgauss */ /*----------------------------------------------------------------------------*/ static INT p_rel(hz,v,pr) TL_BYTE *hz, *v; INT pr; /*------------------------------------------------------------------------------ Simultane Ermittlung und Anwendung der p-Relationen. (Lineare Algebra!) Variablen: v, Nummern der abhaengigen Spalten in hz; pr, Primzahl; hz, Matrix mit Basis und Darstellungen. Rueckgabe Matrix hz. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *_v,*_hz,*z_eins,*z_zwei,*z_drei,*z_vier,mu,su; INT i,j,k; for (i=(INT)0,_v=v,_hz=hz;i<_dm;i++,_v++,_hz += _dm_drei) if (*_v == i+1L) for (j=(INT)0,z_eins=_hz+_dm,z_zwei=hz+_dm;j<_dm_zwei;j++,z_eins++,z_zwei++) if ((mu= *z_eins)!=(TL_BYTE)0) for (k=(INT)0,z_drei=hz+i,z_vier=z_zwei;k<=i-1L;k++,z_drei += _dm_drei,z_vier += _dm_drei) if (*z_drei != (TL_BYTE)0) { su= TL_MULP(mu,*z_drei,pr); *z_vier=TL_ADP(su,*z_vier,pr); } return OK; } /* p_rel */ /*----------------------------------------------------------------------------*/ static INT zykel(liste,zyk) TL_BYTE *liste, *zyk; /*------------------------------------------------------------------------------ berechnet die Zykelschreibweise einer Permutation liste aus ihrer Listen- schreibweise. Dabei steht eine negative Zahl immer als Ende des Zykels. Variablen: liste, Pointer auf die Permutation in Listenschreibweise. Rueckgabe Permutation zyk in Zykelschreibweise. Rueckgabewerte: (INT)0, falls kein Fehler aufgetreten ist; (INT)-109, falls nicht genuegend Speicher vorhanden war. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *z; INT merk,merk_eins,i,j,n; INT fertig; TL_BYTE *besucht; for (n=(INT)0;liste[n];n++); if ((besucht=(TL_BYTE *)TL_calloc((int)n,sizeof(TL_BYTE)))==NULL) return no_memory(); z=zyk; i=(INT)0; *z++ =(TL_BYTE)(merk=merk_eins=1L); fertig=FALSE; do { besucht[i]=(TL_BYTE)1; if (liste[i]==merk_eins) { z--; *z++ = -merk; for (j=(INT)0;j=n || !liste[i]) fertig=TRUE; else *z++ =(TL_BYTE)(merk=merk_eins=i+1L); } else { merk= *z++ =(TL_BYTE)liste[i]; i=liste[i]-1L; } } while (!fertig && i(TL_BYTE)0) fprintf(stream,"%d ",z[i]); else { fprintf(stream,"%d)",-z[i]); klam=1-klam; } } fprintf(stream,")"); break; } fprintf(stream,"\n"); for (i=prang*prang,dar=darmat[q];i>(INT)0;i--,dar++) { if (!(i%prang)) fprintf(stream,"\n"); fprintf(stream,"%3d",*dar); } fprintf(stream,"\n\n\n"); SYM_free(z); } #endif } } return((INT)0); } /* p_writemat */ /*----------------------------------------------------------------------------*/ static INT TL_darmod(hz,lambda,pr,perm,darmat) TL_BYTE *perm,*hz, *lambda, **darmat; INT pr; /*------------------------------------------------------------------------------ berechnet die pr-modular irreduziblen Darstellungsmatrizen fuer zwei Permu- tationen. Dazu muessen die Spalten der ersten (_dm x _dm)-Teilmatrix von hz die zugrunde gelegte Basis kodieren sowie die naechsten beiden (_dm x _dm)- Teilmatrizen von hz die zugehoerigen gewoehnlichen darstellenden Matrizen sein. (_dm ist die gewoehnliche Dimension der Darstellung.) Variablen: hz, Matrix mit der zugrunde gelegten Basis und die zugehoerigen gewoehnlichen Darstellungsmatrizen; lambda, Partition; pr, Primzahl; perm, Permutation. Rueckgabe Matrizen darmat der p-modular irreduziblen Darstellungen. Rueckgabewerte: prang, Dimension der p-modular irreduziblen Darstellungen; (INT)-109, falls nicht genuegend Speicher vorhanden war. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *v; INT prang; if ((v=(TL_BYTE *)TL_calloc((int)_dm,sizeof(TL_BYTE)))==NULL) return no_memory(); modmat(hz,pr); moddreimat(hz,pr,1L); prang=modgauss(hz,v,pr); p_rel(hz,v,pr); if (p_writemat(hz,v,lambda,pr,perm,darmat,prang)) return no_memory(); SYM_free(v); return(prang); } /* TL_darmod */ /******************************************************************************* * * Hauptfunktion zur Berechnung der p-mod. irred. Darstellungen... * *******************************************************************************/ /*----------------------------------------------------------------------------*/ static INT darmod(lambda,dim,bz,pz,gzl,perm,darmat) TL_BYTE *lambda, *bz, *perm, **darmat; INT dim,pz,*gzl; /*------------------------------------------------------------------------------ koordiniert die Berechnung der gew. irred. Darstellungen mit der Berechnung der p-mod. irred. Variablen: lambda, Partition; dim, Dimension der gewoehnlichen Darstellungen; bz, Koeffizientenschema aus alkonmat; pz, Primzahl,fuer welche die p-mod. Darstellungsmatrizen be- rechnet werden; gzl, #(INT)0, d.h. berechne zuerst die gew. irred. Darstellungen, =(INT)0, d.h. gew. irred. Darstellungen existieren schon; perm, Permutation, fuer die die Darstellungen berechnet werden. Rueckgabe Matrizen darmat der p-modular irreduziblen Darstellungen. Rueckgabewerte: prang, Dimension der Darstellung; (INT)-10, falls Pointer auf lambda NULL ist; -11L, falls lambda keinen Eintrag hat; -12L, falls lambda einen Eintrag kleiner 0 hat; -13L, falls lambda keine eigentliche Partition ist; // -15L, falls n MAXN uebersteigt; -18L, falls dim groesser MAXDM ist; -19L, falls Pointer auf bz NULL ist; -21L, falls dim kleiner 1 ist; -22L, falls Pointer auf darmat NULL ist; -23L, falls Pointer auf gzl NULL ist; -24L, falls pz keine Primzahl ist; -25L, falls pz kleiner 1 ist; -26L, falls pz groesser n ist; -27L, falls keine ganzzahlige Loesung bei der Berechnung der gewoehnlichen Darstellungen existiert; (INT)-30, falls Pointer auf perm NULL ist; -31L, falls ein Element von perm kleiner 1 ist; -32L, falls ein Element von perm groesser n ist; -33L, falls Laenge von perm groesser n ist; (INT)-109, falls nicht genuegend Speicher zu Verfuegung steht. Bemerkungen: gzl veraendert sich selbststaendig. Wird darmod mit einem von alkonmat neuberechneten bz aufgerufen, muss gzl einen von 0 verschiedenen Wert haben. Sind die ganzzahligen Loesungen der gewoenlichen Darstellungen berechnet, so ist gzl=(INT)0, und man kann durch nochmaliges Aufrufen von darmod mit diesem die Berechnungen der gew. Darstellungen ueberspringen. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *_hz,*z_eins,*z_zwei,*z_drei; INT prang,n,j,i; TL_BYTE *hz; /* dim x 3dim */ INT il; /* Abfangen moeglicher Uebergabefehler... */ if (lambda==NULL) return(LmbNul); else if (!lambda[0]) return(LmbEmp); for (j=(INT)0,n=(INT)0;lambda[j];j++) if (lambda[j]<(TL_BYTE)0) return(LmbLt_null); else n+=lambda[j]; for (j=1L;lambda[j];j++) if (lambda[j]>lambda[j-1]) return(LmbNRg); if (darmat==NULL) return(DrtNul); else if (gzl==NULL) return(GzlNul); else if (bz==NULL) return(BzNul); else if (dim<=(INT)0) return(DimLe_null); else if (dim>MAXDM) return(DmGtMx); else if (pz<=(INT)0) return(PrmLe_null); else if (pz>n) return(PrmGtN); else if (pz) { for (j=(INT)0;PZ[j]<=n && PZ[j]<=pz;j++); if (pz!=PZ[j-1]) return(NoPrm); } else if (perm==NULL) return(PerNul); for (j=(INT)0;jn) return(PerGtN); /* Auf geht's... */ _dm=dim; _dm_zwei=2L*_dm; _dm_drei=3L*_dm; if ((hz=(TL_BYTE *)TL_calloc((int)_dm_drei*(int)_dm,sizeof(TL_BYTE)))==NULL) return no_memory(); for (il=(INT)_dm*(INT)_dm_drei,z_eins=hz,z_zwei=bz;il>(INT)0;il--) *z_eins++ = *z_zwei++; if (*gzl) { if (lambda[2]) 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)) { for (j=i+1L,z_eins=_hz,z_drei=z_zwei;j<_dm;j++,z_eins++,z_drei += _dm_drei) *z_drei = *z_eins; for (j=i+1L,z_eins=_hz+_dm,z_drei=z_zwei+_dm;j<_dm;j++,z_eins++,z_drei += _dm_drei) *z_drei = *z_eins; } for (il=(INT)_dm*(INT)_dm_drei,z_eins=bz,z_zwei=hz;il>(INT)0;il--) *z_eins++ = *z_zwei++; /* Berechnung der gewoehnlichen irreduziblen Darstellung mit Hilfe einer modularen Arithmetik. */ *gzl=ganzgaussmod(bz,hz); for (i=(INT)0,z_eins=hz,z_zwei=bz;i<_dm;++i) { for (j=(INT)0;j<_dm;++j) *z_eins++ = *z_zwei++; for (j=_dm;j<_dm_drei;++j) *z_zwei++ = *z_eins++; } } if (!(*gzl)) /* Berechnung der modular irred. Darstellg. */ prang=TL_darmod(hz,lambda,pz,perm,darmat); else prang= *gzl; SYM_free(hz); return(prang); } /* darmod */ INT dimension_mod(part,prim,res) OP part,prim; OP res; /* AK 200294 */ { /* AK 240194 for a single dimension */ TL_BYTE *lambda; TL_BYTE *slambda; INT erg = OK; INT i,dm,omaxdim; INT ak_j; TL_BYTE *bz; INT res_dim; INT n,p; OP w; CTO(INTEGER,"dimension_mod",prim); CTO(PARTITION,"dimension_mod",part); C2R(part,prim,"dimension_mod",res); if (S_I_I(prim) < (INT)0) { fprintf(stderr,"number = %ld\n",S_I_I(prim)); error("dimension_mod: prime number (2. parameter) is negativ"); goto endr_ende; } if (S_I_I(prim) == (INT)0) /* ordinary dimension */ { erg += dimension(part,res); goto s2r; } if (not primep(prim)) { fprintf(stderr,"number = %ld\n",S_I_I(prim)); error("dimension_mod: prime number (2. parameter) is not prime"); goto endr_ende; } if (equal_parts(part,prim)) { erg += m_i_i((INT)0,res); goto s2r; } omaxdim=MAXDM; w = callocobject(); weight(part,w); n = S_I_I(w); p = S_I_I(prim); lambda = (TL_BYTE *)TL_calloc((int)n, sizeof(TL_BYTE)); if (lambda == NULL) { MAXDM=omaxdim; erg += ERROR; goto endr_ende; } for (i=(INT)0;i=(INT)0;i--,ak_j++) lambda[ak_j]=S_PA_II(part,i); dimension(part,w); MAXDM= S_I_I(w); freeall(w); if (MAXDM<(INT)0) { MAXDM=omaxdim; SYM_free(lambda); error("dimension_mod:internal error"); erg =MAXDM; goto endr_ende; } slambda=(TL_BYTE *)TL_calloc((int)(n+1),sizeof(TL_BYTE)); if (slambda == NULL) { MAXDM=omaxdim; SYM_free(lambda); erg += ERROR; goto endr_ende; } bz=(TL_BYTE *)TL_calloc((int)MAXDM*(int)MAXDM,sizeof(TL_BYTE)); if (bz == NULL) { MAXDM=omaxdim; SYM_free(slambda); SYM_free(lambda); erg += ERROR; goto endr_ende; } _assoziiere(lambda,slambda,n); if ((dm=k_alkonmat(slambda,bz,p))<(INT)0) { res_dim=dm; MAXDM=omaxdim; goto dme; } if ((res_dim=k_dimmod(bz,MAXDM,p))<(INT)0) { MAXDM=omaxdim; SYM_free(bz); SYM_free(slambda); SYM_free(lambda); goto endr_ende; } dme: SYM_free(bz); SYM_free(slambda); SYM_free(lambda); m_i_i(res_dim,res); j_zyk((INT)-15,(INT)0,NULL,NULL); /* AK 020294 */ s2r: S2R(part,prim,"dimension_mod",res); ENDR("dimension_mod"); } INT schnitt_mat(part,prim,res) OP part,prim; OP res; /* input: partition part prime number: p output integer matrix modulo p, whose rang = degree of mod irrep */ /* AK 200294 */ /* AK 070498 V2.0 */ { TL_BYTE *lambda; TL_BYTE *slambda; INT i,j,dm,omaxdim; INT ak_j; TL_BYTE *bz; INT res_dim; INT n,p; OP w; INT erg = OK; CE3(part,prim,res,schnitt_mat); if (equal_parts(part,prim)) return m_i_i((INT)0,res); C2R(part,prim,"schnitt_mat",res); omaxdim=MAXDM; w = callocobject(); weight(part,w); n = S_I_I(w); p = S_I_I(prim); lambda = (TL_BYTE *)TL_calloc((int)n, sizeof(TL_BYTE)); if (lambda == NULL) { MAXDM=omaxdim; return no_memory(); } for (i=(INT)0;i=(INT)0;i--,ak_j++) lambda[ak_j]=S_PA_II(part,i); dimension(part,w); MAXDM= S_I_I(w); freeall(w); /* _dimension(lambda,n); */ if (MAXDM<(INT)0) { MAXDM=omaxdim; SYM_free(lambda); error("dimension_mod:internal error"); return(MAXDM); } slambda=(TL_BYTE *)TL_calloc((int)(n+1),sizeof(TL_BYTE)); if (slambda == NULL) { MAXDM=omaxdim; SYM_free(lambda); return no_memory(); } bz=(TL_BYTE *)TL_calloc((int)MAXDM*(int)MAXDM,sizeof(TL_BYTE)); if (bz == NULL) { MAXDM=omaxdim; SYM_free(slambda); SYM_free(lambda); return no_memory(); } _assoziiere(lambda,slambda,n); if ((dm=k_alkonmat(slambda,bz,p))<(INT)0) { res_dim=dm; MAXDM=omaxdim; goto dme; } erg += m_ilih_m(MAXDM,MAXDM,res); for (i=0;i=i+1;++j); if ((j(INT)0 ; i--) *bb++= *aa++; return OK; } /* matcopy */ /*----------------------------------------------------------------------------*/ static INT fak(x) INT x; /*------------------------------------------------------------------------------ berechnet x!. Variable: x, natuerliche Zahl. Rueckgabewert: x!. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { if (x<=1L) return(1L); else return (x*fak(x-1L)); } /*fak*/ /*----------------------------------------------------------------------------*/ static INT nexgitt(y,lambda,mtc) TL_BYTE *lambda, *y; INT *mtc; /*------------------------------------------------------------------------------ berechnet aus Tableau y und Partition lambda das naechste Tableau y. Variablen: y, Tableau; lambda, Partition. Rueckgabe neues Tableau y, falls ein neues existiert (mtc = TRUE). Rueckgabewerte: (INT)0, falls kein Fehler aufgetreten ist; (INT)-109, falls kein Speicherplatz vorhanden war. ------------------------------------------------------------------------------*/ /* TL 0790 */ /* AK 210891 V1.3 */ { TL_BYTE *hilf; static TL_BYTE *h=NULL; static int _nn = 0; INT m,i,j,l,merke; INT durch; if (*mtc == 280194L) { if (h != NULL) SYM_free(h); h = NULL; return OK; } if (_nn != _n) { if (h != NULL) SYM_free(h); h = NULL; } if (h == NULL) { h=(TL_BYTE *)TL_calloc(_n+_n,sizeof(TL_BYTE)); _nn = _n; } if (!h) return no_memory(); hilf=h+_n; memcpy(h,y,_n * sizeof(TL_BYTE)); if (!(*mtc)) for (i=(INT)0,j=(INT)0;lambda[i];++i) { for (l=j;l(l=h[i-1])) { if ((lambda[l]-lambda[m])> (hilf[l]-hilf[m]+(TL_BYTE)1)) { durch=TRUE; merke=l; j=merke+(TL_BYTE)1; while ((hilf[j]==(TL_BYTE)0) || ((lambda[l]-lambda[j])< (hilf[l]-hilf[j]+(TL_BYTE)2))) ++j; h[i-1]=j; --hilf[j]; ++hilf[merke]; for (l=i;l<_n;++l) if (j<_n) { for (j=(TL_BYTE)0;!hilf[j];++j); h[l]=j; --hilf[j]; } } } --i; if (i == (INT)0) *mtc=FALSE; } while (!durch && *mtc); } memcpy(y,h,_n * sizeof(TL_BYTE) ); return (INT)0; } /*nexgitt*/ #endif /* DGTRUE */