Commit 8b13fff5 authored by Luca's avatar Luca
Browse files

remove s_r from the end with shuffling

parent 9f039ae2
...@@ -3,6 +3,7 @@ MODULE gpl_module ...@@ -3,6 +3,7 @@ MODULE gpl_module
use globals use globals
use utils use utils
use maths_functions use maths_functions
use shuffle
use mpl_module use mpl_module
implicit none implicit none
...@@ -83,14 +84,30 @@ CONTAINS ...@@ -83,14 +84,30 @@ CONTAINS
END FUNCTION pending_integral END FUNCTION pending_integral
FUNCTION remove_sr_from_last_place(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)/))/ &
(product((/(i,i=1,size(a))/))*product((/(i,i=1,m)/))), &
size(a) + m)
alpha = shuffle_product(a,[zero_array(m-1),sr])
res = G_flat(a,y2)*G_flat([zero_array(m-1),sr],y2)
do j = 2,size(alpha,1)
res = res - G_flat(alpha(j,:),y2)
end do
END FUNCTION remove_sr_from_last_place
FUNCTION reduce_to_convergent(a,y2) result(res) FUNCTION reduce_to_convergent(a,y2) result(res)
complex(kind=prec) :: a(:), y2, res, sr complex(kind=prec) :: a(:), y2, res, sr
integer :: i
integer :: i, mminus1
res = 0 res = 0
i = min_index(abs(a)) i = min_index(abs(a))
sr = a(i) sr = a(i)
if(i == 1) then if(i == 1) then
!s_r at beginning, use (68)
print*, 's_r at at first place' print*, 's_r at at first place'
res = G_flat([cmplx(0), a(i+1:size(a))], y2) & res = G_flat([cmplx(0), a(i+1:size(a))], y2) &
+ G_flat([y2], sr) * G_flat(a(i+1:size(a)), y2) & + G_flat([y2], sr) * G_flat(a(i+1:size(a)), y2) &
...@@ -98,6 +115,23 @@ CONTAINS ...@@ -98,6 +115,23 @@ CONTAINS
- G_flat([a(i+1)], sr) * G_flat(a(i+1:size(a)), y2) - G_flat([a(i+1)], sr) * G_flat(a(i+1:size(a)), y2)
return return
end if end if
if(i == size(a)) then
! sr at the end, thus shuffle
print*, 's_r 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)
return
end if
! thus s_r in middle, use (67)
print*, 's_r in the middle'
res = G_flat([a(1:i-1),cmplx(0),a(i+1:size(a))],y2) &
- pending_integral([sr,a(i-1)], i-1, [a(1:i-2),a(i+1:size(a)),y2]) &
+ G_flat([a(i-1)],sr) * G_flat([a(1:i-1),a(i+1:size(a))],y2) &
+ pending_integral([sr,a(i+1)], i, [a(1:i-1),a(i+2:size(a)),y2]) &
- G_flat([a(i+1)],sr) * G_flat([a(1:i-1),a(i+1:size(a))],y2)
END FUNCTION reduce_to_convergent END FUNCTION reduce_to_convergent
RECURSIVE FUNCTION G_flat(z_flat,y) result(res) RECURSIVE FUNCTION G_flat(z_flat,y) result(res)
...@@ -110,7 +144,13 @@ CONTAINS ...@@ -110,7 +144,13 @@ CONTAINS
call print_G(z_flat,y) call print_G(z_flat,y)
! is just a logarithm? ! is just a logarithm?
if(all(abs(z_flat) < zero)) then
print*, 'all z are zero'
res = log(y)**size(z_flat) / factorial(size(z_flat))
return
end if
if(size(z_flat) == 1) then if(size(z_flat) == 1) then
print*, 'is just a logarithm' print*, 'is just a logarithm'
if(abs(z_flat(1)) <= zero) then if(abs(z_flat(1)) <= zero) then
...@@ -132,13 +172,6 @@ CONTAINS ...@@ -132,13 +172,6 @@ CONTAINS
return return
end if end if
! need make convergent?
if(.not. is_convergent(z_flat,y)) then
print*, 'need to make convergent'
res = reduce_to_convergent(z_flat, y)
return
end if
! need remove trailing zeroes? ! need remove trailing zeroes?
k = size(z_flat) k = size(z_flat)
kminusj = find_amount_trailing_zeros(z_flat) kminusj = find_amount_trailing_zeros(z_flat)
...@@ -159,6 +192,13 @@ CONTAINS ...@@ -159,6 +192,13 @@ CONTAINS
return return
end if end if
! need make convergent?
if(.not. is_convergent(z_flat,y)) then
print*, 'need to make convergent'
res = reduce_to_convergent(z_flat, y)
return
end if
! thus it is convergent, and has no trailing zeros ! thus it is convergent, and has no trailing zeros
! -> evaluate in condensed notation -> which will give series representation ! -> evaluate in condensed notation -> which will give series representation
m_prime = get_condensed_m(z_flat) m_prime = get_condensed_m(z_flat)
......
...@@ -20,7 +20,7 @@ PROGRAM TEST ...@@ -20,7 +20,7 @@ PROGRAM TEST
! call do_GPL_tests() ! call do_GPL_tests()
! call do_shuffle_tests() ! put this somewhere else ! call do_shuffle_tests() ! put this somewhere else
res = G_flat(cmplx((/0.0,0.0,10.0/)),cmplx(2.0)) res = G_flat(cmplx((/2,1/)),cmplx(3))
print*, res print*, res
......
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