Commit a3fbb738 by Luca Naterop

### remove s_r from last place by shuffling under pending integral

parent aea74d41
 ... ... @@ -3,17 +3,31 @@ PROGRAM eval use globals use gpl_module use utils use shuffle implicit none integer :: i complex(kind=prec) :: res ! complex(kind=prec) :: a(3), s(2) ! complex(kind=prec) :: alpha(product((/(i,i=1,size(a)+size(s))/))/ & ! (product((/(i,i=1,size(a))/))*product((/(i,i=1,size(s))/))), & ! size(a) + size(s)) call parse_cmd_args() res = GPL([2,1,3,4]) ! here's an example where we need to shuffle away from last place print*, res ! res = pending_integral(cmplx([1,0]) + epsilon ,1, cmplx([3,2]) + epsilon) ! a = cmplx((/1,2,1/)) ! s = cmplx((/4.0,42e50/)) ! alpha = shuffle_product(a,s) ! call print_logical_matrix(alpha == 42e50) ! print*, find_first_true(alpha(6,:) == 42e50) ! res = GPL([2,1,3,4]) ! here's an example where we need to shuffle away from last place ! print*, res res = pending_integral(cmplx([1,3]),2,cmplx([2,4])) print*, res END PROGRAM eval
 ... ... @@ -68,6 +68,32 @@ CONTAINS END SUBROUTINE print_G FUNCTION remove_sr_from_last_place_in_PI(a,y2,m,p) result(res) ! here what is passed is not the full a vector, only a1, ..., ak without the trailing zeroes complex(kind=prec) :: a(:), y2, s(m), p(:), res integer :: m, i, j, n complex(kind=prec) :: alpha(product((/(i,i=1,size(a)+size(s))/))/ & (product((/(i,i=1,size(a))/))*product((/(i,i=1,size(s))/))), & size(a) + size(s)) s = [zeroes(m-1),cmplx(42e50)] alpha = shuffle_product(a,s) if(verb >= 50) then print*, 'mapping to ' call print_G(a,y2) print*, 'PI with p=',abs(p),'i=',m,'g =',abs([zeroes(m-1),y2]) end if res = GPL(a,y2)*pending_integral(p,m,[zeroes(m-1),y2]) if(verb >= 50) print*, 'also mapping to' do j = 2,size(alpha, 1) ! find location of s_r n = find_first_true(alpha(j,:) == 42e50) if(verb >= 50) print*, 'PI with p=',abs(p),'i=',n,'g =',abs([alpha(j,1:n-1),alpha(j,n+1:size(alpha,2)),y2]) res = res - pending_integral(p, n, [alpha(j,1:n-1),alpha(j,n+1:size(alpha,2)),y2]) end do END FUNCTION remove_sr_from_last_place_in_PI RECURSIVE FUNCTION pending_integral(p,i,g) result(res) ! evaluates a pending integral by reducing it to simpler ones and g functions complex(kind=prec) :: p(:), g(:), res ... ... @@ -146,10 +172,11 @@ CONTAINS return end if ! case higher depth, s_r at the end, use my (64) ! case higher depth, s_r at the end, use (62) if(i == size(g)) then if(verb >= 30) print*, 's_r at the end, need to shuffle (TODO)' res = 0 if(verb >= 30) print*, 's_r at the end, need to shuffle' m = find_amount_trailing_zeros(a) + 1 res = remove_sr_from_last_place_in_PI(a(1:size(a)-(m-1)), y2, m, p) return end if ... ... @@ -163,7 +190,7 @@ CONTAINS END FUNCTION pending_integral FUNCTION remove_sr_from_last_place(a,y2,m,sr) result(res) FUNCTION remove_sr_from_last_place_in_G(a,y2,m,sr) result(res) complex(kind=prec) :: a(:), sr, res,y2 integer :: m,i,j complex(kind=prec) :: alpha(product((/(i,i=1,size(a)+m)/))/ & ... ... @@ -174,13 +201,12 @@ CONTAINS do j = 2,size(alpha,1) res = res - G_flat(alpha(j,:),y2) end do END FUNCTION remove_sr_from_last_place END FUNCTION remove_sr_from_last_place_in_G FUNCTION make_convergent(a,y2) result(res) ! goes from G-functions to pending integrals and simpler expressions according to (62),(64),(67) and (68) complex(kind=prec) :: a(:), y2, res, sr integer :: i, mminus1 res = 0 ... ... @@ -191,7 +217,7 @@ CONTAINS ! sr at the end, thus shuffle as in (62) if(verb >= 30) print*, 'sr at the end' mminus1 = find_amount_trailing_zeros(a(1:size(a)-1)) res = remove_sr_from_last_place(a(1:size(a)-mminus1-1),y2,mminus1+1,sr) res = remove_sr_from_last_place_in_G(a(1:size(a)-mminus1-1),y2,mminus1+1,sr) return end if ... ...
 ... ... @@ -248,9 +248,7 @@ CONTAINS ! computes the polylog for now naively (except for dilog half-naively) integer :: m complex(kind=prec) :: x,res print*, 'called polylog with m = ', m if(verb >= 70) print*, 'called polylog(',m,',',x,')' if(m == 2) then res = dilog(x) ... ...
 ... ... @@ -77,6 +77,18 @@ CONTAINS end do END FUNCTION find_first_zero FUNCTION find_first_true(v) result(res) ! returns index of first element in v that is true logical :: v(:) integer :: i, res do i = 1, size(v) if(v(i)) then res = i return end if end do END FUNCTION find_first_true FUNCTION min_index(v) ! returns the index of the smallest element in v real(kind=prec) :: v(:), minimum ... ... @@ -140,6 +152,15 @@ CONTAINS end do END SUBROUTINE print_matrix SUBROUTINE print_logical_matrix(m) logical :: m(:,:) integer :: s(2), i s = shape(m) do i = 1,s(1) print*, m(i,:) end do END SUBROUTINE print_logical_matrix ! subroutine print(s1,s2,s3,s4,s5) ! character(len = *), intent(in), optional :: s1, s2, s3, s4, s5 ! if(print_enabled) then ... ...
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!