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
b408c492
Commit
b408c492
authored
May 08, 2019
by
Luca
Browse files
shuffle tests, print as matrix interface, and more
parent
1a88494e
Changes
7
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
89 additions
and
59 deletions
+89
-59
globals.f90
globals.f90
+9
-0
gpl_module.f90
gpl_module.f90
+5
-8
makefile
makefile
+1
-1
mpl_module.f90
mpl_module.f90
+2
-3
shuffle.f90
shuffle.f90
+18
-22
test.f90
test.f90
+19
-9
utils.f90
utils.f90
+35
-16
No files found.
globals.f90
0 → 100644
View file @
b408c492
MODULE
globals
implicit
none
integer
,
parameter
::
prec
=
selected_real_kind
(
15
,
32
)
real
::
zero
=
1e-15
! values smaller than this count as zero
integer
::
GPLInfinity
=
30
! the default outermost expansion order for MPLs
END
MODULE
globals
gpl_module.f90
View file @
b408c492
MODULE
gpl_module
use
mpl_module
use
globals
use
utils
use
mpl_module
implicit
none
CONTAINS
...
...
@@ -67,8 +68,6 @@ CONTAINS
integer
::
m_prime
(
size
(
z_flat
)),
condensed_size
,
kminusj
,
j
,
k
,
i
integer
,
allocatable
::
m
(:)
print
*
,
'G_flat called with args'
,
abs
(
z_flat
)
! need make convergent?
if
(
.not.
is_convergent
(
z_flat
,
y
))
then
print
*
,
'need to make convergent'
...
...
@@ -80,11 +79,9 @@ CONTAINS
kminusj
=
find_amount_trailing_zeros
(
z_flat
)
j
=
k
-
kminusj
if
(
all
(
abs
(
z_flat
)
<
zero
))
then
print
*
,
'all are zero'
,
abs
(
z_flat
)
res
=
GPL_zero_zi
(
k
,
y
)
return
else
if
(
kminusj
>
0
)
then
print
*
,
'we have'
,
kminusj
,
'trailing zeroes'
allocate
(
s
(
j
,
j
))
s
=
shuffle_with_zero
(
z_flat
(
1
:
j
-1
))
res
=
log
(
y
)
*
G_flat
(
z_flat
(
1
:
size
(
z_flat
)
-1
),
y
)
...
...
@@ -119,9 +116,9 @@ CONTAINS
integer
::
m
(:),
k
,
i
complex
(
kind
=
prec
)
::
z
(:),
x
(
k
),
y
,
res
,
c
(
sum
(
m
)
+1
,
sum
(
m
)
+1
),
z_flat
(
sum
(
m
)),
a
(
sum
(
m
)
-1
)
print
*
,
'called G_condensed with args'
print
*
,
'm = '
,
m
print
*
,
'z = '
,
abs
(
z
)
!
print*, 'called G_condensed with args'
!
print*, 'm = ', m
!
print*, 'z = ', abs(z)
! are all z_i = 0 ?
if
(
k
==
1
.and.
abs
(
z
(
1
))
<
zero
)
then
...
...
makefile
View file @
b408c492
...
...
@@ -7,7 +7,7 @@ FFLAGS=-fdefault-real-8 -cpp
LD
=
gfortran
OBJ
=
utils
.o mpl_module.o gpl_module.o
OBJ
=
globals.o utils.o shuffle
.o mpl_module.o gpl_module.o
# Rules for main fortran files
...
...
mpl_module.f90
View file @
b408c492
MODULE
mpl_module
use
utils
use
globals
use
utils
implicit
none
integer
::
GPLInfinity
=
30
! the default n if it is not passed
CONTAINS
FUNCTION
dilog
(
x
,
n
)
...
...
shuffle
_algebra
.f90
→
shuffle.f90
View file @
b408c492
PROGRAM
shuffle_algebra
MODULE
shuffle
use
globals
implicit
none
integer
::
v1
(
2
),
v2
(
2
)
integer
::
amount_shuffles
integer
::
res
(
3
,
3
)
v1
=
(/
1
,
2
/)
v2
=
(/
3
,
4
/)
call
print_as_matrix
(
shuffle_product
(
v1
,
v2
))
CONTAINS
FUNCTION
append_to_each_row
(
a
,
m
)
result
(
res
)
...
...
@@ -21,7 +13,7 @@ CONTAINS
res
(
i
,:)
=
[
a
,
m
(
i
,:)]
end
do
END
FUNCTION
append_to_each_row
FUNCTION
stack_matrices_vertically
(
m1
,
m2
)
result
(
res
)
! appends to matrix m1 the rows of matrix m2
integer
::
m1
(:,:),
m2
(:,:)
...
...
@@ -30,16 +22,6 @@ CONTAINS
res
(
size
(
m1
,
1
)
+1
:
size
(
res
,
1
),:)
=
m2
END
FUNCTION
stack_matrices_vertically
SUBROUTINE
print_as_matrix
(
m
)
! prints a 2d array as a matrix
integer
::
m
(:,:)
integer
::
s
(
2
),
i
s
=
shape
(
m
)
do
i
=
1
,
s
(
1
)
print
*
,
abs
(
m
(
i
,:))
end
do
END
SUBROUTINE
print_as_matrix
RECURSIVE
FUNCTION
factorial
(
n
)
result
(
res
)
integer
,
intent
(
in
)
::
n
integer
::
res
...
...
@@ -79,6 +61,20 @@ CONTAINS
append_to_each_row
(
beta
,
shuffle_product
(
v1
,
w2
))
)
END
FUNCTION
shuffle_product
END
PROGRAM
shuffle_algebra
END
MODULE
shuffle
! PROGRAM test
! use shuffle_algebra
! implicit none
! integer :: v1(3), v2(3)
! integer :: amount_shuffles
! integer :: res(3,3)
! v1 = (/1,2,3/)
! v2 = (/-1,-2,-3/)
! call print_as_matrix(shuffle_product(v1, v2))
! END PROGRAM test
test.f90
View file @
b408c492
...
...
@@ -3,7 +3,9 @@
! These tests assume that GPLInfinity = 30
PROGRAM
TEST
use
globals
use
utils
use
shuffle
use
mpl_module
use
gpl_module
implicit
none
...
...
@@ -11,9 +13,10 @@ PROGRAM TEST
complex
(
kind
=
prec
)
::
res
real
,
parameter
::
tol
=
1.0e-14
logical
::
tests_successful
=
.true.
! call do_MPL_tests()
call
do_GPL_tests
()
! call do_GPL_tests()
call
do_shuffle_tests
()
! put this somewhere else
if
(
tests_successful
)
then
print
*
,
'All tests passed. '
...
...
@@ -23,7 +26,7 @@ PROGRAM TEST
end
if
CONTAINS
subroutine
check
(
res
,
ref
)
complex
(
kind
=
prec
)
::
res
,
ref
real
(
kind
=
prec
)
::
delta
...
...
@@ -85,18 +88,25 @@ CONTAINS
complex
(
kind
=
prec
),
parameter
::
epsilon
=
1E-14
print
*
,
'doing GPL tests...'
!
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.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_condensed((/ 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_condensed((/ 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'
)
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
subroutine
do_shuffle_tests
()
integer
::
v
(
3
)
=
(/
1
,
2
,
3
/)
integer
::
w
(
2
)
=
(/
-1
,
-2
/)
call
print_matrix
(
shuffle_product
(
v
,
w
))
end
subroutine
do_shuffle_tests
END
PROGRAM
TEST
\ No newline at end of file
utils.f90
View file @
b408c492
...
...
@@ -4,18 +4,28 @@
! Write your own print function with ability to suppress print
! Muss immer alle prints und warnings ausschalten können
! Test Programm schreiben mit exit codes -> gfortran 'test.f90' und dann 'echo $?'
! Define GPL infinity
! Mach n optional
! Kommentar schreiben zu anderer Notation
! Funktion überprüfen! Tests schreiben!
MODULE
utils
use
globals
implicit
none
integer
,
parameter
::
prec
=
selected_real_kind
(
15
,
32
)
real
::
zero
=
1e-15
! logical :: print_enabled = .true.
! logical :: warnings_enabled = .true.
INTERFACE
print_matrix
! prints 2d array as matrix. For complex it takes absolutes
SUBROUTINE
print_integer_matrix
(
m
)
integer
::
m
(:,:)
integer
::
s
(
2
)
END
SUBROUTINE
print_integer_matrix
SUBROUTINE
print_complex_matrix
(
m
)
complex
::
m
(:,:)
integer
::
s
(
2
)
END
SUBROUTINE
print_complex_matrix
END
INTERFACE
print_matrix
CONTAINS
FUNCTION
get_condensed_m
(
z
)
result
(
m
)
...
...
@@ -86,16 +96,6 @@ CONTAINS
end
do
END
FUNCTION
find_first_zero
SUBROUTINE
print_as_matrix
(
m
)
! prints a 2d array as a matrix
complex
::
m
(:,:)
integer
::
s
(
2
),
i
s
=
shape
(
m
)
do
i
=
1
,
s
(
1
)
print
*
,
abs
(
m
(
i
,:))
end
do
END
SUBROUTINE
print_as_matrix
FUNCTION
zero_array
(
n
)
result
(
res
)
integer
::
n
complex
(
kind
=
prec
)
::
res
(
n
)
...
...
@@ -134,6 +134,25 @@ CONTAINS
END
MODULE
utils
SUBROUTINE
print_integer_matrix
(
m
)
integer
::
m
(:,:)
integer
::
s
(
2
),
i
s
=
shape
(
m
)
do
i
=
1
,
s
(
1
)
print
*
,
m
(
i
,:)
end
do
END
SUBROUTINE
print_integer_matrix
SUBROUTINE
print_complex_matrix
(
m
)
complex
::
m
(:,:)
integer
::
s
(
2
),
i
s
=
shape
(
m
)
do
i
=
1
,
s
(
1
)
print
*
,
abs
(
m
(
i
,:))
end
do
END
SUBROUTINE
print_complex_matrix
! PROGRAM test
! use utils
! implicit none
...
...
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