(* ******************************************************************************************************)
(*                                                                                                      *)
(*          This is the final part of a program based on the algorithms presented in the paper         *)
(*                                                                                                      *)
(*           New tools for classifying Hamiltonian circle actions with isolated fixed points,           *)
(*    Foundations of Computational Mathematics, 14 (2014),791-860. DOI:10.1007/s10208-014-9204-1.       *)
(*                                                                                                      *)
(*                             by Leonor Godinho and Silvia Sabatini                                    *)
(*                                                                                                      *)
(*    For manifolds of index 3, it uses the partitions in the file PartitionsIndex3.zip to determine    *)
(*   the possible isotropy weights for a circle action satisfying the required conditions.              *)
(*                                                                                                      *)
(*                                                                                                      *)
(* ************************************************************************************************** *)


(* Part 3 - Sorting Partitions according to the the rank of the matrices A obtained in Part II *)


(* First we sort the partitions according to whether the rank of the matrices
 A-Diag(part) is (cardI-1) or smaller and store them in the files "Part#toprk.txt" and "Part#smallrk.txt"; when the rank is cardI-1 we discard the partitions that originate null spaces with no vectors with positive entries;when the rank is smaller than cardI-1 we discard those whose vectors have an entry equal to zero (they do not satisfy "test 2" below)*)

Print[];
Print["**************************************************************************"];
Print["Working with NNMs"];
Print["**************************************************************************"];

Parttoprk=Table[0,{i,1,Length[lff]}];
Partsmallrk=Table[0,{i,1,Length[lff]}];
Print[];
Print["Sorting the Partitions according to the rank of the corresponding matrices..."];
k=1; 
test2=Function[x,(Val=False;s=1;
While[s≤cardI,
t=1;
If[Not[Val],
Val=True; 
While[t≤Length[x],
Val=(Val&&(x[[t]][[s]]==0));
t=t+1]];
s=s+1];
Not[Val])];

