Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Open sidebar
McMule
handyG
Commits
489f35f4
Commit
489f35f4
authored
Aug 28, 2019
by
ulrich_y
Browse files
Added hi-weight test
parent
312c9505
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
94 additions
and
0 deletions
+94
-0
checks/test.f90
checks/test.f90
+94
-0
No files found.
checks/test.f90
View file @
489f35f4
...
...
@@ -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
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment