/***********************************************************************
     This is a program for computing the (p,q)-cohomology groups of a
     complete intersection in a product of complex projective spaces.

       Written in THINK C 4.0 for the Macintosh by Tristan Hubsch.
 ***********************************************************************/


/*   ****** The header files ******   */
#include <stdio.h>



/*   ****** The global def's ******   */
#define nx = 7;                      {Maximum dimension for the CP(n)s.}
#define mx = 12;                {Maximum total dimension of the CP(n)s.}
#define hx = 9;                         {Maximum number of constraints.}
#define hy = 18;                                      {Since hy = 2 hx.}
#define wx = 126;           {Maximum number of "wedges", depends on hx.}


/*   ****** The global var's ******   */
long	H, K, M, SubDim,
		Dim[mx], NorCoh[mx], TanCoh[mx],
		Confg[mx][hx],
		Wedge[mx][wx],
		NorSS[mx+1][hx+1],
		TanSS[mx+1][hx+1],
		NCNSS[mx+1][hx+1],
		TCNSS[mx+1][hx+1],
		TCTSS[mx+1][hx+1],
		Choose[mx+1][hx+1];



/*   ****** The global fun's ******   */
long	Parity (long);
void	GetCheckInt(long);
void	GetCheckIntLn (long);




/*   ****** The main rutine ******   */
main()
{
while()
  {
	Initialize;
	REPEAT
		GetDimen;
  IF M < 0 THEN
   GOTO 88;
99:
		IF M <> 0 THEN
			BEGIN
				Configuration;
				DoSpectra;
				DoCohs;
				ShoNorSS;
				ShoTanSS;
				WhatNow;
    IF M < 0 THEN GOTO 88
    ELSE IF M = 0 THEN GOTO 99;
				ShoNCNSS;
				WhatNow;
    IF M < 0 THEN GOTO 88
    ELSE IF M = 0 THEN GOTO 99;
				ShoTCNSS;
				WhatNow;
    IF M < 0 THEN GOTO 88
    ELSE IF M = 0 THEN GOTO 99;
				ShoTCTSS;
			END;
	UNTIL M = 0
  }
}



/*   ****** The sub-rutines ******   */
long	Parity (jj : Integer) : Integer;
		VAR
			aaa, ii, prty : Integer;
	BEGIN
		IF jj = 0 THEN
			Parity := 1;
		IF jj < 0 THEN
			aaa := -jj
		ELSE
			aaa := jj;
		prty := 1;
		FOR ii := 1 TO aaa DO
			prty := -prty;
		Parity := prty
	END;

	PROCEDURE GetCheckInt(VAR glop : Integer);
		VAR
			IOCode : Integer;
	BEGIN
  {$I-}
  REPEAT
  Read(glop);
  IOCode := IOResult;
  IF IOCode <> 0 THEN
    WriteLn('Er ... that is not what I would expect. Re-enter, please.')
  UNTIL IOCode = 0;
  {$I+}
	END;

	PROCEDURE GetCheckIntLn (VAR glop : Integer);
		VAR
			IOCode : Integer;
	BEGIN
  {$I-}
  REPEAT
  ReadLn(glop);
  IOCode := IOResult;
  IF IOCode <> 0 THEN
    WriteLn('Er ... that is not what I would expect. Re-enter, please.')
  UNTIL IOCode = 0;
  {$I+}
	END;

	PROCEDURE Initialize;
		LABEL
			33;
		VAR
			a, b, c, IOCode : Integer;

	BEGIN
