Print["by K.Kajda, ver: 1.0\nlast modified 19 sep 2008"]


BeginPackage["Reducer5pt`"]


p1::usage = "External momentum p1."
p2::usage = "External momentum p2."
p3::usage = "External momentum p3."
p4::usage = "External momentum p4."
p5::usage = "External momentum p5."
p6::usage = "External momentum p6."
q::usage = "Chord"
g::usage = "Metric tensor"
mu1::usage = "Index"
mu2::usage = "Index"
mu3::usage = "Index"
mu3::usage = "Index"
mu4::usage = "Index"

RedF0::usage = "Reduces scalar six point function.\nUsage: RedF0[p1s,p2s,p3s,p4s,p5s,p6s,s12,s23,s34,s45,s56,s16,s123,s234,s345,m1s,m2s,m3s,m4s,m5s,m6s]\nwhere p1s=p1^2,...  m1s=m1^2,... and s12=(p1+p2)^2,..."
RedF1::usage = "Reduces vector six point function and returns result as a sum over chords with coefficients.\nUsage: RedF1[p1s,p2s,p3s,p4s,p5s,p6s,s12,s23,s34,s45,s56,s16,s123,s234,s345,m1s,m2s,m3s,m4s,m5s,m6s]\nwhere p1s=p1^2,...  m1s=m1^2,... and s12=(p1+p2)^2,..."
RedF2::usage = "Reduces tensor (rank 2) six point function and returns result as a basis formed from metric tensor g[mu,nu] and chords q[mu,i].\nUsage: RedF2[p1s,p2s,p3s,p4s,p5s,p6s,s12,s23,s34,s45,s56,s16,s123,s234,s345,m1s,m2s,m3s,m4s,m5s,m6s]\nwhere p1s=p1^2,...  m1s=m1^2,... and s12=(p1+p2)^2,..."
RedF3::usage = "Reduces tensor (rank 3) six point function and returns result as a basis formed from metric tensor g[mu,nu] and chords q[mu,i].\nUsage: RedF3[p1s,p2s,p3s,p4s,p5s,p6s,s12,s23,s34,s45,s56,s16,s123,s234,s345,m1s,m2s,m3s,m4s,m5s,m6s]\nwhere p1s=p1^2,...  m1s=m1^2,... and s12=(p1+p2)^2,..."
RedF4::usage = "Reduces tensor (rank 4) six point function and returns result as a basis formed from metric tensor g[mu,nu] and chords q[mu,i].\nUsage: RedF4[p1s,p2s,p3s,p4s,p5s,p6s,s12,s23,s34,s45,s56,s16,s123,s234,s345,m1s,m2s,m3s,m4s,m5s,m6s]\nwhere p1s=p1^2,...  m1s=m1^2,... and s12=(p1+p2)^2,..."

RedE0::usage = "Reduces scalar five point function.\nUsage: RedE0[p1s,p2s,p3s,p4s,p5s,s12,s23,s34,s45,s15,m1s,m2s,m3s,m4s,m5s]\nwhere p1s=p1^2,...  m1s=m1^2,... and s12=(p1+p2)^2,..."
RedE1::usage = "Reduces vector five point function and returns result as a sum over chords with coefficients.\nUsage: RedE1[p1s,p2s,p3s,p4s,p5s,s12,s23,s34,s45,s15,m1s,m2s,m3s,m4s,m5s]\nwhere p1s=p1^2,...  m1s=m1^2,... and s12=(p1+p2)^2,..."
RedE2::usage = "Reduces tensor (rank 2) five point function and returns result as a basis formed from metric tensor g[mu,nu] and chords q[mu,i].\nUsage: RedE2[p1s,p2s,p3s,p4s,p5s,s12,s23,s34,s45,s15,m1s,m2s,m3s,m4s,m5s]\nwhere p1s=p1^2,...  m1s=m1^2,... and s12=(p1+p2)^2,..."
RedE3::usage = "Reduces tensor (rank 3) five point function and returns result as a basis formed from metric tensor g[mu,nu] and chords q[mu,i].\nUsage: RedE3[p1s,p2s,p3s,p4s,p5s,s12,s23,s34,s45,s15,m1s,m2s,m3s,m4s,m5s]\nwhere p1s=p1^2,...  m1s=m1^2,... and s12=(p1+p2)^2,..."

RedFcoef::usage = "Returns specific tensor coefficient of six point function.\nUsage: RedFcoef[coef_,p1s,p2s,p3s,p4s,p5s,p6s,s12,s23,s34,s45,s56,s16,s123,s234,s345,m1s,m2s,m3s,m4s,m5s,m6s]\nwhere p1s=p1^2,...  m1s=m1^2,... and s12=(p1+p2)^2,..."
RedEcoef::usage = "Returns specific tensor coefficient of five point function.\nUsage: RedEcoef[coef_,p1s,p2s,p3s,p4s,p5s,s12,s23,s34,s45,s15,m1s,m2s,m3s,m4s,m5s]\nwhere p1s=p1^2,...  m1s=m1^2,... and s12=(p1+p2)^2,..."
RedFget::usage = "Returns rules of coefficients of six point function.\nUsage: RedFget[rank_,p1s,p2s,p3s,p4s,p5s,p6s,s12,s23,s34,s45,s56,s16,s123,s234,s345,m1s,m2s,m3s,m4s,m5s,m6s]\nwhere p1s=p1^2,...  m1s=m1^2,... and s12=(p1+p2)^2,...\nPossible options for rank_\nrank0 - scalar six point function\nrank1 - coefficient of vector six point function\nrank2 - coefficient of tensor (2nd order) six point function\nrank3 - coefficient of tensor (3rd order) six point function\nrank4 - coefficient of tensor (4th order) six point function\nrankALL - all coefficient of tensor six point function"
RedEget::usage = "Returns rules of coefficients of five point function.\nUsage: RedEget[rank_,p1s,p2s,p3s,p4s,p5s,s12,s23,s34,s45,s15,m1s,m2s,m3s,m4s,m5s]\nwhere p1s=p1^2,...  m1s=m1^2,... and s12=(p1+p2)^2,..."

D4::usage = "Four point scalar integral."
C3::usage = "Three point scalar integral."
B2::usage = "Two point scalar integral."



Begin["`Private`"]


(******************************************)
(*       Modified Cayley determinant      *)
(******************************************)
MCM[size_] := Module[{matrix,i,j,Y},

	Y[a_,b_]:=-(qq[a]-qq[b])^2+m[a]^2+m[b]^2;

	Switch[size,
		5,
	matrix=
	{{0, 1, 1, 1, 1, 1}, 
         {1, Y[1,1], Y[1,2], Y[1,3], Y[1,4], Y[1,5]}, 
	 {1, Y[1,2], Y[2,2], Y[2,3], Y[2,4], Y[2,5]}, 
         {1, Y[1,3], Y[2,3], Y[3,3], Y[3,4], Y[3,5]}, 
         {1, Y[1,4], Y[2,4], Y[3,4], Y[4,4], Y[4,5]}, 
         {1, Y[1,5], Y[2,5], Y[3,5], Y[4,5], Y[5,5]}},
		6,
	matrix=
	{{0, 1, 1, 1, 1, 1, 1}, 
	 {1, Y[1,1], Y[1,2], Y[1,3], Y[1,4], Y[1,5], Y[1,6]}, 
         {1, Y[1,2], Y[2,2], Y[2,3], Y[2,4], Y[2,5], Y[2,6]}, 
         {1, Y[1,3], Y[2,3], Y[3,3], Y[3,4], Y[3,5], Y[3,6]}, 
         {1, Y[1,4], Y[2,4], Y[3,4], Y[4,4], Y[4,5], Y[4,6]}, 
         {1, Y[1,5], Y[2,5], Y[3,5], Y[4,5], Y[5,5], Y[5,6]}, 
         {1, Y[1,6], Y[2,6], Y[3,6], Y[4,6], Y[5,6], Y[6,6]}}
	];
		   

  Return[matrix]]


