Commit c3567fdc authored by Luca's avatar Luca

refactor

parent 412ce699
......@@ -9,7 +9,7 @@ CONTAINS
RECURSIVE FUNCTION factorial(n) result(res)
integer, intent(in) :: n
integer :: res
res = merge(1,n*factorial(n-1),n==1)
res = merge(1,n*factorial(n-1),n==0)
END FUNCTION factorial
FUNCTION zeta(n)
......@@ -69,7 +69,13 @@ CONTAINS
print*, 'G_flat called with args', abs(z_flat)
! remove trailing zeroes
! need make convergent?
if(.not. is_convergent(z_flat,y)) then
print*, 'need to make convergent'
res = 0
return
end if
! need remove trailing zeroes?
k = size(z_flat)
kminusj = find_amount_trailing_zeros(z_flat)
j = k - kminusj
......@@ -134,8 +140,8 @@ CONTAINS
! need make convergent?
if(.not. GPL_has_convergent_series(m,z,y,k)) then
print*, 'need to make convergent'
if(k == 1 .and. m(1) == 1) then
print*, 'now we use the easy case. ha. ha.'
if(k == 1 .and. m(1) == 1) then ! use (59)
else
print*, ' ', 'does not have convergent series representation'
end if
......
......@@ -27,7 +27,7 @@ PROGRAM shuffle_algebra
type(word_sum) :: ws, ws1, ws2
ws = shuffle_product(v1,v2)
call print_word_sum(ws)
print*, ws%words
CONTAINS
RECURSIVE FUNCTION shuffle_product(v1, v2) result(res)
......
......@@ -61,7 +61,7 @@ CONTAINS
call test_one_MPL((/ 2,1,2 /),cmplx((/ 0.03, 0.5012562893380046, 55.3832 /)),ref, '1.3')
end subroutine do_MPL_tests
subroutine test_one_GPL(m,z,y,k,ref,test_id)
subroutine test_one_condensed(m,z,y,k,ref,test_id)
integer :: m(:), k
complex(kind=prec) :: z(:), y, res, ref
character(len=*) :: test_id
......@@ -69,23 +69,33 @@ CONTAINS
print*, ' ', 'testing GPL ', test_id, ' ...'
res = G_condensed(m,z,y,k)
call check(res,ref)
end subroutine test_one_GPL
end subroutine test_one_condensed
subroutine test_one_flat(z,y,ref,test_id)
complex(kind=prec) :: z(:), y, res, ref
character(len=*) :: test_id
print*, ' ', 'testing GPL ', test_id, ' ...'
res = G_flat(z,y)
call check(res,ref)
end subroutine test_one_flat
subroutine do_GPL_tests()
complex(kind=prec) :: ref
complex(kind=prec), parameter :: epsilon = 1E-14
print*, 'doing GPL tests...'
ref = dcmplx(0.0819393734128676)
call test_one_GPL((/ 1,1 /),cmplx((/ 1.3d0, 1.1d0 /)),cmplx(0.4),2,ref,'2.1')
! ref = dcmplx(0.0819393734128676)
! call test_one_condensed((/ 1,1 /),cmplx((/ 1.3d0, 1.1d0 /)),cmplx(0.4),2,ref,'2.1')
ref = dcmplx(0.01592795952537145)
call test_one_GPL((/ 3,2 /),cmplx((/ 1.3d0, 1.1d0 /)),cmplx(0.4),2,ref,'2.2')
! ref = dcmplx(0.01592795952537145)
! call test_one_condensed((/ 3,2 /),cmplx((/ 1.3d0, 1.1d0 /)),cmplx(0.4),2,ref,'2.2')
ref = dcmplx(0.0020332632172573974)
call test_one_GPL((/ 4 /),cmplx((/ 0 /)),cmplx(1.6),1,ref,'2.3')
! ref = dcmplx(0.0020332632172573974)
! call test_one_condensed((/ 4 /),cmplx((/ 0 /)),cmplx(1.6),1,ref,'2.3')
! call test_one_GPL((/1,1,1/),cmplx((/ 0.0,1.7,0.0 /)),cmplx(1.1),3,ref,'2.4')
ref = dcmplx(0.0020332632172573974)
call test_one_flat(cmplx((/0.0,1.7,0.5/)),cmplx(1.1),ref,'2.5')
end subroutine do_GPL_tests
END PROGRAM TEST
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