PROGRAM ENUM
C
C COSET ENUMERATION USING LOOKAHEAD.
C VERSION 2.1, FORTRAN 77, JUST ONE STORAGE ARRAY  MEM.
C COPYRIGHT L.H.SOICHER, 1992.
C
      IMPLICIT INTEGER(A-Z)
      PARAMETER(MAXMEM=4000000)
      COMMON MEM(MAXMEM)
C
C MAIN PROGRAM READS IN THE DATA AND CALLS SUBROUTINE ENUMGO TO DO 
C ALL THE WORK.
C
      OPEN(UNIT=1,FILE="GRAPE_tcin")
      OPEN(UNIT=2,FILE="GRAPE_tcout")
      REWIND(1)
      REWIND(2)
      READ(1,*)ILOOKA,OUTSW,NSTOP,MAXC
C READ IN INVERSES OF GENERATORS, SUBGROUP GENERATORS, AND RELATORS.
C STREL IS THE POINT IN  MEM  WHERE THE RELATORS BEGIN (AFTER THE
C SUBGROUP GENERATORS).
C ILOOKA IS THE INDEX INCREMENT AT WHICH LOOKAHEAD TAKES PLACE.
C IF ILOOKA=0 THEN LOOKAHEAD TAKES PLACE EVERY TIME THE INDEX DOUBLES.
C OUTSW=1 IFF OUTPUT OF THE COSET TABLE IS REQUIRED.
C THE ENUMERATION FAILS IF END OF TABLE IS REACHED  NSTOP  TIMES.
C MAXC  IS THE MAXIMUM NUMBER OF LIVE COSETS.
      READ(1,*)NGEN
      IF(NGEN.LE.0)THEN
         WRITE(2,*)' NO GENERATORS - TRIVIAL GROUP'
         STOP
      ENDIF
      IF(NGEN.GT.MAXMEM)THEN
         WRITE(*,*)' ERROR - MAXMEM TOO SMALL'
         STOP
      ENDIF
      READ(1,*)(MEM(J),J=1,NGEN)
      L=NGEN+1
    3 READ(1,*)LENGTH
      IF(LENGTH.EQ.0)GOTO 3
      IF(LENGTH.EQ.-2)LENGTH=0
      IF(LENGTH.GE.0)GOTO 4
      STREL=L
      GOTO 3
    4 IF(L+LENGTH.GT.MAXMEM)THEN
         WRITE(*,*)' ERROR - MAXMEM TOO SMALL'
         STOP
      ENDIF
      MEM(L)=LENGTH
      IF(LENGTH.EQ.0)GOTO 2
      FRONT=L+1
      BACK=L+LENGTH
      READ(1,*)(MEM(J),J=FRONT,BACK)
      L=BACK+1
      GOTO 3
    2 IF(MAXC.EQ.0)MAXC=(MAXMEM-L)/(NGEN+2)
      IF(MAXC.LT.2)THEN
         WRITE(*,*)' ERROR - MAXC TOO SMALL'
	 STOP
      ENDIF
      IF(L+(NGEN+2)*MAXC.GT.MAXMEM)THEN
	  WRITE(*,*)' ERROR - MAXMEM TOO SMALL'
	  STOP
      ENDIF
      CALL ENUMGO(MEM(1),MEM(1+NGEN),MEM(L+1),MEM(L+MAXC+1),
     1            MEM(L+2*MAXC+1),
     1            NGEN,L-NGEN,STREL-NGEN,MAXC,ILOOKA,OUTSW,NSTOP)
      CLOSE(1)
      CLOSE(2)
      STOP
      END
      SUBROUTINE ENUMGO(INV,W,ULINK,DLINK,T,
     1                  NGEN,WLEN,STREL,MAXC,ILOOKA,OUTSW,NSTOP)
      IMPLICIT INTEGER(A-Z)
      LOGICAL LOOKA,CLOSED
      INTEGER INV(NGEN),W(WLEN),ULINK(MAXC),DLINK(MAXC),T(NGEN,MAXC)
