Commit bdc545ff authored by ulrich_y's avatar ulrich_y
Browse files

Undid some stuff related to ieps

parent 522fa0b7
...@@ -18,7 +18,7 @@ CONTAINS ...@@ -18,7 +18,7 @@ CONTAINS
integer :: l integer :: l
type(inum) :: y type(inum) :: y
complex(kind=prec) :: GPL_zero_zi complex(kind=prec) :: GPL_zero_zi
GPL_zero_zi = 1.0_prec/factorial(l) * log(y) ** l GPL_zero_zi = 1.0_prec/factorial(l) * log(y%c) ** l
END FUNCTION GPL_zero_zi END FUNCTION GPL_zero_zi
FUNCTION is_convergent(z,y) FUNCTION is_convergent(z,y)
...@@ -103,7 +103,7 @@ CONTAINS ...@@ -103,7 +103,7 @@ CONTAINS
!res = pending_integral(p,2,[sub_ieps(g(1))]) - pending_integral(p,2,[cmplx(0.0)]) & !res = pending_integral(p,2,[sub_ieps(g(1))]) - pending_integral(p,2,[cmplx(0.0)]) &
! + G_flat(p(2:size(p)), p(1)) * log(-sub_ieps(g(1))) ! + G_flat(p(2:size(p)), p(1)) * log(-sub_ieps(g(1)))
res = pending_integral(p,2,[g(1)]) - pending_integral(p,2,[izero]) & res = pending_integral(p,2,[g(1)]) - pending_integral(p,2,[izero]) &
+ G_flat(p(2:size(p)), p(1)) * log(neg(g(1))) + G_flat(p(2:size(p)), p(1)) * (log(-g(1)%c)+cmplx(0,2*pi))
return return
end if end if
...@@ -248,16 +248,19 @@ CONTAINS ...@@ -248,16 +248,19 @@ CONTAINS
! improves the convergence by applying the Hoelder convolution to G(z1,...zk,1) ! improves the convergence by applying the Hoelder convolution to G(z1,...zk,1)
type(inum) :: z(:),oneminusz(size(z)) type(inum) :: z(:),oneminusz(size(z))
complex(kind=prec) :: res complex(kind=prec) :: res
type(inum), parameter :: p = inum(2.0,+1) complex(kind=prec), parameter :: p = 2.0
integer :: k, j integer :: k, j
if(verb >= 30) print*, 'requires Hoelder convolution' if(verb >= 30) print*, 'requires Hoelder convolution'
oneminusz = ione-z !TODO ieps?!??
do j=1,size(z)
oneminusz(j) = inum(1.-z(j)%c,-z(j)%i0)
enddo
k = size(z) k = size(z)
res = G_flat(z,ione/p) ! first term of the sum res = G_flat(z,inum(1./p,di0)) ! first term of the sum
res = res + (-1)**k * G_flat(oneminusz(k:1:-1), ione-ione/p) res = res + (-1)**k * G_flat(oneminusz(k:1:-1), inum(1.-1/p,di0))
do j = 1,k-1 do j = 1,k-1
res = res + (-1)**j * G_flat(oneminusz(j:1:-1),ione-ione/p) * G_flat(z(j+1:k),ione/p) res = res + (-1)**j * G_flat(oneminusz(j:1:-1),inum(1.-1/p,di0)) * G_flat(z(j+1:k),inum(1./p,di0))
end do end do
END FUNCTION improve_convergence END FUNCTION improve_convergence
...@@ -274,7 +277,7 @@ CONTAINS ...@@ -274,7 +277,7 @@ CONTAINS
if(size(z_flat) == 1) then if(size(z_flat) == 1) then
if( abs(z_flat(1) - y) <= zero ) then if( abs(z_flat(1)%c - y%c) <= zero ) then
res = 0 res = 0
return return
end if end if
...@@ -289,16 +292,16 @@ CONTAINS ...@@ -289,16 +292,16 @@ CONTAINS
! is just a logarithm? ! is just a logarithm?
if(all(abs(z_flat) < zero)) then if(all(abs(z_flat) < zero)) then
if(verb >= 70) print*, 'all z are zero' if(verb >= 70) print*, 'all z are zero'
res = log(y)**size(z_flat) / factorial(size(z_flat)) res = log(y%c)**size(z_flat) / factorial(size(z_flat))
return return
end if end if
if(size(z_flat) == 1) then if(size(z_flat) == 1) then
if(verb >= 70) print*, 'is just a logarithm' if(verb >= 70) print*, 'is just a logarithm'
if(abs(z_flat(1)) <= zero) then if(abs(z_flat(1)) <= zero) then
res = log(y) res = log(y%c)
return return
end if end if
res = log((z_flat(1) - y)/z_flat(1)) res = plog1(y,z_flat(1)) ! log((z_flat(1) - y)/z_flat(1))
return return
end if end if
...@@ -309,7 +312,7 @@ CONTAINS ...@@ -309,7 +312,7 @@ CONTAINS
if(is_depth_one) then if(is_depth_one) then
! case m >= 2, other already handled above ! case m >= 2, other already handled above
if(verb >= 70) print*, 'is just a polylog' if(verb >= 70) print*, 'is just a polylog'
res = -polylog(m_1,y/z_flat(m_1)) res = -polylog(m_1, y, z_flat(m_1))!-polylog(m_1,y/z_flat(m_1))
return return
end if end if
...@@ -324,7 +327,7 @@ CONTAINS ...@@ -324,7 +327,7 @@ CONTAINS
if(verb >= 30) print*, 'need to remove trailing zeroes' if(verb >= 30) print*, 'need to remove trailing zeroes'
allocate(s(j,j)) allocate(s(j,j))
s = shuffle_with_zero(z_flat(1:j-1)) s = shuffle_with_zero(z_flat(1:j-1))
res = log(y)*G_flat(z_flat(1:size(z_flat)-1),y) res = log(y%c)*G_flat(z_flat(1:size(z_flat)-1),y)
do i = 1,size(s,1) do i = 1,size(s,1)
res = res - G_flat([s(i,:),z_flat(j),zeroes(kminusj-1)], y) res = res - G_flat([s(i,:),z_flat(j),zeroes(kminusj-1)], y)
end do end do
...@@ -342,7 +345,8 @@ CONTAINS ...@@ -342,7 +345,8 @@ CONTAINS
! requires Hoelder convolution? ! requires Hoelder convolution?
if( any(1.0 <= abs(z_flat%c/y%c) .and. abs(z_flat%c/y%c) <= 1.1) ) then if( any(1.0 <= abs(z_flat%c/y%c) .and. abs(z_flat%c/y%c) <= 1.1) ) then
res = improve_convergence(z_flat/y) !TODO
res = improve_convergence(toinum(z_flat%c/y%c))
return return
end if end if
...@@ -390,8 +394,8 @@ CONTAINS ...@@ -390,8 +394,8 @@ CONTAINS
! assumes zero arguments expressed through the m's ! assumes zero arguments expressed through the m's
integer :: m(:), k, i integer :: m(:), k, i
type(inum) :: z(:), y, x(k), z_flat(sum(m)) type(inum) :: z(:), y, z_flat(sum(m))
complex(kind=prec) :: res complex(kind=prec) :: res, x(k)
! print*, 'called G_condensed with args' ! print*, 'called G_condensed with args'
! print*, 'm = ', m ! print*, 'm = ', m
...@@ -418,15 +422,15 @@ CONTAINS ...@@ -418,15 +422,15 @@ CONTAINS
res = G_flat(z_flat,y) res = G_flat(z_flat,y)
return return
end if end if
!TODO is that okay?
x(1) = y/z(1) x(1) = y%c/z(1)%c
do i = 2,k do i = 2,k
x(i) = z(i-1)/z(i) x(i) = z(i-1)%c/z(i)%c
end do end do
! print*, 'computed using Li with ' ! print*, 'computed using Li with '
! print*, 'm = ', m ! print*, 'm = ', m
! print*, 'x = ', x ! print*, 'x = ', x
res = (-1)**k * MPL(m,x%c) res = (-1)**k * MPL(m,x)
END FUNCTION G_condensed END FUNCTION G_condensed
......
...@@ -15,27 +15,9 @@ MODULE ieps ...@@ -15,27 +15,9 @@ MODULE ieps
type(inum), parameter :: marker=inum(0.,5) type(inum), parameter :: marker=inum(0.,5)
interface operator (*)
module procedure multinumss, multinumvs
end interface operator (*)
interface operator (+)
module procedure addinumss, addinumvs
end interface operator (+)
interface operator (-)
module procedure subinumss,subinumvs,subinumsv
end interface operator (-)
interface operator (**)
module procedure powinum
end interface operator (**)
interface operator (/)
module procedure divint, divinumss, divinumvs
end interface operator (/)
interface abs interface abs
module procedure absinum, absinumv module procedure absinum, absinumv
end interface abs end interface abs
interface log
module procedure loginum
end interface log
interface toinum interface toinum
module procedure toinum_cmplx, toinum_real, toinum_int module procedure toinum_cmplx, toinum_real, toinum_int
...@@ -47,79 +29,6 @@ MODULE ieps ...@@ -47,79 +29,6 @@ MODULE ieps
module procedure realis, realiv module procedure realis, realiv
end interface real end interface real
CONTAINS CONTAINS
FUNCTION NEG(n1)
implicit none
type(inum), intent(in) :: n1
type(inum) :: neg
neg = inum(-n1%c,-n1%i0)
END FUNCTION
FUNCTION MULTINUMSS(n1, n2)
implicit none
type(inum), intent(in) :: n1, n2
type(inum) :: multinumss
multinumss = inum( n1%c*n2%c, int(sign(1._prec,real(n1%c)*n2%i0 + real(n2%c)*n1%i0)) )
END FUNCTION MULTINUMSS
FUNCTION MULTINUMVS(n1, n2)
implicit none
type(inum), intent(in) :: n1(:), n2
type(inum) :: multinumvs(size(n1))
integer i
do i = 1,size(n1)
multinumvs(i) = inum( n1(i)%c*n2%c, int(sign(1._prec,real(n1(i)%c)*n2%i0 + real(n2%c)*n1(i)%i0)) )
enddo
END FUNCTION MULTINUMVS
FUNCTION ADDINUMSS(n1, n2)
implicit none
type(inum), intent(in) :: n1, n2
type(inum) :: addinumss
!TODO: what *is* the sum?
addinumss = inum(n1%c + n2%c, n1%i0 )
END FUNCTION ADDINUMSS
FUNCTION ADDINUMVS(n1, n2)
implicit none
type(inum), intent(in) :: n1(:), n2
type(inum) :: addinumvs(size(n1))
!TODO: what *is* the sum?
integer i
do i = 1,size(n1)
addinumvs(i) = inum(n1(i)%c + n2%c, n1(i)%i0 )
enddo
END FUNCTION ADDINUMVS
FUNCTION SUBINUMSS(n1, n2)
implicit none
type(inum), intent(in) :: n1, n2
type(inum) :: subinumss
!TODO: what *is* the sum?
subinumss = inum(n1%c - n2%c, n1%i0 )
END FUNCTION SUBINUMSS
FUNCTION SUBINUMVS(n1, n2)
implicit none
type(inum), intent(in) :: n1(:), n2
type(inum) :: subinumvs(size(n1))
!TODO: what *is* the sum?
integer i
do i = 1,size(n1)
subinumvs(i) = inum(n1(i)%c - n2%c, n1(i)%i0 )
enddo
END FUNCTION SUBINUMvs
FUNCTION SUBINUMSV(n2, n1)
implicit none
type(inum), intent(in) :: n1(:), n2
type(inum) :: subinumsv(size(n1))
!TODO: what *is* the sum?
integer i
do i = 1,size(n1)
subinumsv(i) = inum(n2%c - n1(i)%c, n1(i)%i0 )
enddo
END FUNCTION SUBINUMSV
FUNCTION ABSINUM(n1) FUNCTION ABSINUM(n1)
implicit none implicit none
type(inum), intent(in) :: n1 type(inum), intent(in) :: n1
...@@ -134,59 +43,6 @@ CONTAINS ...@@ -134,59 +43,6 @@ CONTAINS
absinumv = abs(n1%c) absinumv = abs(n1%c)
END FUNCTION ABSINUMV END FUNCTION ABSINUMV
FUNCTION POWINUM(n1, m)
implicit none
type(inum), intent(in) :: n1
integer, intent(in) :: m
type(inum) :: powinum
if (aimag(n1%c)<zero) then
powinum = inum( cmplx(real(n1%c)**m,0.), int(sign(1._prec,real(n1%c)**m)) )
else
powinum = inum( n1%c**m, n1%i0 )
endif
END FUNCTION POWINUM
FUNCTION DIVINT(n1, m)
implicit none
type(inum), intent(in) :: n1
integer, intent(in) :: m
type(inum) :: divint
divint = inum( n1%c/m, n1%i0*sign(1,m))
END FUNCTION DIVINT
FUNCTION DIVINUMss(n1, n2)
implicit none
type(inum), intent(in) :: n1, n2
type(inum) :: divinumss
divinumss = inum( n1%c/n2%c, int(sign(1., real(n2%c)*n1%i0 - real(n1%c)*n2%i0)))
END FUNCTION DIVINUMss
FUNCTION DIVINUMvs(n1, n2)
implicit none
type(inum), intent(in) :: n1(:), n2
type(inum) :: divinumvs(size(n1))
integer i
do i = 1,size(n1)
divinumvs(i) = inum( n1(i)%c/n2%c, int(sign(1., real(n2%c)*n1(i)%i0 - real(n1(i)%c)*n2%i0)))
enddo
END FUNCTION DIVINUMvs
FUNCTION LOGINUM(n1)
implicit none
type(inum), intent(in) :: n1
complex(kind=prec) :: loginum
if (abs(aimag(n1%c)).lt.zero) then
loginum = log(abs(real(n1%c)))
if (real(n1%c)<0) then
loginum = loginum + cmplx(0,n1%i0*pi)
endif
else
loginum = log(n1%c)
endif
END FUNCTION LOGINUM
FUNCTION TOINUM_cmplx(z, s) FUNCTION TOINUM_cmplx(z, s)
complex(kind=prec) :: z(:) complex(kind=prec) :: z(:)
type(inum) :: toinum_cmplx(size(z)) type(inum) :: toinum_cmplx(size(z))
......
...@@ -3,6 +3,9 @@ MODULE maths_functions ...@@ -3,6 +3,9 @@ MODULE maths_functions
use globals use globals
use utils use utils
implicit none implicit none
interface polylog
module procedure polylog1, polylog2
end interface polylog
CONTAINS CONTAINS
FUNCTION zeta(n) FUNCTION zeta(n)
...@@ -297,11 +300,11 @@ CONTAINS ...@@ -297,11 +300,11 @@ CONTAINS
END FUNCTION END FUNCTION
RECURSIVE FUNCTION polylog(m,x) result(res) RECURSIVE FUNCTION polylog1(m,x) result(res)
! computes the polylog ! computes the polylog
integer :: m integer :: m
type(inum) :: x type(inum) :: x, inv
complex(kind=prec) :: res complex(kind=prec) :: res
if(verb >= 70) print*, 'called polylog(',m,',',x%c,x%i0,')' if(verb >= 70) print*, 'called polylog(',m,',',x%c,x%i0,')'
...@@ -312,8 +315,9 @@ CONTAINS ...@@ -312,8 +315,9 @@ CONTAINS
res = -(1. - 2.**(1-m))*zeta(m) res = -(1. - 2.**(1-m))*zeta(m)
return return
else if (abs(x) .gt. 1) then else if (abs(x) .gt. 1) then
res = (-1)**(m-1)*polylog(m,ione/x) & inv = inum(1./x%c, x%i0)
- cmplx(0,2*pi)**m * bernoulli_polynomial(m, 0.5-cmplx(0.,1.)*log(neg(x))/2/pi) / factorial(m) res = (-1)**(m-1)*polylog(m,inv) &
- cmplx(0,2*pi)**m * bernoulli_polynomial(m, 0.5-cmplx(0.,1.)*conjg(log(-x%c))/2/pi) / factorial(m)
return return
endif endif
...@@ -324,7 +328,26 @@ CONTAINS ...@@ -324,7 +328,26 @@ CONTAINS
else else
res = naive_polylog(m,x%c) res = naive_polylog(m,x%c)
end if end if
END FUNCTION polylog END FUNCTION polylog1
RECURSIVE FUNCTION polylog2(m,x,y) result(res)
type(inum) :: x, y
integer m
complex(kind=prec) :: res
res=polylog1(m,inum(x%c/y%c,di0))
END FUNCTION POLYLOG2
FUNCTION PLOG1(a,b)
! calculates log(1-a/b)
implicit none
type(inum) :: a,b
complex(kind=prec) plog1
plog1 = log(1.-a%c/b%c)
END FUNCTION
END MODULE maths_functions END MODULE maths_functions
......
This diff is collapsed.
MODULE GLOBAL_DEF
implicit none
!! ----------
!! parameters
!! ----------
integer, parameter :: prec = selected_real_kind(15,32)
real (kind=prec), parameter :: cw = 0.876613
real (kind=prec), parameter :: sw = 0.481196
real (kind=prec), parameter :: pi = 3.14159265358979323846_prec
real (kind=prec), parameter :: z3 = 1.20205690315959428540_prec
real (kind=prec), parameter :: log2 = 0.693147180559945309417_prec
real (kind=prec), parameter :: conv = 3.893850E+8 ! convert GeV to pb
real (kind=prec), parameter :: xsc = 0._prec ! FDH=>1 vs HV=>0
real (kind=prec), parameter :: Nc = 3._prec
real (kind=prec), parameter :: Tf = 0.5_prec
real (kind=prec), parameter :: Cf = (Nc**2-1)/(2*Nc)
real (kind=prec), parameter :: Nh = 1._prec
real (kind=prec), parameter :: Nf = 5._prec
complex (kind=prec), parameter :: imag = (0.0_prec,1.0_prec)
real (kind=prec), parameter :: zero = 1.0E-50_prec
real (kind=prec), parameter :: alpha_ew = 0.03394_prec
! real (kind=prec), parameter :: alpha = 1/127.9_prec
! real (kind=prec), parameter :: alpha = 1./137.0359997_prec
! real (kind=prec), parameter :: GF = 1.16637E-11_prec ! MeV^-2
real (kind=prec), parameter :: GF = 1._prec
real (kind=prec), parameter :: alpha = 1._prec
real (kind=prec), parameter :: Mmu = 105.658372_prec ! MeV
real (kind=prec), parameter :: Mel = 0.51099893_prec ! MeV
! real (kind=prec), parameter :: Mel = 10._prec ! MeV
real (kind=prec), parameter :: Mtau = 1776.82_prec ! MeV
real (kind=prec), parameter :: xi_sep = 1.0E-10_prec
real (kind=prec), parameter :: del_sep = 1.0E-10_prec
! character (len=3), parameter :: cgamma = "exp"
character (len=3), parameter :: cgamma = "gam"
integer print_ok, throw_away
!! ---------
!! variables
!! ---------
integer :: ran_seed = 1
real (kind=prec) :: p1(4),p2(4),p3(4),p4(4),p5(4),p6(4),p7(4), &
p8(4),p9(4), pol1(4)
real (kind=prec) :: mu, musq, delcut, xinormcut
real (kind=prec) :: xinormcut1, xinormcut2
character (len=8) :: flavour
real (kind=prec) :: Mm ! MeV
real (kind=prec) :: Me ! MeV
contains
SUBROUTINE CRASH(function_name)
character(len=*) :: function_name
write(6,*) "Program crashes because of a call to the function ", &
function_name
stop
END SUBROUTINE CRASH
END MODULE GLOBAL_DEF
! An implementation of the shuffle algebra
! in accordance with 1904.07279v1, polylogs for the masses, p.7-8
! This implementation defines words as strings of characters and shuffles them
! into sums of words.
PROGRAM shuffle_algebra
implicit none
! Currently words can be no longer than the following values
! Might need to be adjusted
integer, parameter :: max_word_size = 6
integer, parameter :: max_word_sum_size = 1000
type word
character(len=max_word_size) :: letters
integer :: length
endtype word
type word_sum
type(word), dimension(max_word_sum_size) :: words
integer :: length
end type word_sum
type(word) :: v1 = word("abc",3)
type(word) :: v2 = word("123",3)
type(word) :: w1
type(word_sum) :: ws, ws1, ws2
ws = shuffle_product(v1,v2)
print*, ws%words
CONTAINS
RECURSIVE FUNCTION shuffle_product(v1, v2) result(res)
! takes two words and returns shuffle product as a word sum
type(word_sum) :: res, p1, p2, s1, s2
type(word) :: v1,v2,w1,w2
type(character) :: alpha, beta
! print*, '----------------------'
! print*, 'v1 = ', v1
! print*, 'v2 = ', v2