33 :
		Write('The dimension of the submanifold to be defined : ');
  GetCheckIntLn(SubDim);
  IF SubDim < 0 THEN
			BEGIN
				WriteLn('You have to reinvent algebraic geometry for that.');
				WriteLn(' Meanwhile, try again :');
				WriteLn('');
				GOTO 33
			END
		ELSE IF SubDim = 0 THEN
			BEGIN
				WriteLn('Nothing much to do with that, try again :');
				WriteLn('');
				GOTO 33
			END
		ELSE IF SubDim >= mx THEN
			BEGIN
				WriteLn('Too big for me, sorry. Try again :');
				WriteLn('');
				GOTO 33
			END;
		WriteLn('');
		FOR a := 1 TO mx DO
			Dim[a] := 0;
		FOR a := 1 TO mx DO
			FOR b := 1 TO hx DO
				Confg[a, b] := 0;
		FOR a := 1 TO mx DO
			FOR b := 1 TO wx DO
				Wedge[a, b] := 0;
		FOR a := 0 TO mx DO
			FOR b := 0 TO hx DO
				BEGIN
					NorSS[a, b] := 0;
					TanSS[a, b] := 0;
					NCNSS[a, b] := 0;
					TCNSS[a, b] := 0;
					TCTSS[a, b] := 0
				END;

		FOR a := 2 TO (2 * hx) DO
			FOR b := 1 TO (a - 1) DO
				Choose[b, a] := 0;
		FOR a := 1 TO (2 * hx) DO
			Choose[0, a] := 0;
		FOR b := 0 TO 2 * hx DO
			Choose[b, 0] := 1;
		FOR b := 1 TO 2 * hx DO
			Choose[b, 1] := b;
		FOR a := 2 TO 2 * hx DO
			FOR b := a TO 2 * hx DO
				BEGIN
					Choose[b, a] := 0;
					FOR c := (a - 1) TO (b - 1) DO
						Choose[b, a] := Choose[b, a] + Choose[c, (a - 1)]
				END
	END;

	PROCEDURE GetDimen;
  LABEL
   77;
		VAR
			r, TotDim : Integer;     {Reads in the dimensions of the CP's.}

	BEGIN
		REPEAT
			WriteLn('');
			Write('How many factor-CPs ? ');
			Write('("0" to quit, "-ve" for starting all over) : ');
			GetCheckIntLn(M);
			IF (M < 0) THEN
				 GOTO 77;
		UNTIL (M <= mx);

		IF (M <> 0) THEN
			BEGIN
				REPEAT
					WriteLn('');
					Write('Enter the ', M : 1, ' dimensions : ');
					TotDim := 0;
					IF (M > 1) THEN
						FOR r := 1 TO (M - 1) DO
							BEGIN
								GetCheckInt(Dim[r]);
								TotDim := TotDim + Dim[r]
							END;
					GetCheckIntLn(Dim[M]);
					TotDim := TotDim + Dim[M];
				UNTIL (TotDim <= mx) AND (TotDim > SubDim);
				FOR r := (M + 1) TO mx DO
					Dim[r] := 0;
				H := TotDim - SubDim
			END;
77 :
	END;

	PROCEDURE Configuration;
		VAR
			a, r : Integer;              {Reads in the configuration matrix.}

	BEGIN
		WriteLn('');
		WriteLn('Enter ', H : 1, ' degrees of homogeneity :');
		FOR r := 1 TO M DO
			BEGIN
				Write('[ ', Dim[r] : 1, ' || ');
				FOR a := 1 TO (H - 1) DO
					GetCheckInt(Confg[r, a]);
				GetCHeckIntLn(Confg[r, H]);
				FOR a := (H + 1) TO hx DO
					Confg[r, a] := 0;
			END;
		FOR r := (M + 1) TO mx DO
			FOR a := 1 TO hx DO
				Confg[r, a] := 0;
	END;

	PROCEDURE BareBott (VAR nn, kk, jj, zz : Integer);
	BEGIN
		IF kk >= 0 THEN         {Bott's formula with the bare hyperplane bundle.}
			zz := zz * Choose[(kk + nn), nn]
		ELSE IF kk <= -(nn + 1) THEN
			BEGIN
				jj := jj + nn;
				zz := zz * Choose[(-kk - 1), nn]
			END
		ELSE
			zz := 0
	END;

	PROCEDURE TangBott (VAR nn, kk, jj, zz : Integer);
	BEGIN
		IF kk >= -1 THEN                {Bott's formula with the tangent bundle.}
			zz := zz * (kk + nn + 2) * Choose[(kk + nn), (nn - 1)]
		ELSE IF kk = -(nn + 1) THEN
			jj := jj + (nn - 1)
		ELSE IF kk <= -(nn + 3) THEN
			BEGIN
				jj := jj + nn;
				zz := zz * (-kk - nn - 2) * Choose[(-kk - 2), (nn - 1)]
			END
		ELSE
			zz := 0
	END;

	PROCEDURE CotaBott (VAR nn, kk, jj, zz : Integer);
	BEGIN
		IF kk >= 2 THEN               {Bott's formula with the cotangent bundle.}
			zz := zz * (kk - 1) * Choose[(kk + nn - 1), (nn - 1)]
		ELSE IF kk = 0 THEN
			jj := jj + 1
		ELSE IF kk <= -nn THEN
			BEGIN
				jj := jj + nn;
				zz := zz * (1 - kk) * Choose[(-kk - 1), (nn - 1)]
			END
		ELSE
			zz := 0
	END;

	PROCEDURE EndtBott (VAR nn, kk, jj, zz : Integer);
		VAR
			ugh : Integer;     {Bott's formula with the endomorphism bundle.}

	BEGIN
		IF kk > 0 THEN        {Deviate from layout to keep things on the screen.}
			BEGIN
				zz := zz * (nn * kk * (nn + kk + 1) + 1) * Choose[(nn + kk - 1), (nn - 1)];
				ugh := zz MOD (kk + 1);             {Check the remainder.}
				zz := zz DIV (kk + 1);                        {As if O.K.}
				IF ugh <> 0 THEN
					Write('Non-Integer rank in H*(EndT) !')
			END
		ELSE IF kk = 0 THEN
			zz := zz        {Case kk=0 requires no action.}
		ELSE IF kk = -1 THEN
			BEGIN
				jj := jj + 1;
				IF nn > 1 THEN
					zz := zz * (nn + 1)
				ELSE
					zz := 0           {No traceless 1by1 matrix.}
			END
		ELSE IF kk = -nn THEN
			BEGIN
				jj := jj + (nn - 1);
				IF nn > 1 THEN
					zz := zz * (nn + 1)
				ELSE
					zz := 0         {No traceless 1by1 matrix.}
			END
		ELSE IF kk = -(nn + 1) THEN
			jj := jj + nn                            {zz := zz*1.}
		ELSE IF kk < -(nn + 1) THEN
			BEGIN
				jj := jj + nn;
				zz := zz * (nn * kk * (nn + kk + 1) + 1) * Choose[(-kk - 2), (nn - 1)];
				ugh := zz MOD (-kk - nn);   {Check the remainder.}
				zz := zz DIV (-kk - nn);              {As if O.K.}
				IF ugh <> 0 THEN
					Write('Non-Integer rank in H*(EndT) !')
			END
		ELSE
			zz := 0
	END;

	PROCEDURE DoNorSS;
		LABEL
			22;                                                   {Catch 22}
		VAR
			a, b, j, r, z : Integer;
			d : ARRAY[1..mx] OF Integer;

	BEGIN
		FOR a := 1 TO Choose[H, K] DO
			FOR b := 1 TO H DO
				BEGIN
					FOR r := 1 TO M DO
						d[r] := Wedge[r, a] + Confg[r, b];
					FOR r := (M + 1) TO mx DO
						d[r] := 0;
					z := 1;
					j := 0;
					FOR r := 1 TO M DO
						IF z = 0 THEN
							GOTO 22
						ELSE
							BareBott(Dim[r], d[r], j, z);
					NorSS[j, K] := NorSS[j, K] + z;
22 :
				END
	END;

	PROCEDURE DoTanSS;
		LABEL
			22;                                                   {Catch 22}
		VAR
			a, j, r, s, z : Integer;

	BEGIN
		FOR a := 1 TO Choose[H, K] DO
			FOR s := 1 TO M DO
				BEGIN
					z := 1;
					j := 0;
					FOR r := 1 TO M DO
						IF z = 0 THEN
							GOTO 22
						ELSE IF s = r THEN
							TangBott(Dim[r], Wedge[r, a], j, z)
						ELSE
							BareBott(Dim[r], Wedge[r, a], j, z);
					TanSS[j, K] := TanSS[j, K] + z;
22 :
				END
	END;

	PROCEDURE DoNCNSS;
		LABEL
			22;                                                   {Catch 22}
		VAR
			a, b, c, j, r, z : Integer;
			d : ARRAY[1..mx] OF Integer;

	BEGIN
		FOR a := 1 TO Choose[H, K] DO
			FOR b := 1 TO H DO
				FOR c := 1 TO H DO
					BEGIN
						FOR r := 1 TO M DO
							d[r] := Wedge[r, a] - Confg[r, b] + Confg[r, c];
						FOR r := (M + 1) TO mx DO
							d[r] := 0;
						z := 1;
						j := 0;
						FOR r := 1 TO M DO
							IF z = 0 THEN
								GOTO 22
							ELSE
								BareBott(Dim[r], d[r], j, z);
						NCNSS[j, K] := NCNSS[j, K] + z;
22 :
					END
	END;

	PROCEDURE DoTCNSS;
		LABEL
			22;                                                   {Catch 22}
		VAR
			a, b, j, r, s, z : Integer;
			d : ARRAY[1..mx] OF Integer;

	BEGIN
		FOR a := 1 TO Choose[H, K] DO
			FOR b := 1 TO H DO
				FOR s := 1 TO M DO
					BEGIN
						FOR r := 1 TO M DO
							d[r] := Wedge[r, a] - Confg[r, b];
						FOR r := (M + 1) TO mx DO
							d[r] := 0;
						z := 1;
						j := 0;
						FOR r := 1 TO M DO
							IF z = 0 THEN
								GOTO 22
							ELSE IF r = s THEN
								TangBott(Dim[r], d[r], j, z)
							ELSE
								BareBott(Dim[r], d[r], j, z);
						TCNSS[j, K] := TCNSS[j, K] + z;
22 :
					END
	END;

	PROCEDURE DoTCTSS;
		LABEL
			22;                                                   {Catch 22}
		VAR
			a, j, r, s, t, z : Integer;

	BEGIN
		FOR a := 1 TO Choose[H, K] DO
			FOR t := 1 TO M DO
				FOR s := 1 TO M DO
					BEGIN
						z := 1;
						j := 0;
						FOR r := 1 TO M DO
							IF z = 0 THEN
								GOTO 22
							ELSE IF r = s THEN
								IF r = t THEN
									EndtBott(Dim[r], Wedge[r, a], j, z)
								ELSE
									CotaBott(Dim[r], Wedge[r, a], j, z)
							ELSE IF r = t THEN
								TangBott(Dim[r], Wedge[r, a], j, z)
							ELSE
								BareBott(Dim[r], Wedge[r, a], j, z);
						TCTSS[j, K] := TCTSS[j, K] + z;
22 :
					END
	END;

	PROCEDURE Wedging;
		VAR
			a, b, c, r : Integer;
			d : ARRAY[1..mx, 1..wx] OF Integer;

	BEGIN
		FOR a := 1 TO wx DO
			FOR r := 1 TO mx DO
				d[r, a] := Wedge[r, a];
		c := 0;
		FOR b := (K + 1) TO H DO
			BEGIN
				FOR a := 1 TO Choose[(b - 1), K] DO
					BEGIN
						c := c + 1;
						FOR r := 1 TO M DO
							Wedge[r, c] := d[r, a] - Confg[r, b]
					END
			END;
		K := K + 1
	END;

	PROCEDURE DoSpectra;
		VAR
			f, g : Integer;

	BEGIN
		FOR g := 1 TO mx DO
			FOR f := 1 TO wx DO
				Wedge[g, f] := 0;
		FOR g := 0 TO mx DO
			FOR f := 0 TO hx DO
				BEGIN
					NorSS[g, f] := 0;
					TanSS[g, f] := 0;
					NCNSS[g, f] := 0;
					TCNSS[g, f] := 0;
					TCTSS[g, f] := 0;
				END;
		K := 0;
		DoNorSS;
		DoTanSS;
		DoNCNSS;
		DoTCNSS;
		DoTCTSS;
		REPEAT
			Wedging;
			DoNorSS;
			DoTanSS;
			DoNCNSS;
			DoTCNSS;
			DoTCTSS;
		UNTIL K >= H
	END;

	PROCEDURE DoCohs;   {Gets the ranks of the CICY cohomology in T and E.}
		VAR
			j, q : Integer;

	BEGIN
		FOR q := 0 TO SubDim DO
			BEGIN
				NorCoh[q] := 0;              {No cohomology to start with.}
				TanCoh[q] := 0;              {No cohomology to start with.}
			END;
		FOR q := 0 TO SubDim DO                       {For every diagonal,}
			FOR j := 0 TO H DO          {summing up the terms along it.}
				BEGIN   {This corresponds to the filtration in our Eq(17).}
					NorCoh[q] := NorCoh[q] + NorSS[(j + q), j];
					TanCoh[q] := TanCoh[q] + TanSS[(j + q), j];
				END;
		FOR q := 1 TO H DO  {Getting rid of the negative dim. part of}
			FOR j := 1 TO q DO    {the E-bdl sp.seq. assuming no error.}
				BEGIN
					NorCoh[0] := NorCoh[0] + Parity(j) * NorSS[(q - j), q];
					TanCoh[0] := TanCoh[0] + Parity(j) * TanSS[(q - j), q];
				END;
	END;

	PROCEDURE ShoNorSS;                   {Displays the E spectral sequence.}
		VAR
			r, j : Integer;

	BEGIN
		WriteLn('');
		WriteLn('The E spectral sequence :');
		WriteLn('');
		Write(' \j :');
		FOR j := 0 TO (H + SubDim) DO
			Write(j : 4);
		WriteLn(' |  H*(CICY,E)');
		Write('k \-+');
		FOR j := 0 TO (H + SubDim) DO
			Write('----');
		Write('-|  [');
		FOR r := 0 TO (SubDim - 1) DO
			Write(NorCoh[r] : 1, ',');
		WriteLn(NorCoh[SubDim] : 1, ']');

		FOR r := 0 TO H DO
			BEGIN
				Write(r : 1, '   |');
				FOR j := 0 TO (H + SubDim) DO
					Write(NorSS[j, r] : 4);
				WriteLn(' |');
			END;
		WriteLn('');
	END;

	PROCEDURE ShoTanSS;                    {Displays the T spectral sequence.}
		VAR
			r, j : Integer;

	BEGIN
		WriteLn('');
		WriteLn('The T spectral sequence :');
		WriteLn('');
		Write(' \j :');
		FOR j := 0 TO (H + SubDim) DO
			Write(j : 4);
		WriteLn(' |  H*(CICY,T)');
		Write('k \-+');
		FOR j := 0 TO (H + SubDim) DO
			Write('----');
		Write('-|  [');
		FOR r := 0 TO (SubDim - 1) DO
			Write(TanCoh[r] : 1, ',');
		WriteLn(TanCoh[SubDim] : 1, ']');

		FOR r := 0 TO H DO
			BEGIN
				Write(r : 1, '   |');
				FOR j := 0 TO (H + SubDim) DO
					Write(TanSS[j, r] : 4);
				WriteLn(' |');
			END;
		WriteLn('');
	END;

	PROCEDURE ShoNCNSS;           {Displays the E x E*  spectral sequence.}
		VAR
			r, j : Integer;

	BEGIN
		WriteLn('');
		WriteLn('The  E x E*  spectral sequence :');
		WriteLn('');
		Write(' \j :');
		FOR j := 0 TO (H + SubDim) DO
			Write(j : 4);
		WriteLn(' |');
		Write('k \-+');
		FOR j := 0 TO (H + SubDim) DO
			Write('----');
		WriteLn('-|');

		FOR r := 0 TO H DO
			BEGIN
				Write(r : 1, '   |');
				FOR j := 0 TO (H + SubDim) DO
					Write(NCNSS[j, r] : 4);
				WriteLn(' |');
			END;
		WriteLn('');
	END;

	PROCEDURE ShoTCNSS;           {Displays the T x E*  spectral sequence.}
		VAR
			r, j : Integer;

	BEGIN
		WriteLn('');
		WriteLn('The  T x E*  spectral sequence :');
		WriteLn('');
		Write(' \j :');
		FOR j := 0 TO (H + SubDim) DO
			Write(j : 4);
		WriteLn(' |');
		Write('k \-+');
		FOR j := 0 TO (H + SubDim) DO
			Write('----');
		WriteLn('-|');

		FOR r := 0 TO H DO
			BEGIN
				Write(r : 1, '   |');
				FOR j := 0 TO (H + SubDim) DO
					Write(TCNSS[j, r] : 4);
				WriteLn(' |');
			END;
		WriteLn('');
	END;

	PROCEDURE ShoTCTSS;           {Displays the T x T*  spectral sequence.}
		VAR
			r, j : Integer;

	BEGIN
		WriteLn('');
		WriteLn('The  T x T*  spectral sequence :');
		WriteLn('');
		Write(' \j :');
		FOR j := 0 TO (H + SubDim) DO
			Write(j : 4);
		WriteLn(' |');
		Write('k \-+');
		FOR j := 0 TO (H + SubDim) DO
			Write('----');
		WriteLn('-|');

		FOR r := 0 TO H DO
			BEGIN
				Write(r : 1, '   |');
				FOR j := 0 TO (H + SubDim) DO
					Write(TCTSS[j, r] : 4);
				WriteLn(' |');
			END;
		WriteLn('');
	END;

	PROCEDURE WhatNow;
  LABEL
   77;
		VAR
			ChasEnd, Answer : Char;

	BEGIN
		Write('Hit some key to continue ("s" to start all over, "0" to quit) : ');
		IF NOT eoln THEN
			Read(Answer);
		IF Answer = 's' THEN
   BEGIN
    M := -1;
			 GOTO 77
   END
  ELSE IF Answer = '0' THEN
   BEGIN
    M := 0;
			 GOTO 77
   END;    
		WHILE NOT eoln DO
			Read(ChasEnd);
		Read(ChasEnd);
77 :
	END;