{ DISCHARGE.PAS 1.1:  THIS PROGRAM SUPPLEMENTS THE PAPER `THE FOUR COLOR 
  THEOREM' [4CT] BY N ROBERTSON, D P SANDERS, P D SEYMOUR, AND R THOMAS. REFER 
  TO `DISCHARGING CARTWHEELS' [DC] (AND `REDUCIBILITY IN THE FOUR-COLOR THEOREM' 
  [R]) FOR A DESCRIPTION OF THIS PROGRAM.  DIRECT REFERENCES TO THESE PAPERS 
  WILL BE PROVIDED VIA `REF:'. COPYRIGHT 1996, 1997 BY THE AUTHORS AND 
  CHRISTOPHER CARL HECKMAN. PERMISSION TO USE FOR THE PURPOSE OF SCHOLARLY 
  RESEARCH IS HEREBY GRANTED. }

PROGRAM DISCHARGE (INPUT, OUTPUT);

CONST
	VERTS = 27;       { 1 + MAXIMUM NUMBER OF VERTICES IN A FREE COMPLETION }
	MAXDEG = 13;          { 1 + MAX DEGREE OF A VERTEX IN A FREE COMPLETION }
	MAXCONFS = 640;                      { MAXIMUM NUMBER OF CONFIGURATIONS }
	MAXVAL = 12;  
	CARTVERT = 5 * MAXVAL + 2;                         { DOMAIN OF L_A, U_A }
	RULEFILE = 'rules';                             { FILE CONTAINING RULES }
	UNAVSET = 'unavoidable.conf';     { FILE CONTAINING THE UNAVOIDABLE SET }
	OUTLETFILE = 'outlet.et';        { OUTLETS WILL BE WRITTEN TO THIS FILE }
	INFINITY = 12;                             { 12 IS GOOD ENOUGH FOR HERE }
	MAXOUTLETS = 110;
	MAXSYM = 50;                             { MAXIMUM NUMBER OF SYMMETRIES }
	MAXELIST = 134;                              { LENGTH OF EDGELIST [A,B] }
	MAXASTACK = 5;                     { MAXIMUM HEIGHT OF STACK FOR REDUCE }
	MAXLEVEL = 12;                     { 1 + MAXIMUM LEVEL OF AN INPUT LINE }
	MAXAXLES = 1 + MAXLEVEL;                                 { 1 + MAXLEVEL }
	BLANK = ' '; 
	COMMA = ',';
	LPAREN = '(';
	RPAREN = ')';
	CR = CHR (13);                                      { CARRIAGE - RETURN }
	BACK = CHR (8);                                             { BACKSPACE }
TYPE
	LONGINTEGER = INTEGER; { MAXINT = 2 ^ 31 - 1 > 2 * 10 ^ 9 IS BIG ENOUGH }
	PRINTWHAT = (NOTHING, INPUTLINE, BASICS, HUBCAPS, ALL);
	DIRS = (DEASIL, WIDDERSHINS);                      { DEASIL = CLOCKWISE }
	ISOMAP = ARRAY [0 .. CARTVERT] OF INTEGER;
	OUTLETPTR = ARRAY [1 .. 2 * MAXOUTLETS + 1] OF INTEGER;
	ADJMATRIX = ARRAY [0 .. CARTVERT, 0 .. CARTVERT] OF INTEGER;
	CONFIG = ARRAY [0 .. VERTS, 0 .. MAXDEG] OF LONGINTEGER;
	AXLE = RECORD
		LOW, UPP : ISOMAP
		END;
	OUTLET = RECORD
		NUMBER,NOLINES,VALUE : INTEGER;
		POS,LOW,UPP          : ISOMAP
		END;
	CONDITION = RECORD
		M,N : INTEGER;
		END;
	POSOUTLET = RECORD
		T : OUTLET;
		X : INTEGER
		END;
	QUERY = RECORD
		U,V,Z,XI : INTEGER;
		END;
	QUESTION = ARRAY [0 .. CARTVERT] OF QUERY;
	ELIST = ARRAY [0 .. INFINITY, 0 .. INFINITY, 0 .. MAXELIST] OF INTEGER;
	CONFIGLIST = ARRAY [1 .. MAXCONFS] OF CONFIG;
	OUTLETLIST = ARRAY [0 .. MAXOUTLETS] OF OUTLET;
	COORDS = ARRAY [0 .. VERTS] OF LONGINTEGER;
	QUESTIONLIST = ARRAY [1 .. MAXCONFS] OF QUESTION;
	BLIST = ARRAY [0 .. CARTVERT] OF BOOLEAN;

VAR
	DEGREE, LEVEL, NUMSYM               : INTEGER;
	SYM                                 : ARRAY [-1 .. MAXSYM] OF OUTLET;
	OUTLETS                             : ARRAY [1 .. MAXOUTLETS] OF OUTLET;
	COND                                : ARRAY [0 .. MAXLEVEL] OF CONDITION;
	INFILE1,                                  { INPUT FROM PRESENTATION FILE }
	INFILE2,                                  { INPUT FROM RULES FILE }
	OUTFILE                             : FILE OF CHAR;
	ADJMAT, X                           : ADJMATRIX;
	REDQUEST                            : QUESTIONLIST;
	CONF                                : CONFIGLIST;
	NUMCONFS, NUMAXLES                  : INTEGER;
	POSOUTLETS                          : ARRAY [1 .. 2 * MAXOUTLETS] 
	                                           OF POSOUTLET;
	AXLES                               : ARRAY [0 .. MAXAXLES] OF AXLE;
	NUMOUTLETS, LINENO, I               : INTEGER;
	PRINT                               : PRINTWHAT;
	NULLCONDITION                       : CONDITION;
	EDGELIST                            : ELIST;
	U, V                                : ISOMAP;
	A                                   : AXLE;
	CH                                  : CHAR;
	FILENAME, GENERIC, USTRING, VSTRING : STRING;
	CONFNAME                            : STRING; { CONFIGURATION NAME }


PROCEDURE WRITESTRING (S : STRING); { PRINT OUT A STRING, UP UNTIL THE LAST 
		NON-BLANK, WITH NO CARRIAGE-RETURN. NOTE THAT THE COMPILER THAT WAS 
		PROVIDED WITH THIS SYSTEM WAS GENERIC, AND DID NOT ALLOW VARIABLE 
		STRING-LENGTH. }
	VAR
		I, L : INTEGER;
	BEGIN
		L := 0;
		FOR I := 1 TO LENGTH (S) DO
			IF S [I] <> BLANK THEN L := I;
		FOR I := 1 TO L DO
			WRITE (S [I]);
	END;


PROCEDURE READERROR (N : INTEGER);
	BEGIN
		WRITELN;
		WRITE ('ERROR ', N : 1, ' WHILE READING CONFIGURATION ');
		WRITE (CONFNAME);
		WRITELN;
		HALT { PROGRAM }
	END;


PROCEDURE ERROR (MESSAGE: STRING);
	BEGIN
		WRITELN;
		WRITESTRING (MESSAGE);
		WRITELN (' ON LINE ',LINENO : 1);
		HALT { PROGRAM }
	END;


FUNCTION ISBLANK (CH : CHAR) : BOOLEAN;
	BEGIN
		ISBLANK := (CH IN [BLANK, CR, CHR (10), CHR (9)])
		{ CHR (10) AND CHR (9) ARE LINE-FEED AND TAB, RESPECTIVELY. }
	END;
	
	
PROCEDURE READNONBLANK1 (VAR CH : CHAR); 
	BEGIN
		REPEAT
			READ (INFILE1, CH);
			IF PRINT >= INPUTLINE THEN WRITE (CH);
			IF CH = CR THEN LINENO := LINENO + 1
		UNTIL NOT ISBLANK (CH)
	END;


PROCEDURE READNONBLANK2 (VAR CH : CHAR);
	BEGIN
		REPEAT
			READ (INFILE2, CH);
			IF PRINT >= INPUTLINE THEN WRITE (CH);
			IF CH = CR THEN LINENO := LINENO + 1
		UNTIL NOT ISBLANK (CH)
	END;


PROCEDURE SKIPCOMMENTS2;
	VAR
		AGAIN1, AGAIN2 : BOOLEAN;
		S              : STRING;
	BEGIN
		AGAIN1 := TRUE;
		REPEAT
			IF EOF (INFILE2) THEN
				AGAIN1 := FALSE
			ELSE
				BEGIN
					AGAIN2 := TRUE;
					WHILE AGAIN2 DO
						IF ISBLANK (INFILE2^) THEN
							BEGIN
								IF INFILE2^ = CR THEN
									LINENO := LINENO + 1;
								GET (INFILE2);
								AGAIN2 := NOT EOF (INFILE2)
							END
						ELSE
							AGAIN2 := FALSE;
					AGAIN1 := (INFILE2^ = '#')
				END;
			IF (AGAIN1) THEN
				BEGIN
					READLN (INFILE2, S);
					IF PRINT >= INPUTLINE THEN 
						WRITELN (LINENO, ': ', S);
					LINENO := LINENO + 1
				END
		UNTIL (NOT AGAIN1)
	END;


PROCEDURE READSTRING (S : STRING); { FROM OPEN FILE, CHECK TO MAKE SURE THAT S 
		APPEARS AS THE NEXT SEQUENCE OF CHARACTERS. IF NOT, RETURN AN ERROR 
		MESSAGE }
	VAR
		I  : INTEGER;
		CH : CHAR;
	BEGIN
		I := 1;
		WHILE S [I] <> BLANK DO
			BEGIN
				READNONBLANK1 (CH);
				IF CH <> S [I] THEN ERROR ('EXPECTED STRING IS MISSING');
				I := I + 1
			END
	END;


PROCEDURE PRINTOUTLET (N : INTEGER; T : OUTLET); { WRITES TO OUTFILE, WHICH IS 
		ASSUMED TO BE OPEN. }
	VAR
		I : INTEGER;
	BEGIN
		WRITELN (OUTFILE, N :1, BLANK, T.VALUE : 1, BLANK, T.NUMBER : 1);
		FOR I := 1 TO T.NOLINES DO
			WRITELN (OUTFILE, T.POS [I] : 1, BLANK, T.LOW [I] : 1, BLANK, 
					T.UPP [I] : 1);
		WRITELN (OUTFILE)
	END;


PROCEDURE INDENT (N : INTEGER; S : STRING);
	VAR
		I : INTEGER;
	BEGIN
		WRITELN;
		FOR I := 1 TO 2 * N DO
			WRITE (BLANK);
		WRITESTRING (S)
	END;


FUNCTION MODULO (X, Y : INTEGER) : INTEGER; { THE USUAL MODULO FUNCTION, 
	EXCEPT THAT Y IS RETURNED INSTEAD OF 0 IF X MOD Y = 0. }
	BEGIN
		IF X MOD Y = 0
			THEN MODULO := Y
			ELSE MODULO := X MOD Y
	END;


PROCEDURE PRINTAXLE (A : AXLE);
	VAR
		I : INTEGER;
	BEGIN
		FOR I := 1 TO 5 * DEGREE DO
			IF (A.LOW [I] <> 5) OR (A.UPP [I] <> INFINITY) THEN
				IF A.LOW [I] = A.UPP [I] THEN
					WRITE (BLANK, I : 1, ':', A.LOW [I] : 1)
				ELSE IF A.UPP [I] = INFINITY THEN
					WRITE (BLANK, I : 1, ':', A.LOW [I] : 1, '+')
				ELSE
					WRITE (BLANK, I : 1, ':', A.LOW [I] : 1, A.UPP [I] : 1);
		WRITELN
	END;


FUNCTION JOIN (A : AXLE; C : CONDITION) : AXLE; { REF: DC-4. COMPUTES A "JOIN" 
		C. }
	BEGIN
		IF ((A.LOW [C.N] > - C.M) OR (- C.M >= A.UPP [C.N])) AND (C.M < 0)
			THEN ERROR ('INVALID UPPER BOUND IN CONDITION');
		IF ((A.LOW [C.N] >= C.M) OR (C.M > A.UPP [C.N])) AND (C.M > 0)
			THEN ERROR ('INVALID LOWER BOUND IN CONDITION');
		IF (C.N > 2 * DEGREE) THEN
			IF (A.LOW [MODULO(C.N, DEGREE)] <> A.UPP [MODULO(C.N, DEGREE)]) OR
					(A.UPP [MODULO(C.N, DEGREE)] < 4 + (C.N - 1) DIV DEGREE)
				THEN ERROR ('ILLEGAL FAN VERTEX IN JOIN (A,C)');
		IF C.M < 0 THEN A.UPP [C.N] := - C.M;
		IF C.M > 0 THEN A.LOW [C.N] := + C.M;
		JOIN := A
	END;


FUNCTION CIRCLEPLUS (A, B, MODULUS : INTEGER) : INTEGER; { REF: DC-6 }
	BEGIN
		IF A + ((B - 1) MOD MODULUS) < MODULUS 
			THEN CIRCLEPLUS := A + B
			ELSE CIRCLEPLUS := A + B - MODULUS
	END;


FUNCTION JOINPO (A : AXLE; P : POSOUTLET) : AXLE; { RETURNS THE AXLE A "JOIN" 
		P ( = (T,X) ) }
	VAR
		SPOKE, I : INTEGER;
	BEGIN
		FOR I := 1 TO P.T.NOLINES DO
			BEGIN
				SPOKE := CIRCLEPLUS (P.X - 1, P.T.POS [I], DEGREE);
				IF A.LOW [SPOKE] < P.T.LOW [I] 
					THEN A.LOW [SPOKE] := P.T.LOW [I];
				IF A.UPP [SPOKE] > P.T.UPP [I] 
					THEN A.UPP [SPOKE] := P.T.UPP [I]
			END;
		JOINPO := A
	END;


FUNCTION CONJUGATE (C : CONDITION) : CONDITION; { REF: DC-3. COMPUTES THE 
		"CONJUGATE" OF C }
	BEGIN
		C.M := 1 - C.M;
		CONJUGATE := C
	END;


PROCEDURE RADIUS2 (CONFNUM : INTEGER); { CHECK THAT CONFIGURATION #CONFNUM HAS 
		RADIUS <= 2. THIS IS DONE BY CHECKING WHETHER THERE IS AN ALL-1 ROW 
		OF A^2, WHERE A IS THE ADJACENCY MATRIX OF CONFIGURATION #CONFNUM. }
	VAR
		I, J, K, CTR     : INTEGER;
		NVERTS, RINGSIZE : INTEGER;
		ISCTR, ADJACENT  : BOOLEAN;
		A                : ARRAY [1 .. CARTVERT, 1 .. CARTVERT] OF BOOLEAN;
	BEGIN
		CTR := 0;
		NVERTS := CONF [CONFNUM, 0, 0];
		RINGSIZE := CONF [CONFNUM, 0, 1];
		FOR I := 1 TO NVERTS DO
			FOR J := 1 TO CONF [CONFNUM,I,0] DO
				A [I,CONF [CONFNUM,I,J]] := TRUE;
		FOR I := 1 TO NVERTS DO
			A [I,I] := TRUE;
		FOR I := 1 + RINGSIZE TO NVERTS DO
			BEGIN
				ISCTR := TRUE;
				FOR J := 1 + RINGSIZE TO NVERTS DO
					BEGIN
						ADJACENT := FALSE;
						FOR K := 1 + RINGSIZE TO NVERTS DO
							IF A [I,K] AND A [K,J] THEN
								BEGIN
									ADJACENT := TRUE;
									EXIT {LOOP}
								END;
						IF NOT ADJACENT THEN
							BEGIN
								ISCTR := FALSE;
								EXIT {LOOP}
							END
					END; 
				IF ISCTR THEN
					BEGIN
						CTR := I;
						EXIT {LOOP}
					END
			END;
		IF CTR = 0 THEN READERROR (38)
	END;


PROCEDURE ADDEDGES (A,B,C : INTEGER); { A,B,C FORM A TRIANGLE IN DEASIL 
		(CLOCKWISE) ORDER }
	BEGIN
		ADJMAT [A,B] := C;
		ADJMAT [B,C] := A;
		ADJMAT [C,A] := B
	END;


PROCEDURE DOFAN (I, K : INTEGER); { SET DEGREE OF SPOKE (VERTEX I) TO K. }
	BEGIN
		IF K = 5
			THEN ADDEDGES (I, MODULO (I - 1, DEGREE) + DEGREE, DEGREE + I)
			ELSE 
				BEGIN
					ADDEDGES (I, MODULO (I - 1, DEGREE) + DEGREE, 2 * DEGREE + I);
					IF K = 6
						THEN ADDEDGES (I, 2 * DEGREE + I, DEGREE + I)
						ELSE 
							BEGIN
								ADDEDGES (I, 2 * DEGREE + I, 3 * DEGREE + I);
								IF K = 7
									THEN ADDEDGES (I, 3 * DEGREE + I, DEGREE + I)
									ELSE 
										BEGIN
											ADDEDGES (I, 3 * DEGREE + I, 4 * DEGREE + I);
											ADDEDGES (I, 4 * DEGREE + I, DEGREE + I)
										END
							END
				END
	END;


PROCEDURE GETADJMAT (A : AXLE); { COMPUTE ADJACENCY-MATRIX FOR AXLE A. }
	VAR
		H, I, J : INTEGER;
	BEGIN
		FOR I := 0 TO CARTVERT - 1 DO
			FOR J := 0 TO CARTVERT - 1 DO
				ADJMAT [I,J] := -1;
		FOR I := 1 TO DEGREE DO
			BEGIN
				H := MODULO (I - 1, DEGREE);
				ADDEDGES (0, H, I);
				ADDEDGES (I, H, DEGREE + H);
				IF A.UPP [I] < 9 THEN DOFAN (I, A.UPP [I])
			END
	END;


PROCEDURE DOOUTLET (A : AXLE; NUM : INTEGER; X, Y, Z, B : ISOMAP); { REF: 
		DC-8. GIVEN A RULE (DESCRIBED BY Z AND B), COMPUTES AN OUTLET AND ADDS 
		IT TO THE LIST IF THE HUB HAS THE RIGHT DEGREE. }
	VAR
		PHI             : ISOMAP;
		I, J, HUB       : INTEGER;
		U, V, W, UP, LO : INTEGER;
		APPLIES         : BOOLEAN;
	BEGIN
		WITH OUTLETS [NUMOUTLETS + 1] DO
			BEGIN
				GETADJMAT (A);
				APPLIES := TRUE;
				NUMBER := NUM;
				NOLINES := Z [0] - 1;
				FOR I := 0 TO CARTVERT DO
					PHI [I] := - 1;
				IF NUM > 0 THEN
					BEGIN
						PHI [0] := 1; PHI [1] := 0; VALUE := 1; HUB := 1
					END
				ELSE
					BEGIN
						PHI [0] := 0; PHI [1] := 1; VALUE := -1; HUB := 0
					END;
				POS [1] := 1;
				I := 1;
				FOR J := 0 TO NOLINES DO
					BEGIN
						UP := B [J] MOD 10;
						IF UP = 9 THEN UP := INFINITY;
						LO := B [J] DIV 10;
						IF LO = 0 THEN LO := UP;
						IF LO > UP THEN ERROR ('CONDITION (T2) VIOLATED');
						IF (LO > 9) OR (LO < 5) OR (UP < 5) OR ((UP > 8) AND 
								(UP < INFINITY))
							THEN ERROR ('CONDITION (T3) VIOLATED');
						UPP [I] := UP;
						LOW [I] := LO;
						IF J = HUB THEN
							BEGIN
								IF (LOW [HUB + 1] > DEGREE) OR (UPP [HUB + 1] < DEGREE)
									THEN
										BEGIN
											APPLIES := FALSE; EXIT { LOOP }
										END
							END
						ELSE
							BEGIN
								IF J >= 2 THEN
									BEGIN
										U := PHI [X [Z [J]]];
										V := PHI [Y [Z [J]]];
										IF (U < 0) OR (V < 0) OR (U > CARTVERT) 
												OR (V > CARTVERT)
											THEN ERROR ('RULE USES ILLEGAL VERTEX');
										W := ADJMAT [U,V];
										POS [I] := W;
										PHI [Z [J]] := W
									END;
								IF (POS [I] < 0) OR (POS [I] > CARTVERT) 
									THEN ERROR ('RULE USES ILLEGAL VERTEX');
								IF (POS [I] <= DEGREE) AND (UPP [I] = LOW [I]) 
									THEN DOFAN (POS [I], UPP [I]);
								I := I + 1
							END;
					END
			END;
		POSOUTLETS [NUMOUTLETS + 1].T := OUTLETS [NUMOUTLETS + 1];
		IF APPLIES THEN NUMOUTLETS := NUMOUTLETS + 1
	END;


PROCEDURE READOUTLETS (A : AXLE); { READS RULES AND CONVERTS THEM TO OUTLETS }
	VAR
		S                         : STRING;
		I, NUMBER, NUMRULES, TEMP : INTEGER;
		Z, B                      : ISOMAP;
	BEGIN
		TEMP := LINENO;
		RESET (INFILE2, RULEFILE);
		NUMRULES := 0;
		NUMOUTLETS := 0;
		WRITELN ('READING RULES FROM FILE ', RULEFILE, '.'); 
		SKIPCOMMENTS2;
		I := -1; { SIZE OF M OR -1 IF THERE IS NO OUTLET }
		WHILE NOT EOF (INFILE2) DO
			BEGIN
				SKIPCOMMENTS2;
				NUMRULES := NUMRULES + 1;
				READ (INFILE2, NUMBER);
				IF PRINT >= INPUTLINE THEN 
					WRITE (NUMBER : 1, BLANK);
				IF NUMBER = 0 THEN ERROR ('RULE HAS NUMBER ZERO');
				WHILE ISBLANK (INFILE2^) DO
					BEGIN
						IF INFILE2^ = CR THEN
							LINENO := LINENO + 1;
						GET (INFILE2)
					END;
				IF (INFILE2^ IN ['i','I']) AND (I < 0) 
					THEN ERROR ('ILLEGAL RULE REFERENCE');
				IF INFILE2^ IN ['i','I'] THEN
					BEGIN
						IF NUMOUTLETS + 2 > MAXOUTLETS 
							THEN ERROR ('TOO MANY OUTLETS');
						DOOUTLET (A, + NUMBER, V, U, Z, B);
						DOOUTLET (A, - NUMBER, V, U, Z, B);
						READLN (INFILE2, S); 
						LINENO := LINENO + 1;
						IF NOT EOF (INFILE2) THEN
							BEGIN
								READLN (INFILE2);
								LINENO := LINENO + 1
							END;
						IF PRINT >= INPUTLINE THEN WRITELN (S)
					END
				ELSE
					BEGIN
						READLN (INFILE2, B [0], B [1]);
						IF PRINT >= INPUTLINE THEN 
							WRITELN (B [0] : 1, BLANK, B [1] : 1, BLANK);
						LINENO := LINENO + 1;
						IF EOF (INFILE2) THEN ERROR ('UNEXPECTED END OF RULE FILE.');
						I := 2;
						WHILE (I <= CARTVERT) AND NOT EOLN (INFILE2) DO
							BEGIN
								READ (INFILE2, Z [I], B [I]);
								IF PRINT >= INPUTLINE 
									THEN WRITE (Z [I] : 1, BLANK, B [I] : 1, BLANK);
								IF (Z [I] < 0) OR (Z [I] > 16) 
									THEN ERROR ('ILLEGAL ENTRY IN RULEFILE');
								I := I + 1
							END;
						IF I > CARTVERT THEN ERROR ('TOO MANY VERTICES IN A RULE');
						Z [0] := I;
						IF NUMOUTLETS + 2 > MAXOUTLETS THEN ERROR ('TOO MANY OUTLETS');
						DOOUTLET (A, + NUMBER, U, V, Z, B);
						DOOUTLET (A, - NUMBER, U, V, Z, B);
						READLN (INFILE2); LINENO := LINENO + 1;
						IF PRINT >= INPUTLINE THEN WRITELN
					END
			END;
		CLOSE (INFILE2);
		WRITELN ('TOTAL OF ', NUMRULES : 1, ' RULES RESULTED IN ', 
				NUMOUTLETS : 1, ' OUTLETS OF DEGREE ', DEGREE : 1, '.');
		LINENO := TEMP
	END;


PROCEDURE GETQUESTION (CONFNUM : INTEGER); { REF: DC-21. CONVERTS A 
		CONFIGURATION INTO A LIST OF QUERIES (I.E. A QUESTION), SO THAT WE 
		CAN CHECK PLANAR ISOMROPHISM MORE EFFICIENTLY. }
	VAR
		FOUND              : BLIST;
		G, H, I, J, K, DEG : INTEGER;
		RINGSIZE, NVERTS   : INTEGER;
		QFRONT, QBACK      : INTEGER; { USE REDQUESTION [CONFNUM,N].Z AS A 
									QUEUE, WITH N BEING A POINTER }

	PROCEDURE LOCATE (V1, V2, V3 : INTEGER); { V1,V2,V3 FORM A DEASIL TRIANGLE, 
			WITH V1,V2 ALREADY KNOWN. REDQUEST TELLS HOW TO FIND V3 GIVEN 
			V1,V2. }
		BEGIN
			WITH REDQUEST [CONFNUM, QFRONT] DO
				BEGIN
					U := V1;
					V := V2;
					Z := V3;
					IF V3 <= RINGSIZE
						THEN XI := 0
						ELSE XI := CONF [CONFNUM,V3,0]
				END;
			FOUND [V3] := TRUE;
			QFRONT := QFRONT + 1
		END; { LOCATE }

	BEGIN { GETQUESTION }
		FOR I := 0 TO CARTVERT DO
			FOUND [I] := FALSE;
		NVERTS := CONF [CONFNUM,0,0];
		RINGSIZE := CONF [CONFNUM,0,1];
		QFRONT := 0; QBACK := 0;
		J := 1 + RINGSIZE;
		FOR I := 2 + RINGSIZE TO NVERTS DO
			IF CONF [CONFNUM,I,0] > CONF [CONFNUM,J,0] THEN J := I;
		LOCATE (0, 0, J);
		K := 0;
		FOR I := 1 TO CONF [CONFNUM,J,0] DO
			IF CONF [CONFNUM,J,I] > RINGSIZE THEN
				IF (K = 0) OR (CONF [CONFNUM,K,0] < CONF [CONFNUM, 
							CONF [CONFNUM,J,I],0])
					THEN K := CONF [CONFNUM,J,I];
		LOCATE (NVERTS, RINGSIZE, K);
		REPEAT
			I := REDQUEST [CONFNUM,QBACK].Z;
			QBACK := QBACK + 1;
			IF I > RINGSIZE THEN
				BEGIN
					DEG := CONF [CONFNUM,I,0];
					J := 1;
					WHILE NOT FOUND [CONF [CONFNUM,I,J]] DO
						J := J + 1;
					H := MODULO (J - 1, DEG);
					WHILE (CONF [CONFNUM,I,H] > RINGSIZE) AND (H <> J) DO
						IF FOUND [CONF [CONFNUM,I,H]] 
							THEN H := MODULO (H - 1, DEG)
						ELSE
							BEGIN
								LOCATE (CONF [CONFNUM,I,MODULO (H + 1, DEG)], 
										I, CONF [CONFNUM,I,H]);
								H := MODULO (H - 1, DEG)
							END;
					IF H <> J THEN
						BEGIN
							J := MODULO (J + 1, DEG);
							WHILE (CONF [CONFNUM,I,J] > RINGSIZE) DO
								IF FOUND [CONF [CONFNUM,I,J]] THEN
									J := MODULO (J + 1, DEG)
								ELSE
									BEGIN
										LOCATE (I, CONF [CONFNUM,I,MODULO (J - 1, DEG)], 
												CONF [CONFNUM,I,J]);
										J := MODULO (J + 1, DEG)
									END;
							IF (H - J + DEG) MOD DEG > 2 THEN { MORE VERTICES TO FIND;
									I IS A CUT-VERTEX; + DEG IS TO FIX A COMPILER BUG }
								BEGIN
									LOCATE (CONF [CONFNUM,I,MODULO (H + 1, DEG)], 
											I, CONF [CONFNUM,I,H]);
									G := MODULO (H - 1, DEG);
									WHILE G <> J DO
										IF (CONF [CONFNUM,I,G] <= RINGSIZE) OR 
												FOUND [CONF [CONFNUM,I,G]] 
											THEN READERROR (50000)
										ELSE
											BEGIN
												LOCATE (REDQUEST [CONFNUM,QFRONT - 1].Z, I,
														CONF [CONFNUM,I,G]);
												G := MODULO (G - 1, DEG)
											END
								END
						END
				END
		UNTIL QBACK = QFRONT;
		REDQUEST [CONFNUM,QFRONT].U := -1
	END;


PROCEDURE READCONF (CONFNUM : INTEGER); { REF: 4CT-4. READS ONE CONFIGURATION 
		FROM INFILE2 (ASSUMED ALREADY OPEN),	CHECKS IT, AND PUTS IT IN 
		CONF [CONFNUM].  DOES NOT READ COORDINATES. }
	VAR
		I, J, K, P, J1, J2, J3   : INTEGER;
		SUMDEG, RINGSIZE, NVERTS : INTEGER;
	BEGIN
		IF EOF (INFILE2) THEN READERROR (612);
		READ (INFILE2, NVERTS, RINGSIZE, J1, J2);
		IF PRINT >= INPUTLINE THEN WRITELN (CONFNAME);
		IF PRINT >= INPUTLINE 
			THEN WRITELN (NVERTS : 1, BLANK, RINGSIZE : 1, BLANK, J1 : 1, 
					BLANK, J2 : 1, BLANK);
		READ (INFILE2, J1);
		IF PRINT >= INPUTLINE THEN WRITELN (J1 : 1, BLANK);
		FOR I := 1 TO 2 * J1 DO
			BEGIN
				READ (INFILE2, J2);
				IF PRINT >= INPUTLINE THEN WRITE (J2 : 1, BLANK)
			END;
		IF PRINT > INPUTLINE THEN WRITELN;
		CONF [CONFNUM,0,0] := NVERTS;
		CONF [CONFNUM,0,1] := RINGSIZE;
		IF NVERTS >= VERTS THEN READERROR (99999);
		IF EOF (INFILE2) THEN READERROR (142857);
		FOR I := 1 TO NVERTS DO
			BEGIN
				READ (INFILE2, J, CONF [CONFNUM,I,0]);
				IF PRINT >= INPUTLINE 
					THEN WRITE (J : 4, BLANK, CONF [CONFNUM,I,0] : 4, BLANK);
				IF (J <> I) OR (CONF [CONFNUM,I,0] > NVERTS - 1) 
					THEN READERROR (14);
				FOR J := 1 TO CONF [CONFNUM,I,0] DO
					BEGIN
						READ (INFILE2, CONF [CONFNUM,I,J]);
						IF PRINT >= INPUTLINE 
							THEN WRITE (CONF [CONFNUM,I,J] : 4, BLANK)
					END;
				IF EOF (INFILE2) THEN READERROR (15);
				IF PRINT >= INPUTLINE THEN WRITELN
			END;
		FOR I := 1 TO NVERTS DO				{ READ OVER COORDINATES }
			IF EOF (INFILE2)
				THEN READERROR (1995)
				ELSE READ (INFILE2, J);
		IF NOT EOF (INFILE2) THEN READLN (INFILE2);
		IF NOT EOF (INFILE2) THEN READLN (INFILE2);
		IF PRINT >= INPUTLINE THEN WRITELN ('COORDINATES SKIPPED');
		
	{ NOW CHECK THE DEFINITION OF A CONFIGURATION (IN R) AGAINST WHAT WE'VE 
	JUST READ IN: }
		SUMDEG := 0;
		IF (RINGSIZE < 2) OR (RINGSIZE >= NVERTS) THEN READERROR (1);    { 1 }
		FOR I := 1 TO RINGSIZE DO                                        { 2 }
			IF CONF [CONFNUM,I,0] < 3
				THEN READERROR (2)
				ELSE SUMDEG := SUMDEG + CONF [CONFNUM,I,0];
		FOR I := 1 + RINGSIZE TO NVERTS DO
			IF CONF [CONFNUM,I,0] < 5
				THEN READERROR (2)
				ELSE SUMDEG := SUMDEG + CONF [CONFNUM,I,0];
		FOR I := 1 TO NVERTS DO                                          { 3 }
			FOR J := 1 TO CONF [CONFNUM,I,0] DO
				IF (CONF [CONFNUM,I,J] > NVERTS) OR (1 > CONF [CONFNUM,I,J]) 
					THEN READERROR (3);
		FOR I := 1 TO RINGSIZE DO                                        { 4 }
			IF CONF [CONFNUM,I,1] <> MODULO (I + 1, RINGSIZE) 
				THEN READERROR (4000 + I)
			ELSE IF CONF [CONFNUM,I,CONF [CONFNUM,I,0] ] <> 
					MODULO (I - 1, RINGSIZE)
				THEN READERROR (40000 + I)
			ELSE
				FOR J := 2 TO CONF [CONFNUM,I,0] - 1 DO
					IF CONF [CONFNUM,I,J] <= RINGSIZE 
						THEN READERROR (400000 + 100 * I + J);
		IF SUMDEG <> 6 * NVERTS - 6 - 2 * RINGSIZE THEN READERROR (5);   { 5 }
		FOR I := 1 + RINGSIZE TO NVERTS DO                               { 6 }
			BEGIN
				J1 := 0; J2 := 0; J3 := 0;
				FOR J := 1 TO CONF [CONFNUM,I,0] DO
					IF (CONF [CONFNUM,I,J] > RINGSIZE) AND (CONF [CONFNUM,I,
							MODULO (J + 1, CONF [CONFNUM,I,0])] <= RINGSIZE) THEN
						BEGIN
							J3 := J2; J2 := J1; J1 := J
						END;
				IF J3 > 0 THEN READERROR (6000);
				IF (J2 <> 0) AND (CONF [CONFNUM,I,MODULO (J1 + 2, CONF 
						[CONFNUM,I,0])] <= RINGSIZE) AND (CONF [CONFNUM,I,
						MODULO (J2 + 2, CONF [CONFNUM,I,0])] <= RINGSIZE)
					THEN READERROR (60000 + I)
			END;
		FOR I := 1 TO RINGSIZE DO                                        { 7 }
			FOR J := 1 TO CONF [CONFNUM,I,0] - 1 DO
				BEGIN
					K := CONF [CONFNUM,I,J];
					P := CONF [CONFNUM,CONF [CONFNUM,I,J],0];
					WHILE P > 0 DO
						IF (CONF [CONFNUM,I,MODULO (J + 1, CONF [CONFNUM,I,0])] <> 
								CONF [CONFNUM,K,P]) OR (I <> CONF [CONFNUM,K,
								MODULO (P + 1, CONF [CONFNUM,K,0])])
							THEN P := P - 1
							ELSE EXIT {LOOP};
					IF P = 0 THEN READERROR (7)
				END;
		FOR I := RINGSIZE + 1 TO NVERTS DO
			FOR J := 1 TO CONF [CONFNUM,I,0] DO
				BEGIN
					K := CONF [CONFNUM,I,J];
					P := CONF [CONFNUM,CONF [CONFNUM,I,J],0];
					WHILE P > 0 DO
						IF (CONF [CONFNUM,I,MODULO (J + 1, CONF [CONFNUM,I,0])] <> 
								CONF [CONFNUM,K,P]) OR (I <> CONF [CONFNUM,K,MODULO 
								(P + 1, CONF [CONFNUM,K,0])])
							THEN P := P - 1
							ELSE EXIT {LOOP};
					IF P = 0 THEN READERROR (7)
				END
	END;


PROCEDURE GETCONF; { READS IN UNAVOIDABLE SET. }
	BEGIN
		CONFNAME := UNAVSET;
		RESET (INFILE2, UNAVSET);
		IF EOF (INFILE2) THEN READERROR (1);
		WRITELN ('READING UNAVOIDABLE SET ... ');
		NUMCONFS := 0;
		READLN (INFILE2, CONFNAME);
		WHILE NOT EOF (INFILE2) DO
			BEGIN
				NUMCONFS := NUMCONFS + 1;
				IF NUMCONFS > MAXCONFS THEN READERROR (999);
				READCONF (NUMCONFS);
				RADIUS2 (NUMCONFS);
				GETQUESTION (NUMCONFS);
				IF NOT EOF (INFILE2) THEN READLN (INFILE2, CONFNAME)
			END;
		CLOSE (INFILE2);
		IF PRINT >= INPUTLINE THEN WRITELN;
		WRITELN ('DONE. READ ', NUMCONFS : 1,' CONFIGURATIONS.')
	END;



PROCEDURE READRULES (A : AXLE); { PART OF CHECKHUBCAP IN C PROGRAM }
	VAR
		I : INTEGER;
	BEGIN
		READOUTLETS (A);
		FOR I := 1 TO NUMOUTLETS DO
			POSOUTLETS [I + NUMOUTLETS] := POSOUTLETS [I];
		REWRITE (OUTFILE, OUTLETFILE);
		FOR I := 1 TO NUMOUTLETS DO
			PRINTOUTLET (I, OUTLETS [I]);
		CLOSE (OUTFILE);
		WRITELN ('OUTLETS WRITTEN TO ', OUTLETFILE : 1)
	END;


FUNCTION SUBCONF (DEG : ISOMAP; Q : QUESTION; VAR IMAGE : ISOMAP) : BOOLEAN; 
		{ LOOKS FOR ONE OF THE UNAVOIDABLE CONFIGURATIONS (DESCRIBED BY Q) IN 
		THE GRAPH GENERATED BY DEG, AND PUTS THE ISOMORPHISM (IF THERE IS 
		ONE) INTO IMAGE. }
	VAR
		J : INTEGER;

	FUNCTION ROOTEDSUBCONF (X, Y : INTEGER; DIRECTION : DIRS) : BOOLEAN; 
			{ LOOK FOR UNAVOIDABLE CONFIGURATION WITH ONE EDGE IDENTIFIED. 
			IF NOT THERE, RETURNS FALSE. }
		VAR
			I, W  : INTEGER;
			LEGAL : BOOLEAN;
			USED  : BLIST;    { TELL WHICH VERTICES OF THE CARTWHEEL ARE 
							MAPPED ONTO }
		BEGIN
			LEGAL := FALSE;
			FOR I := 0 TO CARTVERT DO
				BEGIN
					IMAGE [I] := -1;
					USED [I] := FALSE
				END;
			IF DIRECTION = DEASIL 
				THEN IMAGE [0] := 1
				ELSE IMAGE [0] := 0;
			IMAGE [Q [0].Z] := X; USED [X] := TRUE;
			IMAGE [Q [1].Z] := Y; USED [Y] := TRUE;
			I := 2;
			WHILE Q [I].U >= 0 DO  
				BEGIN
					IF DIRECTION = DEASIL
						THEN W := ADJMAT [IMAGE [Q [I].U], IMAGE [Q [I].V]]
						ELSE W := ADJMAT [IMAGE [Q [I].V], IMAGE [Q [I].U]];
					IF W < 0 THEN EXIT { LOOP };
					IF (Q [I].XI > 0) AND (Q [I].XI <> DEG [W]) THEN EXIT { LOOP };
					IF USED [W] THEN EXIT { LOOP };
					IMAGE [Q [I].Z] := W; USED [W] := TRUE;
					I := I + 1;
					LEGAL := (Q [I].U < 0) { LEGAL ONLY IF ALL VERTICES IN 
										Q CHECK OUT. }
				END;
			IF LEGAL THEN { TEST WELL-POSITIONEDNESS }
				FOR I := 1 TO DEGREE DO
					IF USED [DEGREE + I] AND USED [DEGREE + MODULO (I - 1, DEGREE)] 
							AND NOT USED [I]
						THEN LEGAL := FALSE;
			ROOTEDSUBCONF := LEGAL
		END; { ROOTED SUBCONF }

	BEGIN { SUBCONF }
		SUBCONF := (EDGELIST [Q [0].XI, Q [1].XI, 0] > 0);
		FOR J := 1 TO EDGELIST [Q [0].XI, Q [1].XI, 0] DO
			IF ROOTEDSUBCONF (EDGELIST [Q [0].XI, Q [1].XI, 2 * J - 1], 
					EDGELIST [Q [0].XI, Q [1].XI, 2 * J], WIDDERSHINS)
				THEN EXIT { LOOP }
			ELSE IF ROOTEDSUBCONF (EDGELIST [Q [0].XI, Q [1].XI, 2 * J - 1], 
					EDGELIST [Q [0].XI, Q [1].XI, 2 * J], DEASIL)
				THEN EXIT { LOOP }
			ELSE SUBCONF := (J < EDGELIST [Q [0].XI, Q [1].XI, 0])
	END;


PROCEDURE CHECKCONDITION; { REF: DC-16. HANDLES CONDITION DISPOSITION. }
	VAR
		C    : CONDITION;
		GOOD : BOOLEAN;
		I    : INTEGER;
	BEGIN
		IF EOLN (INFILE1) THEN ERROR ('UNEXPECTED END-OF-LINE');
		READ (INFILE1, C.N, C.M);
		IF PRINT >= INPUTLINE THEN WRITELN (C.N : 1, BLANK, C.M : 1, BLANK);
		IF (C.N < 1) OR (C.N > 5 * DEGREE) 
			THEN ERROR ('INVALID VERTEX IN CONDITION');
		IF ((C.M < -8) OR (C.M > 9)) OR ((C.M > -5) AND (C.M < 6)) 
			THEN ERROR ('INVALID CONDITION');
		AXLES [LEVEL + 1] := JOIN (AXLES [LEVEL], C);
		AXLES [LEVEL] := JOIN (AXLES [LEVEL], CONJUGATE (C));
		GOOD := TRUE;
		FOR I := 0 TO LEVEL DO
			GOOD := GOOD AND (COND [I].N <= 2 * DEGREE) AND (COND [I].N >= 1);
		IF NOT GOOD THEN { SPOKE VERTICES ARE TOO RESTRICTIVE } 
			BEGIN
				IF PRINT > INPUTLINE THEN WRITE ('SYMMETRY NOT ADDED')
			END
		ELSE IF NUMSYM = MAXSYM THEN
			ERROR ('TOO MANY SYMMETRIES')
		ELSE
			WITH SYM [NUMSYM] DO
				BEGIN		
					IF PRINT >= BASICS THEN WRITE ('ADDING SYMMETRY: ');
					NUMSYM := NUMSYM + 1;  { DOES NOT AFFECT `WITH' STATEMENT }
					SYM [NUMSYM] := SYM [NUMSYM - 1];
					NUMBER := LINENO;
					VALUE := 1;
					NOLINES := LEVEL;
					FOR I := 0 TO LEVEL DO
						BEGIN
							POS [I] := COND [I].N;
							IF COND [I].M > 0 THEN
								BEGIN
									LOW [I] := COND [I].M;
									UPP [I] := INFINITY
								END
							ELSE
								BEGIN
									LOW [I] := 5;
									UPP [I] := - COND [I].M
								END;
							IF PRINT >= BASICS 
								THEN WRITE (' (',POS [I] : 1, COMMA, LOW [I] : 1, COMMA, 
										UPP [I] : 1, RPAREN)
						END
				END;
		COND [LEVEL] := C;
		COND [LEVEL + 1] := NULLCONDITION;
		LEVEL := LEVEL + 2 { PROGRAM AUTOMATICALLY DECREASES LEVEL BY 1 LATER ON }
	END;


