1781 integer,
intent(in) :: rmax
1782 double complex,
intent(in) :: p10,p21,p32,p43,p40,p20,p31,p42,p30,p41
1783 double complex,
intent(in) :: m02,m12,m22,m32,m42
1784 double complex,
intent(out) :: E(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
1785 double complex,
intent(out) :: Euv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
1786 double precision,
optional,
intent(out) :: Eerr(0:rmax),Eerr2(0:rmax)
1787 double precision :: q10,q21,q32,q43,q40,q20,q31,q42,q30,q41
1788 double complex :: mm02,mm12,mm22,mm32,mm42
1789 double precision :: Eerraux(0:rmax),Eerr2aux(0:rmax),Ediff(0:rmax)
1790 integer,
optional,
intent(in) :: id_in
1791 double complex :: E2uv(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
1792 double complex :: E2(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
1793 double complex :: Edd(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
1794 double complex :: elimcminf2
1795 double complex :: args(15)
1796 integer :: n0,rank,errflag,id
1797 double precision :: accrelDD(0:rmax_DD),accabsDD(0:rmax_DD),Eacc(0:rmax),norm,norm_coli,norm_dd,Eacc2(0:rmax)
1798 double precision :: accrel2DD(0:rmax_DD),accabs2DD(0:rmax_DD)
1799 integer :: accflagDD,errflagDD,NDD,rankDD
1800 logical :: mflag,eflag
1801 integer :: r,n1,n2,n3,n4
1803 if (5.gt.nmax_cll) then
1804 call seterrflag_cll(-10)
1805 call errout_cll(
'E_cll',
'Nmax_cll smaller 5',eflag,.true.)
1806 write(nerrout_cll,*)
'Nmax_cll =',nmax_cll
1807 write(nerrout_cll,*)
'Reinitialize COLLIER with Nmax_cll >= 5'
1808 call propagateerrflag_cll
1811 if (rmax.gt.rmax_cll) then
1812 call seterrflag_cll(-10)
1813 call errout_cll(
'E_cll',
'argument rmax larger than rmax_cll',eflag,.true.)
1814 write(nerrout_cll,*)
'rmax =',rmax
1815 write(nerrout_cll,*)
'rmax_cll =',rmax_cll
1816 write(nerrout_cll,*)
'Reinitialize COLLIER with rmax_cll >= ',rmax
1817 call propagateerrflag_cll
1822 if (
present(id_in)) then
1846 call setmasterfname_cll(
'E_cll')
1847 call setmastern_cll(5)
1848 call setmasterr_cll(rmax)
1849 call setmasterargs_cll(15,args)
1851 call settencache_cll(never_tenred_cll)
1855 select case (mode_cll)
1861 call calce(e,euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
1862 m02,m12,m22,m32,m42,rmax,id,eerraux,eerr2aux)
1864 norm = abs(e(0,0,0,0,0))
1870 norm = max(norm,abs(e(0,n1,n2,n3,n4)))
1875 if (norm.eq.0d0) then
1876 norm = max(abs(p10),abs(p21),abs(p32),abs(p43),abs(p40), &
1877 abs(p20),abs(p31),abs(p42),abs(p30),abs(p41), &
1878 abs(m02),abs(m12),abs(m22),abs(m32),abs(m42))
1879 if(norm.ne.0d0) then
1882 norm=1d0/muir2_cll**3
1885 if (norm.ne.0d0) then
1887 eacc2 = eerr2aux/norm
1893 if (
present(eerr)) eerr = eerraux
1894 if (
present(eerr2)) eerr2 = eerr2aux
1896 if (mflag)
call propagateaccflag_cll(eacc,rmax)
1904 call seterrflag_cll(-10)
1905 call errout_cll(
'E_cll',
'rank higher than maximum rank implemented in DD library',eflag)
1907 write(nerrout_cll,*)
'E_cll: 5-point function of rank>5 not implemented in DD library'
1913 q10 = dreal(getminf2dd_cll(p10))
1914 q21 = dreal(getminf2dd_cll(p21))
1915 q32 = dreal(getminf2dd_cll(p32))
1916 q43 = dreal(getminf2dd_cll(p43))
1917 q40 = dreal(getminf2dd_cll(p40))
1918 q20 = dreal(getminf2dd_cll(p20))
1919 q31 = dreal(getminf2dd_cll(p31))
1920 q42 = dreal(getminf2dd_cll(p42))
1921 q30 = dreal(getminf2dd_cll(p30))
1922 q41 = dreal(getminf2dd_cll(p41))
1923 mm02 = getminf2dd_cll(m02)
1924 mm12 = getminf2dd_cll(m12)
1925 mm22 = getminf2dd_cll(m22)
1926 mm32 = getminf2dd_cll(m32)
1927 mm42 = getminf2dd_cll(m42)
1930 call e_dd(edd,q10,q21,q32,q43,q40,q20,q31,q42,q30,q41, &
1931 mm02,mm12,mm22,mm32,mm42,rank,id)
1932 e(0:rank/2,0:rank,0:rank,0:rank,0:rank) = edd(0:rank/2,0:rank,0:rank,0:rank,0:rank)
1935 call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
1936 if (
present(eerr)) eerr(0:rmax) = accabsdd(0:rmax)
1937 if (
present(eerr2)) eerr2(0:rmax) = accabs2dd(0:rmax)
1939 norm = abs(e(0,0,0,0,0))
1945 norm = max(norm,abs(e(0,n1,n2,n3,n4)))
1950 if (norm.eq.0d0) then
1951 norm = max(abs(p10),abs(p21),abs(p32),abs(p43),abs(p40), &
1952 abs(p20),abs(p31),abs(p42),abs(p30),abs(p41), &
1953 abs(m02),abs(m12),abs(m22),abs(m32),abs(m42))
1954 if(norm.ne.0d0) then
1957 norm=1d0/muir2_cll**3
1960 if (norm.ne.0d0) then
1961 eacc = accabsdd(0:rmax)/norm
1962 eacc2 = accabs2dd(0:rmax)/norm
1967 if (mflag)
call propagateaccflag_cll(eacc,rmax)
1979 call calce(e,euv,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
1980 m02,m12,m22,m32,m42,rmax,id,eerraux,eerr2aux)
1985 call seterrflag_cll(-10)
1986 call errout_cll(
'E_cll',
'rank higher than maximum rank implemented in DD library',eflag)
1988 write(nerrout_cll,*)
'E_cll: 5-point function of rank>5 not implemented in DD library'
1994 q10 = dreal(getminf2dd_cll(p10))
1995 q21 = dreal(getminf2dd_cll(p21))
1996 q32 = dreal(getminf2dd_cll(p32))
1997 q43 = dreal(getminf2dd_cll(p43))
1998 q40 = dreal(getminf2dd_cll(p40))
1999 q20 = dreal(getminf2dd_cll(p20))
2000 q31 = dreal(getminf2dd_cll(p31))
2001 q42 = dreal(getminf2dd_cll(p42))
2002 q30 = dreal(getminf2dd_cll(p30))
2003 q41 = dreal(getminf2dd_cll(p41))
2004 mm02 = getminf2dd_cll(m02)
2005 mm12 = getminf2dd_cll(m12)
2006 mm22 = getminf2dd_cll(m22)
2007 mm32 = getminf2dd_cll(m32)
2008 mm42 = getminf2dd_cll(m42)
2011 call e_dd(edd,q10,q21,q32,q43,q40,q20,q31,q42,q30,q41, &
2012 mm02,mm12,mm22,mm32,mm42,rank,id)
2013 e2(0:rank/2,0:rank,0:rank,0:rank,0:rank) = edd(0:rank/2,0:rank,0:rank,0:rank,0:rank)
2016 call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
2018 norm_coli = abs(e(0,0,0,0,0))
2019 norm_dd = abs(e2(0,0,0,0,0))
2025 norm_coli = max(norm_coli,abs(e(0,n1,n2,n3,n4)))
2026 norm_dd = max(norm_dd,abs(e2(0,n1,n2,n3,n4)))
2031 if (norm_coli.eq.0d0) then
2032 norm_coli = max(abs(p10),abs(p21),abs(p32),abs(p43),abs(p40), &
2033 abs(p20),abs(p31),abs(p42),abs(p30),abs(p41), &
2034 abs(m02),abs(m12),abs(m22),abs(m32),abs(m42))
2035 if(norm_coli.ne.0d0) then
2036 norm_coli=1d0/norm_coli**3
2038 norm_coli=1d0/muir2_cll**3
2041 if (norm_dd.eq.0d0) then
2042 norm_dd = max(abs(p10),abs(p21),abs(p32),abs(p43),abs(p40), &
2043 abs(p20),abs(p31),abs(p42),abs(p30),abs(p41), &
2044 abs(m02),abs(m12),abs(m22),abs(m32),abs(m42))
2045 if(norm_dd.ne.0d0) then
2046 norm_dd=1d0/norm_dd**3
2048 norm_dd=1d0/muir2_cll**3
2051 norm=min(norm_coli,norm_dd)
2054 call checkcoefse_cll(e,e2,p10,p21,p32,p43,p40,p20,p31,p42,p30,p41, &
2055 m02,m12,m22,m32,m42,rmax,norm,ediff)
2058 if (eerraux(rmax).lt.accabsdd(rmax)) then
2059 if (
present(eerr)) eerr = max(eerraux,ediff)
2060 if (
present(eerr2)) eerr2 = eerr2aux
2061 if (norm.ne.0d0) then
2062 eacc = max(eerraux/norm_coli,ediff/norm)
2063 eacc2 = eerr2aux/norm_coli
2068 if (monitoring) pointscnte_coli = pointscnte_coli + 1
2072 if (
present(eerr)) eerr = max(accabsdd(0:rmax),ediff)
2073 if (
present(eerr2)) eerr2 = accabs2dd(0:rmax)
2074 if (norm.ne.0d0) then
2075 eacc = max(accabsdd(0:rmax)/norm_dd,ediff/norm)
2076 eacc2 = accabs2dd(0:rmax)/norm_dd
2081 if (monitoring) pointscnte_dd = pointscnte_dd + 1
2084 if (mflag)
call propagateaccflag_cll(eacc,rmax)
2088 if (mflag)
call propagateerrflag_cll
2090 if (monitoring) then
2091 pointscnte_cll = pointscnte_cll + 1
2093 if(maxval(eacc).gt.reqacc_cll) accpointscnte_cll = accpointscnte_cll + 1
2095 if(maxval(eacc).gt.critacc_cll) then
2096 critpointscnte_cll = critpointscnte_cll + 1
2097 if ( critpointscnte_cll.le.noutcritpointsmax_cll(5) ) then
2098 call critpointsout_cll(
'E_cll',0,maxval(eacc), critpointscnte_cll)
2099 if( critpointscnte_cll.eq.noutcritpointsmax_cll(5)) then
2100 write(ncpout_cll,*)
' Further output of Critical Points for E_cll suppressed '
2107 if(maxval(eacc2).gt.reqacc_cll) accpointscnte2_cll = accpointscnte2_cll + 1
2109 if(maxval(eacc2).gt.critacc_cll) then
2110 critpointscnte2_cll = critpointscnte2_cll + 1
2111 if ( critpointscnte2_cll.le.noutcritpointsmax_cll(5) ) then
2112 call critpointsout2_cll(
'E_cll',0,maxval(eacc2), critpointscnte2_cll)
2113 if( critpointscnte2_cll.eq.noutcritpointsmax_cll(5)) then
2114 write(ncpout2_cll,*)
' Further output of Critical Points for E_cll suppressed '
2115 write(ncpout2_cll,*)