(******************************************)
(*              Determinants              *)
(******************************************)
SM[matrix_][Sequence[x__]][Sequence[y__]] := 
  Module[{sigx,sigy,rowSEQ,colSEQ,
	  norows,nocolumns,determinant},

	sigx=Signature[List[x]];
        sigy=Signature[List[y]];

        If[sigx==0 || sigy==0,
        {   
           determinant=0
        },
        {
        rowSEQ={#+1}& /@ List[Sequence[x]];
        colSEQ={#+1}& /@ List[Sequence[y]];

        norows=Delete[matrix,rowSEQ];
        nocolumns=Delete[#,colSEQ]& /@ norows;
        
        determinant=
          (-1)^(Plus[x,y])*
          sigx*sigy*Det[nocolumns]
        }];

  Return[determinant]]



(******************************************)
(*        definitions, rules, etc.        *)
(******************************************)
chords={
  qq[1]->0,
  qq[2]->p1,
  qq[3]->p1+p2,
  qq[4]->p1+p2+p3,
  qq[5]->p1+p2+p3+p4,
  qq[6]->p1+p2+p3+p4+p5
};

kinematics={
	  p1^2->ps1,
	  p2^2->ps2,
	  p3^2->ps3,
	  p4^2->ps4,
          p5^2->ps5,
	  m[1]^2->ms1, 
	  m[2]^2->ms2, 
	  m[3]^2->ms3, 
	  m[4]^2->ms4, 
	  m[5]^2->ms5};

scalars5pt={
          p1*p2->(s12-ps1-ps2)/2,
	  p2*p3->(s23-ps2-ps3)/2,
	  p3*p4->(s34-ps3-ps4)/2,
	  p4*p5->(s45-ps4-ps5)/2,
	  p1*p5->(s15-ps1-ps5)/2,
	  p3*p5->(s12-s34-s45+ps4)/2,
	  p1*p4->(s23-s15-s45+ps5)/2,
          p2*p5->(s34-s12-s15+ps1)/2,
          p1*p3->(s45-s12-s23+ps2)/2,
          p2*p4->(s15-s23-s34+ps3)/2};
 	  
scalars6pt={       
	  p6^2->ps6,
	  m[6]^2->ms6,   
          p1*p2->(-ps1-ps2+s12)/2, 
	  p2*p3->(-ps2-ps3+s23)/2, 
	  p3*p4->(-ps3-ps4+s34)/2, 
	  p4*p5->(-ps4-ps5+s45)/2, 
	  p5*p6->(-ps5-ps6+s56)/2, 
	  p1*p6->(-ps1-ps6+s16)/2, 
	  p1*p3->(ps2-s12+s123-s23)/2, 
	  p2*p4->(ps3-s23+s234-s34)/2, 
	  p3*p5->(ps4-s34+s345-s45)/2, 
	  p1*p4->(-s123+s23-s234+s56)/2, 
	  p1*p5->(ps6-s16+s234-s56)/2, 
	  p2*p5->(s16-s234+s34-s345)/2, 
	  p2*p6->(ps1-s12-s16+s345)/2, 
	  p3*p6->(s12-s123-s345+s45)/2, 
	  p4*p6->(ps5+s123-s45-s56)/2};

(*********************************************)
(* Drops ee & ff for tensor coefficients of  *)
(* 6pt & 5pt function                        *)
(*********************************************)
DROPstr[x_, dropn_] := ToExpression[#] & /@ Characters[StringDrop[ToString[x], dropn]];
JOINstr[Sequence[x__]] := StringJoin[Map[ToString[#] &, List[x] ]];
CreateRules[list1_,list2_]:=Map[(Rule @@ #)&, Transpose[{list1,list2}]];

Options[RedF1]={Listable->False};
Options[RedF2]={Listable->False};
Options[RedF3]={Listable->False};
Options[RedF4]={Listable->False};

Options[RedE1]={Listable->False};
Options[RedE2]={Listable->False};
Options[RedE3]={Listable->False};

OptChange[fun_,new___Rule]:=
  Module[{i},
     Map[If[Length[i=Position[{new},First[#]->_,1,1]]===0, 
            #,{new}[[Sequence @@ First[i]]]]&, Options[fun]] ]


(*******************************************)
(*               6pt scalar                *)
(*******************************************)
RedF0[pq1_,pq2_,pq3_,pq4_,pq5_,pq6_,
      pq1pq2_,pq2pq3_,pq3pq4_,pq4pq5_,pq5pq6_,pq1pq6_,
      pq1pq2pq3_,pq2pq3pq4_,pq3pq4pq5_,
      mq1_,mq2_,mq3_,mq4_,mq5_,mq6_]:=

 Module[{kinrules,kinematics6pt,cayley,result},

	kinrules={ps1->pq1,ps2->pq2,ps3->pq3,ps4->pq4,ps5->pq5,ps6->pq6,
		  ms1->mq1,ms2->mq2,ms3->mq3,ms4->mq4,ms5->mq5,ms6->mq6,
		  s12->pq1pq2,s23->pq2pq3,s34->pq3pq4,
		  s45->pq4pq5,s56->pq5pq6,s16->pq1pq6,
                  s123->pq1pq2pq3,s234->pq2pq3pq4,s345->pq3pq4pq5};
	kinematics6pt=Join[kinematics,scalars6pt]/.kinrules;
	cayley=Expand[(MCM[6] /.chords)]/.kinematics6pt;

	result=Sum[SM[cayley][0][r]*I5[r][kinematics6pt],{r,1,6}];
  

  Return[result/SM[cayley][0][0] /.kinematics6pt]]


(*******************************************)
(*               6pt vector                *)
(*******************************************)
RedF1[pq1_,pq2_,pq3_,pq4_,pq5_,pq6_,
      pq1pq2_,pq2pq3_,pq3pq4_,pq4pq5_,pq5pq6_,pq1pq6_,
      pq1pq2pq3_,pq2pq3pq4_,pq3pq4pq5_,
      mq1_,mq2_,mq3_,mq4_,mq5_,mq6_,options___Rule]:=

 Module[{option,kinrules,kinematics6pt,cayley,result},

	option=OptChange[RedE1,options];
	kinrules={ps1->pq1,ps2->pq2,ps3->pq3,ps4->pq4,ps5->pq5,ps6->pq6,
		  ms1->mq1,ms2->mq2,ms3->mq3,ms4->mq4,ms5->mq5,ms6->mq6,
		  s12->pq1pq2,s23->pq2pq3,s34->pq3pq4,
		  s45->pq4pq5,s56->pq5pq6,s16->pq1pq6,
                  s123->pq1pq2pq3,s234->pq2pq3pq4,s345->pq3pq4pq5};
	kinematics6pt=Join[kinematics,scalars6pt]/.kinrules;
	cayley=Expand[(MCM[6] /.chords)]/.kinematics6pt;

	result=
	   Table[q[mu1,i-1]*
	   	Sum[SM[cayley][0,i][0,r]*I5[r][kinematics6pt],{r,1,6}],
	   {i,2,6}]/SM[cayley][0][0];

	If[Not[Listable/.option],result=Apply[Plus,result]];

  Return[result /.kinematics6pt]]


(*******************************************)
(*         6pt tensor 2-nd order TEST      *)
(*******************************************)
RedF2[pq1_,pq2_,pq3_,pq4_,pq5_,pq6_,
      pq1pq2_,pq2pq3_,pq3pq4_,pq4pq5_,pq5pq6_,pq1pq6_,
      pq1pq2pq3_,pq2pq3pq4_,pq3pq4pq5_,
      mq1_,mq2_,mq3_,mq4_,mq5_,mq6_,options___Rule]:=

 Module[{option,kinrules,kinematics6pt,cayley,
	 SM3D00Array,SM2D00Array,SM3D00,SM2D00,
         I6,I6Array,F6,result},

	option=OptChange[RedE1,options];
	kinrules={ps1->pq1,ps2->pq2,ps3->pq3,ps4->pq4,ps5->pq5,ps6->pq6,
		  ms1->mq1,ms2->mq2,ms3->mq3,ms4->mq4,ms5->mq5,ms6->mq6,
		  s12->pq1pq2,s23->pq2pq3,s34->pq3pq4,
		  s45->pq4pq5,s56->pq5pq6,s16->pq1pq6,
                  s123->pq1pq2pq3,s234->pq2pq3pq4,s345->pq3pq4pq5};
	kinematics6pt=Join[kinematics,scalars6pt] /.kinrules;
	cayley=Expand[(MCM[6] /.chords)] /.kinematics6pt;

	SM3D00Array=Table[SM[cayley][0,i,r][0,j,r],{i,1,6},{r,1,6},{j,1,6}];
	SM2D00Array=Table[SM[cayley][0,i][0,j],{i,1,6},{j,1,6}];
	SM3D00[i_,r_,j_]:=SM3D00Array[[i,r,j]];
	SM2D00[i_,j_]:=SM2D00Array[[i,j]];

	I6[i_,j_]:=
	 Sum[If[r!=i,SM2D00[j,r]/SM2D00[r,r]*
              SM3D00[i,r,s]*I45[r,s], 0],{r,1,6},{s,1,6}];	

	I6Array=Table[F6[{i,j}]->I6[i,j],{i,2,6},{j,i,6}]//Flatten;	

	If[Listable/.option,
	 result=I6Array/SM[cayley][0][0]/. (x_->y_)->y, 
	{result=(Table[q[mu1,i-1]*q[mu2,j-1]*F6[Sort[{i,j}]],
	         {i,2,6},{j,2,6}]/.I6Array)/SM[cayley][0][0];
	 result=Plus @@ Flatten[result]} ];


  Return[result /.kinematics6pt]]


(*******************************************)
(*         6pt tensor 3-rd order           *)
(*******************************************)
RedF3[pq1_,pq2_,pq3_,pq4_,pq5_,pq6_,
      pq1pq2_,pq2pq3_,pq3pq4_,pq4pq5_,pq5pq6_,pq1pq6_,
      pq1pq2pq3_,pq2pq3pq4_,pq3pq4pq5_,
      mq1_,mq2_,mq3_,mq4_,mq5_,mq6_,options___Rule]:=

 Module[{option,kinrules,kinematics6pt,cayley,
	 SM3DnoArray,SM3D00Array,SM3D0uArray,
	 SM2DnoArray,SM2D00Array,SM2D0uArray,SM1DnoArray,
	 SM3Dno,SM3D00,SM3D0u,SM3D0d,SM2Dno,SM2D00,SM2D0u,SM1Dno,
	 S4andS3,S4andS3Array,F6,E00,E00Array,result},

	option=OptChange[RedF3,options];
	kinrules={ps1->pq1,ps2->pq2,ps3->pq3,ps4->pq4,ps5->pq5,ps6->pq6,
		  ms1->mq1,ms2->mq2,ms3->mq3,ms4->mq4,ms5->mq5,ms6->mq6,
		  s12->pq1pq2,s23->pq2pq3,s34->pq3pq4,
		  s45->pq4pq5,s56->pq5pq6,s16->pq1pq6,
                  s123->pq1pq2pq3,s234->pq2pq3pq4,s345->pq3pq4pq5};
	kinematics6pt=Join[kinematics,scalars6pt] /.kinrules;
	cayley=Expand[(MCM[6] /.chords)] /.kinematics6pt;

	
	SM3DnoArray=Table[SM[cayley][i,j,r][k,l,r],{i,1,6},{j,1,6},{r,1,6},{k,1,6},{l,1,6}];
	SM3D00Array=Table[SM[cayley][0,i,r][0,j,r],{i,1,6},{r,1,6},{j,1,6}];
	SM3D0uArray=Table[SM[cayley][0,i,r][j,k,r],{i,1,6},{r,1,6},{j,1,6},{k,1,6}];
	SM2DnoArray=Table[SM[cayley][s,r][s,r],{s,1,6},{r,1,6}];
	SM2D00Array=Table[SM[cayley][0,i][0,j],{i,1,6},{j,1,6}];
	SM2D0uArray=Table[SM[cayley][0,r][i,r],{i,1,6},{r,1,6}];
	SM1DnoArray=Table[SM[cayley][i][j],{i,0,6},{j,0,6}];

	SM3Dno[i_,j_,r_,k_,l_]:=SM3DnoArray[[i,j,r,k,l]];
        SM3D00[i_,r_,j_]:=SM3D00Array[[i,r,j]];
	SM3D0u[i_,r_,j_,k_]:=SM3D0uArray[[i,r,j,k]];
	SM2Dno[s_,r_]:=SM2DnoArray[[s,r]];
	SM2D00[i_,j_]:=SM2D00Array[[i,j]];
	SM2D0u[i_,r_]:=SM2D0uArray[[i,r]];
        SM1Dno[i_,j_]:=SM1DnoArray[[i+1,j+1]];

	S4andS3[i_,j_,k_]:=
	Sum[If[r!=i && r!=j,
	 SM2D00[k,r]/SM2D00[r,r]*
	 Sum[If[s!=r,
	    ((-SM3D00[s,r,j]*SM3D0u[s,r,i,s] + SM3D0u[i,r,s,j]*SM3D00[s,r,s])*I45ch[r,s]- 
             Sum[
             (-SM3D00[s,r,j]*SM3Dno[t,s,r,i,s] + SM3D0u[i,r,s,j]*SM3D0u[s,r,t,s])*I35ch[r,s,t],
             {t,1,6}])/SM2Dno[s,r], 0],{s,1,6}], 0], {r,1,6}];		

	E00[r_]:=
	-1/2*
	Sum[If[s!=r, SM2D0u[s,r]/SM2Dno[s,r]*
	   (SM3D00[s,r,s]*I45ch[r,s] - Sum[SM3D0u[s,r,t,s]*I35ch[r,s,t],{t,1,6}]), 0],{s,1,6}];

	S4andS3Array=Flatten[Table[F6[{{i,j},k}]->S4andS3[i,j,k], {i,2,6},{j,i,6},{k,2,6}]]
			/.{I45ch->I45,I35ch->I35} /.kinematics6pt;
	E00Array=Table[E00[r],{r,1,6}]/.{I45ch->I45,I35ch->I35}/.kinematics6pt;	

	If[Listable/.option,
	result={Table[ Sum[SM2D00[k,r]/SM2D00[r,r]*E00Array[[r]],{r,1,6}], {k,2,6}],
		       S4andS3Array}/SM1Dno[0,0] /.(x_->y_)->y//Flatten,	 
       {result={Table[ Sum[g[mu1,mu2]*q[mu3,k-1]*SM2D00[k,r]/SM2D00[r,r]*E00Array[[r]],{r,1,6}], {k,2,6}],
		Table[ q[mu1,i-1]*q[mu2,j-1]*q[mu3,k-1]*F6[{Sort[{i,j}],k}], {i,2,6},{j,2,6},{k,2,6}] /.S4andS3Array };
	result=Plus @@ Flatten[result/SM1Dno[0,0]]} ];


  Return[result]]


(*******************************************)
(*         6pt tensor 4-th order           *)
(*******************************************)
RedF4[pq1_,pq2_,pq3_,pq4_,pq5_,pq6_,
      pq1pq2_,pq2pq3_,pq3pq4_,pq4pq5_,pq5pq6_,pq1pq6_,
      pq1pq2pq3_,pq2pq3pq4_,pq3pq4pq5_,
      mq1_,mq2_,mq3_,mq4_,mq5_,mq6_,options___Rule]:=

 Module[{option,kinrules,kinematics6pt,cayley,
	 SM4DnoArray,SM4D00Array,SM4D0uArray,SM3DnoArray,SM3D00Array,SM3D0uArray,
         SM2DnoArray,SM4Dno,SM4D00,SM4D0u,SM3Dno,SM3D00,SM3D0u,SM2Dno,
	 S4,S3,S2,E00j,S4Array,S3Array,S2Array,E00jArray,SMspecial,result},

	option=OptChange[RedF4,options];
	kinrules={ps1->pq1,ps2->pq2,ps3->pq3,ps4->pq4,ps5->pq5,ps6->pq6,
		  ms1->mq1,ms2->mq2,ms3->mq3,ms4->mq4,ms5->mq5,ms6->mq6,
		  s12->pq1pq2,s23->pq2pq3,s34->pq3pq4,
		  s45->pq4pq5,s56->pq5pq6,s16->pq1pq6,
                  s123->pq1pq2pq3,s234->pq2pq3pq4,s345->pq3pq4pq5};
	kinematics6pt=Join[kinematics,scalars6pt] /.kinrules;    
	cayley=Expand[(MCM[6] /.chords)] /.kinematics6pt;


	SM4DnoArray=Table[SM[cayley][i,s,t,r][j,s,t,r],{i,1,6},{s,1,6},{t,1,6},{r,1,6},{j,1,6}];
	SM4D00Array=Table[SM[cayley][0,s,t,r][0,s,t,r],{s,1,6},{t,1,6},{r,1,6}];
	SM4D0uArray=Table[SM[cayley][0,s,t,r][i,s,t,r],{s,1,6},{t,1,6},{r,1,6},{i,1,6}];
	SM3DnoArray=Table[SM[cayley][i,s,r][j,s,r],{i,1,6},{s,1,6},{r,1,6},{j,1,6}];
	SM3D00Array=Table[SM[cayley][0,i,r][0,j,r],{i,1,6},{r,1,6},{j,1,6}];
	SM3D0uArray=Table[SM[cayley][0,i,r][j,k,r],{i,1,6},{r,1,6},{j,1,6},{k,1,6}];
	SM2DnoArray=Table[SM[cayley][i,r][j,r],{i,0,6},{r,1,6},{j,0,6}];
     
	SM4Dno[i_,s_,t_,r_,j_]:=SM4DnoArray[[i,s,t,r,j]];
	SM4D00[s_,t_,r_]:=SM4D00Array[[s,t,r]];
	SM4D0u[s_,t_,r_,i_]:=SM4D0uArray[[s,t,r,i]];
	SM3Dno[i_,s_,r_,j_]:=SM3DnoArray[[i,s,r,j]];
        SM3D00[i_,r_,j_]:=SM3D00Array[[i,r,j]];
	SM3D0u[i_,r_,j_,k_]:=SM3D0uArray[[i,r,j,k]];
	SM2Dno[i_,r_,j_]:=SM2DnoArray[[i+1,r,j+1]];


	S4[i_,j_,k_,r_]:=
	Sum[If[s!=r,
	 (-SM3D00[s,r,k]*
	   (SM3D0u[s,r,i,s]*SM3D0u[s,r,j,s] + SM3Dno[i,s,r,j]*SM3D00[s,r,s])+
	   (SM3D0u[i,r,s,k]*SM3D0u[s,r,j,s] + SM3D0u[j,r,s,k]*SM3D0u[s,r,i,s])*
		SM3D00[s,r,s])/(SM2Dno[s,r,s])^2*I45ch[r,s], 0],{s,1,6}];	

	S3[i_,j_,k_,r_]:=
	Sum[If[s!=t && s!=r && t!=r,
	  (SM3D00[s,r,k]*
	  (SM3Dno[t,s,r,i]*SM3D0u[s,r,j,s] + SM3Dno[i,s,r,j]*SM3D0u[s,r,t,s]+
           	SM2Dno[s,r,s]*SM4D0u[s,t,r,i]*SM3Dno[t,s,r,j]/SM3Dno[s,t,r,s])-
	  (SM3D0u[i,r,s,k]*SM3D0u[s,r,j,s] + SM3D0u[j,r,s,k]*SM3D0u[s,r,i,s]) * 
		SM3D0u[s,r,t,s]-
	  (SM3D0u[i,r,s,k]*SM3Dno[t,s,r,j] + SM3D0u[j,r,s,k]*SM3Dno[t,s,r,i])*
		SM2Dno[s,r,s]*SM4D00[s,t,r]/(2*SM3Dno[s,t,r,s]))/
		(SM2Dno[s,r,s])^2*
	  I35ch[r,s,t], 0],{s,1,6},{t,1,6}];

	S2[i_,j_,k_,r_]:=
	-Sum[If[s!=t && s!=r && s!=u && t!=r && t!=u,
	  (SM3D00[s,r,k]*SM3Dno[t,s,r,j]*SM4Dno[u,s,t,r,i]-
	  (SM3D0u[j,r,s,k]*SM4Dno[u,s,t,r,i] + SM3D0u[i,r,s,k]*SM4Dno[u,s,t,r,j])/2*
		SM3D0u[s,r,t,s])/(SM2Dno[s,r,s]*SM3Dno[s,t,r,s])*
	  I25ch[r,s,t,u], 0],{s,1,6},{t,1,6},{u,1,6}];

	E00j[j_,r_]:=
      (-Sum[If[s!=r,
	 (3*SM2Dno[s,r,0]*SM3D0u[s,r,j,s] - SM2Dno[s,r,j]*SM3D00[s,r,s])*
	    SM3D00[s,r,s]/(SM2Dno[s,r,s])^2*I45ch[r,s], 0],{s,1,6}]+
	Sum[If[s!=r && s!=t && t!=r,
	 (3*SM2Dno[s,r,0]*SM3D0u[s,r,j,s] - SM2Dno[s,r,j]*
           (SM3D0u[s,r,t,s])^2/SM3Dno[s,t,r,s])*
	    SM3D0u[s,r,t,s]/(SM2Dno[s,r,s])^2*
	    I35ch[r,s,t], 0],{s,1,6},{t,1,6}]-
	Sum[If[s!=t && s!=r && s!=u && t!=r && t!=u,
	   SM2Dno[s,r,j]*SM4D0u[s,t,r,u]*SM3D0u[s,r,t,s]/
	  (SM2Dno[s,r,s]*SM3Dno[s,t,r,s])*
           I25ch[r,s,t,u] ,0],{s,1,6},{t,1,6},{u,1,6}])/2;

	
	S4Array=Table[If[i!=r && j!=r && k!=r,S4[i,j,k,r], 0],
		{i,2,6},{j,2,6},{k,2,6},{r,1,6}]/.{I45ch->I45,I35ch->I35,I25ch->I25} /.kinematics6pt;
	S3Array=Table[If[i!=r && j!=r && k!=r,S3[i,j,k,r], 0],
		{i,2,6},{j,2,6},{k,2,6},{r,1,6}]/.{I45ch->I45,I35ch->I35,I25ch->I25} /.kinematics6pt;
	S2Array=Table[If[i!=r && j!=r && k!=r,S2[i,j,k,r], 0],
		{i,2,6},{j,2,6},{k,2,6},{r,1,6}]/.{I45ch->I45,I35ch->I35,I25ch->I25} /.kinematics6pt;

	SArray=Table[II6[i,j,k,r]->
	(S4Array[[i-1,j-1,k-1,r]]+S4Array[[k-1,j-1,i-1,r]]+S4Array[[i-1,k-1,j-1,r]]+
	 S3Array[[i-1,j-1,k-1,r]]+S3Array[[k-1,j-1,i-1,r]]+S3Array[[i-1,k-1,j-1,r]]+
	 S2Array[[i-1,j-1,k-1,r]]+S2Array[[k-1,j-1,i-1,r]]+S2Array[[i-1,k-1,j-1,r]]),{i,2,6},{j,i,6},{k,j,6},{r,1,6}]//Flatten;

	E00jArray=Table[If[k!=r,E00j[k,r], 0],{k,2,6},{r,1,6}]/.{I45ch->I45,I35ch->I35,I25ch->I25} /.kinematics6pt;
	SMspecial=Table[SM[cayley][0,l][0,r]/(3*SM2Dno[0,r,0]),{l,2,6},{r,1,6}];

	If[Listable /.option,
	{result=-{Table[ Sum[If[k!=r,
		  SMspecial[[l-1,r]]*E00jArray[[k-1,r]], 0],{r,1,6}] ,{k,2,6},{l,2,6}],
	         Table[ Sum[If[i!=r && j!=r && k!=r,SMspecial[[l-1,r]]*
		  II6[Apply[Sequence, Sort[{i,j,k}]],r], 0],{r,1,6}] ,{i,2,6},{j,i,6},{k,j,6},{l,2,6}]}/SM[cayley][0][0]
			/.SArray/.(x_->y_)->y//Flatten},
	{result={Table[ Sum[If[k!=r,
		  q[mu4,l-1]*(g[mu1*mu2]*q[mu3,k-1]+g[mu3*mu1]*q[mu2,k-1]+g[mu2*mu3]*q[mu1,k-1])*
	          SMspecial[[l-1,r]]*E00jArray[[k-1,r]], 0],{r,1,6}] ,{k,2,6},{l,2,6}],
	         Table[ Sum[If[i!=r && j!=r && k!=r,
		  q[mu4,l-1]*q[mu1,i-1]*q[mu2,j-1]*q[mu3,k-1]*SMspecial[[l-1,r]]*
		  II6[Apply[Sequence, Sort[{i,j,k}]],r], 0],{r,1,6}] ,{i,2,6},{j,2,6},{k,2,6},{l,2,6}]/.SArray};
	 result=Plus @@ Flatten[-result/SM[cayley][0][0]]}];


  Return[result]]


(*******************************************)
(*           6pt coefficients              *)
(*******************************************)
RedFcoef[coef_,pq1_,pq2_,pq3_,pq4_,pq5_,pq6_,
         pq1pq2_,pq2pq3_,pq3pq4_,pq4pq5_,pq5pq6_,pq1pq6_,
         pq1pq2pq3_,pq2pq3pq4_,pq3pq4pq5_,
         mq1_,mq2_,mq3_,mq4_,mq5_,mq6_]:=

 Module[{kinrules,kinematics6pt,IndList,i1,i2,result},


	kinrules={ps1->pq1,ps2->pq2,ps3->pq3,ps4->pq4,ps5->pq5,ps6->pq6,
		  ms1->mq1,ms2->mq2,ms3->mq3,ms4->mq4,ms5->mq5,ms6->mq6,
		  s12->pq1pq2,s23->pq2pq3,s34->pq3pq4,
		  s45->pq4pq5,s56->pq5pq6,s16->pq1pq6,
                  s123->pq1pq2pq3,s234->pq2pq3pq4,s345->pq3pq4pq5};
	kinematics6pt=Join[kinematics,scalars6pt] /.kinrules;
	cayley=Expand[(MCM[6] /.chords)] /.kinematics6pt;

        IndList=DROPstr[coef, 2];

	Switch[Length[IndList],
        	1,
	i1=First[IndList];
	result=
	 If[i1!=0,
	  result = Sum[SM[cayley][0,i1+1][0,r]*I5[r][kinematics6pt],{r,1,6}],
	  result = Sum[SM[cayley][0][r]*I5[r][kinematics6pt],{r,1,6}] ],
		2,
	i1=IndList[[1]];
	i2=IndList[[2]];
	result=
	 Sum[If[r!=(i1+1),SM[cayley][0,i2+1][0,r]/SM[cayley][0,r][0,r]*
		          SM[cayley][0,i1+1,r][0,s,r]*I45[r,s], 0],
		{r,1,6},{s,1,6}];,
		3,
	i1=IndList[[1]];
	i2=IndList[[2]];
	i3=IndList[[3]];

	SM3DnoArray=Table[SM[cayley][i,j,r][k,l,r],{i,1,6},{j,1,6},{r,1,6},{k,1,6},{l,1,6}];
	SM3D00Array=Table[SM[cayley][0,i,r][0,j,r],{i,1,6},{r,1,6},{j,1,6}];
	SM3D0uArray=Table[SM[cayley][0,i,r][j,k,r],{i,1,6},{r,1,6},{j,1,6},{k,1,6}];
	SM2DnoArray=Table[SM[cayley][i,j][k,l],{i,0,6},{j,0,6},{k,0,6},{l,0,6}];
	SM1DnoArray=Table[SM[cayley][i][j],{i,0,6},{j,0,6}];

        
	SM3Dno[i_,j_,r_,k_,l_]:=SM3DnoArray[[i,j,r,k,l]];
        SM3D00[i_,r_,j_]:=SM3D00Array[[i,r,j]];
	SM3D0u[i_,r_,j_,k_]:=SM3D0uArray[[i,r,j,k]];
	SM2Dno[i_,j_,k_,l_]:=SM2DnoArray[[i+1,j+1,k+1,l+1]];
        SM1Dno[i_,j_]:=SM1DnoArray[[i+1,j+1]];

	
	S4andS3[i_,j_,r_]:=
	 Sum[If[s!=r,
	    ((-SM3D00[s,r,j]*SM3D0u[s,r,i,s] + SM3D0u[i,r,s,j]*SM3D00[s,r,s])*I45[r,s]- 
             Sum[
             (-SM3D00[s,r,j]*SM3Dno[t,s,r,i,s] + SM3D0u[i,r,s,j]*SM3D0u[s,r,t,s])*I35[r,s,t],
             {t,1,6}])/SM2Dno[s,r,s,r], 0],{s,1,6}];		


	E00[r_]:=
	-1/2*
	Sum[If[s!=r,	
	    SM2Dno[s,r,0,r]/SM2Dno[s,r,s,r]*
	   (SM3D00[s,r,s]*I45[r,s] - Sum[SM3D0u[s,r,t,s]*I35[r,s,t],{t,1,6}]), 0],{s,1,6}];

	
	i=i1+1;
	j=i2+1;
	k=i3+1;
	
	If[i1!=0 && i2!=0,
	 result=Sum[If[r!=i && r!=j,
               SM2Dno[0,k,0,r]/SM2Dno[0,r,0,r]*S4andS3[i,j,r], 0],{r,1,6}],
	 result=Sum[
	       SM2Dno[0,k,0,r]/SM2Dno[0,r,0,r]*E00[r],{r,1,6}] ],
		4,
	i1=IndList[[1]];
	i2=IndList[[2]];
	i3=IndList[[3]];
	i4=IndList[[4]];

	SM4DnoArray=Table[SM[cayley][i,s,t,r][j,s,t,r],{i,1,6},{s,1,6},{t,1,6},{r,1,6},{j,1,6}];
	SM4D00Array=Table[SM[cayley][0,s,t,r][0,s,t,r],{s,1,6},{t,1,6},{r,1,6}];
	SM4D0uArray=Table[SM[cayley][0,s,t,r][i,s,t,r],{s,1,6},{t,1,6},{r,1,6},{i,1,6}];
	SM3DnoArray=Table[SM[cayley][i,s,r][j,s,r],{i,1,6},{s,1,6},{r,1,6},{j,1,6}];
	SM3D00Array=Table[SM[cayley][0,i,r][0,j,r],{i,1,6},{r,1,6},{j,1,6}];
	SM3D0uArray=Table[SM[cayley][0,i,r][j,k,r],{i,1,6},{r,1,6},{j,1,6},{k,1,6}];
	SM2DnoArray=Table[SM[cayley][i,r][j,r],{i,0,6},{r,1,6},{j,0,6}];
     
	SM4Dno[i_,s_,t_,r_,j_]:=SM4DnoArray[[i,s,t,r,j]];
	SM4D00[s_,t_,r_]:=SM4D00Array[[s,t,r]];
	SM4D0u[s_,t_,r_,i_]:=SM4D0uArray[[s,t,r,i]];
	SM3Dno[i_,s_,r_,j_]:=SM3DnoArray[[i,s,r,j]];
        SM3D00[i_,r_,j_]:=SM3D00Array[[i,r,j]];
	SM3D0u[i_,r_,j_,k_]:=SM3D0uArray[[i,r,j,k]];
	SM2Dno[i_,r_,j_]:=SM2DnoArray[[i+1,r,j+1]];

	S4[i_,j_,k_,r_]:=
	Sum[If[s!=r,
	 (-SM3D00[s,r,k]*
	   (SM3D0u[s,r,i,s]*SM3D0u[s,r,j,s] + SM3Dno[i,s,r,j]*SM3D00[s,r,s])+
	   (SM3D0u[i,r,s,k]*SM3D0u[s,r,j,s] + SM3D0u[j,r,s,k]*SM3D0u[s,r,i,s])*
		SM3D00[s,r,s])/(SM2Dno[s,r,s])^2*I45[r,s], 0],{s,1,6}];	

	S3[i_,j_,k_,r_]:=
	Sum[If[s!=t && s!=r && t!=r,
	  (SM3D00[s,r,k]*
	  (SM3Dno[t,s,r,i]*SM3D0u[s,r,j,s] + SM3Dno[i,s,r,j]*SM3D0u[s,r,t,s]+
           	SM2Dno[s,r,s]*SM4D0u[s,t,r,i]*SM3Dno[t,s,r,j]/SM3Dno[s,t,r,s])-
	  (SM3D0u[i,r,s,k]*SM3D0u[s,r,j,s] + SM3D0u[j,r,s,k]*SM3D0u[s,r,i,s]) * 
		SM3D0u[s,r,t,s]-
	  (SM3D0u[i,r,s,k]*SM3Dno[t,s,r,j] + SM3D0u[j,r,s,k]*SM3Dno[t,s,r,i])*
		SM2Dno[s,r,s]*SM4D00[s,t,r]/(2*SM3Dno[s,t,r,s]))/
		(SM2Dno[s,r,s])^2*
	  I35[r,s,t], 0],{s,1,6},{t,1,6}];

	S2[i_,j_,k_,r_]:=
	-Sum[If[s!=t && s!=r && s!=u && t!=r && t!=u,
	  (SM3D00[s,r,k]*SM3Dno[t,s,r,j]*SM4Dno[u,s,t,r,i]-
	  (SM3D0u[j,r,s,k]*SM4Dno[u,s,t,r,i] + SM3D0u[i,r,s,k]*SM4Dno[u,s,t,r,j])/2*
		SM3D0u[s,r,t,s])/(SM2Dno[s,r,s]*SM3Dno[s,t,r,s])*
	  I25[r,s,t,u], 0],{s,1,6},{t,1,6},{u,1,6}];

	E00j[j_,r_]:=
      (-Sum[If[s!=r,
	 (3*SM2Dno[s,r,0]*SM3D0u[s,r,j,s] - SM2Dno[s,r,j]*SM3D00[s,r,s])*
	    SM3D00[s,r,s]/(SM2Dno[s,r,s])^2*I45[r,s], 0],{s,1,6}]+
	Sum[If[s!=r && s!=t && t!=r,
	 (3*SM2Dno[s,r,0]*SM3D0u[s,r,j,s] - SM2Dno[s,r,j]*
           (SM3D0u[s,r,t,s])^2/SM3Dno[s,t,r,s])*
	    SM3D0u[s,r,t,s]/(SM2Dno[s,r,s])^2*
	    I35[r,s,t], 0],{s,1,6},{t,1,6}]-
	Sum[If[s!=t && s!=r && s!=u && t!=r && t!=u,
	   SM2Dno[s,r,j]*SM4D0u[s,t,r,u]*SM3D0u[s,r,t,s]/
	  (SM2Dno[s,r,s]*SM3Dno[s,t,r,s])*
           I25[r,s,t,u] ,0],{s,1,6},{t,1,6},{u,1,6}])/2;

	i=i1+1;
	j=i2+1;
	k=i3+1;
	l=i4+1;

	If[i1!=0 && i2!=0,
	 result=-Sum[If[r!=i && r!=j && r!=k,
		SM[cayley][0,l][0,r]/(3*SM2Dno[0,r,0])*
		(S4[i,j,k,r]+S4[k,j,i,r]+S4[i,k,j,r]+
	  	 S3[i,j,k,r]+S3[k,j,i,r]+S3[i,k,j,r]+
	  	 S2[i,j,k,r]+S2[k,j,i,r]+S2[i,k,j,r]), 0],{r,1,6}],
	 result=-Sum[If[r!=k,
		SM[cayley][0,l][0,r]/(3*SM2Dno[0,r,0])*
		E00j[k,r], 0],{r,1,6}] ]
	];
	


  Return[result/SM[cayley][0][0] /.kinematics6pt]]


(*******************************************)
(*           6pt all coefficients          *)
(*******************************************)
RedFget[rank_,pq1_,pq2_,pq3_,pq4_,pq5_,pq6_,
      pq1pq2_,pq2pq3_,pq3pq4_,pq4pq5_,pq5pq6_,pq1pq6_,
      pq1pq2pq3_,pq2pq3pq4_,pq3pq4pq5_,
      mq1_,mq2_,mq3_,mq4_,mq5_,mq6_]:=

 Module[{kinrules,kinematics6pt,cayley,rankDroped,
         temp,coeficients,ffcoef,ctr,fin,result={}},


	kinrules={ps1->pq1,ps2->pq2,ps3->pq3,ps4->pq4,ps5->pq5,ps6->pq6,
		  ms1->mq1,ms2->mq2,ms3->mq3,ms4->mq4,ms5->mq5,ms6->mq6,
		  s12->pq1pq2,s23->pq2pq3,s34->pq3pq4,
		  s45->pq4pq5,s56->pq5pq6,s16->pq1pq6,
                  s123->pq1pq2pq3,s234->pq2pq3pq4,s345->pq3pq4pq5};
	kinematics6pt=Join[kinematics,scalars6pt] /.kinrules;

	rankDroped=DROPstr[rank,4];

	If[rankDroped===ToExpression["{A,L,L}"],{ctr=5;rankDroped={0}},ctr=1];
	

	Do[

	Switch[rankDroped[[1]],
		0,
	fin={ToExpression["ff0"]->RedF0[pq1,pq2,pq3,pq4,pq5,pq6,
                                   pq1pq2,pq2pq3,pq3pq4,pq4pq5,pq5pq6,pq1pq6,
                                   pq1pq2pq3,pq2pq3pq4,pq3pq4pq5,
                                   mq1,mq2,mq3,mq4,mq5,mq6]},
		1,
	fin=RedF1[pq1,pq2,pq3,pq4,pq5,pq6,
                  pq1pq2,pq2pq3,pq3pq4,pq4pq5,pq5pq6,pq1pq6,
                  pq1pq2pq3,pq2pq3pq4,pq3pq4pq5,
                  mq1,mq2,mq3,mq4,mq5,mq6,Listable->True]
                   /.q[_,n_]*F_:>ToExpression["ff"<>ToString[n]]->F,
		2,
	coeficients=RedF2[pq1,pq2,pq3,pq4,pq5,pq6,
                  pq1pq2,pq2pq3,pq3pq4,pq4pq5,pq5pq6,pq1pq6,
                  pq1pq2pq3,pq2pq3pq4,pq3pq4pq5,
                  mq1,mq2,mq3,mq4,mq5,mq6,Listable->True];
	ffcoef=ToExpression["{ff11,ff12,ff13,ff14,ff15,ff22,ff23,ff24,ff25,ff33,ff34,ff35,ff44,ff45,ff55}"];
        fin=CreateRules[ffcoef,coeficients],
		3,
	coeficients=RedF3[pq1,pq2,pq3,pq4,pq5,pq6,
                  pq1pq2,pq2pq3,pq3pq4,pq4pq5,pq5pq6,pq1pq6,
                  pq1pq2pq3,pq2pq3pq4,pq3pq4pq5,
                  mq1,mq2,mq3,mq4,mq5,mq6,Listable->True];
	ffcoef=ToExpression["{ff001,ff002,ff003,ff004,ff005,
	          ff111,ff112,ff113,ff114,ff115,ff121,ff122,ff123,ff124,ff125,ff131, 
		  ff132,ff133,ff134,ff135,ff141,ff142,ff143,ff144,ff145,ff151,ff152, 
                  ff153,ff154,ff155,ff221,ff222,ff223,ff224,ff225,ff231,ff232,ff233, 
                  ff234,ff235,ff241,ff242,ff243,ff244,ff245,ff251,ff252,ff253,ff254, 
                  ff255,ff331,ff332,ff333,ff334,ff335,ff341,ff342,ff343,ff344,ff345, 
                  ff351,ff352,ff353,ff354,ff355,ff441,ff442,ff443,ff444,ff445,ff451, 
                  ff452,ff453,ff454,ff455,ff551,ff552,ff553,ff554,ff555}"];
	fin=CreateRules[ffcoef,coeficients],
		4,
	coeficients=RedF4[pq1,pq2,pq3,pq4,pq5,pq6,
                  pq1pq2,pq2pq3,pq3pq4,pq4pq5,pq5pq6,pq1pq6,
                  pq1pq2pq3,pq2pq3pq4,pq3pq4pq5,
                  mq1,mq2,mq3,mq4,mq5,mq6,Listable->True];
	ffcoef=ToExpression["{ff0011,ff0012,ff0013,ff0014,ff0015,ff0021,ff0022,ff0023,ff0024, 
		  ff0025,ff0031,ff0032,ff0033,ff0034,ff0035,ff0041,ff0042,ff0043, 
                  ff0044,ff0045,ff0051,ff0052,ff0053,ff0054,ff0055,ff1111,ff1112, 
                  ff1113,ff1114,ff1115,ff1121,ff1122,ff1123,ff1124,ff1125,ff1131, 
                  ff1132,ff1133,ff1134,ff1135,ff1141,ff1142,ff1143,ff1144,ff1145, 
                  ff1151,ff1152,ff1153,ff1154,ff1155,ff1221,ff1222,ff1223,ff1224, 
                  ff1225,ff1231,ff1232,ff1233,ff1234,ff1235,ff1241,ff1242,ff1243, 
                  ff1244,ff1245,ff1251,ff1252,ff1253,ff1254,ff1255,ff1331,ff1332, 
                  ff1333,ff1334,ff1335,ff1341,ff1342,ff1343,ff1344,ff1345,ff1351, 
                  ff1352,ff1353,ff1354,ff1355,ff1441,ff1442,ff1443,ff1444,ff1445, 
                  ff1451,ff1452,ff1453,ff1454,ff1455,ff1551,ff1552,ff1553,ff1554,
                  ff1555,ff2221,ff2222,ff2223,ff2224,ff2225,ff2231,ff2232,ff2233, 
                  ff2234,ff2235,ff2241,ff2242,ff2243,ff2244,ff2245,ff2251,ff2252, 
                  ff2253,ff2254,ff2255,ff2331,ff2332,ff2333,ff2334,ff2335,ff2341, 
                  ff2342,ff2343,ff2344,ff2345,ff2351,ff2352,ff2353,ff2354,ff2355, 
                  ff2441,ff2442,ff2443,ff2444,ff2445,ff2451,ff2452,ff2453,ff2454, 
                  ff2455,ff2551,ff2552,ff2553,ff2554,ff2555,ff3331,ff3332,ff3333,
                  ff3334,ff3335,ff3341,ff3342,ff3343,ff3344,ff3345,ff3351,ff3352,
                  ff3353,ff3354,ff3355,ff3441,ff3442,ff3443,ff3444,ff3445,ff3451, 
                  ff3452,ff3453,ff3454,ff3455,ff3551,ff3552,ff3553,ff3554,ff3555, 
                  ff4441,ff4442,ff4443,ff4444,ff4445,ff4451,ff4452,ff4453,ff4454, 
                  ff4455,ff4551,ff4552,ff4553,ff4554,ff4555,ff5551,ff5552,ff5553, 
                  ff5554,ff5555}"];
	fin=CreateRules[ffcoef,coeficients] ];

	rankDroped={i};
	result=Join[result,fin],{i,1,ctr}];
	
	
  Return[ Flatten[result] ]]

(*====================================================================================*)
(*====================================================================================*)
(*====================================================================================*)

(******************************************)
(*         Scalar 5pt integral            *)
(******************************************)
RedE0[pq1_,pq2_,pq3_,pq4_,pq5_,
      pq1pq2_,pq2pq3_,pq3pq4_,pq4pq5_,pq1pq5_,
      mq1_,mq2_,mq3_,mq4_,mq5_]:=

 Module[{kinrules,kinematics5pt,cayley,result},

	kinrules={ps1->pq1,ps2->pq2,ps3->pq3,ps4->pq4,ps5->pq5,
		  ms1->mq1,ms2->mq2,ms3->mq3,ms4->mq4,ms5->mq5,
		  s12->pq1pq2,s23->pq2pq3,s34->pq3pq4,
		  s45->pq4pq5,s15->pq1pq5};
	kinematics5pt=Join[kinematics,scalars5pt] /.kinrules;
	cayley=Expand[(MCM[5] /.chords)] /.kinematics5pt;

	result=
	  Sum[SM[cayley][0][s]*I4[s],{s,1,5}];

  Return[result/SM[cayley][0][0] /.kinematics5pt]]


(*******************************************)
(*               5pt vector                *)
(*******************************************)
RedE1[pq1_,pq2_,pq3_,pq4_,pq5_,
      pq1pq2_,pq2pq3_,pq3pq4_,pq4pq5_,pq1pq5_,
      mq1_,mq2_,mq3_,mq4_,mq5_,options___Rule]:=

 Module[{option,kinrules,kinematics5pt,cayley,result},

	option=OptChange[RedE1,options];
	kinrules={ps1->pq1,ps2->pq2,ps3->pq3,ps4->pq4,ps5->pq5,
		  ms1->mq1,ms2->mq2,ms3->mq3,ms4->mq4,ms5->mq5,
		  s12->pq1pq2,s23->pq2pq3,s34->pq3pq4,
		  s45->pq4pq5,s15->pq1pq5};
	kinematics5pt=Join[kinematics,scalars5pt] /.kinrules;
	cayley=Expand[(MCM[5] /.chords)]/.kinematics5pt;
       
	result=
	Table[q[mu1,i-1]*
	  Sum[SM[cayley][0,i][0,s]*I4[s],{s,1,5}], {i,2,5}]/SM[cayley][0][0];

	If[Not[Listable/.option],result=Apply[Plus,result]];


  Return[result /.kinematics5pt]]


(*******************************************)
(*          5pt tensor 2nd order           *)
(*******************************************)
RedE2[pq1_,pq2_,pq3_,pq4_,pq5_,
      pq1pq2_,pq2pq3_,pq3pq4_,pq4pq5_,pq1pq5_,
      mq1_,mq2_,mq3_,mq4_,mq5_,options___Rule]:=

  Module[{option,kinrules,kinematics5pt,rules,cayley,
	  SM2D0dArray,SM2D00Array,SM1DnoArray,
	  SM2D0d,SM2D00,SM1Dno,II5,ID5,ArrayID5,E00,result},

	option=OptChange[RedE2,options];
	kinrules={ps1->pq1,ps2->pq2,ps3->pq3,ps4->pq4,ps5->pq5,
		  ms1->mq1,ms2->mq2,ms3->mq3,ms4->mq4,ms5->mq5,
		  s12->pq1pq2,s23->pq2pq3,s34->pq3pq4,
		  s45->pq4pq5,s15->pq1pq5};
	kinematics5pt=Join[kinematics,scalars5pt] /.kinrules;
	cayley=Expand[(MCM[5] /.chords)]/.kinematics5pt;
	
	SM2D0dArray=Table[SM[cayley][0,i][j,k],{i,1,5},{j,1,5},{k,1,5}];
	SM2D00Array=Table[SM[cayley][0,i][0,j],{i,1,5},{j,1,5}];
	SM1DnoArray=Table[SM[cayley][i][i],{i,1,5}];
	SM2D0d[i_,j_,k_]:=SM2D0dArray[[i,j,k]];
	SM2D00[i_,j_]:=SM2D00Array[[i,j]];
	SM1Dno[i_]:=SM1DnoArray[[i]];

	ID5[i_,j_]:=
	Sum[((-SM2D00[s,j]*SM2D0d[s,i,s]+SM2D0d[i,s,j]*SM2D00[s,s])*I4[s]-
	(Sum[If[s!=t,
            (-SM2D00[s,j]*SM[cayley][t,s][i,s]+SM2D0d[i,s,j]*SM2D0d[s,t,s])*I3[s,t],0],{t,1,5}])
	)/SM1Dno[s],{s,1,5}];

	ArrayID5=Flatten[Table[II5[i,j],{i,2,5},{j,i,5}]];
	E00=
	Sum[SM[cayley][0][s]/SM1Dno[s]*
	(SM2D00[s,s]*I4[s] - Sum[If[s!=t,SM2D0d[s,t,s]*I3[s,t],0],{t,1,5}]), 
		{s,1,5}]/2;
   
        If[Listable/.option,
	 result=Flatten[{-E00,ArrayID5}/SM[cayley][0][0] ]/.II5->ID5, 
	{result={-g[mu1,mu2]*E00,
	    Table[q[mu1,i-1]*q[mu2,j-1]*II5[Sequence @@ Sort[{i,j}] ],
	    	{i,2,5},{j,2,5}]}/SM[cayley][0][0];
	 result=Plus @@ Flatten[result /.II5->ID5]} ];
      

  Return[result/.kinematics5pt]]


(*******************************************)
(*          5pt tensor 3rd order           *)
(*******************************************)
RedE3[pq1_,pq2_,pq3_,pq4_,pq5_,
      pq1pq2_,pq2pq3_,pq3pq4_,pq4pq5_,pq1pq5_,
      mq1_,mq2_,mq3_,mq4_,mq5_,options___Rule]:=

  Module[{option,kinrules,kinematics5pt,cayley,SM3DnoArray,
          SM2DnoArray,SM2D00Array,SM2D0uArray,SM1DnoArray,
	  SM3Dno,SM2Dno,SM2D00,SM2D0u,SM1Dno,
	  S4,S3,S2,E00j,S4Array,S3Array,S2Array,E00jArray,result},

	option=OptChange[RedE3,options];
	kinrules={ps1->pq1,ps2->pq2,ps3->pq3,ps4->pq4,ps5->pq5,
		  ms1->mq1,ms2->mq2,ms3->mq3,ms4->mq4,ms5->mq5,
		  s12->pq1pq2,s23->pq2pq3,s34->pq3pq4,
		  s45->pq4pq5,s15->pq1pq5};
	kinematics5pt=Join[kinematics,scalars5pt] /.kinrules;
	cayley=Expand[(MCM[5] /.chords)]/.kinematics5pt;       
	
	SM3DnoArray=Table[SM[cayley][i,s,t][j,s,t],{i,0,5},{s,1,5},{t,1,5},{j,0,5}];
	SM2DnoArray=Table[SM[cayley][i,s][j,s],{i,1,5},{s,1,5},{j,1,5}];
	SM2D00Array=Table[SM[cayley][0,i][0,j],{i,1,5},{j,1,5}];
	SM2D0uArray=Table[SM[cayley][0,i][j,k],{i,1,5},{j,1,5},{k,1,5}];
	SM1DnoArray=Table[SM[cayley][i][j],{i,0,5},{j,0,5}];
	SM3Dno[i_,s_,t_,j_]:=SM3DnoArray[[i+1,s,t,j+1]];
	SM2Dno[i_,s_,j_]:=SM2DnoArray[[i,s,j]];
	SM2D00[i_,j_]:=SM2D00Array[[i,j]];
	SM2D0u[i_,j_,k_]:=SM2D0uArray[[i,j,k]];
	SM1Dno[i_,j_]:=SM1DnoArray[[i+1,j+1]];

	 S4[i_,j_,k_]:=
	 Sum[(-SM2D00[s,k]*
	  (SM2D0u[s,i,s]*SM2D0u[s,j,s] + SM2Dno[i,s,j]*SM2D00[s,s])+
	  (SM2D0u[i,s,k]*SM2D0u[s,j,s] + SM2D0u[j,s,k]*SM2D0u[s,i,s])*
	   SM2D00[s,s])/(SM1Dno[s,s])^2*I4[s], {s,1,5}];

	 S3[i_,j_,k_]:=
	 Sum[If[s!=t,
	  1/(SM1Dno[s,s])^2*
          (SM2D00[s,k]*
	  (SM2Dno[t,s,i]*SM2D0u[s,j,s] + SM2Dno[i,s,j]*SM2D0u[s,t,s]+
	   SM1Dno[s,s]*SM3Dno[0,s,t,i]*SM2Dno[t,s,j]/SM2Dno[s,t,s])-
          (SM2D0u[i,s,k]*SM2D0u[s,j,s] + SM2D0u[j,s,k]*SM2D0u[s,i,s])*
	   SM2D0u[s,t,s]-
	  (SM2D0u[i,s,k]*SM2Dno[t,s,j] + SM2D0u[j,s,k]*SM2Dno[t,s,i])*
	   SM1Dno[s,s]*SM3Dno[0,s,t,0]/(2*SM2Dno[s,t,s]))*
  		I3[s,t],0], {s,1,5},{t,1,5}];

	S2[i_,j_,k_]:=
	 Sum[If[s!=t && s!=u && t!=u,
	 -1/(SM1Dno[s,s]*SM2Dno[s,t,s])*
	  (SM2D00[s,k]*SM2Dno[t,s,j]*SM3Dno[u,s,t,i]-
	  (SM2D0u[j,s,k]*SM3Dno[u,s,t,i] + SM2D0u[i,s,k]*SM3Dno[u,s,t,j])*
           SM2D0u[s,t,s]/2)*I2[s,t,u], 0],{s,1,5},{t,1,5},{u,1,5}];

	E00j[j_]:=
       -Sum[(3*SM1Dno[s,0]*SM2D0u[s,j,s]-SM1Dno[s,j]*SM2D00[s,s])*
	        SM2D00[s,s]/(SM1Dno[s,s])^2 * I4[s],{s,1,5}]+
	Sum[If[s!=t,
	    (3*SM1Dno[s,0]*SM2D0u[s,j,s]-SM1Dno[s,j]*(SM2D0u[s,t,s])^2/SM2Dno[s,t,s])*
	       SM2D0u[s,t,s]/(SM1Dno[s,s])^2 * I3[s,t], 0],{s,1,5},{t,1,5}]-
	Sum[If[s!=t && s!=u && t!=u,
	    SM1Dno[s,j]*SM1Dno[s,s]*SM3Dno[u,s,t,0]*SM2D0u[s,t,s]/
	   (SM2Dno[s,t,s]*(SM1Dno[s,s])^2) * I2[s,t,u], 0],{s,1,5},{t,1,5},{u,1,5}];


	 S4Array=Table[S4[i,j,k],{i,2,5},{j,2,5},{k,2,5}]/.kinematics5pt;
	 S3Array=Table[S3[i,j,k],{i,2,5},{j,2,5},{k,2,5}]/.kinematics5pt;
	 S2Array=Table[S2[i,j,k],{i,2,5},{j,2,5},{k,2,5}]/.kinematics5pt;
	 

	If[Listable/.option,
	 result=-{Table[E00j[j],{j,2,5}]/2,
                  Table[S4Array[[i,j,k]]+S4Array[[k,j,i]]+S4Array[[i,k,j]]+
                        S3Array[[i,j,k]]+S3Array[[k,j,i]]+S3Array[[i,k,j]]+
		        S2Array[[i,j,k]]+S2Array[[k,j,i]]+S2Array[[i,k,j]],
	           {i,1,4},{j,i,4},{k,j,4}]}/(3*SM1Dno[0,0]) //Flatten, 
	{result={Table[q[mu1,i]*q[mu2,j]*q[mu3,k]*
		       (S4Array[[i,j,k]]+S4Array[[k,j,i]]+S4Array[[i,k,j]]+
                        S3Array[[i,j,k]]+S3Array[[k,j,i]]+S3Array[[i,k,j]]+
		        S2Array[[i,j,k]]+S2Array[[k,j,i]]+S2Array[[i,k,j]]),
	   	   {i,1,4},{j,1,4},{k,1,4}],
		 Table[(g[mu1,mu2]*q[mu3,j]+g[mu3,mu1]*q[mu2,j]+g[mu2,mu3]*q[mu1,j])*
			E00j[j+1], {j,1,4}]/2}/(3*SM1Dno[0,0]);
	 result=Plus @@ Flatten[-result]} 
	];


 Return[result/.kinematics5pt]]


(*******************************************)
(*           5pt coefficients              *)
(*******************************************)
RedEcoef[coef_,pq1_,pq2_,pq3_,pq4_,pq5_,
      pq1pq2_,pq2pq3_,pq3pq4_,pq4pq5_,pq1pq5_,
      mq1_,mq2_,mq3_,mq4_,mq5_]:=

 Module[{kinrules,kinematics5pt,IndList,i1,i2,i3,i,j,k,X,
         S4,S3,S2,SM3DnoArray,SM2DnoArray,SM2D00Array,
         SM2D0uArray,SM2D0dArray,SM1DnoArray,
	 SM3Dno,SM2Dno,SM2D00,SM2D0u,SM2D0d,SM1Dnocayley,result},


	kinrules={ps1->pq1,ps2->pq2,ps3->pq3,ps4->pq4,ps5->pq5,
		  ms1->mq1,ms2->mq2,ms3->mq3,ms4->mq4,ms5->mq5,
		  s12->pq1pq2,s23->pq2pq3,s34->pq3pq4,
		  s45->pq4pq5,s15->pq1pq5};
	kinematics5pt=Join[kinematics,scalars5pt] /.kinrules;

	cayley=Expand[(MCM[5] /.chords)]/.kinematics5pt;

        IndList=DROPstr[coef, 2];


	Switch[Length[IndList],
        	1,
	i1=First[IndList];
	result=
	 If[i1!=0,
	  Sum[SM[cayley][0,i1+1][0,s]*I4[s], {s,1,5}],
	  Sum[SM[cayley][0][s]*I4[s], {s,1,5}] ],

		2,
	i1=IndList[[1]];
	i2=IndList[[2]];
	result=
	 If[i1!=0 && i2!=0,
          X[s_,t_,i_,j_]:=-SM[cayley][0,s][0,i2+1]*SM[cayley][t,s][i1+1,s] + SM[cayley][0,i1+1][s,i2+1]*SM[cayley][t,s][0,s];
	  Sum[(X[s,0,i1+1,i2+1]*I4[s] - Sum[X[s,t,i1+1,i2+1]*I3[s,t], {t,1,5}])/SM[cayley][s][s], {s,1,5}],
	 -Sum[SM[cayley][s][0]/(2*SM[cayley][s][s])*
	     (SM[cayley][0,s][0,s]*I4[s] - Sum[SM[cayley][t,s][0,s]*I3[s,t], {t,1,5}]), {s,1,5}] ],

		3,
	i1=IndList[[1]];
	i2=IndList[[2]];
	i3=IndList[[3]];

	SM3DnoArray=Table[SM[cayley][i,s,t][j,s,t],{i,0,5},{s,1,5},{t,1,5},{j,0,5}];
	SM2DnoArray=Table[SM[cayley][i,s][j,s],{i,1,5},{s,1,5},{j,1,5}];
	SM2D00Array=Table[SM[cayley][0,i][0,j],{i,1,5},{j,1,5}];
	SM2D0uArray=Table[SM[cayley][0,i][j,k],{i,1,5},{j,1,5},{k,1,5}];
	SM2D0dArray=Table[SM[cayley][i,s][0,s],{i,1,5},{s,1,5}];
	SM1DnoArray=Table[SM[cayley][i][j],{i,0,5},{j,0,5}];

	SM3Dno[i_,s_,t_,j_]:=SM3DnoArray[[i+1,s,t,j+1]];
	SM2Dno[i_,s_,j_]:=SM2DnoArray[[i,s,j]];
	SM2D00[i_,j_]:=SM2D00Array[[i,j]];
	SM2D0u[i_,j_,k_]:=SM2D0uArray[[i,j,k]];
	SM2D0d[i_,s_]:=SM2D0dArray[[i,s]];
	SM1Dno[i_,j_]:=SM1DnoArray[[i+1,j+1]];

	 S4[i_,j_,k_]:=
	 Sum[(-SM2D00[s,k]*
	  (SM2D0u[s,i,s]*SM2D0u[s,j,s] + SM2Dno[i,s,j]*SM2D00[s,s])+
	  (SM2D0u[i,s,k]*SM2D0u[s,j,s] + SM2D0u[j,s,k]*SM2D0u[s,i,s])*
	   SM2D00[s,s])/(SM1Dno[s,s])^2*I4[s], {s,1,5}];

	 S3[i_,j_,k_]:=
	 Sum[If[s!=t,
	  1/(SM1Dno[s,s])^2*
          (SM2D00[s,k]*
	  (SM2Dno[t,s,i]*SM2D0u[s,j,s] + SM2Dno[i,s,j]*SM2D0d[t,s]+
	   SM1Dno[s,s]*SM3Dno[0,s,t,i]*SM2Dno[t,s,j]/SM2Dno[s,t,s])-
          (SM2D0u[i,s,k]*SM2D0u[s,j,s] + SM2D0u[j,s,k]*SM2D0u[s,i,s])*
	   SM2D0d[t,s]-
	  (SM2D0u[i,s,k]*SM2Dno[t,s,j] + SM2D0u[j,s,k]*SM2Dno[t,s,i])*
	   SM1Dno[s,s]*SM3Dno[0,s,t,0]/(2*SM2Dno[s,t,s]))*
  		I3[s,t],0], {s,1,5},{t,1,5}];

	 S2[i_,j_,k_]:=
	 Sum[If[s!=t && s!=u && t!=u,
	 -1/(SM1Dno[s,s]*SM2Dno[s,t,s])*
	  (SM2D00[s,k]*SM2Dno[t,s,j]*SM3Dno[u,s,t,i]-
	  (SM2D0u[j,s,k]*SM3Dno[u,s,t,i] + SM2D0u[i,s,k]*SM3Dno[u,s,t,j])*
           SM2D0d[t,s]/2)*I2[s,t,u], 0],
	 {s,1,5},{t,1,5},{u,1,5}];

	i=i1+1;
	j=i2+1;
	k=i3+1;

	result=
	-If[i1!=0 && i2!=0,
	  (S4[i,j,k]+S4[k,j,i]+S4[i,k,j]+
	   S3[i,j,k]+S3[k,j,i]+S3[i,k,j]+
           S2[i,j,k]+S2[k,j,i]+S2[i,k,j])/3,		
	 1/6*
	 (-Sum[(2*SM1Dno[s,0]*SM2D0u[s,k,s] - SM1Dno[s,s]*SM2D00[s,k])*
	          SM2D00[s,s]*I4[s]/(SM1Dno[s,s])^2, {s,1,5}]+
	  Sum[If[s!=t,
         ((SM1Dno[s,0]*SM2D0u[s,k,s] - SM1Dno[s,s]*SM2D00[s,k])*
	   SM2D0d[t,s]/(SM1Dno[s,s])^2+
	   SM1Dno[s,0]*SM2Dno[t,s,k]*SM2D00[s,s]/(SM1Dno[s,s])^2+
	   SM1Dno[s,0]*SM2D0d[t,s]*SM3Dno[0,s,t,k]/(SM1Dno[s,s]*SM2Dno[s,t,s]))*
		 I3[s,t], 0], {s,1,5},{t,1,5}]-
	  Sum[If[s!=t && s!=u && t!=u,
	   SM1Dno[s,0]*SM2D0d[t,s]*
	   SM3Dno[u,s,t,k]/(SM1Dno[s,s]*SM2Dno[s,t,s])*
		I2[s,t,u], 0], {s,1,5},{t,1,5},{u,1,5}]) ] ];


  Return[result/SM[cayley][0][0] /.kinematics5pt]]


(*******************************************)
(*           5pt all coefficients          *)
(*******************************************)
RedEget[rank_,pq1_,pq2_,pq3_,pq4_,pq5_,
      pq1pq2_,pq2pq3_,pq3pq4_,pq4pq5_,pq1pq5_,
      mq1_,mq2_,mq3_,mq4_,mq5_]:=

 Module[{kinrules,kinematics5pt,cayley,FivePT,rankDroped,
         coeficients,eecoef,ctr,fin,result={}},


	kinrules={ps1->pq1,ps2->pq2,ps3->pq3,ps4->pq4,ps5->pq5,
		  ms1->mq1,ms2->mq2,ms3->mq3,ms4->mq4,ms5->mq5,
		  s12->pq1pq2,s23->pq2pq3,s34->pq3pq4,
		  s45->pq4pq5,s15->pq1pq5};
	kinematics5pt=Join[kinematics,scalars5pt] /.kinrules;

	rankDroped=DROPstr[rank,4];
	If[rankDroped===ToExpression["{A,L,L}"],{ctr=4;rankDroped={0}},ctr=1];

	Do[

	Switch[rankDroped[[1]],
		0,
	fin={ToExpression["ee0"]->RedE0[pq1,pq2,pq3,pq4,pq5,
		     pq1pq2,pq2pq3,pq3pq4,pq4pq5,pq1pq5,
                     mq1,mq2,mq3,mq4,mq5]},
		1,
	fin=RedE1[pq1,pq2,pq3,pq4,pq5,
                     pq1pq2,pq2pq3,pq3pq4,pq4pq5,pq1pq5,
                     mq1,mq2,mq3,mq4,mq5,Listable->True]
                   /.q[_,n_]*F_:>ToExpression["ee"<>ToString[n]]->F,
		2,
	coeficients=RedE2[pq1,pq2,pq3,pq4,pq5,
                     pq1pq2,pq2pq3,pq3pq4,pq4pq5,pq1pq5,
                     mq1,mq2,mq3,mq4,mq5,Listable->True];
	eecoef=ToExpression["{ee00,ee11,ee12,ee13,ee14,ee22,ee23,ee24,ee33,ee34,ee44}"];
        fin=CreateRules[eecoef,coeficients],
		3,
	coeficients=RedE3[pq1,pq2,pq3,pq4,pq5,
                     pq1pq2,pq2pq3,pq3pq4,pq4pq5,pq1pq5,
                     mq1,mq2,mq3,mq4,mq5,Listable->True];
	eecoef=ToExpression["{ee001,ee002,ee003,ee004,
	                      ee111, ee112, ee113, ee114, ee122, ee123, ee124, ee133, 
	                      ee134, ee144, ee222, ee223, ee224, ee233, ee234, ee244, 
                              ee333, ee334, ee344, ee444}"];
	fin=CreateRules[eecoef,coeficients] ];

	rankDroped={i};
	result=Join[result,fin],{i,1,ctr}];
	
	
  Return[ Flatten[result] ]]


(*---------------------------------------*)
(*       Reduction to 5pt function       *)
(*---------------------------------------*)
I5[r_][kinematics_]:=Module[{pentagons,ES,result},
	
	
	pentagons=
	   {ES[p1^2 + 2*p1*p6 + p6^2, p2^2, p3^2, p4^2, p5^2, 
  	       p1^2 + 2*p1*p2 + p2^2 + 2*p1*p6 + 2*p2*p6 + p6^2, 
               p2^2 + 2*p2*p3 + p3^2, 
	       p3^2 + 2*p3*p4 + p4^2, 
               p4^2 + 2*p4*p5 + p5^2, 
               p1^2 + 2*p1*p5 + p5^2 + 2*p1*p6 + 2*p5*p6 + p6^2, 
               m[6]^2, m[2]^2, m[3]^2, m[4]^2, m[5]^2], 
	    ES[p1^2 + 2*p1*p2 + p2^2, p3^2, p4^2, p5^2, p6^2, 
               p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, 
               p3^2 + 2*p3*p4 + p4^2, 
               p4^2 + 2*p4*p5 + p5^2, 
               p5^2 + 2*p5*p6 + p6^2, 
               p1^2 + 2*p1*p2 + p2^2 + 2*p1*p6 + 2*p2*p6 + p6^2, 
               m[1]^2, m[3]^2, m[4]^2, m[5]^2, m[6]^2], 
 	    ES[p1^2, p2^2 + 2*p2*p3 + p3^2, p4^2, p5^2, p6^2, 
               p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, 
               p2^2 + 2*p2*p3 + p3^2 + 2*p2*p4 + 2*p3*p4 + p4^2, 
               p4^2 + 2*p4*p5 + p5^2, 
               p5^2 + 2*p5*p6 + p6^2, 
               p1^2 + 2*p1*p6 + p6^2, 
	       m[1]^2, m[2]^2, m[4]^2, m[5]^2, m[6]^2], 
	    ES[p1^2, p2^2, p3^2 + 2*p3*p4 + p4^2, p5^2, p6^2, 
               p1^2 + 2*p1*p2 + p2^2, 
               p2^2 + 2*p2*p3 + p3^2 + 2*p2*p4 + 2*p3*p4 + p4^2, 
               p3^2 + 2*p3*p4 + p4^2 + 2*p3*p5 + 2*p4*p5 + p5^2, 
               p5^2 + 2*p5*p6 + p6^2, 
               p1^2 + 2*p1*p6 + p6^2, 
	       m[1]^2, m[2]^2, m[3]^2, m[5]^2, m[6]^2], 
 	    ES[p1^2, p2^2, p3^2, p4^2 + 2*p4*p5 + p5^2, p6^2, 
               p1^2 + 2*p1*p2 + p2^2, 
               p2^2 + 2*p2*p3 + p3^2, 
               p3^2 + 2*p3*p4 + p4^2 + 2*p3*p5 + 2*p4*p5 + p5^2, 
               p4^2 + 2*p4*p5 + p5^2 + 2*p4*p6 + 2*p5*p6 + p6^2, 
               p1^2 + 2*p1*p6 + p6^2, 
               m[1]^2, m[2]^2, m[3]^2, m[4]^2, m[6]^2], 
	    ES[p1^2, p2^2, p3^2, p4^2, p5^2 + 2*p5*p6 + p6^2, 
               p1^2 + 2*p1*p2 + p2^2, 
               p2^2 + 2*p2*p3 + p3^2, 
               p3^2 + 2*p3*p4 + p4^2, 
               p4^2 + 2*p4*p5 + p5^2 + 2*p4*p6 + 2*p5*p6 + p6^2, 
               p1^2 + 2*p1*p5 + p5^2 + 2*p1*p6 + 2*p5*p6 + p6^2, 
               m[1]^2, m[2]^2, m[3]^2, m[4]^2, m[5]^2]};

	result=pentagons[[r]]/.kinematics/.ES->RedE0;

  Return[result]]


(*---------------------------------------*)
(*  Reduction to 4pt function FROM 6pt   *)
(*---------------------------------------*)
I45[Sequence[n__]]:=Module[{rules,TT,result},


    rules={
        TT[{1, 2}] -> 
	D4[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p6 + 2*p2*p6 + p6^2, p3^2, p4^2, p5^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p6 + 2*p2*p6 + 2*p3*p6 + p6^2, 
           p3^2 + 2*p3*p4 + p4^2, 
           m[6]^2, m[3]^2, m[4]^2, m[5]^2], 
	TT[{1, 3}] -> 
        D4[p1^2 + 2*p1*p6 + p6^2, p2^2 + 2*p2*p3 + p3^2, p4^2, p5^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p6 + 2*p2*p6 + 2*p3*p6 + p6^2, 
           p2^2 + 2*p2*p3 + p3^2 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           m[6]^2, m[2]^2, m[4]^2, m[5]^2], 
        TT[{1, 4}] -> 
        D4[p1^2 + 2*p1*p6 + p6^2, p2^2, p3^2 + 2*p3*p4 + p4^2, p5^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p6 + 2*p2*p6 + p6^2, 
           p2^2 + 2*p2*p3 + p3^2 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           m[6]^2, m[2]^2, m[3]^2, m[5]^2], 
        TT[{1, 5}] -> 
        D4[p1^2 + 2*p1*p6 + p6^2, p2^2, p3^2, p4^2 + 2*p4*p5 + p5^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p6 + 2*p2*p6 + p6^2, 
           p2^2 + 2*p2*p3 + p3^2, 
           m[6]^2, m[2]^2, m[3]^2, m[4]^2], 
        TT[{1, 6}] -> 
        D4[p1^2 + 2*p1*p5 + p5^2 + 2*p1*p6 + 2*p5*p6 + p6^2, p2^2, p3^2, p4^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p5 + 2*p2*p5 + p5^2 + 2*p1*p6 + 2*p2*p6 + 2*p5*p6 + p6^2, 
           p2^2 + 2*p2*p3 + p3^2, 
           m[5]^2, m[2]^2, m[3]^2, m[4]^2], 
        TT[{2, 3}] -> 
        D4[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, p4^2, p5^2, p6^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           p4^2 + 2*p4*p5 + p5^2, 
           m[1]^2, m[4]^2, m[5]^2, m[6]^2], 
        TT[{2, 4}] -> 
        D4[p1^2 + 2*p1*p2 + p2^2, p3^2 + 2*p3*p4 + p4^2, p5^2, p6^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           p3^2 + 2*p3*p4 + p4^2 + 2*p3*p5 + 2*p4*p5 + p5^2, 
           m[1]^2, m[3]^2, m[5]^2, m[6]^2], 
        TT[{2, 5}] -> 
        D4[p1^2 + 2*p1*p2 + p2^2, p3^2, p4^2 + 2*p4*p5 + p5^2, p6^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, 
           p3^2 + 2*p3*p4 + p4^2 + 2*p3*p5 + 2*p4*p5 + p5^2, 
           m[1]^2, m[3]^2, m[4]^2, m[6]^2], 
        TT[{2, 6}] -> 
        D4[p1^2 + 2*p1*p2 + p2^2, p3^2, p4^2, p5^2 + 2*p5*p6 + p6^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, 
           p3^2 + 2*p3*p4 + p4^2, 
           m[1]^2, m[3]^2, m[4]^2, m[5]^2], 
        TT[{3, 4}] -> 
        D4[p1^2, p2^2 + 2*p2*p3 + p3^2 + 2*p2*p4 + 2*p3*p4 + p4^2, p5^2, p6^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           p2^2 + 2*p2*p3 + p3^2 + 2*p2*p4 + 2*p3*p4 + p4^2 +2*p2*p5 + 2*p3*p5 + 2*p4*p5 + p5^2, 
           m[1]^2, m[2]^2, m[5]^2, m[6]^2], 
        TT[{3, 5}] -> 
        D4[p1^2, p2^2 + 2*p2*p3 + p3^2, p4^2 + 2*p4*p5 + p5^2, p6^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, 
           p2^2 + 2*p2*p3 + p3^2 + 2*p2*p4 + 2*p3*p4 + p4^2 + 2*p2*p5 + 2*p3*p5 + 2*p4*p5 + p5^2, 
           m[1]^2, m[2]^2, m[4]^2, m[6]^2], 
        TT[{3, 6}] -> 
        D4[p1^2, p2^2 + 2*p2*p3 + p3^2, p4^2, p5^2 + 2*p5*p6 + p6^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, 
           p2^2 + 2*p2*p3 + p3^2 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           m[1]^2, m[2]^2, m[4]^2, m[5]^2], 
        TT[{4, 5}] -> 
        D4[p1^2, p2^2, p3^2 + 2*p3*p4 + p4^2 + 2*p3*p5 + 2*p4*p5 + p5^2, p6^2, 
           p1^2 + 2*p1*p2 + p2^2, 
           p2^2 + 2*p2*p3 + p3^2 + 2*p2*p4 + 2*p3*p4 + p4^2 + 2*p2*p5 + 2*p3*p5 + 2*p4*p5 + p5^2, 
           m[1]^2, m[2]^2, m[3]^2, m[6]^2], 
        TT[{4, 6}] -> 
        D4[p1^2, p2^2, p3^2 + 2*p3*p4 + p4^2, p5^2 + 2*p5*p6 + p6^2, 
           p1^2 + 2*p1*p2 + p2^2, 
           p2^2 + 2*p2*p3 + p3^2 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           m[1]^2, m[2]^2, m[3]^2, m[5]^2], 
        TT[{5, 6}] -> 
        D4[p1^2, p2^2, p3^2, p4^2 + 2*p4*p5 + p5^2 + 2*p4*p6 + 2*p5*p6 + p6^2, 
           p1^2 + 2*p1*p2 + p2^2, p2^2 + 2*p2*p3 + p3^2, m[1]^2, 
           m[2]^2, m[3]^2, m[4]^2]};

	result=TT[Sort[List[n]]] /.rules;

 Return[result]]


(*---------------------------------------*)
(*  Reduction to 3pt function FROM 6pt   *)
(*---------------------------------------*)
I35[Sequence[n__]]:=Module[{rules,TT,result},

     rules={
        TT[{1, 2, 3}] -> 
        C3[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p6 + 2*p2*p6 + 2*p3*p6 + p6^2, p4^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2 + 2*p1*p6 + 2*p2*p6 + 2*p3*p6 + 2*p4*p6 + p6^2, 
           m[6]^2, m[4]^2, m[5]^2], TT[{1, 2, 4}] -> 
        C3[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p6 + 2*p2*p6 + p6^2, p3^2 + 2*p3*p4 + p4^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2 + 2*p1*p6 + 2*p2*p6 + 2*p3*p6 + 2*p4*p6 + p6^2, 
           m[6]^2, m[3]^2, m[5]^2], 
        TT[{1, 2, 5}] -> 
        C3[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p6 + 2*p2*p6 + p6^2, p3^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p6 + 2*p2*p6 + 2*p3*p6 + p6^2, 
           m[6]^2, m[3]^2, m[4]^2], 
        TT[{1, 2, 6}] -> 
        C3[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p5 + 2*p2*p5 + p5^2 + 2*p1*p6 + 2*p2*p6 + 2*p5*p6 + p6^2, p3^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p5 + 2*p2*p5 + 2*p3*p5 + p5^2 + 2*p1*p6 + 2*p2*p6 + 2*p3*p6 + 2*p5*p6 + p6^2, 
           m[5]^2, m[3]^2, m[4]^2], 
        TT[{1, 3, 4}] -> 
        C3[p1^2 + 2*p1*p6 + p6^2, p2^2 + 2*p2*p3 + p3^2 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2 + 2*p1*p6 + 2*p2*p6 + 2*p3*p6 + 2*p4*p6 + p6^2, 
           m[6]^2, m[2]^2, m[5]^2], 
        TT[{1, 3, 5}] -> 
        C3[p1^2 + 2*p1*p6 + p6^2, p2^2 + 2*p2*p3 + p3^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p6 + 2*p2*p6 + 2*p3*p6 + p6^2, 
           m[6]^2, m[2]^2, m[4]^2], 
        TT[{1, 3, 6}] -> 
        C3[p1^2 + 2*p1*p5 + p5^2 + 2*p1*p6 + 2*p5*p6 + p6^2, p2^2 + 2*p2*p3 + p3^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p5 + 2*p2*p5 + 2*p3*p5 + p5^2 + 2*p1*p6 + 2*p2*p6 + 2*p3*p6 + 2*p5*p6 + p6^2, 
           m[5]^2, m[2]^2, m[4]^2], 
        TT[{1, 4, 5}] -> 
        C3[p1^2 + 2*p1*p6 + p6^2, p2^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p6 + 2*p2*p6 + p6^2, 
           m[6]^2, m[2]^2, m[3]^2], 
        TT[{1, 4, 6}] -> 
        C3[p1^2 + 2*p1*p5 + p5^2 + 2*p1*p6 + 2*p5*p6 + p6^2, p2^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p5 + 2*p2*p5 + p5^2 + 2*p1*p6 + 2*p2*p6 + 2*p5*p6 + p6^2, 
           m[5]^2, m[2]^2, m[3]^2], 
        TT[{1, 5, 6}] -> 
        C3[p1^2 + 2*p1*p4 + p4^2 + 2*p1*p5 + 2*p4*p5 + p5^2 + 2*p1*p6 + 2*p4*p6 + 2*p5*p6 + p6^2, p2^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p4 + 2*p2*p4 + p4^2 + 2*p1*p5 + 2*p2*p5 + 2*p4*p5 + p5^2 + 2*p1*p6 + 2*p2*p6 + 2*p4*p6 + 2*p5*p6 + p6^2, 
           m[4]^2, m[2]^2, m[3]^2], 
        TT[{2, 3, 4}] -> 
        C3[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2, p5^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2 + 2*p1*p5 + 2*p2*p5 + 2*p3*p5 + 2*p4*p5 + p5^2, 
           m[1]^2, m[5]^2, m[6]^2], 
        TT[{2, 3, 5}] -> 
        C3[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, p4^2 + 2*p4*p5 + p5^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2 + 2*p1*p5 + 2*p2*p5 + 2*p3*p5 + 2*p4*p5 + p5^2, 
           m[1]^2, m[4]^2, m[6]^2], 
        TT[{2, 3, 6}] -> 
        C3[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, p4^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           m[1]^2, m[4]^2, m[5]^2], 
        TT[{2, 4, 5}] -> 
        C3[p1^2 + 2*p1*p2 + p2^2, p3^2 + 2*p3*p4 + p4^2 + 2*p3*p5 + 2*p4*p5 + p5^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2 + 2*p1*p5 + 2*p2*p5 + 2*p3*p5 + 2*p4*p5 + p5^2, 
           m[1]^2, m[3]^2, m[6]^2], 
        TT[{2, 4, 6}] -> 
        C3[p1^2 + 2*p1*p2 + p2^2, p3^2 + 2*p3*p4 + p4^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           m[1]^2, m[3]^2, m[5]^2], 
        TT[{2, 5, 6}] -> 
        C3[p1^2 + 2*p1*p2 + p2^2, p3^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, 
           m[1]^2, m[3]^2, m[4]^2], 
        TT[{3, 4, 5}] -> 
        C3[p1^2, p2^2 + 2*p2*p3 + p3^2 + 2*p2*p4 + 2*p3*p4 + p4^2 + 2*p2*p5 + 2*p3*p5 + 2*p4*p5 + p5^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2 + 2*p1*p5 + 2*p2*p5 + 2*p3*p5 + 2*p4*p5 + p5^2, 
           m[1]^2, m[2]^2, m[6]^2], 
        TT[{3, 4, 6}] -> 
        C3[p1^2, p2^2 + 2*p2*p3 + p3^2 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           m[1]^2, m[2]^2, m[5]^2], 
        TT[{3, 5, 6}] -> 
        C3[p1^2, p2^2 + 2*p2*p3 + p3^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, 
           m[1]^2, m[2]^2, m[4]^2], 
        TT[{4, 5, 6}] -> 
        C3[p1^2, p2^2, 
           p1^2 + 2*p1*p2 + p2^2, 
           m[1]^2, m[2]^2, m[3]^2]};

	result=TT[Sort[List[n]]] /.rules;

 Return[result]]


(*---------------------------------------*)
(*  Reduction to 3pt function FROM 6pt   *)
(*---------------------------------------*)
I25[Sequence[n__]]:=
  Module[{rules,TT,result},

     rules={
        TT[{1, 2, 3, 4}] -> 
        B2[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2 + 2*p1*p6 + 2*p2*p6 + 2*p3*p6 + 2*p4*p6 + p6^2, 
          m[6]^2, m[5]^2], 
        TT[{1, 2, 3, 5}] -> 
        B2[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p6 + 2*p2*p6 + 2*p3*p6 + p6^2, 
           m[6]^2, m[4]^2], 
        TT[{1, 2, 3, 6}] -> 
        B2[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p5 + 2*p2*p5 + 2*p3*p5 + p5^2 + 2*p1*p6 + 2*p2*p6 + 2*p3*p6 + 2*p5*p6 + p6^2, 
           m[5]^2, m[4]^2], 
        TT[{1, 2, 4, 5}] -> 
        B2[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p6 + 2*p2*p6 + p6^2, 
           m[6]^2, m[3]^2], 
        TT[{1, 2, 4, 6}] -> 
        B2[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p5 + 2*p2*p5 + p5^2 + 2*p1*p6 + 2*p2*p6 + 2*p5*p6 + p6^2, 
           m[5]^2, m[3]^2], 
        TT[{1, 2, 5, 6}] -> 
        B2[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p4 + 2*p2*p4 + p4^2 + 2*p1*p5 + 2*p2*p5 + 2*p4*p5 + p5^2 + 2*p1*p6 + 2*p2*p6 + 2*p4*p6 + 2*p5*p6 + p6^2, 
           m[4]^2, m[3]^2], 
        TT[{1, 3, 4, 5}] -> 
        B2[p1^2 + 2*p1*p6 + p6^2, 
           m[6]^2, m[2]^2], 
        TT[{1, 3, 4, 6}] -> 
        B2[p1^2 + 2*p1*p5 + p5^2 + 2*p1*p6 + 2*p5*p6 + p6^2, 
           m[5]^2, m[2]^2], 
        TT[{1, 3, 5, 6}] -> 
        B2[p1^2 + 2*p1*p4 + p4^2 + 2*p1*p5 + 2*p4*p5 + p5^2 + 2*p1*p6 + 2*p4*p6 + 2*p5*p6 + p6^2, 
           m[4]^2, m[2]^2], 
        TT[{1, 4, 5, 6}] -> 
        B2[p1^2 + 2*p1*p3 + p3^2 + 2*p1*p4 + 2*p3*p4 + p4^2 + 2*p1*p5 + 2*p3*p5 + 2*p4*p5 + p5^2 + 2*p1*p6 + 2*p3*p6 + 2*p4*p6 + 2*p5*p6 + p6^2, 
           m[3]^2, m[2]^2], 
        TT[{2, 3, 4, 5}] -> 
        B2[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2 + 2*p1*p5 + 2*p2*p5 + 2*p3*p5 + 2*p4*p5 + p5^2, 
           m[1]^2, m[6]^2], 
        TT[{2, 3, 4, 6}] -> 
        B2[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           m[1]^2, m[5]^2], 
        TT[{2, 3, 5, 6}] -> 
        B2[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, 
           m[1]^2, m[4]^2], 
        TT[{2, 4, 5, 6}] -> 
        B2[p1^2 + 2*p1*p2 + p2^2, 
           m[1]^2, m[3]^2], 
        TT[{3, 4, 5, 6}] -> 
        B2[p1^2, 
           m[1]^2, m[2]^2]};

	result=TT[Sort[List[n]]] /.rules;

 Return[result]]


(*---------------------------------------*)
(*       Reduction to 4pt function       *)
(*---------------------------------------*)
I4[r_]:=Module[{boxes,result},

	boxes={D4[p1^2 + 2*p1*p5 + p5^2, p2^2, p3^2, p4^2, 
  	          p1^2 + 2*p1*p2 + p2^2 + 2*p1*p5 + 2*p2*p5 + p5^2, 
                  p2^2 + 2*p2*p3 + p3^2, 
                  m[5]^2, m[2]^2, m[3]^2, m[4]^2], 
	       D4[p1^2 + 2*p1*p2 + p2^2, p3^2, p4^2, p5^2, 
                  p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, 
                  p3^2 + 2*p3*p4 + p4^2, 
                  m[1]^2, m[3]^2, m[4]^2, m[5]^2], 
               D4[p1^2, p2^2 + 2*p2*p3 + p3^2, p4^2, p5^2, 
                  p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, 
                  p2^2 + 2*p2*p3 + p3^2 + 2*p2*p4 + 2*p3*p4 + p4^2, 
                  m[1]^2, m[2]^2, m[4]^2, m[5]^2], 
               D4[p1^2, p2^2, p3^2 + 2*p3*p4 + p4^2, p5^2, 
                  p1^2 + 2*p1*p2 + p2^2, 
                  p2^2 + 2*p2*p3 + p3^2 + 2*p2*p4 + 2*p3*p4 + p4^2, 
                  m[1]^2, m[2]^2, m[3]^2, m[5]^2], 
               D4[p1^2, p2^2, p3^2, p4^2 + 2*p4*p5 + p5^2, 
                  p1^2 + 2*p1*p2 + p2^2, 
                  p2^2 + 2*p2*p3 + p3^2, 
                  m[1]^2, m[2]^2, m[3]^2, m[4]^2]};

	result=boxes[[r]];

 Return[result]]

(*---------------------------------------*)
(*       Reduction to 4pt function       *)
(*---------------------------------------*)
I3[Sequence[n__]]:=Module[{rules,TT,result},

     rules={
	TT[{1, 2}] -> 
	C3[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p5 + 2*p2*p5 + p5^2, p3^2, 
	   p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p5 + 2*p2*p5 + 2*p3*p5 + p5^2, 
           m[5]^2, m[3]^2, m[4]^2], 
 	TT[{1, 3}] -> 
        C3[p1^2 + 2*p1*p5 + p5^2, p2^2 + 2*p2*p3 + p3^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p5 + 2*p2*p5 + 2*p3*p5 + p5^2, 
           m[5]^2, m[2]^2, m[4]^2], 
        TT[{1, 4}] -> 
        C3[p1^2 + 2*p1*p5 + p5^2, p2^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p5 + 2*p2*p5 + p5^2, 
           m[5]^2, m[2]^2, m[3]^2], 
        TT[{1, 5}] -> 
        C3[p1^2 + 2*p1*p4 + p4^2 + 2*p1*p5 + 2*p4*p5 + p5^2, p2^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p4 + 2*p2*p4 + p4^2 + 2*p1*p5 + 2*p2*p5 + 2*p4*p5 + p5^2, 
           m[4]^2, m[2]^2, m[3]^2], 
        TT[{2, 3}] -> 
        C3[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, p4^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           m[1]^2, m[4]^2, m[5]^2], 
        TT[{2, 4}] -> 
        C3[p1^2 + 2*p1*p2 + p2^2, p3^2 + 2*p3*p4 + p4^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           m[1]^2, m[3]^2, m[5]^2], 
        TT[{2, 5}] -> 
        C3[p1^2 + 2*p1*p2 + p2^2, p3^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, 
           m[1]^2, m[3]^2, m[4]^2], 
        TT[{3, 4}] -> 
        C3[p1^2, p2^2 + 2*p2*p3 + p3^2 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           m[1]^2, m[2]^2, m[5]^2], 
        TT[{3, 5}] -> 
        C3[p1^2, p2^2 + 2*p2*p3 + p3^2, 
           p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, 
           m[1]^2, m[2]^2, m[4]^2], 
        TT[{4, 5}] -> 
        C3[p1^2, p2^2, 
           p1^2 + 2*p1*p2 + p2^2, 
           m[1]^2, m[2]^2, m[3]^2]};


	result=TT[Sort[List[n]]] /.rules;

 
 Return[result]]

(*---------------------------------------*)
(*       Reduction to 2pt function       *)
(*---------------------------------------*)
I2[Sequence[n__]]:=Module[{rules,TT,result},

     rules={
	TT[{1, 2, 3}] -> 
	B2[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p5 + 2*p2*p5 + 2*p3*p5 + p5^2, 
           m[5]^2, m[4]^2], 
	TT[{1, 2, 4}] -> 
	B2[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p5 + 2*p2*p5 + p5^2, 
           m[5]^2, m[3]^2], 
	TT[{1, 2, 5}] -> 
        B2[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p4 + 2*p2*p4 + p4^2 + 2*p1*p5 + 2*p2*p5 + 2*p4*p5 + p5^2, 
	   m[4]^2, m[3]^2], 
        TT[{1, 3, 4}] -> 
        B2[p1^2 + 2*p1*p5 + p5^2, 
	   m[5]^2, m[2]^2], 
        TT[{1, 3, 5}] -> 
        B2[p1^2 + 2*p1*p4 + p4^2 + 2*p1*p5 + 2*p4*p5 + p5^2, 
           m[4]^2, m[2]^2], 
        TT[{1, 4, 5}] -> 
        B2[p1^2 + 2*p1*p3 + p3^2 + 2*p1*p4 + 2*p3*p4 + p4^2 + 2*p1*p5 + 2*p3*p5 + 2*p4*p5 + p5^2, 
           m[3]^2, m[2]^2], 
        TT[{2, 3, 4}] -> 
        B2[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2 + 2*p1*p4 + 2*p2*p4 + 2*p3*p4 + p4^2, 
           m[1]^2, m[5]^2], 
        TT[{2, 3, 5}] -> 
        B2[p1^2 + 2*p1*p2 + p2^2 + 2*p1*p3 + 2*p2*p3 + p3^2, 
           m[1]^2, m[4]^2], 
        TT[{2, 4, 5}] -> 
        B2[p1^2 + 2*p1*p2 + p2^2, 
           m[1]^2, m[3]^2], 
        TT[{3, 4, 5}] -> 
        B2[p1^2, 
           m[1]^2, m[2]^2]};

  
	result=TT[Sort[List[n]]] /.rules;


 Return[result]]



End[]


EndPackage[]