FUNCTION OUTLETFORCED (A : AXLE; T : OUTLET; X : INTEGER) : INTEGER; 
		{ REF: DC-16 ET AL }
	VAR
		I, P, DEGREE : INTEGER;
		FORCED       : BOOLEAN;

	BEGIN
		DEGREE := A.LOW [0];
		FORCED := TRUE;
		X := X - 1;
		FOR I := 1 TO T.NOLINES DO
			BEGIN
				P := CIRCLEPLUS (X, T.POS [I], DEGREE);
				IF (T.LOW [I] > A.LOW [P]) OR (T.UPP [I] < A.UPP [P]) 
					THEN FORCED := FALSE
			END;
		IF FORCED 
			THEN OUTLETFORCED := T.VALUE
			ELSE OUTLETFORCED := 0
	END;


FUNCTION OUTLETPERMITTED (A : AXLE; T : OUTLET; X : INTEGER) : INTEGER; 
		{ REF: DC-16 ET AL }
	VAR
		I, P, DEGREE : INTEGER;
		PERMITTED    : BOOLEAN;
	BEGIN
		DEGREE := A.LOW [0];
		X := X - 1;
		PERMITTED := TRUE;
		FOR I := 1 TO T.NOLINES DO
			BEGIN
				P := CIRCLEPLUS (X, T.POS [I], DEGREE);
				IF (T.LOW [I] > A.UPP [P]) OR (T.UPP [I] < A.LOW [P]) 
					THEN PERMITTED := FALSE
			END;
		IF PERMITTED
			THEN OUTLETPERMITTED := T.VALUE
			ELSE OUTLETPERMITTED := 0
	END;


FUNCTION REFLECTFORCED (A : AXLE; T : OUTLET; X : INTEGER) : INTEGER; 
		{ REF: DC-17 }
	VAR
		DEGREE, I, P, Q : INTEGER;
		FORCED          : BOOLEAN;
	BEGIN
		DEGREE := A.LOW [0];
		X := X - 1;
		FORCED := TRUE;
		FOR I := 1 TO T.NOLINES DO
			BEGIN
				P := CIRCLEPLUS (X, T.POS [I], DEGREE);
				IF (P < 1) OR (P > 2 * DEGREE) THEN
					FORCED := FALSE
				ELSE IF P <= DEGREE THEN
					Q := DEGREE - P + 1
				ELSE IF P < 2 * DEGREE THEN
					Q := 3 * DEGREE - P
				ELSE
					Q := 2 * DEGREE;
				IF (T.LOW [I] > A.LOW [Q]) OR (T.UPP [I] < A.UPP [Q]) 
					THEN FORCED := FALSE
			END;
		IF FORCED
			THEN REFLECTFORCED := T.VALUE
			ELSE REFLECTFORCED := 0
	END;


PROCEDURE CHECKSYMMETRY (A : AXLE); { REF: DC-16. CHECK SYMMETRY DISPOSITION }
	VAR
		K, EPS, LEVEL, LINE, I : INTEGER;
	BEGIN
		READ (INFILE1, K, EPS, LEVEL, LINE);
		IF PRINT >= INPUTLINE THEN 
			WRITE (K : 1, BLANK, EPS : 1, BLANK, LEVEL : 1, BLANK, LINE : 1, BLANK);
		IF (K < 0) OR (K > A.LOW [0]) OR (EPS < 0) OR (EPS > 1) 
			THEN ERROR ('ILLEGAL SYMMETRY');
		I := 0;
		WHILE (I < NUMSYM) AND (SYM [I].NUMBER <> LINE) DO
			I := I + 1;
		IF I = NUMSYM THEN ERROR ('NO SYMMETRY AS REQUESTED');
		IF SYM [I].NOLINES <> LEVEL 
			THEN ERROR ('LEVEL MISMATCH IN SYMMETRY');
		IF (EPS = 0) AND (0 = OUTLETFORCED (A, SYM [I], K + 1)) 
			THEN ERROR ('INVALID SYMMETRY');
		IF (EPS = 1) AND (0 = REFLECTFORCED (A, SYM [I], K + 1)) 
			THEN ERROR ('INVALID REFLECTED SYMMETRY')
	END;


