443 integer,
intent(in) :: N,rmax,id
444 double complex,
intent(in) :: MomInv(BinomTable(2,N)), masses2(0:N-1)
445 double precision,
intent(out) :: TNerr(0:rmax),TNerr2(0:rmax)
446 double complex :: q10,q21,q32,q43,q54,q20,q31,q42,q53,q50,q30,q41,q52,q40,q51
447 double complex :: mm02,mm12,mm22,mm32,mm42,mm52
448 double complex :: mx(0:5,0:5), mxinv(0:5,0:5),mx0k(5,5),mx0kinv(5,5),ff(N-1)
449 double complex :: det,newdet,TNaux,mxinvs,mx0kinvs(5)
450 double complex :: zmx0kinv(5,5),Z(5,5),zmx0kinvs(5)
451 double precision :: maxZ,maxzmx0kinv(5),maxzmx0kinvs
452 double complex,
intent(inout) :: TN(BinomTable(rmax,N+rmax-2),0:rmax/2,0:rmax)
453 double complex,
intent(inout) :: TNuv(BinomTable(rmax,N+rmax-2),0:rmax/2,0:rmax)
454 double complex,
allocatable :: TNm1_0(:,:,:), TNm1UV_0(:,:,:), TNm1_i(:,:,:,:)
455 double complex,
allocatable :: TNm1_0aux(:,:,:), TNm1UV_0aux(:,:,:), TNm1UV_i(:,:,:,:)
456 double complex :: S(5), elimminf2_coli,chdet,gram(1:5,1:5),gramdet
457 double precision :: TNm1err(0:5,0:rmax),TNm1err2(0:5,0:rmax)
458 integer :: r,n0,n1,n2,n3,n4,n5,n6,k,i,j,m,nid(0:5),r0,bin,kbest,Nm1,inds(N-1)
459 integer :: bino,bino_0,bino_i,bino_m1,bino_m2,cnt,iaux,rmax_m1,shift,cind,rBCD
460 integer :: mia1,mia2,mia3
461 logical :: errorwriteflag
462 character(len=*),
parameter :: fmt10 =
"(A18,'(',d25.18,' , ',d25.18,' )')"
465 character(len=*),
parameter :: fmt999 =
"(' gm(',i1,',',i1,') = ',d23.16,' , ',d23.16)"
474 rmax_m1 = max(rmax-1,0)
475 bino_0 = binomtable(rmax_m1,n+rmax_m1-2)
476 bino_i = binomtable(rmax_m1,nm1+rmax_m1-2)
477 allocate(tnm1_0(bino_0,0:rmax_m1/2,0:rmax_m1))
478 allocate(tnm1_0aux(bino_i,0:rmax_m1/2,0:rmax_m1))
479 allocate(tnm1_i(bino_i,0:rmax_m1/2,0:rmax_m1,5))
480 allocate(tnm1uv_0(bino_0,0:rmax_m1/2,0:rmax_m1))
481 allocate(tnm1uv_0aux(bino_i,0:rmax_m1/2,0:rmax_m1))
482 allocate(tnm1uv_i(bino_i,0:rmax_m1/2,0:rmax_m1,5))
488 if (mod(id/bin,2).eq.0)
then
496 nm1,rmax_m1,nid(0),tnerr=tnm1err(0,0:rmax_m1), &
497 tnerr2=tnm1err2(0,0:rmax_m1))
499 call calctnint(tnm1_i(:,:,:,k),tnm1uv_i(:,:,:,k),
submominv(n,k,mominv), &
500 submasses(n,k,masses2),nm1,rmax_m1,nid(k), &
501 tnerr=tnm1err(k,0:rmax_m1),tnerr2=tnm1err2(k,0:rmax_m1))
506 tnm1_0(1,n0,2*n0) = tnm1_0aux(1,n0,2*n0)
508 mia1 = binomtable(r-1,n+r-3)+1
509 mia2 = binomtable(r,n+r-3)
510 mia3 = binomtable(r,n+r-2)
511 tnm1_0(mia1:mia3,n0,r+2*n0) = tnm1_0aux(1:mia2,n0,r+2*n0)
516 do i=binomtable(r-2*n0-1,n+r-2*n0-3),1,-1
517 tnm1_0(i,n0,r) = -tnm1_0(i,n0,r-1)
519 tnm1_0(i,n0,r) = tnm1_0(i,n0,r) &
520 - tnm1_0(addtocind(j,i,r-2*n0-1,n-1),n0,r)
526 tnm1uv_0(1,n0,2*n0) = tnm1uv_0aux(1,n0,2*n0)
528 mia1 = binomtable(r-1,n+r-3)+1
529 mia2 = binomtable(r,n+r-3)
530 mia3 = binomtable(r,n+r-2)
531 tnm1uv_0(mia1:mia3,n0,r+2*n0) = tnm1uv_0aux(1:mia2,n0,r+2*n0)
536 do i=binomtable(r-2*n0-1,n+r-2*n0-3),1,-1
537 tnm1uv_0(i,n0,r) = -tnm1uv_0(i,n0,r-1)
539 tnm1uv_0(i,n0,r) = tnm1uv_0(i,n0,r) &
540 - tnm1uv_0(addtocind(j,i,r-2*n0-1,n-1),n0,r)
548 mm02 = elimminf2_coli(masses2(0))
549 mm12 = elimminf2_coli(masses2(1))
550 mm22 = elimminf2_coli(masses2(2))
551 mm32 = elimminf2_coli(masses2(3))
552 mm42 = elimminf2_coli(masses2(4))
553 mm52 = elimminf2_coli(masses2(5))
554 q10 = elimminf2_coli(mominv(1))
555 q21 = elimminf2_coli(mominv(2))
556 q32 = elimminf2_coli(mominv(3))
557 q43 = elimminf2_coli(mominv(4))
558 q54 = elimminf2_coli(mominv(5))
560 q50 = elimminf2_coli(mominv((n-6)*n+6))
562 q50 = elimminf2_coli(mominv(4*n+1))
564 q20 = elimminf2_coli(mominv(n+1))
565 q31 = elimminf2_coli(mominv(n+2))
566 q42 = elimminf2_coli(mominv(n+3))
567 q53 = elimminf2_coli(mominv(n+4))
569 q40 = elimminf2_coli(mominv((n-5)*n+5))
570 q51 = elimminf2_coli(mominv((n-5)*n+6))
572 q40 = elimminf2_coli(mominv(3*n+1))
573 q51 = elimminf2_coli(mominv(3*n+2))
575 q30 = elimminf2_coli(mominv(2*n+1))
576 q41 = elimminf2_coli(mominv(2*n+2))
577 q52 = elimminf2_coli(mominv(2*n+3))
591 ff(i) = elimminf2_coli(mominv(cnt)) + mm02 &
592 - elimminf2_coli(masses2(i))
597 mx(1,0) = q10 - mm12 + mm02
598 mx(2,0) = q20 - mm22 + mm02
599 mx(3,0) = q30 - mm32 + mm02
600 mx(4,0) = q40 - mm42 + mm02
601 mx(5,0) = q50 - mm52 + mm02
604 mx(2,1) = q10+q20-q21
605 mx(3,1) = q10+q30-q31
606 mx(4,1) = q10+q40-q41
607 mx(5,1) = q10+q50-q51
611 mx(3,2) = q20+q30-q32
612 mx(4,2) = q20+q40-q42
613 mx(5,2) = q20+q50-q52
618 mx(4,3) = q30+q40-q43
619 mx(5,3) = q30+q50-q53
625 mx(5,4) = q40+q50-q54
633 call chinv(6,mx,mxinv)
638 mx0k(i,j) = mx(i,j-1)
646 write(*,*)
'det',5,det
654 newdet = chdet(5,mx0k)
655 if (abs(newdet).gt.abs(det))
then
658 write(*,*)
'det',j-1,newdet
667 write(*,*)
'kbest',kbest
675 mx0k(i,kbest) = mx(i,0)
678 call chinv(5,mx0k,mx0kinv)
680 mx0kinv(kbest,i) = 0d0
683 mxinvs = sum(mxinv(0:5,0))
685 mx0kinvs(i) = sum(mx0kinv(i,1:5))
689 z(1:5,1:5) = mx(1:5,1:5)
691 zmx0kinv = matmul(z,mx0kinv)
694 maxzmx0kinv(i) = maxval(abs(zmx0kinv(1:5,i)))
695 zmx0kinvs(i) = sum(zmx0kinv(i,1:5))
698 maxzmx0kinvs = maxval(abs(zmx0kinvs(1:5)))
700 maxz = maxval(abs(z))
709 do cind=1,binomtable(r-2*n0,n+r-2*n0-2)
711 tnuv(cind,n0,r) = tnm1uv_0(cind,n0-1,r-2) + 2*mm02*tnuv(cind,n0-1,r-2)
713 tnuv(cind,n0,r) = tnuv(cind,n0,r) &
714 + ff(i)*tnuv(addtocind(i,cind,r-2*n0,n-1),n0-1,r-1)
716 tnuv(cind,n0,r) = tnuv(cind,n0,r)/(2*(r+3-n))
724 tn(1,0,0) = -mxinv(0,0)*tnm1_0(1,0,0)
726 tn(1,0,0) = tn(1,0,0) &
727 + mxinv(k,0)*(tnm1_i(1,0,0,k)-tnm1_0(1,0,0))
731 tnerr(0) = max(abs(mxinvs)*tnm1err(0,0), &
732 abs(mxinv(1,0))*tnm1err(1,0) , &
733 abs(mxinv(2,0))*tnm1err(2,0) , &
734 abs(mxinv(3,0))*tnm1err(3,0) , &
735 abs(mxinv(4,0))*tnm1err(4,0) , &
736 abs(mxinv(5,0))*tnm1err(5,0) )
738 tnerr2(0) = max(abs(mxinvs)*tnm1err2(0,0), &
739 abs(mxinv(1,0))*tnm1err2(1,0) , &
740 abs(mxinv(2,0))*tnm1err2(2,0) , &
741 abs(mxinv(3,0))*tnm1err2(3,0) , &
742 abs(mxinv(4,0))*tnm1err2(4,0) , &
743 abs(mxinv(5,0))*tnm1err2(5,0) )
745 if (rmax.eq.0)
return
750 do n0=0,max((r-n+6)/2,0)
751 bino_m1 = binomtable(r-2*n0,n+r-2*n0-2)
753 inds = calccindarr(nm1,r-2*n0,i)
756 s(m) = -tnm1_0(i,n0,r)
760 write(*,*)
'Tnred s(m)',s
763 if (inds(1).eq.0)
then
764 s(1) = s(1) + tnm1_i(dropcind(1,i,r-2*n0,nm1),n0,r,1)
766 if (inds(2).eq.0)
then
767 s(2) = s(2) + tnm1_i(dropcind(2,i,r-2*n0,nm1),n0,r,2)
769 if (inds(3).eq.0)
then
770 s(3) = s(3) + tnm1_i(dropcind(3,i,r-2*n0,nm1),n0,r,3)
772 if (inds(4).eq.0)
then
773 s(4) = s(4) + tnm1_i(dropcind(4,i,r-2*n0,nm1),n0,r,4)
775 if (inds(5).eq.0)
then
776 s(5) = s(5) + tnm1_i(dropcind(5,i,r-2*n0,nm1),n0,r,5)
780 write(*,*)
'Tnred s(m)',s
784 tnaux = mx0kinv(k,1)*s(1)+mx0kinv(k,2)*s(2) &
785 + mx0kinv(k,3)*s(3)+mx0kinv(k,4)*s(4)+mx0kinv(k,5)*s(5)
786 iaux = addtocind(k,i,r,n-1)
787 tn(iaux,n0,r+1) = tn(iaux,n0,r+1) + (inds(k)+1)*tnaux/(r+1)
789 write(*,*)
'Tnred comb',k,mx0kinv(k,1)*s(1),mx0kinv(k,2)*s(2) &
790 , mx0kinv(k,3)*s(3),mx0kinv(k,4)*s(4),mx0kinv(k,5)*s(5), tnaux
792 if(abs(tnaux).ne.0d0)
then
793 write(*,*)
'Tnred cancel', k, max(abs(mx0kinv(k,1)*s(1)),abs(mx0kinv(k,2)*s(2)) &
794 , abs(mx0kinv(k,3)*s(3)),abs(mx0kinv(k,4)*s(4)),abs(mx0kinv(k,5)*s(5))) &
806 if (r.le.rmax-1)
then
808 tnerr(r+1) = max( maxval(abs(mx0kinvs(1:5)))*tnm1err(0,r), &
809 maxval(abs(mx0kinv(1:5,1)))*tnm1err(1,r) , &
810 maxval(abs(mx0kinv(1:5,2)))*tnm1err(2,r) , &
811 maxval(abs(mx0kinv(1:5,3)))*tnm1err(3,r) , &
812 maxval(abs(mx0kinv(1:5,4)))*tnm1err(4,r) , &
813 maxval(abs(mx0kinv(1:5,5)))*tnm1err(5,r) )
815 tnerr2(r+1) = max( abs(maxzmx0kinvs)*tnm1err2(0,r), &
816 abs(maxzmx0kinv(1))*tnm1err2(1,r) , &
817 abs(maxzmx0kinv(2))*tnm1err2(2,r) , &
818 abs(maxzmx0kinv(3))*tnm1err2(3,r) , &
819 abs(maxzmx0kinv(4))*tnm1err2(4,r) , &
820 abs(maxzmx0kinv(5))*tnm1err2(5,r) )/maxz
823 if (mode_coli.lt.1)
then
826 gramdet = chdet(5,gram)
832 write(*,fmt999) i,j,gram(i,j)
835 write(*,*)
'TNred relGramdet=',gramdet/det
838 if (max(abs(tn(1,0,0)),maxval(abs(tn(1:6,0,1))))*abs(gramdet/det).gt. &
841 tnerr(r+1)= max(tnerr(r+1), &
842 max(abs(tn(1,0,0)),maxval(abs(tn(1:6,0,1))))*abs(gramdet/det) )
843 tnerr2(r+1)= max(tnerr2(r+1), &
844 max(abs(tn(1,0,0)),maxval(abs(tn(1:6,0,1))))*abs(gramdet/det) )
846 if (abs(gramdet/det).gt.reqacc_coli)
then
847 call seterrflag_coli(-6)
848 call errout_coli(
'CalcTNred', &
849 'input momenta inconsistent! (not 4-dimensional)', &
851 if (errorwriteflag)
then
852 write(nerrout_coli,fmt10)
' CalcTNred: q10 = ',q10
853 write(nerrout_coli,fmt10)
' CalcTNred: q21 = ',q21
854 write(nerrout_coli,fmt10)
' CalcTNred: q32 = ',q32
855 write(nerrout_coli,fmt10)
' CalcTNred: q43 = ',q43
856 write(nerrout_coli,fmt10)
' CalcTNred: q54 = ',q54
857 write(nerrout_coli,fmt10)
' CalcTNred: q50 = ',q50
858 write(nerrout_coli,fmt10)
' CalcTNred: q20 = ',q10
859 write(nerrout_coli,fmt10)
' CalcTNred: q31 = ',q31
860 write(nerrout_coli,fmt10)
' CalcTNred: q42 = ',q42
861 write(nerrout_coli,fmt10)
' CalcTNred: q53 = ',q53
862 write(nerrout_coli,fmt10)
' CalcTNred: q40 = ',q40
863 write(nerrout_coli,fmt10)
' CalcTNred: q51 = ',q51
864 write(nerrout_coli,fmt10)
' CalcTNred: q30 = ',q30
865 write(nerrout_coli,fmt10)
' CalcTNred: q41 = ',q41
866 write(nerrout_coli,fmt10)
' CalcTNred: q52 = ',q52
867 write(nerrout_coli,fmt10)
' CalcTNred: mm02 = ',mm02
868 write(nerrout_coli,fmt10)
' CalcTNred: mm12 = ',mm12
869 write(nerrout_coli,fmt10)
' CalcTNred: mm22 = ',mm22
870 write(nerrout_coli,fmt10)
' CalcTNred: mm32 = ',mm32
871 write(nerrout_coli,fmt10)
' CalcTNred: mm42 = ',mm42
872 write(nerrout_coli,fmt10)
' CalcTNred: mm52 = ',mm52
873 write(nerrout_coli,fmt10)
' CalcTNred: gram = ',gramdet/det
884 write(*,*)
'Tnred mn err',tnm1err(1:5,r)
885 write(*,*)
'Tnred coef err', (maxval(abs(mx0kinv(1:5,k))),k=1,5)
886 write(*,*)
'Tnred err',tnerr(r+1)