GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
/***** Main program for the automorphism program AUTO *****/12#include "typedef.h"3#include "types.h"45static int normal_option;6static int perp_no;7static int ***perp;8static int perpdim;9static int ***perpbase;10static int ***perpprod;11static int *perpvec;1213#include "auttools.c"14#include "bachtools.c"15#include "iotools.c"16#include "lattools.c"17#include "mattools.c"18#include "orbtools.c"19#include "preproc.c"20#include "sorttools.c"2122/*************************************************************************\23| The functions 'autgrp' calculates generators and the order of the group24| G := {g in GL_n(Z) | g * Fo[i] * g^{tr} = Fo[i], 1<= i<= Foanz}25| returned via a pointer to 'bravais_TYP'.26|27| The arguments of autgrp are:28| matrix_TYP **Fo: a set of n times n matrices,29| the first must be positiv definite30| int Foanz: the number of the matrices given in 'Fo'.31| matrix_TYP **Erz: if already element of G are known,32| they can be used for calculating generators33| for the whole group.34| The matrices of known elements can be given35| to the function by the pointer 'Erz'.36| int Erzanz: The number of matrices given in 'Erz"37| matrix_TYP *SV: The rows of the matrix 'SV' must be the vectors38| x in Z^n with x * F[0] * x^{tr} <= m, where39| m is the maximal diagonal entry of the Matrix40| F[0]41| int *options: see below.42|43| options is a pointer to integer (of length 6)44| The possible options are encoded in the following way:45| options[0]: The depth, up to wich scalar product combinations46| shall be calculated. The value should be small.47| options[0] > 0 should be used only, if the automorphismn48| group is expected to be small (with respect to the number49| of shortest vectors).50| options[1]: The n-point stabiliser with respect to different basis51| will be calculated.52| options[2]: If options[2] = 1, additional output is written to the53| file AUTO.tmp54| options[3]: If options[3] = 1, Bacher polynomials are used.55| If options[3] = 2, Bacher polynomial are used up to a deepth56| specified in options[4].57| If options[3] = 3, Bacher polynomials are used, using58| combinations of vectors having the scalar59| product specified in options[5]60| options[3] = 4 is the combination of options[3] = 2 and61| options[3] = 3.62| options[4]: A natural number number or zero (if options[3] = 2 or 4)63| options[5]: An integral number (if options[3] = 3 or 4)64|65| It is possible to use NULL for options,66| in this case option is assumed to be [0,0,0,0,0,0]67\*************************************************************************/686970bravais_TYP *autgrp(Fo, Foanz, SV, Erz, Erzanz, options)71matrix_TYP **Fo, **Erz, *SV;72int Foanz, Erzanz, *options;73{74FILE *outfile;75bachpol *bach;76flagstruct flags;77scpcomb *comb;78group G;79invar F;80veclist V, norm;81fpstruct fp;82int dim, max, fail, *vec;83int ***H, nH, ngen, **sumveclist, **sumvecbase;84int i, j, k, l, n, *Vvi, *Vvj, **Fvi, *Fvij, **FAi;85bravais_TYP *B;8687normal_option = FALSE;88/* get the flags from the command line */89getflags(&flags, options);90if(Erzanz > 0)91flags.GEN = 1;92else93flags.GEN = 0;94/* F.n is the number of invariant forms */95F.n = Foanz;96if ((F.A = (int***)malloc(F.n * sizeof(int**))) == 0)97exit (2);98/* read the invariant forms */99F.dim = Fo[0]->cols;100dim = F.dim;101for(i=0;i<F.n;i++)102{103if(Fo[i]->cols != F.dim || Fo[i]->rows != F.dim)104{105printf("forms in autgrp have different dimension\n");106exit(2);107}108}109for(i=0;i<F.n;i++)110{111if ((F.A[i] = (int**)malloc(dim * sizeof(int*))) == 0)112exit (2);113for(j=0;j<F.dim;j++)114{115if ((F.A[i][j] = (int*)malloc(dim * sizeof(int))) == 0)116exit (2);117for(k=0;k<F.dim;k++)118F.A[i][j][k] = Fo[i]->array.SZ[j][k];119}120}121if (flags.GEN == 1)122/* some automorphisms are already known */123{124ngen = Erzanz;125if ((H = (int***)malloc(ngen * sizeof(int**))) == 0)126exit (2);127nH = 0;128fail = 0;129for(i=0;i<ngen;i++)130{131if(Erz[i]->cols != dim || Erz[i]->rows != dim)132{133printf("Elements 'Erz' have wrong dimension\n");134exit(3);135}136}137i = 0;138while (nH+fail < ngen)139{140if ((H[nH] = (int**)malloc(dim * sizeof(int*))) == 0)141exit (2);142for(j=0;j<dim;j++)143{144if ((H[nH][j] = (int*)malloc(dim * sizeof(int))) == 0)145exit (2);146for(k=0;k<dim;k++)147H[nH][j][k] = Erz[i]->array.SZ[j][k];148}149/* check whether the matrix is really an automorphism, i.e. fixes the forms */150if (checkgen(H[nH], F) == 0)151/* the matrix is not an automorphism */152{153++fail;154for (j = 0; j < dim; ++j)155free(H[nH][j]);156free(H[nH]);157}158else159/* the matrix fixes all forms in F */160++nH;161i++;162}163}164else165nH = 0;166167168169V.dim = dim;170V.len = dim + F.n;171/* get the short vectors */172V.n = SV->rows;173if ((V.v = (int**)malloc((V.n+1) * sizeof(int*))) == 0)174exit (2);175for(i=0;i<=V.n;i++)176{177if ((V.v[i] = (int*)malloc(V.len * sizeof(int))) == 0)178exit (2);179}180for(i=1;i<= V.n;i++)181{182for(j=0;j<=dim;j++)183V.v[i][j] = SV->array.SZ[i-1][j];184}185/* the first nonzero entry of each vector is made positive and the maximal186entry of the vectors is determined */187max = 1;188for (i = 1; i <= V.n; ++i)189{190Vvi = V.v[i];191for (j = 0; j < dim && Vvi[j] == 0; ++j);192if (j < dim && Vvi[j] < 0)193{194for (k = j; k < dim; ++k)195Vvi[k] *= -1;196}197for (k = j; k < dim; ++k)198{199if (abs(Vvi[k]) > max)200max = abs(Vvi[k]);201}202}203if (max > MAXENTRY)204/* there is an entry, which is bigger than MAXENTRY, which might cause overflow,205since the program doesn't use long integer arithmetic */206{207fprintf(stderr, "Error: Found entry %d in short vectors.\nTo avoid overflow, the entries should not exceed %d.\n", max, MAXENTRY);208exit (3);209}210/* V.prime is a prime p, such that every entry x in the short vectors remains211unchanged under reduction mod p in symmetric form, i.e. -p/2 < x <= p/2 */212for (V.prime = 2*max + 1; isprime(V.prime) == 0; ++V.prime);213/* sort the vectors and delete doublets */214sortvecs(&V);215/* the norm-vector (i.e. the vector of the norms with respect to the different216invariant forms) of each vector must be equal to the norm-vector of one217of the vectors from the standard-base */218if ((norm.v = (int**)malloc((dim+1) * sizeof(int*))) == 0)219exit (2);220norm.n = dim;221norm.dim = F.n;222norm.len = F.n;223for (i = 1; i <= norm.n; ++i)224{225/* norm.v[i] is the norm combination of the (i-1)-th base-vector */226if ((norm.v[i] = (int*)malloc(norm.dim * sizeof(int))) == 0)227exit (2);228for (k = 0; k < norm.dim; ++k)229norm.v[i][k] = F.A[k][i-1][i-1];230}231sortvecs(&norm);232/* delete those vectors, which can not be the image of any of the standard-base233vectors */234checkvecs(&V, F, norm);235for (i = 1; i <= norm.n; ++i)236free(norm.v[i]);237free(norm.v);238/* print the invariant forms, if output is in ASCII-format */239/*********************************************240printf("#%d\n", F.n);241for (i = 0; i < F.n; ++i)242putform(F.A[i], dim);243**********************************************/244/* F.v[i][j] is the transposed of the product of the Gram-matrix F.A[i] with the245transposed of the vector v[j], hence the scalar product of v[j] and v[k] with246respect to the Gram-matrix F.A[i] can be computed as standard scalar product247of v[j] and F.v[i][k] */248if ((F.v = (int***)malloc(F.n * sizeof(int**))) == 0)249exit (2);250/* the product of the maximal entry in the short vectors with the maximal entry251in F.v[i] should not exceed MAXNORM to avoid overflow */252max = MAXNORM / max;253for (i = 0; i < F.n; ++i)254{255FAi = F.A[i];256if ((F.v[i] = (int**)malloc((V.n+1) * sizeof(int*))) == 0)257exit (2);258Fvi = F.v[i];259for (j = 1; j <= V.n; ++j)260{261Vvj = V.v[j];262if ((Fvi[j] = (int*)malloc(dim * sizeof(int))) == 0)263exit (2);264Fvij = Fvi[j];265for (k = 0; k < dim; ++k)266{267Fvij[k] = sscp(FAi[k], Vvj, dim);268if (abs(Fvij[k]) > max)269/* some entry in F.v[i] is too large */270{271fprintf(stderr, "Error: Found entry %d in F.v.\nTo avoid overflow, the entries should not exceed %d.\n", Fvij[k], max);272exit (3);273}274}275}276}277/* fp.per is the order in which the images of the base-vectors are set */278if ((fp.per = (int*)malloc(dim * sizeof(int))) == 0)279exit (2);280/* fp.e[i] is the index in V.v of the i-th vector of the standard-base in the281new order */282if ((fp.e = (int*)malloc(dim * sizeof(int))) == 0)283exit (2);284/* fp.diag is the diagonal of the fingerprint in the new order, fp.diag[i] is285an upper bound for the length of the orbit of the i-th base-vector under286the stabilizer of the preceding ones */287if ((fp.diag = (int*)malloc(dim * sizeof(int))) == 0)288exit (2);289/* compute the fingerprint */290fingerprint(&fp, F, V);291if (flags.PRINT == 1)292/* if the -P option is given, print the diagonal fp.diag and the number of short293vectors on AUTO.tmp */294{295outfile = fopen("AUTO.tmp", "a");296fprintf(outfile, "%d short vectors\n", 2*V.n);297fprintf(outfile, "fingerprint diagonal:\n");298for (i = 0; i < dim; ++i)299fprintf(outfile, " %2d", fp.diag[i]);300fprintf(outfile, "\n");301fclose(outfile);302}303/* get the standard basis in the new order */304if ((vec = (int*)malloc(dim * sizeof(int))) == 0)305exit (2);306for (i = 0; i < dim; ++i)307{308for (j = 0; j < dim; ++j)309vec[j] = 0;310vec[fp.per[i]] = 1;311fp.e[i] = numberof(vec, V);312if (abs(fp.e[i]) > V.n)313/* the standard-base must occur in the set of short vectors, since Id is314certainly an automorphism */315{316fprintf(stderr, "Error: standard basis vector nr. %d not found\n", i);317exit (3);318}319}320free(vec);321/* if the -D option is given, the scalar product combinations and the322corresponding vector sums are computed for the standard-basis */323if (flags.DEPTH > 0)324{325if ((comb = (scpcomb*)malloc(dim * sizeof(scpcomb))) == 0)326exit (2);327for (i = 0; i < dim; ++i)328{329/* compute the list of scalar product combinations and the corresponding330vector sums */331scpvecs(&comb[i].list, &sumveclist, i, fp.e, flags.DEPTH, V, F);332/* compute a basis for the lattice that is generated by the vector sums and333a transformation matrix that expresses the basis in terms of the334vector sums */335base(&comb[i], &sumvecbase, sumveclist, F.A[0], dim);336if (flags.PRINT == 1)337/* if the -P option is given, print the rank of the lattice generated by the338vector sums on level i on AUTO.tmp */339{340outfile = fopen("AUTO.tmp", "a");341fprintf(outfile, "comb[%d].rank = %d\n", i, comb[i].rank);342fclose(outfile);343}344/* compute the coefficients of the vector sums in terms of the basis */345coef(&comb[i], sumvecbase, sumveclist, F.A[0], dim);346for (j = 0; j <= comb[i].list.n; ++j)347free(sumveclist[j]);348free(sumveclist);349/* compute the scalar products of the base-vectors */350scpforms(&comb[i], sumvecbase, F);351for (j = 0; j < comb[i].rank; ++j)352free(sumvecbase[j]);353free(sumvecbase);354}355}356/* the Bacher-polynomials for the first BACHDEP base-vectors are computed,357if no scalar product was given as an argument, the scalar product is set358to 1/2 the norm of the base-vector (with respect to the first form) */359if (flags.BACH[0] == 1)360{361if ((bach = (bachpol*)malloc(flags.BACHDEP * sizeof(bachpol))) == 0)362exit (2);363for (i = 0; i < flags.BACHDEP; ++i)364{365if (flags.BACH[2] == 0)366/* no scalar product was given as an option */367flags.BACHSCP = V.v[fp.e[i]][dim] / 2;368/* compute the Bacher-polynomial */369bacher(&bach[i], fp.e[i], flags.BACHSCP, V, F.v[0]);370if (flags.PRINT == 1)371/* if the -P option is given, print the Bacher-polynomial on AUTO.tmp */372{373outfile = fopen("AUTO.tmp", "a");374fprintf(outfile, "Bacher-polynomial of base vector fp.e[%d]:\n", i);375fputbach(outfile, bach[i]);376fclose(outfile);377}378}379}380/* set up the group: the generators in G.g[i] are matrices that fix the381first i base-vectors but do not fix fp.e[i] */382if ((G.g = (int****)malloc(dim * sizeof(int***))) == 0)383exit (2);384/* G.ng is the number of generators in G.g[i] */385if ((G.ng = (int*)malloc(dim * sizeof(int))) == 0)386exit (2);387/* the first G.nsg[i] generators in G.g[i] are obtained as stabilizer elements388and are not necessary to generate the group */389if ((G.nsg = (int*)malloc(dim * sizeof(int))) == 0)390exit (2);391/* G.ord[i] is the orbit length of fp.e[i] under the generators in392G.g[i] ... G.g[dim-1] */393if ((G.ord = (int*)malloc(dim * sizeof(int))) == 0)394exit (2);395for (i = 0; i < dim; ++i)396{397if ((G.g[i] = (int***)malloc(1 * sizeof(int**))) == 0)398exit (2);399G.ng[i] = 0;400G.nsg[i] = 0;401}402G.dim = dim;403if ((G.g[0][0] = (int**)malloc(dim * sizeof(int*))) == 0)404exit (2);405/* -Id is always an automorphism */406for (i = 0; i < dim; ++i)407{408if ((G.g[0][0][i] = (int*)malloc(dim * sizeof(int))) == 0)409exit (2);410for (j = 0; j < dim; ++j)411G.g[0][0][i][j] = 0;412G.g[0][0][i][i] = -1;413G.ng[0] = 1;414}415/* fill in the generators which were given as input */416for (i = 0; i < nH; ++i)417{418for (j = 0; j < dim && operate(fp.e[j], H[i], V) == fp.e[j]; ++j);419if (j < dim)420/* the generator is not Id and fixes fp.e[0],...,fp.e[j-1] but not fp.e[j] */421{422++G.ng[j];423if ((G.g[j] = (int***)realloc(G.g[j], G.ng[j] * sizeof(int**))) == 0)424exit (2);425if ((G.g[j][G.ng[j]-1] = (int**)malloc(dim * sizeof(int*))) == 0)426exit (2);427for (k = 0; k < dim; ++k)428{429if ((G.g[j][G.ng[j]-1][k] = (int*)malloc(dim * sizeof(int))) == 0)430exit (2);431for (l = 0; l < dim; ++l)432G.g[j][G.ng[j]-1][k][l] = H[i][k][l];433}434}435for (k = 0; k < dim; ++k)436free(H[i][k]);437free(H[i]);438}439if (nH > 0)440free(H);441nH = 0;442for (i = 0; i < dim; ++i)443nH += G.ng[i];444if ((H = (int***)malloc(nH * sizeof(int**))) == 0)445exit (2);446/* calculate the orbit lengths under the automorphisms known so far */447for (i = 0; i < dim; ++i)448{449if (G.ng[i] > 0)450{451nH = 0;452for (j = i; j < dim; ++j)453{454for (k = 0; k < G.ng[j]; ++k)455{456H[nH] = G.g[j][k];457++nH;458}459}460G.ord[i] = orbitlen(fp.e[i], fp.diag[i], H, nH, V);461}462else463G.ord[i] = 1;464}465free(H);466/* compute the full automorphism group */467autom(&G, V, F, fp, comb, bach, flags);468/* print the generators of the group, which are necessary for generating */469B = putgens(G, flags);470n = 0;471for (i = flags.STAB; i < dim; ++i)472{473if (G.ord[i] > 1)474++n;475}476/* print a base to AUTO.tmp if the print-flag is set */477if (flags.PRINT == 1)478{479outfile = fopen("AUTO.tmp", "a");480fprintf(outfile, "%dx%d\n", n, dim);481for (i = flags.STAB; i < dim; ++i)482{483if (G.ord[i] > 1)484{485for (j = 0; j < dim; ++j)486fprintf(outfile, " %d", V.v[fp.e[i]][j]);487fprintf(outfile, "\n");488}489}490fclose(outfile);491}492/* print the order of the group */493putord(G, flags, B);494495496if (flags.BACH[0] == 1)497{498for (i = 0; i < flags.BACHDEP; ++i)499free(bach[i].coef);500free(bach);501}502if (flags.DEPTH > 0)503{504for(i=0;i<dim;i++)505{506for(j=0;j<=comb[i].list.n;j++)507free(comb[i].coef[j]);508free(comb[i].coef);509for(j=0;j<=comb[i].list.n;j++)510free(comb[i].list.v[j]);511free(comb[i].list.v);512for(j=0;j<comb[i].rank;j++)513free(comb[i].trans[j]);514free(comb[i].trans);515for(j=0;j<F.n;j++)516{517for(k=0;k<comb[i].rank;k++)518free(comb[i].F[j][k]);519free(comb[i].F[j]);520}521free(comb[i].F);522}523free(comb);524}525for(i=0;i<F.n;i++)526{527for(j=1;j<=V.n;j++)528free(F.v[i][j]);529free(F.v[i]);530for(j=0;j<dim;j++)531free(F.A[i][j]);532free(F.A[i]);533}534free(F.A); free(F.v);535for(i=0;i<=V.n;i++)536free(V.v[i]);537free(V.v);538free(fp.diag); free(fp.per); free(fp.e);539for(i=0;i<dim;i++)540{541for(j=0;j<G.ng[i];j++)542{543for(k=0;k<dim;k++)544free(G.g[i][j][k]);545free(G.g[i][j]);546}547free(G.g[i]);548}549free(G.g); free(G.ord); free(G.ng); free(G.nsg);550551return(B);552}553554555556bravais_TYP *perfect_normalizer(Fo, SV, Erz, Erzanz, options, P, Panz, Pdim, Pbase)557matrix_TYP *Fo, **Erz, *SV, **P, **Pbase;558int Erzanz, *options, Panz, Pdim;559{560FILE *outfile;561bachpol *bach;562flagstruct flags;563scpcomb *comb;564group G;565invar F;566veclist V, norm;567fpstruct fp;568int dim, max, fail, *vec;569int ***H, nH, ngen, **sumveclist, **sumvecbase;570int i, j, k, l, n, *Vvi, *Vvj, **Fvi, *Fvij, **FAi;571bravais_TYP *B;572573extern matrix_TYP *init_mat();574575normal_option = TRUE;576perp_no = Panz;577if((perp = (int ***)malloc(perp_no *sizeof(int **))) == 0)578{579printf("malloc of 'perp' in 'perfect_normalizer' failed\n");580exit(2);581}582for(i=0;i<perp_no;i++)583perp[i] = P[i]->array.SZ584perpdim = Pdim;585if((perpbase = (int ***)malloc(perpdim *sizeof(int **))) == 0)586{587printf("malloc of 'perpbase' in 'perfect_normalizer' failed\n");588exit(2);589}590for(i=0;i<perpdim;i++)591perpbase[i] = Pbase[i]->array.SZ;592if((perpprod = (int ***)malloc(perpdim *sizeof(int **))) == 0)593{594printf("malloc of 'perpprod' in 'perfect_normalizer' failed\n");595exit(2);596}597for(i=0;i<perpdim;i++)598{599if((perpprod[i] = (int **)malloc(Fo->cols *sizeof(int *))) == 0)600{601printf("malloc of 'perpprod[i]' in 'perfect_normalizer' failed\n");602exit(2);603}604for(j=0;j<Fo->cols;j++)605{606if((perpprod[i][j] = (int *)malloc((j+1) *sizeof(int))) == 0)607{608printf("malloc of 'perpprod[i]' in 'perfect_normalizer' failed\n");609exit(2);610}611}612}613if((perpvec = (int *)malloc(perpdim *sizeof(int))) == 0)614{615printf("malloc of 'perpvec' in 'perfect_normalizer' failed\n");616exit(2);617}618for(i=0;i<perpdim;i++)619perpprod[i] = init_mat(Fo->cols, Fo->cols, "");620/* get the flags from the command line */621getflags(&flags, options);622if(Erzanz > 0)623flags.GEN = 1;624else625flags.GEN = 0;626/* F.n is the number of invariant forms */627F.n = 1;628if ((F.A = (int***)malloc(1 * sizeof(int**))) == 0)629exit (2);630/* read the invariant forms */631F.dim = Fo->cols;632dim = F.dim;633if(Fo->cols != F.dim || Fo->rows != F.dim)634{635printf("error form 'Fo' in autgrp must be a square matrix\n");636exit(2);637}638if ((F.A[0] = (int**)malloc(dim * sizeof(int*))) == 0)639exit (2);640for(j=0;j<F.dim;j++)641{642if ((F.A[0][j] = (int*)malloc(dim * sizeof(int))) == 0)643exit (2);644for(k=0;k<F.dim;k++)645F.A[0][j][k] = Fo->array.SZ[j][k];646}647if (flags.GEN == 1)648/* some automorphisms are already known */649{650ngen = Erzanz;651if ((H = (int***)malloc(ngen * sizeof(int**))) == 0)652exit (2);653nH = 0;654fail = 0;655for(i=0;i<ngen;i++)656{657if(Erz[i]->cols != dim || Erz[i]->rows != dim)658{659printf("Elements 'Erz' have wrong dimension\n");660exit(3);661}662}663i = 0;664while (nH+fail < ngen)665{666if ((H[nH] = (int**)malloc(dim * sizeof(int*))) == 0)667exit (2);668for(j=0;j<dim;j++)669{670if ((H[nH][j] = (int*)malloc(dim * sizeof(int))) == 0)671exit (2);672for(k=0;k<dim;k++)673H[nH][j][k] = Erz[i]->array.SZ[j][k];674}675/* check whether the matrix is really an automorphism, i.e. fixes the forms */676if (checkgen(H[nH], F) == 0)677/* the matrix is not an automorphism */678{679++fail;680for (j = 0; j < dim; ++j)681free(H[nH][j]);682free(H[nH]);683}684else685/* the matrix fixes all forms in F */686++nH;687i++;688}689}690else691nH = 0;692693694695V.dim = dim;696V.len = dim + F.n;697/* get the short vectors */698V.n = SV->rows;699if ((V.v = (int**)malloc((V.n+1) * sizeof(int*))) == 0)700exit (2);701if ((V.v[0] = (int*)malloc(V.len * sizeof(int))) == 0)702exit (2);703for(i=1;i<= V.n;i++)704{705V.v[i] = SV->array.SZ[i-1];706}707/* the first nonzero entry of each vector is made positive and the maximal708entry of the vectors is determined */709max = 1;710for (i = 1; i <= V.n; ++i)711{712Vvi = V.v[i];713for (j = 0; j < dim && Vvi[j] == 0; ++j);714if (j < dim && Vvi[j] < 0)715{716for (k = j; k < dim; ++k)717Vvi[k] *= -1;718}719for (k = j; k < dim; ++k)720{721if (abs(Vvi[k]) > max)722max = abs(Vvi[k]);723}724}725if (max > MAXENTRY)726/* there is an entry, which is bigger than MAXENTRY, which might cause overflow,727since the program doesn't use long integer arithmetic */728{729fprintf(stderr, "Error: Found entry %d in short vectors.\nTo avoid overflow, the entries should not exceed %d.\n", max, MAXENTRY);730exit (3);731}732/* V.prime is a prime p, such that every entry x in the short vectors remains733unchanged under reduction mod p in symmetric form, i.e. -p/2 < x <= p/2 */734for (V.prime = 2*max + 1; isprime(V.prime) == 0; ++V.prime);735/* sort the vectors and delete doublets */736sortvecs(&V);737/* the norm-vector (i.e. the vector of the norms with respect to the different738invariant forms) of each vector must be equal to the norm-vector of one739of the vectors from the standard-base */740if ((norm.v = (int**)malloc((dim+1) * sizeof(int*))) == 0)741exit (2);742norm.n = dim;743norm.dim = F.n;744norm.len = F.n;745for (i = 1; i <= norm.n; ++i)746{747/* norm.v[i] is the norm combination of the (i-1)-th base-vector */748if ((norm.v[i] = (int*)malloc(norm.dim * sizeof(int))) == 0)749exit (2);750for (k = 0; k < norm.dim; ++k)751norm.v[i][k] = F.A[k][i-1][i-1];752}753sortvecs(&norm);754/* delete those vectors, which can not be the image of any of the standard-base755vectors */756checkvecs(&V, F, norm);757for (i = 1; i <= norm.n; ++i)758free(norm.v[i]);759free(norm.v);760/* print the invariant forms, if output is in ASCII-format */761/*********************************************762printf("#%d\n", F.n);763for (i = 0; i < F.n; ++i)764putform(F.A[i], dim);765**********************************************/766/* F.v[i][j] is the transposed of the product of the Gram-matrix F.A[i] with the767transposed of the vector v[j], hence the scalar product of v[j] and v[k] with768respect to the Gram-matrix F.A[i] can be computed as standard scalar product769of v[j] and F.v[i][k] */770if ((F.v = (int***)malloc(F.n * sizeof(int**))) == 0)771exit (2);772/* the product of the maximal entry in the short vectors with the maximal entry773in F.v[i] should not exceed MAXNORM to avoid overflow */774max = MAXNORM / max;775for (i = 0; i < F.n; ++i)776{777FAi = F.A[i];778if ((F.v[i] = (int**)malloc((V.n+1) * sizeof(int*))) == 0)779exit (2);780Fvi = F.v[i];781for (j = 1; j <= V.n; ++j)782{783Vvj = V.v[j];784if ((Fvi[j] = (int*)malloc(dim * sizeof(int))) == 0)785exit (2);786Fvij = Fvi[j];787for (k = 0; k < dim; ++k)788{789Fvij[k] = sscp(FAi[k], Vvj, dim);790if (abs(Fvij[k]) > max)791/* some entry in F.v[i] is too large */792{793fprintf(stderr, "Error: Found entry %d in F.v.\nTo avoid overflow, the entries should not exceed %d.\n", Fvij[k], max);794exit (3);795}796}797}798}799/* fp.per is the order in which the images of the base-vectors are set */800if ((fp.per = (int*)malloc(dim * sizeof(int))) == 0)801exit (2);802/* fp.e[i] is the index in V.v of the i-th vector of the standard-base in the803new order */804if ((fp.e = (int*)malloc(dim * sizeof(int))) == 0)805exit (2);806/* fp.diag is the diagonal of the fingerprint in the new order, fp.diag[i] is807an upper bound for the length of the orbit of the i-th base-vector under808the stabilizer of the preceding ones */809if ((fp.diag = (int*)malloc(dim * sizeof(int))) == 0)810exit (2);811/* compute the fingerprint */812fingerprint(&fp, F, V);813if (flags.PRINT == 1)814/* if the -P option is given, print the diagonal fp.diag and the number of short815vectors on AUTO.tmp */816{817outfile = fopen("AUTO.tmp", "a");818fprintf(outfile, "%d short vectors\n", 2*V.n);819fprintf(outfile, "fingerprint diagonal:\n");820for (i = 0; i < dim; ++i)821fprintf(outfile, " %2d", fp.diag[i]);822fprintf(outfile, "\n");823fclose(outfile);824}825/* get the standard basis in the new order */826if ((vec = (int*)malloc(dim * sizeof(int))) == 0)827exit (2);828for (i = 0; i < dim; ++i)829{830for (j = 0; j < dim; ++j)831vec[j] = 0;832vec[fp.per[i]] = 1;833fp.e[i] = numberof(vec, V);834if (abs(fp.e[i]) > V.n)835/* the standard-base must occur in the set of short vectors, since Id is836certainly an automorphism */837{838fprintf(stderr, "Error: standard basis vector nr. %d not found\n", i);839exit (3);840}841}842free(vec);843/* if the -D option is given, the scalar product combinations and the844corresponding vector sums are computed for the standard-basis */845if (flags.DEPTH > 0)846{847if ((comb = (scpcomb*)malloc(dim * sizeof(scpcomb))) == 0)848exit (2);849for (i = 0; i < dim; ++i)850{851/* compute the list of scalar product combinations and the corresponding852vector sums */853scpvecs(&comb[i].list, &sumveclist, i, fp.e, flags.DEPTH, V, F);854/* compute a basis for the lattice that is generated by the vector sums and855a transformation matrix that expresses the basis in terms of the856vector sums */857base(&comb[i], &sumvecbase, sumveclist, F.A[0], dim);858if (flags.PRINT == 1)859/* if the -P option is given, print the rank of the lattice generated by the860vector sums on level i on AUTO.tmp */861{862outfile = fopen("AUTO.tmp", "a");863fprintf(outfile, "comb[%d].rank = %d\n", i, comb[i].rank);864fclose(outfile);865}866/* compute the coefficients of the vector sums in terms of the basis */867coef(&comb[i], sumvecbase, sumveclist, F.A[0], dim);868for (j = 0; j <= comb[i].list.n; ++j)869free(sumveclist[j]);870free(sumveclist);871/* compute the scalar products of the base-vectors */872scpforms(&comb[i], sumvecbase, F);873for (j = 0; j < comb[i].rank; ++j)874free(sumvecbase[j]);875free(sumvecbase);876}877}878/* the Bacher-polynomials for the first BACHDEP base-vectors are computed,879if no scalar product was given as an argument, the scalar product is set880to 1/2 the norm of the base-vector (with respect to the first form) */881if (flags.BACH[0] == 1)882{883if ((bach = (bachpol*)malloc(flags.BACHDEP * sizeof(bachpol))) == 0)884exit (2);885for (i = 0; i < flags.BACHDEP; ++i)886{887if (flags.BACH[2] == 0)888/* no scalar product was given as an option */889flags.BACHSCP = V.v[fp.e[i]][dim] / 2;890/* compute the Bacher-polynomial */891bacher(&bach[i], fp.e[i], flags.BACHSCP, V, F.v[0]);892if (flags.PRINT == 1)893/* if the -P option is given, print the Bacher-polynomial on AUTO.tmp */894{895outfile = fopen("AUTO.tmp", "a");896fprintf(outfile, "Bacher-polynomial of base vector fp.e[%d]:\n", i);897fputbach(outfile, bach[i]);898fclose(outfile);899}900}901}902/* set up the group: the generators in G.g[i] are matrices that fix the903first i base-vectors but do not fix fp.e[i] */904if ((G.g = (int****)malloc(dim * sizeof(int***))) == 0)905exit (2);906/* G.ng is the number of generators in G.g[i] */907if ((G.ng = (int*)malloc(dim * sizeof(int))) == 0)908exit (2);909/* the first G.nsg[i] generators in G.g[i] are obtained as stabilizer elements910and are not necessary to generate the group */911if ((G.nsg = (int*)malloc(dim * sizeof(int))) == 0)912exit (2);913/* G.ord[i] is the orbit length of fp.e[i] under the generators in914G.g[i] ... G.g[dim-1] */915if ((G.ord = (int*)malloc(dim * sizeof(int))) == 0)916exit (2);917for (i = 0; i < dim; ++i)918{919if ((G.g[i] = (int***)malloc(1 * sizeof(int**))) == 0)920exit (2);921G.ng[i] = 0;922G.nsg[i] = 0;923}924G.dim = dim;925if ((G.g[0][0] = (int**)malloc(dim * sizeof(int*))) == 0)926exit (2);927/* -Id is always an automorphism */928for (i = 0; i < dim; ++i)929{930if ((G.g[0][0][i] = (int*)malloc(dim * sizeof(int))) == 0)931exit (2);932for (j = 0; j < dim; ++j)933G.g[0][0][i][j] = 0;934G.g[0][0][i][i] = -1;935G.ng[0] = 1;936}937/* fill in the generators which were given as input */938for (i = 0; i < nH; ++i)939{940for (j = 0; j < dim && operate(fp.e[j], H[i], V) == fp.e[j]; ++j);941if (j < dim)942/* the generator is not Id and fixes fp.e[0],...,fp.e[j-1] but not fp.e[j] */943{944++G.ng[j];945if ((G.g[j] = (int***)realloc(G.g[j], G.ng[j] * sizeof(int**))) == 0)946exit (2);947if ((G.g[j][G.ng[j]-1] = (int**)malloc(dim * sizeof(int*))) == 0)948exit (2);949for (k = 0; k < dim; ++k)950{951if ((G.g[j][G.ng[j]-1][k] = (int*)malloc(dim * sizeof(int))) == 0)952exit (2);953for (l = 0; l < dim; ++l)954G.g[j][G.ng[j]-1][k][l] = H[i][k][l];955}956}957for (k = 0; k < dim; ++k)958free(H[i][k]);959free(H[i]);960}961if (nH > 0)962free(H);963nH = 0;964for (i = 0; i < dim; ++i)965nH += G.ng[i];966if ((H = (int***)malloc(nH * sizeof(int**))) == 0)967exit (2);968/* calculate the orbit lengths under the automorphisms known so far */969for (i = 0; i < dim; ++i)970{971if (G.ng[i] > 0)972{973nH = 0;974for (j = i; j < dim; ++j)975{976for (k = 0; k < G.ng[j]; ++k)977{978H[nH] = G.g[j][k];979++nH;980}981}982G.ord[i] = orbitlen(fp.e[i], fp.diag[i], H, nH, V);983}984else985G.ord[i] = 1;986}987free(H);988/* compute the full automorphism group */989autom(&G, V, F, fp, comb, bach, flags);990/* print the generators of the group, which are necessary for generating */991B = putgens(G, flags);992n = 0;993for (i = flags.STAB; i < dim; ++i)994{995if (G.ord[i] > 1)996++n;997}998/* print a base to AUTO.tmp if the print-flag is set */999if (flags.PRINT == 1)1000{1001outfile = fopen("AUTO.tmp", "a");1002fprintf(outfile, "%dx%d\n", n, dim);1003for (i = flags.STAB; i < dim; ++i)1004{1005if (G.ord[i] > 1)1006{1007for (j = 0; j < dim; ++j)1008fprintf(outfile, " %d", V.v[fp.e[i]][j]);1009fprintf(outfile, "\n");1010}1011}1012fclose(outfile);1013}1014/* print the order of the group */1015putord(G, flags, B);101610171018if (flags.BACH[0] == 1)1019{1020for (i = 0; i < flags.BACHDEP; ++i)1021free(bach[i].coef);1022free(bach);1023}1024if (flags.DEPTH > 0)1025{1026for(i=0;i<dim;i++)1027{1028for(j=0;j<=comb[i].list.n;j++)1029free(comb[i].coef[j]);1030free(comb[i].coef);1031for(j=0;j<=comb[i].list.n;j++)1032free(comb[i].list.v[j]);1033free(comb[i].list.v);1034for(j=0;j<comb[i].rank;j++)1035free(comb[i].trans[j]);1036free(comb[i].trans);1037for(j=0;j<F.n;j++)1038{1039for(k=0;k<comb[i].rank;k++)1040free(comb[i].F[j][k]);1041free(comb[i].F[j]);1042}1043free(comb[i].F);1044}1045free(comb);1046}1047for(i=0;i<F.n;i++)1048{1049for(j=1;j<=V.n;j++)1050free(F.v[i][j]);1051free(F.v[i]);1052for(j=0;j<dim;j++)1053free(F.A[i][j]);1054free(F.A[i]);1055}1056free(F.A); free(F.v);1057free(V.v);1058free(perp);1059free(perpbase);1060for(i=0;i<perpdim;i++)1061{1062for(j=0;j<Fo->cols;j++)1063free(perpprod[i][j]);1064free(perpprod[i]);1065}1066free(perpprod);1067free(perpvec);1068free(fp.diag); free(fp.per); free(fp.e);1069for(i=0;i<dim;i++)1070{1071for(j=0;j<G.ng[i];j++)1072{1073for(k=0;k<dim;k++)1074free(G.g[i][j][k]);1075free(G.g[i][j]);1076}1077free(G.g[i]);1078}1079free(G.g); free(G.ord); free(G.ng); free(G.nsg);10801081return(B);1082}108310841085