PROCEDURE CHECKISO (CONFNUM : INTEGER; A : AXLE; IMAGE : ISOMAP); { VERIFY 
		THAT IMAGE IS IN FACT AN ISOMORPHISM. }
	VAR
		H, I, J, K, U, V : INTEGER;
		USED             : BLIST;
		RINGSIZE, NVERTS : INTEGER;

	PROCEDURE INDUCHECK (A, B : INTEGER); { CHECK THAT EDGE AB IS INCLUDED 
			IN THE CARTWHEEL. }
		BEGIN
			IF USED [A] AND USED [B] AND (X [A,B] <> 1) 
				THEN ERROR ('ISOMORPHISM NOT INDUCED')
		END; { INDUCHECK }

	BEGIN { CHECKISO }
		NVERTS := CONF [CONFNUM,0,0];
		RINGSIZE := CONF [CONFNUM,0,1];
		FOR I := 0 TO CARTVERT DO
			FOR J := 0 TO CARTVERT DO
				X [I,J] := 0;
		GETADJMAT (A);
		FOR I := 0 TO CARTVERT DO
			USED [I] := FALSE;
		FOR I := 1 + RINGSIZE TO NVERTS DO
			IF (IMAGE [I] < 0) OR (IMAGE [I] > CARTVERT) THEN
				ERROR ('ISOMORPHISM ERROR #1')
			ELSE IF USED [IMAGE [I]] THEN
				ERROR ('ISOMORPHISM ERROR #1')
			ELSE IF A.UPP [IMAGE [I]] <> CONF [CONFNUM,I,0] THEN
				ERROR ('ISOMORPHISM ERROR #2')
			ELSE IF IMAGE [I] <= 2 * DEGREE THEN
				USED [IMAGE [I]] := TRUE
			ELSE IF A.LOW [MODULO (IMAGE [I], DEGREE)] < A.UPP [MODULO 
					(IMAGE [I], DEGREE)] THEN
				ERROR ('ISOMORPHISM ERROR #3')
			ELSE IF A.UPP [MODULO (IMAGE [I], DEGREE)] < (IMAGE [I] - 1) 
					DIV DEGREE + 4 THEN
				ERROR ('ISOMORPHISM ERROR #3')
			ELSE
				USED [IMAGE [I]] := TRUE;
		FOR I := 1 TO DEGREE DO
			IF USED [I + DEGREE] AND USED [DEGREE + MODULO (I - 1, DEGREE)] 
					AND NOT USED [I]
				THEN ERROR ('ISOMORPHISM ERROR #4');
		FOR I := 1 + RINGSIZE TO NVERTS DO
			FOR J := 1 TO CONF [CONFNUM,I,0] DO
				IF CONF [CONFNUM,I,J] > RINGSIZE THEN
					BEGIN
						IF IMAGE [0] <> 0 THEN { DEASIL }
							BEGIN
								U := IMAGE [I]; V := IMAGE [CONF [CONFNUM, I, J]]
							END
						ELSE { WIDDERSHINS }
							BEGIN
								U := IMAGE [CONF [CONFNUM, I, J]]; V := IMAGE [I]
							END;
						X [U,V] := 1;
						K := CONF [CONFNUM,I,MODULO (J + 1, 
								CONF [CONFNUM,I,0])];
						IF K <= RINGSIZE THEN
							BEGIN
								IF CONF [CONFNUM,I, MODULO (J - 1, 
										CONF [CONFNUM,I,0])] <= RINGSIZE
									THEN ERROR ('ISOMORPHISM ERROR #5')
							END
						ELSE IF IMAGE [K] <> ADJMAT [U,V] 
							THEN ERROR ('ISOMORPHISM ERROR #6')
					END;
		FOR I := 1 TO DEGREE DO
			BEGIN
				INDUCHECK (0, I);
				H := MODULO (I - 1, DEGREE);
				INDUCHECK (H, H + DEGREE);
				INDUCHECK (I, H + DEGREE);
				IF A.LOW [I] = A.UPP [I] THEN
					CASE A.UPP [I] OF
						5 : INDUCHECK (H + DEGREE, DEGREE + I);
						6 : BEGIN
							INDUCHECK (H + DEGREE, 2 * DEGREE + I);
							INDUCHECK (2 * DEGREE + I, I);
							INDUCHECK (2 * DEGREE + I, DEGREE + I)
						    END;
						7 : BEGIN
							INDUCHECK (H + DEGREE, 2 * DEGREE + I);
							INDUCHECK (2 * DEGREE + I, I);
							INDUCHECK (2 * DEGREE + I, 3 * DEGREE + I);
							INDUCHECK (3 * DEGREE + I, I);
							INDUCHECK (3 * DEGREE + I, DEGREE + I)
						    END;
						8 : BEGIN
							INDUCHECK (H + DEGREE, 2 * DEGREE + I);
							INDUCHECK (2 * DEGREE + I, I);
							INDUCHECK (2 * DEGREE + I, 3 * DEGREE + I);
							INDUCHECK (3 * DEGREE + I, I);
							INDUCHECK (4 * DEGREE + I, 3 * DEGREE + I);
							INDUCHECK (4 * DEGREE + I, I);
							INDUCHECK (4 * DEGREE + I, DEGREE + I)
						    END;
						OTHERWISE ERROR ('UNEXPECTED ERROR IN CHECKISO')
					END
			END
	END;	