C
C MAIN SUBROUTINE TO DO COSET ENUMERATION.
C
C FIRST, INITIALIZE ACTIVE COSET LIST, FREELIST, AND COINCIDENCE QUEUE.
C IF  Y  IS IN THE COINCIDENCE QUEUE THEN  Y  IS COINCIDENT
C WITH  -ULINK(Y) (< Y).
C CURC IS THE CURRENT COSET BEING PROCESSED.
C CURW IS A POINTER TO THE CURRENT WORD CURC IS BEING PUSHED THROUGH.
C LASTCL IS THE LAST CLOSED COSET.
C LASTC IS THE LAST ACTIVE COSET.
C ASSUMES  MAXC.GE.2.
      ISTOP=0
      LASTC=1
      LASTCL=0
      CURC=1
      ULINK(1)=0
      DLINK(1)=0
      DO 5 J=1,NGEN
    5 T(J,1)=0
      CURW=1
      FREEL=2
      L=MAXC-1
      DO 6 J=2,L
    6 DLINK(J)=J+1
      DLINK(MAXC)=0
      FRONTQ=0
      BACKQ=0
      INDEX=1
      MAXDEF=1
      TOTDEF=1
      NLOOKA=ILOOKA+1
      IF(ILOOKA.EQ.0)NLOOKA=2
      LOOKA=.FALSE.
      CLOSED=.TRUE.
C MAIN LOOP.
   99 IF(LASTC.EQ.LASTCL)GOTO 88
      IF(CURC.NE.0)GOTO 7
C LOOKAHEAD FINISHED.
      WRITE(*,106)INDEX
  106 FORMAT(' LOOKAHEAD FINISHED. INDEX = ',I8,/)
      IF(FREEL.EQ.0)GOTO 89
      LOOKA=.FALSE.
      CLOSED=.TRUE.
      NLOOKA=INDEX+ILOOKA
      IF(ILOOKA.EQ.0)NLOOKA=2*INDEX
      IF(LASTCL.EQ.0)GOTO 8
      CURC=DLINK(LASTCL)
      CURW=STREL
      GOTO 7
    8 CURC=1
      CURW=1
    7 LENGTH=W(CURW)
      FRONT=CURW+1
      BACK=CURW+LENGTH
      FRONTC=CURC
      BACKC=CURC
C FORWARD SCAN.
   12 NEXTC=T(W(FRONT),FRONTC)
      IF(NEXTC.EQ.0)GOTO 13
      FRONTC=NEXTC
      FRONT=FRONT+1
      IF(FRONT.GT.BACK)GOTO 14
      GOTO 12
C BACKWARD SCAN.
   13 NEXTC=T(INV(W(BACK)),BACKC)
      IF(NEXTC.EQ.0)GOTO 15
      BACKC=NEXTC
      BACK=BACK-1
      IF(FRONT.GT.BACK)GOTO 14
      GOTO 13
   15 IF(FRONT.EQ.BACK)GOTO 17
      IF(.NOT.LOOKA.AND.FREEL.NE.0.AND.INDEX.LT.NLOOKA)GOTO 9
      IF(LOOKA)GOTO 42
      IF(FREEL.NE.0)GOTO 43
C REACHED END OF TABLE.
      ISTOP=ISTOP+1
      IF(ISTOP.EQ.NSTOP)GOTO 89
   43 WRITE(*,110)INDEX
  110 FORMAT(' LOOKAHEAD STARTED.  INDEX = ',I8)
      LOOKA=.TRUE.
   42 CLOSED=.FALSE.
      CURW=CURW+LENGTH+1
      IF(W(CURW).NE.0)GOTO 99
      CURC=DLINK(CURC)
      CURW=STREL
      CLOSED=.TRUE.
      GOTO 99
C DEFINE NEW COSET.
    9 INDEX=INDEX+1
      IF(INDEX.GT.MAXDEF)MAXDEF=INDEX
      TOTDEF=TOTDEF+1
      L=FREEL
      FREEL=DLINK(FREEL)
      CALL INSERT(L,LASTC,ULINK,DLINK,MAXC)
      LASTC=L
      DO 21 J=1,NGEN
   21 T(J,L)=0
      T(W(BACK),L)=BACKC
      T(INV(W(BACK)),BACKC)=L
      BACKC=L
      BACK=BACK-1
      GOTO 12
C DEDUCTION.
   17 T(W(FRONT),FRONTC)=BACKC
      T(INV(W(FRONT)),BACKC)=FRONTC
      FRONTC=BACKC
   14 CURW=CURW+LENGTH+1
      IF(W(CURW).NE.0)GOTO 20
      YY=CURC
      CURC=DLINK(CURC)
      CURW=STREL
C THE NEXT STATEMENT PREVENTS A COSET YY > 1 GOING BEFORE COSET 1
C ON THE ACTIVE COSET LIST.
      IF(YY.NE.1.AND.LASTCL.EQ.0)CLOSED=.FALSE.
      IF(.NOT.CLOSED.OR.ULINK(YY).EQ.LASTCL)GOTO 10
      IF(YY.EQ.LASTC)LASTC=ULINK(YY)
      CALL DELETE(YY,ULINK,DLINK,MAXC)
      CALL INSERT(YY,LASTCL,ULINK,DLINK,MAXC)
   10 IF(CLOSED)LASTCL=YY
      CLOSED=.TRUE.
   20 IF(FRONTC.EQ.BACKC)GOTO 99
C
C PROCESS COINCIDENCE.
      IF(FRONTC.LT.BACKC)THEN
      X=FRONTC
      Y=BACKC
      ELSE
      X=BACKC
      Y=FRONTC
      ENDIF
      INDEX=INDEX-1
      IF(Y.NE.CURC)GOTO 35
      CURC=DLINK(CURC)
      CURW=STREL
      CLOSED=.TRUE.
   35 IF(Y.EQ.LASTCL)LASTCL=ULINK(Y)
      IF(Y.EQ.LASTC)LASTC=ULINK(Y)
      CALL DELETE(Y,ULINK,DLINK,MAXC)
   23 DO 24 J=1,NGEN
      JX=T(J,X)
      IF(JX.EQ.Y)JX=X
      JY=T(J,Y)
      IF(JY.EQ.Y)JY=X
      IF(JX.EQ.0.OR.JY.EQ.0.OR.JX.EQ.JY)GOTO 24
C POSSIBLE NEW COINCIDENCE.
   30 IF(ULINK(JX).GE.0) GOTO 31
      JX=-ULINK(JX)
      GOTO 30
   31 IF(ULINK(JY).GE.0)GOTO 32
      JY=-ULINK(JY)
      GOTO 31
   32 IF(JX.EQ.JY)GOTO 24
      IF(JX.GT.JY)THEN
      TEMP=JX
      JX=JY
      JY=TEMP
      ENDIF
      INDEX=INDEX-1
      IF(JY.NE.CURC)GOTO 36
      CURC=DLINK(CURC)
      CURW=STREL
      CLOSED=.TRUE.
   36 IF(JY.EQ.LASTCL)LASTCL=ULINK(JY)
      IF(JY.EQ.LASTC)LASTC=ULINK(JY)
      CALL DELETE(JY,ULINK,DLINK,MAXC)
      IF(BACKQ.EQ.0)FRONTQ=JY
      ULINK(JY)=-JX
      DLINK(JY)=0
      IF(BACKQ.NE.0)DLINK(BACKQ)=JY
      BACKQ=JY
   24 CONTINUE
C UPDATE TABLE.
      DO 25 J=1,NGEN
      JY=T(J,Y)
      IF(JY.EQ.0)GOTO 25
      IF(JY.EQ.Y)T(J,Y)=X
      IF(JY.NE.Y)T(INV(J),JY)=0
   25 CONTINUE
      DO 26 J=1,NGEN
      JX=T(J,X)
      JY=T(J,Y)
      IF(JX.NE.0.OR.JY.EQ.0)GOTO 26
      IF(JY.EQ.X.AND.T(INV(J),X).NE.0)GOTO 26
      T(J,X)=JY
      T(INV(J),JY)=X
   26 CONTINUE
C RETURN Y TO THE FREELIST.
      DLINK(Y)=FREEL
      FREEL=Y
      IF(FRONTQ.EQ.0)GOTO 99
C OBTAIN NEXT COINCIDENCE TO PROCESS.
      Y=FRONTQ
      FRONTQ=DLINK(Y)
      IF(FRONTQ.EQ.0)BACKQ=0
      X=-ULINK(Y)
      GOTO 23
