Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
H
handyG
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Analytics
Analytics
Repository
Value Stream
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Commits
Open sidebar
McMule
handyG
Commits
c3567fdc
Commit
c3567fdc
authored
May 07, 2019
by
Luca
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
refactor
parent
412ce699
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
30 additions
and
14 deletions
+30
-14
gpl_module.f90
gpl_module.f90
+10
-4
random/shuffle_algebra.f90
random/shuffle_algebra.f90
+1
-1
test.f90
test.f90
+19
-9
No files found.
gpl_module.f90
View file @
c3567fdc
...
...
@@ -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
...
...
shuffle_algebra.f90
→
random/
shuffle_algebra.f90
View file @
c3567fdc
...
...
@@ -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
)
...
...
test.f90
View file @
c3567fdc
...
...
@@ -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
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