PROCEDURE GETEDGELIST (AX : AXLE); { GIVEN AN AXLE, FINDS ALL EDGES UV WITH 
		(DEG (U), DEG (V)) = (A,B). }
	VAR
		A, B, C, D, E, H, I : INTEGER;

	PROCEDURE ADDTOLIST (U, V : INTEGER); { ADD ONE EDGE UV TO LIST ACCORDING 
			TO DEG (U), DEG (V). }
		VAR
			K, DU, DV : INTEGER;
		BEGIN
			DU := AX.UPP [U];
			DV := AX.UPP [V]; 		
			K := 1 + EDGELIST [DU,DV,0];
			IF (DU >= DV) AND (DV <= 8) AND ((DU <= 8) OR (U = 0)) THEN
				IF 2 * K > MAXELIST 
					THEN 
						ERROR ('NOT ENOUGH EDGES IN EDGELIST')
					ELSE
						BEGIN
							EDGELIST [DU,DV,0] := K;
							EDGELIST [DU,DV,2 * K - 1] := U;
							EDGELIST [DU,DV,2 * K] := V
						END;
			K := 1 + EDGELIST [DV,DU,0];
			IF (DV >= DU) AND (DU <= 8) AND ((DV <= 8) OR (V = 0)) THEN
				IF 2 * K > MAXELIST 
					THEN 
						ERROR ('NOT ENOUGH EDGES IN EDGELIST')
					ELSE
						BEGIN
							EDGELIST [DV,DU,0] := K;
							EDGELIST [DV,DU,2 * K - 1] := V;
							EDGELIST [DV,DU,2 * K] := U
						END
		END; { ADDTOLIST }

	BEGIN { GETEDGELIST }
		FOR A := 5 TO 11 DO
			FOR B := 5 TO 11 DO
				EDGELIST [A,B,0] := 0;
		FOR I := 1 TO DEGREE DO
			BEGIN
				ADDTOLIST (0, I);
				H := MODULO (I - 1, DEGREE);
				ADDTOLIST (I, H);
				A := DEGREE + H;
				B := DEGREE + I;
				C := DEGREE + B;
				D := DEGREE + C;
				E := DEGREE + D;
				ADDTOLIST (I, A);
				ADDTOLIST (I, B);
				IF AX.LOW [I] = AX.UPP [I] THEN { ADD FANS ABOVE SPOKE }
					CASE AX.UPP [I] OF
						5 : ADDTOLIST (A, B);
						6 : BEGIN
							ADDTOLIST (A, C);
							ADDTOLIST (I, C);
							ADDTOLIST (B, C)
						    END;
						7 : BEGIN
							ADDTOLIST (A, C);
							ADDTOLIST (I, C);
							ADDTOLIST (C, D);
							ADDTOLIST (I, D);
							ADDTOLIST (B, D)
						    END;
						8 : BEGIN
							ADDTOLIST (A, C);
							ADDTOLIST (I, C);
							ADDTOLIST (C, D);
							ADDTOLIST (I, D);
							ADDTOLIST (D, E);
							ADDTOLIST (I, E);
							ADDTOLIST (B, E)
						    END;
						OTHERWISE ERROR ('UNEXPECTED ERROR IN "GETEDGELIST"')
					END
			END	
	END;