C
C WRITE RESULT.
   88 WRITE(2,102)INDEX
  102 FORMAT(' INDEX = ',I8)
      WRITE(2,103)MAXDEF
  103 FORMAT(' MAX.  NO. OF COSETS DEFINED = ',I8)
      WRITE(2,104)TOTDEF
  104 FORMAT(' TOTAL NO. OF COSETS DEFINED = ',I8)
      GOTO 999
   89 WRITE(2,105)MAXC
  105 FORMAT(' RUN OUT OF SPACE AFTER ',I8,' COSETS.')
      WRITE(2,104)TOTDEF
C ULINK MAY BE CHANGED BY THE FOLLOWING CALL TO PGEN.
  999 CALL PGEN(T,ULINK,DLINK,NGEN,INV,LASTCL,OUTSW,MAXC)
      RETURN
      END
      SUBROUTINE DELETE(Y,ULINK,DLINK,MAXC)
C DELETES  Y  FROM THE ACTIVE COSET LIST.
C WE ASSUME  ULINK(Y).NE.0.
      IMPLICIT INTEGER(A-Z)
      DIMENSION ULINK(MAXC),DLINK(MAXC)
      IF(DLINK(Y).NE.0)ULINK(DLINK(Y))=ULINK(Y)
      DLINK(ULINK(Y))=DLINK(Y)
      RETURN
      END
      SUBROUTINE INSERT(Y,Z,ULINK,DLINK,MAXC)
C INSERTS  Y  AFTER  Z  IN THE ACTIVE COSET LIST.
C WE ASSUME  Z.NE.0.
      IMPLICIT INTEGER(A-Z)
      DIMENSION ULINK(MAXC),DLINK(MAXC)
      IF(DLINK(Z).NE.0)ULINK(DLINK(Z))=Y
      DLINK(Y)=DLINK(Z)
      ULINK(Y)=Z
      DLINK(Z)=Y
      RETURN
      END
      SUBROUTINE PGEN(T,MAP,DLINK,NGEN,INV,LASTCL,OUTSW,MAXC)
C IF OUTSW=1, OUTPUTS (PERHAPS PARTIAL) PERMUTATIONS FROM COSET TABLE.
C IF RUN OUT OF SPACE, OUTPUTS LAST CLOSED COSET NUMBER.
C THE UNIT 3 OUTPUT IS IN  GAP 3 FORMAT FOR A SEQUENCE  GRAPE_tc_permgens  OF
C PERMUTATION GENERATORS FROM THE COSET TABLE.
      IMPLICIT INTEGER(A-Z)
      DIMENSION T(NGEN,MAXC),MAP(MAXC),DLINK(MAXC),INV(NGEN)
      IF(DLINK(LASTCL).EQ.0.AND.OUTSW.EQ.0)RETURN
      N=0
      K=1
    1 N=N+1
      MAP(K)=N
      K=DLINK(K)
      IF(K.NE.0)GOTO 1
      IF(OUTSW.EQ.0)GOTO 5
      OPEN(UNIT=3,FILE="GRAPE_tcpermgrp")
      REWIND(3)
      NA=0
      DO 4 J=1,NGEN
      IF(INV(J).GE.J)NA=NA+1
    4 CONTINUE
      WRITE(3,*)'GRAPE_tc_permgens := ['
      ACNT=0
      DO 2 J=1,NGEN
      IF(INV(J).LT.J)GOTO 2
      ACNT=ACNT+1
      WRITE(3,*)'PermList( ['
      K=1
    3 XX=0
      IF(T(J,K).NE.0)XX=MAP(T(J,K))
      K=DLINK(K)
      IF(K.NE.0)THEN
         WRITE(3,101)XX,','
  101    FORMAT(I8,A)
	 GOTO 3
      ENDIF
      IF(ACNT.NE.NA)THEN
         WRITE(3,101)XX,' ] ),'
      ELSE
         WRITE(3,101)XX,' ] ) ];'
      ENDIF
    2 CONTINUE
      CLOSE(3)
      IF(DLINK(LASTCL).EQ.0)RETURN
    5 XX=0
      IF(LASTCL.NE.0)XX=MAP(LASTCL)
      WRITE(2,102)XX
  102 FORMAT(' LAST CLOSED COSET = ',I8)
      RETURN
      END