43 integer,
intent(in) :: rmax
44 double complex,
intent(in) :: m02
45 double complex,
intent(in) :: A(0:rmax/2),A2(0:rmax/2)
46 double precision,
intent(in) :: norm0
47 double precision,
intent(out) :: Adiff(0:rmax)
48 double complex :: diffA
49 double precision :: norm,ratio
54 character(len=*),
parameter :: fmt1 =
"(A5,'dcmplx(',d25.18,' ,',d25.18,' )')"
55 character(len=*),
parameter :: fmt2 = &
56 "(A6,' A(',i1,') = (',E23.16,' , ',E23.16,' )')"
71 norm = norm0*abs(m02)**(n0)
76 adiff(2*n0) = max(adiff(2*n0),abs(diffa))
77 if ((abs(diffa).gt.
checkacc_cll*norm).and.(flag.eq.1))
then
78 write(
ncheckout_cll,*)
'*************************************************************************'
81 write(
ncheckout_cll,
'(A21,I2,A4,I2)')
'A integral with rank', 2*n0,
' of ',rmax
82 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
99 write(
ncheckout_cll,*)
'------------------------------------------------------------'
101 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
108 ratio=abs(diffa)/norm
109 elseif((flag.eq.2).and.(abs(diffa).gt.ratio*norm))
then
113 ratio=abs(diffa)/norm
115 elseif ((abs(diffa).gt.
checkacc_cll*norm).and.(flag.eq.0))
then
120 write(
ncheckout_cll,*)
'*************************************************************************'
125 write(
ncheckout_cll,*)
' Further output for differences in A functions suppressed '
128 elseif(flag.eq.3)
then
146 integer,
intent(in) :: rmax
147 double complex,
intent(in) :: p10,m02,m12
148 double complex,
intent(in) :: B(0:rmax/2,0:rmax),B2(0:rmax/2,0:rmax)
149 double precision,
intent(in) :: norm0
150 double precision,
intent(out) :: Bdiff(0:rmax)
151 double complex :: diffB
152 double precision :: norm,ratio
153 integer :: r,n0,n1,i,flag
157 character(len=*),
parameter :: fmt1 =
"(A6,'dcmplx(',d25.18,' ,',d25.18,' )')"
158 character(len=*),
parameter :: fmt2 = &
159 "(A6,' B(',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
175 if (max(abs(p10),abs(m02),abs(m12)).ne.0d0)
then
176 norm = norm0*max(abs(p10),abs(m02),abs(m12))**n0
180 diffb = b(n0,n1)-b2(n0,n1)
181 if (n0.eq.0) bdiff(r) = max(bdiff(r),abs(diffb))
182 if ((abs(diffb).gt.
checkacc_cll*norm).and.(flag.eq.1))
then
183 write(
ncheckout_cll,*)
'*************************************************************************'
186 write(
ncheckout_cll,
'(A21,I2,A4,I2)')
'B integral with rank', r,
' of ',rmax
187 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
204 write(
ncheckout_cll,*)
'------------------------------------------------------------'
211 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
222 ratio=abs(diffb)/norm
223 elseif((flag.eq.2).and.(abs(diffb).gt.ratio*norm))
then
227 ratio=abs(diffb)/norm
228 elseif ((abs(diffb).gt.
checkacc_cll*norm).and.(flag.eq.0))
then
234 write(
ncheckout_cll,*)
'*************************************************************************'
239 write(
ncheckout_cll,*)
' Further output for differences in B functions suppressed '
242 elseif(flag.eq.3)
then
258 subroutine checkcoefsc_cll(C,C2,p10,p21,p20,m02,m12,m22,rmax,norm0,Cdiff)
260 integer,
intent(in) :: rmax
261 double complex,
intent(in) :: p10,p21,p20,m02,m12,m22
262 double complex,
intent(in) :: C(0:rmax/2,0:rmax,0:rmax),C2(0:rmax/2,0:rmax,0:rmax)
263 double precision,
intent(in) :: norm0
264 double precision,
intent(out) :: Cdiff(0:rmax)
265 double complex :: diffC
266 double precision :: norm,ratio
267 integer :: r,n0,n1,n2,i,flag
271 character(len=*),
parameter :: fmt1 =
"(A5,'dcmplx(',d25.18,' ,',d25.18,' )')"
272 character(len=*),
parameter :: fmt2 = &
273 "(A6,' C(',i1,',',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
290 norm = norm0/norm0**n0
291 diffc = c(n0,n1,n2)-c2(n0,n1,n2)
292 if (n0.eq.0) cdiff(r) = max(cdiff(r),abs(diffc))
293 if ((abs(diffc).gt.
checkacc_cll*norm).and.(flag.eq.1))
then
294 write(
ncheckout_cll,*)
'*************************************************************************'
297 write(
ncheckout_cll,
'(A21,I2,A4,I2)')
'C integral with rank', r,
' of ',rmax
302 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
319 write(
ncheckout_cll,*)
'------------------------------------------------------------'
326 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
337 ratio=abs(diffc)/norm
338 elseif((flag.eq.2).and.(abs(diffc).gt.ratio*norm))
then
342 ratio=abs(diffc)/norm
343 elseif ((abs(diffc).gt.
checkacc_cll*norm).and.(flag.eq.0))
then
350 write(
ncheckout_cll,*)
'*************************************************************************'
355 write(
ncheckout_cll,*)
' Further output for differences in C functions suppressed '
358 elseif(flag.eq.3)
then
376 m02,m12,m22,m32,rmax,norm0,Ddiff)
378 integer,
intent(in) :: rmax
379 double complex,
intent(in) :: p10,p21,p32,p30,p20,p31,m02,m12,m22,m32
380 double complex,
intent(in) :: D(0:rmax/2,0:rmax,0:rmax,0:rmax)
381 double complex,
intent(in) :: D2(0:rmax/2,0:rmax,0:rmax,0:rmax)
382 double precision,
intent(in) :: norm0
383 double precision,
intent(out) :: Ddiff(0:rmax)
384 double complex :: diffD
385 double precision :: norm,ratio
386 integer :: r,n0,n1,n2,n3,i,flag
390 character(len=*),
parameter :: fmt1 =
"(A5,'dcmplx(',d25.18,' ,',d25.18,' )')"
391 character(len=*),
parameter :: fmt2 = &
392 "(A6,' D(',i1,',',i1,',',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
410 norm = norm0/sqrt(norm0)**n0
411 diffd = d(n0,n1,n2,n3)-d2(n0,n1,n2,n3)
412 if (n0.eq.0) ddiff(r) = max(ddiff(r),abs(diffd))
413 if ((abs(diffd).gt.
checkacc_cll*norm).and.(flag.eq.1))
then
414 write(
ncheckout_cll,*)
'*************************************************************************'
417 write(
ncheckout_cll,
'(A21,I2,A4,I2)')
'D integral with rank', r,
' of ',rmax
423 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
440 write(
ncheckout_cll,*)
'------------------------------------------------------------'
451 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
462 ratio=abs(diffd)/norm
468 elseif((flag.eq.2).and.(abs(diffd).gt.ratio*norm))
then
471 if(norm.gt.1d-100)
then
473 ratio=abs(diffd)/norm
478 elseif ((abs(diffd).gt.
checkacc_cll*norm).and.(flag.eq.0))
then
486 write(
ncheckout_cll,*)
'*************************************************************************'
491 write(
ncheckout_cll,*)
' Further output for differences in D functions suppressed '
494 elseif(flag.eq.3)
then
513 subroutine checkcoefse_cll(E,E2,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
514 m02,m12,m22,m32,m42,rmax,norm0,Ediff)
516 integer,
intent(in) :: rmax
517 double complex,
intent(in) :: p10,p21,p32,p43,p40,p20,p31,p42,p30,p41
518 double complex,
intent(in) :: m02,m12,m22,m32,m42
519 double complex,
intent(in) :: E(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
520 double complex,
intent(in) :: E2(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
521 double precision,
intent(in) :: norm0
522 double precision,
intent(out) :: Ediff(0:rmax)
523 double complex :: Gram(4,4),diffE
524 double complex :: Ep(BinomTable(rmax,rmax+3)),Ep2(BinomTable(rmax,rmax+3)),diffEp(BinomTable(rmax,rmax+3))
525 double precision :: norm,ratio
527 integer :: r,n0,n1,n2,n3,n4,m0,m1,m2,m3,m4,i,flag,flagEc
528 integer :: struc1(BinomTable(rmax,rmax+3),0:4), struc2(0:4)
532 double complex :: LoCons(0:rmax/2,BinomTable(rmax,rmax+3),0:rmax/2,BinomTable(rmax,rmax+3),0:rmax)
535 character(len=*),
parameter :: fmt1 =
"(A5,'dcmplx(',d25.18,',',d25.18,' )')"
536 character(len=*),
parameter :: fmt2 = &
537 "(A6,' E(',i1,',',i1,',',i1,',',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
538 character(len=*),
parameter :: fmt3 = &
539 "(A6,' E*T(',i1,',',i1,',',i1,',',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
540 character(len=*),
parameter :: fmt4 = &
541 "(A6,' E(',i1,',',i1,',',i1,',',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
561 norm = norm0/norm0**(n0/3d0)
562 diffe = e(n0,n1,n2,n3,n4)-e2(n0,n1,n2,n3,n4)
563 if (n0.eq.0) ediff(r)=max(ediff(r),abs(diffe))
564 if ((abs(diffe).gt.
checkacc_cll*norm).and.(flagec.eq.1))
then
565 write(
ncheckout_cll,*)
'*************************************************************************'
568 write(
ncheckout_cll,
'(A21,I2,A4,I2)')
'E integral with rank', r,
' of ',rmax
575 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
592 write(
ncheckout_cll,*)
'------------------------------------------------------------'
608 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
609 write(
ncheckout_cll,fmt2)
'COLI:',0,0,0,0,0,e(0,0,0,0,0)
610 write(
ncheckout_cll,fmt2)
'DD :',0,0,0,0,0,e2(0,0,0,0,0)
611 write(
ncheckout_cll,fmt2)
'COLI:',n0,n1,n2,n3,n4,e(n0,n1,n2,n3,n4)
612 write(
ncheckout_cll,fmt2)
'DD :',n0,n1,n2,n3,n4,e2(n0,n1,n2,n3,n4)
615 ratio=abs(diffe)/norm
616 elseif((flagec.eq.2).and.(abs(diffe).gt.ratio*norm))
then
617 write(
ncheckout_cll,fmt2)
'COLI:',n0,n1,n2,n3,n4,e(n0,n1,n2,n3,n4)
618 write(
ncheckout_cll,fmt2)
'DD :',n0,n1,n2,n3,n4,e2(n0,n1,n2,n3,n4)
620 ratio=abs(diffe)/norm
621 elseif ((abs(diffe).gt.
checkacc_cll*norm).and.(flagec.eq.0))
then
629 if((flagec.eq.2))
then
630 write(
ncheckout_cll,*)
'*************************************************************************'
635 write(
ncheckout_cll,*)
' Further output for differences Ec in E functions suppressed '
638 elseif(flagec.eq.3)
then
653 gram(1,2) = (p10+p20-p21)*.5d0
654 gram(1,3) = (p10+p30-p31)*.5d0
655 gram(1,4) = (p10+p40-p41)*.5d0
656 gram(2,3) = (p20+p30-p32)*.5d0
657 gram(2,4) = (p20+p40-p42)*.5d0
658 gram(3,4) = (p30+p40-p43)*.5d0
659 gram(2,1) = gram(1,2)
660 gram(3,1) = gram(1,3)
661 gram(4,1) = gram(1,4)
662 gram(3,2) = gram(2,3)
663 gram(4,2) = gram(2,4)
664 gram(4,3) = gram(3,4)
673 norm = norm0/norm0**((r-m0)/3d0)
676 do i1=1,binomtable(r-2*m0,3+r-2*m0)
677 struc1(i1,1:4)=calccindarr(4,r-2*m0,i1)
682 do i2=1,binomtable(r-2*n0,3+r-2*n0)
683 struc2(1:4)=calccindarr(4,r-2*n0,i2)
685 + e(n0,struc2(1),struc2(2),struc2(3),struc2(4))* &
686 locons(m0,i1,n0,i2,r)
688 + e2(n0,struc2(1),struc2(2),struc2(3),struc2(4))* &
689 locons(m0,i1,n0,i2,r)
693 norm = max(norm,min(abs(ep(i1)),abs(ep2(i1))))
694 diffep(i1) = ep(i1)-ep2(i1)
697 do i1=1,binomtable(r-2*m0,3+r-2*m0)
698 ediff(r) = max(ediff(r),abs(diffep(i1))/norm)
700 if ((abs(diffep(i1)).gt.
checkacc_cll*norm).and.(flag.eq.1))
then
701 write(
ncheckout_cll,*)
'*************************************************************************'
704 write(
ncheckout_cll,
'(A21,I2,A4,I2)')
'E integral with rank', r,
' of ',rmax
705 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
722 write(
ncheckout_cll,*)
'------------------------------------------------------------'
738 write(
ncheckout_cll,*)
'--------------------------------------------------------------------------'
739 write(
ncheckout_cll,fmt4)
'COLI:',0,0,0,0,0,e(0,0,0,0,0)
740 write(
ncheckout_cll,fmt4)
'DD :',0,0,0,0,0,e2(0,0,0,0,0)
752 ratio=abs(diffep(i1))/norm
753 elseif((flag.eq.2).and.(abs(diffep(i1)).gt.ratio*norm))
then
758 ratio=abs(diffep(i1))/norm
759 elseif ((abs(diffep(i1)).gt.
checkacc_cll*norm).and.(flag.eq.0))
then
768 write(
ncheckout_cll,*)
'*************************************************************************'
773 write(
ncheckout_cll,*)
' Further output for differences in E functions suppressed '
776 elseif(flag.eq.3)
then
793 subroutine checkcoefsf_cll(F,F2,p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40, &
794 p51,p30,p41,p52,m02,m12,m22,m32,m42,m52,rmax,norm0,Fdiff)
796 integer,
intent(in) :: rmax
797 double complex,
intent(in) :: p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40
798 double complex,
intent(in) :: p51,p30,p41,p52,m02,m12,m22,m32,m42,m52
799 double complex,
intent(in) :: F(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
800 double complex,
intent(in) :: F2(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
801 double precision,
intent(in) :: norm0
802 double precision,
intent(out) :: Fdiff(0:rmax)
803 double complex :: diffF,Gram(5,5)
804 double complex :: Fp(BinomTable(rmax,rmax+4)),Fp2(BinomTable(rmax,rmax+4)),diffFp(BinomTable(rmax,rmax+4))
806 double precision :: norm,ratio
807 integer :: r,n0,n1,n2,n3,n4,n5,m0,m1,m2,m3,m4,m5,i,flag,flag2
808 integer :: struc1(BinomTable(rmax,rmax+4),0:5), struc2(0:5)
812 double complex :: LoCons(0:rmax/2,BinomTable(rmax,rmax+4),0:rmax/2,BinomTable(rmax,rmax+4),0:rmax)
815 character(len=*),
parameter :: fmt1 =
"(A5,'dcmplx(',d25.18,',',d25.18,' )')"
816 character(len=*),
parameter :: fmt2 = &
817 "(A6,' F(',i1,',',i1,',',i1,',',i1,',',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
818 character(len=*),
parameter :: fmt3 = &
819 "(A6,' F*T(',i1,',',i1,',',i1,',',i1,',',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
820 character(len=*),
parameter :: fmt4 = &
821 "(A6,' F(',i1,',',i1,',',i1,',',i1,',',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
840 do n4=0,r-2*n0-n1-n2-n3
841 n5 = r-2*n0-n1-n2-n3-n4
843 norm = norm0/norm0**(n0/4d0)
844 difff = f(n0,n1,n2,n3,n4,n5)-f2(n0,n1,n2,n3,n4,n5)
845 if (n0.eq.0) fdiff(r) = max(fdiff(r),abs(difff))
846 if ((abs(difff).gt.
checkacc_cll*norm).and.(flag2.eq.1))
then
847 write(
ncheckout_cll,*)
'*************************************************************************'
850 write(
ncheckout_cll,
'(A21,I2,A4,I2)')
'F integral with rank', r,
' of ',rmax
858 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
875 write(
ncheckout_cll,*)
'------------------------------------------------------------'
897 write(
ncheckout_cll,*)
'--------------------------------------------------------------------------'
900 write(
ncheckout_cll,fmt2)
'COLI:',0,0,0,0,0,0,f(0,0,0,0,0,0)
901 write(
ncheckout_cll,fmt2)
'DD :',0,0,0,0,0,0,f2(0,0,0,0,0,0)
902 write(
ncheckout_cll,fmt2)
'COLI:',n0,n1,n2,n3,n4,n5,f(n0,n1,n2,n3,n4,n5)
903 write(
ncheckout_cll,fmt2)
'DD :',n0,n1,n2,n3,n4,n5,f2(n0,n1,n2,n3,n4,n5)
908 ratio=abs(difff)/norm
909 elseif((flag2.eq.2).and.(abs(difff).gt.ratio*norm))
then
910 write(
ncheckout_cll,fmt2)
'COLI:',n0,n1,n2,n3,n4,n5,f(n0,n1,n2,n3,n4,n5)
911 write(
ncheckout_cll,fmt2)
'DD :',n0,n1,n2,n3,n4,n5,f2(n0,n1,n2,n3,n4,n5)
913 ratio=abs(difff)/norm
914 elseif ((abs(difff).gt.
checkacc_cll*norm).and.(flag.eq.0))
then
935 gram(1,2) = (p10+p20-p21)*.5d0
936 gram(1,3) = (p10+p30-p31)*.5d0
937 gram(1,4) = (p10+p40-p41)*.5d0
938 gram(1,5) = (p10+p50-p51)*.5d0
939 gram(2,3) = (p20+p30-p32)*.5d0
940 gram(2,4) = (p20+p40-p42)*.5d0
941 gram(2,5) = (p20+p50-p52)*.5d0
942 gram(3,4) = (p30+p40-p43)*.5d0
943 gram(3,5) = (p30+p50-p53)*.5d0
944 gram(4,5) = (p40+p50-p54)*.5d0
945 gram(2,1) = gram(1,2)
946 gram(3,1) = gram(1,3)
947 gram(4,1) = gram(1,4)
948 gram(5,1) = gram(1,5)
949 gram(3,2) = gram(2,3)
950 gram(4,2) = gram(2,4)
951 gram(5,2) = gram(2,5)
952 gram(4,3) = gram(3,4)
953 gram(5,3) = gram(3,5)
954 gram(5,4) = gram(4,5)
963 norm = norm0/norm0**((r-m0)/4d0)
966 do i1=1,binomtable(r-2*m0,4+r-2*m0)
967 struc1(i1,1:5)=calccindarr(5,r-2*m0,i1)
972 do i2=1,binomtable(r-2*n0,4+r-2*n0)
973 struc2(1:5)=calccindarr(5,r-2*n0,i2)
975 + f(n0,struc2(1),struc2(2),struc2(3),struc2(4),struc2(5))* &
976 locons(m0,i1,n0,i2,r)
978 + f2(n0,struc2(1),struc2(2),struc2(3),struc2(4),struc2(5))* &
979 locons(m0,i1,n0,i2,r)
983 norm = max(norm,min(abs(fp(i1)),abs(fp2(i1))))
984 difffp(i1) = fp(i1)-fp2(i1)
987 do i1=1,binomtable(r-2*m0,4+r-2*m0)
988 fdiff(r) = max(fdiff(r),abs(difffp(i1))/norm)
990 if ((abs(difffp(i1)).gt.
checkacc_cll*norm).and.(flag.eq.1))
then
991 write(
ncheckout_cll,*)
'*************************************************************************'
994 write(
ncheckout_cll,
'(A21,I2,A4,I2)')
'F integral with rank', r,
' of ',rmax
995 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
1012 write(
ncheckout_cll,*)
'------------------------------------------------------------'
1034 write(
ncheckout_cll,*)
'--------------------------------------------------------------------------'
1035 write(
ncheckout_cll,fmt4)
'COLI:',0,0,0,0,0,0,f(0,0,0,0,0,0)
1036 write(
ncheckout_cll,fmt4)
'DD :',0,0,0,0,0,0,f2(0,0,0,0,0,0)
1048 ratio=abs(difffp(i1))/norm
1049 elseif((flag.eq.2).and.(abs(difffp(i1)).gt.ratio*norm))
then
1058 ratio=abs(difffp(i1))/norm
1059 elseif ((abs(difffp(i1)).gt.
checkacc_cll*norm).and.(flag.eq.0))
then
1069 write(
ncheckout_cll,*)
'***************************************************************************'
1074 write(
ncheckout_cll,*)
' Further output for differences in F functions suppressed '
1077 elseif(flag.eq.3)
then
1095 integer,
intent(in) :: N,rmax
1096 double complex,
intent(in) :: MomInv(BinomTable(2,N)), masses2(0:N-1)
1097 double complex,
intent(in) :: TN(NCoefs(rmax,N))
1098 double complex,
intent(in) :: TN2(NCoefs(rmax,N))
1099 double precision,
intent(in) :: norm0
1100 double precision,
intent(out) :: TNdiff(0:rmax)
1101 double complex :: diffTN,Gram(N-1,N-1)
1102 double complex :: TNp(BinomTable(rmax,rmax+N-2)),TNp2(BinomTable(rmax,rmax+N-2)),diffTNp(BinomTable(rmax,rmax+N-2))
1103 double precision :: norm,ratio
1105 integer :: ind,i,m0,n0,ncnt,r,ncntr,flag,flag2
1108 double complex,
allocatable :: LoCons(:,:,:,:,:)
1110 character(len=*),
parameter :: fmt1 =
"(A8,'(',i2,')=dcmplx(',d25.18,',',d25.18,' )')"
1111 character(len=*),
parameter :: fmt2 = &
1112 "(A6,' TN(',i2,') = (',E23.16,' , ',E23.16,' ), r=',i2)"
1113 character(len=*),
parameter :: fmt3 = &
1114 "(A6,' TN*T(',i1,',',i2,') = (',E23.16,' , ',E23.16,' ), r=',i2)"
1115 character(len=*),
parameter :: fmt4 = &
1116 "(A6,' TN(',i2,') = (',E23.16,' , ',E23.16,' )')"
1141 do i2=1,binomtable(r-2*n0,n+r-2*n0-2)
1147 norm = norm0/norm0**(n0/real(n-2))
1149 if (max(abs(mominv(1)),abs(masses2(0)),abs(masses2(1))).ne.0d0)
then
1150 norm = norm0*max(abs(mominv(1)),abs(masses2(0)),abs(masses2(1)))**n0
1156 difftn = tn(ind)-tn2(ind)
1157 if (n0.eq.0) tndiff(r) = max(tndiff(r),abs(difftn))
1158 if ((abs(difftn).gt.
checkacc_cll*norm) .and.(flag.eq.1))
then
1159 write(
ncheckout_cll,*)
'***************************************************************************'
1162 write(
ncheckout_cll,
'(A21,I2,A10,I2,A4,I2)')
'TN integral with N =', n,
' and rank ', r,
' of ',rmax
1163 write(
ncheckout_cll,*)
'---------------------------------------------------------------------------'
1180 write(
ncheckout_cll,*)
'---------------------------------------------------------------------------'
1181 do i=1,binomtable(2,n)
1187 write(
ncheckout_cll,*)
'---------------------------------------------------------------------------'
1196 ratio=abs(difftn)/norm
1202 elseif((flag.eq.2).and.(abs(difftn).gt.ratio*norm))
then
1205 if(norm.gt.1d-100)
then
1207 ratio=abs(difftn)/norm
1212 elseif ((flag.eq.0).and.(abs(difftn).gt.
checkacc_cll*norm))
then
1225 allocate(locons(0:rmax/2,binomtable(rmax,rmax+n-2),0:rmax/2,binomtable(rmax,rmax+n-2),0:rmax))
1233 norm = norm0/norm0**((r-m0)/real(n-2))
1239 do i1=1,binomtable(r-2*m0,n+r-2*m0-2)
1244 do i2=1,binomtable(r-2*n0,n+r-2*n0-2)
1246 tnp(i1) = tnp(i1) + tn(ncnt)*locons(m0,i1,n0,i2,r)
1247 tnp2(i1) = tnp2(i1) + tn2(ncnt)*locons(m0,i1,n0,i2,r)
1250 norm = max(norm,min(abs(tnp(i1)),abs(tnp2(i1))))
1251 difftnp(i1) = tnp(i1)-tnp2(i1)
1254 do i1=1,binomtable(r-2*m0,n+r-2*m0-2)
1255 tndiff(r) = max(tndiff(r),abs(difftnp(i1))/norm)
1257 if ((abs(difftnp(i1)).gt.
checkacc_cll*norm).and.(flag.eq.1))
then
1258 write(
ncheckout_cll,*)
'***************************************************************************'
1261 write(
ncheckout_cll,
'(A21,I2,A10,I2,A4,I2)')
'TN integral with N =', n,
' and rank ', r,
' of ',rmax
1262 write(
ncheckout_cll,*)
'---------------------------------------------------------------------------'
1279 write(
ncheckout_cll,*)
'---------------------------------------------------------------------------'
1280 do i=1,binomtable(2,n)
1286 write(
ncheckout_cll,*)
'---------------------------------------------------------------------------'
1297 ratio=abs(difftnp(i1))/norm
1298 elseif((flag.eq.2).and.(abs(difftnp(i1)).gt.ratio*norm))
then
1303 ratio=abs(difftnp(i1))/norm
1304 elseif ((flag.eq.0).and.(abs(difftnp(i1)).gt.
checkacc_cll*norm))
then
1311 tndiff = tndiff*norm0
1315 write(
ncheckout_cll,*)
'*************************************************************************'
1320 write(
ncheckout_cll,*)
' Further output for differences in TN functions suppressed '
1323 else if (flag.eq.3)
then
1341 integer,
intent(in) :: r
1342 double complex,
intent(in) :: p10,m02,m12
1343 double complex,
intent(in) :: DB,DB2
1344 double complex :: diffB
1345 double precision :: norm
1350 character(len=*),
parameter :: fmt1 =
"(A5,'dcmplx(',g25.18,',',g25.18,' )')"
1361 norm = min(abs(db),abs(db2))
1365 write(
ncheckout_cll,*)
'*************************************************************************'
1376 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
1380 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
1383 write(
ncheckout_cll,*)
'*************************************************************************'
1389 write(
ncheckout_cll,*)
' Further output for differences in DB functions suppressed '
1407 integer,
intent(in) :: rmax
1408 double complex,
intent(in) :: p10,m02,m12
1409 double complex,
intent(in) :: DB(0:rmax/2,0:rmax),DB2(0:rmax/2,0:rmax)
1410 double precision,
intent(in) :: norm0
1411 double precision,
intent(out) :: DBdiff(0:rmax)
1412 double complex :: diffDB
1413 double precision :: norm,ratio
1414 integer :: r,n0,n1,i
1419 character(len=*),
parameter :: fmt1 =
"(A6,'dcmplx(',d25.18,' ,',d25.18,' )')"
1420 character(len=*),
parameter :: fmt2 = &
1421 "(A6,' DB(',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
1439 norm = norm0/norm0**n0
1440 diffdb = db(n0,n1)-db2(n0,n1)
1441 if (n0.eq.0) dbdiff(r) = max(dbdiff(r),abs(diffdb))
1442 if ((abs(diffdb).gt.
checkacc_cll*norm).and.(flag.eq.1))
then
1443 write(
ncheckout_cll,*)
'*************************************************************************'
1446 write(
ncheckout_cll,
'(A21,I2,A4,I2)')
'DB integral with rank', r,
' of ',rmax
1447 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
1464 write(
ncheckout_cll,*)
'------------------------------------------------------------'
1471 write(
ncheckout_cll,*)
'-------------------------------------------------------------------------'
1482 ratio=abs(diffdb)/norm
1483 elseif((flag.eq.2).and.(abs(diffdb).gt.ratio*norm))
then
1487 ratio=abs(diffdb)/norm
1488 elseif ((abs(diffdb).gt.
checkacc_cll*norm).and.(flag.eq.0))
then
1494 write(
ncheckout_cll,*)
'*************************************************************************'
1499 write(
ncheckout_cll,*)
' Further output for differences in B functions suppressed '
1502 elseif(flag.eq.3)
then
1556 character(len=*),
intent(in) :: sub, err
1557 logical,
intent(out) :: flag
1558 logical,
optional,
intent(in) :: nomaster
1570 write(
nerrout_cll,*)
'***********************************************************'
1575 if (
present(nomaster))
then
1583 write(
nerrout_cll,*)
'***********************************************************'
1585 write(
nerrout_cll,*)
' Further output of Errors will be suppressed '
1603 character(len=*),
intent(in) :: sub
1604 double precision,
intent(in) :: acc
1605 integer,
intent(in) :: N
1611 write(
ncpout_cll,*)
'***********************************************************'
1612 write(
ncpout_cll,
'(A19,I6)')
'Critical Point NO.', cntr
1615 'in integral: ', trim(sub),
', N = ',n
1617 write(
ncpout_cll,*)
'in integral: ', trim(sub)
1619 write(
ncpout_cll,*)
'estimated accuracy: ', acc
1620 write(
ncpout_cll,*)
'-----------------------------------------------------------'
1651 character(len=*),
intent(in) :: sub
1652 double precision,
intent(in) :: acc
1653 integer,
intent(in) :: N
1659 write(
ncpout2_cll,*)
'***********************************************************'
1660 write(
ncpout2_cll,
'(A19,I6)')
'Critical Point NO.', cntr
1663 'in integral: ', trim(sub),
', N = ',n
1668 write(
ncpout2_cll,*)
'-----------------------------------------------------------'
1702 101
format(
' #calls ',a9,
' = ',i20)
1703 102
format(
' #calls ',a9,
' (N = ',i1,
') = ',i20)
1704 111
format(
' #calls ',a9,
' = ',i20,
' or ',f10.5,
' %')
1705 112
format(
' #calls ',a9,
' (N = ',i1,
') = ',i20,
' or ',f10.5,
' %')
1709 write(
ninfout_cll,*)
'COLLIER: CritPointsMonitor not initialized'
1715 write(
ninfout_cll,*)
'COLLIER: Output for critical points switched off'
1721 90
format (//
' Collier: Summary of critical points:')
1724 100
format (/
' Total numbers of calls of COLLIER functions')
1781 110
format (/
' Numbers of calls of COLLIER functions'/ &
1782 ' with an estimated accuracy worse than reqacc_coli =',es11.4)
1844 130
format (/
' Numbers of calls of COLLIER functions'/ &
1845 ' with an estimated accuracy worse than '/ &
1846 ' sqrt(reqacc_coli) =',es11.4)
1850 120
format (/
' Numbers of calls of COLLIER functions'/ &
1851 ' with an estimated accuracy worse than critacc_coli =',es11.4)
1917 290
format (//
' Collier: Summary of COLI/DD use in mode 3:')
1920 300
format (/
' Total numbers of uses of COLI functions')
1997 210
format (/
' Total numbers of uses of DD functions')
2074 220
format (/
' Total numbers of calls of COLI/DD functions')
2137 320
format (/
' Numbers of comparisons of functions between COLI and DD')
2154 330
format (/
' Numbers of calls of COLLIER functions'/ &
2155 ' with difference between COLI and DD > checkacc_cll =',es11.4)
2185 401
format(
' #calls all ',
' = ',i20)
2186 411
format(
' #calls with errors of level ',i3,
' = ',i20,
' or ',f10.5,
' %')
2187 421
format(
' #events all ',
' = ',i20)
2188 431
format(
' #events with errors of level ',i3,
' = ',i20,
' or ',f10.5,
' %')
2191 400
format (/
' Numbers of errors in COLI functions')
2198 405
format (/
' Numbers of errors in DD functions')
2205 410
format (/
' Numbers of errors in COLLIER functions')
2212 415
format (/
' Numbers of errors in Events')
2219 501
format(
' #calls all ',
' = ',i20)
2220 511
format(
' #calls with accuracy of level ',i3,
' = ',i20,
' or ',f10.5,
' %')
2221 521
format(
' #events all ',
' = ',i20)
2222 531
format(
' #events with accuracy of level ',i3,
' = ',i20,
' or ',f10.5,
' %')
2225 510
format (/
' Numbers of COLLIER calls with accuracy levels')
2232 500
format (/
' Numbers of Events with accuracy levels')
2256 101
format(
' #calls ',a9,
' = ',i20)
2257 102
format(
' #calls ',a9,
' (N = ',i1,
') = ',i20)
2258 111
format(
' #calls ',a9,
' = ',i20,
' or ',f10.5,
' %')
2259 112
format(
' #calls ',a9,
' (N = ',i1,
') = ',i20,
' or ',f10.5,
' %')
2263 write(
ninfout_cll,*)
'COLLIER: CritPointsMonitor not initialized'
2272 90
format (//
' Collier: Summary of critical points:')
2275 100
format (/
' Total numbers of calls of COLLIER functions')
2332 110
format (/
' Numbers of calls of COLLIER functions'/ &
2333 ' with an estimated accuracy worse than reqacc_coli =',es11.4)
2392 130
format (/
' Numbers of calls of COLLIER functions'/ &
2393 ' with an estimated accuracy worse than '/ &
2394 ' sqrt(reqacc_coli) =',es11.4)
2398 120
format (/
' Numbers of calls of COLLIER functions'/ &
2399 ' with an estimated accuracy worse than critacc_coli =',es11.4)
2460 501
format(
' #calls all ',
' = ',i20)
2461 511
format(
' #calls with accuracy of level ',i3,
' = ',i20,
' or ',f10.5,
' %')
2462 521
format(
' #events all ',
' = ',i20)
2463 531
format(
' #events with accuracy of level ',i3,
' = ',i20,
' or ',f10.5,
' %')
2466 510
format (/
' Numbers of COLLIER calls with accuracy levels')
2473 500
format (/
' Numbers of Events with accuracy levels')
2494 recursive function contractlostruc(Nm1,struc1,struc2,Gram)
result(res)
2496 integer,
intent(in) :: nm1
2497 integer,
intent(in) :: struc1(0:nm1), struc2(0:nm1)
2498 integer :: struc1aux(0:nm1), struc2aux(0:nm1), struc2aux2(0:nm1)
2499 double complex,
intent(in) :: gram(nm1,nm1)
2500 double complex :: res
2501 integer :: i,j,con,sum1,sum2,fac
2502 logical :: errorwriteflag,eflag
2509 sum1 = sum1 + struc1(i)
2510 sum2 = sum2 + struc2(i)
2513 if (sum1.ne.sum2)
then
2515 call errout_cll(
'ContractLoStruc',
' inconsistent call',eflag)
2517 write(
nerrout_cll,*)
' ContractLoStruc: Lorentz structures struc1 and struc2 must be of equal rank!'
2529 if (struc1(i).ge.1)
then
2535 struc1aux(con) = struc1aux(con)-1
2540 if (struc2(0).ge.1)
then
2542 struc2aux(0) = struc2aux(0)-1
2543 struc2aux(con) = struc2aux(con)+1
2546 res = res + struc2aux(con)*
contractlostruc(nm1,struc1aux,struc2aux,gram)
2551 if (struc2(i).ge.1)
then
2553 struc2aux(i) = struc2aux(i)-1
2563 if (struc2(0).ge.1)
then
2565 struc2aux(0) = struc2aux(0)-1
2573 fac = fac + 2*struc2aux(i)
2581 if (struc2(i).ge.1)
then
2583 struc2aux(i) = struc2aux(i)-1
2585 if (struc2aux(j).ge.1)
then
2586 struc2aux2 = struc2aux
2587 struc2aux2(j) = struc2aux2(j)-1
2612 integer,
intent(in) :: nm1,rmax
2613 double complex,
intent(in) :: gram(nm1,nm1)
2614 double complex :: locons(0:rmax/2,binomtable(rmax,nm1+rmax-1),0:rmax/2,binomtable(rmax,nm1+rmax-1),0:rmax)
2615 integer :: struc1(0:nm1),struc2(0:nm1),struc2aux(0:nm1)
2616 integer :: r,i,j,i1,i2,i1aux,i2aux,i2aux2,n01,n02,con,fac,i20
2620 locons(0,1,0,1,0) = 1d0
2625 do i1=1,binomtable(r-2*n01,nm1+r-2*n01-1)
2626 struc1(1:nm1) = calccindarr(nm1,r-2*n01,i1)
2630 if (struc1(i).ge.1)
then
2636 i1aux = dropcind2(con,i1,r-2*n01,nm1)
2641 do i2=1,binomtable(r-2*n02,nm1+r-2*n02-1)
2642 struc2(1:nm1) = calccindarr(nm1,r-2*n02,i2)
2645 if (struc2(0).ge.1)
then
2647 i2aux = addtocind(con,i2,r-2*n02,nm1)
2648 locons(n01,i1,n02,i2,r) = locons(n01,i1,n02,i2,r) + &
2649 (struc2(con)+1)*locons(n01,i1aux,n02-1,i2aux,r-1)
2654 if (struc2(i).ge.1)
then
2655 i2aux = dropcind2(i,i2,r-2*n02,nm1)
2656 locons(n01,i1,n02,i2,r) = locons(n01,i1,n02,i2,r) + &
2657 gram(i,con)*locons(n01,i1aux,n02,i2aux,r-1)
2668 do i2=1,binomtable(r-2*n02,nm1+r-2*n02-1)
2669 struc2(1:nm1) = calccindarr(nm1,r-2*n02,i2)
2672 if (struc2(0).ge.1)
then
2680 fac = fac + 2*struc2(i)
2682 locons(n01,i1,n02,i2,r) = locons(n01,i1,n02,i2,r) + &
2683 fac*locons(n01-1,i1,n02-1,i2,r-2)
2688 if (struc2(i).ge.1)
then
2690 struc2aux(i) = struc2aux(i)-1
2691 i2aux = dropcind2(i,i2,r-2*n02,nm1)
2693 if (struc2aux(j).ge.1)
then
2694 i2aux2 = dropcind2(j,i2aux,r-2*n02,nm1)
2695 locons(n01,i1,n02,i2,r) = locons(n01,i1,n02,i2,r) + &
2696 gram(i,j)*locons(n01-1,i1,n02,i2aux2,r-2)
2722 function calcgram(N,MomInv)
result (Gram)
2724 integer,
intent(in) :: n
2725 double complex,
intent(in) :: mominv(binomtable(2,n))
2726 double complex :: mominvinf(binomtable(2,n)),elimminf2_coli
2727 double complex :: gram(n-1,n-1)
2731 do i=1,binomtable(2,n)
2732 mominvinf(i) = elimminf2_coli(mominv(i))
2738 gram(i,i) = mominvinf(cnt)
2742 gram(j-i,j) = mominvinf(cnt)
2745 if (cnt.gt.binomtable(2,n))
exit
2747 gram(n-i,n-i) = mominvinf(cnt)
2751 gram(j,n-i+j) = mominvinf(cnt)
2758 gram(i,j) = -(gram(i,j)-gram(i,i)-gram(j,j))/2d0
2759 gram(j,i) = gram(i,j)