FUNCTION REDUCE (A : AXLE) : BOOLEAN; { REF: DC-18 }
	VAR
		STACK          : ARRAY [1 .. MAXASTACK] OF AXLE;
		I, H, STACKPTR : INTEGER;
		B              : AXLE;
		IMAGE          : ISOMAP;
	BEGIN
		IF PRINT = ALL 
			THEN WRITELN ('TESTING REDUCIBILITY. PUTTING INPUT AXLE ON STACK.');
		STACKPTR := 1;
		STACK [1] := A;
		WHILE STACKPTR > 0 DO
			BEGIN
				B := STACK [STACKPTR];
				STACKPTR := STACKPTR - 1;
				IF PRINT = ALL THEN
					BEGIN
						WRITE ('AXLE FROM STACK: '); PRINTAXLE (B)
					END;
				GETADJMAT (B);
				GETEDGELIST (B);
				H := 1;
				WHILE (H <= NUMCONFS) AND NOT SUBCONF (B.UPP, REDQUEST [H], 
						IMAGE) DO
					H := H + 1;
				IF H > NUMCONFS THEN
					ERROR ('NOT REDUCIBLE')
				ELSE
					BEGIN
						IF PRINT = ALL THEN
							BEGIN
								WRITE ('CONF (', (H - 1) DIV 70 + 1 : 1, COMMA, 
										((H - 1) MOD 70) DIV 7 + 1 : 1, COMMA, 
										(H - 1) MOD 7 + 1 : 1, '): ');
								FOR I := 1 TO CONF [H,0,0] DO
									IF IMAGE [I] >= 0 
										THEN WRITE (IMAGE [I] : 1, LPAREN, I : 1, RPAREN,
										 		BLANK);
								WRITELN
							END;
						CHECKISO (H, B, IMAGE);
						FOR I := 1 + CONF [H,0,1] TO CONF [H,0,0] DO
							IF B.LOW [IMAGE [I]] < B.UPP [IMAGE [I]] THEN
								BEGIN
									IF PRINT = ALL 
										THEN WRITELN ('LOWERING UPPER BOUND OF VERTEX ',
												IMAGE [I] : 1,' TO ', B.UPP [IMAGE [I]] - 1
												: 1, ' AND ADDING TO STACK.');
									STACKPTR := STACKPTR + 1;
									IF STACKPTR > MAXASTACK 
										THEN ERROR ('STACK OVERFLOW');
									STACK [STACKPTR] := B;
									STACK [STACKPTR].UPP [IMAGE [I]] := 
											B.UPP [IMAGE [I]] - 1
								END
					END
			END; { WHILE }
		IF PRINT = ALL 
			THEN WRITELN ('ALL POSSIBILITIES FOR LOWER DEGREES TESTED.');
		REDUCE := TRUE
	END;


