Commit 489f35f4 authored by ulrich_y's avatar ulrich_y

Added hi-weight test

parent 312c9505
......@@ -30,6 +30,7 @@ PROGRAM TEST
call do_ginac_tests
#ifndef NOSPEED
call do_timing_tests(5)
call do_high_weight_tests
#endif
#endif
#endif
......@@ -491,6 +492,99 @@ CONTAINS
close(unit=9)
end subroutine
subroutine fyshuffle(list, seed)
real(kind=prec) :: list(:), tmp
integer j,i, seed
do i=size(list),2,-1
j = int(ran2(seed) * i) + 1
tmp = list(j)
list(j) = list(i)
list(i) = tmp
enddo
end subroutine
function test_one_high_weight(length, fzero, funiq, alphabet, seed, what) result(res)
integer length,seed, i, what
integer nzero, nuniq, nsmall, c
real(kind=prec) :: fzero, funiq, fsmall
real(kind=prec) :: arguments(length), alphabet(10)
complex(kind=prec) :: Geval, res
nzero = nint(fzero*length)
nuniq = nint( funiq*length)
nsmall = nint(fsmall*funiq*length)
if (nzero+nuniq > length) nuniq = length - nzero
!do i=1,nsmall
! alphabet(i) = 0.8_prec * ran2(seed)
!enddo
!do i=nsmall+1,nuniq
! alphabet(i) = 1.5_prec/(0.15_prec + ran2(seed))
!enddo
arguments(1:nzero) = 0._prec
do i=1,nuniq
arguments(nzero+i) = alphabet(i)
enddo
do i=nzero+nuniq,length
c = int(ran2(seed)*nuniq)+1
arguments(i) = alphabet(c)
enddo
call fyshuffle(arguments, seed)
do while(arguments(length)<zero)
call fyshuffle(arguments, seed)
enddo
write(9,*)"args",arguments
if (what.eq.1) then
res = G(arguments, 1._prec)
elseif (what.eq.2) then
res = Geval(cmplx([arguments, 1._prec],kind=prec),length+1)
endif
end function
subroutine do_high_weight_tests
integer, parameter :: ntests=10
real(kind=prec), parameter :: fzero = 0.28
real(kind=prec), parameter :: funiq = 0.63
real(kind=prec), parameter :: fsmal = 0.42
integer(kind=8) cstart, cend, count_rate
complex(kind=prec) :: res(ntests,2)
real(kind=prec) :: alphabet(10)
integer i,j
integer seed, seedold
seed = 123123
open(unit=9, file="stats-hi.txt")
alphabet = (/ 0.3, 0.6, 1.8, 5.3, 3.6, 8.3, 0.1, 0.4, 0.2, 10.2 /)
do i=2,7
seedold=seed
do j=1,ntests
call system_clock(cstart, count_rate=count_rate)
res(j,1) = test_one_high_weight(i, fzero, funiq, alphabet, seed,1)
call system_clock(cend, count_rate=count_rate)
write(9,*) "time",i,j,real(cend-cstart)/real(count_rate,kind=prec)!/ntests
enddo
seed=seedold
do j=1,ntests
call system_clock(cstart, count_rate=count_rate)
res(j,2) = test_one_high_weight(i, fzero, funiq, alphabet, seed,2)
call system_clock(cend, count_rate=count_rate)
write(9,*)"ginac",i,j,real(cend-cstart)/real(count_rate,kind=prec)!/ntests
enddo
write(9,*)"del",abs(res(:,1)-res(:,2)) / tol
write(9,*)
write(9,*)
enddo
close(unit=9)
end subroutine
#endif
FUNCTION RAN2(randy)
......
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