Commit 0e52465a by Luca

### tests cleanup and convergence criterion of GPL

parent 47964a0c
 ... @@ -12,6 +12,24 @@ CONTAINS ... @@ -12,6 +12,24 @@ CONTAINS res = merge(1,n*factorial(n-1),n==1) res = merge(1,n*factorial(n-1),n==1) END FUNCTION factorial END FUNCTION factorial FUNCTION GPL_has_convergent_series(m,z,y,k) ! tests if GPL has a convergent series representation integer :: m(:), k complex(kind=prec) :: z(:), y logical :: GPL_has_convergent_series GPL_has_convergent_series = .false. if(all(abs(y) <= abs(z))) then if(m(1) == 1) then GPL_has_convergent_series = (y/z(1) /= 1) else GPL_has_convergent_series = .true. end if end if END FUNCTION GPL_has_convergent_series FUNCTION GPL_zero_zi(l,y) FUNCTION GPL_zero_zi(l,y) ! used to compute the value of GPL when all zi are zero ! used to compute the value of GPL when all zi are zero integer :: l integer :: l ... @@ -27,12 +45,18 @@ CONTAINS ... @@ -27,12 +45,18 @@ CONTAINS integer :: m(:), k, i integer :: m(:), k, i complex(kind=prec) :: z(:), x(k), y, GPL complex(kind=prec) :: z(:), x(k), y, GPL ! first check if we have only zero arguments ! are all z_i = 0 ? if(k == 1 .and. z(1) == 0) then if(k == 1 .and. z(1) == 0) then ! for that we assume that only one argument was passed, the rest through m1 ! for that we assume that only one argument was passed, the rest through m1 GPL = GPL_zero_zi(m(1)-1,y) GPL = GPL_zero_zi(m(1)-1,y) return return end if end if ! do they have convergent series rep? if(.not. GPL_has_convergent_series(m,z,y,k)) then print*, ' ', 'does not have convergent series representation' end if do i = 1,k do i = 1,k x(i) = merge(y/z(1), z(i-1)/z(i),i == 1) x(i) = merge(y/z(1), z(i-1)/z(i),i == 1) end do end do ... ...
 ... @@ -29,14 +29,16 @@ CONTAINS ... @@ -29,14 +29,16 @@ CONTAINS polylog = sum(x**j / j**m) polylog = sum(x**j / j**m) END FUNCTION polylog END FUNCTION polylog FUNCTION MPL_converges(x) FUNCTION MPL_converges(m,x) ! checks if the MPL converges ! checks if the MPL converges complex(kind=prec) :: x(:) complex(kind=prec) :: x(:) integer :: m(:) logical :: MPL_converges logical :: MPL_converges MPL_converges = .false. if(abs(product(x)) < 1) then if(abs(product(x)) < 1) then if(m(1) /= 1 .or. x(1) /= 1) then MPL_converges = .true. MPL_converges = .true. else end if MPL_converges = .false. end if end if END FUNCTION MPL_converges END FUNCTION MPL_converges ... @@ -77,6 +79,6 @@ END MODULE mpl_module ... @@ -77,6 +79,6 @@ END MODULE mpl_module ! PROGRAM test ! PROGRAM test ! use mpl_module ! use mpl_module ! logical :: result ! logical :: result ! result = MPL_converges( dcmplx((/10.1d0,.7d0,.3d0/)) ) ! result = MPL_converges( dcmplx((/1.0d0,.7d0,.3d0/)), (/ 1,2,1 /) ) ! print*, result ! print*, result ! end PROGRAM test ! end PROGRAM test
 ... @@ -9,11 +9,18 @@ PROGRAM TEST ... @@ -9,11 +9,18 @@ PROGRAM TEST complex(kind=prec) :: res complex(kind=prec) :: res real, parameter :: tol = 1.0e-14 real, parameter :: tol = 1.0e-14 integer :: testnr logical :: tests_successful = .true. ! call do_MPL_tests() call do_MPL_tests() call do_GPL_tests() call do_GPL_tests() if(tests_successful) then print*, 'All tests passed. ' else print*, 'Some tests failed. ' stop 1 end if CONTAINS CONTAINS subroutine check(res, ref) subroutine check(res, ref) ... @@ -22,13 +29,23 @@ CONTAINS ... @@ -22,13 +29,23 @@ CONTAINS delta = abs((res-ref)/ref) delta = abs((res-ref)/ref) if(delta < tol) then if(delta < tol) then print*, testnr,'passed with delta = ', delta print*, ' ',' passed with delta = ', delta else else print*, testnr,'not passed with delta = ', delta print*, ' ',' failed with delta = ', delta stop 1 tests_successful = .false. end if end if end subroutine check end subroutine check subroutine test_one_MPL(m,x,ref, test_id) integer :: m(:) complex(kind=prec) :: x(:), ref character(len=*) :: test_id print*, ' ', 'testing MPL ', test_id, ' ...' res = MPL(m,x) call check(res,ref) end subroutine test_one_MPL subroutine do_MPL_tests() subroutine do_MPL_tests() integer :: m2(2), m3(3) integer :: m2(2), m3(3) integer :: bla integer :: bla ... @@ -36,80 +53,42 @@ CONTAINS ... @@ -36,80 +53,42 @@ CONTAINS complex(kind=prec) :: res, ref complex(kind=prec) :: res, ref print*, 'doing MPL tests...' print*, 'doing MPL tests...' testnr = 1 m2 = (/ 1,1 /) x2 = dcmplx((/ 0.3156498673740053, 0.3431255827785649 /)) res = MPL(m2,x2) ref = dcmplx(0.022696600480693277651633) ref = dcmplx(0.022696600480693277651633) call check(res,ref) call test_one_MPL((/ 1,1 /),cmplx((/ 0.3156498673740053, 0.3431255827785649 /)),ref, '1.1') testnr = 2 m2 = (/ 1,1 /) x2 = dcmplx((/ 0.03, 0.5012562893380046 /)) res = MPL(m2,x2) ref = dcmplx(0.00023134615630308335448329926098409) ref = dcmplx(0.00023134615630308335448329926098409) call check(res,ref) call test_one_MPL((/ 1,1 /),cmplx((/ 0.03, 0.5012562893380046 /)),ref, '1.2') testnr = 3 m3 = (/ 2,1,2 /) x3 = dcmplx((/ 0.03, 0.5012562893380046, 55.3832 /)) res = MPL(m3,x3) ref = dcmplx(0.000023446106415452030937059124671151) ref = dcmplx(0.000023446106415452030937059124671151) call check(res,ref) call test_one_MPL((/ 2,1,2 /),cmplx((/ 0.03, 0.5012562893380046, 55.3832 /)),ref, '1.3') end subroutine do_MPL_tests end subroutine do_MPL_tests subroutine check_one_MPL(m,x,ref) subroutine test_one_GPL(m,z,y,k,ref,test_id) ! checks MPL(m,x) against reference value ref integer :: m(:), k integer :: m(:) complex(kind=prec) :: z(:), y, res, ref complex(kind=prec) :: x(:) character(len=*) :: test_id complex(kind=prec) :: res, ref res = MPL(m,x) print*, ' ', 'testing GPL ', test_id, ' ...' res = GPL(m,z,y,k) call check(res,ref) call check(res,ref) end subroutine check_one_MPL end subroutine test_one_GPL subroutine do_GPL_tests() subroutine do_GPL_tests() integer :: m2(2), m1(1), k integer :: m2(2), m1(1), k complex(kind=prec) :: z2(2), z1(1), y, res, ref complex(kind=prec) :: z2(2), z1(1), y, res, ref print*, 'doing GPL tests...' print*, 'doing GPL tests...' testnr = 11 m2 = (/ 1,1 /) z2 = dcmplx((/ 1.3d0, 1.1d0 /)) y = 0.4 k = 2 res = GPL(m2,z2,y,k) ref = dcmplx(0.0819393734128676) ref = dcmplx(0.0819393734128676) call check(res,ref) call test_one_GPL((/ 1,1 /),cmplx((/ 1.3d0, 1.1d0 /)),cmplx(0.4),2,ref,'2.1') testnr = 12 m2 = (/ 3,2 /) z2 = dcmplx((/ 1.3d0, 1.1d0 /)) y = 0.4 k = 2 res = GPL(m2,z2,y,k) ref = dcmplx(0.01592795952537145) ref = dcmplx(0.01592795952537145) call check(res,ref) call test_one_GPL((/ 3,2 /),cmplx((/ 1.3d0, 1.1d0 /)),cmplx(0.4),2,ref,'2.2') testnr = 13 m1 = (/ 4 /) z1 = dcmplx((/ 0 /)) y = 1.6 k = 1 res = GPL(m1,z1,y,k) ref = dcmplx(0.0173042341866201179) ref = dcmplx(0.0173042341866201179) call check(res,ref) call test_one_GPL((/ 4 /),cmplx((/ 0 /)),cmplx(1.6),1,ref,'2.3') end subroutine do_GPL_tests end subroutine do_GPL_tests subroutine check_one_GPL(m,z,y,k,ref) ! checks one GPL(m,z,y,k) against reference value ref integer :: m(:), k complex(kind=prec) :: z(:), y, res, ref res = GPL(m,z,y,k) call check(res,ref) end subroutine check_one_GPL END PROGRAM TEST END PROGRAM TEST \ No newline at end of file
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!