PROCEDURE CHECKBOUND (AX : AXLE; S : OUTLETPTR; V, P, DEPTH : INTEGER); 
		{ REF: DC-10 }
	VAR
		Q, A, F, I : INTEGER;
		SPRIME     : OUTLETPTR;
		AXPRIME    : AXLE;
		FORCED     : BOOLEAN;
	BEGIN
		I := P;
		WHILE S [I] < 99 DO { 1 }
			BEGIN
				IF S [I] = 0 THEN
					IF OUTLETFORCED (AX, POSOUTLETS [I].T, POSOUTLETS [I].X) 
							<> 0 THEN
						S [I] := 1
					ELSE IF 0 = OUTLETPERMITTED (AX, POSOUTLETS [I].T, 
							POSOUTLETS [I].X) THEN
						S [I] := -1;
				I := I + 1
			END;
		A := 0;
		F := 0;
		I := 1;
		IF PRINT >= HUBCAPS THEN INDENT (DEPTH, 'PO''S:');
		WHILE S [I] < 99 DO { 2 }
			BEGIN
				IF S [I] = 1 THEN
					F := F + POSOUTLETS [I].T.VALUE
				ELSE IF (POSOUTLETS [I].T.VALUE > 0) AND (S [I] = 0) THEN
					A := A + POSOUTLETS [I].T.VALUE;
				IF (S [I] = 0) AND (PRINT >= HUBCAPS) THEN WRITE ('?');
				IF (S [I] >= 0) AND (PRINT >= HUBCAPS) 
					THEN WRITE (POSOUTLETS [I].T.NUMBER : 1, COMMA, 
							POSOUTLETS [I].X : 1, BLANK);
				I := I + 1
			END;
		IF PRINT >= HUBCAPS THEN WRITELN;
		IF A + F <= V THEN { 3 }
			BEGIN
				IF PRINT >= HUBCAPS 
					THEN INDENT (DEPTH, 'INEQUALITY HOLDS. CASE DONE');
				IF PRINT > NOTHING THEN WRITELN
			END
		ELSE
			IF F > V THEN { 4 }
				BEGIN
					IF NOT REDUCE (AX) 
						THEN ERROR ('INCORRECT HUBCAP UPPER BOUND')
				END
			ELSE BEGIN
				Q := P;
				WHILE S [Q] < 99 DO { 5 }
					IF (S [Q] = 0) AND (POSOUTLETS [Q].T.VALUE > 0) THEN
						BEGIN
							SPRIME := S; { 6 }
							SPRIME [Q] := 1;
							AXPRIME := JOINPO (AX, POSOUTLETS [Q]);
							FORCED := FALSE;
							FOR I := 1 TO P DO { 7 }
								IF (S [I] = -1) AND (OUTLETFORCED (AXPRIME, POSOUTLETS 
											[I].T, POSOUTLETS [I].X) <> 0) THEN
										BEGIN
											IF PRINT >= HUBCAPS 
												THEN INDENT (DEPTH, 'POSITIONED OUTLET');
											IF PRINT >= HUBCAPS THEN 
												WITH POSOUTLETS [Q] DO
													WRITELN (BLANK, T.NUMBER : 1, COMMA, 
															X : 1, ' CAN''T BE FORCED.', 
															POSOUTLETS [I].T.NUMBER : 1, 
															COMMA, POSOUTLETS [I].X : 1, 
															'FORCED.');
											FORCED := TRUE
										END;
							IF NOT FORCED THEN { 8 }
								BEGIN
									IF PRINT >= HUBCAPS THEN
										BEGIN
											INDENT (DEPTH, 'STARTING RECURSION WITH');
											WRITELN (BLANK, POSOUTLETS [Q].T.NUMBER : 1, 
													COMMA, POSOUTLETS [Q].X : 1, ' FORCED')
										END;
									CHECKBOUND (AXPRIME, SPRIME, V, Q, DEPTH + 1)
								END;
							IF PRINT >= HUBCAPS THEN
								BEGIN
									INDENT (DEPTH, 'REJECTING POSITIONED OUTLET');
									WRITELN (BLANK, POSOUTLETS [Q].T.NUMBER : 1, COMMA, 
											POSOUTLETS [Q].X : 1, '. ');
								END;
							S [Q] := -1; { 9 }
							A := A - POSOUTLETS [Q].T.VALUE;
							IF A + F <= V THEN EXIT { LOOP }; { 10 }
							Q := Q + 1
						END
					ELSE
						Q := Q + 1;
				IF A + F > V THEN
					ERROR ('UNEXPECTED ERROR 101')
				ELSE
					IF PRINT >= HUBCAPS THEN INDENT (DEPTH, 'INEQUALITY HOLDS.')
			     END
	END;
		

PROCEDURE CHECKHUBCAP (A : AXLE); { REF: DC-8. HANDLES HUBCAP DISPOSITION. }
	VAR
		STATUS, X, Y, V, AUX : ISOMAP;
		SUM, I, J, NUMTRPLS  : INTEGER;
		C1,C2,C3             : CHAR;
		S                    : OUTLETPTR;
		EDGENOPRINTED        : BOOLEAN;
	BEGIN
		NUMTRPLS := 0;
		REPEAT
			READ (INFILE1, C1);
			IF PRINT >= INPUTLINE THEN WRITE (C1)
		UNTIL (C1 = LPAREN) OR EOLN (INFILE1);
		WHILE NOT EOLN (INFILE1) DO
			BEGIN
				NUMTRPLS := NUMTRPLS + 1;
				IF (NUMTRPLS > MAXVAL) THEN ERROR ('TOO MANY HUBCAP ELEMENTS');
				READ (INFILE1, X [NUMTRPLS], C1, Y [NUMTRPLS], C2, V [NUMTRPLS], 
						C3);
				IF PRINT >= INPUTLINE 
					THEN WRITE (X [NUMTRPLS] : 1, C1, Y [NUMTRPLS] : 1, C2, 
							V [NUMTRPLS] : 1, C3, BLANK);
				IF (C1 <> COMMA) OR (C2 <> COMMA) OR (C3 <> RPAREN) 
					THEN ERROR ('SYNTAX ERROR');
				WHILE (C3 <> LPAREN) AND NOT EOLN (INFILE1) DO
					BEGIN
						READ (INFILE1, C3);
						IF PRINT >= INPUTLINE THEN WRITE (C3)
					END
			END;
		IF PRINT > INPUTLINE THEN WRITELN;
		IF PRINT >= BASICS THEN 
			BEGIN
				WRITELN;
				WRITELN ('TESTING HUBCAP FOR:');
				PRINTAXLE (A);
				WRITE ('FORCED POSITIONED OUTLETS:');
				FOR I := 1 TO DEGREE DO
					BEGIN
						EDGENOPRINTED := FALSE;
						FOR J := 1 TO NUMOUTLETS DO
							IF OUTLETFORCED (A, OUTLETS [J], I) <> 0 THEN
								BEGIN
									IF NOT EDGENOPRINTED THEN
										BEGIN
											WRITELN;
											WRITE ('EDGE ', I : 1, ': ');
											EDGENOPRINTED := TRUE
										END;
									WRITE (OUTLETS [J].NUMBER : 1, BLANK)
								END
					END;
				WRITELN
			END;
		FOR I := 1 TO DEGREE DO
			BEGIN
				STATUS [I] := 0; AUX [I] := 0
			END;
		SUM := 0;
		FOR I := 1 TO NUMTRPLS DO
			IF (X [I] < 1) OR (X [I] > DEGREE) OR (Y [I] < 1) OR (Y [I] > DEGREE) 
				THEN
					BEGIN
						WRITELN ('INVALID HUBCAP MEMBER (', X [I] : 1, COMMA, 
								Y [I] : 1, COMMA, V [I] : 1, RPAREN);
						ERROR ('')
					END
			ELSE IF X [I] = Y [I] THEN
				BEGIN
					IF STATUS [X [I]] <> 0 
						THEN ERROR ('INVALID HUBCAP -- SPOKE USED TOO MUCH');
					STATUS [X [I]] := -1; SUM := SUM + V [I] * 2
				END
			ELSE
				BEGIN
					IF (STATUS [X [I]] = -1) 
						THEN ERROR ('INVALID HUBCAP -- SPOKE USED TOO MUCH');
					IF STATUS [X [I]] = 0
						THEN STATUS [X [I]] := Y [I]
						ELSE STATUS [X [I]] := -1;
					IF (STATUS [Y [I]] = -1) 
						THEN ERROR ('INVALID HUBCAP -- SPOKE USED TOO MUCH');
					IF STATUS [Y [I]] = 0
						THEN STATUS [Y [I]] := X [I]
						ELSE STATUS [Y [I]] := -1;
					SUM := SUM + V [I];
					AUX [X [I]] := V [I]
				END;
		FOR I := 1 TO DEGREE DO
			IF STATUS [I] = 0 THEN ERROR ('INVALID HUBCAP -- VERTEX MIS-PAIRED')
			ELSE IF STATUS [I] > 0 THEN
				IF STATUS [STATUS [I]] = I
					THEN SUM := SUM + AUX [I]
					ELSE ERROR ('INVALID HUBCAP -- CROSSING EDGES');
		IF (PRINT >= BASICS) OR (SUM > 20 * (DEGREE - 6) + 1) 
			THEN WRITELN ('TOTAL DOUBLE COVER COST IS ', SUM : 1);
		IF SUM > 20 * (DEGREE - 6) + 1 THEN ERROR ('INCORRECT HUBCAP');
		FOR I := 1 TO NUMTRPLS DO
			BEGIN
				IF PRINT >= HUBCAPS 
					THEN WRITELN ('--> CHECKING HUBCAP MEMBER (', X [I] : 1, COMMA, 
							Y [I]: 1, COMMA, V [I] : 1, RPAREN);
				FOR J := 1 TO NUMOUTLETS DO
					BEGIN
						S [J] := 0; POSOUTLETS [J].X := X [I]
					END;
				IF X [I] <> Y [I] THEN
					FOR J := NUMOUTLETS + 1 TO 2 * NUMOUTLETS DO
						BEGIN
							S [J] := 0; POSOUTLETS [J].X := Y [I]
						END;
				IF X [I] = Y[I]
					THEN S [NUMOUTLETS + 1] := 99
					ELSE S [2 * NUMOUTLETS + 1] := 99; { MARK END OF LIST }
				CHECKBOUND (A, S, V [I], 1, 1)
			END;
		IF PRINT >= HUBCAPS THEN WRITELN
	END;
		


{ MAIN ROUTINE }{ REF: 4CT-30, DC-16 } 
BEGIN
	USTRING := 'AAABADCBEDIDAAFGP';
	VSTRING := 'AABACABDCFCJEMABB'; { FOR QUICK INITIALIZATION OF U,V ARRAYS }
	FOR I := 0 TO 16 DO
		BEGIN
			U [I] := ORD (USTRING [I + 1]) - ORD ('A');
			V [I] := ORD (VSTRING [I + 1]) - ORD ('A')
		END;
	WRITE ('REDUCTION FOR WHICH FILE? ');
	READLN (FILENAME);
	WRITE ('PRINT EVERYTHING? ');
	READLN (CH);
	IF CH IN ['Y','y'] THEN
		PRINT := ALL
	ELSE
		BEGIN
			WRITE ('PRINT NOTHING? ');
			READLN (CH);
			IF CH IN ['Y','y'] THEN
				PRINT := NOTHING
			ELSE
				BEGIN
					WRITE ('PRINT HUBCAPS? ');
					READLN (CH);
					IF CH IN ['Y','y'] THEN
						PRINT := HUBCAPS
					ELSE
						BEGIN
							WRITE ('PRINT BASICS? ');
							READLN (CH);
							IF CH IN ['Y','y']
								THEN PRINT := BASICS
								ELSE PRINT := INPUTLINE
						END
				END
		END;
	RESET (INFILE1, FILENAME);
	WRITELN;
	WRITELN ('VERIFYING ', FILENAME);
	LEVEL := 0;
	LINENO := 1; 
	NUMSYM := 0;
	NULLCONDITION.M := 0;
	NULLCONDITION.N := 0;
	COND [0] := NULLCONDITION;
	READSTRING ('Degree');
	READ (INFILE1, DEGREE);
	IF PRINT >= INPUTLINE THEN WRITELN;
	IF PRINT >= INPUTLINE THEN WRITE (LINENO : 1, ' : ', DEGREE : 1, BLANK);
	IF (DEGREE < 5) OR (DEGREE > 12) THEN ERROR ('INVALID DEGREE');
	A.LOW [0] := DEGREE;
	A.UPP [0] := DEGREE;
	FOR I := 1 TO CARTVERT DO { BUILD TRIVIAL AXLE }
		BEGIN
			A.LOW [I] := 5;
			A.UPP [I] := INFINITY
		END;
	WRITELN;
	READRULES (A);
	GETCONF;
	AXLES [LEVEL] := A;
	WHILE LEVEL >= 0 DO
		BEGIN
			IF LEVEL >= MAXLEVEL 
				THEN ERROR ('MAXLEVEL NOT HIGH ENOUGH TO CONTINUE');
			A := AXLES [LEVEL];
			LINENO := LINENO + 1;
			READNONBLANK1 (CH);
			IF CH <> 'L' THEN ERROR ('LEVEL MARKER EXPECTED');
			READ (INFILE1, I);
			IF PRINT >= INPUTLINE THEN WRITE (I : 1, BLANK);
			IF I <> LEVEL THEN ERROR ('UNEXPECTED LEVEL');
			READNONBLANK1 (CH);
			CASE CH OF
				'C' : CHECKCONDITION;
				'H' : CHECKHUBCAP (A);
				'R' : IF NOT REDUCE (A) THEN ERROR ('REDUCIBILITY FAILED');
				'S' : CHECKSYMMETRY (A);
				OTHERWISE ERROR ('UNRECOGNIZED DISPOSITION')
			END;
			READLN (INFILE1);
			IF PRINT >= INPUTLINE THEN WRITELN;
			IF (NUMSYM > 0) AND (SYM [NUMSYM - 1].NOLINES >= LEVEL) AND 
					(PRINT >= BASICS)
				THEN WRITE ('DELETING SYMMETRIES:');
			WHILE (NUMSYM > 0) AND (SYM [NUMSYM - 1].NOLINES >= LEVEL) DO 
			{ THE REASON FOR -1 }
				BEGIN
					IF PRINT >= BASICS 
						THEN WRITE (BLANK, SYM [NUMSYM].NUMBER : 1);
					NUMSYM := NUMSYM - 1
				END;
			LEVEL := LEVEL - 1
		END;
	READLN (INFILE1, GENERIC);
	WRITELN;
	IF PRINT >= INPUTLINE THEN WRITESTRING (GENERIC);
	LINENO := LINENO + 1;
	IF GENERIC <> 'Q.E.D.' THEN ERROR ('Q.E.D. EXPECTED');
	WRITELN;
	WRITESTRING (FILENAME);
	WRITELN (' VERIFIED.');
	CLOSE (INFILE1)
END.