void factorise_subgroup(
int **S, int index, int *subset, struct pga_vars *pga, struct pcp_vars *pcp)
/* definition set for subgroup */
{
register int *y = y_address;
register int i, j;
for (i = 0; i < pga->q; ++i) {
if (1 << i & pga->list[index])
continue;
for (j = 1; j <= 2 * pcp->lastg; ++j)
y[pcp->lused + j] = 0;
for (j = 0; j < pga->s; ++j)
if (S[j][i] != 0)
y[pcp->lused + pcp->ccbeg + subset[j]] = pga->p - S[j][i];
y[pcp->lused + pcp->ccbeg + i] = 1;
echelon(pcp);
}
eliminate(0, pcp);
}
void setup_echelon (int *queue, int *queue_length, int cp, struct pcp_vars *pcp)
{
register int *y = y_address;
register int lastg = pcp->lastg;
int i;
/* now echelonise the result */
for (i = 1; i <= lastg; ++i)
y[cp + lastg + i] = 0;
echelon (pcp);
if (pcp->redgen != 0 && pcp->m != 0)
queue[++*queue_length] = pcp->redgen;
}
void factor_subgroup (struct pcp_vars *pcp)
{
register int *y = y_address;
FILE * Subgroup;
int flag;
int cp;
int i;
Subgroup = fopen ("ISOM_Subgroup", "r");
if (Subgroup == (FILE *) NULL) return;
while (!feof (Subgroup)) {
if (fscanf (Subgroup, "%d", &flag) == -1)
continue;
/* should we eliminate (in order to renumber the generators)? */
if (flag == ELIMINATE)
eliminate (FALSE, pcp);
if (fscanf (Subgroup, "%d", &flag) == -1)
continue;
setup_symbols (pcp);
cp = pcp->lused;
setup_word_to_collect (Subgroup, PRETTY, WORD, cp, pcp);
for (i = 1; i <= pcp->lastg; ++i)
y[cp + pcp->lastg + i] = 0;
echelon (pcp);
}
CloseFile (Subgroup);
}
void jacobi(int c, int b, int a, int ptr, struct pcp_vars *pcp)
{
register int *y = y_address;
register int i;
register int k;
register int p1;
register int cp1;
register int cp2;
register int unc;
register int address;
register int ycol;
register int commba;
register int count;
register int count2;
register int offset;
register int lastg = pcp->lastg;
register int prime = pcp->p;
register int pm1 = pcp->pm1;
register int p_power = pcp->ppower;
register int p_pcomm = pcp->ppcomm;
#include "access.h"
#if defined(GROUP)
if (is_space_exhausted(2 * lastg + 3, pcp))
return;
#endif
/* cp1 and cp2 are the base addresses for the collected
part of the lhs and of the rhs, respectively */
cp1 = pcp->lused;
cp2 = cp1 + lastg;
unc = cp2 + lastg + 1;
for (i = 1; i <= lastg; i++)
y[cp1 + i] = y[cp2 + i] = 0;
/* calculate the class pcp->cc part of the jacobi relation
(b^p) a = b^(p - 1) (ba) */
if (c == b) {
ycol = y[p_power + b];
collect(ycol, cp1, pcp);
collect(a, cp1, pcp);
if (b != a) {
y[cp2 + b] = pm1;
p1 = y[p_pcomm + b];
commba = y[p1 + a];
collect(a, cp2, pcp);
collect(b, cp2, pcp);
collect(commba, cp2, pcp);
} else {
/* we are processing (a^p) a = a (a^p) */
ycol = y[p_power + a];
y[cp2 + a] = 1;
collect(ycol, cp2, pcp);
}
} else {
if (b - a > 0) {
#if defined(GROUP)
/* calculate the class pcp->cc part of the jacobi relation
(cb) a = c (ba); set up a as the collected part for lhs */
y[cp1 + c] = 1;
collect(b, cp1, pcp);
collect(a, cp1, pcp);
y[cp2 + c] = 1;
collect(a, cp2, pcp);
collect(b, cp2, pcp);
p1 = y[p_pcomm + b];
commba = y[p1 + a];
collect(commba, cp2, pcp);
#endif
} else {
/* calculate the class pcp->cc part of the jacobi relation
(ca) a^(p - 1) = c (a^p); first collect rhs */
ycol = y[p_power + a];
y[cp2 + c] = 1;
collect(ycol, cp2, pcp);
/* collect lhs; set up c as collected part */
y[cp1 + c] = 1;
collect(a, cp1, pcp);
y[unc] = 1;
y[unc + 1] = PACK2(pm1, a);
collect(-unc + 1, cp1, pcp);
}
}
/* the jacobi collections are completed */
if ((p1 = ptr) > 0) {
/* we are filling in the tail on y[p1]; convert the class pcp->cc
part to string form in y[cp1 + 2 + 1] to y[cp1 + 2 + count]
where count is the string length */
count = 0;
for (i = pcp->ccbeg; i <= lastg; i++) {
k = y[cp1 + i] - y[cp2 + i];
if (k != 0) {
if (k < 0)
k += prime;
++count;
y[cp1 + 2 + count] = PACK2(k, i);
}
}
if (count > 0) {
/* y[p1] was trivial to class pcp->cc - 1 so create a new entry */
if (y[p1] >= 0) {
y[p1] = -(cp1 + 1);
y[cp1 + 1] = p1;
y[cp1 + 2] = count;
pcp->lused += count + 2;
} else {
/* the class pcp->cc part is nontrivial so make room for
lower class terms */
address = -y[p1];
count2 = y[address + 1];
/* move class pcp->cc part up */
offset = cp1 + count + 3;
for (i = 1; i <= count; i++)
y[offset + count2 - i] = y[offset - i];
/* copy in lower class terms */
for (i = 1; i <= count2; i++)
y[cp1 + 2 + i] = y[address + i + 1];
/* create new header block */
y[cp1 + 1] = y[address];
y[cp1 + 2] = count + count2;
/* deallocate old entry */
y[address] = 0;
/* set up pointer to new entry */
y[p1] = -(cp1 + 1);
pcp->lused += count + count2 + 2;
}
}
} else {
/* we are checking consistency equations */
echelon(pcp);
if ((pcp->fullop && pcp->eliminate_flag) || pcp->diagn)
text(9, c, b, a, 0);
}
}
void collect_relations (struct pcp_vars *pcp)
{
register int *y = y_address;
register int i;
register int j;
register int k;
register int p1;
register int length;
register int cp, cp1, cp2;
register int relp = pcp->relp;
register int ndrel = pcp->ndrel;
register int lastg = pcp->lastg;
for (i = 1; i <= ndrel; ++i) {
/* space is required for two collected parts set up here
and possibly for 5 * pcp->lastg in collect_def_comm */
if (is_space_exhausted (7 * lastg + 7, pcp))
return;
cp1 = pcp->lused;
cp2 = cp1 + lastg;
/* original zero out -- bug reported by John Cannon October 1998 */
/*
for (j = 1; j <= lastg; ++j)
y[cp1 + j] = y[cp2 + j] = 0;
*/
for (j = 1; j <= 2; ++j) {
p1 = y[++relp];
if (p1 != 0) {
cp = (j == 1) ? cp1 : cp2;
/* bug fix */
for (k = 1; k <= lastg; ++k)
y[cp + k] = 0;
length = y[p1];
/* is the relation a word or a commutator? */
if (length > 0)
collect_gen_word (p1, length, cp, pcp);
else if (length < 0) {
/* we may need to update pcp->lused, as space immediately
above it is used in commutator routines */
if (j == 2) pcp->lused += lastg;
collect_def_comm (p1, cp, pcp);
if (j == 2) pcp->lused -= lastg;
}
if (!pcp->valid)
return;
}
}
echelon (pcp);
if ((pcp->fullop && pcp->eliminate_flag) || pcp->diagn)
text (1, i, 0, 0, 0);
if (pcp->overflow || pcp->complete != 0)
return;
}
}