While[k≤ Length[lff],
Print[];
Print["Multigraph #"<>ToString[k]];
Print[];
j=1;
    Parttoprk[[k]]={}; 
Partsmallrk[[k]]={};
Auxgoodpart=Import[FileNameJoin[{NotebookDirectory[],"OutputPart"<>ToString[k]<>".txt"}],"Table"];
Lpar=Length[Auxgoodpart];
NLpar=IntegerPart[Lpar/10];
While[j≤Lpar,
auxpart=Auxgoodpart[[j]];
       Mat=A[[k]]-DiagonalMatrix[auxpart];
  lns=NullSpace[Mat];
  If[MatrixRank[Mat]==cardI-1, 
        s=lns[[1]];
        If[And@@(#1>0&)/@s||And@@(#1<0&)/@s,Parttoprk[[k]]=Append[Parttoprk[[k]],auxpart]],
   If[test2[lns], Partsmallrk[[k]]=Append[Partsmallrk[[k]],auxpart]]];
  If[NLpar≠0,If[Divisible[j,NLpar],If[j/NLpar≤ 10,Print[j/NLpar*10 "%"]]]];
j=j+1];
Export[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3" ,"Part"<>ToString[k]<>"toprk.txt"}],Parttoprk[[k]]];
Export[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3" ,"Part"<>ToString[k]<>"smallrk.txt"}],Partsmallrk[[k]]];
k=k+1];

(*Part 4 - Maximum Rank (RANK = cardI-1) *)

Print[];
Print["**************************************************************************"];
Print["Using partitions that give matrices with  rank equal to cardI-1:"]

(* Isotropy Weights: Creates list of possible isotropy weights for NNMs and stores them in the array IW: for the p-th NNM, IW[[p]] stores its possible isotropy weights at the different fixed points *)

Print[];
Print["Determining the possible isotropy weights..."]
j=1;
IW=Table[0,{i,1,Length[lff]}];
While[j≤Length[lff],
AuxIW={};
AuxPart=Flatten[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3",ToString["Part"<>ToString[j]<>"toprk.txt"]}],"List"]];
LAP=Length[AuxPart];
If[LAP≠0,
p=1;
Weight={};
While[p≤LAP,Mat=A[[j]]-DiagonalMatrix[ToExpression[AuxPart[[p]]]];
lns=Flatten[NullSpace[Mat]]; 
i=1;
AuxWeight={};
While[i≤ NFP, 
W={};
l=1;
While[l≤ cardI, 
If[ e[[j]][[l]][[1]]==i,W=Append[W,lns[[l]]]];
If[e[[j]][[l]][[2]]==i,W=Append[W,-lns[[l]]]];
l=l+1];
AuxWeight=Append[AuxWeight,W];
i=i+1];
Weight=Append[Weight,AuxWeight];
p=p+1];
,Weight={}];
AuxIW=Append[AuxIW,Weight];
IW[[j]]=Flatten[AuxIW,1];
j=j+1]

(* Using the ABBV localization formula we select those which satisfy ∫c_l = 0 for l=0,...,dim/2-1 and store them in the array "FIW" *)

Print[];
Print["Selecting those for which ∫c_l = 0 for l=0,1,2,3"];
j=1;
FIW=Table[0,{i,1,Length[lff]}];
While[j≤Length[lff],
AuxList={};
Print[];
Print["Multigraph #"<>ToString[j]<>":"];
k=1;
selectlist={};
While[k≤Length[IW[[j]]],
l=0;
Flag=True;
While[l≤dim/2-1,
Loc=0;
i=1;
While[i≤NFP,Loc=Loc+SymmetricPolynomial[l,IW[[j]][[k]][[i]]]/SymmetricPolynomial[dim/2,IW[[j]][[k]][[i]]];
i=i+1];
If[Loc≠ 0,l=dim/2;Flag=False,l=l+1]];
If[Flag,selectlist=Append[selectlist,IW[[j]][[k]]]];
k=k+1];
If[Length[selectlist]≠0,
Fselectlist=DeleteDuplicates[Table[Sort[selectlist[[i,j]]],{i,Length[selectlist]},{j,NFP}]];
FIW[[j]]=Fselectlist; 
Print[];
Print["The possible isotropy weights are:"];
Print[FIW[[j]]] ,
FIW[[j]]={};Print["There are no isotropy weights"]];
j=j+1];

(* PART 5 - SMALLER RANK *)

(* PART 5 a) - Selection of Possible Null Spaces *)

Print[];
Print["**************************************************************************"];
Print["Using partitions that give matrices with rank smaller than cardI-1:"]

(* We build the list "PossisbleNullSpaces" that stores all null spaces in RowReduced form, discarding those which have a basis vector with a negative entry while all the other basis vectors have the same entry equal to zero, since the corresponding matrices cannot have a positive vector in their kernels *)

Print[];
Print["Determining the null spaces of the matrices in Row Reduced form when the rank is smaller than cardI-1..."];
j=1;
PossibleNullSpaces={};
While[j≤Length[lff],
AuxPart=Flatten[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3",ToString["Part"<>ToString[j]<>"smallrk.txt"]}],"List"]];
LAP=Length[AuxPart];
AuxPossibleNullSpaces={};
If[LAP≠0,p=1;
While[p≤LAP,
flag=True;
AuxPartition=ToExpression[AuxPart[[p]]];
Mat=A[[j]]-DiagonalMatrix[AuxPartition];
lns=RowReduce[NullSpace[Mat]];
l=1;
While[l≤Length[lns],
t=1;
While[t≤cardI,If[lns[[l]][[t]]<0&&Select[Drop[lns[[All,t]],{l}],#≠0&]=={},flag=False];
If[flag,t=t+1,t=cardI+1]];
If[flag,l=l+1,l=Length[lns]+1]];
If[flag,AuxPossibleNullSpaces=Append[AuxPossibleNullSpaces,lns]];
p=p+1];
If[Length[AuxPossibleNullSpaces]≠0,PossibleNullSpaces=Append[PossibleNullSpaces,{j,AuxPossibleNullSpaces}]]];
Print["Multigraph #"<>ToString[j]];
j=j+1];


(* We remove the elements of "PossisbleNullSpaces" for which the span of the above bases has an entry that is always negative, creating a new list of possible null spaces: "PossibleNullSpaces2" *)

Print[];
Print["Removing some Null Spaces whose bases have a negative entry..."];
p=1;
PossibleNullSpaces2={};
While[p≤Length[PossibleNullSpaces],
k=1;
AuxPossibleNullspaces={};
While[k≤Length[PossibleNullSpaces[[p]][[2]]],
flag2=True;
i=1;
While[i≤cardI,If[Select[PossibleNullSpaces[[p]][[2]][[k]][[All,i]],#>0&]=={},flag2=False];
If[flag2,i=i+1,i=cardI+1]];
If[flag2,AuxPossibleNullspaces=Append[AuxPossibleNullspaces,PossibleNullSpaces[[p]][[2]][[k]]]];
k=k+1];
If[Length[AuxPossibleNullspaces]≠0,PossibleNullSpaces2=Append[PossibleNullSpaces2,{PossibleNullSpaces[[p]][[1]],AuxPossibleNullspaces}]];
p=p+1];

p=1;
PNull={};
While[p≤Length[PossibleNullSpaces2], 
PNull=Append[PNull,PossibleNullSpaces2[[p]][[1]]];
p=p+1];
Export[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3" ,"PNullSpaces.txt"}],PNull,"List"];

(* PART 5 b) ISOTROPY WEIGHTS *)

(* First we consider the span of the different null spaces for NNMs to get the general expressions of the isotropy weights and store these weights in the array "IW2"; the value IW2[[p]] stores the possible isotropy weights at the different fixed points for the p-th NNM of "lff" *)


Print[];
Print["Determining the possible isotropy weights..."];
p=1;
IW2=Table[0,{i,1,Length[lff]}];
While[p≤Length[PossibleNullSpaces2],
Print[];
Print["Multigraph #"<>ToString[PossibleNullSpaces[[p]][[1]]]];
LLength=Length[PossibleNullSpaces2[[p]][[2]]];
NLLength=IntegerPart[LLength/10];
k=1;
WeightList={};
While[k≤LLength,
Array[b,Length[PossibleNullSpaces2[[p]][[2]][[k]]]];
i=1;
AuxWeight={};
While[i≤NFP,
l=1;
Weight={};
While[l≤cardI,
 If[ e[[PossibleNullSpaces2[[p]][[1]]]][[l]][[2]]==i,
W=0;
j=1;
While[j≤Length[PossibleNullSpaces2[[p]][[2]][[k]]],W=W-b[j]*PossibleNullSpaces2[[p]][[2]][[k]][[j]][[l]];
j=j+1];
Weight=Append[Weight,W]];
If[ e[[PossibleNullSpaces2[[p]][[1]]]][[l]][[1]]==i,
W=0;
j=1;
While[j≤Length[PossibleNullSpaces2[[p]][[2]][[k]]],W=W+b[j]*PossibleNullSpaces2[[p]][[2]][[k]][[j]][[l]];
j=j+1];
Weight=Append[Weight,W]];
l=l+1];
  AuxWeight=Append[AuxWeight,Weight];
i=i+1];
WeightList=Append[WeightList,AuxWeight];
If[NLLength≠0,If[Divisible[k,NLLength],If[k/NLLength ≤10,Print[k/NLLength*10 "%"]]]];
k=k+1]; 
IW2[[PossibleNullSpaces2[[p]][[1]]]]=WeightList;
p=p+1];

(* We then use the fact that the action is effective to elliminate common divisors at each fixed point *)

(* Attention: We Store the Isotropy weights obtained in the files "FIWaux#.txt", where "#" is the number of the graph *)

FIWaux=IW2;
p=1;
Print[];
While[p≤Length[PossibleNullSpaces2],
LLength=Length[PossibleNullSpaces2[[p]][[2]]];
NLLength=IntegerPart[LLength/10];
q=PossibleNullSpaces2[[p]][[1]];
Print["Multigraph #"<>ToString[q]];
k=1;
While[k≤LLength,
Array[b,Length[PossibleNullSpaces2[[p]][[2]][[k]]]];
i=1;
While[i≤NFP,G=PolynomialGCD@@FIWaux[[q]][[k]][[i]];
If[ToString[G]≠ToString[1]&&Not[NumberQ[G]],
Laux=Solve[G==1,Variables[G][[1]]];
l=1;
aux2=FIWaux[[q]][[k]];
While[l≤NFP,
j=1;
aux={};
While[j≤dim/2,
aux=Append[aux,Simplify[FIWaux[[q]][[k]][[l]][[j]]/.Flatten[Laux]]];
j=j+1];
aux2=ReplacePart[aux2,l->aux];
l=l+1];
FIWaux[[q]]=ReplacePart[FIWaux[[q]],k->aux2]];
i=i+1];
If[NLLength≠0,If[Divisible[k,NLLength],If[k/NLLength ≤10,Print[k/NLLength*10 "%"]]]];k=k+1];
Export[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","FIWaux"<>ToString[q]<>".txt"}],FIWaux[[q]],"List"];
p=p+1];

(* Part 5 c) Performing several tets on the isotropy weights to reduce the number of possible cases *)

(* Attention: this part contains several functions that are going to be used in other parts below *)

TestRational=Function[{x,ned},
(Length2=Length[x];
k=1;droplist4={};
While[k≤Length2,
Flag=True;
Array[b,ned];
i=1;
NFPaux=Length[x[[k]]];
While[i≤NFPaux,
j=1;
dimaux=Length[x[[k]][[i]]];
While[j≤dimaux,
v=x[[k]][[i]][[j]];
If[NumberQ[v]&&Element[v,Rationals]&&Not[IntegerQ[v]],Flag=False];
If[Flag,j=j+1,j=dimaux+1]];
If[Flag,i=i+1,i=NFPaux+1]];
If[Not[Flag],droplist4=Append[droplist4,k]];
k=k+1])];

TestPositive=Function[{x,ned},
(k=1;
droplistq={};
While[k≤Length[x],
Array[b,ned];
NFPaux=Length[x[[k]]];
dimaux=Length[x[[k]][[1]]];
Laux=Flatten[Table [x[[k]][[j]][[i]]>0 ,{j,1,NFPaux-1},{i,If[j≤3,j,j-1],dimaux}]];
If[ToString[Reduce[Laux,DeleteDuplicates[Flatten[Table[Variables[x[[k]][[j]][[i]]],{j,1,NFPaux-1},{i,j,d}]]],Integers]]==ToString[False],droplistq=Append[droplistq,k]];
k=k+1])];

DropFunction=Function[{x,y},
(NewList={};
k=1;
While[k≤Length[x],
If[Not[MemberQ[y,k]],NewList=Append[NewList,x[[k]]]];
k=k+1])];

DropFunction2=Function[{x,y,q},
(NewList={};
k=1;
While[k≤Length[x],
If[Not[MemberQ[y,{q,k}]],NewList=Append[NewList,x[[k]]]];
k=k+1])];

(* 1. First we eliminate cases where we obtain rational weights after ellimination of common divisors. 
We store the possible weights in the files "NewFIWaux#.txt", where "#" is the number of the multigraph *)

PNull=ToExpression[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","PNullSpaces.txt"}],"List"]];
p=1;
While[p≤Length[PNull],
k=1;
droplist4={};
q=PNull[[p]];
Print["Multigraph #"<>ToString[q]]; 
FIWauxq=ToExpression[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3" ,"FIWaux"<>ToString[q]<>".txt"}],"List"]];
TestRational[FIWauxq,cardI];
DropFunction[FIWauxq,droplist4];
aux3=NewList;
aux4=Simplify[aux3];
Export[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","NewFIWaux"<>ToString[q]<>".txt"}],aux4,"List"];
p=p+1];

(* 2. In the cases where we have multiple edges at the minimum we select possible cases according to Lemma 8.2 (1).
We save the resulting weights in the files "NNewFIWaux#.txt", where "#" is the number of the graph *)


PNull=ToExpression[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","PNullSpaces.txt"}],"List"]];
p=1;
While[p≤Length[PNull],
q=PNull[[p]];
Print["Multigraph #"<>ToString[q]];
FIWauxq=ToExpression[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","NewFIWaux"<>ToString[q]<>".txt"}],"List"]];
LLength=Length[FIWauxq];
droplist={};
LLL=Tally[Table[e[[q]][[i]][[2]],{i,1,d}]]; 
l=1;
While[l≤Length[LLL],
If[LLL[[l,2]]==d&& d≠ 1,
LLL2=Flatten[Position[Table[e[[q]][[i]][[2]],{i,1,d}],LLL[[l,1]]]];
k=1;
While[k≤LLength,
LLL3=Select[Tuples[LLL2,2],#[[1]]<#[[2]]&];
LLL4=Table[PolynomialGCD@@Table[{FIWauxq[[k]][[1]][[LLL3[[i]][[1]]]],FIWauxq[[k]][[1]][[LLL3[[i]][[2]]]]},{i,1,Length[LLL3]}][[i]],{i,1,Length[LLL3]}];
LLL5=DeleteCases[Cases[LLL4,_Integer],1];
If[Length[LLL5]>0,
droplist=Append[droplist,k],
cc=1;
While[cc≤Length[LLL4],
If[ToString[LLL4[[cc]]]≠ToString[1]&&Not[NumberQ[LLL4[[cc]]]],Laux=Solve[LLL4[[cc]]==1,Variables[LLL4[[cc]]][[1]]];
r=1;
aux2=FIWauxq[[k]];
While[r≤NFP,
j=1;
aux={};
While[j≤dim/2,
aux=Append[aux,Simplify[FIWauxq[[k]][[r]][[j]]/.Flatten[Laux]]];
j=j+1];
aux2=ReplacePart[aux2,r->aux];
r=r+1];
FIWauxq=Part[FIWauxq,k->aux2]];
cc=cc+1]];
k=k+1],
If[LLL[[l,2]]==d-1&& d-1≠ 1,
LLL2=Flatten[Position[Table[e[[q]][[i]][[2]],{i,1,d}],LLL[[l,1]]]];
k=1;
While[k≤Length[FIWauxq],
G=PolynomialGCD@@Table[FIWauxq[[k]][[1]][[LLL2[[i]]]],{i,1,Length[LLL2]}];
If[NumberQ[G]&&G>1,
droplist=Append[droplist,k],
If[ToString[G]≠ToString[1]&&Not[NumberQ[G]],
Laux=Solve[G==1,Variables[G][[1]]];
r=1;
aux2=FIWauxq[[k]];
While[r≤NFP,
j=1;
aux={};
While[j≤dim/2,
aux=Append[aux,Simplify[FIWauxq[[k]][[r]][[j]]/.Flatten[Laux]]];
j=j+1];
aux2=ReplacePart[aux2,r->aux];
r=r+1];
FIWauxq=ReplacePart[FIWauxq,k->aux2]]];
k=k+1]]];
l=l+1];

DropFunction[FIWauxq,droplist];
FIWauxIII=NewList;
Export[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","NNewFIWaux"<>ToString[q]<>".txt"}],FIWauxIII,"List"];
p=p+1];

(* 3. We eliminate again possible  cases where we obtain rational weights after ellimination of common divisors. 
We store the possible weights in the files "ShortFIWauxc#.txt", where "#" is the number of the multigraph *)


PNull=ToExpression[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","PNullSpaces.txt"}],"List"]];
p=1;
While[p≤Length[PNull],
q=PNull[[p]];
Print["Multigraph #"<>ToString[q]];
FIWauxq=ToExpression[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","NNewFIWaux"<>ToString[q]<>".txt"}],"List"]];

TestRational[FIWauxq,cardI];
DropFunction[FIWauxq,droplist4];
aux3=NewList;
aux4=Simplify[aux3];
Export[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","ShortFIWauxc"<>ToString[q]<>".txt"}],aux4,"List"];
p=p+1];

(* 4. Now we select the cases with the right number and position of positive weights. The possible cases are stored in the files  "NewShortFIWaux#.txt", where # is the number of the multigraph *)

PNull=ToExpression[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","PNullSpaces.txt"}],"List"]];

p=1;
While[p≤Length[PNull],
q=PNull[[p]]; 

IWauxq=ToExpression[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","ShortFIWauxc"<>ToString[q]<>".txt"}],"List"]];

Print["Multigraph #"<>ToString[q]<>":"];
TestPositive[IWauxq,cardI];
DropFunction[IWauxq,droplistq];
IWListq=NewList;

Export[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3" ,"NewShortFIWaux"<>ToString[q]<>".txt"}],IWListq,"List"];

p=p+1];

(* 5. Now we select the cases for which ∫c_j = 0 for j=0,...,dim/2-1 and store them in the files "FinalIWaux#.txt" *)

PNull=ToExpression[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","PNullSpaces.txt"}],"List"]];


droplistsmall={};
Bignumlist={};
Print[];
Print["Selecting the isotropy weights that give ∫c_j = 0 for j=0,1,2,3"];
p=1;
While[ p≤ Length[PNull], 
q=PNull[[p]]; 

IWauxq=ToExpression[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","NewShortFIWaux"<>ToString[q]<>".txt"}],"List"]];

k=1;
Print[];
Length2=Length[IWauxq];
    NLength2=IntegerPart[Length2/10];
Print["Multigraph #"<>ToString[q]<>":"];
While[k≤ Length2,
Array[b,cardI];
loclistsmallaux={};
j=0;
While[j≤dim/2-1,
Locsmall=0;
i=1;
While[i≤NFP,Locsmall=Locsmall+SymmetricPolynomial[j,IWauxq[[k]][[i]]]/SymmetricPolynomial[dim/2,IWauxq[[k]][[i]]];
i=i+1];
SLocsmall=Together[Locsmall];
loclistsmallaux=Append[loclistsmallaux,SLocsmall];
j=j+1];
NSLocsmall=Numerator/@loclistsmallaux;
If[Not[MemberQ[Bignumlist,NSLocsmall]],

VVsmall=DeleteDuplicates[Flatten[Variables/@NSLocsmall]];
solsmall=Solve[NSLocsmall==0];
If[Length[solsmall]==0,droplistsmall=Append[droplistsmall,{q,k}];Bignumlist=Append[Bignumlist,NSLocsmall],

If[MemberQ[Table[Select[(VVsmall/.solsmall)[[i]],#==0||(Variables[#]=={}&&Not[Block[{$MaxExtraPrecision=1000},IntegerQ[#]]])||(Variables[#]=={}&&Not[Block[{$MaxExtraPrecision=1000},Positive[#]]]) &],{i,1,Length[VVsmall/.solsmall]}],{}]==False,droplistsmall=Append[droplistsmall,{q,k}];Bignumlist=Append[Bignumlist,NSLocsmall],

Listaux=Position[Table[Select[(VVsmall/.solsmall)[[i]],#==0||(Variables[#]=={}&&Not[IntegerQ[#]])||(Variables[#]=={}&&Not[Positive[#]]) &],{i,1,Length[VVsmall/.solsmall]}],{}];

If[Length[Listaux]==1,

aux2=IWauxq[[k]];
l=1;
While[l≤NFP,
j=1;
aux={};
While[j≤dim/2,
aux=Append[aux,Simplify[IWauxq[[k]][[l]][[j]]/.Flatten[solsmall[[Listaux[[1]]]]]]];
j=j+1];
aux2=ReplacePart[aux2,l->aux];
l=l+1];
IWauxq=ReplacePart[IWauxq,k->aux2]]];
Clear[solsmall]],
droplistsmall=Append[droplistsmall,{q,k}]];

If[NLength2≠0,If[Divisible[k,NLength2],If[k/NLength2≤10,Print[k/NLength2*10 "%"]]]];
k=k+1];
p=p+1];


IWFinal=Table[{},{i,1,Length[lff]}];
p=1;
While[p≤Length[PNull],
q=PNull[[p]];

IWauxq=ToExpression[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","NewShortFIWaux"<>ToString[q]<>".txt"}],"List"]];

DropFunction2[IWauxq,droplistsmall,q];
IWaux=NewList;

Export[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","FinalIWaux"<>ToString[q]<>".txt"}],IWaux,"List"];
p=p+1];

(* 6. Delete duplicates: *)

PNull=ToExpression[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","PNullSpaces.txt"}],"List"]];

IWFinal=Table[{},{i,1,Length[lff]}];
p=1;
While[p≤Length[PNull],
q=PNull[[p]];

IWauxq=ToExpression[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","FinalIWaux"<>ToString[q]<>".txt"}],"List"]];

FIWaux3=DeleteDuplicates[Table[Sort[Expand[IWauxq[[i,j]]]],{i,1,Length[IWauxq]},{j,1,NFP}]];
IWFinal[[q]]=FIWaux3;

Export[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","LastIWaux"<>ToString[q]<>".txt"}],FIWaux3,"List"]; 
p=p+1];

(* 7. Now we compute ∫c_1^4  and ∫c_1^2c_2 and ∫c_2^2 and see if they have one of the valus in Table... of [GLS] *)

PNull=ToExpression[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","PNullSpaces.txt"}],"List"]];

droplistsmall={};
Bignumlist={};
Print[];
Print["Computing the Chern Numbers"];
p=1;
Keeper={};
Keeper2={};
While[ p≤ Length[PNull], 
q=PNull[[p]]; 
IWauxq=ToExpression[Import[FileNameJoin[{NotebookDirectory[],"dim"<>ToString[dim]<>"nfp"<>ToString[NFP]<>"index3","LastIWaux"<>ToString[q]<>".txt"}],"List"]];
k=1;
Print[];
Length2=Length[IWauxq];
    NLength2=IntegerPart[Length2/10];
Print["Multigraph #"<>ToString[q]<>":"];
While[k≤ Length2,
Array[b,cardI];
Locsmall=0;
Locsmall2c12c2=0;
Locsmallc22=0;
i=1;
While[i≤NFP,Locsmall=Locsmall+(SymmetricPolynomial[1,IWauxq[[k]][[i]]])^4/SymmetricPolynomial[dim/2,IWauxq[[k]][[i]]];
Locsmall2c12c2=Locsmall2c12c2+(SymmetricPolynomial[1,IWauxq[[k]][[i]]])^2*SymmetricPolynomial[2,IWauxq[[k]][[i]]]/SymmetricPolynomial[dim/2,IWauxq[[k]][[i]]];Locsmallc22=Locsmallc22+(SymmetricPolynomial[2,IWauxq[[k]][[i]]])^2/SymmetricPolynomial[dim/2,IWauxq[[k]][[i]]];
i=i+1];
loclistsmallaux=Together[Locsmall];
loclistsmallaux2=Together[Locsmall2c12c2];
loclistsmallaux3=Together[Locsmallc22];
loclistsmallaux4=Together[loclistsmallaux2 -2*loclistsmallaux/9];

ListForC14=81*{5,8,9,16,18,25,26,29};
ListForC12c2=9*{22,28,30,44,48,62,64,70};
ListForC22={97,106,109,130,136,157,160,169};

NSLocsmall=Numerator[loclistsmallaux4] ; 

VVsmall=Variables[NSLocsmall];
If[VVsmall=={},AppendTo[Keeper,{q,k,loclistsmallaux,loclistsmallaux2,loclistsmallaux3,loclistsmallaux4}];
Cont=1;
While[Cont<9,
solsmall=Solve[loclistsmallaux3==ListForC22[[Cont]] && loclistsmallaux==ListForC14[[Cont]] && loclistsmallaux2==ListForC12c2[[Cont]] ]; 

If[solsmall !={},AppendTo[Keeper2,{q,k,loclistsmallaux,loclistsmallaux2,loclistsmallaux3,loclistsmallaux4}]];
Cont=Cont+1]];
k=k+1]; 
p=p+1];

(* Part 6 - Conclusion - Finally we print all possible isotropy weights for each multigraph*)

KeeperNumber1={};
KeeperNumber2={};
KeeperNumber1=If[Length[Keeper]≠0,DeleteDuplicates[Table[Keeper[[i]][[1]],{i,1,Length[Keeper]}]]];
If[Length[Keeper2]≠0,KeeperNumber2=DeleteDuplicates[Table[Keeper2[[i]][[1]],{i,1,Length[Keeper]}]]];

Print["**************************************************************************"];
Print["Conclusion:"];
Print["**************************************************************************"];
p=1;
While[p≤Length[lff],

auxList={};
If[FIW[[p]]≠{}|| MemberQ[KeeperNumber1,p]||MemberQ[KeeperNumber2,p], 
cont=1;

While[cont≤Length[Keeper],
If[Keeper[[cont]][[1]]==p , AppendTo[auxList,{IWFinal[[p]][[Keeper[[cont]][[2]]]],Keeper[[cont]][[3]],Keeper[[cont]][[4]],Keeper[[cont]][[5]]}]];cont=cont+1];
cont=1;
While[cont≤Length[Keeper2],
If[Keeper2[[cont]][[1]]==p ,AppendTo[auxList,{IWFinal[[p]][[Keeper2[[cont]][[2]]]],Keeper[[cont]][[3]],Keeper[[cont]][[4]],Keeper[[cont]][[5]]}]];cont=cont+1];
NS=Length[auxList]+Length[FIW[[p]]];
Print[];
Print["**************************************************************************"];
Print["All Possible Isotropy Weights for Multigraph #"<>ToString[p]<>":"];

Print["There are at most "<>ToString[NS]<>" solutions:"];
If[FIW[[p]]≠{},
Print[FIW[[p]]];
Print[]]];
If[auxList=={}&& FIW[[p]]=={},Print["There are no possible isotropy weights for multigraph # "<> ToString[p]]];
If[auxList≠ {},k=1;While[k≤ Length[auxList], Print[auxList[[k]][[1]]];Print["Chern numbers:"];Print["c_1^4= ",auxList[[k]][[2]]];
Print["c_1^2c_2= ",auxList[[k]][[3]]];
Print["c_2^2= ",auxList[[k]][[4]]];
Print[]; k=k+1]];
If[FIW[[p]]≠{}|| auxList≠ {}, Print[lgg[[p]]];Print["**************************************************************************"];Print[]];
p=p+1];