Skip to content

GitLab

H
handyG
Commit bdc545ff authored by ulrich_y's avatar ulrich_y
2 Browse files
Options

Undid some stuff related to ieps

parent 522fa0b7
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 52 additions and 1643 deletions
src/gpl_module.f90
View file @ bdc545ff
......@@ -18,7 +18,7 @@ CONTAINS
integer :: l
type(inum) :: y
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
FUNCTION is_convergent(z,y)
......@@ -103,7 +103,7 @@ CONTAINS
!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)))
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
end if
......@@ -248,16 +248,19 @@ CONTAINS
! improves the convergence by applying the Hoelder convolution to G(z1,...zk,1)
type(inum) :: z(:),oneminusz(size(z))
complex(kind=prec) :: res
type(inum), parameter :: p = inum(2.0,+1)
complex(kind=prec), parameter :: p = 2.0
integer :: k, j
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)
res = G_flat(z,ione/p) ! first term of the sum
res = res + (-1)**k * G_flat(oneminusz(k:1:-1), ione-ione/p)
res = G_flat(z,inum(1./p,di0)) ! first term of the sum
res = res + (-1)**k * G_flat(oneminusz(k:1:-1), inum(1.-1/p,di0))
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 FUNCTION improve_convergence
......@@ -274,7 +277,7 @@ CONTAINS
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
return
end if
......@@ -289,16 +292,16 @@ CONTAINS
! is just a logarithm?
if(all(abs(z_flat) < zero)) then
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
end if
if(size(z_flat) == 1) then
if(verb >= 70) print*, 'is just a logarithm'
if(abs(z_flat(1)) <= zero) then
res = log(y)
res = log(y%c)
return
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
end if
......@@ -309,7 +312,7 @@ CONTAINS
if(is_depth_one) then
! case m >= 2, other already handled above
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
end if
......@@ -324,7 +327,7 @@ CONTAINS
if(verb >= 30) print*, 'need to remove trailing zeroes'
allocate(s(j,j))
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)
res = res - G_flat([s(i,:),z_flat(j),zeroes(kminusj-1)], y)
end do
......@@ -342,7 +345,8 @@ CONTAINS
! requires Hoelder convolution?
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
end if
......@@ -390,8 +394,8 @@ CONTAINS
! assumes zero arguments expressed through the m's
integer :: m(:), k, i
type(inum) :: z(:), y, x(k), z_flat(sum(m))
complex(kind=prec) :: res
type(inum) :: z(:), y, z_flat(sum(m))
complex(kind=prec) :: res, x(k)
! print*, 'called G_condensed with args'
! print*, 'm = ', m
......@@ -418,15 +422,15 @@ CONTAINS
res = G_flat(z_flat,y)
return
end if
x(1) = y/z(1)
!TODO is that okay?
x(1) = y%c/z(1)%c
do i = 2,k
x(i) = z(i-1)/z(i)
x(i) = z(i-1)%c/z(i)%c
end do
! print*, 'computed using Li with '
! print*, 'm = ', m
! print*, 'x = ', x
res = (-1)**k * MPL(m,x%c)
res = (-1)**k * MPL(m,x)
END FUNCTION G_condensed
......
src/ieps.f90
View file @ bdc545ff
......@@ -15,27 +15,9 @@ MODULE ieps
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
module procedure absinum, absinumv
end interface abs
interface log
module procedure loginum
end interface log
interface toinum
module procedure toinum_cmplx, toinum_real, toinum_int
......@@ -47,79 +29,6 @@ MODULE ieps
module procedure realis, realiv
end interface real
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)
implicit none
type(inum), intent(in) :: n1
......@@ -134,59 +43,6 @@ CONTAINS
absinumv = abs(n1%c)
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)
complex(kind=prec) :: z(:)
type(inum) :: toinum_cmplx(size(z))
......
src/maths_functions.f90
View file @ bdc545ff
......@@ -3,6 +3,9 @@ MODULE maths_functions
use globals
use utils
implicit none
interface polylog
module procedure polylog1, polylog2
end interface polylog
CONTAINS
FUNCTION zeta(n)
......@@ -297,11 +300,11 @@ CONTAINS
END FUNCTION
RECURSIVE FUNCTION polylog(m,x) result(res)
RECURSIVE FUNCTION polylog1(m,x) result(res)
! computes the polylog
integer :: m
type(inum) :: x
type(inum) :: x, inv
complex(kind=prec) :: res
if(verb >= 70) print*, 'called polylog(',m,',',x%c,x%i0,')'
......@@ -312,8 +315,9 @@ CONTAINS
res = -(1. - 2.**(1-m))*zeta(m)
return
else if (abs(x) .gt. 1) then
res = (-1)**(m-1)*polylog(m,ione/x) &
- cmplx(0,2*pi)**m * bernoulli_polynomial(m, 0.5-cmplx(0.,1.)*log(neg(x))/2/pi) / factorial(m)
inv = inum(1./x%c, x%i0)
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
endif
......@@ -324,7 +328,26 @@ CONTAINS
else
res = naive_polylog(m,x%c)
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
......
src/other_stuff/functions_old.F95 deleted 100644 → 0
View file @ 522fa0b7
This diff is collapsed.
src/other_stuff/global_def_old.f95 deleted 100644 → 0
View file @ 522fa0b7
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
src/other_stuff/shuffle_algebra.f90 deleted 100644 → 0
View file @ 522fa0b7
! 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
if(v1%length == 0) then
res = word_sum((/ v2 /),1)
else if(v2%length == 0) then
res = word_sum((/ v1 /),1)
else
alpha = v1%letters(1:1)
beta = v2%letters(1:1)
w1 = word(v1%letters(2:),v1%length-1)
w2 = word(v2%letters(2:),v2%length-1)
p1 = shuffle_product(w1,v2)
p2 = shuffle_product(v1,w2)
s1 = times(alpha, p1)
s2 = times(beta, p2)
res = combined_word_sum(s1,s2)
end if
END FUNCTION shuffle_product
FUNCTION combined_word_sum(s1, s2)
! combines word sums s1 and s2 into s
type(word_sum) :: s1, s2, combined_word_sum
type(word), dimension(s1%length + s2%length) :: combined_words
integer :: length
length = s1%length + s2%length
combined_words(1:s1%length) = s1%words(1:s1%length)
combined_words(s1%length+1:length) = s2%words(1:s2%length)
combined_word_sum = word_sum(combined_words,length)
END FUNCTION combined_word_sum
FUNCTION times(l, ws)
! computes word sum from letter times word sum, e.g. a(bc + cd) = abc + acd
character :: l
type(word_sum) :: ws
type(word_sum) :: times
integer :: i
times%length = ws%length
do i=1,ws%length
times%words(i)%letters = l // ws%words(i)%letters
end do
END FUNCTION times
SUBROUTINE print_word_sum(ws)
! prints a sum of word with plusses for easy readibility
integer :: i
type(word_sum) :: ws
do i = 1,ws%length
write(*, fmt="(1xai0)", advance="no") ws%words(i)%letters
if(i /= ws%length) then
write(*, fmt="(1xai0)", advance="no") " + "
end if
end do
END SUBROUTINE print_word_sum
END PROGRAM shuffle_algebra
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment